; Program:	ZERR - ZCPR 3.4 Error Handler
;		ZERRLSH - Companion error handler for LSH
; Version:	1.6
; Date: 	August 22, 1991
; Author:	Rob Friefeld

; Derivation - EASE 1.6z by Paul Pomerleau, with mods by Bridger Mitchell

; 1.6   <rdf>
;	Substantial changes to ZERRLSH.INC to accomodate LSH Version 1.1
;	Minor changes to ZERRED for smaller code size.
;	Fixed error in SUBMIT job abort handling.
;	Increased stack size of ZERR15 to 60 bytes.

; 1.5b	<rdf>
;	Moved LSH history file buffer code into ZERRLSH.INC.  Buffer
;	address is automatically set below code per history size info
;	kept on shell stack by LSH for Type4 version.
;
;	Installation program needed adjustment of offsets after v1.5
;	change to ZERRCMD.


; 1.5
; - Changes by Joe Wright  14 September 1990
;	Changed this file to .REQUEST ZERRED (renamed from ZERR-ED)
;	and BGSIG2 to simplify the linker command line.
;
;	Fixed ZERRCMD and ZERRED so that CMDLEN is passed correctly
;	by ZMAC (Z80ASM always did it right).
;
;	Changed the header to Type 3.  T4LDR will set it to 4 at runtime.
;	Moved $MEMRY location to 10Bh if Type 4.  The linker fills it in
;	and T4LDR uses the value to load ZERR as high as possible.
;	The LSH file buffer is now below ZERR for Type 4.
;
;	Some minor changes for M80 assembly, include filespecs in upper
;	case, colons after labels, ADD A,A instead of ADD A.  Also the
;	DC statement works differently in M80.  It tags the last character
;	in the string, not the line.  Changed affected lines to DB ....+80h.
;
; Note:
;	SLRNKP does not produce a valid bitmap for PRL and should not
;	be used.  Use Hawley's ZML or DRI's LINK to produce PRL's.
;	ZML is the best choice because it produces a shorter file.

; 1.4
; - Changes by Al Hawley <aeh> so that SLR products no longer required
;	for assembly.
; - Uses Z34ERR12.LIB with latest error codes
; - Console i/o uses BDOS functions
; - Option to deselect CSF bit 4 testing.
; - Destructive backspace option for editor
; - Type 3 header omitted
;ZERRLSH ---
; - LSH history file correction is skipped if LSH recording toggle is OFF.

; Modified by Carson Wilson 8 Sep 89 to prefix an arbitrary string
;   and continue processing if CSF bit 4 is set on entry (signals that
;   a transient version of a resident command should be invoked).
; NOTES:
; - The prefix string at PREFIX is up to 9 bytes long (8-char. DIRNAME plus
;   colon), and is installable by the user.
; - LINE can become longer than 255 characters if a user prepends a
;   9-character string to a 251-character command.  I have expanded the
;   LINE buffer by 9 bytes to handle this, but the line editor still cannot
;   handle over 255 bytes, which MAY cause problems.
; - At present the command LSH.CMD is NOT prefixed and saved back to LSH.CMD.
;   Apparently the editor module itself must be modified to implement this.
;   I'm not sure this is a problem; in some circumstances it might be desirable
;   not to alter the LSH.CMD file.  For now, the code skips all LSH testing
;   if CSF bit 4 is set.

; All changes marked <crw>.


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

vers	equ	16
rev	equ	' '		; Test revision

	include	SYSDEF.LIB	; Standard definitions
	include	ZERRDEF.LIB	; Common program module defs

y	equ	yes
n	equ	no

	.request	zerred	; Always link the editor in
	ext	edit		; Line editor entry

;Note: The format and usage of .printx varies with the
;assembler used. For two pass assemblers like M80 and
;ZMAC, modifications will be needed to ensure that the
;following messages are printed in pass 1 as intended.
;In addition, M80 requires that the print string be
;delimited. ZMAC can be configured to print on Pass 1,
;as does the SLR assembler.	(aeh)

m80	equ	no		; M80 assembler ?


	 if	m80

	 if1			; Pass 1
	.printx	"ZERR - Error Handler for ZCPR 3.3+"
	 endif

; Note:  M80 does not support the .ACCEPT pseudop.  If you
; insist on M80, you must edit the following to taste. (jww)

