title	Compute .COM file from .PRL
	name	('RSXCOM')
	maclib	base80

; This program extracts the program code from an existing .PRL
; file organized as PRL, .SPR or RSX, stripping off the header
; of the file.

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

;		Version 2.3, October 1997

; How to call:

;	RSXCOM {drive:}filename{.ext} {[option]}

; Option may be one of R(SX), P(RL), S(PR)
; The default extension is .RSX, the new file has the same name
; but .COM as extension. A check will be performed, testing the
; expected format of the RSX header.
; If option is set to 'P' then no check will be performed and
; the default extension will be .PRL
; If option is set to 'S' then no check will be performed and
; the default extension will be .SPR
; The resulting .COM file will be fixed for 0100H relative code
; Option 'R' is the same as the default setting

	entry	$memry

	extrn	open,dskred,create,dskget,dskput,puteof,delete
	extrn	close,crlf,string,wrbuf,wrFCB,UPPcon,skpblk
	extrn	getver,filnam,conino,condir,getlin,parse,indexa
	extrn	rndred,wcard

_PRG	macro
	db	'RSXCOM'
	endm

_VER	macro
	db	'2.3'
	endm

RSXhead	equ	27

_$STR	equ	 6
_$NXT	equ	 9
_$NAM	equ	16

_RSX	equ	0
_PRL	equ	1
_SPR	equ	2

RSXbeg	equ	0100h
SPRbeg	equ	0000h

_JP	equ	0c3h

$ILL.CPU:
	_PRG
	db	' requires Z80 CPU',eot
$ILL.OS:
	_PRG
	db	' requires CP/M 3.x',eot
ErrAbort:
	ld	c,.string
	call	BDOS		; Give error message
	jp	OS
;
; %%%%%%%%%%%%%%%%%%
; %%% MAIN ENTRY %%%
; %%%%%%%%%%%%%%%%%%
;
MAIN:
	sub	a		; Test right machine
	ld	de,$ILL.CPU
	jp	pe,ErrAbort	; .. nope
	call	getver		; Get version number
	ld	de,$ILL.OS
	jr	c,ErrAbort	; .. invalid system
	ld	sp,stack	; Load our stack
	ld	de,$HEAD
	call	string		; Give info
	ld	hl,CCPlen
	ld	c,(hl)		; Get count
	ld	a,c		; Test any parameter
	or	a
	ld	de,$HELP
	jp	z,comstr	; Should be
	ld	b,0
	inc	hl
	ld	a,'['
	cpir			; Find option
	jr	nz,strt		; None, start with default
	ld	a,(hl)
	call	UPPcon		; Get UPPER case
	ld	b,a
	ex	de,hl
	inc	de
	call	skpblk
	ld	a,(de)
	cp	']'		; Test legal closing
	jp	nz,illop
	ld	c,_RSX
	ld	a,b
	cp	'R'		; 'R'SX
	jr	z,setmode
	ld	c,_PRL
	cp	'P'		; 'P'RL
	jr	z,setmode
	ld	c,_SPR
	cp	'S'		; 'S'PR
	jp	nz,illop	; Should be
setmode:
	ld	a,c
	ld	(RSXflg),a	; Indicate mode
	ld	a,TRUE
	ld	(OptFlg),a
strt:
	ld	de,FCB+.fdrv+.fname
	ld	a,(de)
	cp	' '		; Test extension
	jr	nz,@chkex
	push	de
	call	RSXmodeGet	; Fetch extension
	pop	de
	ld	bc,.fext
	ldir			; Set .RSX or .PRL
	jr	@skpex
@chkex:
	call	GetEXT		; Get index of extension
	ld	a,(OptFlg)	; Test option found
	cp	TRUE
	ld	hl,RSXflg
	ld	a,c
	jr	nz,@setex
	cp	(hl)		; Verify same level
	ld	de,$ILL.COMB
	jp	nz,comstr	; .. should be
	jr	@skpex
@setex:
	ld	(hl),a		; .. set index
