;
; Program: IF
; Author: Richard Conn
; Modified By: Charles McManis
; Version: 1.2
; Date: 11 Feb 85
; Previous Versions: 1.1 (22 Apr 84)
;
version equ 12
;
; IF is intended to be invoked from the IF routine in an FCP.
; This program implements the IF conditional tests and sets the next level
; of IF to be TRUE or FALSE.
;
; Modified on 02/11/85 to accept ambiguous file names and match them. This
; allows aliases to add file extensions if they are needed, for instance
; if there is an alias LDIR that gets a directory of an .LBR file, it
; previously had to be defined as an example :
;
;
;
; 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
jmp ifstart
;
; Condition Table
;
condtab:
db 'T ' ;TRUE
dw ifctrue
db 'F ' ;FALSE
dw ifcfalse
db 'EM' ;file empty
dw ifcempty
db 'ER' ;error message
dw ifcerror
db 'EX' ;file exists
dw ifcex
db 'IN' ;user input
dw ifcinput
db 'NU' ;null argument
dw ifcnull
db 'TC' ;Z3TCAP Entry Loaded
dw ifctcap
db 'WH' ;Wheel Byte
dw ifcwheel
db 0
;
; FCP Extension Command: IF
;
ifstart:
;
; Advance to Next Line if Noisey
;
IF NOISE
mvi a,lf
call cout
ENDIF ;NOISE
;
; Test for Equal Sign in Line and Process FCB1=FCB2 form if so
;
lxi h,tbuff+1 ;pt to buffer
ifteq:
mov a,m ;look for =
inx h ;pt to next
ora a ;done if EOL
jz ifck0
cpi '=' ;equal?
jnz ifteq
lxi h,fcb1+1 ;= found, so compare FCB1 and FCB2
lxi d,fcb2+1
mvi b,11 ;11 chars
ifteq1:
ldax d ;compare
; ** Such a small change really.
cpi '?' ; see if an AFN was specified
jz okchar ; always match a ?
mov c,a ; save it in C temporarily
mov a,m ; get the other character
cpi '?' ; see if it is a ?
jz okchar ; if so accept it as a match
cmp c
; ** This allows IF $1=* and IF $1=*.?q? etc
; cmp m ; this guy is no longer needed.
jnz ifcf ;FALSE if no match
okchar:
inx h ;advance
inx d
dcr b ;count down
jnz ifteq1
jmp ifct ;TRUE if match
;
; Test Condition in FCB1 and file name in FCB2
; Execute condition processing routine
;
ifck0:
lxi d,fcb1+1 ;pt to first char in FCB1
ldax d ;get it
cpi '/' ;help?
jz ifhelp
cpi ' ' ;also help
jz ifhelp
sta negflag ;set negate flag
cpi negchar ;is it a negate?
jnz ifck1
inx d ;pt to char after negchar
ifck1:
call regtest ;test for register value
jnz runreg
call condtest ;test of condition match
jnz runcond ;process condition
IF NOISE
call print
db ' No IF Condition Given',0
ret
ELSE ;NOT NOISE
mvi a,bel
jmp cout
ENDIF ;NOISE
;
; Print Help Message
;
ifhelp:
IF NOT NOISE
mvi a,lf ;leading new line
call cout
ENDIF ;NOT NOISE
call print
db 'IF, Version '
db (version/10)+'0','.',(version mod 10)+'0'
db ' - Conditional Test'
db cr,lf,'Syntax:'
db cr,lf,' IF condition arguments -or- IF ~condition arguments'
db cr,lf,'where a leading "~" negates the effect of the '
db 'IF Condition'
db cr,lf,'Possible IF Conditions are:'
db cr,lf,' T Always TRUE'
db cr,lf,' F Always FALSE'
db cr,lf,' EMPTY <file list> T if Files are Empty'
db cr,lf,' ERROR T if Error Flag Set'
db cr,lf,' EXIST <file list> T if Files Exist'
db cr,lf,' INPUT T if User Hits T, Y, CR, or SP'
db cr,lf,' NULL arg T if No Arg Follows'
db cr,lf,' TCAP T if ZCPR3 TCAP Available'
db cr,lf,' WHEEL T if Wheel Byte Set'
db cr,lf,' reg value T if Register reg = value'
db cr,lf,' fcb1=fcb2 T if the Two FCB values are ='
db cr,lf,'Only first 2 letters of keywords are required'
db cr,lf,'The leading "~" is effective with all conditions except'
db ' fcb1=fcb2'
db 0
ret
;
; Process register - register value is in A
;
runreg:
push psw ;save value
call getnum ;extract value in FCB2 as a number
pop psw ;get value
cmp b ;compare against extracted value
jz ifctrue ;TRUE if match
jmp ifcfalse ;FALSE if non-match
;
; Process conditional test - address of conditional routine is in HL
;
runcond:
pchl ;"call" routine pted to by HL
;
; Condition: NULL (2nd file name)
;
ifcnull:
lda fcb2+1 ;get first char of 2nd file name
cpi ' ' ;space = null
jz ifctrue
jmp ifcfalse
;
; Condition: TCAP
;
ifctcap:
call getenv ;get ptr to ZCPR3 environment descriptor
lxi d,80h ;pt to TCAP entry
dad d
mov a,m ;get first char
cpi ' '+1 ;space or less = none
jc ifcfalse
jmp ifctrue
;
; Condition: WHEEL
;
ifcwheel:
call getenv ;get ptr to ZCPR3 environment descriptor
lxi d,29h ;pt to Wheel Byte address
dad d
mov a,m ;get low
inx h
mov h,m ;get high
mov l,a ;put low
mov a,m ;get Wheel Byte
ora a ;0=not wheel
jz ifcfalse
jmp ifctrue
;
; Condition: TRUE
; IFCTRUE enables an active IF
; Condition: FALSE
; IFCFALSE enables an inactive IF
;
ifctrue:
call negtest ;test for negate
jz ifcf ;make IF FALSE
ifct:
IF NOISE
call print
db ' IF T',0
ENDIF ;NOISE
call ift ;make IF TRUE
rnz
jmp ifovfl
ifcfalse:
call negtest ;test for negate
jz ifct ;make IF TRUE
ifcf:
IF NOISE
call print
db ' IF F',0
ENDIF ;NOISE
call iff ;make IF FALSE
rnz
ifovfl:
IF NOISE
call print
db ' IF Overflow',0
ret
ELSE ;NOT NOISE
mvi a,bel
jmp cout
ENDIF ;NOISE
;
; Condition: EXIST filename.typ
; List of Files Permitted
;
ifcex:
call skip2 ;skip to 2nd token
jz ifctrue ;declare TRUE if none
;
; Extract Next File
;
ifcex1:
lxi d,fcb1 ;pt to FCB
call zfname ;convert text
push h ;save ptr to next char
;
; Log Into to DU and Search for File
;
call tlog ;log into DU
lxi d,fcb1 ;pt to fcb
mvi c,17 ;search for first
call bdos
inr a ;set zero if error
;
; Abort as FALSE if File Not Found
;
pop h ;get ptr to next char
jz ifcfalse
;
; Advance to Next File, if Any
;
mov a,m ;more to follow?
inx h
cpi ','
jz ifcex1
;
; All Files Exist if No More Files
;
jmp ifctrue ;all found, so TRUE
;
; Condition: EMPTY filename.typ
;
ifcempty:
call skip2 ;skip to 2nd token
jz ifctrue ;TRUE if none
;
; Select Next File
;
ifcem1:
lxi d,fcb1 ;pt to FCB1
call zfname ;convert
push h ;save ptr to next
;
; Log into DU and Try to Open File
;
call tlog ;log into FCB1's DU
lxi d,fcb1 ;pt to fcb1
mvi c,15 ;open file
push d ;save fcb ptr
call bdos
pop d
inr a ;not found?
;
; File is Empty if Not Found
;
jz ifemt
;
; Try to Read one Record from File
;
mvi c,20 ;try to read a record
call bdos
ora a ;0=OK
;
; File is Empty if Can't Read Record
;
jnz ifemt ;NZ if no read
pop h ;file not empty
;
; File Exists and Contains Something
;
jmp ifcfalse ;so EMPTY condition is FALSE
;
; File is Empty - Advance
;
ifemt:
pop h ;pt to next char
mov a,m ;get next char
inx h
cpi ',' ;more to come?
jz ifcem1
;
; Done and True if No More Files - All are Empty
;
jmp ifctrue ;all empty, so TRUE
;
; Save TBUFF and skip to 2nd token
;
skip2:
lxi d,tbuff+1 ;pt to first char
call codend ;pt to free area
skip2a:
ldax d ;get next char
mov d
ora a ;done?
jnz skip2a
call codend ;skip over spaces
call sksp
call sknsp ;skip over 1st token
call sksp ;skip over spaces
mov a,m ;get 1st char of 2nd token
ora a ;return with Z if none
ret
;
; Convert chars in FCB2 into a number in B
;
getnum:
lxi h,fcb2+1 ;pt to first char
call eval10 ;evaluate
mov b,a ;value in B
ret
;
; Log into DU in FCB1
;
tlog:
lda fcb1 ;get disk
ora a ;current?
jnz tlog1
mvi c,25 ;get disk
call bdos
inr a ;increment for following decrement
tlog1:
dcr a ;A=0
mov e,a ;disk in E
mvi c,14
call bdos
lda fcb1+13 ;pt to user
mov e,a
mvi c,32 ;set user
jmp bdos
;
; Test of Negate Flag = negchar
;
negtest:
lda negflag ;get flag
cpi negchar ;test for No
ret
;
; Test FCB1 against a single digit (0-9)
; Return with register value in A and NZ if so
;
regtest:
ldax d ;get digit
sui '0'
jc zret ;Z flag for no digit
cpi 10 ;range?
jnc zret ;Z flag for no digit
mov b,a ;register number in B
call getreg ;get register value
mov b,a ;save value
xra a ;set NZ
dcr a
mov a,b ;get register value
ret
zret:
xra a ;set Z
ret
;
; Test FCB1 against condition table (must have 2-char entries)
; Return with routine address in HL if match and NZ flag
;
condtest:
lxi h,condtab ;pt to table
condt1:
mov a,m ;end of table?
ora a
rz
ldax d ;get char
mov b,m ;get other char in B
inx h ;pt to next
inx d
cmp b ;compare entries
jnz condt2
ldax d ;get 2nd char
cmp m ;compare
jnz condt2
inx h ;pt to address
mov a,m ;get address in HL
inx h
mov h,m
mov l,a ;HL = address
xra a ;set NZ for OK
dcr a
ret
condt2:
lxi b,3 ;pt to next entry
dad b ; ... 1 byte for text + 2 bytes for address
dcx d ;pt to 1st char of condition
jmp condt1
