*************************************************************************
*  Z C P R 8080 -- Translation to 8080 code - see below                 *
*                                                                       *
*  Z C P R 2 -- Z80-Based Command Processor Replacement, Version 2.0    *
*                                                                       *
*  Copyright (c) 1982, 1983 by Richard Conn                             *
*  All Rights Reserved                                                  *
*                                                                       *
*  ZCPR2 was written by Richard Conn, who assumes no responsibility     *
*  or liability for its use.  ZCPR2 is released to the public           *
*  domain for non-commercial use only.                                  *
*                                                                       *
*  The public is encouraged to freely copy and use this program for     *
*  non-commercial purposes.  Any commercial use of ZCPR2 is prohibited  *
*  unless approved by the author, Richard Conn, in writing.             *
*                                                                       *
*  This is Mod 0.3 to the RELEASE VERSION of ZCPR2.                     *
*                                                                       *
*  Translated to 8080 code - see below                                  *
*                                                                       *
*************************************************************************

;
;  ZCPR2 -- CP/M Z80 Command Processor Replacement (ZCPR) Version 2.0
;
;       ZCPR2 is based upon ZCPR
;
;       ZCPR2 was an individual effort by Richard Conn, with comments,
; recommendations, and some beta testing by the following people:
;               Frank Wancho
;               Charlie Strom
;               Hal Carter
;
;       Extensive documentation on ZCPR2 and the utilities in the ZCPR2
; System can be found in the following manuals:
;               ZCPR2 Concepts Manual
;               ZCPR2 Installation Manual
;               ZCPR2 User's Guide
;               ZCPR2 Rationale
;***********************8080 IMPLEMENTATION NOTE***************************
;
;       Note: ZCPR has been translated to 8080 code; this version will
; run on 8080/8085 CPU's. All Z80 relative jumps were converted to
; absolute jumps; the balance of Z80 opcodes used were translated to
; short 8080 code routines, each of which is clearly commented. The
; translation requires expansion of te CCP and in the tested implemen-
; tation, SUBMIT processing was turned off and mutiple command line
; buffer, external stack, external FCB and external path specification
; were enabled. It is fortunate that the implementation of the latter
; advanced features are accompanied by a reduction of space required in
; the CCP proper. See the ZCPR2 Installation Manual for details.
;
;       The ZCPR2 utilities are all writtten in 8080 code and will
; therefore operate properly with the following exceptions: DU2, HELP2,
; LRUNZ. 8080 versions of these utilities are now available.
;
;                                       Charles H. Strom
;                                       May 11, 1983
;
; LDIR replacement changed to subroutine (LDIRSB) to save space (CHS-5/22/83)
;
;**************************************************************************
;
;
;******** Structure Notes ********
;
;       ZCPR2 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 ZCPR2
;
;    1          Buffers
;
;    2          CPR Starting Modules
;                       CPR1    CPR     CONT    RESTRT  RS1
;                       CAPBUF  RSTCPR  RCPRNL  ERROR   PRNNF
;
;    3          Utilities
;                       CRLF    CONOUT  CONIN   LCOUT   LSTOUT
;                       PAGER   READF   READ    BDOSB   PRINTC
;                       PRINT   PRIN1   GETDRV  DEFDMA  DMASET
;                       RESET   BDOSJP  LOGIN   OPENF   OPEN
;                       GRBDOS  CLOSE   SEARF   SEAR1   SEARN
;                       SUBKIL  DELETE  GETUSR  SETUSR
;
;     4         CPR Utilities
;                       SETUD   UCASE   REDBUF  BREAK   SDELM
;                       ADVAN   SBLANK  ADDAH   NUMBER  NUMERR
;                       HEXNUM  DIRPTR  SLOGIN  DLOGIN  SCANLOG
;                       SCANER  SCANX   SCANF   CMDSER
;
;     5         CPR-Resident Commands and Functions
;     5A                DIR     DIRPR   PRFN    GETSBIT FILLQ
;     5B                ERA
;     5C                LIST
;     5D                TYPE
;     5E                SAVE    EXTEST
;     5F                REN
;     5G                JUMP
;     5H                GO
;     5I                COM     CALLPROG
;     5J                GET     MLOAD   PRNLE   PATH
;
;
FALSE   EQU     0
TRUE    EQU     NOT FALSE
;
;  The following MACLIB statement loads all the user-selected equates
; which are used to customize ZCPR2 for the user's working environment.
;
       MACLIB  ZCPRHDR
;
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
;
;
;**** Section 0 ****
;
       ORG     CPRLOC
