;************************************************************************ ;* * ;* LDIR-B * ;* v1.00 17 Oct 1987 * ;* * ;************************************************************************ ; ; +-----------------------------------------------------------------------+ ; | ==> This is the exact source code used to create LDIR-B v1.0. The COM | ; | file, as well as appropriate documentation, can be found in | ; | LDIR-B.LBR. The source is to be included in future releases | ; | of LDIR-B.LBR. | ; +-----------------------------------------------------------------------+ ; ; Placed into the public domain by Steven G. Greenberg. ; Responsible updates encouraged, please document below. ; ;---------------------------------------------------------------------------- ; Update History ;---------------------------------------------------------------------------- ;............................................................................ ; ; v1.40 July 1, 1988 Michal Carson ; ; Added display of datestamps for the library itself. Corrected one bug ; with interpretation of crunched-file datestamp headers; 0ffh was not ; being converted back into 00h. This caused trash to be displayed in ; the guise of a datestamp, specifically "FF ore] FF". Look familiar? ; No? Oh, well. Re-arranged pfname routine to downcase letters of a ; filename which have high bits set; these should not be appearing in ; libraries and if they do appear, we certainly want to be aware of them. ; Extchr has been replace by crflag which will contain 0ffh if the file ; is crunched; this serves the same purpose as storing the middle letter ; of the file extension in extchr. Changed method of determining a file's ; compression; the first sector of each file is now read and the first ; two bytes examined for crunched or squeezed headers. This will add very ; little to the execution time given that crunching is very common now ; and we would read a sector of any crunched file anyway. Uncommented ; code to do warm boot on exit according to byte at 111h; not zero ; (0ffh) exits with warm boot. ; ;............................................................................ ; ; v1.30 May 28, 1988 Michal Carson ; ; Added support for Modification date. Changes to display--eliminated ; CRC to make room; my apologies to anyone for whom the CRC display ; held great significance. LINLEN lost two more characters (now 19). ; Version 1.20 was not available; I have seen only a com file. ; ;............................................................................ ; ; v1.10 November 5, 1987 Bruce Morgen ; ; Added minimalist ZCPR3 support. If the program is installed via ; Z3INS or Z-RIP (or auto-installed at run-time by ZCPR 3.3+ or by ; BGii 1.13+), LDIR-B will get the wheel byte address and CRT length ; from the ZCPR3 environment and will log into the user area parsed ; into DFCB+13 by the CPR. This revision necessarily moves the ; configuration bytes up by eight bytes; it also uses the extra byte ; at "SPARE:" as the MSB of the wheel byte address and no longer ; assumes that the wheel byte is on page 0 (commercial ZCPR3 ; implementations tend to follow the "Echelon Standard" memory map, ; established by Joe Wright, which puts the wheel byte up at FDFFh). ; LDIR-B now displays filesizes in records as well as kbytes. The ; record count is more easily related to the file transfer progress ; displays of IMP and MEX, and with the DECOUT routine already ; available, why not? Reduced "LINLEN" to 21 and revised "HEDING:" ; format to accomodate the record count inclusion. LDIR-B now accepts ; the second token on the incoming command line as an optional ; wildcard filespec for selecting the library member files to be ; shown. If present, this selection is displayed following the ; library's name in the "( --> filename.typ)" format. The rather ; silly 1023-member restriction is also removed through the simple ; expedient of using a 16-bit value at "DIRLEN:" and adding a little ; extra code to handle the bigger numbers. Fixed bug handling LBRs ; with no member files, same code handles a no-match situation with ; the user-supplied wildcard. ; ;............................................................................ ; ; v1.00 18 Oct 87 Steven Greenberg ; ; For additional system security, will ignore LBR files with SYS ; attribute set if wheel byte is zero. The wheel byte location is ; defined by the byte at 105H and defaults to 3EH. ; (prevents snooping around sys COM files on systems using a COMMAND.LBR) ; ; Checks for console characters- aborts on ^K,K,k ^X,X,x or ^C,C,c, ; pauses on ^S. Added line counter which issues "[more]" prompt ; after 22 lines (byte at 104H). Typing a space at any time sets ; line counter to one for "line by line" advance. ; ; LUXX77A revised to LUX77B by Irv Hoff now includes and automat- ; ically supports this program. ; ;............................................................................ ; ; v0.91 08 Oct 87 Steven Greenberg ; ; Beta release. ; ;============================================================================ ; ; .Z80 ; ASEG ORG 100H ; ; LINLEN EQU 19 ; Max # of "comment" characters ; ; --- ASCII equates --- ; CTRLC EQU 03H ; ^C LF EQU 0AH ; Linefeed CR EQU 0DH ; Carriage return ; ; --- CP/M address equates --- ; DFCB EQU 5CH ; Default file control block #1 FCB2 EQU 6CH ; Default file control block #2 DDMA EQU 80H ; Default dma address BDOS EQU 0005H ; Bdos entrypoint ; ; --- BDOS function equates --- ; CONIN EQU 1 ; Console input (single char) CONOUT EQU 2 ; Output single char to console PRTSTR EQU 9 ; Print string to console CONST EQU 11 ; Get console status OPEN EQU 15 ; Open file CLOSE EQU 16 ; Close file READ EQU 20 ; Read file (sequential) SETDMA EQU 26 ; Set dma address GSUSER EQU 32 ; Get/set user code RDRND EQU 33 ; Read random ;---------------------------------------------------------------------------- ; ENTRY: JP START DB 'Z3ENV',1 Z3EADR: DW 00 ; Set by CPR or the Z3INS utility if Z3 ; WBFLAG: DB 0 ; Warm boot flag. Non-zero if warm boot req'd. NLN: DB 22 ; #of lines before [more] prompt. Usually 22. WHLLOC: DB 3EH ; Wheel byte location. ("3EH" = 003EH). SPARE: DB 0 ; Spare. (now used - b/m) ; ; START: LD (OLDSTK),SP ; Save system stack pointer LD SP,STACK ; Set to local area LD HL,(Z3EADR) ; Get possible Z3 environment pointer LD A,L OR H JR Z,NOTZ3 ; If (Z3EADR) = 0000H, assume non-Z3 LD A,(DFCB+2) CP '/' JP Z,GIVUSG LD A,(DFCB+13) ; Otherwise, get CCP-parsed user # LD E,A ; Log in via BDOS function #32 LD C,GSUSER CALL BDOSAV ; HL is preserved at BDOSAV LD DE,29H ; Offset to wheel address in DE ADD HL,DE ; Add it to environment address LD E,(HL) ; LSB in E INC HL ; Bump pointer LD D,(HL) ; MSB in D LD (WHLLOC),DE ; Poke into LDIR-B LD DE,6 ; Offset to CRT selection ADD HL,DE ; Add it in LD E,3 ; D=0, so DE=0003h LD A,(HL) ; Get selected CRT # in A OR A ; Test for zero JR Z,CRT0 ; If CRT #0, just 3 bumps ADD HL,DE ; Otherwise 6 bumps CRT0: ADD HL,DE LD A,(HL) ; Get "usable" CRT lines LD (NLN),A ; Poke into LDIR-B NOTZ3: LD A,(DFCB+1) ; Any argument supplied? CP ' ' JP Z,GIVUSG ; If not, give usage ; LD A,(BDOS+2) ; Subtract 2k+ (for CCP) from available TPA SUB 11 ; - and save for later check LD (OVFTPA),A LD A,(NLN) ; Init screen line counter (decrements to 0) LD (LINCTR),A LD HL,'RB' ; Last 2 letters of "LBR" (backwords) LD (DFCB+10),HL ; Put at fcb+10, +11 LD A,'L' ; Similarly LD (DFCB+9),A ; Now we have a forced "LBR" extension. LD HL,FCB2+1 ; Put possible user wildcard LD DE,WLDFCB ; filespec into a safe buffer LD BC,11 LDIR LD DE,DFCB+12 ; Make sure fcb is clr except filename & drive LD B,24 ; # of zeroes for the rest XOR A ; A zero, obviously ; ZLP2: LD (DE),A ; Put those in INC DE DJNZ ZLP2 ; LD HL,0 ; Init "#of files" counter to zero LD (NFILES),HL LD DE,DFCB ; Open the library file LD C,OPEN CALL BDOSAV INC A JP Z,NOSUCH ; Br to error message if no such file ; LD A,(DFCB+10) ; Check if file has SYS attribute AND 80H JR Z,NONSYS ; If not, it's OK LD HL,(WHLLOC) ; Else we must check if wheel byte is set LD A,(HL) ; Get the wheel byte itself OR A JP Z,NOSUCH ; If zero, pretend the file does not exist ; NONSYS: LD C,SETDMA ; Make sure the default DMA is 80H LD DE,DDMA CALL BDOSAV CALL CRLF ; Type a CR/LF sequence to the screen LD DE,LBRNAM ; Followed by "Library File =" CALL MESAGE LD HL,DFCB+1 ; Point to the LBR's filename CALL PFNAME ; Routine types the specified filename LD A,(WLDFCB) ; Has user specified a wildcard? SUB ' ' JR Z,NOWILD ; If not, finished with display CALL BLANK3 ; Otherwise print three blanks LD DE,FNMSG ; Point at "( --> " CALL MESAGE ; Print it LD HL,WLDFCB ; Point at wildcard CALL PFNAME ; Type it out as filename.typ LD A,')' ; Close parens CALL TYPE CALL CRLF NOWILD: CALL READ1 ; Read the library's 1st record LD HL,DDMA ; Point to first byte LD A,(HL) ; Validity check- the dirctory entry for the ; OR A ; - directory itself must be "active" (zero) ; JP NZ,CORUPT ; Else the library is corrupt ; ; We would normally check for eleven blank characters next (the filename area ; of the directory entry for the directory itself. We will skip this validity ; check, however, because some MS-DOS library programs actually insert the ; library's name here. Skipping the check insures compatibility. ; LD HL,DDMA+12 ; More validity checking: OR (HL) ; The library's "index" must be zero INC HL ; If index(lo) >0, lbr is corrupt OR (HL) JP NZ,CORUPT ; Likewise for index(hi) LD (crflag),A ; Zero out this flag for next routine INC HL LD A,(HL) ; Get length of directory(lo) INC HL LD H,(HL) ; Get length of directory(hi) LD L,A ; Full directory length in HL OR H JP Z,CORUPT ; 0-length LBR directory is corrupt LD (DIRLEN),HL ; It's big enough, store it ; Satisfied that the file is in fact a library, we extract the bytes ; which should contain its creation and last modification dates and ; display these for the user's edification. LD DE,NOMSG ; Breathing room CALL MESAGE LD HL,(DDMA+18) ; Get creation date of lbr file CALL DATE ; Print a date if it's good JR C,TRYMOD ; No creation date try last mod LD DE,CREMSG ; Extchr cleared--will not look for stamp CALL MESAGE ; 'Cre ' CALL SHODATE ; Display the result of "date" TRYMOD: LD HL,(DDMA+20) ; Get last mod date of lbr file CALL DATE JR C,NOMOD ; No mod date LD DE,MODMSG ; 'Mod ' CALL MESAGE CALL SHODATE NOMOD: CALL CRLF ; Now do a new line ; ; Program operation: We will read the entire lbr directory into memory in one ; shot, avoiding having to go back to it later as we are reading the first ; record of various member files (should minimize head movement and maximize ; speed). Only the 21 bytes of interest out of the 32 will be saved for each ; entry, however, and entries flagged as deleted or non-existant will be ; skipped. ; LD DE,DIRBUF ; Dir data will be packed to mem starting here JR SKIP1 ; Jump into loop (only 3 entries first record) ; ;............................................................................ ; MAINLP: LD HL,DDMA+00 ; 1st entry per record CALL ACTIVQ ; Active? CALL Z,PRCENT ; Routine copies 19 of this entry into "DIRBUF" ; SKIP1: LD HL,DDMA+20H ; As above, 3 more times / sector CALL ACTIVQ ; Active? CALL Z,PRCENT LD HL,DDMA+40H CALL ACTIVQ ; Active? CALL Z,PRCENT LD HL,DDMA+60H CALL ACTIVQ ; Active? CALL Z,PRCENT LD HL,(DIRLEN) DEC HL LD A,L OR H JR Z,DUNDIR ; If done reading in directory, go process LD (DIRLEN),HL ; Else store length remaining CALL READ1 ; and read another record into DDMA JR MAINLP ; Loop, w/o resetting DE ; ;---------------------------------------------------------------------------- ; ; Routine to move 21 key bytes from one entry into sequential mem in "dirbuf" ; HL points to the lbr directory entry in queston, DE continues to increment ; through "dirbuf" for all entries. ; PRCENT: INC HL ; Skip flag byte. We already know its "active" LD BC,21 ; # of bytes to be moved LDIR ; (DE is incrementing through DIRBUF) LD HL,(NFILES) ; Ok to clobber HL now (not DE!) INC HL ; Increment the "# of files" counter LD (NFILES),HL LD A,(OVFTPA) ; Be extra cautious and make sure "DE" never SUB D ; - approaches the end of the TPA. JP C,CORUPT ; If it does, the consider the LBR corrupt RET ; (actually a TPA that small is "corrupt") ;---------------------------------------------------------------------------- ; ; Now we are done reading the directory information, and it is time to start ; processing, starting from the beginning of "dirbuf" ; DUNDIR: LD HL,(NFILES) ; Test for no matching members! LD A,L OR H JR NZ,DODIR LD DE,EMPMSG ; Point at msg CALL MESAGE ; Show it JP RETCCP ; Go home ; DODIR: LD DE,HEDING ; Type main heading CALL MESAGE LD HL,DIRBUF ; Back to beg of packed data to be processed ;............................................................................ ; NAMLP: LD A,(LINCTR) ; Top of main loop, one loop per entry DEC A LD (LINCTR),A ; Keep track of lines per console screen CALL CKABRT ; Check for ^C, etc. Also pauses if linctr=0 LD A,CR ; In case "CKABRT" echoed extraneous chars, CALL TYPE ; - an extra CR so we'll write over them CALL PFNAME ; Type a filename (increase HL by 11) CALL BLANK2 ; Type 2 blanks LD E,(HL) ; Get the entry's "index" for later reference INC HL LD D,(HL) INC HL LD (INDEX),DE ; Put 2 byte index value there for now LD E,(HL) ; Get the member's file size in sectors INC HL LD D,(HL) INC HL ; ; The member's file size can be processed immediately, since according to ; the format it's the next thing we want to type to the screen anyway. ; The code below will take the length in records (now in DE), divide it by ; eight, convert that to BCD, and then print the remainder as the fractional ; part of the size in "k". ; PUSH HL ; Save pointer and size in recs PUSH DE EX DE,HL ; Recs to HL CALL DECOUT ; Print w/leading blanks LD A,'r' ; Type an "r" CALL TYPE POP DE ; Restore pointer and size POP HL XOR A ; We'll accumulate the fractional part in here SRL D ; } RR E ; } RRA ; } SRL D ; } Divide by 8, shifting remainder into A RR E ; } RRA ; } SRL D ; } RR E ; } RRA ; } RRA RRA ; A now has the remainder times 8. PUSH AF ; Save that while we type the full number of k. PUSH HL ; Save our pointer too. EX DE,HL CALL DECOUT ; Converts the # in HL to BCD and types it. POP HL POP AF ; Get everything back ; LD E,(HL) ; Get CRC value for later processing INC HL ; LD D,(HL) INC HL ; LD (CRCVAL),DE ; Put that here for now. ; LD E,(HL) ; Get date for later processing ; INC HL ; LD D,(HL) ; INC HL LD DE,CDATVAL ; Point to cre date storage LDI ; Mod date storage follows LDI ; Move cre and mod dates LDI LDI LD (HLSAVE),HL ; Save our pointer again LD H,0 ; Meanwhile, our "fraction" is still in A LD L,A ; Use the value to select appropriate text LD DE,FRACTS ; - from the 8-byte wide table "fracts" ADD HL,DE EX DE,HL CALL MESAGE ; And output that to the console ; ; We read the first record of the file into the default dma and examine it ; to determine compression format. This is very slightly slower than ; checking the extension first and only reading the record if the middle ; letter indicates a crunched file; it is a great deal more accurate. XOR A LD (CRFLAG),A ; clear flag CALL RDHDR ; Read the first record of the file LD HL,DDMA ; Pt to first character of record LD A,76H ; Z80 halt instruction CPI ; Is it there? LD DE,TYPE0 ; Ptr to "------" message JR NZ,CORECT ; No, so we don't know the compression LD A,(HL) ; Get the second character of the file LD DE,TYPE1 ; "Sqeezed" INC A ; Indicated by 76h 0ffh series JR Z,CORECT LD DE,TYPE2 ; "Crunched" LD (CRFLAG),A ; save as a flag INC A ; Indicated by 76h 0feh series JR Z,CORECT LD DE,TYPE0 ; In case we fall through, "------" ; CORECT: CALL MESAGE ; Whatever it is, type it. CALL BLANK2 ; Type 2 blanks ; ; The "DATE" routine will, if possible, define "DAY", "MONTH", and "YEAR". ; MONTH will be pointer to a string, while the other two will contain actual ; BCD values. Returns w/ carry set if no date can be determined. ; XOR A LD (OFFSET),A ; Offset to cre date is zero LD HL,(CDATVAL) ; Pointer to cre date CALL DATE ; Perf date conversion, as described JR C,NODATE ; If no date, go type "---" CALL SHODATE ; Display date LD A,10 LD (OFFSET),A ; Offset to mod date is ten LD HL,(MDATVAL) ; Pointer to mod date CALL DATE ; Repeat for mod date JR C,NODATE1 ; Just print one "---" entry CALL SHODATE JR DOCRC ; CRC gone, jumps to Comment field SHODATE: LD A,(DAY) ; First get the day of the month CALL HEXO ; Type that CALL BLANK1 ; Followed by one space LD DE,(MONTH) ; Get pointer to month string CALL MESAGE ; And type the month CALL BLANK1 ; Another space LD A,(YEAR) ; Finally the year, BCD again CALL HEXO ; Type that CALL BLANK2 ; 2 spaces RET ; NODATE: LD DE,DATLES ; Special "---" string for dateless files CALL MESAGE NODATE1: LD DE,DATLES CALL MESAGE ; DOCRC:; LD A,(CRCVAL+1) ; Get crc hi-byte ; CALL HEXO ; Ascii hex output routine ; LD A,(CRCVAL+0) ; Likewise lo-byte ; CALL HEXO ; CALL BLANK3 ; 3 blanks after CRC LD A,(CRFLAG) ; Re-analyze extension INC A ; 0ffh if crunched JR NZ,DUNLIN ; If not, we are done. Go to next LBR member. ; ;............................................................................ ; ; If the file is crunched, we will attempt to fill in the "comments" column. ; The first priority is to look for text contained between "[" and "]" in ; the crunched file header. Failing that, we will simply display an arrow ; followed by the original filename as extracted from the file header. ; LD B,7FH ; Search for "[" or zero, whichever comes 1st LD HL,DDMA ; SRCHLP: LD A,(HL) INC HL OR A JR Z,NOBRCK ; Zero means done CP '[' JR Z,FNDBRK ; If we found it DJNZ SRCHLP ; (limit search to the one record we read) ; NOBRCK: CALL MAKEUP ; No comment found, so invent one, as described JR DUNLIN ; Thats's all, go on to next LBR entry ; ;............................................................................ ; ; A "comment" has been found so we will display it. The comment text is nearly ; always in full upper case, because it was originally entered as part of a ; command line and converted to U/C by the CCP. We will fake it by making ; the first char U/C and the rest L/C to make it look good. ; FNDBRK: LD B,LINLEN ; # of characters allowed for the comment LD C,0FFH ; (used to flag the first loop) ; COMLP: LD A,(HL) ; Get a char INC HL OR A ; If zero we are done JR Z,DUNLIN CP ']' ; Likewise a "]" character JR Z,DUNLIN INC C CALL NZ,LCASE ; Convert to lower case if not first loop CALL TYPE DJNZ COMLP ; Continue, but not past max #of chars allowed ; ;.............................................................................. ; DUNLIN: CALL CRLF ; Done with whole line; move to next LBR member LD HL,(NFILES) ; Decr the #of files count to see if we're done DEC HL LD (NFILES),HL LD A,H OR L LD HL,(HLSAVE) ; Before looping, restore HL (now pointing to JP NZ,NAMLP ; - next packed directory entry in "dirbuf") JR RETCCP ; ;============================================================================ ; Subroutines ;============================================================================ ; ;____________________________________________________________________________ ; ; Read in the 1st 128 bytes of a member file. The file's index is in "index" ; RDHDR: LD HL,(INDEX) ; Get index of file LD (DFCB+33),HL ; Put it in the rr field at fcb+33,34 XOR A LD (DFCB+35),A ; Make sure this is zero LD C,RDRND ; Prepare for random read LD DE,DFCB CALL BDOSAV ; Read first sector of the file to the ddma OR A JR NZ,CORUPT ; (if read operation failed) RET ; ;____________________________________________________________________________ ; READ1: PUSH DE ; Seq. read next sector to DDMA. Kills BC. LD DE,DFCB LD C,READ CALL BDOSAV OR A JR NZ,CORUPT ; If unexpected EOF error POP DE RET ; ;____________________________________________________________________________ ; NOSUCH: LD DE,NSMSG ; Type "File not found" and exit CALL MESAGE JR RETCCP ; ;____________________________________________________________________________ ; CORUPT: LD DE,CORMSG ; Type "library file corrupt", and exit CALL MESAGE JR RETCCP ; ;____________________________________________________________________________ ; GIVUSG: LD DE,USAGE ; Give usage instructions and exit CALL MESAGE ; JR RETCCP ; fall through ; ;............................................................................ ; ; Terminate. Return to CCP, or do a warm boot if byte at 111H was patched. ; RETCCP: LD A,(WBFLAG) OR A JP NZ,0000H ; Do a warm boot if so dictated by flag LD SP,(OLDSTK) ; Else a return to CCP RET ; ;____________________________________________________________________________ ; ; Print a file's real [uncrunched] filename in lieu of a comment in the ; comments column. Only done of no "[..]" comment could be found. ; MAKEUP: LD DE,FNMSG ; "( --> " CALL MESAGE LD HL,DDMA+2 ; Filename area LD B,12 ; Necessary? ; MAKELP: LD A,(HL) INC HL CP 10H ; Usually 00 terminates; stop at any of 16 JR C,DUNAME ; - obviously non-ascii bytes for future CALL TYPE ; - expansion of system dependent info arae. DJNZ MAKELP ; (also could stop 3 bytes past ".") ; DUNAME: LD A,')' ; Follow with closing parenthesis CALL TYPE RET ; ;____________________________________________________________________________ ; BLANK3: LD A,' ' ; Type 3 blanks to the console CALL TYPE ; BLANK2: LD A,' ' ; Likewise 2 bytes CALL TYPE ; BLANK1: LD A,' ' ; A single oarty CALL TYPE RET ; ;____________________________________________________________________________ ; CRLF: LD A,CR ; Type a CR/LF sequence to the console CALL TYPE LD A,LF ; CALL TYPE ; fall through ; RET ; ;............................................................................ ; TYPE: PUSH AF ; Type the char in A; save all registers PUSH BC PUSH DE LD E,A LD C,CONOUT CALL BDOSAV POP DE POP BC POP AF RET ; ;____________________________________________________________________________ ; LCASE: CP 41H ; Down-case the character in "A" RET C ; "@" and below should be left alone CP 5BH ; "[" and above should be left alone RET NC ADD A,20H ; Else down-case it RET ; ;____________________________________________________________________________ ; MESAGE: PUSH BC ; Type string pointed to by DE ("$" terminated) LD C,PRTSTR CALL BDOSAV POP BC RET ; ;____________________________________________________________________________ ; BDOSAV: PUSH BC ; Call bdos; save all regs (except A) PUSH DE PUSH HL CALL BDOS POP HL POP DE POP BC RET ; ;____________________________________________________________________________ ; ; Monitor "linctr"; if zero pause and wait for another char to continue, then ; then reset "LINCRT" to the "nln" value (unless the "continue character was ; a space, in which case reset "LINCTR" to "1"). Check console input status, ; get a character if necessary. Abort if it is one of the 6 abort characters. ; Space sets "LINCTR" to "1" at any time. Pause on ^S, waiting for another ; character (and process it as above [except another ^S]). That should about ; cover it. ; CKABRT: PUSH AF ; Save all regs PUSH BC PUSH DE LD A,(LINCTR) ; # of lines on current screen so far OR A JR NZ,NLNZ ; Br if not zero yet LD A,(NLN) ; Reset the line counter in advance LD (LINCTR),A LD DE,MORPRM ; "[more]" prompt CALL MESAGE ; WA4CH: LD C,CONST ; Loop till we get any character CALL BDOSAV OR A JR Z,WA4CH LD C,CONIN ; Get the character CALL BDOSAV JR GOT1B ; Continue. Process the char also, but not ^S. ; ;............................................................................ ; NLNZ: LD C,CONST ; Normally, just check console status. CALL BDOSAV OR A JR NZ,GOT1 ; RETABT: POP DE ; Always return from this subr from here POP BC POP AF RET ; ;.............................................................................. ; GOT1: LD C,CONIN ; Get the pending console character CALL BDOSAV CP 'S'-40H ; ^S pauses JR Z,WA4CH ; GOT1B: CP ' ' ; Space sets the line counter to one JR Z,SET1 ; AND 1FH ; ^C, ^K, ^X, C, K, X, etc all abort CP 'C'-40H JR Z,ABRT CP 'K'-40H JR Z,ABRT CP 'X'-40H JR NZ,RETABT ; Ignore other keys ; ABRT: JP RETCCP ; Fix stack and exit direct ; ; ----------------------- SET1: LD A,1 ; Set line counter to '1' LD (LINCTR),A JR RETABT ; ;____________________________________________________________________________ ; PFNAME: LD B,8 ; Print filename spec'd by HL. Inject the "." CALL FNLP LD A,'.' ; Inject a "." CALL TYPE LD B,3 ; Fall through for extension FNLP: LD A,(HL) ; Types 8 filename chars INC HL ; 3 filetype chars RLA JR C,$+5 ; Check for high bit set RRA JR FNLP1 ; Not set, print as is RRA AND 07FH OR 020H ; Print lowercase for char+80h CP 020H JR NZ,FNLP1 LD A,'_' ; Print underline for space+80h FNLP1: CALL TYPE DJNZ FNLP 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 character 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 and return RET ; ;____________________________________________________________________________ ; DIV10: EX DE,HL ; Divide 16 bit value in HL by 10 LD HL,0 ; Zero the low byte LD BC,-10 ; We can skip the negation code 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 fits 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 ; ;............................................................................ ; HEXO: PUSH AF ; Output the byte in A as hex (2 ascii chars) SRL A SRL A SRL A SRL A ; Get ms nyb CALL NYBOUT ; Output that POP AF ; Orig byte again AND 0FH ; Ls nym ; NYBOUT: OR 30H ; Embedded subr to output 1 nybble starts here CP 3AH ; See if dec --> ascii conv exceeds "9" JR C,SKIP7 ; Ok if not ADD A,7 ; Else add offset to to get to "A" ; SKIP7: CALL TYPE ; Type the ascii char RET ; ;============================================================================ ; ; Convert the 2 byte date value in HL, in DRI format, to something ; usable; values returned as "date", "month", and "year" ; DATE: ;LD HL,(DATVAL) ; # of days since Dec 31, 1977 LD A,H OR L ; Zero is indicative of an undated entry JR Z,CHKDS ; If so, go try to get a date some other way ; LD A,78H ; Init to BCD 1978 LD DE,365 ; Amount to subtract per year (except leap) LD B,28 ; #of days in Feb for current year ; YRLP: AND A ; Clear carry SBC HL,DE ; Subtract 1 year JR Z,GOTYR JR C,GOTYR ; If carry, we've gone too far ADD A,1 ; Else incr year by one (BCD) DAA AND A SBC HL,DE ; Repeat for the following [non-leap] year JR Z,GOTYR JR C,GOTYR ADD A,1 DAA INC B ; The following year IS a leap year INC DE ; So use 366 for DE and flag B with a "29" AND A SBC HL,DE JR Z,GOTYR JR C,GOTYR ADD A,1 DAA DEC DE ; Put year and #of Feb days back to normal DEC B AND A SBC HL,DE ; Repeat for one more [non-leap] year JR Z,GOTYR JR C,GOTYR ADD A,1 DAA JR YRLP ; And loop ; ;............................................................................ ; GOTYR: ADD HL,DE ; Reverse the last subtraction with current val LD (YEAR),A ; The correct year value, BCD LD A,B ; And save current Feb val for future ref LD (FEB),A LD BC,MONTBL ; Table of #of days/month ; MNTHLP: LD A,(BC) ; Get #of days LD E,A ; Put it in DE LD D,0 AND A SBC HL,DE ; Subtract JR Z,GOTMON JR C,GOTMON ; If carry, we've gone too far again INC BC ; Else move ahead to the next month INC BC INC BC INC BC INC BC ; (1 byte for #of days, 4 bytes for abrev.) LD A,C CP LOW(ENDTBL) ; (table is <256 bytes, so this is OK) JR NZ,MNTHLP ; LD DE,INTERR ; *** this shouldn't happen? *** CALL MESAGE ; (algorithm error; for debugging only) JP RETCCP ; GOTMON: ADD HL,DE ; Once again, add back in INC BC ; Meanwhile, keep pointer to month text LD (MONTH),BC LD A,L ; The remainder should be the day# CP 0AH ; Final BCD conversion JR C,OKD ADD A,6 CP 1AH JR C,OKD ADD A,6 CP 2AH JR C,OKD ADD A,6 OKD: LD (DAY),A AND A ; Return with clear carry RET ; And that's it! ; ;............................................................................ ; ; Failing to find an LBR date, program will support the system specific format ; of the CR23D program which embeds a date in the header of the crunched file ; (Recognized by "01" after filename before "00" terminating header area) ; CHKDS: LD A,(CRFLAG) ; If it wasn't crunched, don't even bother INC A ; 0ffh if crunched JR Z,OKSOFR ; NOTD: SCF ; Else just set carry (means no date info) RET ; And return ; OKSOFR: LD HL,DDMA+2 ; Loop to look for DateStamped file LD A,1 ; Value to look for LD B,13 ; Loop counter LOOP01: CP (HL) ; Check byte INC HL JR Z,GOTIT ; Found the charicteristic "01"! JR NC,NOTD ; No carry implies we hit the zero DJNZ LOOP01 ; Else keep checking JR NOTD ; Ran out, give up ; GOTIT: PUSH DE LD DE,(OFFSET) ; Offset to the date param we want ADD HL,DE ; Maybe advance, maybe not POP DE LD A,(HL) ; Should already be pointing to year INC A ; 00h in datestamp is converted to 0ffh JR Z,$+3 ; in header to avoid terminating header DEC A ; convert 0ffh back to 00h LD (YEAR),A ; Already in BCD! INC HL ; Let's skip to day before month INC HL LD A,(HL) INC A ; Datestamped files may still have no JR Z,$+3 ; dates in them (i.e., 00 00 00) DEC A LD (DAY),A ; (Because that one's easy) DEC HL ; Now back to the month LD A,(HL) INC A JR Z,$+3 DEC A CP 0AH ; Leave 00-09 the way they are JR C,LVMON SUB 6 ; (BCD to binary conversion) ; LVMON: LD B,A ADD A,A ; 2x val ADD A,A ; 4x val ADD A,B ; 5x val ADD A,LOW(MONTBL-4) ; +1 offsets to chars, -5 since Jan is 1 not 0 LD L,A LD H,HIGH(MONTBL-4) JR NC,NCM ; Don't forget about a possible carry INC H ; NCM: LD (MONTH),HL ; Pointer to month text AND A ; Clr carry LD DE,MONTBL ; Ptr to months table SBC HL,DE ; Carry indicates 00h for month (no date) RET ; ;============================================================================ ; ; Check a library directory entry before reading it into DIRBUF. Returns Z ; if the entry is OK, NZ if it is to be skipped (wildcard matcher adapted ; from LDIRZ by Rick Conn). ; ACTIVQ: LD A,(HL) ; Must be an active member OR A RET NZ ; Otherwise return NZ ; PUSH DE ; Save incoming DE LD DE,WLDFCB ; Point to user's wildcard LD A,(DE) SUB ' ' ; Is it blank? JR Z,JUSTDE ; Then just return Z ; PUSH HL ; Now save incoming HL INC HL ; Bump to member filename LD B,11 ; Check 11 bytes GETENT1: LD A,(DE) ; Check for match with wildcards LD C,(HL) ; Get target char INC HL ; Pt to next INC DE CP '?' ; Wild match? JR Z,GETENT2 CP C ; Match? JR NZ,GETE0 ; Skip if not, return NZ GETENT2: DJNZ GETENT1 ; Count down until Z GETE0: POP HL JUSTDE: POP DE RET ;............................................................................ ; MONTBL: DB 31,'Jan$' FEB: DB 28,'Feb$' ; This loc is written to with a "29" sometimes DB 31,'Mar$' DB 30,'Apr$' DB 31,'May$' DB 30,'Jun$' DB 31,'Jul$' DB 31,'Aug$' DB 30,'Sep$' DB 31,'Oct$' DB 30,'Nov$' DB 31,'Dec$' ; ENDTBL EQU $ ; ;............................................................................ ; LBRNAM: DB 'Library File = $' INTERR: DB CR,LF,'+ PGM ERR +',CR,LF,'$' NSMSG: DB CR,LF,'+++ Library file not found +++',CR,LF,'$' CORMSG: DB CR,LF,'+++ Library file is corrupt +++',CR,LF,'$' EMPMSG: DB CR,LF,'+++ No (matching) members found +++',CR,LF,'$' DATLES: DB '-- --- -- $' MORPRM: DB '[more]$' NOMSG: DB ' $' CREMSG: DB 'Cre $' MODMSG: DB 'Mod $' ; FRACTS: DB '.00k $ ' ; 0k DB '.12k $ ' ; 1/8k DB '.25k $ ' ; 1/4k DB '.37k $ ' ; 3/8k DB '.50k $ ' ; 1/2k DB '.62k $ ' ; 5/8k DB '.75k $ ' ; 3/4k DB '.87k $ ' ; 7/8k TYPE0: DB ' -- $' ; [Method = "none"] TYPE1: DB 'Squeezed$' TYPE2: DB 'Crunched$' FNMSG: DB '(--> $' ; Precedes uncompressed filename display ; ;............................................................................ ; USAGE: DB CR,LF,'v1.40 SGG 02 Jun 88',CR,LF,LF ; DB 'Usage: LDIR lbrname [afn.typ]',CR,LF,LF,'$' ; HEDING: DB CR,LF DB ' Name Length Method Cre Date Mod Date Comments',CR,LF DB '============ ============ ======== ==================== =================',CR,LF,'$' CDATVAL: DS 2 ; Date in DRI format (# of days MDATVAL: ; ..since 31 Dec 1977) DS 2 OFFSET: DS 2 ; Offset to date param in crunched files YEAR: DS 1 ; Year in BCD MONTH: DS 2 ; Pointer to "$" terminated month string DAY: DS 1 ; Day of month, BCD OLDSTK: DS 2 ; Save system stack here DIRLEN: DS 2 ; Directory length, #of records INDEX: DS 2 ; An RA index value to a beg of a menber file CRFLAG DS 1 ; 0ffh if crunched, other values undefined ;CRCVAL: DS 2 ; File's 2 byte CRC value saved here NFILES: DS 2 ; Overall loop counter for program operation HLSAVE: DS 2 ; Temp storage for HL OVFTPA: DS 1 ; To monitor program case it tries to go nuts LINCTR: DS 1 ; Line counter for "[more]" prompt WLDFCB: DS 11 ; Safe storage for FCB2 filenametyp ; DS 80H ; Stack area for program's use ; STACK EQU $ ; TOS ; DIRBUF: DS 1024*19 ; (not really part of program) - max memory ; ; Needed for a 1024 member library END