;
; Program: ERROR1
; Author: Richard Conn
; Version: 1.0
; Date: 5 Mar 84
;
version	equ	10

;
;	This error handler displays the error line to the user and
; provides him with four options as to how to process this line:
;		1. Replace the command in error with a new command
;		2. Skip the command in error and resume execution
;			with the next command
;		3. Replace the command line as it now stands
;		4. Throw away the command line and resume user
;			control
;
;	This program is transportable from one ZCPR3 system to another
; provided it is reassembled with the correct address for the ZCPR3
; Environment Descriptor (Z3ENV) or DDT is used to patch this address
; (which is the first two bytes after the opening JMP).  If an external
; ZCPR3 Environment Descriptor is not available, one will have to be
; provided by setting the Z3ENV equate to 0 and providing SYSENV.LIB in
; the current directory at assembly time.
;

;
; Equates for Key Values
;
z3env	SET	0f400h	;address of ZCPR3 environment
cmtch	equ	';'	;comment character
cr	equ	0dh
lf	equ	0ah

;
; External Z3LIB and SYSLIB Routines
;
	ext	z3init
	ext	print,pstr,codend,capine,bbline,crlf,moveb
	ext	erradr,puter1,puterc		;Error Handler Routines
	ext	qprint				;Quiet Mode Prints
	ext	getefcb,getcl1,qerror		;Z3 Messages et al

;
; Environment Definition
;
	if	z3env ne 0
;
; External ZCPR3 Environment Descriptor
;
	jmp	start
	db	'Z3ENV'	;This is a ZCPR3 Utility
	db	1	;External Environment Descriptor
z3eadr:
	dw	z3env
start:
	lhld	z3eadr	;pt to ZCPR3 environment
;
	else
;
; Internal ZCPR3 Environment Descriptor
;
	MACLIB	Z3BASE.LIB
	MACLIB	SYSENV.LIB
z3eadr:
	jmp	start
	SYSENV
start:
	lxi	h,z3eadr	;pt to ZCPR3 environment
	endif

;
; Start of Program -- Initialize ZCPR3 Environment
;
	call	z3init	;initialize the ZCPR3 Environment
;
; Print Banner
;
	call	qprint
	db	'ERROR1, Version '
	db	(version/10)+'0','.',(version mod 10)+'0'
	db	cr,lf,0
;
; Determine if Program Invoked as an Error Handler or By the User
;
	call	qerror	;error?
	jz	handler	;handle error
;
; Invoked by the User, so Install as an Error Handler
;
	call	getefcb		;pt to external FCB
	jz	start1		;proceed if external FCB not available
;
; Make Name Invoked by User the Name of the Error Handler
;
	inx	h		;pt to first char
	lxi	d,ername	;pt to name of error handler message
	mvi	b,8		;at most 8 bytes
	call	moveb		;copy into buffer
;
; Make Command Line in Buffer the Error Handler
;
start1:
	lxi	h,ername	;make name in buffer the error handler
	call	puterc		;set command
	mvi	a,0ffh		;set error code
	call	puter1		;set message
	call	print
	db	' Error Handler Installed',0
	ret
;
; Handle Error
;
handler:
	call	erradr		;get address of error line
	xchg			;HL pts to free area, DE pts to error line
	call	codend		;get ptr to free area
	shld	badcmd		;save ptr to bad command
;
; Extract Bad Command and Store It in Memory Starting at BADCMD
;	DE pts to bad command, HL pts to location to store it at
;
savebad:
	ldax	d		;get next char
	mov	m,a		;put it
	ora	a		;done?
	jz	sbad1
	cpi	cmtch		;check for comment
	jz	sbad1
	inx	h		;pt to next
	inx	d
	jmp	savebad
;
; Set ending 0 in bad command buffer and check for continuation
;
sbad1:
	mvi	m,0		;store ending zero
	inx	h		;pt to next
	cpi	cmtch		;more?
	jnz	sbad2
	inx	d		;pt to rest of command
sbad2:
	shld	restcmd		;save rest of command line
;
; Extract Rest of Command Line and Store It in Memory Starting at RESTCMD
;
saverest:
	ldax	d		;get next
	mov	m,a		;put it
	inx	h		;pt to next
	inx	d
	ora	a		;done?
	jnz	saverest
	shld	scratch		;save ptr to scratch area
