title	Scan Libraries for assembler EQUs
	name	('LBREQU')
	maclib	base80.lib

; Scan thru .LBR files looking for .MAC members
; Extract all lines including EQUate statements

; Call it:
;	LBREQU LBRfile {EQUfile} {[opt]}

; Extension of LBRfile defaults to .LBR

; Without EQUfile result will be written to file @@@EQU.INC

; Option may be:
;	A	Append date to EQUfile rather than rewrite new file
;	V	Be pretty verbose, type libraries and members

; Copyright (C)	Werner Cirsovius
;		Hohe Weide 44
;		D-Hamburg 20253
;		Phone: +49-40-4223247

;		Initial version 1.1, September 1997

$$VER	macro
	db	'1.1'
	endm

$$PRG	macro
	db	'LBREQU'
	endm

	entry	$memry

	ext	string,getver,prfn,crlf,skpblk,skpitm,uppcon
	ext	defio,combrk,wrfcb,rdbfp,rdbuf,cmdarg,indexa
	ext	curdrv,dirmax,files,creatd,opnapp,wrbuf,wrbfp
	ext	closef,delete,setdma,dskred,rndred,open,fillin
	ext	emplin,parse,wcard

_ARGC	equ	3		; Max arguments

_ACT	equ	0

_IDX	equ	12
_LEN	equ	14
_MEM	equ	32
;
; ++++++++++++++++++++++++++++++++++++++++++++++++++++
; -->> THIS MUST BE THE VERY FIRST ENTRY AT 0103H <<--
; ++++++++++++++++++++++++++++++++++++++++++++++++++++
;
$SRC:
	db	'MAC'		; May change to other extension
;
; Read directory of .LBR file
;
RdDIR:
	ld	de,$PRC.LBR
	ld	hl,FCB
	call	TellLBR		; Give info on library
	ld	de,(LBRDIR)	; Get start of directory pointer
	ld	(LBRPTR),de	; .. init
	call	rdRec		; Read record
	push	de
	pop	ix
	push	hl
	call	chkDIR		; Verify correct directory
	pop	hl		; Get back pointer
	call	..rdD		; .. read remainder
	ld	(LINEPT),hl
	ld	(hl),255	; .. force max input
	ret
..rdD:
	dec	bc
	ld	a,c
	or	b		; Test end
	ret	z		; .. yeap
	ex	de,hl
	call	rdRec		; Read record
	jr	..rdD
;
; Scan .MAC files
;
scanMAC:
	call	nxtMACfile	; Get next .MAC file
	ret	z		; .. end
nxt.scan:
	ld	de,(LINEPT)	; Get line pointer
	ld	b,null
	call	fillin		; .. read line
	jr	c,scanMAC	; .. end of file
	jr	z,nxt.scan	; .. empty line
	inc	de
	push	de
	ld	c,a		; .. save length
	call	isEQU?		; .. test EQU
	pop	de
	ld	b,null
	call	z,prclin	; .. write this line
	jr	nxt.scan
;
; Process line ^DE with length in reg C
;
prclin:
	push	de
	push	bc
	call	fixlin		; .. fix line
	ex	de,hl
	ld	hl,$PREFIX
	ld	bc,pre.len
	ldir			; Append name of lib and file
	ld	hl,FCB
	call	appFN
	ld	a,'/'
	ld	(de),a
	inc	de
	ld	hl,(LBRPTR)	; Get current pointer
	call	appFN
	ld	hl,$SUFFIX
	ld	bc,suf.len
	ldir
	pop	bc
	pop	de
wrline:
	call	emplin		; .. write this line
	ret	nc
	jp	wrterr
;
; Process line ^DE with length in reg C
;
fixlin:
	ld	b,0
	dec	bc		; Fix for CR and LF
	dec	bc
	ex	de,hl
	ld	a,';'
	cpir			; Find comment
	ret	nz		; .. nope
	dec	hl
..fl:
	dec	hl
	ld	a,(hl)		; Find first item
	cp	' '+1
	jr	c,..fl
	inc	hl
	ret
;
; Append file ^HL to pointer ^DE
;
appFN:
	ld	a,(defio)
	push	af
	ld	a,1000b
	ld	(defio),a
	ex	de,hl
	call	prfn		; Unpack name
	ex	de,hl
	pop	af
	ld	(defio),a
	ret
