title	Loader build program
	name	('LDBLD')
	maclib	base80

; Program builds program from kernel and loader
; (such as SID, ZSID and .UTL files)

; Call it:

;		LDBLD Load_File Kernel_File New_File

; Where

;	Load_File	is the loader {default .COM}
;	Kernel_File	is the kernel {default .SPR}
;	New_File	is the new debugger {default .COM}

; The loader consists of one header record which will be
; ignored. Note that the first byte MUST be zero.
; The second record holds the offset (zero relative)
; (word at @0001) to that address in the loader where the
; length should go. The third record is the real start of
; the loader.

; The kernel must be generated by the DR-LINK option [OS]
; generating a zero-page-relative file. LINK generates .SPR
; The kernel is prefixed by a page header. The word at @0001
; in the header holds the length of code.
; The third record is the real start of the kernel which will
; be followed by a link map

; Copyright (C)	Werner Cirsovius
;		Hohe Weide 44
;		D-2000 Hamburg 20
;		Voice +49 40 4223247

;		Version 1.0, April 1991

_RO	equ	9
_SYS	equ	10
SysUsr	equ	0

Parms	equ	3		; .. request three files here
First	equ	1
Second	equ	2
Third	equ	3

.WR	equ	0
.RD	equ	1

etx	equ	0

	ext	strcn0,crlf,conino,uppcon
	ext	@parcn,@parsx,filnam,Wcard,fparse
	ext	open,delete,create,filsiz,dskred,dskwrt
	ext	setbuf,close,usrget,setatt
;
; Get answer YES or NO
; ENTRY	Reg HL points to message
; EXIT	Zero flag set if YES selected
;
GetYN:
	push	de
	ex	de,hl
	call	strcn0		; Give message
	ld	de,$YN
	call	strcn0
WtYN:
	call	conino		; Get answer
	call	uppcon
	cp	'Y'
	jr	z,Y..
	cp	'N'
	jr	nz,WtYN
Y..:
	push	af
	call	crlf		; .. close line
	pop	af
	pop	de
	cp	'Y'		; .. check answer
	ret
;
; Tell file exist
; ENTRY	Reg DE holds FCB
;
exist:
	call	open		; Find file
	ret	c		; .. new one
	ld	hl,_SYS
	add	hl,de
	bit	7,(hl)		; .. test SYS bit
	jr	z,no.SYS
	call	usrget		; Get current user
	cp	SysUsr		; .. test user 0
	ret	nz
no.SYS:
	ld	hl,$file
	call	PrMsFN		; .. give message
	ld	hl,$exist
	call	GetYN		; .. test overwrite
	jr	z,RO??		; .. overwrite it
..abort:
	ld	de,$abort
	jp	ComStr
RO??:
	ld	hl,_RO
	add	hl,de
	bit	7,(hl)		; .. test RO bit
	ret	z
	push	hl
	ld	hl,$file
	call	PrMsFN		; .. give message
	ld	hl,$RO
	call	GetYN		; .. test set attribute
	pop	hl
	jr	nz,..abort	; .. no
	res	7,(hl)		; Clear bit
	call	setatt		; .. reset RO
	ret
;
; Read head of file
; ENTRY	Reg DE holds FCB
; EXIT	Reg BC holds length of file (without header)
;	Reg DE holds value from 1st record
;	Reg HL holds value from 2nd record
;
RdHead:
	call	filsiz		; Get size of file
	jr	nz,ill.head	; .. should be not too long
	ld	a,h
	cp	1+1		; .. note max is 01FF ->> FFFF
	jr	nc,ill.head
	dec	hl		; .. fix less header
	dec	hl
	bit	7,h		; .. check result
	jr	nz,ill.head
	ld	a,l
	or	h
	jr	z,ill.head
	push	hl		; .. save length
	ld	b,2		; Two records header
HdLoop:
	call	dskred		; .. get record
	jr	c,ill.head
	ld	a,(DMA)
	or	a		; First byte MUST be zero
	jr	nz,ill.head
	ld	hl,(DMA+1)	; Get parameter
	push	hl
	djnz	HdLoop
	pop	hl		; .. get 2nd parameter
	pop	de		; .. 1st
	pop	bc		; .. length
	ret