lsherr	equ	no		; Use with LSH ?
bgprompt equ	no		; Use with BGii ?
type4	equ	yes		; Assemble as Type 4 ?

	 else

	.printx
	.printx	"ZERR - Error Handler for ZCPR 3.3+"
	.printx
	.accept	"Use extensions for LSH? (y/n) ",lsherr
	.accept	"Use with Backgrounder ii? (y/n) ",bgprompt
	.accept	"Type 4 assembly? (y/n) ",type4
	.printx
	 endif	; m80

	 if bgprompt
	.request bgsig2
	ext	bgtask		; Reflect current BGii task in prompt
	 endif

	.request	vlib,z3lib,syslib

	ext	retcst		; <crw>
	ext	z3vinit
	ext	qerror
	ext	getcl1,putcl,geterc,erradr,getmsg
	ext	getefcb,gdefdu,getduok,dutdir,gcmddu
	ext	getsrun,haltsub
	ext	getzrun,putzrun

	 if	type4
	public	$memry
	 else
	ext	$memry
	 endif

; Access for editor module

	public	conout,print,cin,caps
	public	ins_flag,bsp_flag,line



;=========================================================================
;
;		P R O G R A M	 H E A D E R
;
;=========================================================================

entry:
	rst	0
	dw	start
	db	'Z3ENV'
type:
	db	3			; Type-3 (overwritten by T4LDR)
z3eadr:
	dw	0			; Filled in by Z33+

	 if	type4
$memry:	ds	2			; Filled in by linker
	 else
	dw	entry			; Intended load address
	 endif	;type 4


;=========================================================================
;
;		C O N F I G U R A T I O N    A R E A
;
;=========================================================================

		 if lsherr
progid:		dc	'ZERR+LSH'	; For installation program
		 else
progid:		dc	'ZERR    '
		 endif

versid:		db	vers		; Version ID for INST
revid:		db	rev		; INST does NOT look at this
beep_flag:	db	y		; Beep at various times
ins_flag:	db	y		; Overwrite vs insert
bsp_flag:	db	y		; Destructive backspace?

	include	ZERRCMD.INC		; Editor command list here


prefix:		db ':',0,0,0,0,0,0,0,0	; Up to 9 bytes <crw>
		db 0			; Null terminator makes 10


		 if lsherr
lshid:		db	'LSH'		; Name to match on shell stack
		ds	9 - ($-lshid)
		 endif


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

start:
	ld	(stack),sp	; Save ccp's sp
	ld	sp,stack	; Set new stack
	call	Z3VINIT		; Initialize library routines
	call	QERROR		; See if error handler invocation
	jp	z,errorh	; If so, branch to error processing


;=========================================================================
;
;		I N S T A L L A T I O N    C O D E
;
;=========================================================================

; Program was invoked manually
;   1 - Help or Exit request?
;   2 - Else install error handler command line

; Subtask 1 -- Check for command line option
; '/' or '//' will get ID message.  Any other non-blank exits error handler.

eh_inst1:
	ld	hl,fcb+1	; Option location
	ld	a,(hl)
	cp	'/'		; Help request?
	jr	nz,eh_inst1a
	inc	hl
	ld	a,(hl)
	cp	'/'
	jp	z,idmsg
	cp	' '
	jp	z,idmsg

eh_inst1a:
	cp	' '
	jp	nz,quit_eh

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

; Subtask 2 -- build error handling command line including directory prefix
; using data from the external FCB.  We use the fact that the drive and user
; where the program was actually found along the path are stored in the
; command file control block.

eh_inst2:
	call	GETERC		; Ptr to error command line
	ex	de,hl		; Switch pointer into de

	call	GCMDDU		; Get DU where file was found
	ld	a,b		; Drive in b
	add	a,'A'		; Convert to letter
	ld	(de),a		; Save in error command line
	inc	de		; Increment command line pointer
	ld	a,c		; Now user #
	call	mafdc		; Convert to decimal in command line

	ld	a,':'		; Put in the colon
	ld	(de),a
	inc	de

	call	GETEFCB		; Get address of the command fcb
	inc	hl		; Advance pointer to name of program
	ld	bc,8		; Copy 8 characters of name
	ldir			; into error command line

	xor	a		; Store terminating null
	ld	(de),a

	call	progmsg		; Tell user and exit
	dc	' Installed'
	jp	exit

;=========================================================================
;
;		E R R O R    H A N D L I N G	C O D E
;
;=========================================================================

; This is the main entry point for error handling
;  0 - If CSF requesting transient, skip editing and try to run it.
;  1 - Display signon
;  2 - Stop ZEX and SUB if running*
;  3 - Clear Command Stat Flag*
;  4 - Display error type
;  5 - Load command line to editing buffer
;  6 - Deal with bad command
;
;  * No longer needed with Z33