;
; Test line ^DE contains 'EQU'
;
isEQU?:
	ld	a,(de)		; Verify 1st character non blank
	cp	' '+1
	jr	c,NO.Z
	cp	';'		; Test comment
	jr	z,NO.Z		; Ignore line
	call	skpitm		; Skip item
	call	skpblk		; .. and blank
	ld	b,'E'
	call	hitEQU?		; Now test it
	ret	nz
	ld	b,'Q'
	call	hitEQU?
	ret	nz
	ld	b,'U'
	call	hitEQU?
	ret	nz
	ld	a,(de)		; Verify delimiter
	cp	' '+1
	jr	nc,NO.Z
	xor	a
	ret
NO.Z:
	xor	a
	inc	a		; Set no match
	ret
;
; Test character ^DE matches B no care of case - Z set says match
;
hitEQU?:
	ld	a,(de)		; Get character
	inc	de
	call	uppcon		; .. as UPPER case
	cp	b
	ret
;
; Get next .MAC file - Z set says no more
;
nxtMACfile:
	ld	hl,(DCNT)	; Get count
	ld	a,l		; Test any there
	or	h
	ret	z		; .. nope
	dec	hl		; Count down
	ld	(DCNT),hl
	ld	hl,(LBRPTR)	; Get current pointer
	ld	de,_MEM
	add	hl,de
	ld	(LBRPTR),hl	; .. save
	ld	a,(hl)		; Test active member
	cp	_ACT
	jr	nz,nxtMACfile	; .. try next if not
	push	hl
	pop	ix
	call	isMAC?		; Test .MAC file
	jr	nz,nxtMACfile	; .. try next if not
	ld	hl,FCB+_RRN
	ld	a,(ix+_IDX)	; Unpack record number
	ld	(hl),a
	inc	hl
	ld	a,(ix+_IDX+1)
	ld	(hl),a
	inc	hl
	ld	(hl),0
	ld	de,$PRC.MEM
	push	ix
	pop	hl
	call	TellLBR		; Give info on member
	ld	a,reclng
	ld	(rdbfp),a	; .. force read
	ld	de,(rdbuf)
	call	setdma
	ld	de,FCB
	call	rndred		; .. position file
	jr	nc,NO.Z
	jp	rd.err
;
; Test extension ^IX .MAC - Z set says yes
;
isMAC?:
	ld	iy,$SRC
	ld	a,(ix+.fdrv+.fname)
	cp	(iy+0)
	ret	nz
	ld	a,(ix+.fdrv+.fname+1)
	cp	(iy+1)
	ret	nz
	ld	a,(ix+.fdrv+.fname+2)
	cp	(iy+2)
	ret
;
; Check 1st directory entry ^DE and ^IX
; Returns records to be read in reg BC
;
chkDIR:
	ld	a,(de)		; Verify zero
	or	a
	jr	nz,DIR.err
	ld	b,.fname+.fext
..cD:
	inc	de
	ld	a,(de)		; Verify blanks
	cp	' '
	jr	nz,DIR.err
	djnz	..cD
	ld	a,(ix+_IDX)	; Verify correct index
	or	(ix+_IDX+1)
	jr	nz,DIR.err
	ld	l,(ix+_LEN)	; Get length
	ld	h,(ix+_LEN+1)
	ld	a,l
	or	h		; Verify not zero
	jr	z,DIR.err
	push	hl
	add	hl,hl		; *2
	add	hl,hl		; *4
	dec	hl
	ld	(DCNT),hl	; .. save count
	pop	bc
	ret
DIR.err:
	ld	de,$DIR.ERR
	jp	in.err		; .. process error
;
; Read record from .LBR file into buffer ^DE
; On exit reg HL points to next record buffer
;
rdRec:
	push	de
	call	setdma		; Set disk buffer
	ld	hl,reclng
	add	hl,de		; .. advance
	ld	de,FCB
	call	dskred		; .. read record
	pop	de
	ret	nc		; .. ok
rd.err:
	ld	de,$RD.ERR
	jp	in.err		; .. process error
