title	Linking ABS file
	name	('LABS')
	maclib	base80
	maclib	reldef

; Link an absolute generated REL80 format file

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

;		Version 1.0 November 1996

; Call it:	LABS filename{.ext}
;		Default extension is .REL

; ===== LIB linkage =====

	ext	open,string,ascbyt,indexa,conout,crlf
	ext	parse,getver,dskget,wcard,close,delete
	ext	dskput,wrbuf,wrfcb,wrbfp,creatd,@wrrec,puteof

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

	entry	$memry

; ===== Start program =====

	dseg
$HELP:
	db	'Call it:',tab,'LABS filename{.ext}',cr,lf
	db	tab,tab,'Default extension is .REL'
	db	cr,lf,eot
$ILL.OS:
	db	'Requires CP/M 3.x',eot
$ILL.CPU:
	db	'Requires Z80 CPU',eot
$ILLFIL:
	db	'File name illegal',eot
$NOFIL:
	db	'File not present',eot
$NOCREC:
	db	'Cannot create .COM file',eot
$NOSREC:
	db	'Cannot create .SYM file',eot
$FILERR:
	db	'Abnormal termination',eot
$WRT.ERR:
	db	'File write error',eot
$ILL.CODE:
	db	'Not supported REL80 code detected',cr,lf
	db	'Use a full function linker instead',eot
$VERS:
	db	'LABS 1.0'
	db	tab,tab,'Linker for ABSolute REL80 code'
	db	cr,lf,lf,eot
$RANGE:
	db	'Absolute     '
$LEN:
	db	'xxxx (0100-'
$END.ADR:
	db	'xxxx)',cr,lf,eot
$ADR:
	db	'  '
$..ADR:
	db	'xxxx',tab,eot
$FADR:
	dc	'xxxx '
$FFN:
	db	'1234567',null
$REL:
	db	'REL'
$COM:
	db	'COM'
$SYM:
	db	'SYM'
ctrltb:
	dw	field0,inv.code,field2,inv.code
	dw	inv.code,inv.code,inv.code,field7
	dw	inv.code,inv.code,fielda,fieldb
	dw	inv.code,fieldd,fielde,fieldf
FIB:
	dw	CCP,FCB
$FCB:
	ds	FCBlen
$DMA:
	ds	reclng
$NAME:
	ds	item+1
heap:
	ds	2
ACT.PC:
	dw	TPA
HexWrd:
	ds	2		; Hex bytes
$memry:
	dw	0
;
	ds	2*48
LocStk:
	cseg
illCPU:
	ld	de,$ILL.CPU
	ld	c,.string
	call	BDOS		; Tell invalid machine
	jp	OS
LABS:
	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
	ld	hl,rederr
	ld	(biterr),hl	; Set error linkage
	ld	a,(CCPlen)	; Test file here
	or	a
	ld	de,$HELP
	jp	z,comstr
	ld	de,$HELP
	ld	hl,CCPlen
	ld	a,(hl)
	or	a
	jp	z,comstr	; Test parameter left
;;+	ld	c,a
;;+	ld	b,0
;;+	inc	hl
;;+	ld	a,'['
;;+	cpir
;;+	call	z,option	; Get option if here
	ld	de,FIB
	call	parse		; Get file
	ld	de,$ILLFIL
	jp	c,comstr
	ex	de,hl
	ld	de,FCB
	call	wcard		; Verify no wild card
	ex	de,hl
	jp	z,comstr
	ld	de,FCBext
	ld	a,(de)		; Test extension
	cp	' '
	jr	nz,noex
	ld	hl,$REL
	ld	bc,.fext
	ldir			; Set .REL
