home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
ZSYS
/
SIMTEL20
/
ZCPR3
/
VMENUCK.MAC
< prev
next >
Wrap
Text File
|
2000-06-30
|
11KB
|
551 lines
;
; PROGRAM: VMENUCK
; AUTHOR: RICHARD CONN
; VERSION: 1.0
; DATE: 22 July 84
; PREVIOUS VERSIONS: None
; DERIVATION: MENUCK 1.0 (18 May 84)
;
VERS EQU 10 ;VERSION NUMBER
z3env SET 0f400h
;
; VMENUCK is used to check the syntax of a MENU.VMN file for the ZCPR3
; menu processor, VMENU. VMENU was optimized for size and runtime speed, and
; I tried to keep the size under 2K (and succeeded, for that matter). In
; keeping VMENU small, the error diagnostics it gives are quite limited, with
; a variety of errors producing the message "Str Err" for MENU.VMN
; structure error.
;
; VMENUCK is intended to be used to check the syntax and other features
; of a user's MENU.VMN before allowing VMENU to run with it. In this way,
; many errors may be caught before the MENU.VMN file comes into common use,
; and there is plenty of space for informative diagnostics.
;
;
; MENU Constants
;
MCMD EQU ':' ;Menu Jump Command
MINDIC EQU '#' ;Menu Indic
GOPTION EQU '-' ;Global Option Indic
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 'VMENUCK 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,' VMENUCK dir:filename.typ <-- Check File'
db cr,lf,' VMENUCK dir:filename <-- Check filename.VMN'
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 -- VMENU 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,'VMenu 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
cpi 'P' ;pointed-to file?
jz mcmd6
;
; 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:
push psw
call lprint
db ' Invalid Digit for F, N, or T Variable (not 1-4) - ',0
mcmd5:
pop psw
dcx h ;pt to invalid char
call cout
call newerr ;increment error count
jmp mcmd1
;
; Check for Pointed to File
;
mcmd6:
mov a,m ;get next char
inx h ;pt to next
ani 7fh ;mask
call caps
cpi 'F'
jz mcmd1
cpi 'N'
jz mcmd1
cpi 'T'
jz mcmd1
push psw ;save char
call lprint
db ' Invalid Pointed-to File Option (not F, N, or T) - ',0
jmp mcmd5 ;process error and back up ptr
;
; 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
cpi XOPTION ;only exit option allowed
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 'VMN'
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