;
;  ENTRY POINTS INTO ZCPR2
;
;    IF MULTCMD (MULTIPLE COMMANDS ON ONE LINE) is FALSE:
;    If ZCPR2 is entered at location CPRLOC (at the JMP to CPR), then
; the default command in CMDLIN will be processed.  If ZCPR2 is entered
; at location CPRLOC+3 (at the JMP to CPR1), then the default command in
; CMDLIN will NOT be processed.
;    NOTE:  Entry into ZCPR2 at CPRLOC is permitted, but in order for this
; to work, CMDLIN MUST be initialized to contain the command line (ending in 0)
; and the C register MUST contain a valid User/Disk Flag
; (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.  The NXTCHR (NeXT CHaRacter pointer)
; is located to be compatable with such programs (if they determine the buffer
; length from the byte at BUFSIZ [CPRLOC + 6]), but under ZCPR2
; this is no longer necessary.  ZCPR2 automatically initializes
; this buffer pointer in all cases if MULTCMD is not enabled.
;
;    IF MULTCMD is TRUE:
;    Entry at CPR or CPR1 has the same effect.  Multiple command processing
; will still continue.
;    Hence, if MULTCMD is FALSE, a user program need only load the buffer
; CMDLIN with the desired command line, terminated by a zero, in order to
; have this command line executed.  If MULTCMD is TRUE, a user program must
; load this buffer as before, but he must also set the NXTCHR pointer to
; point to the first character of the command line.
;    NOTE:  ***** (BIG STAR) ***** Programs such as SYNONYM3 will fail if
; multiple commands are enabled, but this feature is so very useful that I
; feel it is worth the sacrifice.  The ZCPR2 utilities of STARTUP and MENU
; require multiple commands, and this feature also permits simple chaining
; of programs to be possible under the ZCPR2 environment.
;
;       Enjoy using ZCPR2!
;                       Richard Conn
;
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
; CMDLIN.  This command line is terminated by a binary zero.  ZCPR2 then
; parses, interprets, and executes the command line.
;   Case is not significant in the command line.  ZCPR2 converts all lower-case
; letters to upper-case.
;   If MULTCMD is TRUE, then the user must set a pointer to the first
; character of the command line into the buffer NXTCHR.  If MULTCMD is FALSE,
; no action other than placing a zero-terminated command line into the buffer
; starting at CMDLIN is required on the part of the user.
;
       IF      MULTCMD         ;MULTIPLE COMMANDS ALLOWED?
;
; For Multiple Commands, the command line buffer (CMDLIN) is located external
; to ZCPR2 so that it is not overlayed during Warm Boots; the same is true
; for NXTCHR, the 2nd key buffer.  BUFSIZ and CHRCNT are not important and
; are provided so the BDOS READLN function can load CMDLIN directly and
; a user program can see how much space is available in CMDLIN for its text.
;
NXTCHR  EQU     CLBASE          ;NXTCHR STORED EXTERNALLY (2 bytes)
BUFSIZ  EQU     NXTCHR+2        ;BUFSIZ STORED EXTERNALLY (1 byte)
CHRCNT  EQU     BUFSIZ+1        ;CHRCNT STORED EXTERNALLY (1 byte)
CMDLIN  EQU     CHRCNT+1        ;CMDLIN STORED EXTERNALLY (long)
;
       ELSE
;
; If no multiple commands are permitted, these buffers are left internal
; to ZCPR2 so that the original CCP command line facility (as used by
; programs like SYNONYM3) can be left intact.
;
BUFLEN  EQU     80              ;MAXIMUM BUFFER LENGTH
BUFSIZ:
       DB      BUFLEN          ;MAXIMUM BUFFER LENGTH
CHRCNT:
       DB      0               ;NUMBER OF VALID CHARS IN COMMAND LINE
CMDLIN:
       DB      '               '       ;DEFAULT (COLD BOOT) COMMAND
       DB      0                       ;COMMAND STRING TERMINATOR
       DS      BUFLEN-($-CMDLIN)+1     ;TOTAL IS 'BUFLEN' BYTES
;
NXTCHR:
       DW      CMDLIN          ;POINTER TO COMMAND INPUT BUFFER
;
       ENDIF           ;MULTCMD
;

;
; FILE TYPE FOR COMMAND
;
COMMSG:
       COMTYP                  ;USE MACRO FROM ZCPRHDR.LIB
;
       IF      SUBON           ;IF SUBMIT FACILITY ENABLED ...
;
; SUBMIT FILE CONTROL BLOCK
;
SUBFCB:
       DB      1               ;DISK NAME SET TO DEFAULT TO DRIVE A:
       DB      '$$$'           ;FILE NAME
       DB      '     '
       SUBTYP                  ;USE MACRO FROM ZCPRHDR.LIB
       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
;
       ENDIF           ;SUBON
;
; COMMAND FILE CONTROL BLOCK
;
       IF      EXTFCB          ;MAY BE PLACED EXTERNAL TO ZCPR2
;
FCBDN   EQU     FCBADR          ;DISK NAME
FCBFN   EQU     FCBDN+1         ;FILE NAME
FCBFT   EQU     FCBFN+8         ;FILE TYPE
FCBDM   EQU     FCBFT+7         ;DISK GROUP MAP
FCBCR   EQU     FCBDM+16        ;CURRENT RECORD NUMBER
;
       ELSE                    ;OR INTERNAL TO ZCPR2
;
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
;
       ENDIF           ;EXTFCB
;

;
; LINE COUNT BUFFER
;
PAGCNT:
       DB      NLINES-2        ;LINES LEFT ON PAGE

;
; CPR COMMAND NAME TABLE
;   EACH TABLE ENTRY IS COMPOSED OF THE 4-BYTE COMMAND AND 2-BYTE ADDRESS
;
CMDTBL:
       CTABLE          ;DEFINE COMMAND TABLE VIA MACRO IN ZCPRHDR FILE
;
NCMNDS  EQU     ($-CMDTBL)/(NCHARS+2)
;

;
;**** Section 2 ****
; ZCPR2 STARTING POINTS
;
; START ZCPR2 AND DON'T PROCESS DEFAULT COMMAND STORED IF MULTIPLE COMMANDS
; ARE NOT ALLOWED
;
CPR1:
;
       IF      NOT MULTCMD     ;IF MULTIPLE COMMANDS NOT ALLOWED
;
       XRA     A               ;SET END OF COMMAND LINE SO NO DEFAULT COMMAND
       STA     CMDLIN          ;FIRST CHAR OF BUFFER
;
       ENDIF           ;NOT MULTCMD
;
; START ZCPR2 AND POSSIBLY PROCESS DEFAULT COMMAND
;
; NOTE ON MODIFICATION BY Ron Fowler:  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
;
       IF      NOT MULTCMD     ;ONLY ONE COMMAND PERMITTED
;
       LXI     H,CMDLIN        ;SET PTR TO BEGINNING OF COMMAND LINE
       SHLD    NXTCHR
;
       ENDIF           ;NOT MULTCMD
;
       PUSH    B
       MOV     A,C             ;C=USER/DISK NUMBER (SEE LOC 4)
       RAR                     ;EXTRACT USER NUMBER
       RAR
       RAR
       RAR
       ANI     0FH
       STA     CURUSR          ;SET USER
       CALL    SETUSR          ;SET USER NUMBER
       CALL    RESET           ;RESET DISK SYSTEM
;
       IF      SUBON           ;IF SUBMIT FACILITY ENABLED
;
       STA     RNGSUB          ;SAVE SUBMIT CLUE FROM DRIVE A:
;
       ENDIF           ;SUBON
;
       POP     B
       MOV     A,C             ;C=USER/DISK NUMBER (SEE LOC 4)
       ANI     0FH             ;EXTRACT CURRENT DISK DRIVE
       STA     CURDR           ;SET IT
       CNZ     LOGIN           ;LOG IN DEFAULT DISK IF NOT ALREADY LOGGED IN
       CALL    SETUD           ;SET USER/DISK FLAG
       CALL    DEFDMA          ;SET DEFAULT DMA ADDRESS
;
       IF      SUBON           ;CHECK FOR $$$.SUB IF SUBMIT FACILITY IS ON
;
       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
       CNZ     SEAR1
       STA     RNGSUB          ;SET FLAG (0=NO $$$.SUB)
;
       ENDIF           ;SUBON
;
       IF      MULTCMD
;
;  TEST FOR NEXT COMMAND IN CONT LOOP IF MULTIPLE COMMAND LINE BUFFER
;       IS ENABLED
;
CONT:
;
       ENDIF           ;MULTCMD
;
       LHLD    NXTCHR          ;PT TO NEXT CHARACTER TO PROCESS
       MOV     A,M             ;GET IT
       CPI     3               ;RESTART IF ^C
       JZ      RESTRT
       ORA     A               ;0 IF NO COMMAND LINE PRESENT
       JNZ     RS1
;
       IF      NOT MULTCMD
;
;  TEST FOR ANY DEFAULT COMMAND BEFORE CONT LOOP IS
;       ENTERED IF MULTIPLE COMMAND LINE BUFFER IS DISABLED
;
CONT:
;
       ENDIF           ;NOT MULTCMD
;
; PROMPT USER AND INPUT COMMAND LINE FROM HIM
;
RESTRT:
       LXI     SP,STACK        ;RESET STACK
;
; PRINT PROMPT (DU>)
;
       CALL    CRLF            ;PRINT PROMPT
;
       IF      DUPRMPT         ;IF DRIVE IN PROMPT
       LDA     CURDR           ;CURRENT DRIVE IS PART OF PROMPT
       ADI     'A'             ;CONVERT TO ASCII A-P
       CALL    CONOUT
;
       LDA     CURUSR          ;GET USER NUMBER
;
       IF      SUPRES          ;IF SUPPRESSING USR # REPORT FOR USR 0
;
       ORA     A
       JZ      RS000
;
       ENDIF           ;SUPRES
;
       CPI     10              ;USER < 10?
       JC      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
;
       ENDIF           ;DUPRMPT
;
; READ INPUT LINE FROM USER OR $$$.SUB
;
RS000:
       LXI     H,CMDLIN        ;SET POINTER TO FIRST CHAR IN COMMAND LINE
       SHLD    NXTCHR          ;POINTER TO NEXT CHARACTER TO PROCESS
       MVI     M,0             ;ZERO OUT COMMAND LINE IN CASE OF WARM BOOT
       PUSH    H               ;SAVE PTR
       CALL    REDBUF          ;INPUT COMMAND LINE FROM USER (OR $$$.SUB)
       POP     H               ;GET PTR
       MOV     A,M             ;CHECK FOR COMMENT LINE
       CPI     COMMENT         ;BEGINS WITH COMMENT CHAR?
       JZ      RESTRT          ;INPUT ANOTHER LINE IF SO
       ORA     A               ;NO INPUT?
       JZ      RESTRT
;
; PROCESS INPUT LINE; HL PTS TO FIRST LETTER OF COMMAND
;
RS1:
       LXI     SP,STACK        ;RESET STACK
;
       IF      MULTCMD         ;MULTIPLE COMMANDS ALLOWED?
;
       MOV     A,M             ;GET FIRST CHAR OF COMMAND
       CPI     CMDSEP          ;IS IT A COMMAND SEPARATOR?
       JNZ     RS2
       INX     H               ;SKIP IT IF IT IS
       SHLD    NXTCHR          ;SET PTR BACK
;
       ENDIF           ;MULTCMD
;
; SET POINTER FOR MULTIPLE COMMAND LINE PROCESSING TO FIRST CHAR OF NEW CMND
;
RS2:
       SHLD    CMDCH1          ;SET PTR TO FIRST CHAR OF NEW COMMAND LINE
;
; CAPITALIZE COMMAND LINE
;
CAPBUF:
       MOV     A,M             ;CAPITALIZE COMMAND CHAR
       CALL    UCASE
       MOV     M,A
       INX     H               ;PT TO NEXT CHAR
       ORA     A               ;EOL?
       JNZ     CAPBUF
       CALL    SCANER          ;PARSE COMMAND NAME FROM COMMAND LINE
       JNZ     ERROR           ;ERROR IF COMMAND NAME CONTAINS A '?'
       LXI     D,RSTCPR        ;PUT RETURN ADDRESS OF COMMAND
       PUSH    D               ;ON THE STACK
COLON   EQU     $+1             ;FLAG FOR IN-THE-CODE MODIFICATION
       MVI     A,0             ;COMMAND OF THE FORM 'DU:COMMAND'?
       ORA     A               ;0=NO
       JNZ     COM             ;PROCESS AS COM FILE IF NOT
       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 CURRENT USER/DISK
;
; 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
       CPI     ' '             ;ANY CHAR?
       JZ      CONT            ;CONTINUE WITH NEXT COMMAND IF NO ERROR

;
; INVALID COMMAND -- PRINT IT
;
ERROR:
       CALL    CRLF            ;NEW LINE
CURTOK  EQU     $+1             ;POINTER FOR IN-THE-CODE MODIFICATION
       LXI     H,0             ;PT TO BEGINNING OF COMMAND LINE
ERR1:
       MOV     A,M             ;GET CHAR
       CPI     ' '+1           ;SIMPLE '?' IF <SP> OR LESS
       JC      ERR2
       CALL    CONOUT          ;PRINT COMMAND CHAR
       INX     H               ;PT TO NEXT CHAR
       JMP     ERR1            ;CONTINUE
ERR2:
       CALL    PRINT           ;PRINT '?'
       DB      '?'+80H
ERR3:
       CALL    DLOGIN          ;PANIC RESTORE OF DEFAULT USER/DISK
;
       IF      SUBON           ;IF SUBMIT FACILITY IS ON
;
       CALL    SUBKIL          ;TERMINATE ACTIVE $$$.SUB IF ANY
;
       ENDIF           ;SUBON
;
       JMP     RESTRT          ;RESTART CPR

;
; 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
       JMP     CONOUT
;
CONIN:
       MVI     C,1     ;INPUT CHAR
       CALL    BDOS    ;GET INPUT CHAR WITH ^S PROCESSING AND ECHO
       JMP     UCASE   ;CAPITALIZE
;
CONOUT:
       PUSH    B       ;EXX REPLACEMENT
       PUSH    D
       PUSH    H
       MVI     C,2
OUTPUT:
       MOV     E,A
       CALL    BDOS
       POP     H       ;EXX REPLACEMENT
       POP     D
       POP     B
       RET
;
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
       JZ      LC1
       POP     PSW     ;GET CHAR
;
; OUTPUT
CHAR IN REG A TO LIST DEVICE
;
LSTOUT:
       PUSH    B       ;EXX REPLACEMENT
       PUSH    D       ;SAVE REGS
       PUSH    H
       MVI     C,5
       JMP     OUTPUT
LC1:
       POP     PSW     ;GET CHAR
       PUSH    PSW
       CALL    CONOUT  ;OUTPUT TO CON:
       POP     PSW
       CPI     LF      ;CHECK FOR PAGING
       RNZ
;
; 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
       JNZ     PAGER1          ;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
;
       JZ      PAGER1          ;  PGDFLG MEANS NO PAGING, PLEASE
;
       ELSE                    ;IF PAGING NOT DEFAULT
;
       JNZ     PAGER1          ;  PGDFLG MEANS PLEASE PAGINATE
;
       ENDIF           ;PGDFLG
;
       PUSH    B               ;SAVE REG
       CALL    BIOS+9          ;BIOS CONSOLE INPUT ROUTINE
       POP     B               ;GET REG
       CPI     'C'-'@'         ;^C
       JZ      RSTCPR          ;RESTART CPR
PAGER1:
       POP     H               ;RESTORE HL
       RET
;
; READ FILE BLOCK FUNCTION
;
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 CHAR WITH MSB SET) PTED TO BY RET ADR
; START WITH <CRLF>
;
PRINTC:
       CALL    CRLF            ;NEW LINE
