;
;  PROGRAM:  PATH
;  VERSION:  3.0
;  AUTHOR:  RICHARD CONN
;  DATE:  12 Apr 84
;  PREVIOUS VERSIONS:  NONE
;  DERIVATION:  PATH, Version 1.0 (for ZCPR2) of 12 Jan 83
;
VERS	EQU	30
z3env	SET	0f400h

;
;	PATH allows the user to do two things -- display the current path
; and set a new path.  Named directories may be used in the definition of
; the new path.
;
;	PATH is invoked by the following forms:
;		PATH			<-- Display Path
;		PATH path-expression	<-- Set Path
;		PATH //			<-- Print Help
;

;
;  CP/M Constants
;
cpm	equ	0	;base
fcb	equ	cpm+5ch
tbuff	equ	cpm+80h
cr	equ	0dh
lf	equ	0ah

;
;  SYSLIB Routines
;
	ext	z3init,eprint,codend,dirtdu,dutdir
	ext	cout,epstr,pafdc,retud
	ext	getpath,getmdisk,getmuser,getwhl

;
; 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 Env and the VLIB Env
	lxi	h,0	;save stack ptr
	dad	sp
	shld	strtstack	; save ptr to original stack
	lxi	h,tbuff+1	; pt to command line input
	shld	cmdline	; save ptr to command line
	call	retud	; get current disk and user
;
;  Print Banner
;
	call	eprint
	db	'PATH  Version '
	db	vers/10+'0','.',(vers mod 10)+'0',0

;
;  Check for Help
;
	lda	fcb+1	; get first char
	cpi	'/'	; help?
	jnz	start1
	call	eprint
	db	cr,lf,'Syntax:'
	db	cr,lf,'  PATH       <-- Display Path'
	db	cr,lf,'  PATH expr  <-- Set Path'
	db	0
	ret

;
;  Check for Error and Continue if not
;
start1:
	call	getpath	; external path available?
	mov	a,h	; HL=0 if none
	ora	l
	jnz	start2
	call	eprint
	db	' - Abort: No Path',0
	ret
start2:
	call	getwhl	; check for wheel
	jnz	start3
	call	eprint
	db	' - Abort: No Wheel',0
	ret
start3:
	lhld	cmdline	; check command line for text
	call	sblank	; skip to non-blank
	shld	cmdline	; set ptr to next element
	ora	a	; EOL=display function
	jz	pdisp
	call	codend	; set temporary path
	shld	pathptr	; point to it

;
;  **** Set New Path ****
;	CMDLINE pts to next element
;
pbuild:
	lhld	cmdline	; pt to next element
	call	sblank	; skip to non-blank
	mov	a,m	; get first char of next element
	ora	a	; EOL?
	jz	pbdone	; done if so, store path and display
	shld	token	; save ptr to first byte
	mov	a,m	; get first char
	cpi	'$'	; is it current?
	jz	pbdu	; DU: form
	sui	'A'	; convert to number
	jc	pbdir	; DIR: form
	mov	b,a	; save number
	call	getmdisk	; get max disk number
	mov	c,a
	mov	a,b
	cmp	c	; in range?
	jnc	pbdir	; DIR: form if not
	inx	h	; pt to next char -- may be DU or DIR
	mov	a,m	; get next part of element
	cpi	'$'	; current?
	jz	pbdu	; is a DU: form
digtst:
	cpi	':'	; colon ends it
	jz	pbdu	; is a DU: form
	cpi	' '	; space ends it
	jz	pbdu
	ora	a	; EOL ends it
	jz	pbdu
	cpi	'0'	; must be a digit
	jc	pbdir	; DIR: form if not in range
	cpi	'9'+1
	jnc	pbdir
	inx	h	; pt to next
	mov	a,m	; get it
	jmp	digtst
;
;  It is a DU: form
;
pbdu:
	lhld	pathptr	; pt to path entry
	xchg		; ... in DE
	lhld	token	; pt to token
	mov	a,m	; current?
	cpi	'$'
	jz	pbdu1
	sui	'A'-1	; convert to number from 1 to n
pbdu1:
	stax	d	; save disk element
	inx	h	; pt to next
	inx	d
	mov	a,m	; current user?
	inx	h	; pt to after user in case of match to current
	cpi	'$'	; current?
	jz	pbdu2
	dcx	h	; pt to first digit
	push	d	; save ptr to path
	call	eval10	; convert to number in C
	jc	rangerr
	call	getmuser	; check for max user
	inr	a
	mov	b,a	; place max in B
	mov	a,c	; value in A
	cmp	b
	jnc	rangerr
	pop	d	; get ptr to path
pbdu2:
	stax	d	; store user number
	inx	d
	mov	a,m	; ending with colon?
	cpi	':'
	jnz	pbdu3
	inx	h	; skip over colon
pbdu3:
	shld	cmdline	; save ptr to next command line entry
	xchg
	shld	pathptr	; save ptr to next path entry
	jmp	pbuild	; continue processing
;
;  Build DIR: form
;
pbdir:
	lhld	token	; pt to name
	call	dirtdu	; convert to DU in BC
	jnz	gotud	; process new DU
;
;  Entry not found
;
rangerr:
	call	eprint
	db	cr,lf,'Bad Expression at ',0
	lhld	token	; print string starting at token
	call	epstr
	lhld	strtstack	; get original stack
	sphl			; set stack ptr
	ret
;
;  Got User and Disk -- Store in Path
;
gotud:
	lhld	pathptr	; get ptr to path
	inr	b	; disk A = 1
	mov	m,b	; store disk
	inx	h
	mov	m,c	; store user
	inx	h	; pt to next
	shld	pathptr
	lhld	token	; skip over token
