title	COMMON statistic of a library .REL file
	name	('LIBCOMM')
	maclib	base80

; Searching for COMMON references of a library .REL file

; Copyright (C)	Werner Cirsovius
;		Hohe Weide 44
;		D-20253 Hamburg
;		Tel.: 040/4223247

;		Version 1.0 September 1997

	ext	string,conout,combrk,crlf,decout,indexa
	ext	open,dskred,dskget,reopen,wcard

	ext	bit1,bit2,bit3,bit4,bit8,bit16,bitcnt,biterr
	ext	AField,BField,dskpc

	dseg
$REL:
	db	'REL'
$IRL:
	db	'IRL'
$NOFILE:
	db	'Cannot find REL file',eot
$ILLIRL:
	db	'Invalid IRL file',eot
$FILERR:
	db	'Abnormal REL termination',eot
$WILD:
	db	'Wildcard not allowed in filename'
	db	cr,lf,eot
$HELP:
	db	'LIBCOMM searches a REL-80 library for COMMON references.'
	db	cr,lf,lf
	db	'.REL file as well as .IRL file are supported.'
	db	cr,lf,eot
$NUM:
	db	' (Size = '
$$NUM:
	db	'65535)',eot
$MOD:
	db	'Module '
$$MOD:
	db	'65535:',eot
$BREAK:
	db	cr,lf,lf,'*** USER BREAK ***',cr,lf,eot
ctrltb:
	dw	field0,field1,field2,field3
	dw	field4,field5,field6,field7
	dw	field8,field9,fielda,fieldb
	dw	fieldc,fieldd,fielde,fieldf
$NAME:
	ds	8+1
$MODNAM:
	ds	8+1
newmod:
	db	0
ModNum:
	dw	0

	cseg
;
; Try to find file with extension ^HL - C set if file not found
;
tryFile:
	ld	de,FCBext
	ld	bc,.fext
	ldir			; Set .REL
Fopen:
	ld	de,FCB
	call	open		; Test file present
	ret
;
; Test extension .IRL ^HL - Z set says yes
;
isIRL:
	ld	a,(hl)		; Get it
	cp	'I'		; Test it
	ret	nz
	inc	hl
	ld	a,(hl)
	cp	'R'
	ret	nz
	inc	hl
	ld	a,(hl)
	cp	'L'
	ret
;
; Process one module - Z set on end of file
;
ProcModule:
	ld	hl,(ModNum)
	inc	hl		; Advance module number
	ld	(ModNum),hl
	ld	a,-1
	ld	(newmod),a	; Init new moule
	ld	(bitcnt),a	; Init bit count
;
; Decode the bitstream
;
loop:
	call	bit1		; Get a bit
	jr	c,ctrl1		; It's special
	call	bit8		; Get byte
	jr	loop
;
; First bit is not 0, test next two bits
;
ctrl1:
	call	bit2		; Get control bits
	or	a		; Test special
	jr	z,ctrl2
	call	bit16		; Get word
	jr	loop
;
; The observed two bits are 00, await four control bits
;
ctrl2:
	call	bit4		; Get control bits
	ld	hl,ctrltb
	call	indexa		; Get index
	ex	de,hl
	ld	de,loop
	push	de		; Set return address
	jp	(hl)		; -->> Jump
;
; Code	0000 (ENTRY symbol), 0001 (Select COMMON),
;	0010 (Name of module), 0011 (LIBRARY request),
;	0100 (Special MS item)
; ->>	Name field 
;
field0:
field1:
field3:
field4:
f.0_4:
	call	RdBField	; Get field
	ret
;
; Name of module
;
field2:
	call	RdBField	; Get field
	ld	de,$MODNAM
	ld	bc,8+1
	ldir			; Unpack name of module
	ret
;
; Code	0101 (Define COMMON size), 0110 (Chain external),
;	0111 (Define ENTRY point)
; ->>	Value field - name field
;
field6:
field7:
	call	AField		; Get 16 bit
	jr	f.0_4		; Then name
;
; Define COMMON size
;
field5:
	call	AField		; Get 16 bit
	push	hl		; Save value
	call	RdBField	; Get field
	call	ModName		; Tell name of module
	call	COMMname
	pop	hl
	call	prdec		; Print size
	call	crlf
	ret
;
; Code	1000 (External plus offset), 1001 (External plus offset),
;	1010 (define data size), 1011 (Set location counter),
;	1100 (Chain address), 1101 (Define program size)
; ->>	Value field
;
field8:
field9:
fielda:
fieldb:
fieldc:
fieldd:
	call	AField		; Get 16 bit
	ret
;
; Code	1110 (End module)
; ->>	Value field (Reset to byte boundary)
;
fielde:
	call	AField		; Get 16 bit
	pop	af		; Clean stack
	xor	a
	inc	a		; Set no end
	ret