;
; Scan .LBR files
;
scanLBR:
	call	nxtLBRfile	; Get next library file
	jr	z,lineLBR	; .. that's all
	call	RdDIR		; Read directory of .LBR file
	call	scanMAC		; Scan MAC files
	jr	scanLBR
lineLBR:
	ld	b,eot
	ld	de,$LINE
	jp	wrline		; Put delimiter line at the end
;
; Get next library file - Z set says no more files
;
nxtLBRfile:
	ld	hl,(FCNT)	; Get count
	ld	a,l
	or	h		; Test remainder
	ret	z		; .. nope
	dec	hl
	ld	(FCNT),hl
	ld	hl,(FPTR)	; Get file pointer
	inc	hl		; .. skip drive
	ld	de,FCBnam
	ld	bc,.fname+.fext
	ldir			; .. get name
	ld	(FPTR),hl
	ld	de,FCB
	call	open		; .. open file
	jr	c,opn.err	; .. not on disk
	xor	a
	inc	a		; Set success
	ret
opn.err:
	ld	de,$NO.OP
in.err:
	ld	hl,FCB
Fmsg:
	push	hl
	call	string		; Tell file message
	pop	de
	call	prfn
	call	crlf
	jp	OS
;
; Init program
;
Initialize:
	call	GetArgs		; Sample arguments
	ld	de,$ILLLBR
	call	assign		; Assign file
	ret
;
; Bad error - Wrong machine
;
illCPU:
	ld	de,$ILL.CPU
	ld	c,.string
	call	BDOS		; Tell invalid machine
	jp	OS
;
; %%%%%%%%%%%%%%%%
; %% COLD START %%
; %%%%%%%%%%%%%%%%
;
MAIN:
	sub	a		; Test right machine
	jp	pe,illCPU	; .. nope
	ld	sp,LocStk
	ld	de,$VERS
	call	string		; Give version
	call	getver		; Verify CP/M 3.x
	ld	de,$ILL.OS
	jp	c,comstr
	call	Initialize	; Initialize program
	call	GetFiles	; Find source file(s)
	call	Rewrite		; Rewrite result file
	call	scanLBR		; Do the job
	call	closef		; Close result file
	jr	c,wrterr	; .. error
	ld	de,$RESULT
	ld	hl,(wrfcb)	; .. get FCB
	jp	Fmsg
help:
	ld	de,$HELP	; .. give help
comstr:
	call	string
	jp	OS
wrterr:
	ld	de,$NO.CLOS
del..:
	call	string
	ld	de,(wrfcb)
	call	delete		; .. delete file
	jp	OS
;
; Find source file
;
GetFiles:
	ld	de,FCBnam
	ld	hl,$WILD
	ld	bc,.fname
	call	.LDIR?		; Init name
	ld	de,FCBext
	ld	hl,$LBR
	ld	bc,.fext
	call	.LDIR?		; .. and extension
	ld	a,(FCB)		; Get drive
	dec	a
	call	m,curdrv	; Map current to real drive
	call	dirmax		; .. fetch max count
	ld	c,l
	ld	b,h
	ld	hl,($memry)	; Fetch start of data
	ld	(FPTR),hl
	ld	de,FCB
	call	files		; .. fetch file
	ld	(FCNT),bc	; .. save count
	ld	(LBRDIR),de	; .. and top
	ret	nc		; .. well done
	ld	de,$NO.SRC
	jp	comstr		; .. error
;
; Rewrite result file
;
Rewrite:
	ld	hl,(LBRDIR)	; Get top
	ld	(wrbuf),hl	; .. as output buffer
	ld	de,reclng
	add	hl,de
	ld	(wrfcb),hl	; .. and FCB
	ld	(hl),0		; .. set default drive
	push	hl
	push	hl
	ld	de,fcblen
	add	hl,de
	ld	(LBRDIR),hl	; .. set new top
	pop	de
	inc	de
	ld	hl,$FON
	ld	bc,.fname+.fext
	ldir			; ..set file name
	pop	de
	ld	a,(@APP@)
	or	a		; Test append
	jr	z,..crec	; .. nope
	push	de
	ld	de,(wrbuf)
	call	setdma
	pop	de
	call	opnapp		; .. prepare append
	jr	c,cr.err	; .. error
	ld	(wrbfp),a
	ret