;
PRINT:
       XTHL                    ;GET PTR TO STRING
       CALL    PRIN1           ;PRINT STRING
       XTHL                    ;RESTORE HL AND RET ADR
       RET
;
; PRINT STRING (ENDING IN 0 OR BYTE WITH MSB SET) PTED TO BY HL
;
PRIN1:
       MOV     A,M             ;GET NEXT BYTE
       INX     H               ;PT TO NEXT BYTE
       ORA     A               ;END OF STRING?
       RZ                      ;STRING TERMINATED BY BINARY 0
       PUSH    PSW             ;SAVE FLAGS
       ANI     7FH             ;MASK OUT MSB
       CALL    CONOUT          ;PRINT CHAR
       POP     PSW             ;GET FLAGS
       RM                      ;STRING TERMINATED BY MSB SET
       JMP     PRIN1
;
; BDOS FUNCTION ROUTINES
;
;
; RETURN NUMBER OF CURRENT DISK IN A
;
GETDRV:
       MVI     C,19H
       JMP     BDOSJP
;
; SET 80H AS DMA ADDRESS
;
DEFDMA:
       LXI     D,TBUFF         ;80H=TBUFF
DMASET:
       MVI     C,1AH
       JMP     BDOSJP
;
RESET:
       MVI     C,0DH
BDOSJP:
       JMP     BDOS
;
LOGIN:
       MOV     E,A
       MVI     C,0EH
       JMP     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
       JMP     GRBDOS
;
SEARF:
       LXI     D,FCBDN ;SPECIFY FCB
SEAR1:
       MVI     C,11H
       JMP     GRBDOS
;
SEARN:
       MVI     C,12H
       JMP     GRBDOS
;
; CHECK FOR SUBMIT FILE IN EXECUTION AND ABORT IT IF SO
;
       IF      SUBON           ;ENABLE ONLY IF SUBMIT FACILITY IS ENABLED
;
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
;
       ENDIF           ;SUBON
;
DELETE:
       MVI     C,13H
       JMP     BDOSJP  ;SAVE MORE SPACE
;
;  GET/SET USER NUMBER
;
GETUSR:
       MVI     A,0FFH          ;GET CURRENT USER NUMBER
SETUSR:
       MOV     E,A             ;USER NUMBER IN E
       MVI     C,20H           ;SET USER NUMBER TO VALUE IN E (GET IF E=FFH)
       JMP     BDOSJP          ;MORE SPACE SAVING
;
; END OF BDOS FUNCTIONS
;
;
;**** Section 4 ****
; ZCPR2 UTILITIES
;
; SET USER/DISK FLAG TO CURRENT USER AND DEFAULT DISK
;
SETUD:
       CALL    GETUSR          ;GET NUMBER OF CURRENT USER
       ANI     0FH             ;MASK SURE 4 BITS
       ADD     A               ;PLACE IT IN HIGH NYBBLE
       ADD     A
       ADD     A
       ADD     A
       LXI     H,CURDR         ;MASK IN CURRENT DRIVE NUMBER (LOW NYBBLE)
       ORA     M               ;MASK IN
       STA     UDFLAG          ;SET USER/DISK NUMBER
       RET
;
; CONVERT CHAR IN A TO UPPER CASE
;
UCASE:
       ANI     7FH             ;MASK OUT MSB
       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:
;
       IF      SUBON           ;IF SUBMIT FACILITY IS ENABLED, CHECK FOR IT
;
       LDA     RNGSUB          ;SUBMIT FILE CURRENTLY IN EXECUTION?
       ORA     A               ;0=NO
       JZ      RB1             ;GET LINE FROM CONSOLE IF NOT
       LXI     D,SUBFCB        ;OPEN $$$.SUB
       PUSH    D               ;SAVE DE
       CALL    OPEN
       POP     D               ;RESTORE DE
       JZ      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
       JNZ     RB1             ;ABORT $$$.SUB IF ERROR IN READING LAST REC
       LXI     D,CHRCNT        ;COPY LAST RECORD (NEXT SUBMIT CMND) TO CHRCNT
       LXI     H,TBUFF         ;  FROM TBUFF
       LXI     B,BUFLEN        ;NUMBER OF BYTES
       CALL    LDIRSB          ;LDIR REPLACEMENT SUBROUTINE
       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
       JZ      RB1             ;ABORT $$$.SUB IF ERROR
       MVI     A,SPRMPT        ;PRINT SUBMIT PROMPT
       CALL    CONOUT
       LXI     H,CMDLIN        ;PRINT COMMAND LINE FROM $$$.SUB
       CALL    PRIN1
       CALL    BREAK           ;CHECK FOR ABORT (ANY CHAR)
       RNZ                     ;IF NO ^C, RETURN TO CALLER AND RUN
       CALL    SUBKIL          ;KILL $$$.SUB IF ABORT
       JMP     RESTRT          ;RESTART CPR
;
; INPUT COMMAND LINE FROM USER CONSOLE
;
RB1:
       CALL    SUBKIL          ;ERASE $$$.SUB IF PRESENT
;
       ENDIF           ;SUBON
;
       MVI     A,CPRMPT        ;PRINT PROMPT
       CALL    CONOUT
       MVI     C,0AH           ;READ COMMAND LINE FROM USER
       LXI     D,BUFSIZ
       CALL    BDOS
;
; STORE ZERO AT END OF COMMAND LINE
;
       LXI     H,CHRCNT        ;PT TO CHAR COUNT
       MOV     A,M             ;GET CHAR COUNT
       INX     H               ;PT TO FIRST CHAR OF COMMAND LINE
       CALL    ADDAH           ;PT TO AFTER LAST CHAR OF COMMAND LINE
       MVI     M,0             ;STORE ENDING ZERO
       RET
;
; CHECK FOR ANY CHAR FROM USER CONSOLE; RET W/ZERO SET IF NONE
;
BREAK:
       PUSH    B               ;EXX REPLACEMENT
       PUSH    D               ;SAVE REGS
       PUSH    H
       CALL    BIOS+6          ;CONSOLE STATUS CHECK
       ORA     A               ;SET FLAGS
       CNZ     BIOS+9          ;GET INPUT CHAR WITH ^S PROCESSING
       CPI     'S'-'@'         ;PAUSE IF ^S
       CZ      BIOS+9          ;GET NEXT CHAR
       POP     H               ;RESTORE REGS
       POP     D
       POP     B
       CPI     'C'-'@'         ;CHECK FOR ABORT
       RET

;
; CHECK TO SEE IF DE PTS TO DELIMITER; IF SO, RET W/ZERO FLAG SET
;
SDELM:
       LDAX    D
       ORA     A               ;0=DELIMITER
       RZ
       CPI     ' '+1           ;DELIM IF <= <SP>
       JC      ZERO
       CPI     '='             ;'='=DELIMITER
       RZ
       CPI     5FH             ;UNDERSCORE=DELIMITER
       RZ
       CPI     '.'             ;'.'=DELIMITER
       RZ
       CPI     ':'             ;':'=DELIMITER
       RZ
       CPI     ','             ;','=DELIMITER
       RZ
       CPI     ';'             ;';'=DELIMITER
       RZ
       CPI     '<'             ;'<'=DELIMITER
       RZ
       CPI     '>'             ;'>'=DELIMITER
;
       IF      MULTCMD         ;MULTIPLE COMMANDS ALLOWED?
