ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/ZCPR2/ZCPR.ASM

Assembly Source File | 2000-06-30 | 57KB | 2,373 lines

*************************************************************************
*                                    *
*  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.            *
*                                    *
*************************************************************************

;
;  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
;
;******** 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
;
;
; 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
;    EXX    - EXCHANGE BC, DE, HL WITH BC', DE', HL'
;
;
;
;    @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        ;;RANGE ERROR
    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
;
EXX    MACRO        ;;EXCHANGE PRIMARY AND ALTERNATE REGISTERS
    DB    0D9H
    ENDM
;
; END OF Z80 MACRO EXTENSIONS
;
;
;**** 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
    JRZ    RESTRT
    ORA    A        ;0 IF NO COMMAND LINE PRESENT
    JRNZ    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
    JRZ    RS000
;
    ENDIF        ;SUPRES
;
    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
;
    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?
    JRZ    RESTRT        ;INPUT ANOTHER LINE IF SO
    ORA    A        ;NO INPUT?
    JRZ    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?
    JRNZ    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?
    JRNZ    CAPBUF
    CALL    SCANER        ;PARSE COMMAND NAME FROM COMMAND LINE
    JRNZ    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
    JRC    ERR2
    CALL    CONOUT        ;PRINT COMMAND CHAR
    INX    H        ;PT TO NEXT CHAR
    JR    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
    JR    CONOUT
;
CONIN:
    MVI    C,1    ;INPUT CHAR
    CALL    BDOS    ;GET INPUT CHAR WITH ^S PROCESSING AND ECHO
    JMP    UCASE    ;CAPITALIZE
;
CONOUT:
    EXX
    MVI    C,2
OUTPUT:
    MOV    E,A
    CALL    BDOS
    EXX
    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
    JRZ    LC1
    POP    PSW    ;GET CHAR
;
; OUTPUT CHAR IN REG A TO LIST DEVICE
;
LSTOUT:
    EXX        ;SAVE REGS
    MVI    C,5
    JR    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
    JRNZ    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
;
    JRZ    PAGER1        ;  PGDFLG MEANS NO PAGING, PLEASE
;
    ELSE            ;IF PAGING NOT DEFAULT
;
    JRNZ    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
    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
;
    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
    JR    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)
    JR    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
    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,CHRCNT     ;COPY LAST RECORD (NEXT SUBMIT CMND) TO CHRCNT
    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,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:
    EXX            ;SAVE REGS
    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
    EXX            ;RESTORE REGS
    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>
    JRC    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:
    LDED    NXTCHR    ;PT TO NEXT CHAR
;
; 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
    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
NUM0A:
    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
    CPI    ':'        ;DONE IF COLON
    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            ;*2
    JRC    NUMERR
    RLC            ;*4
    JRC    NUMERR
    RLC            ;*8
    JRC    NUMERR
    ADD    C        ;*9
    JRC    NUMERR
    ADD    C        ;*10
    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
;
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
    JRNZ    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
    SDED    CURTOK        ;SET PTR TO NON-BLANK OR END OF LINE
    MVI    B,11        ;PREP FOR POSSIBLE SPACE FILL
    JRZ    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?
    JRC    SCAN1
    CPI    'P'+1        ;IN LETTER RANGE?
    JRC    SCAN1A
SCAN1:
    CPI    '0'        ;CHECK FOR DIGIT RANGE
    JRC    SCAN2
    CPI    '9'+1        ;IN DIGIT RANGE?
    JRNC    SCAN2
SCAN1A:
    INX    D        ;PT TO NEXT CHAR
    CALL    SDELM        ;CHECK FOR DELIMITER; IF NOT, CHECK FOR DIGIT
    JR    SCAN1
SCAN2:
    POP    D        ;RESTORE PTR TO FIRST CHAR
    CPI    ':'        ;WAS DELIMITER A COLON?
    JRNZ    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
    JRC    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    ':'
    JRZ    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
    JRNZ    SCAN4        ;FILL FILE TYPE BYTES WITH <SP>
    INX    D        ;PT TO CHAR IN COMMAND LINE AFTER '.'
    CALL    SCANF        ;FILL FCB FILE TYPE
    JR    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
;
    SDED    NXTCHR
;
; 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
    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 FCB AND DON'T ADVANCE DE IF SO
    CALL    SCQ        ;SCANNER COUNT QUESTION MARKS
    JR    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:
    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:
    MVI    A,' '        ;<SP> FILL
SCANF5:
    INX    H        ;PT TO NEXT BYTE IN FCB
    MOV    M,A        ;FILL WITH BYTE IN A
    DJNZ    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
    JRZ    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
    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
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
    JRZ    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?
    JRZ    GOTFLG        ;GOT SYSTEM SPECIFIER
    CPI    SOFLG        ;SYS ONLY?
    JRNZ    DIRDN
    DCR    B        ;B=0 FOR SYS FILES ONLY
