title	Compute .PRL file(s) from .COM
	maclib	base80

; This program extracts the PRL code from an existing .COM
; file organized as RSX, installing the header for the file(s).

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

;		Version 2.1, June 1993

; How to call:

;	GENRSX {drive:}filename{.ext}

; The default extension is .COM, the new file(s) have the same
; name as named in the RSX file with extension .RSX.

_PRG	macro
	db	'GENRSX'
	endm

_VER	macro
	db	'2.1'
	endm

	entry	$memry

	extrn	open,dskred,shfrhl,string,create,crlf,delete
	extrn	wcard,getver,rndred,dskwrt,close,filnam,divrec

.RET	equ	0c9h

; ===== Code starts here ====

$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:
	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,$HEADER
	call	string		; Give header
	ld	a,(CCPlen)	; Test any command
	ld	de,$HELP
	or	a
	jp	z,comstr	; .. give $HELP
	ld	de,FCBext
	ld	a,(de)
	cp	' '		; Test extension
	jr	nz,@norex
	ld	hl,comex
	ld	bc,.fext
	ldir			; Set .COM
@norex:
	ld	de,FCB
	call	wcard		; Verify no wild cards
	jr	z,NoWild
	call	open		; Test file here
	ld	de,$NO.FILE
	jp	c,comstr	; Not here
	call	ProcFile	; Process this file
	ld	de,$DONE
	jr	comstr
wrterr:
	ld	de,$WRT.ERR
@comdl:
	push	de
	ld	de,ourFCB
	call	delete		; Delete the bad file
	pop	de
	jr	comstr
rderr:
	ld	de,$NO.REC
	ld	a,(RSXflg)
	cp	FALSE
	jr	z,comstr
	ld	de,$RD.ERR
	jr	comstr
NoWild:
	ld	de,$NO.WILD
	jr	comstr
illRSX:
	ld	de,$ILL.RSX
comstr:
	call	crlf
	call	string		; Tell message
	call	crlf
	jp	OS

; ===== Subroutines =====
;
; Process one .COM file
;
ProcFile:
	ld	hl,($memry)
	ld	(strbuf),hl	; Init pointers
	ld	(curbuf),hl
	ld	a,FALSE		; And several other things
	ld	(RSXflg),a
	ld	hl,0
	ld	(RSXcnt),hl
RSXred:
	ld	de,FCB
	call	dskred		; Get record
	jp	c,rderr		; None here
	ld	hl,DMA
	ld	a,(RSXflg)
	cp	TRUE
	jr	z,skptst	; Test first record
	ld	a,(hl)
	cp	.RET		; Test legal RSX
	jp	nz,illRSX
	ld	hl,DMA+16	; Set to 2nd line
skptst:
	ld	a,(hl)
	inc	hl
	or	(hl)		; Test end of RSX
	jr	z,endofx
	dec	hl
	push	hl
	pop	de
	ld	hl,(curbuf)
	ex	de,hl
	ld	bc,16
	ldir			; Unpack header record
	ex	de,hl
	ld	(curbuf),hl
	ld	hl,(RSXcnt)
	inc	hl		; Bump count
	ld	(RSXcnt),hl
	ex	de,hl
	ld	a,l		; Test record done
	cp	0
	jr	nz,skptst
	ld	a,TRUE
	ld	(RSXflg),a
	jr	RSXred
endofx:
	ld	hl,(RSXcnt)	; Test any RSX
	ld	a,h
	or	l
	jp	z,illRSX
RSXlop:
	ld	hl,(strbuf)	; Get current top
	ld	de,line
	ld	bc,16
	ldir			; Get current line
	ld	(strbuf),hl
	ld	de,RSXnam	; Point to name of RSX
	ld	b,.fname
	ld	hl,ourFCB+1
lgtst:
	ld	a,(de)
	ld	(hl),a
	call	illchr		; Test legal characters
	jp	c,illRSX
	inc	de
	inc	hl
	djnz	lgtst
	ld	hl,(RSXlng)	; Get start offset of RSX
	call	divrec		; Convert to record
	ld	(RSXlng),hl
	ld	hl,(RSXrec)
	ld	(RSXhdl),hl
	push	hl
	pop	de
	ld	a,l
	and	111b		; Test remainder
	push	af
	call	shfrhl		; Divide length by 8
	call	shfrhl
	call	shfrhl
	pop	af
	jr	z,norem
	inc	hl		; Fix for remainder
