title	RPLSUB - RPL Subroutines.
	.list

;; RPLSUB -- Assembly language support routines for RPL.
;  Richard A. Holmes, February 12, 1987.
;  4845 San Sebastian Avenue
;  Las Vegas, NV 89121
;  (702) 458-4933

;; This code has the program's starting point.  It sets the stack
;  and then calls a FORTRAN main driving routine.  The FORTRAN code
;  calls several routines included in here:
;
;  start		program starting address
;  endrun		return to CCP
;  fsize		determine file size.
;  sfirst		search for first directory entry
;  strend		output string to console with CRLF.
;  strout		output string with no CRLF.
;  opin			open input file
;  opout		open output file
;  rsectr		read disk sector from input file
;  wsectr		write disk sector to output file
;  clout		close output disk file
;  error		write error message to console, abort
;  getusr		get current user number
;  setusr		set current user number
;  amb1st		find 1st file with wildcard spec
;  ambnxt		find next file with wildcard spec
;  putfil		save a file name
;  getfil		retrieve a file name
;  chrout		output one character to the screen
;  makres		make reserved space file
;  delres		delete reserved space file
;  help			show help message

cr	set	13
lf	set	10

start::
	lxi	h,0
	dad	sp
	shld	savestack
	lxi	sp,stack	; set our stack pointer
	lxi	h,cuser
	call	getusr
	call	rpl##		; join main line code

; Endrun.  Terminate execution.
endrun::
	call	delres		; delete reserved space file
	lxi	h,cuser
	call	setusr
;;	lhld	savestack
;;	sphl
;;	ret
	jp	0

savestack: ds	2

	page	60

;;	FSIZE - Determine size of file.
;	Richard A. Holmes, 1983.
;
;	This FORTRAN-80 callable function will determine the
;	number of 128 byte blocks used by a file.
;
;		size = fsize(drive,name)
;
;	where
;
;		FSIZE    (integer)  if = -1, file does not exist
;				    else, count of 128 byte blocks
;		DRIVE	 (integer)  the drive indicator
;				    0 = default drive
;				    1 = A, 2 = B, etc.
;		NAME	 (byte(11)) the file name and extension

fszfcb:	ds	36
fszdrv	equ	fszfcb
fsznam	equ	fszfcb+1
fszext	equ	fszfcb+12
fszr0	equ	fszfcb+33
fszr1	equ	fszr0+1
fszr2	equ	fszr1+1
fszlex: ds	1		; highest extent seen
fszrec:	ds	1		; record count of highest ext

fsize:: call	setup
	mvi	a,'?'
	sta	fszext		; set extension to ?
; Set the DMA address to x'80'.
	mvi	c,x'1A'		; SETDMA command
	lxi	d,x'80'		; actual address
	call	5		; do it.
	lxi	d,fszfcb
	mvi	c,35
	call	5
; Check for maximum size file.
	lxi	h,-1
	lda	fszr2
	ora	a
	rnz
; Get the high record number from r0 and r1 in the FCB.
	lda	fszr0
	mov	l,a	
	lda	fszr1
	mov	h,a
	ret

; Search for first.
sfirst::
	call	setup
	lxi	d,fszfcb
	mvi	c,x'11'
	call	5
	ret

setup:	push	h
; Initially clear out the FCB.
	lxi	h,fszfcb	; where to start zeroing
	mvi	c,35		; length of FCB
	xra	a		; initialization constant
fsz10:	dcr	c		; count this byte
	jm	fsz20		; if all zeroed
	mov	m,a		; clear a byte
	inx	h		; move to next byte
	jmp	fsz10		; look for more
; Store the file name in the FCB.
fsz20:	mvi	c,11		; length of file name
	lxi	h,fsznam	; where to store the name
fsz30:	dcr	c		; count this byte
	jm	fsz40		; if all moved
	ldax	d		; fetch a byte
	mov	m,a		; stash it
	inx	d		; adjust source
	inx	h		; adjust destination
	jmp	fsz30		; try for another
; Store the drive code.
fsz40:	pop	h		; retrieve address of drive code
	mov	a,m		; fetch drive code
	sta	fszdrv		; save it in FCB
	ret

;; STROUT - output a string with no trailing characters.

strout:: push	h
	pop	d
	mvi	c,9
	jmp	5


;; STREND - output a string with a trailing CRLF.

strend::
	push	h
	pop	d
	mvi	c,9
	call	5
	mvi	e,13
	mvi	c,6
	call	5
	mvi	e,10
	mvi	c,6
	call	5
	ret

	.z80

opin::
; Initialize the input FCB.
	ld	bc,36
	ld	de,infcb
	ld	hl,zerofcb
	ldir				; initially clear the FCB
	ld	a,(indev)
	ld	(infcb),a		; set device
	ld	bc,11
	ld	de,infcb+1
	ld	hl,infile
	ldir				; set file name/extension
