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

;
;  PROGRAM:  MENUCK
;  AUTHOR:  RICHARD CONN
;  VERSION:  1.0
;  DATE:  18 May 84
;  PREVIOUS VERSIONS:  None
;  DERIVATION:  MCHECK 1.1 (6 Jan 83)
;
VERS	EQU	10	;VERSION NUMBER
z3env	SET	0f400h

;
;	MENUCK is used to check the syntax of a MENU.MNU file for the ZCPR3
; menu processor, MENU.  MENU was optimized for size and runtime speed, and
; I tried to keep the size under 2K (and succeeded, for that matter).  In
; keeping MENU small, the error diagnostics it gives are quite limited, with
; a variety of errors producing the message "Str Err" for MENU.MNU
; structure error.
;
;	MENUCK is intended to be used to check the syntax and other features
; of a user's MENU.MNU before allowing MENU to run with it.  In this way,
; many errors may be caught before the MENU.MNU file comes into common use,
; and there is plenty of space for informative diagnostics.
;

;
;  MENU Constants
;
MCMD	EQU	':'	;Menu Jump Command
RSM	EQU	'$'	;System Menu Indic
MINDIC	EQU	'#'	;Menu Indic
GOPTION	EQU	'-'	;Global Option Indic
COPTION	EQU	'C'	;Option chars
DOPTION	EQU	'D'
POPTION	EQU	'P'
XOPTION	EQU	'X'
VARFLAG	EQU	'$'	;Variable Flag

;
;  CP/M Constants
;
bentry	equ	5	;BDOS Entry
fcb	equ	5ch	;FCB
tbuff	equ	80h	;Temp I/O Buffer
cr	equ	0dh
lf	equ	0ah
EOF	equ	'Z'-'@'	;^Z=EOF

;
;  Externals
;
	ext	z3init,zfname,z3log

	ext	caps,crlf,eval10,retud
	ext	f$open,f$close,f$read
	ext	print,cout
	ext	moveb
	ext	phldc,padc,pfn2,pafdc
	ext	codend

;
; 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

	call	print
	db	'MENUCK  Version '
	db	(vers/10)+'0','.',(vers mod 10)+'0',0

	lda	fcb+1	;get first char
	cpi	' '	;no file name?
	jz	help
	cpi	'/'	;option?
	jnz	start1
;
;  Print Help Message
;
help:
	call	print
	db	cr,lf,'Syntax:'
	db	cr,lf,'  MENUCK dir:filename.typ <-- Check File'
	db	cr,lf,'  MENUCK dir:filename     <-- Check filename.MNU'
	db	0
	ret

;
;  Begin serious processing -- locate the file pted to by HL
;
start1:
	lxi	d,fcb		;pt to FCB
	call	z3log		;log into indicated FCB

;
;  Set File Type to MNU if not specified
;
start2:
	lxi	h,fcb+9		;pt to file type
	mov	a,m		;get first char
	cpi	' '		;set type if <SP>
	jnz	start3
	push	b		;save BC
	lxi	d,mnutyp	;set type to MNU
	xchg
	mvi	b,3		;3 bytes
	call	moveb
	pop	b		;get BC
;
;  Try to Open the File
;
start3:
	lxi	d,fcb		;prepare to open file
	xra	a		;A=0 to select current disk
	stax	d
	call	f$open		;open file
	jz	readfile	;read in file if OK
	call	print
	db	cr,lf,' File Not Found',0
	ret
;
;  Read in File
;
readfile:
	call	codend		;get address of first block
readloop:
	lxi	d,fcb		;read block
	call	f$read		;do it
	ora	a		;check for error
	jnz	readdone
	lxi	d,tbuff		;pt to block just read in
	mvi	b,128		;128 bytes
readmove:
	ldax	d		;get byte
	ani	7fh		;mask MSB
	mov	m,a		;put byte
	inx	h		;pt to next
	inx	d
	dcr	b		;count down
	jnz	readmove
	xchg			;DE pts to next block
	lhld	bentry+1	;get address of BDOS
	mov	a,h		;check for possible overflow
	sui	10		;10 pages below BDOS is limit
	cmp	d		;within range?
	xchg			;HL pts to next block
	jnc	readloop	;continue read if within range
	call	print
	db	cr,lf,' TPA Overflow -- MENU File is Too Big',0
	ret
;
;  Read is Done -- Store Ending ^Z and Set Initial Values
;
readdone:
	mvi	m,EOF	;Store ^Z to ensure EOF
	lxi	d,fcb		;Close File
	call	f$close
	mvi	a,0ffh		;A = -1
	sta	menunum		;set menu number
	sta	maxnum		;set max number of all menus
	lxi	h,0		;HL=0
	shld	errors		;Set Error Count to 0
	inx	h		;HL=1
	shld	linenum		;Set Line Number to 1