;
       RZ
       CPI     CMDSEP          ;COMMAND SEPARATOR
;
       ENDIF           ;MULTCMD
;
       RET
ZERO:
       XRA     A       ;SET ZERO FLAG
       RET

;
; ADVANCE INPUT PTR TO FIRST NON-BLANK AND FALL THROUGH TO SBLANK
;
ADVAN:
       XCHG            ;START LDED REPLACEMENT
       LHLD    NXTCHR  ;PT TO NEXT CHAR
       XCHG            ;END LDED REPLACEMENT
;
; SKIP STRING PTED TO BY DE (STRING ENDS IN 0 OR CMDSEP) UNTIL END OF STRING
;   OR NON-DELIM ENCOUNTERED (BEGINNING OF TOKEN)
;
SBLANK:
       LDAX    D       ;GET CHAR
       ORA     A       ;ZERO?
       RZ
;
       IF      MULTCMD ;MULTIPLE COMMANDS ALLOWED?
;
       CPI     CMDSEP  ;COMMAND SEPARATOR?
       RZ
;
       ENDIF           ;MULTCMD
;
       CALL    SDELM   ;SKIP OVER DELIMITER
       RNZ
       INX     D       ;ADVANCE TO NEXT CHAR
       JMP     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?
       JNZ     NUMS1           ;CHECK FOR SUFFIX
       DCR     B               ;LDIR REPLACEMENT
       JNZ     NUMS            ;COUNT DOWN
       JMP     NUM0            ;BY DEFAULT, PROCESS
NUMS1:
       CPI     NUMBASE         ;CHECK AGAINST BASE SWITCH FLAG
       JZ      HNUM0
;
; PROCESS DECIMAL NUMBER
;
NUM0:
       LXI     H,FCBFN         ;PT TO BEGINNING OF TOKEN
NUM0A:
       LXI     B,1100H         ;C=ACCUMULATED VALUE, B=CHAR COUNT
                               ; (C=0, B=11)
NUM1:
       MOV     A,M             ;GET CHAR
       CPI     ' '             ;DONE IF <SP>
       JZ      NUM2
       CPI     ':'             ;DONE IF COLON
       JZ      NUM2
       INX     H               ;PT TO NEXT CHAR
       SUI     '0'             ;CONVERT TO BINARY (ASCII 0-9 TO BINARY)
       CPI     10              ;ERROR IF >= 10
       JNC     NUMERR
       MOV     D,A             ;DIGIT IN D
       MOV     A,C             ;NEW VALUE = OLD VALUE * 10
       RLC                     ;*2
       JC      NUMERR
       RLC                     ;*4
       JC      NUMERR
       RLC                     ;*8
       JC      NUMERR
       ADD     C               ;*9
       JC      NUMERR
       ADD     C               ;*10
       JC      NUMERR
       ADD     D               ;NEW VALUE = OLD VALUE * 10 + DIGIT
       JC      NUMERR          ;CHECK FOR RANGE ERROR
       MOV     C,A             ;SET NEW VALUE
       DCR     B               ;DJNZ REPLACEMENT
       JNZ     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?
       JZ      HNUM3           ;RETURN IF SO
       CPI     NUMBASE         ;DONE IF NUMBASE SUFFIX
       JZ      HNUM3
       SUI     '0'             ;CONVERT TO BINARY
       JC      NUMERR          ;RETURN AND DONE IF ERROR
       CPI     10              ;0-9?
       JC      HNUM2
       SUI     7               ;A-F?
       CPI     10H             ;ERROR?
       JNC     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
       DCR     B               ;DJNZ REPLACEMENT
       JNZ     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
;
SLOGIN:
       XRA     A               ;A=0 FOR DEFAULT DISK
       STA     FCBDN           ;SELECT DEFAULT DISK SINCE USER/DISK
                               ;  SPECIFICALLY SELECTED BY THIS ROUTINE
TEMPDR  EQU     $+1             ;POINTER FOR IN-THE-CODE MODIFICATION
       MVI     A,0             ;2ND BYTE (IMMEDIATE ARG) IS TEMPDR
       ORA     A               ;0=CURRENT DRIVE
       JNZ     SLOG1
       LDA     CURDR           ;LOG IN CURRENT DRIVE
       INR     A               ;ADD 1 FOR NEXT DCR
SLOG1:
       DCR     A               ;ADJUST FOR PROPER DISK NUMBER (A=0)
       CALL    LOGIN           ;LOG IN NEW DRIVE
TEMPUSR EQU     $+1             ;POINTER FOR IN-THE-CODE MODIFICATION
       MVI     A,0             ;2ND BYTE IS USER TO BE SELECTED
       JMP     SETUSR          ;LOG IN NEW USER

;
; CHECK FOR SPECIFIED DRIVE AND LOG IN DEFAULT DRIVE IF SPECIFIED<>DEFAULT
;
DLOGIN:
CURDR   EQU     $+1             ;POINTER FOR IN-THE-CODE MODIFICATION
       MVI     A,0             ;PREP TO LOG IN CURRENT DRIVE
       CALL    LOGIN           ;LOGIN CURRENT DRIVE
CURUSR  EQU     $+1             ;POINTER FOR IN-THE-CODE MODIFICATION
       MVI     A,0             ;PREP TO LOG IN CURRENT USER NUMBER
       JMP     SETUSR          ;LOG IN NEW USER

;
;  ROUTINE TO CHECK FOR A WHEEL BYTE AS NON-ZERO
;    IF WHEEL BYTE IS ZERO, THEN ABORT (POP STACK AND RETURN)
;
;
       IF      WHEEL           ;WHEEL FACILITY?
;
WHLCHK:
       LDA     WHLADR          ;GET WHEEL BYTE
       ORA     A               ;ZERO?
       RNZ                     ;OK IF NOT
       JMP     ERROR           ;PROCESS AS ERROR
;
       ENDIF           ;WHEEL
;

;
; EXTRACT TOKEN FROM COMMAND LINE AND PLACE IT INTO FCBDN;
;   FORMAT FCBDN FCB IF TOKEN RESEMBLES FILE NAME AND TYPE (FILENAME.TYP);
;   ON INPUT, NXTCHR PTS TO CHAR AT WHICH TO START SCAN;
;   ON OUTPUT, NXTCHR PTS TO CHAR AT WHICH TO CONTINUE AND ZERO FLAG IS RESET
;     IF '?' IS IN TOKEN
;
; ENTRY POINTS:
;       SCANLOG - LOAD TOKEN INTO FIRST FCB AND LOG IN TEMP USER/DISK
;       SCANER - LOAD TOKEN INTO FIRST FCB
;       SCANX - LOAD TOKEN INTO FCB PTED TO BY HL
;
SCANLOG:
       CALL    SCANER          ;DO SCAN
       PUSH    PSW             ;SAVE FLAG
       CALL    SLOGIN          ;LOG IN TEMPORARY USER/DISK
       POP     PSW             ;GET FLAG
       RET
SCANER:
       LXI     H,FCBDN         ;POINT TO FCBDN
SCANX:
       XRA     A               ;A=0
       STA     TEMPDR          ;SET TEMPORARY DRIVE NUMBER TO DEFAULT
       MOV     M,A             ;SET FIRST BYTE OF FCBDN AS DEFAULT DRIVE
       STA     COLON           ;SET NO COLON FLAG
       LDA     CURUSR          ;GET CURRENT USER
       STA     TEMPUSR         ;SET TEMPUSR
       CALL    ADVAN           ;SKIP TO NON-BLANK OR END OF LINE
       XCHG                    ;START SDED REPLACEMENT
       SHLD    CURTOK          ;SET PTR TO NON-BLANK OR END OF LINE
       XCHG                    ;END SDED REPLACEMENT
       MVI     B,11            ;PREP FOR POSSIBLE SPACE FILL
       JZ      SCAN4           ;DONE IF EOL
;
;  SCAN TOKEN FOR DU: FORM, WHICH MEANS WE HAVE A USER/DISK SPECIFICATION
;    DE PTS TO NEXT CHAR IN LINE, HL PTS TO FCBDN
;
       PUSH    D               ;SAVE PTR TO FIRST CHAR
       CALL    SDELM           ;CHECK FOR DELIMITER AND GET FIRST CHAR
       CPI     'A'             ;IN LETTER RANGE?
       JC      SCAN1
       CPI     'P'+1           ;IN LETTER RANGE?
       JC      SCAN1A
SCAN1:
       CPI     '0'             ;CHECK FOR DIGIT RANGE
       JC      SCAN2
       CPI     '9'+1           ;IN DIGIT RANGE?
       JNC     SCAN2
SCAN1A:
       INX     D               ;PT TO NEXT CHAR
       CALL    SDELM           ;CHECK FOR DELIMITER; IF NOT, CHECK FOR DIGIT
       JMP     SCAN1
SCAN2:
       POP     D               ;RESTORE PTR TO FIRST CHAR
       CPI     ':'             ;WAS DELIMITER A COLON?
       JNZ     SCAN3           ;DONE IF NO COLON
       STA     COLON           ;SET COLON FOUND
;
;  SCAN FOR AND EXTRACT USER/DISK INFO
;    ON ENTRY, HL PTS TO FCBDN, DE PTS TO FIRST CHAR, AND A CONTAINS FIRST CHAR
;
       LDAX    D               ;GET FIRST CHAR
       CPI     'A'             ;CONVERT POSSIBLE DRIVE SPEC TO NUMBER
       JC      SUD1            ;IF LESS THAN 'A', MUST BE DIGIT
