* SYSTEM SEGMENT: SYS.FCP
* SYSTEM: ZCPR3
* CUSTOMIZED BY: RICHARD CONN
*
* PROGRAM: SYSFCP.ASM
* AUTHOR: RICHARD CONN
* VERSION: 1.0
* DATE: 22 FEB 84
* PREVIOUS VERSIONS: NONE
*
VERSION EQU 10
*
* Global Library which Defines Addresses for SYSTEM
*
MACLIB Z3BASE ; USE BASE ADDRESSES
MACLIB SYSFCP ; USE EQUATES FROM HEADER FILE
;
LF EQU 0AH
CR EQU 0DH
BELL EQU 07H
;
BASE EQU 0
WBOOT EQU BASE+0000H ;CP/M WARM BOOT ADDRESS
UDFLAG EQU BASE+0004H ;USER NUM IN HIGH NYBBLE, DISK IN LOW
BDOS EQU BASE+0005H ;BDOS FUNCTION CALL ENTRY PT
TFCB EQU BASE+005CH ;DEFAULT FCB BUFFER
FCB1 EQU TFCB ;1st and 2nd FCBs
FCB2 EQU TFCB+16
TBUFF EQU BASE+0080H ;DEFAULT DISK I/O BUFFER
TPA EQU BASE+0100H ;BASE OF TPA
;
$-MACRO ;FIRST TURN OFF THE EXPANSIONS
;
; MACROS TO PROVIDE Z80 EXTENSIONS
; MACROS INCLUDE:
;
; JR - JUMP RELATIVE
; JRC - JUMP RELATIVE IF CARRY
; JRNC - JUMP RELATIVE IF NO CARRY
; JRZ - JUMP RELATIVE IF ZERO
; JRNZ - JUMP RELATIVE IF NO ZERO
; DJNZ - DECREMENT B AND JUMP RELATIVE IF NO ZERO
;
; @GENDD MACRO USED FOR CHECKING AND GENERATING
; 8-BIT JUMP RELATIVE DISPLACEMENTS
;
@GENDD MACRO ?DD ;;USED FOR CHECKING RANGE OF 8-BIT DISPLACEMENTS
IF (?DD GT 7FH) AND (?DD LT 0FF80H)
DB 100H,?DD ;Displacement Range Error
ELSE
DB ?DD
ENDIF ;;RANGE ERROR
ENDM
;
;
; Z80 MACRO EXTENSIONS
;
JR MACRO ?N ;;JUMP RELATIVE
IF I8080 ;;8080/8085
JMP ?N
ELSE ;;Z80
DB 18H
@GENDD ?N-$-1
ENDIF ;;I8080
ENDM
;
JRC MACRO ?N ;;JUMP RELATIVE ON CARRY
IF I8080 ;;8080/8085
JC ?N
ELSE ;;Z80
DB 38H
@GENDD ?N-$-1
ENDIF ;;I8080
ENDM
;
JRNC MACRO ?N ;;JUMP RELATIVE ON NO CARRY
IF I8080 ;;8080/8085
JNC ?N
ELSE ;;Z80
DB 30H
@GENDD ?N-$-1
ENDIF ;;I8080
ENDM
;
JRZ MACRO ?N ;;JUMP RELATIVE ON ZERO
IF I8080 ;;8080/8085
JZ ?N
ELSE ;;Z80
DB 28H
@GENDD ?N-$-1
ENDIF ;;I8080
ENDM
;
JRNZ MACRO ?N ;;JUMP RELATIVE ON NO ZERO
IF I8080 ;;8080/8085
JNZ ?N
ELSE ;;Z80
DB 20H
@GENDD ?N-$-1
ENDIF ;;I8080
ENDM
;
DJNZ MACRO ?N ;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
IF I8080 ;;8080/8085
DCR B
JNZ ?N
ELSE ;;Z80
DB 10H
@GENDD ?N-$-1
ENDIF ;;I8080
ENDM
*
* SYSTEM Entry Point
*
org fcp ; passed for Z3BASE
db 'Z3FCP' ; Flag for Package Loader
*
* **** Command Table for FCP ****
* This table is FCP-dependent!
*
* The command name table is structured as follows:
*
* ctable:
* DB 'CMNDNAME' ; Table Record Structure is
* DW cmndaddress ; 8 Chars for Name and 2 Bytes for Adr
* ...
* DB 0 ; End of Table
*
cnsize equ 4 ; NUMBER OF CHARS IN COMMAND NAME
db cnsize ; size of text entries
ctab:
db 'IF '
dw ifstart
db 'ELSE'
dw ifelse
db 'FI '
dw ifend
db 'XIF '
dw ifexit
db 0
;
; Condition Table
;
condtab:
;
IF IFOTRUE
db 'T ' ;TRUE
dw ifctrue
db 'F ' ;FALSE
dw ifcfalse
ENDIF
;
IF IFOEMPTY
db 'EM' ;file empty
dw ifcempty
ENDIF
;
IF IFOERROR
db 'ER' ;error message
dw ifcerror
ENDIF
;
IF IFOEXIST
db 'EX' ;file exists
dw ifcex
ENDIF
;
IF IFOINPUT
db 'IN' ;user input
dw ifcinput
ENDIF
;
IF IFONULL
db 'NU'
dw ifcnull
ENDIF
;
IF IFOTCAP ;Z3 TCAP available
db 'TC'
dw ifctcap
ENDIF
;
IF IFOWHEEL ;Wheel Byte
db 'WH'
dw ifcwheel
ENDIF
;
db 0
*
* Print " IF"
*
prif:
call print
db 'IF',' '+80H
ret
*
* Print String (terminated in 0 or MSB Set) at Return Address
*
print:
IF NOISE
mvi a,' ' ;print leading space
call conout
ENDIF ;NOISE
xthl ; get address
call print1
xthl ; put address
ret
*
* Print String (terminated by MSB Set) pted to by HL
*
print1:
mov a,m ; done?
inx h ; pt to next
call conout ; print char
ora a ; set MSB flag (M)
rm ; MSB terminator
jr print1
*
* **** FCP Routines ****
* All code from here on is FCP-dependent!
*
;
; FCP Command: XIF
; XIF terminates all IFs, restoring a basic TRUE state
;
ifexit:
IF NOISE
call nl ;print new line
ENDIF ;NOISE
call iftest ;see if current IF is running and FALSE
jrz ifstat ;abort with status message if so
lxi h,z3msg+1 ;pt to IF flag
xra a ;A=0
mov m,a ;zero IF flag
jr ifendmsg ;print message
;
; FCP Command: FI
; FI decrements to the previous IF
;
; Algorithm:
; Rotate Current IF Bit (1st IF Message) Right 1 Bit Position
;
ifend:
IF NOISE
call nl ;print new line
ENDIF ;NOISE
lxi h,z3msg+1 ;pt to IF flag
mov a,m ;get it
ora a ;no IF active?
jrz ifnderr
ifendmsg:
IF NOISE
push psw ;save A
call print
db 'T','o'+80H ;prefix to status display
pop psw ;get A
ENDIF ;NOISE
rrc ;move right 1 bit
ani 7fh ;mask msb 0
mov m,a ;store active bit
jrnz ifstat ;print status if IF still active
ifnderr:
IF NOISE
call print ;print message
db 'N','o'+80H
jmp prif
ELSE ;NOT NOISE
ret
ENDIF ;NOISE
;
; FCP Command: ELSE
; ELSE complements the Active Bit for the Current IF
;
; Algorithm:
; If Current IF is 0 (no IF) or 1 (one IF), then toggle
; Active IF Bit associated with Current IF
; Else
; If Previous IF was Active then toggle
; Active IF Bit associated with Current IF
; Else do nothing
;
ifelse:
IF NOISE
call nl ;print new line
ENDIF ;NOISE
lxi h,z3msg+1 ;pt to IF msgs
mov a,m ;get current IF
mov b,a ;save current IF in B
inx h ;pt to active IF message
rrc ;back up to previous IF level
ani 7fh ;mask out possible carry
jrz iftog ;toggle if IF level is 0 or 1
ana m ;determine previous IF status
jrz ifstat ;don't toggle, and just print status
iftog:
mov a,m ;get active IF message
cma ;flip bits
ana b ;look at only interested bit
mov c,a ;result in C
mov a,b ;complement IF byte
cma
mov b,a
mov a,m ;get active byte
ana b ;mask in only uninterested bits
ora c ;mask in complement of interested bit
mov m,a ;save result and fall thru to print status
;
; Indicate if current IF is True or False
;
ifstat:
IF NOISE
call prif
mvi b,'F' ;assume False
call iftest ;see if IF is FALSE (Z if so)
jrz ifst1 ;Zero means IF F or No IF
mvi b,'T' ;set True
ifst1:
mov a,b ;get T/F flag and fall thru to print it
ELSE ;NOT NOISE
ret
ENDIF ;NOISE
;
; Console Output Routine
;
conout:
push h ; save regs
push d
push b
push psw
ani 7fh ; mask MSB
mov e,a ; char in E
mvi c,2 ; output
call bdos
pop psw ; get regs
pop b
pop d
pop h
ret
;
; Output LF (to go with CR from ZCPR3)
;
nl:
mvi a,lf ;output LF
jr conout
;
; FCP Command: IF
;
ifstart:
IF NOISE
call nl ;print new line
ENDIF ;NOISE
call iftest ;see if current IF is running and FALSE
;
IF NOT COMIF
jrz ifcfalse ;raise next IF level to FALSE if so
ELSE
jz ifcf
ENDIF ;NOT COMIF
;
;
; If IF.COM to be processed, goto ROOT (base of path) and load it
;
IF COMIF
;
; Get Current Disk and User in BC
;
lda udflag ;get UD
push psw ;save UD flag
ani 0fh ;get disk
sta cdisk ;set current disk
mov b,a ;B=disk (A=0)
pop psw ;get UD flag
rlc ;get user in low 4 bits
rlc
rlc
rlc
ani 0fh ;get user
sta cuser ;set current user
mov c,a ;... in C
;
; Pt to Start of Path
;
lxi h,expath ;pt to path
;
; Check for End of Path
;
fndroot:
mov a,m ;check for done
ora a ;end of path?
jrz froot2
;
; Process Next Path Element
;
cpi '$' ;current disk?
jrnz froot0
lda cdisk ;get current disk
inr a ;+1 for following -1
froot0:
dcr a ;set A=0
mov b,a ;set disk
inx h ;pt to user
mov a,m ;get user
cpi '$' ;current user?
jrnz froot1
lda cuser ;get current user
froot1:
mov c,a ;set user
inx h ;pt to next
jr fndroot
;
; Done with Search - BC Contains ROOT DU
;
froot2:
;
; Log Into ROOT
;
call logbc ;log into root DU
;
; Set Address of Next Load and Set DMA for OPEN
;
lxi h,100h ;pt to TPA
shld nxtload ;set address for next load
xchg ;DE=100H so don't wipe out buffers
mvi c,26 ;set DMA
call bdos
;
; Try to Open File IF.COM
;
lxi d,extfcb ;pt to FCB
mvi c,15 ;open file
call bdos
inr a ;check for found
jz ifnotfnd
;
; Load File IF.COM
;
ifload:
;
; Set Load Address
;
lhld nxtload ;get address of next load
push h ;save it
lxi d,80h ;pt to following
dad d
shld nxtload
pop d ;get load address
mvi c,26 ;set DMA
call bdos
;
; Read in Block (Sector) and Loop Back if Not Done
;
lxi d,extfcb ;read file
mvi c,20
push d ;save ptr in case of failure (done)
call bdos
pop d
ora a ;OK?
jz ifload
;
; Done - Close File
;
mvi c,16 ;close file
call bdos
;
; Reset Environment (DMA and DU) and Run IF.COM
;
call reset ;reset DMA and directory
jmp tpa ;run IF.COM
;
; Reset DMA Address and Current Disk (in CDISK) and User (in CUSER)
;
reset:
lxi d,80h ;reset DMA address
mvi c,26
call bdos
lda cdisk ;return home
mov b,a
lda cuser
mov c,a
;
; Log Into DU in BC
;
logbc:
mov e,b ;set disk
push b
mvi c,14 ;select disk
call bdos
pop b
mov e,c ;set user
mvi c,32 ;select user
jmp bdos
;
; IF.COM not found - Process as IF F
;
ifnotfnd:
call reset ;return home
jr ifcf
;
; Buffers for COMIF
;
nxtload:
ds 2 ;address of next block (sector) to load
cuser:
ds 1 ;current user
cdisk:
ds 1 ;current disk (A=0)
;
ENDIF ;COMIF
;
IF NOT COMIF
;****************************************************************
;* *
;* Non-IF.COM Processing *
;* *
;****************************************************************
;
; Test for Equality if Enabled
;
IF IFOEQ
lxi h,tbuff+1 ;look for '=' in line
tsteq:
mov a,m ;get char
inx h ;pt to next
ora a ;EOL?
jrz ifck0 ;continue if so
cpi '=' ;'=' found?
jrnz tsteq
lxi h,fcb1+1 ;compare FCBs
lxi d,fcb2+1
mvi b,11 ;11 bytes
eqtest:
ldax d ;compare
cmp m
jrnz ifcf
inx h ;pt to next
inx d
djnz eqtest
jr ifct
ENDIF ;IFOEQ
;
; Test Condition in FCB1 and file name in FCB2
; Execute condition processing routine
;
ifck0:
lxi d,fcb1+1 ;pt to first char in FCB1
;
IF IFONEG
ldax d ;get it
sta negflag ;set negate flag
cpi negchar ;is it a negate?
jrnz ifck1
inx d ;pt to char after negchar
ifck1:
ENDIF ;IFONEG
;
IF IFOREG ;REGISTERS
call regtest ;test for register value
jrnz runreg
ENDIF ;IFOREG
;
call condtest ;test of condition match
jrnz runcond ;process condition
call print ;beep to indicate error
db bell+80H
jmp ifstat ;no condition, display current condition
;
; Process register - register value is in A
;
IF IFOREG
runreg:
push psw ;save value
call getnum ;extract value in FCB2 as a number
pop psw ;get value
cmp b ;compare against extracted value
jrz ifctrue ;TRUE if match
jr ifcfalse ;FALSE if non-match
ENDIF ;IFOREG
;
; Process conditional test - address of conditional routine is in HL
;
runcond:
pchl ;"call" routine pted to by HL
;
ENDIF ;NOT COMIF
;
;
; Condition: NULL (2nd file name)
;
IF IFONULL
ifcnull:
lda fcb2+1 ;get first char of 2nd file name
cpi ' ' ;space = null
jrz ifctrue
jr ifcfalse
ENDIF ;IFONULL
;
; Condition: TCAP
;
IF IFOTCAP
ifctcap:
lda z3env+80H ;get first char of Z3 TCAP Entry
cpi ' '+1 ;space or less = none
jrc ifcfalse
jr ifctrue
ENDIF ;IFOTCAP
;
; Condition: WHEEL
;
IF IFOWHEEL
ifcwheel:
lhld z3env+29h ;get address of wheel byte
mov a,m ;get byte
ora a ;test for true
jrz ifcfalse ;FALSE if 0
jr ifctrue
ENDIF ;IFOWHEEL
;
; Condition: TRUE
; IFCTRUE enables an active IF
; Condition: FALSE
; IFCFALSE enables an inactive IF
;
ifctrue:
;
IF IFONEG
call negtest ;test for negate
jrz ifcf
ENDIF ;IFONEG
;
ifct:
mvi b,0ffh ;active
jmp ifset
ifcfalse:
;
IF IFONEG
call negtest ;test for negate
jrz ifct
ENDIF ;IFONEG
;
ifcf:
mvi b,0 ;inactive
jmp ifset
;
; Condition: INPUT (from user)
;
IF IFOINPUT
ifcinput:
lxi h,z3msg+7 ;pt to ZEX message byte
mvi m,10b ;suspend ZEX input
push h ;save ptr to ZEX message byte
IF NOT NOISE
call nl
ENDIF ;NOT NOISE
call prif
call print
db 'True?',' '+80H
mvi c,1 ;input from console
call bdos
pop h ;get ptr to ZEX message byte
mvi m,0 ;return ZEX to normal processing
cpi ' ' ;yes?
jrz ifctrue
ani 5fh ;mask and capitalize user input
cpi 'T' ;true?
jrz ifctrue
cpi 'Y' ;yes?
jrz ifctrue
cpi CR ;yes?
jrz ifctrue
jr ifcfalse
ENDIF ;IFOINPUT
;
; Condition: EXIST filename.typ
;
IF IFOEXIST
ifcex:
call tlog ;log into DU
lxi d,fcb2 ;pt to fcb
mvi c,17 ;search for first
call bdos
inr a ;set zero if error
jrz ifcfalse ;return FALSE
jr ifctrue ;return TRUE
ENDIF ;IFOEXIST
;
; Condition: EMPTY filename.typ
;
IF IFOEMPTY
ifcempty:
call tlog ;log into FCB2's DU
lxi d,fcb2 ;pt to fcb2
mvi c,15 ;open file
push d ;save fcb ptr
call bdos
pop d
inr a ;not found?
jrz ifctrue
mvi c,20 ;try to read a record
call bdos
ora a ;0=OK
jrnz ifctrue ;NZ if no read
jr ifcfalse
ENDIF ;IFOEMPTY
;
; Condition: ERROR
;
IF IFOERROR
ifcerror:
lda z3msg+6 ;get error byte
ora a ;0=TRUE
jrz ifctrue
jr ifcfalse
ENDIF ;IFOERROR
;
; **** Support Routines ****
;
;
; Convert chars in FCB2 into a number in B
;
IF IFOREG
getnum:
mvi b,0 ;set number
lxi h,fcb2+1 ;pt to first char
getn1:
mov a,m ;get char
inx h ;pt to next
sui '0' ;convert to binary
rc ;done if error
cpi 10 ;range?
rnc ;done if out of range
mov c,a ;value in C
mov a,b ;A=old value
add a ;*2
add a ;*4
add b ;*5
add a ;*10
add c ;add in new digit value
mov b,a ;result in B
jr getn1 ;continue processing
ENDIF ;IFOREG
;
; Log into DU in FCB2
;
IF NOT COMIF
tlog:
lda fcb2 ;get disk
ora a ;current?
jrnz 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 fcb2+13 ;pt to user
mov e,a
mvi c,32 ;set user
jmp bdos
;
ENDIF ;NOT COMIF
;
; Test of Negate Flag = negchar
;
IF IFONEG
negtest:
negflag equ $+1 ;pointer for in-the-code modification
mvi a,0 ;2nd byte is filled in
cpi negchar ;test for No
ret
ENDIF ;IFONEG
;
; Test FCB1 against a single digit (0-9)
; Return with register value in A and NZ if so
;
IF IFOREG
regtest:
ldax d ;get digit
sui '0'
jrc zret ;Z flag for no digit
cpi 10 ;range?
jrnc zret ;Z flag for no digit
lxi h,z3msg+30H ;pt to registers
add l ;pt to register
mov l,a
mov a,h ;add in H
aci 0
mov h,a
xra a ;set NZ
dcr a
mov a,m ;get register value
ret
zret:
xra a ;set Z
ret
ENDIF ;IFOREG
;
; Test to see if a current IF is running and if it is FALSE
; If so, return with Zero Flag Set (Z)
; If not, return with Zero Flag Clear (NZ)
; Affect only HL and PSW
;
iftest:
lxi h,z3msg+1 ;get IF flag
mov a,m ;test for active IF
ora a
jrz ifok ;no active IF
inx h ;pt to active flag
ana m ;check active flag
rz ;return Z since IF running and FALSE
ifok:
xra a ;return NZ for OK
dcr a
ret
;
; Test FCB1 against condition table (must have 2-char entries)
; Return with routine address in HL if match and NZ flag
;
IF NOT COMIF
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
jrnz condt2
ldax d ;get 2nd char
cmp m ;compare
jrnz 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
jr condt1
;
ENDIF ;NOT COMIF
;
; Turn on next IF level
; B register is 0 if level is inactive, 0FFH is level is active
; Return with
Z flag set if OK
;
ifset:
lxi h,z3msg+1 ;get IF flag
mov a,m
ora a ;if no if at all, start 1st one
jrz ifset1
cpi 80h ;check for overflow (8 IFs max)
jrz iferr
inx h ;pt to active IF byte
ana m ;check to see if current IF is TRUE
jrnz ifset0 ;if TRUE, proceed
mvi b,0 ;set False IF
ifset0:
dcx h ;pt to IF level
mov a,m ;get it
rlc ;advance to next level
ani 0feh ;only 1 bit on
mov m,a ;set IF byte
jr ifset2
ifset1:
inr a ;A=1
mov m,a ;set 1st IF
inx h ;clear active IF byte
mvi m,0
dcx h
ifset2:
mov d,a ;get IF byte
ana b ;set interested bit
mov b,a
inx h ;pt to active flag
mov a,d ;complement IF byte
cma
mov d,a
mov a,m ;get active byte
ana d ;mask in only uninterested bits
ora b ;mask in complement of interested bit
mov m,a ;save result
call ifstat ;print status
xra a ;return with Z
ret
iferr:
call print ;beep to indicate overflow
db bell+80H
xra a ;set NZ
dcr a
ret
;
; Test for Size Error
;
if ($ GT (FCP + FCPS*128))
sizerr equ novalue ;FCP is too large for buffer
endif
