; PROGRAM:	SAVE.Z80
; AUTHOR:	Jay Sage
; DATE: 	September 4, 1988
; VERSION:	1.1
; DERIVATION:	ZCPR34 resident SAVE command

vers	equ	15		; Version number

; Version 1.5  04 November 89  Howard Goldstein
;	Fixed several problems in the "from-till" mode including failure
;	when the range encompassed more than 255 records and failure to
;	accept FFFF as an ending address.  The full 64k can now be saved
;	in this mode, although the other mode has been changed to allow
;	a maximmum of 510 instead of 512 records.
;	Changed the banner to always display "SAVE" for the program
;	name.
;	Removed the in-line versions of PRTTYPE and PRTNAME since
;	they're now available in the standard libraries.
;	Added a public symbol, COUT, which simply jumps to BOUT.  This
;	causes all console output to be done through the DOS.  Console
;	input is now also done via DOS calls.
;	Replaced PRINT with EPRINT to shorten code.

; Version 1.4  25 November 88  Joe Wright
;	Report error if Z34 scanner was unable to find DIR: reference.

; Version 1.3  27 October 88  Joe Wright
;	Moved the filespec from TFCB2 to TFCB before EXTEST to get it
;	out of the way of F$EXIST (Func 17) which corrupts the default
;	DMA address (0080h) and therefore the 'tail' of TFCB2.
;	Removed RETCST calls to Z33LIB in favor of GETMSG.

; Version 1.2  20 September 88	Joe Wright
;	Placed prttype routine inline and put prtname routine back
;	in the code so that I can assemble it here without Jay's
;	newest libraries.
;	Reduced code in RADBIN: and elsewhere.

; Version 1.1  04 September 88	Jay Sage
;	Fixed code so that it will work in non-Z34 environment, such as
;	BGii and Z3PLUS.  Replaced code originally borrowed from ZCPR3
;	with library calls.  The number evaluation routines still need to
;	be improved; the present ones are from an old version of ZCPR33.
;	New code is much shorter and simpler.

; Version 0.7  20 January 88
;	Place RST 0 (instead or RET) as the first byte.
;	Eliminated Type 3/4 test.  Either is OK now.

; Version 0.6  September 1987  Joe Wright
;	Implement SAVE as a Type 4 command.

; SYNTAX:
; Version 0.5  3 Sept 87  Joe Wright
;	SAVE FROM-TILL UFN
; where from and till are hexadecimal memory addresses.  For example
; you might save the current NDR buffer with the following:
;	'save e600-e6ff names.ndr'
;
; Version 0.4
;	SAVE NUMBER UFN [SECTOR-FLAG]
; where number is a decimal number unless followed by an 'H' (exact character
; defined by the NUMBASE equate below), in which case it is a hesadecimal
; number.  UFN is an unambiguous file specification.  The third field is
; optional.  It allows the number of units to be stored to be interpreted not
; as pages (the default, 256-byte units) but as sectors or records (128-byte
; units).  The SECTCH equate below defines the character used for this switch.
; If SECTCH is defined to be the space character, then any character (and only
; the first character matters) will select sector mode.  Otherwise the
; character must match SECTCH.


; REVISION HISTORY
;
; Version 0.4	Jay Sage	May 19, 1987
; Updated to use Z33LIB routines.  Added version message with load address
; information.