;
;  SET DISK NUMBER (A=1)
;
       SUI     'A'-1           ;CONVERT DRIVE NUMBER TO 1-16
       CPI     MAXDISK+1       ;WITHIN RANGE?
       JNC     ERROR           ;INVALID DISK NUMBER
       STA     TEMPDR          ;SET TEMPORARY DRIVE NUMBER
       MOV     M,A             ;SET FCBDN
       INX     D               ;PT TO NEXT CHAR
       LDAX    D               ;SEE IF IT IS A COLON (:)
       CPI     ':'
       JZ      SUD2            ;DONE IF NO USER NUMBER (IT IS A COLON)
;
;  SET USER NUMBER
;
SUD1:
       PUSH    H               ;SAVE PTR TO FCBDN
       XCHG                    ;HL PTS TO FIRST DIGIT
       CALL    NUM0A           ;GET NUMBER
       XCHG                    ;DE PTS TO TERMINATING COLON
       POP     H               ;GET PTR TO FCBDN
       CPI     MAXUSR+1        ;WITHIN LIMIT?
       JNC     ERROR
;
       IF      USERON          ;ALLOW USER CHANGE ONLY IF USER IS ALLOWED
;
       STA     TEMPUSR         ;SAVE USER NUMBER
;
       ENDIF
;
SUD2:
       INX     D               ;PT TO CHAR AFTER COLON
;
; EXTRACT FILENAME FROM POSSIBLE FILENAME.TYP
;   DE PTS TO NEXT CHAR TO PROCESS, HL PTS TO FCBDN
;
SCAN3:
       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
       LDAX    D               ;GET LAST CHAR WHICH STOPPED SCAN
       CPI     '.'             ;IF (DE) DELIMITER IS A '.', WE HAVE A TYPE
       JNZ     SCAN4           ;FILL FILE TYPE BYTES WITH <SP>
       INX     D               ;PT TO CHAR IN COMMAND LINE AFTER '.'
       CALL    SCANF           ;FILL FCB FILE TYPE
       JMP     SCAN5           ;SKIP TO NEXT PROCESSING
SCAN4:
       CALL    SCANF4          ;SPACE FILL
;
; FILL IN EX, S1, S2, AND RC WITH ZEROES
;
SCAN5:
       MVI     B,4             ;4 BYTES
       XRA     A               ;A=0
       CALL    SCANF5          ;FILL WITH ZEROES
;
; SCAN COMPLETE -- DE PTS TO DELIMITER BYTE AFTER TOKEN
;
       XCHG                    ;START SDED REPLACEMENT
       SHLD    NXTCHR
       XCHG                    ;END SDED REPLACEMENT
;
; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN FILENAME.TYP
;
QMCNT   EQU     $+1             ;POINTER FOR IN-THE-CODE MODIFICATION
       MVI     A,0             ;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
       JZ      SCANF4
       INX     H               ;PT TO NEXT BYTE IN FCBDN
       CPI     '*'             ;IS (DE) A WILD CARD?
       JNZ     SCANF1          ;CONTINUE IF NOT
       MVI     M,'?'           ;PLACE '?' IN FCB AND DON'T ADVANCE DE IF SO
       CALL    SCQ             ;SCANNER COUNT QUESTION MARKS
       JMP     SCANF2
SCANF1:
       MOV     M,A             ;STORE FILENAME CHAR IN FCB
       INX     D               ;PT TO NEXT CHAR IN COMMAND LINE
       CPI     '?'             ;CHECK FOR QUESTION MARK (WILD)
       CZ      SCQ             ;SCANNER COUNT QUESTION MARKS
SCANF2:
       DCR     B               ;DJNZ REPLACEMENT
       JNZ     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
       JMP     SCANF3
;
;  FILL MEMORY POINTED TO BY HL WITH SPACES FOR B BYTES
;
SCANF4:
       MVI     A,' '           ;<SP> FILL
SCANF5:
       INX     H               ;PT TO NEXT BYTE IN FCB
       MOV     M,A             ;FILL WITH BYTE IN A
       DCR     B               ;DJN REPLACEMENT
       JNZ     SCANF5
       RET
;
;  INCREMENT QUESTION MARK COUNT FOR SCANNER
;    THIS ROUTINE INCREMENTS THE COUNT OF THE NUMBER OF QUESTION MARKS IN
;    THE CURRENT FCB ENTRY
;
SCQ:
       PUSH    H               ;SAVE HL
       LXI     H,QMCNT         ;GET COUNT
       INR     M               ;INCREMENT
       POP     H               ;GET HL
       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
       MOV     A,C             ;CHECK NUMBER OF COMMANDS
       ORA     A               ;IF NONE, THEN ABORT
       JZ      CMS5
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
       JNZ     CMS3            ;NO MATCH
       INX     D               ;PT TO NEXT CHAR
       INX     H
       DCR     B               ;DJNZ REPLACEMENT
       JNZ     CMS2            ;COUNT DOWN
       LDAX    D               ;NEXT CHAR IN INPUT COMMAND MUST BE <SP>
       CPI     ' '
       JNZ     CMS4
       RET                     ;COMMAND IS CPR-RESIDENT (ZERO FLAG SET)
CMS3:
       INX     H               ;SKIP TO NEXT COMMAND TABLE ENTRY
       DCR     B               ;DJNZ REPLACEMENT
       JNZ     CMS3
CMS4:
       INX     H               ;SKIP ADDRESS
       INX     H
       DCR     C               ;DECREMENT TABLE ENTRY NUMBER
       JNZ     CMS1
CMS5:
       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
;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 ENABLED
;
DIR:
       CALL    SCANLOG         ;EXTRACT POSSIBLE D:FILENAME.TYP TOKEN AND LOG
       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,80H           ;PREPARE FOR DIR-ONLY SELECTION
       JZ      DIRDN           ;THERE IS NO FLAG, SO DIR ONLY
       MVI     B,1             ;SET FOR BOTH DIR AND SYS FILES
       CPI     SYSFLG          ;SYSTEM AND DIR FLAG SPECIFIER?
       JZ      GOTFLG          ;GOT SYSTEM SPECIFIER
       CPI     SOFLG           ;SYS ONLY?
       JNZ     DIRDN
       DCR     B               ;B=0 FOR SYS FILES ONLY
GOTFLG:
       INX     D               ;PT TO CHAR AFTER FLAG
DIRDN:
       XCHG                    ;START SDED REPLACEMENT
       SHLD    NXTCHR          ;SET PTR FOR NEXT PASS
       XCHG                    ;END SDED REPLACEMENT
                               ;DROP INTO DIRPR TO PRINT DIRECTORY
                               ; THEN RESTART CPR
;
       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
;
DIRPR:
       MOV     A,B             ;GET FLAG
       STA     SYSTST          ;SET SYSTEM TEST FLAG
       MVI     E,0             ;SET COLUMN COUNTER TO ZERO
       PUSH    D               ;SAVE COLUMN COUNTER (E)
       CALL    SEARF           ;SEARCH FOR SPECIFIED FILE (FIRST OCCURRANCE)
       JNZ     DIR3
       CALL    PRNNF           ;PRINT NO FILE MSG; REG A NOT CHANGED
       XRA     A               ;SET ZERO FLAG
       POP     D               ;RESTORE DE
       RET
;
; ENTRY SELECTION LOOP; ON ENTRY, A=OFFSET FROM SEARF OR SEARN
;
DIR3:
       CALL    GETSBIT         ;GET AND TEST FOR TYPE OF FILES
       JZ      DIR6
       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
       JNZ     DIR4
       CALL    CRLF            ;NEW LINE
       JMP     DIR5
DIR4:
       CALL    PRINT
;
       IF      WIDE
;
       DB      '  '            ;2 SPACES
       DB      FENCE           ;THEN FENCE CHAR
       DB      ' ',' '+80H     ;THEN 2 MORE SPACES
;
       ELSE
;
       DB      ' '             ;SPACE
       DB      FENCE           ;THEN FENCE CHAR
       DB      ' '+80H         ;THEN SPACE
;
       ENDIF                   ;WIDE
;
DIR5:
       MVI     B,01H           ;PT TO 1ST BYTE OF FILE NAME
       MOV     A,B             ;A=OFFSET
       CALL    DIRPTR          ;HL NOW PTS TO 1ST BYTE OF FILE NAME
       CALL    PRFN            ;PRINT FILE NAME
DIR6:
       CALL    BREAK           ;CHECK FOR ABORT
       JZ      DIR7
       CALL    SEARN           ;SEARCH FOR NEXT FILE
       JNZ     DIR3            ;CONTINUE IF FILE FOUND
DIR7:
       POP     D               ;RESTORE STACK
       MVI     A,0FFH          ;SET NZ FLAG
       ORA     A
       RET
;
       ENDIF                   ;DIRON OR ERAON
;
;  PRINT FILE NAME PTED TO BY HL
;
PRFN:
       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
       DCR     B       ; COUNT DOWN
       JNZ     PRFN1
       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)
       MVI     A,10            ;ADD 10 TO PT TO SYSTEM FILE ATTRIBUTE BIT
       CALL    DIRPTR          ;A=SYSTEM BYTE
       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