;
; Prompt User for Action
;
prompt:
	call	print
	db	cr,lf,'Error Line is:',cr,lf,'   ',0
	call	erradr		;get address of error line
	call	pstr
	call	print
	db	cr,lf,cr,lf,'Options are: '
	db	cr,lf,' 1. Replace Command in Error with a New Command'
	db	cr,lf,'     Replace ',0
	lhld	badcmd
	call	pstr
	call	print
	db	cr,lf,' 2. Advance to Next Command and Resume Processing'
	db	cr,lf,'     Advance to ',0
	lhld	restcmd
	call	pstr
	call	print
	db	cr,lf,' 3. Replace Entire Line with a New Line'
	db	cr,lf,'     Replace ',0
	call	erradr		;pt to error line
	call	pstr
	call	print
	db	cr,lf,' 4. Throw Away Entire Line and Continue'
	db	cr,lf,'     Throw Away ',0
	call	erradr		;pt to error line
	call	pstr
	call	print
	db	cr,lf,cr,lf,'Select Option - ',0
	call	capine
	call	crlf
	cpi	'1'	;option 1
	jz	replace	;replace command in error
	cpi	'2'	;option 2
	jz	advance	;advance to next command
	cpi	'3'	;option 3
	jz	newline	;enter new line
	cpi	'4'	;option 4
	jz	flush	;throw away line
	call	print
	db	cr,lf,'Invalid Option - Retry',cr,lf,0
	jmp	prompt
;
; Replace Command in Error
;
replace:
	call	print
	db	'Replacement Command?',cr,lf,'  ',0
	lhld	restcmd	;pt to rest of command line in DE
	xchg
	mvi	a,0ffh	;capitalize
	call	bbline	;get line from user
	call	build	;build and run command
	jmp	prompt	;continue if error
;
; Advance to Rest of Command Line
;
advance:
	lhld	restcmd	;pt to it
	xchg
	lxi	h,empty	;HL pts to empty command, DE pts to tail
	call	build	;build and run command
	jmp	prompt	;continue if error
;
; Enter New Line
;
newline:
	call	print
	db	'New Command?',cr,lf,'  ',0
	mvi	a,0ffh	;capitalize
	call	bbline	;get line from user
	lxi	d,empty	;HL pts to user command, DE pts to empty command
	call	build	;build and run command
	jmp	prompt	;continue if error
;
; Flush Commands
;
flush:
	ret		;simply exit if no more commands
;
; Build New Command Line in SCRATCH Area and Run it by returning to ZCPR3
;   On input, HL pts to header, DE pts to tail
;
build:
	lxi	b,1	;set char count (1 for ending zero)
	push	d	;save ptr to tail
	push	h	;save ptr to header
	lhld	scratch	;pt to scratch area
	pop	d	;get ptr to header
	ldax	d	;get first char
	ora	a	;any there?
	cnz	copy	;copy line into buffer
	pop	d	;get ptr to tail
	ldax	d	;anything there?
	ora	a
	jz	bldt	;terminate build if not
	mvi	m,cmtch	;begin with semicolon
	inx	h	;pt to next
	call	copy
bldt:
	mvi	m,0	;store ending zero
;
; Store Command Line into MCL Buffer
;
	call	getcl1	;pt to command line
	cmp	c	;check for char count within range
	rc
	mov	a,b	;check for line too long
	ora	a	;line too long?
	rnz		;error if so
	lxi	d,4	;pt to first char
	push	h	;save ptr to current
	dad	d
	pop	d	;get ptr to current
	xchg		;DE pts to first char position, HL pts to CL buffer
	mov	m,e	;set address to resume processing
	inx	h
	mov	m,d
	lhld	scratch		;pt to new line
	xchg			;in DE, while HL pts to first char position
	call	copy		;copy it
	mov	m,a		;store ending zero
	pop	d		;clear stack
	ret			;resume processing
;
; Copy string pted to by DE into buffer pted to by HL
;
copy:
	ldax	d	;get next char
	ora	a	;done?
	rz
	mov	m,a	;store it
	inx	b	;increment count
	inx	h	;pt to next
	inx	d
	jmp	copy
;
; Buffers
;
ername:
	db	'ERROR1  ',0	;name of error handler
empty:
	db	0	;empty command line
badcmd:
	ds	2	;ptr to bad command extracted
restcmd:
	ds	2	;ptr to tail of bad command line
scratch:
	ds	2	;ptr to scratch area used to build new lines

	end