; Version 0.3	Jay Sage	May 15, 1987
; Updated for latest release of Z33, which has a different entry point for
; the reparse routine.
;
; Version 0.2	Jay Sage	May 4, 1987
;
; This is a hastily constructed transient version of the SAVE command from the
; ZCPR33 command processor.  It uses a type-3 environment so that it can be
; loaded at a high address in memory, where one hopes that it will not
; interfere with the memory image to be stored.  The command will work in the
; desired way only when the memory area saved does not include the memory
; occupied by SAVE.COM, or where it does not matter that that part of memory
; has been corrupted.  I recommend linking the program to an address about
; 0.5K below the lowest system address ever used in your system (this is the
; CCP base address if you never use resident system extensions, such as print
; spoolers or XSUB, that install themselves below the CCP).  A value of A000H
; is typical.
;
; This first release is intended primarily as an example of some of the ways
; features of ZCPR33 can be used.  Of particular interest is the use of the
; parser from the command processor.  Many refinements should be added to this
; program before it is considered to be more than an instructional example.
; I would recommend the following at least:
;
;    1. Replace many of the in-line routines with calls to library
;	functions.  This will make the code more readable and easier to
;	maintain.
;    2. Add various self-checking features.  For example, a warning should
;	at least be given if the memory area saved includes any part of the
;	SAVE code itself.
;    3. Increase the flexibility of the command.  For example, the command
;	could be made to allow saving blocks of memory from arbitrary starting
;	to arbitrary ending addresses (as in the DSD debugger).
;    4. The interface to the ZCPR33 error handling facilities should be
;	developed further.
;    5. Add to the built-in help display showing the syntax allowed.  This
;	screen should adapt automatically to the actual name of the program
;	and to the definitions of SECTCH and NUMBASE.
;
;		Jay Sage, April 28, 1987


;=============================================================================
;
;			D E F I N I T I O N S
;
;=============================================================================

sectch	equ	' '		; Character used to switch to sector mode (if
				; ..set to ' ', any character will switch)
numbase	equ	'H'		; Character to switch to hexadecimal numbers

ecbaddir equ	02		; Specified dir: out of range or not found

ecambig	equ	08		; Error code to return for an ambiguous file
				; ..name specification
ecbadnum equ	09		; Error code to return for a bad number

ecfull	equ	11		; Directory or disk full error

tfcb	equ	005ch
tfcb2	equ	006ch
tail	equ	0080h
tpa	equ	0100h
bell	equ	07h
tab	equ	09h
lf	equ	0ah
cr	equ	0dh

	extrn		z3init,getmsg,getwhl,z3log		; Z3LIB
	extrn		prttype,prtname
	extrn		phlfdc,bout				; SYSLIB
	extrn		sksp,sknsp,eprint,crlf,bin,pfn2
	extrn		f$close,f$exist,f$make
	extrn		f$write,setdma,initfcb

;=============================================================================
;
;			M A I N    C O D E
;
;=============================================================================

entry:	rst	0		; New Type 3 construct	JWW
	dw	save
	db	'Z3ENV'
type:	db	3		; Type 3 environment
z3env:	dw	0		; ENV address
ldaddr:
	dw	entry		; Load address

; Display version message

banner:
	call	eprint
	db	cr,lf,'SAVE, Version '
	db	vers/10+'0','.',vers mod 10+'0',' ',0
	ld	a,(type)
	ld	hl,(ldaddr)
	call	prttype
	call	eprint
	db	'  File Save Utility',cr,lf,0
	ret

; This help screen should be significantly improved.  This is just a quick and
; dirty cut at something.

help:	call	banner
	call	eprint
	db	cr,lf,'  Syntax:',cr,lf,cr,lf,'    ',0
	call	prtname
	call	eprint
	db	' nn[H] FILE.TYP ['

	 if	sectch eq ' '
	db	'o'
	 else
	db	sectch
	 endif	;sectch eq ' '

	db	']',cr,lf,'      '
	db	'Where nn is the decimal or [H]exadecimal length in pages.'
	db	cr,lf,'      '

	 if	sectch eq ' '
	db	'Any character'
	 else
	db	'''',sectch,''''
	 endif	;sectch eq ' '

	db	' in the third token switches from page mode'
	db	cr,lf,'      '
	db	'to sector/record mode, or..'
	db	cr,lf,cr,lf,'    ',0
	call	prtname
	call	eprint
	db	' from-till FILE.TYP',cr,lf,'      '
	db	'Where ''from'' and ''till'' are hexadecimal addresses of the'
	db	cr,lf,'      '
	db	'start and end of the memory block you wish to save.'
	db	cr,lf,0

	ret

