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 / SYSFCP.ASM < prev    next >
Assembly Source File  |  2000-06-30  |  18KB  |  945 lines
  1. *  SYSTEM SEGMENT:  SYS.FCP
  2. *  SYSTEM:  ZCPR3
  3. *  CUSTOMIZED BY:  RICHARD CONN
  4.  
  5. *
  6. *  PROGRAM:  SYSFCP.ASM
  7. *  AUTHOR:  RICHARD CONN
  8. *  VERSION:  1.0
  9. *  DATE:  22 FEB 84
  10. *  PREVIOUS VERSIONS:  NONE
  11. *
  12. VERSION    EQU    10
  13.  
  14. *
  15. *  Global Library which Defines Addresses for SYSTEM
  16. *
  17.     MACLIB    Z3BASE    ; USE BASE ADDRESSES
  18.     MACLIB    SYSFCP    ; USE EQUATES FROM HEADER FILE
  19.  
  20. ;
  21. LF    EQU    0AH
  22. CR    EQU    0DH
  23. BELL    EQU    07H
  24. ;
  25. BASE    EQU    0
  26. WBOOT    EQU    BASE+0000H        ;CP/M WARM BOOT ADDRESS
  27. UDFLAG    EQU    BASE+0004H        ;USER NUM IN HIGH NYBBLE, DISK IN LOW
  28. BDOS    EQU    BASE+0005H        ;BDOS FUNCTION CALL ENTRY PT
  29. TFCB    EQU    BASE+005CH        ;DEFAULT FCB BUFFER
  30. FCB1    EQU    TFCB            ;1st and 2nd FCBs
  31. FCB2    EQU    TFCB+16
  32. TBUFF    EQU    BASE+0080H        ;DEFAULT DISK I/O BUFFER
  33. TPA    EQU    BASE+0100H        ;BASE OF TPA
  34. ;
  35. $-MACRO         ;FIRST TURN OFF THE EXPANSIONS
  36. ;
  37. ; MACROS TO PROVIDE Z80 EXTENSIONS
  38. ;   MACROS INCLUDE:
  39. ;
  40. ;    JR    - JUMP RELATIVE
  41. ;    JRC    - JUMP RELATIVE IF CARRY
  42. ;    JRNC    - JUMP RELATIVE IF NO CARRY
  43. ;    JRZ    - JUMP RELATIVE IF ZERO
  44. ;    JRNZ    - JUMP RELATIVE IF NO ZERO
  45. ;    DJNZ    - DECREMENT B AND JUMP RELATIVE IF NO ZERO
  46. ;
  47. ;    @GENDD MACRO USED FOR CHECKING AND GENERATING
  48. ;    8-BIT JUMP RELATIVE DISPLACEMENTS
  49. ;
  50. @GENDD    MACRO    ?DD    ;;USED FOR CHECKING RANGE OF 8-BIT DISPLACEMENTS
  51.     IF (?DD GT 7FH) AND (?DD LT 0FF80H)
  52.     DB    100H,?DD    ;Displacement Range Error
  53.     ELSE
  54.     DB    ?DD
  55.     ENDIF        ;;RANGE ERROR
  56.     ENDM
  57. ;
  58. ;
  59. ; Z80 MACRO EXTENSIONS
  60. ;
  61. JR    MACRO    ?N    ;;JUMP RELATIVE
  62.     IF    I8080    ;;8080/8085
  63.     JMP    ?N
  64.     ELSE        ;;Z80
  65.     DB    18H
  66.     @GENDD    ?N-$-1
  67.     ENDIF        ;;I8080
  68.     ENDM
  69. ;
  70. JRC    MACRO    ?N    ;;JUMP RELATIVE ON CARRY
  71.     IF    I8080    ;;8080/8085
  72.     JC    ?N
  73.     ELSE        ;;Z80
  74.     DB    38H
  75.     @GENDD    ?N-$-1
  76.     ENDIF        ;;I8080
  77.     ENDM
  78. ;
  79. JRNC    MACRO    ?N    ;;JUMP RELATIVE ON NO CARRY
  80.     IF    I8080    ;;8080/8085
  81.     JNC    ?N
  82.     ELSE        ;;Z80
  83.     DB    30H
  84.     @GENDD    ?N-$-1
  85.     ENDIF        ;;I8080
  86.     ENDM
  87. ;
  88. JRZ    MACRO    ?N    ;;JUMP RELATIVE ON ZERO
  89.     IF    I8080    ;;8080/8085
  90.     JZ    ?N
  91.     ELSE        ;;Z80
  92.     DB    28H
  93.     @GENDD    ?N-$-1
  94.     ENDIF        ;;I8080
  95.     ENDM
  96. ;
  97. JRNZ    MACRO    ?N    ;;JUMP RELATIVE ON NO ZERO
  98.     IF    I8080    ;;8080/8085
  99.     JNZ    ?N
  100.     ELSE        ;;Z80
  101.     DB    20H
  102.     @GENDD    ?N-$-1
  103.     ENDIF        ;;I8080
  104.     ENDM
  105. ;
  106. DJNZ    MACRO    ?N    ;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
  107.     IF    I8080    ;;8080/8085
  108.     DCR    B
  109.     JNZ    ?N
  110.     ELSE        ;;Z80
  111.     DB    10H
  112.     @GENDD    ?N-$-1
  113.     ENDIF        ;;I8080
  114.     ENDM
  115. *
  116. *  SYSTEM Entry Point
  117. *
  118.     org    fcp        ; passed for Z3BASE
  119.  
  120.     db    'Z3FCP'        ; Flag for Package Loader
  121. *
  122. *  **** Command Table for FCP ****
  123. *    This table is FCP-dependent!
  124. *
  125. *    The command name table is structured as follows:
  126. *
  127. *    ctable:
  128. *        DB    'CMNDNAME'    ; Table Record Structure is
  129. *        DW    cmndaddress    ; 8 Chars for Name and 2 Bytes for Adr
  130. *        ...
  131. *        DB    0    ; End of Table
  132. *
  133. cnsize    equ    4        ; NUMBER OF CHARS IN COMMAND NAME
  134.     db    cnsize    ; size of text entries
  135. ctab:
  136.     db    'IF  '
  137.     dw    ifstart
  138.     db    'ELSE'
  139.     dw    ifelse
  140.     db    'FI  '
  141.     dw    ifend
  142.     db    'XIF '
  143.     dw    ifexit
  144.     db    0
  145. ;
  146. ; Condition Table
  147. ;
  148. condtab:
  149. ;
  150.     IF    IFOTRUE
  151.     db    'T '        ;TRUE
  152.     dw    ifctrue
  153.     db    'F '        ;FALSE
  154.     dw    ifcfalse
  155.     ENDIF
  156. ;
  157.     IF    IFOEMPTY
  158.     db    'EM'        ;file empty
  159.     dw    ifcempty
  160.     ENDIF
  161. ;
  162.     IF    IFOERROR
  163.     db    'ER'        ;error message
  164.     dw    ifcerror
  165.     ENDIF
  166. ;
  167.     IF    IFOEXIST
  168.     db    'EX'        ;file exists
  169.     dw    ifcex
  170.     ENDIF
  171. ;
  172.     IF    IFOINPUT
  173.     db    'IN'        ;user input
  174.     dw    ifcinput
  175.     ENDIF
  176. ;
  177.     IF    IFONULL
  178.     db    'NU'
  179.     dw    ifcnull
  180.     ENDIF
  181. ;
  182.     IF    IFOTCAP        ;Z3 TCAP available
  183.     db    'TC'
  184.     dw    ifctcap
  185.     ENDIF
  186. ;
  187.     IF    IFOWHEEL    ;Wheel Byte
  188.     db    'WH'
  189.     dw    ifcwheel
  190.     ENDIF
  191. ;
  192.     db    0
  193.  
  194. *
  195. *  Print " IF"
  196. *
  197. prif:
  198.     call    print
  199.     db    'IF',' '+80H
  200.     ret
  201. *
  202. *  Print String (terminated in 0 or MSB Set) at Return Address
  203. *
  204. print:
  205.     IF    NOISE
  206.     mvi    a,' '        ;print leading space
  207.     call    conout
  208.     ENDIF        ;NOISE
  209.     xthl            ; get address
  210.     call    print1
  211.     xthl            ; put address
  212.     ret
  213. *
  214. *  Print String (terminated by MSB Set) pted to by HL
  215. *
  216. print1:
  217.     mov    a,m        ; done?
  218.     inx    h        ; pt to next
  219.     call    conout        ; print char
  220.     ora    a        ; set MSB flag (M)
  221.     rm            ; MSB terminator
  222.     jr    print1
  223.  
  224. *
  225. *  **** FCP Routines ****
  226. *  All code from here on is FCP-dependent!
  227. *
  228.  
  229. ;
  230. ; FCP Command: XIF
  231. ;   XIF terminates all IFs, restoring a basic TRUE state
  232. ;
  233. ifexit:
  234.     IF    NOISE
  235.     call    nl        ;print new line
  236.     ENDIF        ;NOISE
  237.     call    iftest        ;see if current IF is running and FALSE
  238.     jrz    ifstat        ;abort with status message if so
  239.     lxi    h,z3msg+1    ;pt to IF flag
  240.     xra    a        ;A=0
  241.     mov    m,a        ;zero IF flag
  242.     jr    ifendmsg    ;print message
  243.  
  244. ;
  245. ; FCP Command: FI
  246. ;   FI decrements to the previous IF
  247. ;
  248. ;   Algorithm:
  249. ;    Rotate Current IF Bit (1st IF Message) Right 1 Bit Position
  250. ;
  251. ifend:
  252.     IF    NOISE
  253.     call    nl        ;print new line
  254.     ENDIF        ;NOISE
  255.     lxi    h,z3msg+1    ;pt to IF flag
  256.     mov    a,m        ;get it
  257.     ora    a        ;no IF active?
  258.     jrz    ifnderr
  259. ifendmsg:
  260.     IF    NOISE
  261.     push    psw        ;save A
  262.     call    print
  263.     db    'T','o'+80H    ;prefix to status display
  264.     pop    psw        ;get A
  265.     ENDIF        ;NOISE
  266.     rrc            ;move right 1 bit
  267.     ani    7fh        ;mask msb 0
  268.     mov    m,a        ;store active bit
  269.     jrnz    ifstat        ;print status if IF still active
  270. ifnderr:
  271.     IF    NOISE
  272.     call    print        ;print message
  273.     db    'N','o'+80H
  274.     jmp    prif
  275.     ELSE        ;NOT NOISE
  276.     ret
  277.     ENDIF        ;NOISE
  278.  
  279. ;
  280. ; FCP Command: ELSE
  281. ;   ELSE complements the Active Bit for the Current IF
  282. ;
  283. ;   Algorithm:
  284. ;    If Current IF is 0 (no IF) or 1 (one IF), then toggle
  285. ;        Active IF Bit associated with Current IF
  286. ;    Else
  287. ;        If Previous IF was Active then toggle
  288. ;            Active IF Bit associated with Current IF
  289. ;        Else do nothing
  290. ;
  291. ifelse:
  292.     IF    NOISE
  293.     call    nl        ;print new line
  294.     ENDIF        ;NOISE
  295.     lxi    h,z3msg+1    ;pt to IF msgs
  296.     mov    a,m        ;get current IF
  297.     mov    b,a        ;save current IF in B
  298.     inx    h        ;pt to active IF message
  299.     rrc            ;back up to previous IF level
  300.     ani    7fh        ;mask out possible carry
  301.     jrz    iftog        ;toggle if IF level is 0 or 1
  302.     ana    m        ;determine previous IF status
  303.     jrz    ifstat        ;don't toggle, and just print status
  304. iftog:
  305.     mov    a,m        ;get active IF message
  306.     cma            ;flip bits
  307.     ana    b        ;look at only interested bit
  308.     mov    c,a        ;result in C
  309.     mov    a,b        ;complement IF byte
  310.     cma
  311.     mov    b,a
  312.     mov    a,m        ;get active byte
  313.     ana    b        ;mask in only uninterested bits
  314.     ora    c        ;mask in complement of interested bit
  315.     mov    m,a        ;save result and fall thru to print status
  316. ;
  317. ; Indicate if current IF is True or False
  318. ;
  319. ifstat:
  320.     IF    NOISE
  321.     call    prif
  322.     mvi    b,'F'        ;assume False
  323.     call    iftest        ;see if IF is FALSE (Z if so)
  324.     jrz    ifst1        ;Zero means IF F or No IF
  325.     mvi    b,'T'        ;set True
  326. ifst1:
  327.     mov    a,b        ;get T/F flag and fall thru to print it
  328.     ELSE        ;NOT NOISE
  329.     ret
  330.     ENDIF        ;NOISE
  331.  
  332. ;
  333. ;  Console Output Routine
  334. ;
  335. conout:
  336.     push    h        ; save regs
  337.     push    d
  338.     push    b
  339.     push    psw
  340.     ani    7fh        ; mask MSB
  341.     mov    e,a        ; char in E
  342.     mvi    c,2        ; output
  343.     call    bdos
  344.     pop    psw        ; get regs
  345.     pop    b
  346.     pop    d
  347.     pop    h
  348.     ret
  349.  
  350. ;
  351. ;  Output LF (to go with CR from ZCPR3)
  352. ;
  353. nl:
  354.     mvi    a,lf        ;output LF
  355.     jr    conout
  356.  
  357. ;
  358. ; FCP Command: IF
  359. ;
  360. ifstart:
  361.     IF    NOISE
  362.     call    nl        ;print new line
  363.     ENDIF        ;NOISE
  364.     call    iftest        ;see if current IF is running and FALSE
  365. ;
  366.     IF    NOT COMIF
  367.     jrz    ifcfalse    ;raise next IF level to FALSE if so
  368.     ELSE
  369.     jz    ifcf
  370.     ENDIF        ;NOT COMIF
  371. ;
  372.  
  373. ;****************************************************************
  374. ;*                                *
  375. ;* IF.COM Processing                        *
  376. ;*                                *
  377. ;****************************************************************
  378.  
  379. ;
  380. ; If IF.COM to be processed, goto ROOT (base of path) and load it
  381. ;
  382.     IF    COMIF
  383. ;
  384. ; Get Current Disk and User in BC
  385. ;
  386.     lda    udflag        ;get UD
  387.     push    psw        ;save UD flag
  388.     ani    0fh        ;get disk
  389.     sta    cdisk        ;set current disk
  390.     mov    b,a        ;B=disk (A=0)
  391.     pop    psw        ;get UD flag
  392.     rlc            ;get user in low 4 bits
  393.     rlc
  394.     rlc
  395.     rlc
  396.     ani    0fh        ;get user
  397.     sta    cuser        ;set current user
  398.     mov    c,a        ;... in C
  399. ;
  400. ; Pt to Start of Path
  401. ;
  402.     lxi    h,expath    ;pt to path
  403. ;
  404. ; Check for End of Path
  405. ;
  406. fndroot:
  407.     mov    a,m        ;check for done
  408.     ora    a        ;end of path?
  409.     jrz    froot2
  410. ;
  411. ; Process Next Path Element
  412. ;
  413.     cpi    '$'        ;current disk?
  414.     jrnz    froot0
  415.     lda    cdisk        ;get current disk
  416.     inr    a        ;+1 for following -1
  417. froot0:
  418.     dcr    a        ;set A=0
  419.     mov    b,a        ;set disk
  420.     inx    h        ;pt to user
  421.     mov    a,m        ;get user
  422.     cpi    '$'        ;current user?
  423.     jrnz    froot1
  424.     lda    cuser        ;get current user
  425. froot1:
  426.     mov    c,a        ;set user
  427.     inx    h        ;pt to next
  428.     jr    fndroot
  429. ;
  430. ; Done with Search - BC Contains ROOT DU
  431. ;
  432. froot2:
  433. ;
  434. ; Log Into ROOT
  435. ;
  436.     call    logbc        ;log into root DU
  437. ;
  438. ; Set Address of Next Load and Set DMA for OPEN
  439. ;
  440.     lxi    h,100h        ;pt to TPA
  441.     shld    nxtload        ;set address for next load
  442.     xchg            ;DE=100H so don't wipe out buffers
  443.     mvi    c,26        ;set DMA
  444.     call    bdos
  445. ;
  446. ; Try to Open File IF.COM
  447. ;
  448.     lxi    d,extfcb    ;pt to FCB
  449.     mvi    c,15        ;open file
  450.     call    bdos
  451.     inr    a        ;check for found
  452.     jz    ifnotfnd
  453. ;
  454. ; Load File IF.COM
  455. ;
  456. ifload:
  457. ;
  458. ; Set Load Address
  459. ;
  460.     lhld    nxtload        ;get address of next load
  461.     push    h        ;save it
  462.     lxi    d,80h        ;pt to following
  463.     dad    d
  464.     shld    nxtload
  465.     pop    d        ;get load address
  466.     mvi    c,26        ;set DMA
  467.     call    bdos
  468. ;
  469. ; Read in Block (Sector) and Loop Back if Not Done
  470. ;
  471.     lxi    d,extfcb    ;read file
  472.     mvi    c,20
  473.     push    d        ;save ptr in case of failure (done)
  474.     call    bdos
  475.     pop    d
  476.     ora    a        ;OK?
  477.     jz    ifload
  478. ;
  479. ; Done - Close File
  480. ;
  481.     mvi    c,16        ;close file
  482.     call    bdos
  483. ;
  484. ; Reset Environment (DMA and DU) and Run IF.COM
  485. ;
  486.     call    reset        ;reset DMA and directory
  487.     jmp    tpa        ;run IF.COM
  488. ;
  489. ; Reset DMA Address and Current Disk (in CDISK) and User (in CUSER)
  490. ;
  491. reset:
  492.     lxi    d,80h        ;reset DMA address
  493.     mvi    c,26
  494.     call    bdos
  495.     lda    cdisk        ;return home
  496.     mov    b,a
  497.     lda    cuser
  498.     mov    c,a
  499. ;
  500. ; Log Into DU in BC
  501. ;
  502. logbc:
  503.     mov    e,b        ;set disk
  504.     push    b
  505.     mvi    c,14        ;select disk
  506.     call    bdos
  507.     pop    b
  508.     mov    e,c        ;set user
  509.     mvi    c,32        ;select user
  510.     jmp    bdos
  511. ;
  512. ; IF.COM not found - Process as IF F
  513. ;
  514. ifnotfnd:
  515.     call    reset        ;return home
  516.     jr    ifcf
  517. ;
  518. ; Buffers for COMIF
  519. ;
  520. nxtload:
  521.     ds    2        ;address of next block (sector) to load
  522. cuser:
  523.     ds    1        ;current user
  524. cdisk:
  525.     ds    1        ;current disk (A=0)
  526. ;
  527.     ENDIF        ;COMIF
  528. ;
  529.  
  530.     IF    NOT COMIF
  531. ;****************************************************************
  532. ;*                                *
  533. ;* Non-IF.COM Processing                    *
  534. ;*                                *
  535. ;****************************************************************
  536.  
  537. ;
  538. ; Test for Equality if Enabled
  539. ;
  540.     IF    IFOEQ
  541.     lxi    h,tbuff+1    ;look for '=' in line
  542. tsteq:
  543.     mov    a,m        ;get char
  544.     inx    h        ;pt to next
  545.     ora    a        ;EOL?
  546.     jrz    ifck0        ;continue if so
  547.     cpi    '='        ;'=' found?
  548.     jrnz    tsteq
  549.     lxi    h,fcb1+1    ;compare FCBs
  550.     lxi    d,fcb2+1
  551.     mvi    b,11        ;11 bytes
  552. eqtest:
  553.     ldax    d        ;compare
  554.     cmp    m
  555.     jrnz    ifcf
  556.     inx    h        ;pt to next
  557.     inx    d
  558.     djnz    eqtest
  559.     jr    ifct
  560.     ENDIF        ;IFOEQ
  561. ;
  562. ; Test Condition in FCB1 and file name in FCB2
  563. ;   Execute condition processing routine
  564. ;
  565. ifck0:
  566.     lxi    d,fcb1+1    ;pt to first char in FCB1
  567. ;
  568.     IF    IFONEG
  569.     ldax    d        ;get it
  570.     sta    negflag        ;set negate flag
  571.     cpi    negchar        ;is it a negate?
  572.     jrnz    ifck1
  573.     inx    d        ;pt to char after negchar
  574. ifck1:
  575.     ENDIF        ;IFONEG
  576. ;
  577.     IF    IFOREG        ;REGISTERS
  578.     call    regtest        ;test for register value
  579.     jrnz    runreg
  580.     ENDIF        ;IFOREG
  581. ;
  582.     call    condtest    ;test of condition match
  583.     jrnz    runcond        ;process condition
  584.     call    print        ;beep to indicate error
  585.     db    bell+80H
  586.     jmp    ifstat        ;no condition, display current condition
  587. ;
  588. ; Process register - register value is in A
  589. ;
  590.     IF    IFOREG
  591. runreg:
  592.     push    psw        ;save value
  593.     call    getnum        ;extract value in FCB2 as a number
  594.     pop    psw        ;get value
  595.     cmp    b        ;compare against extracted value
  596.     jrz    ifctrue        ;TRUE if match
  597.     jr    ifcfalse    ;FALSE if non-match
  598.     ENDIF        ;IFOREG
  599. ;
  600. ; Process conditional test - address of conditional routine is in HL
  601. ;
  602. runcond:
  603.     pchl            ;"call" routine pted to by HL
  604. ;
  605.     ENDIF        ;NOT COMIF
  606. ;
  607.  
  608. ;
  609. ; Condition:  NULL (2nd file name)
  610. ;
  611.     IF    IFONULL
  612. ifcnull:
  613.     lda    fcb2+1        ;get first char of 2nd file name
  614.     cpi    ' '        ;space = null
  615.     jrz    ifctrue
  616.     jr    ifcfalse
  617.     ENDIF        ;IFONULL
  618.  
  619. ;
  620. ; Condition:  TCAP
  621. ;
  622.     IF    IFOTCAP
  623. ifctcap:
  624.     lda    z3env+80H    ;get first char of Z3 TCAP Entry
  625.     cpi    ' '+1        ;space or less = none
  626.     jrc    ifcfalse
  627.     jr    ifctrue
  628.     ENDIF        ;IFOTCAP
  629.  
  630. ;
  631. ; Condition:  WHEEL
  632. ;
  633.     IF    IFOWHEEL
  634. ifcwheel:
  635.     lhld    z3env+29h    ;get address of wheel byte
  636.     mov    a,m        ;get byte
  637.     ora    a        ;test for true
  638.     jrz    ifcfalse    ;FALSE if 0
  639.     jr    ifctrue
  640.     ENDIF        ;IFOWHEEL
  641. ;
  642. ; Condition:  TRUE
  643. ;    IFCTRUE  enables an active IF
  644. ; Condition:  FALSE
  645. ;    IFCFALSE enables an inactive IF
  646. ;
  647. ifctrue:
  648. ;
  649.     IF    IFONEG
  650.     call    negtest    ;test for negate
  651.     jrz    ifcf
  652.     ENDIF        ;IFONEG
  653. ;
  654. ifct:
  655.     mvi    b,0ffh    ;active
  656.     jmp    ifset
  657. ifcfalse:
  658. ;
  659.     IF    IFONEG
  660.     call    negtest    ;test for negate
  661.     jrz    ifct
  662.     ENDIF        ;IFONEG
  663. ;
  664. ifcf:
  665.     mvi    b,0    ;inactive
  666.     jmp    ifset
  667.  
  668. ;
  669. ; Condition: INPUT (from user)
  670. ;
  671.     IF    IFOINPUT
  672. ifcinput:
  673.     lxi    h,z3msg+7    ;pt to ZEX message byte
  674.     mvi    m,10b        ;suspend ZEX input
  675.     push    h        ;save ptr to ZEX message byte
  676.     IF    NOT NOISE
  677.     call    nl
  678.     ENDIF        ;NOT NOISE
  679.     call    prif
  680.     call    print
  681.     db    'True?',' '+80H
  682.     mvi    c,1        ;input from console
  683.     call    bdos
  684.     pop    h        ;get ptr to ZEX message byte
  685.     mvi    m,0        ;return ZEX to normal processing
  686.     cpi    ' '        ;yes?
  687.     jrz    ifctrue
  688.     ani    5fh        ;mask and capitalize user input
  689.     cpi    'T'        ;true?
  690.     jrz    ifctrue
  691.     cpi    'Y'        ;yes?
  692.     jrz    ifctrue
  693.     cpi    CR        ;yes?
  694.     jrz    ifctrue
  695.     jr    ifcfalse
  696.     ENDIF        ;IFOINPUT
  697.  
  698. ;
  699. ; Condition: EXIST filename.typ
  700. ;
  701.     IF    IFOEXIST
  702. ifcex:
  703.     call    tlog    ;log into DU
  704.     lxi    d,fcb2    ;pt to fcb
  705.     mvi    c,17    ;search for first
  706.     call    bdos
  707.     inr    a    ;set zero if error
  708.     jrz    ifcfalse    ;return FALSE
  709.     jr    ifctrue        ;return TRUE
  710.     ENDIF        ;IFOEXIST
  711.  
  712. ;
  713. ; Condition: EMPTY filename.typ
  714. ;
  715.     IF    IFOEMPTY
  716. ifcempty:
  717.     call    tlog        ;log into FCB2's DU
  718.     lxi    d,fcb2        ;pt to fcb2
  719.     mvi    c,15        ;open file
  720.     push    d        ;save fcb ptr
  721.     call    bdos
  722.     pop    d
  723.     inr    a        ;not found?
  724.     jrz    ifctrue
  725.     mvi    c,20        ;try to read a record
  726.     call    bdos
  727.     ora    a        ;0=OK
  728.     jrnz    ifctrue        ;NZ if no read
  729.     jr    ifcfalse
  730.     ENDIF        ;IFOEMPTY
  731.  
  732. ;
  733. ; Condition: ERROR
  734. ;
  735.     IF    IFOERROR
  736. ifcerror:
  737.     lda    z3msg+6        ;get error byte
  738.     ora    a        ;0=TRUE
  739.     jrz    ifctrue
  740.     jr    ifcfalse
  741.     ENDIF        ;IFOERROR
  742.  
  743. ;
  744. ; **** Support Routines ****
  745. ;
  746.  
  747. ;
  748. ; Convert chars in FCB2 into a number in B
  749. ;
  750.     IF    IFOREG
  751. getnum:
  752.     mvi    b,0    ;set number
  753.     lxi    h,fcb2+1    ;pt to first char
  754. getn1:
  755.     mov    a,m    ;get char
  756.     inx    h    ;pt to next
  757.     sui    '0'    ;convert to binary
  758.     rc        ;done if error
  759.     cpi    10    ;range?
  760.     rnc        ;done if out of range
  761.     mov    c,a    ;value in C
  762.     mov    a,b    ;A=old value
  763.     add    a    ;*2
  764.     add    a    ;*4
  765.     add    b    ;*5
  766.     add    a    ;*10
  767.     add    c    ;add in new digit value
  768.     mov    b,a    ;result in B
  769.     jr    getn1    ;continue processing
  770.     ENDIF        ;IFOREG
  771.  
  772. ;
  773. ; Log into DU in FCB2
  774. ;
  775.     IF    NOT COMIF
  776. tlog:
  777.     lda    fcb2    ;get disk
  778.     ora    a    ;current?
  779.     jrnz    tlog1
  780.     mvi    c,25    ;get disk
  781.     call    bdos
  782.     inr    a    ;increment for following decrement
  783. tlog1:
  784.     dcr    a    ;A=0
  785.     mov    e,a    ;disk in E
  786.     mvi    c,14
  787.     call    bdos
  788.     lda    fcb2+13    ;pt to user
  789.     mov    e,a
  790.     mvi    c,32    ;set user
  791.     jmp    bdos
  792. ;
  793.     ENDIF        ;NOT COMIF
  794.  
  795. ;
  796. ; Test of Negate Flag = negchar
  797. ;
  798.     IF    IFONEG
  799. negtest:
  800. negflag    equ    $+1        ;pointer for in-the-code modification
  801.     mvi    a,0        ;2nd byte is filled in
  802.     cpi    negchar        ;test for No
  803.     ret
  804.     ENDIF        ;IFONEG
  805.  
  806. ;
  807. ; Test FCB1 against a single digit (0-9)
  808. ;  Return with register value in A and NZ if so
  809. ;
  810.     IF    IFOREG
  811. regtest:
  812.     ldax    d        ;get digit
  813.     sui    '0'
  814.     jrc    zret        ;Z flag for no digit
  815.     cpi    10        ;range?
  816.     jrnc    zret        ;Z flag for no digit
  817.     lxi    h,z3msg+30H    ;pt to registers
  818.     add    l        ;pt to register
  819.     mov    l,a
  820.     mov    a,h        ;add in H
  821.     aci    0
  822.     mov    h,a
  823.     xra    a        ;set NZ
  824.     dcr    a
  825.     mov    a,m        ;get register value
  826.     ret
  827. zret:
  828.     xra    a        ;set Z
  829.     ret
  830.     ENDIF        ;IFOREG
  831.  
  832. ;
  833. ; Test to see if a current IF is running and if it is FALSE
  834. ;   If so, return with Zero Flag Set (Z)
  835. ;   If not, return with Zero Flag Clear (NZ)
  836. ; Affect only HL and PSW
  837. ;
  838. iftest:
  839.     lxi    h,z3msg+1    ;get IF flag
  840.     mov    a,m        ;test for active IF
  841.     ora    a
  842.     jrz    ifok        ;no active IF
  843.     inx    h        ;pt to active flag
  844.     ana    m        ;check active flag
  845.     rz            ;return Z since IF running and FALSE
  846. ifok:
  847.     xra    a        ;return NZ for OK
  848.     dcr    a
  849.     ret
  850.  
  851. ;
  852. ; Test FCB1 against condition table (must have 2-char entries)
  853. ;  Return with routine address in HL if match and NZ flag
  854. ;
  855.     IF    NOT COMIF
  856. condtest:
  857.     lxi    h,condtab    ;pt to table
  858. condt1:
  859.     mov    a,m        ;end of table?
  860.     ora    a
  861.     rz
  862.     ldax    d        ;get char
  863.     mov    b,m        ;get other char in B
  864.     inx    h        ;pt to next
  865.     inx    d
  866.     cmp    b        ;compare entries
  867.     jrnz    condt2
  868.     ldax    d        ;get 2nd char
  869.     cmp    m        ;compare
  870.     jrnz    condt2
  871.     inx    h        ;pt to address
  872.     mov    a,m        ;get address in HL
  873.     inx    h
  874.     mov    h,m
  875.     mov    l,a        ;HL = address
  876.     xra    a        ;set NZ for OK
  877.     dcr    a
  878.     ret
  879. condt2:
  880.     lxi    b,3        ;pt to next entry
  881.     dad    b        ; ... 1 byte for text + 2 bytes for address
  882.     dcx    d        ;pt to 1st char of condition
  883.     jr    condt1
  884. ;
  885.     ENDIF        ;NOT COMIF
  886. ;
  887. ; Turn on next IF level
  888. ;   B register is 0 if level is inactive, 0FFH is level is active
  889. ;   Return with Z flag set if OK
  890. ;
  891. ifset:
  892.     lxi    h,z3msg+1    ;get IF flag
  893.     mov    a,m
  894.     ora    a        ;if no if at all, start 1st one
  895.     jrz    ifset1
  896.     cpi    80h        ;check for overflow (8 IFs max)
  897.     jrz    iferr
  898.     inx    h        ;pt to active IF byte
  899.     ana    m        ;check to see if current IF is TRUE
  900.     jrnz    ifset0        ;if TRUE, proceed
  901.     mvi    b,0        ;set False IF
  902. ifset0:
  903.     dcx    h        ;pt to IF level
  904.     mov    a,m        ;get it
  905.     rlc            ;advance to next level
  906.     ani    0feh        ;only 1 bit on
  907.     mov    m,a        ;set IF byte
  908.     jr    ifset2
  909. ifset1:
  910.     inr    a        ;A=1
  911.     mov    m,a        ;set 1st IF
  912.     inx    h        ;clear active IF byte
  913.     mvi    m,0
  914.     dcx    h
  915. ifset2:
  916.     mov    d,a        ;get IF byte
  917.     ana    b        ;set interested bit
  918.     mov    b,a
  919.     inx    h        ;pt to active flag
  920.     mov    a,d        ;complement IF byte
  921.     cma
  922.     mov    d,a
  923.     mov    a,m        ;get active byte
  924.     ana    d        ;mask in only uninterested bits
  925.     ora    b        ;mask in complement of interested bit
  926.     mov    m,a        ;save result
  927.     call    ifstat        ;print status
  928.     xra    a        ;return with Z
  929.     ret
  930. iferr:
  931.     call    print        ;beep to indicate overflow
  932.     db    bell+80H
  933.     xra    a        ;set NZ
  934.     dcr    a
  935.     ret
  936.  
  937. ;
  938. ; Test for Size Error
  939. ;
  940.     if    ($ GT (FCP + FCPS*128))
  941. sizerr    equ    novalue    ;FCP is too large for buffer
  942.     endif
  943.  
  944.     end
  945.