;
;  Count Number of Menus
;
	call	codend		;Pt to First Byte
	mov	a,m		;get first byte
;
;  Skip to Beginning of Menu Display
;
mdskip:
	cpi	EOF		;EOF?
	jz	mdone
	cpi	MINDIC		;beginning of display?
	jz	mcgo		;now go skip commands
	call	lskip		;skip to next line
	jmp	mdskip
mcgo:
	inx	h		;pt to char after MINDIC
	mov	a,m		;another MINDIC?
	cpi	MINDIC
	jz	mdone		;done if 2 in a row
	lda	maxnum		;get menu number count
	inr	a		;found another one
	sta	maxnum
mcskip:
	call	lskip		;skip to next line
	jz	mdone		;done if premature EOF
	cpi	MINDIC		;end of display?
	jnz	mcskip
	inx	h		;pt to char after MINDIC
	mov	a,m		;get it
	jmp	mdskip
;
;  Check for Valid First Character
;
mdone:
	call	print
	db	cr,lf,'Menu Syntax Check on ',0
	call	retud		;get dir
	mov	a,b		;get disk
	adi	'A'
	call	cout
	mov	a,c		;get user
	call	pafdc
	mvi	a,':'
	call	cout
	lxi	d,fcb+1		;pt to FCB
	call	pfn2
	call	print		;Print Header
	db	cr,lf
	db	cr,lf,' Line Comment/Error Message'
	db	cr,lf,' ---- ---------------------',0

	xra	a		;set no global option
	sta	gopt
	call	codend		;get address of first byte
	mov	a,m		;get first char
	cpi	GOPTION		;global options?
	jnz	newmenu		;process globals
	mvi	a,0ffh		;set global option
	sta	gopt
	call	lprint
	db	'** Global Options Detected **',0
	call	optchk		;check options
	xra	a		;set no global option
	sta	gopt
	call	nxtline		;advance to next line
;
;  This is the main entry point for processing a menu
;
newmenu:
	mov	a,m		;get Menu Indicator
	cpi	MINDIC		;must be MINDIC
	jz	nm1
	call	newerr		;add to error count
	call	lprint
	db	' New Menu Expected, But ',MINDIC,' NOT Found -- '
	db	'Aborting',0
	jmp	errxit
;
;  Print that we have a new menu
;
nm1:
	call	lprint
	db	'** Menu Number ',0
	lda	menunum		;increment menu number
	inr	a
	sta	menunum
	call	padc
	call	optchk		;check options
;
;  Skip Thru Display
;
nm2:
	call	nxtline		;skip to next line
	jnz	nm2a		;continue if no EOF
earlyeof:
	call	newerr		;add to error count
	call	lprint
	db	' Premature EOF Encountered',0
	jmp	errxit
nm2a:
	cpi	MINDIC		;Menu Indicator?
	jnz	nm2		;Continue
;
;  Move Thru Menu Commands
;
nm3:
	call	mcmd1		;check Menu Command Line
	jz	earlyeof
	call	lcheck		;check line
	cpi	MINDIC		;check for menu indicator
	jnz	nm3		;continue until menu indicator encountered
	inx	h		;check for 2 indicators in a row for end
	mov	a,m		;get 2nd char
	dcx	h		;back up in case it is not
	cpi	MINDIC		;2 in a row?
	jnz	newmenu		;process as new menu if not
errxit:
	call	lprint
	db	'** End of Menu Check **',cr,lf,'	',0
	lhld	errors		;check error count
	mov	a,h		;check for Zero
	ora	l
	jnz	err1
	call	print
	db	'No',0
	jmp	err2
err1:
	call	phldc		;print as decimal
err2:
	call	print
	db	' Errors Detected',0
	ret

;
;  Utilities
;

;
;  LPRINT -- Print "Line # "+text
;
lprint:
	call	crlf		;new line
	push	h		;save HL
	lhld	linenum		;get line number
	call	phldc		;print as decimal
	pop	h		;restore HL
	mvi	a,' '		;print <sp>
	call	cout
	jmp	print		;print text
;
;  NXTLINE -- Advance to next line, check for EOF, and increment Line Number
;  LSKIP -- Advance to next line and check for EOF
;	Return with HL pting to first char of next line and Z Set if EOF
;
nxtline:
	push	h		;increment line count
	lhld	linenum		;add 1
	inx	h
	shld	linenum
	pop	h		;fall thru to skipping
lskip:
	mov	a,m		;get char
	cpi	EOF		;EOF?
	rz
	inx	h		;pt to next
	cpi	lf		;line feed?
	jnz	lskip		;continue if not
	mov	a,m		;get first char of next line
	cpi	EOF		;check for EOF
	ret