; Program begins here.

save:	call	z3init		; Z3ENV address passed in HL by Z34

; Check for help request

	ld	a,(tfcb+1)	; Get first character of number
	cp	'/'		; Explicit help request
	jr	z,helprel
	cp	'?'		; Explicit help request
	jr	z,helprel
	cp	' '		; No command tail - implied help request
helprel:
	jp	z,help

	ld	hl,tfcb2+1	; Point to first character of file name
	ld	a,(hl)		; Get it
	cp	' '		; See if any file name specified
	jr	nz,main		; If file name, go on with save
	ld	(hl),'?'	; Otherwise, force ambiguous expression

main:	call	getwhl		; Make sure user has wheel status
	jr	nz,main1	; Branch if OK

	call	eprint
	db	bell,'  Not Wheel',0
	ret

main1:
	ld	(stack),sp	; Save system stack pointer
;
; Check for Z34 scanner error.
;
	ld	a,(tfcb2+15)
	inc	a		; 255 -> 0
	ld	c,ecbaddir
	jp	z,error		; Quit

	ld	hl,data		; Initialize data space
	ld	de,data+1
	ld	bc,datalen-1
	ld	(hl),0		; Seed first value
	ldir			; Propagate it
	ld	hl,100h		; Set default save starting address
	ld	(dmaadr),hl

	call	number		; Extract number(s) from command line

	jp	c,badnumber	; Invoke error handler if bad number

	ex	de,hl		; Number to HL

	ld	a,(secflag)	; See if sector count specified
	or	a
	jr	nz,save0	; If so, proceed with save

	add	hl,hl		; Else double page count to get sector count

save0:
	ld	(record),hl	; Save record count, 512 max (64k)

	ld	a,(mode)	; Check if 'from-till' form
	or	a
	jr	nz,save0a	; Branch if so
	ld	de,510+1	; Too many records
	sbc	hl,de		; Sets carry if ok
	jp	nc,badnumber	; Too many records

save0a:
	ld	hl,tfcb2	; Point to FCB
	ld	de,tfcb		; Default FCB
	push	de
	ld	bc,14
	ldir
	pop	de
	call	ambchk		; Check for ambiguous file spec (vectors to
				; ..error handler if so)

	call	extest		; Test for existence of file and abort if so
	call	f$make
	inc	a
	jr	z,loaderr	; Branch if error in creating file

	ld	bc,(record)	
	ld	hl,(dmaadr)	; Start writing from here
;
save1:
	ld	a,b		; Check for BC = 0
	or	c
	jr	z,save2		; Branch if done

	dec	bc		; Count down sectors
	call	setdma		; Set DMA address to HL for write
	call	f$write
	push	de		; Save FCB pointer
	ld	de,128		; Advance address by 128 bytes
	add	hl,de
	pop	de		; Restore FCB pointer
	jr	z,save1		; If write successful, go back for more
	ld	b,0ffh		; B nonzero if write failed

save2:
	call	f$close		; Close file even if last write failed
	or	b		; Combine close return code with
				; ..write success flag
	jr	nz,loaderr	; Abort if close or write failed

	call	eprint
	db	'  Saved ',0
	ld	hl,(record)
	call	phlfdc
	call	eprint
	db	' record',0
	dec	hl
	ld	a,h
	or	l
	ld	a,'s'
	call	nz,bout
	call	eprint
	db	' as ',0
	inc	de		; Point to first character of file name
	call	pfn2
	jr	done

;-----------------------------------------------------------------------------

; Check the FCB pointed to by DE for the presence of a question mark.  If so,
; return via error handler.  Otherwise return to the calling code.

ambchk:
	ld	h,d		; Copy DE into HL
	ld	l,e
	ld	a,'?'		; Set up for scan for question mark
	ld	bc,11		; Scan 11 characters
	cpir
	ret	nz		; Return if no '?' found

amberr:
	ld	c,ecambig	; Error code for ambiguous file name
	jr	error

;-----------------------------------------------------------------------------