@skpex:
	ld	de,FCB
	call	wcard		; Verify no wild card
	jp	z,NoWild
	call	open		; Test file here
	ld	de,$NO.FILE
	jp	c,comstr	; Not here
	ld	de,FCB
	call	dskred		; Get 1st record
	ld	de,$NO.REC
	jp	c,comstr	; None here
	ld	a,(DMA)		; Test format
	cp	0
	jp	nz,illRSX
	ld	hl,(DMA+1)	; Get length of code
	ld	(.RSXlen),hl	; .. save
	ld	a,(RSXflg)	; Test check
	cp	_RSX
	jr	nz,@nolfx
	ld	de,-RSXhead
	add	hl,de		; Test legal header length
	jp	nc,illRSX
	ld	a,h
	or	l
	jp	z,illRSX
@nolfx:
	ld	(RSXlen),hl	; Save netto length
	ld	de,FCB
	call	dskred		; Skip 2nd record
	jp	c,illRSX
	ld	a,(RSXflg)
	cp	_SPR		; Test to be reloacted
	call	z,GetBitmap	; .. load bit map if so
	ld	de,ourFCB
	ld	hl,FCB
	ld	bc,.fdrv+.fname
	ldir			; Unpack file name and drive
exist::
	ld	hl,$COM$
	ld	bc,.fext
	ldir			; Set .COM
	ld	de,ourFCB
	call	open		; Test file on disk
	jr	c,crecom
	call	other		; .. ask for other file
	ld	de,$ABORT
	jp	c,comstr	; .. no, break
	ld	de,ourFCB+.fdrv+.fname
	jr	nz,exist	; .. test again
	ld	de,ourFCB
	call	delete		; Delete file
crecom:
	ld	de,ourFCB
	call	create		; Create it
	ld	de,$CAN.CREC
	jp	c,comstr	; Cannot do so
	ld	hl,ourDMA
	ld	(wrbuf),hl	; Set up buffers
	ld	hl,ourFCB
	ld	(wrFCB),hl
	ld	a,(RSXflg)
	cp	_RSX		; Test RSX
	call	z,prcRSX	; .. yeap, do it
	ld	hl,(RSXlen)	; Fetch length
@lop3:
	call	dskget		; Now load the remainder
	jr	c,illRSX
	call	MapPut
	jr	c,wrterr
	dec	hl
	ld	a,h
	or	l
	jr	nz,@lop3
	call	puteof		; Fill last record
	jr	c,wrterr
	ld	de,ourFCB
	call	close		; Close file
	ld	de,$NO.CLOSE	; Impossible
	jr	c,comstr
	call	TellStat	; .. get statistic
	jr	comstr		; .. print
illRSX:
	ld	de,$ILL.RSX
	jr	@comdl
wrterr:
	ld	de,$WRT.ERR
@comdl:
	push	de
	ld	de,ourFCB
	call	delete		; Delete the bad file
	pop	de
	jr	comstr
NoWild:
	ld	de,$NO.WILD
	jr	comstr
illop:
	ld	de,$ILL.OPT
comstr:
	call	crlf
	call	string		; Tell message
	call	crlf
	jp	OS
;
; Ask for file action
; EXIT	 C	Quit
;	NC  NZ	New file
;	NC   Z	Delete existing file
;
other:
	ld	de,ourFCB+.fdrv
	call	filnam		; .. print file
	ld	de,$EXIST
	call	string		; .. ask for action
WtKey:
	call	conino		; Get character
	call	UPPcon
	cp	'N'		; .. test valid
	jr	z,..other
	cp	'D'
	jr	z,..other
	cp	'Q'
	jr	nz,WtKey
..other:
	push	af
	call	condir		; Echo selection
	call	crlf
	pop	af
	cp	'Q'
	scf
	ret	z		; .. exit if Quit
	cp	'D'
	scf
	ccf
	ret	z		; .. and Delete
	ld	de,$F.NAME
