; New Name: NZRCP.Z80 Joe Wright July 1987 ; Program: Z34RCP ; Version: 1.0 ; Description: Resident Command Package (RCP) for ZCPR34 ; Author: Jay Sage ; Date: March 1, 1987 ; Derivation: SYSRCP (Richard Conn) and many other contributions ; ZCPR34 is copyright 1987 by Jay P. Sage. All rights reserved. End-user ; distribution and duplication permitted for non-commercial purposes only. ; Any commercial use of ZCPR34, defined as any situation where the duplicator ; recieves revenue by duplicating or distributing ZCPR34 by itself or in ; conjunction with any hardware or software product, is expressly prohibited ; unless authorized in writing by Jay P. Sage. version equ 2 subver equ 4 ; Vers 2.4 - Add whlchk subroutine for indirect addressing of wheel byte. ; 4 Apr 88 - Fixed command list routines. ; Joe Wright - Inhibit SPOP if there is no shell. Allow shstks = 1. ; Vers 2.3 - Reset command, after calling F37, jumps to 0. ; 22 Feb 88 ; Vers 2.2 - Modified for use of Z34CMN.LIB and NZ-COM. ; 31 Dec 87 ; Joe Wright ; Vers 2.1 - R command uses ZRDOS function 37 to reset drives. ; 6 Sep 87 - WHL command changed, WHLQ disappears. ; Joe Wright - REG command expanded. Add REG E (program error byte) ; - SPOP command added. Pops the shell stack ;============================================================================= ; ; D E F I N I T I O N S S E C T I O N ; ;============================================================================= name ('RCP') maclib z34cmn.lib ; Defines ZCPR system addresses maclib z34defn.lib ; Defines offsets in Z34 command processor maclib z34mac.lib ; Macros maclib sysdef.lib ; Common logic, sys, ascii defines maclib nzrcp.lib ; Defines command options ;============================================================================= ; ; E N T R Y C O D E S E C T I O N ; ;============================================================================= start: db 'Z3RCP' ; Package ID ;---------------------------------------- ; Command table db cmdsize ; Length of each command name cmdtbl ; Dispatch table from Z33RCP.LIB db 0 ; Marks end of command jump table ;---------------------------------------- ; Name of RCP ; This block allows the 'H' command and/or the SHOW utility to display a name ; and version number for this RCP as well as the commands that are supported. rcpname: idstring ; From macro in Z33RCP.LIB ; Include only those code sections that are required. ; include rcph ; 'H' help (command list) command page ; RCP-H.Z80 'H' Command ;============================================================================= ; ; H E L P C O M M A N D ; ;============================================================================= ; This command displays a list of all resident commands that are supported, ; including those in the CPR (command processor), RCP, and FCP. clist: ; Print the CPR-resident command names if listcpr call print ; Print "CPR" db lf db 'CP','R'+80h ; ld hl,(ccp) ; CCP location from Z3ENV ld de,offcmd ; Offset to CPR command table add hl,de call cmdlist ; Display the list of commands endif ;listcpr ; Print the FCP-resident command names if listfcp ld hl,(fcp) ld a,h or l jr z,rcplist ; No FCP ld a,(hl) or a jr z,rcplist ; FCP removed call print ; Print header for FCP db lf db 'FC','P'+80h ld de,5 add hl,de ; Point to FCP command table call cmdlist endif ;listfcp ; Print the RCP-resident command names rcplist: if listrcp call crlf ; Skip a line ld hl,rcpname ; Print RCP name call printhl ld hl,start+5 ; Point to RCP command table else ret endif ;listrcp ; Fall through to CMDLIST ;---------------------------------------- ; Subroutine to display list of commands in a command table (code above ; falls through to this routine -- do not move it). The commands are ; displayed 5 per line with 8 character spaces allowed for each command ; (subject to equates below). cmdlist: call crlf ; Start with new line ld e,(hl) ; Get size of each command name into DE ld d,0 inc hl ; Point to name of first command ld c,cmdsline ; Set names-per-line value cmdlist1: ld a,(hl) ; Get first character of the command name or a ; See if it is null jr nz,cmdlist1a ; If not, continue ld a,cmdsline ; See if we are already on a new line cp c call nz,crlf ; If not, skip a line ret cmdlist1a: if noshow ; Option to suppress wheel-limited cmds rla ; Shift high bit of name into carry bit jr nc,cmdlist2 ; If not restricted, go on call whlchk ; Check wheel byte jr nz,cmdlist2 ; If wheel set, continue as usual add hl,de ; Otherwise skip this command jr cmdlist5 endif ; Print leading spaces between names cmdlist2: ld a,cmdspace ; Spacing between command names sub e ; Less length of each command name ld b,a ld a,' ' cmdlist3: call conout djnz cmdlist3 ; Print name of command ld b,e ; Length of each name into B cmdlist4: ld a,(hl) ; Get command name character call conout inc hl ; Point to next djnz cmdlist4 dec c ; Decrement count of names on this line jr nz,cmdlist5 ; Branch if room for more names call crlf ; Otherwise, end this line and ld c,cmdsline ; ..reset count for another line of commands ; Skip to next command name cmdlist5: inc hl ; Skip jump vector inc hl jr cmdlist1 ; Back to process next name ; End RCP-H.Z80 ;============================================================================= ; ; P O P S H E L L S T A C K C O M M A N D ; ;============================================================================= ; ; POP the Shell Stack ; if spopon ; Pop the shell stack spop: ld hl,(z3env+1eh) ; SHSTK (indirect) ld a,h or l ret z ; No shell stack ex de,hl ; SHSTK to DE ld hl,(z3env+20h) ; SHSTKS to L, SHSIZE to H push hl ; Save SHSIZE xor a ; Your basic null in A ld b,l dec b ; SHSTKS-1 in B jr z,sp0a ; Clear one entry push de ; Save SHSTK ld e,h ; SHSIZE to E ld d,a ; Clear D ld h,a ; Clear H.. ld l,a ; ..and L sp0: add hl,de ; Multiply SHSIZE*(SHSTKS-1) djnz sp0 ld b,h ld c,l ; Length to BC ex de,hl ; SHSIZE to HL pop de ; Get SHSTK (destination) add hl,de ; SHSTK+SHSIZE to HL (Source) ldir sp0a: pop bc ; Get SHSIZE in B sp1: ld (de),a ; Clear last entry inc de djnz sp1 ret endif ; SPOPON if clson ; include rcpcls ; 'CLS' clear screen command page ; RCP-CLS.Z80 'CLS' Command ;============================================================================= ; ; C L E A R S C R E E N C O M M A N D ; ;============================================================================= ; Command: CLS ; Function: To clear the CRT screen ; Comments: The setting of the CLSTCAP equate determines whether this ; command uses the TCAP information or not. If not, it uses the ; clear-screen string passed in macro CLSSTR. That string should ; end with the high bit set. cls: if clstcap ; If using TCAP for clear screen string ld a,(z3env+80h) ; Get beginning of tcap cp ' '+1 ; See if blank or perhaps null jr nc,cls1 ; If not, go to clear screen code call print ; If blank, then give error message db ' No TCA','P'+80h ret cls1: ld hl,z3env+97h ; Point to beginning of clear screen string jp printhl ; Display it else ; Not using tcap call print clsstr ; String from Z33RCP.LIB ret endif ;clstcap ; End RCP-CLS.Z80 endif ;clson if reson ; include rcpr ; 'R' disk reset command page ; RCP-R.Z80 'R' command ;============================================================================= ; ; D I S K R E S E T C O M M A N D ; ;============================================================================= ; Command: RESET ; Function: Reset the disk system ; Comments: ZRDOS does not require a disk system reset when disks are ; changed, but directory programs will not show the correct ; size if this is not done. It is also good practice. Since ; no warm boot performed, the disk in drive A need not have the ; operating system on it. ; Ver 2.1 Now logs all drives off and forces fixed and ram disks to ; re-log. reset: if resmsg ; If displaying a reset message call print ; Report action dc ' Reset' endif ;resmsg ld de,-1 ; All 16 drives ld c,37 ; Disks reset ZRDOS function call bdos ld c,13 ; Reset disk system jp bdos ; End RCP-R.Z80 endif ;reson if tston ; include rcptst ; 'TST' error test command page ; RCP-TST.Z80 'TST' Command ;============================================================================= ; ; E R R O R T E S T C O M M A N D ; ;============================================================================= ; Command: TST ; Function: To set the message buffer program error flag based on ; error count reported by M80 or L80 ; Syntax: TST PN where PN is (at least) the first letter of M80 or L80 testerr: ; Check for name of program to test ld a,(fcb1+1) ; Get first character in program name if testm80 ld hl,m80f ; Preset for m80 test counts ld de,m80w cp 'M' jr z,testcount endif ; Testm80 if testf80 ld hl,f80f ld de,f80w cp 'F' jr z,testcount endif ; Testf80 ; If no match, give error message call print db 'bad nam','e'+80h testcount: ld a,(hl) ; Test first error count word inc hl or (hl) ex de,hl ; Test second word or (hl) inc hl or (hl) ld hl,z3msg+6 ; Point to program error flag ld (hl),0 ; Clear it ret z ; If counts were zero, we are done ld (hl),0ffh ; Else set the error flag ret ; End RCP-TST.Z80 endif ;tston if spaceon ; include rcpsp ; 'SP' space on disk command page ; RCP-SP.Z80 'SP' Command ;============================================================================= ; ; D I S K S P A C E C O M M A N D ; ;============================================================================= ; Command: SP ; Function: Shows space remaining on designated drive ; Syntax: SP [DIR:|DU:] ; Comments: This code can be called by several other RCP commands so that ; they can show the space remaining on the disk after their ; operation. if [erasp or cpsp or dirsp] crspace: ; Used to call space after other subroutines call crlf ; Start new line endif ;[erasp or cpsp or dirsp] space: ld a,(fcb1) ; Determine requested drive or a ; If drive explicitly selected jr nz,space1 ; ..then skip ld c,25 ; BDOS get current drive function call bdos inc a ; Shift to range 1..16 space1: dec a ; Shift to range 0..15 ld e,a ; Save in E for selecting disk below add 'A' ; Convert to letter and ld (seldrv),a ; save in message string below ld c,14 ; BDOS select disk function call bdos ; Not needed if no drive selected, but smallest ; ..possible code size this way. ; Here we extract the following disk parameter information from the disk ; parameter block (DPB): ; BLKSHF: block shift factor (1 byte) ; BLKMAX: max number of blocks on disk (2 bytes) dparams: ld c,31 ; BDOS get disk parameters function call bdos inc hl ; Advance to block shift factor byte inc hl ld a,(hl) ; Get value and ld (blkshf),a ; ..save it in code below inc hl ; Advance to max block number word inc hl inc hl ld e,(hl) ; Get value into HL inc hl ld d,(hl) inc de ; Add 1 for max number of blocks ; Compute amount of free space left on disk dfree: ld c,27 ; BDOS get allocation vector function push de ; Save BLKMAX value call bdos ; Get allocation vector into HL ld b,h ; Copy allocation vector to BC ld c,l pop hl ; Restore MAXBLK value to HL ld de,0 ; Inititialize count of free blocks ; At this point we have ; BC = allocation vector address ; DE = free block count ; HL = number of blocks on disk free1: push bc ; Save allocation address ld a,(bc) ; Get bit pattern of allocation byte ld b,8 ; Set to process 8 blocks free2: rla ; Rotate allocated block bit into carry flag jr c,free3 ; If set (bit=1), block is allocated inc de ; If not set, block is not allocated, so ; ..increment free block count free3: ld c,a ; Save remaining allocation bits in C dec hl ; Count down number of blocks on disk ld a,l ; See if we are down to zero or h jr z,free4 ; Branch if no more blocks to check ld a,c ; Get back current allocation bit pattern djnz free2 ; Loop through 8 bits pop bc ; Get pointer to allocation vector inc bc ; Point to next allocation byte jr free1 ; Continue by processing next allocation byte free4: pop bc ; Clean up stack ex de,hl ; Free block count to HL blkshf equ $+1 ; Pointer for in-the-code modification ld a,0 ; Get block shift factor sub 3 ; Convert to log base 2 of K per block jr z,free6 ; Done if single density (1k per block) ; Convert for blocks of more than 1K each free5: add hl,hl dec a jr nz,free5 ; At this point HL = amount of free space on disk in K free6: call print db ' Space on ' seldrv: db 0 ; Modified above to contain drive letter db ':',[' '+80h] ; Display decimal value of HL ld b,0 ; Initialize count of digits already printed ld de,10000 ; Divisor in DE call decdsp ; Print digit (or space if leading '0') ld de,1000 call decdsp call decdsp3 ; Display hundreds, tens, and units ld a,'K' jp conout ; Final return from space routine ; End RCP-SP.Z80 endif ;spaceon if diron ; include rcpdir ; 'DIR' directory command page ; RCP-DIR.Z80 'DIR' Command ;============================================================================= ; ; D I R E C T O R Y D I S P L A Y C O M M A N D ; ;============================================================================= ; Command: DIR ; Function: Display a directory of the files on disk ; Syntax: DIR Displays the DIR files ; DIR S Displays the SYS files ; DIR A Display both DIR and SYS files ; DIR /S Equivalent to DIR *.* S ; DIR /A Equivalent to DIR *.* A dir: call retsave ; Save return address and set stack ; See if FCB should be made wild (all '?') ld hl,fcb1+1 ; Point to file name in FCP ld a,(hl) ; Get first character of filename if slashchk ; Allow "DIR /S" and "DIR /A" formats cp '/' ; If name does not start with '/' jr nz,dir01 ; ..branch and process normally inc hl ; Point to second character ld a,(hl) ; Get option character after slash ld (fcb2+1),a ; ..and put it into second FCB dec hl ; Back to first character ld a,' ' ; Simulate empty FCB endif ;slashchk dir01: ld b,11 ; Prepare to fill FCB name and type with '?' cp ' ' ; See if no file spec given ld a,'?' ; Get ready to fill with '?' call z,fillp ; ..carry out fill if nosys ; Suppress-SYS-file-if-no-wheel option call whlchk ; Check wheel byte jr z,dirnly ; If wheel off, ignore options endif ld a,(fcb2+1) ; Get first char of 2nd file name ld b,1 ; Set for both dir and sys files cp allflag ; SYS and DIR flag specifier? jr z,dirpr ; Got system specifier dec b ; B=0 for sys files only cp sysflag ; SYS only? jr z,dirpr dirnly: ld b,80h ; Must be dir-only selection ; DIRECTORY PRINT ROUTINE; ON ENTRY, B REG IS SET AS FOLLOWS: ; 0 FOR ONLY SYSTEM FILES, 80H FOR ONLY DIR FILES, 1 FOR BOTH ; dirpr: ld a,b ; Get systst flag call getdir ; Load and sort directory jp z,prfnf ; Print no file message ld e,width ; Count down to 0 ; ; ENTRY PRINT LOOP; ON ENTRY, HL PTS TO FILES SELECTED (TERMINATED BY 0) ; AND E IS ENTRY COUNTER ; dir3: ld a,(hl) ; Check for done or a if dirsp and spaceon jp z,spaexit ; Show space when done else jp z,exit ; Exit if done endif ; Dirsp and spaceon ld a,e ; Get entry counter or a ; Output if 4 entries printed in line jr nz,dir3a ; Continue call crlf ; New line ld e,width ; Reset entry count ld a,e ; Get entry count dir3a cp width ; First entry? jr z,dir4 call print ; if wide ; db ' ' ; 2 spaces db fence ; Then fence char db ' '+80h ; Then 1 more space ; else ; db ' ' ; Space db fence+80h ; Then fence char ; endif ; Wide ; dir4: call prfn ; Print file name call break ; Check for abort dec e ; Decrement entry counter jr dir3 ; End RCP-DIR.Z80 endif ;diron if eraon ; include rcpera ; 'ERA' erase command page ; RCP-ERA.Z80 'ERA' Command ;============================================================================= ; ; E R A S E C O M M A N D ; ;============================================================================= ;Command: ERA ;Function: Erase files ;Forms: ; ERA Erase Specified files and print their names ; ERA I Erase Specified files and print their names, but ask ; for verification before Erase is done era: call retsave ld a,(fcb2+1) ; Get eraflg if it's there ld (eraflg),a ; Save it as a flag ld a,1 ; Dir files only call getdir ; Load directory of files jp z,prfnf ; Abort if no files ; ; MAIN ERASE LOOP ; era1: call break ; See if user wants to stop push hl ; Save ptr to file call prfn ; Print its name ld (nxtfile),hl ; Save ptr to next file pop hl ; Get ptr to this file call rotest ; Test file pted to by hl for r/o jr nz,era3 eraflg equ $+1 ; Address of flag ld a,0 ; 2nd byte is flag cp 'I' ; Is it an inspect option? jr nz,era2 ; Skip prompt if it is not call eraq ; Erase? jr nz,era3 ; Skip if not era2: ld de,fcb1+1 ; Copy into fcb1 ld b,11 ; 11 bytes call blkmov call initfcb1 ; Init fcb ld c,19 ; Delete file call bdos era3: ld hl,(nxtfile) ; Hl pts to next file ld a,(hl) ; Get char or a ; Done? if erasp and spaceon jp z,spaexit else jp z,exit endif ; Erasp and spaceon call crlf ; New line jr era1 ; End RCP-ERA.Z80 endif ;eraon if lton ; include rcplt ; 'LIST' and 'TYPE' commands page ; RCP-LT.Z80 ;============================================================================= ; ; L I S T A N D T Y P E C O M M A N D S ; ;============================================================================= ;Command: LIST ;Function: Print out specified file on the LST: Device ;Forms: ; LIST Print file (NO Paging) ;Notes: ; The flags which apply to TYPE do not take effect with LIST if liston list: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED call retsave ld a,0ffh ; Turn on printer flag jr type0 endif ;liston ;Command: TYPE ;Function: Print out specified file on the CON: Device ;Forms: ; TYPE Print file ; TYPE P Print file with paging flag ;Notes: ; The flag PGDFLG defines the letter which toggles the paging ; facility (P in the forms section above) ; The flag PGDFLT determines if TYPE is to page by default ; (PGDFLT=TRUE if TYPE pages by default); combined with ; PGDFLG, the following events occur -- ; If PGDFLT = TRUE, PGDFLG turns OFF paging ; If PGDFLT = FALSE, PGDFLG turns ON paging ; type: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; ; call retsave xor a ; Turn off printer flag ; ; ENTRY POINT FOR CPR LIST FUNCTION (LIST) ; type0: if liston ld (prflg),a ; Set flag endif ; Liston ld a,(fcb2+1) ; Get page flag ld (pgflg),a ; Save it as a flag ld a,1 ; Select dir files call getdir ; Allow ambiguous files (HL points to buffer) jp z,prfnf ; No files jr typex2 ; Entry point for successive files typex: ld hl,(nxtfile) ; Get ptr to next file ld a,(hl) ; Any files? or a jp z,exit if liston ld a,(prflg) ; Check for list output or a ; 0=type jr z,typex1 ld a,cr ; Bol on printer call lcout ld a,ff ; Form feed the printer call lcout jr typex2 endif ; Liston typex1: ; LDA PAGCNT ; If we've just done so, push hl ld hl,(pagcnt) ld a,(hl) pop hl cp nlines-2 ; Don't type another call nz,pagebreak ; Page break message typex2: ld de,fcb1+1 ; Copy into fcb1 ld b,11 ; 11 bytes call blkmov ld (nxtfile),hl ; Set ptr to next file call initfcb1 ; Init fcb1 ld c,15 ; Open file call bdos inc a ; Set error flag jp z,prfnf ; Abort if error ; MVI A,NLINES-2 ; Set line count ; STA PAGCNT ld hl,(pagcnt) ld (hl),nlines-2 ld a,cr ; New line call lcout ld a,lf call lcout ld bc,080h ; Set char position and tab count ; (b=0=tab, c=080h=char position) ; ; MAIN LOOP FOR LOADING NEXT BLOCK ; type2: ld a,c ; Get char count cp 80h jr c,type3 ; PUSH H ; Read next block push bc ld de,fcb1 ; Pt to fcb ld c,20 ; Read record call bdos or a ; Set flags pop bc ; POP H jr nz,typex ; End of file? ld c,0 ; Set char count ld hl,tbuff ; Pt to first char ; ; MAIN LOOP FOR PRINTING CHARS IN TBUFF ; type3: ld a,(hl) ; Get next char and 7fh ; Mask out msb cp 1ah ; End of file (^z)? jr z,typex ; Next file if so ; ; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION ; cp cr ; Reset tab count? jr z,type4 cp lf ; Reset tab count? jr z,type4 cp tab ; Tab? jr z,type5 ; ; OUTPUT CHAR AND INCREMENT CHAR COUNT ; call lcout ; Output char inc b ; Increment tab count jr type6 ; ; OUTPUT OR AND RESET TAB COUNT ; type4: call lcout ; Output or ld b,0 ; Reset tab counter jr type6 ; ; TABULATE ; type5: ld a,' ' ; call lcout inc b ; Incr pos count ld a,b and 7 jr nz,type5 ; ; CONTINUE PROCESSING ; type6: inc c ; Increment char count inc hl ; Pt to next char call break ; Check for abort jp z,typex ; Skip jr type2 ; ; SEND OUTPUT TO LST: OR CON:, AS PER THE FLAG ; RETURN WITH Z IF ABORT ; lcout: push hl ; Save regs push bc ld e,a ; Char in e ld c,2 ; Output to con: if liston prflg equ $+1 ; Pointer for in-the-code modification ld a,0 ; 2nd byte is the print flag or a ; 0=type jr z,lc1 ld c,5 ; Output to lst: endif ; Liston lc1: push de ; Save char call bdos ; Output char in e pop de ; Get char ld a,e cp lf jr nz,lc2 if liston ld a,(prflg) ; Output to lst:? or a ; Nz = yes jr nz,lc2 endif ; Liston ; ; CHECK FOR PAGING ; ; LXI H,PAGCNT ; Count down ld hl,(pagcnt) dec (hl) jr nz,lc2 ; Jump if not end of page ld (hl),nlines-2 ; Refill counter pgflg equ $+1 ; Pointer to in-the-code buffer ld a,0 ; 2nd byte is the paging flag cp pgdflg ; Page default override option wanted? ; if pgdflt ; If paging is default ; jr z,lc2 ; Pgdflg means no paging ; else ; jr nz,lc2 ; Pgdflg means page ; endif ; Pgdflt ; call pagebreak ; Print page break message jp z,typex ; Z to skip lc2: pop bc ; Restore regs pop hl ret ; ; PRINT PAGE BREAK MESSAGE AND GET USER INPUT ; ABORT IF ^C, RZ IF ^X ; pagebreak: push hl ; Save hl call print db cr,lf,' Typing',' '+80h ld hl,fcb1+1 ; Print file name call prfn call dash ; Print dash call conin ; Get input pop hl ; Restore hl push af call crlf ; New line pop af jp break1 ; ; End RCP-LT.Z80 endif ;lton if renon ; include rcpren ; 'REN' rename command page ; RCP-REN.Z80 ;Section 5E ;Command: REN ;Function: To change the name of an existing file ;Forms: ; REN = Perform function ; ren: ; ; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED ; call retsave ; ; ; STEP 1: CHECK FOR FILE 2 BEING AMBIGUOUS ; ld hl,fcb2+1 ; Can't be ambiguous call ambchk1 ; ; STEP 2: LOG INTO USER AREA ; call logusr ; Log into user area of fcb1 ; ; STEP 3: SEE IF OLD FILE IS R/O ; ld hl,fcb1 ; Pt to 1st fcb push hl ld de,fcb2 ; Pt to 2nd file push de ; Save ptr ld a,(hl) ; Get 1st's drive ld (de),a ; Stuff into second fcb ld c,17 ; Look for file call bdos inc a jp z,prfnf call getsbit ; Get ptr to entry in tbuff ex de,hl ; Hl pts to entry inc hl ; Pt to fn call rotest ; See if file is r/o jp nz,exit ; ; STEP 4: SEE IF NEW FILE ALREADY EXISTS ; EXTEST PERFORMS A NUMBER OF CHECKS: ; 1) AMBIGUITY ; 2) R/O ; 3) IF FILE EXISTS AND NOT R/O, PERMISSION TO DELETE ; call extest jp z,exit ; R/o or no permission ; ; STEP 5: EXCHANGE FILE NAME FIELDS FOR RENAME ; pop de ; Pt to old pop hl ; Pt to new push hl ; Save ptr ld b,12 ; 12 bytes call iswap1 ; ; STEP 6: RENAME THE FILE ; pop de ; Get ptr to fcb ld c,23 ; Rename call bdos inc a ; Set zero flag if error jp z,prfnf ; Print no source file message jp exit ; ; ; End RCP-REN.Z80 endif ;renon if proton ; include rcpprot ; 'PROT' file attribute setting command page ; RCP-PROT.Z80 ;Section 5F ;Command: PROT ;Function: To set the attributes of a file (R/O and SYS) ; ;Form: ; PROT afn RSI ;If either R or S are omitted, the file is made R/W or DIR, resp; ;R and S may be in any order. If I is present, Inspection is enabled. att: call retsave xor a ; Set no inspect ld (inspect),a ld hl,0 ; Set r/o and sys attributes off ld de,fcb2+1 ; Pt to attributes ld b,3 ; 3 chars max att1: ld a,(de) ; Get char inc de ; Pt to next cp 'I' ; Inspect? jr z,atti cp 'R' ; Set r/o? jr z,attr cp 'S' ; Set sys? jr z,atts att2: djnz att1 jr att3 atti: ld (inspect),a ; Set flag jr att2 attr: ld h,80h ; Set r/o bit jr att2 atts: ld l,80h ; Set sys bit jr att2 att3: ld (fatt),hl ; Save file attributes ld a,1 ; Select dir and sys files call getdir ; Load directory jp z,prfnf ; No file error jr att5 att4: ld hl,(nxtfile) ; Pt to next file ld a,(hl) ; End of list? or a jp z,exit call crlf ; New line att5: call break ; Check for possible abort push hl ; Save ptr to current file call prfn ; Print its name ld (nxtfile),hl ; Save ptr to next file call print db ' Set to R','/'+80h ld hl,(fatt) ; Get attributes ld c,'W' ; Assume r/w ld a,h ; Get r/o bit or a jr z,att6 ld c,'O' ; Set r/o att6: ld a,c ; Get char call conout ld a,l ; Get sys flag or a ; Set flag jr z,att7 call print db ' and SY','S'+80h att7: inspect equ $+1 ; Ptr for in-the-code modification ld a,0 ; Get inspect flag or a ; Z=no pop hl ; Get ptr to current file jr z,att8 call eraq1 ; Ask for y/n jr nz,att4 ; Advance to next file if not y att8: ld de,fcb1+1 ; Copy into fcb1 ld b,11 ; 11 bytes call blkmov fatt equ $+1 ; Ptr for in-the-code modification ld hl,0 ; Get attributes dec de ; Pt to sys byte dec de ld a,l ; Get sys flag call attset ; Set attribute correctly dec de ; Pt to r/o byte ld a,h ; Get r/o flag call attset ld de,fcb1 ; Pt to fcb ld c,30 ; Set attributes call bdos jr att4 attset: or a ; 0=clear attribute jr z,attst1 ld a,(de) ; Get byte or 80h ; Set attribute ld (de),a ret attst1: ld a,(de) ; Get byte and 7fh ; Clear attribute ld (de),a ret ; ; End RCP-PROT.Z80 endif ;proton if cpon ; include rcpcp ; 'CP' file copying command ; RCP-CP.Z80 ;============================================================================= ; ; F I L E C O P Y C O M M A N D ; ;============================================================================= ; Command: CP ; Function: Copy a file from one place to another ; Syntax: CP destfile=srcfile ; CP srcfile ; Comments: Both file specifications can include a directory specification. ; If only one file name is given, then the current directory and ; the source file name are assumed for the destination. copy: call retsave ; If new is blank, make it the same name and type as old ld de,fcb1+1 ; Point to destination file name ld a,(de) ; Get first character cp ' ' ; If not blank (no name) jr nz,copy0 ; ..then branch to copy ld hl,fcb2+1 ; Copy source name into destination FCB ld b,11 ; Name and type are 11 bytes call blkmov ; See if destination is same as source, and abort if so copy0: ld hl,fcb1 ; Set up pointers to two files ld de,fcb2 push hl push de inc hl ; Point to names of files inc de ld b,13 ; Compare 13 bytes (name, type, and user #) copy1: call comp jr nz,copy2 ; If they differ, go on with copy ld c,25 ; Get-current-disk BDOS function call bdos ; Get it in case no drive given explicitly inc a ; Shift to range 1..16 ld b,a ; ..and keep value in B pop de ; Restore pointers to FCBs pop hl ld a,(de) ; Get drive of source file ld c,a ; ..and save it in C or a ; Is it default drive? jr nz,copy1a ; Branch if drive made explicit ld c,b ; Otherwise, copy default drive into C copy1a: ld a,(hl) ; Get drive of destination file or a ; Is it default drive? jr nz,copy1b ; Branch if drive made explicit ld a,b ; Otherwise, get current drive copy1b: cp c ; Compare the two drives specified jr nz,copy3 ; Branch if they are different jr cperr ; Branch to error code if they are the same copy2: pop de ; Clean up the stack pop hl ; Make note of the user numbers of the two files copy3: ld a,(fcb1+13) ; Get destination user number ld (usrdest),a ld a,(fcb2+13) ; Get source user number ld (usrsrc),a ; Set up new FCB for source file and open the source call define ; Define buffer addresses dynamically ld hl,(srcfcb) ; Get address to use for new source FCB push hl ex de,hl ; Copy file data to new FCB ld b,12 call blkmov call logsrc ; Log in user number of source file pop hl ; Initialize the source file FCB call initfcb2 ld c,15 ; Open file call bdos inc a ; Check for error jp z,prfnf ; Branch if file not found ; Make sure destination file does not already exist call logdest ; Log into destination s user area call extest ; Test for existence of file jp z,exit ; Branch if it exists ; Create destination file ld de,fcb1 ; Point to destination FCB ld c,22 ; BDOS make-file function call bdos inc a ; Test for error (no directory space) jr nz,copy5 ; Branch if OK ; Report file error cperr: call print db ' Copy','?'+80h jp exit ; Copy source to destination with buffering ;++++++++++ this should be done by changing DMA address to save all the ; buffer swapping copy5: call logsrc ; Log in source user area ld b,0 ; Initialize counter ld hl,(cbuff) ; Initialize buffer pointer copy5a: push hl ; Save address and counter push bc ld hl,(srcfcb) ; Point to source file FCB ex de,hl ; Put it in DE for BDOS call ld c,20 ; BDOS read-sequential function call bdos pop bc ; Get counter and address pop de or a ; Read Ok? jr nz,copy5b ; Branch if end of file push bc ; Save counter ld hl,tbuff ; Copy from 80h to buffer ld b,128 ; 128 bytes call blkmov ex de,hl ; HL points to next buffer address pop bc ; Get counter back inc b ; Increment it ld a,b ; See if buffer full cp cpblocks jr nz,copy5a ; If not, go back for more copy5b: ld a,b ; Get count of blocks loaded into buffer or a ; Are there any? jr z,copy6 ; Branch if not (we are done) push bc ; Save count call logdest ; Log into destination user number cbuff equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Point to beginning of copy buffer copy5c: ld de,tbuff ; Copy into tbuff ld b,128 ; 128 bytes call blkmov push hl ; Save pointer to next block ld de,fcb1 ; Point to destination file FCB ld c,21 ; Write the block call bdos or a jr nz,cperr ; Branch on error (disk full of write error) pop hl ; Get back pointer to next block pop bc ; Get count ; djnz copy5 ; Work through the blocks dec b ; jr z,copy5 ; push bc ; Save count jr copy5c ; Back for another bufferful ; Close the destination file copy6: call logdest ; Log into destination user number ld de,fcb1 ; Point to destination FCB ld c,16 ; Close file call bdos call print db ' Don','e'+80h if cpsp and spaceon jp spaexit ; Report space remaining on destination drive else jp exit endif ;cpsp and spaceon ; Log into user number of source file logsrc: usrsrc equ $+1 ; Pointer for in-the-code modification ld a,0 ; Get user number jr setusrrel ; Local jump to save code ; Log into user number of destination file logdest: usrdest equ $+1 ; Pointer for in-the-code modification ld a,0 ; Get user number setusrrel: jp setusr ; End RCP-CP.Z80 endif ;cpon if peekon or pokeon or porton ; include rcpiom ; 'PEEK', 'POKE', 'PORT' commands page ; RCP-IOM.Z80 ; Command: PEEK ; Function: Display memory contents ; ; Form: ; PEEK startadr 256 bytes displayed ; PEEK startadr endadr range of bytes displayed if peekon peek: call retsave ld hl,tbuff+1 ; Find first number nxtpeek equ $+1 ; Pointer for in-the-code modification ld de,100h ; Default peek address if none call sksp ; Skip to first token (if any) call nz,hexnum ; Get start address if any push de ; Save starting address ld bc,255 ; Compute default ending address ex de,hl add hl,bc if peekchk ; Check for overflow jr nc,peek0 ; If no overflow past FFFF, go on ld hl,0ffffh ; Else use FFFF as ending address peek0: endif ;peekchk ex de,hl ; End address in DE call sksp ; Skip to next token (if any) call nz,hexnum ; Get 2nd number in DE (else default) peek1: pop hl ; HL is start address, DE is end address if peekhdr push hl ; Save starting address again ld b,8 ; Output leading spaces peek0a: call print db ' '+80h djnz peek0a ld b,16 ; Display 16 column headers peek0b: ld a,l and 03h call z,spac call spac call spac ld a,l ; Get low byte of address and 0fh ; Display low hex digit call pah inc hl djnz peek0b if peekbdr call crlf ld b,8 peek0c: call print db ' '+80h djnz peek0c ld b,16 peek0d: ld a,l and 3 call z,spac inc l call print db ' -', '-'+80h djnz peek0d endif ;peekbdr pop hl ; Restore starting address endif ;peekhdr ld c,0ffh ; Use C as continue flag call peek2 ; Do peek ld (nxtpeek),hl ; Set continued peek address jp exit peek2: ld a,c ; Check continuation flag or a ; ret z ; ; Print line header peek2a: call crlf ; New line ld a,h ; Print address call pashc ld a,l call pahc call dash ; Print leader ld b,16 ; 16 bytes to display push hl ; Save start address ; Print hex values for 16 bytes peek3: ld a,l and 03h call z,spac ld a,(hl) ; Get next byte call pashc ; Print with leading space ; Check for last address ; If c is already 0, leave it that way. ; Otherwise check for end address and if so ; Set c to zero. ld a,c ; See if continue flag already cleared or a jr z,peek3a ; If so, skip test ld a,h sub a,d ; See if h = d ld c,a ld a,l sub a,e ; See if l = e or c ; Combine two tests ld c,a peek3a: inc hl ; Pt to next djnz peek3 ; Print ascii equivalents for 16 bytes pop hl ; Pt to first address again ld b,16 ; 16 bytes call print ; Space and fence db ' ' db fence+80h push bc ; Save flag in c peek4: ld a,(hl) ; Get next byte ld c,'.' ; Assume dot and 7fh ; Mask it cp ' ' ; Dot if less than space jr c,peek5 cp 7fh ; Don't print del jr z,peek5 ld c,a ; Char in c peek5: ld a,c ; Get char call conout ; Send it inc hl ; Pt to next djnz peek4 call print ; Closing fence db fence+80h pop bc ; Get flag in c back call break ; Allow abort jr peek2 endif ; Peekon ; ; PRINT A AS 2 HEX CHARS ; PASHC - LEADING SPACE ; if peekon or [pokeon and not pokeq] or porton pashc: push af ; Save a call spac pop af pahc: push af rrca ; Exchange nybbles rrca rrca rrca call pah ; Print hex char pop af pah: and 0fh ; Mask add a,'0' ; Convert to ascii cp '9'+1 ; Letter? jr c,pah1 add a,7 ; Adjust to letter pah1: jp conout ; endif ; Peekon or [pokeon and not pokeq] or porton ; ;Section 5I ;Command: POKE ;Function: Place Values into Memory ; ;Form: ; POKE startadr val1 val2 ... ; if pokeon poke: call retsave ld hl,tbuff+1 ; Pt to first char call sksp ; Skip to non-blank jr z,noargs ; Arg error call hexnum ; Convert to number if not pokeq call print db ' Pok','e'+80h call adrat ; Print at message endif ; LOOP FOR STORING HEX VALUES SEQUENTIALLY VIA POKE poke1: push de ; Save address call sksp ; Skip to non-blank jp z,exit ; Done cp '"' ; Quoted text? jr z,poke2 call hexnum ; Get number ld a,e ; Get low pop de ; Get address ld (de),a ; Store number inc de ; Pt to next jr poke1 ; ; STORE ASCII CHARS ; poke2: pop de ; Get next address inc hl ; Pt to next char poke3: ld a,(hl) ; Get next char or a ; Done? jp z,exit ld (de),a ; Put char inc hl ; Pt to next inc de jr poke3 endif ; Pokeon ; ; No Argument Error ; if pokeon or porton noargs: call print db ' Arg','?'+80h jp exit ; endif ; Pokeon or porton ; ;Section 5I+ ;Command: PORT ;Function: Display or Set I/O Port Data ; ;Form: ; PORT addr - read port and display value ; PORT addr value - output value to port ; if porton port: call retsave ld hl,tbuff+1 ; Find first number call sksp ; Skip to first command-line token jr z,noargs ; Abort if no port address given call hexnum ; Get start address into de push hl ; Save pointer to command tail ld hl,portaddr ; Modify code ld (hl),e ; Move specified port addr into place dec hl ; Point to opcode position ld (hl),0dbh ; Poke 'in' opcode ex (sp),hl ; Get tail pointer back while saving this one call print ; Print header db ' Por','t'+80h ld a,e call pashc ; Print port address call sksp ; Skip to possible second value jr z,portin ; Proceed with port input call hexnum ; Get 2nd number in de ex (sp),hl ; Get pointer to opcode back ld (hl),0d3h ; Poke 'out' opcode call print db ': OU','T'+80h ld a,e ; Get value to output jr paddr portin: call print db ': I','N'+80h xor a ; Make sure high port address = 0 (for HD64180) paddr: ld b,0 ; ..for both IN and OUT instructions opcode: db 0 ; Opcode for IN or OUT inserted by code above portaddr: db 0 ; Port address inserted by code above call pashc pop hl ; Clean up stack jp exit endif ; Porton ; End RCP-IOM.Z80 endif ;peekon or pokeon or porton if regon ; include rcpreg ; 'REG' register operation commands page ; RCP-REG.Z80 ; ;Section 5J ;Command: REG ;Function: Manipulate Memory Registers ; ;Forms: ; REG D or REG <-- Display 10 Register Values ; REG Mreg <-- Decrement Register Value ; REG Preg <-- Increment Register Value ; REG Sreg value <-- Set Register Value ; ; Vers 2.1 Joe Wright ; ; REG reg <-- Display a single register value ; ; REG numbers now range from 0 to 31, although only the first ten are ; displayed with REG D. ; ; REG now treats the program error byte as register E. ; register: ld de,fcb1+2 ; Pt to first arg ld a,(de) ; Get possible digit call regptr ; Pt HL to potential register dec de ; Point to command ld a,(de) cp 'S' ; Set? jr z,rset cp 'P' ; Plus? jr z,rinc cp 'M' ; Minus? jr z,rdec cp ' ' jr z,rshow cp 'D' jr z,rshow call regptr jp regout ; INCREMENT REGISTER VALUE ; HL PTS TO MEMORY REGISTER ON INPUT rinc: inc (hl) ; Increment it jr regout ; Print result ; DECREMENT REGISTER VALUE ; HL PTS TO MEMORY REGISTER ON INPUT rdec: dec (hl) ; Decrement value jr regout ; Print result ; Show first ten registers and Program Error byte ; rshow: call rshow10 ld hl,z3msg+6 jp regout rshow10: xor a ; Select register 0 ld b,a ; Counter set to 0 in B call regp1 ; HL pts to register 0 rshow1: ld a,b ; Get counter value cp 10 ; First ten registers ret z ; Exit if done push bc ; Save counter push hl ; Save pointer call regout ; Print register value pop hl ; Get pointer pop bc ; Get counter inc b ; Increment counter ld a,b ; Check for new line and 3 call z,crlf ; Newline after fourth display inc hl ; Pt to next register jr rshow1 ; SET REGISTER VALUE ; HL PTS TO REGISTER ON INPUT rset: ld de,fcb2+1 ; Pt to value call de2bin ; Eval string at DE to binary in B ld (hl),b ; Set value ; Enter with HL pointing to the register. HL is maintained. ; regout: call print db ' Reg',' '+80h ld de,z3msg+30h ; Register 0 sbc hl,de ; Register number in HL ld a,l cp 32 ; A numbered Register? jr c,rego0 ; Yep call print db ' ','E'+80h jr rego1 ; Report rego0: push hl push de ld b,0 ; Suppress zeros call decdsp2 ; Report register number pop de pop hl rego1: add hl,de ; HL points to register again call print db ' =',' '+80h ld l,(hl) xor a ld h,a ld b,a ; Suppress leading zeros jp decdsp3 ; Display value ; Evaluate decimal string at DE to binary in B ; de2bin: ld b,0 ; Init value to zero de2b: ld a,(de) ; Get this digit inc de ; Pt to next sub '0' ; Convert to binary ret c ; A space, finished cp 10 ; Range? ret nc ; Not decimal, finished ld c,a ; Digit in c ld a,b ; Multiply old by 10 add a,a ; *2 add a,a ; *4 add a,b ; *5 add a,a ; *10 add a,c ; Add in new digit ld b,a ; Result in b jr de2b ; Again ; SET HL TO POINT TO MEMORY REGISTER WHOSE INDEX IS PTED TO BY HL ; ON INPUT, A CONTAINS REGISTER CHAR ; ON OUTPUT, HL = ADDRESS OF MEMORY REGISTER (REG 0 ASSUMED IF ERROR) regptr: ld hl,z3msg+6 ; The E register cp 'E' ret z push de call de2bin ; Get register number in B pop de ld a,b cp 32 ; Range 0-31 ld a,0 jr nc,regp1 ; Out of range, use 0 ld a,b ; Value in A regp1: ld hl,z3msg+30h ; Pt to memory registers add a,l ; Pt to proper register ld l,a ret ; No chance of crossing page boundary ; ; End RCP-REG.Z80 endif ;regon if whlon or whlqon ; include rcpwhl ; 'WHL' and 'WHLQ' commands page ; ;Section 5K ;Command: WHL/WHLQ ;Function: Set the Wheel Byte on or off ; ;If WHLQUIET equate is true, then RCP does not report wheel status with WHL ;command. ; ;Form: ; WHL -- turn Wheel Byte OFF ; WHL password -- turn Wheel Byte ON if password is correct ; WHLQ -- find out status of Wheel Byte ; ; Vers 2.1 Changes the function a little as follows: ; ; WHL -- Report Wheel Status (no WHLQ) ; WHL password -- Set Wheel ON if password is correct ; -- Set Wheel OFF if password incorrect whl: ld hl,fcb1+1 ; Pt to first char ld a,(hl) ; Get it if not whlqon cp ' ' jr z,whlmsg ; Report wheel status if no password endif ld de,whlpass ld b,8 ; Check 8 chars call comp ; Compare jr nz,whloff ; Set wheel OFF if incorrect password ; TURN ON WHEEL BYTE ld a,0ffh ; Turn on wheel byte jr whlset ; TURN OFF WHEEL BYTE whloff: xor a ; Turn off wheel byte whlset: ld hl,(z3whl) ; Indirect from z3env ld (hl),a whlq: if whlquiet ret endif ; PRINT WHEEL BYTE MESSAGE if not whlquiet whlmsg: call print dc ' Wheel ' call whlchk ; Check wheel byte jr z,offm call print dc 'On' ret offm: call print dc 'Off' ret endif ;[not whlquiet] or whlqon ; WHEEL PASSWORD DEFINED FROM SYSRCP.LIB FILE db 'Z'-'@' ; Leading ^z to block attempt to type rcp file whlpass: wpass ; Use macro ; ; End RCP-WHL.Z80 endif ;whlon if echoon ; include rcpecho ; 'ECHO' command page ; RCP-ECHO.Z80 ;============================================================================= ; ; E C H O T E X T T O S C R E E N A N D P R I N T E R ; ;============================================================================= ; Command: ECHO ; Function: Echo text to console or printer echo: xor a ; Lower case flag setting if upcase ; If upper case default dec a endif ;upcase ld (casefl),a ; Store flag in code below ld hl,tbuff+1 ; Point to first character call getchar ; Get first character (should be blank) ; If none, exit from routine if echolst call getchar ; Get first char after leading blank ld b,a ; Save first char as list output flag cp '$' ; Print flag? jr z,echo2 ; If so, go on dec hl ; Else backup one character endif ; Echolst ; LOOP TO ECHO CHARS echo2: call getchar if echolst cp ff ; Form feed? jr z,echo3 endif ;echolst cp '^' jr nz,echo2a ; Not control character prefix call getchar ; Get next character and 1fh ; Convert to control character jr echo2d ; Echo it echo2a: cp cmdchar ; Case shift prefix? jr nz,echo2d ; No, normal echo call getchar ; Get next character cp ucasechar ; Up-shift character? jr z,echo2c ; Store non-zero value in case flag echo2b: cp lcasechar ; Lower-case character? jr nz,echo2d ; No, echo the character as is xor a ; Else, clear case flag echo2c: ld (casefl),a jr echo2 ; On to next character echo2d: call echout ; Send char jr echo2 ; FORM FEED - SEND NEW LINE FOLLOWED BY FORM FEED IF PRINTER OUTPUT if echolst echo3: ld a,b ; Check for printer output cp '$' jr nz,echoff ; Send form feed normally if not printer call echonl ; Send new line ld a,ff ; Send form feed jr echout ; SEND FORM FEED CHAR TO CONSOLE echoff: ld a,ff ; Get char jr echo2d endif ;echolst ; END OF PRINT LOOP - CHECK FOR PRINTER TERMINATION echo4: if not echolst ret else ld a,b ; Get list mode flag cp '$' ret nz ; Done if no printer output ; OUTPUT A NEW LINE echonl: ld a,cr ; Output new line on printer call echout ld a,lf ; Fall thru to echout endif ;not echolst ; OUTPUT CHAR TO PRINTER OR CONSOLE echout: ld c,a ; Char in c cp 'A' ; If less than 'a' jr c,echouta ; Leave as is cp 'Z'+1 ; If greater than 'z' jr nc,echouta ; Leave as is add 20h ; Else convert to lower case echouta: ld d,a ; Save lower case version in d casefl equ $+1 ; Pointer for in-the-code modification ld a,0 or a jr nz,echoutb ; If upper case selected, go on as is ld c,d ; Else substitute lower case version echoutb: push hl ; Save hl push bc ; Save bc ld de,0ch-3 ; Offset for console output if echolst ld a,b ; Check for printer output cp '$' jr nz,echout1 inc de ; Add 3 for printer offset inc de inc de endif ;echolst ; OUTPUT CHAR IN C WITH BIOS OFFSET IN DE echout1: call biout ; Bios output pop bc ; Restore bc,hl pop hl ret ; Get a character from the command tail buffer getchar: ld a,(hl) ; Get character inc hl ; Point to next one or a ; Check for end of string ret nz ; If not end, return pop hl ; Else, clean up stack jr echo4 ; And exit from routine ; OUTPUT CHAR IN C TO BIOS WITH OFFSET IN DE biout: ld hl,(wboot+1) ; Get address of warm boot add hl,de ; Pt to routine jp (hl) ; Jump to it ; End RCP-ECHO.Z80 endif ;echoon ; include rcpsubs ; File of subroutines page ; RCPSUBS.Z80 Subroutines for Z33RCP.Z80 ;----------------------------------------------------------------------------- ; Display decimal digit routines ;-------------------- ; Display hundreds, tens, and units digits (assumes flag in B has been set) if regon or spaceon decdsp3: ld de,100 ; Display hundreds call decdsp decdsp2: ld de,10 ; Display tens call decdsp ld a,l ; Get remaining units value add '0' ; Convert to character jr conout ; Print it and return ;-------------------- ; Routine to print any single digit ; Actually, this routine displays the value of HL divided by DE and leaves the ; remainder in HL. In computing the character to display, it assumes that the ; result of the division will be a decimal digit. If the result is zero, the ; value in the B register, which is the number of digits already printed, is ; checked. If it is zero, a space is printed instead of a leading '0'. If it ; is not zero, the '0' is printed. Whenever any digit (not a space) is ; printed, the value in B is incremented. decdsp: ld c,'0'-1 ; Initialize digit count xor a ; Clear carry flag decdsp1: inc c ; Pre-increment the digit sbc hl,de ; Subtract DE from HL jr nc,decdsp1 add hl,de ; Add back in to produce remainder ld a,c ; Get decimal digit cp '0' ; Check for leading 0 jr nz,decdout ; If not 0, proceed to display it ld a,b ; Digit printed already? or a ld a,' ' ; Possible space for calling routine to print ; ret z ; If no digit printed, return zero flag set jr z,conout ; Print leading space decdout: inc b ; Indicate digit printed ld a,c ; Else print real digit ; Fall through to CONOUT endif ;regon or spaceon ;----------------------------------------------------------------------------- ; Console Output Routine conout: putreg ; Save all register except AF push af ; Save AF, too and 7fh ; Mask out MSB ld e,a ; Transfer character to E ld c,2 ; BDOS conout function number call bdos pop af getreg ; Restore registers note: ; Use this RET for NOTE command ret if peekon or [pokeon and not pokeq] or porton spac: ld a,' ' jr conout endif ; peekon or [pokeon and not pokeq] or porton ;----------------------------------------------------------------------------- ; String printing routines ;-------------------- ; Print string following call (terminated with null or character with the ; high bit set) print: ex (sp),hl ; Get address call printhl ex (sp),hl ; Put address ret ;-------------------- ; Print string pointed to by HL (terminated with null or character with the ; high bit set) printhl: ld a,(hl) ; Get next character inc hl ; Point to following one or a ; See if null terminator ret z ; If so, we are done call conout ; Display the character ret m ; We are done if MSB is set (negative number) jr printhl ; Back for more ;----------------------------------------------------------------------------- ; OUTPUT NEW LINE TO CON: crlf: call print db cr,lf+80h ret ; CONSOLE INPUT if eraon or lton or proton or renon or cpon conin: push hl ; Save regs push de push bc ld c,1 ; Input call bdos pop bc ; Get regs pop de pop hl and 7fh ; Mask msb cp 61h ret c and 5fh ; To upper case ret endif ; Eraon or lton or proton or renon or cpon ; ; SAVE RETURN ADDRESS ; retsave: pop de ; Get return address pop hl ; Get return address to zcpr3 ld (z3ret),hl ; Save it push hl ; Put return address to zcpr3 back push de ; Put return address back ret ; if spaceon and [dirsp or cpsp or erasp] spaexit: call crspace ; Show space remaining endif ; Spaceon and [dirsp or cpsp or erasp] ; ; EXIT TO ZCPR3 ; exit: z3ret equ $+1 ; Pointer to in-the-code modification jp 0 ; Return address ; ; PRINT A DASH ; if lton or peekon dash: call print db ' -',' '+80h ret ; endif ; Lton or peekon ; ; PRINT ADDRESS MESSAGE ; PRINT ADDRESS IN DE ; if peekon or pokeon if not pokeq adrat: call print db ' at',' '+80h ld a,d ; Print high call pahc ld a,e ; Print low jp pahc endif ; Not pokeq endif ; Peekon or pokeon if peekon or pokeon or porton ; ; EXTRACT HEXADECIMAL NUMBER FROM LINE PTED TO BY HL ; RETURN WITH VALUE IN DE AND HL PTING TO OFFENDING CHAR ; hexnum: ld de,0 ; De=accumulated value hnum1: ld a,(hl) ; Get char cp ' '+1 ; Done? ret c ; Return if space or less inc hl ; Pt to next sub '0' ; Convert to binary jr c,numerr ; Return and done if error cp 10 ; 0-9? jr c,hnum2 sub 7 ; A-f? cp 10 jr c,numerr ; Must be at least 0Ah cp 10h ; Error? jr nc,numerr ; Greater than 0Fh hnum2: push hl ; Save pointer ex de,hl add hl,hl add hl,hl add hl,hl add hl,hl ; DE x16 to HL ld e,a ld d,0 add hl,de ex de,hl ; DE = DE * 16 + A pop hl ; Get the pointer jr hnum1 ; Try again ; ; NUMBER ERROR ; numerr: call print db ' Num','?'+80h jp exit ; ; SKIP TO NEXT NON-BLANK ; sksp: ld a,(hl) ; Get char inc hl ; Pt to next cp ' ' ; Skip spaces jr z,sksp dec hl ; Pt to good char or a ; Set eol flag ret ; endif ; Peekon or pokeon or porton ;----------------------------------------------------------------------------- ; Test File in FCB for unambiguity and existence, ask user to delete if so ; Return with Z flag set if R/O or no permission to delete ; if renon or cpon extest: call ambchk ; Ambiguous file names not allowed call searf ; Look for specified file jr z,exok ; Ok if not found call getsbit ; Position into dir inc de ; Pt to file name ex de,hl ; Hl pts to file name push hl ; Save ptr to file name call prfn ; Print file name pop hl call rotest ; Check for r/o jr nz,exer call eraq ; Erase? jr nz,exer ; Restart as error if no ld de,fcb1 ; Pt to fcb1 ld c,19 ; Delete file call bdos exok: xor a dec a ; Nz = ok ret exer: xor a ; Error flag - file is r/o or no permission ret ; ; CHECK FOR AMBIGUOUS FILE NAME IN FCB1 ; RETURN Z IF SO ; ambchk: ld hl,fcb1+1 ; Pt to fcb ; ; CHECK FOR AMBIGUOUS FILE NAME PTED TO BY HL ; ambchk1: push hl ld b,11 ; 11 bytes amb1: ld a,(hl) ; Get char and 7fh ; Mask cp '?' jr z,amb2 inc hl ; Pt to next djnz amb1 dec b ; Set nz flag pop de ret amb2: pop hl ; Pt to file name call prfn call print db ' is AF','N'+80h jp exit ; endif ; Renon or cpon ; ; TEST FILE PTED TO BY HL FOR R/O ; NZ IF R/O ; if renon or cpon or eraon ; rotest: push hl ; Advance to r/o byte ld bc,8 ; Pt to 9th byte add hl,bc ld a,(hl) ; Get it and 80h ; Mask bit push af ld hl,romsg call nz,printhl ; Print if nz pop af ; Get flag pop hl ; Get ptr ret romsg: db ' is R/','O'+80h ; ; CHECK USER TO SEE IF HE APPROVES ERASE OF FILE ; RETURN WITH Z IF YES ; eraq: call print db ' - Eras','e'+80h endif ; Renon or cpon or eraon if renon or cpon or eraon or proton eraq1: call print db ' (Y/N/Q)?',' '+80h call conin ; Get response cp 'Q' ; Quit command? jp z,exit cp 'Y' ; Key on yes ret ; endif ; Renon or cpon or eraon or proton ; ; INIT FCB1, RETURN WITH DE PTING TO FCB1 ; if eraon or lton or cpon initfcb1: ld hl,fcb1 ; Pt to fcb initfcb2: push hl ; Save ptr ld bc,12 ; Pt to first byte add hl,bc ld b,24 ; Zero 24 bytes xor a ; Zero fill call fillp ; Fill memory pop de ; Pt to fcb ret ; endif ; Eraon or lton or cpon ; if eraon or lton or cpon or diron fillp: ld (hl),a ; Store byte inc hl ; Pt to next djnz fillp ; Count down ret ; endif ; Eraon or lton or cpon or diron ; ; CHECK FOR USER INPUT; IF ^C, RETURN WITH Z ; if diron or lton or eraon or proton or peekon break: push hl ; Save regs push de push bc ld c,11 ; Console status check call bdos or a ld c,1 ; Get char if any call nz,bdos pop bc ; Restore regs pop de pop hl break1: cp ctrlc ; Check for abort jp z,exit ; Exit cp ctrlx ; Skip? ret endif ; Diron or lton or eraon or proton or peekon ; AFTER A SEARCH, RETURN NZ SET IF DESIRED TYPE OF FILE FOUND, Z IF NOT ; THIS ALGORITHM LOOKS AT THE SYSTEM BIT OF THE LOCATED FILE; THIS ; BIT IS SET TO 1 IF THE FILE IS A SYSTEM FILE AND 0 IF NOT A SYSTEM ; FILE. THE FOLLOWING EXCLUSIVE OR MASKS ARE APPLIED TO RETURN Z OR NZ ; AS REQUIRED BY THE CALLING PROGRAM: ; ; SYSTEM BYTE: X 0 0 0 0 0 0 0 (AFTER 80H MASK, X=1 IF SYS, 0 IF DIR) ; ; SYS-ONLY : 0 0 0 0 0 0 0 0 (XOR 0 = 0 if X=0, = 80H if X=1) ; DIR-ONLY : 1 0 0 0 0 0 0 0 (XOR 80H = 80h if X=0, = 0 if X=1) ; BOTH : 0 0 0 0 0 0 0 1 (XOR 1 = 81H or 1H, NZ in both cases) if diron or eraon or lton or proton or cpon or renon getsbit: dec a ; Adjust to returned value rrca ; Convert number to offset into tbuff rrca rrca and 60h ld de,tbuff ; Pt to buffer add a,e ; Add entry offset to base addr ld e,a ; Result in e push de ; Save ptr in de add 10 ; Add offset of 10 to pt to system byte ld e,a ; Set address ld a,(de) ; Get byte pop de ; Get ptr in de and 80h ; Look at only system bit systst equ $+1 ; In-the-code variable xor 0 ; If systst=0, sys only; if systst=80h, dir ; Only; if systst=1, both sys and dir ret ; Nz if ok, z if not ok ; ; ; COPY HL TO DE FOR B BYTES ; blkmov: ld a,(hl) ; Get ld (de),a ; Put inc hl ; Pt to next inc de djnz blkmov ; Loop ret ; ; PRINT FILE NOT FOUND MESSAGE ; prfnf: call print db ' No File','s'+80h jp exit ; LOG INTO USER AREA CONTAINED IN FCB1 ; logusr: ld a,(fcb1+13) ; Get user number setusr: ld e,a ld c,32 ; Use bdos fct jp bdos ; ; PRINT FILE NAME PTED TO BY HL ; prfn: call print ; Leading space db ' '+80h ld b,8 ; 8 chars call prfn1 call print db '.'+80h ; Dot ld b,3 ; 3 chars prfn1: ld a,(hl) ; Get char inc hl ; Pt to next call conout ; Print char djnz prfn1 ; Count down ret ; ; SEARCH FOR FIRST ; searf: push bc ; Save counter push hl ; Save hl ld c,17 ; Search for first function searf1: ld de,fcb1 ; Pt to fcb call bdos inc a ; Set zero flag for error return pop hl ; Get hl pop bc ; Get counter ret endif ; Diron or eraon or lton or proton or cpon or renon ;----------------------------------------------------------------------------- ; Define buffers as high as possible in TPA for the following groups ; of commands: ; COPY needs SRCFCB and CBUFF ; LIST/TYPE needs PAGCNT and DIRBUF ; ERA, PROT, and DIR commands. needs DIRBUF ; If DIRBUF is defined, its value is in HL on return from this code. The DE ; register pair is not changed by the code, but the BC pair is affected. dirbufon equ lton or diron or eraon or proton if dirbufon dirbuf: ds 2 ; Address for directory buffer endif ;dirbufon if cpon srcfcb: ds 2 ; Address of source file FCB (CBUFF address ; ..is in the code) endif ;cpon if lton pagcnt: ds 2 ; Address for page counter endif ;lton if cpon or lton or eraon or proton or diron define: push de ld hl,(bdos+1) ; Get bottom of BDOS ex de,hl ; ..into DE ld hl,(1) ; Get BIOS warmboot address into HL ld bc,-[0e00h+800h+3] ; Offset to command processor address add hl,bc ; Now we have to compare and pick the lower address as the top of TPA push hl ; Save CPR address while comparing xor a ; Clear the carry flag sbc hl,de ; Compute (CPR-BDOS) pop hl ; Restore CPR address jr c,define1 ; Branch if BDOS address is higher (use CPR) ex de,hl ; Otherwise use BDOS address define1: if lton dec hl ; Put PAGCNT in first free byte at top of TPA ld (pagcnt),hl endif ;lton if cpon ld de,-36 ; Calculate place for SRCFCB for copy command add hl,de ld (srcfcb),hl if dirbufon push hl ; Save if needed below endif ;dirbufon ld de,-[cpblocks*128] ; CBUFF can use same space as DIRBUF add hl,de ld (cbuff),hl if dirbufon pop hl endif ;dirbufon endif ;cpon if dirbufon ld de,-[maxdirs*11] ; Space for directory buffer add hl,de ld (dirbuf),hl endif pop de ret endif ;cpon or dirbufon ;----------------------------------------------------------------------------- ; ; SEARCH FOR NEXT ; if diron or eraon or lton or proton searn: push bc ; Save counter push hl ; Save hl ld c,18 ; Search for next function jr searf1 ; LOAD DIRECTORY AND SORT IT ; ON INPUT, A=SYSTST FLAG (0=SYS, 1=DIR, 80H=BOTH) ; DIRECTORY IS LOADED INTO BUFFER AT TOP OF TPA ; RETURN WITH ZERO SET IF NO MATCH AND HL PTS TO 1ST ENTRY IF MATCH direrr: call print db 'DIR Ovf','l'+80h jp exit getdir: ld (systst),a ; Set system test flag call logusr ; Log into user area of fcb1 ; LXI H,DIRBUF ; Pt to dir buffer call define ; Define buffer addresses ld (hl),0 ; Set empty ld bc,0 ; Set counter call searf ; Look for match ret z ; Return if not found ; ; STEP 1: LOAD DIRECTORY ; gd1: push bc ; Save counter call getsbit ; Check for system ok pop bc jr z,gd2 ; Not ok, so skip push bc ; Save counter inc de ; Pt to file name ex de,hl ; Hl pts to file name, de pts to buffer ld b,11 ; Copy 11 bytes call blkmov ; Do copy pop bc ; Get counter inc bc ; Increment counter ld hl,maxdirs-1 ; See if count equals or exceeds MAXDIRS ld a,b ; Check high bytes sub a,h jr c,gd1a ; If carry set, we are OK ld a,c ; Check low bytes sub a,l jr nc,direrr ; If no carry, jump to error message gd1a: ex de,hl ; Hl pts to next buffer location gd2: call searn ; Look for next jr nz,gd1 ld (hl),0 ; Store ending 0 ; LXI H,DIRBUF ; Pt to dir buffer ld hl,(dirbuf) ; Pt to dir buffer ld a,(hl) ; Check for empty or a ret z ; ; STEP 2: SORT DIRECTORY ; if sorton push hl ; Save ptr to dirbuf for return call diralpha ; Sort pop hl endif xor a ; Set nz flag for ok dec a ret ; ; DIRALPHA -- ALPHABETIZES DIRECTORY IN DIRBUF; BC CONTAINS ; THE NUMBER OF FILES IN THE DIRECTORY ; diralpha: ; ; SHELL SORT -- ; THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS" ; BY KERNIGAN AND PLAUGHER, PAGE 106. COPYRIGHT, 1976, ADDISON-WESLEY. ; ld h,b ; Hl=bc=file count ld l,c ld (n),hl ; Set "N" ld (gap),hl ; Set initial gap to n for first division by 2 ; FOR (GAP = N/2; GAP > 0; GAP = GAP/2) srtl0: or a ; Clear carry gap equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Get previous gap ld a,h ; Rotate right to divide by 2 rra ld h,a ld a,l rra ld l,a ; TEST FOR ZERO or h ret z ; Done with sort if gap = 0 ld (gap),hl ; Set value of gap ld (ii),hl ; Set ii=gap for following loop ; FOR (II = GAP + 1; II <= N; II = II + 1) srtl1: ii equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Add 1 to ii inc hl ld (ii),hl ; TEST FOR II <= N ex de,hl ; Ii is in de n equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Number of items to sort ld a,l ; Compare by subtraction sub a,e ld a,h sbc a,d ; Carry set means ii > n jr c,srtl0 ; Don't do for loop if ii > n ex de,hl ; Set jj = ii initially for first subtraction of gap ld (jj),hl ; FOR (JJ = II - GAP; JJ > 0; JJ = JJ - GAP) srtl2: ld hl,(gap) ; Get gap ex de,hl ; In de jj equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Get jj ld a,l ; Compute jj - gap sub a,e ld l,a ld a,h sbc a,d ld h,a ld (jj),hl ; Jj = jj - gap jr c,srtl1 ; If carry from subtractions, jj < 0 and abort or l ; Jj=0? jr z,srtl1 ; If zero, jj=0 and abort ; SET JG = JJ + GAP ex de,hl ; Jj in de ld hl,(gap) ; Get gap add hl,de ; Jj + gap ld (jg),hl ; Jg = jj + gap ; IF (V(JJ) <= V(JG)) call icompare ; J in de, jg in hl ; ... THEN BREAK jr c,srtl1 ; ... ELSE EXCHANGE ld hl,(jj) ; Swap jj, jg ex de,hl jg equ $+1 ; Pointer for in-the-code modification ld hl,0 call iswap ; Jj in de, jg in hl ; END OF INNER-MOST FOR LOOP jr srtl2 ; ; SWAP (Exchange) the elements whose indexes are in HL and DE ; iswap: call ipos ; Compute position from index ex de,hl call ipos ; Compute 2nd element position from index ld b,11 ; 11 bytes to flip endif ; Diron or eraon or lton or proton if diron or eraon or lton or proton or renon iswap1: ld a,(de) ; Get bytes ld c,(hl) ld (hl),a ; Put bytes ld a,c ld (de),a inc hl ; Pt to next inc de djnz iswap1 ret endif ; Diron or eraon or lton or proton or renon if diron or eraon or lton or proton ; ; ICOMPARE compares the entry pointed to by the pointer pointed to by HL ; with that pointed to by DE (1st level indirect addressing); on entry, ; HL and DE contain the numbers of the elements to compare (1, 2, ...); ; on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)), ; and Non-Zero and No-Carry means ((DE)) > ((HL)) ; icompare: call ipos ; Get position of first element ex de,hl call ipos ; Get position of 2nd element ex de,hl ; ; COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE; ; NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE