home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / vfiler43.lbr / VFSUBS1.LZB / VFSUBS1.LIB
Encoding:
Text File  |  1993-10-25  |  9.9 KB  |  455 lines
  1. ;===========================================================================
  2. ;
  3. ; VFSUBS1.Z80 - File Loading and Sorting and Ring Maintenance Routines
  4. ;
  5. ;===========================================================================
  6.  
  7.  
  8. ; FILELOAD loads the files into the buffer, setting up the ring
  9. ;    Return:    Z if load OK,
  10. ;        NZ if no files loaded
  11.  
  12. fileload:
  13.     call    getdpb        ; Get dpb values for f, gf, s commands
  14.     ld    hl,(ring)    ; Start --> current position of ring
  15.     ld    (ringpos),hl    ; Initialize ring pointers
  16.     ld    (ringend),hl    ; So ring is empty.
  17.     ld    (bufstart),hl    ; Preset now in case ring is empty
  18.     ld    hl,0        ; No files found (so far)
  19.     ld    (ringcnt),hl
  20.  
  21.     ld    a,1        ; 1 = get system mask.
  22.     call    filemask    ; Get system file spec.
  23.  
  24. ; Build ring with filename positioned in default FCB area
  25.  
  26.     xor    a        ; Clear search 'fcb'..
  27.     ld    (fcbext),a    ; Extent byte..
  28.     ld    (fcbrno),a    ; And record number.
  29.     ld    de,fcb        ; Default fcb for search
  30.     ld    c,srchf        ; Of first occurrence.
  31.     call    bdos
  32.     inc    a        ; 0ffh --> 00h if no file found
  33.     jr    nz,setring    ; If found, branch and build ring.
  34. noload:
  35.     inc    a        ; Indicate no files loaded.
  36.     ld    (canflg),a    ; Return non-zero for error.
  37.     ret
  38.  
  39.  
  40. ;---------------------------------------------------------------------------
  41.  
  42. ; RINGEMPT - Test ring empty, Return Zero if no files
  43.  
  44. ringempt:
  45.     push    hl        ; Save HL
  46.     ld    hl,(ringcnt)    ; Get the count
  47.     ld    a,h
  48.     or    l
  49.     pop    hl        ; Restore HL
  50.     ret
  51.  
  52. ;---------------------------------------------------------------------------
  53.  
  54. ; SETRING - Establish ring (circular list) of filenames
  55. ;     - put each found name in ring.
  56. ;     - A = offset into 'TBUFF' name storage
  57.  
  58. setring:
  59.     dec    a        ; Un-do 'inr' from above and below
  60.     rrca
  61.     rrca
  62.     rrca            ; Effectively A*32
  63.     add    a,tbuff        ; Add page offset and..
  64.     ld    l,a        ; Put address into hl.
  65.     ld    h,0
  66.  
  67.      if    remote
  68.     call    getwhl        ; If wheel is off, never show SYS files
  69.     jr    z,noshow
  70.      endif    ;remote
  71.  
  72.     ld    a,(nosysa)    ; Show $SYS files?
  73.     or    a
  74.     jr    z,showsys
  75.  
  76. noshow:
  77.     push    hl        ; Save HL
  78.     ld    de,10
  79.     add    hl,de        ; Point to $SYS attribute
  80.     ld    a,(hl)        ; Get the byte
  81.     pop    hl        ; Restore HL
  82.     rla            ; Rotate attribute into carry
  83.     ld    a,' '
  84.     jr    c,setring1    ; Skip $SYS files
  85.  
  86. showsys:
  87.     ld    a,(fcb)        ; Get drive/user designator and..
  88.     ld    (hl),a        ; Put into 'fcb' buffer.
  89.     ld    de,(ringpos)    ; Pointer to current load point in ring
  90.     ld    b,eltsiz-1    ; Move drive designator and name to ring
  91.     call    movec        ; Move attributes as well
  92.     ex    de,hl        ; De contains next load point address
  93.     push    hl
  94.     dec    hl
  95.     dec    hl
  96.     dec    hl        ; Point to R/O attribute
  97.     ld    a,128
  98.     cp    (hl)        ; Check if set
  99.     pop    hl
  100.     ld    a,' '
  101.     jr    nc,setring0    ; Not R/O
  102.     ld    a,'r'
  103. setring0:
  104.     ld    (hl),a        ; Space for potential..
  105.     inc    hl        ; Tagging of files for mass copy.
  106.     ld    (ringpos),hl    ; Store and search..
  107.  
  108.     ld    a,(maxpage)    ; Get maximum page of memory allowed.
  109.     cp    h        ; About to overflow zcpr3?
  110.     jp    c,b$size1    ; Br if above valid range.
  111.  
  112.     ld    hl,(ringcnt)    ; Another file found.
  113.     inc    hl
  114.     ld    (ringcnt),hl    ; Update file count.
  115.  
  116. setring1:
  117.     ld    c,srchn        ; For next occurrence.
  118.     ld    de,fcb        ; Filename address field
  119.     call    bdos
  120.     inc    a        ; If all done, 0ffh --> 00h.
  121.     jr    nz,setring    ; If not, put next name into ring.
  122.     call    ringempt
  123.     jr    z,noload
  124.  
  125. ; All filenames in ring -- setup ring size and copy-buffer start point
  126.  
  127.     ld    hl,(ringpos)    ; Next load point of ring is start of buffer
  128.     ld    (ringend),hl    ; Set ring end..
  129.     ld    (bufstart),hl    ; And copy-buffer start.
  130.  
  131. ;---------------------------------------------------------------------------
  132.  
  133. ; Sort ring of file entries
  134. ;   - Shell sort algoritm used
  135.  
  136. sort:
  137.  
  138. ; Bypass sort if only 1 element in ring
  139.  
  140.     ld    hl,(ringcnt)    ; Get number of files in ring
  141.     dec    hl        ; Only 1 file?
  142.     ld    a,h
  143.     or    l
  144.     jr    z,tblinz    ; Bypass sort if only one file in ring.
  145.  
  146. ; Set GAP to (power of 2 nearest CNT) - 1
  147.  
  148.     ex    de,hl        ; De = cnt
  149.     inc    de
  150.     ld    hl,4        ; Set initial gap.
  151.     jr    sort02
  152. sort01:
  153.     add    hl,hl        ; Double gap
  154. sort02:
  155.     call    cmpdehl        ; Compare current gap to cnt
  156.     jr    nc,sort01    ; Br if gap < cnt
  157.     dec    hl        ; Set gap = gap-1
  158.     ld    (ringgap),hl
  159.  
  160. ;  DO WHILE (GAP>1)
  161.  
  162.     jr    sort07
  163. sort03:
  164.     ld    hl,(ringgap)    ; Gap = gap / 2
  165.     call    shftrh
  166.     ld    (ringgap),hl
  167.  
  168. ;    DO J = 0 TO (CNT-GAP)
  169.  
  170.     ld    hl,(ringcnt)
  171.     ld    de,(ringgap)
  172.     ld    a,l
  173.     sub    e
  174.     ld    l,a
  175.     ld    a,h
  176.     sbc    a,d
  177.     ld    h,a
  178.     ld    (ringdiff),hl    ; Save (cnt-gap) for inner loop.
  179.     ld    hl,0        ; J = 0
  180. sort04:
  181.     ld    (ringj),hl
  182.     ex    de,hl        ; De = j
  183.     ld    hl,(ringdiff)    ; Hl = (cnt-gap)
  184.     call    cmpdehl        ; J > (cnt-gap)?
  185.     jr    nc,sort07    ; Br if so.
  186.  
  187. ;      DO I = J TO 0 BY (-GAP) WHILE (ENTRY(I) > ENTRY(I+GAP))
  188.  
  189.     ld    hl,(ringj)    ; I = j
  190. sort05:
  191.     ld    (ringi),hl
  192.     ld    a,h        ; Exit if i = -1
  193.     and    l
  194.     inc    a
  195.     jr    z,sort06
  196.     ex    de,hl        ; De = i
  197.     ld    hl,(ringgap)    ; Hl = gap
  198.     add    hl,de        ; De = i, hl = i+gap
  199.     call    ringcmp        ; Compare elements for potential swap.
  200.     jr    c,sort06
  201.  
  202. ;     Swap ENTRY(I) and ENTRY(I+GAP)
  203.  
  204.     call    ringswap
  205.  
  206. ;      ENDDO (I = J TO 0)
  207.  
  208.     ld    de,(ringgap)    ; I = i - gap
  209.     ld    a,d
  210.     cpl
  211.     ld    d,a
  212.     ld    a,e
  213.     cpl
  214.     ld    e,a
  215.     inc    de
  216.     ld    hl,(ringi)
  217.     add    hl,de
  218.     jr    c,sort05
  219.  
  220. ;    ENDDO (DO J = 0 TO (CNT-GAP))
  221.  
  222. sort06:
  223.     ld    hl,(ringj)    ; J=j+1
  224.     inc    hl
  225.     jr    sort04
  226.  
  227. ;  ENDDO (DO WHILE (GAP>1))
  228.  
  229. sort07:
  230.     ld    de,-2        ; Gap > 1?
  231.     ld    hl,(ringgap)
  232.     add    hl,de
  233.     jr    c,sort03
  234.  
  235. ; Sort done -- initialize tables for fast CRC calculations
  236.  
  237. tblinz:
  238.     call    initcrc
  239.  
  240. ; Calculate buffer maximum available record capacity
  241.  
  242. b$size:
  243.     ld    hl,(bdos+1)    ; Get 'bdos' entry (fbase)
  244.  
  245.      if    not warmboot
  246.     ld    de,-ccp_ln
  247.     add    hl,de
  248.      endif            ; Not warmboot
  249.  
  250.     dec    hl
  251.     ex    de,hl        ; De = highest buffer address
  252.     ld    hl,(bufstart)    ; Hl = buffer start addr (end of ring list)
  253.     ld    a,e        ; Hl = de - hl = buffer size (bytes)
  254.     sub    l
  255.     ld    l,a
  256.     ld    a,d
  257.     sbc    a,h
  258.     ld    h,a
  259.     jr    c,b$size1    ; Error if start addr > end addr
  260.  
  261.     ld    b,7+1        ; Shift hl right 7 bits
  262.     call    shiftlp        ; To divide by 128.
  263.  
  264.     ld    a,h        ; Memory available for copy?
  265.     or    l
  266.     jr    nz,b$size2    ; Yes, buffer memory space available.
  267.  
  268. b$size1:
  269.     xor    a        ; Error code
  270.     inc    a
  271.     inc    a        ; Indicate no room for files selected.
  272.     ld    (canflg),a    ; Return non-zero for error.
  273.     ret
  274.  
  275. b$size2:
  276.     ld    (rec$max),hl    ; Store maximum record count.
  277.     xor    a        ; Return z for ok
  278.     ld    (canflg),a
  279.     ret
  280.  
  281. ;------------------------------
  282.  
  283. ; RINGCMP - Compare Ring Elements
  284. ;    - DE - First element number
  285. ;    - HL - Second element number
  286.  
  287. ringcmp:
  288.     call    ringaddr    ; Get address of element in hl
  289.     ex    de,hl
  290.     call    ringaddr    ; Get address of element in de
  291.     ex    de,hl
  292.     push    hl        ; Save position pointers..
  293.     push    de        ; For potential swap.
  294.     ld    a,(defalfa)    ; Check for type of alphabetization
  295.     or    a        ; If zero, alpha by type and name
  296.     jr    z,sorttn
  297.  
  298. ; sort by file name and type
  299.  
  300.     ld    b,12        ; # of characters to compare
  301.     call    cmpstr        ; Do comparison
  302.     jr    nocmp        ; Final test
  303.  
  304. ;------------------------------
  305.  
  306. ; sort by file type and name
  307.  
  308. sorttn:
  309.     push    hl        ; Save ptrs
  310.     push    de
  311.     ld    bc,9        ; Pt to type
  312.     add    hl,bc
  313.     ex    de,hl
  314.     add    hl,bc
  315.     ex    de,hl
  316.     ld    b,3        ; 3 chars in file type
  317.     call    cmpstr        ; Compare type
  318.     pop    de        ; Get ptrs
  319.     pop    hl
  320.     jr    nz,nocmp    ; Final test
  321.     push    hl
  322.     push    de
  323.     ld    b,8        ; 8 chars in file name
  324.     inc    hl        ; Pt to first
  325.     inc    de
  326.     call    cmpstr        ; Compare name
  327.     pop    de        ; Get ptrs
  328.     pop    hl
  329.     jr    nz,nocmp    ; Final test
  330.     call    cmpdh        ; Ignore attribute
  331.  
  332. ;------------------------------
  333.  
  334. ; final test for swapping purposes
  335.  
  336. nocmp:
  337.     pop    de
  338.     pop    hl
  339.     ret
  340.  
  341. ;------------------------------
  342.  
  343. ; RINGADDR  - Get address of Ring Element
  344. ;    - HL = Element number
  345. ;
  346. ; Note - assumes ELTSIZ = 13
  347.  
  348. ringaddr:
  349.     push    bc        ; Save work regs
  350.     push    de
  351.  
  352.     ld    b,h        ; Bc = hl
  353.     ld    c,l
  354.     add    hl,hl        ; Hl = hl * 2
  355.     add    hl,bc        ; * 3
  356.     add    hl,hl        ; * 6
  357.     add    hl,hl        ; * 12
  358.     add    hl,bc        ; * 13
  359.     ld    de,(ring)    ; Get ring start address
  360.     add    hl,de        ; Point to array element
  361.  
  362.     pop    de        ; Restore work regs
  363.     pop    bc
  364.     ret
  365.  
  366. ;------------------------------
  367.  
  368. ; RINGSWAP - Swap ring elements
  369. ;    - HL -> first element
  370. ;    - DE -> second element
  371.  
  372. ringswap:
  373.     ld    b,eltsiz    ; Length of element to swap
  374. swap:
  375.     ld    c,(hl)        ; Get character from one string..
  376.     ld    a,(de)        ; And one from other string.
  377.     ld    (hl),a        ; Second into first
  378.     ld    a,c        ; First into second
  379.     ld    (de),a
  380.     inc    hl        ; Bump swap pointers
  381.     inc    de
  382.     djnz    swap
  383.     ret
  384.  
  385. ;------------------------------
  386.  
  387. ; CMPSTR- left to right compare of two strings
  388. ;     DE -> to 'a' string,
  389. ;     HL -> to 'b' string,
  390. ;     B     contains string length.)
  391.  
  392. cmpstr:
  393.     call    cmpdh
  394.     ret    nz        ; If not equal, set flag.
  395.     inc    hl        ; Bump compare..
  396.     inc    de        ; Pointers and do next character.
  397.     djnz    cmpstr        ; If done compare, strings are equal
  398.     ret
  399.  
  400. ;------------------------------
  401.  
  402. ; CMPDH - Make comparison without regard to the attribute bit
  403.  
  404. cmpdh:
  405.     push    bc        ; Save BC
  406.     ld    c,7fh        ; Mask
  407.     ld    a,(hl)        ; B character
  408.     and    c        ; Strip attribute
  409.     ld    b,a        ; Save it
  410.     ld    a,(de)        ; A character
  411.     and    c        ; Strip attribute
  412.     cp    b        ; Set flags, carry if B > A
  413.     pop    bc        ; Restore BC
  414.     ret
  415.  
  416. ;---------------------------------------------------------------------------
  417.  
  418. ; FILELERR - Process File Load Error
  419.  
  420. ; - No files in current DIR (or not enough Storage to hold them)
  421. ;    Report it on the error line
  422.  
  423. filelerr:
  424.     ld    a,(canflg)    ; Get log-cancel flag
  425.     or    a
  426.     jr    nz,filerr2    ; Br if not from fileload
  427.     call    ermsg        ; Due to movdone (canflag = 0)
  428.     db    'List Empty',0
  429.     ret
  430.  
  431. filerr2:
  432.     dec    a        ; Was canflg = 1?
  433.     jr    nz,filerr3    ; Br if not
  434.     call    ermsg        ; Due to fileload (canflg = 1)
  435.     db    'No File Found',0
  436.     ret
  437.  
  438. filerr3:
  439.     call    ermsg        ; Due to fileload (canflg = 2)
  440.     db    'No Room for file list',0
  441.     ret
  442.  
  443. ;---------------------------------------------------------------------------
  444.  
  445. ; RINGFCB - Copy filename from RINGPOS to SFCB
  446. ;        - Initialize FCB
  447.  
  448. ringfcb:
  449.     ld    hl,(ringpos)    ; Move name from ring to source 'fcb'
  450.     ld    de,s$fcb    ; Place to move filename and..
  451.     ld    b,12        ; Amount to move (fall thru to move)
  452.     call    movec        ; Set the file name, type and attributes
  453.     ld    de,s$fcb    ; Get fcb address again
  454.     jp    initfcb        ; Initialize fcb and return.
  455.