WtLine:
	call	string
	ld	de,line
	call	getlin		; Load line
	push	af
	call	crlf
	pop	af
	jr	z,WtLine
	ld	de,PB
	call	parse		; Parse file
	jr	c,WtLine
	xor	a		; Set ok
	inc	a
	ret
;
; Check legal characters
; ENTRY	Accu holds character
; EXIT	Carry flag set on illegal character
;
illchr:
	cp	' '		; Blank is allowed
	ret	z
	cp	'0'		; Numbers, too
	ret	c
	cp	'9'+1
	ccf
	ld	d,a
	ret	nc
	call	UPPcon
	cp	'A'		; And letters, of course
	ret	c
	cp	'Z'+1
	ccf
	ld	a,d
	ret
;
; Get address by type
; EXIT	Reg HL holds pointer from table
;
RSXmodeGet:
	ld	hl,TypeTab	; Point to type
	ld	a,(RSXflg)	; Get mode as index
	call	indexa		; .. get index
	ex	de,hl
	ret
;
; Build statistic about loading
; EXIT	Reg DE holds pointer to string
;
TellStat:
	call	RSXmodeGet	; Get pointer for extension
	ld	bc,.fext
	ld	de,$CNV
	ldir			; .. unpack
	ld	a,(RSXflg)	; Get type
	ld	hl,RSXbeg
	cp	_SPR
	jr	c,..TellRSX
	ld	hl,SPRbeg
..TellRSX:
	push	hl
	ld	de,$.FROM
	call	xtoa		; .. store as hex
	ld	hl,(.RSXlen)	; Get length
	pop	de
	add	hl,de
	dec	hl		; .. fix top
	ld	de,$.TO
	call	xtoa		; .. store
	ld	de,$CNV
	ret
;
; Store hex word as ASCII
; ENTRY	Reg HL holds word
;	Reg DE points to buffer
;
xtoa:
	ld	a,h		; Get hi
	call	xbtoa		; .. process it
	ld	a,l		; .. then lo
xbtoa:
	push	af
	rra			; .. get hi
	rra
	rra
	rra
	call	xntoa		; .. to ASCII
	pop	af
xntoa:
	and	LoMask		; .. mask lower bits
	add	a,90h		; .. convert
	daa
	adc	a,40h
	daa
	ld	(de),a
	inc	de
	ret
;
; Load the bitmap of an .SPR file
;
GetBitmap:
	ld	hl,(RSXlen)	; Get RSX length
	call	div8		; Divide by eight for bit count
	ld	(MapLen),hl	; .. save
	call	div8		; /8/8
	call	div2		; /8/8/2 -> /128
	inc	hl		; Add two records for header
	inc	hl
	ld	(FCBRND),hl	; .. set as record
	xor	a
	ld	(FCBRND+2),a
	ld	de,FCB
	call	rndred		; Position record
	call	dskred		; .. and read
	ld	a,(RSXlen)	; Get length of RSX
	and	RecLng-1	; .. remainder
	ld	c,a
	ld	b,0
	ld	hl,DMA
	add	hl,bc		; .. set pointer
	ld	(BitPtr),hl
	ld	a,RecLng
	sub	c		; Get left in buffer
	ld	c,a
	ld	(BitLen),bc
	ld	hl,($memry)
	ld	(MapPtr),hl	; .. init pointer
SPRmap.rd:
	ld	hl,(BitPtr)	; Get source
	ld	de,(MapPtr)	; .. destination
	ld	bc,(BitLen)	; .. length
	push	bc
	ldir			; .. unpack
	pop	bc
	ld	(MapPtr),de
	ld	hl,(MapLen)
	or	a
	sbc	hl,bc		; .. subtract bytes
	jr	c,EndMap.rd
	jr	z,EndMap.rd
	ld	(MapLen),hl
	ld	hl,DMA
	ld	(BitPtr),hl	; Set source
	ld	hl,RecLng
	ld	(BitLen),hl	; .. bit length
	ld	de,FCB
	call	dskred		; Read next record
	jr	SPRmap.rd