; Now open it
	ld	c,x'0f'
	ld	de,infcb
	call	5
	cp	x'ff'
	ret	nz

	ld	hl,noinfile
	call	error


opout::
; Initialize the output FCB.
	ld	bc,36
	ld	de,outfcb
	ld	hl,zerofcb
	ldir
	ld	a,(outdev)
	ld	(outfcb),a
	ld	bc,11
	ld	de,outfcb+1
	ld	hl,outfil
	ldir
; Now open it
	ld	c,x'0f'
	ld	de,outfcb
	call	5			; do an OPEN
; If it didn't work, then MAKE it.
	or	a
	ret	p
	ld	c,x'16'
	ld	de,outfcb
	call	5			; do a MAKE
	or	a
	ret	p
	ld	hl,nodirspace
	call	error

nodirspace: db	'No directory space for output file.$'

;; stat = rsectr(bufptr,recnumber)
;
;  stat = 0, good read
;  stat > 0, error
;  stat < 0, EOF

rsectr::
	push	de
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	ld	hl,sector
	add	hl,de
	push	hl
	pop	de		; DE = DMA address
	ld	c,x'1a'
	call	5		; set DMA address
	pop	de
	ld	a,(de)
	ld	(infcb+33),a	; set record number
	inc	de
	ld	a,(de)		; set record number (high byte)
	ld	(infcb+34),a
	ld	c,x'21'		
	ld	de,infcb
	call	5		; issue random read
	or	a
	ret	z		; if no error condition
	cp	1
	jr	z,rseceof	; if EOF situation
	cp	4
	jr	z,rseceof	; if EOF situation
	cp	6
	jr	z,rseceof	; if EOF situation
	ret

rseceof: ld	a,x'80'		; negative returned value means EOF
	or	a
	ret

noinfile:  db	'The input file does not exist.$'

;; stat = wsectr(bufptr,recnumber)
;
;  stat = 0, good write
;  stat > 0, error

wsectr::
	push	de
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	ld	hl,sector
	add	hl,de
	push	hl
	pop	de
	ld	c,x'1a'
	call	5		; set DMA address
	pop	de
	ld	a,(de)
	ld	(outfcb+33),a	; set record number
	inc	de
	ld	a,(de)		; set record number (high byte)
	ld	(outfcb+34),a
	ld	c,x'22'		
	ld	de,outfcb
	call	5		; issue random write
	or	a
	ret			; if no error condition

clout::	ld	de,outfcb
	ld	c,x'10'
	call	5
	ret

;; ERROR - put out an error message.  Terminate.

error::	push	hl
	ld	hl,dollar
	call	strend		; force beginning of new line
	pop	hl
	call	strend		; show provided error message
	ld	e,7		; ring the bell
	ld	c,x'06'
	call	5		; console output character
	call	delres		; make sure there is no reserved space file
	ld	hl,cuser
	call	setusr
	ld	c,x'00'
	jp	5		; do a SYSTEM RESET

dollar:	db	'$'

;; SETUSR - set user number.

setusr::
	ld	e,(hl)		; fetch user number
	ld	c,x'20'		; set function code
	call	5
	ret

;; GETUSR - get current user number.

getusr::
	push	hl
	ld	e,x'ff'
	ld	c,x'20'
	call	5
	pop	hl
	ld	(hl),a
	ret


;; GETDEV - get current device (default disk drive)

getdev::
	push	hl
	ld	c,x'19'
	call	5
	pop	hl
	inc	a
	ld	(hl),a
	ret


;; AMB1ST - Get first file using ambiguous file spec.

amb1st::
	push	hl
	pop	de
	ld	c,x'11'
	call	5		; issue search for first
	ret

;; AMBNXT - Get next file using ambiguous file spec.

ambnxt::
	push	hl
	pop	de
	ld	c,x'12'
	call	5		; issue search for next
	ret

;; PUTFIL - Put next file name in list.

putfil::
	ld	bc,11
	push	hl
	ld	hl,(pptr)
	ex	de,hl
	pop	hl
	ldir
	ld	hl,(pptr)
	ld	de,11
	add	hl,de
	ld	(hl),0
	ld	(pptr),hl
	ret

pptr:	dw	fnames	; put name pointer

getfil::
	ld	bc,11
	push	hl
	pop	de
	ld	hl,(gptr)
	ldir
	ld	hl,(gptr)
	ld	de,11
	add	hl,de
	ld	(gptr),hl
	ret

gptr:	dw	fnames

;; CHROUT - output a character to the console.
;
;	call chrout(char)

chrout::
	ld	e,(hl)
	ld	c,x'06'
	jp	5