ill.head:
	ld	hl,$illHead
	jr	IO.del		; Give error
;
; Execute I/O
;
Do.IO:
	ld	hl,(IO.Call)	; Get address
	jp	(hl)		; .. go
;
; Read code from file
; ENTRY	Reg DE points to FCB
;	Reg BC holds records to be read
;
RdCode:
	ld	a,.RD
	ld	ix,dskred
	ld	hl,$Read
	jr	??Code		; .. go
;
; Write code to file
; ENTRY	Reg DE points to FCB
;	Reg BC holds records to be written
;
WrCode:
	ld	a,.WR
	ld	ix,dskwrt
	ld	hl,$Write
??Code:
	ld	(IO.Call),ix	; Save execution
	ld	(IO.type),a
	call	.PrMsFN		; Tell action
CodeLoop:
	push	de
	ld	de,(Cur.PC)
	call	setbuf		; Set disk buffer
	ld	hl,RecLng
	add	hl,de
	ld	(Cur.PC),hl	; .. set next address
	pop	de
	call	Do.IO		; Execute I/O
	jr	c,CodeErr	; .. bad
	dec	bc
	ld	a,b
	or	c		; Test done
	jr	nz,CodeLoop
	ld	a,(IO.type)
	cp	.RD		; .. test read
	ret	z		; .. end
	call	close		; Close file
	ret	nc		; .. ok
CodeErr:
	ld	a,(IO.type)
	cp	.WR
	ld	hl,$wrErr
	jr	z,IO.del
	ld	hl,$rdErr
IO.del:
	push	de
	ld	de,$FCB.DBG
	call	delete		; Delete COM file
	pop	de
	jr	IO.Err		; .. error
;
; Error routine for parsing
;
Pars.Err:
	ld	de,$Parse
	call	strcn0		; Tell error
	ld	de,ParseBuff
	call	strcn0		; .. give invalid line
	jp	OS
;
; Prepare a file
; ENTRY	Reg DE holds FCB
;	Reg HL holds default extension
;	Reg B  holds parameter where file will be found
;	Accu   holds file craetion mode
;
PrepFile:
	push	af
	push	hl
	ld	(ParsePB+2),de	; Set up FCB
	push	de
	ld	c,.fdrv+1+.fname+1+.fext
	ld	de,ParseBuff
	call	@parsx		; Get parameter into buffer
	ld	de,ParsePB
	call	fparse		; Parse file name
	jr	c,Pars.Err	; .. error parsing line
	pop	hl		; Get FCB
	pop	de		; Get extension
	push	hl
	dec	a		; Test dot in name
	jr	z,SkpExt
	ld	bc,FCBext-FCB
	add	hl,bc
	ld	a,(hl)		; .. test extension here
	cp	' '
	jr	nz,SkpExt	; .. ok
	ex	de,hl
	ld	bc,.fext
	ldir			; Set name
SkpExt:
	pop	de
	call	Wcard		; Check wild card
	ld	hl,$NoWild
	jr	z,IO.Err	; Tell invalid wild card
	pop	af		; Get mode
	cp	.RD
	jr	z,Reset		; .. find file
	call	exist		; Tell file exists
	call	delete		; .. delete existing file
	call	create		; .. create
	ret	nc		; .. ok
	ld	hl,$create
IO.Err:
	call	.PrMsFN		; Tell error and file
	jp	OS
Reset:
	call	open		; Find file
	ld	hl,$open
	jr	c,IO.Err	; .. oops
	ret
;
; Give message and print file
; ENTRY	Reg DE points to FCB
;	Reg HL holds message closed by zero
;
PrMsFN:
	ex	de,hl
	call	strcn0		; Tell error
	ex	de,hl
	inc	de
	call	filnam		; .. give file name
	dec	de
	ret
.PrMsFN:
	call	PrMsFN		; Same as above
	call	crlf		; .. close line
	ret
