title	Checking reference of library .REL file
	name	('LIBREF')
	maclib	base80

; Checking reference list of library .REL file

; Format:
;
; *LABEL    in  (X) MODUL1  ,(P) MODUL2
;
; Where *LABEL is the name of an external or public symbol.
; (X) denotes external declaration in MODUL1 and (P) public MODUL2

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

;		Version 1.0 September 1997

	entry	$memry

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

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

;;DEBUG	equ	TRUE
DEBUG	equ	FALSE

NamLen	equ	8

_ENT	equ	'P'
_EXT	equ	'X'

_OUT	equ	7

_LEFT	equ	13
_COLS	equ	80 / _LEFT

COLMASK	equ	00001111b

;
; #####################
; ### START PROGRAM ###
; #####################
;
LIBREF:
	ld	hl,(TPATOP)	; Get top
	ld	sp,hl		; For stack
	ld	de,-2*64
	add	hl,de		; Let some room
	ld	(heaptop),hl	; For data top
	ld	hl,($memry)	; Get start of data
	ld	(heapcurr),hl
	ld	(hl),0		; Set empty
	ld	hl,dskget
	ld	(dskpc),hl	; Set file read routine
	ld	hl,dskerr
	ld	(biterr),hl	; Set error routine
	ld	de,FCB+.fdrv
	ld	a,(de)
	cp	' '		; Test filename given
	jp	z,Help
	dec	de
	call	wcard		; Test wildcard
	jp	z,IllWild	; Not allowed
	ld	a,(FCB+.fdrv+.fname)
	cp	' '		; Test extension
	jr	nz,gotext	; Got one
	ld	hl,$$REL
	call	exist		; Test .REL file does exist
	jr	nc,goREL	; Yeap
	ld	hl,$$IRL
	call	exist		; Test .IRL file does exist
	jp	c,NoFile	; Not on board
	call	IRLpos		; Position to .REL record
	jr	goREL		; Start
gotext:
	ld	de,FCB
	call	open		; Find file
	jp	c,NoFile	; Not on board
goREL:
	ld	de,$READING
	call	string		; Tell reading file
	call	PrFName		; Print name of file
	ld	a,' '
	call	conout		; Give delimiter
libread:
	call	bit1		; Read bit from library
	jr	c,noconst	; Maybe control
	call	bit8		; Skip constant byte
	jr	libread
noconst:
	call	bit2		; Read next two bits
	or	a		; Test control
	jr	z,spclink
	call	bit16		; Skip address
	jr	libread
spclink:
	call	bit4		; Get control bits
	ld	hl,ctrtab
	call	indexa		; Get address for control
	ld	hl,libread
	push	hl		; Set return address
	ex	de,hl
	jp	(hl)		; Execute
;
; Special link item 0000 (0) - ENTRY symbol
;
spc0000:
	call	.BField		; Get name field
	call	stENTRY		; Store as ENTRY
	ret
;
; Special link item 0001 (1) - Select COMMON block
; Special link item 0011 (3) - Library request
; Special link item 0100 (4) - Extension MS-Link
;
spc0001:
spc0011:
spc0100:
	call	.BField		; Skip item
	ret
;
; Special link item 0010 (2) - Program name
;
spc0010:
	call	.BField		; Get name field
	call	stNAME		; Store as NAME
	ret
;
; Special link item 0101 (5) - Define COMMON size
; Special link item 0111 (7) - Define entry point
;
spc0101:
spc0111:
	call	AField		; Skip value
	call	.BField		; Skip item
	ret
;
; Special link item 0110 (6) - Chain external
;
spc0110:
	call	AField		; Skip value
	call	.BField		; Read item
	call	stEXTRN		; Store as EXTRN
	ret
;
; Special link item 1000 (8) - External minus offset
; Special link item 1001 (9) - External plus offset
; Special link item 1010 (A) - define data size
; Special link item 1011 (B) - Set location counter
; Special link item 1100 (C) - Chain address
; Special link item 1101 (D) - define program size
;
spc1000:
spc1001:
spc1010:
spc1011:
spc1100:
spc1101:
	call	AField		; Skip value
	ret
;
; Special link item 1110 (E) - End module
;
spc1110:
	call	AField		; Skip value
	ld	a,-1
	ld	(bitcnt),a	; Force byte boundary
	call	Rotate		; Print rotation
TstAbort:
	call	combrk		; Maybe user break
	ret	nc		; Nope
	cp	'C'-'@'		; Maybe break
	ret	nz
	ld	de,$ABORT
	jp	IllMsg
;
; Special link item 1111 (F) - End file
;
spc1111:
	pop	af		; Clean stack
	ld	a,' '
	call	conout
	call	crlf