EndMap.rd:
	ld	hl,2		; Reset record
	ld	(FCBRND),hl
	xor	a
	ld	(FCBRND+2),a
	ld	de,FCB
	call	rndred		; Position record to start
	ld	hl,($memry)
	ld	(MapPtr),hl	; .. re-init pointer
	ld	a,8
	ld	(BitLen),a	; Set length of one byte
	ret
;
; Put byte to file, may be relocate
;
MapPut:
	ld	c,a
	ld	a,(RSXflg)	; Test .SPR
	cp	_SPR
	jr	nz,NoMap
	push	hl
	ld	hl,(MapPtr)	; Get pointer
	rl	(hl)		; .. shift it
	jr	nc,NotSet	; .. skip bit
	inc	c		; Fix page
NotSet:
	ld	a,(BitLen)
	dec	a
	jr	nz,MoreBit	; Test bits there
	inc	hl		; Bump map
	ld	(MapPtr),hl
	ld	a,8		; .. reset count
MoreBit:
	ld	(BitLen),a
	pop	hl
NoMap:
	ld	a,c
	call	dskput
	ret
;
; Shift reg HL a bit
;
div8:
	call	div2
	call	div2
div2:
	srl	h
	rr	l
	ret
;
; Get selected extension index
; EXIT	Reg C holds index
;
GetEXT:
	ld	ix,TypeTab
	ld	c,_RSX		; Init level
@morex:
	ld	l,(ix+0)
	ld	h,(ix+1)
	ld	de,FCB+.fdrv+.fname
	ld	b,.fext
..test:
	ld	a,(de)
	cp	(hl)		; Test same extension
	jr	nz,@nxtex
	inc	de
	inc	hl
	djnz	..test
	ret			; .. found
@nxtex:
	inc	ix		; Skip table pointer
	inc	ix
	inc	c		; .. get next
	ld	a,c
	cp	_SPR+1		; Test still valid
	jr	c,@morex
	ld	de,$ILL.EXT
	jp	comstr		; .. not found
;
; Process RSX header
;
prcRSX:
	ld	hl,RSX$HD
	ld	b,RSXhead
rdRSX:
	call	dskget		; Get header bytes
	jp	c,illRSX	; .. should be there
	ld	(hl),a
	inc	hl
	djnz	rdRSX
	ld	ix,RSX$HD	; .. point to header
	ld	a,_JP
	cp	(ix+_$STR)	; Check header
	call	nz,RSXdiag
	cp	(ix+_$NXT)
	call	nz,RSXdiag
	ld	hl,RSX$HD+_$NAM
	ld	b,.fname
chkRSX:
	ld	a,(hl)
	inc	hl
	call	illchr		; Check correct name
	call	c,RSXdiag
	djnz	chkRSX
	ld	b,RSXhead
wrRSX:
	ld	a,(ix)
	call	dskput		; Write header
	jp	c,wrterr
	inc	ix
	djnz	wrRSX
	ret
;
; Output diagnostic for invalid RSX header
;
RSXdiag:
	ld	a,(DIAG)	; Test diagnostic done
	or	a
	ret	nz		; .. yeap
	dec	a
	ld	(DIAG),a	; Indicate done
	push	bc
	push	de
	push	hl
	ld	hl,RSX$HD
	ld	de,RSX$DAT
	ld	b,_$NAM
	call	stASC		; .. save as ASCII
	ld	b,.fname
	call	stCHR		; .. and character
	ld	b,RSXhead-_$NAM-.fname
	call	stASC		; .. and ASCII again
	ld	de,RSX$WARN
	call	string		; .. output header
	pop	hl
	pop	de
	pop	bc
	ret
;
; Store ASCII hex sequence
;
stASC:
	ld	a,(hl)		; Get byte
	inc	hl
	call	xbtoa		; .. unpack
	inc	de		; .. skip blank
	djnz	stASC
	ret
;
; Store character sequence
;
stCHR:
	ld	a,(hl)		; Get byte
	inc	hl
	ld	(de),a		; .. unpack
	inc	de
	inc	de		; .. skip blank
	djnz	stCHR
	ret

	dseg