gotud1:
	mov	a,m	; skip to space or EOL
	inx	h	; pt to next
	ora	a	; EOL?
	jz	gotud2
	cpi	' '	; space?
	jnz	gotud1
gotud2:
	dcx	h	; pt to EOL or space
	shld	cmdline	; set ptr to next element
	jmp	pbuild	; continue building
;
;  Path Building is Done -- CODEND contains new path
;
pbdone:
	lhld	pathptr	; store ending zero in path
	mvi	m,0
	call	getpath	; pt to path
	xchg		; ... in DE
	call	codend	; copy temp path into external path
pcopy:
	mov	a,m	; get disk
	stax	d	; put disk
	ora	a	; end of path?
	jz	pdisp	; done if so and display
	inx	h	; pt to user
	inx	d
	mov	a,m	; get user
	stax	d	; put user
	inx	h	; pt to next disk
	inx	d
	jmp	pcopy

;
;  **** Display Path Function ****
;
pdisp:
	call	eprint
	db	cr,lf,' Symbolic Form: ',0
	call	getpath	; pt to external path
pdisp1:
	mov	a,m	; get disk
	ora	a	; done?
	jz	adisp
	cpi	'$'	; current?
	jz	pdisp2
	adi	'@'	; convert to letter
pdisp2:
	call	cout	; print disk letter
	inx	h	; pt to user
	mov	a,m	; get user number
	cpi	'$'	; current?
	jnz	pdisp3
	call	cout	; print current indicator
	jmp	pdisp4
pdisp3:
	call	pafdc	; print user number
pdisp4:
	call	colon
	inx	h	; pt to next element
	mov	a,m	; done?
	ora	a	; 0=yes
	cnz	arrow
	jmp	pdisp1
;
;  Print Absolute Path
;
adisp:
	call	eprint
	db	cr,lf,' DU Form:       ',0
	call	retud	; get current user/disk
	call	getpath	; pt to path
adisp1:
	mov	a,m	; get disk
	ora	a	; done?
	jz	ndisp
	cpi	'$'	; current?
	jnz	adisp2
	mov	a,b	; get current disk
	inr	a	; adjust to 1 to n
adisp2:
	adi	'@'	; convert to letter
	call	cout	; print disk letter
	inx	h	; pt to user
	mov	a,m	; get user
	cpi	'$'	; current?
	jnz	adisp3
	mov	a,c	; get current user
adisp3:
	call	pafdc	; print user
	call	colon
	inx	h	; pt to next
	mov	a,m	; done?
	ora	a
	cnz	arrow
	jmp	adisp1
;
;  Print Named Path
;
ndisp:
	call	eprint
	db	cr,lf,' DIR Form:      ',0
	call	getpath	; pt to external path
ndisp1:
	call	retud	; get current user and disk in C and B
	mov	a,m	; get disk
	ora	a	; done?
	rz
	cpi	'$'	; current?
	jz	ndisp2
	mov	b,a	; disk in B
	dcr	b	; adjust to 0 to n-1
ndisp2:
	inx	h	; pt to user
	mov	a,m	; get it
	cpi	'$'	; current?
	jz	ndisp3
	mov	c,a	; user in C
ndisp3:
	inx	h	; pt to next
	push	h	; save ptr
	call	udscan	; scan dirs for user/disk and print its name
	pop	h	; get ptr
	call	colon
	mov	a,m	; done?
	ora	a
	cnz	arrow
	jmp	ndisp1

;
;  **** Utilities ****
;

;
;  Convert Chars pted to by HL to Number in C
;    Return with Carry Set if Overflow
;    If OK, Value in C and HL pts to character after last digit
;
eval10:
	mvi	c,0	; set value
eval1:
	mov	a,m	; get first digit
	sui	'0'	; convert to binary
	jc	evalx	; done with value in C
	cpi	10	; range?
	jnc	evalx	; done with value in C
	mov	b,a	; digit in B
	mov	a,c	; multiply by 10
	add	a	; *2
	rc		; error abort
	add	a	; *4
	rc
	add	c	; *5
	rc
	add	a	; *10
	rc
	add	b	; add value
	rc
	mov	c,a	; value in C
	inx	h	; pt to next
	jmp	eval1
evalx:
	ora	a	; clear carry flag
	ret

;
;  Print Colon
;
colon:
	mvi	a,':'	; print colon
	jmp	cout

;
;  Print Arrow
;
arrow:
	call	eprint
	db	' --> ',0
	ret

;
;  Skip to non-blank
;
sblank:
	mov	a,m	; get char
	inx	h	; pt to next
	cpi	' '	; space?
	jz	sblank
	dcx	h	; pt to non-blank
	ret
;
;  Scan directories for user and disk in C and B
;	Print name if found or "Noname" if not
;
udscan:
	call	dutdir	; convert to name
	jz	udscan1	; error return if no name
	mvi	b,8	; 8 chars max
udsprn:
	mov	a,m	; get name char
	cpi	' '	; done?
	rz
	call	cout	; print char
	inx	h	; pt to next
	dcr	b	; count down
	jnz	udsprn
	ret
udscan1:
	call	eprint
	db	'Noname',0
	ret

;
;  Buffers
;
cmdline:
	ds	2	; ptr to next char in command line
token:
	ds	2	; ptr to current token
pathptr:
	ds	2	; ptr to next path entry
strtstack:
	ds	2	; ptr to original stack

	end