SymLoop:
	ld	c,00000000b	; Set no access in this loop
	ld	ix,($memry)	; Get start of data
Outloop:
	bit	7,(ix+NamIdx)	; Test module name already written
	call	z,OutChain	; Print chain
	call	TstAbort	; Test user break
	ld	de,SymLen
	add	ix,de		; Build new top
	ld	a,(ix+0)
	or	a		; Test end
	jr	nz,Outloop	; Nope
	bit	_OUT,c		; Test any output in this loop
	jr	nz,SymLoop	; Yeap
	jp	OS		; End
;
; Output chain ^IX
;
OutChain:
	ld	a,' '
	ld	($NAM),a	; Init name delimiter
	ld	a,'*'
	call	conout		; Indicate module
	push	ix		; Copy pointer
	pop	iy
	ld	de,SymIdx
	call	prSym		; Print symbol
	ld	de,SymName
	ld	bc,NamLen
	ldir			; Unpack symbol name
	ld	c,1 SHL _OUT	; Init module count and print
	ld	de,$DEL
	call	string		; Indicate symbol
ChainLoop:
	ld	a,(iy+TypIdx)
	ld	($TYP),a	; Set type
	ld	de,$NAM
	call	string		; Give delimiter
	ld	a,','
	ld	($NAM),a	; Init name delimiter
	ld	de,NamIdx
	call	prSym		; Print module
	set	7,(iy+NamIdx)	; Indicate this one printed
	inc	c		; Bump counter
ChainNxt:
	ld	de,SymLen
	add	iy,de		; Point to next
	ld	a,(iy+0)	; Test more
	or	a
	jr	z,ChainExt	; End of all
	call	CmpSym		; Find symbole
	jr	nz,ChainNxt	; Nope
	ld	a,c
	and	COLMASK
	cp	_COLS-1		; Test all columns scanned
	jr	nz,ChainLoop
	call	crlf		; Give new line
	ld	e,' '
	ld	b,_LEFT
	call	conchd		; Blank a bit
	ld	a,c
	and	NOT COLMASK
	ld	c,a		; Clear counter
	ld	a,' '
	ld	($NAM),a	; Init name delimiter
	jr	ChainLoop
ChainExt:
	ld	a,c
	and	COLMASK
	call	nz,crlf		; New line if any in previous line
	ret
;
; Find symbol from ^IY - Z set says yes
;
CmpSym:
	push	iy
	push	bc
	ld	b,NamLen	; Set length
	ld	de,SymName
	call	FndSym		; Search it
	pop	bc
	pop	iy
	ret
;
FndSym:
	ld	a,(de)
	cp	(iy+SymIdx)	; Compare
	ret	nz		; No match
	inc	de
	inc	iy
	djnz	FndSym
	ret
;
; Print offset symbol
;
prSym:
	push	iy
	pop	hl		; Copy pointer
	add	hl,de		; Position in symbol
	push	hl
	push	bc
	ld	b,NamLen	; Set length
prSymNam:
	ld	a,(hl)
	call	conout		; Print symbol
	inc	hl
	djnz	prSymNam
	pop	bc
	pop	hl
	ret
;
; Read name field
;
.BField:
	ld	hl,BFIELDdata
	call	BField		; Read item
	ret
;
; Expand name to ^DE
;
Expand:
IF	DEBUG
	push	de
	call	.Expand
	ld	de,$INSRT
	call	string
	pop	iy
	ld	de,0
	call	prSym
	call	crlf
	ret
	dseg
$INSRT:
	db	'Insert: ',eot
	cseg
.Expand:
ENDIF	;DEBUG
	ld	hl,BFIELDdata
	ld	b,(hl)		; Get length of symbol
	ld	c,b
ExpMove:
	inc	hl
	ld	a,(hl)
	ld	(de),a		; Unpack data
	inc	de
	djnz	ExpMove
	ld	a,8
	sub	c		; Get fill length
	ret	z		; Nothing to fill
	ld	b,a
	ld	a,' '
ExpFill:
	ld	(de),a		; Fill with blanks
	inc	de
	djnz	ExpFill
	ret
;
; Store as NAME
;
stNAME:
	ld	de,NAMEfield
	call	Expand		; Expand name
	ret			; That's all
;
; Store as ENTRY
;
stENTRY:
	ld	a,_ENT		; Set ENTRY
	jr	StSymbol
;
; Store as EXTRN
;
stEXTRN:
	ld	a,_EXT		; Set EXTRN