errorh:
	call	beep		; Did the user want a beep?

; Subtask 0 -- Transient requested?

; If a resident command was unable to handle the command line (i.e. it had an
; ambig filespec), it may signal the error handler to run the more powerful
; transient command of the same name by setting Command Stat Flag bit 4.

	ld	a,(prefix)	; If prefix string null, ignore CSF bit4
	or	a
	jr	z,errorh1

; <crw>. .
	call	RETCST		; Z3LIB: return CSF address in HL
	bit	4,(hl)		; Bit 4 signifies transient request
	jp	nz,errorh5	; Skip console i/o if so
; . . <crw>

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

; Subtask 1 -- Display program signon message

errorh1:
	call	header

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

; Subtask 4 -- Determine the error return code and display information about
; the nature of the error.  The currently defined error types are in
; Z34ERR.LIB.

errorh4:
	call	GETMSG
	ld	a,(hl)		; Get the error return code
	cp	maxecodes+1	; If number greater than max in table
	jr	c,errorh4a	; Error within established list
	ld	a,4		; Use unknown error number
errorh4a:
	add	a,a		; Make 8 bit skip into 16 bit
	ld	e,a
	ld	d,0
	ld	hl,errstrs - 2	; Add to first string index
	add	hl,de
	ld	e,(hl)
	inc	hl
	ld	d,(hl)		; Pull in string location
	ex	de,hl
	call	printhl		; Print it
	call	crlf

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

; Subtask 5 -- Load bad command line into editing buffer
; Save pointer to end of bad command

errorh5:
	ld	a,(prefix)	; Test for null prefix
	or	a
	jr	z,preskip

;  <crw>. .
	call	RETCST		; Z3LIB: return CST address in HL
	bit	4,(hl)		; Bit 4 signifies transient request
preskip:
	ld	de,line		; Pointer to editing buffer
	jr	z,predone	; No prefix needed

; Transient requested by resident command, so prepend PREFIX to LINE.

	ld	hl,prefix	; Point to null-terminated custom prefix
	xor	a
dopre:	cp	(hl)		; Terminator?
	jr	z,predone	; Yes, we're through
	ldi			; No, load another..
	jr	dopre
predone:
;. . <crw>

	call	ERRADR		; Get pointer to bad command line
	push	hl		; Save for reuse below

scan:				; Find end of this command
	ld	a,(hl)
	ld	(de),a
	or	a		; See if end of command line buffer
	jr	z,errorh5b
	cp	';'		; See if at command separator
	jr	z,errorh5a
	inc	hl		; Point to next character
	inc	de
	jr	scan		; Continue scanning

errorh5a:
	push	hl		; Save end of bad command
fillrest:
	ld	a,(hl)		; Put remainder of CL into buffer
	ldi
	or	a
	jr	nz,fillrest
	pop	hl

errorh5b:
	ld	a,(hl)		; Get delimiter
	ld	(delim),a	; Store delimiter
	ld	(hl),0		; Mark end of string
	ld	(delimptr),hl	; Save ptr to bad command's delimiter

	ld	a,(prefix)	; Test for null prefix
	or	a
	jr	z,errorh6	; Go to editor if so

; <crw>. .
	call	RETCST		; Z3LIB: return CST address in HL
	bit	4,(hl)		; Bit 4 signifies transient request
	jp	nz,noedit	; Skip edit if so
;. .<crw>

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

; Subtask 6 -- Deal with the bad command

; This is where the real error handling is performed.  With normal command
; lines (ZEX and SUBMIT not running), the user has the following three
; choices: fix the bad command, skip the bad command, or abort the entire
; command line.  If ZEX or SUBMIT is running, the user must be given the
; option to abort the entire job.

; The error handler goes to a line editor with the cursor on the bad command.
; The editor implements Fix, Abort or Continue.  It returns a code to
; signal the option chosen.

errorh6:

; First we do some work for LSH.  (See ZERRLSH.INC)

	 if lsherr
	call	find_lsh	; Do some inits
	 endif

; Display message indicating choices for dealing with bad command

	call	printc
	dc	'     ['
	ld	a,(abort_cmd)
	call	ctlprint
	call	print
	dc	' - Cancel'
	ld	a,(delim)	; Get bad command delimiter
	or	a
	jr	z,errorh6a	; No trailing commands; skip continue option
	call	print
	dc	' / '
	ld	a,(cont_cmd)
	call	ctlprint
	call	print
	dc	' - Skip'
