forked from MirrorRepos/RomWBW
2044 lines
50 KiB
NASM
2044 lines
50 KiB
NASM
TITLE 'ZCPR Version 1.0'
|
||
;
|
||
; CP/M Z80 Command Processor Replacement (CPR) Version 1.0
|
||
; CCPZ CREATED AND CUSTOMIZED FOR ARIES-II BY RLC
|
||
; FURTHER MODIFIED BY RGF AS V2.0
|
||
; FURTHER MODIFIED BY RLC AS V2.1
|
||
; FURTHER MODIFIED BY KBP AS V2.2
|
||
; FURTHER MODIFIED BY RLC AS V2.4 (V2.3 skipped)
|
||
; FURTHER MODIFIED BY RLC AS V2.5
|
||
; FURTHER MODIFIED BY RLC AS V2.6
|
||
; FURTHUR MODIFIED BY SBB AS V2.7
|
||
; FURTHER MODIFIED BY RLC AS V2.8
|
||
; FURTHER MODIFIED BY RLC AS V2.9
|
||
; FURTHER MODIFIED BY RLC AS V3.0
|
||
; FURTHER MODIFIED BY RLC AS V3.1
|
||
; FURTHER MODIFIED BY RLC AS V4.0
|
||
; ZCPR VERSION 1.0 CREATED FROM CCPZ VERSION 4.0 BY RLC IN
|
||
; A COORDINATED EFFORT WITH CCP-GROUP
|
||
;
|
||
; ZCPR is a group effort by CCP-GROUP, whose active membership involved
|
||
; in this project consists of the following:
|
||
; RLC - Richard Conn
|
||
; RGF - Ron Fowler
|
||
; KBP - Keith Peterson
|
||
; FJW - Frank Wancho
|
||
; The following individual also provided a contribution:
|
||
; SBB - Steve Bogolub
|
||
;
|
||
;
|
||
;******** Structure Notes ********
|
||
;
|
||
; This CPR is divided into a number of major sections. The following
|
||
; is an outline of these sections and the names of the major routines
|
||
; located therein.
|
||
;
|
||
; Section Function/Routines
|
||
; ------- -----------------
|
||
;
|
||
; -- Opening Comments, Equates, and Macro Definitions
|
||
;
|
||
; 0 JMP Table into CPR
|
||
;
|
||
; 1 Buffers
|
||
;
|
||
; 2 CPR Starting Modules
|
||
; CPR1 CPR RESTRT RSTCPR RCPRNL
|
||
; PRNNF
|
||
;
|
||
; 3 Utilities
|
||
; CRLF CONOUT CONIN LCOUT LSTOUT
|
||
; READF READ BDOSB PRINTC PRINT
|
||
; GETDRV DEFDMA DMASET RESET BDOSJP
|
||
; LOGIN OPENF OPEN GRBDOS CLOSE
|
||
; SEARF SEAR1 SEARN SUBKIL DELETE
|
||
; RESETUSR GETUSR SETUSR
|
||
;
|
||
; 4 CPR Utilities
|
||
; SETUD SETU0D UCASE REDBUF CNVBUF
|
||
; BREAK USRNUM ERROR SDELM ADVAN
|
||
; SBLANK ADDAH NUMBER NUMERR HEXNUM
|
||
; DIRPTR SLOGIN DLOGIN COMLOG SCANER
|
||
; CMDSER
|
||
;
|
||
; 5 CPR-Resident Commands and Functions
|
||
; 5A DIR DIRPR FILLQ
|
||
; 5B ERA
|
||
; 5C LIST
|
||
; 5D TYPE PAGER
|
||
; 5E SAVE
|
||
; 5F REN
|
||
; 5G USER
|
||
; 5H DFU
|
||
; 5I JUMP
|
||
; 5J GO
|
||
; 5K COM CALLPROG ERRLOG ERRJMP
|
||
; 5L GET MEMLOAD PRNLE
|
||
;
|
||
;
|
||
FALSE EQU 0
|
||
TRUE EQU NOT FALSE
|
||
;
|
||
; CUSTOMIZATION EQUATES
|
||
;
|
||
; The following equates may be used to customize this CPR for the user's
|
||
; system and integration technique. The following constants are provided:
|
||
;
|
||
; REL - TRUE if integration is to be done via MOVCPM
|
||
; - FALSE if integration is to be done via DDT and SYSGEN
|
||
;
|
||
; BASE - Base Address of user's CP/M system (normally 0 for DR version)
|
||
; This equate allows easy modification by non-standard CP/M (eg,H89)
|
||
;
|
||
; CPRLOC - Base Page Address of CPR; this value can be obtained by running
|
||
; the BDOSLOC program on your system, or by setting the
|
||
; MSIZE and BIOSEX equates to the system memory size in
|
||
; K-bytes and the "extra" memory required by your BIOS
|
||
; in K-bytes. BIOSEX is zero if your BIOS is normal size,
|
||
; and can be negative if your BIOS is in PROM or in
|
||
; non-contiguous memory.
|
||
;
|
||
; RAS - Remote-Access System; setting this equate to TRUE disables
|
||
; certain CPR commands that are considered harmful in a Remote-
|
||
; Access environment; use under Remote-Access Systems (RBBS) for
|
||
; security purposes
|
||
;
|
||
REL EQU FALSE ;SET TO TRUE FOR MOVCPM INTEGRATION
|
||
;
|
||
BASE EQU 0 ;BASE OF CP/M SYSTEM (SET FOR STANDARD CP/M)
|
||
;
|
||
IF REL
|
||
CPRLOC EQU 0 ;MOVCPM IMAGE
|
||
ELSE
|
||
;
|
||
; If REL is FALSE, the value of CPRLOC may be set in one
|
||
; of two ways. The first way is to set MSIZE and BIOSEX
|
||
; as described above using the following three lines:
|
||
;
|
||
;MSIZE EQU 56 ;SIZE OF MEM IN K-BYTES
|
||
;BIOSEX EQU 0 ;EXTRA # K-BYTES IN BIOS
|
||
;CPRLOC EQU 3400H+(MSIZE-20-BIOSEX)*1024 ;CPR ORIGIN
|
||
;
|
||
; The second way is to obtain the origin of your current
|
||
; CPR using BDSLOC or its equivalent, then merely set CPRLOC
|
||
; to that value as as in the following line:
|
||
;
|
||
;CPRLOC EQU 0BD00H ;FILL IN WITH BDOSLOC SUPPLIED VALUE
|
||
CPRLOC EQU 0D000H ;WW - CUSTOMIZED FOR ROMWBW
|
||
;
|
||
; Note that you should only use one method or the other.
|
||
; Do NOT define CPRLOC twice!
|
||
;
|
||
; The following gives the required offset to load the CPR into the
|
||
; CP/M SYSGEN Image through DDT (the Roffset command); Note that this
|
||
; value conforms with the standard value presented in the CP/M reference
|
||
; manuals, but it may not necessarily conform with the location of the
|
||
; CPR in YOUR CP/M system; several systems (Morrow Designs, P&T, Heath
|
||
; Org-0 to name a few) have the CPR located at a non-standard address in
|
||
; the SYSGEN Image
|
||
;
|
||
;CPRR EQU 0980H-CPRLOC ;DDT LOAD OFFSET
|
||
CPRR EQU 1100H-CPRLOC ;DDT LOAD OFFSET FOR MORROW DESIGNS
|
||
ENDIF
|
||
;
|
||
RAS EQU FALSE ;SET TO TRUE IF CPR IS FOR A REMOTE-ACCESS SYSTEM
|
||
;
|
||
; The following is presented as an option, but is not generally user-customiz-
|
||
; able. A basic design choice had to be made in the design of ZCPR concerning
|
||
; the execution of SUBMIT files. The original CCP had a problem in this sense
|
||
; in that it ALWAYS looked for the SUBMIT file from drive A: and the SUBMIT
|
||
; program itself (SUBMIT.COM) would place the $$$.SUB file on the currently
|
||
; logged-in drive, so when the user was logged into B: and he issued a SUBMIT
|
||
; command, the $$$.SUB was placed on B: and did not execute because the CCP
|
||
; looked for it on A: and never found it.
|
||
; After much debate it was decided to have ZCPR perform the same type of
|
||
; function as CCP (look for the $$$.SUB file on A:), but the problem with
|
||
; SUBMIT.COM still exists. Hence, RGF designed SuperSUB and RLC took his
|
||
; SuperSUB and designed SUB from it; both programs are set up to allow the
|
||
; selection at assembly time of creating the $$$.SUB on the logged-in drive
|
||
; or on drive A:.
|
||
; A final definition of the Indirect Command File ($$$.SUB or SUBMIT
|
||
; File) is presented as follows:
|
||
; "An Indirect Command File is one which contains
|
||
; a series of commands exactly as they would be
|
||
; entered from a CP/M Console. The SUBMIT Command
|
||
; (or SUB Command) reads this files and transforms
|
||
; it for processing by the ZCPR (the $$$.SUB File).
|
||
; ZCPR will then execute the commands indicated
|
||
; EXACTLY as if they were typed at the Console."
|
||
; Hence, to permit this to happen, the $$$.SUB file must always
|
||
; be present on a specific drive, and A: is the choice for said drive.
|
||
; With this facility engaged as such, Indirect Command Files like:
|
||
; DIR
|
||
; A:
|
||
; DIR
|
||
; can be executed, even though the currently logged-in drive is changed
|
||
; during execution. If the $$$.SUB file was present on the currently
|
||
; logged-in drive, the above series of commands would not work since the
|
||
; ZCPR would be looking for $$$.SUB on the logged-in drive, and switching
|
||
; logged-in drives without moving the $$$.SUB file as well would cause
|
||
; processing to abort.
|
||
;
|
||
SUBA equ TRUE ; Set to TRUE to have $$$.SUB always on A:
|
||
; Set to FALSE to have $$$.SUB on the logged-in drive
|
||
;
|
||
; The following flag enables extended processing for user-program supplied
|
||
; command lines. This is for Command Level 3 of ZCPR. Under the CCPZ Version
|
||
; 4.0 philosophy, three command levels exist:
|
||
; (1) that command issued by the user from his console at the '>' prompt
|
||
; (2) that command issued by a $$$.SUB file at the '$' prompt
|
||
; (3) that command issued by a user program by placing the command into
|
||
; CIBUFF and setting the character count in CBUFF
|
||
; Setting CLEVEL3 to TRUE enables extended processing of the third level of
|
||
; ZCPR command. All the user program need do is to store the command line and
|
||
; set the character count; ZCPR will initialize the pointers properly, store
|
||
; the ending zero properly, and capitalize the command line for processing.
|
||
; Once the command line is properly stored, the user executes the command line
|
||
; by reentering the ZCPR through CPRLOC [NOTE: The C register MUST contain
|
||
; a valid User/Disk Flag (see location 4) at this time.]
|
||
;
|
||
CLEVEL3 equ TRUE ;ENABLE COMMAND LEVEL 3 PROCESSING
|
||
;
|
||
;
|
||
;*** TERMINAL AND 'TYPE' CUSTOMIZATION EQUATES
|
||
;
|
||
NLINES EQU 24 ;NUMBER OF LINES ON CRT SCREEN
|
||
WIDE EQU TRUE ;TRUE IF WIDE DIR DISPLAY
|
||
FENCE EQU '|' ;SEP CHAR BETWEEN DIR FILES
|
||
;
|
||
PGDFLT EQU TRUE ;SET TO FALSE TO DISABLE PAGING BY DEFAULT
|
||
PGDFLG EQU 'P' ;FOR TYPE COMMAND: PAGE OR NOT (DEP ON PGDFLT)
|
||
; THIS FLAG REVERSES THE DEFAULT EFFECT
|
||
;
|
||
MAXUSR EQU 15 ;MAXIMUM USER NUMBER ACCESSABLE
|
||
;
|
||
SYSFLG EQU 'A' ;FOR DIR COMMAND: LIST $SYS AND $DIR
|
||
;
|
||
SOFLG EQU 'S' ;FOR DIR COMMAND: LIST $SYS FILES ONLY
|
||
;
|
||
SUPRES EQU TRUE ;SUPRESSES USER # REPORT FOR USER 0
|
||
;
|
||
DEFUSR EQU 0 ;DEFAULT USER NUMBER FOR COM FILES
|
||
;
|
||
SPRMPT EQU '$' ;CPR PROMPT INDICATING SUBMIT COMMAND
|
||
CPRMPT EQU '>' ;CPR PROMPT INDICATING USER COMMAND
|
||
;
|
||
NUMBASE EQU 'H' ;CHARACTER USED TO SWITCH FROM DEFAULT
|
||
; NUMBER BASE
|
||
;
|
||
SECTFLG EQU 'S' ;OPTION CHAR FOR SAVE COMMAND TO SAVE SECTORS
|
||
;
|
||
; END OF CUSTOMIZATION SECTION
|
||
;
|
||
CR EQU 0DH
|
||
LF EQU 0AH
|
||
TAB EQU 09H
|
||
;
|
||
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
|
||
TBUFF EQU BASE+0080H ;DEFAULT DISK I/O BUFFER
|
||
TPA EQU BASE+0100H ;BASE OF TPA
|
||
;
|
||
;
|
||
; MACROS TO PROVIDE Z80 EXTENSIONS
|
||
; MACROS INCLUDE:
|
||
;
|
||
$-MACRO ;FIRST TURN OFF THE EXPANSIONS
|
||
;
|
||
; 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
|
||
; LDIR - MOV @HL TO @DE FOR COUNT IN BC
|
||
; LXXD - LOAD DOUBLE REG DIRECT
|
||
; SXXD - STORE DOUBLE REG DIRECT
|
||
;
|
||
;
|
||
;
|
||
; @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 ;Displacement Range Error on Jump Relative
|
||
ELSE
|
||
DB ?DD
|
||
ENDIF
|
||
ENDM
|
||
;
|
||
;
|
||
; Z80 MACRO EXTENSIONS
|
||
;
|
||
JR MACRO ?N ;;JUMP RELATIVE
|
||
DB 18H
|
||
@GENDD ?N-$-1
|
||
ENDM
|
||
;
|
||
JRC MACRO ?N ;;JUMP RELATIVE ON CARRY
|
||
DB 38H
|
||
@GENDD ?N-$-1
|
||
ENDM
|
||
;
|
||
JRNC MACRO ?N ;;JUMP RELATIVE ON NO CARRY
|
||
DB 30H
|
||
@GENDD ?N-$-1
|
||
ENDM
|
||
;
|
||
JRZ MACRO ?N ;;JUMP RELATIVE ON ZERO
|
||
DB 28H
|
||
@GENDD ?N-$-1
|
||
ENDM
|
||
;
|
||
JRNZ MACRO ?N ;;JUMP RELATIVE ON NO ZERO
|
||
DB 20H
|
||
@GENDD ?N-$-1
|
||
ENDM
|
||
;
|
||
DJNZ MACRO ?N ;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
|
||
DB 10H
|
||
@GENDD ?N-$-1
|
||
ENDM
|
||
;
|
||
LDIR MACRO ;;LDIR
|
||
DB 0EDH,0B0H
|
||
ENDM
|
||
;
|
||
LDED MACRO ?N ;;LOAD DE DIRECT
|
||
DB 0EDH,05BH
|
||
DW ?N
|
||
ENDM
|
||
;
|
||
LBCD MACRO ?N ;;LOAD BC DIRECT
|
||
DB 0EDH,4BH
|
||
DW ?N
|
||
ENDM
|
||
;
|
||
SDED MACRO ?N ;;STORE DE DIRECT
|
||
DB 0EDH,53H
|
||
DW ?N
|
||
ENDM
|
||
;
|
||
SBCD MACRO ?N ;;STORE BC DIRECT
|
||
DB 0EDH,43H
|
||
DW ?N
|
||
ENDM
|
||
;
|
||
; END OF Z80 MACRO EXTENSIONS
|
||
;
|
||
;
|
||
;**** Section 0 ****
|
||
;
|
||
ORG CPRLOC
|
||
;
|
||
; ENTRY POINTS INTO ZCPR
|
||
; If the ZCPR is entered at location CPRLOC (at the JMP to CPR), then
|
||
; the default command in CIBUFF will be processed. If the ZCPR is entered
|
||
; at location CPRLOC+3 (at the JMP to CPR1), then the default command in
|
||
; CIBUFF will NOT be processed.
|
||
; NOTE: Entry into ZCPR in this way is permitted under ZCPR Version 4.0,
|
||
; but in order for this to work, CIBUFF and CBUFF MUST be initialized properly
|
||
; AND the C register MUST contain a valid User/Disk Flag (see Location 4: the
|
||
; most significant nybble contains the User Number and the least significant
|
||
; nybble contains the Disk Number).
|
||
; Some user programs (such as SYNONYM3) attempt to use the default
|
||
; command facility. Under the original CPR, it was necessary to initialize
|
||
; the pointer after the reserved space for the command buffer to point to
|
||
; the first byte of the command buffer. Under Version 4.x of ZCPR, this is
|
||
; no longer the case. The CIBPTR (Command Input Buffer PoinTeR) is located
|
||
; to be compatable with such programs (provided they determine the buffer
|
||
; length from the byte at MBUFF [CPRLOC + 6]), but under Version 4.x of ZCPR
|
||
; this is no longer necessary. ZCPR Version 4.x automatically initializes
|
||
; this buffer pointer in all cases.
|
||
;
|
||
ENTRY:
|
||
JMP CPR ; Process potential default command
|
||
JMP CPR1 ; Do NOT process potential default command
|
||
;
|
||
;**** Section 1 ****
|
||
; BUFFERS ET AL
|
||
;
|
||
; INPUT COMMAND LINE AND DEFAULT COMMAND
|
||
; The command line to be executed is stored here. This command line
|
||
; is generated in one of three ways:
|
||
; (1) by the user entering it through the BDOS READLN function at
|
||
; the du> prompt [user input from keyboard]
|
||
; (2) by the SUBMIT File Facility placing it there from a $$$.SUB
|
||
; file
|
||
; (3) by an external program or user placing the required command
|
||
; into this buffer
|
||
; In all cases, the command line is placed into the buffer starting at
|
||
; CIBUFF. This command line is terminated by the last character (NOT Carriage
|
||
; Return), and a character count of all characters in the command line
|
||
; up to and including the last character is placed into location CBUFF
|
||
; (immediately before the command line at CIBUFF). The placed command line
|
||
; is then parsed, interpreted, and the indicated command is executed.
|
||
; If CLEVEL3 is permitted, a terminating zero is placed after the command
|
||
; (otherwise the user program has to place this zero) and the CIBPTR is
|
||
; properly initialized (otherwise the user program has to init this ptr).
|
||
; If the command is placed by a user program, entering at CPRLOC is enough
|
||
; to have the command processed. Again, under CCPZ Version 4.0, it is not
|
||
; necessary to store the pointer to CIBUFF in CIBPTR; ZCPR will do this for
|
||
; the calling program if CLEVEL3 is made TRUE.
|
||
; WARNING: The command line must NOT exceed BUFLEN characters in length.
|
||
; For user programs which load this command, the value of BUFLEN can be
|
||
; obtained by examining the byte at MBUFF (CPRLOC + 6).
|
||
;
|
||
BUFLEN EQU 80 ;MAXIMUM BUFFER LENGTH
|
||
MBUFF:
|
||
DB BUFLEN ;MAXIMUM BUFFER LENGTH
|
||
CBUFF:
|
||
DB 0 ;NUMBER OF VALID CHARS IN COMMAND LINE
|
||
CIBUFF:
|
||
DB ' ' ;DEFAULT (COLD BOOT) COMMAND
|
||
CIBUF:
|
||
DB 0 ;COMMAND STRING TERMINATOR
|
||
DS BUFLEN-($-CIBUFF)+1 ;TOTAL IS 'BUFLEN' BYTES
|
||
;
|
||
CIBPTR:
|
||
DW CIBUFF ;POINTER TO COMMAND INPUT BUFFER
|
||
CIPTR:
|
||
DW CIBUF ;CURRENT POINTER
|
||
;
|
||
DS 26 ;STACK AREA
|
||
STACK EQU $ ;TOP OF STACK
|
||
;
|
||
; FILE TYPE FOR COMMAND
|
||
;
|
||
COMMSG:
|
||
DB 'COM'
|
||
;
|
||
; SUBMIT FILE CONTROL BLOCK
|
||
;
|
||
SUBFCB:
|
||
IF SUBA ;IF $$$.SUB ON A:
|
||
DB 1 ;DISK NAME SET TO DEFAULT TO DRIVE A:
|
||
ENDIF
|
||
;
|
||
IF NOT SUBA ;IF $$$.SUB ON CURRENT DRIVE
|
||
DB 0 ;DISK NAME SET TO DEFAULT TO CURRENT DRIVE
|
||
ENDIF
|
||
;
|
||
DB '$$$' ;FILE NAME
|
||
DB ' '
|
||
DB 'SUB' ;FILE TYPE
|
||
DB 0 ;EXTENT NUMBER
|
||
DB 0 ;S1
|
||
SUBFS2:
|
||
DS 1 ;S2
|
||
SUBFRC:
|
||
DS 1 ;RECORD COUNT
|
||
DS 16 ;DISK GROUP MAP
|
||
SUBFCR:
|
||
DS 1 ;CURRENT RECORD NUMBER
|
||
;
|
||
; COMMAND FILE CONTROL BLOCK
|
||
;
|
||
FCBDN:
|
||
DS 1 ;DISK NAME
|
||
FCBFN:
|
||
DS 8 ;FILE NAME
|
||
FCBFT:
|
||
DS 3 ;FILE TYPE
|
||
DS 1 ;EXTENT NUMBER
|
||
DS 2 ;S1 AND S2
|
||
DS 1 ;RECORD COUNT
|
||
FCBDM:
|
||
DS 16 ;DISK GROUP MAP
|
||
FCBCR:
|
||
DS 1 ;CURRENT RECORD NUMBER
|
||
;
|
||
; OTHER BUFFERS
|
||
;
|
||
PAGCNT:
|
||
DB NLINES-2 ;LINES LEFT ON PAGE
|
||
CHRCNT:
|
||
DB 0 ;CHAR COUNT FOR TYPE
|
||
QMCNT:
|
||
DB 0 ;QUESTION MARK COUNT FOR FCB TOKEN SCANNER
|
||
;
|
||
; CPR BUILT-IN COMMAND TABLE
|
||
;
|
||
NCHARS EQU 4 ;NUMBER OF CHARS/COMMAND
|
||
;
|
||
; CPR COMMAND NAME TABLE
|
||
; EACH TABLE ENTRY IS COMPOSED OF THE 4-BYTE COMMAND AND 2-BYTE ADDRESS
|
||
;
|
||
CMDTBL:
|
||
DB 'DIR '
|
||
DW DIR
|
||
DB 'LIST'
|
||
DW LIST
|
||
DB 'TYPE'
|
||
DW TYPE
|
||
DB 'USER'
|
||
DW USER
|
||
DB 'DFU '
|
||
DW DFU
|
||
;
|
||
IF NOT RAS ;FOR NON-RAS
|
||
DB 'GO '
|
||
DW GO
|
||
DB 'ERA '
|
||
DW ERA
|
||
DB 'SAVE'
|
||
DW SAVE
|
||
DB 'REN '
|
||
DW REN
|
||
DB 'GET '
|
||
DW GET
|
||
DB 'JUMP'
|
||
DW JUMP
|
||
ENDIF
|
||
;
|
||
NCMNDS EQU ($-CMDTBL)/(NCHARS+2)
|
||
;
|
||
;
|
||
;**** Section 2 ****
|
||
; CPR STARTING POINTS
|
||
;
|
||
; START CPR AND DON'T PROCESS DEFAULT COMMAND STORED
|
||
;
|
||
CPR1:
|
||
XRA A ;SET NO DEFAULT COMMAND
|
||
STA CBUFF
|
||
;
|
||
; START CPR AND POSSIBLY PROCESS DEFAULT COMMAND
|
||
;
|
||
; NOTE ON MODIFICATION BY RGF: BDOS RETURNS 0FFH IN
|
||
; ACCUMULATOR WHENEVER IT LOGS IN A DIRECTORY, IF ANY
|
||
; FILE NAME CONTAINS A '$' IN IT. THIS IS NOW USED AS
|
||
; A CLUE TO DETERMINE WHETHER OR NOT TO DO A SEARCH
|
||
; FOR SUBMIT FILE, IN ORDER TO ELIMINATE WASTEFUL SEARCHES.
|
||
;
|
||
CPR:
|
||
LXI SP,STACK ;RESET STACK
|
||
PUSH B
|
||
MOV A,C ;C=USER/DISK NUMBER (SEE LOC 4)
|
||
RAR ;EXTRACT USER NUMBER
|
||
RAR
|
||
RAR
|
||
RAR
|
||
ANI 0FH
|
||
MOV E,A ;SET USER NUMBER
|
||
CALL SETUSR
|
||
CALL RESET ;RESET DISK SYSTEM
|
||
STA RNGSUB ;SAVE SUBMIT CLUE FROM DRIVE A:
|
||
POP B
|
||
MOV A,C ;C=USER/DISK NUMBER (SEE LOC 4)
|
||
ANI 0FH ;EXTRACT DEFAULT DISK DRIVE
|
||
STA TDRIVE ;SET IT
|
||
JRZ NOLOG ;SKIP IF 0...ALREADY LOGGED
|
||
CALL LOGIN ;LOG IN DEFAULT DISK
|
||
;
|
||
IF NOT SUBA ;IF $$$.SUB IS ON CURRENT DRIVE
|
||
STA RNGSUB ;BDOS '$' CLUE
|
||
ENDIF
|
||
;
|
||
NOLOG:
|
||
LXI D,SUBFCB ;CHECK FOR $$$.SUB ON CURRENT DISK
|
||
RNGSUB EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
|
||
MVI A,0 ;2ND BYTE (IMMEDIATE ARG) IS THE RNGSUB FLAG
|
||
ORA A ;SET FLAGS ON CLUE
|
||
CMA ;PREPARE FOR COMING 'CMA'
|
||
CNZ SEAR1
|
||
CMA ;0FFH IS RETURNED IF NO $$$.SUB, SO COMPLEMENT
|
||
STA RNGSUB ;SET FLAG (0=NO $$$.SUB)
|
||
LDA CBUFF ;EXECUTE DEFAULT COMMAND?
|
||
ORA A ;0=NO
|
||
JRNZ RS1
|
||
;
|
||
; PROMPT USER AND INPUT COMMAND LINE FROM HIM
|
||
;
|
||
RESTRT:
|
||
LXI SP,STACK ;RESET STACK
|
||
;
|
||
; PRINT PROMPT (DU>)
|
||
;
|
||
CALL CRLF ;PRINT PROMPT
|
||
CALL GETDRV ;CURRENT DRIVE IS PART OF PROMPT
|
||
ADI 'A' ;CONVERT TO ASCII A-P
|
||
CALL CONOUT
|
||
CALL GETUSR ;GET USER NUMBER
|
||
;
|
||
IF SUPRES ;IF SUPPRESSING USR # REPORT FOR USR 0
|
||
ORA A
|
||
JRZ RS000
|
||
ENDIF
|
||
;
|
||
CPI 10 ;USER < 10?
|
||
JRC RS00
|
||
SUI 10 ;SUBTRACT 10 FROM IT
|
||
PUSH PSW ;SAVE IT
|
||
MVI A,'1' ;OUTPUT 10'S DIGIT
|
||
CALL CONOUT
|
||
POP PSW
|
||
RS00:
|
||
ADI '0' ;OUTPUT 1'S DIGIT (CONVERT TO ASCII)
|
||
CALL CONOUT
|
||
;
|
||
; READ INPUT LINE FROM USER OR $$$.SUB
|
||
;
|
||
RS000:
|
||
CALL REDBUF ;INPUT COMMAND LINE FROM USER (OR $$$.SUB)
|
||
;
|
||
; PROCESS INPUT LINE
|
||
;
|
||
RS1:
|
||
;
|
||
IF CLEVEL3 ;IF THIRD COMMAND LEVEL IS PERMITTED
|
||
CALL CNVBUF ;CAPITALIZE COMMAND LINE, PLACE ENDING 0,
|
||
; AND SET CIBPTR VALUE
|
||
ENDIF
|
||
;
|
||
CALL DEFDMA ;SET TBUFF TO DMA ADDRESS
|
||
CALL GETDRV ;GET DEFAULT DRIVE NUMBER
|
||
STA TDRIVE ;SET IT
|
||
CALL SCANER ;PARSE COMMAND NAME FROM COMMAND LINE
|
||
CNZ ERROR ;ERROR IF COMMAND NAME CONTAINS A '?'
|
||
LXI D,RSTCPR ;PUT RETURN ADDRESS OF COMMAND
|
||
PUSH D ;ON THE STACK
|
||
LDA TEMPDR ;IS COMMAND OF FORM 'D:COMMAND'?
|
||
ORA A ;NZ=YES
|
||
JNZ COM ; IMMEDIATELY
|
||
CALL CMDSER ;SCAN FOR CPR-RESIDENT COMMAND
|
||
JNZ COM ;NOT CPR-RESIDENT
|
||
MOV A,M ;FOUND IT: GET LOW-ORDER PART
|
||
INX H ;GET HIGH-ORDER PART
|
||
MOV H,M ;STORE HIGH
|
||
MOV L,A ;STORE LOW
|
||
PCHL ;EXECUTE CPR ROUTINE
|
||
;
|
||
; ENTRY POINT FOR RESTARTING CPR AND LOGGING IN DEFAULT DRIVE
|
||
;
|
||
RSTCPR:
|
||
CALL DLOGIN ;LOG IN DEFAULT DRIVE
|
||
;
|
||
; ENTRY POINT FOR RESTARTING CPR WITHOUT LOGGING IN DEFAULT DRIVE
|
||
;
|
||
RCPRNL:
|
||
CALL SCANER ;EXTRACT NEXT TOKEN FROM COMMAND LINE
|
||
LDA FCBFN ;GET FIRST CHAR OF TOKEN
|
||
SUI ' ' ;ANY CHAR?
|
||
LXI H,TEMPDR
|
||
ORA M
|
||
JNZ ERROR
|
||
JR RESTRT
|
||
;
|
||
; No File Error Message
|
||
;
|
||
PRNNF:
|
||
CALL PRINTC ;NO FILE MESSAGE
|
||
DB 'No Fil','e'+80H
|
||
RET
|
||
;
|
||
;**** Section 3 ****
|
||
; I/O UTILITIES
|
||
;
|
||
; OUTPUT CHAR IN REG A TO CONSOLE AND DON'T CHANGE BC
|
||
;
|
||
;
|
||
; OUTPUT <CRLF>
|
||
;
|
||
CRLF:
|
||
MVI A,CR
|
||
CALL CONOUT
|
||
MVI A,LF ;FALL THRU TO CONOUT
|
||
;
|
||
CONOUT:
|
||
PUSH B
|
||
MVI C,02H
|
||
OUTPUT:
|
||
MOV E,A
|
||
PUSH H
|
||
CALL BDOS
|
||
POP H
|
||
POP B
|
||
RET
|
||
;
|
||
CONIN:
|
||
MVI C,01H ;GET CHAR FROM CON: WITH ECHO
|
||
CALL BDOSB
|
||
JMP UCASE ;CAPITALIZE
|
||
;
|
||
LCOUT:
|
||
PUSH PSW ;OUTPUT CHAR TO CON: OR LST: DEP ON PRFLG
|
||
PRFLG EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
|
||
MVI A,0 ;2ND BYTE (IMMEDIATE ARG) IS THE PRINT FLAG
|
||
ORA A ;0=TYPE
|
||
JRZ LC1
|
||
POP PSW ;GET CHAR
|
||
;
|
||
; OUTPUT CHAR IN REG A TO LIST DEVICE
|
||
;
|
||
LSTOUT:
|
||
PUSH B
|
||
MVI C,05H
|
||
JR OUTPUT
|
||
LC1:
|
||
POP PSW ;GET CHAR
|
||
PUSH PSW
|
||
CALL CONOUT ;OUTPUT TO CON:
|
||
POP PSW
|
||
CPI LF ;CHECK FOR PAGING
|
||
JZ PAGER
|
||
RET
|
||
;
|
||
READF:
|
||
LXI D,FCBDN ;FALL THRU TO READ
|
||
READ:
|
||
MVI C,14H ;FALL THRU TO BDOSB
|
||
;
|
||
; CALL BDOS AND SAVE BC
|
||
;
|
||
BDOSB:
|
||
PUSH B
|
||
CALL BDOS
|
||
POP B
|
||
ORA A
|
||
RET
|
||
;
|
||
; PRINT STRING (ENDING IN 0) PTED TO BY RET ADR;START WITH <CRLF>
|
||
;
|
||
PRINTC:
|
||
PUSH PSW ;SAVE FLAGS
|
||
CALL CRLF ;NEW LINE
|
||
POP PSW
|
||
;
|
||
PRINT:
|
||
XTHL ;GET PTR TO STRING
|
||
PUSH PSW ;SAVE FLAGS
|
||
CALL PRIN1 ;PRINT STRING
|
||
POP PSW ;GET FLAGS
|
||
XTHL ;RESTORE HL AND RET ADR
|
||
RET
|
||
;
|
||
; PRINT STRING (ENDING IN 0) PTED TO BY HL
|
||
;
|
||
PRIN1:
|
||
MOV A,M ;GET NEXT BYTE
|
||
ORA A ;WW - SET FLAGS
|
||
RZ ;WW - DONE IF ZERO
|
||
ANI 7FH ;WW - CLEAR HIGH BIT
|
||
CALL CONOUT ;PRINT CHAR
|
||
MOV A,M ;GET NEXT BYTE AGAIN FOR TEST
|
||
INX H ;PT TO NEXT BYTE
|
||
ORA A ;SET FLAGS
|
||
RM ;DONE IF MSB SET
|
||
JR PRIN1
|
||
;
|
||
; BDOS FUNCTION ROUTINES
|
||
;
|
||
;
|
||
; RETURN NUMBER OF CURRENT DISK IN A
|
||
;
|
||
GETDRV:
|
||
MVI C,19H
|
||
JR BDOSJP
|
||
;
|
||
; SET 80H AS DMA ADDRESS
|
||
;
|
||
DEFDMA:
|
||
LXI D,TBUFF ;80H=TBUFF
|
||
DMASET:
|
||
MVI C,1AH
|
||
JR BDOSJP
|
||
;
|
||
RESET:
|
||
MVI C,0DH
|
||
BDOSJP:
|
||
JMP BDOS
|
||
;
|
||
LOGIN:
|
||
MOV E,A
|
||
MVI C,0EH
|
||
JR BDOSJP ;SAVE SOME CODE SPACE
|
||
;
|
||
OPENF:
|
||
XRA A
|
||
STA FCBCR
|
||
LXI D,FCBDN ;FALL THRU TO OPEN
|
||
;
|
||
OPEN:
|
||
MVI C,0FH ;FALL THRU TO GRBDOS
|
||
;
|
||
GRBDOS:
|
||
CALL BDOS
|
||
INR A ;SET ZERO FLAG FOR ERROR RETURN
|
||
RET
|
||
;
|
||
CLOSE:
|
||
MVI C,10H
|
||
JR GRBDOS
|
||
;
|
||
SEARF:
|
||
LXI D,FCBDN ;SPECIFY FCB
|
||
SEAR1:
|
||
MVI C,11H
|
||
JR GRBDOS
|
||
;
|
||
SEARN:
|
||
MVI C,12H
|
||
JR GRBDOS
|
||
;
|
||
; CHECK FOR SUBMIT FILE IN EXECUTION AND ABORT IT IF SO
|
||
;
|
||
SUBKIL:
|
||
LXI H,RNGSUB ;CHECK FOR SUBMIT FILE IN EXECUTION
|
||
MOV A,M
|
||
ORA A ;0=NO
|
||
RZ
|
||
MVI M,0 ;ABORT SUBMIT FILE
|
||
LXI D,SUBFCB ;DELETE $$$.SUB
|
||
;
|
||
DELETE:
|
||
MVI C,13H
|
||
JR BDOSJP ;SAVE MORE SPACE
|
||
;
|
||
; RESET USER NUMBER IF CHANGED
|
||
;
|
||
RESETUSR:
|
||
TMPUSR EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
|
||
MVI A,0 ;2ND BYTE (IMMEDIATE ARG) IS TMPUSR
|
||
MOV E,A ;PLACE IN E
|
||
JR SETUSR ;THEN GO SET USER
|
||
GETUSR:
|
||
MVI E,0FFH ;GET CURRENT USER NUMBER
|
||
SETUSR:
|
||
MVI C,20H ;SET USER NUMBER TO VALUE IN E (GET IF E=FFH)
|
||
JR BDOSJP ;MORE SPACE SAVING
|
||
;
|
||
; END OF BDOS FUNCTIONS
|
||
;
|
||
;
|
||
;**** Section 4 ****
|
||
; CPR UTILITIES
|
||
;
|
||
; SET USER/DISK FLAG TO CURRENT USER AND DEFAULT DISK
|
||
;
|
||
SETUD:
|
||
CALL GETUSR ;GET NUMBER OF CURRENT USER
|
||
ADD A ;PLACE IT IN HIGH NYBBLE
|
||
ADD A
|
||
ADD A
|
||
ADD A
|
||
LXI H,TDRIVE ;MASK IN DEFAULT DRIVE NUMBER (LOW NYBBLE)
|
||
ORA M ;MASK IN
|
||
STA UDFLAG ;SET USER/DISK NUMBER
|
||
RET
|
||
;
|
||
; SET USER/DISK FLAG TO USER 0 AND DEFAULT DISK
|
||
;
|
||
SETU0D:
|
||
TDRIVE EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
|
||
MVI A,0 ;2ND BYTE (IMMEDIATE ARG) IS TDRIVE
|
||
STA UDFLAG ;SET USER/DISK NUMBER
|
||
RET
|
||
;
|
||
; CONVERT CHAR IN A TO UPPER CASE
|
||
;
|
||
UCASE:
|
||
CPI 61H ;LOWER-CASE A
|
||
RC
|
||
CPI 7BH ;GREATER THAN LOWER-CASE Z?
|
||
RNC
|
||
ANI 5FH ;CAPITALIZE
|
||
RET
|
||
;
|
||
; INPUT NEXT COMMAND TO CPR
|
||
; This routine determines if a SUBMIT file is being processed
|
||
; and extracts the command line from it if so or from the user's console
|
||
;
|
||
REDBUF:
|
||
LDA RNGSUB ;SUBMIT FILE CURRENTLY IN EXECUTION?
|
||
ORA A ;0=NO
|
||
JRZ RB1 ;GET LINE FROM CONSOLE IF NOT
|
||
LXI D,SUBFCB ;OPEN $$$.SUB
|
||
PUSH D ;SAVE DE
|
||
CALL OPEN
|
||
POP D ;RESTORE DE
|
||
JRZ RB1 ;ERASE $$$.SUB IF END OF FILE AND GET CMND
|
||
LDA SUBFRC ;GET VALUE OF LAST RECORD IN FILE
|
||
DCR A ;PT TO NEXT TO LAST RECORD
|
||
STA SUBFCR ;SAVE NEW VALUE OF LAST RECORD IN $$$.SUB
|
||
CALL READ ;DE=SUBFCB
|
||
JRNZ RB1 ;ABORT $$$.SUB IF ERROR IN READING LAST REC
|
||
LXI D,CBUFF ;COPY LAST RECORD (NEXT SUBMIT CMND) TO CBUFF
|
||
LXI H,TBUFF ; FROM TBUFF
|
||
LXI B,BUFLEN ;NUMBER OF BYTES
|
||
LDIR
|
||
LXI H,SUBFS2 ;PT TO S2 OF $$$.SUB FCB
|
||
MVI M,0 ;SET S2 TO ZERO
|
||
INX H ;PT TO RECORD COUNT
|
||
DCR M ;DECREMENT RECORD COUNT OF $$$.SUB
|
||
LXI D,SUBFCB ;CLOSE $$$.SUB
|
||
CALL CLOSE
|
||
JRZ RB1 ;ABORT $$$.SUB IF ERROR
|
||
MVI A,SPRMPT ;PRINT SUBMIT PROMPT
|
||
CALL CONOUT
|
||
LXI H,CIBUFF ;PRINT COMMAND LINE FROM $$$.SUB
|
||
CALL PRIN1
|
||
CALL BREAK ;CHECK FOR ABORT (ANY CHAR)
|
||
;
|
||
IF CLEVEL3 ;IF THIRD COMMAND LEVEL IS PERMITTED
|
||
RZ ;IF <NULL> (NO ABORT), RETURN TO CALLER AND RUN
|
||
ENDIF
|
||
;
|
||
IF NOT CLEVEL3 ;IF THIRD COMMAND LEVEL IS NOT PERMITTED
|
||
JRZ CNVBUF ;IF <NULL> (NO ABORT), CAPITALIZE COMMAND
|
||
ENDIF
|
||
;
|
||
CALL SUBKIL ;KILL $$$.SUB IF ABORT
|
||
JMP RESTRT ;RESTART CPR
|
||
;
|
||
; INPUT COMMAND LINE FROM USER CONSOLE
|
||
;
|
||
RB1:
|
||
CALL SUBKIL ;ERASE $$$.SUB IF PRESENT
|
||
CALL SETUD ;SET USER AND DISK
|
||
MVI A,CPRMPT ;PRINT PROMPT
|
||
CALL CONOUT
|
||
MVI C,0AH ;READ COMMAND LINE FROM USER
|
||
LXI D,MBUFF
|
||
CALL BDOS
|
||
;
|
||
IF CLEVEL3 ;IF THIRD COMMAND LEVEL IS PERMITTED
|
||
JMP SETU0D ;SET CURRENT DISK NUMBER IN LOWER PARAMS
|
||
ENDIF
|
||
;
|
||
IF NOT CLEVEL3 ;IF THIRD COMMAND LEVEL IS NOT PERMITTED
|
||
CALL SETU0D ;SET CURRENT DISK NUMBER IF LOWER PARAMS
|
||
; AND FALL THRU TO CNVBUF
|
||
ENDIF
|
||
;
|
||
; CAPITALIZE STRING (ENDING IN 0) IN CBUFF AND SET PTR FOR PARSING
|
||
;
|
||
CNVBUF:
|
||
LXI H,CBUFF ;PT TO USER'S COMMAND
|
||
MOV B,M ;CHAR COUNT IN B
|
||
INR B ;ADD 1 IN CASE OF ZERO
|
||
CB1:
|
||
INX H ;PT TO 1ST VALID CHAR
|
||
MOV A,M ;CAPITALIZE COMMAND CHAR
|
||
CALL UCASE
|
||
MOV M,A
|
||
DJNZ CB1 ;CONTINUE TO END OF COMMAND LINE
|
||
CB2:
|
||
MVI M,0 ;STORE ENDING <NULL>
|
||
LXI H,CIBUFF ;SET COMMAND LINE PTR TO 1ST CHAR
|
||
SHLD CIBPTR
|
||
RET
|
||
;
|
||
; CHECK FOR ANY CHAR FROM USER CONSOLE;RET W/ZERO SET IF NONE
|
||
;
|
||
BREAK:
|
||
PUSH D ;SAVE DE
|
||
MVI C,11 ;CSTS CHECK
|
||
CALL BDOSB
|
||
CNZ CONIN ;GET INPUT CHAR
|
||
BRKBK:
|
||
POP D
|
||
RET
|
||
;
|
||
; GET THE REQUESTED USER NUMBER FROM THE COMMAND LINE AND VALIDATE IT.
|
||
;
|
||
USRNUM:
|
||
CALL NUMBER
|
||
CPI MAXUSR+1
|
||
RC
|
||
;
|
||
; INVALID COMMAND -- PRINT IT
|
||
;
|
||
ERROR:
|
||
CALL CRLF ;NEW LINE
|
||
LHLD CIPTR ;PT TO BEGINNING OF COMMAND LINE
|
||
ERR2:
|
||
MOV A,M ;GET CHAR
|
||
CPI ' '+1 ;SIMPLE '?' IF <SP> OR LESS
|
||
JRC ERR1
|
||
PUSH H ;SAVE PTR TO ERROR COMMAND CHAR
|
||
CALL CONOUT ;PRINT COMMAND CHAR
|
||
POP H ;GET PTR
|
||
INX H ;PT TO NEXT
|
||
JR ERR2 ;CONTINUE
|
||
ERR1:
|
||
CALL PRINT ;PRINT '?'
|
||
DB '?'+80H
|
||
CALL SUBKIL ;TERMINATE ACTIVE $$$.SUB IF ANY
|
||
JMP RESTRT ;RESTART CPR
|
||
;
|
||
; CHECK TO SEE IF DE PTS TO DELIMITER; IF SO, RET W/ZERO FLAG SET
|
||
;
|
||
SDELM:
|
||
LDAX D
|
||
ORA A ;0=DELIMITER
|
||
RZ
|
||
CPI ' ' ;ERROR IF < <SP>
|
||
JRC ERROR
|
||
RZ ;<SP>=DELIMITER
|
||
CPI '=' ;'='=DELIMITER
|
||
RZ
|
||
CPI 5FH ;UNDERSCORE=DELIMITER
|
||
RZ
|
||
CPI '.' ;'.'=DELIMITER
|
||
RZ
|
||
CPI ':' ;':'=DELIMITER
|
||
RZ
|
||
CPI ';' ;';'=DELIMITER
|
||
RZ
|
||
CPI '<' ;'<'=DELIMITER
|
||
RZ
|
||
CPI '>' ;'>'=DELIMITER
|
||
RET
|
||
;
|
||
; ADVANCE INPUT PTR TO FIRST NON-BLANK AND FALL THROUGH TO SBLANK
|
||
;
|
||
ADVAN:
|
||
LDED CIBPTR
|
||
;
|
||
; SKIP STRING PTED TO BY DE (STRING ENDS IN 0) UNTIL END OF STRING
|
||
; OR NON-BLANK ENCOUNTERED (BEGINNING OF TOKEN)
|
||
;
|
||
SBLANK:
|
||
LDAX D
|
||
ORA A
|
||
RZ
|
||
CPI ' '
|
||
RNZ
|
||
INX D
|
||
JR SBLANK
|
||
;
|
||
; ADD A TO HL (HL=HL+A)
|
||
;
|
||
ADDAH:
|
||
ADD L
|
||
MOV L,A
|
||
RNC
|
||
INR H
|
||
RET
|
||
;
|
||
; EXTRACT DECIMAL NUMBER FROM COMMAND LINE
|
||
; RETURN WITH VALUE IN REG A;ALL REGISTERS MAY BE AFFECTED
|
||
;
|
||
NUMBER:
|
||
CALL SCANER ;PARSE NUMBER AND PLACE IN FCBFN
|
||
LXI H,FCBFN+10 ;PT TO END OF TOKEN FOR CONVERSION
|
||
MVI B,11 ;11 CHARS MAX
|
||
;
|
||
; CHECK FOR SUFFIX FOR HEXADECIMAL NUMBER
|
||
;
|
||
NUMS:
|
||
MOV A,M ;GET CHARS FROM END, SEARCHING FOR SUFFIX
|
||
DCX H ;BACK UP
|
||
CPI ' ' ;SPACE?
|
||
JRNZ NUMS1 ;CHECK FOR SUFFIX
|
||
DJNZ NUMS ;COUNT DOWN
|
||
JR NUM0 ;BY DEFAULT, PROCESS
|
||
NUMS1:
|
||
CPI NUMBASE ;CHECK AGAINST BASE SWITCH FLAG
|
||
JRZ HNUM0
|
||
;
|
||
; PROCESS DECIMAL NUMBER
|
||
;
|
||
NUM0:
|
||
LXI H,FCBFN ;PT TO BEGINNING OF TOKEN
|
||
LXI B,1100H ;C=ACCUMULATED VALUE, B=CHAR COUNT
|
||
; (C=0, B=11)
|
||
NUM1:
|
||
MOV A,M ;GET CHAR
|
||
CPI ' ' ;DONE IF <SP>
|
||
JRZ NUM2
|
||
INX H ;PT TO NEXT CHAR
|
||
SUI '0' ;CONVERT TO BINARY (ASCII 0-9 TO BINARY)
|
||
CPI 10 ;ERROR IF >= 10
|
||
JRNC NUMERR
|
||
MOV D,A ;DIGIT IN D
|
||
MOV A,C ;NEW VALUE = OLD VALUE * 10
|
||
RLC
|
||
RLC
|
||
RLC
|
||
ADD C ;CHECK FOR RANGE ERROR
|
||
JRC NUMERR
|
||
ADD C ;CHECK FOR RANGE ERROR
|
||
JRC NUMERR
|
||
ADD D ;NEW VALUE = OLD VALUE * 10 + DIGIT
|
||
JRC NUMERR ;CHECK FOR RANGE ERROR
|
||
MOV C,A ;SET NEW VALUE
|
||
DJNZ NUM1 ;COUNT DOWN
|
||
;
|
||
; RETURN FROM NUMBER
|
||
;
|
||
NUM2:
|
||
MOV A,C ;GET ACCUMULATED VALUE
|
||
RET
|
||
;
|
||
; NUMBER ERROR ROUTINE FOR SPACE CONSERVATION
|
||
;
|
||
NUMERR:
|
||
JMP ERROR ;USE ERROR ROUTINE - THIS IS RELATIVE PT
|
||
;
|
||
; EXTRACT HEXADECIMAL NUMBER FROM COMMAND LINE
|
||
; RETURN WITH VALUE IN REG A; ALL REGISTERS MAY BE AFFECTED
|
||
;
|
||
HEXNUM:
|
||
CALL SCANER ;PARSE NUMBER AND PLACE IN FCBFN
|
||
HNUM0:
|
||
LXI H,FCBFN ;PT TO TOKEN FOR CONVERSION
|
||
LXI D,0 ;DE=ACCUMULATED VALUE
|
||
MVI B,11 ;B=CHAR COUNT
|
||
HNUM1:
|
||
MOV A,M ;GET CHAR
|
||
CPI ' ' ;DONE?
|
||
JRZ HNUM3 ;RETURN IF SO
|
||
CPI NUMBASE ;DONE IF NUMBASE SUFFIX
|
||
JRZ HNUM3
|
||
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:
|
||
INX H ;PT TO NEXT CHAR
|
||
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
|
||
;
|
||
; RETURN FROM HEXNUM
|
||
;
|
||
HNUM3:
|
||
XCHG ;RETURNED VALUE IN HL
|
||
MOV A,L ;LOW-ORDER BYTE IN A
|
||
RET
|
||
;
|
||
; PT TO DIRECTORY ENTRY IN TBUFF WHOSE OFFSET IS SPECIFIED BY A AND C
|
||
;
|
||
DIRPTR:
|
||
LXI H,TBUFF ;PT TO TEMP BUFFER
|
||
ADD C ;PT TO 1ST BYTE OF DIR ENTRY
|
||
CALL ADDAH ;PT TO DESIRED BYTE IN DIR ENTRY
|
||
MOV A,M ;GET DESIRED BYTE
|
||
RET
|
||
;
|
||
; CHECK FOR SPECIFIED DRIVE AND LOG IT IN IF NOT DEFAULT
|
||
;
|
||
SLOGIN:
|
||
XRA A ;SET FCBDN FOR DEFAULT DRIVE
|
||
STA FCBDN
|
||
CALL COMLOG ;CHECK DRIVE
|
||
RZ
|
||
JR DLOG5 ;DO LOGIN OTHERWISE
|
||
;
|
||
; CHECK FOR SPECIFIED DRIVE AND LOG IN DEFAULT DRIVE IF SPECIFIED<>DEFAULT
|
||
;
|
||
DLOGIN:
|
||
CALL COMLOG ;CHECK DRIVE
|
||
RZ ;ABORT IF SAME
|
||
LDA TDRIVE ;LOG IN DEFAULT DRIVE
|
||
;
|
||
DLOG5: JMP LOGIN
|
||
;
|
||
; ROUTINE COMMON TO BOTH LOGIN ROUTINES; ON EXIT, Z SET MEANS ABORT
|
||
;
|
||
COMLOG:
|
||
TEMPDR EQU $+1 ;POINTER FOR IN-THE-CODE MODIFICATION
|
||
MVI A,0 ;2ND BYTE (IMMEDIATE ARG) IS TEMPDR
|
||
ORA A ;0=NO
|
||
RZ
|
||
DCR A ;COMPARE IT AGAINST DEFAULT
|
||
LXI H,TDRIVE
|
||
CMP M
|
||
RET ;ABORT IF SAME
|
||
;
|
||
; EXTRACT TOKEN FROM COMMAND LINE AND PLACE IT INTO FCBDN;
|
||
; FORMAT FCBDN FCB IF TOKEN RESEMBLES FILE NAME AND TYPE (FILENAME.TYP);
|
||
; ON INPUT, CIBPTR PTS TO CHAR AT WHICH TO START SCAN;
|
||
; ON OUTPUT, CIBPTR PTS TO CHAR AT WHICH TO CONTINUE AND ZERO FLAG IS RESET
|
||
; IF '?' IS IN TOKEN
|
||
;
|
||
; ENTRY POINTS:
|
||
; SCANER - LOAD TOKEN INTO FIRST FCB
|
||
; SCANX - LOAD TOKEN INTO FCB PTED TO BY HL
|
||
;
|
||
SCANER:
|
||
LXI H,FCBDN ;POINT TO FCBDN
|
||
SCANX:
|
||
XRA A ;SET TEMPORARY DRIVE NUMBER TO DEFAULT
|
||
STA TEMPDR
|
||
CALL ADVAN ;SKIP TO NON-BLANK OR END OF LINE
|
||
SDED CIPTR ;SET PTR TO NON-BLANK OR END OF LINE
|
||
LDAX D ;END OF LINE?
|
||
ORA A ;0=YES
|
||
JRZ SCAN2
|
||
SBI 'A'-1 ;CONVERT POSSIBLE DRIVE SPEC TO NUMBER
|
||
MOV B,A ;STORE NUMBER (A:=0, B:=1, ETC) IN B
|
||
INX D ;PT TO NEXT CHAR
|
||
LDAX D ;SEE IF IT IS A COLON (:)
|
||
CPI ':'
|
||
JRZ SCAN3 ;YES, WE HAVE A DRIVE SPEC
|
||
DCX D ;NO, BACK UP PTR TO FIRST NON-BLANK CHAR
|
||
SCAN2:
|
||
LDA TDRIVE ;SET 1ST BYTE OF FCBDN AS DEFAULT DRIVE
|
||
MOV M,A
|
||
JR SCAN4
|
||
SCAN3:
|
||
MOV A,B ;WE HAVE A DRIVE SPEC
|
||
STA TEMPDR ;SET TEMPORARY DRIVE
|
||
MOV M,B ;SET 1ST BYTE OF FCBDN AS SPECIFIED DRIVE
|
||
INX D ;PT TO BYTE AFTER ':'
|
||
;
|
||
; EXTRACT FILENAME FROM POSSIBLE FILENAME.TYP
|
||
;
|
||
SCAN4:
|
||
XRA A ;A=0
|
||
STA QMCNT ;INIT COUNT OF NUMBER OF QUESTION MARKS IN FCB
|
||
MVI B,8 ;MAX OF 8 CHARS IN FILE NAME
|
||
CALL SCANF ;FILL FCB FILE NAME
|
||
;
|
||
; EXTRACT FILE TYPE FROM POSSIBLE FILENAME.TYP
|
||
;
|
||
MVI B,3 ;PREPARE TO EXTRACT TYPE
|
||
CPI '.' ;IF (DE) DELIMITER IS A '.', WE HAVE A TYPE
|
||
JRNZ SCAN15 ;FILL FILE TYPE BYTES WITH <SP>
|
||
INX D ;PT TO CHAR IN COMMAND LINE AFTER '.'
|
||
CALL SCANF ;FILL FCB FILE TYPE
|
||
JR SCAN16 ;SKIP TO NEXT PROCESSING
|
||
SCAN15:
|
||
CALL SCANF4 ;SPACE FILL
|
||
;
|
||
; FILL IN EX, S1, S2, AND RC WITH ZEROES
|
||
;
|
||
SCAN16:
|
||
MVI B,4 ;4 BYTES
|
||
SCAN17:
|
||
INX H ;PT TO NEXT BYTE IN FCBDN
|
||
MVI M,0
|
||
DJNZ SCAN17
|
||
;
|
||
; SCAN COMPLETE -- DE PTS TO DELIMITER BYTE AFTER TOKEN
|
||
;
|
||
SDED CIBPTR
|
||
;
|
||
; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN FILENAME.TYP
|
||
;
|
||
LDA QMCNT ;GET NUMBER OF QUESTION MARKS
|
||
ORA A ;SET ZERO FLAG TO INDICATE ANY '?'
|
||
RET
|
||
;
|
||
; SCANF -- SCAN TOKEN PTED TO BY DE FOR A MAX OF B BYTES; PLACE IT INTO
|
||
; FILE NAME FIELD PTED TO BY HL; EXPAND AND INTERPRET WILD CARDS OF
|
||
; '*' AND '?'; ON EXIT, DE PTS TO TERMINATING DELIMITER
|
||
;
|
||
SCANF:
|
||
CALL SDELM ;DONE IF DELIMITER ENCOUNTERED - <SP> FILL
|
||
JRZ SCANF4
|
||
INX H ;PT TO NEXT BYTE IN FCBDN
|
||
CPI '*' ;IS (DE) A WILD CARD?
|
||
JRNZ SCANF1 ;CONTINUE IF NOT
|
||
MVI M,'?' ;PLACE '?' IN FCBDN AND DON'T ADVANCE DE IF SO
|
||
CALL SCQ ;SCANNER COUNT QUESTION MARKS
|
||
JR SCANF2
|
||
SCANF1:
|
||
MOV M,A ;STORE FILENAME CHAR IN FCBDN
|
||
INX D ;PT TO NEXT CHAR IN COMMAND LINE
|
||
CPI '?' ;CHECK FOR QUESTION MARK (WILD)
|
||
CZ SCQ ;SCANNER COUNT QUESTION MARKS
|
||
SCANF2:
|
||
DJNZ SCANF ;DECREMENT CHAR COUNT UNTIL 8 ELAPSED
|
||
SCANF3:
|
||
CALL SDELM ;8 CHARS OR MORE - SKIP UNTIL DELIMITER
|
||
RZ ;ZERO FLAG SET IF DELIMITER FOUND
|
||
INX D ;PT TO NEXT CHAR IN COMMAND LINE
|
||
JR SCANF3
|
||
;
|
||
; FILL MEMORY POINTED TO BY HL WITH SPACES FOR B BYTES
|
||
;
|
||
SCANF4:
|
||
INX H ;PT TO NEXT BYTE IN FCBDN
|
||
MVI M,' ' ;FILL FILENAME PART WITH <SP>
|
||
DJNZ SCANF4
|
||
RET
|
||
;
|
||
; INCREMENT QUESTION MARK COUNT FOR SCANNER
|
||
; THIS ROUTINE INCREMENTS THE COUNT OF THE NUMBER OF QUESTION MARKS IN
|
||
; THE CURRENT FCB ENTRY
|
||
;
|
||
SCQ:
|
||
LDA QMCNT ;GET COUNT
|
||
INR A ;INCREMENT
|
||
STA QMCNT ;PUT COUNT
|
||
RET
|
||
;
|
||
; CMDTBL (COMMAND TABLE) SCANNER
|
||
; ON RETURN, HL PTS TO ADDRESS OF COMMAND IF CPR-RESIDENT
|
||
; ON RETURN, ZERO FLAG SET MEANS CPR-RESIDENT COMMAND
|
||
;
|
||
CMDSER:
|
||
LXI H,CMDTBL ;PT TO COMMAND TABLE
|
||
MVI C,NCMNDS ;SET COMMAND COUNTER
|
||
CMS1:
|
||
LXI D,FCBFN ;PT TO STORED COMMAND NAME
|
||
MVI B,NCHARS ;NUMBER OF CHARS/COMMAND (8 MAX)
|
||
CMS2:
|
||
LDAX D ;COMPARE AGAINST TABLE ENTRY
|
||
CMP M
|
||
JRNZ CMS3 ;NO MATCH
|
||
INX D ;PT TO NEXT CHAR
|
||
INX H
|
||
DJNZ CMS2 ;COUNT DOWN
|
||
LDAX D ;NEXT CHAR IN INPUT COMMAND MUST BE <SP>
|
||
CPI ' '
|
||
JRNZ CMS4
|
||
RET ;COMMAND IS CPR-RESIDENT (ZERO FLAG SET)
|
||
CMS3:
|
||
INX H ;SKIP TO NEXT COMMAND TABLE ENTRY
|
||
DJNZ CMS3
|
||
CMS4:
|
||
INX H ;SKIP ADDRESS
|
||
INX H
|
||
DCR C ;DECREMENT TABLE ENTRY NUMBER
|
||
JRNZ CMS1
|
||
INR C ;CLEAR ZERO FLAG
|
||
RET ;COMMAND IS DISK-RESIDENT (ZERO FLAG CLEAR)
|
||
;
|
||
;**** Section 5 ****
|
||
; CPR-Resident Commands
|
||
;
|
||
;
|
||
;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
|
||
;
|
||
DIR:
|
||
MVI A,80H ;SET SYSTEM BIT EXAMINATION
|
||
PUSH PSW
|
||
CALL SCANER ;EXTRACT POSSIBLE D:FILENAME.TYP TOKEN
|
||
CALL SLOGIN ;LOG IN DRIVE IF NECESSARY
|
||
LXI H,FCBFN ;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP
|
||
MOV A,M ;GET FIRST CHAR OF FILENAME.TYP
|
||
CPI ' ' ;IF <SP>, ALL WILD
|
||
CZ FILLQ
|
||
CALL ADVAN ;LOOK AT NEXT INPUT CHAR
|
||
MVI B,0 ;SYS TOKEN DEFAULT
|
||
JRZ DIR2 ;JUMP; THERE ISN'T ONE
|
||
CPI SYSFLG ;SYSTEM FLAG SPECIFIER?
|
||
JRZ GOTSYS ;GOT SYSTEM SPECIFIER
|
||
CPI SOFLG ;SYS ONLY?
|
||
JRNZ DIR2
|
||
MVI B,80H ;FLAG SYS ONLY
|
||
GOTSYS:
|
||
INX D
|
||
SDED CIBPTR
|
||
CPI SOFLG ;SYS ONLY SPEC?
|
||
JRZ DIR2 ;THEN LEAVE BIT SPEC UNCHAGNED
|
||
POP PSW ;GET FLAG
|
||
XRA A ;SET NO SYSTEM BIT EXAMINATION
|
||
PUSH PSW
|
||
DIR2:
|
||
POP PSW ;GET FLAG
|
||
DIR2A:
|
||
;DROP INTO DIRPR TO PRINT DIRECTORY
|
||
; THEN RESTART CPR
|
||
;
|
||
; DIRECTORY PRINT ROUTINE; ON ENTRY, MSB OF A IS 1 (80H) IF SYSTEM FILES EXCL
|
||
;
|
||
DIRPR:
|
||
MOV D,A ;STORE SYSTEM FLAG IN D
|
||
MVI E,0 ;SET COLUMN COUNTER TO ZERO
|
||
PUSH D ;SAVE COLUMN COUNTER (E) AND SYSTEM FLAG (D)
|
||
MOV A,B ;SYS ONLY SPECIFIER
|
||
STA SYSTST
|
||
CALL SEARF ;SEARCH FOR SPECIFIED FILE (FIRST OCCURRANCE)
|
||
CZ PRNNF ;PRINT NO FILE MSG;REG A NOT CHANGED
|
||
;
|
||
; ENTRY SELECTION LOOP; ON ENTRY, A=OFFSET FROM SEARF OR SEARN
|
||
;
|
||
DIR3:
|
||
JRZ DIR11 ;DONE IF ZERO FLAG SET
|
||
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)
|
||
MVI A,10 ;ADD 10 TO PT TO SYSTEM FILE ATTRIBUTE BIT
|
||
CALL DIRPTR
|
||
POP D ;GET SYSTEM BIT MASK FROM D
|
||
PUSH D
|
||
ANA D ;MASK FOR SYSTEM BIT
|
||
SYSTST EQU $+1 ;POINTER TO IN-THE-CODE BUFFER SYSTST
|
||
CPI 0
|
||
JRNZ DIR10
|
||
POP D ;GET ENTRY COUNT (=<CR> COUNTER)
|
||
MOV A,E ;ADD 1 TO IT
|
||
INR E
|
||
PUSH D ;SAVE IT
|
||
ANI 03H ;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE
|
||
PUSH PSW
|
||
JRNZ DIR4
|
||
CALL CRLF ;NEW LINE
|
||
JR DIR5
|
||
DIR4:
|
||
CALL PRINT
|
||
;
|
||
IF WIDE
|
||
DB ' ' ;2 SPACES
|
||
DB FENCE ;THEN FENCE CHAR
|
||
DB ' ',' '+80H ;THEN 2 MORE SPACES
|
||
ENDIF
|
||
;
|
||
IF NOT WIDE
|
||
DB ' ' ;SPACE
|
||
DB FENCE ;THEN FENCE CHAR
|
||
DB ' '+80H ;THEN SPACE
|
||
ENDIF
|
||
;
|
||
DIR5:
|
||
MVI B,01H ;PT TO 1ST BYTE OF FILE NAME
|
||
DIR6:
|
||
MOV A,B ;A=OFFSET
|
||
CALL DIRPTR ;HL NOW PTS TO 1ST BYTE OF FILE NAME
|
||
ANI 7FH ;MASK OUT MSB
|
||
CPI ' ' ;NO FILE NAME?
|
||
JRNZ DIR8 ;PRINT FILE NAME IF PRESENT
|
||
POP PSW
|
||
PUSH PSW
|
||
CPI 03H
|
||
JRNZ DIR7
|
||
MVI A,09H ;PT TO 1ST BYTE OF FILE TYPE
|
||
CALL DIRPTR ;HL NOW PTS TO 1ST BYTE OF FILE TYPE
|
||
ANI 7FH ;MASK OUT MSB
|
||
CPI ' ' ;NO FILE TYPE?
|
||
JRZ DIR9 ;CONTINUE IF SO
|
||
DIR7:
|
||
MVI A,' ' ;OUTPUT <SP>
|
||
DIR8:
|
||
CALL CONOUT ;PRINT CHAR
|
||
INR B ;INCR CHAR COUNT
|
||
MOV A,B
|
||
CPI 12 ;END OF FILENAME.TYP?
|
||
JRNC DIR9 ;CONTINUE IF SO
|
||
CPI 09H ;END IF FILENAME ONLY?
|
||
JRNZ DIR6 ;PRINT TYP IF SO
|
||
MVI A,'.' ;PRINT DOT BETWEEN FILE NAME AND TYPE
|
||
CALL CONOUT
|
||
JR DIR6
|
||
DIR9:
|
||
POP PSW
|
||
DIR10:
|
||
CALL BREAK ;CHECK FOR ABORT
|
||
JRNZ DIR11
|
||
CALL SEARN ;SEARCH FOR NEXT FILE
|
||
JR DIR3 ;CONTINUE
|
||
DIR11:
|
||
POP D ;RESTORE STACK
|
||
RET
|
||
;
|
||
; FILL FCB @HL WITH '?'
|
||
;
|
||
FILLQ:
|
||
MVI B,11 ;NUMBER OF CHARS IN FN & FT
|
||
FQLP:
|
||
MVI M,'?' ;STORE '?'
|
||
INX H
|
||
DJNZ FQLP
|
||
RET
|
||
;
|
||
;Section 5B
|
||
;Command: ERA
|
||
;Function: Erase files
|
||
;Forms:
|
||
; ERA <afn> Erase Specified files and print their names
|
||
;
|
||
IF NOT RAS ;NOT FOR REMOTE-ACCESS SYSTEM
|
||
;
|
||
ERA:
|
||
CALL SCANER ;PARSE FILE SPECIFICATION
|
||
CPI 11 ;ALL WILD (ALL FILES = 11 '?')?
|
||
JRNZ ERA1 ;IF NOT, THEN DO ERASES
|
||
CALL PRINTC
|
||
DB 'All','?'+80H
|
||
CALL CONIN ;GET REPLY
|
||
CPI 'Y' ;YES?
|
||
JNZ RESTRT ;RESTART CPR IF NOT
|
||
CALL CRLF ;NEW LINE
|
||
ERA1:
|
||
CALL SLOGIN ;LOG IN SELECTED DISK IF ANY
|
||
XRA A ;PRINT ALL FILES (EXAMINE SYSTEM BIT)
|
||
MOV B,A ;NO SYS-ONLY OPT TO DIRPR
|
||
CALL DIRPR ;PRINT DIRECTORY OF ERASED FILES
|
||
LXI D,FCBDN ;DELETE FILE SPECIFIED
|
||
CALL DELETE
|
||
RET ;REENTER CPR
|
||
;
|
||
ENDIF ;RAS
|
||
;
|
||
;Section 5C
|
||
;Command: LIST
|
||
;Function: Print out specified file on the LST: Device
|
||
;Forms:
|
||
; LIST <ufn> Print file (NO Paging)
|
||
;
|
||
LIST:
|
||
MVI A,0FFH ;TURN ON PRINTER FLAG
|
||
JR TYPE0
|
||
;
|
||
;Section 5D
|
||
;Command: TYPE
|
||
;Function: Print out specified file on the CON: Device
|
||
;Forms:
|
||
; TYPE <ufn> Print file
|
||
; TYPE <ufn> P Print file with paging flag
|
||
;
|
||
TYPE:
|
||
XRA A ;TURN OFF PRINTER FLAG
|
||
;
|
||
; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
|
||
;
|
||
TYPE0:
|
||
STA PRFLG ;SET FLAG
|
||
CALL SCANER ;EXTRACT FILENAME.TYP TOKEN
|
||
JNZ ERROR ;ERROR IF ANY QUESTION MARKS
|
||
CALL ADVAN ;GET PGDFLG IF IT'S THERE
|
||
STA PGFLG ;SAVE IT AS A FLAG
|
||
JRZ NOSLAS ;JUMP IF INPUT ENDED
|
||
INX D ;PUT NEW BUF POINTER
|
||
XCHG
|
||
SHLD CIBPTR
|
||
NOSLAS:
|
||
CALL SLOGIN ;LOG IN SELECTED DISK IF ANY
|
||
CALL OPENF ;OPEN SELECTED FILE
|
||
JZ TYPE4 ;ABORT IF ERROR
|
||
CALL CRLF ;NEW LINE
|
||
MVI A,NLINES-1 ;SET LINE COUNT
|
||
STA PAGCNT
|
||
LXI H,CHRCNT ;SET CHAR POSITION/COUNT
|
||
MVI M,0FFH ;EMPTY LINE
|
||
MVI B,0 ;SET TAB CHAR COUNTER
|
||
TYPE1:
|
||
LXI H,CHRCNT ;PT TO CHAR POSITION/COUNT
|
||
MOV A,M ;END OF BUFFER?
|
||
CPI 80H
|
||
JRC TYPE2
|
||
PUSH H ;READ NEXT BLOCK
|
||
CALL READF
|
||
POP H
|
||
JRNZ TYPE3 ;ERROR?
|
||
XRA A ;RESET COUNT
|
||
MOV M,A
|
||
TYPE2:
|
||
INR M ;INCREMENT CHAR COUNT
|
||
LXI H,TBUFF ;PT TO BUFFER
|
||
CALL ADDAH ;COMPUTE ADDRESS OF NEXT CHAR FROM OFFSET
|
||
MOV A,M ;GET NEXT CHAR
|
||
ANI 7FH ;MASK OUT MSB
|
||
CPI 1AH ;END OF FILE (^Z)?
|
||
RZ ;RESTART CPR IF SO
|
||
;
|
||
; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION
|
||
;
|
||
CPI CR ;RESET TAB COUNT?
|
||
JRZ TABRST
|
||
CPI LF ;RESET TAB COUNT?
|
||
JRZ TABRST
|
||
CPI TAB ;TAB?
|
||
JRZ LTAB
|
||
CALL LCOUT ;OUTPUT CHAR
|
||
INR B ;INCREMENT CHAR COUNT
|
||
JR TYPE2L
|
||
TABRST:
|
||
CALL LCOUT ;OUTPUT <CR> OR <LF>
|
||
MVI B,0 ;RESET TAB COUNTER
|
||
JR TYPE2L
|
||
LTAB:
|
||
MVI A,' ' ;<SP>
|
||
CALL LCOUT
|
||
INR B ;INCR POS COUNT
|
||
MOV A,B
|
||
ANI 7
|
||
JRNZ LTAB
|
||
;
|
||
; CONTINUE PROCESSING
|
||
;
|
||
TYPE2L:
|
||
CALL BREAK ;CHECK FOR ABORT
|
||
JRZ TYPE1 ;CONTINUE IF NO CHAR
|
||
CPI 'C'-'@' ;^C?
|
||
RZ ;RESTART IF SO
|
||
JR TYPE1
|
||
TYPE3:
|
||
DCR A ;NO ERROR?
|
||
RZ ;RESTART CPR
|
||
TYPE4:
|
||
JMP ERRLOG
|
||
;
|
||
; PAGING ROUTINES
|
||
; PAGER COUNTS DOWN LINES AND PAUSES FOR INPUT (DIRECT) IF COUNT EXPIRES
|
||
; PAGSET SETS LINES/PAGE COUNT
|
||
;
|
||
PAGER:
|
||
PUSH H
|
||
LXI H,PAGCNT ;COUNT DOWN
|
||
DCR M
|
||
JRNZ PGBAK ;JUMP IF NOT END OF PAGE
|
||
MVI M,NLINES-2 ;REFILL COUNTER
|
||
;
|
||
PGFLG EQU $+1 ;POINTER TO IN-THE-CODE BUFFER PGFLG
|
||
MVI A,0 ;0 MAY BE CHANGED BY PGFLG EQUATE
|
||
CPI PGDFLG ;PAGE DEFAULT OVERRIDE OPTION WANTED?
|
||
;
|
||
IF PGDFLT ;IF PAGING IS DEFAULT
|
||
JRZ PGBAK ; PGDFLG MEANS NO PAGING, PLEASE
|
||
ELSE ;IF PAGING NOT DEFAULT
|
||
JRNZ PGBAK ; PGDFLG MEANS PLEASE PAGINATE
|
||
ENDIF
|
||
;
|
||
CALL CONIN ;GET CHAR TO CONTINUE
|
||
CPI 'C'-'@' ;^C
|
||
JZ RSTCPR ;RESTART CPR
|
||
PGBAK:
|
||
POP H ;RESTORE HL
|
||
RET
|
||
;
|
||
;Section 5E
|
||
;Command: SAVE
|
||
;Function: To save the contents of the TPA onto disk as a file
|
||
;Forms:
|
||
; SAVE <Number of Pages> <ufn>
|
||
; Save specified number of pages (start at 100H)
|
||
; from TPA into specified file; <Number of
|
||
; Pages> is in DEC
|
||
; SAVE <Number of Sectors> <ufn> S
|
||
; Like SAVE above, but numeric argument specifies
|
||
; number of sectors rather than pages
|
||
;
|
||
IF NOT RAS ;NOT FOR REMOTE-ACCESS SYSTEM
|
||
;
|
||
SAVE:
|
||
CALL NUMBER ;EXTRACT NUMBER FROM COMMAND LINE
|
||
MOV L,A ;HL=PAGE COUNT
|
||
MVI H,0
|
||
PUSH H ;SAVE PAGE COUNT
|
||
CALL EXTEST ;TEST FOR EXISTENCE OF FILE AND ABORT IF SO
|
||
MVI C,16H ;BDOS MAKE FILE
|
||
CALL GRBDOS
|
||
POP H ;GET PAGE COUNT
|
||
JRZ SAVE3 ;ERROR?
|
||
XRA A ;SET RECORD COUNT FIELD OF NEW FILE'S FCB
|
||
STA FCBCR
|
||
CALL ADVAN ;LOOK FOR 'S' FOR SECTOR OPTION
|
||
INX D ;PT TO AFTER 'S' TOKEN
|
||
CPI SECTFLG
|
||
JRZ SAVE0
|
||
DCX D ;NO 'S' TOKEN, SO BACK UP
|
||
DAD H ;DOUBLE IT FOR HL=SECTOR (128 BYTES) COUNT
|
||
SAVE0:
|
||
SDED CIBPTR ;SET PTR TO BAD TOKEN OR AFTER GOOD TOKEN
|
||
LXI D,TPA ;PT TO START OF SAVE AREA (TPA)
|
||
SAVE1:
|
||
MOV A,H ;DONE WITH SAVE?
|
||
ORA L ;HL=0 IF SO
|
||
JRZ SAVE2
|
||
DCX H ;COUNT DOWN ON SECTORS
|
||
PUSH H ;SAVE PTR TO BLOCK TO SAVE
|
||
LXI H,128 ;128 BYTES PER SECTOR
|
||
DAD D ;PT TO NEXT SECTOR
|
||
PUSH H ;SAVE ON STACK
|
||
CALL DMASET ;SET DMA ADDRESS FOR WRITE (ADDRESS IN DE)
|
||
LXI D,FCBDN ;WRITE SECTOR
|
||
MVI C,15H ;BDOS WRITE SECTOR
|
||
CALL BDOSB ;SAVE BC
|
||
POP D ;GET PTR TO NEXT SECTOR IN DE
|
||
POP H ;GET SECTOR COUNT
|
||
JRNZ SAVE3 ;WRITE ERROR?
|
||
JR SAVE1 ;CONTINUE
|
||
SAVE2:
|
||
LXI D,FCBDN ;CLOSE SAVED FILE
|
||
CALL CLOSE
|
||
INR A ;ERROR?
|
||
JRNZ SAVE4
|
||
SAVE3:
|
||
CALL PRNLE ;PRINT 'NO SPACE' ERROR
|
||
SAVE4:
|
||
CALL DEFDMA ;SET DMA TO 0080
|
||
RET ;RESTART CPR
|
||
;
|
||
; Test File in FCB for existence, ask user to delete if so, and abort if he
|
||
; choses not to
|
||
;
|
||
EXTEST:
|
||
CALL SCANER ;EXTRACT FILE NAME
|
||
JNZ ERROR ;'?' IS NOT PERMITTED
|
||
CALL SLOGIN ;LOG IN SELECTED DISK
|
||
CALL SEARF ;LOOK FOR SPECIFIED FILE
|
||
LXI D,FCBDN ;PT TO FILE FCB
|
||
RZ ;OK IF NOT FOUND
|
||
PUSH D ;SAVE PTR TO FCB
|
||
CALL PRINTC
|
||
DB 'Delete File','?'+80H
|
||
CALL CONIN ;GET RESPONSE
|
||
POP D ;GET PTR TO FCB
|
||
CPI 'Y' ;KEY ON YES
|
||
JNZ RSTCPR ;RESTART IF NO
|
||
PUSH D ;SAVE PTR TO FCB
|
||
CALL DELETE ;DELETE FILE
|
||
POP D ;GET PTR TO FCB
|
||
RET
|
||
;
|
||
ENDIF ;RAS
|
||
;
|
||
;Section 5F
|
||
;Command: REN
|
||
;Function: To change the name of an existing file
|
||
;Forms:
|
||
; REN <New ufn>=<Old ufn> Perform function
|
||
;
|
||
IF NOT RAS ;NOT FOR REMOTE-ACCESS SYSTEM
|
||
;
|
||
REN:
|
||
CALL EXTEST ;TEST FOR FILE EXISTENCE AND RETURN
|
||
; IF FILE DOESN'T EXIST; ABORT IF IT DOES
|
||
LDA TEMPDR ;SAVE CURRENT DEFAULT DISK
|
||
PUSH PSW ;SAVE ON STACK
|
||
REN0:
|
||
LXI H,FCBDN ;SAVE NEW FILE NAME
|
||
LXI D,FCBDM
|
||
LXI B,16 ;16 BYTES
|
||
LDIR
|
||
CALL ADVAN ;ADVANCE CIBPTR
|
||
CPI '=' ;'=' OK
|
||
JRNZ REN4
|
||
REN1:
|
||
XCHG ;PT TO CHAR AFTER '=' IN HL
|
||
INX H
|
||
SHLD CIBPTR ;SAVE PTR TO OLD FILE NAME
|
||
CALL SCANER ;EXTRACT FILENAME.TYP TOKEN
|
||
JRNZ REN4 ;ERROR IF ANY '?'
|
||
POP PSW ;GET OLD DEFAULT DRIVE
|
||
MOV B,A ;SAVE IT
|
||
LXI H,TEMPDR ;COMPARE IT AGAINST CURRENT DEFAULT DRIVE
|
||
MOV A,M ;MATCH?
|
||
ORA A
|
||
JRZ REN2
|
||
CMP B ;CHECK FOR DRIVE ERROR
|
||
MOV M,B
|
||
JRNZ REN4
|
||
REN2:
|
||
MOV M,B
|
||
XRA A
|
||
STA FCBDN ;SET DEFAULT DRIVE
|
||
LXI D,FCBDN ;RENAME FILE
|
||
MVI C,17H ;BDOS RENAME FCT
|
||
CALL GRBDOS
|
||
RNZ
|
||
REN3:
|
||
CALL PRNNF ;PRINT NO FILE MSG
|
||
REN4:
|
||
JMP ERRLOG
|
||
;
|
||
ENDIF ;RAS
|
||
;
|
||
;Section 5G
|
||
;Command: USER
|
||
;Function: Change current USER number
|
||
;Forms:
|
||
; USER <unum> Select specified user number;<unum> is in DEC
|
||
;
|
||
USER:
|
||
CALL USRNUM ;EXTRACT USER NUMBER FROM COMMAND LINE
|
||
MOV E,A ;PLACE USER NUMBER IN E
|
||
CALL SETUSR ;SET SPECIFIED USER
|
||
RSTJMP:
|
||
JMP RCPRNL ;RESTART CPR
|
||
;
|
||
;Section 5H
|
||
;Command: DFU
|
||
;Function: Set the Default User Number for the command/file scanner
|
||
; (MEMLOAD)
|
||
;Forms:
|
||
; DFU <unum> Select Default User Number;<unum> is in DEC
|
||
;
|
||
DFU:
|
||
CALL USRNUM ;GET USER NUMBER
|
||
STA DFUSR ;PUT IT AWAY
|
||
JR RSTJMP ;RESTART CPR (NO DEFAULT LOGIN)
|
||
;
|
||
;Section 5I
|
||
;Command: JUMP
|
||
;Function: To Call the program (subroutine) at the specified address
|
||
; without loading from disk
|
||
;Forms:
|
||
; JUMP <adr> Call at <adr>;<adr> is in HEX
|
||
;
|
||
IF NOT RAS ;NOT FOR REMOTE-ACCESS SYSTEM
|
||
;
|
||
JUMP:
|
||
CALL HEXNUM ;GET LOAD ADDRESS IN HL
|
||
JR CALLPROG ;PERFORM CALL
|
||
;
|
||
ENDIF ;RAS
|
||
;
|
||
;Section 5J
|
||
;Command: GO
|
||
;Function: To Call the program in the TPA without loading
|
||
; loading from disk. Same as JUMP 100H, but much
|
||
; more convenient, especially when used with
|
||
; parameters for programs like STAT. Also can be
|
||
; allowed on remote-access systems with no problems.
|
||
;
|
||
;Form:
|
||
; GO <parameters like for COMMAND>
|
||
;
|
||
IF NOT RAS ;ONLY IF RAS
|
||
;
|
||
GO: LXI H,TPA ;Always to TPA
|
||
JR CALLPROG ;Perform call
|
||
;
|
||
ENDIF ;END OF GO FOR RAS
|
||
;
|
||
;Section 5K
|
||
;Command: COM file processing
|
||
;Function: To load the specified COM file from disk and execute it
|
||
;Forms:
|
||
; <command>
|
||
;
|
||
COM:
|
||
LDA FCBFN ;ANY COMMAND?
|
||
CPI ' ' ;' ' MEANS COMMAND WAS 'D:' TO SWITCH
|
||
JRNZ COM1 ;NOT <SP>, SO MUST BE TRANSIENT OR ERROR
|
||
LDA TEMPDR ;LOOK FOR DRIVE SPEC
|
||
ORA A ;IF ZERO, JUST BLANK
|
||
JZ RCPRNL
|
||
DCR A ;ADJUST FOR LOG IN
|
||
STA TDRIVE ;SET DEFAULT DRIVE
|
||
CALL SETU0D ;SET DRIVE WITH USER 0
|
||
CALL LOGIN ;LOG IN DRIVE
|
||
JMP RCPRNL ;RESTART CPR
|
||
COM1:
|
||
LDA FCBFT ;FILE TYPE MUST BE BLANK
|
||
CPI ' '
|
||
JNZ ERROR
|
||
LXI H,COMMSG ;PLACE DEFAULT FILE TYPE (COM) INTO FCB
|
||
LXI D,FCBFT ;COPY INTO FILE TYPE
|
||
LXI B,3 ;3 BYTES
|
||
LDIR
|
||
LXI H,TPA ;SET EXECUTION/LOAD ADDRESS
|
||
PUSH H ;SAVE FOR EXECUTION
|
||
CALL MEMLOAD ;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE
|
||
POP H ;GET EXECUTION ADDRESS
|
||
RNZ ;RETURN (ABORT) IF LOAD ERROR
|
||
;
|
||
; CALLPROG IS THE ENTRY POINT FOR THE EXECUTION OF THE LOADED
|
||
; PROGRAM;ON ENTRY TO THIS ROUTINE, HL MUST CONTAIN THE EXECUTION
|
||
; ADDRESS OF THE PROGRAM (SUBROUTINE) TO EXECUTE
|
||
;
|
||
CALLPROG:
|
||
SHLD EXECADR ;PERFORM IN-LINE CODE MODIFICATION
|
||
CALL DLOGIN ;LOG IN DEFAULT DRIVE
|
||
CALL SCANER ;SEARCH COMMAND LINE FOR NEXT TOKEN
|
||
LXI H,TEMPDR ;SAVE PTR TO DRIVE SPEC
|
||
PUSH H
|
||
MOV A,M ;SET DRIVE SPEC
|
||
STA FCBDN
|
||
LXI H,FCBDN+10H ;PT TO 2ND FILE NAME
|
||
CALL SCANX ;SCAN FOR IT AND LOAD IT INTO FCBDN+16
|
||
POP H ;SET UP DRIVE SPECS
|
||
MOV A,M
|
||
STA FCBDM
|
||
XRA A
|
||
STA FCBCR
|
||
LXI D,TFCB ;COPY TO DEFAULT FCB
|
||
LXI H,FCBDN ;FROM FCBDN
|
||
LXI B,33 ;SET UP DEFAULT FCB
|
||
LDIR
|
||
LXI H,CIBUFF
|
||
COM4:
|
||
MOV A,M ;SKIP TO END OF 2ND FILE NAME
|
||
ORA A ;END OF LINE?
|
||
JRZ COM5
|
||
CPI ' ' ;END OF TOKEN?
|
||
JRZ COM5
|
||
INX H
|
||
JR COM4
|
||
;
|
||
; LOAD COMMAND LINE INTO TBUFF
|
||
;
|
||
COM5:
|
||
MVI B,0 ;SET CHAR COUNT
|
||
LXI D,TBUFF+1 ;PT TO CHAR POS
|
||
COM6:
|
||
MOV A,M ;COPY COMMAND LINE TO TBUFF
|
||
STAX D
|
||
ORA A ;DONE IF ZERO
|
||
JRZ COM7
|
||
INR B ;INCR CHAR COUNT
|
||
INX H ;PT TO NEXT
|
||
INX D
|
||
JR COM6
|
||
;
|
||
; RUN LOADED TRANSIENT PROGRAM
|
||
;
|
||
COM7:
|
||
MOV A,B ;SAVE CHAR COUNT
|
||
STA TBUFF
|
||
CALL CRLF ;NEW LINE
|
||
CALL DEFDMA ;SET DMA TO 0080
|
||
CALL SETUD ;SET USER/DISK
|
||
;
|
||
; EXECUTION (CALL) OF PROGRAM (SUBROUTINE) OCCURS HERE
|
||
;
|
||
EXECADR EQU $+1 ;CHANGE ADDRESS FOR IN-LINE CODE MODIFICATION
|
||
CALL TPA ;CALL TRANSIENT
|
||
CALL DEFDMA ;SET DMA TO 0080, IN CASE
|
||
;PROG CHANGED IT ON US
|
||
CALL SETU0D ;SET USER 0/DISK
|
||
CALL LOGIN ;LOGIN DISK
|
||
JMP RESTRT ;RESTART CPR
|
||
;
|
||
; TRANSIENT LOAD ERROR
|
||
;
|
||
COM8:
|
||
POP H ;CLEAR RETURN ADDRESS
|
||
CALL RESETUSR ;RESET CURRENT USER NUMBER
|
||
; RESET MUST BE DONE BEFORE LOGIN
|
||
ERRLOG:
|
||
CALL DLOGIN ;LOG IN DEFAULT DISK
|
||
ERRJMP:
|
||
JMP ERROR
|
||
;
|
||
;Section 5L
|
||
;Command: GET
|
||
;Function: To load the specified file from disk to the specified address
|
||
;Forms:
|
||
; GET <adr> <ufn> Load the specified file at the specified page;
|
||
; <adr> is in HEX
|
||
;
|
||
IF NOT RAS ;NOT FOR REMOTE-ACCESS SYSTEM
|
||
;
|
||
GET:
|
||
CALL HEXNUM ;GET LOAD ADDRESS IN HL
|
||
PUSH H ;SAVE ADDRESS
|
||
CALL SCANER ;GET FILE NAME
|
||
POP H ;RESTORE ADDRESS
|
||
JRNZ ERRJMP ;MUST BE UNAMBIGUOUS
|
||
;
|
||
; FALL THRU TO MEMLOAD
|
||
;
|
||
ENDIF ;RAS
|
||
;
|
||
; LOAD MEMORY WITH THE FILE WHOSE NAME IS SPECIFIED IN THE COMMAND LINE
|
||
; ON INPUT, HL CONTAINS STARTING ADDRESS TO LOAD
|
||
;
|
||
MEMLOAD:
|
||
CALL MLOAD ;USER MEMORY LOAD SUBROUTINE
|
||
PUSH PSW ;SAVE RETURN STATUS
|
||
CALL RESETUSR ;RESET USER NUMBER
|
||
POP PSW ;GET RETURN STATUS
|
||
RET
|
||
|
||
;
|
||
; MEMORY LOAD SUBROUTINE
|
||
; EXIT POINTS ARE A SIMPLE RETURN WITH THE ZERO FLAG SET IF NO ERROR,
|
||
; A SIMPLE RETURN WITH THE ZERO FLAG RESET (NZ) IF MEMORY FULL, OR A JMP TO
|
||
; COM8 IF COM FILE NOT FOUND
|
||
;
|
||
MLOAD:
|
||
SHLD LOADADR ;SET LOAD ADDRESS
|
||
CALL GETUSR ;GET CURRENT USER NUMBER
|
||
STA TMPUSR ;SAVE IT FOR LATER
|
||
STA TSELUSR ;TEMP USER TO SELECT
|
||
;
|
||
; MLA is a reentry point for a non-standard CP/M Modification
|
||
; This is the return point for when the .COM (or GET) file is not found the
|
||
; first time, Drive A: is selected for a second attempt
|
||
;
|
||
MLA:
|
||
CALL SLOGIN ;LOG IN SPECIFIED DRIVE IF ANY
|
||
CALL OPENF ;OPEN COMMAND.COM FILE
|
||
JRNZ MLA1 ;FILE FOUND - LOAD IT
|
||
;
|
||
; ERROR ROUTINE TO SELECT USER 0 IF ALL ELSE FAILS
|
||
;
|
||
DFUSR EQU $+1 ;MARK IN-THE-CODE VARIABLE
|
||
MVI A,DEFUSR ;GET DEFAULT USER
|
||
TSELUSR EQU $+1 ;MARK IN-THE-CODE VARIABLE
|
||
CPI DEFUSR ;SAME?
|
||
JRZ MLA0 ;JUMP IF
|
||
STA TSELUSR ;ELSE PUT DOWN NEW ONE
|
||
MOV E,A
|
||
CALL SETUSR ;GO SET NEW USER NUMBER
|
||
JR MLA ;AND TRY AGAIN
|
||
;
|
||
; ERROR ROUTINE TO SELECT DRIVE A: IF DEFAULT WAS ORIGINALLY SELECTED
|
||
;
|
||
MLA0:
|
||
LXI H,TEMPDR ;GET DRIVE FROM CURRENT COMMAND
|
||
XRA A ;A=0
|
||
ORA M
|
||
JNZ COM8 ;ERROR IF ALREADY DISK A:
|
||
MVI M,1 ;SELECT DRIVE A:
|
||
JR MLA
|
||
;
|
||
; FILE FOUND -- PROCEED WITH LOAD
|
||
;
|
||
MLA1:
|
||
LOADADR EQU $+1 ;MEMORY LOAD ADDRESS (IN-LINE CODE MOD)
|
||
LXI H,TPA ;SET START ADDRESS OF MEMORY LOAD
|
||
ML2:
|
||
MVI A,ENTRY/256-1 ;GET HIGH-ORDER ADR OF JUST BELOW CPR
|
||
CMP H ;ARE WE GOING TO OVERWRITE THE CPR?
|
||
JRC PRNLE ;ERROR IF SO
|
||
PUSH H ;SAVE ADDRESS OF NEXT SECTOR
|
||
XCHG ;... IN DE
|
||
CALL DMASET ;SET DMA ADDRESS FOR LOAD
|
||
LXI D,FCBDN ;READ NEXT SECTOR
|
||
CALL READ
|
||
POP H ;GET ADDRESS OF NEXT SECTOR
|
||
JRNZ ML3 ;READ ERROR OR EOF?
|
||
LXI D,128 ;MOVE 128 BYTES PER SECTOR
|
||
DAD D ;PT TO NEXT SECTOR IN HL
|
||
JR ML2
|
||
;
|
||
ML3:
|
||
DCR A ;LOAD COMPLETE
|
||
RZ ;OK IF ZERO, ELSE FALL THRU TO PRNLE
|
||
;
|
||
; LOAD ERROR
|
||
;
|
||
PRNLE:
|
||
CALL PRINTC
|
||
DB 'Ful','l'+80H
|
||
MVI A,1 ;SET NON-ZERO TO INDICATE ERROR
|
||
ORA A ;SET FLAG
|
||
RET
|
||
;
|
||
END
|
||
|