..crec:
	call	creatd		; .. create file
	ret	nc
cr.err:
	ld	de,$NO.CREC
	jp	comstr		; .. error
;
; Move ^HL -> ^DE for BC bytes if ^DE a blank
;
.LDIR?:
	ld	a,(de)		; Test empty
	cp	' '
	ret	nz		; .. nope
	ldir			; .. unpack
	ret
;
; Test break
;
isBRK?:
	call	combrk		; Test keyboard attached
	ret	nc		; .. nope
	cp	'C'-'@'		; Test abort
	ret	nz		; .. nope
	ld	de,$ABORT
	jp	del..
;
; Assign standard file - Error message in ^DE
;
assign:
	ld	hl,comstr
	push	hl		; Set error return
	push	de		; Save message
	ld	de,PB
	call	parse		; Get file
	pop	de
	ret	c
	ld	a,l
	or	h		; Verify correct end
	ret	nz
	pop	af		; .. clean stack
	ret
;
; Sample CCP arguments
;
GetArgs:
	ld	de,CCPlen
	ld	b,_ARGC
	ld	hl,ARGV
	call	cmdarg		; Get arguments
	jp	c,help		; .. error
	ld	hl,ARGVex-2
	call	indexa		; .. get pointer
	ex	de,hl
	jp	(hl)		; .. parse line
;
; The command line parser
;
; Got three parameters of the form
;	FILE1 FILE2 [OPTION]
;
CCP.3:
	ld	hl,(ARGV+2*(_ARGC-1))
	ld	a,(hl)		; Verify option
	cp	'['
	jp	nz,help		; .. must be
	call	..opt		; Get option
	jr	..equf		; .. get EQU file
;
; Got two parameters of the forms
;	FILE1 [OPTION]
;	FILE1 FILE2
;	FILE1 FILE2[OPTION]
;
CCP.2:
	ld	hl,(ARGV+2*(_ARGC-2))
	ld	a,(hl)		; Test option
	cp	'['
	jr	nz,equf?	; .. nope, get EQU file
	call	..opt		; Get option
	jr	getFN		; .. then file
equf?:
	call	prcopt		; Process option if there
..equf:
	ld	hl,(ARGV+2*(_ARGC-2))
	call	unpeqf		; .. unpack EQU file
	jr	getFN		; .. get file
;
; Got one parameters of the forms
;	FILE1
;	FILE1[OPTION]
;
CCP.1:
	ld	hl,(ARGV)	; Get 1st parameter
	call	prcopt		; Process option if there
;
; Now get file name
;
getFN:
	ld	hl,(ARGV)	; Get 1st parameter
	ld	(PB),hl		; .. into block
	ret
;
; Test if option embedded in string ^HL and process if so
;
prcopt:
	ld	a,(hl)		; Get character
	or	a		; Test end
	ret	z		; .. yeap
	cp	'['		; Test option
	jr	z,opt.fnd	; .. yeap
	inc	hl
	jr	prcopt
opt.fnd:
	ld	(hl),null	; Overwrite '['
..opt:
	ld	c,00b		; Init options
	inc	hl
	ld	a,(hl)		; Fetch option
	cp	'V'		; Test 'V'erbose
	jr	nz,optApp?
	call	opt.VERB	; .. do it
	jr	z,opt.ex	; .. no more
	cp	'A'		; Test 'A'ppend
	jr	nz,noop
	call	opt.APP		; Do it
	jr	z,opt.ex	; .. verify end
noop:
	jp	help
optApp?:
	cp	'A'		; Test 'A'ppend
	jr	nz,noop
	call	opt.APP		; Do it
	jr	z,opt.ex	; .. end
	cp	'V'		; Test 'V'erbose
	jr	nz,noop
	call	opt.VERB	; .. do it
	jr	nz,noop		; .. verify end
opt.ex:
	inc	hl
	ld	a,(hl)
	or	a		; Verify real end
	jr	nz,noop		; .. verify end
	ret
;
; Execute option A
;
opt.APP:
	bit	0,c		; Test already set
	set	0,c
	ld	ix,@APP@
	jr	set.opt		; .. set it