; Various entries to the error handler

badnumber:
	ld	c,ecbadnum	; Error code for bad number value
	jr	error

loaderr:
	ld	c,ecfull

error:
	call	getmsg		; Point to Z3MSG
	ld	(hl),c		; Plug in the error code
	inc	hl
	inc	hl
	inc	hl		; Point to the command status flag
	ld	a,(hl)		; Get it
	or	1110b		; Error, ECP and Transient bits
	ld	(hl),a		; Put it back

done:
	ld	sp,(stack)	; Restore system stack pointer
	ret

;-----------------------------------------------------------------------------

; Test file whose FCB is pointed to by DE to see if file exists.  Ask user
; to delete if so, and abort if he choses not to.

extest:
	call	z3log		; Log into designated directory
	call	initfcb
	call	f$exist		; See if file already exists
	ret	z		; OK if not found, so return

	call	eprint
	defb	bell
	defb	'  Erase existing ',0
	inc	de		; Point to first character of file name
	call	pfn2		; Print it
	dec	de		; Restore FCB pointer
	call	eprint		; Add question mark
	defb	' ? ',0
	call	bin		; Get user response
	and	5fh		; Convert to upper case
	cp	'Y'		; Test for permission to erase file
	jp	nz,done		; If not, flush the entire command line
	jp	crlf		; Kick up a new line and return

;-----------------------------------------------------------------------------

; Define public symbol COUT so that all SYSLIB routines that call COUT
; will use BOUT instead

cout::	jp	bout

;-----------------------------------------------------------------------------

; The routine NUMBER evaluates a string in the first token in the command
; line tail.  It interprets the forms: ##, ##H, or ####-####.  If the form
; is the latter, the MODE flag is set.	This routine also checks to see if
; the third command-line token indicates a sector (record) count instead of
; a page count.  The SECFLAG flag is set if it does.
;
; If the number conversion is successful, the value is returned as a 16-bit
; quantity in DE.  If the number is less than 256, then the zero flag is set.
; If an invalid character is encountered in the string, the routine returns
; with the carry flag set and HL pointing to the offending character.

number:

	ld	hl,tail+1
	call	sksp		; Skip to beginning of first token
	push	hl		; Save pointer for later number parsing

; Check for possible third token

	call	sknsp		; Skip over first token
	call	sksp		; ..to second token
	call	sknsp		; Skip over second token
	call	sksp		; ..to third token
	ld	a,(hl)		; Get possible first character in token
	or	a		; If null
	jr	z,num1		; ..leave flag as is

	 if	sectch ne ' '	; If specific character required
	cp	sectch		; ..see if it is the sector flag character
	jr	nz,num1		; If not, leave flag as is
	 endif

	ld	(secflag),a	; Set the flag

num1:
	pop	hl		; Get back pointer to first token
	push	hl
	call	skndel		; Skip to next delimiter
	cp	' '		; Is it 'space'?
	pop	hl		; Pt back to beginning of string
	jr	z,numb1		; Mode 0 syntax

; We have encountered FROM-TILL syntax

num2:	ld	(secflag),a	; Indicate that count is in sectors
	ld	(mode),a	; ..and that we're in from-till mode
	call	hexnum1		; Value to DE
	ret	c
	ld	(dmaadr),de	; Start writing from here
	call	skdel		; First digit of TILL
	call	hexnum1		; Value in DE
	ret	c

	ld	hl,(dmaadr)
	ex	de,hl		; From in de, till in hl
	sbc	hl,de
	ret	c		; FROM > TILL
;
; Divide HL by 128 for record count, return in DE
;
	ld	de,128		; Fudge factor (D=0)
	add	hl,de
	rl	d		; Move possible carry to d
	add	hl,hl		; Divide by 128
	ld	e,h		; Result in e
	rl	d		; CY to d
	ret


