home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / arc-lbr / ldir-h1.lbr / LDIR-H1.ZZ0 / LDIR-H1.Z80
Text File  |  1988-05-11  |  23KB  |  821 lines
  1.  
  2. ;                LDIR-H1
  3. ;                  05 May 1988
  4. ;
  5. ;           based on Steve Greenberg's LDIR-B
  6. ;
  7. ;
  8. ; This program shows the member files in a .LBR.  May be used by itself
  9. ; or can be called by LUX77B.  Can be used on an RCPM or individual CP/M
  10. ; system.  Place on A0:  Shows the names of the library files, how long
  11. ; they are in both records and 'k' and their normal 'uncrunched' name.
  12. ;
  13. ;-----------------------------------------------------------------------
  14. ;
  15. ; LDIR-H1  - 05/05/88  Checks for BYE5 in use    - Irv Hoff
  16. ; LDIR-H   - 02/17/88                - Irv Hoff
  17. ; LDIR-B12 - 11/05/87  Added ZCPR3 capability    - Bruce Morgen
  18. ; LDIR-B   - 10/17/87                - Steven Greenberg
  19. ;
  20. ;-----------------------------------------------------------------------
  21. ;
  22.     .Z80                ; Only needed if using M80/L80
  23.     ASEG                ; Only needed if using M80/L80
  24.     ORG    100H
  25. ;
  26. ;
  27. ; ASCII equates
  28. ;
  29. BS    EQU    08H        ; Backspace
  30. CR    EQU    0DH        ; Carriage return
  31. LF    EQU    0AH        ; Linefeed
  32. ;
  33. ; CP/M address equates
  34. ;
  35. DFCB    EQU    005CH        ; Default file control block #1
  36. FCB2    EQU    006CH        ; Default file control block #2
  37. DDMA    EQU    0080H        ; Default DMA address
  38. BDOS    EQU    0005H        ; BDOS entry point
  39. ;
  40. ; BDOS function equates
  41. ;
  42. CONIN    EQU    1        ; Console input (single character)
  43. CONOUT    EQU    2        ; Output single char to console
  44. PRTSTR    EQU    9        ; Print string to console
  45. CONST    EQU    11        ; Get console status
  46. OPEN    EQU    15        ; Open file
  47. READ    EQU    20        ; Read file (sequential)
  48. SETDMA    EQU    26        ; Set dma address
  49. GSUSER    EQU    32        ; Get/set user code
  50. RDRND    EQU    33        ; Read random
  51. ;
  52. ;-----------------------------------------------------------------------
  53. ;
  54. ENTRY:    JP    START
  55. ;
  56. ;
  57. ; Following two lines for the ZCPR3 Enviornment descriptor, ignore if
  58. ; not using ZCPR3.
  59.  
  60.     DEFB    'Z3ENV',1
  61. ;
  62. Z3EADR:    DEFW    00        ; Set by CPR or the Z3INS utility if Z3
  63. ;
  64. ;-----------------------------------------------------------------------
  65. ;
  66. NLN:    DEFB    22        ; #of lines before [more] prompt
  67. WHLLOC:    DEFW    003EH        ; Wheel byte location
  68. ;
  69. ;-----------------------------------------------------------------------
  70. ;
  71. ;            Start of program
  72. ;
  73. ;-----------------------------------------------------------------------
  74. ;
  75. START:    LD    (STACK),SP    ; Save system stack pointer
  76.     LD    SP,STACK    ; Set to local area
  77. ;
  78. ; Check for BYE5
  79. ;
  80.     LD    C,32        ; Get current user area
  81.     LD    E,0FFH
  82.     CALL    BDOSAV
  83.     PUSH    AF        ; Save current usea area temporarily
  84.     LD    C,32        ; Check for BYE5
  85.     LD    E,241
  86.     CALL    BDOSAV
  87.     LD    (BYE5),A    ; Store answer (4Dh if BYE5 is in use)
  88.     POP    AF        ; Get current user area back
  89.     LD    C,32        ; Restore current user area
  90.     LD    E,A
  91.     CALL    BDOSAV
  92. ;
  93. ; See if using ZCPR3, if not, exit
  94. ;
  95.     LD    HL,(Z3EADR)    ; Get possible Z3 environment pointer
  96.     LD    A,L
  97.     OR    H
  98.     JR    Z,NOTZ3        ; If (Z3EADR) = 0000H, assume non-Z3
  99. ;
  100.     LD    A,(DFCB+2)
  101.     CP    '/'
  102.     JP    Z,GIVUSG    ; Exit if looking for use of program
  103. ;
  104.     LD    A,(DFCB+13)    ; Otherwise get CCP-parsed user #
  105.     LD    E,A        ; Log in via BDOS function #32
  106.     LD    C,GSUSER
  107.     CALL    BDOSAV        ; HL is preserved at BDOSAV
  108.     LD    DE,29H        ; Offset to wheel address in DE
  109.     ADD    HL,DE        ; Add it to environment address
  110.     LD    E,(HL)        ; LSB in E
  111.     INC    HL        ; Bump pointer
  112.     LD    D,(HL)        ; MSB in D
  113.     LD    (WHLLOC),DE    ; Poke into LDIR-B
  114.     LD    DE,6        ; Offset to CRT selection
  115.     ADD    HL,DE        ; Add it in
  116.     LD    E,3        ; D=0, so DE=0003h
  117.     LD    A,(HL)        ; Get selected CRT # in A
  118.     OR    A        ; Test for zero
  119.     JR    Z,CRT0        ; If CRT #0, just 3 bumps
  120.     ADD    HL,DE        ; Otherwise 6 bumps
  121. ;
  122. CRT0:    ADD    HL,DE
  123.     LD    A,(HL)        ; Get "usable" CRT lines
  124.     LD    (NLN),A        ; Poke into LDIR-B
  125. ;
  126. ; Skips above section if not ZCPR3
  127. ;
  128. NOTZ3:    LD    A,(DFCB+1)    ; Any commands requested?
  129.     CP    ' '
  130.     JP    Z,GIVUSG    ; If not, give usage
  131. ;
  132.     LD    A,(BDOS+2)    ; Subtract 2k+ (for CCP) from TPA
  133.     SUB    11        ; - and save for later check
  134.     LD    (OVFTPA),A
  135.     LD    A,(NLN)        ; Set line count
  136.     LD    (LINCTR),A
  137.     LD    HL,'RB'        ; Last 2 letters of "LBR" (backwords)
  138.     LD    (DFCB+10),HL    ; Put at FCB+10 and +11
  139.     LD    A,'L'        ; Similarly
  140.     LD    (DFCB+9),A    ; Now we have a forced "LBR" extension
  141.     LD    HL,FCB2+1    ; Put possible user wildcard
  142.     LD    DE,WLDFCB    ; filespec into a safe buffer
  143.     LD    BC,11
  144.     LDIR
  145.     LD    DE,DFCB+12    ; Clear rest of FCB
  146.     LD    B,24        ; # of zeroes for the rest
  147.     XOR    A        ; A zero, obviously
  148. ;
  149. ZLP2:    LD    (DE),A        ; Put those in
  150.     INC    DE
  151.     DJNZ    ZLP2
  152. ;
  153.     LD    HL,0        ; Set "number of files" counter to zero
  154.     LD    (NFILES),HL
  155.     LD    DE,DFCB        ; Open the library file
  156.     LD    C,OPEN
  157.     CALL    BDOSAV
  158.     INC    A
  159.     JP    Z,NOSUCH    ; Can't find that file, display error
  160. ;
  161.     LD    A,(DFCB+10)    ; Check if file has .SYS attribute
  162.     AND    80H
  163.     JR    Z,NONSYS    ; If not, it's OK
  164. ;
  165.     LD    HL,(WHLLOC)    ; If .SYS extent, check if wheel is on
  166.     LD    A,(HL)        ; Get the wheel byte itself
  167.     OR    A
  168.     JP    Z,NOSUCH    ; If zero, pretend there is no such file
  169. ;
  170. NONSYS:    LD    C,SETDMA    ; Make sure the default DMA is 80H
  171.     LD    DE,DDMA
  172.     CALL    BDOSAV
  173.     CALL    CRLF        ; Type a CR/LF sequence to the screen
  174.     LD    DE,LBRNAM    ; Followed by "Library File ="
  175.     CALL    MESAGE
  176.     LD    HL,DFCB+1    ; Point to the LBR's filename
  177.     CALL    PFNAME        ; Routine types the specified filename
  178.     LD    A,(WLDFCB)    ; Has user specified a wildcard?
  179.     SUB    ' '
  180.     JR    Z,NOWILD    ; If not, finished with display
  181. ;
  182.     CALL    BLANK3        ; Otherwise print three blanks
  183.     LD    DE,FNMSG    ; Point at "( --> "
  184.     CALL    MESAGE        ; Print it
  185.     LD    HL,WLDFCB    ; Point at wildcard
  186.     CALL    PFNAME        ; Type it out as filename.typ
  187.     LD    A,')'        ; Close parenthesis
  188.     CALL    TYPE
  189. ;
  190. NOWILD:    CALL    CRLF        ; Another CR/LF, obviously
  191.     CALL    READ1        ; Read the library's 1st record
  192.     LD    HL,DDMA        ; Point to first byte
  193.     LD    A,(HL)        ; Validity check, the dirctory entry
  194.     OR    A        ;   for the directory itself must be
  195.                 ;   "active" (zero)
  196.     JP    NZ,CORUPT    ; Else the library is corrupt
  197. ;
  198. ; We would normally check for eleven blank characters next (the filename
  199. ; area of the directory entry for the directory itself.  We will skip
  200. ; this validity check, however, because some MS-DOS library programs
  201. ; actually insert the library's name here.  Skipping the check insures
  202. ; compatibility.
  203. ;
  204.     LD    HL,DDMA+12    ; More validity checking:
  205.     XOR    A        ; The library's "index" must be zero
  206.     CP    (HL)
  207.     JP    NZ,CORUPT    ; If INDEX(low) >0, .LBR is corrupt
  208. ;
  209.     INC    HL
  210.     CP    (HL)
  211.     JP    NZ,CORUPT    ; Likewise for INDEX(high)
  212. ;
  213.     INC    HL
  214.     LD    A,(HL)        ; Get length of directory(low)
  215.     INC    HL
  216.     LD    H,(HL)        ; Get length of directory(high)
  217.     LD    L,A        ; Full directory length in HL
  218.     OR    H
  219.     JP    Z,CORUPT    ; 0-length LBR directory is corrupt
  220. ;
  221.     LD    (DIRLEN),HL    ; It's big enough, store it
  222. ;
  223. ; Program operation: We will read the entire .LBR directory into memory
  224. ; in one shot, avoiding having to go back to it later as we are reading
  225. ; the first record of various member files (should minimize head move-
  226. ; ment and maximize speed).  Only the 19 bytes of interest out of the
  227. ; 32 will be saved for each entry, however, and entries flagged as de-
  228. ; leted or non-existant will be skipped.
  229. ;
  230.     LD    DE,DIRBUF    ; Directory data starting here
  231.     JR    SKIP1        ; Jump into loop (only 3 entries
  232. ;                ;   first record)
  233. ;
  234. ;-----------------------------------------------------------------------
  235. ;
  236. MAINLP:    LD    HL,DDMA+00    ; 1st entry per record
  237.     CALL    ACTIVQ        ; Active?
  238.     CALL    Z,PRCENT    ; Routine copies 19 of this entry
  239. ;                ;   into "DIRBUF"
  240. SKIP1:    LD    HL,DDMA+20H    ; As above, 3 more times / recird
  241.     CALL    ACTIVQ        ; Active?
  242.     CALL    Z,PRCENT
  243.     LD    HL,DDMA+40H
  244.     CALL    ACTIVQ        ; Active?
  245.     CALL    Z,PRCENT
  246.     LD    HL,DDMA+60H
  247.     CALL    ACTIVQ        ; Active?
  248.     CALL    Z,PRCENT
  249.     LD    HL,(DIRLEN)
  250.     DEC    HL
  251.     LD    A,L
  252.     OR    H
  253.     JR    Z,DUNDIR    ; Done reading in directory, go process
  254. ;
  255.     LD    (DIRLEN),HL    ; Else store length remaining
  256.     CALL    READ1        ; and read another record into DDMA
  257.     JR    MAINLP        ; Loop, without resetting DE
  258. ;
  259. ;-----------------------------------------------------------------------
  260. ;
  261. ; Routine to move 19 key bytes from one entry into sequential memory in
  262. ; "DIRBUF".  HL points to the .LBR directory entry in queston, DE con-
  263. ; tinues to increment through "dirbuf" for all entries.
  264. ;
  265. PRCENT:    INC    HL        ; Skip flag byte, we already know its
  266.                 ;   "active"
  267.     LD    BC,19        ; number of bytes to be moved
  268.     LDIR            ; (DE is incrementing through DIRBUF)
  269.     LD    HL,(NFILES)    ; Ok to clobber HL now (not DE!)
  270.     INC    HL        ; Increment the "# of files" counter
  271.     LD    (NFILES),HL
  272.     LD    A,(OVFTPA)    ; Be extra cautious and make sure
  273.     SUB    D        ;   "DE" never approaches end of TPA
  274.     JP    C,CORUPT    ; If it does, the .LBR is corrupt
  275. ;
  276.     RET            ; (A TPA that small, is "corrupt")
  277. ;
  278. ;-----------------------------------------------------------------------
  279. ;
  280. ; Now we are done reading the directory information, and it is time to
  281. ; start processing, starting from the beginning of "DIRBUF"
  282. ;
  283. DUNDIR:    LD    HL,(NFILES)    ; Test for no matching members
  284.     LD    A,L
  285.     OR    H
  286.     JR    NZ,DODIR
  287.     LD    DE,EMPMSG    ; Show the message
  288.     CALL    MESAGE
  289.     JP    EXIT        ; Return to CCP, all done
  290. ;.....
  291. ;
  292. DODIR:    LD    DE,HEDING    ; Type main heading
  293.     CALL    MESAGE
  294.     LD    HL,DIRBUF    ; Back to beginning of packed data
  295.                 ;   to be processed
  296. ;
  297. ;-----------------------------------------------------------------------
  298. ;
  299. NAMLP:    LD    A,(LINCTR)    ; Top of main loop, one loop per entry
  300.     DEC    A
  301.     LD    (LINCTR),A    ; Keep track of lines per console screen
  302.     CALL    CKABRT        ; Check for ^C, etc, also [more] pause
  303.     LD    A,CR        ; In case "DKABRT" echoed extraneous chars,
  304.     CALL    TYPE        ; - an extra CR so we'll write over them
  305.     CALL    PFNAME        ; Type a filename (increase HL by 11)
  306.     CALL    BLANK2        ; Type 2 blanks
  307.     LD    E,(HL)        ; Get the entry's "INDEX" for later reference
  308.     INC    HL
  309.     LD    D,(HL)
  310.     INC    HL
  311.     LD    (INDEX),DE    ; Put 2 byte index value there for now
  312.     LD    E,(HL)        ; Get the member's file size in records
  313.     INC    HL
  314.     LD    D,(HL)
  315.     INC    HL
  316. ;
  317. ; The member's file size can be processed immediately, since according
  318. ; to the format, it's the next thing we want to type to the screen
  319. ; anyway.  The code below will take the length in records (now in DE),
  320. ; divide it by eight, convert that to BCD, and then print the remainder
  321. ; as the fractional part of the size in "k".
  322. ;
  323. ;
  324. ; Get number of records into DE, then go print that first
  325. ;
  326.     PUSH    HL        ; Save pointer and size in records
  327.     PUSH    DE
  328.     EX    DE,HL        ; Recs to HL
  329.     CALL    DECOUT        ; Print with leading blanks
  330.     POP    DE        ; Get number of records back
  331.     LD    HL,7
  332.     ADD    HL,DE
  333.     EX    DE,HL        ; new number of records into DE
  334.     POP    HL
  335.     XOR    A        ; We'll accumulate the fractional part in here
  336.     SRL    D        ; }
  337.     RR    E        ; }
  338.     RRA            ; }
  339.     SRL    D        ; } Divide by 8, shifting remainder into A
  340.     RR    E        ; }
  341.     RRA            ; }
  342.     SRL    D        ; }
  343.     RR    E        ; }
  344.     RRA            ; }
  345.     RRA
  346.     RRA            ; A now has the remainder times 8.
  347.     PUSH    HL        ; Save our pointer too.
  348.     EX    DE,HL
  349.     CALL    DECOUT        ; Converts the # in HL to BCD and types it.
  350.     POP    HL
  351.     INC    HL
  352.     INC    HL
  353.     INC    HL
  354.     INC    HL
  355.     LD    (HLSAVE),HL    ; Save our pointer again
  356.     LD    DE,ENDSIZ
  357.     CALL    MESAGE        ; And output that to the console
  358. ;
  359. ; Now we examine the middle letter of the extension to determine the
  360. ; file's storage "method" (ie "Crunched", "Squeezed", or nothing).  This
  361. ; version of the program is lazy and doesn't bother to read the file for
  362. ; verification.  The "PFNAME" routine which previously typed the file-
  363. ; name conveniently saved the middle letter of the extension in "EXTCHR"
  364. ;
  365.     LD    A,(EXTCHR)    ; Get filetype by mid ext letter
  366.     CP    'Z'        ; Crunched?
  367.     JR    Z,NAMLP1
  368.     CP    'Q'
  369.     JR    NZ,NZRO
  370. ;
  371. NAMLP1:    CALL    RDHDR        ; Read the member's 1st record into DDMA
  372.     LD    A,(EXTCHR)    ; Get filetype by mid ext letter
  373.     CP    'Z'        ; Crunched?
  374.     LD    DE,TYPE1
  375.     JR    Z,CORECT
  376.     CP    'Q'        ; Squeezed?
  377.     LD    DE,TYPE2
  378.     JR    Z,CORECT
  379. ;
  380. NZRO:    LD    DE,TYPE3    ; For non-compressed
  381. ;
  382. CORECT:    CALL    MESAGE        ; Whatever it is, type it
  383.     CALL    BLANK3        ; Type 3 blanks
  384.     LD    A,(EXTCHR)    ; Re-analyze extension
  385.     CP    'Z'        ; Crunched?
  386.     LD    HL,DDMA+2
  387.     JR    Z,MAKEUP    ; Go to next LBR member
  388. ;
  389.     CP    'Q'
  390.     LD    HL,DDMA+4
  391.     JR    Z,MAKEUP
  392. ;
  393. DUNLIN:    CALL    CRLF        ; Done with whole line; move to next
  394.                 ;   .LBR member
  395.     LD    HL,(NFILES)    ; Decrement the number of files count
  396.                 ;   to see if we're done
  397.     DEC    HL
  398.     LD    (NFILES),HL
  399.     LD    A,H
  400.     OR    L
  401.     LD    HL,(HLSAVE)    ; Before looping, restore HL (now
  402.                 ;   pointing to next packed directory
  403.                 ;   in "DIRBUF".
  404.     JP    NZ,NAMLP    ; Get the next file
  405. ;
  406. ;-----------------------------------------------------------------------
  407. ;
  408. ;               Subroutines
  409. ;
  410. ;-----------------------------------------------------------------------
  411. ;
  412. ; Terminate.  Return to CCP.
  413. ;
  414. EXIT:    LD    SP,(STACK)    ; Reset the original stack, go to CCP
  415.     RET
  416. ;
  417. ;-----------------------------------------------------------------------
  418. ;
  419. GIVUSG:    LD    DE,USAGE    ; Give usage instructions and exit
  420.     CALL    MESAGE
  421.     JR    EXIT        ; Return to CCP
  422. ;
  423. ;_______________________________________________________________________
  424. ;
  425. ; Read in the 1st 128 bytes of a member file.  The file's index is in
  426. ; "INDEX".
  427. ;
  428. RDHDR:    LD    HL,(INDEX)    ; Get index of file
  429.     LD    (DFCB+33),HL    ; Put it in the rr field at fcb+33,34
  430.     XOR    A
  431.     LD    (DFCB+35),A    ; Make sure this is zero
  432.     LD    C,RDRND        ; Prepare for random read
  433.     LD    DE,DFCB
  434.     CALL    BDOSAV        ; Read first record of the file to the ddma
  435.     OR    A
  436.     JP    NZ,CORUPT    ; (if read operation failed)
  437.     RET
  438. ;
  439. ;-----------------------------------------------------------------------
  440. ;
  441. ; Print a file's real name
  442. ;
  443. MAKEUP:    LD    DE,FNMSG    ; "--> "
  444.     CALL    MESAGE
  445.     LD    B,12        ; Necessary?
  446. ;
  447. MAKELP:    LD    A,(HL)
  448.     INC    HL
  449.     CP    10H        ; Usually 00 terminates; stop at any of
  450.     JR    C,DUNAME    ;   16 obviously non-ASCII bytes for
  451.                 ;   future expansion of system dependent
  452.                 ;   information area.
  453.     CP    '['        ; Start of a comment?
  454.     JR    Z,DUNAME    ; If yes, ignore
  455.     CALL    TYPE
  456.     DJNZ    MAKELP        ; (also could stop 3 bytes past ".")
  457. ;
  458. DUNAME:    CALL    BLANK1        ; Follow with 1 blank and a ")"
  459.     JP    DUNLIN
  460. ;
  461. ;-----------------------------------------------------------------------
  462. ;
  463. TYPE:    PUSH    AF        ; Type the char in A; save all registers
  464.     PUSH    BC
  465.     PUSH    DE
  466.     LD    E,A
  467.     LD    C,CONOUT
  468.     CALL    BDOSAV
  469.     POP    DE
  470.     POP    BC
  471.     POP    AF
  472.     RET
  473. ;
  474. ;-----------------------------------------------------------------------
  475. ;
  476. CRLF:    LD    A,CR        ; Type a CR/LF sequence to the console
  477.     CALL    TYPE
  478.     LD    A,LF
  479.     CALL    TYPE
  480.     RET
  481. ;
  482. ;-----------------------------------------------------------------------
  483. ;
  484. NOSUCH:    LD    DE,NSMSG    ; Type "File not found" and exit
  485.     CALL    MESAGE
  486.     JP    EXIT        ; Return to CCP
  487. ;
  488. ;-----------------------------------------------------------------------
  489. ;
  490. READ1:    PUSH    DE        ; Sequential read next record to DDMA.
  491.                 ;   Kills BC.
  492.     LD    DE,DFCB
  493.     LD    C,READ
  494.     CALL    BDOSAV
  495.     OR    A
  496.     JP    NZ,CORUPT    ; If unexpected EOF error
  497.     POP    DE
  498.     RET
  499. ;
  500. ;-----------------------------------------------------------------------
  501. ;
  502. MESAGE:    PUSH    BC        ; Type string pointed to by DE (ends
  503.     LD    C,PRTSTR    ;   with '$')
  504.     CALL    BDOSAV
  505.     POP    BC
  506.     RET
  507. ;
  508. ;-----------------------------------------------------------------------
  509. ;
  510. BDOSAV:    PUSH    IY        ; CALL BDOS, save all regs (except A)
  511.     PUSH    IX
  512.     PUSH    HL
  513.     PUSH    DE
  514.     PUSH    BC
  515.     CALL    BDOS
  516.     POP    BC
  517.     POP    DE
  518.     POP    HL
  519.     POP    IX
  520.     POP    IY
  521.     RET
  522. ;
  523. ;-----------------------------------------------------------------------
  524. ;
  525. ; Monitor "LINCTR" - if zero, pause and wait for another character to
  526. ; continue, then then reset "LINCRT" to the "NLN" value (unless the
  527. ; "continue character was a space, in which case reset "LINCTR" to "1"
  528. ; to display only one additional line).  Check console input status,
  529. ; get a character if necessary.  Abort if it is one of the 6 abort char-
  530. ; acters.  Space sets "LINCTR" to "1" at any time.  Pause on ^S, waiting
  531. ; for another character (and process it as above [except another ^S]).
  532. ; That should about cover it.
  533. ;
  534. CKABRT:    PUSH    IX        ; Save original values
  535.     PUSH    IY
  536.     PUSH    AF
  537.     PUSH    BC
  538.     PUSH    DE
  539.     LD    A,(LINCTR)    ; # of lines on current screen so far
  540.     OR    A
  541.     JR    NZ,NLNZ        ; Br if not zero yet
  542. ;
  543.     LD    A,(NLN)        ; Reset the line counter in advance
  544.     LD    (LINCTR),A
  545.     LD    DE,MORPRM    ; "[more]" prompt
  546.     CALL    MESAGE
  547. ;
  548. ; Check both remote input and local keyboard for a character, but first
  549. ; see if BYE5 is present.
  550. ;
  551. WA4CH:    LD    A,(BYE5)    ; Using BYE5?
  552.     CP    77
  553.     JR    NZ,WA5CH    ; If not, exit
  554. ;
  555.     LD    C,61        ; Special BDOS call for remote status
  556.     CALL    BDOSAV
  557.     OR    A
  558.     JR    Z,WA5CH        ; No remote character, check local
  559. ;
  560.     LD    C,64
  561.     CALL    BDOSAV
  562.     JR    GOT1A
  563. ;
  564. WA5CH:    LD    C,CONST        ; Loop till we get any character
  565.     CALL    BDOSAV
  566.     OR    A
  567.     JR    Z,WA4CH        ; Allows checking for remote input also
  568. ;
  569.     LD    C,CONIN
  570.     CALL    BDOSAV
  571.     JR    GOT1A        ; Got a character, see what it is
  572. ;
  573. ;-----------------------------------------------------------------------
  574. ;
  575. NLNZ:    LD    A,(BYE5)    ; BYE5 in use?
  576.     CP    77
  577.     JR    NZ,NLNZN    ; If not, exit
  578. ;
  579.     LD    C,61        ; Got a remote character to pause?
  580.     CALL    BDOSAV
  581.     OR    A
  582.     JR    Z,NLNZN        ; No, check for local character
  583. ;
  584.     LD    C,64        ; Have charcter, get it
  585.     CALL    BDOSAV
  586.     OR    A
  587.     JR    GOT1        ; See what it is
  588. ;
  589. NLNZN:    LD    C,CONST        ; Normally, just check console status.
  590.     CALL    BDOSAV
  591.     OR    A
  592.     JR    Z,RETABT    ; No character, back to work
  593. ;
  594.     LD    C,CONIN        ; Get the pending console character
  595.     CALL    BDOSAV
  596.     JR    GOT1
  597. ;
  598. RETABT:    POP    DE        ; Always return from this subr from here
  599.     POP    BC
  600.     POP    AF
  601.     POP    IY
  602.     POP    IX
  603.     RET
  604. ;
  605. ;-----------------------------------------------------------------------
  606. ;
  607. ; Got a character, see what it is, if a space, turn up a single line.
  608. ;
  609. GOT1:    CP    'S'-40H        ; CTL-S pauses
  610.     JR    Z,WA4CH
  611. ;
  612. GOT1A:    PUSH    AF
  613.     CP    ' '
  614.     JR    C,GOT1B
  615.     LD    DE,ERASE
  616.     CALL    MESAGE
  617. ;
  618. GOT1B:    POP    AF
  619.     CP    ' '        ; Space sets the line counter to one
  620.     JR    Z,SET1
  621.     AND    1FH        ; ^C, ^K, ^X, C, K, X, etc all abort
  622.     CP    'C'-40H
  623.     JR    Z,ABRT
  624.     CP    'K'-40H
  625.     JR    Z,ABRT
  626.     CP    'X'-40H
  627.     JR    NZ,RETABT    ; Ignore other keys
  628. ;
  629. ABRT:    JP    EXIT        ; Return to CCP
  630. ;
  631. SET1:    LD    A,1        ; Set line counter to '1'
  632.     LD    (LINCTR),A
  633.     JR    RETABT
  634. ;
  635. ;-----------------------------------------------------------------------
  636. ;
  637. PFNAME:    LD    B,8        ; Print filename spec'd by HL.    Inject
  638.                 ;   the "."
  639. ;
  640. FNLP:    LD    A,(HL)        ; }
  641.     INC    HL        ; } type 8 filename chars
  642.     CALL    TYPE        ; }
  643.     DJNZ    FNLP        ; }
  644. ;
  645.     LD    A,'.'        ; Inject a "."
  646.     CALL    TYPE
  647.     LD    A,(HL)        ; Type first ext char
  648.     INC    HL
  649.     CALL    TYPE
  650.     LD    A,(HL)        ; Side effect of this routine, save
  651.     INC    HL        ;   middle extent character for possible
  652.     CALL    TYPE        ;   later analysis
  653.     AND    05FH        ; Upper-case to be sure
  654.     LD    (EXTCHR),A    ; Save for later analysis
  655.     LD    A,(HL)        ; Type the 3rd and final extent char.
  656.     INC    HL
  657.     CALL    TYPE
  658.     RET
  659. ;
  660. ;-----------------------------------------------------------------------
  661. ;
  662. CORUPT:    LD    DE,CORMSG    ; Type "library file corrupt", and exit
  663.     CALL    MESAGE
  664.     JP    EXIT        ; Return to CCP
  665. ;
  666. ;-----------------------------------------------------------------------
  667. ;
  668. BLANK3:    LD    A,' '        ; Type 3 blanks to the console
  669.     CALL    TYPE
  670. ;
  671. BLANK2:    LD    A,' '        ; Likewise 2 bytes
  672.     CALL    TYPE
  673. ;
  674. BLANK1:    LD    A,' '        ; A single oarty
  675.     CALL    TYPE
  676.     RET
  677. ;
  678. ;-----------------------------------------------------------------------
  679. ;
  680. ; Convert a binary number to four ASCII characters and type them, right
  681. ; justified.
  682. ;
  683. DECOUT:    CALL    DIV10        ; Divide original # (in HL), by 10
  684.     LD    A,L        ; Get remainder from L, (0-9)
  685.     PUSH    AF        ; Save in reverse order retrieval later
  686.     EX    DE,HL        ; Old dividend becomes new divisor
  687.     CALL    DIV10        ; Repeat 3 more times
  688.     LD    A,L
  689.     PUSH    AF
  690.     EX    DE,HL
  691.     CALL    DIV10
  692.     LD    A,L
  693.     PUSH    AF
  694.     EX    DE,HL
  695.     CALL    DIV10
  696.     LD    A,L
  697.     PUSH    AF
  698.     EX    DE,HL
  699.     LD    B,3        ; Becomes loop counter
  700.     LD    C,0EFH        ; Mask to convert zeroes to blanks
  701. ;
  702. DECLP:    POP    AF        ; Type the 4 digits, with leading 0
  703.                 ;    suppression
  704.     OR    A        ; Is it zero?
  705.     JR    Z,LVMASK    ; Leave mask set if so
  706.     LD    C,0FFH        ; Else cancel masking (0FF zeroes to
  707.                 ;    blanks)
  708. ;
  709. LVMASK:    ADD    A,'0'        ; Convert to ASCII
  710.     AND    C        ; Possibly blank a zero
  711.     CALL    TYPE        ; Output the character
  712.     DJNZ    DECLP        ; Do the first 3 digits
  713. ;
  714.     POP    AF        ; Last digit is easy, never blank it
  715.     ADD    A,'0'        ; Convert to ACSII
  716.     CALL    TYPE        ; Type it and return
  717.     RET
  718. ;
  719. ;-----------------------------------------------------------------------
  720. ;
  721. DIV10:    EX    DE,HL        ; Divide 16 bit value in HL by 10
  722.     LD    HL,0        ; Zero the low byte
  723.     LD    BC,-10        ; We can skip the negation code
  724.     LD    A,11H        ; Iterations, 17 require to get all
  725.     JR    UM1        ;   the DE bits
  726. ;
  727. UM0:    ADC    HL,HL
  728. ;
  729. UM1:    ADD    HL,BC        ; Divide HLDE by -BC
  730.     JR    C,UM2        ; If it fits
  731.     SBC    HL,BC        ; Else restore it
  732.     OR    A        ; Make sure carry is 0
  733. ;
  734. UM2:    RL    E        ; Result bit to DE
  735.     RL    D
  736.     DEC    A
  737.     JR    NZ,UM0        ; Continue
  738.     RET
  739. ;
  740. ;-----------------------------------------------------------------------
  741. ;
  742. ; Check a library directory entry before reading it into DIRBUF.
  743. ; Returns Z if the entry is OK, NZ if it is to be skipped.
  744. ;
  745. ACTIVQ:    LD    A,(HL)        ; Must be an active member
  746.     OR    A
  747.     RET    NZ        ; Otherwise return NZ
  748.     PUSH    DE        ; Save incoming DE
  749.     LD    DE,WLDFCB    ; Point to user's wildcard
  750.     LD    A,(DE)
  751.     SUB    ' '        ; Is it blank?
  752.     JR    NZ,CHKWLD    ; If not, use it
  753.     POP    DE        ; Otherwise return Z
  754.     RET
  755. ;
  756. CHKWLD:    PUSH    HL        ; Now save incoming HL
  757.     INC    HL        ; Bump to member filename
  758.     LD    B,11        ; Check 11 bytes
  759. ;
  760. GETENT1:LD    A,(DE)        ; Check for match with wildcards
  761.     LD    C,(HL)        ; Get target char
  762.     INC    HL        ; Pt to next
  763.     INC    DE
  764.     CP    '?'        ; Wild match?
  765.     JR    Z,GETENT2
  766.     CP    C        ; Match?
  767.     JR    NZ,GETE0    ; Skip if not, return NZ
  768. ;
  769. GETENT2:DJNZ    GETENT1        ; Count down until zero
  770. ;
  771. GETE0:    POP    HL
  772.     POP    DE
  773.     RET
  774. ;
  775. ;-----------------------------------------------------------------------
  776. ;
  777. CORMSG:    DEFB    CR,LF,'+++ Library file is corrupt +++',CR,LF,'$'
  778. EMPMSG:    DEFB    CR,LF,'+++ No (matching) members found +++',CR,LF,'$'
  779. ERASE:    DEFB    BS,' ',BS,'$'
  780. ENDSIZ:    DEFB    'k  ','$'
  781. FNMSG:    DEFB    '--> ','$'    ; Precedes uncompressed filename display
  782. LBRNAM:    DEFB    'Library File = ','$'
  783. MORPRM:    DEFB    '[more] ','$'
  784. NSMSG:    DEFB    CR,LF,'+++ Library file not found +++',CR,LF,'$'
  785. ;
  786. TYPE1:    DEFB    ' Crunched','$'
  787. TYPE2:    DEFB    ' Squeezed','$'
  788. TYPE3:    DEFB    '    --   ','$'    ; [Method = "none"]
  789. ;
  790. ;-----------------------------------------------------------------------
  791. ;
  792. USAGE:    DEFB    CR,LF,'vH1',CR,LF,LF
  793.     DEFB    'To Use:  B>LDIR lbrname      '
  794.     DEFB    '<<-- no .LBR extent needed',CR,LF,LF,'$'
  795. ;
  796. HEDING:    DEFB    CR,LF
  797.     DEFB    '   Name         Length     Method      Original name'
  798.     DEFB    CR,LF
  799.     DEFB    '============   === ====   ========   ================='
  800.     DEFB    CR,LF,'$'
  801. ;
  802. ;-----------------------------------------------------------------------
  803. ;
  804. BYE5:    DEFS    1    ; Checks for presence of BYE5
  805. DIRLEN:    DEFS    2    ; Directory length, number of records
  806. INDEX:    DEFS    2    ; An RA index value to a beg of a menber file
  807. EXTCHR:    DEFS    1    ; Middle letter of filename extension saved here
  808. NFILES:    DEFS    2    ; Overall loop counter for program operation
  809. HLSAVE:    DEFS    2    ; Temp storage for HL
  810. OVFTPA:    DEFS    1    ; To monitor program case it tries to go nuts
  811. LINCTR:    DEFS    1    ; Line counter for "[more]" prompt
  812. WLDFCB:    DEFS    11    ; Safe storage for FCB2 filenametyp
  813. ;
  814.     DEFS    80H    ; Stack area for program's use
  815. ;
  816. STACK:    DEFS    2    ; CCP stack address
  817. ;
  818. DIRBUF:    DEFS    1024*19    ; (Not really part of program) - maximum memory
  819.             ;   needed for a 1024 member library
  820.     END
  821.