StSymbol:
	ld	(SymType),a	; Save type
	ld	de,E?TRfield
	call	Expand		; Expand ENTRY/EXTRN
	ld	hl,(heapcurr)	; Get heap pointer
	push	hl
	ld	bc,SymLen
	add	hl,bc		; Get new top
	push	hl
	ld	de,(heaptop)
	or	a
	sbc	hl,de		; Test enough memory
	pop	hl
	pop	de
	jr	nc,NoMem	; Nope, error
	ld	(heapcurr),hl	; Save new top
	ld	hl,NAMEfield
	ldir			; Unpack it
	xor	a
	ld	(de),a		; Close chain
	ret
NoMem:
	ld	de,$NOMEM
IllMsg:
	call	string		; Tell error
	jp	OS		; Abort
dskerr:
	call	PrFName
	ld	de,$RDERR
	jr	IllMsg
Help:
	ld	de,$HELP
	jr	IllMsg
IllWild:
	ld	de,$WILD
	jr	IllMsg
NoFile:
	ld	de,$NOFILE
	call	string
	call	PrFName
	call	crlf
	jp	OS
;
; Test if file does exist
; ENTRY	Reg HL points to extension
; EXIT	Carry set if file not found
;
exist:
	ld	de,FCB+.fdrv+.fname
	ld	bc,.fext
	ldir			; Set extension
	ld	de,FCB
	call	open		; Try to open file
	ret
;
; Position .IRL file to .REL record
;
IRLpos:
	ld	de,FCB
	call	dskred		; Read first record
	ret	c
	ld	a,(DMA)		; Fetch extend number
	ld	(FCB+_EX),a
	ld	a,(DMA+1)	; Fetch record number
	ld	(FCB+_CR),a
	ld	de,FCB
	call	reopen		; Re-open file
	ret	nc		; Ok
	jp	dskerr
;
; Print name of FCB ^DE to console
;
PrFName:
	ld	de,FCB+.fdrv
	ld	b,.fname
	call	PrFN		; Print name
	ld	a,'.'
	call	conout		; Give delimiter
	ld	b,.fext		; Print extension
;
; Print part of FCB ^DE to console
;
PrFN:
	ld	a,(de)		; Get name of file
	and	NoMSB
	cp	' '
	call	nz,conout	; Print it except blank
	inc	de
	djnz	PrFN
	ret
;
; Print rotating character
;
Rotate:
IF	DEBUG
	ret
ELSE
	ld	hl,RotPos
	inc	(hl)		; Advance pointer
	ld	a,(hl)
	and	00000011b	; Modulo 4
	ld	c,a
	ld	b,0
	add	hl,bc
	inc	hl
	ld	a,(hl)		; Get character
	call	conout		; Print it
	ld	a,bs
	call	conout
	ret
	
	dseg

RotPos:				; \
	db	0		; |
	db	'|/-\'		; /

	cseg
ENDIF	;DEBUG

	dseg
BFIELDdata:
	ds	1+NamLen+1
SymName:
	ds	NamLen
;
NAMEfield:			; \
	ds	NamLen		; |
SymType:			; |
	ds	1		; |
E?TRfield:			; |
	ds	NamLen		; /
SymLen	equ	$-NAMEfield
;
NamIdx	equ	NAMEfield-NAMEfield
TypIdx	equ	SymType-NAMEfield
SymIdx	equ	E?TRfield-NAMEfield
;
ctrtab:
	dw	spc0000,spc0001,spc0010,spc0011
	dw	spc0100,spc0101,spc0110,spc0111
	dw	spc1000,spc1001,spc1010,spc1011
	dw	spc1100,spc1100,spc1110,spc1111
;
heapcurr:
	ds	2
heaptop:
	ds	2
$memry:
	ds	2
$$REL:
	db	'REL'
$$IRL:
	db	'IRL'
$READING:
	db	'Reading modules of library file ',eot
$NOMEM:
	db	'Not enough memory - abort'
	db	cr,lf,eot
$RDERR:
	db	' : library read error - abort'
	db	cr,lf,eot
$NOFILE:
	db	'Cannot find library file'
	db	cr,lf,eot
$ABORT:
	db	' '
	db	cr,lf
	db	'User interrupt - abort',eot
$DEL:
	db	' in ',eot
$NAM:
	db	' ('
$TYP:
	db	'x) ',eot
$WILD:
	db	'Wildcard not allowed in filename'
	db	cr,lf,eot
$HELP:
	db	'LIBREF generates a reference list of a REL-80 library.'
	db	cr,lf,lf
	db	'.REL file as well as .IRL file are supported.'
	db	cr,lf,lf
	db	'Format:'
	db	cr,lf,lf
	db	'*LABEL    in  (X) MODUL1  ,(P) MODUL2'
	db	cr,lf,lf
	db	'Where *LABEL is the name of an external or public symbol.'
	db	cr,lf
	db	'(X) denotes external in MODUL1 and (P) public declaration in MODUL2.'
	db	cr,lf,eot

	end	LIBREF