CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol077/zcpr.asm

Assembly Source File | 1984-04-29 | 50.2 KB | 2,041 lines

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

;
;  MEMORY LOAD SUBROUTINE
;    EXIT POINTS ARE A SIMPLE RETURN WITH THE ZERO FLAG SET IF NO ERROR,
; A SIMPLE RETURN WITH THE ZERO FLAG RESET (NZ) IF MEMORY FULL, OR A JMP TO
; COM8 IF COM FILE NOT FOUND
;
MLOAD:
    SHLD    LOADADR        ;SET LOAD ADDRESS
    CALL    GETUSR        ;GET CURRENT USER NUMBER
    STA    TMPUSR        ;SAVE IT FOR LATER
    STA    TSELUSR     ;TEMP USER TO SELECT
;
;   MLA is a reentry point for a non-standard CP/M Modification
; This is the return point for when the .COM (or GET) file is not found the
; first time, Drive A: is selected for a second attempt
;
MLA:
    CALL    SLOGIN        ;LOG IN SPECIFIED DRIVE IF ANY
    CALL    OPENF        ;OPEN COMMAND.COM FILE
    JRNZ    MLA1        ;FILE FOUND - LOAD IT
;
; ERROR ROUTINE TO SELECT USER 0 IF ALL ELSE FAILS
;
DFUSR    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
    MVI    A,DEFUSR    ;GET DEFAULT USER
TSELUSR    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
    CPI    DEFUSR        ;SAME?
    JRZ    MLA0        ;JUMP IF
    STA    TSELUSR        ;ELSE PUT DOWN NEW ONE
    MOV    E,A
    CALL    SETUSR        ;GO SET NEW USER NUMBER
    JR    MLA        ;AND TRY AGAIN
;
; ERROR ROUTINE TO SELECT DRIVE A: IF DEFAULT WAS ORIGINALLY SELECTED
;
MLA0:
    LXI    H,TEMPDR    ;GET DRIVE FROM CURRENT COMMAND
    XRA    A        ;A=0
    ORA    M
    JNZ    COM8        ;ERROR IF ALREADY DISK A:
    MVI    M,1        ;SELECT DRIVE A:
    JR    MLA
;
; FILE FOUND -- PROCEED WITH LOAD
;
MLA1:
LOADADR    EQU    $+1        ;MEMORY LOAD ADDRESS (IN-LINE CODE MOD)
    LXI    H,TPA        ;SET START ADDRESS OF MEMORY LOAD
ML2:
    MVI    A,ENTRY/256-1    ;GET HIGH-ORDER ADR OF JUST BELOW CPR
    CMP    H        ;ARE WE GOING TO OVERWRITE THE CPR?
    JRC    PRNLE        ;ERROR IF SO
    PUSH    H        ;SAVE ADDRESS OF NEXT SECTOR
    XCHG            ;... IN DE
    CALL    DMASET        ;SET DMA ADDRESS FOR LOAD
    LXI    D,FCBDN     ;READ NEXT SECTOR
    CALL    READ
    POP    H        ;GET ADDRESS OF NEXT SECTOR
    JRNZ    ML3        ;READ ERROR OR EOF?
    LXI    D,128        ;MOVE 128 BYTES PER SECTOR
    DAD    D        ;PT TO NEXT SECTOR IN HL
    JR    ML2
;
ML3:
    DCR    A        ;LOAD COMPLETE
    RZ            ;OK IF ZERO, ELSE FALL THRU TO PRNLE
;
; LOAD ERROR
;
PRNLE:
    CALL    PRINTC
    DB    'Ful','l'+80H
    MVI    A,1        ;SET NON-ZERO TO INDICATE ERROR
    ORA    A        ;SET FLAG
    RET
;
    END