home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / RCPM / SFILE31.LBR / SFILE31.AQM / SFILE31.ASM
Assembly Source File  |  2000-06-30  |  49KB  |  2,315 lines
  1. ; SFILE31.ASM - SuperFILE v31 for CP/M-80 - October 4, 1986
  2. ;
  3. ;
  4. ;          NOTE: Read the SFILE.HIS file to follow
  5. ;            the ongoing history of this pgm.
  6. ;
  7. ;
  8. ;          NOTE: This version assembles with
  9. ;            ASM, LASM, MAC, M80 or SLRMAC
  10. ;
  11. ;
  12. ;    ASEG        ; Needed by the M80 assembler, ignore for others
  13. ;
  14. VER:    EQU    31    ; Version 3.1 86/09/04
  15. ;
  16. ; This program allows full wildcard searches of the directories and all
  17. ; library files on a CP/M system for a requested file, starting at A0:
  18. ; The user can optionally specify a single drive to be searched by in-
  19. ; cluding the drive name as a prefix to the search file.  This is based
  20. ; on SD-81, so credit is given to the MANY people that have worked on it
  21. ; in the past.
  22. ;
  23. ; This program is particularly beneficial on a RCPM with a large disk
  24. ; system.  You may wish to do the following:
  25. ;
  26. ;         FILE.COM   -    set CKLBR option to NO
  27. ;         SFILE.COM  -    set CKLBR option to YES
  28. ;
  29. ; This gives the users two separate programs to use - on large systems,
  30. ; it may take as long as 5-6 minutes to find a program if using SFILE,
  31. ; while searching for the same program may only take 30-40 seconds with
  32. ; FILE.
  33. ;
  34. ; Entering SFILE<ret> or SFILE ?<ret> will display a brief help message.
  35. ;
  36. ; The USER AREA PATCH TABLE is the same as in SD - if 0FFH is placed in
  37. ; an user location, that drive will be skipped.  This makes it possible
  38. ; to use the program on multi-disk systems where the drive numbers are
  39. ; not necessarily sequential.
  40. ;
  41. ; The program can now be optionally assembled to support named directories.
  42. ; If the RCPM uses 'CD <area_name>' (or something similar) to change areas,
  43. ; then the program will report the name of the area rather than d/u.  The
  44. ; list of directoriy names is currently 'hard wired' into the program and
  45. ; must be updated each time the area names are changed.  Name tables begin
  46. ; at ATABLE:; there is one table for each drive available and pointers to
  47. ; these tables must be inserted at PTRTBL:.
  48.  
  49. ;=======================================================================
  50. ;            current revision
  51. ;
  52. ; 86/03/12  Added  option to display area names instead of  d/u.   Many 
  53. ;   v30     RCPM's now use CD.COM or similar utilities to change  areas 
  54. ;           on  the hard disk.   This makes d/u display of found  files 
  55. ;           rather  useless.   Names  must  be hardwired into  code  at 
  56. ;           locations ATABLE:,  BTABLE:, etc and pointers to each table 
  57. ;           at  PTRTBL:.   Also expanded 'ck' to 'checking';  too  many 
  58. ;           users asking "What does ck mean?"
  59. ;                                       - Ian Cottrell
  60. ;                                         ICBBS
  61. ;                                         613-990-9774
  62. ;
  63. ;=======================================================================
  64. ;
  65. ;
  66. NO    EQU    0
  67. YES    EQU    NOT NO        ; (Cannot be 0FFH for some assemblers)
  68. ;
  69. CR    EQU    0DH
  70. LF    EQU    0AH
  71. ESC    EQU    1BH
  72. ;
  73. ;
  74. ; To skip or include library searches
  75. ;
  76. CKLBR    EQU    YES        ; YES to include .LBR searches
  77.                 ; NO  to skip looking in .LBR files
  78.                 ;    (then name that version FILE.COM)
  79. ;
  80. ; ZCPR Compatibility - disregard MAXD and MAXU if ZCPR is NO
  81. ;
  82. ZCPR    EQU    NO        ; YES = ZCPR/BYE used for MAX D/U
  83. MAXD    EQU    3DH        ; Set to max drive location _/ /
  84. MAXU    EQU    3FH        ; Set to max user location ___/
  85. ;
  86. ;
  87. ; To skip or include $SYS search and/or WHEEL check
  88. ;
  89. CKSYS    EQU    NO        ; YES to include system files
  90. CKWHL    EQU    NO        ; YES if you use the WHEEL
  91. WHEEL    EQU    3EH        ; Normal WHEEL byte location
  92. ;
  93. ;
  94. ; To display $SYS or R/O files that have attributes set, in lower-case.
  95. ;
  96. USELC    EQU    YES        ; YES to show attribute(s) in lower case
  97. ;
  98. ;
  99. ; To use area names instead of DU:
  100. ;
  101. ;
  102. NAMDIR    EQU    YES        ; YES to use directory names
  103.                 ; Be sure to change ATABLE:, BTABLE:, etc
  104.                 ; to reflect the area names on your system
  105. ;
  106. ; BDOS equates
  107. ;
  108. BDOS    EQU    0005H
  109. FCB    EQU    005CH
  110. TBUF    EQU    0080H
  111. ;
  112. RDCHR    EQU    1        ; Read character from console
  113. WRCHR    EQU    2        ; Write character to console
  114. PRINTS    EQU    9        ; Print string
  115. CONST    EQU    11        ; Check console status
  116. RESET    EQU    13        ; Reset disk system
  117. SELDSK    EQU    14        ; Select disk
  118. OPEN    EQU    15        ; 0FFH = not found
  119. CLOSE    EQU    16        ;   "      "    "
  120. SEARCH    EQU    17        ;   "      "    "
  121. NEXT    EQU    18        ;   "      "    "
  122. READ    EQU    20        ; Not 0 = EOF
  123. WRITE    EQU    21        ; Not 0 = disk full
  124. MAKE    EQU    22        ; 0FFH    = directory full
  125. CURDSK    EQU    25        ; Get currently logged disk name
  126. SETDMA    EQU    26        ; Set current DMA
  127. GALLOC    EQU    27        ; Get address of allocation vector
  128. CURDPB    EQU    31        ; Get current disk parameters
  129. CURUSR    EQU    32        ; Get currently logged user number
  130. READRN    EQU    33        ; Get random read
  131. RECORD    EQU    36        ; Set random record number
  132. ;
  133. ARCMAR    EQU    26        ; Archive header marker byte
  134. HDRSIZ    EQU    27        ; Header size for archive (-4 if version = 1)
  135. FCR    EQU    32
  136. FRN    EQU    33
  137. ;
  138. ;
  139.     ORG    0100H
  140. ;
  141.     JMP    START
  142. ;
  143. ;
  144. ;-----------------------------------------------------------------------
  145. ;
  146. ; Drive/user area lookup table
  147. ;
  148. ; Configure the following table for your specific needs.  CP/M v2.2 can
  149. ; have 16 user areas (0-15), but ZCPR3 extends this to 32 user areas
  150. ; (0-31).  If the ZCPR equate is set YES, you can totally disregard the
  151. ; following table, if the CLWHL is also set YES.
  152. ;
  153. ; Assuming ZCPR is set NO, then insert the maximum user area allowed for
  154. ; each drive.  Put a 0FFH for all drives that are not available.  This
  155. ; allows use of non-sequential drive systems.
  156. ;
  157. ; With the CKWHL equate set YES, all user areas available will then be
  158. ; searched, regardless what is placed into the following table, when the
  159. ; WHEEL byte is set high by ZCPR.
  160. ;
  161. LODRV    EQU    $        ; Mark beginning of drive/user table
  162. ;
  163.     DB    1        ; 1)  A: drive maximum user area
  164.     DB    0FFH        ; 2)  B: drive maximum user area
  165.     DB    0FFH        ; 2)  C: drive maximum user area
  166.     DB    0FFH        ; 2)  D: drive maximum user area
  167.     DB    0FFH        ; 2)  E: drive maximum user area
  168.     DB    0FFH        ; 2)  F: drive maximum user area
  169.     DB    0FFH        ; 2)  G: drive maximum user area
  170.     DB    0FFH        ; 2)  H: drive maximum user area
  171.     DB    0FFH        ; 2)  I: drive maximum user area
  172.     DB    0FFH        ; 2)  J: drive maximum user area
  173.     DB    0FFH        ; 2)  K: drive maximum user area
  174.     DB    0FFH        ; 2)  L: drive maximum user area
  175.     DB    0FFH        ; 2)  M: drive maximum user area
  176.     DB    0FFH        ; 2)  N: drive maximum user area
  177.     DB    0FFH        ; 2)  O: drive maximum user area
  178.     DB    15        ; 2)  P: drive maximum user area
  179. ;
  180. HIDRV    EQU    $        ; Mark end of drive/user table
  181. ;
  182. ;
  183. ;-----------------------------------------------------------------------
  184. ;
  185. ;            Program starts here
  186. ;
  187. ;-----------------------------------------------------------------------
  188. ;
  189. ;
  190. START:    LXI    H,0
  191.     DAD    SP        ; HL=old stack
  192.     SHLD    STACK        ; Save it
  193.     LXI    SP,STACK    ; Get new stack
  194. ;
  195.     XRA    A
  196.     STA    FNDFLG        ; Clear file found flag
  197.     STA    NEWUSR        ; Make new user = 0
  198.     STA    BASUSR        ; Duplicate it if multi-disk mode
  199.     MVI    C,48        ; Get ZRDOS version
  200.     CALL    BDOS
  201.     MOV    A,L
  202.     STA    ZRDFLG        ; Save it
  203.     MVI    C,12        ; Get and save the CP/M version #
  204.     CALL    BDOS
  205.     MOV    A,L
  206.     STA    VERFLG
  207.     STA    DOPFLG        ; Do not allow multi-drive yet
  208.     CPI    20H        ; Set carry if CP/M 1.4
  209.     JC    VERERR        ; Exit on earlier than 2.0
  210.     LXI    H,FCB+1        ; Point to name
  211.     MOV    A,M        ; Any specified?
  212.     CPI    ' '
  213.     JZ    GUIDE        ; So print help guide
  214.     CPI    '?'
  215.     JNZ    START1
  216.     LDA    FCB+2        ; Question mark by itself?
  217.     CPI    ' '
  218.     JZ    GUIDE        ; If yes, print help guide
  219. ;
  220. START1:    PUSH    H        ; Save FCB address
  221.     LXI    D,SEARN        ; Point to search name holding area
  222.     MVI    B,11        ; Size of file name, type
  223.     CALL    MOVE        ; Move it
  224.     POP    H        ; Restore fcb address
  225.     MVI    E,0FFH        ; Get current user number
  226.     MVI    C,CURUSR
  227.     CALL    CPM
  228.     STA    OLDUSR        ; Initialize startup user number
  229. ;
  230. CLNON:    MVI    C,CURDSK
  231.     CALL    CPM        ; Get current disk number
  232.     STA    OLDDSK        ; Save for reset if needed
  233.     LXI    H,FCB
  234.     MOV    A,M        ; Get drive name for directory search
  235.     ORA    A        ; Any specified?
  236.     JNZ    START2        ; Yes skip next routine
  237.     XRA    A
  238.     STA    DOPFLG        ; Ok let multi-drive in
  239.     MVI    A,1        ; Otherwise, get disk 'A:'
  240. ;
  241. START2:    MOV    M,A        ; Put the absolute drive code in FCB
  242. ;
  243. CKREST:    LXI    D,SIGNON
  244.     CALL    PRINT
  245. ;
  246.      IF    CKWHL
  247.     LDA    WHEEL        ; WHEEL set?
  248.     ORA    A
  249.     JZ    CKRST1        ; NO - don't bother with $SYS files
  250.      ENDIF            ; CKWHL
  251. ;
  252.      IF    CKSYS OR CKWHL
  253.     LXI    D,SIGN1
  254.     CALL    PRINT
  255.      ENDIF            ; CKSYS OR CKWHL
  256.  
  257. CKRST1:    LXI    D,SIGN2
  258.     CALL    PRINT
  259. ;
  260.     LDA    DOPFLG
  261.     ORA    A
  262.     CZ    SWAPEM        ; Swap BDOS error vector tables
  263. ;
  264. ;
  265. ; Validate drive code and user area numbers from the drive table
  266. ;
  267. NOOPT:    LXI    D,DRVMSG    ; Get the drive/user error message
  268.     PUSH    D
  269.     LDA    FCB        ; Get directory drive code
  270.     DCR    A        ; Normalize to range of 0-15 drives
  271. ;
  272.      IF    NOT ZCPR
  273.     CPI    HIDRV-LODRV    ; Compare with maximum drives on-line
  274.     JNC    ERXIT        ; Take drive error exit if out of range
  275.      ENDIF            ; NOT ZCPR
  276. ;
  277.      IF    ZCPR
  278.     LXI    H,MAXD        ; Adddress to HL
  279.     MOV    L,M        ; MAXD to L
  280.     INX    H        ; Add one
  281.     CMP    L        ; Check it
  282.     JNC    EX0        ; Exit if out of range
  283.      ENDIF            ; ZCPR
  284. ;
  285.     LXI    H,USRMSG    ; Switch to user # error message
  286.     XTHL
  287.     MOV    E,A        ; Use drive code as index into table
  288.     MVI    D,0
  289. ;
  290.      IF    NOT ZCPR
  291. USRCK:    LXI    H,LODRV        ; Point to base of drive/user table
  292.     DAD    D
  293.     MOV    A,M        ; Get the maximum user # for this drive
  294.     CPI    0FFH        ; Check for skip drive
  295.     JZ    ERXIT        ; Exit if not wanted
  296.      ENDIF            ; NOT ZCPR
  297. ;
  298.      IF    ZCPR
  299.     LDA    MAXU
  300.     SUI    1
  301.      ENDIF            ; ZCPR
  302. ;
  303. USRCK2:    ANI    1FH        ; Make sure its in range 0-31
  304.     STA    MAXUSR        ; Save it for later
  305.     LXI    H,NEWUSR    ; Point to the directory user area
  306.     CMP    M        ; Compare it with the maximum
  307.     JC    ERXIT        ; Take error exit if user number illegal
  308.     POP    D        ; Destroy error message pointer
  309.     LXI    H,FCB+1        ; Point to name
  310. ;
  311. ;
  312. ; Make FCB all '?' to search for every file
  313. ;
  314. WCD:    MVI    B,11        ; Filename + filetype count
  315. ;
  316. QLOOP:    MVI    M,'?'        ; Store '?' in FCB
  317.     INX    H
  318.     DCR    B
  319.     JNZ    QLOOP
  320. ;
  321. GOTFCB:    MVI    A,'?'        ; Force wild extent
  322.     STA    FCB+12
  323.     CALL    SETSRC        ; Set DMA for BDOS media change check
  324.     LXI    H,FCB        ; Point to fcb drive code for directory
  325.     MOV    E,M        ; Get the drive code out of the FCB
  326.     DCR    E        ; Normalize drive code for select
  327.     MVI    C,SELDSK    ; Select the directory drive to retrieve
  328.     CALL    CPM        ; The proper allocation vector
  329.     MVI    C,CURDPB    ; It is 2.x or MP/M...request DPB
  330.     CALL    BDOS
  331.     INX    H
  332.     INX    H
  333.     MOV    A,M        ; Get block shift
  334.     STA    BLKSHF
  335.     INX    H        ; Bump to block mask
  336.     MOV    A,M
  337.     STA    BLKMSK        ; Get it
  338.     INX    H
  339.     INX    H
  340.     MOV    E,M        ; Get max block #
  341.     INX    H
  342.     MOV    D,M
  343.     XCHG
  344.     SHLD    BLKMAX        ; Save it
  345.     XCHG
  346.     INX    H
  347.     MOV    E,M        ; Get directory size
  348.     INX    H
  349.     MOV    D,M
  350.     XCHG
  351.     SHLD    DIRMAX        ; Save max # of entries in directory
  352. ;
  353. ;
  354. ; Re-enter here on subsequent passes while in the all-users mode
  355. ;
  356. SETTBL:    LDA    FCB
  357.  
  358.      IF    NOT NAMDIR
  359.     ADI    'A'-1
  360.     STA    PROC1
  361.     LXI    D,PROCES    ; Show the user what area is being
  362.     CALL    PRINT        ;   worked on
  363.     LDA    NEWUSR
  364.     STA    LSTUSR
  365.     CALL    TYPUSR
  366.     LXI    D,PROC2
  367.     CALL    PRINT
  368.      ENDIF            ; NOT NAMDIR
  369.  
  370.      IF    NAMDIR
  371.     CALL    PRTNAM
  372.     LXI    D,PROCES
  373.     CALL    PRINT
  374.      ENDIF            ; NAMDIR
  375.  
  376. ;
  377. SETTB1:    LHLD    DIRMAX        ; Get directory maximum again
  378.     INX    H        ; Directory size is DIRMAX+1
  379.     DAD    H        ; Double directory size
  380.     LXI    D,ORDER        ; To get size of order table
  381.     DAD    D        ; Allocate order table
  382.     SHLD    TBLOC        ; Name table begins after order table
  383.     SHLD    NEXTT
  384.     XCHG
  385.     LHLD    BDOS+1        ; Make sure we have room to continue
  386.     MOV    A,E
  387.     SUB    L
  388.     MOV    A,D
  389.     SBB    H
  390.     JNC    OUTMEM
  391.     LDA    NEWUSR        ; Get user area for directory
  392.     MOV    E,A
  393.     MVI    C,CURUSR    ; Get the user function
  394.     CALL    CPM        ; And set new user number
  395. ;
  396. ;
  397. ; Look up the FCB in the directory
  398. ;
  399.     MVI    A,'?'
  400.     LXI    H,FCB+12
  401.     MOV    M,A        ; Match all extents
  402.     INX    H
  403.     MOV    M,A        ; Match all S1 bytes
  404.     INX    H
  405.     MOV    M,A        ; Match all S2 bytes
  406.     LXI    H,0
  407.     SHLD    COUNT        ; Initialize match counter
  408.     CALL    SETSRC        ; Set DMA for directory search
  409.     MVI    C,SEARCH    ; Get 'SEARCH FIRST' function
  410.     JMP    LOOK        ; And go search for 1st match
  411. ;.....
  412. ;
  413. ;
  414. ; Read more directory entries
  415. ;
  416. MORDIR:    MVI    C,NEXT        ; Search next
  417. ;
  418. LOOK:    LXI    D,FCB
  419.     CALL    CPM        ; Read directory entry
  420.     INR    A        ; Check for end (0FFH)
  421.     JZ    SPRINT        ; If no more, sort & print what we have
  422. ;
  423. ;
  424. ; Point to directory entry
  425. ;
  426. SOME:    DCR    A        ; Undo prev 'INR A'
  427.     ANI    3        ; Make modulus 4
  428.     ADD    A        ; Multiply by 32 as each entry is 32
  429.     ADD    A        ;   bytes long
  430.     ADD    A
  431.     ADD    A
  432.     ADD    A
  433.     LXI    H,TBUF+1    ; Point to buffer (skip to filename)
  434.     ADD    L        ; Point to entry
  435.     ADI    9        ; Point to .SYS byte
  436.     MOV    L,A        ; Save (can't carry to 'H')
  437. ;
  438.      IF    CKWHL
  439.     LDA    WHEEL        ; WHEEL set?
  440.     ORA    A
  441.     JNZ    SYSFOK        ; YES - show $SYS files, too
  442.      ENDIF            ; CKWHL
  443. ;
  444.      IF    CKSYS AND (NOT CKWHL)
  445.     JMP    SYSFOK        ; Show system files too
  446.      ENDIF            ; CKSYS AND (NOT CKWHL)
  447. ;
  448.     MOV    A,M        ; Get .SYS byte
  449.     ORA    A        ; Check bit 7
  450.     JM    MORDIR        ; Skip that file
  451. ;
  452. SYSFOK:    MOV    A,L        ; Go back now
  453.     SUI    10        ; Back to user number (allocation flag)
  454.     MOV    L,A        ; Hl points to entry now
  455.     LDA    NEWUSR        ; Get current user
  456.     CMP    M
  457.     JNZ    MORDIR        ; Ignore if different
  458.     INX    H
  459. ;
  460. ;
  461. ; Move entry to table
  462. ;
  463.     XCHG            ; Entry to DE
  464.     LHLD    NEXTT        ; Next table entry to HL
  465.     MVI    B,11        ; Entry length (name, type, extent)
  466. ;
  467. TMOVE:    LDAX    D        ; Get entry character
  468. ;
  469.      IF    NOT USELC
  470.     ANI    7FH        ; Remove attributes
  471.      ENDIF            ; NOT USELC
  472. ;
  473.     MOV    M,A        ; Store in table
  474.     INX    D
  475.     INX    H
  476.     DCR    B        ; More?
  477.     JNZ    TMOVE
  478.     INX    D        ; DE->> S1
  479.     INX    D        ; DE->> S2
  480.     LDAX    D        ; Get S2 byte, overflow=int(extents/32)
  481.     PUSH    H        ; Save HL
  482.     MOV    L,A        ; Set up 16-bit multiply
  483.     MVI    H,0
  484.     MVI    B,5
  485.     CALL    SHLL        ; HL is now # of overflow extents
  486.     DCX    D        ; DE->> S1
  487.     DCX    D        ; DE->> extent
  488.     LDAX    D        ; Get extent
  489.     ADD    L
  490.     MOV    L,A
  491.     MOV    A,H
  492.     ACI    0
  493.     MOV    H,A        ; HL now has total extents
  494.     MVI    B,7
  495.     CALL    SHLL        ; HL now has total records less last ext
  496.     INX    D        ; DE->> S1
  497.     INX    D        ; DE->> S2
  498.     INX    D        ; Point to record count
  499.     LDAX    D        ; Get it
  500.     ADD    L
  501.     MOV    L,A
  502.     MOV    A,H
  503.     ACI    0
  504.     MOV    H,A        ; HL now has total records
  505.     XTHL            ; Do some fancy shuffling
  506.     XCHG
  507.     XTHL
  508.     XCHG
  509.     MOV    M,D
  510.     INX    H
  511.     MOV    M,E
  512.     POP    D        ; All back to normal
  513.     INX    H
  514.     SHLD    NEXTT        ; Save updated table address
  515.     XCHG
  516.     LHLD    COUNT        ; Bump the # of matches made
  517.     INX    H
  518.     SHLD    COUNT
  519.     LXI    H,13        ; Size of next entry
  520.     DAD    D
  521.     XCHG            ; Future NEXTT is in DE
  522.     LHLD    BDOS+1        ; Pick up TPA end
  523.     MOV    A,E
  524.     SUB    L        ; Compare NEXTT-TPA end
  525.     MOV    A,D
  526.     SBB    H
  527.     JC    MORDIR        ; If TPA end > NEXTT, loop back for more
  528. ;
  529. OUTMEM:    CALL    ERXIT        ; Exit if directory too large
  530.     DB    'Memory',0
  531. ;.....
  532. ;
  533. ;
  534. ;-----------------------------------------------------------------------
  535. ;        s  u  b  r  o  u  t  i    n  e  s
  536. ;-----------------------------------------------------------------------
  537. ;
  538. ;
  539. ; Fetch character from console (without echo)
  540. ;
  541. CINPUT:    LHLD    0001H
  542.     MVI    L,9
  543.     CALL    GOHL
  544.     ANI    7FH
  545.     RET
  546. ;.....
  547. ;
  548. ;
  549. ; Check for a CTL-C or CTL-S entered from the keyboard.  Jump to exit
  550. ; if CTL-C, pause on CTL-S.
  551. ;
  552. CKABRT:    LHLD    0001H
  553.     MVI    L,6        ; Check status of keyboard
  554.     CALL    GOHL        ; Any key pressed?
  555.     ORA    A
  556.     RZ            ; No, return to caller
  557.     CALL    CINPUT        ; Get character
  558.     CPI    'C'-40H        ; CTL-C?
  559.     JZ    EX0        ; If yes then quit
  560.     CPI    'X'-40H        ; CTL-X?
  561.     JZ    EX0        ; If yes then quit
  562.     CPI    'S'-40H        ; CTL-S?
  563.     RNZ            ; No, return to caller
  564.     CALL    CINPUT        ; Yes, wait for another char.
  565.     CPI    'C'-40H        ; Might be CTL-C
  566.     JZ    EX0        ; If yes then quit
  567.     CPI    'X'-40H        ; Might be CTL-X
  568.     JZ    EX0        ; If yes fall through and continue
  569.     RET
  570. ;.....
  571. ;
  572. ;
  573. ; Test file extent for LBR
  574. ;
  575. CKLBRY:    PUSH    H
  576.     PUSH    D
  577.     PUSH    B
  578.     XCHG
  579.     LXI    H,LBRTYP
  580.     MVI    C,3
  581. ;
  582. CKLBL:    LDAX    D
  583.     ANI    7FH
  584.     CMP    M
  585.     JNZ    CKLBX
  586.     INX    H
  587.     INX    D
  588.     DCR    C
  589.     JNZ    CKLBL
  590. CKLBX:    POP    B
  591.     POP    D
  592.     POP    H
  593.     RET
  594. ;.....
  595. ;
  596. ;
  597. ; Test file extent for ARC
  598. ;
  599. CKARC:    PUSH    H
  600.     PUSH    D
  601.     PUSH    B
  602.     XCHG
  603.     LXI    H,ARCTYP
  604.     MVI    C,3
  605. ;
  606. CKARL:    LDAX    D
  607.     ANI    7FH
  608.     CMP    M
  609.     JNZ    CKARX
  610.     INX    H
  611.     INX    D
  612.     DCR    C
  613.     JNZ    CKARL
  614. ;
  615. CKARX:    POP    B
  616.     POP    D
  617.     POP    H
  618.     RET
  619. ARCTYP:    DB    'ARC'
  620. ;.....
  621. ;
  622. ;
  623. ; Check to see if there indeed is a library file directory
  624. ;
  625. CKLDIR:    MVI    B,11        ; Length of file name
  626.     MVI    A,' '        ; Space
  627.     INX    H
  628. ;
  629. CKDLP:    CMP    M
  630.     JNZ    LMLEXI
  631.     DCR    B
  632.     INX    H
  633.     JNZ    CKDLP
  634. ;
  635. ;
  636. ; The first entry in the LBR directory is indeed blank.  Now see if the
  637. ; directory size is >0
  638. ;
  639.     MOV    E,M        ; File starting location low
  640.     INX    H        ; Must be zero here
  641.     MOV    A,M        ; File starting location high
  642.     ORA    E        ; Must be zero here also
  643.     JNZ    LMLEXI
  644.     INX    H
  645.     MOV    E,M        ; Get library size low
  646.     INX    H        ; Point to library size high
  647.     MOV    D,M        ; Get library size high
  648.     MOV    A,D
  649.     ORA    E        ; Library must have some size
  650.     JZ    LMLEXI
  651.     DCX    D
  652.     XCHG
  653.     SHLD    SLFILE
  654.     MVI    B,3
  655.     LXI    H,17
  656.     DAD    D
  657.     PUSH    H
  658.     LHLD    TLIBRA
  659.     INX    H
  660.     SHLD    TLIBRA
  661.     POP    H
  662.     JMP    LMTEST
  663. ;.....
  664. ;
  665. ;
  666. ; New compare routine
  667. ;
  668. COMPARE:LXI    B,ORDER-2
  669.     DAD    H
  670.     DAD    B
  671.     XCHG
  672.     DAD    H
  673.     DAD    B
  674.     XCHG
  675.     MOV    C,M
  676.     INX    H
  677.     MOV    B,M
  678.     XCHG
  679.     MOV    E,M
  680.     INX    H
  681.     MOV    D,M
  682.     XCHG
  683.     MOV    E,A        ; Count
  684. ;
  685. CMPLPE:    MOV    A,M
  686.     ANI    7FH
  687.     MOV    D,A
  688.     LDAX    B
  689.     ANI    7FH
  690.     CMP    D
  691.     INX    B
  692.     INX    H
  693.     RNZ
  694.     DCR    E
  695.     JNZ    CMPLPE
  696.     RET
  697. ;.....
  698. ;
  699. ;
  700. ; Compare routine for sort
  701. ;
  702. COMPR:    PUSH    H        ; Save table address
  703.     MOV    E,M        ; Load low order
  704.     INX    H
  705.     MOV    D,M        ; Load high order
  706.     INX    H
  707.     MOV    C,M
  708.     INX    H
  709.     MOV    B,M
  710. ;
  711. ;
  712. ; BC, DE now point to entries to be compared
  713. ;
  714.     XCHG
  715.     MOV    E,A        ; Get count
  716. ;
  717. CMPLP:    MOV    A,M
  718.     ANI    7FH
  719.     MOV    D,A
  720.     LDAX    B
  721.     ANI    7FH
  722.     CMP    D
  723.     INX    H
  724.     INX    B
  725.     JNZ    NOTEQL        ; Quit on mismatch
  726.     DCR    E        ; Or end of count
  727.     JNZ    CMPLP
  728. ;
  729. NOTEQL:    POP    H
  730.     RET            ; Cond code tells all
  731. ;.....
  732. ;
  733. ;
  734. ; Entry to BDOS saving all extended registers
  735. ;
  736. CPM:    PUSH    B
  737.     PUSH    D
  738.     PUSH    H
  739.     LDA    ZRDFLG        ; ZRDOS running?
  740.     ORA    A
  741.     JNZ    ZRD        ; ZRDOS error trap and DOSs call
  742.     CALL    BDOS
  743.     MOV    B,A        ; Save return code
  744.     LDA    VERFLG        ; Is this 3.0?
  745.     CPI    30H
  746.     MOV    A,B
  747.     JC    CPM20        ; No, exit normally
  748.     CPI    0FFH        ; It is 3.0 - was return code ff?
  749.     JNZ    CPM20        ; No, exit normally
  750.     MOV    A,H        ; 3.0 and A=FF - check for error code
  751.     ORA    A
  752.     JNZ    DSKERR        ; Trap out if we got a physical error
  753.     MOV    A,B        ; Else continue normally
  754. ;
  755. CPM20:    POP    H
  756.     POP    D
  757.     POP    B
  758.     RET
  759. ;.....
  760. ;
  761. ;
  762. ; Start a new line
  763. ;
  764. CRLF:    MVI    A,CR        ; Send CR
  765.     CALL    TYPE
  766.     MVI    A,LF        ; Send LF
  767.     JMP    TYPE        ; Exit to caller from TYPE
  768. ;.....
  769. ;
  770. ;
  771. ; Print HL in decimal with leading zero suppression
  772. ;
  773. DECPRT:    XRA    A        ; Clear leading zero flag
  774.     STA    LZFLG
  775.     LXI    D,-1000        ; Print 1000'S DIGIT
  776.     CALL    DIGIT
  777.     LXI    D,-100        ; Etc.
  778.     CALL    DIGIT
  779.     LXI    D,-10
  780.     CALL    DIGIT
  781.     MVI    A,'0'        ; Get 1'S DIGIT
  782.     ADD    L
  783.     JMP    TYPE
  784. ;
  785. DIGIT:    MVI    B,'0'        ; Start off with ASCII 0
  786. ;
  787. DIGLP:    PUSH    H        ; Save current remainder
  788.     DAD    D        ; Subtract
  789.     JNC    DIGEX        ; Quit on overflow
  790.     POP    PSW        ; Throw away remainder
  791.     INR    B        ; Bump digit
  792.     JMP    DIGLP        ; Loop back
  793. ;
  794. DIGEX:    POP    H        ; Restore pointer
  795.     MOV    A,B
  796.     CPI    '0'        ; Zero digit?
  797.     JNZ    DIGNZ        ; No, type it
  798.     LDA    LZFLG        ; Leading zero?
  799.     ORA    A
  800.     MVI    A,'0'
  801.     JNZ    TYPE        ; Print digit
  802.     LDA    SUPSPC        ; Get space suppression flag
  803.     ORA    A        ; See if printing file totals
  804.     RZ            ; Yes, don't give leading spaces
  805.     MVI    A,' '
  806.     JMP    TYPE        ; Leading zero, so print space
  807. ;
  808. DIGNZ:    STA    LZFLG        ; Leading zero flag so next zero prints
  809.     JMP    TYPE        ; And print digit
  810. ;.....
  811. ;
  812. ;
  813. ; Compute the size of the file/library and update our summary datum.
  814. ; This has been changed into a subroutine so that both the file size
  815. ; computation and a library size (when printing out library members)
  816. ; can be computed in k.
  817. ;
  818. DOIT:    MOV    E,M        ; Get extent #
  819.     MVI    D,0
  820.     INX    H
  821.     MOV    A,M        ; Get record count of last extent
  822.     XCHG
  823.     DAD    H        ; # of extents times 16k
  824.     DAD    H
  825.     DAD    H
  826.     DAD    H
  827.     XCHG            ; Save in DE
  828.     LXI    H,BLKMSK
  829.     ADD    M        ; Round last extent to block size
  830.     RRC
  831.     RRC            ; Convert from records to k
  832.     RRC
  833.     ANI    1FH
  834.     MOV    L,A        ; Add to total k
  835.     MVI    H,0
  836.     DAD    D
  837.     LDA    BLKMSK        ; Get records/blk-1
  838.     RRC
  839.     RRC            ; Convert to k/blk
  840.     RRC
  841.     ANI    1FH
  842.     CMA            ; Use to finish rounding
  843.     ANA    L
  844.     MOV    L,A
  845.     RET
  846. ;.....
  847. ;
  848. ;
  849. ; Recovery point from intercepted BDOS select and bad sector errors.
  850. ;
  851. DSKERR:    LXI    SP,STACK    ; Get out of BDOS' STACK
  852.     JMP    EXIT        ; And exit back to CCP
  853. ;.....
  854. ;
  855. ;
  856. ; Output the directory files we've matched.
  857. ;
  858. ENTRY:    LHLD    COUNT
  859.     DCX    H        ; Dock file count
  860.     SHLD    COUNT
  861.     MOV    A,H        ; Is this the last file?
  862.     ORA    L
  863.     JZ    OKPRNT        ; If count=0, last file so skip compare
  864. ;
  865. ;
  866. ; Compare each entry to make sure that it isn't part of a multiple ex-
  867. ; tent file.  Go only when we have the last extent of the file.
  868. ;
  869.     CALL    CKABRT        ; Check for abort code from keyboard
  870.     LHLD    NEXTT
  871.     MVI    A,11
  872.     CALL    COMPR        ; Does this entry match next one?
  873.     JNZ    OKPRNT        ; No, print it
  874.     INX    H
  875.     INX    H        ; Skip since highest extent last in list
  876.     SHLD    NEXTT
  877.     JMP    ENTRY        ; Loop back for next lowest extent
  878. ;.....
  879. ;
  880. ;
  881. ENTRYL:    LHLD    LCOUNT        ; Get FCB count
  882.     DCX    H        ; Decrement it
  883.     SHLD    LCOUNT
  884.     MOV    A,H        ; Is this the last file?
  885.     ORA    L
  886.     JZ    LBRTST        ; If count=0, last file skip compare
  887.     PUSH    B
  888.     CALL    CKABRT        ; Check for abort code from keyboard
  889.     LHLD    NEXTL
  890.     MVI    A,11
  891.     CALL    COMPR        ; Does this entry match next one?
  892.     POP    B
  893.     JNZ    LBRTST        ; No, print it
  894.     INX    H
  895.     INX    H        ; Skip, highest extent comes last in list
  896.     SHLD    NEXTL
  897.     JMP    ENTRYL        ; Loop back for next lowest extent
  898. ;.....
  899. ;
  900. ;
  901. ; Error exit
  902. ;
  903. ERXIT:    CALL    CRLF        ; Space down
  904.     POP    D        ; Get pointer to message string
  905.     CALL    PRINT        ; Print it
  906.     LXI    D,ERRMS1    ; Print " error"
  907.     CALL    PRINT
  908.     CALL    CRLF        ; Space down
  909. ;
  910. ;
  911. ; Exit - all done restore stack
  912. ;
  913. EXIT:    LDA    DOPFLG        ; Check multi disk mode
  914.     ORA    A
  915.     JNZ    EX0
  916.     CALL    CKABRT        ; Check for user abort first
  917. ;
  918.      IF    NOT ZCPR
  919.     MVI    A,HIDRV-LODRV    ; Get maximum drive code to search
  920.      ENDIF            ; NOT ZCPR
  921. ;
  922.      IF    ZCPR
  923.     LDA    MAXD
  924.      ENDIF            ; ZCPR
  925. ;
  926.     LXI    H,FCB        ; Bump directory fcb drive code
  927.     INR    M
  928.     CMP    M        ; Does next disk exceed maximum?
  929.     JC    EX0
  930.     JMP    NOOPT        ; Search next disk if MAXDR not true
  931. ;.....
  932. ;
  933. ;
  934. ; Prints the ending results
  935. ;
  936. EX0:    LXI    D,CLEAR
  937.     CALL    PRINT
  938.  
  939.      IF    NAMDIR
  940.     LXI    D,AREA        ; Show the last area searched
  941.     CALL    PRINT
  942.      ENDIF            ; NAMDIR
  943.  
  944.      IF    NOT NAMDIR
  945.     LXI    D,PROC1        ; Show the last drive searched
  946.     CALL    PRINT
  947.     LDA    LSTUSR
  948.     STA    NEWUSR
  949.     CALL    TYPUSR        ; Show the last user area searched
  950.     LXI    D,PROC2
  951.     CALL    PRINT
  952.      ENDIF            ; NOT NAMDIR
  953.  
  954.     XRA    A        ; Be sure space suppress flag is set
  955.     STA    SUPSPC
  956. ;
  957.      IF    CKLBR
  958.     LXI    D,TLMSG
  959.     CALL    PRINT
  960.     LHLD    TLIBRA
  961.     CALL    DECPRT
  962.      ENDIF            ; CKLBR
  963. ;
  964.     LXI    D,TMMSG
  965.     CALL    PRINT
  966.     LHLD    TMATCH
  967.     CALL    DECPRT
  968.     LXI    D,TCMSG
  969.     CALL    PRINT
  970.     LHLD    TFILES
  971.     CALL    DECPRT
  972. ;
  973.     CALL    CRLF        ; Just for neatness
  974.     MVI    C,CONST        ; Check console status
  975.     CALL    CPM
  976.     ORA    A        ; Char waiting?
  977.     MVI    C,RDCHR
  978.     CNZ    CPM        ; Gobble up character
  979.     LDA    VERFLG        ; Or error mode, depending on version
  980.     CPI    30H
  981.     JC    EXIT0
  982.     MVI    C,45
  983.     MVI    E,0        ; Set error mode back to default
  984.     CALL    CPM
  985.     JMP    EXIT1
  986. ;
  987. EXIT0:    LDA    DOPFLG        ; If they were swapped
  988.     ORA    A
  989.     CZ    SWAPEM
  990. ;
  991. EXIT1:    LHLD    STACK        ; Get old stack pointer
  992.     SPHL            ; Move back to old stack
  993.     RET            ; And return to CCP
  994. ;.....
  995. ;
  996. ;
  997. ; Kludge to allow call to address in HL
  998. ;
  999. GOHL:    PCHL
  1000.     JMP    CPM
  1001. ;.....
  1002. ;
  1003. ;
  1004. GUIDE:    LXI    D,HELP        ; Print help information
  1005.     CALL    PRINT
  1006. ;
  1007.      IF    CKWHL
  1008.     LDA    WHEEL        ; WHEEL set?
  1009.     ORA    A
  1010.     JZ    GUIDE1        ; NO - don't bother with $SYS files
  1011.      ENDIF            ; CKWHL
  1012. ;
  1013.      IF    CKSYS OR CKWHL
  1014.     LXI    D,HELP1
  1015.     CALL    PRINT
  1016.      ENDIF            ; CKSYS OR CKWHL
  1017. ;
  1018. GUIDE1:    LXI    D,HELP2
  1019.     JMP    VERER1
  1020. ;.....
  1021. ;
  1022. ;
  1023. ; Close the library file
  1024. ;
  1025. LBCLOSE:LXI    D,LBRFCB
  1026.     MVI    C,CLOSE
  1027.     CALL    CPM
  1028.     RET
  1029. ;.....
  1030. ;
  1031. ;
  1032. ; Exit library member printing
  1033. ;
  1034. LBEXIT:    XRA    A        ; Get a zero to...
  1035.     STA    SUPSPC        ; Suppress leading spaces in totals
  1036.     RET
  1037. ;.....
  1038. ;
  1039. ;
  1040. ; At least one more file to output - can we put it on the current line?
  1041. ;
  1042. LBGNXT:    POP    B
  1043.     POP    H
  1044.     JMP    LMTESA        ; And go output another file
  1045. ;
  1046. COMPS:    PUSH    H
  1047.     PUSH    D
  1048.     PUSH    B
  1049.     LXI    B,SEARN
  1050.     MVI    E,11
  1051. ;
  1052. COMPS1:    MOV    A,M
  1053.     ANI    7FH
  1054.     MOV    D,A
  1055.     LDAX    B
  1056.     INX    B
  1057.     INX    H
  1058.     ANI    7FH
  1059.     CPI    '?'
  1060.     JZ    COMPS2
  1061.     CMP    D
  1062.     JNZ    COMPS3
  1063. ;
  1064. COMPS2:    DCR    E
  1065.     JNZ    COMPS1
  1066. ;
  1067. COMPS3:    POP    B
  1068.     POP    D
  1069.     POP    H
  1070.     RET
  1071. ;.....
  1072. ;
  1073. ;
  1074. ; Valid entry obtained - spit it out
  1075. ;
  1076. LBRTST:    MVI    A,1        ; Set not an .ARC file as default
  1077.     STA    ISARC        ; in type of file flag.
  1078.     LHLD    NEXTL        ; Get order table pointer
  1079.     MOV    E,M        ; Get low order address
  1080.     INX    H
  1081.     MOV    D,M        ; Get high order address
  1082.     INX    H
  1083.     SHLD    NEXTL        ; Save updated table pointer
  1084.     LXI    H,8
  1085.     DAD    D
  1086.     CALL    CKLBRY
  1087.     JZ    LBRSET        ; It's a library so skip .ARC test
  1088.     CALL    CKARC        ; Check if current file is a .ARC
  1089.     JNZ    LBRNEX
  1090.     XRA    A
  1091.     STA    ISARC        ; Save current file type is arc
  1092. LBRSET:    PUSH    D
  1093.     POP    H
  1094. ;
  1095. ;
  1096. ; Saves the library file name into LBRFCB
  1097. ;
  1098.     LDA    FCB
  1099.     LXI    D,LBRFCB    ; To
  1100.     STAX    D
  1101.     INX    D
  1102.     MVI    B,11        ; Length
  1103.     CALL    MOVE        ; Do the move
  1104.     XCHG
  1105.     MVI    B,25
  1106. ;
  1107. CLMFCB:    MVI    M,0
  1108.     INX    H
  1109.     DCR    B
  1110.     JNZ    CLMFCB
  1111.     CALL    SETLDMA
  1112.     LXI    D,LBRFCB    ; Point to file
  1113.     MVI    C,OPEN        ; Get function
  1114.     CALL    CPM        ; Open it
  1115.     MVI    C,READ
  1116.     LXI    D,LBRFCB
  1117.     CALL    CPM
  1118.     CALL    SETFOP
  1119.     LXI    H,LBBUF
  1120.     MOV    A,M
  1121.     ORA    A
  1122.     JZ    CKLDIR        ; Check directory present?
  1123.     LDA    ISARC        ; Was file a .ARC file
  1124.     ORA    A
  1125.     JNZ    LMLEXI        ; No so error
  1126.     MOV    A,M        ; Get buffer byte again
  1127.     CPI    ARCMAR        ; is an arc mark ?
  1128.     JZ    CKADIR        ; Yep so Check directory present?
  1129. ;
  1130. LMLEXI:    CALL    LBCLOSE
  1131. ;
  1132. ;
  1133. ; Do next library file
  1134. ;
  1135. LBRNEX:    LHLD    LCOUNT        ; Check count
  1136.     MOV    A,H
  1137.     ORA    L
  1138.     JZ    LBEXIT        ; No more, all done
  1139.     JMP    ENTRYL        ; Else, get next .lbr file
  1140. ;.....
  1141. ;
  1142. ;
  1143. LFMLOP:    LHLD    SLFILE        ; Get
  1144.     MOV    A,L
  1145.     ORA    H
  1146.     JZ    LMLEXI
  1147.     DCX    H
  1148.     SHLD    SLFILE
  1149.     CALL    SETLDMA
  1150.     MVI    C,READ
  1151.     LXI    D,LBRFCB
  1152.     CALL    CPM
  1153.     CALL    SETFOP
  1154.     MVI    B,4        ; Get file count per record
  1155.     LXI    H,LBBUF        ; Get buffer starting address
  1156. ;
  1157. LMTEST:    MOV    A,M        ; Get member open flag
  1158.     ORA    A        ; Test for open
  1159.     JZ    PRMNAM
  1160. ;
  1161. LMTESA:    LDA    ISARC        ; Test if we are doing an arc file
  1162.     ORA    A
  1163.     RZ            ; Just return if .arc
  1164.     LXI    D,32        ; Member not open get offset
  1165.     DAD    D        ; To next and add it in.
  1166.     DCR    B        ; Is buffer empty ?
  1167.     JNZ    LMTEST        ; No so test next entry
  1168.     JMP    LFMLOP        ; Yes get next buffer...
  1169. ;
  1170. ;.....
  1171. ;
  1172. ;
  1173. ;------------------------------------------------
  1174. ; Archive file subroutines
  1175. ;------------------------------------------------
  1176. ;
  1177. CKADIR:    XRA    A
  1178.     DCR    A
  1179.     STA    GETABL        ; Say buffer is full (first read by lbr test)
  1180.     LHLD    TLIBRA        ; Bump library count total
  1181.     INX    H
  1182.     SHLD    TLIBRA
  1183. ARCLP:    CALL    GET        ; Get the next character from buffer
  1184.     CPI    ARCMAR        ; Is it archive header marker?
  1185.     JNZ    LMLEXI        ;  and abort if not
  1186.     CALL    GET        ; Get header version
  1187.     ORA    A        ; If zero, that's logical end of file,
  1188.     JZ    LMLEXI        ;  and we're done
  1189.     LXI    D,ANAME        ; Set to fill header buffer
  1190.     MVI    B,HDRSIZ    ; Setup normal header size less file name
  1191.     CPI    1        ; But test if version 1
  1192.     JNZ    GETHD1        ; Skip if not version 1
  1193.     LXI    B,HDRSIZ-4    ; Else, header is 4 bytes less
  1194. GETHD1:    CALL    GET        ; Get header byte
  1195.     STAX    D        ; Store in buffer
  1196.     INX    D
  1197.     DCR    B
  1198.     JNZ    GETHD1        ; Loop for all bytes
  1199.     LXI    H,ARCFIL    ; Prefill dummy arc fcb name with spaces
  1200.     MVI    B,11
  1201. FIXAN:    MVI    M,' '
  1202.     INX    H
  1203.     DCR    B
  1204.     JNZ    FIXAN
  1205.     MVI    B,5        ; Prefill rest of dummy fcb with zero
  1206. FIXAE:    MVI    M,0
  1207.     INX    H
  1208.     DCR    B
  1209.     JNZ    FIXAE
  1210.     LXI    H,ANAME        ; Get pointer to archive header buffer
  1211.     LXI    D,ARCFIL    ; Point to our dummy fcb
  1212.     MVI    B,8        ; Get name length
  1213. MANAME:    MOV    A,M        ; Get character from header
  1214.     INX    H
  1215.     ORA    A
  1216.     JZ    AEDONE        ; Nothing in buffer so we're done
  1217.     CPI    02EH        ; Is the char a point
  1218.     JZ    DAEXT        ; DO FILE EXTENT
  1219.     STAX    D
  1220.     INX    D
  1221.     DCR    B
  1222.     JNZ    MANAME
  1223. DAEXT:    LXI    D,ARCFIL+8    ; Get dummy file extent address
  1224.     MVI    B,3
  1225.     MOV    A,M
  1226.     CPI    2EH
  1227.     JNZ    AELOP
  1228.     INX    H
  1229. AELOP:    MOV    A,M        ; Fill in the file extent
  1230.     ORA    A
  1231.     JZ    AEDONE
  1232.     STAX    D
  1233.     INX    H
  1234.     INX    D
  1235.     DCR    B
  1236.     JNZ    AELOP
  1237. AEDONE:    LXI    H,ASIZE
  1238.     MOV    E,M        ; Fetch BCDE from (HL)
  1239.     INX    H
  1240.     MOV    D,M
  1241.     INX    H
  1242.     MOV    C,M
  1243.     XRA    A        ; Clear flags
  1244.     MOV    A,E        ; Convert file length count in bytes
  1245.     RAL            ;  to length in records for output
  1246.     MOV    A,D
  1247.     RAL
  1248.     MOV    E,A
  1249.     MOV    A,C
  1250.     RAL
  1251.     MOV    D,A
  1252.     XCHG
  1253.     SHLD    ARCFIL+13    ; Save file length
  1254.     LXI    H,ARCFIL-1    ; Point to dummy fcb
  1255.     CALL    PRMNAM        ; List the file info
  1256.     LXI    H,ASIZE        ; Get remaining file size
  1257.     MOV    A,M
  1258.     ANI    7FH
  1259.     LHLD    ARCFIL+13    ; Save file length
  1260.     XCHG            ; Save record offset
  1261.     LXI    H,GETABL    ; Point to offset of last byte read
  1262.     ADD    M        ; Add byte offsets
  1263.     CPI    80H        ; Does it overflow current record?
  1264.     JC    NRAD
  1265.     SUI    80H        ; Adjust pointer
  1266.     INX    D        ; Bump record number
  1267. NRAD:    MOV    M,A        ; Update buffer ptr for new position
  1268.     MOV    A,D        ; Check record offset
  1269.     ORA    E
  1270.     JZ    LEXIT        ; Return if none (still in same record)
  1271. SEEK2:    PUSH    D        ; Save record offset
  1272.     LXI    D,LBRFCB
  1273.     MVI    C,RECORD    ; Compute current "random" record no.
  1274.     CALL    CPM        ; (I.e. next sequential record to read)
  1275.     LHLD    LBRFCB+FRN    ; Get result
  1276.     DCX    H        ; Adjust next record to current record
  1277.     POP    D        ; Restore record offset
  1278.     DAD    D        ; Compute new record no.
  1279.     JC    LMLEXI        ; If >64k, it's past largest (8 Mb) file
  1280.     SHLD    LBRFCB+FRN    ; Save new record no.
  1281.     MVI    C,READRN    ; Read the random record
  1282.     CALL    GETREC
  1283.     ORA    A
  1284.     JNZ    LMLEXI        ; File read error
  1285.     LXI    H,LBRFCB+FCR    ; Point to current record in extent
  1286.     INR    M        ; Bump for subsequent sequential read
  1287. LEXIT:    JMP    ARCLP        ; Loop for next file
  1288. ;.....
  1289. ;
  1290. ;
  1291. ; Get next sequential byte from archive file
  1292. ;
  1293. GET:    PUSH    B        ; Save registers
  1294.     PUSH    D        
  1295.     PUSH    H
  1296.     LDA    GETABL        ; Point to last byte read
  1297.     INR    A        ; At end of buffer?
  1298.     CPI    80H
  1299.     CNC    GETNXT        ; Yes, read next record and reset ptr
  1300.     STA    GETABL        ; Save new buffer ptr
  1301.     MOV    L,A
  1302.     MVI    H,0
  1303.     LXI    D,LBBUF
  1304.     DAD    D
  1305.     MOV    A,M        ; Fetch byte from there
  1306.     POP    H        ; Restore registers
  1307.     POP    D
  1308.     POP    B
  1309.     RET            ; Return
  1310. ;.....
  1311. ;
  1312. ;
  1313. ; Get next sequential record from archive file
  1314. ;
  1315. GETNXT:    MVI    C,READ        ; Setup read-sequential function code
  1316.     CALL    GETREC
  1317.     ORA    A
  1318.     JNZ    RDERR
  1319.     PUSH    PSW
  1320.     XRA    A
  1321.     DCR    A
  1322.     STA    GETABL
  1323.     POP    PSW
  1324.     RET
  1325. RDERR:    POP    H        ; Strip getnxt return
  1326.     POP    H        ; Clean up the get stack
  1327.     POP    D
  1328.     POP    B
  1329.     POP    H        ; strip get calling address 
  1330.     JMP    LMLEXI        ; Show error
  1331. ;.....
  1332. ;
  1333. ;
  1334. ; Get record (sequential or random) from archive file
  1335. ;
  1336. GETREC:    PUSH    H
  1337.     PUSH    B
  1338.     CALL    SETLDMA        ; Set library DMA address
  1339.     LXI    D,LBRFCB    ; Setup FCB address
  1340.     POP    B        ; Restore read function
  1341.     CALL    CPM        ; Do it
  1342.     PUSH    PSW        ; Save read status
  1343.     CALL    SETFOP        ; Reset Print file DMA address
  1344.     POP    PSW        ; Restore read status
  1345.     POP    H        ; Restore buffer ptr
  1346.     RET
  1347. ;.....
  1348. ;
  1349. ;
  1350. ; Move characters from 'HL' to 'DE' length in 'B'
  1351. ;
  1352. MOVE:    MOV    A,M        ; Get a character
  1353.     STAX    D        ; Store it
  1354.     INX    H        ; To next 'FROM'
  1355.     INX    D        ; To next 'TO'
  1356.     DCR    B        ; More?
  1357.     JNZ    MOVE        ; Yes, loop
  1358.     RET            ; No, return
  1359. ;.....
  1360. ;
  1361. ;
  1362. ; Sort is all done - print entries that compare
  1363. ;
  1364. NOOUT:    LHLD    COUNT
  1365.     SHLD    LCOUNT
  1366.     LXI    H,ORDER        ; Initialize order table pointer
  1367.     SHLD    NEXTL
  1368.     SHLD    NEXTT
  1369.     JMP    ENTRY
  1370. ;.....
  1371. ;
  1372. ;
  1373. ; Directory for one user area completed.  If 'ALL USERS' option is se-
  1374. ; lected, then go do another directory on the next user number until we
  1375. ; exceed the maximum user # for the selected drive.
  1376. ;
  1377. NXTUSR:    CALL    CKABRT        ; Check for user abort first
  1378.     LDA    MAXUSR        ; No abort - get maximum user number
  1379.     LXI    H,NEWUSR    ; Bump directory user number
  1380.     INR    M
  1381.     CMP    M        ; Does next user # exceed maximum?
  1382.     JNC    SETTBL        ; Continue if more user areas to go
  1383.     LDA    BASUSR        ; Reset base user number for the
  1384.     MOV    M,A        ; Next directory search
  1385. ;
  1386. ;
  1387. ; Directory for all user areas completed.  If the multi-disk option is
  1388. ; enabled and selected, reset to the base user area and repeat the di-
  1389. ; rectory for next drive on-line until we either exceed the drives in
  1390. ; our LODRV-HIDRV table, or the BDOS shuts us down with a select or bad
  1391. ; sector error, which will be intercepted back to the exit module.
  1392. ;
  1393. NXTDSK:    LXI    H,FNDFLG    ; Get file found flag
  1394.     MVI    M,0        ; Clear file found flag for next drive
  1395. ;
  1396. NDSK:    LDA    DOPFLG        ; See if the flag is set now
  1397.     ORA    A
  1398.     JNZ    EXIT        ; If yes, all done
  1399.     CALL    CKABRT        ; Check for user abort first
  1400.     MVI    A,HIDRV-LODRV    ; Get maximum drive code to search
  1401.     LXI    H,FCB        ; Bump directory FCB drive code
  1402.     INR    M
  1403.     CMP    M        ; Does next disk exceed maximum?
  1404.     JC    EXIT
  1405.     MOV    E,M
  1406.     MVI    D,0
  1407.     DCR    E
  1408.     LXI    H,LODRV
  1409.     DAD    D
  1410.     MOV    A,M
  1411.     CPI    0FFH
  1412.     JZ    NDSK        ; Search next disk if MAXDR not true
  1413.     JMP    NOOPT
  1414. ;.....
  1415. ;
  1416. ;
  1417. OKPRNT:    LHLD    NEXTT        ; Get order table pointer
  1418.     MOV    E,M        ; Get low order address
  1419.     INX    H
  1420.     MOV    D,M        ; Get high order address
  1421.     INX    H
  1422.     SHLD    NEXTT        ; Save updated table pointer
  1423.     XCHG            ; Table entry to HL
  1424. ;
  1425. ;
  1426. ; Put in user and drive printout here
  1427. ;
  1428.     PUSH    H        ; Save the current address
  1429.     LHLD    TFILES
  1430.     INX    H
  1431.     SHLD    TFILES
  1432.     POP    H
  1433.     CALL    COMPS        ; Match what we are looking for ?
  1434.     JNZ    OKEXIT        ; No, so don't print it
  1435.     PUSH    H
  1436.     LHLD    TMATCH
  1437.     INX    H
  1438.     SHLD    TMATCH
  1439.     POP    H
  1440.     MVI    A,CR
  1441.     CALL    TYPE
  1442.     LDA    FCB        ; Precede new line with drive name
  1443.  
  1444.      IF    NAMDIR
  1445.     CALL    PRTNAM        ; Type area name
  1446.     LXI    D,AREA
  1447.     CALL    PRINT
  1448.      ENDIF            ; NAMDIR
  1449.  
  1450.      IF    NOT NAMDIR
  1451.     ADI    'A'-1
  1452.     CALL    TYPE
  1453.     CALL    TYPUSR
  1454.      ENDIF            ; NOT NAMDIR
  1455.  
  1456.     MVI    A,':'        ; Tag header with a colon and a space
  1457.     CALL    TYPE        ; And exit back to entry
  1458.     MVI    A,' '
  1459.     CALL    TYPE
  1460.  
  1461.      IF    NOT NAMDIR
  1462.     LDA    NEWUSR
  1463.     CPI    10
  1464.     JNC    OVER9
  1465.     MVI    A,' '
  1466.     CALL    TYPE
  1467.      ENDIF            ; NOT NAMDIR
  1468. ;
  1469. OVER9:    MVI    B,8        ; File name length
  1470.     CALL    TYPENM        ; Type filename
  1471.     MVI    A,'.'        ; Period after filename
  1472.     CALL    TYPE
  1473.     MVI    B,3        ; Display 3 characters of filetype
  1474.     CALL    TYPEXT
  1475.     MOV    D,M
  1476.     INX    H
  1477.     MOV    E,M        ; Size in DE (records)
  1478.     LDA    BLKMSK
  1479.     PUSH    PSW
  1480.     ADD    E
  1481.     MOV    E,A
  1482.     MOV    A,D
  1483.     ACI    0
  1484.     MOV    D,A
  1485.     POP    PSW
  1486.     CMA
  1487.     ANA    E
  1488.     MOV    E,A        ; Size in DE
  1489.     MVI    B,3
  1490. ;
  1491. SHRR:    MOV    A,D
  1492.     ORA    A
  1493.     RAR
  1494.     MOV    D,A
  1495.     MOV    A,E
  1496.     RAR
  1497.     MOV    E,A
  1498.     DCR    B
  1499.     JNZ    SHRR
  1500.     XCHG            ; Get file size
  1501. ;
  1502. ;
  1503. ; Output the size of the individual file.
  1504. ;
  1505.     CALL    DECPRT        ; Go print it
  1506.     MVI    A,'k'        ; And follow with k size
  1507.     CALL    TYPE
  1508.     CALL    CRLF
  1509.     MVI    A,0FFH
  1510.     STA    FNDFLG        ; Set file found flag
  1511. ;
  1512. ;
  1513. ; One file output - test to see if we have to output another one.
  1514. ;
  1515. OKEXIT:    LHLD    COUNT        ; Get current file counter and test it
  1516.     MOV    A,H
  1517.     ORA    L
  1518.     JZ    PRTOTL        ; If no more files exit to summary output
  1519.     JMP    ENTRY
  1520. ;.....
  1521. ;
  1522. ;
  1523. OVER91:    MVI    B,8        ; File name length
  1524.     CALL    TYPENM
  1525.     MVI    A,'.'        ; Period after file name
  1526.     CALL    TYPE
  1527.     MVI    B,3        ; Display 3 characters of filetype
  1528.     CALL    TYPEXT
  1529.     INX    H
  1530.     INX    H
  1531.     MOV    E,M
  1532.     INX    H
  1533.     MOV    D,M
  1534.     XCHG
  1535. ;
  1536. ;
  1537. ; Output the size of the individual file.
  1538. ;
  1539.     PUSH    D
  1540.     PUSH    H
  1541.     PUSH    H
  1542.     LHLD    LLENLOC
  1543.     PUSH    H
  1544.     POP    D
  1545.     POP    H
  1546.     DAD    D
  1547.     SHLD    LLENLOC
  1548.     POP    H
  1549. ;
  1550. ;
  1551. ; New code added to convert .LIB members from records to 'k'.  Upon
  1552. ; entry, member's size in records is in HL
  1553. ;
  1554.     XCHG            ; Put it in DE
  1555.     LXI    H,0        ; Zero out HL
  1556.     MOV    A,E        ; Put low byte of record count in a
  1557.     ADI    7        ; Add seven to always round up 1k
  1558.     RRC            ; Convert it to k
  1559.     RRC
  1560.     RRC
  1561.     ANI    1FH
  1562.     MOV    E,A        ; And put it back
  1563.     MOV    L,D        ; Get the high byte if any
  1564.     MVI    D,0        ; Clean out the old resting place
  1565.     DAD    H        ; Multiply it by 32 to convert to
  1566.     DAD    H        ; Number
  1567.     DAD    H        ; Of
  1568.     DAD    H        ; k
  1569.     DAD    H        ; Bytes
  1570.     DAD    D        ; And add in the low byte
  1571.     POP    D
  1572.     CALL    DECPRT        ; Go print it
  1573.     MVI    A,'k'        ; And follow with size
  1574.     CALL    TYPE
  1575.     LXI    H,INLBF
  1576.     MVI    B,6
  1577.     CALL    TYPENM
  1578.     LXI    H,LBRFCB+1
  1579.     MVI    B,8        ; File name length
  1580.     CALL    TYPENM
  1581.     MVI    A,'.'        ; Period after file name
  1582.     CALL    TYPE
  1583.     MVI    B,3        ; Display 3 characters of filetype
  1584.     CALL    TYPEXT
  1585.     CALL    CRLF        ; So we can still see it!
  1586.     MVI    A,0FFH
  1587.     STA    FNDFLG        ; Set file found flag
  1588.     JMP    LBGNXT
  1589. ;.....
  1590. ;
  1591. ;
  1592. ; Print string terminated with '0' character
  1593. ;
  1594. PRINT:    LDAX    D
  1595.     ORA    A
  1596.     RZ            ; If zero, finished
  1597.     CALL    TYPE        ; Display on CRT
  1598.     INX    D
  1599.     JMP    PRINT
  1600. ;.....
  1601. ;
  1602. ;
  1603. PRTLMEM: IF    NOT CKLBR
  1604.     XRA    A
  1605.     RET            ; Skip library checks
  1606.      ENDIF            ; NOT CKLBR
  1607. ;
  1608.     LXI    H,SEARN+8
  1609.     CALL    CKLBRY
  1610.     RZ
  1611.     LXI    H,ORDER        ; Initialize order table pointer
  1612.     SHLD    NEXTL
  1613.     JMP    ENTRYL
  1614. ;.....
  1615. ;
  1616. ;
  1617. PRMNAM:    PUSH    H        ; Print member name and size
  1618.     PUSH    B
  1619.     CALL    CKABRT        ; Check for abort code from keyboard
  1620. ;
  1621. PRMNA1:    POP    B
  1622.     POP    H
  1623.     PUSH    H
  1624.     PUSH    B
  1625.     INX    H
  1626.     PUSH    H
  1627.     LHLD    TFILES
  1628.     INX    H
  1629.     SHLD    TFILES
  1630.     POP    H
  1631.     CALL    COMPS        ; Match what we are looking for ?
  1632.     JNZ    LBGNXT
  1633.     PUSH    H
  1634.     LHLD    TMATCH
  1635.     INX    H
  1636.     SHLD    TMATCH
  1637.     POP    H
  1638.     MVI    A,CR
  1639.     CALL    TYPE
  1640.     LDA    FCB        ; Precede new line with drive name
  1641.  
  1642.      IF    NAMDIR
  1643.     CALL    PRTNAM        ; Print area name
  1644.     LXI    D,AREA
  1645.     CALL    PRINT
  1646.      ENDIF            ; NAMDIR
  1647.  
  1648.      IF    NOT NAMDIR
  1649.     ADI    'A'-1
  1650.     CALL    TYPE
  1651.     CALL    TYPUSR
  1652.      ENDIF            ; NOT NAMDIR
  1653.  
  1654.     MVI    A,':'        ; Tag header with a colon and a space
  1655.     CALL    TYPE        ; And exit back to entry
  1656.     MVI    A,' '
  1657.     CALL    TYPE
  1658.  
  1659.      IF    NOT NAMDIR
  1660.     LDA    NEWUSR
  1661.     CPI    10
  1662.     JNC    OVER91
  1663.     MVI    A,' '
  1664.     CALL    TYPE
  1665.      ENDIF            ; NOT NAMDIR
  1666.  
  1667.     JMP    OVER91
  1668. ;.....
  1669. ;
  1670. ; PRTNAM prints the name of the area being searched
  1671. ;
  1672.  
  1673.      IF    NAMDIR
  1674. PRTNAM:    PUSH    H        ; Save regs
  1675.     PUSH    B
  1676.     DCR    A        ; Adjust - 0=A, 1=B, etc
  1677.     LXI    H,PTRTBL    ; Point to table of pointers
  1678.     ADD    A        ; Calculate offset into table
  1679.     MOV    C,A
  1680.     MVI    B,0
  1681.     DAD    B
  1682.     MOV    A,M
  1683.     INX    H
  1684.     MOV    H,M
  1685.     MOV    L,A        ; HL now points to name table for drive
  1686.     LDA    NEWUSR        ; Now calc offset into that table
  1687.     STA    LSTUSR
  1688.     ADD    A        ; *2
  1689.     ADD    A        ; *4
  1690.     ADD    A        ; *8
  1691.     MOV    C,A        ; To BC
  1692.     MVI    B,0
  1693.     DAD    B
  1694.     MVI    B,8        ; 8 characters in each name
  1695.     LXI    D,AREA        ; Point to storage buffer
  1696. AREALP:    MOV    A,M        ; Move name
  1697.     STAX    D
  1698.     INX    H
  1699.     INX    D
  1700.     DCR    B
  1701.     JNZ    AREALP
  1702.     XRA    A
  1703.     STAX    D        ; Terminator
  1704.     POP    B
  1705.     POP    H
  1706.     RET
  1707.      ENDIF            ; NAMDIR
  1708. ;.....
  1709. ;
  1710. ;
  1711. ; Now check for libraries
  1712. ;
  1713. PRTOTL:    LHLD    LCOUNT        ; How many files did we see?
  1714.     MOV    A,H
  1715.     ORA    L
  1716.     CNZ    PRTLMEM        ; Skip the .lbr check if none found
  1717.     XRA    A        ; Get a zero to...
  1718.     STA    SUPSPC        ; Suppress leading spaces in totals
  1719.     JMP    NXTUSR
  1720. ;.....
  1721. ;
  1722. ;
  1723. ; Reset Warm Boot Trap in ZRDOS
  1724. ;
  1725. RESTRAP:PUSH    H
  1726.     PUSH    D
  1727.     PUSH    B
  1728.     PUSH    PSW
  1729.     MVI    C,52        ; Reset warm boot trap
  1730.     CALL    BDOS
  1731.     POP    PSW
  1732.     POP    B
  1733.     POP    D
  1734.     POP    H
  1735.     RET
  1736. ;.....
  1737. ;
  1738. ;
  1739. ; For file output mode, return to old user area and set dma for the file
  1740. ; output buffer.
  1741. ;
  1742. SETFOP:    LDA    OLDUSR        ; Get user number at startup
  1743.     MOV    E,A
  1744.     MVI    C,CURUSR
  1745.     CALL    CPM        ; Reset the old user number
  1746.     RET
  1747. ;.....
  1748. ;
  1749. ;
  1750. ; Set the library file DMA address
  1751. ;
  1752. SETLDMA:LDA    NEWUSR        ; Get user area for directory
  1753.     MOV    E,A
  1754.     MVI    C,CURUSR    ; Get the user function
  1755.     CALL    CPM        ; And set new user number
  1756.     LXI    D,LBBUF
  1757.     MVI    C,SETDMA
  1758.     CALL    CPM
  1759.     RET
  1760. ;.....
  1761. ;
  1762. ;
  1763. ; Move disk buffer dma to default buffer for directory search operations
  1764. ; and BDOS media change routines (necessary for pre-CP/M 2 systems while
  1765. ; in file output mode with an active buffer).
  1766. ;
  1767. SETSRC:    LXI    D,TBUF
  1768. ;
  1769. SET2:    MVI    C,SETDMA
  1770.     JMP    CPM
  1771. ;.....
  1772. ;
  1773. ;
  1774. ; Set Warm Boot Trap in ZRDOS
  1775. ;
  1776. SETTRAP:PUSH    H
  1777.     PUSH    D
  1778.     PUSH    B
  1779.     MVI    C,50        ; Set warm boot trap to come here
  1780.     LXI    D,WBTRAP
  1781.     CALL    BDOS
  1782.     POP    B
  1783.     POP    D
  1784.     POP    H
  1785.     RET
  1786. ;.....
  1787. ;
  1788. ;
  1789. ; Shift HL left by B bits
  1790. ;
  1791. SHLL:    DAD    H
  1792.     DCR    B
  1793.     RZ
  1794.     JMP    SHLL
  1795. ;.....
  1796. ;
  1797. ;
  1798. ; This sort routine is adapted from Software Tools by Kernigan and
  1799. ; Plaugher.
  1800. ;
  1801. SORT:    LHLD    SCOUNT        ; Number of entries
  1802. ;
  1803. L0:    ORA    A        ; Clear carry
  1804.     MOV    A,H        ; GAP=GAP/2
  1805.     RAR
  1806.     MOV    H,A
  1807.     MOV    A,L
  1808.     RAR
  1809.     MOV    L,A
  1810.     ORA    H        ; Is it zero?
  1811.     JZ    NOOUT        ; Then none left
  1812.     MOV    A,L        ; Make GAP odd
  1813.     ORI    1
  1814.     MOV    L,A
  1815.     SHLD    GAP
  1816.     INX    H        ; I=GAP+1
  1817. ;
  1818. L2:    SHLD    I
  1819.     XCHG
  1820.     LHLD    GAP
  1821.     MOV    A,E        ; J=I-GAP
  1822.     SUB    L
  1823.     MOV    L,A
  1824.     MOV    A,D
  1825.     SBB    H
  1826.     MOV    H,A
  1827. ;
  1828. L3:    SHLD    J
  1829.     XCHG
  1830.     LHLD    GAP        ; JG=J+GAP
  1831.     DAD    D
  1832.     SHLD    JG
  1833.     MVI    A,13        ; Compare 13 characters
  1834.     CALL    COMPARE        ; Compare (J) and (JG)
  1835.     JP    L5        ; If A(J)<=A(JG)
  1836.     LHLD    J
  1837.     XCHG
  1838.     LHLD    JG
  1839.     CALL    SWAP        ; Exchange A(J) and A(JG)
  1840.     LHLD    J        ; J=J-GAP
  1841.     XCHG
  1842.     LHLD    GAP
  1843.     MOV    A,E
  1844.     SUB    L
  1845.     MOV    L,A
  1846.     MOV    A,D
  1847.     SBB    H
  1848.     MOV    H,A
  1849.     JM    L5        ; If J>0 goto l3
  1850.     ORA    L        ; Check for zero
  1851.     JZ    L5
  1852.     JMP    L3
  1853. ;
  1854. L5:    LHLD    SCOUNT        ; For later
  1855.     XCHG
  1856.     LHLD    I        ; I=I+1
  1857.     INX    H
  1858.     MOV    A,E        ; If I<=N goto l2
  1859.     SUB    L
  1860.     MOV    A,D
  1861.     SBB    H
  1862.     JP    L2
  1863.     LHLD    GAP
  1864.     JMP    L0
  1865. ;.....
  1866. ;
  1867. ;
  1868. ; Sort
  1869. ;
  1870. SPRINT:    CALL    SETFOP        ; Return to file output DMA & user #
  1871.     LHLD    COUNT        ; Get file name count
  1872.     MOV    A,L
  1873.     ORA    H        ; Any found?
  1874.     JZ    PRTOTL        ; Exit if no files found
  1875.     PUSH    H        ; Save file count
  1876.     STA    SUPSPC        ; Enable leading zero suppression
  1877. ;
  1878. ;
  1879. ; Initialize the order table
  1880. ;
  1881.     LHLD    TBLOC        ; Get start of name table
  1882.     XCHG            ; Into DE
  1883.     LXI    H,ORDER        ; Point to order table
  1884.     LXI    B,13        ; Entry length
  1885. ;
  1886. BLDORD:    MOV    M,E        ; Save low order address
  1887.     INX    H
  1888.     MOV    M,D        ; Save high order address
  1889.     INX    H
  1890.     XCHG            ; Table address to HL
  1891.     DAD    B        ; Point to next entry
  1892.     XCHG
  1893.     XTHL            ; Save table addr, fetch loop counter
  1894.     DCX    H        ; Count down loop
  1895.     MOV    A,L
  1896.     ORA    H        ; More?
  1897.     XTHL            ; (restore table address, save counter)
  1898.     JNZ    BLDORD        ; Yes, go do another one
  1899.     POP    H        ; Clean loop counter off stack
  1900.     LHLD    COUNT        ; Get count
  1901.     SHLD    SCOUNT        ; Save as # to sort
  1902.     DCX    H        ; Only 1 entry?
  1903.     MOV    A,L
  1904.     ORA    H
  1905.     JZ    NOOUT        ; Yes, so skip sort
  1906.     JMP    SORT
  1907. ;.....
  1908. ;
  1909. ;
  1910. ; Swap entries in the order table
  1911. ;
  1912. SWAP:    LXI    B,ORDER-2    ; Table base
  1913.     DAD    H        ; *2
  1914.     DAD    B        ; + base
  1915.     XCHG
  1916.     DAD    H        ; *2
  1917.     DAD    B        ; + base
  1918.     MOV    C,M
  1919.     LDAX    D
  1920.     XCHG
  1921.     MOV    M,C
  1922.     STAX    D
  1923.     INX    H
  1924.     INX    D
  1925.     MOV    C,M
  1926.     LDAX    D
  1927.     XCHG
  1928.     MOV    M,C
  1929.     STAX    D
  1930.     RET
  1931. ;.....
  1932. ;
  1933. ;
  1934. SWAP20:    LHLD    BDOS+1        ; Get pointer to base of BDOS
  1935.     INX    H        ; Swap in the new pointer if running a
  1936.     MOV    E,M        ; Program below the CCP
  1937.     INX    H
  1938.     MOV    D,M
  1939.     XCHG            ; Now HL points to the proper vector
  1940.     MVI    L,9        ; Point to record error vector
  1941.     LXI    D,VECTBL    ; Exchanging with our own vector table
  1942.     MVI    A,4        ; 4 bytes to swap
  1943. ;
  1944. SWAPLP:    MOV    B,M        ; Get byte from HL
  1945.     XCHG
  1946.     MOV    C,M        ; Get byte from DE
  1947.     MOV    M,B        ; Put byte from HL
  1948.     XCHG
  1949.     MOV    M,C        ; Put byte from DE
  1950.     INX    H        ; Bump exchange pointers
  1951.     INX    D
  1952.     DCR    A        ; Dock counter
  1953.     JNZ    SWAPLP        ; Continue swapping til done
  1954.     RET
  1955. ;.....
  1956. ;
  1957. ;
  1958. ; Trap BDOS select and sector error vectors to our own intercept routine
  1959. ; so we can catch a reference to an illegal drive.
  1960. ;
  1961. SWAPEM:    LDA    ZRDFLG        ; See if ZRDOS running
  1962.     ORA    A
  1963.     RNZ            ; Yes, quit this
  1964.     LDA    VERFLG        ; Check version
  1965.     CPI    30H        ; See if error mode call is available
  1966.     JC    SWAP20        ; If not, use BDOS error vectors
  1967.     MVI    C,2DH
  1968.     MVI    E,0FFH        ; Use set error mode call
  1969.     CALL    CPM        ; Set "return code only" mode
  1970.     RET
  1971. ;.....
  1972. ;
  1973. ;
  1974. ; Output character in a to console, and optionally to printer and/or the
  1975. ; output file.
  1976. ;
  1977. TYPE:    PUSH    B
  1978.     PUSH    D
  1979.     PUSH    H
  1980.     PUSH    PSW        ; Save the character to output
  1981.     CALL    TYPE1        ; Send it to console
  1982.     POP    PSW        ; Restore the output character
  1983. ;
  1984. TYPRET:    POP    H        ; Exit from type
  1985.     POP    D
  1986.     POP    B
  1987.     RET
  1988. ;.....
  1989. ;
  1990. ;
  1991. ; Print a string at HL of length B, retains any high bits set in the
  1992. ; file extent - can be changed to lower case if USELC option is set YES.
  1993. ;
  1994. TYPEXT:    MOV    A,M
  1995.     CALL    TYPE
  1996.     INX    H
  1997.     DCR    B
  1998.     JNZ    TYPEXT
  1999.     RET
  2000. ;.....
  2001. ;
  2002. ;
  2003. ; Print a string at HL of length B, removes any high bits set.
  2004. ;
  2005. TYPENM:    MOV    A,M
  2006.     ANI    7FH
  2007.     CALL    TYPE
  2008.     INX    H
  2009.     DCR    B
  2010.     JNZ    TYPENM
  2011.     RET
  2012. ;.....
  2013. ;
  2014. ;
  2015. ; Output character
  2016. ;
  2017. TYPE1:     IF    USELC AND CKWHL    OR (NOT    CKWHL AND NOT ZCPR)
  2018.     ORA    A        ; Check for attributes not set
  2019.     JP    TYPE2
  2020.     ANI    7FH        ; Delete the attribute bit now
  2021.     CPI    'A'        ; Change only from A-Z
  2022.     JC    TYPE2
  2023.     CPI    'Z'+1
  2024.     JNC    TYPE2        ; Punctuation can change so leave it
  2025.     ORI    20H        ; If attribute, make lower case
  2026.      ENDIF            ; USELC AND CKWHL, etc.
  2027. ;
  2028. TYPE2:    MOV    E,A        ; Get character into BDOS entry register
  2029.     MVI    C,WRCHR
  2030.     JMP    BDOS        ; Call CONOUT via the BDOS
  2031. ;.....
  2032. ;
  2033. ;
  2034. ; Print the user number of the directory in decimal
  2035. ;
  2036. TYPUSR:    LDA    NEWUSR
  2037.     CPI    10        ; If user no. < 10, skip tens digit
  2038.     JC    DUX
  2039.     PUSH    B
  2040.     MVI    C,'0'-1
  2041. ;
  2042. DUY:    INR    C        ; Get tens digit
  2043.     SUI    10
  2044.     JNC    DUY        ; Loop until we've gone too far
  2045.     ADI    10
  2046.     MOV    B,A        ; Save units digit
  2047.     MOV    A,C        ; Print tens digit
  2048.     CALL    TYPE
  2049.     MOV    A,B        ; Get units back
  2050.     POP    B
  2051. ;
  2052. DUX:    ADI    '0'
  2053.     JMP    TYPE
  2054. ;.....
  2055. ;
  2056. ;
  2057. VERERR:    LXI    D,VERBAD    ; Abort, bum CP/M version
  2058. ;
  2059. VERER1:    CALL    PRINT
  2060.     JMP    EXIT1
  2061. ;.....
  2062. ;
  2063. ;
  2064. ; WBTRAP is where the ZRDOS returns control on warm boot (error)
  2065. ;
  2066. WBTRAP:    LXI    H,DSKERR    ; Return here after reseeting the trap
  2067.     PUSH    H        ; Save DSKERR on stack
  2068.     JMP    RESTRAP
  2069. ;.....
  2070. ;
  2071. ;
  2072. ; ZRDOS Error Trap and System Call exits to CPM20
  2073. ;
  2074. ZRD:    CALL    SETTRAP        ; Set the warm boot trap
  2075.     CALL    BDOS        ; Do what we're told
  2076.     CALL    RESTRAP        ; Reset the trap
  2077.     JMP    CPM20        ; Error free exit
  2078.  
  2079. ;.....
  2080. ;
  2081. ;
  2082. ;-----------------------------------------------------------------------
  2083. ;
  2084. ;            END OF PROGRAM CODE
  2085. ;
  2086. ;-----------------------------------------------------------------------
  2087. ;
  2088. ;
  2089. SIGNON:    DB    CR,LF,'SuperFILE '
  2090.     DB    VER/10+'0','.',VER MOD 10+'0',CR,LF,0
  2091. ;
  2092.      IF    CKSYS OR CKWHL
  2093. SIGN1:    DB    'includes $SYS files',CR,LF,0
  2094.      ENDIF            ; CKSYS OR CKWHL
  2095. ;
  2096. SIGN2:
  2097.      IF    CKLBR
  2098.     DB    '(also searches '
  2099.      ENDIF            ; CKLBR
  2100. ;
  2101.      IF    NOT CKLBR
  2102.     DB    '(does not search '
  2103.      ENDIF            ; NOT CKLBR
  2104. ;
  2105.     DB    'lbr / arc) - ^X to abort',CR,LF,CR,LF,0
  2106. ;.....
  2107. ;
  2108. ;
  2109. HELP:    DB    CR,LF,'  SuperFILE v'
  2110.     DB    VER/10+'0','.',VER MOD 10+'0',CR,LF
  2111.     DB    CR,LF,'  A FILE search program ',0
  2112. ;
  2113.      IF    CKSYS OR CKWHL
  2114. HELP1:    DB    'that includes $SYS files',CR,LF
  2115.     DB    '  ',0
  2116.      ENDIF            ; CKSYS
  2117. ;
  2118. HELP2:
  2119.      IF    CKLBR
  2120.     DB    '(also searches '
  2121.      ENDIF            ; CKLBR
  2122. ;
  2123.      IF    NOT CKLBR
  2124.     DB    '(does not search '
  2125.      ENDIF            ; NOT CKLBR
  2126. ;
  2127.     DB    'lbr / arc) - ^X to abort',CR,LF,CR,LF
  2128. ;
  2129.      IF    CKLBR
  2130.     DB    '       (Use FILE.COM to skip lbr/arc checks)'
  2131.      ENDIF            ; CKLBR
  2132. ;
  2133.      IF    NOT CKLBR
  2134.     DB    '       (Use SFILE.COM to include lbr/arc checks)'
  2135.      ENDIF            ; NOT CKLBR
  2136. ;
  2137.     DB    CR,LF,CR,LF,CR,LF
  2138.     DB    '  Examples to search all drive and user areas:',CR,LF
  2139.     DB    CR,LF,'          A>'
  2140. ;
  2141.      IF    CKLBR
  2142.     DB    'S'
  2143.      ENDIF            ; CKLBR
  2144. ;
  2145.     DB    'FILE *.AQM',CR,LF,'          A>'
  2146. ;
  2147.      IF    CKLBR
  2148.     DB    'S'
  2149.      ENDIF            ; CKLBR
  2150. ;
  2151.     DB    'FILE IMP*.*',CR,LF
  2152.     DB    CR,LF,'  Examples to search a single drive and all '
  2153.     DB    'user areas:',CR,LF
  2154.     DB    CR,LF,'          A>'
  2155. ;
  2156.      IF    CKLBR
  2157.     DB    'S'
  2158.      ENDIF            ; CKLBR
  2159. ;
  2160.     DB    'FILE B:BYE5??.*',CR,LF,'          A>'
  2161. ;
  2162.      IF    CKLBR
  2163.     DB    'S'
  2164.      ENDIF            ; CKLBR
  2165. ;
  2166.     DB    'FILE D:KMD*.*'
  2167.     DB    CR,LF,CR,LF,CR,LF,CR,LF,0
  2168.  
  2169.      IF    NAMDIR
  2170. PTRTBL:    DW    ATABLE        ; Location of name table for drive A
  2171.     DW    BTABLE        ; Location of name table for drive B
  2172.     DW    CTABLE        ; Location of name table for drive C
  2173.     DW    DTABLE        ; Location of name table for drive D
  2174.     DW    ETABLE        ; Location of name table for drive E
  2175.     DW    FTABLE        ; Location of name table for drive F
  2176.     DW    GTABLE        ; Location of name table for drive G
  2177.     DW    HTABLE        ; Location of name table for drive H
  2178.     DW    ITABLE        ; Location of name table for drive I
  2179.     DW    JTABLE        ; Location of name table for drive J
  2180.     DW    KTABLE        ; Location of name table for drive K
  2181.     DW    LTABLE        ; Location of name table for drive L
  2182.     DW    MTABLE        ; Location of name table for drive M
  2183. ;
  2184. ; Table of area names for each drive.  Each entry must be 8 characters
  2185. ; long.  Number of entries must be equal to or greater than the
  2186. ; maximum user area shown in HIDRV:
  2187. ;
  2188. ATABLE:    DB    'FLOPPY  '    ; Eight characters/entry
  2189.                 ; Users only access to A1:
  2190. BTABLE:
  2191. CTABLE:
  2192. DTABLE:
  2193. ETABLE:
  2194. FTABLE:
  2195. GTABLE:
  2196. HTABLE:
  2197. ITABLE:
  2198. JTABLE:
  2199. KTABLE:
  2200. LTABLE:
  2201. MTABLE:    DB    'BASE    '
  2202.     DB    'ASSEM   '
  2203.     DB    'WSTAR   '
  2204.     DB    'COMM    '
  2205.     DB    'EMPTY   '
  2206.     DB    'BASIC   '
  2207.     DB    'SCALC   '
  2208.     DB    'DBASE2  '
  2209.     DB    'RBBS    '
  2210.     DB    'MEXPLUS '
  2211.     DB    'GAMES   '
  2212.     DB    'NEWSOFT '
  2213.     DB    '        '
  2214.     DB    'ZCPR3   '
  2215.     DB    'DEVELOP '
  2216.     DB    'XFER    '    ; Users access to M15:
  2217.      ENDIF            ; NAMDIR
  2218. ;.....
  2219. ;
  2220. ;
  2221. ; Message area
  2222. ;
  2223. DRVMSG:    DB    '+++ Drive',0
  2224. ERRMS1:    DB    ' '
  2225. ERRMS2:    DB    'Error',0
  2226. INLBF:    DB    '  in  '
  2227. LBRTYP:    DB    'LBR'
  2228. PROCES:    DB    CR,'Checking '
  2229.  
  2230.      IF    NAMDIR
  2231. AREA:    DB    '        ',0
  2232.      ENDIF            ; NAMDIR
  2233.  
  2234. PROC1:    DB    ' ',0
  2235. PROC2:    DB    ': ',0
  2236.  
  2237. USRMSG:    DB    'User #',0
  2238.  
  2239. CLEAR:    DB    CR,'                  '
  2240.  
  2241.      IF    NAMDIR
  2242. TUMSG:    DB    CR,LF,'    Finished after area ',0
  2243.      ENDIF            ; NAMDIR
  2244.  
  2245.      IF    NOT NAMDIR
  2246. TUMSG:    DB    CR,LF,'    Finished after d/u = ',0
  2247.      ENDIF            ; NOT NAMDIR
  2248.  
  2249. TLMSG:    DB    CR,LF,'    Lbr / Arc searched = ',0
  2250. TMMSG:    DB    CR,LF,'    Files that matched = ',0
  2251. TCMSG:    DB    CR,LF,'    # of files checked = ',0
  2252. VERBAD:    DB    '+++ Needs CP/M 2.0 or Newer to RUN',0
  2253. ;
  2254. ;
  2255. ;=======================================================================
  2256. ;
  2257. ;             UNINITIALIZED DATA AREA
  2258. ;
  2259. ;=======================================================================
  2260. ;
  2261. BASUSR:    DB    0        ; Dupe of original dir. user # to search
  2262. BLKMSK:    DB    0        ; Records/blk - 1
  2263. BLKSHF:    DB    0        ; # shifts to mult by sec/blk
  2264. DOPFLG:    DB    0        ;
  2265. FNDFLG:    DB    0        ; File found flag
  2266. HITRAP:    DB    0        ; Highlit trap (previously typed char)
  2267. LSTUSR:    DB    0        ; To show last user area checked
  2268. LZFLG:    DB    0        ; 0 when printing leading zeros
  2269. MAXUSR:    DB    0        ; Max user # for drive from lookup table
  2270. NEWUSR:    DB    0        ; User # selected by "$U" option
  2271. OLDDSK:    DB    0        ; Holder for currently logged-in drive
  2272. OLDUSR:    DB    0        ; Contains user number upon invocation
  2273. SUPSPC:    DB    0        ; Leading space flag for decimal routine
  2274. VERFLG:    DB    0        ; CP/M version number (0=pre-CP/M 2)
  2275. ZRDFLG:    DB    0        ; ZRDOS version
  2276. ;
  2277. BLKMAX:    DW    0        ; Highest block # on drive
  2278. COUNT:    DW    0        ; Entry count
  2279. DIRMAX:    DW    0        ; Highest file # in directory
  2280. GAP:    DW    0        ; Sort routine storage
  2281. I:    DW    0        ; Sort routine storage
  2282. J:    DW    0        ; Sort routine storage
  2283. JG:    DW    0        ; Sort routine storage
  2284. LCOUNT:    DW    0
  2285. LLENLOC:DW    0        ; Running total of .LBR length
  2286. NEXTL:    DW    0
  2287. NEXTT:    DW    0        ; Next table entry
  2288. SCOUNT:    DW    0        ; # to sort
  2289. SLFILE:    DW    0
  2290. TBLOC:    DW    0        ; Pointer to start of name table
  2291. TEMP:    DW    0        ; Save dir entry
  2292. TFILES:    DW    0
  2293. TLIBRA:    DW    0
  2294. TMATCH:    DW    0
  2295. VECTBL:    DW    DSKERR        ; BDOS sector error intercept vector
  2296.     DW    DSKERR        ; BDOS select error intercept vector
  2297. ;
  2298. ISARC    DS    1        ; Current file type flag for .arc
  2299. GETABL    DS    1
  2300. ANAME:    DS    13        ; Name string
  2301. ASIZE:    DS    14        ; Compressed bytes
  2302. ARCFIL    DS    16        ; Dummy archive fcb
  2303. ;
  2304. SEARN:    DS    11        ; Holding area for search name
  2305. LBRFCB:    DS    36
  2306. LBBUF:    DS    80H
  2307. ;
  2308.     DS    100        ; Stack area
  2309. STACK:    DS    2        ; Save old stack pointer here
  2310. ;
  2311. ORDER    EQU    $        ; Order table starts here
  2312. ;
  2313. ;
  2314.     END
  2315.