noex:
	ld	de,FCB
	call	open		; Find file
	ld	de,$NOFIL
	jp	c,comstr	; Should be here
	ld	hl,dskget
	ld	(dskpc),hl	; Enable disk I/O
	ld	hl,$DMA
	ld	(wrbuf),hl	; Set write buffer
	ld	de,$FCB
	ld	(wrfcb),de	; .. and FCB
	push	de
	ld	hl,FCB
	ld	bc,.fdrv+.fname
	ldir			; Unpack name of file
	ld	hl,$COM
	ld	bc,.fext
	ldir			; Set .COM
	pop	de
	call	creatd		; Create file
	ld	de,$NOCREC
	jp	c,comstr	; .. impossible
	ld	hl,($memry)	; Fetch memory pointer
	ld	(heap),hl	; .. init heap
	ld	(hl),-1		; .. set end
newbit:
	ld	a,-1
	ld	(bitcnt),a	; Init bit count
;
; Decode the bitstream
;
loop:
	call	bit1		; Get a bit
	jr	c,ctrl1		; It's special
	call	bit8
	call	fputc.a		; Put byte to file
	jr	loop
;
; First bit is not 0, test next two bits
;
ctrl1:
	call	bit2		; Get control bits
	or	a		; Verify valid one
	jp	nz,inv.code
;
; The observed two bits are 00, await four control bits
;
	call	bit4		; Get control bits
	ld	hl,ctrltb
	call	indexa		; Get index
	ex	de,hl
	jp	(hl)		; -->> Jump
;
; Control code decoder
;
; Only a few codes are allowed here
;
; Code 0000, 0010
; Format : Name field	0000 - Entry symbol
;			0010 - Program name
;
field0:
field2:
	call	.BField		; Simple get name and discard
	jp	loop
;
; Code 0111
; Format : Value field and name field	0111 - Define entry point
;
field7:
	call	.AField.0	; Get address of symbol
	push	hl
	call	.BField		; Get name
	pop	de
	call	insSYM		; Insert into symbol table
	jp	loop
;
; Code : 1010, 1011, 1101
; Format : Value field	1010 - Define data size
;			1011 - Set location counter
;			1101 - Define program size
;
fielda:
	ld	de,0		; We expect 0000
	call	.AField.0	; Get location counter
chk.AFres:
	or	a
	sbc	hl,de		; Verigy correct result
	jp	z,loop
	jp	inv.code
fieldd:
	ld	de,0		; We expect 0000
	ld	c,01b
	call	.AField		; Get program size
	jr	chk.AFres
fieldb:
	call	.AField.0	; Get new location counter
	call	setPC		; .. set it
	jp	loop
;
; Code : 1110
; Format : Value field (Reset to byte boundary)
;
fielde:
	call	.AField.0	; Get transfer address
	ld	a,l
	or	h		; Verify none
	jp	z,newbit	; Set byte boundary
	jp	inv.code
;
; Code : 1111
; Format : End of file
;
fieldf:
	call	closef		; Close file
	jp	c,WrErr		; .. not possible
	call	wrSYM		; Write symbol table
	call	tell.load	; Give range info
	jp	OS
;
; Close file - Note the difference from standard LIB closing
; - This is due to binary closing
;
closef:
	call	_puteof		; ** NOT STANDARD **
	ld	de,(wrfcb)
	call	nc,close	; .. close file
	ret
;
; Fill last record with end of file if necessary
;
_puteof:
	ld	a,(wrbfp)	; Test buffer filled
	cp	reclng
	jp	z,@wrrec	; .. yeap, write it
	jp	puteof		; .. else fill it
;
; ===== Subroutines =====
;
; Error handler
;
rederr:
	ld	hl,$FILERR	; Simple error message
	jr	err.exit
;
; Invalid code detected
;
inv.code:
	ld	hl,$ILL.CODE
err.exit:
	ld	de,$FCB
	call	close		; Close
	call	delete		; .. and delete file
	ex	de,hl
comstr:
	call	string
	call	crlf
	jp	OS
; 
; Get two control bit fields and verify zero
; Then get 16 bit
; 
.AField.0:
	ld	c,0		; Set what we expect
