page ; Library: RCPSUBS for Z34RCP ; Author: Carson Wilson ; Version: 1.4 ; Date: October 4, 1989 ; Changes: Added modifications by Rob Friefeld for CLED. ; ; Version: 1.3 ; Date: Sept. 8, 1989 ; Changes: Added ERREX1 routine. RCP now sets bit 4 of the command ; status flag on ambiguous file name errors. Intelligent ; error handlers can interpret this bit and chain to ; more sophisticated transient programs of the same name, ; much the same as CP/M Plus. ; ; Version: 1.2 ; Date: August 12, 1989 ; Changes: Added QPLUG and UNPLUG routines for QUIET operation. ; Author: Carson Wilson ; Version: 1.1 ; Date: December 30, 1988 ; Changes: Added CPMVER routine to detect CP/M Plus. ; Expanded ZSDOS datestamp buffer to full 128 bytes. ; Now gets CCP address from Z34CMN.LIB instead of calculating ; it from BIOS address, since NZCOM allows nonstandard length ; CCP segments (suggested by Howard Goldstein). ; Author: Carson Wilson ; Version: 1.0 ; Date: June 15, 1988 ; ; Subroutines for Z34RCP.Z80 ; ---------------------------------------- ; Routines to chain to Error Handler (EH) ; 1. Error codes (from ZCPR34.LBR) ; ZCPR34 uses the error byte at the beginning of the message buffer as a flag ; to show what kind of error occurred. Advanced error handlers will be able ; to help the user further by suggesting the possible cause of the error. ecbaddir equ 2 ; Bad directory specification -- logging of ; ..user number beyond legal range, ; ..nonexistent named directory ecambig equ 8 ; Ambiguous file specification where not ; ..allowed (SAVE, GET, REN) ecbadnum equ 9 ; Bad numerical value -- not a number where ; ..number expected, number out of range ecnofile equ 10 ; File not found -- REN, TYPE, LIST could not ; ..find a specified file ecdiskfull equ 11 ; Disk directory or data area full ; ..(DOS write error) ectpafull equ 12 ; TPA overflow error ecdupspec equ 16 ; Duplicate filespecs (COPY, RENAME) ; 2. Error Routines if cpon or renon or lton or proton NoFlErr: ; File missing ld a,ecnofile ; File not found error jr errexit ; Chain to error handler endif ; cpon or renon or lton or proton if cpon FulErr: ; Disk or directory full (BDOS write error) ld a,ecdiskfull ; Disk or data area full jr errexit ; Chain to error handler DupErr: ; Duplicate file specs ld a,ecdupspec ; Duplicate filespec error jr errexit ; Chain to error handler endif ; cpon ; ; Check for illegal directory specification under ZCPR 3.4. ; DirChek assumes that FCB's have not been altered since they were ; set by the CCP. Therefore DirChek is called before other BDOS calls. if cpon or lton or renon or diron or eraon or proton or reson or spaceon DirChek: ld a,(fcb1+15) ; Z34 sets these to non zero ld hl,fcb2+15 ; ..if illegal dirspecs. found or (hl) ret z ; Return if OK ld a,ecbaddir ; Bad dir. error code ; fall thru endif ; ; Set error type, then set error, ECP, and external program bits of command ; status flag to tell CCP to go straight to EH. ErrExit: ld b,0 ErrEx1: ld ix,z3msg ; Point to message buffer ld (ix+0),a ; First set error type in error byte ld a,00001110b ; Tell CCP External, No ECP, Error, No shell or b ; Add any specified bits ld (ix+3),A ; Set bits in command status flag jp exit ; Return to CCP ; ------------------------------------------------------------- ; Routine to get wheel byte - Returns wheel in A with flags set getwhl: push hl ld hl,(z3whl) ; Get wheel address from ENV ld a,(hl) ; Read wheel byte and a ; Set flags pop hl ret ; ------------------------------ if systime ; Time in CLED prompt ; ; PMBCD - Print byte at (HL) to console as 1 or 2 BCD digits. ; ; Entry: A = 80h for leading zero's ; A = 0h for no leading zero's ; pmbcd: rld ; Get hi nibble (HL) to low nibble A or a ; For HD64180 call nz,decout ; Display if low or high of A not zero rld ; Get low nibble (HL), from above decout: and 00001111b ; Mask high nibble add a,'0' ; Convert to character jr conout endif ; systime ; 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 decdsp4: add a,'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 jr z,spac ; Print leading space if not decdout: ld a,c ; Else print real digit inc b ; Indicate digit printed jr conout endif ; regon or spaceon ; ------------ ; Print a dash if lton or peekon dash: call print db ' -',' '+80h ret endif ; Lton or peekon ; ------------------------- ; Shut off output in QUIET is set. Return Z if QUIET, NZ otherwise. ; Uses: AF qplug: ld a,(quiet) or a ret z ld a,0C9h ; "RET" qplug1: ld (plug),a ret ; -------------------------- ; Turn on output unplug: xor a jr qplug1 ; ------------- ; Print a space spac: ld a,' ' ; fall thru ; Console Output Routine conout: plug: db 00h ; Goes to 0C9h to turn off output putreg ; Save all registers 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 ; ------------------------ ; 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 if whlon or quieton ; ; Routine to say "On" if A is non-zero or "Off" if A is zero. ; Called by WHL and Q commands. onmsg: dc ' On' offmsg: dc ' Off' tella: ld hl,offmsg ; Prepare to say Off or a jr z,printhl ; Say it if A=0 ld hl,onmsg ; Say On ; fall thru ; Display message and return endif ; whlon or quieton ; 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 ; ------------------------------- ; 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)? N',88h ; 88h = backspace call conin ; Get response cp 'Q' ; Quit command? jr z,exit cp 'Y' ; Key on yes ret endif ; Renon or cpon or eraon or proton ; ------------------------------------- ; Give space on current disk and return if spaceon and [dirsp or cpsp or erasp or resetsp] spaexit: call crspace ; Show space remaining ; fall thru endif ; spaceon and [dirsp or cpsp or erasp or resetsp] ; ; Exit to ZCPR3 ; exit: z3ret equ $+1 ; Pointer to in-the-code modification ld hl,0 ; Return address jp (hl) ; Goto ZCPR3 ; -------------------------------------------------------- ; Check for user input; if ^X, return with Z, abort if ^C 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 jr z,exit ; Exit cp ctrlx ; Skip? ret endif ; Diron or lton or eraon or proton or peekon ; --------------------- ; Print address in DE if peekon or pokeon adrat: call print db ' at',' '+80h ld a,d ; Print high call pahc ld a,e ; Print low jp pahc endif ; Peekon or pokeon ; -------------------------------------------------- ; Extract hexadecimal number from line pted to by HL ; Return with value in DE and HL pting to offending char if peekon or pokeon or porton 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 10h ; Error? jr nc,numerr 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: ld a,ecbadnum ; Numeric error jp errexit ; Chain to error handler ; 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 ld a,ecambig ; Ambiguous name error ld b,00010000b ; Bit 4 tells EH to load transient jp ErrEx1 ; Chain to error handler endif ; Renon or cpon ; --------------------------------------- ; 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 ; Fill a region with byte in A 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 ; --------------------------------------------------------------------- ; 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 routine: ; ; 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 a,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 ; 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 spac ; Leading space 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 call dirchek ; Check bad dirspec 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 ; ------------------------- ; Copy HL to DE for B bytes if diron or eraon or lton or proton or cpon blkmov: ld a,(hl) ; Get ld (de),a ; Put inc hl ; Pt to next inc de djnz blkmov ; Loop ret endif ; Diron or eraon or lton or proton or cpon ; ----------------------------- ; Print file not found message if diron or eraon prfnf: call print db ' No File','s'+80h jp exit endif ; Diron or eraon ; ------------------------------------------------------------------ ; Define buffers as high as possible in TPA for the following groups ; of commands: ; ; COPY needs SRCFCB, CBUFF, STPBUF (if STPCALL) ; ERA, PROT, LIST/TYPE need DIRBUF and NXTFILE ; DIR 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 eraon or proton or diron if dirbufon dirbuf: ds 2 ; Address for directory buffer endif ; dirbufon if lton or eraon or proton nxtfile: ds 2 ; Ptr to next file in list endif ; eraon or lton or proton if cpon or dirbufon or cledon define: push de ld hl,(bdos+1) ; Get bottom of BDOS ex de,hl ; ..into DE ld hl,(ccp) ; From Z34CMN.LIB ; 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 cpon ld de,-36 ; Calculate place for SRCFCB for copy command add hl,de ld (srcfcb),hl if stpcall ld de,-128 add hl,de ; Buffer for datestamps ld (stpbuf),hl endif ; stpcall 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 ; dirbufon pop de ret endif ; cpon or dirbufon or cledon ; --------------- ; 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: ld a,ectpafull ; Chain to error handler jp errexit getdir: ld (systst),a ; Set system test flag call logusr ; Log into user area of fcb1 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 h jr c,gd1a ; If carry set, we are OK ld a,c ; Check low bytes sub 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 ld hl,(dirbuf) ; Pt to dir buffer ld a,(hl) ; Check for empty or a ret z ; Step 2: Sort directory if dsort 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 ; if dsort 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 (num),hl ; Set "NUM" ld (gap),hl ; Set initial gap to n for first division by 2 ; For (gap = num/2; gap > 0; gap = gap/2) srtl0: gap equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Get previous gap or a ; Clear carry rr h ; Rotate right to divide by 2 rr l ld a,l ; Test for zero or h ret z ; Done with sort if gap = 0 ld (gap),hl ; Set value of gap push hl pop ix ; Set ix=gap for following loop ; For (ix = gap + 1; ix <= num; ix = ix + 1) srtl1: inc ix ; Add 1 to ix push ix pop de ; IX is in DE ; Test for ix <= num num equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Number of items to sort ld a,l ; Compare by subtraction sub e ld a,h sbc a,d ; Carry set means ix > n jr c,srtl0 ; Don't do for loop if ix > n ex de,hl ; Set jj = ix initially for first ; ..subtraction of gap ld (jj),hl ; For (jj = ix - gap; jj > 0; jj = jj - gap) srtl2: ld de,(gap) jj equ $+1 ; Pointer for in-the-code modification ld hl,0 ; Get jj sbc hl,de ; Compute JJ - GAP ld a,h 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 iy = jj + gap ex de,hl ; Jj in de ld hl,(gap) ; Get gap add hl,de ; Jj + gap push hl pop iy ; IY = iy + gap ; If (v(jj) <= v(iy)) call icompare ; JJ in de, iy in hl ; ...then break jr c,srtl1 ; ...else exchange ld de,(jj) ; Swap jj, iy push iy pop hl call iswap ; Jj in de, iy 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 ; Dsort endif ; Diron or eraon or lton or proton if diron or eraon or lton or proton or renon or (cpon and leftright) iswap1: ld a,(de) ; Get bytes ld c,(hl) ex de,hl ld (de),a ; Put bytes ld (hl),c inc hl ; Pt to next inc de djnz iswap1 ret endif ; Diron or eraon or lton or proton or renon ; ..or (cpon and leftright) if leftright and (cpon or renon) ; ; FCBSWAP exchanges 16 byte FCB1 with FCB2 from the command line. ; This allows COPY and REN commands to execute left to right, ; e.g., "cp source dest". Costs 10 bytes. ; ; If TESTEQ is true, then commands containing '=' still execute right ; to left, e.g., "cp dest=source". Costs 11 bytes additional. ; fcbswap: if testeq xor a ; Zero B ld b,a ld hl,80h ; Point to command line, length ld c,(hl) ; Set up for CPIR ld a,'=' ; Search for '=' cpir ; '=' found in command? ret z ; Yes, don't swap endif ; Testeq ld de,fcb1 ; Point to command fcb's ld hl,fcb2 ld b,16 ; Exchange them jr iswap1 endif ; leftright and (cpon or renon) if diron or eraon or lton or proton if dsort ; ; 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