numb1:	ld	hl,tfcb+1+7	; Set pointer to last char of number string
	ld	bc,8		; Number of characters to scan
	ld	a,numbase	; Scan for HEX identifier
	cpdr			; Do the search (decrementing)
	inc	hl		; Point to HEX marker or beginning of string
	jr	nz,decimal1	; Branch if HEX identifier not found

	ld	(hl),' '	; Replace HEX marker with valid terminator
				; ..and fall through to HEXNUM

;----------------------------------------

; At this entry point the character string in the first default FCB is
; converted as a hexadecimal number (there must NOT be a HEX marker).

hexnum:
	ld	hl,tfcb+1	; Point to string in first FCB

; At this entry point the character string pointed to by HL is converted
; as a hexadecimal number (there must be NO HEX marker at the end).

hexnum1:
	ld	c,16		; HEX radix base
	jr	radbin		; Invoke the generalized conversion routine

;----------------------------------------

; This entry point performs decimal conversion of the string pointed to
; by HL.

decimal1:
	ld	c,10		; Decimal radix base
				; Fall through to generalized
				; ..radix conversion routine

; This routine converts the string pointed to by the entry on the top of
; the stack using the radix passed in DE.  If the conversion is successful,
; the value is returned in BC.	HL points to the character that terminated
; the number, and A contains that character.  If an invalid character is
; encountered, the routine returns with the carry flag set and nonzero, and
; HL points to the offending character.

radbin:
	ld	de,0		; Initialize result
radbin1:
	or	a		; Make sure carry is reset
	call	sdelm		; Test for delimiter (returns Z if delimiter)
	ret	z		; Return if delimiter encountered

	sub	'0'		; See if less than '0'
	ret	c		; Return with carry set if so
	cp	10		; See if in range '0'..'9'
	jr	c,radbin2	; Branch if it is valid
	cp	'A'-'0'		; Bad character if < 'A'
	ret	c		; ..so we return with carry set
	sub	7		; Convert to range 10..15
radbin2:
	cp	c		; Compare to radix in C
	ccf			; Carry should be set; this will clear it
	ret	c		; If carry now set, we have an error
;
; It's a valid digit.  Multiply DE by the radix and add it in
;
	inc	hl		; Point to next character
	push	hl		; Save it on the stack
	ld	b,c		; Radix to B
	ld	hl,0		; Clear an accumulator

mpy:	add	hl,de
	djnz	mpy

	ld	e,a		; Digit to E
	ld	d,b		; Zero to D
	add	hl,de
	ex	de,hl		; New result to DE
	pop	hl		; Restore pointer
	jr	radbin1

;-----------------------------------------------------------------------------

; SKDEL - Skip over delimiters (including spaces)

skdel:	call	sdelm
	ret	nz		; Not a delimiter
	inc	hl
	jr	skdel

; SKNDEL - Skip to next delimiter (including space)

skndel:	call	sdelm
	ret	z
	inc	hl
	jr	skndel

;-----------------------------------------------------------------------------

; This routine checks for a delimiter character pointed to by HL.  It returns
; with the character in A and the zero flag set if it is a delimiter.  All
; registers are preserved except A.

sdelm:
	ld	a,(hl)		; Get the character
	exx			; Use alternate register set (shorter code)
	ld	hl,deldat	; Point to delimiter list
	ld	bc,delend-deldat; Length of delimiter list
	cpir			; Scan for match
	exx			; Restore registers
	ret			; Returns Z if delimiter

deldat:				; List of delimiter characters
	db	' '
	db	'='
	db	'_'
	db	'.'
	db	':'
	db	';'
	db	'<'
	db	'>'
	db	','
	db	'-'
	db	'/'
	db	'\'
	db	'|'
	db	'~'
	db	0		; The ultimate delimiter
delend:

;-----------------------------------------------------------------------------

	dseg

data:				; Beginning of area to initialize
dmaadr:
	ds	2
mode:
	ds	1
secflag:
	ds	1
record:
	ds	2

datalen	equ	$ - data	; Size of area to initialize

stack:	defs	2		; Place to keep system stack address

	end
;
; End of SAVE.Z80