CP/M

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

/ CP/M / CPM_CDROM.iso / mbug / mbug078.arc / COMMON.LZB / COMMON.LIB

Wrap

Text File | 1979-12-31 | 42.3 KB | 1,462 lines

;------------------------------------------------------------------------------ ; Command tail parsing, Wildcard expansion, other startup stuff ;------------------------------------------------------------------------------ STRTUP: LD A,(BDOS+2) ; Size up the tpa SUB ENDHI+11 ; (includes 2k+ for the ccp) JR NC,ENOUGH ; LD DE,LAKMEM ; "not enough memory..." JP FATAL ; (fatal error) ;.............................................................................. ; ENOUGH: LD A,(QUIFL) ; Move patches to data area for flag use LD (QUIFM),A ; (allows the program to be re-executable LD A,(NPROFL) ; - even if the patch corresponds to a LD (NPROFM),A ; - command line option) LD A,(TRBOFL) ; LD (NOMSFM),A ; LD A,(CNFRFL) ; LD (CNFRFM),A ; XOR A ; Make sure the stamp defaults to a leading 0 LD (STAMP+0),A ; ; Four user# variables are used: USERNO is the original, saved for restora- ; tion before exit. CURUSR is the currently "logged" user, INUSR contains the ; input file's user code; OUTUSR is the output's. Both are defaulted to ; USERNO. Routines LOGIN and LOGOUT log to appropriate user areas when ; called. Unnecessary BDOS 'set user area' calls are inhibited at all times, ; for what it's worth. CALL GETUSR ; Get user# guy started with LD A,(USERNO) ; (above routine put the number here) LD (CURUSR),A ; Define this as the "current" user# LD (INUSR),A ; And the default user for both input & output LD (OUTUSR),A ; ;.............................................................................. LD HL,(Z3ED) ; Get ZCPR3 "environment descriptor" LD A,H ; OR L ; If 0000, program was not installed by Z3INS JR NZ,ZCPR ; Non-zero; program is Z3 LD A,(Z3FLG) ; Else see if installed by patch or CRINSTAL OR A ; JR NZ,ZCPR ; If so, go use Z3 code ;.............................................................................. ; ; Non-ZCPR command tail processing. ; CALL GTOPTS ; Get & process any "slash" options LD HL,2000H ; Init OUTFCB to default drive & 1 blank char LD (OUTFCB+0),HL ; LD DE,DDMA+1 ; Beg of string to be parsed LD HL,INFCB ; 37 byte fcb, where fcb-1 will have user# CALL PARSEU ; Parse. (Note- 'fcb'-1 is 'INUSR') PUSH HL ; Save command line pointer LD IX,INFCB ; Spec fcb for "CHKVLD" call below. CALL CHKVLD ; Check validity of drive / user (saves hl) LD A,(INFCB+1) ; Make sure we have a non-blank filename CP ' ' ; JP Z,GIVUSG ; Give usage & exit CALL AUX1 ; Aux processing handles special delimiters POP DE ; Get back command line pointer, pushed as hl JR C,DONE1 ; AUX1 rtns w/ carry set if cmnd tail is dun LD HL,OUTFCB ; New fcb to be filled CALL PARSEU ; Do it. LD IX,OUTFCB ; Spec for "chkvld" CALL CHKVLD ; Check validity of "OUTFCB" CALL AUX1 ; As above LD A,(OUTFCB+1) ; Additional check- 2nd filename should be blnk CP ' ' ; JR Z,DONE1 ; LD DE,PRSER5 ; Error if not JP FATALU ; ;.............................................................................. ; ; ZCPR3 command tail processing. ; ZCPR: LD HL,DFCB+1 ; Input file spec will come from default FCB1 LD A,(HL) ; But first check for zcpr help invocation CP '/' ; JP Z,GIVUSG ; If so, give usage and exit CP ' ' ; No filename spec'd req's help also JP Z,GIVUSG ; DEC HL ; Else set to beg of dfcb1 LD DE,INFCB ; The input FCB CALL CLRFCB ; Init it to blanks and zeroes LD BC,16 ; Copy drive, filename, user, et al LDIR ; Now the input fcb is set up, but... LD A,(DFCB+13) ; Get the system supplied user# into the LD (INUSR),A ; - byte where the program expects it LD A,(DFCB2+13) ; Similarly for the output file LD (OUTUSR),A ; Goes there LD A,(DFCB2+0) ; Output drive spec stays here. LD (OUTFCB+0),A ; Rest of FCB filled in later, for each file. LD HL,DDMA ; Look for "[...]" stamp LD C,(HL) ; LD B,0 ; #of chars to search LD A,'[' ; Char to search for CPIR ; DEC HL ; Move back to match point, if any LD A,B ; Was there a match? OR C ; CALL NZ,PRCSTM ; (misses if "[" was last char, but that's ok) CALL GTOPTS ; Get and process any "slash options" ; Continue w/ "DONE1" below... ;.............................................................................. ; ; More preliminaries. Determine if multi-sector I/O is indicated; type prog- ; ram intro to console; expand ambiguous wildcard filespecs. ; DONE1: XOR A ; Default the multi-sec i/o flag to false LD (CPM3FL),A ; LD A,(NOMSFM) ; If multi-sec i/o not desired, skip below tst OR A ; JR NZ,NOSMS ; LD C,GETVER ; Get cp/m version# CALL BDOS ; Will return result in l LD A,30H-1 ; CP L ; 3.0 or greater? JR NC,NOSMS ; No, don't set flag LD (CPM3FL),A ; Else set it with this convenient non-o # ; ; NOSMS: LD DE,INTRO ; Version#, etc. CALL MESAGE ; Type that to console CALL LOGIN ; Log to the input files's user area CALL FIXFCB ; Uncr will convert ? in middle of ext to "Z" LD DE,INFCB ; Spec input FCB for below call CALL WILDEX ; Perform wildcard expansion LD (NMBFLS),HL ; Put number of matching files here JR NZ,SOME ; Br if any matches at all (subr set z flag) ; ; LD DE,ERR1 ; No matches- "Input file not found" JP FATAL ; ; PERR3: LD DE,ERR3 ; "too many matching files" (unlikely) JP FATAL ; SOME: LD DE,-MAXFLS ; Maximum #of matching files supported ADD HL,DE ; JP C,PERR3 ; LD HL,FNBUFF ; Init this pointer to 1st matching filename LD (BUFPTR),HL ; (advances as we work on each file) RET ; This completes all the common preliminaries ;______________________________________________________________________________ ; ; Support subroutines for above ;.............................................................................. ; ; Get and process one or two options. The options are the last item in the ; command tail, and must be preceded by a space & slash (ie allow slashes in ; filenames). If found, zero out the slash so it becomes the effective end of ; the command tail before doing the real parsing. ; GTOPTS: LD A,(DDMA) ; Get #of chars in command tail OR A ; None? RET Z ; Return if so LD B,A ; (will be used as loop limiter below) ADD A,DDMA ; Add offset to beg of command tail LD L,A ; Put result in hl, for transfer to ix LD H,0 ; PUSH HL ; POP IX ; LD A,' ' ; Now eliminate trailing blanks BLNKLP: CP (IX) ; JR NZ,LSTCHR ; Br out at last real char DEC IX ; DJNZ BLNKLP ; ("B" still has length of cmnd tail) RET ; LSTCHR: LD A,'/' ; This is what we're looking for CP (IX-1) ; Is next to last char a slash? JR NZ,CHEK2 ; If not, see if char before that is MINISB: LD A,' ' ; (alt entry here from below) SUB (IX-2) ; Is char before that blank? RET NZ ; Forget it LD (IX-1),A ; If so, zero the slash & process option at IX CALL PRCOPT ; SUB A ; Set zero flag RET ; CHEK2: DEC IX ; We will allow any two options CP (IX-1) ; Is char before one before last a slash? RET NZ ; Forget it CALL MINISB ; > use the same block of code abv as a subr RET NZ ; Return if that did nothing INC IX ; CALL PRCOPT ; Else process the 2nd option as well RET ; ;.............................................................................. ; ; Check the validity of the drive & user specified. This routine also a user ; code of "FF", returned by "PARSEFCB" when none is specified, to the actual ; value of the current user area. Called with IX pointing to th FCB in ques- ; tion. ; CHKVLD: PUSH HL ; Don't clobber command line pointer LD A,H ; First check for hl=ffff, the generic error AND L ; - return from PARSEFCB INC A ; JR Z,RETER1 ; Br if that is the case LD A,(IX-1) ; Else get the user# generated by parsefcb CP 0FFH ; (at FCB-1). "FF" means current user JR NZ,NTDEFU ; Br if user is not "default" LD A,(USERNO) ; Else convert "FF" to actual current user# LD (IX-1),A ; And stick it NTDEFU: LD HL,MAXUSR ; Compare user code against "max user +1" CP (HL) ; JR NC,RETER2 ; Br if invalid LD A,(IX+0) ; User# ok, now get the drive spec LD HL,MAXDRV ; CP (HL) ; Compare against max drive+1 POP HL ; Restore command line pointer & rtn if drv ok RET C ; ; LD DE,PRSER3 ; "Invalid Drive" (fatal error) JP FATALU ; ; RETER2: LD DE,PRSER2 ; "Invalid User" (nothing personal..) JP FATALU ; ; RETER1: LD DE,PRSER1 ; "Invalid Argument" (illogical...) JP FATALU ; ;.............................................................................. ; ; This routine analyzes what "PARSEFCB" stopped at. If its the end of the ; command tail, indicate that & rtn. If its a "[...]" stamp, process that and ; return. If its just the end of the (first) filename, indicate that. ; AUX1: LD A,H ; See if "parseu" says tail is done OR L ; (it does that by returning zero) JR Z,RTNDUN ; Rtn w/ carry set if that is the case. LD A,(HL) ; Delim; else beg of blanks foll last filename CP '[' ; "stamp"? JR NZ,NTSTMP ; Br if not CALL PRCSTM ; If so, process stamp & rtn. We are done. RTNDUN: SCF ; Flag that we are done RET ; NTSTMP: INC HL ; Skip past delimiter or 1 blank & rtn AND A ; (indicates 'might not be done') RET ; ;.............................................................................. ; ; Process a single letter option pointed to by IX. ; PRCOPT: LD A,(IX) ; Get the letter AND 0DFH ; Upcase it CP 'Q' ; JR Z,QUIET ; Force quiet mode CP 'V' ; JR Z,NOISY ; Force verbose mode CP 'C' ; JR Z,CONFRM ; Confirm mode LD DE,PRSER4 ; Else option is bad, guy needs help JP FATALU ; QUIET: LD (QUIFM),A ; Stick the 'q' (any non-zero #) in the flag RET ; NOISY: XOR A ; /V forces the quiet flag to the zero state LD (QUIFM),A ; RET ; CONFRM: LD (CNFRFM),A ; /C sets the confirm flag to a non-0 value RET ; ;______________________________________________________________________________ ; PRSER5 EQU $ ; (destination filename supplied) PRSER8 EQU $ ; (stamp buffer overflow) PRSER1 EQU $ ; (error from "parseu") DB 'Invalid argument.$' PRSER2: DB 'Invalid user number.$' ; PRSER3: DB 'Invalid drive.$' ; PRSER4: DB 'Invalid option.$' ; ;------------------------------------------------------------------------------ ; File I/O subroutines: Input ;------------------------------------------------------------------------------ ; Open the input file whose fcb is "INFCB" ; OPNIN: CALL LOGIN ; Log to the input file's user area LD DE,INFCB ; Open an input file LD C,OPEN ; CALL BDOSAV ; INC A ; AND A ; (clr carry for successful return) RET NZ ; Return if successful SCF ; Return, indicating failure RET ; ;.............................................................................. ; ; Open the input file whose fcb is "INFCB" ; CLSIN: CALL LOGIN ; Log to the input file's user area LD DE,INFCB ; LD C,CLOSE ; CALL BDOSAV ; And close it RET ; ;______________________________________________________________________________ ; ; "A" <-- Next byte from ("physical") input stream. ; Returns with carry set on EOF. GETCHR EQU $ GETBYT EQU $ EXX ; Switch to i/o regs LD A,L ; Pointer to next avail char SLA A ; See if 00h or 80h OR A ; (init carry flag [rtn stat] to clear) CALL Z,POSRLD ; "possibly reload" the buffer if 00 or 80H LD A,(HL) ; Get byte to return (garbage if eof) INC HL ; Advance input pointer EXX ; Back to normal regs & rtn RET ; ;................................ ; POSRLD: ; "possibly reload" the input buffer ; I/o regs are active LD A,(SECNT) ; Decr sector count (for this buffer) DEC A ; LD (SECNT),A ; AND A ; (clr carry) CALL Z,RELOAD ; Reload buffer if empty (resets hl) RET C ; (also sets carry if eof is encountered) CALL PROGI ; Incr #of recs read AND A ; Guarantee clr carry if not eof yet RET ; ;.............................................................................. ; ; Reload the input buffer, & reset HL' to point to the beginning of it. As- ; sumes input bfr starts page boundary and is of page multiple length. The ; I/O registers are active. ; RELOAD: PUSH BC ; PUSH DE ; CALL LOGIN ; Log to the input file user area LD B,IBUFSZ ; Loop counter, buffer length in pages LD DE,IBUF ; Beg of buffer LD L,0 ; Will count sectors actually read LD A,(CPM3FL) ; See if multi-sector i/o is desired OR A ; JP NZ,MSECI ; Br if so, else continue w/ conventional RLDLP: LD E,0 ; Lo byte of current dma CALL RDSEC ; Read in 128 bytes (1/2 page) JR NZ,RLDRTN ; (return if eof enecountered) INC L ; Incr "sectors read" count LD E,80H ; To read in the next half page CALL RDSEC ; Do that JR NZ,RLDRTN ; As above INC L ; INC D ; Next page DJNZ RLDLP ; Loop till done RLDRTN: LD A,L ; Put count of sectors read into "secnt" RLDRT2: LD (SECNT),A ; POP DE ; Restore regs POP BC ; AND A ; Return w/ clr carry JR Z,ZEREAD ; Br if #of sectors read was zero LD HL,IBUF ; Reset input pointer to beg of input buffer RET ; Rtn with carry clr (from "and" instr) ZEREAD: SCF ; Set flg indicating no sectors were read (eof) RET ; ;.............................................................................. ; ; Multi sector i/o refill buffer routine. Fills whole buffer at once. ; MSECI: LD C,SETDMA ; De already contains pntr to beg of input bfr CALL BDOSAV ; LD E,IBUFSZ*2 ; Spec multi sector count (secs = 2 x pages) LD C,SETMS ; Bdos func# CALL BDOSAV ; LD DE,INFCB ; Input file fcb LD C,READ ; CALL BDOSAV ; Fill it up! OR A ; Did it fill all the way up? JR NZ,DIDNOT ; Br if it didn't LD A,IBUFSZ*2 ; If it did, then put the full # here & cont. JR RLDRT2 ; (rest is same as above) DIDNOT: LD A,(BDOSHL+1) ; Get the value bdos returned in h (# read) JR RLDRT2 ; (rest is same as above) ;.............................................................................. ; ; Subr for [ non multi-] reload, reads 128 bytes to memory starting at DE ; RDSEC: PUSH DE ; Save de before clobbering it with fcb LD C,SETDMA ; Set dma to val in de CALL BDOSAV ; LD DE,INFCB ; Input fcb LD C,READ ; CALL BDOSAV ; Read a record POP DE ; Restore de to value on entry OR A ; Set zero flag based on error val rtn'd in "a" RET ; & rtn ;------------------------------------------------------------------------------ ; File I/O subroutines: Output ;------------------------------------------------------------------------------ ; Open the output file. Also type an arrow, followed by it's name. ; OPNOUT: CALL LOGOUT ; Log to the output user # LD DE,ARROW ; Print " ---> " LD A,(CPM3FL) ; But use a different arrow for ms i/o OR A ; JR Z,REGARW ; LD DE,ARROW3 ; REGARW: CALL MESAG2 ; (prints w/o a leading cr/lf) LD HL,OUTFCB ; CALL PRNFIL ; Print output filename LD A,(CNFRFM) ; Confirm flag? OR A ; JR Z,NCN ; Br if not LD DE,CNMSG ; Else ask confirmation message CALL MESAG2 ; CALL RSPNSE ; Get answer JR Z,CHK4IT ; If yes, continue JR NOPE ; NCN: LD A,(NPROFM) ; "no prompt" flag set OR A ; JR NZ,ERASIT ; If so, go perf a "blind erase" CHK4IT: LD C,SETDMA ; (re-direct the crap from the below call) LD DE,DDMA ; Def dma is a good unused area CALL BDOSAV ; LD C,SFIRST ; Else see if output filename exists LD DE,OUTFCB ; CALL BDOSAV ; INC A ; Now zero if file does not already exist JR Z,MAKFIL ; If that is the case, just go make the file LD DE,PROMPT ; File exist, prompt the user CALL MESAG2 ; CALL RSPNSE ; Get response JR Z,ERASIT ; Erase it if response is positive NOPE: CALL CRLF ; Extra cr/lf for file skip SCF ; Set flag: "mission not accomplished" RET ; ERASIT: LD A,(QUIFM) ; For aesthetics, must do an extra CRLF if OR A ; - in quiet mode & a prompt was asked JR Z,NOAEST ; (br if not in quiet mode) LD A,(NPROFM) ; OR A ; JR NZ,NOAEST ; Br if no prompt was asked CALL CRLF ; Else do it NOAEST: LD DE,OUTFCB ; Erase existing file w/ same name LD C,ERASE ; CALL BDOSAV ; MAKFIL: LD C,MAKE ; Make the new file CALL BDOSAV ; INC A ; JR NZ,OUTOK ; Err cond check LD DE,ERR2A ; "file open error" JP FATAL ; (this is fatal) OUTOK: AND A ; Guarantee clr carry RET ; ;.............................................................................. ; ; Close the output file whose fcb is "OUTFCB". ; CLSOUT: CALL LOGOUT ; Log to the output file's user area LD DE,OUTFCB ; LD C,CLOSE ; CALL BDOSAV ; And close it RET ; ;______________________________________________________________________________ ; ; Output char in 'A' to the output buffer. ; OUTB: EXX ; Switch to i/o regs PUSH AF ; Save caller's char LD (DE),A ; Put byte into the next avail position INC E ; Increment pointer LD A,E ; See if on a 128 byte boundary SLA A ; JR NZ,RETOUT ; Return if not CALL PROGO ; If so, update output record count JR C,RETOUT ; Return if it wasn't a full page boundary INC D ; Incr pointer high byte LD A,EOBFHI ; Limit CP D ; Check JR NZ,RETOUT ; Ret if limit not reached PUSH BC ; If so, write the output buffer to disk LD B,OBUFSZ*2 ; Number of 128 byte records to write CALL WRTOUT ; Writes out 'b' 128 byte records POP BC ; LD DE,OBUF ; Reset pointer to beginning of bfr & rtn. RETOUT: POP AF ; Restore caller's char, flip regs & rtn EXX ; RET ; ;______________________________________________________________________________ ; ; Write partial or full output buffer to disk. ; The #of records to be written is specified in "B". ; WRTOUT: CALL LOGOUT ; Log to the output file user area LD A,B ; See if zero sectors spec'd OR A ; RET Z ; Simply return if so LD DE,OBUF ; Init dma addr to beg of output bfr LD A,(CPM3FL) ; OR A ; JP NZ,MSECO ; Br for multi-sector output WRTLP: CALL WRSEC ; Write 128 bytes DEC B ; RET Z ; Return if done LD E,80H ; Else incr by 1/2 page CALL WRSEC ; INC D ; Inc hi-byte, 0 the lo to effect LD E,0 ; Another 80h incr DJNZ WRTLP ; Loop till done RET ; ;.............................................................................. ; MSECO: LD C,SETDMA ; De already points to the output buffer CALL BDOSAV ; LD E,B ; Put #of secs to write here, still in b LD C,SETMS ; Bdos func# CALL BDOSAV ; LD DE,OUTFCB ; Output file fcb LD C,WRITE ; Bdos func# CALL BDOSAV ; Write out the whole buffer OR A ; RET Z ; Ret if no error, else fall thru to ; "wrterr" below & then thru to "fatal" ;.............................................................................. ; WRTERR: CP 2 ; Disk full? JR NZ,NOTFUL ; LD DE,ERR2B ; "disk full." JP FATAL ; NOTFUL: LD DE,ERR2C ; "output error." (generic failure message) JP FATAL ; ;.............................................................................. ; ; Aux subr for above. Writes 128 bytes from current val of DE. ; WRSEC: LD C,SETDMA ; Set dma as spec'd CALL BDOSAV ; PUSH DE ; Save that val LD DE,OUTFCB ; Spec the output file LD C,WRITE ; CALL BDOSAV ; Do it OR A ; POP DE ; Restore to same value as before RET Z ; Rtn, assuming no error JR WRTERR ; ;______________________________________________________________________________ ; ; Output the partial output buffer thru the current pointer (DE'). If not on ; a sector boundary, fill the remainder with "1A"'s. Close files & see if ; there are any more of them. ; DONE: EXX ; Determine where nearest record boundary is LD A,E ; Get low byte of output pointer EXX ; CPL ; Compute how far to next page boundary INC A ; AND 7FH ; Convert to distance to next half-page bndry JR Z,ONBNDY ; If there already (should be the case on uncr) LD B,A ; Else set up to fill rest of sector w/ eof's LD A,1AH ; FILLP: CALL OUTB ; Do that DJNZ FILLP ; ONBNDY: EXX ; Compute #of sectors to write to disk EX DE,HL ; Put output pointer in hl LD BC,OBUF ; (ok to clobber bc' now, uncr is done w/ it) AND A ; (clr carry) SBC HL,BC ; How far into the buffer we are SLA L ; Effectively divide difference by 128 RL H ; LD B,H ; "b" now has #of recs to be written CALL WRTOUT ; Do that CALL PROGI2 ; Output the final count CALL PROGF ; Last pass: print values in "k" also EXX ; RET ; ;------------------------------------------------------------------------------ ; File I/O subroutines: Input and/or Output ;------------------------------------------------------------------------------ ; "Log" to the input, output, or the default user area. LOGDEF: PUSH BC ; PUSH DE ; LD A,(USERNO) ; Log to the original user area, if necessary JR LOGX ; LOGOUT: PUSH BC ; PUSH DE ; LD A,(OUTUSR) ; Log to the output user area, if necessary JR LOGX ; LOGIN: PUSH BC ; PUSH DE ; LD A,(INUSR) ; Log to the input user area, if necessary LOGX: LD E,A ; Common code for either of above LD A,(CURUSR) ; CP E ; JR Z,SKIPU ; Filter out unnecessary user# changes LD A,E ; Back to "A" for updating "curusr" LD (CURUSR),A ; Do that LD C,GSUSER ; Now actually change user #'s CALL BDOSAV ; SKIPU: POP DE ; POP BC ; RET ; ;______________________________________________________________________________ ; ; Get the current (called on program entry) user#. Put it in "USERNO". ; Get the default drive and put its adjusted value in "DEFDRV" ; GETUSR: PUSH BC ; PUSH DE ; LD C,GSUSER ; LD E,0FFH ; Spec "get" as opposed to "set" CALL BDOSAV ; LD (USERNO),A ; Put that there LD C,GETDSK ; Get current disk function CALL BDOSAV ; INC A ; Adjust so it is normal (ie a=1, not zero) LD (DEFDRV),A ; Put that there POP DE ; POP BC ; RET ; ;______________________________________________________________________________ ; ; Advance to the next file in the wildcard expansion filename list. ; SKIPIT: LD A,(QUIFM) ; One less cr/lf desirable in quiet mode OR A ; JR NZ,NNCRLF ; CALL CRLF ; When done, advance console cursor to newline NNCRLF: LD HL,(NMBFLS) ; #of files left to do DEC HL ; Done with that one! LD (NMBFLS),HL ; LD A,H ; OR L ; RET ; Rtn w/ non-0 status if still more files ;______________________________________________________________________________ ; ; Add the value in A to the current running checksum. Regular regs active. ; CKSUM: LD HL,(CHKSUM) ; Get current checksum LD C,A ; LD B,0 ; New val in bc ADD HL,BC ; Add to running checksum LD (CHKSUM),HL ; And save RET ; Return w/ a still intact ;______________________________________________________________________________ ; ; Initialize the FCB pointed to by DE. Leave the drive spec alone. ; CLRFCB: PUSH DE ; Save caller's pointer to fcb INC DE ; Skip past drive spec LD B,11 ; #of blanks for filename area LD A,' ' ; A blank, obviously ZLP1: LD (DE),A ; Put in the blanks INC DE ; DJNZ ZLP1 ; LD B,24 ; #of zeroes for the rest XOR A ; A zero, obviously ZLP2: LD (DE),A ; Put those in INC DE ; DJNZ ZLP2 ; POP DE ; Restore pointer to fcb and rtn RET ; ;------------------------------------------------------------------------------ ; Misc. subroutines ;------------------------------------------------------------------------------ ; RSPNSE: LD C,CONIN ; --- get a user y/n response --- CALL BDOSAV ; Wait for response LD C,A ; Put that there for a sec LD A,' ' ; CALL TYPE ; LD A,C ; Ok... CP CTRLC ; ^c ? JR NZ,NCTRLC ; Br if not LD DE,ABORT ; JP FATAL ; NCTRLC: CP 'Y' ; RET Z ; CP 'y' ; RET ; Rtns zero response if guy answered "Yes" ;______________________________________________________________________________ DIVIDE: ; 4 x 2 divide- hlde / bc for result in de ; (remainder in hl) LD A,B ; } CPL ; } LD B,A ; } LD A,C ; } negate divisor in bc CPL ; } LD C,A ; } INC BC ; } DV10: LD A,11H ; Iterations, 17 req. to get all the de bits JR UM1 UM0: ADC HL,HL UM1: ADD HL,BC ; Divide hlde by -bc JR C,UM2 ; If it fit SBC HL,BC ; Else restore it OR A ; Make sure carry is 0 UM2: RL E ; Result bit to de RL D DEC A JR NZ,UM0 ; Continue RET ;______________________________________________________________________________ ; DIV10: EX DE,HL ; Divide 16 bit val in hl by 10 LD HL,0 ; Zero the lo byte LD BC,-10 ; We can skip the negation code JR DV10 ; ;______________________________________________________________________________ ; ; Bdos call with all registers and alternates saved except "A" ; BDOSAV: EX AF,AF' PUSH AF EX AF,AF' PUSH BC PUSH DE PUSH HL EXX PUSH BC PUSH DE PUSH HL PUSH IX PUSH IY EXX CALL BDOS LD (BDOSHL),HL ; Some routines may want to analyze hl EXX POP IY POP IX POP HL POP DE POP BC EXX POP HL POP DE POP BC EX AF,AF' POP AF EX AF,AF' RET ;______________________________________________________________________________ ; ; Type the string pointed to by DE to the console. ; MESAGE: CALL CRLF ; Precede all messages with cr, lf MESAG2: PUSH BC ; (entry here for no cr/lf) LD C,PRTSTR ; Print string CALL BDOSAV ; POP BC ; RET ; ;______________________________________________________________________________ ; ; Non-Z80 fatal error special "emergency exit". This routine to be JUMPED to. ; MESS80: LD C,PRTSTR ; Can't use "MESAGE" beause can't use "BDOSAV" CALL BDOS ; RET ; Rtn to CCP. (OS's stack still intact) ;______________________________________________________________________________ ; ; Print a carriage return / linefeed sequence. ; CRLF: LD A,CR ; CALL TYPE ; LD A,LF ; CALL TYPE ; RET ; ;______________________________________________________________________________ ; ; Type the character in A to the console device. Saves all regs. ; TYPE: PUSH AF ; PUSH BC ; PUSH DE ; LD E,A ; Where bdos wants it LD C,CONOUT ; Bdos "console output" function CALL BDOSAV ; Do it POP DE ; POP BC ; POP AF ; RET ; ;______________________________________________________________________________ ; ; Print fatal error messages. Jump to this routine- not a call! ; FATALU: CALL MESAGE ; Entry here if usage instructions desired. GIVUSG: LD DE,USAGE ; FATAL: CALL MESAGE ; Print any final message. RETCCP: CALL LOGDEF ; Restore user number from original prog entry LD SP,(OLDSTK) ; Restore to system stack LD A,(WRMFLG) ; Warm boot flag set? OR A ; JP NZ,0000 ; If so, perf a warm boot RET ; Else return to system ccp ;______________________________________________________________________________ ; ; Print the filename whose FCB is pointed to by HL. Aligned filename printout ; due to J. Sage. ; PRNFIL: DEC HL ; Slide back to user# at fcb-1 LD B,(HL) ; Put that here for now INC HL ; Back to drive spec LD A,(HL) ; Get drive spec INC HL ; Move to 1st char of filename OR A ; Drive = default? JR NZ,NOTDEF ; Br if not LD A,(DEFDRV) ; If so, get the default drive NOTDEF: ADD A,'A'-1 ; Convert to a letter CALL TYPE ; LD C,11+2 ; Total spaces to fill for fn and ft + 1 ; (will be used later) LD A,B ; Get user# we picked up above CP 10 ; 2 digits? JR C,ONEDIG ; Br if not PUSH AF ; LD A,'1' ; Type the '1' CALL TYPE ; POP AF ; DEC C ; Adjust #of spaces typed by one SUB 10 ; ONEDIG: ADD A,'0' ; Ascii conversion CALL TYPE ; Type the other (or only) digit LD A,':' ; Follow drive spec with a ":" CALL TYPE ; LD B,8+1 ; Max chars in file name plus 1 CALL PRNFNT ; Print file name LD A,'.' ; Print dot CALL TYPE LD B,3+1 ; Max chars in file type plus 1 CALL PRNFNT ; Print file type PRNSP: LD A,' ' ; Fill out with spaces DEC C ; RET Z ; CALL TYPE ; JR PRNSP ; ;................................ ; PRNFNT: DEC B ; Aux routine for abv; print file name or type RET Z ; Reyurn if no more LD A,(HL) ; Else get character INC HL ; Point to next character CP ' ' ; Is it a space? JR Z,PRNFNT ; If so, loop back for more DEC C ; Else, decrement count of printed chars CALL TYPE ; Print the character JR PRNFNT ; Back for more ;______________________________________________________________________________ ; ; Wildcard expansion. HL points to the filename buffer, & DE to the FCB. On ; exit, HL will have the #of files, whose names are spaced 16 bytes apart in ; the filename buffer (note names start at buffer +1, +17, etc.). ; WILDEX: ; After S. Kluger PUSH DE ; Save pointer to fcb to be expanded LD DE,DDMA ; Explicitly set the dma to 80h LD C,SETDMA ; CALL BDOSAV ; POP DE ; Restore fcb LD HL,FNBUFF ; Beginning of filename expansion buffer LD (BUFPTR),HL ; Init pointer to that LD HL,0 ; LD (COUNT),HL ; Init count to zero LD C,SFIRST ; CALL BDOSAV ; Bdos "Search for first" call CP 0FFH ; RET Z ; Nothing found -- error CALL MOVEN ; Else move first name to buffer WLOOP: LD C,SNEXT ; "search for next" CALL BDOSAV ; CP 0FFH ; JR Z,DONEW ; Finished CALL MOVEN ; Move another name in JR WLOOP ; Loop for rest of files DONEW: OR A LD HL,(COUNT) RET MOVEN: PUSH DE ; Aux routine for above LD HL,(BUFPTR) ADD A,A ADD A,A ADD A,A ADD A,A ADD A,A ADD A,80H LD C,A LD B,0 LD D,16 ; Move 16 chars MOVLP: LD A,(BC) LD (HL),A INC HL INC BC DEC D JR NZ,MOVLP LD (BUFPTR),HL POP DE LD HL,(COUNT) INC HL LD (COUNT),HL RET ;______________________________________________________________________________ ; ; Update the running count of #of records output (add one to it). ; PROGO: PUSH AF ; Save everything PUSH BC ; PUSH HL ; LD HL,(OUTCTR) ; Update binary count INC HL ; LD (OUTCTR),HL ; LD HL,PROGBF+11 ; Point to ascii string version of count CALL BCDINC ; Incr that, too POP HL ; Restore regs & return POP BC ; POP AF ; RET ; ;.............................................................................. ; ; Update #of records read on input. Every 2 or 4 calls to this routine, ac- ; tually update the display. ; PROGI: PUSH AF ; Save everything PUSH BC ; PUSH HL ; PUSH DE ; LD C,DIRCON ; LD E,0FFH ; See if a char is avail; if it is, get it CALL BDOSAV ; POP DE ; OR A ; Return code from bdos- zero if no char JR Z,CONTIN ; If not, continue CP CTRLC ; ^c? JR NZ,CONTIN ; Continue if not LD DE,ABORT ; Else abort JP FATAL ; CONTIN: LD A,(INCTR+0) ; Mask ls bits to determine whether this call DEC A ; - is an 'active' one (updates the console) LD L,A ; Put that there for a sec LD A,(UFLAG2) ; 03H for UNCR, 07H for CRUNCH AND L ; LD L,A ; Once again, put that there for a sec LD A,(QUIFM) ; Flag disables all verbiage OR L ; (both must be zero for a printout) CALL Z,PRNFIN ; If zero, actually do a printout LD HL,(INCTR) ; In any event, perform the increments INC HL ; First, incrment the binary version LD (INCTR),HL ; LD HL,PROGBF+5 ; Increment ascii string representing same CALL BCDINC ; POP HL ; Restore regs & rtn POP BC ; POP AF ; RET ; ;.............................................................................. ; ; Routine like "PROGI" above, but does NOT increment and WILL update the ; console on any call. Basically used as a final screen update. ; PROGI2: PUSH AF ; LD A,(QUIFM) ; Still, don't type if in "quiet" mode OR A ; JR NZ,QUIET2 ; PUSH BC ; Else print up the final tally PUSH HL ; CALL PRNFIN ; POP HL ; POP BC ; QUIET2: POP AF ; RET ; ;______________________________________________________________________________ ; PRNFIN: PUSH DE ; Update the console display... PUSH IX ; LD DE,PROGBF ; This buffer contains most of the stuff, CALL MESAG2 ; - ready to be typed LD DE,(OUTCTR) ; Compression ratio must be computed, however PUSH DE ; POP IX ; Get #of output recs into ix LD HL,(INCTR) ; Spec the divisor for the subroutine call LD (DIVISR),HL ; CALL COMRAT ; Compute ratio. result, in %, returned in hl LD A,' ' ; Need an extra space here to make it look good CALL TYPE ; CALL DECOUT ; Type to screen in decimal LD DE,PERCNT ; A "%" char, basicly CALL MESAG2 ; Type that LD A,(OLDFLG) ; Skip rest for old style (v1.x) files OR A ; JR NZ,SKIPW ; LD HL,(ENTRY) ; Type "Codes Assigned" to the screen LD A,(UFLAG) ; Fudge factor analysis OR A ; JR Z,NOFUD ; DEC HL ; Adjust for a 2 count "skew" due to DEC HL ; - inherent nature of UNCR to be "behind" NOFUD: CALL DECOUT ; LD A,' ' ; Some more aesthetics CALL TYPE ; CALL TYPE ; LD HL,(TTOTAL) ; Get "Codes Reassigned" CALL DECOUT ; Type that value LD A,(FULFLG) ; Below analysis only used by "crunch" only LD L,A ; LD A,(UFLAG) ; Conceivably speed things up a little? AND L ; (by skipping if not full or not crunching) JR Z,SKIPW ; ; "Incremental compression ratio" computation. For analysis of the possibil- ; ity of setting the adaptive reset flag, compute the compression ratio since ; the last reset (not necessarily the beginning of the file). This is sig- ; nificantly preferable to analyzing the ratio since the beginning (the one ; displayed on the console) because that number gets very "stable" as one ; gets further & further into a large file. Sudden structural variations will ; not get picked up quickly that way. ; INCTR0 and OUTCT0 contain the #of records at the time of the last reset (or ; zero). The offset from them (to the current values) are the numbers divided ; to compute the ratio. LD HL,(INCTR) ; As described above LD DE,(INCTR0) ; AND A ; SBC HL,DE ; LD (DIVISR),HL ; Adjusted input rec count will be the divisor LD HL,(OUTCTR) ; LD DE,(OUTCT0) ; AND A ; SBC HL,DE ; Adjusted output record count is dividend EX DE,HL ; PUSH DE ; POP IX ; Put it in IX for the subR call CALL COMRAT ; Returns a compression ration in "HL" ; The criteria for adaptive reset is when the current "incremental" ratio ; goes "up". "Up" is defined as higher the limit, which is equal to the low- ; est incremental ratio achieved so far (not necessarily the last computed ; ratio). ["So far" means since the last adaptive reset, if any.] ; Computations below are single byte precision. If the "compression" ratio ; (during crunching) actually ever got higher than 256%, then this analysis ; is really quite irrelevant.. that would really be a lost cause... LD A,(LOWPER) ; Get "target" value SUB L ; Compare to current JR C,CHK4RS ; If current is higher, reset may be indicated LD A,L ; If new ratio is lower, it is the new target LD (LOWPER),A ; JR SKIPW ; That's all ; If new value is higher, a reset may be indicated. The exact criteria is ; that the value be one full percentage point, besides the +/- 1 normal ; roundoff wavering, above the target value. CHK4RS: INC A ; Adjust the difference computed by one JP P,SKIPW ; If that is not negative, no reset now LD A,80H ; Else set the adaptive reset flag. Full LD (RSTFLG),A ; - processing occurs back at the main loop PUSH HL ; However, take care of updating these now LD HL,(INCTR) ; Inctr0 <-- inctr LD (INCTR0),HL ; LD HL,(OUTCTR) ; Outct0 <-- outctr LD (OUTCT0),HL ; POP HL ; SKIPW: POP IX ; Restore regs and return POP DE ; RET ;______________________________________________________________________________ ; ; Compute a compression ratio, in percent. Calculates IX / ("divisr"). When ; called, DE must have a a copy of the dividend as well as IX. ; COMRAT: LD HL,0 ; Prepare for 32 bit multiply by 100 LD B,H ; [ ratio = (100 * out) / in ] LD C,L ; ADD IX,IX ADC HL,HL ; 2x ADD IX,DE ADC HL,BC ; 3x ADD IX,IX ADC HL,HL ; 6x ADD IX,IX ADC HL,HL ; 12x ADD IX,IX ADC HL,HL ; 24x ADD IX,DE ADC HL,BC ; 25x ADD IX,IX ADC HL,HL ; 50x ADD IX,IX ADC HL,HL ; 100x ADD IX,IX ADC HL,HL ; 200x PUSH IX ; Get result into hl de for dividing POP DE ; LD BC,(DIVISR) ; Get divisor CALL DIVIDE ; Divides (hl de) / bc EX DE,HL ; Put result into hl SRL H ; Divide it by 2 RR L ; RET NC ; & return if no need to round up INC HL ; Else round up RET ;.............................................................................. ; ; Increment a 4 character ASCII unpacked BCD string, pointed to by HL. ; BCDINC: LD B,4 ; Loop counter DIGLP: LD A,(HL) ; Hl points to string OR 10H ; Blank to zero conversion (init'd to blank) INC A ; Incr LD (HL),A ; Re-store CP '9'+1 ; Carry? RET NZ ; Rtn if not LD (HL),'0' ; Else zero & loop to next char DEC HL ; DJNZ DIGLP ; (but not past limit) RET ; & rtn ;______________________________________________________________________________ ; ; Convert records to "k" and print same. Called at end of process. ; PROGF: PUSH DE ; Save regs PUSH BC ; ; LD DE,SPCPAR ; Spaces, parenthesis CALL MESAG2 ; LD HL,(INCTR) ; Input recs CALL AUXSUB ; Div by 8 and type LD DE,ARROW2 ; " --->" CALL MESAG2 ; LD A,' ' ; CALL TYPE ; LD HL,(OUTCTR) ; Similarly for output recs CALL AUXSUB ; LD A,')' ; CALL TYPE ; CALL CRLF ; POP BC ; Restore & rtn POP DE ; RET ; ;................................ ; Aux routine for above calculates (HL)/8 AUXSUB: LD DE,7 ; With upward rounding, & types it. ADD HL,DE ; [ie compute (#recs+7) / 8 ] SRL H ; } RR L ; } SRL H ; } div by 8 RR L ; } SRL H ; } RR L ; } CALL DECOUT ; Type hl in decimal LD A,'k' ; CALL TYPE ; RET ; ;______________________________________________________________________________ ; ; Convert a binary number to four chars ASCII & type them, right justified. ; DECOUT: CALL DIV10 ; Divide orig # (in hl), by 10 LD A,L ; Get remainder from l, (0-9) PUSH AF ; Save in reverse order retrieval later EX DE,HL ; Old dividend becomes new divisor CALL DIV10 ; Repeat 3 more times LD A,L ; PUSH AF ; EX DE,HL ; CALL DIV10 ; LD A,L ; PUSH AF ; EX DE,HL ; CALL DIV10 ; LD A,L ; PUSH AF ; EX DE,HL ; LD B,3 ; Becomes loop counter LD C,0EFH ; Mask to convert zeroes to blanks DECLP: POP AF ; Type the 4 digits, with leading 0 suppression OR A ; Is it zero? JR Z,LVMASK ; Lv mask set if so LD C,0FFH ; Else cancel masking (of zeroes to blanks) LVMASK: ADD A,'0' ; Convert to ascii AND C ; Possibly blank a zero CALL TYPE ; Output the char DJNZ DECLP ; Do the first 3 digits POP AF ; Last digit is easy. Never blank it. ADD A,'0' ; Convert to ACSII CALL TYPE ; Type it & rtn RET ;______________________________________________________________________________ ; ; (Re-)initialize all necessary ram locs. Called once for each file to be ; processed. This routine gets its info from an initialization block called ; "SHADOW", which is copied into the working memory. Routine also performs ; alternate register initialization. ; INTRAM: LD HL,SHADOW ; Contains a copy of all relevant init values LD DE,RAM ; Target LD BC,EOSHAD-SHADOW LDIR ; Do it EXX ; Routine performs register initialization too LD HL,IBUF ; Reset input buffer pointer LD DE,OBUF ; Reset output buffer pointer LD BC,0 ; Zero this EXX ; Back to primary registers RET ; ;------------------------------------------------------------------------------ ; Text, data, etc. ;------------------------------------------------------------------------------ ;______________________________________________________________________________ ; CNMSG: DEFB ' Do it? ','$' ABORT: DEFB '^C detected.$' PROMPT: DEFB ' Overwrite existing file? ',BELL,'$' HEADNG: DEFB ' in out rat ca cr',CR,LF ; (cont) DEFB ' ==== ==== ==== ==== ====',CR,LF,'$' ;______________________________________________________________________________ ; SHADOW EQU $ ; (for description, see immediately below) ; DB 00 ; "fulflg" DW 0000 ; "chksum" DB 01 ; "secnt" DW 0000 ; "inctr" DW 0000 ; "outctr" DW 0000 ; "inctr0" DW 0000 ; "outct0" DW 0000H ; "entry" DB 09 ; "codlen" DB 02H ; "trgmsk" DB 09H ; "codle0" DB 00H ; "rstflg" DW 0000H ; "ttotal" DB 0FFH ; "lowper" DW NOPRED ; "lastpr" DB 01H ; "entflg" DB 00H ; "oldflg" DB CR,' 0 / 0$' ; "progbf" EOSHAD EQU $ ;______________________________________________________________________________ DSEG ; The following ram locs must be re-initialized each time the program is ; executed (for each file when wildcards are used). The area called "SHADOW" ; above is used to accomplish this. RAM EQU $ FULFLG: DS 1 ; Becomes "FF" when table is full CHKSUM: DS 2 ; Checksum accumulated here SECNT: DS 1 ; Count of sectors read per "reload" call INCTR: DS 2 ; Count of total sectors read from input OUTCTR: DS 2 ; Likewise for output INCTR0: DS 2 ; Value of "inctr" at last reset OUTCT0: DS 2 ; Value of "outctr" at last reset ENTRY: DS 2 ; Current entry (code) number. CODLEN: DS 1 ; Current code length, in bits. TRGMSK: DS 1 ; Mask contains "1" bit in pos of next code len CODLE0: DS 1 ; "Delayed" value of "CODLEN" RSTFLG: DS 1 ; Will cause an adaptive reset when set TTOTAL: DS 2 ; "codes reassigned" (for display purposes) LOWPER: DS 1 ; Lowest incremental compr. ratio achieved LASTPR: DS 2 ; "Last pred" ENTFLG: DS 1 ; Flag prevents duplicating entries OLDFLG: DS 1 ; PROGBF: DS 20 ; Alphanumeric ASCII to go to console ;.............................................................................. INUSR: DS 1 ; MUST immediately precede the input FCB INFCB: DS 36 ; Input file FCB. OUTUSR: DS 1 ; MUST immediately precede the output FCB OUTFCB: DS 36 ; Output FCB ;.............................................................................. ; ; The flags below are analogous to some of patches at the beginning of the ; program. Those default values are copied into the data area here each prog- ; ram execution, since some can be changed if an appropriate command line ; option is processed. This keeps the prgrm re-executable. QUIFM: DS 1 ; Verbose mode flag NPROFM: DS 1 ; No prompt before overwrite flag NOMSFM: DS 1 ; Defeat multi-sector i/o flag CNFRFM: DS 1 ; Confirm every file flag ;______________________________________________________________________________