FQLP:
       MVI     M,'?'           ;STORE '?'
       INX     H
       DCR     B               ;DJNZ REPLACEMENT
       JNZ     FQLP
       RET
;
;Section 5B
;Command: ERA
;Function:  Erase files
;Forms:
;       ERA <afn>       Erase Specified files and print their names
;       ERA <afn> V     Erase Specified files and print their names, but ask
;                               for verification before Erase is done
;Notes:
;       Several Key Flags affect this command:
;               ERAV - If TRUE, the V option is enabled, and the character
;                       which turns it on (the V) is defined by ERDFLG
;               ERAOK - If TRUE, the OK? prompt is enabled
;       If ERAOK is FALSE, the verification feature is disabled regardless
;               of what value ERAV has
;       If ERAOK is TRUE, then:
;               If ERAV is TRUE, verification is requested only if the V
;                       flag (actual letter defined by ERDFLG) is in the
;                       command line
;               If ERAV is FALSE, verification is always requested, and a
;                       V flag in the command line will cause an error
;                       message to be printed (V?) after the ERA is completed
;
       IF      ERAON           ;ERA ENABLED?
;
ERA:
;
       IF      WERA            ;WHEEL FACILITY ENABLED?
;
       CALL    WHLCHK          ;CHECK FOR IT
;
       ENDIF           ;WERA
;
       CALL    SCANLOG         ;PARSE FILE SPECIFICATION AND LOG IN USER/DISK
;
       IF      ERAV AND ERAOK  ;V FLAG AND OK? ENABLED?
;
       CALL    ADVAN           ;GET ERAFLG IF IT'S THERE
       STA     ERAFLG          ;SAVE IT AS A FLAG
       JZ      ERA1            ;JUMP IF INPUT ENDED
       INX     D               ;PUT NEW BUF POINTER
ERA1:
       XCHG                    ;PUT PTR IN HL
       SHLD    NXTCHR          ;SET PTR TO BYTE FOR NEXT COMMAND PROCESSING
;
       ENDIF                   ;ERAV
;
       MVI     B,1             ;DISPLAY ALL MATCHING FILES
       CALL    DIRPR           ;PRINT DIRECTORY OF ERASED FILES
       RZ                      ;ABORT IF NO FILES
;
       IF      ERAOK           ;PRINT PROMPT
;
       IF      ERAV            ;TEST VERIFY FLAG
;
ERAFLG  EQU     $+1             ;ADDRESS OF FLAG
       MVI     A,0             ;2ND BYTE IS FLAG
       CPI     ERDFLG          ;IS IT A VERIFY OPTION?
       JNZ     ERA2            ;SKIP PROMPT IF IT IS NOT
;
       ENDIF                   ;ERAV
;
       CALL    PRINTC
       DB      'OK to Erase','?'+80H
       CALL    CONIN           ;GET REPLY
       CPI     'Y'             ;YES?
       RNZ                     ;ABORT IF NOT
;
       ENDIF                   ;ERAOK
;
ERA2:
       LXI     D,FCBDN         ;DELETE FILE SPECIFIED
       CALL    DELETE
       RET                     ;REENTER CPR
;
       ENDIF                   ;ERAON
;
;Section 5C
;Command: LIST
;Function:  Print out specified file on the LST: Device
;Forms:
;       LIST <ufn>      Print file (NO Paging)
;Notes:
;       The flags which apply to TYPE do not take effect with LIST
;
       IF      LTON            ;LIST AND TYPE ENABLED?
;
LIST:
       MVI     A,0FFH          ;TURN ON PRINTER FLAG
       JMP     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
;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:
       XRA     A               ;TURN OFF PRINTER FLAG
;
; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
;
TYPE0:
       STA     PRFLG           ;SET FLAG
;
       IF      WLT     ;WHEEL ON?
;
       CALL    WHLCHK          ;CHECK WHEEL BYTE
;
       ENDIF           ;WLT
;
       CALL    SCANLOG         ;EXTRACT FILENAME.TYP TOKEN AND LOG USER/DISK
       JNZ     ERROR           ;ERROR IF ANY QUESTION MARKS
       CALL    ADVAN           ;GET PGDFLG IF IT'S THERE
       STA     PGFLG           ;SAVE IT AS A FLAG
       JZ      TYPE1           ;JUMP IF INPUT ENDED
       INX     D               ;PUT NEW BUF POINTER
TYPE1:
       XCHG                    ;START SDED REPLACEMENT
       SHLD    NXTCHR          ;SET PTR TO BYTE FOR NEXT COMMAND PROCESSING
       XCHG                    ;END SDED REPLACEMENT
       CALL    OPENF           ;OPEN SELECTED FILE
       JZ      ERROR           ;ABORT IF ERROR
       CALL    CRLF            ;NEW LINE
       MVI     A,NLINES-1      ;SET LINE COUNT
       STA     PAGCNT
       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
       JC      TYPE3
       PUSH    H               ;READ NEXT BLOCK
       PUSH    B
       CALL    READF
       POP     B
       POP     H
       JNZ     TYPE7           ;ERROR?
       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)?
       RZ                      ;RESTART CPR IF SO
;
; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION
;
       CPI     CR              ;RESET TAB COUNT?
       JZ      TYPE4
       CPI     LF              ;RESET TAB COUNT?
       JZ      TYPE4
       CPI     TAB             ;TAB?
       JZ      TYPE5
;
;  OUTPUT CHAR AND INCREMENT CHAR COUNT
;
       CALL    LCOUT           ;OUTPUT CHAR
       INR     B               ;INCREMENT TAB COUNT
       JMP     TYPE6
;
;  OUTPUT <CR> OR <LF> AND RESET TAB COUNT
;
TYPE4:
       CALL    LCOUT           ;OUTPUT <CR> OR <LF>
       MVI     B,0             ;RESET TAB COUNTER
       JMP     TYPE6
;
;  TABULATE
;
TYPE5:
       MVI     A,' '           ;<SP>
       CALL    LCOUT
       INR     B               ;INCR POS COUNT
       MOV     A,B
       ANI     7
       JNZ     TYPE5
;
; CONTINUE PROCESSING
;
TYPE6:
       INR     C               ;INCREMENT CHAR COUNT
       INX     H               ;PT TO NEXT CHAR
       CALL    BREAK           ;CHECK FOR ABORT
       RZ                      ;RESTART IF SO
       JMP     TYPE2
TYPE7:
       DCR     A               ;NO ERROR?
       RZ                      ;RESTART CPR
       JMP     ERROR
;
       ENDIF                   ;LTON
;
;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 DCR
;       SAVE <Number of Sectors> <ufn> S
;                               Like SAVE above, but numeric argument specifies
;                               number of sectors rather than pages
;Notes:
;       The MULTCMD flag (Multiple Commands Allowed) expands the code slightly,
;               but is required to support multiple commands with SAVE
;       The SECTFLG defines the letter which indicates a sector count
;               (S in the Forms section above)
;
       IF      SAVEON          ;SAVE ENABLED?
;
SAVE:
;
       IF      WSAVE   ;WHEEL FACILITY?
;
       CALL    WHLCHK          ;CHECK FOR WHEEL BYTE
;
       ENDIF           ;WSAVE
;
       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
       JZ      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
       JZ      SAVE0
       DCX     D               ;NO 'S' TOKEN, SO BACK UP
       DAD     H               ;DOUBLE IT FOR HL=SECTOR (128 BYTES) COUNT
SAVE0:
       XCHG                    ;START SDED REPLACEMENT
       SHLD    NXTCHR          ;SET PTR TO BAD TOKEN OR AFTER GOOD TOKEN
       XCHG                    ;END SDED REPLACEMENT
       LXI     D,TPA           ;PT TO START OF SAVE AREA (TPA)
SAVE1:
       MOV     A,H             ;DONE WITH SAVE?
       ORA     L               ;HL=0 IF SO
       JZ      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
       JNZ     SAVE3           ;WRITE ERROR?
       JMP     SAVE1           ;CONTINUE
SAVE2:
       LXI     D,FCBDN         ;CLOSE SAVED FILE
       CALL    CLOSE
       INR     A               ;ERROR?
       JNZ     SAVE4
SAVE3:
       CALL    PRNLE           ;PRINT 'NO SPACE' ERROR
SAVE4:
       JMP     DEFDMA          ;SET DMA TO 0080 AND RESTART CPR
;
       ENDIF                   ;SAVEON
;
; Test File in FCB for existence, ask user to delete if so, and abort if he
;  choses not to
;
       IF      SAVEON OR RENON ;FOR SAVE AND REN FUNCTIONS
;
EXTEST:
       CALL    SCANLOG         ;EXTRACT FILE NAME AND LOG IN USER/DISK
       JNZ     ERROR           ;'?' IS NOT PERMITTED
       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      'Erase',' '+80H
       LXI     H,FCBFN         ;PT TO FILE NAME FIELD
       CALL    PRFN            ;PRINT IT
       MVI     A,'?'           ;PRINT QUESTION
       CALL    CONOUT
       CALL    CONIN           ;GET RESPONSE
       POP     D               ;GET PTR TO FCB
       CPI     'Y'             ;KEY ON YES
       JNZ     ERR3            ;RESTART AS ERROR IF NO
       PUSH    D               ;SAVE PTR TO FCB
       CALL    DELETE          ;DELETE FILE
       POP     D               ;GET PTR TO FCB
       RET