;
; Execute option V
;
opt.VERB:
	bit	1,c		; Test already set
	set	1,c
	ld	ix,@VERB@
set.opt:
	jp	nz,help		; .. was set, error
	ld	(ix),TRUE	; .. set flag
	inc	hl
	ld	a,(hl)		; Test end
	cp	']'
	ret
;
; Unpack EQU file name
; ENTRY	Reg pair HL points to name parameter
;
unpeqf:
	ld	(PB),hl		; Save name of EQU file
	ld	de,$ILLEQU
	call	assign		; Assign file
	ex	de,hl
	ld	de,FCB
	call	wcard		; Test wild card
	ex	de,hl
	jp	z,comstr	; .. invalid
	ld	de,$FON
	ld	hl,FCBnam
	ld	bc,.fname+.fext
	ldir			; Unpack file name
	ret
;
; Check break and be verbose if selceted
; Print message ^DE and file ^HL
;
TellLBR:
	call	isBRK?		; Test break
	ld	a,(@VERB@)
	or	a		; Test option
	ret	z
	call	string		; Tell action
	ex	de,hl
	call	prfn		; .. give file
	call	crlf
	ret

	dseg

$VERS:
	$$PRG
	db	' '
	$$VER
	db	cr,lf,lf,eot
$HELP:
	db	'Scan thru .LBR files looking for .MAC members'
	db	cr,lf
	db	'Extract all lines including EQUate statements'
	db	cr,lf
	db	'Call it:',cr,lf
	db	tab
	$$PRG
	db	' LBRfile {EQUfile} {[opt]}'
	db	cr,lf
	db	'Extension of LBRfile defaults to .LBR, LBRfile may be ambiguous'
	db	cr,lf,lf
	db	'Without EQUfile result will be written to file @@@EQU.INC'
	db	cr,lf,lf
	db	'Option may be:'
	db	cr,lf
	db	tab,'A',tab,'Append date to EQUfile rather than rewrite new file'
	db	cr,lf
	db	tab,'V',tab,'Be pretty verbose, type libraries and members'
	db	cr,lf,lf
	db	'(The extension .MAC may be changed at location 0103H)'
	db	cr,lf,eot
$ILL.OS:
	db	'Requires CP/M 3.x',eot
$ILL.CPU:
	db	'Requires Z80 CPU',eot
$NO.SRC:
	db	'No appropriate file found',cr,lf,eot
$NO.CREC:
	db	'Directory full, cannot create output file'
	db	cr,lf,eot
$NO.CLOS:
	db	'Disk full, cannot write or close output file'
	db	cr,lf,eot
$ILLLBR:
	db	'Invalid LBR file spec',cr,lf,eot
$ILLEQU:
	db	'Invalid EQU file spec',cr,lf,eot
$NO.OP:
	db	'Cannot open file ',eot
$RD.ERR:
	db	'Read error from file ',eot
$DIR.ERR:
	db	'Invalid directory in file ',eot
$PRC.LBR:
	db	'Processing lirarian ',eot
$PRC.MEM:
	db	'- Processing member ',eot
$RESULT:
	db	'Scan done, result in file ',eot
$FON:
	db	'@@@EQU  INC'
$ABORT:
	db	cr,lf
	db	'** Aborted by user - No file generated'
	db	cr,lf,eot
$LINE:
	db	'--------------------------------------------------------'
	db	cr,lf,eot
$WILD:
	db	'????????'
$LBR:
	db	'LBR'
$PREFIX:
	db	tab,'; ['
pre.len	equ	$-$PREFIX
$SUFFIX:
	db	']',cr,lf,null
suf.len	equ	$-$SUFFIX
FPTR:
	ds	2
FCNT:
	ds	2
LBRDIR:
	ds	2
LBRPTR:
	ds	2
DCNT:
	ds	2
LINEPT:
	ds	2
$memry:
	dw	0
PB:
	dw	DMA,FCB
ARGV:
	ds	2*_ARGC
ARGVex:
	dw	CCP.1,CCP.2,CCP.3
@APP@:
	db	FALSE
@VERB@:
	db	FALSE
;
	ds	2*64
LocStk	equ	$

	end	MAIN