;
;  MCMD1 -- Check Menu Line, check for EOF, and increment Line Number
;	Return with HL pting to first char of next line and Z Set if EOF
;
mcmd1:
	mov	a,m		;get char
	cpi	EOF		;EOF?
	jz	mcmdx
	inx	h		;pt to next
	cpi	VARFLAG		;variable?
	jz	mcmd2
	cpi	lf		;line feed?
	jnz	mcmd1		;continue if not
mcmdx:
	push	h		;increment line count
	lhld	linenum		;add 1
	inx	h
	shld	linenum
	pop	h		;fall thru to skipping
	mov	a,m		;get first char of next line
	cpi	EOF		;check for EOF
	ret
;
; Check Variable
;
mcmd2:
	mov	a,m		;get char
	ani	7fh		;mask
	call	caps		;capitalize
	inx	h		;pt to next
	cpi	VARFLAG		;OK if double VARFLAG
	jz	mcmd1
	cpi	'D'		;OK if D
	jz	mcmd1
	cpi	'U'		;OK if U
	jz	mcmd1
	cpi	'F'		;filename.typ?
	jz	mcmd3
	cpi	'N'		;filename?
	jz	mcmd3
	cpi	'T'		;filetype?
	jz	mcmd3
;
; Invalid Variable
;
	dcx	h		;pt to previous (bad char)
	push	psw		;save char
	call	lprint
	db	' Variable Error (Not $, D, U, F, N, or T) - ',0
	pop	psw		;get char
	call	cout		;print it
	call	newerr		;increment error count
	jmp	mcmd1
;
; Digit from 1 to 4 should follow
;
mcmd3:
	mov	a,m		;get next char
	inx	h		;pt to next
	ani	7fh		;mask and cap
	call	caps
	cpi	'1'		;must be from 1 to 4
	jc	mcmd4
	cpi	'5'
	jc	mcmd1
;
; Invalid Digit
;
mcmd4:
	dcx	h		;pt to offending char
	push	psw
	call	lprint
	db	' Invalid Digit for F, N, or T Variable (not 1-4) - ',0
	pop	psw
	call	cout
	call	newerr		;increment error count
	jmp	mcmd1

;
;  OPTCHK -- Check Line Pted to by HL for Valid GOPTION and MINDIC options
;	Do Not Affect HL
;	Print Error Message and Character if Invalid Option Found
;
optchk:
	push	h		;save HL
	push	b
	inx	h		;skip indicator
optclp:
	mov	a,m		;get char
	call	caps		;capitalize
	inx	h		;pt to next
	cpi	cr		;EOL?
	jz	optcdn
	mov	b,a		;char in B
	lda	gopt		;global option?
	ora	a		;0=no
	mov	a,b		;get char
	jnz	optcl1		;skip RSM test if it is global
	cpi	RSM		;System Menu?
	jz	optclp
optcl1:
	cpi	COPTION		;check options
	jz	optclp
	cpi	DOPTION
	jz	optclp
	cpi	POPTION
	jz	optclp
	cpi	XOPTION
	jz	optclp
	call	newerr		;increment error count
	call	lprint
	db	' Invalid Option: ',0
	mov	a,b		;get char
	call	cout		;print char
	jmp	optclp
optcdn:
	pop	b
	pop	h		;restore ptr
	ret
;
;  Increment Error Count
;
newerr:
	push	h	;save HL
	lhld	errors	;increment error count
	inx	h
	shld	errors
	pop	h	;restore HL
	ret
;
;  Check Line, especially looking for Menu Jump
;
lcheck:
	push	h	;save ptr to first char
	inx	h	;pt to 2nd char
	mov	a,m	;get it
	cpi	MCMD	;menu jump?
	jnz	lchk1
	inx	h	;pt to menu number
	call	eval10	;convert to binary in DE
	mov	a,d	;D must be 0
	ora	a	;check
	jz	lchk0
lchker:
	call	newerr	;increment error count
	call	lprint
	db	' Menu Number Out of Range',0
	jmp	lchk1
lchk0:
	lda	maxnum	;get max menu number
	cmp	e	;check for range
	jc	lchker
lchk1:
	pop	h	;restore ptr
	mov	a,m	;get first char in line
	ret
;
;  Skip HL over Blanks
;
sblank:
	mov	a,m	;get char
	inx	h	;pt to next
	cpi	' '	;blank?
	jz	sblank	;continue skipping
	dcx	h	;pt to non-blank
	ret

;
;  Buffers
;
mnutyp:
	db	'MNU'
errors:
	ds	2	;error count
linenum:
	ds	2	;current line number
menunum:
	ds	1	;current menu number
maxnum:
	ds	1	;max menu number
gopt:
	ds	1	;global option flag

	end