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: 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 ; 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 (NO ABORT), RETURN TO CALLER AND RUN ENDIF ; IF NOT CLEVEL3 ;IF THIRD COMMAND LEVEL IS NOT PERMITTED JRZ CNVBUF ;IF (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 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 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 < JRC ERROR RZ ;=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 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 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 - 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 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 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 Displays the DIR files ; DIR S Displays the SYS files ; DIR 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 , 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 (= COUNTER) MOV A,E ;ADD 1 TO IT INR E PUSH D ;SAVE IT ANI 03H ;OUTPUT 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 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 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 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 Print file ; TYPE 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 OR MVI B,0 ;RESET TAB COUNTER JR TYPE2L LTAB: MVI A,' ' ; 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 ; Save specified number of pages (start at 100H) ; from TPA into specified file; is in DEC ; SAVE 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 = 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 Select specified user number; 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 Select Default User Number; 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 Call at ; 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 ; 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: ; ; COM: LDA FCBFN ;ANY COMMAND? CPI ' ' ;' ' MEANS COMMAND WAS 'D:' TO SWITCH JRNZ COM1 ;NOT , 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 Load the specified file at the specified page; ; 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