errorh6a:
	call	print
	dc	']'

; Display system prompt before command line

errorh6b:
	call	crlf
	call	prompt
	call	print
	dc	'>'

; Edit the command line

	call	edit		; 1 line editor
	cp	rcexec		; Return code in A
	jr	nz,errorh6c	; Abort or skip

noedit:				; Entry point to invoke transient <crw>
	ld	hl,line		; Load edited command line and go
	call	PUTCL
	jr	nz,ed_exit	; OK, line fits
	call	beep
	call	printc
	dc	'<CL OVFL>'
	jr	errorh6b	; Recycle now on ovfl

ed_exit:
	 if lsherr
	ld	a,(prefix)	; Test for null prefix
	or	a
	jr	z,ed_exit1	; Skip CSF test if so
; <crw>. .
	call	RETCST		; Z3LIB: return CST address in HL
	bit	4,(hl)		; Bit 4 signifies transient request
	res	4,(hl)		; Reset in case we are reinvoked
;	jp	nz,exit 	; Skip update if so
;. .<crw>
ed_exit1:
	call	z,fix_lsh	; Update LSH history file (See ZERRLSH.INC)
	 endif
	jp	exit


; Either an Abort or a Skip returned from the line editor
;
errorh6c:
	cp	rcabrt		; Abort code
	jp	z,abort
	ld	a,(delim)	; Get command delimiter again
	or	a
	jp	z,abort		; No more commands, must have meant abort
				; Else fall through to continue

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

; Skip over bad command and resume with next

skip:
	call	GETCL1		; Pt to command line buffer
	ld	de,(delimptr)	; De pts to bad command's delimiter
	inc	de		; Now pointing to next command
	ld	(hl),e		; Stuff address in
	inc	hl		; First two bytes
	ld	(hl),d		; Of multiple command line buffer

	call	printc
	dc	'Continuing...'
	jp	exit		; Resume command execution with next command

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

; Abort (flush) command line

abort:
	call	abortmsg	; Say "Cancel"
	call	GETZRUN		; See if zex is running
	jr	z,abort1	; Branch if not

; Deal with running ZEX script

	call	print
	dc	'     Cancel ZEX script (Y/N)? '

	call	getyesno	; Get user's answer
	call	z,PUTZRUN	; Abort zex

abort1:
	call	GETSRUN		; Is a submit job running?
	jr	z,abort2	; If not, return to command processor

; Deal with running SUBMIT job

	call	print
	dc	'     Cancel SUBMIT job (Y/N)? '

	call	getyesno	; Get user's answer
	call	z,HALTSUB	; Abort submit

abort2:
	jp	exit		; Back to command processor


; GETYESNO -- get yes/no answer from user

; Only 'Y' or 'y' accepted as affirmative answers.
; If 'Y', returns A=0 and Z.
; Echo response.

getyesno:
	call	capin		; Get user response
	cp	'Y'
	jr	nz,nomsg
abortmsg:
	call	printc
	dc	'Cancelled'
	xor	a
	ret
nomsg:
	call	print
	db	' No',cr,lf+80h
	xor	a
	dec	a
	ret
	


;----------------------------------------
; Prompt -- PRINT a DU/DIR prompt.
;  If BGii is running, print in upper or lower case for current task
;
prompt:
	call	printc
	dc	'[Error] '
	call	GDEFDU		; Get DU
	call	GETDUOK
	jr	z,nodu
	 if bgprompt
	call	bgtask		; Ret A = 0 if no BG or upper, 20h if lower
	add	a,'A'		; Conversion for drive number
	 else
	ld	a,'A'
	 endif
	add	a,b		; Drive
	call	conout
	ld	a,c		; User
	call	pafdc
nodu:	call	DUTDIR		; Get DIR
	ret	z		; Done if no name
	ld	a,':'		; Print DU:DIR divider char
	call	conout

; Print a NAME
prompt2:
	 if bgprompt
	call	bgtask
prompt0:
	ld	e,a		; 0 or 20h
	ld	b,8
prompt2a:
	ld	a,(hl)
	inc	hl
	cp	' '		; No blanks
	ret	z
	add	a,e
	call	conout
	djnz	prompt2a
	ret
	 else
prompt0:
	ld	b,8
prompt2a:
	ld	a,(hl)
	inc	hl
	cp	' '
	call	nz,conout
	djnz	prompt2a
	ret
	 endif	;BGprompt


