mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
542 lines
10 KiB
542 lines
10 KiB
;
|
|
; 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 :
|
|
;
|
|
;
|
|
|
|
;
|
|
; Equates for Key Values
|
|
;
|
|
z3env SET 0f400h ;address of ZCPR3 environment
|
|
noise equ 0 ;set to 1 for noisey (message) operation
|
|
negchar equ '~' ;negation prefix char
|
|
bdos equ 5
|
|
fcb1 equ 5ch
|
|
fcb2 equ 6ch
|
|
tbuff equ 80h
|
|
cr equ 0dh
|
|
lf equ 0ah
|
|
bel equ 07h
|
|
|
|
;
|
|
; External Z3LIB and SYSLIB Routines
|
|
;
|
|
ext z3init,strtzex,stopzex,geter1,getreg,ift,iff,getenv
|
|
ext eval10,print,capine,codend,sksp,sknsp,zfname,cout
|
|
|
|
;
|
|
; 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: INPUT (from user)
|
|
;
|
|
ifcinput:
|
|
IF NOT NOISE
|
|
mvi a,lf ;new line
|
|
call cout
|
|
ENDIF ;NOT NOISE
|
|
call stopzex ;suspend ZEX input
|
|
call print
|
|
db ' IF True? ',0
|
|
call capine
|
|
call strtzex ;resume ZEX input
|
|
cpi 'T' ;true?
|
|
jz ifctrue
|
|
cpi 'Y' ;yes?
|
|
jz ifctrue
|
|
cpi cr ;new line?
|
|
jz ifctrue
|
|
cpi ' ' ;space?
|
|
jz ifctrue
|
|
jmp ifcfalse
|
|
|
|
;
|
|
; 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
|
|
|
|
;
|
|
; Condition: ERROR
|
|
;
|
|
ifcerror:
|
|
call geter1 ;get error byte
|
|
jz ifctrue
|
|
jmp ifcfalse
|
|
|
|
;
|
|
; **** Support Routines ****
|
|
;
|
|
|
|
;
|
|
; 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
|
|
|
|
;
|
|
; Buffers
|
|
;
|
|
negflag:
|
|
ds 1 ;negation flag
|
|
|
|
end
|
|
|