MirrorRepos/RomWBW
1
0
Fork 1
mirror of https://github.com/wwarthen/RomWBW.git synced 2026-02-06 22:23:13 -06:00
Code Issues Projects Releases Wiki Activity
Files
ae287ca56d2cb0a52f609d199cd007299718fe0f
RomWBW/Source/Images/d_bp/u15/SYSRCP.ASM
Wayne Warthen 8bc4a40662 Overhaul disk image build process
2020-01-03 20:42:06 -08:00

2306 lines
44 KiB
NASM
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
* SYSTEM SEGMENT: SYS.RCP
* SYSTEM: ARIES-1
* CUSTOMIZED BY: RICHARD CONN
*
* PROGRAM: SYSRCP.ASM
* AUTHOR: RICHARD CONN
* VERSION: 1.0
* DATE: 3 FEB 84
* PREVIOUS VERSIONS: NONE
*
VERSION EQU 10
*
* SYSRCP is a resident command processor for ZCPR3. As with
* all resident command processors, SYSRCP performs the following functions:
*
* 1. Assuming that the EXTFCB contains the name of the
* command, SYSRCP looks to see if the first character
* of the file name field in the EXTFCB is a question
* mark; if so, it returns with the Zero Flag Set and
* HL pointing to the internal routine which prints
* its list of commands
* 2. The resident command list in SYSRCP is scanned for
* the entry contained in the file name field of
* EXTFCB; if found, SYSRCP returns with the Zero Flag
* Set and HL pointing to the internal routine which
* implements the function; if not found, SYSRCP returns
* with the Zero Flag Reset (NZ)
*
*
* Global Library which Defines Addresses for SYSRCP
*
MACLIB Z3BASE ; USE BASE ADDRESSES
MACLIB SYSRCP ; USE SYSRCP HEADER
;
CTRLC EQU 'C'-'@'
TAB EQU 09H
LF EQU 0AH
FF EQU 0CH
CR EQU 0DH
CTRLX EQU 'X'-'@'
;
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
DIRBUF EQU BASE+4000H ;DIR BUFFER (MANY ENTRIES PERMITTED)
PAGCNT EQU DIRBUF-100H ;PAGE COUNT BUFFER
OLDFCB EQU PAGCNT+1 ;OLD FCB BUFFER
CPBLOCKS EQU 32 ;USE 4K FOR BUFFERING OF COPY
;
$-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 on Jump Relative
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 rcp ; passed for Z3BASE
db 'Z3RCP' ; Flag for Package Loader
*
* **** Command Table for RCP ****
* This table is RCP-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 'H ' ; Help for RCP
dw clist
ctab1:
;
IF CPON
db 'CP ' ; Copy
dw copy
ENDIF ;CPON
;
IF DIRON
db 'DIR ' ; Directory
dw dir
ENDIF ;DIRON
;
IF ECHOON
db 'ECHO' ; Echo
dw echo
ENDIF
;
IF ERAON
db 'ERA ' ; Erase
dw era
ENDIF ;ERAON
;
IF LTON AND LISTON
db 'LIST' ; List
dw list
ENDIF ;LTON AND LISTON
;
IF NOTEON
db 'NOTE' ; Note-Comment-NOP Command
dw note
ENDIF
;
IF PEEKON
db 'P ' ; Peek into Memory
dw peek
ENDIF ;PEEKON
;
IF POKEON
db 'POKE' ; Poke Values into Memory
dw poke
ENDIF ;POKEON
;
IF PROTON
db 'PROT' ; Protection Codes
dw att
ENDIF ;PROTON
;
IF REGON
db 'REG ' ; Register Command
dw regcmd
ENDIF ;RSETON
;
IF RENON
db 'REN ' ; Rename
dw ren
ENDIF ;RENON
;
IF LTON
db 'TYPE' ; Type
dw type
ENDIF ;LTON
;
IF WHLON
db 'WHL ' ; Wheel
dw whl
db 'WHLQ' ; Wheel Query
dw whlmsg
ENDIF ;WHLON
;
db 0
*
* BANNER NAME OF RCP
*
rcp$name:
db 'SYS '
db (version/10)+'0','.',(version mod 10)+'0'
db RCPID
db 0
*
* Command List Routine
*
clist:
lxi h,rcp$name ; print RCP Name
call print1
lxi h,ctab1 ; print table entries
mvi c,1 ; set count for new line
clist1:
mov a,m ; done?
ora a
rz
dcr c ; count down
jrnz clist1a
call crlf ; new line
mvi c,4 ; set count
clist1a:
lxi d,entryname ; copy command name into message buffer
mvi b,cnsize ; number of chars
clist2:
mov a,m ; copy
stax d
inx h ; pt to next
inx d
dcr b
jnz clist2
inx h ; skip to next entry
inx h
push h ; save ptr
lxi h,entrymsg ; print message
call print1
pop h ; get ptr
jmp clist1
*
* 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
;
; This simple return doubles for the NOTE Command (NOP) and CONOUT Exit
; NOTE Command: NOTE any text
;
NOTE:
ret
*
* Print String (terminated in 0 or MSB Set) at Return Address
*
print:
xthl ; get address
call print1
xthl ; put address
ret
*
* Print String (terminated in 0 or MSB Set) pted to by HL
*
print1:
mov a,m ; done?
inx h ; pt to next
ora a ; 0 terminator
rz
call conout ; print char
rm ; MSB terminator
jmp print1
*
* CLIST Messages
*
entrymsg:
db ' ' ; command name prefix
entryname:
ds cnsize ; command name
db 0 ; terminator
*
* **** RCP Routines ****
* All code from here on is RCP-dependent!
*
;
;Section 5A
;Command: DIR
;Function: To display a directory of the files on disk
;Forms:
; DIR <afn> Displays the DIR files
; DIR <afn> S Displays the SYS files
; DIR <afn> A Display both DIR and SYS files
;Notes:
; The flag SYSFLG defines the letter used to display both DIR and
; SYS files (A in the above Forms section)
; The flag SOFLG defines the letter used to display only the SYS
; files (S in the above Forms section)
; The flag WIDE determines if the file names are spaced further
; apart (WIDE=TRUE) for 80-col screens
; The flag FENCE defines the character used to separate the file
; names
;
IF DIRON
DIR:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WDIR
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE ;SAVE RET ADDRESS AND SET STACK
LXI H,FCB1+1 ;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP
MOV A,M ;GET FIRST CHAR OF FILENAME.TYP
CPI ' ' ;IF <SP>, ALL WILD
CZ FILLQ
LDA FCB2+1 ;GET FIRST CHAR OF 2ND FILE NAME
MVI B,80H ;PREPARE FOR DIR-ONLY SELECTION
CPI ' ' ;ANY FLAG?
JRZ DIRPR ;THERE IS NO FLAG, SO DIR ONLY
MVI B,1 ;SET FOR BOTH DIR AND SYS FILES
CPI SYSFLG ;SYSTEM AND DIR FLAG SPECIFIER?
JRZ DIRPR ;GOT SYSTEM SPECIFIER
CPI SOFLG ;SYS ONLY?
JRNZ DIRPR
DCR B ;B=0 FOR SYS FILES ONLY
;
ENDIF ;DIRON
;
; DIRECTORY PRINT ROUTINE; ON ENTRY, B REG IS SET AS FOLLOWS:
; 0 FOR ONLY SYSTEM FILES, 80H FOR ONLY DIR FILES, 1 FOR BOTH
;
IF DIRON OR ERAON OR LTON OR PROTON OR CPON OR RENON
DIRPR:
MOV A,B ;GET SYSTST FLAG
CALL GETDIR ;LOAD AND SORT DIRECTORY
JZ PRFNF ;PRINT NO FILE MESSAGE
MVI E,4 ;COUNT DOWN TO 0
;
; ENTRY PRINT LOOP; ON ENTRY, HL PTS TO FILES SELECTED (TERMINATED BY 0)
; AND E IS ENTRY COUNTER
;
DIR3:
MOV A,M ;CHECK FOR DONE
ORA A
JZ EXIT ;EXIT IF DONE
MOV A,E ;GET ENTRY COUNTER
ORA A ;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE
CZ DIRCRLF ;NEW LINE
MOV A,E ;GET ENTRY COUNT
CPI 4 ;FIRST ENTRY?
JRZ DIR4
CALL PRINT
;
IF WIDE
;
DB ' ' ;2 SPACES
DB FENCE ;THEN FENCE CHAR
DB ' '+80H ;THEN 1 MORE SPACE
;
ELSE
;
DB ' ' ;SPACE
DB FENCE+80H ;THEN FENCE CHAR
;
ENDIF ;WIDE
;
DIR4:
CALL PRFN ;PRINT FILE NAME
CALL BREAK ;CHECK FOR ABORT
DCR E ;DECREMENT ENTRY COUNTER
JR DIR3
;
; CRLF FOR DIR ROUTINE
;
DIRCRLF:
PUSH PSW ;DON'T AFFECT PSW
CALL CRLF ;NEW LINE
POP PSW
MVI E,4 ;RESET ENTRY COUNTER
RET
;
; AFTER A SEARCH, RETURN NZ SET IF DESIRED TYPE OF FILE FOUND, Z IF NOT
; THIS ALGORITHM LOOKS AT THE SYSTEM BIT OF THE LOCATED FILE; THIS
; BIT IS SET TO 1 IF THE FILE IS A SYSTEM FILE AND 0 IF NOT A SYSTEM
; FILE. THE FOLLOWING EXCLUSIVE OR MASKS ARE APPLIED TO RETURN Z OR NZ
; AS REQUIRED BY THE CALLING PROGRAM:
;
; SYSTEM BYTE: X 0 0 0 0 0 0 0 (AFTER 80H MASK, X=1 IF SYS, 0 IF DIR)
;
; SYS-ONLY : 0 0 0 0 0 0 0 0 (XOR 0 = 0 if X=0, = 80H if X=1)
; DIR-ONLY : 1 0 0 0 0 0 0 0 (XOR 80H = 80h if X=0, = 0 if X=1)
; BOTH : 0 0 0 0 0 0 0 1 (XOR 1 = 81H or 1H, NZ in both cases)
;
GETSBIT:
DCR A ;ADJUST TO RETURNED VALUE
RRC ;CONVERT NUMBER TO OFFSET INTO TBUFF
RRC
RRC
ANI 60H
MOV C,A ;OFFSET INTO TBUFF IN C (C=OFFSET TO ENTRY)
LXI D,TBUFF ;PT TO BUFFER
MOV A,E ;BASE ADDRESS IN A
ADD C ;ADD IN ENTRY OFFSET
MOV E,A ;RESULT IN E
PUSH D ;SAVE PTR IN DE
ADI 10 ;ADD OFFSET OF 10 TO PT TO SYSTEM BYTE
MOV E,A ;SET ADDRESS
LDAX D ;GET BYTE
POP D ;GET PTR IN DE
ANI 80H ;LOOK AT ONLY SYSTEM BIT
SYSTST EQU $+1 ;IN-THE-CODE VARIABLE
XRI 0 ; IF SYSTST=0, SYS ONLY; IF SYSTST=80H, DIR
; ONLY; IF SYSTST=1, BOTH SYS AND DIR
RET ;NZ IF OK, Z IF NOT OK
;
; FILL FCB @HL WITH '?'
;
FILLQ:
MVI B,11 ;NUMBER OF CHARS IN FN & FT
MVI A,'?' ;STORE '?'
FILLP:
MOV M,A ;STORE BYTE
INX H ;PT TO NEXT
DJNZ FILLP ;COUNT DOWN
RET
;
; LOAD DIRECTORY AND SORT IT
; ON INPUT, A=SYSTST FLAG (0=SYS, 1=DIR, 80H=BOTH)
; DIRECTORY IS LOADED INTO DIRBUF
; RETURN WITH ZERO SET IF NO MATCH AND HL PTS TO 1ST ENTRY IF MATCH
;
GETDIR:
STA SYSTST ; SET SYSTEM TEST FLAG
CALL LOGUSR ; LOG INTO USER AREA OF FCB1
LXI H,DIRBUF ; PT TO DIR BUFFER
MVI M,0 ; SET EMPTY
LXI B,0 ; SET COUNTER
CALL SEARF ; LOOK FOR MATCH
RZ ; RETURN IF NOT FOUND
;
; STEP 1: LOAD DIRECTORY
;
GD1:
PUSH B ; SAVE COUNTER
CALL GETSBIT ; CHECK FOR SYSTEM OK
POP B
JRZ GD2 ; NOT OK, SO SKIP
PUSH B ; SAVE COUNTER
INX D ; PT TO FILE NAME
XCHG ; HL PTS TO FILE NAME, DE PTS TO BUFFER
MVI B,11 ; COPY 11 BYTES
CALL LDIR ; DO COPY
XCHG ; HL PTS TO NEXT BUFFER LOCATION
POP B ; GET COUNTER
INX B ; INCREMENT COUNTER
GD2:
CALL SEARN ; LOOK FOR NEXT
JRNZ GD1
MVI M,0 ; STORE ENDING 0
LXI H,DIRBUF ; PT TO DIR BUFFER
MOV A,M ; CHECK FOR EMPTY
ORA A
RZ
;
; STEP 2: SORT DIRECTORY
;
PUSH H ; SAVE PTR TO DIRBUF FOR RETURN
CALL DIRALPHA ; SORT
POP H
XRA A ; SET NZ FLAG FOR OK
DCR A
RET
;*
;* DIRALPHA -- ALPHABETIZES DIRECTORY IN DIRBUF; BC CONTAINS
;* THE NUMBER OF FILES IN THE DIRECTORY
;*
DIRALPHA:
MOV A,B ; ANY FILES?
ORA C
RZ
MOV H,B ; HL=BC=FILE COUNT
MOV L,C
SHLD N ; SET "N"
;*
;* SHELL SORT --
;* THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS"
;* BY KERNIGAN AND PLAUGHER, PAGE 106. COPYRIGHT, 1976, ADDISON-WESLEY.
;* ON ENTRY, BC=NUMBER OF ENTRIES
;*
N EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION
LXI H,0 ; NUMBER OF ITEMS TO SORT
SHLD GAP ; SET INITIAL GAP TO N FOR FIRST DIVISION BY 2
;* FOR (GAP = N/2; GAP > 0; GAP = GAP/2)
SRTL0:
ORA A ; CLEAR CARRY
GAP EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION
LXI H,0 ; GET PREVIOUS GAP
MOV A,H ; ROTATE RIGHT TO DIVIDE BY 2
RAR
MOV H,A
MOV A,L
RAR
MOV L,A
;* TEST FOR ZERO
ORA H
RZ ; DONE WITH SORT IF GAP = 0
SHLD GAP ; SET VALUE OF GAP
SHLD I ; SET I=GAP FOR FOLLOWING LOOP
;* FOR (I = GAP + 1; I <= N; I = I + 1)
SRTL1:
I EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION
LXI H,0 ; ADD 1 TO I
INX H
SHLD I
;* TEST FOR I <= N
XCHG ; I IS IN DE
LHLD N ; GET N
MOV A,L ; COMPARE BY SUBTRACTION
SUB E
MOV A,H
SBB D ; CARRY SET MEANS I > N
JRC SRTL0 ; DON'T DO FOR LOOP IF I > N
LHLD I ; SET J = I INITIALLY FOR FIRST SUBTRACTION OF GAP
SHLD J
;* FOR (J = I - GAP; J > 0; J = J - GAP)
SRTL2:
LHLD GAP ; GET GAP
XCHG ; ... IN DE
J EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION
LXI H,0 ; GET J
MOV A,L ; COMPUTE J - GAP
SUB E
MOV L,A
MOV A,H
SBB D
MOV H,A
SHLD J ; J = J - GAP
JRC SRTL1 ; IF CARRY FROM SUBTRACTIONS, J < 0 AND ABORT
MOV A,H ; J=0?
ORA L
JRZ SRTL1 ; IF ZERO, J=0 AND ABORT
;* SET JG = J + GAP
XCHG ; J IN DE
LHLD GAP ; GET GAP
DAD D ; J + GAP
SHLD JG ; JG = J + GAP
;* IF (V(J) <= V(JG))
CALL ICOMPARE ; J IN DE, JG IN HL
;* ... THEN BREAK
JRC SRTL1
;* ... ELSE EXCHANGE
LHLD J ; SWAP J, JG
XCHG
JG EQU $+1 ; POINTER FOR IN-THE-CODE MODIFICATION
LXI H,0
CALL ISWAP ; J IN DE, JG IN HL
;* END OF INNER-MOST FOR LOOP
JR SRTL2
;*
;* SWAP (Exchange) the elements whose indexes are in HL and DE
;*
ISWAP:
CALL IPOS ; COMPUTE POSITION FROM INDEX
XCHG
CALL IPOS ; COMPUTE 2ND ELEMENT POSITION FROM INDEX
MVI B,11 ; 11 BYTES TO FLIP
ISWAP1:
LDAX D ; GET BYTES
MOV C,M
MOV M,A ; PUT BYTES
MOV A,C
STAX D
INX H ; PT TO NEXT
INX D
DJNZ ISWAP1
RET
;*
;* ICOMPARE compares the entry pointed to by the pointer pointed to by HL
;* with that pointed to by DE (1st level indirect addressing); on entry,
;* HL and DE contain the numbers of the elements to compare (1, 2, ...);
;* on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)),
;* and Non-Zero and No-Carry means ((DE)) > ((HL))
;*
ICOMPARE:
CALL IPOS ; GET POSITION OF FIRST ELEMENT
XCHG
CALL IPOS ; GET POSITION OF 2ND ELEMENT
XCHG
;*
;* COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE;
;* NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE<HL
;* RET W/ZERO SET MEANS DE=HL
;*
IF NOT SORTNT ; TYPE AND NAME?
;*
;* COMPARE BY FILE TYPE AND FILE NAME
;*
PUSH H
PUSH D
LXI B,8 ; PT TO FT (8 BYTES)
DAD B
XCHG
DAD B
XCHG ; DE, HL NOW PT TO THEIR FT'S
MVI B,3 ; 3 BYTES
CALL COMP ; COMPARE FT'S
POP D
POP H
RNZ ; CONTINUE IF COMPLETE MATCH
MVI B,8 ; 8 BYTES
JR COMP ; COMPARE FN'S
;
ELSE ; NAME AND TYPE
;*
;* COMPARE BY FILE NAME AND FILE TYPE
;*
MVI B,11 ; COMPARE FN, FT AND FALL THRU TO COMP
;*
;* COMP COMPARES DE W/HL FOR B BYTES; RET W/CARRY IF DE<HL
;* MSB IS DISREGARDED
;*
COMP:
MOV A,M ; GET (HL)
ANI 7FH ; MASK MSB
MOV C,A ; ... IN C
LDAX D ; COMPARE
ANI 7FH ; MASK MSB
CMP C
RNZ
INX H ; PT TO NEXT
INX D
DJNZ COMP ; COUNT DOWN
RET
;
ENDIF ; NOT SORTNT
;*
;* Compute physical position of element whose index is in HL; on exit, HL
;* is the physical address of this element; Indexes are 1..N
;*
IPOS:
DCX H ; HL=(HL-1)*11+DIRBUF
MOV B,H ; BC=HL
MOV C,L
DAD H ; HL=HL*2
DAD H ; HL=HL*4
DAD B ; HL=HL*5
DAD H ; HL=HL*10
DAD B ; HL=HL*11
LXI B,DIRBUF ; ADD IN DIRBUF
DAD B
RET
;
ENDIF ;DIRON OR ERAON OR LTON OR PROTON OR CPON OR RENON
;
;Section 5B
;Command: ERA
;Function: Erase files
;Forms:
; ERA <afn> Erase Specified files and print their names
; ERA <afn> I Erase Specified files and print their names, but ask
; for verification before Erase is done
;
IF ERAON
ERA:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WERA
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
LDA FCB2+1 ;GET ERAFLG IF IT'S THERE
STA ERAFLG ;SAVE IT AS A FLAG
MVI A,1 ;DIR FILES ONLY
CALL GETDIR ;LOAD DIRECTORY OF FILES
JZ PRFNF ;ABORT IF NO FILES
;
; MAIN ERASE LOOP
;
ERA1:
PUSH H ;SAVE PTR TO FILE
CALL PRFN ;PRINT ITS NAME
SHLD NXTFILE ;SAVE PTR TO NEXT FILE
POP H ;GET PTR TO THIS FILE
CALL ROTEST ;TEST FILE PTED TO BY HL FOR R/O
JRNZ ERA3
ERAFLG EQU $+1 ;ADDRESS OF FLAG
MVI A,0 ;2ND BYTE IS FLAG
CPI 'I' ;IS IT AN INSPECT OPTION?
JRNZ ERA2 ;SKIP PROMPT IF IT IS NOT
CALL ERAQ ;ERASE?
JRNZ ERA3 ;SKIP IF NOT
ERA2:
LXI D,FCB1+1 ;COPY INTO FCB1
MVI B,11 ;11 BYTES
CALL LDIR
CALL INITFCB1 ;INIT FCB
MVI C,19 ;DELETE FILE
CALL BDOS
ERA3:
LHLD NXTFILE ;HL PTS TO NEXT FILE
MOV A,M ;GET CHAR
ORA A ;DONE?
JZ EXIT
CALL CRLF ;NEW LINE
JR ERA1
;
ENDIF ;ERAON
;
;Section 5C
;Command: LIST
;Function: Print out specified file on the LST: Device
;Forms:
; LIST <afn> Print file (NO Paging)
;Notes:
; The flags which apply to TYPE do not take effect with LIST
;
IF LTON
LIST:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WLIST
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
MVI A,0FFH ;TURN ON PRINTER FLAG
JR TYPE0
;
;Section 5D
;Command: TYPE
;Function: Print out specified file on the CON: Device
;Forms:
; TYPE <afn> Print file
; TYPE <afn> P Print file with paging flag
;Notes:
; The flag PGDFLG defines the letter which toggles the paging
; facility (P in the forms section above)
; The flag PGDFLT determines if TYPE is to page by default
; (PGDFLT=TRUE if TYPE pages by default); combined with
; PGDFLG, the following events occur --
; If PGDFLT = TRUE, PGDFLG turns OFF paging
; If PGDFLT = FALSE, PGDFLG turns ON paging
;
TYPE:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WTYPE
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
XRA A ;TURN OFF PRINTER FLAG
;
; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
;
TYPE0:
STA PRFLG ;SET FLAG
LDA FCB2+1 ;GET PAGE FLAG
STA PGFLG ;SAVE IT AS A FLAG
MVI A,1 ;SELECT DIR FILES
CALL GETDIR ;ALLOW AMBIGUOUS FILES
JZ PRFNF ;NO FILES
SHLD NXTFILE ;SET PTR TO NEXT FILE
JR TYPEX2
TYPEX:
LHLD NXTFILE ;GET PTR TO NEXT FILE
MOV A,M ;ANY FILES?
ORA A
JZ EXIT
LDA PRFLG ;CHECK FOR LIST OUTPUT
ORA A ;0=TYPE
JRZ TYPEX1
MVI A,CR ;BOL ON PRINTER
CALL LCOUT
MVI A,FF ;FORM FEED THE PRINTER
CALL LCOUT
JR TYPEX2
TYPEX1:
CALL PAGEBREAK ;PAGE BREAK MESSAGE
TYPEX2:
LXI D,FCB1+1 ;COPY INTO FCB1
MVI B,11 ;11 BYTES
CALL LDIR
SHLD NXTFILE ;SET PTR TO NEXT FILE
CALL INITFCB1 ;INIT FCB1
MVI C,15 ;OPEN FILE
CALL BDOS
INR A ;SET ERROR FLAG
JZ PRFNF ;ABORT IF ERROR
MVI A,NLINES-2 ;SET LINE COUNT
STA PAGCNT
MVI A,CR ;NEW LINE
CALL LCOUT
MVI A,LF
CALL LCOUT
LXI B,080H ;SET CHAR POSITION AND TAB COUNT
; (B=0=TAB, C=080H=CHAR POSITION)
;
; MAIN LOOP FOR LOADING NEXT BLOCK
;
TYPE2:
MOV A,C ;GET CHAR COUNT
CPI 80H
JRC TYPE3
PUSH H ;READ NEXT BLOCK
PUSH B
LXI D,FCB1 ;PT TO FCB
MVI C,20 ;READ RECORD
CALL BDOS
ORA A ;SET FLAGS
POP B
POP H
JRNZ TYPE7 ;END OF FILE?
MVI C,0 ;SET CHAR COUNT
LXI H,TBUFF ;PT TO FIRST CHAR
;
; MAIN LOOP FOR PRINTING CHARS IN TBUFF
;
TYPE3:
MOV A,M ;GET NEXT CHAR
ANI 7FH ;MASK OUT MSB
CPI 1AH ;END OF FILE (^Z)?
JRZ TYPE7 ;NEXT FILE IF SO
;
; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION
;
CPI CR ;RESET TAB COUNT?
JRZ TYPE4
CPI LF ;RESET TAB COUNT?
JRZ TYPE4
CPI TAB ;TAB?
JRZ TYPE5
;
; OUTPUT CHAR AND INCREMENT CHAR COUNT
;
CALL LCOUT ;OUTPUT CHAR
JZ TYPEX ;SKIP
INR B ;INCREMENT TAB COUNT
JR TYPE6
;
; OUTPUT <CR> OR <LF> AND RESET TAB COUNT
;
TYPE4:
CALL LCOUT ;OUTPUT <CR> OR <LF>
JZ TYPEX ;SKIP
MVI B,0 ;RESET TAB COUNTER
JR TYPE6
;
; TABULATE
;
TYPE5:
MVI A,' ' ;<SP>
CALL LCOUT
JZ TYPEX ;SKIP
INR B ;INCR POS COUNT
MOV A,B
ANI 7
JRNZ TYPE5
;
; CONTINUE PROCESSING
;
TYPE6:
INR C ;INCREMENT CHAR COUNT
INX H ;PT TO NEXT CHAR
CALL BREAK ;CHECK FOR ABORT
JZ TYPEX ;SKIP
JR TYPE2
TYPE7:
LXI D,FCB1 ;CLOSE FILE
MVI C,16 ;BDOS FUNCTION
CALL BDOS
JMP TYPEX
;
; SEND OUTPUT TO LST: OR CON:, AS PER THE FLAG
; RETURN WITH Z IF ABORT
;
LCOUT:
PUSH H ;SAVE REGS
PUSH D
PUSH B
MOV E,A ;CHAR IN E
MVI C,2 ;OUTPUT TO CON:
PRFLG EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
MVI A,0 ;2ND BYTE IS THE PRINT FLAG
ORA A ;0=TYPE
JRZ LC1
MVI C,5 ;OUTPUT TO LST:
LC1:
PUSH D ;SAVE CHAR
CALL BDOS ;OUTPUT CHAR IN E
POP D ;GET CHAR
MOV A,E
CPI LF
JRNZ LC2
LDA PRFLG ;OUTPUT TO LST:?
ORA A ;NZ = YES
JRNZ LC2
;
; CHECK FOR PAGING
;
LXI H,PAGCNT ;COUNT DOWN
DCR M
JRNZ LC2 ;JUMP IF NOT END OF PAUSE
MVI M,NLINES-2 ;REFILL COUNTER
PGFLG EQU $+1 ;POINTER TO IN-THE-CODE BUFFER
MVI A,0 ;2ND BYTE IS THE PAGING FLAG
CPI PGDFLG ;PAGE DEFAULT OVERRIDE OPTION WANTED?
;
IF PGDFLT ;IF PAGING IS DEFAULT
;
JRZ LC2 ;PGDFLG MEANS NO PAGING
;
ELSE
;
JRNZ LC2 ;PGDFLG MEANS PAGE
;
ENDIF ;PGDFLT
;
CALL PAGEBREAK ;PRINT PAGE BREAK MESSAGE
JR LC3 ;Z TO SKIP
LC2:
XRA A ;SET OK
DCR A ;NZ=OK
LC3:
POP B ;RESTORE REGS
POP D
POP H
RET
;
; PRINT PAGE BREAK MESSAGE AND GET USER INPUT
; ABORT IF ^C, RZ IF ^X
;
PAGEBREAK:
PUSH H ;SAVE HL
CALL PRINT
DB cr,lf,' Typing',' '+80H
LXI H,FCB1+1 ;PRINT FILE NAME
CALL PRFN
CALL DASH ;PRINT DASH
CALL CONIN ;GET INPUT
POP H ;RESTORE HL
PUSH PSW
CALL CRLF ;NEW LINE
POP PSW
CPI CTRLC ;^C
JZ EXIT
CPI CTRLX ;SKIP?
RET
;
ENDIF ;LTON
;
;Section 5E
;Command: REN
;Function: To change the name of an existing file
;Forms:
; REN <New ufn>=<Old ufn> Perform function
;
IF RENON
REN:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WREN
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
;
;
; STEP 1: CHECK FOR FILE 2 BEING AMBIGUOUS
;
LXI H,FCB2+1 ;CAN'T BE AMBIGUOUS
CALL AMBCHK1
;
; STEP 2: LOG INTO USER AREA
;
CALL LOGUSR ;LOG INTO USER AREA OF FCB1
;
; STEP 3: SEE IF NEW FILE ALREADY EXISTS
; EXTEST PERFORMS A NUMBER OF CHECKS:
; 1) AMBIGUITY
; 2) R/O
; 3) IF FILE EXISTS AND NOT R/O, PERMISSION TO DELETE
;
CALL EXTEST
JZ EXIT ;R/O OR NO PERMISSION
;
; STEP 4: EXCHANGE FILE NAME FIELDS FOR RENAME
;
LXI H,FCB1 ;EXCHANGE NAMES ONLY
PUSH H ;SAVE PTR
INX H
LXI D,FCB2+1
MVI B,11 ;11 BYTES
REN1:
LDAX D ;GET OLD
MOV C,A
MOV A,M
STAX D ;PUT NEW
MOV M,C
INX H ;PT TO NEXT
INX D
DJNZ REN1
;
; STEP 5: SEE IF OLD FILE IS R/O
;
CALL SEARF ;LOOK FOR FILE
JZ PRFNF
CALL GETSBIT ;GET PTR TO ENTRY IN TBUFF
XCHG ;HL PTS TO ENTRY
INX H ;PT TO FN
CALL ROTEST ;SEE IF FILE IS R/O
JNZ EXIT
;
; STEP 6: RENAME THE FILE
;
POP D ;GET PTR TO FCB
MVI C,23 ;RENAME
CALL BDOS
INR A ;SET ZERO FLAG IF ERROR
JZ PRFNF ;PRINT NO SOURCE FILE MESSAGE
JMP EXIT
;
ENDIF ;RENON
;
;Section 5F
;Command: PROT
;Function: To set the attributes of a file (R/O and SYS)
;
;Form:
; PROT afn RSI
;If either R or S are omitted, the file is made R/W or DIR, resp;
;R and S may be in any order. If I is present, Inspection is enabled.
;
IF PROTON
ATT:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WPROT
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
XRA A ;SET NO INSPECT
STA INSPECT
LXI H,0 ;SET R/O AND SYS ATTRIBUTES OFF
LXI D,FCB2+1 ;PT TO ATTRIBUTES
MVI B,3 ;3 CHARS MAX
ATT1:
LDAX D ;GET CHAR
INX D ;PT TO NEXT
CPI 'I' ;INSPECT?
JRZ ATTI
CPI 'R' ;SET R/O?
JRZ ATTR
CPI 'S' ;SET SYS?
JRZ ATTS
ATT2:
DJNZ ATT1
JR ATT3
ATTI:
STA INSPECT ;SET FLAG
JR ATT2
ATTR:
MVI H,80H ;SET R/O BIT
JR ATT2
ATTS:
MVI L,80H ;SET SYS BIT
JR ATT2
ATT3:
SHLD FATT ;SAVE FILE ATTRIBUTES
MVI A,1 ;SELECT DIR AND SYS FILES
CALL GETDIR ;LOAD DIRECTORY
JZ PRFNF ;NO FILE ERROR
SHLD NXTFILE ;PT TO NEXT FILE
JR ATT5
ATT4:
LHLD NXTFILE ;PT TO NEXT FILE
MOV A,M ;END OF LIST?
ORA A
JZ EXIT
CALL CRLF ;NEW LINE
ATT5:
PUSH H ;SAVE PTR TO CURRENT FILE
CALL PRFN ;PRINT ITS NAME
SHLD NXTFILE ;SAVE PTR TO NEXT FILE
CALL PRINT
DB ' Set to R','/'+80H
LHLD FATT ;GET ATTRIBUTES
MVI C,'W' ;ASSUME R/W
MOV A,H ;GET R/O BIT
ORA A
JRZ ATT6
MVI C,'O' ;SET R/O
ATT6:
MOV A,C ;GET CHAR
CALL CONOUT
MOV A,L ;GET SYS FLAG
ORA A ;SET FLAG
JRZ ATT7
CALL PRINT
DB ' and SY','S'+80H
ATT7:
INSPECT EQU $+1 ;PTR FOR IN-THE-CODE MODIFICATION
MVI A,0 ;GET INSPECT FLAG
ORA A ;Z=NO
POP H ;GET PTR TO CURRENT FILE
JRZ ATT8
CALL ERAQ1 ;ASK FOR Y/N
JRNZ ATT4 ;ADVANCE TO NEXT FILE IF NOT Y
ATT8:
LXI D,FCB1+1 ;COPY INTO FCB1
MVI B,11 ;11 BYTES
CALL LDIR
FATT EQU $+1 ;PTR FOR IN-THE-CODE MODIFICATION
LXI H,0 ;GET ATTRIBUTES
DCX D ;PT TO SYS BYTE
DCX D
MOV A,L ;GET SYS FLAG
CALL ATTSET ;SET ATTRIBUTE CORRECTLY
DCX D ;PT TO R/O BYTE
MOV A,H ;GET R/O FLAG
CALL ATTSET
LXI D,FCB1 ;PT TO FCB
MVI C,30 ;SET ATTRIBUTES
CALL BDOS
JR ATT4
ATTSET:
ORA A ;0=CLEAR ATTRIBUTE
JRZ ATTST1
LDAX D ;GET BYTE
ORI 80H ;SET ATTRIBUTE
STAX D
RET
ATTST1:
LDAX D ;GET BYTE
ANI 7FH ;CLEAR ATTRIBUTE
STAX D
RET
;
ENDIF ;PROTON
;
;Section 5G
;Command: CP
;Function: To copy a file from one place to another
;
;Form:
; CP new=old
;
IF CPON
COPY:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WCP
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
;
; STEP 0: IF NEW IS BLANK, MAKE IT THE SAME NAME AND TYPE AS OLD
;
LXI D,FCB1+1 ;PT TO NEW FILE NAME
LDAX D ;GET FIRST CHAR
CPI ' ' ;NO NAME?
JRNZ COPY0
LXI H,FCB2+1 ;MAKE SAME AS OLD
MVI B,11 ;11 BYTES
CALL LDIR
;
; STEP 1: SEE IF NEW=OLD AND ABORT IF SO
;
COPY0:
LXI H,FCB1 ;PT TO NEXT
LXI D,FCB2 ;PT TO OLD
PUSH H ;SAVE PTRS
PUSH D
INX H ;PT TO FILE NAME
INX D
MVI B,13 ;COMPARE 13 BYTES
COPY1:
LDAX D ;GET OLD
CMP M ;COMPARE TO NEW
JRNZ COPY2
INX H ;PT TO NEXT
INX D
DJNZ COPY1
MVI C,25 ;GET CURRENT DISK
CALL BDOS
INR A ;MAKE 1..P
MOV B,A ;CURRENT DISK IN B
POP D ;GET PTR TO DN
POP H
LDAX D ;GET DISK
MOV C,A ;... IN C
ORA A ;CURRENT?
JRNZ COPY1A
MOV C,B ;MAKE C CURRENT
COPY1A:
MOV A,M ;GET DISK
ORA A ;CURRENT?
JRNZ COPY1B
MOV A,B ;MAKE A CURRENT
COPY1B:
CMP C ;SAME DISK ALSO?
JRNZ COPY3 ;CONTINUE WITH OPERATION
JR CPERR
COPY2:
POP D ;GET PTRS
POP H
;
; STEP 2: SET USER NUMBERS
;
COPY3:
LDA FCB1+13 ;GET NEW USER
STA USRNEW
LDA FCB2+13 ;GET OLD USER
STA USROLD
;
; STEP 3: SEE IF OLD FILE EXISTS
;
LXI H,OLDFCB ;COPY OLD INTO 2ND FCB
PUSH H ;SAVE PTR TO 2ND FCB
XCHG
MVI B,14 ;14 BYTES
CALL LDIR
CALL LOGOLD ;LOG IN USER NUMBER OF OLD FCB
POP H ;GET PTR TO 2ND FCB
CALL INITFCB2 ;INIT FCB
MVI C,17 ;LOOK FOR FILE
CALL BDOS
INR A ;CHECK FOR ERROR
JZ PRFNF ;FILE NOT FOUND
;
; STEP 4: SEE IF NEW EXISTS
;
CALL LOGNEW ;LOG INTO NEW'S USER AREA
CALL EXTEST ;TEST
JZ EXIT ;ERROR EXIT
;
; STEP 5: CREATE NEW
;
LXI D,FCB1 ;PT TO FCB
MVI C,22 ;MAKE FILE
CALL BDOS
INR A ;ERROR?
JRNZ COPY4
;
; COPY ERROR
;
CPERR:
CALL PRINT
DB ' Copy','?'+80H
JMP EXIT
;
; STEP 6: OPEN OLD
;
COPY4:
CALL LOGOLD ;GET USER
LXI H,OLDFCB ;PT TO FCB
CALL INITFCB2 ;INIT FCB
MVI C,15 ;OPEN FILE
CALL BDOS
;
; STEP 7: COPY OLD TO NEW WITH BUFFERING
;
COPY5:
CALL LOGOLD ;GET USER
MVI B,0 ;SET COUNTER
LXI H,TPA ;SET NEXT ADDRESS TO COPY INTO
COPY5A:
PUSH H ;SAVE ADDRESS AND COUNTER
PUSH B
LXI D,OLDFCB ;READ BLOCK FROM FILE
MVI C,20
CALL BDOS
POP B ;GET COUNTER AND ADDRESS
POP D
ORA A ;OK?
JRNZ COPY5B
PUSH B ;SAVE COUNTER
LXI H,TBUFF ;COPY FROM BUFFER
MVI B,128 ;128 BYTES
CALL LDIR
XCHG ;HL PTS TO NEXT
POP B ;GET COUNTER
INR B ;INCREMENT IT
MOV A,B ;DONE?
CPI CPBLOCKS ;DONE IF CPBLOCKS LOADED
JRNZ COPY5A
COPY5B:
MOV A,B ;GET COUNT
ORA A
JRZ COPY6 ;DONE IF NOTHING LOADED
PUSH B ;SAVE COUNT
CALL LOGNEW ;GET USER
LXI H,TPA ;PT TO TPA
COPY5C:
LXI D,TBUFF ;COPY INTO TBUFF
MVI B,128 ;128 BYTES
CALL LDIR
PUSH H ;SAVE PTR TO NEXT
LXI D,FCB1 ;PT TO FCB
MVI C,21 ;WRITE BLOCK
CALL BDOS
ORA A
JRNZ CPERR ;COPY ERROR
POP H ;GET PTR TO NEXT BLOCK
POP B ;GET COUNT
DCR B ;COUNT DOWN
JRZ COPY5 ;GET NEXT
PUSH B ;SAVE COUNT
JR COPY5C
;
; STEP 8: CLOSE FILES
;
COPY6:
CALL LOGOLD ;GET USER
LXI D,OLDFCB ;PT TO FCB
MVI C,16 ;CLOSE FILE
CALL BDOS
CALL LOGNEW ;GET USER
LXI D,FCB1 ;PT TO FCB
MVI C,16 ;CLOSE FILE
CALL BDOS
CALL PRINT
DB ' Don','e'+80H
JMP EXIT
;
; LOG INTO USER NUMBER OF OLD FILE
;
LOGOLD:
USROLD EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
MVI A,0 ;GET NUMBER
JMP SETUSR
;
; LOG INTO USER NUMBER OF NEW FILE
;
LOGNEW:
USRNEW EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
MVI A,0 ;GET NUMBER
JMP SETUSR
;
ENDIF ;CPON
;
;Section 5H
;Command: PEEK
;Function: Display memory
;
;Form:
; PEEK startadr - 256 bytes displayed
; PEEK startadr endadr - range of bytes displayed
;
IF PEEKON
PEEK:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WPEEK
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
LXI H,TBUFF+1 ;FIND FIRST NUMBER
NXTPEEK EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
LXI D,0 ;DEFAULT PEEK ADDRESS IF NONE
CALL SKSP ;SKIP TO NON-BLANK
CNZ HEXNUM ;GET START ADDRESS IF ANY (ELSE DEFAULT)
CALL PRINT
DB ' Pee','k'+80H
CALL ADRAT ;PRINT ADDRESS MESSAGE
PUSH D ;SAVE IT
LXI B,256 ;COMPUTE END ADDRESS
XCHG
DAD B
XCHG ;END ADDRESS IN DE
CALL SKSP ;SKIP TO NON-BLANK
JRZ PEEK1 ;PROCESS
CALL HEXNUM ;GET 2ND NUMBER IN DE
PEEK1:
POP H ;HL IS START ADDRESS, DE IS END ADDRESS
CALL PEEK2 ;DO PEEK
SHLD NXTPEEK ;SET CONTINUED PEEK ADDRESS
JMP EXIT
;
; DISPLAY LOOP
;
PEEK2:
MOV A,D ;SEE IF DE<=HL
CMP H
RC ;OUT OF BOUNDS
JRNZ PEEK2A ;HL > DE
MOV A,E
CMP L
RZ
RC
PEEK2A:
CALL CRLF ;NEW LINE
MOV A,H ;PRINT ADDRESS
CALL PASHC
MOV A,L
CALL PAHC
CALL DASH ;PRINT LEADER
MVI B,16 ;16 BYTES TO DISPLAY
PUSH H ;SAVE START ADDRESS
PEEK3:
MOV A,M ;GET NEXT BYTE
CALL PASHC ;PRINT WITH LEADING SPACE
INX H ;PT TO NEXT
DJNZ PEEK3
POP H ;PT TO FIRST
MVI B,16 ;16 BYTES
MVI A,' ' ;SPACE AND FENCE
CALL CONOUT
CALL PRINT
DB FENCE+80H
PEEK4:
MOV A,M ;GET NEXT BYTE
MVI C,'.' ;ASSUME DOT
ANI 7FH ;MASK IT
CPI ' ' ;DOT IF LESS THAN SPACE
JRC PEEK5
CPI 7FH ;DON'T PRINT DEL
JRZ PEEK5
MOV C,A ;CHAR IN C
PEEK5:
MOV A,C ;GET CHAR
CALL CONOUT ;SEND IT
INX H ;PT TO NEXT
DJNZ PEEK4
CALL PRINT ;CLOSING FENCE
DB FENCE+80H
CALL BREAK ;ALLOW ABORT
JR PEEK2
;
ENDIF ;PEEKON
;
; PRINT A AS 2 HEX CHARS
; PASHC - LEADING SPACE
;
IF PEEKON OR POKEON
PASHC:
PUSH PSW ;SAVE A
CALL PRINT
DB ' '+80H
POP PSW
PAHC:
PUSH B ;SAVE BC
MOV C,A ;BYTE IN C
RRC ;EXCHANGE NYBBLES
RRC
RRC
RRC
CALL PAH ;PRINT HEX CHAR
MOV A,C ;GET LOW
POP B ;RESTORE BC AND FALL THRU TO PAH
PAH:
ANI 0FH ;MASK
ADI '0' ;CONVERT TO ASCII
CPI '9'+1 ;LETTER?
JRC PAH1
ADI 7 ;ADJUST TO LETTER
PAH1:
JMP CONOUT
;
ENDIF ;PEEKON OR POKEON
;
;Section 5I
;Command: POKE
;Function: Place Values into Memory
;
;Form:
; POKE startadr val1 val2 ...
;
IF POKEON
POKE:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
IF WPOKE
CALL WHLTST
ENDIF ;WHEEL APPROVAL
;
CALL RETSAVE
LXI H,TBUFF+1 ;PT TO FIRST CHAR
CALL SKSP ;SKIP TO NON-BLANK
JRZ NOARGS ;ARG ERROR
CALL HEXNUM ;CONVERT TO NUMBER
CALL PRINT
DB ' Pok','e'+80H
CALL ADRAT ;PRINT AT MESSAGE
;
; LOOP FOR STORING HEX VALUES SEQUENTIALLY VIA POKE
;
POKE1:
PUSH D ;SAVE ADDRESS
CALL SKSP ;SKIP TO NON-BLANK
JZ EXIT ;DONE
CPI '"' ;QUOTED TEXT?
JRZ POKE2
CALL HEXNUM ;GET NUMBER
MOV A,E ;GET LOW
POP D ;GET ADDRESS
STAX D ;STORE NUMBER
INX D ;PT TO NEXT
JR POKE1
;
; STORE ASCII CHARS
;
POKE2:
POP D ;GET NEXT ADDRESS
INX H ;PT TO NEXT CHAR
POKE3:
MOV A,M ;GET NEXT CHAR
ORA A ;DONE?
JZ EXIT
STAX D ;PUT CHAR
INX H ;PT TO NEXT
INX D
JR POKE3
;
; No Argument Error
;
NOARGS:
CALL PRINT
DB ' Arg','?'+80H
JMP EXIT
;
ENDIF ;POKEON
;
;Section 5J
;Command: REG
;Function: Manipulate Memory Registers
;
;Forms:
; REG D or REG <-- Display Register Value
; REG Mreg <-- Decrement Register Value
; REG Preg <-- Increment Register Value
; REG Sreg value <-- Set Register Value
;
IF REGON
REGCMD:
LXI H,FCB1+1 ;PT TO FIRST ARG
MOV A,M ;GET FIRST CHAR
PUSH PSW ;SAVE CHAR
CPI 'A' ;ASSUME DIGIT IF LESS THAN 'A'
JRC REGC1
INX H ;PT TO DIGIT
REGC1:
MOV A,M ;GET DIGIT
CALL REGPTR ;PT TO REGISTER
POP PSW ;GET CHAR
CPI 'S' ;SET?
JRZ RSET
CPI 'P' ;PLUS?
JRZ RINC
CPI 'M' ;MINUS?
JRZ RDEC
;
; SHOW REGISTER VALUES
;
RSHOW:
XRA A ;SELECT REGISTER 0
MOV B,A ;COUNTER SET TO 0 IN B
CALL REGP2 ;HL PTS TO REGISTER 0
RSHOW1:
MOV A,B ;GET COUNTER VALUE
CPI 10
JZ CRLF ;NEW LINE AND EXIT IF DONE
CALL PRINT
DB ' Reg',' '+80H
MOV A,B ;PRINT REGISTER NUMBER
ADI '0'
CALL CONOUT
CALL PRINT
DB ' ','='+80H
PUSH B ;SAVE COUNTER
CALL REGOUT ;PRINT REGISTER VALUE
POP B ;GET COUNTER
INR B ;INCREMENT COUNTER
MOV A,B ;CHECK FOR NEW LINE
ANI 3
CZ CRLF
INX H ;PT TO NEXT REGISTER
JR RSHOW1
;
; INCREMENT REGISTER VALUE
; HL PTS TO MEMORY REGISTER ON INPUT
;
RINC:
INR M ;INCREMENT IT
JR REGOUT ;PRINT RESULT
;
; DECREMENT REGISTER VALUE
; HL PTS TO MEMORY REGISTER ON INPUT
;
RDEC:
DCR M ;DECREMENT VALUE
JR REGOUT ;PRINT RESULT
;
; SET REGISTER VALUE
; HL PTS TO REGISTER ON INPUT
;
RSET:
LXI D,FCB2+1 ;PT TO VALUE
MVI B,0 ;INIT VALUE TO ZERO
RSET1:
LDAX D ;GET NEXT DIGIT
INX D ;PT TO NEXT
SUI '0' ;CONVERT TO BINARY
JRC RSET2
CPI 10 ;RANGE?
JRNC RSET2
MOV C,A ;DIGIT IN C
MOV A,B ;MULTIPLY OLD BY 10
ADD A ;*2
ADD A ;*4
ADD B ;*5
ADD A ;*10
ADD C ;ADD IN NEW DIGIT
MOV B,A ;RESULT IN B
JR RSET1
RSET2:
MOV M,B ;SET VALUE
REGOUT:
CALL PRINT ;PRINT LEADING SPACE
DB ' '+80H
MOV A,M ;GET REGISTER VALUE
MVI B,100 ;PRINT 100'S
MVI C,0 ;SET LEADING SPACE FLAG
CALL DECB ;PRINT 100'S
MVI B,10 ;PRINT 10'S
CALL DECB ;PRINT 10'S
ADI '0' ;PRINT 1'S
JMP CONOUT
;
; SUBTRACT B FROM A UNTIL CARRY, THEN PRINT DIGIT COUNT
;
DECB:
MVI D,'0' ;SET DIGIT
DECB1:
SUB B ;SUBTRACT
JRC DECB2
INR D ;ADD 1 TO DIGIT CHAR
JR DECB1
DECB2:
ADD B ;ADD BACK IN
MOV E,A ;SAVE A IN E
MOV A,D ;GET DIGIT CHAR
CPI '0' ;LEADING ZERO CHECK
JRNZ DECB3
MOV A,C ;ANY LEADING DIGIT YET?
ORA A
JRZ DECB4
DECB3:
MOV A,D ;GET DIGIT CHAR
CALL CONOUT ;PRINT IT
INR C ;SET C<>0 FOR LEADING DIGIT CHECK
DECB4:
MOV A,E ;RESTORE A FOR NEXT ROUND
RET
;
; SET HL TO POINT TO MEMORY REGISTER WHOSE INDEX IS PTED TO BY HL
; ON INPUT, A CONTAINS REGISTER CHAR
; ON OUTPUT, HL = ADDRESS OF MEMORY REGISTER (REG 0 ASSUMED IF ERROR)
;
REGPTR:
MVI B,0 ;INIT TO ZERO
SUI '0' ;CONVERT
JRC REGP1
CPI 10 ;RANGE
JRNC REGP1
MOV B,A ;VALUE IN B
REGP1:
MOV A,B ;VALUE IN A
REGP2:
LXI H,Z3MSG+30H ;PT TO MEMORY REGISTERS
ADD L ;PT TO PROPER REGISTER
MOV L,A
MOV A,H
ACI 0
MOV H,A ;HL PTS TO REGISTER
RET
;
ENDIF ;REGON
;
;Section 5K
;Command: WHL/WHLQ
;Function: Set the Wheel Byte on or off
;
;Form:
; WHL -- turn Wheel Byte OFF
; WHL password -- turn Wheel Byte ON if password is correct
; WHLQ -- find out status of Wheel Byte
;
IF WHLON
WHL:
LXI H,FCB1+1 ;PT TO FIRST CHAR
MOV A,M ;GET IT
CPI ' ' ;TURN BYTE OFF IF NO PASSWORD
JRZ WHLOFF
LXI D,WHLPASS
MVI B,8 ;CHECK 8 CHARS
WHL1:
LDAX D ;GET CHAR
CMP M ;COMPARE
JRNZ WHLMSG
INX H ;PT TO NEXT
INX D
DJNZ WHL1
;
; TURN ON WHEEL BYTE
;
MVI A,0FFH ;TURN ON WHEEL BYTE
JR WHLSET
;
; TURN OFF WHEEL BYTE
;
WHLOFF:
XRA A ;TURN OFF WHEEL BYTE
WHLSET:
STA Z3WHL ;SET WHEEL BYTE AND PRINT MESSAGE
;
; PRINT WHEEL BYTE MESSAGE
;
WHLMSG:
CALL PRINT
DB ' Wheel Byte',' '+80H
LDA Z3WHL ;GET WHEEL BYTE
ORA A ;ZERO IS OFF
JRZ OFFM
CALL PRINT
DB 'O','N'+80H
RET
OFFM:
CALL PRINT
DB 'OF','F'+80H
RET
;
; WHEEL PASSWORD DEFINED FROM SYSRCP.LIB FILE
;
DB 'Z'-'@' ;LEADING ^Z IN CASE OF TYPE
WHLPASS:
WPASS ;USE MACRO
;
ENDIF ;WHLON
;
;Section 5L
;Command: ECHO
;Function: Echo Text without Interpretation to Console or Printer
;
;Form:
; ECHO text <-- echo text to console
; ECHO $text <-- echo text to printer
;
; Additionally, if a form feed character is encountered in the
; output string, no further output will be done, a new line will be
; issued, and this will be followed by a form feed character. That is:
;
; ECHO $text^L
;
; will cause "text" to be printed on the printer followed by CR, LF, FF.
;
ECHO:
LXI H,TBUFF+1 ;PT TO FIRST CHAR
ECHO1:
MOV A,M ;SKIP LEADING SPACES
INX H ;PT TO NEXT
CPI ' '
JRZ ECHO1
;
IF ECHOLST
MOV B,A ;CHAR IN B
CPI '$' ;PRINT FLAG?
JRZ ECHO2
ENDIF ;ECHOLST
;
DCX H ;PT TO CHAR
;
; LOOP TO ECHO CHARS
;
ECHO2:
MOV A,M ;GET CHAR
ORA A ;EOL?
JRZ ECHO4
;
IF ECHOLST
CPI FF ;FORM FEED?
JRZ ECHO3
ENDIF ;ECHOLST
;
ECHO2C:
CALL ECHOUT ;SEND CHAR
INX H ;PT TO NEXT
JR ECHO2
;
; FORM FEED - SEND NEW LINE FOLLOWED BY FORM FEED IF PRINTER OUTPUT
;
IF ECHOLST
ECHO3:
MOV A,B ;CHECK FOR PRINTER OUTPUT
CPI '$'
JRNZ ECHOFF ;SEND FORM FEED NORMALLY IF NOT PRINTER
CALL ECHONL ;SEND NEW LINE
MVI A,FF ;SEND FORM FEED
JR ECHOUT
;
; SEND FORM FEED CHAR TO CONSOLE
;
ECHOFF:
MVI A,FF ;GET CHAR
JR ECHO2C
ENDIF ;ECHOLST
;
; END OF PRINT LOOP - CHECK FOR PRINTER TERMINATION
;
ECHO4:
IF NOT ECHOLST
;
RET
;
ELSE
;
MOV A,B ;CHECK FOR PRINTER OUTPUT
CPI '$'
RNZ ;DONE IF NO PRINTER OUTPUT
;
; OUTPUT A NEW LINE
;
ECHONL:
MVI A,CR ;OUTPUT NEW LINE ON PRINTER
CALL ECHOUT
MVI A,LF ;FALL THRU TO ECHOUT
;
ENDIF ;NOT ECHOLST
;
; OUTPUT CHAR TO PRINTER OR CONSOLE
;
ECHOUT:
MOV C,A ;CHAR IN C
PUSH H ;SAVE HL
PUSH B ;SAVE BC
LXI D,0CH-3 ;OFFSET FOR CONSOLE OUTPUT
;
IF ECHOLST
MOV A,B ;CHECK FOR PRINTER
CPI '$'
JRNZ ECHOUT1
INX D ;ADD 3 FOR PRINTER OFFSET
INX D
INX D
;
ENDIF ;ECHOLST
;
; OUTPUT CHAR IN C WITH BIOS OFFSET IN DE
;
ECHOUT1:
CALL BIOUT ;BIOS OUTPUT
POP B ;RESTORE BC,HL
POP H
RET
;
; OUTPUT CHAR IN C TO BIOS WITH OFFSET IN DE
;
BIOUT:
LHLD WBOOT+1 ;GET ADDRESS OF WARM BOOT
DAD D ;PT TO ROUTINE
PCHL ;JUMP TO IT
;
; ** SUPPORT UTILITIES **
;
;
; CHECK FOR USER INPUT; IF ^C, RETURN WITH Z
;
BREAK:
PUSH H ;SAVE REGS
PUSH D
PUSH B
MVI E,0FFH ;GET CHAR IF ANY
MVI C,6 ;CONSOLE STATUS CHECK
CALL BDOS
POP B ;RESTORE REGS
POP D
POP H
CPI CTRLC ;CHECK FOR ABORT
JZ EXIT ;EXIT
CPI CTRLX ;SKIP?
RET
;
; COPY HL TO DE FOR B BYTES
;
LDIR:
MOV A,M ;GET
STAX D ;PUT
INX H ;PT TO NEXT
INX D
DJNZ LDIR ;LOOP
RET
;
; PRINT FILE NOT FOUND MESSAGE
;
PRFNF:
CALL PRINT
DB ' No File','s'+80H
JMP EXIT
;
; OUTPUT NEW LINE TO CON:
;
CRLF:
MVI A,CR
CALL CONOUT
MVI A,LF
JMP CONOUT
;
; SEARCH FOR FIRST AND NEXT
;
SEARF:
PUSH B ; SAVE COUNTER
PUSH H ; SAVE HL
MVI C,17 ; SEARCH FOR FIRST FUNCTION
SEARF1:
LXI D,FCB1 ; PT TO FCB
CALL BDOS
INR A ; SET ZERO FLAG FOR ERROR RETURN
POP H ; GET HL
POP B ; GET COUNTER
RET
SEARN:
PUSH B ; SAVE COUNTER
PUSH H ; SAVE HL
MVI C,18 ; SEARCH FOR NEXT FUNCTION
JR SEARF1
;
; CONSOLE INPUT
;
CONIN:
PUSH H ; SAVE REGS
PUSH D
PUSH B
MVI C,1 ; INPUT
CALL BDOS
POP B ; GET REGS
POP D
POP H
ANI 7FH ; MASK MSB
CPI 61H
RC
ANI 5FH ; TO UPPER CASE
RET
;
; LOG INTO USER AREA CONTAINED IN FCB1
;
LOGUSR:
LDA FCB1+13 ;GET USER NUMBER
SETUSR:
MOV E,A
MVI C,32 ;USE BDOS FCT
JMP BDOS
;
; PRINT FILE NAME PTED TO BY HL
;
PRFN:
CALL PRINT ;LEADING SPACE
DB ' '+80H
MVI B,8 ;8 CHARS
CALL PRFN1
MVI A,'.' ;DOT
CALL CONOUT
MVI B,3 ;3 CHARS
PRFN1:
MOV A,M ; GET CHAR
INX H ; PT TO NEXT
CALL CONOUT ; PRINT CHAR
DJNZ PRFN1 ; COUNT DOWN
RET
;
; SAVE RETURN ADDRESS
;
RETSAVE:
POP D ; GET RETURN ADDRESS
POP H ; GET RETURN ADDRESS TO ZCPR3
SHLD Z3RET ; SAVE IT
PUSH H ; PUT RETURN ADDRESS TO ZCPR3 BACK
PUSH D ; PUT RETURN ADDRESS BACK
RET
;
; EXIT TO ZCPR3
;
EXIT:
Z3RET EQU $+1 ; POINTER TO IN-THE-CODE MODIFICATION
LXI H,0 ; RETURN ADDRESS
PCHL ; GOTO ZCPR3
;
; TEST WHEEL BYTE FOR APPROVAL
; IF WHEEL BYTE IS 0 (OFF), ABORT WITH A MESSAGE (FLUSH RET ADR AND EXIT)
;
IF WHEEL ;IF ANY WHEEL OPTION IS RUNNING
WHLTST:
LDA Z3WHL ;GET WHEEL BYTE
ORA A ;ZERO?
RNZ
POP PSW ;CLEAR STACK
CALL PRINT
DB ' No Whee','l'+80H
RET
ENDIF ;WHEEL
;
; PRINT A DASH
;
IF LTON OR PEEKON
DASH:
CALL PRINT
DB ' -',' '+80H
RET
;
ENDIF ;LTON OR PEEKON
;
; PRINT ADDRESS MESSAGE
; PRINT ADDRESS IN DE
;
IF PEEKON OR POKEON
ADRAT:
CALL PRINT
DB ' at',' '+80H
MOV A,D ;PRINT HIGH
CALL PAHC
MOV A,E ;PRINT LOW
JMP PAHC
;
; EXTRACT HEXADECIMAL NUMBER FROM LINE PTED TO BY HL
; RETURN WITH VALUE IN DE AND HL PTING TO OFFENDING CHAR
;
HEXNUM:
LXI D,0 ;DE=ACCUMULATED VALUE
MVI B,5 ;B=CHAR COUNT
HNUM1:
MOV A,M ;GET CHAR
CPI ' '+1 ;DONE?
RC ;RETURN IF SPACE OR LESS
INX H ;PT TO NEXT
SUI '0' ;CONVERT TO BINARY
JRC NUMERR ;RETURN AND DONE IF ERROR
CPI 10 ;0-9?
JRC HNUM2
SUI 7 ;A-F?
CPI 10H ;ERROR?
JRNC NUMERR
HNUM2:
MOV C,A ;DIGIT IN C
MOV A,D ;GET ACCUMULATED VALUE
RLC ;EXCHANGE NYBBLES
RLC
RLC
RLC
ANI 0F0H ;MASK OUT LOW NYBBLE
MOV D,A
MOV A,E ;SWITCH LOW-ORDER NYBBLES
RLC
RLC
RLC
RLC
MOV E,A ;HIGH NYBBLE OF E=NEW HIGH OF E,
; LOW NYBBLE OF E=NEW LOW OF D
ANI 0FH ;GET NEW LOW OF D
ORA D ;MASK IN HIGH OF D
MOV D,A ;NEW HIGH BYTE IN D
MOV A,E
ANI 0F0H ;MASK OUT LOW OF E
ORA C ;MASK IN NEW LOW
MOV E,A ;NEW LOW BYTE IN E
DJNZ HNUM1 ;COUNT DOWN
RET
;
; NUMBER ERROR
;
NUMERR:
CALL PRINT
DB ' Num','?'+80H
JMP EXIT
;
; SKIP TO NEXT NON-BLANK
;
SKSP:
MOV A,M ;GET CHAR
INX H ;PT TO NEXT
CPI ' ' ;SKIP SPACES
JRZ SKSP
DCX H ;PT TO GOOD CHAR
ORA A ;SET EOL FLAG
RET
;
ENDIF ;PEEKON OR POKEON
;
; Test File in FCB for unambiguity and existence, ask user to delete if so
; Return with Z flag set if R/O or no permission to delete
;
IF RENON OR CPON
EXTEST:
CALL AMBCHK ;AMBIGUOUS FILE NAMES NOT ALLOWED
CALL SEARF ;LOOK FOR SPECIFIED FILE
JRZ EXOK ;OK IF NOT FOUND
CALL GETSBIT ;POSITION INTO DIR
INX D ;PT TO FILE NAME
XCHG ;HL PTS TO FILE NAME
PUSH H ;SAVE PTR TO FILE NAME
CALL PRFN ;PRINT FILE NAME
POP H
CALL ROTEST ;CHECK FOR R/O
JRNZ EXER
CALL ERAQ ;ERASE?
JRNZ EXER ;RESTART AS ERROR IF NO
LXI D,FCB1 ;PT TO FCB1
MVI C,19 ;DELETE FILE
CALL BDOS
EXOK:
XRA A
DCR A ;NZ = OK
RET
EXER:
XRA A ;ERROR FLAG - FILE IS R/O OR NO PERMISSION
RET
;
; CHECK FOR AMBIGUOUS FILE NAME IN FCB1
; RETURN Z IF SO
;
AMBCHK:
LXI H,FCB1+1 ;PT TO FCB
;
; CHECK FOR AMBIGUOUS FILE NAME PTED TO BY HL
;
AMBCHK1:
PUSH H
MVI B,11 ;11 BYTES
AMB1:
MOV A,M ;GET CHAR
ANI 7FH ;MASK
CPI '?'
JRZ AMB2
INX H ;PT TO NEXT
DJNZ AMB1
DCR B ;SET NZ FLAG
POP D
RET
AMB2:
POP H ;PT TO FILE NAME
CALL PRFN
CALL PRINT
DB ' is AF','N'+80H
JMP EXIT
;
ENDIF ;RENON OR CPON
;
; CHECK USER TO SEE IF HE APPROVES ERASE OF FILE
; RETURN WITH Z IF YES
;
IF RENON OR CPON OR ERAON OR PROTON
ERAQ:
CALL PRINT
DB ' - Eras','e'+80H
ERAQ1:
CALL PRINT
DB ' (Y/N)?',' '+80H
CALL CONIN ;GET RESPONSE
CPI 'Y' ;KEY ON YES
RET
;
ENDIF ;RENON OR CPON OR ERAON OR PROTON
;
; TEST FILE PTED TO BY HL FOR R/O
; NZ IF R/O
;
IF RENON OR ERAON OR CPON
ROTEST:
PUSH H ;ADVANCE TO R/O BYTE
LXI B,8 ;PT TO 9TH BYTE
DAD B
MOV A,M ;GET IT
ANI 80H ;MASK BIT
PUSH PSW
LXI H,ROMSG
CNZ PRINT1 ;PRINT IF NZ
POP PSW ;GET FLAG
POP H ;GET PTR
RET
ROMSG:
DB ' is R/','O'+80H
;
ENDIF ;RENON OR ERAON OR CPON
;
; INIT FCB1, RETURN WITH DE PTING TO FCB1
;
IF ERAON OR LTON OR CPON
INITFCB1:
LXI H,FCB1 ;PT TO FCB
INITFCB2:
PUSH H ;SAVE PTR
LXI B,12 ;PT TO FIRST BYTE
DAD B
MVI B,24 ;ZERO 24 BYTES
XRA A ;ZERO FILL
CALL FILLP ;FILL MEMORY
POP D ;PT TO FCB
RET
;
ENDIF ;ERAON OR LTON OR CPON
;
; BUFFERS
;
NXTFILE:
DS 2 ;PTR TO NEXT FILE IN LIST
;
; SIZE ERROR TEST
;
IF ($ GT (RCP + RCPS*128))
SIZERR EQU NOVALUE ;RCP IS TOO LARGE FOR BUFFER
ENDIF
;
; END OF SYS.RCP
;
END

Reference in New Issue View Git Blame Copy Permalink