MapLen:
	dw	0
MapPtr:
	dw	0
BitPtr:
	dw	0
BitLen:
	dw	0
$memry:
	dw	0
TypeTab:
	dw	$RSX$,$PRL$,$SPR$
$RSX$:
	db	'RSX'
$PRL$:
	db	'PRL'
$SPR$:
	db	'SPR'
$COM$:
	db	'COM'
$HEAD:
	_PRG
	db	' v'
	_VER
	db	cr,lf,eot
$HELP:
	db	'Call it',cr,lf,lf,tab
	_PRG
	db	' file{.ext} {[option]}',cr,lf,lf
	_PRG
	db	' converts page relocatable files into '
	db	'regular .COM files. This will be',cr,lf
	db	'done by deleting the header and the bit map '
	db	'at the end of the file.',cr,lf,lf
	db	'The following options are available:',cr,lf,lf
	db	tab,'R',tab,'Expects a page relocatable file '
	db	'with legal RSX header which',cr,lf
	db	tab,tab,'will be checked for legal code.',cr,lf
	db	tab,tab,'The default extension is .RSX'
	db	cr,lf,lf
	db	tab,'P',tab,'Expects any page relocatable file'
	db	cr,lf,tab,tab
	db	'0100H relative without checking any header.'
	db	cr,lf
	db	tab,tab,'The default extension is .PRL'
	db	cr,lf,lf
	db	tab,'S',tab,'Expects any page relocatable file'
	db	cr,lf,tab,tab
	db	'0000H relative without checking any header.'
	db	cr,lf,tab,tab
	_PRG
	db	' relocates code to be 0100H relative'
	db	cr,lf
	db	tab,tab,'The default extension is .SPR'
	db	cr,lf,lf
	db	'The default option is ''R'', expecting '
	db	'valid RSX',eot
$ILL.RSX:
	db	'Invalid RSX format',eot
$WRT.ERR:
	db	'File write error',eot
$NO.CLOSE:
	db	'Cannot close .COM file',eot
$CNV:
	ds	.fext,' '
	db	' converted ('
$.FROM:
	db	'1234 to '
$.TO:
	db	'1234)',eot
$NO.FILE:
	db	'File does not exist',eot
$NO.REC:
	db	'No record found'
$EXIST:
	db	' already exists, '
	db	'[D]elete, [N]ew or [Q]uit : ',eot
$F.NAME:
	db	'File name : ',eot
$ABORT:
	db	'.. aborted',eot
$CAN.CREC:
	db	'Cannot create .COM file',eot
$ILL.OPT:
	db	'Invalid option',eot
$ILL.EXT:
	db	'Invalid extension - select .RSX, .PRL or .SPR'
	db	eot
$ILL.COMB:
	db	'Invalid combination of option '
	db	'and extension',eot
$NO.WILD:
	db	'Currently no wild cards supported',eot
RSX$WARN:
	db	'WARNING: Invalid RSX header detected '
	db	'but written to .COM file'
	db	cr,lf
	db	'Expected header (xx: don''t care, '
	db	'c: character expected)'
	db	cr,lf
	db	'xx xx xx xx xx xx C3 xx xx C3 xx xx xx xx '
	db	'xx xx c c c c c c c c xx xx xx'
	db	cr,lf
RSX$DAT:
	db	'xx xx xx xx xx xx xx xx xx xx xx xx xx xx '
	db	'xx xx x x x x x x x x xx xx xx'
	db	cr,lf
	db	'^ Header found'
	db	cr,lf,eot
DIAG:
	db	0
PB:
	dw	line+2,ourFCB
OptFlg:
	db	FALSE
RSXflg:
	db	_RSX
RSXlen:
	ds	2
.RSXlen:
	ds	2
ourFCB:
	ds	FCBlen
ourDMA:
	ds	reclng
line:
	db	14,0
	ds	14+1
RSX$HD:
	ds	RSXhead

	ds	2*32
stack:
	end	MAIN