CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / zsys / simtel20 / zcpr3 / if.mac < prev next >

Wrap

Text File | 1994-07-13 | 10.3 KB | 542 lines

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