;; MAKRES - make reserved space file.
;
;	call makres(amount)		(integer K amount)

makres::
	push	hl
	ld	hl,user0
	call	setusr			; work with user zero
	ld	a,(outdev)
	ld	(xxresfcb),a
	ld	de,x'80'
	ld	c,x'1a'			; set DMA
	call	5
	call	setresfcb
	ld	de,resfcb
	ld	c,x'13'			; DELETE function
	call	5
	call	setresfcb
	ld	de,resfcb
	ld	c,x'16'			; MAKE function
	call	5
	or	a
	jp	m,makopnerr	
	pop	hl
	ld	a,(hl)			; fetch K count
	and	x'1F'			; don't allow wraparound
	rla	 			; * 2
	rla	 			; * 4
	rla	 			; * 8 = number of sectors to write
	push	af
makr10:	pop	af
	dec	a
	jp 	m,makxit		; if no more to write
	push	af
	ld	de,resfcb
	ld	c,x'15'			; WRITE SEQUENTIAL
	call	5
	or	a
	jr	nz,makerr		; if not good write
	jp	makr10			; try again	

makxit:	ld	de,resfcb
	ld	c,x'10'			; CLOSE
	call	5
	ret

makerr:	pop	af
	ld	hl,makerrmsg
	call	error

makopnerr:
	ld	hl,opnerrmsg
	call	error

makerrmsg: db	'Error in reserving space.  Disk is full.$'
opnerrmsg: db	'Error in reserving space.  Directory is full.$'

;; DELRES - Delete reserved space file.
;
;	call delres

delres::
	ld	hl,user0
	call	setusr
	call    setresfcb
	ld	de,resfcb
	ld	c,x'13'
	call	5
	ret

;; SETRESFCB - Setup reserve space file block.

setresfcb:
	ld	de,resfcb
	ld	hl,xxresfcb
	ld	bc,36
	ldir
	ret


;; HELP - Show help message.
;
;       call help
;
;  Note direct console output on a character by character basis
;  is used because there are dollar signs in the text.

help::	ld	hl,helpmsg
help05:	ld	a,(hl)
	or	a
	ret	z			; if end of message
	push	hl
	ld	e,a
	ld	c,6
	call	5			; direct console output
	pop	hl
	inc	hl
	jr	help05

helpmsg:
	db	cr,lf
 db ' Function:   RPL is used to copy disk files.  It reserves space'
 db			' at the ',cr,lf
 db '             beginning of the disk and rewrites in place when'
 db			' possible.',cr,lf
 db '             It accepts user numbers and wildcards.',cr,lf,lf
 db ' Usage:      RPL destination=source $nnk',cr,lf,lf
 db '      where:     destination   specifies where to copy to',cr,lf
 db '                      source   specifies where to copy from',cr,lf 
 db '                        $nnK   specifies amount of reserved space'
 db cr,lf
 db '                                   (if omitted, 4K is reserved)'
 db cr,lf,lf
 db ' Examples:',cr,lf,lf
 db '    A> RPL X.OUT=Y.IN      copies Y.IN to X.OUT',cr,lf
 db '    A> RPL E7:=A:SOURCE    copies SOURCE on A: to SOURCE in'
 db                             ' user 7 of E:',cr,lf
 db '    A> RPL E3:=7:*.* $10K  copies all files in user 7 of the'
 db 				' default drive',cr,lf
 db '                             to user 3 of drive E: after first'
 db 				' reserving',cr,lf
 db '                             10K of disk space'  
 db cr,lf
lenhelp equ $-helpmsg

resfcb:	db	0,'RESERVE!$$$'
	db	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

xxresfcb: db	0,'RESERVE!$$$'
	db	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

user0:	db	0		; to select user zero

zerofcb: db	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	db	0,0,0,0,0,0,0,0,0,0,0

infcb:	ds	36
outfcb: ds	36

nfnames:db	0
ambig:	db	0		; non-zero if ambiguous name
maxfiles equ	255

;; SECTOR, STACK and FNAMES must be the very last things allocated in memory.
;  This is the case when using L80 or SLRNK+ .
	
sector::	ds	1		; beginning of disk sector buffer
endsect	equ	sector+12800		; allow 100 sector buffer area
stack	equ	endsect+600
fnames	equ	stack+2
	entry	highaddr
highaddr equ	fnames

;; The following common blocks must have been previously allocated by another
;  module already loaded.  This is the case with the FORTRAN routines.

	common	/in/
infile:	ds	11
indev:	ds	1
inunit:	ds	1

	common	/out/
outfil:	ds	11
outdev:	ds	1
outunt:	ds	1

	common  /user/
iuser:	ds	1
ouser:	ds	1
cuser:	ds	1

	end	start