; 
; Get two control bit fields and verify against expected in reg C
; Then get 16 bit
; 
.AField:
	call	AField		; .. get values
	cp	c		; Verify ok
	ret	z		; .. yeap
	jp	inv.code	; .. invalid
;
; Get the BField
; EXIT	Reg HL points to name field
;
.BField:
	ld	hl,$NAME
	push	hl
	call	BField		; Get name
	pop	hl
	ret
;
; Tell address range of load
;
tell.load:
	ld	hl,(ACT.PC)	; Get current address
	push	hl
	dec	hl		; Fix end address
	ld	de,$END.ADR
	call	putHEX		; Convert to hex
	pop	hl		; Get back address
	ld	de,TPA
	or	a
	sbc	hl,de		; Calculate length
	ld	de,$LEN
	call	putHEX		; Convert to hex
	ld	de,$RANGE
	call	string		; Tell range
	ret
;
; Convert number in reg HL to buffer in ^DE
;
putHEX:
	ld	a,h
	ld	(HexWrd),a	; Save hi
	ld	a,l
	ld	(HexWrd+1),a	; And low
	ld	hl,HexWrd	; Init buffers
	call	ascbyt		; Convert to ASCII
	call	ascbyt
	ret
;
; Put byte in Accu to file
;
fputc.a:
	ld	hl,(ACT.PC)
	inc	hl		; Bump address
	ld	(ACT.PC),hl
fputc:
	call	dskput		; .. put it
	ret	nc		; .. ok
WrErr:
	ld	hl,$WRT.ERR
	jp	err.exit	; Delete file
;
; Get option from command stream
; ENTRY	Reg pair HL points to option field
;	Reg pair BC holds remaining characters
;
	.comment	|;;
option:
	ld	a,c
	or	b		; Check more
	jr	z,noop
	push	hl
	ld	a,']'
	cpir			; Find counterpart
	pop	hl
	jr	nz,noop
	ld	a,(hl)		; Fetch option
	cp	'B'		; Test verbose
	jr	nz,optP?
	call	opt.B		; .. do it
	ret	z		; .. no more
	cp	'P'		; Verify page mode
	jr	nz,noop
	call	opt.P		; Do it
	ret	z		; .. verify end
noop:
	ld	de,$ILLOP
	dseg
$ILLOP:
	db	'Option [B] or [P] expected',eot
	cseg
	jp	comstr
optP?:
	cp	'P'		; Verify page mode
	jr	nz,noop
	call	opt.P		; Do it
	ret	z		; .. end
	cp	'B'		; Test verbose
	jr	nz,noop
	call	opt.B		; .. do it
	jr	nz,noop		; .. verify end
	ret
;
; Execute option P
;
opt.P:
	jr	opt.?
;
; Execute option B
;
opt.B:
	inc	hl
	ld	a,(hl)		; Test end
	cp	']'
	ret
			|
;
; Print ASCII name from buffer
; ENTRY	Reg HL points to name-1
;	Reg B  holds length
;
PrName:
	inc	hl
	ld	a,(hl)		; Get character
	call	GetASCII	; Get valid ASCII
	call	conout		; Print
	djnz	PrName
	ret
;
; 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
;
; Get space for symbol
; EXIT	Reg DE points to start of symbol
;	Reg HL points to next symbol
;
alloc:
	ld	hl,(heap)	; Fetch start of symbol
	push	hl
	ld	b,item
..aloc:
	ld	(hl),' '	; Blank line
	inc	hl
	djnz	..aloc
	inc	hl
	inc	hl
	ld	(heap),hl	; Set new start
	pop	de
	ret
