RomWBW/Source/Images/d_bp/u15/SHVAR.MAC

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

;
;	SHVAR is used to define a shell variable for the Shell SH.
; It makes entries into the file SH.VAR in the ROOT directory.  The
; syntax of its use is:
;		SHVAR variable text	<-- define/redefine variable
;		SHVAR variable		<-- delete variable
;		SHVAR			<-- list variables
;

;
; Equates for Key Values
;
z3env	SET	0f400h	;address of ZCPR3 environment
backup	equ	0	;backup old file? 1 for yes, 0 for no
ctrlz	equ	'Z'-'@'	;^Z for EOF
fcb	equ	5ch
tbuff	equ	80h
cr	equ	0dh
lf	equ	0ah

;
; External Z3LIB and SYSLIB Routines
;
	ext	cout,qcout,getquiet,sort,crlf
	ext	sksp,fillb,moveb
	ext	initfcb,f$open,f$read,f$close,f$make,f$delete,f$write,f$rename
	ext	z3init,qprint,codend,hmovb,root,logud,getwhl,print
	ext	getfn1,pfn1,cline

;
; 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
	call	banner	;print banner
;
; Check for Wheel
;
	call	getwhl	;get wheel byte
	jnz	start0
	call	print
	db	cr,lf,' Not Wheel - Aborting',0
	ret
;
; Try to Load Variables
;
start0:
;
; Check for Help
;
	lda	fcb+1	;get first char of FCB
	cpi	'/'	;also help?
	jnz	start0x
;
; Print Help Message
;
	call	print
	db	cr,lf,'SHVAR - Define/Redefine/Delete a Shell Variable'
	db	cr,lf,'Syntax:'
	db	cr,lf,'	SHVAR variable text	<-- to Define/Redefine'
	db	cr,lf,'	SHVAR variable		<-- to Delete'
	db	cr,lf,'	SHVAR			<-- to List Variable Names'
	db	0
	ret
;
; Define File to Work With
;
start0x:
	call	getfn1	;get name of shell
	lxi	d,shvfcb+1	;variable FCB
	mvi	b,11	;11 chars
	mov	a,m	;any name given?
	cpi	' '	;space if none
	cnz	moveb	;set name
;
; Define $$$ and BAK Files
;
	lxi	h,shvfcb+1
	lxi	d,shvtmp+1	;set $$$ name
	mvi	b,8		;8 chars
	call	moveb
;
	if	backup
	lxi	d,shvbak+1	;set BAK name
	call	moveb
	endif
;
;
; Save Command Line
;
	lxi	h,tbuff		;save line
	call	cline
	shld	lineptr		;set ptr to line
;
; Load Variables
;
	call	varload
	jnz	start1
;
; Initialize Shell Variables if File Not Found
;
	call	print
	db	cr,lf,' Shell Variable File ',0
	lxi	d,shvfcb+1
	call	pfn1
	call	print
	db	' Not Found',0
	ret
;
; Process User Command
;
start1:
	lda	fcb+1	;check for list option
	cpi	' '	;no args = list
	jz	list
	call	doit	;process command
	call	varsave	;save new shell variables
	ret
;
; Print Names of Variables
;
list:
	call	lpack	;pack just names
	xchg		;set ptr to ptr table
	inx	h
	shld	ptrbuf	;ptr buffer for sort
	lhld	vcount	;run sort?
	mov	a,h
	ora	l
	cnz	lsort	;sort names
	call	print
	db	cr,lf,' Shell Variables --',cr,lf,0
	mvi	c,0	;set counter
	call	codend	;pt to first variable
	mov	a,m	;empty?
	cpi	ctrlz
	jnz	list1
	call	print
	db	'  -- No Variables Defined --',0
	ret
;
; Print Next Variable
;
list1:
	mov	a,m	;end of list?
	cpi	ctrlz
	jz	list3
	call	print
	db	'  ',0
	mvi	b,8	;print 8 chars
list2:
	mov	a,m	;get char
	inx	h	;pt to next
	call	cout	;print it
	dcr	b	;count down
	jnz	list2
	inr	c	;increment count
	mov	a,c	;new line?
	ani	3
	cz	crlf
	jmp	list1
list3:
	mov	a,c	;new line to end?
	ani	3
	cnz	crlf
	ret
;
; Sort Variables
;
lsort:
	call	codend	;pt to first variable
	shld	ssb	;set ptr
	lxi	d,ssb	;pt to SSB
	jmp	sort	;perform sort
;
; Compare Routine
;
compare:
	push	h	;save regs
	push	d
	push	b
	mvi	b,8	;8 chars
comp1:
	ldax	d	;get char
	cmp	m	;compare
	jnz	comp2
	inx	h	;pt to next
	inx	d
	dcr	b	;count down
	jnz	comp1
comp2:
	pop	b	;restore regs
	pop	d
	pop	h
	ret