; LSH interface code
;
	 if lsherr
	include	ZERRLSH.INC
	 endif



;=====================================================================
;
;		U T I L I T Y	R O U T I N E S
;
;=====================================================================

capin:	call	cin

ucase:
	and	7fh
	cp	' '
	jr	nc,caps
	add	a,'@'
caps:
	cp	'a'
	ret	c
	cp	'z'+1
	ret	nc
	and	5fh
	ret


; Convert user in A to decimal number
; If D = 0, then print it, else store it at DE
pafdc:
pusr:	ld	d,0
mafdc:
musr:
	ld	hl,10 shl 8 + '0'-1	; H=10, L='0'-1
	cp	h			; User < 10 ?
	jr	c,pusr1
pusr0:
	inc	l		; Advance character for user number tens digit
	sub	h
	jr	nc,pusr0
	add	a,h
	ld	h,a		; Keep low digit of user number in H
	ld	a,l		; Display tens digit
	call	pusr2
	ld	a,h		; Ready to process units digit
pusr1:
	add	a,'0'
pusr2:
	inc	d
	dec	d
	jp	z,conout
	ld	(de),a
	inc	de
	ret


; Print a text character in control format
ctlprint:
	cp	'['		; Special handling for ESC, TAB, DEL
	jr	z,ctlp1
	cp	'I'
	jr	z,ctlp2
	cp	7fh
	jr	z,ctlp3
	push	af
	call	print
	dc	'^'
	pop	af
	jr	conout

ctlp1:	call	print
	dc	'ESC'
	ret

ctlp2:	call	print
	dc	'TAB'
	ret

ctlp3:	call	print
	dc	'DEL'
	ret


beep:	ld	a,(beep_flag)
	or	a
	ret	z
	ld	a,7		; Print a beep
	jr	conout

crlf:	call	print		; Print a crlf
	db	cr,lf+80h
	ret


printc:
	call	crlf

; Print string following call (terminated with null or character with the
; high bit set)

print:
	ex	(sp),hl		; Get address
	call	printhl
	ex	(sp),hl		; Put address
	ret

; Print string pointed to by HL (terminated with null or character with the
; high bit set)

printhl:
	ld	a,(hl)		; Get next character
	inc	hl		; Point to following one
	or	a		; See if null terminator
	ret	z		; If so, we are done
	call	conout		; Display the character
	ret	m		; We are done if MSB is set (negative number)
	jr	printhl		; Back for more


;  Console input routine, no echo

cin:
	push	hl
	push	de
	push	bc
cin1:	ld	c,6
	ld	e,-1
	call	5
	or	a
	jr	z,cin1
	pop	bc
	pop	de
	pop	hl
	ret


;  Console Output Routine

conout:
	push	hl
	push	de
	push	bc
	push	af		; Save AF, too
	and	7fh		; Mask out MSB
	ld	e,a		; Transfer character to E
	ld	c,2		; BDOS conout function number
	call	5
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret



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

; Messages and Exits

header:	call	print
	dc	'Command Line Error:  '
	ret


idmsg:
	call	progmsg
	db	'  - Z34 Error Handler'
	db	cr,lf
	db	' Syntax:  ZERR            <-- Set error handler',cr,lf
	dc	'          ZERR <any>      <-- Remove error handler'
	jr	exit

quit_eh:
	call	progmsg
	dc	' Removed'
	call	GETERC
	ld	(hl),0

exit:
	ld	sp,(stack)
	ret


; Print program ID and in-line message
;
progmsg:
	ex	(sp),hl
	call	printid
	call	printhl
	ex	(sp),hl
	ret

printid:
	push	hl
	ld	hl,progid	; Program name
	xor	a
	call	prompt0		; Print without blanks

	 if lsherr
	 if fixlog
	call	print
	dc	' Fixed Log'
	 endif	;fixlog
	 endif	;lsherr
	
	call	print
	db	', Version ',vers/10+'0','.',vers mod 10+'0',rev+80h
	pop	hl
	ret



;=========================================================================
;		E R R O R   M S G S
;=========================================================================

	include	Z34ERR12.LIB

; Generate the table of pointers to the error messages
;
errstrs:
	ectable

; Generate the messages
;
	ecmsgs
;
;=========================================================================
;		D A T A
;=========================================================================

	dseg

stkspace	ds	60
stack		ds	2
delimptr	ds	2
delim		ds	2
line		ds	lbufwid+9

	end

; END ZERR.Z80