;
; Insert into symbol table
; ENTRY	Reg HL points to symbol buffer
;	Reg DE holds address
;
insSYM:
	push	hl
	push	de
	call	alloc		; Get space for symbol
	pop	bc		; Get back address
	ld	(hl),-1		; .. close line
	dec	hl
	ld	(hl),b		; .. save address
	dec	hl
	ld	(hl),c
	pop	hl		; Get back start pointer
	ld	c,(hl)
	ld	b,0
	inc	bc
	ldir			; Unpack label
	ret
;
; Write symbol table to console and file
;
wrSYM:
	call	wrCON		; Write to console
	call	crlf
	call	wrFIL		; Write to file
	ret
;
; Write symbols to console
;
wrCON:
	ld	hl,($memry)	; Fetch base address
	call	wC.init		; .. do it
	ld	a,c
	cp	4
	call	nz,crlf		; .. pending line
	ret
;
wC.init:
	ld	c,4
wC.loop:
	ld	a,(hl)		; Fetch length
	inc	hl
	inc	a		; Test done
	ret	z		; .. yeap
	ld	b,item-1
wC.sym:
	ld	a,(hl)
	call	conout		; .. print
	inc	hl
	djnz	wC.sym
	ld	e,(hl)		; Fetch value
	inc	hl
	ld	d,(hl)
	inc	hl
	push	hl
	push	bc
	ex	de,hl
	ld	de,$..ADR
	call	putHEX
	ld	de,$ADR
	call	string		; .. print address
	pop	bc
	pop	hl
	dec	c		; Test line full
	jr	nz,wC.loop
	call	crlf
	jr	wC.init
;
; Write symbols to file
;
wrFIL:
	xor	a
	ld	(wrbfp),a	; Init write
	ld	de,$FCB+.fdrv+.fname
	ld	hl,$SYM
	ld	bc,.fext
	ldir			; Set .SYM file
	ld	de,$FCB
	call	creatd		; Create file
	ld	de,$NOSREC
	jp	c,comstr	; .. impossible
	ld	hl,($memry)	; Fetch base address
	call	wF.init		; .. now write it
	ld	a,c
	cp	4
	call	nz,nl		; .. pending line
	call	closef		; Close file
	jp	c,WrErr		; .. not possible
	ret
;
wF.init:
	ld	c,4
wF.loop:
	ld	a,(hl)		; Fetch length
	inc	hl
	inc	a		; Test done
	ret	z		; .. yeap
	ld	b,item-1	; Get length
	ld	de,$FFN
wF.sym:
	ld	a,(hl)
	ld	(de),a		; .. unpack
	inc	hl
	inc	de
	djnz	wF.sym
	ld	e,(hl)		; Fetch value
	inc	hl
	ld	d,(hl)
	inc	hl
	push	hl
	push	bc
	ex	de,hl
	ld	de,$FADR
	push	de
	call	putHEX
	pop	de
	call	fstring		; .. print address and symbol
	pop	bc
	pop	hl
	dec	c		; Test line full
	push	af
	call	z,nl
	pop	af
	call	nz,ftab
	jr	wF.loop
;
; Close line of file
;
nl:
	ld	a,cr
	call	fputc		; Put new line to file
	ld	a,lf
	call	fputc
	ld	c,4
	ret
;
; Give delimiter to file
;
ftab:
	ld	a,tab
	call	fputc		; .. simple put
	ret
;
; Print string in ^DE to file
;
fstring:
	ld	a,(de)
	or	a
	ret	z		; End is NULL
	cp	' '		; .. or blank
	ret	z
	res	7,a
	call	fputc		; .. print
	inc	de
	jr	fstring
;
; Set new location counter counter in reg HL
;
setPC:
	ld	de,(ACT.PC)	; Get current address
	or	a
	sbc	hl,de		; Test against old one
	ret	z		; .. same, nothing to do here
	jp	c,inv.code	; .. invalid one
	ld	c,l
	ld	b,h
fput.0:
	xor	a
	call	fputc.a		; Put zeroes to file
	dec	bc
	ld	a,b
	or	c
	jr	nz,fput.0
	ret

	end	LABS