;
       ENDIF                   ;SAVEON OR RENON
;
;Section 5F
;Command: REN
;Function:  To change the name of an existing file
;Forms:
;       REN <New ufn>=<Old ufn> Perform function
;
       IF      RENON           ;REN ENABLED?
;
REN:
;
       IF      WREN            ;WHEEL FACILITY?
;
       CALL    WHLCHK          ;CHECK FOR WHEEL BYTE
;
       ENDIF           ;WREN
;
       CALL    EXTEST          ;TEST FOR FILE EXISTENCE AND RETURN
                               ; IF FILE DOESN'T EXIST; ABORT IF IT DOES
       LDA     TEMPDR          ;SAVE SELECTED DISK
       PUSH    PSW             ;SAVE ON STACK
REN0:
       LXI     H,FCBDN         ;SAVE NEW FILE NAME
       LXI     D,FCBDM
       LXI     B,16            ;16 BYTES
       CALL    LDIRSB          ;LDIR REPLACEMENT SUBROUTINE
       CALL    ADVAN           ;ADVANCE TO NEXT CHARACTER (NON-DELIM)
       JZ      REN4            ;ERROR IF NONE
;
;  PERFORM RENAME FUNCTION
;
REN1:
       XCHG                    ;START SDED REPLACMENT
       SHLD    NXTCHR          ;SAVE PTR TO OLD FILE NAME
       XCHG                    ;END SDED REPLACEMENT
       CALL    SCANER          ;EXTRACT FILENAME.TYP TOKEN
       JNZ     REN4            ;ERROR IF ANY '?'
       POP     PSW             ;GET OLD DEFAULT DRIVE
       MOV     B,A             ;SAVE IT
       LXI     H,TEMPDR        ;COMPARE IT AGAINST SELECTED DRIVE
       MOV     A,M             ;DEFAULT?
       ORA     A
       JZ      REN2
       CMP     B               ;CHECK FOR DRIVE ERROR (LIKE REN A:T=B:S)
       JNZ     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     ERROR
;
       ENDIF                   ;RENON
;
RSTJMP:
       JMP     RCPRNL          ;RESTART CPR
;
;Section 5G
;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      JUMPON          ;JUMP ENABLED?
;
JUMP:
;
       IF      WJUMP   ;WHEEL FACILITY?
;
       CALL    WHLCHK          ;CHECK FOR WHEEL BYTE
;
       ENDIF           ;WJUMP
;
       CALL    HEXNUM          ;GET LOAD ADDRESS IN HL
       JMP     CALLPROG        ;PERFORM CALL
;
       ENDIF                   ;JUMPON
;
;Section 5H
;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      GOON            ;GO ENABLED?
;
GO:
;
       IF      WGO     ;WHEEL FACILITY?
;
       CALL    WHLCHK          ;CHECK FOR WHEEL BYTE
;
       ENDIF           ;WGO
;
       LXI     H,TPA           ;Always to TPA
       JMP     CALLPROG        ;Perform call
;
       ENDIF                   ;GOON
;
;Section 5I
;Command: COM file processing
;Function:  To load the specified COM file from disk and execute it
;Forms:  <command line>
;Notes:
;       COM files are processed as follows --
;               1. File name buffers are initialized and a preliminary
;                       error check is done
;               2. MLOAD is used to search for the file along the Path
;                       and load it into the TPA
;               3. CALLPROG is used to set up the buffers to be used by
;                       the transient (FCB at 5CH, FCB at 6CH, BUFF at 80H)
;                       and run the program
;       The flag MULTCMD comes into play frequently here; it mainly serves
;               to save space if MULTCMD is FALSE and enables Multiple
;               Commands on the same line if MULTCMD is TRUE
;
COM:
       LDA     FCBFN           ;ANY COMMAND?
       CPI     ' '             ;' ' MEANS COMMAND WAS 'D:' TO SWITCH
       JNZ     COM1            ;NOT <SP>, SO MUST BE TRANSIENT OR ERROR
;
;  ENTRY POINT TO SELECT USER/DISK
;
;
       IF      WDU     ;WHEEL FACILITY?
;
       CALL    WHLCHK          ;CHECK FOR WHEEL BYTE
;
       ENDIF           ;WDU
;
       LDA     COLON           ;LOOK FOR COLON FLAG
       ORA     A               ;IF ZERO, JUST BLANK
       RZ                      ;RETURN TO MAIN ROUTINE IF NOTHING SPECIFIED
;
;  COMMAND IS DU:, SO LOG IN USER/DISK
;
       LDA     TEMPUSR         ;GET SELECTED USER
       CPI     10H             ;MAKE SURE 4 BITS
       JNC     ERROR           ;RANGE ERROR?
       STA     CURUSR          ;SET CURRENT USER
       CALL    SLOGIN          ;LOG IN US
ER/DISK AS IF TEMPORARILY
;
;  NOW, MAKE LOGIN PERMANENT
;
       LDA     TEMPDR          ;GET SELECTED DRIVE
       ORA     A               ;IF 0 (DEFAULT), NO CHANGE
       JZ      COM0
       DCR     A               ;ADJUST FOR LOG IN
       STA     CURDR           ;SET CURRENT DRIVE
COM0:
       JMP     SETUD           ;SET CURRENT USER/DISK AND RET THRU DLOGIN
;
;  PROCESS COMMAND
;
COM1:
       LXI     D,FCBFT         ;PT TO FILE TYPE
       LDAX    D               ;GET FIRST CHAR OF FILE TYPE
       CPI     ' '             ;MUST BE BLANK, OR ERROR
       JNZ     ERROR
       LXI     H,COMMSG        ;PLACE DEFAULT FILE TYPE (COM) INTO FCB
       LXI     B,3             ;3 BYTES
       CALL    LDIRSB          ;LDIR REPLACEMENT SUBROUTINE
       LXI     H,TPA           ;SET EXECUTION/LOAD ADDRESS
       PUSH    H               ;SAVE FOR EXECUTION
;
       IF      CMDRUN          ;COMMAND RUN FACILITY AVAILABLE?
;
       MVI     A,0FFH          ;USE IT IF AVAILABLE
;
       ENDIF           ;CMDRUN
;
       CALL    MLOAD           ;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE
       POP     H               ;GET EXECUTION ADDRESS
;
; 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    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 FCB+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
       CALL    LDIRSB          ;LDIR REPLACEMENT SUBROUTINE
CMDCH1  EQU     $+1             ;IN-THE-CODE BUFFER FOR ADDRESS OF 1ST CHAR
       LXI     H,CMDLIN
CALLP1:
       MOV     A,M             ;SKIP TO END OF 2ND FILE NAME
       ORA     A               ;END OF LINE?
       JZ      CALLP2
;
       IF      MULTCMD         ;MULTIPLE COMMANDS ALLOWED?
;
       CPI     CMDSEP          ;COMMAND SEPARATOR?
       JZ      CALLP2
;
       ENDIF           ;MULTCMD
;
       CPI     ' '             ;END OF TOKEN?
       JZ      CALLP2
       INX     H
       JMP     CALLP1
;
; LOAD COMMAND LINE INTO TBUFF
;
CALLP2:
       MVI     B,0             ;SET CHAR COUNT
       LXI     D,TBUFF+1       ;PT TO CHAR POS
CALLP3:
       MOV     A,M             ;COPY COMMAND LINE TO TBUFF
       STAX    D
       ORA     A               ;DONE IF ZERO
       JZ      CALLP5
;
       IF      MULTCMD         ;MULTIPLE COMMANDS ALLOWED?
;
       CPI     CMDSEP          ;DONE IF COMMAND SEPARATOR
       JZ      CALLP4
;
       ENDIF           ;MULTCMD
;
       INR     B               ;INCR CHAR COUNT
       INX     H               ;PT TO NEXT
       INX     D
       JMP     CALLP3
;
       IF      MULTCMD         ;MULTIPLE COMMANDS ALLOWED?
;
CALLP4:
       XRA     A               ;STORE ENDING ZERO
       STAX    D               ;INSTEAD OF CMDSEP
;
       ENDIF           ;MULTCMD
;
; RUN LOADED TRANSIENT PROGRAM
;
CALLP5:
;
       IF      MULTCMD         ;MULTIPLE COMMANDS ALLOWED?
;
       SHLD    NXTCHR          ;SAVE PTR TO CONTINUE PROCESSING
;
       ENDIF           ;MULTCMD
;
       MOV     A,B             ;SAVE CHAR COUNT
       STA     TBUFF
       CALL    CRLF            ;NEW LINE
       CALL    DEFDMA          ;SET DMA TO 0080
;
; 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
       CALL    DLOGIN          ;LOGIN CURRENT USER/DISK
       JMP     CONT            ;RESTART CPR AND CONTINUE COMMAND PROCESSING
;
;Section 5J
;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      GETON           ;GET ENABLED?
;
GET:
;
       IF      WGET    ;WHEEL ON?
;
       CALL    WHLCHK          ;CHECK WHEEL BYTE
;
       ENDIF           ;WGET