;
; ####################
; ## Entry of LDBLD ##
; ####################
;
BUILD:
	ld	sp,(TPAtop)	; Get stack
	call	@parcn		; Get parameters from CCP line
	cp	Parms
	ld	de,$help
	jp	nz,ComStr	; .. should be what we need
	ld	de,$FCB.LD
	ld	hl,$COM
	ld	b,First
	ld	a,.RD
	call	PrepFile	; Get Loader
	ld	de,$FCB.KRN
	ld	hl,$SPR
	ld	b,Second
	ld	a,.RD
	call	PrepFile	; Get Kernel
	ld	de,$FCB.DBG
	ld	hl,$COM
	ld	b,Third
	ld	a,.WR
	call	PrepFile	; Create debugger
	ld	de,$FCB.LD
	call	RdHead		; Get header of loader
	ld	(LD.len),bc	; Save length
	push	bc
	ld	(Len.Off),hl	; Save offset
	ld	de,$FCB.KRN
	call	RdHead		; Get header of debugger
	ld	(SPR.len),bc	; Save file length
	ld	(Code.Len),de	; Save code length
	pop	hl
	add	hl,bc		; Get total records
	ld	(Rec.Cnt),hl
	ld	hl,($memry)
	ld	(Cur.PC),hl	; Set base address
	ld	de,$FCB.LD
	ld	bc,(LD.len)
	call	RdCode		; Read loader
	ld	de,$FCB.KRN
	ld	bc,(SPR.Len)
	call	RdCode		; Read kernel
	ld	hl,($memry)
	ld	(Cur.PC),hl	; Set base address
	ld	de,(Len.Off)	; Get length offset
	add	hl,de
	ld	de,(Code.Len)
	ld	(hl),e		; .. store length
	inc	hl
	ld	(hl),d
	ld	bc,(Rec.Cnt)
	ld	de,$FCB.DBG
	call	WrCode		; Write both parts to disk
	ld	de,$rdy		; .. tell build done
ComStr:
	call	strcn0		; Give message
	jp	OS		; .. bye, bye

	dseg

$help:
	db	'Program builds program from kernel '
	db	'and loader',cr,lf,lf
	db	'Call it:',cr,lf,lf
	db	tab,tab,'LDBLD Load_File Kernel_File '
	db	'New_File',cr,lf,lf
	db	'Where',cr,lf,lf
	db	tab,'Load_File',tab,'is the loader '
	db	'{default .COM}',cr,lf
	db	tab,'Kernel_File',tab,'is the kernel '
	db	'{default .SPR}',cr,lf
	db	tab,'New_File',tab,'is the new debugger '
	db	'{default .COM}',cr,lf,etx
$rdy:
	db	'.. ready, application built',etx
$create:
	db	'Cannot create file ',etx
$open:
	db	'Cannot find file ',etx
$Parse:
	db	'Illegal parameter : ',etx
$NoWild:
	db	'No wild card allowed in file name ',etx
$illHead:
	db	'Illegal header in ',etx
$wrErr:
	db	'Error writing ',etx
$rdErr:
	db	'Error reading ',etx
$Read:
	db	'.. reading ',etx
$Write:
	db	'.. writing ',etx
$file:
	db	'File ',etx
$exist:
	db	' already exist, overwrite',etx
$abort:
	db	'.. nothing generated',etx
$RO:
	db	' is write protected, reset protection',etx
$YN:
	db	' [Y,N] ',etx
$COM:
	db	'COM'
$SPR:
	db	'SPR'
$FCB.LD:
	ds	FCBlen
$FCB.KRN:
	ds	FCBlen
$FCB.DBG:
	ds	FCBlen
ParsePB:
	dw	ParseBuff
	dw	$-$
ParseBuff:
	ds	.fdrv+1+.fname+1+.fext+1
LD.len:
	dw	0
Len.Off:
	dw	0
SPR.len:
	dw	0
Code.Len:
	dw	0
Rec.Cnt:
	dw	0
Cur.PC:
	dw	0
$memry::
	dw	0
IO.Call:
	dw	0
IO.type:
	db	0

	end	BUILD