;
; Pack Variables Down to a Minimum (Just 8-char Names)
;
lpack:
	lxi	h,0	;set count
	shld	vcount
	call	codend	;pt to first variable
	mov	d,h	;DE=HL
	mov	e,l
lpack1:
	mov	a,m	;get next char
	stax	d	;set possible EOF
	cpi	ctrlz	;done?
	rz
	push	h	;increment variable count
	lhld	vcount
	inx	h
	shld	vcount
	pop	h
	mvi	b,8	;save 8 chars
lpack2:
	mov	a,m	;get next char
	stax	d	;store it
	inx	h	;pt to next
	inx	d
	dcr	b	;count down
	jnz	lpack2
lpack3:
	mov	a,m	;skip to next variable
	inx	h
	ora	a	;done?
	jnz	lpack3
	jmp	lpack1	;resume
;
; Input and Process User Commands
;
doit:
	call	nadd	;add/delete/redefine variable
;
; Pack Names
;
pack:
	call	codend	;pack entries in table
	mov	d,h	;HL=DE
	mov	e,l
;
; Check Next Entry
;
pack1:
	mov	a,m	;get next char
	stax	d	;put it
	cpi	ctrlz	;done?
	rz
	cpi	' '	;deleted?
	jz	pack3
;
; Copy Entry
;
pack2:
	mov	a,m	;get char
	stax	d	;put it
	inx	h	;pt to next
	inx	d
	ora	a	;done?
	jnz	pack2
	jmp	pack1	;resume
;
; Skip Entry
;
pack3:
	mov	a,m	;get char
	inx	h	;pt to next
	ora	a	;done?
	jnz	pack3
	jmp	pack1	;resume

;
; Add Names to Table
;
nadd:
	lhld	lineptr	;pt to user line
	call	sksp	;skip to first non-blank
	ora	a	;done?
	rz		;exit if no change
	call	qprint
	db	cr,lf,' Shell Variable ',0
;
; Copy Input Name into Shell Buffer SHVAR
;
	push	h	;save ptr to name
	lxi	h,shvar	;init name buffer
	mvi	a,' '	;space fill
	mvi	b,8	;8 chars
	call	fillb
	xchg		;pt to buffer in DE
	pop	h	;pt to name
	mvi	b,8	;8 chars max
nadd1:
	mov	a,m	;get name char
	call	delck	;check for delimiter
	jz	nadd3
	stax	d	;store char
	call	qcout	;print chars of variable name
	inx	h	;pt to next
	inx	d
	dcr	b	;count down
	jnz	nadd1
nadd2:
	mov	a,m	;flush to delimiter
	inx	h
	call	delck	;check for delimiter
	jnz	nadd2
	dcx	h	;pt to delimiter
;
; Search for Name
;
nadd3:
	shld	lineptr	;set ptr to rest of line
	call	codend	;pt to first element
;
; Check for End of Entries
;
nadd4:
	mov	a,m	;get first char of next string
	cpi	ctrlz
	jz	addit	;add name at HL
;
; Compare Names
;
	lxi	d,shvar	;pt to variable
	mvi	b,8	;compare
	shld	curname	;save ptr to current name in case of delete
nadd5:
	ldax	d	;check for duplicate
	cmp	m
	jnz	nadd6
	inx	h	;pt to next
	inx	d
	dcr	b	;count down
	jnz	nadd5
	jmp	nadd7
;
; No Match, so Skip Rest of String
;
nadd6:
	mov	a,m	;skip to end of string
	inx	h	;pt to next
	ora	a	;done?
	jnz	nadd6
	jmp	nadd4	;resume
;
; Match - Determine What User Wants to Do
;
nadd7:
	lhld	lineptr	;see if any text follows name
	call	sksp	;skip to text
	ora	a	;EOL?
	jz	delete	;delete name
;
; Redefine Name
;
	lhld	curname	;pt to name in buffer
	mvi	b,8	;space fill it
	mvi	a,' '
	call	fillb
	jmp	nadd6	;resume in case another duplicate
;
; Delete Name
;
delete:
	call	qprint
	db	' Deleted',0
	lhld	curname	;pt to name in buffer
	mvi	b,8	;space fill it
	mvi	a,' '
	call	fillb
	ret
;
; Add Name
;
addit:
	call	qprint
	db	' = ',0
	shld	curname	;save ptr to new name
	xchg		;dest in DE
	lxi	h,shvar	;pt to name
	mvi	b,8	;8 chars
	call	hmovb	;copy name into buffer
	xchg		;pt to after name with HL
	push	h	;save ptr
	mvi	m,0	;store ending 0 and ^Z in case of abort
	inx	h
	mvi	m,ctrlz	;store ^Z
	lhld	lineptr	;point to user text
	call	sksp	;skip to non-space
	pop	d	;pt to destination