;
       CALL    HEXNUM          ;GET LOAD ADDRESS IN HL
       PUSH    H               ;SAVE ADDRESS
       CALL    SCANER          ;GET FILE NAME
       POP     H               ;RESTORE ADDRESS
       JNZ     ERROR           ;MUST BE UNAMBIGUOUS
;
; FALL THRU TO MLOAD
;
       IF      CMDRUN          ;COMMAND RUN FACILITY AVAILABLE?
;
       XRA     A               ;NO CMDRUN IF FACILITY IS THERE
;
       ENDIF                   ;CMDRUN
;
       ENDIF                   ;GETON

;
;  MEMORY LOAD SUBROUTINE
;
; LOAD MEMORY WITH THE FILE WHOSE NAME IS SPECIFIED IN THE COMMAND LINE
;   ON INPUT, HL CONTAINS STARTING ADDRESS TO LOAD
;
;       EXIT POINTS ARE A RETURN AND LOG IN CURRENT USER/DISK IF NO ERROR,
; A JMP TO ERROR IF COM FILE NOT FOUND OR A MESSAGE AND ABORT IF MEMORY FULL
;
MLOAD:
;
       IF      CMDRUN  ;CMDRUN FACILITY?
;
       STA     CRFLAG  ;SAVE FLAG
;
       ENDIF           ;CMDRUN
;
       SHLD    LOADADR         ;SET LOAD ADDRESS
;
;   MLA is a reentry point for a non-standard CP/M Modification
; The PATH command-search is implemented by this routine
;
MLA:
;
       IF      DRVPREFIX       ;IF DRIVE PREFIX ALLOWED ...
;
       MVI     A,DRVPFATT      ;SET FLAG PER USER SPEC FOR SYS/NON-SYS
       STA     SYSTST          ;TEST FLAG IN GETSBIT
       CALL    SLOGIN          ;LOOK UNDER TEMPORARY USER/DISK
       CALL    SEARF           ;LOOK FOR FILE
MLARUN:
       LXI     H,PATH          ;PT TO PATH FOR FAILURE POSSIBILITY
       JNZ     MLA4            ;FOUND IT -- LOAD IT AND RUN
;
       ELSE                    ;NO DRIVE PREFIX
;
MLARUN:
       LXI     H,PATH          ;POINT TO PATH
;
       ENDIF           ;DRVPREFIX
;
MLA0:
       MOV     A,M             ;GET DRIVE
       ORA     A               ;0=DONE=COMMAND NOT FOUND
;
       IF      CMDRUN          ;COMMAND RUN FACILITY
;
       JNZ     NOCRUN          ;NOT READY FOR CMD RUN YET
CRFLAG  EQU     $+1             ;POINTER FOR IN-THE-CODE MODIFICATION
       MVI     A,0             ;CHECK CRFLAG
       ORA     A               ;0=NO
       JZ      ERROR           ;PROCESS AS ERROR IF CMD RUN EXHAUSTED
;
       IF      ROOTONLY        ;ONLY LOOK FOR EXT COMMAND PROCESSOR AT ROOT
;
       PUSH    H
;
       ENDIF           ;ROOTONLY
;
       XRA     A               ;DO NOT REENTER THIS CODE
       STA     CRFLAG          ;SET ZERO FOR NO ENTRY
       LHLD    CMDCH1          ;GET PTR TO FIRST CHAR OF COMMAND
       DCX     H               ;PT TO CHAR COUNT
       MVI     M,' '           ;STORE LEADING SPACE
       SHLD    CMDCH1          ;POINT TO LEADING SPACE AS FIRST CHAR
       SHLD    NXTCHR          ;NEXT CHAR IS FIRST CHAR OF COMMAND
       LXI     H,CFCB          ;SET CFCB AS COMMAND
       LXI     D,FCBDN         ;... BY COPYING IT INTO FCBDN
       LXI     B,12            ;ONLY 12 BYTES REQUIRED
       CALL    LDIRSB          ;LDIR REPLACEMENT SUBROUTINE
;
       IF      ROOTONLY        ;LOOK FOR EXT COMMAND PROCESSOR AT ROOT ONLY?
;
       JMP     MLA3RT
;
       ELSE                    ;FOLLOW PATH LOOKING FOR EXT COMMAND PROCESSOR
;
       XRA     A               ;A=0
       JMP     MLARUN          ;NOW TRY THE RUN
;
       ENDIF           ;ROOTONLY
;
CFCB:
       CMDFCB                  ;FCB DEFINING INITIAL COMMAND
NOCRUN:
;
       ELSE
;
       JZ      ERROR           ;TRANSIENT LOAD ERROR -- FILE NOT FOUND
;
       ENDIF           ;CMDRUN
;
; LOOK FOR COMMAND IN DIRECTORY PTED TO BY HL; DRIVE IN A
;
       CPI     CURIND          ;CURRENT DRIVE SPECIFIED?
       JNZ     MLA1            ;SKIP DEFAULT DRIVE SELECTION IF SO
       LDA     CURDR           ;GET CURRENT DRIVE
       INR     A               ;SET A=1
MLA1:
       STA     TEMPDR          ;SELECT DIFFERENT DRIVE IF NOT CURRENT
       MVI     A,1             ;PREPARE TO ACCEPT BOTH SYSTEM AND DIR FILES
       STA     SYSTST          ;TEST FLAG IS 1 FOR BOTH
       INX     H               ;PT TO USER NUMBER
       MOV     A,M             ;GET USER NUMBER
       INX     H               ;PT TO NEXT ENTRY IN PATH
       PUSH    H               ;SAVE PTR
       ANI     7FH             ;MASK OUT SYSTEM BIT
       CPI     CURIND          ;CURRENT USER SPECIFIED?
       JNZ     MLA2            ;DO NOT SELECT CURRENT USER IF SO
       LDA     CURUSR          ;GET CURRENT USER NUMBER
MLA2:
       STA     TEMPUSR         ;SET TEMPORARY USER NUMBER
       CMA                     ;FLIP BITS SO SYSTEM BIT IS 0 IF SYS-ONLY
       ANI     80H             ;MASK FOR ONLY NOT OF SYSTEM BIT TO SHOW
       JNZ     MLA3            ;DON'T SET FLAG IS ORIGINALLY SYSTEM BIT=0
       STA     SYSTST          ;TEST FLAG IS 0 FOR SYS-ONLY, 1 FOR BOTH
MLA3:
       CALL    SLOGIN          ;LOG IN PATH-SPECIFIED USER/DISK
MLA3RT:
       CALL    SEARF           ;LOOK FOR FILE
       POP     H               ;GET PTR TO NEXT PATH ENTRY
       JZ      MLA0            ;CONTINUE PATH SEARCH IF SEARCH FAILED
                               ;LOAD IF SEARCH SUCCEEDED
;
; FILE FOUND -- PERFORM SYSTEM TEST AND PROCEED IF APPROVED
;
MLA4:
       PUSH    H               ;SAVE PTR
       CALL    GETSBIT         ;CHECK SYSTEM BIT
       POP     H               ;GET PTR
       JZ      MLA0            ;CONTINUE IF NO MATCH
       CALL    OPENF           ;OPEN FILE FOR INPUT
LOADADR EQU     $+1             ;MEMORY LOAD ADDRESS (IN-LINE CODE MOD)
       LXI     H,TPA           ;SET START ADDRESS OF MEMORY LOAD
MLA5:
       MVI     A,ENTRY/256-1   ;GET HIGH-ORDER ADR OF JUST BELOW CPR
       CMP     H               ;ARE WE GOING TO OVERWRITE THE CPR?
       JC      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
       JNZ     MLA6            ;READ ERROR OR EOF?
       LXI     D,128           ;MOVE 128 BYTES PER SECTOR
       DAD     D               ;PT TO NEXT SECTOR IN HL
       JMP     MLA5
;
MLA6:
       DCR     A               ;LOAD COMPLETE
       JZ      DLOGIN          ;OK IF ZERO, ELSE FALL THRU TO PRNLE

;
; LOAD ERROR
;
PRNLE:
       CALL    PRINTC
       DB      'Ful','l'+80H
       CALL    DLOGIN          ;RESTORE CURRENT USER/DISK
       JMP     RESTRT          ;RESTART ZCPR

;*****
;
LDIRSB: PUSH    PSW             ;START LDIR REPLACEMENT
LDIR1:  MOV     A,M
       STAX    D
       INX     D
       INX     H
       DCX     B
       MOV     A,B
       ORA     C
       JNZ     LDIR1
       POP     PSW             ;END LDIR REPLACEMENT
       RET
;
;
;  DEFAULT PATH USED FOR PATH COMMAND-SEARCH
;
       IF      INTPATH         ;USE THIS PATH?
;
PATH:
       IPATH                   ;PATH DEFINED IN ZCPRHDR.LIB
;
       ENDIF           ;INTPATH

;*****
       IF      INTSTACK        ;INTERNAL STACK
;
;  STACK AREA
;
       DS      48              ;STACK AREA
STACK   EQU     $               ;TOP OF STACK
;
       ENDIF           ;INTSTACK
;

;
;       The following will cause an error message to appear if
; the size of ZCPR2 is over 2K bytes.
;
       IF      ($ GT CPRLOC+800H)
ZCPR2ER EQU     NOVALUE         ;ZCPR2 IS LARGER THAN 2K BYTES
       ENDIF

       END