GOTFLG:
    INX    D        ;PT TO CHAR AFTER FLAG
DIRDN:
    SDED    NXTCHR        ;SET PTR FOR NEXT PASS
                ;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)
    JRNZ    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
    JRZ    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
    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
;
    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
    JRZ    DIR7
    CALL    SEARN        ;SEARCH FOR NEXT FILE
    JRNZ    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
    JRNZ    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
    DJNZ    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
    JRZ    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?
    JRNZ    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
    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
;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
    JRZ    TYPE1        ;JUMP IF INPUT ENDED
    INX    D        ;PUT NEW BUF POINTER
TYPE1:
    SDED    NXTCHR        ;SET PTR TO BYTE FOR NEXT COMMAND PROCESSING
    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
    JRC    TYPE3
    PUSH    H        ;READ NEXT BLOCK
    PUSH    B
    CALL    READF
    POP    B
    POP    H
    JRNZ    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?
    JRZ    TYPE4
    CPI    LF        ;RESET TAB COUNT?
    JRZ    TYPE4
    CPI    TAB        ;TAB?
    JRZ    TYPE5
;
;  OUTPUT CHAR AND INCREMENT CHAR COUNT
;
    CALL    LCOUT        ;OUTPUT CHAR
    INR    B        ;INCREMENT TAB COUNT
    JR    TYPE6
;
;  OUTPUT <CR> OR <LF> AND RESET TAB COUNT
;
TYPE4:
    CALL    LCOUT        ;OUTPUT <CR> OR <LF>
    MVI    B,0        ;RESET TAB COUNTER
    JR    TYPE6
;
;  TABULATE
;
TYPE5:
    MVI    A,' '        ;<SP>
    CALL    LCOUT
    INR    B        ;INCR POS COUNT
    MOV    A,B
    ANI    7
    JRNZ    TYPE5
;
; CONTINUE PROCESSING
;
TYPE6:
    INR    C        ;INCREMENT CHAR COUNT
    INX    H        ;PT TO NEXT CHAR
    CALL    BREAK        ;CHECK FOR ABORT
    RZ            ;RESTART IF SO
    JR    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 DEC
;    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
    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    NXTCHR        ;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:
    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
    LDIR
    CALL    ADVAN        ;ADVANCE TO NEXT CHARACTER (NON-DELIM)
    JRZ    REN4        ;ERROR IF NONE
;
;  PERFORM RENAME FUNCTION
;
REN1:
    SDED    NXTCHR        ;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 SELECTED DRIVE
    MOV    A,M        ;DEFAULT?
    ORA    A
    JRZ    REN2
    CMP    B        ;CHECK FOR DRIVE ERROR (LIKE REN A:T=B:S)
    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    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
    JR    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
    JR    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
    JRNZ    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 USER/DISK AS IF TEMPORARILY
;
;  NOW, MAKE LOGIN PERMANENT
;
    LDA    TEMPDR        ;GET SELECTED DRIVE
    ORA    A        ;IF 0 (DEFAULT), NO CHANGE
    JRZ    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
    LDIR
    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
    LDIR
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?
    JRZ    CALLP2
;
    IF    MULTCMD        ;MULTIPLE COMMANDS ALLOWED?
;
    CPI    CMDSEP        ;COMMAND SEPARATOR?
    JRZ    CALLP2
;
    ENDIF        ;MULTCMD
;
    CPI    ' '        ;END OF TOKEN?
    JRZ    CALLP2
    INX    H
    JR    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
    JRZ    CALLP5
;
    IF    MULTCMD        ;MULTIPLE COMMANDS ALLOWED?
;
    CPI    CMDSEP        ;DONE IF COMMAND SEPARATOR
    JRZ    CALLP4
;
    ENDIF        ;MULTCMD
;
    INR    B        ;INCR CHAR COUNT
    INX    H        ;PT TO NEXT
    INX    D
    JR    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
    JRNZ    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
;
    JRNZ    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
    LDIR
;
    IF    ROOTONLY    ;LOOK FOR EXT COMMAND PROCESSOR AT ROOT ONLY?
;
    JR    MLA3RT
;
    ELSE            ;FOLLOW PATH LOOKING FOR EXT COMMAND PROCESSOR
;
    XRA    A        ;A=0
    JR    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?
    JRNZ    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?
    JRNZ    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
    JRNZ    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
    JRZ    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
    JRZ    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?
    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    MLA6        ;READ ERROR OR EOF?
    LXI    D,128        ;MOVE 128 BYTES PER SECTOR
    DAD    D        ;PT TO NEXT SECTOR IN HL
    JR    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

;*****

;
;  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