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.
945 lines
17 KiB
945 lines
17 KiB
* 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.COM Processing *
|
|
;* *
|
|
;****************************************************************
|
|
|
|
;
|
|
; 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
|
|
|
|
end
|
|
|