;
; Copy User Input into Buffer
;
addit1:
	mov	a,m	;get char
	stax	d	;put char
	ani	7FH	;done?
	cnz	qcout	;print chars of definition
	inx	h	;pt to next
	inx	d
	ora	a	;done?
	jnz	addit1
	mvi	a,ctrlz	;mark end
	stax	d
	ret

;
; Print Banner
;
banner:
	call	qprint
	db	'SHVAR, Version '
	db	(version/10)+'0','.',(version mod 10)+'0'
	db	0
	ret
;
; Check to see if char in A is a delimiter
;	Return with Z if so
;
delck:
	push	h		;pt to table
	push	b		;save BC
	mov	b,a		;char in B
	lxi	h,dtable	;pt to delimiter table
delck1:
	mov	a,m		;get delimiter
	ora	a		;done?
	jz	notdel
	cmp	b		;compare
	jz	yesdel
	inx	h		;pt to next
	jmp	delck1
notdel:
	mov	a,b		;get char
	ora	a		;set Z if null, else NZ
yesdel:
	mov	a,b		;restore char
	pop	b		;restore regs
	pop	h
	ret

;
; Delimiter Table
;
dtable:
	db	'<>;:,.=-_ ',0

;
; Save Shell Variable List
;	Return with Z if Error
;
varsave:
	call	getquiet	;get quiet flag
	jnz	vars0
	call	print
	db	cr,lf,' Writing Shell Variable File ',0
	lxi	d,shvfcb+1
	call	pfn1		;print file name
vars0:
	lxi	d,shvtmp	;open temp
	call	initfcb
	call	f$delete	;delete if any exists
	call	f$make		;create new file
	inr	a		;error?
	rz
	call	codend		;pt to scratch area
;
; Save Loop
;
vars1:
	lxi	d,tbuff		;copy into buffer
	mvi	b,128		;128 bytes
	call	hmovb
	lxi	d,shvtmp	;write block
	call	f$write
	jnz	werr		;write error
	lxi	d,tbuff		;check for done
	mvi	b,128		;128 bytes
;
; Check for Done
;
vars2:
	ldax	d		;look for ^Z
	cpi	ctrlz
	jz	varsx
	inx	d		;pt to next
	dcr	b		;count down
	jnz	vars2
	jmp	vars1
;
; Done
;
varsx:
	lxi	d,shvtmp	;close temp file
	call	f$close
;
; Delete Old Backup File SH.BAK
;
	if	backup
;
	lxi	d,shvbak	;delete any old backups
	call	initfcb
	call	f$delete
;
; Create New Backup File SH.BAK=SH.VAR
;
	lxi	h,shvbak	;new name
	lxi	d,shvfcb	;old name
	call	f$rename	;create backup file
;
	else
;
; Delete Original File
;
	lxi	d,shvfcb	;pt to FCB
	call	initfcb
	call	f$delete
;
	endif		;backup
;
; Create New Shell Variable File SH.VAR=SH.$$$
;
	lxi	h,shvfcb	;new name
	lxi	d,shvtmp	;old name
	call	f$rename	;create new file
	xra	a		;return OK
	dcr	a		;NZ
	ret
;
; File Write Error
;
werr:
	call	print
	db	cr,lf,'Error in Writing File - Aborting',0
	xra	a		;error code
	ret

;
; Load Shell Variable List
;	Return with Z if Error
;
varload:
;
; Look for Variable File
;
	call	root		;determine DU of root
	call	logud		;goto root
	call	codend		;pt to scratch area
	mvi	m,ctrlz		;prep for no file
	lxi	d,shvfcb	;try to open file
	call	initfcb		;init FCB
	call	f$open
	rnz			;file not found
;
; Read in Variable File
;
varl1:
	lxi	d,shvfcb	;read in file
	call	f$read
	jnz	varl2
	lxi	d,tbuff		;pt to data
	xchg			;copy into memory
	mvi	b,128		;128 bytes
	call	hmovb
	xchg
	jmp	varl1
varl2:
	lxi	d,shvfcb	;close file
	call	f$close
;
; Say List is Already Loaded
;
	xra	a		;return NZ for OK
	dcr	a
	ret

;
; Buffers
;
lineptr:
	ds	2		;ptr to next char in line
curname:
	ds	2		;ptr to current variable name
shvar:
	ds	8		;shell variable name
;
	if	backup
shvbak:
	db	0
	db	'SH      '	;name of shell variable file
	db	'BAK'
	ds	24		;36 bytes total
	endif		;backup
;
shvtmp:
	db	0
	db	'SH      '	;name of shell variable file
	db	'$$$'
	ds	24		;36 bytes total
shvfcb:
	db	0
	db	'SH      '	;name of shell variable file
	db	'VAR'
	ds	24		;36 bytes total
;
; Sort Specification Block
;
ssb:
	ds	2		;address of first record
vcount:
	ds	2		;number of records to sort
	dw	8		;size of each record in bytes
	dw	compare		;compare routine
ptrbuf:
	ds	2		;address of pointer buffer
	dw	0ffh		;use pointers

	end