norem:
	add	hl,de		; Add length of PRL table
	call	divrec		; Get record count
	inc	hl		; And fix it
	ld	(RSXrec),hl
	ld	de,ourFCB+9
	ld	hl,RSXex
	ld	bc,.fext
	ldir			; Set extension .RSX
	ld	a,(FCB)
	ld	(ourFCB),a	; Here's the drive
	ld	de,$EXTRACT
	call	string		; Tell file
	ld	de,ourFCB+1
	call	filnam
	call	crlf
	ld	de,ourFCB
	call	delete		; Delete
	call	create		; .. before creating
	ld	de,$NO.CREC
	jp	c,comstr	; Cannot do so
	ld	hl,(RSXlng)
	ld	(FCBrnd),hl	; Set random record
	ld	a,0
	ld	(FCBrnd+2),a
	ld	de,FCB
	call	rndred		; Position record
	jp	c,illRSX
	ld	hl,DMA
	ld	de,DMA+1
	ld	bc,reclng-1
	ld	(hl),0		; Clear record buffer
	ldir
	ld	hl,(RSXhdl)
	ld	(DMA+1),hl	; Set length
	ld	de,ourFCB
	call	dskwrt		; Write first record
	jp	c,wrterr
	ld	hl,0
	ld	(DMA+1),hl	; Set zero
	ld	hl,(RSXrec)
	inc	hl
	jr	lopwr
lop:
	ld	de,FCB
	call	dskred		; Get record
	jp	c,illRSX
lopwr:
	ld	de,ourFCB
	call	dskwrt		; Put record
	jp	c,wrterr
	dec	hl
	ld	a,h
	or	l
	jr	nz,lop		; Test end
	ld	de,ourFCB
	call	close		; Close file
	ld	de,$NO.CLOSE	; Impossible
	jp	c,@comdl
	ld	hl,(RSXcnt)
	dec	hl
	ld	(RSXcnt),hl	; Count down
	ld	a,h
	or	l
	jp	nz,RSXlop	; Get next RSX
	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
	ret	nc
	cp	'A'		; And letters, of course
	ret	c
	cp	'Z'+1
	ccf
	ret

; ===== Data fields =====

	dseg

RSXex:
	db	'RSX'
comex:
	db	'COM'
$HEADER:
	_PRG
	db	' v'
	_VER
	db	cr,lf,lf,eot
$HELP:
	db	'Call it',cr,lf,lf,tab
	_PRG
	db	' file{.ext}',cr,lf,lf
	_PRG
	db	' extracts page relocatable files from '
	db	'combined ones generated with the',cr,lf
	db	'utility GENCOM.',cr,lf,lf
	db	'GENCOM may extract .COM files only, while '
	_PRG
	db	' does this for .RSX files only.'
	db	cr,lf,lf
	db	'The default extension of the combined file '
	db	'is .COM.',cr,lf,lf
	db	'The new files will be named as found in the '
	db	'header of the combined file.',cr,lf
	db	'After extraction these files may be used to '
	db	'generate new combined ones.',cr,lf,lf
	db	'Note if GENCOM will also be used, call '
	_PRG
	db	' first. That is because GENCOM',cr,lf
	db	'deletes the .RSX files.',eot
$ILL.RSX:
	db	'Illegal RSX format',eot
$WRT.ERR:
	db	'File write error',eot
$NO.CLOSE:
	db	'Cannot close .COM file',eot
$DONE:
	db	'RSX file(s) extracted',eot
$NO.FILE:
	db	'File does not exist',eot
$NO.REC:
	db	'No record found'
$NO.CREC:
	db	'Cannot create .COM file',eot
$RD.ERR:
	db	'File read error',eot
$NO.WILD:
	db	'Currently no wild cards supported',eot
$EXTRACT:
	db	'Extracting -->> ',eot
$memry:
	ds	2
strbuf:
	ds	2
curbuf:
	ds	2
RSXflg:
	ds	1
RSXcnt:
	ds	2
ourFCB:
	ds	FCBlen
ourDMA:
	ds	reclng
line:
	ds	16
RSXlng	equ	line
RSXrec	equ	line+2
RSXhdl	equ	line+4
RSXnam	equ	line+6

	ds	2*16
stack:	
	end	MAIN