;
; Code : 1111
; ->>	End of file
;
fieldf:
	pop	af		; Clean stack
	xor	a		; Indicate end
	ret
;
; Get the BField
; EXIT	Reg HL points to name
;
RdBField:
	ld	hl,$NAME
	push	hl
	call	BField		; Get name
	pop	hl
	ret
;
; Print name of module if not done before
;
ModName:
	ld	a,(newmod)	; Test new module
	or	a
	ret	z		; Nope
	ld	hl,(ModNum)	; Get number of module
	ld	de,$$MOD
	ld	b,0
	call	decout		; Convert to decimal
	ld	(hl),':'	; Close string
	inc	hl
	ld	(hl),eot
	ld	de,$MOD
	call	string		; Print it
	ld	a,' '
	call	conout
	ld	hl,$MODNAM	; Point to name
	call	PrName
	call	crlf
	ld	a,FALSE
	ld	(newmod),a	; Reset new moule
	ret
;
; Tell name of COMMON
;
COMMname:
	ld	a,' '
	call	conout
	ld	a,'/'
	call	conout
	ld	hl,$NAME
	call	PrName
	ld	a,'/'
	call	conout
	ret
;
; Print ASCII name from buffer
; ENTRY	Reg HL points to name-1
;	Reg B  holds length
;
PrName:
	ld	b,(hl)		; Get length
..PrName:
	inc	hl
	ld	a,(hl)		; Get character
	call	GetASCII	; Get valid ASCII
	call	conchk		; Print
	djnz	..PrName
	ret
;
; Print character, test BREAK
; ENTRY	Accu holds character
;
conchk:
	call	conout		; Print
	call	combrk		; Test BREAK
	ret	nc		; No, exit
	cp	CtrlC		; Test CTRL-C
	ret	nz
	ld	de,$BREAK
	call	string		; Tell BREAK
	jp	OS		; HARD STOP
;
; Get valid ASCII character
; ENTRY	Accu holds character
; EXIT	Accu mapped to valid character
;
GetASCII:
	cp	' '		; Test control
	jr	c,spc.Ctrl
	cp	'~'+1		; .. and 8 bit
	ret	c
spc.Ctrl:
	ld	a,'*'		; Indicate hex
	ret
;
; Print number in reg HL
;
prdec:
	ld	de,$$NUM
	ld	b,0
	call	decout		; Convert to decimal
	ld	(hl),')'	; Close string
	inc	hl
	ld	(hl),eot
	ld	de,$NUM
	call	string		; Print it
	ret
;
; Skip header of IRL file
;
SkpHead:
	ld	de,FCB
	call	dskred		; Read 1st record
	ld	a,(DMA)		; Get extent number
	ld	(FCB+_EX),a
	ld	a,(DMA+1)	; Get record number
	ld	(FCB+_CR),a
	ld	de,FCB
	call	reopen		; Reopen file
	ret	nc		; Ok
illIRL:
	ld	de,$ILLIRL
	jr	pr.err
;
; Give some help
;
Help:
	ld	de,$HELP
	jr	pr.err
;
; Wildcard not allowed here
;
IllWild:
	ld	de,$WILD
	jr	pr.err
;
; Invalid REL stream
;
rederr:
	ld	de,$FILERR
	jr	pr.err
;
; Tell no file found
;
NoFile:
	ld	de,$NOFILE
pr.err:
	call	string		; Tell file not found
	jp	OS		; Abort
;
; #####################
; ### START PROGRAM ###
; #####################
;
LIBCOMM:
	ld	sp,(TPAtop)	; Get stack
	ld	de,FCBnam
	ld	a,(de)
	cp	' '		; Test filename given
	jp	z,Help		; Bope, give some help
	dec	de
	call	wcard		; Test wildcard
	jp	z,IllWild	; Not allowed
	ld	a,(FCBext)	; Get extension
	cp	' '		; Test defined
	jr	nz,GotExt	; Yeap
	ld	hl,$IRL
	call	tryFile		; Try .IRL file
	ld	hl,$REL
	call	c,tryFile	; Try .REL file if not found
	jr	c,NoFile	; Nope
GotExt:
	call	Fopen		; Open file
	jr	c,NoFile	; Not found
	ld	hl,FCBext	; Test .IRL
	call	isIRL
	call	z,SkpHead	; Skip .IRL header if so
	ld	hl,dskget
	ld	(dskpc),hl	; Enable disk I/O
	ld	hl,rederr
	ld	(biterr),hl	; Set error linkage
GetModule:
	call	ProcModule	; Process one module
	jr	nz,GetModule	; Still more
	jp	OS

	end	LIBCOMM