CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / z33rcp02.lbr / RCPSUBS.LZB / RCPSUBS.LIB

Wrap

Text File | 1993-10-25 | 18.6 KB | 858 lines

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 ld e,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,decdsp2 ; 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 decdsp2: 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 ;----------------------------------------------------------------------------- ; 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 ld hl,0 ; Return address jp (hl) ; Goto zcpr3 ; 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 ; 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 ld b,5 ; B=char count 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: ld c,a ; Digit in c ld a,d ; Get accumulated value rlca ; Exchange nybbles rlca rlca rlca and 0f0h ; Mask out low nybble ld d,a ld a,e ; Switch low-order nybbles rlca rlca rlca rlca ld e,a ; High nybble of e=new high of e, ; Low nybble of e=new low of d and 0fh ; Get new low of d or d ; Mask in high of d ld d,a ; New high byte in d ld a,e and 0f0h ; Mask out low of e or c ; Mask in new low ld e,a ; New low byte in e djnz hnum1 ; Count down ret ; 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 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 ld hl,(dirbuf) ; Pt to dir buffer ld a,(hl) ; Check for empty or a ret z ; STEP 2: SORT DIRECTORY push hl ; Save ptr to dirbuf for return call diralpha ; Sort pop hl 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<HL ; RET W/ZERO SET MEANS DE=HL if not sortnt ; Type and name? ; COMPARE BY FILE TYPE AND FILE NAME push hl push de ld bc,8 ; Pt to ft (8 bytes) add hl,bc ex de,hl add hl,bc ex de,hl ; De, hl now pt to their ft's ld b,3 ; 3 bytes call comp ; Compare ft's pop de pop hl ret nz ; Continue if complete match ld b,8 ; 8 bytes ; FALL THROUGH TO COMP else ; Name and type ; COMPARE BY FILE NAME AND FILE TYPE ld b,11 ; Compare fn, ft and fall thru to comp endif ; Not sortnt endif ; Diron or eraon or lton or proton if diron or eraon or lton or proton or cpon or whlon ; COMP COMPARES DE W/HL FOR B BYTES; RET W/CARRY IF DE<HL ; MSB IS DISREGARDED comp: ld a,(hl) ; Get (hl) and 7fh ; Mask msb ld c,a ; In c ld a,(de) ; Compare and 7fh ; Mask msb cp c ret nz inc hl ; Pt to next inc de djnz comp ; Count down ret endif ; Diron or eraon or lton or proton or cpon or ; whlon if diron or eraon or lton or proton ; Compute physical position of element whose index is in HL; on exit, HL ; is the physical address of this element; Indexes are 1..N ipos: dec hl ; We want HL=(HL-1)*11+(DIRBUF) ld b,h ; Bc=hl ld c,l add hl,hl ; Hl=hl*2 add hl,hl ; Hl=hl*4 add hl,bc ; Hl=hl*5 add hl,hl ; Hl=hl*10 add hl,bc ; Hl=hl*11 ld b,h ; Move offset into BC ld c,l ld hl,(dirbuf) add hl,bc ret endif ; Diron or eraon or lton or proton ; End RCPSUBS.Z80