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 / UTILS / DIRUTL / SDZD134.LBR / SDZD134.AZM / SDZD134.ASM
Assembly Source File  |  2000-06-30  |  114KB  |  5,163 lines
  1. ;              SUPER DIRECTORY PROGRAM
  2. ;                  SDZD134
  3. ;                 15 JUL 88
  4. ;
  5. ;    Read SDZD.INF for detailed instructions on configuring SD for your
  6. ;    system.  For information regarding this utility's modification
  7. ;    history, read SDZD.HIS.
  8. ;
  9. ;        This program is being distributed ready
  10. ;        to use on a CP/M v2.2 computer with two
  11. ;        disk drives , no Z80DOS, and no ZCPR in use.
  12. ;
  13. ;        (Options often changed for RCPM use are
  14. ;        marked with an asterisk.)  The typical
  15. ;        RCPM Sysop might change only these:
  16. ;
  17. ;            a)    3 options starting at MAXDRV
  18. ;            b)    how many drives at LODRV and
  19. ;            c)    6 options starting at USEF
  20. ;            d)    USELCW needs wheel to prevent
  21. ;               showing archive bits
  22. ;
  23. ;
  24. ;         NOTE:  This version can be assembled with
  25. ;            ASM, LASM, M80, MAC or SLRMAC.
  26. ;
  27. ; SD displays the directory of a CP/M disk, sorted alphabetically, with
  28. ; the file size in k, rounded to the nearest CP/M block size.  It also
  29. ; displays library and archive files with the file size in k, if the $L
  30. ; option is selected.
  31. ;
  32. ; Current versions of SD automatically adjust for any block size and di-
  33. ; rectory length under CP/M 2.2,  3.0 or MP/M.    They can also handle any
  34. ; number of disk drives or skip those not available.  Current features:
  35. ;
  36. ;     1) Automatic pauses when the screen fills up except when the
  37. ;        F, N, or P options are specified
  38. ;     2) Searching individual or multiple drives and/or user areas
  39. ;     3) Unconditional or optional disk system reset before execution
  40. ;        begins
  41. ;     4) Directing output to a disk file called DISK.DIR and append-
  42. ;        ing to that file on subsequent runs
  43. ;     5) Summary line output giving drive and user information, num-
  44. ;        ber of files matched, how much space they consume and free
  45. ;        space remaining on the disk
  46. ;     6) Displaying or suppressing "system" files
  47. ;     7) Accepting ambiguous filenames with or without a drive name
  48. ;     8) Printer output (automatically suppresses the [more] pauses)
  49. ;     9) Optional help menu with '?'
  50. ;    10) Displaying number of records used by files
  51. ;    11) Alphabetization of files sorted by type (extent)
  52. ;    12) Selecting alternate list format - vertical if horizontal
  53. ;        is default, and vice versa.
  54. ;    13) Shows contents of .ARC, .ARK or .LBR files with $L option
  55. ;    14) Summary line output optionally contains name of ZCPR3 named
  56. ;        directory, if selected
  57. ;    15) ZCPR3 named directory may be used in command line instead
  58. ;        of DU: if selected
  59. ;    16) ZCPR3 Public user areas may be displayed with or without
  60. ;        WHEEL byte
  61. ;    17) Z80DOS time stamping and SETD22 type stamping of .LBR's
  62. ;        supported via Z80DOS equate.
  63. ;    18) Normal multi-page vertical sort or single page vertical sort
  64. ;    19) Choose files based upon attributes 1-4
  65. ;    20) Z33 ENViorment support of wheel, maxdrv, maxusr location
  66. ;    21) Summary totals now supplied if /A,/D,/H (or combo).
  67. ;
  68. ;-----------------------------------------------------------------------
  69. ;
  70. ;    ASEG            ; Needed for M80 and RMAC, ignore error
  71. ;
  72.     ORG    0100H
  73. ;
  74.     JMP    START
  75. ;
  76. NO    EQU    0
  77. YES    EQU    NOT NO        ; (Some assemblers don't like 0FFh)
  78. ;
  79. ; Define version number
  80. ;
  81. MAIN    EQU    1        ; Main block number
  82. VER    EQU    34        ; Current version
  83. MONTH    EQU    07        ; Month
  84. DAY    EQU    06        ; Day
  85. YEAR    EQU    88        ; Year
  86. ;
  87. ;-----------------------------------------------------------------------
  88. ;                 options
  89. ;
  90. MAXDRV    EQU    no        ; *Yes if MAXD byte is supported
  91. MAXUR    EQU    no        ; *Yes if MAXU byte is supported
  92. WHEEL    EQU    no        ; *Yes if using ZCPR wheel byte
  93.  
  94. ; If using equate ZCPR33 set to YES, then the following 3 will be
  95. ; taken from the ENV descriptor automaticaly if the corresponding
  96. ; MAXDRV, MAXUR, or WHEEL equate is set YES
  97. MXDRV    EQU    3DH        ; *Set to max drive address if MAXDRV=Yes
  98. MXUSR    EQU    3FH        ; *Set to max user  address if MAXUR=Yes
  99. WHLOC    EQU    3EH        ; *Set to wheel location if WHEEL=Yes
  100.  
  101. MXZUSR    EQU    15        ; Maximum user # allowed with WHEEL set
  102.  
  103. PRBRDR    EQU    NO        ; Yes = print quasi-borders for libraries
  104. WMBOOT    EQU    NO        ; If warmboot is needed on exit
  105. VLIST    EQU    YES        ; Yes for vertical alphabetization
  106. VSPAGE    EQU    YES        ; If Vertical sort is to be by page
  107.  
  108.     DB    'Z3ENV'        ; For ZCPR3 Environment ID
  109.     DB    1        ; Class 1, External
  110. Z3ENV:    DW    0        ; Environment Address.    If using ZCPR33
  111.                 ; This can be left as is.
  112. ;-------------------------------
  113. ;
  114. ; Drive/User area lookup table:
  115. ; ----------------------------
  116. ; Change the following table as appropriate for your version of CP/M.
  117. ; You can limit the maximum user area without wheel byte independently
  118. ; for any drive available.  Use 0FFh for drives that are not available.
  119. ;
  120. ;        CP/M  v2.2 has 16 user areas, 0-15
  121. ;        CP/M  v3.0 has 32 user areas, 0-31
  122. ;
  123. ; NOTE: Use your editor to move the "HIDRV" line below the correct
  124. ; number of drives for your system.  This not only saves time when the
  125. ; highest drive has been reached, but will display a drive/user error
  126. ; message which otherwise will not be shown.
  127. ;
  128. LODRV    EQU    $        ; Mark beginning of drive/user table
  129.  
  130.     DB    15        ; Maximum user area for drive A
  131.     DB    15        ; "      "    "    "    "     B
  132. HIDRV    EQU    $        ; Mark end of drive/user table
  133.     DB    0FFH        ; "      "    "    "    "     C
  134.     DB    0FFH        ; "      "    "    "    "     D
  135.     DB    0FFH        ; "      "    "    "    "     E
  136.     DB    0FFH        ; "      "    "    "    "     F
  137.     DB    0FFH        ; "      "    "    "    "     G
  138.     DB    0FFH        ; "      "    "    "    "     H
  139.     DB    0FFH        ; "      "    "    "    "     I
  140.     DB    0FFH        ; "      "    "    "    "     J
  141.     DB    0FFH        ; "      "    "    "    "     K
  142.     DB    0FFH        ; "      "    "    "    "     L
  143.     DB    0FFH        ; "      "    "    "    "     M
  144.     DB    0FFH        ; "      "    "    "    "     N
  145.     DB    0FFH        ; "      "    "    "    "     O
  146.     DB    0FFH        ; "      "    "    "    "     P
  147. ;
  148. ;-------------------------------
  149. ;
  150. ; Command line options:
  151. ; --------------------
  152. ; If any of the following equates are set NO, it prevents their use by
  153. ; any user (including the SYSOP) unless the wheel byte has been set for
  154. ; SYSOP use.  If running an RCPM, you may wish to say NO for those with
  155. ; an asterisk, such as USEF, USERO, USEP and USES to prevent others from
  156. ; using them - the wheel byte makes them available for SYSOP use.
  157. ;
  158. ; NOTE:  For RCPM use, all 5 would normally be set to "NO" to prevent
  159. ; remote use, but would be available to the Sysop with the WHEEL byte.
  160. ;
  161. USEF    EQU    yes        ; *Allow making a local disk copy?
  162. USEO    EQU    yes        ; *Allow showing only $SYS files?
  163. USEP    EQU    yes        ; *Allow making local printer listing?
  164. USER    EQU    yes        ; *Allow disk system reset?
  165. USES    EQU    yes        ; *Allow showing all, and $SYS files?
  166.  
  167. ; Above note goes for the following
  168. USEA    EQU    yes        ; *Allow specifying attributes 1-4?
  169.  
  170. ;
  171. ;-------------------------------
  172. ;
  173. ; Showing tagged attributes
  174. ; -------------------------
  175. ; Displaying files with tagged attributes ($R/O, $SYS, $ARC etc.) in an
  176. ; in an unique manner so they are easy to find, if present.
  177. ;
  178. ;    Example:
  179. ;        FILENAME.SyS    -  $SYS attribute set
  180. ;        FILENAME.doC    -  $SYS and $R/O both set
  181. ;        FILENAME.com    -  $SYS, $R/O and $ARC all set
  182. ;
  183. ; The following equates will permit SD to display the files with tagged
  184. ; attributes in lower case letters (a-z) as in example above.
  185. ;
  186. USELC    EQU    YES        ; Allow lower case letters (a-z)
  187. USELCW    EQU    YES        ; *Allow lower case without wheel byte?
  188. ;
  189. ;-----------------------------------------------------------------------
  190. ;
  191. ; Reverse video options
  192. ; ---------------------
  193. ; The following equate will permit SD to display the files with tagged
  194. ; attributes in either reverse video or bright/dim modes.  This will al-
  195. ; low any character tagged to be visible, as opposed to the USELD method.
  196. ; Up to 7 bytes for enter and exit video modes are provided.  These can
  197. ; be easily patched with DDT, etc.
  198. ;
  199. REVID    EQU    NO        ; Yes = inverse or bright/dim display
  200. ;
  201. ; The following equate will highlight/underline the summary line
  202. ;
  203. ULINE    EQU    NO        ; Yes = highlight/underline summary
  204. ;
  205. ;
  206. ; Reverse video control bytes
  207. ; ---------------------------
  208. ; If byte at RVON is 0, simple lower case will be used to display file
  209. ; attributes.
  210. ;
  211.      IF    REVID
  212. RVON:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for ENTER REVERSE
  213.     DB    0        ; String Terminator MUST BE 0
  214. ;
  215. RVOFF:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for EXIT REVERSE
  216.     DB    0        ; String Terminator MUST BE 0
  217.      ENDIF            ; REVID
  218. ;
  219. ; If byte at ULON is 0, no highlighting/underlining will be used in the
  220. ; banner line.
  221. ;
  222.      IF    ULINE
  223. ULON:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for ENTER ULINE
  224.     DB    0        ; String Terminator, MUST BE 0
  225. ;
  226. ULOFF:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for EXIT ULINE
  227.     DB    0        ; String Terminator MUST BE 0
  228.      ENDIF            ; ULINE
  229. ;
  230. ;-------------------------------
  231. ;
  232. ; Time/date options
  233. ; -----------------
  234. ; The following equate will get the TIMEON from BYE, if BYE is active.
  235. ; The message "Time on system is xx Minutes" will be displayed.
  236. ;
  237. TIMEON    EQU    NO        ; Yes, gets TIMEON from BYE5
  238. ;
  239. ; The following equate will permit the date to be displayed using the
  240. ; European system DD/MM/YY or the American system MM/DD/YY.  This only
  241. ; shows when using 'V' to display version number.
  242. ;
  243. EDATE    EQU    NO        ; Yes = European, No = American
  244. ;
  245. ;-------------------------------
  246. ;
  247. ; If using Z80DOS and you want date stamping support, set the following
  248. ; to YES.
  249. ;
  250. Z80DOS    EQU    NO
  251. ;
  252. ;-------------------------------
  253. ;
  254. ; If want to be able to specify files to be displayed based upon attribute
  255. ;    1 thru 4 , set the following to yes
  256. ;
  257. FATTRIB    EQU    YES
  258. ;
  259.  
  260. ;-------------------------------
  261. ;
  262. ; Z3CPR options
  263. ; -------------
  264. ; for ZCPR33 users - leave all set to NO if not using ZCPR3
  265. ;
  266. ZCPR33    EQU    NO        ; Allow named dir's and ENV support
  267. ZCPR3    EQU    NO        ; Allow named directory in command line
  268. NDIRS    EQU    NO        ; To display directory names
  269. SHOPUB    EQU    NO        ; To display ZRDOS Public Directories
  270. WHLPUB    EQU    NO        ; To make SHOPUB wheel dependent
  271. ZRDOS    EQU    NO        ; Set to yes if using ZRDOS
  272. Z3DRV    EQU    44        ; Offset from ENV location to find drive max
  273. Z3USR    EQU    45        ; Offset from ENV location to find user max
  274. Z3WHL    EQU    41        ; Offset from ENV location to find wheel address
  275. Z3NDR    EQU    21        ; Offset from ENV location to find NDIR address
  276. ;
  277. ;            end of options
  278. ;-----------------------------------------------------------------------
  279. ;
  280. ; Reference items
  281. ; ---------------
  282. RECORD    EQU    36
  283. FRN    EQU    33
  284. FCR    EQU    32
  285. READRN    EQU    33
  286. HDRSIZ    EQU    27
  287. ARCMAR    EQU    26
  288.  
  289. TMPLT0    EQU    $        ; Start of initialization template
  290.  
  291.      IF    VLIST
  292.     DB    0
  293.      ENDIF            ; VLIST
  294.  
  295.      IF    NOT VLIST
  296.     DB    0FFH
  297.      ENDIF            ; NO VLIST
  298.  
  299.     DB    'A'        ; All-users option flag
  300.     DB    'C'        ; File size in records option
  301.     DB    'D'        ; Multi-disk option flag
  302.  
  303.      IF    USEF
  304.     DB    'F'        ; DISK.DIR file output option
  305.      ENDIF            ; USEF
  306.  
  307.      IF    NOT USEF
  308.     DB    'F'+80H
  309.      ENDIF            ; NOT USEF
  310.  
  311.     DB    'H'        ; Show areas from current to highest
  312.     DB    'L'        ; Display library members flag
  313.     DB    'N'        ; No page-pause option flag
  314.  
  315.      IF    USEO
  316.     DB    'O'        ; To show $SYS files only
  317.      ENDIF            ; USEO
  318.  
  319.      IF    NOT USEO
  320.     DB    'O'+80H
  321.      ENDIF            ; NOT USEO
  322.  
  323.      IF    USEP
  324.     DB    'P'        ; Printer output option
  325.      ENDIF            ; USEP
  326.  
  327.      IF    NOT USEP
  328.     DB    'P'+80H
  329.      ENDIF            ; NOT USEP
  330.  
  331.     DB    'Q'        ; To show only non-$ARC files
  332.  
  333.      IF    USER
  334.     DB    'R'        ; Optional reset of disk system
  335.      ENDIF            ; USER
  336.  
  337.      IF    NOT USER
  338.     DB    'R'+80H
  339.      ENDIF            ; NOT USER
  340.  
  341.      IF    USES
  342.     DB    'S'        ; Include $SYS files
  343.      ENDIF            ; USES
  344.  
  345.      IF    NOT USES
  346.     DB    'S'+80H
  347.      ENDIF            ; NOT USES
  348.  
  349.     DB    'T'        ; Primary sort by file type
  350.     DB    'V'        ; Show SD version
  351.     DB    'X'        ; Alternate alphabetization
  352.  
  353.      IF    Z80DOS
  354.     DB    '='        ; Look for exact match of date given
  355.     DB    '+'        ; Look for files of date GE date given
  356.     DB    '-'        ; Look for files of date LT date given
  357.     DB    '!'        ; Match with creation date
  358.     DB    '%'        ; Match with alteration date
  359.     DB    '@'        ; Match with access date
  360.     DB    'Z'        ; Do not show dates
  361.      ENDIF        ;Z80DOS
  362.  
  363.      IF    FATTRIB        ; Allow spec of file attributes 1-4?
  364.      IF    USEA
  365.     DB    '1'        ; Only files with attrib 1
  366.      ENDIF        ;USEA
  367.  
  368.      IF    NOT USEA
  369.     DB    80H+'1'
  370.      ENDIF        ;NOT USEA
  371.  
  372.      IF    USEA
  373.     DB    '2'        ; Only files woth attrib 2
  374.      ENDIF        ;USEA
  375.  
  376.      IF    NOT USEA
  377.     DB    80H+'2'
  378.      ENDIF        ;NOT USEA
  379.  
  380.      IF    USEA
  381.     DB    '3'        ; Only files with attrib 3
  382.      ENDIF        ;USEA
  383.  
  384.      IF    NOT USEA
  385.     DB    80H+'3'
  386.      ENDIF        ;NOT USEA
  387.  
  388.      IF    USEA
  389.     DB    '4'        ; Only files with attrib 4
  390.      ENDIF        ;USEA
  391.  
  392.      IF    NOT USEA
  393.     DB    80H+'4'
  394.      ENDIF        ;NOT USEA
  395.  
  396.      ENDIF        ;FATTRIB
  397. ;
  398. ; End of option lookup table
  399. ;
  400.     DW    OUTBUF        ; Next location in output buffer
  401.     DB    128        ; # of bytes left in output buffer
  402.     DB    0,'DISK    DIR'    ; Output Filename.typ
  403. ;
  404. TMPLT1    EQU    $        ; End of initialization data template
  405.  
  406. VERNAME:DB    13,10,'SDZD',MAIN+'0'
  407.     DB    VER/10+'0',VER MOD 10+'0',' -- '
  408.  
  409.      IF    NOT EDATE
  410.     DB    MONTH/10+'0',MONTH MOD 10+'0','/'
  411.      ENDIF            ; NOT EDATE
  412.  
  413.     DB    DAY/10+'0',DAY MOD 10+'0','/'
  414.  
  415.      IF    EDATE
  416.     DB    MONTH/10+'0',MONTH MOD 10+'0','/'
  417.      ENDIF            ; EDATE
  418.  
  419.     DB    YEAR/10+'0',YEAR MOD 10+'0'
  420.  
  421.      IF    Z80DOS
  422.     DB    ', Z80DOS'
  423.      ENDIF
  424.  
  425.      IF    ZCPR3         ;
  426.     DB    ', ZCPR3/ARC/ARK Version'
  427.      ENDIF            ; ZCPR3 
  428.  
  429.      IF    ZCPR33         ;
  430.     DB    ', ZCPR33/ARC/ARK Version'
  431.      ENDIF            ; ZCPR33
  432.  
  433.     DB    0
  434. ;
  435. ;-----------------------------------------------------------------------
  436. ;             Program starts here
  437. ;-----------------------------------------------------------------------
  438. ;
  439. START:    LXI    H,0
  440.     DAD    SP        ; HL=old stack
  441.     SHLD    STACK        ; Save it
  442.     LXI    SP,STACK    ; Get new stack
  443.  
  444.      IF    ZCPR33
  445.     LHLD    Z3ENV        ; Get ENV address
  446.     PUSH    H
  447.     LXI    D,Z3DRV        ; Point to max drv byte
  448.     DAD    D
  449.     SHLD    Z3DRVL        ; Save location away
  450.     POP    H
  451.     PUSH    H
  452.     LXI    D,Z3USR        ; Point to maxuser byte
  453.     DAD    D
  454.     SHLD    Z3USRL        ; Save location away
  455.     POP    H
  456.     PUSH    H
  457.     LXI    D,Z3WHL        ; Point to address pointer of wheel
  458.     DAD    D
  459.     MOV    E,M        ; Get address of wheel byte
  460.     INX    H
  461.     MOV    D,M
  462.     XCHG
  463.     SHLD    Z3WHLL        ; Save it away
  464.     POP    H
  465.      ENDIF        ; ZCPR33
  466.  
  467.      IF    NDIRS
  468.     LHLD    Z3ENV        ; Get Environment Address
  469.     LXI    D,Z3NDR        ; Point to named directory space
  470.     DAD    D
  471.     MOV    E,M
  472.     INX    H
  473.     MOV    D,M        ; DE Now contains NDR Address
  474.     INX    H
  475.     MOV    A,M
  476.     ADI    1
  477.     STA    NUMDIR        ; Maximum number of entries plus 1
  478.     XCHG
  479.     SHLD    NAMADR        ; Keep Address for later
  480.      ENDIF            ; NDIRS
  481. ;
  482. ; Clear Public User Areas so they can be displayed
  483. ;
  484.      IF    SHOPUB
  485.     LHLD    0109H        ; Get Environment Address
  486.     MVI    D,0
  487.     MVI    E,07EH
  488.     DAD    D        ; HL Points to Public Drive Byte
  489.     MOV    A,M        ; Get public DRV byte
  490.     STA    PUBDRV
  491.     INX    H
  492.     MOV    A,M        ; Get public USR byte
  493.     STA    PUBUSR
  494.      ENDIF            ; SHOPUB
  495.  
  496.      IF    WHLPUB
  497.  
  498.      IF    ZCPR33
  499.     PUSH    H
  500.     LHLD    Z3WHLL        ; Point to ENV
  501.     MOV    A,M        ; Get wheel
  502.     POP    H
  503.      ENDIF        ;ZCPR33
  504.  
  505.      IF    NOT ZCPR33
  506.     LDA    WHLOC        ; Load wheel byte
  507.      ENDIF        ; NOT ZCPR33
  508.  
  509.     ORA    A
  510.     JZ    NOPUB
  511.      ENDIF            ; WHLPUB
  512.  
  513.      IF    SHOPUB
  514.     DCX    H
  515.     MVI    A,0        ; Clear Public Areas temporarily
  516.     MOV    M,A
  517.     INX    H
  518.     MOV    M,A
  519.  
  520.      IF    WHLPUB
  521. NOPUB:    DS    0
  522.      ENDIF            ; WHLPUB
  523. ;
  524. ; (WHLPUB enabled, the R option is redundant)
  525. ;
  526.      ENDIF            ; SHOPUB
  527. ;
  528. ; See if help is wanted
  529. ;
  530.     LXI    H,FCB+1        ; Filename
  531.     MOV    A,M        ; 1st Character
  532.  
  533.      IF    NOT ZCPR33
  534.     CPI    '?'        ; Is it "?"
  535.     JNZ    INIT        ; No, Continue
  536.     INX    H        ; Yes, Next Char
  537.     MOV    A,M        ; 2nd Character
  538.     CPI    ' '        ; Is it " "
  539.     JNZ    INIT        ; If not, did not want help guide
  540.     LDA    FCB+9        ; Check for any extent
  541.     CPI    ' '
  542.     JZ    HELPME        ; If none, wanted help
  543.      ENDIF        ; NOT ZCPR33
  544.  
  545.      IF    ZCPR33
  546.     CPI    '?'        ; Is it "?"
  547.     JNZ    CHKSLH        ; No, Continue
  548.     INX    H        ; Yes, Next Char
  549.     MOV    A,M        ; 2nd Character
  550.     CPI    ' '        ; Is it " "
  551.     JNZ    INIT        ; If not, did not want help guide
  552.     LDA    FCB+9        ; Check for any extent
  553.     CPI    ' '
  554.     JZ    HELPME        ; If none, wanted help
  555.     JMP    INIT
  556. CHKSLH: CPI    '/'        ; Is it a slash?
  557.     JNZ    INIT
  558.     INX    H
  559.     MOV    A,M        ; two slashes gets help
  560.     CPI    '/'
  561.     JZ    HELPME
  562.      ENDIF        ; ZCPR33
  563.  
  564. ;
  565. ; Zero out the entire initialization data area
  566. ;
  567. INIT:    LXI    H,DATA0        ; Point to start of initialized data area
  568.     PUSH    H        ; Save for non-zero filling later
  569.     MVI    C,DATA1-DATA0    ; Data area length
  570.     XRA    A        ; Clear the "A" register
  571.  
  572. ZFILL:    MOV    M,A        ; Null the address
  573.     INX    H        ; Pointer+1
  574.     DCR    C        ; One less to go
  575.     JNZ    ZFILL
  576.  
  577.      IF    SHOPUB        ; In order for the Public Directories
  578.     MVI    A,0FFH        ; To be displayed, Option 'R' must be
  579.     STA    ROPFLG        ; Forced true.
  580.      ENDIF            ; SHOPUB
  581. ;
  582. ; Now copy non-zero initialization data from the template area
  583. ;
  584.     POP    H        ; Load A(DATA0)
  585.     LXI    D,TMPLT0    ; Load A(TMPLT0)
  586.     MVI    C,TMPLT1-TMPLT0    ; Template area length
  587.  
  588. NZFILL:    LDAX    D        ; Load template byte
  589.     MOV    M,A        ; Move to data area
  590.     INX    D        ; Next location to store data
  591.     INX    H        ; Next location to get data
  592.     DCR    C        ; One less to go
  593.     JNZ    NZFILL
  594.  
  595.     LXI    H,0        ; Clear HL
  596.  
  597.      IF    ZRDOS
  598.     MVI    C,ZRDVER    ; Get ZRDOS version
  599.     CALL    BDOS
  600.     MOV    A,L        ; ZRDOS Version #
  601.     STA    ZRDFLG        ; Save it
  602.      ENDIF            ; ZRDOS
  603.  
  604.     MVI    C,CPMVER    ; Get CP/M  version
  605.     CALL    BDOS
  606.     MOV    A,L        ; CP/M Version number
  607.     STA    VERFLG        ; Save it
  608.     STA    SOHFLG        ; Prevents initial unwanted CRLF
  609.     CPI    20H        ; Set carry if CP/M 1.4
  610.     PUSH    PSW        ; Save for BYE test
  611.     MVI    E,0FFH        ; Load current user number if CP/M 2
  612.     MVI    C,STUSER    ; Fall through with A=0 if not
  613.     CNC    CPM        ; Only if CP/M 2.0 or ZRDOS
  614.     STA    OLDUSR        ; Initial user number
  615.     STA    NEWUSR        ; New user = Initial user
  616.     STA    BASUSR        ; Directories
  617.     POP    PSW        ; Recover Version Flag
  618.     MVI    E,241        ; Special BYE5xx Call
  619.     MVI    C,STUSER    ; Returns 77 if BYE5xx active
  620.     CNC    CPM        ; BYE5nn not on CP/M 1.4 system
  621.     SUI    77        ; Return code expected
  622.     STA    BYEACT        ; BYEACT = 0, BYE5nn active
  623.  
  624.      IF    TIMEON
  625.     CALL    TIME
  626.      ENDIF            ; TIMEON
  627.  
  628.      IF    ZCPR3 OR ZCPR33
  629.     LDA    FCB+13        ; Point to command line buffer (CLB)
  630.     STA    NEWUSR
  631.      ENDIF            ; ZCPR3
  632.  
  633.      IF    NOT ZCPR3 AND NOT ZCPR33
  634.     LXI    H,TBUF+1    ; Point to command line buffer (CLB)
  635.     MOV    A,M        ; CLB Character
  636.     CPI    '['        ; CP/M 3.0 style delimiter
  637.     JZ    CLOK        ; (may follow command in CP/M 3.0)
  638.     INX    H        ; CLB pointer +1
  639.     ORA    A        ; Terminator?
  640.     JNZ    CLOK        ; No, continue
  641.     MOV    M,A        ; Yes, set 2nd terminator
  642.  
  643. CLOK:    LXI    D,FCB        ; A(file control block)
  644.     CALL    FNAME        ; Process filename.typ
  645.     MOV    A,B        ; Disk specification
  646.     CPI    0FFH        ; Current?
  647.     JZ    CLUS        ; Yes
  648.     STAX    D        ; No, set disk specification
  649.  
  650. CLUS:    MOV    A,C        ; User specification
  651.     CPI    0FFH        ; Current?
  652.     JZ    CLNON        ; Yes
  653.     STA    NEWUSR        ; No, set user specification
  654.     STA    BASUSR
  655.      ENDIF            ; NOT ZCPR3 AND NOT ZCPR33
  656.  
  657. CLNON:    MVI    C,CURDSK
  658.     CALL    CPM        ; Load current disk number
  659.     STA    OLDDSK        ; Save for reset if needed
  660.     INR    A        ; Adjust
  661.     STA    OUTFCB        ; Save directory file drive
  662.     LXI    H,FCB        ; A(file control block)
  663.     MOV    A,M        ; Load directory search drive
  664.     ORA    A        ; Any specified?
  665.     JNZ    START1        ; Yes, skip next routine
  666.     LDA    OLDDSK        ; Otherwise, get default disk
  667.     INR    A        ; Adjust
  668.     JMP    START2
  669.  
  670. START1:    PUSH    PSW        ; Save status
  671.     MVI    A,1
  672.     STA    DRVFLG        ; Set DRVFLG = 1
  673.     POP    PSW        ; Load status
  674.  
  675. START2:    MOV    M,A        ; Absolute drive code in directory FCB
  676. ;
  677. ; If at least one option is allowed,  scan command line for the option
  678. ; field delimiter. The option field delimiter is considered valid only
  679. ; if it is preceded by at least 1 space  (otherwise may be part of the
  680. ; directory filename).     Any unrecognized options/illegal user numbers
  681. ; will be flagged.(We scan the command line buffer rather than the 2nd
  682. ; default FCB because all 8 options + 2 digit user number will not fit
  683. ; in the 2nd FCB name field).
  684. ;
  685.     LXI    H,TBUF        ; CLB pointer
  686.     MOV    B,M        ; CLB length
  687. ;
  688. ; Search for valid command line delimiter, if not found, assume no
  689. ; options.  Show help menu if single "?" entered.
  690. ;
  691. SCNDOL:    INX    H        ; CLB PTR+1
  692.     DCR    B        ; CLB LEN-1
  693.     JM    DOPTN        ; Exit if command line buffer empty
  694.     MOV    A,M        ; CLB Character
  695.     CPI    '['        ; CPM+ style delimiter?
  696.     JZ    OPTDLM        ; Yes
  697.     CPI    '$'        ; CPM2 style delimiter?
  698.     JZ    SPB4        ; Yes
  699.     CPI    '/'        ; ZCPR style delimiter?
  700.     JNZ    SCNDOL        ; No
  701.  
  702. SPB4:    DCX    H        ; '$' found, space must precede
  703.     MOV    A,M        ; Previous character
  704.     INX    H
  705.     CPI    ' '
  706.     JNZ    SCNDOL        ; No space, ignore '$'
  707. ;
  708. ; Valid delimiter found.  Scan the rest of the buffer for options.
  709. ; Errors past this point cause an abort.
  710. ;
  711. OPTDLM:    XCHG            ; DE = CLB pointer (swap pointers)
  712.  
  713. SCNOPT:    INX    D        ; CLB PRT+1
  714.     DCR    B        ; CLB LEN-1
  715.     JM    DOPTN        ; If option field exhausted, exit
  716.  
  717. SCNAGN:    LDAX    D        ; Load option character
  718.     CPI    ' '        ; Is it " "?
  719.  
  720.      IF    Z80DOS
  721.     JZ    LOKDAT        ; Space, go look for date info
  722.      ENDIF        ;Z80DOS
  723.  
  724.      IF    NOT Z80DOS
  725.     JZ    SCNOPT        ; Yes, Ignore it
  726.      ENDIF        ;NOT Z80DOS
  727.  
  728.     CPI    ']'        ; CPM+ style terminator?
  729.     JZ    SCNOPT        ; Options may follow terminator
  730.     LXI    H,OTBL-1    ; OTBL pointer
  731.     MVI    C,OEND-OTBL+1    ; OTLB length
  732.  
  733. NOMACH:    INX    H        ; OTLB pointer+1
  734.     DCR    C        ; OTLB length-1
  735.     JZ    CLERR        ; Error if option table end
  736.  
  737.      IF    WHEEL        ; ZCMD/ZCPR2/ZCPR3?
  738.     PUSH    PSW        ; Save "A" value
  739.  
  740.      IF    ZCPR33
  741.     PUSH    H
  742.     LHLD    Z3WHLL        ; Point to ENV
  743.     MOV    A,M        ; Get wheel
  744.     POP    H
  745.      ENDIF        ;ZCPR33
  746.  
  747.      IF    NOT ZCPR33
  748.     LDA    WHLOC        ; Load wheel byte
  749.      ENDIF        ; NOT ZCPR33
  750.  
  751.     ORA    A        ; Set Flags
  752.     JZ    NOMAC1        ; Not set, so forget it
  753.     MOV    A,M        ; Load the table option
  754.  
  755.      IF    FATTRIB
  756.     ANI    7FH
  757.      ENDIF        ;FATTRIB
  758.  
  759.      IF    NOT FATTRIB
  760.     ANI    5FH        ; Allow the option
  761.      ENDIF        ;NOT FATTRIB
  762.  
  763.     MOV    M,A        ; Stuff back in table
  764.  
  765. NOMAC1:    POP    PSW        ; Restore "A" value
  766.      ENDIF            ; WHEEL
  767.  
  768.     CMP    M        ; Compare with table entry
  769.     JNZ    NOMACH        ; If no match, check next
  770.     MVI    M,0        ; Else, activate the option
  771.     JMP    SCNOPT        ; Continue scan
  772. ;.....
  773. ;
  774. ; Playback the command line up to the character that stopped the scan
  775. ; and exit
  776. ;
  777. CLERR:    XRA    A        ; Clear "A" register
  778.     INX    D        ; Tag end of CLB
  779.     STAX    D        ; With terminator
  780.     CALL    CRLF        ; New line
  781.     LXI    D,ERRMS2    ; 'Error'
  782.     CALL    PUTS
  783.     LXI    D,ERRTAG    ; '->'
  784.     CALL    PUTS
  785.     LXI    H,TBUF+1    ; Playback CLB to error point
  786.  
  787. CLELP:    MOV    A,M        ; Character
  788.     ORA    A        ; Zero?
  789.     JZ    CLEX        ; Yes, exit
  790.     CALL    PUTCHR        ; No, output to console
  791.     INX    H        ; CLB pointer+1
  792.     JMP    CLELP        ; Continue
  793.  
  794. CLEX:    MVI    A,'?'        ; Tag line with a '?' field
  795.     CALL    PUTCHR
  796.     CALL    CRLF        ; New Line
  797.  
  798.      IF    SHOPUB
  799.     CALL    RSTPUB
  800.      ENDIF            ; SHOPUB
  801.  
  802. ;;;;;    JMP    0000H        ; And reset CCP, all finished
  803.     JMP    EXIT2
  804.  
  805.      IF    Z80DOS
  806. LOKDAT:    INX    D
  807.     LDAX    D        ; Check to see if * was entered meaning
  808.     CPI    '*'        ; use current system time
  809.     JNZ    LOKDAT1        ; NZ=no
  810.     LXI    D,ASCII        ; Tell Z80DOS to put time here
  811.     MVI    C,105
  812.     CALL    5        ; Go get the time
  813.     LXI    D,ASCII
  814.     LDAX    D        ; Get LSB of JDAY
  815.     MOV    L,A
  816.     INX    D
  817.     LDAX    D        ; Get MSB of JDAY
  818.     MOV    H,A
  819.     JMP    LOKDAT2        ; And continue
  820. LOKDAT1:
  821.     call    eval10        ; convert month to binary
  822.     ORA    A        ; month can't be 0
  823.     JZ    BADDATE
  824.     CPI    13         ; can't be >12
  825.     JNC    BADDATE
  826.     STA    MONTHS        ; store month
  827.     LDAX    D        ; End of input line?
  828.     ORA    A
  829.     JZ    BADDATE        ; Z=yes, a no-no
  830.     INX    D        ; Skip /
  831.     call    eval10        ; convert
  832.     ORA    A        ; day can't be 0
  833.     JZ    BADDATE
  834.     CPI    32        ; or >31
  835.     JNC    BADDATE
  836.     STA    DAYS1        ; store day
  837.     LDAX    D        ; End of input line?
  838.     ORA    A
  839.     JZ    BADDATE        ; Z=yes, a no-no
  840.     INX    D        ; Skip /
  841.     call    eval10
  842.     STA    YEARS1        ; store year
  843.     LXI    H,YEARS1        ; pt at date
  844.     call    bin2jul        ; get jul date in hl
  845. LOKDAT2:
  846.     SHLD    DATCHK
  847.     JMP    DOPTN
  848. EVAL10:
  849.     XRA    A
  850.     MOV    B,A        ; B holds current number input
  851. EVAL1:    LDAX    D        ; Get input
  852.     CPI    '/'        ; / is seperator
  853.     JZ    DEVAL10        ; Z= done
  854.     ORA    A
  855.     JZ    DEVAL10        ; Z= at end of line
  856.     SUI    '0'        ; Verify ascii 0-9
  857.     JC    BADDATE
  858.     CPI    10
  859.     JNC    BADDATE
  860.     INX    D
  861.     MOV    C,A        ; Old*10+new
  862.     MOV    A,B
  863.     ADD    A
  864.     ADD    A
  865.     ADD    B
  866.     ADD    A
  867.     ADD    C
  868.     MOV    B,A        ; B has current
  869.     JMP    EVAL1
  870. DEVAL10:
  871.     MOV    A,B
  872.     RET
  873. BADDATE:
  874.     PUSH    D
  875.     LXI    D,BDTMES
  876.     CALL    PUTS
  877.     POP    D
  878.     JMP    CLERR
  879. BDTMES:
  880.     DB    13,10,13,10
  881.     DB    ' *** Illegal Date Entered, form MM/DD/YY or MM/D/YY or M/DD/YY'
  882.     DB    13,10,13,10,0
  883. ;
  884. ;    Binary to Julian Date routine.
  885. ;
  886. ; >>    hl -> yr,mo,da in bin
  887. ; <<     hl = Julian date
  888. ;
  889. ;    Convert to 8080 code from the original
  890. ;    BCD2JUL
  891. ;    by Bridger Mitchel and Howard Goldstein - 4/16/88
  892. ;
  893. bin2jul:
  894.     PUSH    PSW
  895.     PUSH    B
  896.     PUSH    D
  897.     MOV    A,M        ; A=yr
  898.     INX    H
  899.     MOV    C,M        ;c = mo
  900.     INX    H
  901.     PUSH    H        ;save ptr to day
  902.     PUSH    PSW        ;save year
  903. ;
  904. ; set hl= initial julian value of 77/12/31
  905. ;
  906.     LXI    H,0
  907.     SUI    78
  908.     JZ    B2JUL3
  909.     JNC    B2JUL0
  910.     ADI    100        ;<78, assume next century
  911. b2jul0:    MOV    B,A        ;b = # yrs > 78
  912.     MVI    A,1        ;init modulo 4 counter
  913.     LXI    D,365        ;days/yr
  914. b2jul1:    DAD    D        ;calc julian val. of  (yr/01/01 - 1)
  915.     INR    A
  916.     ANI    3        ;every 4 yrs,
  917.     JNZ    B2JUL2
  918.     INX    H        ;..add 1 for leap year
  919. b2jul2:    DCR    B
  920.     JNZ    B2JUL1
  921. ;
  922. ;     hl now = # days in years before current year
  923. ;
  924. b2jul3:    POP    PSW
  925.     ANI    3        ;if current yr == leap year
  926.     JNZ    B2JUL5
  927.     MOV    A,C
  928.     CPI    3        ;..and mo >= march
  929.     JC    B2JUL5
  930.     INX    H        ;..add the extra day (Feb 29)
  931. ;
  932. b2jul5:    MOV    B,C        ; b = month = # months +1 to sum
  933.     LXI    D,DPERMO    ;point at table
  934.     JMP    B2JUL7
  935. ;
  936. b2jul6:    call    addhl        ;add # days in this month
  937.     INX    D        ;bump tbl ptr
  938. b2jul7:    DCR    B
  939.     JNZ    B2JUL6
  940. ;
  941.     POP    D        ;ptr to day
  942.     call    addhl
  943.     pop    d
  944.     pop    b
  945.     pop    a
  946.     ret
  947.  
  948. addhl:    LDAX    D        ;add day of current month
  949. ;
  950. adda2hl:ADD    L
  951.     MOV    L,A
  952.     RNC
  953.     INR    H
  954.     ret
  955.  
  956. ;
  957. ; table of days per month (non-leap year)
  958. ;
  959.  
  960. dpermo:    db    31        ;jan
  961.     db    28        ;feb
  962.     db    31        ;mar
  963.     db    30        ;apr
  964.     db    31        ;may
  965.     db    30        ;jun
  966.     db    31        ;jul
  967.     db    31        ;aug
  968.     db    30        ;sep
  969.     db    31        ;oct
  970.     db    30        ;nov
  971.     db    31        ;dec
  972.  
  973.      ENDIF        ;Z80DOS
  974.  
  975.  
  976.  
  977. ;.....
  978. ;
  979. ; Options input or not specified, and associated flags set.
  980. ;
  981. ; If D-option, swap error vectors, then start at drive A if no
  982. ; drive specified on command line.
  983. ;
  984. DOPTN:    LDA    DOPFLG        ; If multi-disk flag set,
  985.     ORA    A        ; Need to set error traps
  986.     JNZ    AOPTN        ; If not, go check A-option
  987.     CALL    SWAPEM        ; Swap BDOS error vector tables
  988.     LDA    DRVFLG        ; Directory drive specified?
  989.     ORA    A
  990.     JNZ    AOPTN        ; No, don't reset
  991.     MVI    A,1        ; Yes, Set FCB to A:
  992.     STA    FCB
  993. ;
  994. ; Start user at 0 if A-option selected without U-option
  995. ;
  996. AOPTN:    LDA    AOPFLG        ; Check All-users option
  997.     ORA    A
  998.     JNZ    COPTN        ; Jump if not
  999.     LDA    HOPFLG        ; Asking to show all from current?
  1000.     ORA    A
  1001.     JZ    COPTN        ; If yes, do not reset "A" to zero
  1002.     XRA    A        ; No, Start at user 0
  1003.     STA    NEWUSR
  1004.     STA    BASUSR
  1005. ;
  1006. ; Test if C-option and set indicator character 'r', else 'k'
  1007. ;
  1008. COPTN:    LDA    COPFLG        ; File sizes wanted in records?
  1009.     ORA    A
  1010.     MVI    A,'k'
  1011.     JNZ    COPTN1        ; Jump if not
  1012.     MVI    A,'r'
  1013.  
  1014. COPTN1:    STA    FSIZEC        ; Indicator char after size
  1015. ;
  1016. ; Determine whether horizontal or vertical alphabetization.
  1017. ; If X-option selected, use alternate format.
  1018. ; Set flag and fence character accordingly.
  1019. ;
  1020.     LDA    XOPFLG        ; Check for X option
  1021.     ORA    A
  1022.     LDA    VFLAG        ; Get vertical flag
  1023.     JNZ    XOPTN1        ; Jump if no X option
  1024.     CMA            ; Else swap vertical/horizontal indicator
  1025.     STA    VFLAG        ; And change VFLAG other way
  1026.  
  1027. XOPTN1:    DS    0
  1028. ;
  1029. ; The following optionally resets the disk system.  The reset must
  1030. ; be done OUTSIDE of the multiple drive loop if the $F option is
  1031. ; enabled because CP/M 1.4 will clobber the DMA buffer on reset.
  1032. ;
  1033.     LDA    ROPFLG        ; Reset Disk?
  1034.     ORA    A
  1035.     JNZ    NOOPT
  1036. ;
  1037. ; Disk reset if R option entered on command line
  1038. ;
  1039.     MVI    C,RESET
  1040.     CALL    CPM
  1041. ;
  1042. ; Validate drive code and user area numbers from the drive table
  1043. ;
  1044. NOOPT:    LXI    D,DRUMSG    ; Get drive/user error message
  1045.     PUSH    D
  1046.     LDA    FCB        ; Get directory drive code
  1047.     DCR    A        ; Normalize to range of 0-31
  1048.     CPI    HIDRV-LODRV    ; Compare with max drives on-line
  1049.     JNC    ERXIT        ; Drive error exit if out of range
  1050.  
  1051.      IF    MAXDRV        ; Look for MXDRV
  1052.  
  1053.      IF    ZCPR33
  1054.     LHLD    Z3DRVL        ; Point to ENV as loaded
  1055.      ENDIF        ;ZCPR33
  1056.  
  1057.      IF    NOT ZCPR33
  1058.     LXI    H,MXDRV        ; A(MXDRV) to HL
  1059.      ENDIF        ;NOT ZCPR33
  1060.  
  1061.     MOV    L,M        ; (MXDRV) to L
  1062.      ENDIF            ; MAXDRV
  1063.  
  1064.      IF    MAXDRV
  1065.  
  1066.      IF    NOT ZCPR33
  1067.     INX    H        ; +1
  1068.      ENDIF        ; NOT ZCPR33
  1069.  
  1070.     CMP    L        ; Check it
  1071.     JNC    ERXIT        ; Oops if not bigger
  1072.      ENDIF            ; MAXDRV
  1073. ;
  1074. ; Skips any drives marked 0FFh, some computers do not have contiguous
  1075. ; drives, such as Heath H89, etc.
  1076. ;
  1077.     MOV    E,A        ; Drive code = table index
  1078.     MVI    D,0
  1079.     LXI    H,LODRV        ; DUTBL Pointer
  1080.     DAD    D        ; DUTBL Pointer+INDEX
  1081.     MOV    A,M        ; User Number
  1082.     ORA    A        ; Set Status
  1083.     JM    NDSK        ; If negative, ignore drive
  1084.  
  1085.      IF    WHEEL
  1086.  
  1087.      IF    ZCPR33
  1088.     PUSH    H
  1089.     LHLD    Z3WHLL        ; Point to enviorment
  1090.     MOV    A,M        ; Get it
  1091.     POP    H
  1092.      ENDIF        ;ZCPR33
  1093.  
  1094.      IF    NOT ZCPR33
  1095.     LDA    WHLOC        ; Get wheel byte
  1096.      ENDIF        ;NOT ZCPR33
  1097.  
  1098.     ORA    A        ; Check it
  1099.     JZ    USRCK        ; If reset, restrict user
  1100.     MVI    A,MXZUSR    ; If set, max user = MXZUSR
  1101.     JMP    USRCK1
  1102.      ENDIF            ; WHEEL
  1103.  
  1104. USRCK:    LXI    H,LODRV        ; DUTBL PTR
  1105.     DAD    D        ; DUTLB PTR+INDEX
  1106.     MOV    A,M        ; Load max user for this drive
  1107.  
  1108.      IF    MAXUR        ; Use low memory values if smaller
  1109.     MOV    H,A        ; Current value of MAXUSR
  1110.  
  1111.      IF    ZCPR33
  1112.     PUSH    H
  1113.     LHLD    Z3USRL        ; Point to ENV
  1114.     MOV    A,M        ; Get user
  1115.     POP    H
  1116.      ENDIF        ;ZCPR33
  1117.  
  1118.      IF    NOT ZCPR33
  1119.     LDA    MXUSR        ; Alternate value
  1120.      ENDIF        ;NOT ZCPR33
  1121.  
  1122.      ENDIF            ; MAXUR
  1123.  
  1124.      IF    ( MAXUR AND NOT ZCPR3 ) AND NOT ZCPR33
  1125.     SBI    1        ; MAXUSR is really maximum user+1
  1126.      ENDIF            ; MAXUR AND NOT ZCPR3 AND NOT ZCPR33
  1127.  
  1128.      IF    MAXUR
  1129.     CMP    H        ; Compare the two
  1130.     JNC    USRCK1        ; OK if MAXU <= table value
  1131.     STA    MAXUSR        ; Else replace it
  1132.      ENDIF            ; MAXUR
  1133.  
  1134. USRCK1:    MOV    B,A        ; Save max user for later testing
  1135.     ANI    1FH        ; Insure in range 0-31
  1136.     STA    MAXUSR        ; Save it for later
  1137.     LXI    H,NEWUSR    ; Point to directory user area
  1138.     CMP    M        ; Compare with the maximum
  1139.     JC    ERXIT        ; User number illegal, error exit
  1140.     POP    D        ; Destroy error message pointer
  1141.     MOV    A,B        ; Check to see if this drive
  1142.     ORA    A        ; Has been mapped out
  1143.     JM    NDSK        ; Yes, skip this drive
  1144.     LXI    H,FCB+1        ; No, point to name
  1145.     MOV    A,M        ; Any name specified?
  1146.     CPI    '$'        ; Delimiter?
  1147.     JZ    WCD        ; Yes, All files
  1148.     CPI    '/'        ; Unix/ZCPR3 delimiter?
  1149.     JZ    WCD        ; Yes, All files
  1150.     CPI    '['        ; CP/M+ delimiter?
  1151.     JZ    WCD
  1152.     CPI    ' '        ; No, Filename specified
  1153.     JNZ    GOTFCB
  1154. ;
  1155. ; No FCB - make FCB all '?'
  1156. ;
  1157. WCD:    MVI    B,11        ; Filename+typ length
  1158.  
  1159. QLOOP:    MVI    M,'?'        ; Store "?" in FCB
  1160.     INX    H        ; FCB pointer+1
  1161.     DCR    B        ; FCB length-1
  1162.     JNZ    QLOOP        ; Continue
  1163.  
  1164. GOTFCB:    MVI    A,'?'        ; Force wild extent
  1165.     STA    FCB+12
  1166.     CALL    SETSRC        ; Set DMA for BDOS media change check
  1167.     LXI    H,FCB        ; Point to FCB drive code for directory
  1168.     MOV    E,M        ; Load drive code from FCB
  1169.     DCR    E        ; Normalize drive code for select
  1170.     MVI    C,SELDSK    ; Select directory drive to retrieve
  1171.     CALL    CPM        ; The proper allocation vector
  1172.     CALL    CKVER        ; Check version
  1173.     JC    V14        ; Pre-2.x...get parameters the 1.4 way
  1174.     MVI    C,DSKPAR    ; If 2.2 or MP/M...request DPB
  1175.     CALL    BDOS
  1176.     INX    H
  1177.     INX    H
  1178.     MOV    A,M        ; Load block shift
  1179.     STA    BLKSHF        ; Block Shift
  1180.     INX    H        ; Bump to block mask
  1181.     MOV    A,M        ; Load block mask
  1182.     STA    BLKMSK        ; Block Mask
  1183.     INX    H
  1184.     INX    H
  1185.     MOV    E,M        ; Get maximum block #
  1186.     INX    H
  1187.     MOV    D,M
  1188.     XCHG
  1189.     SHLD    BLKMAX        ; Maximum Block #
  1190.     XCHG
  1191.     INX    H
  1192.     MOV    E,M        ; Load directory size
  1193.     INX    H
  1194.     MOV    D,M
  1195.     XCHG
  1196.     JMP    FREE
  1197.  
  1198. V14:    LHLD    BDOS+1        ; Get parameters 1.4 style
  1199.     MVI    L,3BH        ; Point to directory size
  1200.     MOV    E,M        ; Get it
  1201.     MVI    D,0        ; Force high order to 0
  1202.     PUSH    D        ; Save for later
  1203.     INX    H        ; Point to block shift
  1204.     MOV    A,M        ; Fetch
  1205.     STA    BLKSHF        ; Save
  1206.     INX    H        ; Point to block mask
  1207.     MOV    A,M        ; Fetch it
  1208.     STA    BLKMSK        ; And save it
  1209.     INX    H
  1210.     MOV    E,M        ; Get maximum block #
  1211.     MVI    D,0
  1212.     XCHG
  1213.     SHLD    BLKMAX        ; Save it
  1214.     POP    H        ; Restore directory size
  1215.     JMP    FREE20        ; Calculate free space from alloc vector
  1216. ;
  1217. ; Calculate number of K free on selected drive now so the FREE figure
  1218. ; will not reflect either creation or additions to the DISK.DIR file.
  1219. ; Note: This routine will not always function correctly as coded.  To
  1220. ; insure the proper calculation when the $F option is specified and
  1221. ; cataloging multiple disks on a single drive, you should do a CTL-C
  1222. ; AFTER the disk to be cataloged has been readied.
  1223. ;
  1224. FREE:    SHLD    DIRMAX        ; Save max number of directory entries
  1225.     LDA    VERFLG        ; Check version number
  1226.     CPI    30H        ; CP/M 3.0?
  1227.     JC    FREE20        ; No, Use old method
  1228.     LDA    FCB        ; Load drive number
  1229.     DCR    A        ; Normalize
  1230.     MOV    E,A        ; Use compute free space BDOS call
  1231.     MVI    C,46        ; Calculate free space
  1232.     CALL    CPM
  1233.     MVI    C,3        ; Answer is a 24-bit integer
  1234.  
  1235. FRE3L1:    LXI    H,TBUF+2    ; Answer in 1st 3 bytes of TBUF
  1236.     MVI    B,3        ; Convert from records to k
  1237.     ORA    A        ; By dividing by 8
  1238.  
  1239. FRE3L2:    MOV    A,M        ; LS byte record count
  1240.     RAR            ; /2
  1241.     MOV    M,A        ; Replace
  1242.     DCX    H        ; Next byte record count
  1243.     DCR    B        ;
  1244.     JNZ    FRE3L2        ; Loop for 3 bytes
  1245.     DCR    C
  1246.     JNZ    FRE3L1        ; Shift 3 times
  1247.     LHLD    TBUF        ; Now get result in k
  1248.     JMP    SAVFRE        ; Save Free Space
  1249.  
  1250. FREE20:    MVI    C,DSKALL    ; Allocation vector address
  1251.     CALL    BDOS
  1252.     XCHG
  1253.     LHLD    BLKMAX        ; Max Block Number
  1254.     INX    H
  1255.     LXI    B,0        ; Init block count = 0
  1256.  
  1257. GSPBYT:    PUSH    D        ; Save allocation address
  1258.     LDAX    D
  1259.     MVI    E,8        ; Set to process 8 blocks
  1260.  
  1261. GSPLUP:    RAL            ; Test bit
  1262.     JC    NOTFRE
  1263.     INX    B
  1264.  
  1265. NOTFRE:    MOV    D,A        ; Save bits
  1266.     DCX    H        ; Count down blocks
  1267.     MOV    A,L
  1268.     ORA    H
  1269.     JZ    ENDALC        ; Quit if out of blocks
  1270.     MOV    A,D        ; Restore bits
  1271.     DCR    E        ; Count down 8 bits
  1272.     JNZ    GSPLUP        ; Do another bit
  1273.     POP    D        ; Bump to next byte of allocation vector
  1274.     INX    D
  1275.     JMP    GSPBYT        ; Process it
  1276.  
  1277. ENDALC:    POP    D        ; Clear stack of allocation vector pointer
  1278.     MOV    L,C        ; Copy blocks to HL
  1279.     MOV    H,B
  1280.     LDA    BLKSHF        ; Load block shift factor
  1281.     SUI    3        ; Convert from records to k
  1282.     JZ    SAVFRE        ; Skip shifts if 1k blocks return free in HL
  1283.  
  1284. FREKLP:    DAD    H        ; Multiply blocks by k/block
  1285.     DCR    A
  1286.     JNZ    FREKLP
  1287. ;
  1288. SAVFRE:    SHLD    FREEBY        ; Save free space for output later
  1289.     XCHG
  1290.     LHLD    TOTFRE
  1291.     DAD    D
  1292.     SHLD    TOTFRE
  1293. ;
  1294. ; Reenter here on subsequent passes while in the all-users mode
  1295. ;
  1296. SETTBL:    LHLD    DIRMAX        ; Load directory maximum size
  1297.     INX    H        ; Directory size is DIRMAX+1
  1298.     DAD    H        ; Double directory size
  1299.     LXI    D,ORDER        ; Too get order table size
  1300.     DAD    D        ; Allocate order table
  1301.     SHLD    TBLOC        ; Name tbl begins where order tbl ends
  1302.     SHLD    NEXTT
  1303.     XCHG
  1304.     LHLD    BDOS+1        ; Insure we have room to continue
  1305.     MOV    A,E
  1306.     SUB    L
  1307.     MOV    A,D
  1308.     SBB    H
  1309.     JNC    OUTMEM
  1310.     CALL    CKVER        ; Set carry if pre-CP/M 2
  1311.     LDA    NEWUSR        ; Load directory user area
  1312.     MOV    E,A
  1313.     MVI    C,STUSER    ; Get the user function
  1314.     CNC    CPM        ; Set new user number if CP/M 2
  1315. ;
  1316. ; Look up the FCB in the directory
  1317. ;
  1318.     MVI    A,'?'        ; Check for wild FCB extent
  1319.     LXI    H,FCB+12
  1320.     MOV    M,A        ; Match all extents
  1321.     INX    H
  1322.     MOV    M,A        ; Match all S1 bytes
  1323.     INX    H
  1324.     MOV    M,A        ; Match all S2 bytes
  1325.     LXI    H,0
  1326.     SHLD    COUNT        ; Initialize match counter
  1327.     SHLD    TOTFIL        ; "  total file counter
  1328.     SHLD    TOTSIZ        ; "  total size counter
  1329.     CALL    SETSRC        ; Set DMA for directory search
  1330.     MVI    C,SRCHF        ; Load 'search first' function
  1331.     JMP    LOOK        ; Go search for 1st match
  1332. ;
  1333. ; Read more directory entries
  1334. ;
  1335. MORDIR:    MVI    C,SRCHN        ; Search next function
  1336.  
  1337. LOOK:    LXI    D,FCB        ; A(file control block)
  1338.     CALL    CPM        ; Read directory entry
  1339.     INR    A        ; End (0FFH)?
  1340.     JZ    SPRINT        ; Yes, sort & print what we have
  1341. ;
  1342. ; Point to directory entry
  1343. ;
  1344.     DCR    A        ; Undo previous INR A
  1345.     ANI    3        ; Make modulus 4
  1346.     ADD    A        ; Multiply
  1347.     ADD    A        ; By 32 because
  1348.     ADD    A        ; Each directory
  1349.     ADD    A        ; Entry is 32
  1350.     ADD    A        ; Bytes long
  1351.     LXI    H,TBUF+1    ; Point to buffer (skip to FN/FT)
  1352.     ADD    L        ; Point to entry
  1353.  
  1354.      IF    FATTRIB
  1355.     MOV    L,A        ; HL now point to file name
  1356.     LDA    ONEFLG        ; Looking for only attribute 1?
  1357.     ORA    A
  1358.     JNZ    NOTONE        ; NZ=no
  1359.     MOV    A,M
  1360.     ORA    A
  1361.     JP    MORDIR        ; P=not attr 1
  1362. NOTONE:    INX    H
  1363.     LDA    TWOFLG        ; Only attribute 2?
  1364.     ORA    A
  1365.     JNZ    NOTTWO        ; NZ=no
  1366.     MOV    A,M
  1367.     ORA    A
  1368.     JP    MORDIR        ; P=not attr 2
  1369. NOTTWO:    INX    H
  1370.     LDA    THRFLG        ; Only attrib 3?
  1371.     ORA    A
  1372.     JNZ    NOTTHR        ; NZ=no
  1373.     MOV    A,M
  1374.     ORA    A
  1375.     JP    MORDIR        ; P= not attr 3
  1376. NOTTHR:    INX    H
  1377.     LDA    FORFLG        ; Only attr 4?
  1378.     ORA    A
  1379.     JNZ    NOTFOR        ; NZ=no
  1380.     MOV    A,M
  1381.     ORA    A
  1382.     JP    MORDIR        ; P= not attr 4
  1383. NOTFOR:    MOV    A,L
  1384.     ADI    6
  1385.      ENDIF        ; FATTRIB
  1386.  
  1387.      IF    NOT FATTRIB
  1388.     ADI    9        ; Point to sys byte
  1389.      ENDIF        ; NOT FATTRIB
  1390.  
  1391.     MOV    L,A        ; Save (can't carry to H)
  1392.     LDA    QOPFLG        ; Find only non-$ARC files?
  1393.     ORA    A
  1394.     JNZ    OSYS        ; No, check for only $SYS files
  1395.     INX    H        ; Yes, get the archive byte
  1396.     MOV    A,M
  1397.     DCX    H
  1398.     ORA    A        ; Check bit 7 for $ARC file
  1399.     JM    MORDIR        ; If set, ignore this filename
  1400.  
  1401. OSYS:    LDA    OOPFLG        ; Find only $SYS files?
  1402.     ORA    A
  1403.     JNZ    CKSYS
  1404.     MOV    A,M        ; Yes, get system byte
  1405.     ORA    A        ; Check bit 7 for $SYS file
  1406.     JP    MORDIR        ; If not set, ignore this filename
  1407.     JMP    SYSFOK        ; Else check for a match
  1408.  
  1409. CKSYS:    LDA    SOPFLG        ; Did user request $SYS files?
  1410.     ORA    A
  1411.     JZ    SYSFOK        ; If yes, exit
  1412.     MOV    A,M        ; Get system byte back
  1413.     ORA    A        ; Check bit 7 for $SYS file
  1414.     JM    MORDIR        ; Skip that file
  1415.  
  1416. SYSFOK:    MOV    A,L        ; Go back now
  1417.     SUI    10        ; Back to user number (allocation flag)
  1418.     MOV    L,A        ; HL points to entry now
  1419.     LDA    NEWUSR        ; Get current user
  1420.     CMP    M
  1421.     JNZ    MORDIR        ; Ignore if different
  1422.     INX    H
  1423.  
  1424.      IF    Z80DOS
  1425.     PUSH    B        ;
  1426.     PUSH    D        ;
  1427.     PUSH    H        ;
  1428.     MVI    C,54        ; Get time stamp from last search
  1429.     CALL    BDOS        ;
  1430.     LXI    D,6        ; Point to last access field
  1431.     LDA    DGOPFL
  1432.     ORA    A
  1433.     JZ    ACCESS        ; Z=what is wanted
  1434.     LXI    D,2        ; Point to last alteration field
  1435.     LDA    DAOPFL
  1436.     ORA    A
  1437.     JZ    ACCESS        ; Z=what is wanted
  1438.     LXI    D,0        ; Point to creation field
  1439.     LDA    DNOPFL
  1440.     ORA    A
  1441.     JZ    ACCESS        ; Z=what is wanted
  1442.  
  1443.     LXI    D,2        ; Didn't say, so give him alteration date
  1444.  
  1445. ACCESS: DAD    D        ; Point to right field in returned database
  1446.     MOV    E,M        ; Get the date in Julian
  1447.     INX    H
  1448.     MOV    D,M
  1449.     XCHG
  1450.     SHLD    DATMOD
  1451. ;////
  1452.     POP    H
  1453.     POP    D
  1454.     POP    B
  1455.      ENDIF        ;Z80DOS
  1456. ;
  1457. ; Move entry to table
  1458. ;
  1459.     XCHG            ; Entry to DE
  1460.     LHLD    NEXTT        ; Next table entry to HL
  1461.     MVI    B,11        ; Entry length (name, type, extent)
  1462.  
  1463. TMOVE:    LDAX    D        ; Get entry character
  1464.  
  1465.      IF    NOT (USELC OR REVID)
  1466.     ANI    7FH        ; Remove attributes
  1467.      ENDIF            ; NOT (USELC OR REVID)
  1468.  
  1469.     MOV    M,A        ; Store in table
  1470.     INX    D
  1471.     INX    H
  1472.     DCR    B        ; More?
  1473.     JNZ    TMOVE
  1474.     INX    D        ; DE->> S1
  1475.     INX    D        ; DE->> S2
  1476.     LDAX    D        ; Get S2 byte, oflo=int(extents/32)
  1477.     PUSH    H        ; Save HL
  1478.     MOV    L,A        ; Set up 16-bit multiply
  1479.     MVI    H,0
  1480.     MVI    B,5
  1481.     CALL    SHLL        ; HL is now # of oflo extents
  1482.     DCX    D        ; DE->> S1
  1483.     DCX    D        ; DE->> extent
  1484.     LDAX    D        ; Get extent
  1485.     ADD    L
  1486.     MOV    L,A
  1487.     MOV    A,H
  1488.     ACI    0
  1489.     MOV    H,A        ; HL has total extents
  1490.     MVI    B,7
  1491.     CALL    SHLL        ; HL has total records less last ext
  1492.     INX    D        ; DE->> S1
  1493.     INX    D        ; DE->> S2
  1494.     INX    D        ; Point to sector count
  1495.     LDAX    D        ; Get it
  1496.     ADD    L
  1497.     MOV    L,A
  1498.     MOV    A,H
  1499.     ACI    0
  1500.     MOV    H,A        ; HL has total records
  1501.     XTHL            ; Do some fancy shuffling
  1502.     XCHG
  1503.     XTHL
  1504.     XCHG
  1505.     MOV    M,D
  1506.     INX    H
  1507.     MOV    M,E
  1508.     POP    D        ; All back to normal
  1509.     INX    H
  1510.  
  1511.      IF    Z80DOS
  1512.     LDA    DATMOD        ; Get LSB of last modified date
  1513.     MOV    M,A        ;
  1514.     INX    H        ;
  1515.     LDA    DATMOD+1    ; Get MSB of last modified date
  1516.     MOV    M,A        ;
  1517.     INX    H        ;
  1518.      ENDIF        ;Z80DOS
  1519.  
  1520.     SHLD    NEXTT        ; Save updated table address
  1521.     XCHG
  1522.     LHLD    COUNT        ; Bump the # of matches made
  1523.     INX    H
  1524.     SHLD    COUNT
  1525.  
  1526.      IF    Z80DOS
  1527.     LXI    H,15        ; Size of entry include date
  1528.      ENDIF        ;Z80DOS
  1529.  
  1530.      IF    NOT Z80DOS
  1531.     LXI    H,13        ; Size of next entry
  1532.      ENDIF        ;NOT Z80DOS
  1533.  
  1534.     DAD    D
  1535.     XCHG            ; Future NEXTT is in DE
  1536.     LHLD    BDOS+1        ; Pick up TPA end
  1537.     MOV    A,E
  1538.     SUB    L        ; Compare NEXTT-TPA end
  1539.     MOV    A,D
  1540.     SBB    H
  1541.     JC    MORDIR        ; If TPA end > NEXTT, loop back for more
  1542.  
  1543. OUTMEM:    CALL    ERXIT        ; Exit if directory too large
  1544.     DB    'Memory',0
  1545. ;
  1546. ; Shift HL left by B bits
  1547. ;
  1548. SHLL:    DAD    H
  1549.     DCR    B
  1550.     RZ
  1551.     JMP    SHLL
  1552. ;
  1553. ; Sort and print
  1554. ;
  1555. SPRINT:    CALL    SETFOP        ; Return to file output DMA & user #
  1556.     LHLD    COUNT        ; Get file name count
  1557.     MOV    A,L
  1558.     ORA    H        ; Any found?
  1559.     JZ    PRTOTL        ; Exit if no files found
  1560.     PUSH    H        ; Save file count
  1561.     STA    SUPSPC        ; Enable leading zero suppression
  1562. ;
  1563. ; Initialize the order table
  1564. ;
  1565.     LHLD    TBLOC        ; Get start of name table
  1566.     XCHG            ; Into DE
  1567.     LXI    H,ORDER        ; Point to order table
  1568.  
  1569.      IF    Z80DOS
  1570.     LXI    B,15        ; Entry length including date
  1571.      ENDIF        ;Z80DOS
  1572.  
  1573.      IF    NOT Z80DOS
  1574.     LXI    B,13        ; Entry length
  1575.      ENDIF        ;NOT Z80DOS
  1576.  
  1577. BLDORD:    MOV    M,E        ; Save low order address
  1578.     INX    H
  1579.     MOV    M,D        ; Save high order address
  1580.     INX    H
  1581.     XCHG            ; Table address to HL
  1582.     DAD    B        ; Point to next entry
  1583.     XCHG
  1584.     XTHL            ; Save table address, load loop counter
  1585.     DCX    H        ; Count down loop
  1586.     MOV    A,L
  1587.     ORA    H        ; More?
  1588.     XTHL            ; Load table address, save loop counter
  1589.     JNZ    BLDORD        ; Yes, go do another one
  1590.     POP    H        ; Clean loop counter off stack
  1591.     LHLD    COUNT        ; Get count
  1592.     SHLD    SCOUNT        ; Save as # to sort
  1593.     DCX    H        ; Only 1 entry?
  1594.     MOV    A,L
  1595.     ORA    H
  1596.     JZ    DONE        ; Yes, so skip sort
  1597. ;
  1598. ; This sort routine is adapted from SOFTWARE TOOLS
  1599. ;
  1600.     LHLD    SCOUNT        ; Number of entries
  1601.  
  1602. L1:    ORA    A        ; Clear carry
  1603.     MOV    A,H        ; GAP=GAP/2
  1604.     RAR
  1605.     MOV    H,A
  1606.     MOV    A,L
  1607.     RAR
  1608.     MOV    L,A
  1609.     ORA    H        ; Is it zero?
  1610.     JZ    DONE        ; Then none left
  1611.     MOV    A,L        ; Make gap odd
  1612.     ORI    1
  1613.     MOV    L,A
  1614.     SHLD    GAP
  1615.     INX    H        ; I=GAP+1
  1616.  
  1617. L2:    SHLD    I
  1618.     XCHG
  1619.     LHLD    GAP
  1620.     MOV    A,E        ; J=I-GAP
  1621.     SUB    L
  1622.     MOV    L,A
  1623.     MOV    A,D
  1624.     SBB    H
  1625.     MOV    H,A
  1626.  
  1627. L3:    SHLD    J
  1628.     XCHG
  1629.     LHLD    GAP        ; JG=J+GAP
  1630.     DAD    D
  1631.     SHLD    JG
  1632.     CALL    COMPARE        ; Compare (J) and (JG)
  1633.     JP    L4        ; If A(J)<=A(JG)
  1634.     LHLD    J
  1635.     XCHG
  1636.     LHLD    JG
  1637.     CALL    SWAP        ; Exchange a(J) and a(JG)
  1638.     LHLD    J        ; J=J-GAP
  1639.     XCHG
  1640.     LHLD    GAP
  1641.     MOV    A,E
  1642.     SUB    L
  1643.     MOV    L,A
  1644.     MOV    A,D
  1645.     SBB    H
  1646.     MOV    H,A
  1647.     JM    L4        ; If J>0 go to l3
  1648.     ORA    L        ; Check for zero
  1649.     JZ    L4
  1650.     JMP    L3
  1651.  
  1652. L4:    LHLD    SCOUNT        ; For later
  1653.     XCHG
  1654.     LHLD    I        ; I=I+1
  1655.     INX    H
  1656.     MOV    A,E        ; If I<=n go to l2
  1657.     SUB    L
  1658.     MOV    A,D
  1659.     SBB    H
  1660.     JP    L2
  1661.     LHLD    GAP
  1662.     JMP    L1
  1663. ;
  1664. ; Sort is all done - print entries
  1665. ;
  1666. DONE:    LDA    FOPFLG        ; File output flag
  1667.     ORA    A        ; Set?
  1668.     JNZ    NOOUT        ; No, skip open
  1669. ;
  1670. ; If all user option enabled, and we're not on the first pass, then the
  1671. ; output file is already open and positioned, so we can skip the open.
  1672. ;
  1673.     LXI    H,OPNFLG    ; Output file open flag
  1674.     CMP    M        ; A=0,set Z if OPNFLG=0 also
  1675.     JNZ    NOOUT        ; If OPNFLG not zero, skip open
  1676.     DCR    M        ; Else, set OPNFLG for next user #
  1677. ;
  1678. ; First pass on file append - prepare DISK.DIR to receive new
  1679. ; or appended output.
  1680. ;
  1681.     LXI    D,OUTFCB    ; Does output file exist?
  1682.     MVI    C,SRCHF
  1683.     CALL    CPM
  1684.     INR    A
  1685.     JNZ    OPENIT        ; Yes, open for processing
  1686.     MVI    C,MAKE        ; Else, create output file
  1687.     CALL    CPM
  1688.     INR    A        ; Successful?
  1689.     JNZ    NOOUT        ; Yes, Continue
  1690. ;
  1691. ; If make or open fails, declare error
  1692. ;
  1693. OPNERR:    CALL    ERXIT
  1694.     DB    'Open',0
  1695. ;
  1696. WRTERR:    CALL    ERXIT
  1697.     DB    'Write',0
  1698. ;
  1699. ; Output file already exists - open it and position
  1700. ; it to the last record of the last extent.
  1701. ;
  1702. OPENIT:    MVI    C,OPEN        ; Open 1st extent of output file
  1703.     CALL    CPM
  1704.     INR    A
  1705.     JZ    OPNERR        ; Bad deal if 1st won't open
  1706.  
  1707. OPNMOR:    LDA    OUTFCB+15    ; Record count (RC)
  1708.     CPI    128
  1709.     JC    LSTEXT        ; If RC<128, this is last extent
  1710.     LXI    H,OUTFCB+12
  1711.     INR    M        ; Else, increment to next extent
  1712.     MVI    C,OPEN        ; Try to open it
  1713.     CALL    CPM
  1714.     INR    A
  1715.     JNZ    OPNMOR        ; Continue opening extents to end
  1716.     DCR    M        ; Then, reopen preceding extent
  1717.     MVI    C,OPEN
  1718.     CALL    CPM
  1719.     LDA    OUTFCB+15    ; Get RC for the last extent
  1720. ;
  1721. ; At this point, OUTFCB is opened to the last extent of the file, so
  1722. ; read in the last record in the last extent.
  1723. ;
  1724. LSTEXT:    ORA    A        ; Is this extent empty?
  1725.     JZ    NOOUT        ; Yes, starting a clean slate
  1726.     DCR    A        ; Normalize record count
  1727.     STA    OUTFCB+32    ; Set record number to read
  1728.     MVI    C,READ        ; Read last record of file
  1729.     CALL    CPM
  1730.     ORA    A        ; Successful read?
  1731.     JZ    RDOK        ; Yes, scan for EOF mark
  1732.  
  1733. APERR:    CALL    ERXIT
  1734.     DB    'Append',0
  1735. ;
  1736. ; We now have the last record in the file in the buffer. Scan the last
  1737. ; record for the EOF mark, indicate where we can start adding data.
  1738. ;
  1739. RDOK:    LXI    H,OUTBUF    ; Point to output buffer start
  1740.     MVI    B,128        ; Output buffer length
  1741.  
  1742. SCAN:    MOV    A,M        ; Character
  1743.     CPI    'Z'-40H        ; End of file?
  1744.     JZ    RESCR        ; Yes, save pointers and reset CR
  1745.     INX    H        ; Pointer+1
  1746.     DCR    B        ; Length-1
  1747.     JNZ    SCAN        ; Continue to end of buffer
  1748. ;
  1749. ; If an explicit EOF mark or an implied EOF (last record is full) in
  1750. ; the last buffer, move the FCB record and extent pointer back to cor-
  1751. ; rect for the read operation so the first write operation will replace
  1752. ; the last record of the DISK.DIR file.
  1753. ;
  1754. RESCR:    PUSH    H        ; Save EOF buffer pointer
  1755.     PUSH    B        ; Save EOF buffer remaining
  1756.     LXI    H,OUTFCB+32    ; Load current record again
  1757.     DCR    M        ; Record-1
  1758.     JP    SAMEXT        ; If CR>=0, still in same extent
  1759.     LXI    H,OUTFCB+12    ; Else, move to previous extent
  1760.     DCR    M
  1761.     MVI    C,OPEN        ; Then, reopen previous extent
  1762.     CALL    CPM
  1763.     INR    A
  1764.     JZ    APERR        ; Append error if can not reopen
  1765.     LDA    OUTFCB+15    ; Else,
  1766.     DCR    A        ; Position to last record of
  1767.     STA    OUTFCB+32    ; The extent
  1768.  
  1769. SAMEXT:    POP    PSW        ; Recall EOF location in buffer
  1770.     STA    BUFCNT        ; Set buffer counter
  1771.     POP    H        ; Recall next buffer pointer
  1772.     SHLD    BUFPNT        ; Set pointer for first addition
  1773.  
  1774. NOOUT:    LDA    FIRSTT        ; First time through?
  1775.     ORA    A
  1776.     JNZ    NOVOPT        ; No, we've been here before
  1777.     MVI    A,0FFH        ; Yes,
  1778.     STA    FIRSTT        ; Set first time flag
  1779.     LDA    VOPFLG        ; Version display flag
  1780.     ORA    A        ; Set?
  1781.     JNZ    NOVOPT        ; No, skip version print
  1782.     LXI    D,VERNAME    ; Yes, print version
  1783.     CALL    PUTS        ; Print the string
  1784.     CALL    CRLF
  1785.  
  1786. NOVOPT:    LHLD    COUNT
  1787.     SHLD    LCOUNT
  1788.     LXI    H,0
  1789.     SHLD    LBTOTL
  1790.     SHLD    LMTOTL
  1791.     LXI    H,ORDER        ; Initialize order table pointer
  1792.     SHLD    NEXTL
  1793.     SHLD    NEXTT
  1794.     LDA    VFLAG        ; Check display form
  1795.     ORA    A
  1796.     JNZ    NEWLIN        ; Jump if not vertical
  1797.     LHLD    COUNT        ; Code computes end of name table
  1798.     CALL    MULT13        ; (or start of second table
  1799.     XCHG            ; Where files to be stored after
  1800.     LHLD    TBLOC        ; Redundant extents removed)
  1801.     DAD    D
  1802.     SHLD    NEWPTR        ; Save it twice
  1803.     SHLD    XPOINT        ; For later
  1804. ;
  1805. ; Output the directory files we've matched
  1806. ;
  1807. ENTRY:    LHLD    COUNT        ; Files matched count
  1808.     DCX    H        ; Count-1
  1809.     SHLD    COUNT
  1810.     MOV    A,H        ; Is this the last file?
  1811.     ORA    L
  1812.     JZ    OKPRNT        ; Yes, last file so skip compare
  1813. ;
  1814. ; Compare each entry to make sure that it isn't part of a multiple
  1815. ; extent file.    Go only when we have the last extent of the file.
  1816. ;
  1817.     PUSH    B        ; Save number of columns
  1818.     LDA    VFLAG        ; Check display form
  1819.     ORA    A
  1820.     CNZ    CKABRT        ; If horiz, check for abort from keyboard
  1821.     LHLD    NEXTT
  1822.     MVI    A,11
  1823.     CALL    COMPR        ; Does this entry match next one?
  1824.     POP    B        ; Restore number of columns
  1825.     JNZ    OKPRNT        ; No, print it
  1826. NOKPRN:    INX    H
  1827.     INX    H        ; Skip, highest extent last in list
  1828.     SHLD    NEXTT
  1829.     JMP    ENTRY        ; Loop back for next lowest extent
  1830. ;
  1831. ; VLIST substitution. If VLIST option chosen, OKPRINT moves unique
  1832. ; filenames and sizes in "k" to a second table above the first for
  1833. ; use later.
  1834. ;
  1835. OKPRNT:
  1836. ;////
  1837.      IF    Z80DOS
  1838.     PUSH    H
  1839.     PUSH    D
  1840.     PUSH    B
  1841.     LHLD    NEXTT        ; Get order table pointer
  1842.     MOV    E,M        ; Get low order address
  1843.     INX    H
  1844.     MOV    D,M        ; Get high order address
  1845.     LXI    H,13
  1846.     DAD    D
  1847. ;    XCHG
  1848.     MOV    E,M
  1849.     INX    H
  1850.     MOV    D,M
  1851.     LHLD    DATCHK        ; Get the date we are looking for
  1852.     MOV    A,H
  1853.     ORA    L
  1854.     JZ    GDTMTC        ; Z=not looking
  1855.     MOV    A,H
  1856.     CMP    D        ; Check if given date >,=,< the files date
  1857.     JZ    CHDLOW        ; High EQ, check low
  1858.     JC    DATLT        ; C=LT
  1859.     JMP    DATGE        ; Given date GT file date
  1860. CHDLOW:    MOV    A,L        ; Check low byte of date vs. file date
  1861.     CMP    E
  1862. DATGE:    MVI    A,0        ; Assume EQ
  1863.     JC    DATLT        ; C= given LT files date
  1864.     JZ    DATFLG        ; Z= they are EQ
  1865.     MVI    A,2        ; Given GT files date
  1866.     JMP    DATFLG
  1867. DATLT:    MVI    A,1        ; Given was less than files
  1868. DATFLG:    STA    DTMTCH
  1869.     LDA    DEOPFL        ; What kind of date match?
  1870.     ORA    A
  1871.     JZ    DTEXAC        ; Z=exact
  1872.     LDA    DPOPFL
  1873.     ORA    A
  1874.     JZ    DTABVE        ; Z=GE
  1875.     LDA    DMOPFL        ; LT wanted?
  1876.     ORA    A
  1877.     JNZ    DTEXAC        ; NZ=no, didn't tell us so do anything but gave
  1878.                 ; us a date so assume want exact match
  1879.     LDA    DTMTCH
  1880.     CPI    2
  1881.     JZ    GDTMTC        ; Date was below and they wanted below
  1882. NDTMTC:
  1883.     POP    B
  1884.     POP    D
  1885.     POP    H
  1886.     PUSH    H
  1887.     LHLD    COUNT
  1888.     MOV    A,L
  1889.     ORA    H
  1890.     POP    H
  1891.     JZ    PRTOTL
  1892.     JMP    NOKPRN
  1893.  
  1894. DTEXAC:    LDA    DTMTCH        ; They wanted exact, was it?
  1895.     ORA    A
  1896.     JZ    GDTMTC        ; Z=yes
  1897.     JMP    NDTMTC
  1898. DTABVE:    LDA    DTMTCH        ; They wanted GE
  1899.     CPI    1
  1900.     JZ    GDTMTC        ; Z=G
  1901.     ORA    A
  1902.     JNZ    NDTMTC        ; Must be 2, so not equal
  1903. GDTMTC:    POP    B
  1904.     POP    D
  1905.     POP    H
  1906.      ENDIF        ; Z80DOS
  1907.     
  1908.     LHLD    NEXTT        ; Get order table pointer
  1909.     MOV    E,M        ; Get low order address
  1910.     INX    H
  1911.     MOV    D,M        ; Get high order address
  1912.     INX    H
  1913.     SHLD    NEXTT        ; Save updated table pointer
  1914.     XCHG            ; Table entry to HL
  1915.     LDA    VFLAG        ; Check display form
  1916.     ORA    A
  1917.     JNZ    OKPR1        ; Jump if not vertical
  1918.     PUSH    H        ; Save address of byte to be moved
  1919.     LHLD    NEWPTR        ; Address in new table to put byte
  1920.     PUSH    H        ; Save address
  1921.  
  1922.      IF    Z80DOS
  1923.     LXI    D,15        ; Update address including date
  1924.      ENDIF        ;Z80DOS
  1925.  
  1926.      IF    NOT Z80DOS
  1927.     LXI    D,13        ; Update address
  1928.      ENDIF        ;NOT Z80DOS
  1929.  
  1930.     DAD    D
  1931.     SHLD    NEWPTR        ; Save for later (end of table)
  1932.     POP    H        ; Set current move  to    address
  1933.     XCHG            ; Swap pointers
  1934.     POP    H        ; Set current move from address
  1935.     MVI    B,11        ; Filename.typ length
  1936.     CALL    MOVE        ; Move it
  1937.  
  1938.      IF    Z80DOS
  1939.     PUSH    H
  1940.      ENDIF        ;Z80DOS
  1941.  
  1942.     PUSH    D
  1943.     JMP    OKPR2
  1944.  
  1945. OKPR1:    MVI    B,8        ; Filename length
  1946.     CALL    PUTSB        ; Output
  1947.     MVI    A,'.'        ; Period after filename
  1948.     CALL    PUTCHR        ; Output
  1949.     MVI    B,3        ; Filetype length
  1950.     CALL    PUTSB        ; Output
  1951.  
  1952.      IF    Z80DOS
  1953.     LDA    NODFLG
  1954.     ORA    A
  1955.     JZ    NOD1
  1956.     CALL    DISDAT
  1957. NOD1:
  1958.      ENDIF        ;Z80DOS
  1959.  
  1960. OKPR2:    
  1961.     CALL    SIZEFL
  1962.     LHLD    TOTSIZ        ; DE = rounded size in K
  1963.     DAD    D        ; Add to total used
  1964.     SHLD    TOTSIZ
  1965.     LHLD    TOTFIL        ; Increment filecount
  1966.     INX    H
  1967.     SHLD    TOTFIL
  1968.     XCHG
  1969.     LDA    COPFLG        ; Size wanted in records?
  1970.     ORA    A
  1971.     JNZ    OKPR3        ; Jump if not
  1972.     LHLD    FILERC        ; Else get record count
  1973.  
  1974. OKPR3:    LDA    VFLAG        ; Check display form
  1975.     ORA    A
  1976.     JNZ    OKPR4        ; Jump if not vertical
  1977.     POP    D        ; A(size to go)
  1978.     MOV    A,H        ; Move size to table two
  1979.     STAX    D
  1980.     INX    D
  1981.     MOV    A,L
  1982.     STAX    D
  1983.  
  1984.      IF    Z80DOS
  1985.     POP    H        ; Currently pointing to file size
  1986.     INX    H        ; Skip size
  1987.     INX    H
  1988.     INX    D
  1989.     MOV    A,M        ; Get LSB of date
  1990.     STAX    D        ; Save it away
  1991.     INX    D
  1992.     INX    H
  1993.     MOV    A,M        ; Ditto for MSB of date
  1994.     STAX    D
  1995.      ENDIF        ;Z80DOS
  1996. ;
  1997. ; One File Moved - Test to see if we have to move another
  1998. ;
  1999.     LHLD    COUNT        ; Current file counter
  2000.     MOV    A,H
  2001.     ORA    L
  2002.     JZ    PRTOTL        ; Zero, output summary
  2003.     JMP    ENTRY
  2004. ;
  2005. ; Output the size of the individual file
  2006. ;
  2007. OKPR4:    CALL    DECPRT        ; Print it
  2008.     LDA    FSIZEC        ; Follow with 'k' or 'r'
  2009.     CALL    PUTCHR
  2010. ;
  2011. ; One file output - test to see if we have to output another one.
  2012. ;
  2013.     LHLD    COUNT        ; Current file counter
  2014.     MOV    A,H
  2015.     ORA    L        ; Zero?
  2016.     JZ    PRTOTL        ; Yes, exit to summary output
  2017. ;
  2018. ; At least one more file to output,
  2019. ; can we put it on the current line?
  2020. ;
  2021.     DCR    C
  2022.     PUSH    PSW
  2023.     CNZ    FENCE        ; If room left output fence character
  2024.     POP    PSW
  2025.     JNZ    ENTRY        ; Output another file
  2026. ;
  2027. ; Current line full, start a new one
  2028. ;
  2029. NEWLIN:
  2030.      IF    Z80DOS
  2031.     MVI    C,2        ; 2 names per line
  2032.     LDA    NODFLG
  2033.     ORA    A
  2034.     JNZ    NOD2
  2035.     MVI    C,4
  2036. NOD2:
  2037.      ENDIF        ;Z80DOS
  2038.  
  2039.      IF    NOT Z80DOS
  2040.     MVI    C,4        ; Reset names per line counter
  2041.      ENDIF        ;NOT Z80DOS
  2042.  
  2043.     CALL    CRLF        ; Space down to next line
  2044.     JMP    ENTRY        ; Output another file
  2045. ;.....
  2046. ;
  2047. ; Compute the size of the file/library and update our summary datum.
  2048. ; This has been changed into a subroutine so that both the file size
  2049. ; computation and a library size (when printing out library members)
  2050. ; can be computed in K.
  2051. ;
  2052. SIZEFL:    MOV    D,M
  2053.     INX    H
  2054.     MOV    E,M        ; Size in DE (records)
  2055.     XCHG
  2056.     SHLD    FILERC        ; Save record count
  2057.     XCHG
  2058.     LDA    BLKMSK
  2059.     PUSH    PSW
  2060.     ADD    E
  2061.     MOV    E,A
  2062.     MOV    A,D
  2063.     ACI    0
  2064.     MOV    D,A
  2065.     POP    PSW
  2066.     CMA
  2067.     ANA    E
  2068.     MOV    E,A
  2069.     MVI    B,3
  2070.  
  2071. SHRR:    MOV    A,D
  2072.     ORA    A
  2073.     RAR
  2074.     MOV    D,A
  2075.     MOV    A,E
  2076.     RAR
  2077.     MOV    E,A
  2078.     DCR    B
  2079.     JNZ    SHRR
  2080.     RET
  2081. ;
  2082. ; Print HL in decimal with leading zero suppression
  2083. ;
  2084. DECPRT:    XRA    A        ; Clear leading zero flag
  2085.     STA    LZFLG
  2086.     LXI    D,-10000
  2087.     LDA    SUPSPC
  2088.     PUSH    PSW
  2089.     XRA    A
  2090.     STA    SUPSPC
  2091.     CALL    DIGIT
  2092.     POP    PSW
  2093.     STA    SUPSPC
  2094.     LXI    D,-1000        ; Print 1000's digit
  2095.     CALL    DIGIT
  2096.     LXI    D,-100        ; Etc.
  2097.     CALL    DIGIT
  2098.     LXI    D,-10
  2099.     CALL    DIGIT
  2100.     MVI    A,'0'        ; Get 1's digit
  2101.     ADD    L
  2102.     JMP    PUTCHR
  2103.  
  2104. DIGIT:    MVI    B,'0'        ; Start off with ASCII 0
  2105.  
  2106. DIGLP:    PUSH    H        ; Save current remainder
  2107.     DAD    D        ; Subtract
  2108.     JNC    DIGEX        ; Quit on overflow
  2109.     POP    PSW        ; Throw away remainder
  2110.     INR    B        ; Bump digit
  2111.     JMP    DIGLP        ; Loop back
  2112.  
  2113. DIGEX:    POP    H        ; Restore pointer
  2114.     MOV    A,B
  2115.     CPI    '0'        ; Zero digit?
  2116.     JNZ    DIGNZ        ; No, type it
  2117.     LDA    LZFLG        ; Leading zero?
  2118.     ORA    A
  2119.     MVI    A,'0'
  2120.     JNZ    PUTCHR        ; Print digit
  2121.     LDA    SUPSPC        ; Get space suppression flag
  2122.     ORA    A        ; See if printing file totals
  2123.     RZ            ; Yes, don't give leading spaces
  2124.     JMP    SPACE        ; Leading zero..print space
  2125. ;
  2126. DIGNZ:    STA    LZFLG        ; Leading zero flag set
  2127.     JMP    PUTCHR        ; Print leading zero & digit
  2128. ;.....
  2129. ;
  2130. ;-----------------------------------------------------------------------
  2131. ;          VLIST subroutines begin here
  2132. ;
  2133. ;Multiply contents of HL register by 13
  2134. ;
  2135. MULT13:    MOV    D,H
  2136.     MOV    E,L
  2137.     DAD    H
  2138.     DAD    D
  2139.     DAD    H
  2140.     DAD    H
  2141.     DAD    D
  2142.  
  2143.      IF    Z80DOS
  2144.     DAD    D        ; Actually by 15
  2145.     DAD    D        ;
  2146.      ENDIF    ;Z80DOS
  2147.  
  2148.     RET
  2149. ;.....
  2150. ;
  2151. ; Main VLIST subroutine to output a filename and column delimiter
  2152. ;
  2153. VENTRY:    STA    VSFRST
  2154.     CALL    PFILE1        ; Routine to print a filename
  2155.     RZ            ; If at end of line return with zero set
  2156.     CC    FENCE        ; Print column delimiter if more
  2157.     LHLD    JUMPER        ; Put the jumper back in DE
  2158.     XCHG
  2159.     ORI    1        ; Insure non zero return
  2160.     RET
  2161. ;.....
  2162. ;
  2163. PFILE1:
  2164.     PUSH    H
  2165.     PUSH    D
  2166.     XCHG
  2167.     LHLD    NEWPTR
  2168.     MOV    A,H
  2169.     CMP    D
  2170.     JNC    PFILE2
  2171.     MOV    A,L
  2172.     CMP    E
  2173.     POP    D
  2174.     POP    H
  2175.     RZ
  2176.     JNC    PFILE3
  2177.     XRA    A
  2178.     RET
  2179. PFILE2:    POP    D
  2180.     POP    H
  2181. PFILE3:
  2182.     MOV    A,M        ; Let's see what we have
  2183.     CPI    0FEH
  2184.     RNC
  2185.     ANI    7FH        ; Strip parity bit
  2186.     PUSH    B        ; Save number of columns
  2187.     MVI    B,8        ; Print filename and type
  2188.     CALL    PUTSB
  2189.     MVI    A,'.'
  2190.     CALL    PUTCHR
  2191.     MVI    B,3
  2192.     CALL    PUTSB
  2193.     
  2194.      IF    Z80DOS
  2195.     LDA    NODFLG
  2196.     ORA    A
  2197.     JZ    NOD3
  2198.     CALL    DISDAT        ; Display the date
  2199. NOD3:
  2200.      ENDIF        ;Z80DOS
  2201.  
  2202.     MOV    D,M        ; Get it into DE
  2203.     INX    H
  2204.     MOV    E,M
  2205.     XCHG            ; HL <-> DE
  2206.     CALL    DECPRT        ; Print it out
  2207.     LDA    FSIZEC        ; Follow with 'k' or 'r'
  2208.     CALL    PUTCHR
  2209.     POP    B        ; Load number of columns
  2210.     LHLD    TOTFIL        ; Load number of files left
  2211.     DCX    H        ; # files-1
  2212.     SHLD    TOTFIL        ; Resave it
  2213.     MOV    A,H
  2214.     ORA    L        ; Zero yet?
  2215.     RZ            ; Yes, no more files
  2216.     DCR    C        ; No, decrement it
  2217.     STC            ; Force carry on
  2218.     RET            ; This return
  2219. ;.....
  2220. ;
  2221. ;              End of VLIST routines
  2222. ;-----------------------------------------------------------------------
  2223. ;
  2224. ; Show total space and files used
  2225. ;
  2226. PRTOTL:    
  2227.     XRA    A
  2228.     STA    VSFRST
  2229.     LDA    VFLAG        ; Check display form
  2230.     ORA    A
  2231.     JZ    PRTOT1        ; Jump if vertical
  2232.     LDA    LOPFLG
  2233.     ORA    A
  2234.     JNZ    PRTOT1
  2235.     LHLD    TOTFIL        ; How many files matched?
  2236.     MOV    A,H
  2237.     ORA    L
  2238.     CNZ    PRTLMEM        ; Skip .LBR check if none found
  2239.  
  2240. PRTOT1:    XRA    A        ; Get a zero to
  2241.     STA    SUPSPC        ; Suppress leading spaces in totals
  2242.     LHLD    TOTFIL        ; How many files matched?
  2243.     MOV    A,H
  2244.     ORA    L
  2245.     JZ    NXTUSR        ; Skip summary if none found
  2246.     PUSH    H        ; Save TOTFIL
  2247.     STA    FNDFLG        ; Set file found flag
  2248.     LDA    VFLAG        ; Check display form
  2249.     ORA    A
  2250.     JNZ    PRTOT3        ; Horizontal = 0FFh, exit if not zero
  2251.     LDA    SOHFLG
  2252.     ORA    A
  2253.     JZ    PRTOT2
  2254.     XRA    A
  2255.     STA    SOHFLG
  2256.     JMP    PRTOT3
  2257.  
  2258. PRTOT2:    CALL    CRLF
  2259.  
  2260. PRTOT3:    LXI    D,TOTMS1    ; Print "13,10,' Drive'"
  2261.     CALL    PUTS
  2262.     LDA    FCB
  2263.     ADI    'A'-1
  2264.     CALL    PUTCHR        ; Output the drive code
  2265.     CALL    CKVER
  2266.     JC    NOUSER
  2267.     CALL    PUTUSR        ; Output user number
  2268.  
  2269.      IF    NDIRS
  2270.     MVI    A,' '
  2271.     CALL    PUTCHR
  2272.     CALL    NAMDIR
  2273.      ENDIF            ; NDIRS
  2274.  
  2275.     LDA    USRNR
  2276.     CPI    10
  2277.     LXI    D,NOFMS2
  2278.     JC    $+6
  2279.     LXI    D,NOFMS2+1    ; Print some spaces
  2280.     CALL    PUTS
  2281.     LDA    BYEACT        ; BYE active?
  2282.     ORA    A
  2283.     JZ    NOUSER        ; Yes, skip ulcode
  2284.  
  2285.      IF    ULINE
  2286.     LXI    D,ULON        ; Turn on underline
  2287.     CALL    COUTS        ; If not null
  2288.      ENDIF            ; ULINE
  2289.  
  2290. NOUSER:    LXI    D,TOTMS6    ; Print " Files: "
  2291.     CALL    PUTS
  2292.     POP    H        ; Recall TOTFIL
  2293.     XCHG
  2294.     LHLD    TOTFL1        ; Get total number of files so far        
  2295.     DAD    D        ; Add in number this DU
  2296.     SHLD    TOTFL1        ; And save it away
  2297.     XCHG
  2298.     CALL    DECPRT        ; Print # of files matched
  2299.     LXI    D,TOTMS4    ; No CRLF needed, display > 40
  2300.     CALL    PUTS
  2301.     LHLD    TOTSIZ        ; Total k used by matched files
  2302.     XCHG
  2303.     LHLD    TOTSZ1        ; Get running total of all files
  2304.     DAD    D
  2305.     SHLD    TOTSZ1        ; And put it back
  2306.     XCHG
  2307.     CALL    DECPRT        ; Print file size
  2308.     LXI    D,TOTMS5    ; Print "k"
  2309.     CALL    PUTS
  2310.     CALL    PRTFRE        ; Print free space remaining
  2311.  
  2312.      IF    ULINE
  2313.     LDA    BYEACT        ; Bye active?
  2314.     ORA    A        ;
  2315.     JZ    NPRNT        ; Yes, skip ULINE off
  2316.     LXI    D,ULOFF        ; Turn off underline
  2317.     CALL    COUTS        ; If not null
  2318.      ENDIF            ; ULINE
  2319. ;
  2320. ; Summary line printed, now print detail files, first compute total
  2321. ; printout lines.
  2322. ;
  2323. NPRNT:    LDA    VFLAG        ; Check display form
  2324.     ORA    A
  2325.     JNZ    NXTUSR        ; Jump if horizontal
  2326.  
  2327.      IF    Z80DOS
  2328.     LXI    B,1
  2329.     LDA    NODFLG
  2330.     ORA    A
  2331.     JNZ    NOD4
  2332.     LXI    B,3
  2333. NOD4:
  2334.      ENDIF        ;Z80DOS
  2335.  
  2336.      IF    NOT Z80DOS
  2337.     LXI    B,3
  2338.      ENDIF        ;NOT Z80DOS
  2339.  
  2340.     MOV    A,C        ; Get number of names per line
  2341.     CMA            ; Negative of number of columns
  2342.     MOV    E,A        ; Into DE
  2343.     MVI    D,0FFH
  2344.     LHLD    TOTFIL        ; Load total number of files
  2345.     DAD    B        ; Round up to a full line
  2346.     MVI    C,0FFH
  2347.  
  2348. NPRNT1:    INR    C        ; C-reg will hold number of
  2349.     DAD    D        ; Lines to be displayed
  2350.     JC    NPRNT1
  2351.     MOV    A,C
  2352.     STA    LINES        ; Done, save it for later
  2353.     STA    SUPSPC        ; Allow spaces preceding file sizes
  2354. ;
  2355. ; Number lines times entry size = the number of bytes to skip in the
  2356. ; second table when outputting files in vertical order.
  2357. ;
  2358.      IF    VSPAGE
  2359.     LDA    FOPFLG        ; Check File output
  2360.     ORA    A
  2361.     JZ    NVSORT
  2362.     LDA    POPFLG
  2363.     ORA    A
  2364.     JZ    NVSORT
  2365.     LDA    NOPFLG
  2366.     ORA    A
  2367.     JNZ    VSORT
  2368. NVSORT:    MOV    A,C
  2369.     JMP    OVSORT
  2370. VSORT:
  2371.     LDA    LINCNT        ; Get number of lines currently displayed
  2372.     MOV    B,A
  2373.     MVI    A,22        ; Calc number left
  2374.     SUB    B
  2375.     MOV    B,A
  2376.     MOV    A,C        ; Get how many lines this DU
  2377.     CMP    B
  2378.     JC    OVSORT        ; If C, then this DU will fit on the page whole
  2379.     MOV    A,B        ; This DU won't fit, so calc to fill up page
  2380.     ORA    A
  2381.     JNZ    OVSORT
  2382.     MOV    A,C
  2383.     CPI    23
  2384.     JC    OVSORT
  2385.     MVI    A,23
  2386. OVSORT:
  2387.      ENDIF        ; VSPAGE
  2388.  
  2389.     MOV    L,A        ; Put number of lines into HL
  2390.     MVI    H,0
  2391.     CALL    MULT13
  2392.     SHLD    JUMPER        ; Put it away
  2393.     XRA    A
  2394.     STA    WASHERE        ; Set flag for FENCE that says next calc
  2395.                 ; is for the next page of display
  2396. ;
  2397. ; Fill a record with FF at the end of table 2
  2398. ;
  2399.     LHLD    NEWPTR        ; Now points to end of table 2
  2400.     MVI    B,128
  2401.     MVI    A,0FFH
  2402.  
  2403. NPRNT2:    MOV    M,A
  2404.     INX    H
  2405.     DCR    B
  2406.     JNZ    NPRNT2
  2407. ;
  2408. ; Increment the number of files for use later in VENTRY.  This insures
  2409. ; that a column delimiter will be printed after the last filename, if
  2410. ; the file appears in other than the last column of the display.
  2411. ;
  2412.      IF    NOT Z80DOS
  2413.     LXI    H,TOTFIL
  2414.     INR    M
  2415.      ENDIF        ;NOT Z80DOS
  2416. ;
  2417. ; Print out a line of files
  2418. ;
  2419. NPRNT3:    
  2420.      IF    Z80DOS
  2421.     MVI    C,2
  2422.     LDA    NODFLG
  2423.     ORA    A
  2424.     JNZ    NOD5
  2425.     MVI    C,4
  2426. NOD5:
  2427.      ENDIF        ;Z80DOS
  2428.  
  2429.      IF    NOT Z80DOS
  2430.     MVI    C,4        ; Reset number of columns
  2431.      ENDIF        ;NOT Z80DOS
  2432.  
  2433.     CALL    CRLF        ; Start a new line
  2434.     MVI    A,1
  2435.     STA    VSFRST
  2436.  
  2437. ;
  2438. ; Print first filename
  2439. ;
  2440.     LHLD    XPOINT        ; XPOINT = to start of second table
  2441.     CALL    VENTRY        ; At entry. Below, it is incremented
  2442.                 ; For additional lines of printout
  2443.     JZ    NLINE        ; Either out of columns or out of files
  2444. ;
  2445. ; Print second filename
  2446. ;
  2447.     LHLD    XPOINT
  2448.     DAD    D
  2449.     CALL    VENTRY
  2450.     JZ    NLINE
  2451. ;
  2452. ; Print third filename
  2453. ;
  2454.     LHLD    XPOINT
  2455.     DAD    D
  2456.     DAD    D
  2457.     CALL    VENTRY
  2458.     JZ    NLINE
  2459. ;
  2460. ; Print fourth filename
  2461. ;
  2462.     LHLD    XPOINT
  2463.     DAD    D
  2464.     DAD    D
  2465.     DAD    D
  2466.     CALL    VENTRY
  2467.  
  2468. NLINE:    LHLD    XPOINT        ; Increment XPOINT to next file
  2469.  
  2470.      IF    Z80DOS
  2471.     LXI    D,15
  2472.      ENDIF        ;Z80DOS
  2473.  
  2474.      IF    NOT Z80DOS
  2475.     LXI    D,13
  2476.      ENDIF        ;NOT Z80DOS
  2477.  
  2478.     DAD    D
  2479.     SHLD    XPOINT
  2480.     LHLD    TOTFIL        ; Out of files?
  2481.     MOV    A,H
  2482.     ORA    L
  2483.     JZ    DOLIB        ; Yes, Check for libraries
  2484.     LXI    H,LINES        ; No, just need a new line
  2485.     DCR    M
  2486.     JNZ    NPRNT3
  2487.  
  2488. DOLIB:    LDA    LOPFLG
  2489.     ORA    A
  2490.     JNZ    NXTUSR
  2491.     LHLD    TOTFIL        ; How many files matched?
  2492.     MOV    A,H
  2493.     ORA    L
  2494.  
  2495.      IF    NOT Z80DOS
  2496.     CNZ    PRTLMEM        ; Skip library check if none found
  2497.      ENDIF
  2498.      IF    Z80DOS
  2499.     CALL    PRTLMEM
  2500.      ENDIF
  2501.  
  2502. ;
  2503. ; Directory for one user area completed.  If all users option is select-
  2504. ; ed, then go do another directory on the next user number until we ex-
  2505. ; ceed the maximum user # for the selected drive.
  2506. ;
  2507. NXTUSR:    LDA    AOPFLG        ; All user flag
  2508.     ORA    A        ; Set?
  2509.     JZ    NXTUSU        ; Set if zero, show all user areas
  2510.     LDA    HOPFLG        ; "H" flag to show remaining areas
  2511.     ORA    A
  2512.     JNZ    GOCLZ        ; Non-zero, not set, exit
  2513.  
  2514. NXTUSU:    CALL    CKVER        ; Running CP/M 2?
  2515.     JC    GOCLZ        ; No, Skip user increment
  2516.     CALL    CKABRT        ; Yes, Check for user abort
  2517.     LDA    MAXUSR        ; No abort - get maximum user #
  2518.     LXI    H,NEWUSR    ; Increment directory user number
  2519.     INR    M
  2520.     CMP    M        ; Next user # exceed maximum?
  2521.     JNC    SETTBL        ; No, more user areas to go
  2522.     LDA    BASUSR        ; Reset base user number for
  2523.     MOV    M,A        ; The next directory search
  2524. ;
  2525. ; We've finished all of our outputting. Flush the remainder of the out-
  2526. ; put buffer and close the file before going to exit routine.
  2527. ;
  2528. GOCLZ:    LXI    H,OPNFLG    ; Get file open status, reset flag
  2529.     MOV    A,M        ; To force reopen on next pass
  2530.     MVI    M,0
  2531.     ORA    A        ; File open?
  2532.     JZ    NXTDSK        ; No, Skip closing DISK.DIR
  2533.     LXI    H,BUFCNT
  2534.     MOV    A,M        ; Load # of unflushed characters in
  2535.     MVI    M,128        ; Buffer, force BUFCNT to empty status
  2536.     ORA    A        ; If BUFCNT=128, buffer empty set sign
  2537.     JM    DDCLOS        ; Close DISK.DIR if buffer is empty
  2538.     JZ    FLUSH        ; Write last record to DISK.DIR if full
  2539.     LHLD    BUFPNT        ; Else pad unused buffer with CTL-Z
  2540.  
  2541. PUTAGN:    MVI    M,'Z'-40H    ; EOF marker
  2542.     INX    H        ; Next buffer location
  2543.     DCR    A        ; Count-1
  2544.     JNZ    PUTAGN        ; Continue buffer padding fill
  2545.  
  2546. FLUSH:    LXI    D,OUTFCB    ; Flush the last output buffer
  2547.     MVI    C,WRITE
  2548.     CALL    CPM
  2549.     ORA    A
  2550.     JNZ    WRTERR
  2551.  
  2552. DDCLOS:    LXI    D,OUTFCB    ; Close DISK.DIR output file
  2553.     MVI    C,CLOSE
  2554.     CALL    CPM
  2555. ;
  2556. ; Directory for all user areas finished.  If the multi-disk option is
  2557. ; enabled and selected, reset to the base user area and repeat the
  2558. ; directory for next drive on-line until we either exceed the drives in
  2559. ; our LODRV-HIDRV table, or the BDOS shuts us down with a select or bad
  2560. ; record error, which will be intercepted back to the EXIT module.
  2561. ;
  2562. NXTDSK:    LXI    H,FNDFLG    ; Load file found flag
  2563.     MOV    A,M
  2564.     MVI    M,0        ; Clear found flag for next drive
  2565.     ORA    A
  2566.     JNZ    NDSK        ; Continue if at least 1 file found
  2567.     LXI    H,FOPFLG
  2568.     DCR    M
  2569.     PUSH    H
  2570.     LXI    D,NOFMS1    ; Print 1st part of no files message
  2571.     CALL    PUTS        ; Print it
  2572.     LXI    D,NOFLM
  2573.     CALL    PUTS        ; Print message
  2574.     LDA    FCB
  2575.     ADI    'A'-1
  2576.     CALL    PUTCHR        ; Output the drive
  2577.     CALL    CKVER
  2578.     JC    NOUSR1
  2579.     CALL    PUTUSR        ; Output the user number
  2580.  
  2581. NOUSR1:    LXI    D,NOFMS3    ; Print divider
  2582.     CALL    PUTS
  2583.     CALL    PRTFRE        ; Tag with free message
  2584.     LDA    VFLAG        ; Check display form
  2585.     ORA    A
  2586.     CNZ    CRLF        ; Need another CRLF in horizontal mode
  2587.     POP    H
  2588.     INR    M
  2589.  
  2590. NDSK:    LDA    DOPFLG        ; Multi-disk selected?
  2591.     ORA    A
  2592.     JNZ    NPRT        ; No, skip next check
  2593.     CALL    CKABRT        ; Check for user abort
  2594.     MVI    A,HIDRV-LODRV    ; Load max drive code to search
  2595.     LXI    H,FCB        ; Increment directory FCB drive code
  2596.     INR    M
  2597.     CMP    M        ; Does next disk exceed maximum?
  2598.     JC    NPRT
  2599.  
  2600.      IF    MAXDRV
  2601.  
  2602.      IF    ZCPR33
  2603.     PUSH    H
  2604.     LHLD    Z3DRVL        ; Point to ENV
  2605.     MOV    A,M        ; Get it
  2606.     POP    H
  2607.      ENDIF        ;ZCPR33
  2608.  
  2609.      IF    NOT ZCPR33
  2610.     LDA    MXDRV        ; Look at another value limit
  2611.     INR    A
  2612.      ENDIF        ;NOT ZCPR33
  2613.  
  2614.     CMP    M        ; Is it lower?
  2615.     JC    NPRT        ; Bail out if too low
  2616.     JMP    NOOPT        ; Search next disk
  2617.      ENDIF            ; MAXDRV
  2618.  
  2619.     JNC    NOOPT        ; Search next disk if maxdr not true
  2620. ;
  2621. ; If no printer, fall through to EXIT
  2622. ;
  2623. NPRT:    LDA    POPFLG
  2624.     ORA    A        ; Printer active?
  2625.     JNZ    EXIT        ; No, just exit
  2626.     MVI    C,LIST
  2627.     MVI    E,13        ; Print a CRLF
  2628.     CALL    CPM
  2629.     MVI    E,10        ; Line feed
  2630.     CALL    CPM
  2631.     JMP    EXIT        ; All done - exit to CCP
  2632. ;.....
  2633. ;
  2634. ; Output the user number of the directory in decimal
  2635. ;
  2636. PUTUSR:    LDA    NEWUSR
  2637.     CPI    10        ; User no. < 10?
  2638.     JC    DUX        ; Yes, skip 10's digit
  2639.     STA    USRNR
  2640.     PUSH    B        ; No, process 10's digit
  2641.     MVI    C,'0'-1
  2642.  
  2643. DUY:    INR    C        ; Get tens digit
  2644.     SUI    10
  2645.     JNC    DUY        ; Loop until we've gone too far
  2646.     ADI    10
  2647.     MOV    B,A        ; Save units digit
  2648.     MOV    A,C        ; Print tens digit
  2649.     CALL    PUTCHR
  2650.     MOV    A,B        ; Recall units digit
  2651.     POP    B
  2652.  
  2653. DUX:    ADI    '0'        ; Make it ASCII
  2654.     JMP    PUTCHR
  2655.  
  2656. ;.....
  2657. ;
  2658. ; Force new line on output and check for page pause
  2659. ;
  2660. CRLF:    MVI    A,13        ; Send CR
  2661.     CALL    PUTCHR
  2662.     MVI    A,10        ; Send LF
  2663.     JMP    PUTCHR
  2664. ;.....
  2665. ;
  2666. ; Separate the directory output on a line with a space,
  2667. ; the delimiter, followed by another space.
  2668. ;
  2669. FENCE:    CALL    SPACE
  2670.  
  2671.      IF    Z80DOS
  2672.     LDA    NODFLG
  2673.     ORA    A
  2674.     JZ    FENCE1
  2675.     CALL    SPACE
  2676.     CALL    SPACE
  2677. FENCE1:
  2678.      ENDIF        ;Z80DOS
  2679.  
  2680.     MVI    A,':'        ; Fence character
  2681.     CALL    PUTCHR        ; Print it, then a space character
  2682.  
  2683.      IF    Z80DOS
  2684.     LDA    NODFLG
  2685.     ORA    A
  2686.     JZ    NOD6
  2687.     CALL    SPACE
  2688.     CALL    SPACE
  2689. NOD6:
  2690.      ENDIF        ;Z80DOS
  2691.  
  2692. SPACE:    MVI    A,' '
  2693. ;
  2694. ; Output character in A to console, and optionally to printer
  2695. ; and/or the output file.  Detects user abort request.
  2696. ;
  2697. PUTCHR:    PUSH    B
  2698.     PUSH    D
  2699.     PUSH    H
  2700.     PUSH    PSW        ; Save the character to output
  2701.     CALL    HITYPE        ; Send it to console
  2702.     POP    PSW        ; Restore the output character
  2703.     ANI    7FH        ; Strip parity bit on character
  2704. ;
  2705. ; Test file output mode and skip to page pause test if not active
  2706. ;
  2707.     MOV    B,A        ; Save stripped character to B
  2708.     CPI    10        ; At end of line?
  2709.     CZ    CKABRT        ; Check for user abort request
  2710.     LDA    FOPFLG        ; Is file output active?
  2711.     ORA    A
  2712.     JNZ    NOWRIT        ; Go check for page pause if not
  2713. ;
  2714. ; File output mode active - make sure we have room in buffer to add
  2715. ; the next character. If buffer full, write out current record first
  2716. ; and then start a new record with current character.
  2717. ;
  2718.     LHLD    BUFPNT        ; Load current buffer pointer
  2719.     LDA    BUFCNT        ; Load buffer capacity remaining
  2720.     ORA    A        ; Buffer full?
  2721.     JNZ    PUTBUF        ; No, Continue
  2722.     CALL    SETFOP        ; Yes, Set the DMA address
  2723.     LXI    D,OUTFCB    ; Else, write current buffer out
  2724.     MVI    C,WRITE
  2725.     CALL    CPM        ; (call must save character in B)
  2726.     ORA    A        ; Error?
  2727.     JNZ    WRTERR        ; Yes, exit if disk full or R/O
  2728.     LXI    H,OUTBUF    ; Reset buffer pointer
  2729.     MVI    A,128        ; Reset buffer capacity
  2730.  
  2731. PUTBUF:    MOV    M,B        ; Move char to next buffer position
  2732.     INX    H        ; Bump buffer pointer
  2733.     SHLD    BUFPNT        ; And save it
  2734.     DCR    A        ; Buffer char count-1
  2735.     STA    BUFCNT        ; And save it
  2736.  
  2737. NOWRIT:    MOV    A,B        ; Recall stripped character
  2738.     ANI    7FH        ; Strip parity bit on character
  2739.     MOV    E,A        ; Setup list output call
  2740.     MVI    C,LIST
  2741.     LDA    POPFLG        ; Load printer flag
  2742.     ORA    A        ; Set?
  2743.     CZ    CPM        ; Yes, print character
  2744.     MOV    A,E        ; Recall character
  2745.     CPI    10        ; Do we have a line feed?
  2746.     JNZ    PUTRET        ; Exit if not
  2747.     LDA    NOPFLG        ; Page pause function disabled?
  2748.     ORA    A
  2749.     JZ    PUTRET        ; Yes, exit
  2750.     LDA    POPFLG        ; Load, printer flag
  2751.     ORA    A        ; Set?
  2752.     JZ    PUTRET        ; Yes, skip page pause
  2753.     LDA    FOPFLG        ; File output flag
  2754.     ORA    A        ; Set?
  2755.     JZ    PUTRET        ; Yes, skip page pause
  2756.  
  2757.     LDA    LINCNT        ; Load line count
  2758.     INR    A        ; Bump it
  2759.     STA    LINCNT
  2760.     MVI    L,23        ; Allows use of [more] to finish display
  2761.     CMP    L        ; End of the screen?
  2762.     JC    PUTRET
  2763.  
  2764.     LXI    D,EOSMSG    ; Else, display pause message
  2765.     MVI    C,PRINT        ; Without checking for line feeds
  2766.     CALL    BDOS
  2767.     CALL    GETCH        ; Wait for character
  2768.     CPI    'C'-40H        ; Abort on CTL-C
  2769.     JZ    EXIT1
  2770.     CPI    'K'-40H        ; Or CTL-K
  2771.     JZ    EXIT1
  2772.     CPI    'X'-40H        ; Or CTL-X
  2773.     JZ    EXIT1
  2774.     CPI    ' '        ; See if printing character
  2775.     JC    NOTEOS        ; Exit if not
  2776.  
  2777.      IF    NOT VSPAGE
  2778.     JZ    NOTEOS1        ; If a space, exit to different place
  2779.      ENDIF
  2780.  
  2781.     ANI    5FH        ; Change to upper-case
  2782.     CPI    'C'        ; Can abort with c, C
  2783.     JZ    EXIT1
  2784.     CPI    'K'        ; Can abort with k, K
  2785.     JZ    EXIT1
  2786.     CPI    'X'        ; Can abort with x, X
  2787.     JZ    EXIT1
  2788.  
  2789. NOTEOS:    XRA    A        ; Reset line count
  2790.     STA    WASHERE        ; Say are starting over
  2791.  
  2792. NOTEOS1:STA    LINCNT
  2793.     LXI    D,MORERA    ; Overwrite the [more] display
  2794.     MVI    C,PRINT
  2795.     CALL    BDOS
  2796.  
  2797.      IF    VSPAGE
  2798.     LDA    VSFRST
  2799.     ORA    A
  2800.     JZ    DLINES1
  2801.     LDA    WASHERE        ; Were we here before?
  2802.     ORA    A
  2803.     JZ    WEWERE        ; Z=no
  2804.     CPI    23        ; Yes, must be moving by space bar, see how
  2805.                 ; many times
  2806.     JNZ    DLINES        ; NZ=not a full page worth yet
  2807.     XRA    A        ; A full page, move JUMPER up
  2808.     STA    WASHERE
  2809. WEWERE:    LHLD    JUMPER        ; Get current jumper
  2810.     XCHG
  2811.     LHLD    XPOINT        ; Get current position in array
  2812.     DAD    D        ; Skip the right number of files
  2813.  
  2814.      IF    Z80DOS
  2815.     LDA    NODFLG
  2816.     ORA    A
  2817.     JNZ    WEWERE1
  2818.     DAD    D
  2819.     DAD    D
  2820. WEWERE1:
  2821.      ENDIF        ; Z80DOS
  2822.  
  2823.      IF    NOT Z80DOS
  2824.     DAD    D
  2825.     DAD    D
  2826.      ENDIF        ; NOT Z80DOS
  2827.  
  2828.     SHLD    XPOINT        ; New current poition in output array
  2829.     LXI    H,23        ; Calc new jumper, 23 lines/page
  2830.     LDA    LINES
  2831.     CPI    24
  2832.     JNC    MLINES
  2833.     MOV    L,A
  2834. MLINES:    CALL    MULT13
  2835.     SHLD    JUMPER
  2836. DLINES:
  2837.     LDA    WASHERE
  2838.     INR    A
  2839.     STA    WASHERE
  2840. DLINES1:
  2841.     MVI    A,1
  2842.     STA    VSFRST
  2843.      ENDIF        ; VSPAGE
  2844.  
  2845.     XRA    A        ; Reset the 'A' register
  2846. PUTRET:    POP    H        ; Exit from PUTCHR
  2847.     POP    D
  2848.     POP    B
  2849.     RET
  2850. ;.....
  2851. ;
  2852. ; Output character, with low-case or reverse-video highlighting if high
  2853. ; bit set and conditionals enabled.
  2854. ;
  2855. HITYPE:    DS    0
  2856.  
  2857.      IF    USELC OR REVID
  2858.     ORA    A        ; Check for attributes not set
  2859.     JP    CONOUT        ; No attribute..ignore this one
  2860.     ANI    7FH        ; Attribute set, delete now
  2861.      ENDIF            ; USELC OR REVID
  2862.  
  2863.      IF    NOT USELCW AND WHEEL
  2864.     MOV    E,A        ; Save the character for later
  2865.  
  2866.      IF    ZCPR33
  2867.     PUSH    H
  2868.     LHLD    Z3WHLL        ; Point to enviorment
  2869.     MOV    A,M        ; Get it
  2870.     POP    H
  2871.      ENDIF        ;ZCPR33
  2872.  
  2873.      IF    NOT ZCPR33
  2874.     LDA    WHLOC        ; Get wheel byte
  2875.      ENDIF        ;NOT ZCPR33
  2876.  
  2877.     ORA    A        ; Don't use lower case or REVID
  2878.     MOV    A,E        ; Get back the character to display
  2879.     JZ    CONOUT
  2880.      ENDIF            ; NOT USELCW AND WHEEL
  2881.  
  2882.      IF    REVID
  2883.     PUSH    PSW        ; Save character
  2884.     LXI    D,RVON        ; Turn on reverse video
  2885.     CALL    COUTS        ; If not null
  2886.     POP    PSW        ; Restore character
  2887.      ENDIF            ; REVID
  2888.  
  2889.      IF    USELC
  2890.     CPI    'A'        ; Change only from A-Z
  2891.     JC    TYPEC
  2892.     CPI    'Z'+1
  2893.     JNC    TYPEC        ; Punctuation can change so leave it
  2894.     ORI    20H        ; If attribute, make lower case
  2895.      ENDIF            ; USELC
  2896.  
  2897.      IF    USELC OR REVID
  2898. TYPEC:    CALL    CONOUT        ; Send the processed character
  2899.      ENDIF            ; USELC OR REVID
  2900.  
  2901.      IF    REVID
  2902.     LXI    D,RVOFF        ; Turn off reverse video
  2903.     CALL    COUTS        ; If not null
  2904.      ENDIF            ; REVID
  2905.  
  2906.      IF    USELC OR REVID
  2907.     RET
  2908.      ENDIF            ; USELC OR REVID
  2909. ;.....
  2910. ;
  2911. ; Output character in A to console
  2912. ;
  2913. CONOUT:    MOV    E,A        ; Get character for BDOS entry
  2914.     MVI    C,WRCON
  2915.     JMP    BDOS        ; Console Output
  2916. ;.....
  2917. ;
  2918. ; Output (raw) null-terminated string at (DE) to console.
  2919. ;
  2920.  
  2921. COUTS:    LDAX    D        ; Get byte of string
  2922.     ORA    A        ; Null?
  2923.     RZ            ; Return if so
  2924.     PUSH    D
  2925.     CALL    CONOUT
  2926.     POP    D
  2927.     INX    D        ; Next byte
  2928.     JMP    COUTS
  2929. ;.....
  2930. ;
  2931. ; Output bytes at HL of length B to console/printer/file
  2932. ;
  2933. PUTSB:    MOV    A,M
  2934.     CALL    PUTCHR
  2935.     INX    H
  2936.     DCR    B
  2937.     JNZ    PUTSB
  2938.     RET
  2939. ;.....
  2940. ;
  2941. ; Output null-terminated string to console/printer/file
  2942. ;
  2943. PUTS:    LDAX    D        ; Load character from DE string
  2944.     ANI    7FH        ; Strip off parity
  2945.     ORA    A        ; Is a 0?
  2946.     RZ            ; Yes, Terminate
  2947.     CALL    PUTCHR        ; Display character
  2948.     INX    D        ; Next string position
  2949.     JMP    PUTS        ; Continue
  2950. ;.....
  2951. ;
  2952. ; Fetch character from console (without echo)
  2953. ;
  2954. GETCH:    LHLD    0000H+1        ; Warm Boot Address
  2955.     MVI    L,9        ; Direct Console
  2956.     CALL    GOHL        ; Get Character
  2957.     ANI    7FH        ; Strip off any parity
  2958.     RET
  2959. ;.....
  2960. ;
  2961. ; Check for a CTL-C or CTL-S entered from the keyboard.  Jump to EXIT if
  2962. ; CTL-C, pause on CTL-S.
  2963. ;
  2964. CKABRT:    PUSH    H
  2965.     PUSH    D
  2966.     PUSH    B
  2967.     MVI    C,CONST
  2968.     CALL    BDOS
  2969.     ORA    A
  2970.     JZ    CKAB3        ; No character, exit
  2971.     MVI    C,RDCON
  2972.     CALL    BDOS
  2973.     ANI    5FH
  2974.     CPI    'S'-40H
  2975.     JZ    CKAB0
  2976.     CPI    'S'
  2977.     JNZ    CKAB1
  2978.     CALL    CKAB4
  2979.  
  2980. CKAB0:    MVI    C,RDCON
  2981.     CALL    BDOS
  2982.     ANI    5FH
  2983.  
  2984. CKAB1:    CPI    'C'-40H        ; CTL-C?
  2985.     JZ    CKAB2        ; Yes, quit
  2986.     CPI    'K'-40H
  2987.     JZ    CKAB2
  2988.     CPI    'X'-40H
  2989.     JZ    CKAB2
  2990.     CPI    ' '        ; Any other CTL-character, abort
  2991.     JC    CKAB3
  2992.     CALL    CKAB4        ; Clear the character from screen
  2993.     CPI    'C'
  2994.     JZ    CKAB2
  2995.     CPI    'K'
  2996.     JZ    CKAB2
  2997.     CPI    'X'
  2998.     JNZ    CKAB3
  2999.  
  3000. CKAB2:    LXI    D,CKMS1
  3001.     CALL    PUTS
  3002.     POP    B
  3003.     POP    D
  3004.     POP    H
  3005.     JMP    EX0        ; All done
  3006.  
  3007. CKAB3:    POP    B
  3008.     POP    D
  3009.     POP    H
  3010.     RET
  3011.  
  3012. CKAB4:    PUSH    PSW
  3013.     LXI    D,CKMS2
  3014.     CALL    PUTS
  3015.     POP    PSW
  3016.     RET
  3017. ;.....
  3018. ;
  3019. ; Call here to call address in HL
  3020. ;
  3021. GOHL:    PCHL
  3022. ;
  3023. ; Enter BDOS, save all extended registers
  3024. ;
  3025. CPM:    PUSH    B        ; Save Registers
  3026.     PUSH    D
  3027.     PUSH    H
  3028.  
  3029.      IF    ZRDOS
  3030.     LDA    ZRDFLG        ; ZRDOS running?
  3031.     ORA    A
  3032.     JNZ    ZRD        ; ZRDOS error trap and DOSs call
  3033.      ENDIF            ; ZRDOS
  3034.  
  3035.     CALL    BDOS
  3036.     MOV    B,A        ; Save return code
  3037.     LDA    VERFLG        ; Is this 3.0?
  3038.     CPI    30H
  3039.     MOV    A,B
  3040.     JC    CPM20        ; No, exit normally
  3041.     CPI    0FFH        ; Yes, was return code FF?
  3042.     JNZ    CPM20        ; No, exit normally
  3043.     MOV    A,H        ; Yes, check for error code
  3044.     ORA    A
  3045.     JNZ    DSKERR        ; Exit if physical error
  3046.     MOV    A,B        ; Else, continue normally
  3047.  
  3048. CPM20:    POP    H
  3049.     POP    D
  3050.     POP    B
  3051.     RET
  3052. ;.....
  3053. ;
  3054. ; ZRDOS Error Trap and System Call exits to CPM20
  3055. ;
  3056.      IF    ZRDOS
  3057. ZRD:    CALL    SETTRAP        ; Set the warm boot trap
  3058.     CALL    BDOS        ; Do what we're told
  3059.     CALL    RESTRAP        ; Reset the trap
  3060.     JMP    CPM20        ; Error free exit
  3061. ;.....
  3062. ;
  3063. ; Set Warm Boot Trap in ZRDOS
  3064. ;
  3065. SETTRAP:PUSH    H
  3066.     PUSH    D
  3067.     PUSH    B
  3068.     MVI    C,SETWBT    ; Set warm boot trap to come here
  3069.     LXI    D,WBTRAP
  3070.     CALL    BDOS
  3071.     POP    B
  3072.     POP    D
  3073.     POP    H
  3074.     RET
  3075. ;.....
  3076. ;
  3077. ; WBTRAP is where the ZRDOS returns control on warm boot (error)
  3078. ;
  3079. WBTRAP:    LXI    H,DSKERR    ; Return here after trap reset
  3080.     PUSH    H        ; Save DSKERR on stack
  3081. ;
  3082. ; Reset Warm Boot Trap in ZRDOS
  3083. ;
  3084. RESTRAP:PUSH    H
  3085.     PUSH    D
  3086.     PUSH    B
  3087.     PUSH    PSW
  3088.     MVI    C,RESWBT    ; Reset warm boot trap
  3089.     CALL    BDOS
  3090.     POP    PSW
  3091.     POP    B
  3092.     POP    D
  3093.     POP    H
  3094.     RET
  3095.      ENDIF            ; ZRDOS
  3096. ;.....
  3097. ;
  3098. ; For file output mode, return to old user area and set DMA for the file
  3099. ; output buffer.
  3100. ;
  3101. SETFOP:    CALL    CKVER        ; Clear carry if CP/M 2 or later
  3102.     LDA    OLDUSR        ; Get user number at startup
  3103.     MOV    E,A
  3104.     MVI    C,STUSER
  3105.     CNC    CPM        ; Reset old user number if CP/M 2
  3106.     LXI    D,OUTBUF    ; Move DMA from search buffer into
  3107.     JMP    SET2        ; Output buffer
  3108.     RET
  3109. ;.....
  3110. ;
  3111. ; Move disk buffer DMA to default buffer for directory search operations
  3112. ; and BDOS media change routines (required for pre-CP/M 2 systems while
  3113. ; in file output mode with active buffer).
  3114. ;
  3115. SETSRC:    LXI    D,TBUF        ; Default DMA Address
  3116.  
  3117. SET2:    MVI    C,STDMA        ; Set DMA Address
  3118.     JMP    CPM
  3119. ;.....
  3120. ;
  3121. ; Print amount of free space remaining on selected drive
  3122. ;
  3123. PRTFRE:    LXI    D,TOTMS7    ; Print " Free: '
  3124.     CALL    PUTS
  3125.     LHLD    FREEBY
  3126.     CALL    DECPRT        ; Print k free
  3127.     LXI    D,TOTMS8    ; Print "k "
  3128.     CALL    PUTS
  3129.     LDA    VFLAG        ; Alphabetizing vertically?
  3130.     ORA    A
  3131.     RZ            ; If yes, finished
  3132.     JMP    CRLF        ; Else turn up an extra line
  3133. ;.....
  3134. ;
  3135. ; Show string on the console
  3136. ;
  3137. SHOW:    LDAX    D        ; Get character from DE string
  3138.     ANI    7FH        ; Strip off parity
  3139.     ORA    A        ; Is it a 0?
  3140.     RZ            ; Yes, terminate
  3141.     PUSH    B        ; Save registers
  3142.     PUSH    D
  3143.     PUSH    H
  3144.     CALL    CONOUT        ; Show character on console
  3145.     POP    H        ; Load registers
  3146.     POP    D
  3147.     POP    B
  3148.     INX    D        ; Next string position
  3149.     JMP    SHOW        ; Continue
  3150. ;.....
  3151. ;
  3152. ; Compare routine for last extent of file search
  3153. ;
  3154. COMPR:    PUSH    H        ; Save table address
  3155.     MOV    E,M        ; Load low order
  3156.     INX    H
  3157.     MOV    D,M        ; Load high order
  3158.     INX    H
  3159.     MOV    C,M
  3160.     INX    H
  3161.     MOV    B,M
  3162. ;
  3163. ; BC, DE now point to entries to be compared
  3164. ;
  3165.     XCHG
  3166.     MOV    E,A        ; Get count
  3167.  
  3168. CMPLP:    LDAX    B
  3169.     XRA    M        ; Copy bit 7 of M
  3170.     ANI    7FH        ; Into bit 7 of A
  3171.     XRA    M
  3172.     CMP    M        ; Then compare
  3173.     INX    H
  3174.     INX    B
  3175.     JNZ    NOTEQL        ; Quit on mismatch
  3176.     DCR    E        ; Or end of count
  3177.     JNZ    CMPLP
  3178. ;
  3179. NOTEQL:    POP    H
  3180.     RET            ; Condition code tells all
  3181. ;.....
  3182. ;
  3183. ; Swap entries in the order table
  3184. ;
  3185. SWAP:    LXI    B,ORDER-2    ; Table base
  3186.     DAD    H        ; *2
  3187.     DAD    B        ; + base
  3188.     XCHG
  3189.     DAD    H        ; *2
  3190.     DAD    B        ; + base
  3191.     MOV    C,M
  3192.     LDAX    D
  3193.     XCHG
  3194.     MOV    M,C
  3195.     STAX    D
  3196.     INX    H
  3197.     INX    D
  3198.     MOV    C,M
  3199.     LDAX    D
  3200.     XCHG
  3201.     MOV    M,C
  3202.     STAX    D
  3203.     RET
  3204. ;.....
  3205. ;
  3206. ; New compare routine for sorting
  3207. ;
  3208. COMPARE:LXI    B,ORDER-2
  3209.     DAD    H
  3210.     DAD    B
  3211.     XCHG
  3212.     DAD    H
  3213.     DAD    B
  3214.     XCHG
  3215.     MOV    C,M
  3216.     INX    H
  3217.     MOV    B,M
  3218.     XCHG
  3219.     MOV    E,C
  3220.     MOV    D,B
  3221.     MOV    C,M
  3222.     INX    H
  3223.     MOV    H,M
  3224.     MOV    L,C
  3225.     MVI    B,13        ; Count for normal sort
  3226.     LDA    TOPFLG        ; Check for sort by type
  3227.     ORA    A
  3228.     JNZ    CMPLPE        ; Jump if normal sort
  3229.     PUSH    H        ; Save name pointers for later
  3230.     PUSH    D
  3231.     LXI    B,8        ; Point to file types
  3232.     DAD    B
  3233.     XCHG
  3234.     DAD    B
  3235.     XCHG
  3236.     MVI    B,3        ; Count for type compare
  3237.     CALL    CMPLPE
  3238.     POP    D        ; Retrieve name pointers
  3239.     POP    H        ;
  3240.     RNZ
  3241.     MVI    B,8        ; Count for name compare
  3242.     CALL    CMPLPE
  3243.     RNZ
  3244.     INX    D        ; Point to extent
  3245.     INX    D
  3246.     INX    D
  3247.     INX    H
  3248.     INX    H
  3249.     INX    H
  3250.     MVI    B,2        ; Count for extent compare
  3251.  
  3252. CMPLPE:    LDAX    D        ;
  3253.     XRA    M        ; Copy bit 7 of M
  3254.     ANI    7FH        ; Into bit 7 of A
  3255.     XRA    M        ;
  3256.     CMP    M        ; Then compare
  3257.     INX    D
  3258.     INX    H
  3259.     RNZ
  3260.     DCR    B
  3261.     JNZ    CMPLPE
  3262.     RET
  3263. ;.....
  3264. ;
  3265. ; Error exit
  3266. ;
  3267. ERXIT:    MVI    A,0FFH        ; Error Flag
  3268.     STA    FOPFLG        ; Disable file output on error
  3269.     CALL    CRLF        ; Space down
  3270.     POP    D        ; Load message string pointer
  3271.     CALL    PUTS        ; Print message
  3272.     LXI    D,ERRMS1    ; " Error"
  3273.     CALL    PUTS        ; Print message
  3274.     CALL    CRLF        ; Space down
  3275. ;
  3276. ; Exit - all done, restore stack
  3277. ;
  3278. EXIT:    LDA    DOPFLG        ; Multi-disk selected?
  3279.     ORA    A
  3280.     JNZ    EX0        ; No, skip next
  3281.     CALL    CKABRT        ; Check for user abort
  3282.     MVI    A,HIDRV-LODRV    ; Maximum drive code to search
  3283.     LXI    H,FCB        ; Increment directory FCB drive code
  3284.     INR    M
  3285.     CMP    M        ; Does next disk exceed maximum?
  3286.     JC    EX0
  3287.  
  3288.      IF    MAXDRV
  3289.  
  3290.      IF    ZCPR33
  3291.     PUSH    H
  3292.     LHLD    Z3DRVL        ; Point to ENV
  3293.     MOV    A,M        ; Get it
  3294.     POP    H
  3295.      ENDIF        ;ZCPR33
  3296.  
  3297.      IF    NOT ZCPR33
  3298.     LDA    MXDRV        ; Look at another value limit
  3299.     INR    A
  3300.      ENDIF        ;NOT ZCPR33
  3301.  
  3302.     CMP    M        ; Is it lower?
  3303.     JC    EX0        ; Bail out if too low
  3304.     JMP    NOOPT        ; Search next disk
  3305.      ENDIF            ; MAXDRV
  3306.  
  3307.     JNC    NOOPT        ; Search next disk if MAXDR not true
  3308.  
  3309. EX0:    LDA    VFLAG        ; Check display form
  3310.     ORA    A
  3311.     CZ    CRLF        ; Turn up a blank line at end if vertical
  3312.     MVI    C,CONST        ; Check console status
  3313.     CALL    CPM
  3314.     ORA    A        ; Character waiting?
  3315.     MVI    C,RDCON
  3316.     CNZ    CPM        ; Gobble up character
  3317.  
  3318.      IF    ZRDOS
  3319.     LDA    ZRDFLG        ; ZRDOS running?
  3320.     ORA    A
  3321.     JNZ    EXIT2        ; Yes
  3322.      ENDIF            ; ZRDOS
  3323.  
  3324.     LDA    VERFLG        ; Version flag
  3325.     CPI    30H        ; CP/M 3.0?
  3326.     JC    EXIT1        ; No
  3327.     MVI    C,2DH        ; Yes,
  3328.     MVI    E,0        ; Reset error mode to default
  3329.     CALL    CPM
  3330.     JMP    EXIT2        ; Quit
  3331.  
  3332. EXIT1:    LDA    DOPFLG        ; If they were swapped
  3333.     ORA    A
  3334.     CZ    SWAPEM
  3335.  
  3336. EXIT2    EQU    $
  3337.  
  3338.      IF    SHOPUB
  3339.     CALL    RSTPUB
  3340.      ENDIF            ; SHOPUB
  3341.  
  3342.     LDA    AOPFLG        ; Doing all users
  3343.     MOV    C,A
  3344.     LDA    DOPFLG        ; Or disk?
  3345.     ANA    C
  3346.     MOV    C,A
  3347.     LDA    HOPFLG        ; Or higher users?
  3348.     ANA    C
  3349.     JNZ    TOTDONE        ; If no, skip totals
  3350.     MVI    A,1        ; Force no file output
  3351.     STA    LINCNT
  3352.     STA    FOPFLG
  3353.     LXI    D,ALLTOT    ; First part of message
  3354.     CALL    PUTS
  3355.     LHLD    TOTFL1        ; Total files found
  3356.     CALL    DECPRT
  3357.     LXI    D,TOTMS4
  3358.     CALL    PUTS
  3359.     LHLD    TOTSZ1        ; Total 'k' found
  3360.     CALL    DECPRT
  3361.     LXI    D,TOTMS8
  3362.     CALL    PUTS
  3363.     LXI    D,TOTMS7
  3364.     CALL    PUTS
  3365.     LHLD    TOTFRE
  3366.     CALL    DECPRT
  3367.     LXI    D,ALLTO1
  3368.     CALL    PUTS
  3369. TOTDONE:
  3370.      IF    WMBOOT
  3371.     JMP    0000H
  3372.      ENDIF            ; WMBOOT
  3373.  
  3374.     LDA    OLDDSK        ; Restore original drive
  3375.     MOV    E,A
  3376.     MVI    C,14
  3377.     CALL    CPM
  3378.     LDA    OLDUSR        ; Restore original user area
  3379.     MOV    E,A
  3380.     MVI    C,32
  3381.     CALL    CPM
  3382.  
  3383. EXIT3:    LHLD    STACK        ; Get old stack pointer
  3384.     SPHL            ; Move back to old stack
  3385.     RET            ; And return to CCP
  3386. ;.....
  3387. ;
  3388. ; Restore Public areas if they were changed
  3389. ;
  3390.      IF    SHOPUB
  3391. RSTPUB:    LHLD    0109H
  3392.     MVI    D,0
  3393.     MVI    E,07EH
  3394.     DAD    D
  3395.     LDA    PUBDRV
  3396.     MOV    M,A
  3397.     INX    H
  3398.     LDA    PUBUSR
  3399.     MOV    M,A
  3400.     RET
  3401.      ENDIF            ; SHOPUB
  3402. ;.....
  3403. ;
  3404.      IF    NDIRS
  3405. NAMDIR:    MVI    A,0
  3406.     STA    CURDIR        ; Initial check count
  3407.  
  3408. NAMDR1:    LHLD    NAMADR        ; Named directory buffer address
  3409.  
  3410. NAMDR2:    LDA    FCB        ; Get current Drive
  3411.     CMP    M        ; Does NDR entry match current drive?
  3412.     JNZ    NXTDIR        ; No, check next
  3413.     LDA    NEWUSR        ; Get current user
  3414.     INX    H
  3415.     CMP    M        ; Does NDR entry match current user?
  3416.     JNZ    NXTDIR        ; No, check next
  3417.     MVI    A,'['        ; Frame the name in brackets
  3418.     CALL    PUTCHR
  3419.     MVI    C,8        ; Number of Characters in entry
  3420.  
  3421. DIRCHR:    INX    H        ; Match, Point to Directory Name
  3422.     MOV    A,M        ; Get Character
  3423.     CPI    20H        ; End of entry?
  3424.     JNZ    DIRCH1        ; No
  3425.  
  3426. DIRCH0:    PUSH    PSW
  3427.     MVI    A,']'        ; Print closing bracket
  3428.     CALL    PUTCHR
  3429.     POP    PSW
  3430.     JMP    DIRCH2
  3431.  
  3432. DIRCH1:    CALL    PUTCHR
  3433.     DCR    C
  3434.     JNZ    DIRCHR        ; Output Eight characters
  3435.     JMP    DIRCH0
  3436.     RET            ; Done
  3437. DIRCH2:    MOV    A,C
  3438.     ORA    A
  3439.     RZ
  3440.     MVI    A,20H        ; Fill with spaces for neatness sake
  3441.     CALL    PUTCHR
  3442.     DCR    C
  3443.     JNZ    DIRCH2
  3444.     RET
  3445.  
  3446. NXTDIR:    LDA    CURDIR
  3447.     ADI    1        ; Increment Directory pointer
  3448.     STA    CURDIR
  3449.     LXI    H,NUMDIR
  3450.     CMP    M        ; Exceeded Max Entry?
  3451.     JZ    NODIR        ; Yes, there is no entry for this DU
  3452.     LHLD    NAMADR        ; Get base NDR address
  3453.     MVI    D,0
  3454.     MVI    E,18        ; Increment to next entry
  3455.  
  3456. NXTD:    DAD    D
  3457.     DCR    A        ; Decrement count
  3458.     JNZ    NXTD        ; Until current Offset reached
  3459.     JMP    NAMDR2        ; And check the entry for a match
  3460. NODIR:    MVI    C,10        ; No match, output ten spaces
  3461.  
  3462. NODIR1:    MVI    A,20H
  3463.     CALL    PUTCHR
  3464.     DCR    C
  3465.     JNZ    NODIR1
  3466.     RET
  3467.      ENDIF            ; NDIRS
  3468. ;.....
  3469. ;
  3470. ; Trap BDOS select and sector error vectors to our own intercept routine
  3471. ; so we can catch a reference to an illegal drive.
  3472. ;
  3473. SWAPEM:    DS    0
  3474.  
  3475.      IF    ZRDOS
  3476.     LDA    ZRDFLG        ; See if ZRDOS running
  3477.     ORA    A
  3478.     RNZ            ; Yes, quit this
  3479.      ENDIF            ; ZRDOS
  3480.  
  3481.     LDA    VERFLG        ; Version flag
  3482.     CPI    30H        ; Error mode call available?
  3483.     JC    SWAP20        ; No, use BDOS error vectors
  3484.     MVI    C,2DH        ; Yes, use error mode call
  3485.     MVI    E,0FFH        ;
  3486.     CALL    CPM        ; Set "return code only" mode
  3487.     RET
  3488.  
  3489. SWAP20:    LHLD    BDOS+1        ; Load pointer to base of BDOS
  3490.     INX    H        ; Swap new pointer if running a
  3491.     MOV    E,M        ; Program below the CCP
  3492.     INX    H
  3493.     MOV    D,M
  3494.     XCHG            ; HL points to the proper vector
  3495.     MVI    L,9        ; Point to record error vector
  3496.     LXI    D,VECTBL    ; Exchange with our vector table
  3497.     MVI    A,4        ; 4 bytes to swap
  3498.  
  3499. SWAPLP:    MOV    B,M        ; Load byte from HL
  3500.     XCHG
  3501.     MOV    C,M        ; Load byte from DE
  3502.     MOV    M,B        ; Save byte from HL
  3503.     XCHG
  3504.     MOV    M,C        ; Save byte from DE
  3505.     INX    H        ; Increment exchange pointers
  3506.     INX    D
  3507.     DCR    A        ; Counter-1
  3508.     JNZ    SWAPLP        ; Continue swapping
  3509.     RET
  3510. ;.....
  3511. ;
  3512. ; Check CP/M version number. Return carry flag set if pre-CP/M 2.  If
  3513. ; CP/M 2 or later or MP/M (any version), return carry clear.
  3514. ;
  3515. CKVER:    LDA    VERFLG        ; Version Flag
  3516.     CPI    20H        ; CP/M 2.0?
  3517.     RET
  3518. ;.....
  3519. ;
  3520. ; Return point from intercepted BDOS select and bad record errors.
  3521. ;
  3522. DSKERR:    LXI    SP,STACK    ; Get out of BDOS' stack
  3523.     JMP    EXIT        ; And exit back to CCP
  3524. ;.....
  3525. ;
  3526. ;-----------------------------------------------------------------------
  3527. ;             Start of FNAME routine
  3528. ;
  3529. ; Main module
  3530. ;    on entry, DE points to FCB to be filled, HL points to first
  3531. ;        byte of target string, RFCB is 36 bytes long
  3532. ;    on exit, B=disk number (1 for A, etc.) and C=user number
  3533. ;        HL points to terminating character
  3534. ;        A=0 and Z set if error in disk or user numbers
  3535. ;        A=0FFH and NZ if ok
  3536. ;
  3537. MAXDISK    EQU    16        ; Maximum number of disks
  3538. MAXUSER    EQU    31        ; Maximum user number
  3539.  
  3540. FNAME:    PUSH    D        ; Save DE
  3541.     MVI    A,0FFH        ; Set default disk and user
  3542.     STA    DISKNO
  3543.     STA    USERNO
  3544.     MVI    B,36        ; Initialize FCB
  3545.     PUSH    D        ; Save pointer
  3546.     XRA    A        ; A=0
  3547.  
  3548. FNINI:    STAX    D        ; Store zero
  3549.     INX    D        ; Point to next
  3550.     DCR    B        ; Count down
  3551.     JNZ    FNINI
  3552.     POP    D        ; Get pointer back
  3553.     PUSH    H        ; Save pointer
  3554. ;
  3555. ; Scan for colon, comma, or space in string
  3556. ;
  3557. COLON:    MOV    A,M        ; Scan for colon or space
  3558.     INX    H        ; Point to next
  3559.     CPI    ':'        ; Colon found?
  3560.     JZ    COLON1
  3561.     CPI    ','        ; Comma found?
  3562.     JZ    GETF1
  3563.     CPI    ' '+1        ; Delimiter?
  3564.     JC    GETF1
  3565.     JMP    COLON        ; Continue if not EOL
  3566. ;
  3567. COLON1:    POP    H        ; Clear stack
  3568.     MOV    A,M        ; Save possible drive specification
  3569.     CALL    CAPS        ; Capitalize
  3570.     CPI    'A'        ; Digit if less than "A"
  3571.     JC    USERCK        ; Process user number
  3572.     SUI    'A'        ; Change from ASCII to binary
  3573.     CPI    MAXDISK        ; Within bounds?
  3574.     JC    SVDISK
  3575. ;
  3576. ERREXIT:XRA    A        ; Error indicator
  3577.     POP    D        ; Restore DE
  3578.     RET
  3579. ;.....
  3580. ;
  3581. ; Log in specified disk
  3582. ;
  3583. SVDISK:    INR    A        ; Adjust to 1 for "A"
  3584.     STA    DISKNO        ; Save flag
  3585.     INX    H        ; Point to next character
  3586. ;
  3587. ; Check for user
  3588. ;
  3589. USERCK:    MOV    A,M        ; Get possible user #
  3590.     CPI    ':'        ; No user number
  3591.     JZ    GETFILE
  3592.     CPI    '?'        ; All user numbers?
  3593.     JNZ    USERC1
  3594.     STA    USERNO        ; Set value
  3595.     INX    H        ; Point to after
  3596.     MOV    A,M        ; Must be colon
  3597.     CPI    ':'
  3598.     JZ    GETFILE
  3599.     JMP    ERREXIT        ; Fatal error if not colon after ?
  3600.  
  3601. USERC1:    XRA    A        ; Zero user number
  3602.     MOV    B,A        ; B = A for user number
  3603.  
  3604. USRLOOP:MOV    A,M        ; Get digit
  3605.     INX    H        ; Point to next
  3606.     CPI    ':'        ; Done?
  3607.     JZ    USRDN
  3608.     SUI    '0'        ; Convert to binary
  3609.     JC    ERREXIT        ; User number error?
  3610.     CPI    10
  3611.     JNC    ERREXIT
  3612.     MOV    C,A        ; Next digit in C
  3613.     MOV    A,B        ; Old number in A
  3614.     ADD    A        ; *2
  3615.     ADD    A        ; *4
  3616.     ADD    B        ; *5
  3617.     ADD    A        ; *10
  3618.     ADD    C        ; *10+new digit
  3619.     MOV    B,A        ; Result in B
  3620.     JMP    USRLOOP
  3621.  
  3622. USRDN:    MOV    A,B        ; Get newer user number
  3623.     CPI    MAXUSER+1    ; Within range?
  3624.     JNC    ERREXIT
  3625.     STA    USERNO        ; Save in flag
  3626.     JMP    GETFILE
  3627. ;
  3628. ; Extract file name
  3629. ;
  3630. GETF1:    POP    H        ; Get pointer to byte
  3631. ;
  3632. GETFILE:MOV    A,M        ; Pointing to colon?
  3633.     CPI    ':'
  3634.     JNZ    GFILE1
  3635.     INX    H        ; Skip over colon
  3636.  
  3637. GFILE1:    MOV    A,M        ; Get next character
  3638.     CPI    ','        ; Delimiter?
  3639.     JZ    GFQUES
  3640.     CPI    ' '+1        ; Not a delimiter?
  3641.     JNC    GFILE2
  3642.  
  3643. GFQUES:    INX    D        ; Fill with ???
  3644.     MVI    B,11        ; 11 bytes
  3645.     MVI    A,'?'
  3646.  
  3647. GFFILL:    STAX    D        ; Put?
  3648.     INX    D        ; Point to next
  3649.     DCR    B        ; Count down
  3650.     JNZ    GFFILL
  3651.  
  3652. FNDONE:    LDA    DISKNO        ; Get disk number
  3653.     MOV    B,A        ; In 'B'
  3654.     LDA    USERNO        ; Get user number
  3655.     MOV    C,A        ; In 'C'
  3656.     POP    D        ; Restore registers
  3657.     MVI    A,0FFH        ; No error
  3658.     ORA    A        ; Set flags
  3659.     RET
  3660. ;
  3661. ; Get file name fields
  3662. ;
  3663. GFILE2:    MVI    B,8        ; At most, 8 byte filename
  3664.     CALL    SCANF        ; Scan and fill
  3665.     MVI    B,3        ; At most, 3 byte filetype
  3666.     MOV    A,M        ; Get delimiter
  3667.     CPI    '.'        ; Filename ending in "."?
  3668.     JNZ    GFILE3
  3669.     INX    H        ; Point to character after "."
  3670.     CALL    SCANF        ; Scan and fill
  3671.     JMP    FNDONE        ; Done, return to "args"
  3672.  
  3673. GFILE3:    CALL    SCANF4        ; Fill with spaces
  3674.     JMP    FNDONE
  3675. ;
  3676. ; Scanner routine
  3677. ;
  3678. SCANF:    CALL    DELCK        ; Check for delimiter
  3679.     JZ    SCANF4        ; Fill with spaces if found
  3680.     INX    D        ; Next byte in filename
  3681.     CPI    '*'        ; Question mark fill ?
  3682.     JNZ    SCANF1
  3683.     MVI    A,'?'        ; Place "?"
  3684.     STAX    D
  3685.     JMP    SCANF2
  3686.  
  3687. SCANF1:    STAX    D        ; Place character
  3688.     INX    H        ; Next position
  3689.  
  3690. SCANF2:    DCR    B        ; Count down
  3691.     JNZ    SCANF        ; Continue loop
  3692.  
  3693. SCANF3:    CALL    DELCK        ; Skip to delimiter
  3694.     RZ
  3695.     INX    H        ; Point to next
  3696.     JMP    SCANF3
  3697.  
  3698. SCANF4:    INX    D        ; Next filename or filetype
  3699.     MVI    A,' '        ; Fill with spaces
  3700.     STAX    D
  3701.     DCR    B        ; Count down
  3702.     JNZ    SCANF4
  3703.     RET
  3704. ;.....
  3705. ;
  3706. ; Check character pointed to by HL for a delimiter,
  3707. ; return with Zero flag set if the character is a delimiter
  3708. ;
  3709. DELCK:    MOV    A,M        ; Get the character
  3710.     CALL    CAPS        ; Capitalize
  3711.     ORA    A        ; 0=delimiter
  3712.     RZ
  3713.     CPI    ' '+1        ; Space character+1
  3714.     JC    DELCK1        ; Space character or less
  3715.     CPI    '='
  3716.     RZ
  3717.     CPI    5FH        ; Underscore
  3718.     RZ
  3719.     CPI    '.'
  3720.     RZ
  3721.     CPI    ':'
  3722.     RZ
  3723.     CPI    ';'
  3724.     RZ
  3725.     CPI    ','
  3726.     RZ
  3727.     CPI    '<'
  3728.     RZ
  3729.     CPI    '>'
  3730.     RET
  3731. ;
  3732. DELCK1:    CMP    M        ; Compare with self for OK
  3733.     RET
  3734. ;.....
  3735. ;
  3736. CAPS:    CPI    'a'
  3737.     RC
  3738.     CPI    'z'+1
  3739.     RNC
  3740.     SUI    20H
  3741.     RET
  3742. ;.....
  3743. ;              End of FNAME routine
  3744. ;-----------------------------------------------------------------------
  3745. ;
  3746. ; Subroutines to read library file directory
  3747. ;
  3748. PRTLMEM:LXI    H,ORDER        ; Initialize order table pointer
  3749.     SHLD    NEXTL
  3750.     XRA    A
  3751.     STA    LNCNT
  3752.  
  3753. ENTRYL:    LHLD    LCOUNT        ; Get FCB count
  3754.     DCX    H        ; Decrement it
  3755.     SHLD    LCOUNT
  3756.     MOV    A,H        ; Is this the last file?
  3757.     ORA    L
  3758.     JZ    LBRTST        ; Yes, skip compare
  3759.     PUSH    B
  3760.     CALL    CKABRT        ; Keyboard abort?
  3761.     LHLD    NEXTL
  3762.     MVI    A,11
  3763.     CALL    COMPR        ; This entry match next one?
  3764.     POP    B
  3765.     JNZ    LBRTST        ; No, print it
  3766.     INX    H
  3767.     INX    H        ; Skip, highest extent last in list
  3768.     SHLD    NEXTL
  3769.     JMP    ENTRYL        ; Loop back for next lowest extent
  3770. ;.....
  3771. ;
  3772. ; Exit Library member printing
  3773. ;
  3774. LBEXIT:    LHLD    LMTOTL
  3775.     MOV    A,H
  3776.     ORA    L
  3777.     RZ
  3778.     PUSH    H        ; Save member count
  3779.     XRA    A        ; Get a zero to
  3780.     STA    SUPSPC        ; Suppress leading spaces in totals
  3781.  
  3782.      IF    Z80DOS
  3783.     MVI    L,2        ; If last line is full, don't turn
  3784.     LDA    NODFLG
  3785.     ORA    A
  3786.     JNZ    NOD7
  3787.     MVI    L,4
  3788. NOD7:
  3789.      ENDIF        ;Z80DOS
  3790.  
  3791.      IF    NOT Z80DOS
  3792.     MVI    L,4        ; If last line is full, don't turn
  3793.      ENDIF        ;NOT Z80DOS
  3794.  
  3795.     LDA    LNCNT
  3796.     CMP    L        ; Up extra line
  3797.     CNZ    CRLF        ; If partial line, extra line needed
  3798.     LXI    D,CONTM1    ; Print "There are "
  3799.     CALL    PUTS
  3800.     POP    H        ; Get total member count back
  3801.     CALL    DECPRT
  3802.     LXI    D,MFILES    ; Print "Members in "
  3803.     CALL    PUTS
  3804.     LHLD    LBTOTL
  3805.     CALL    DECPRT
  3806.     LXI    D,LIBR
  3807.     JMP    PUTS
  3808. ;
  3809. ; Valid entry obtained - spit it out
  3810. ;
  3811. LBRTST:    MVI    A,1        ; Turn off .ARC/ARK
  3812.     STA    ISARC
  3813.     LHLD    NEXTL        ; Load order table pointer
  3814.     MOV    E,M        ; Low order address
  3815.     INX    H
  3816.     MOV    D,M        ; High order address
  3817.     INX    H
  3818.     SHLD    NEXTL        ; Save updated table pointer
  3819.     LXI    H,8
  3820.     DAD    D
  3821.     CALL    CKLBR
  3822.     JZ    LBRSET
  3823.     CALL    CKARC
  3824.     JNZ    LBRNEX
  3825.     XRA    A
  3826.     STA    ISARC
  3827.  
  3828. LBRSET:    PUSH    D
  3829.  
  3830.      IF    Z80DOS
  3831.     LDA    NODFLG
  3832.     ORA    A
  3833.     JZ    ZARC0
  3834.     LDA    ISARC
  3835.     ORA    A
  3836.     JZ    ZARC0
  3837.     MVI    L,2        ; 2 NAMES PER LINE
  3838.     JMP    ZARC0A
  3839. ZARC0:    MVI    L,4        ; 4 NAMES PER LINE
  3840. ZARC0A:    LDA    LNCNT
  3841.      ENDIF        ;Z80DOS
  3842.  
  3843.      IF    NOT Z80DOS
  3844.     LDA    LNCNT
  3845.     MVI    L,4
  3846.      ENDIF        ;NOT Z80DOS
  3847.  
  3848.     CMP    L
  3849.     CNZ    CRLF
  3850.     PUSH    PSW        ; Just in case
  3851.     LXI    D,LFMSP1    ; Long Library directory message
  3852.     LDA    ISARC
  3853.     ORA    A
  3854.     JNZ    SARCM1
  3855.     LXI    D,AFMSP1
  3856.  
  3857. SARCM1:    CALL    PUTS        ; Print it
  3858.     POP    PSW        ; Put it back
  3859.     LDA    FCB        ; Load current drive
  3860.     ADI    'A'-1        ; Convert to ASCII
  3861.     CALL    PUTCHR        ; Print it
  3862.     CALL    PUTUSR        ; Print user # after it
  3863.     MVI    A,':'        ; And colon
  3864.     CALL    PUTCHR
  3865.     POP    H
  3866.     PUSH    H
  3867.     MVI    B,8        ; Filename length
  3868.     CALL    PUTSB
  3869.     MVI    A,'.'        ; Period after filename
  3870.     CALL    PUTCHR
  3871.     MVI    B,3        ; 3 characters of filetype
  3872.     CALL    PUTSB
  3873.  
  3874.      IF    Z80DOS
  3875.     LDA    NODFLG
  3876.     ORA    A
  3877.     JZ    NOD8
  3878.     CALL    DISDAT
  3879. NOD8:
  3880.      ENDIF        ;Z80DOS
  3881.  
  3882.     CALL    SIZEFL        ; Compute size of library in k
  3883.     XCHG
  3884.     CALL    DECPRT
  3885.     LXI    D,LFMSP3
  3886.     CALL    PUTS
  3887.     POP    H
  3888. ;
  3889. ; Saves the library file name into LBRFCB
  3890. ;
  3891.     LDA    FCB
  3892.     LXI    D,LBRFCB    ; To
  3893.     STAX    D
  3894.     INX    D
  3895.     MVI    B,11        ; Length
  3896.     CALL    MOVE        ; Do the move
  3897.     XCHG
  3898.     MVI    B,25
  3899.  
  3900. CLMFCB:    MVI    M,0
  3901.     INX    H
  3902.     DCR    B
  3903.     JNZ    CLMFCB
  3904.     CALL    SETLDMA
  3905.     LXI    D,LBRFCB    ; Point to file
  3906.     MVI    C,OPEN        ; Get function
  3907.     CALL    CPM        ; Open it
  3908.     MVI    C,READ
  3909.     LXI    D,LBRFCB
  3910.     CALL    CPM
  3911.     CALL    SETFOP
  3912.     LXI    H,LBBUF
  3913.     MOV    A,M
  3914.     ORA    A
  3915.     JZ    CKLDIR        ; Check directory present?
  3916.  
  3917.     LDA    ISARC
  3918.     ORA    A
  3919.     JNZ    BADLBR
  3920.     MOV    A,M
  3921.     CPI    ARCMAR
  3922.     JZ    CKADIR
  3923.  
  3924. BADLBR:    LXI    H,NLBRF
  3925.     LDA    ISARC
  3926.     ORA    A
  3927.     JNZ    NBARC
  3928.     LXI    H,NARCF
  3929.  
  3930. NBARC:    MVI    B,25
  3931.     CALL    PUTSB
  3932. ;
  3933. LMLEXI:    CALL    LBCLOS
  3934. ;
  3935. ; Do next library file
  3936. ;
  3937. LBRNEX:    LHLD    LCOUNT        ; Check count
  3938.     MOV    A,H
  3939.     ORA    L
  3940.     JZ    LBEXIT        ; No more, all done
  3941.     JMP    ENTRYL        ; Else, get next .LBR file
  3942. ;.....
  3943. ;
  3944. ; Close the library file
  3945. ;
  3946. LBCLOS:    LXI    D,LBRFCB
  3947.     MVI    C,CLOSE
  3948.     CALL    CPM
  3949.     RET
  3950. ;.....
  3951. ;
  3952. ; Set the Library file DMA address
  3953. ;
  3954. SETLDMA:CALL    CKVER        ; Set carry if pre-CP/M 2
  3955.     LDA    NEWUSR        ; Get user area for directory
  3956.     MOV    E,A
  3957.     MVI    C,STUSER    ; Get the user function
  3958.     CNC    CPM        ; And set new user number if CP/M 2
  3959.     LXI    D,LBBUF
  3960.     MVI    C,STDMA
  3961.     CALL    CPM
  3962.     RET
  3963. ;.....
  3964. ;
  3965. ; Check to see if there indeed is a LBR file directory
  3966. ;
  3967. CKLDIR:    MVI    B,11        ; Length of file name
  3968.     MVI    A,' '        ; Space
  3969.     INX    H
  3970.  
  3971. CKDLP:    CMP    M
  3972.     JNZ    BADLBR
  3973.     DCR    B
  3974.     INX    H
  3975.     JNZ    CKDLP
  3976. ;
  3977. ; The first entry in the LBR directory is indeed blank.  Now see if the
  3978. ; directory size is > 0
  3979. ;
  3980.     MOV    E,M        ; File starting location low
  3981.     INX    H        ; Must be zero here
  3982.     MOV    A,M        ; File starting location high
  3983.     ORA    E        ; Must be zero here also
  3984.     JNZ    BADLBR
  3985.     INX    H
  3986.     MOV    E,M        ; Get library size low
  3987.     INX    H        ; Point to library size high
  3988.     MOV    D,M        ; Get library size high
  3989.     MOV    A,D
  3990.     ORA    E        ; Library must have some size
  3991.     JZ    BADLBR
  3992.     DCX    D
  3993.     XCHG
  3994.     SHLD    SLFILE
  3995.     LHLD    LBTOTL
  3996.     INX    H
  3997.     SHLD    LBTOTL
  3998.  
  3999.      IF    Z80DOS
  4000.     LDA    ISARC
  4001.     ORA    A
  4002.     JZ    ZARC1
  4003.     LDA    NODFLG
  4004.     ORA    A
  4005.     JZ    ZARC1
  4006.     MVI    A,2
  4007.     JMP    ZARC1A
  4008. ZARC1:    MVI    A,4
  4009. ZARC1A:
  4010.      ENDIF        ;Z80DOS
  4011.  
  4012.      IF    NOT Z80DOS
  4013.     MVI    A,4
  4014.      ENDIF        ;NOT Z80DOS
  4015.  
  4016.     STA    LNCNT        ; Reset names per line counter
  4017.     MVI    B,3
  4018.     LXI    H,17
  4019.     DAD    D
  4020.     JMP    LMTEST
  4021.  
  4022. LFMLOP:    LHLD    SLFILE        ; Get next buffer if more
  4023.     MOV    A,L
  4024.     ORA    H
  4025.     JZ    LMLEXI
  4026.     DCX    H
  4027.     SHLD    SLFILE
  4028.     CALL    SETLDMA
  4029.     MVI    C,READ
  4030.     LXI    D,LBRFCB
  4031.     CALL    CPM
  4032.     CALL    SETFOP
  4033.     MVI    B,4        ; Get file count per record
  4034.     LXI    H,LBBUF        ; Get buffer starting address
  4035.  
  4036. LMTEST:    MOV    A,M        ; Get member open flag
  4037.     ORA    A        ; Test for open
  4038.     JZ    PRMNAM
  4039.  
  4040. LMTESA:    LDA    ISARC
  4041.     ORA    A
  4042.     RZ
  4043.     LXI    D,32        ; Member not open get offset
  4044.     DAD    D        ; To next and add it in
  4045.     DCR    B        ; Is buffer empty ?
  4046.     JNZ    LMTEST        ; No so test next entry
  4047.     JMP    LFMLOP        ; Yes, get next buffer
  4048. ;
  4049. PRMNAM:    PUSH    H        ; Print member name and size
  4050.     PUSH    B
  4051.     CALL    CKABRT        ; Keyboard abort?
  4052.     LXI    H,LNCNT
  4053.  
  4054.      IF    Z80DOS
  4055.     LDA    ISARC
  4056.     ORA    A
  4057.     JZ    ZARC2
  4058.     LDA    NODFLG
  4059.     ORA    A
  4060.     JZ    ZARC2
  4061.     MVI    A,2
  4062.     JMP    ZARC2A
  4063. ZARC2:    MVI    A,4
  4064. ZARC2A:
  4065.      ENDIF        ;Z80DOS
  4066.  
  4067.      IF    NOT Z80DOS
  4068.     MVI    A,4
  4069.      ENDIF        ;NOT Z80DOS
  4070.  
  4071.     CMP    M
  4072.     JNZ    PRMNA1
  4073.  
  4074.      IF    PRBRDR
  4075.     MVI    A,'*'        ; Load "A" with border character
  4076.     CALL    PUTCHR        ; Print it
  4077.     MVI    A,' '        ;
  4078.     CALL    PUTCHR        ; Space between border and text
  4079.      ENDIF            ; PRBRDR
  4080.  
  4081.     JMP    PRMNA2
  4082.  
  4083. PRMNA1:    CALL    SPACE
  4084.     MVI    A,':'
  4085.     CALL    PUTCHR
  4086.     CALL    SPACE
  4087.  
  4088. PRMNA2:    POP    B
  4089.     POP    H
  4090.     PUSH    H
  4091.     PUSH    B
  4092.     INX    H
  4093.     MVI    B,8        ; Filename length
  4094.     CALL    PUTSB
  4095.     MVI    A,'.'        ; Period after filename
  4096.     CALL    PUTCHR
  4097.     MVI    B,3        ; 3 characters of filetype
  4098.     CALL    PUTSB
  4099.     INX    H
  4100.     INX    H
  4101.  
  4102.      IF    Z80DOS
  4103.     PUSH    H        ; Save pointer
  4104.     LDA    ISARC
  4105.     ORA    A
  4106.     JZ    ZARC3
  4107.     LDA    NODFLG
  4108.     ORA    A
  4109.     JZ    ZARC3
  4110.     LXI    D,2
  4111.     DAD    D        ; Skip size field and point to CRC
  4112.                 ; DISDAT will point it to date field
  4113.     CALL    DISDAT        ; Show the date
  4114. ZARC3:    POP    H
  4115.      ENDIF    ;Z80DOS
  4116.  
  4117.     MOV    E,M
  4118.     INX    H
  4119.     MOV    D,M
  4120.     XCHG
  4121. ;
  4122. ; Output the size of the individual file
  4123. ;
  4124.     PUSH    D
  4125.     PUSH    H
  4126.     XCHG
  4127.     LHLD    LLENLOC
  4128.     XCHG
  4129.     DAD    D
  4130.     SHLD    LLENLOC
  4131.     POP    H
  4132. ;
  4133. ; New code added to convert lib members from records to 'k'.  Upon entry
  4134. ; member's size in records is in HL.
  4135. ;
  4136.     LDA    COPFLG        ; File sizes wanted in records?
  4137.     ORA    A
  4138.     JZ    PRMNA3        ; Jump if so
  4139.     LXI    D,7        ; Round up to nearest 1k
  4140.     DAD    D
  4141.     XCHG
  4142.     LXI    H,0
  4143.     MOV    A,E        ; Low byte of record count in A
  4144.     RRC
  4145.     RRC
  4146.     RRC
  4147.     ANI    1FH
  4148.     MOV    E,A        ; And put it back
  4149.     MOV    L,D        ; Get the high byte if any
  4150.     MVI    D,0        ; Clean out the old resting place
  4151.     DAD    H        ; Multiply it by 32 to convert to
  4152.     DAD    H        ; Number of k bytes
  4153.     DAD    H
  4154.     DAD    H
  4155.     DAD    H
  4156.     DAD    D        ; And add in the low byte
  4157.  
  4158. PRMNA3:    POP    D
  4159.     CALL    DECPRT        ; Go print it
  4160.     LDA    FSIZEC        ; Follow with 'k' or 'r'
  4161.     CALL    PUTCHR
  4162. ;
  4163. ; Update library member total and name counter
  4164. ;
  4165.     LHLD    LMTOTL
  4166.     INX    H
  4167.     SHLD    LMTOTL
  4168.     LDA    LNCNT
  4169.     DCR    A
  4170.     STA    LNCNT
  4171.     POP    B
  4172.     POP    H
  4173.     JNZ    LMTESA        ; And go output another file
  4174. ;
  4175. ; Current line full, start a new one
  4176. ;
  4177.      IF    Z80DOS
  4178.     LDA    ISARC
  4179.     ORA    A
  4180.     JZ    ZARC4
  4181.     LDA    NODFLG
  4182.     ORA    A
  4183.     JZ    ZARC4
  4184.     MVI    A,2
  4185.     JMP    ZARC4A
  4186. ZARC4:    MVI    A,4
  4187. ZARC4A:
  4188.      ENDIF        ;Z80DOS
  4189.  
  4190.      IF    NOT Z80DOS
  4191.     MVI    A,4
  4192.      ENDIF        ;NOT Z80DOS
  4193.  
  4194.     STA    LNCNT        ; Reset names per line counter
  4195.     CALL    CRLF        ; Space down to next line
  4196.     JMP    LMTESA
  4197. ;.....
  4198. ;
  4199. ; Move characters from "HL" to "DE" length in "B"
  4200. ;
  4201. MOVE:    MOV    A,M        ; Get a character
  4202.     STAX    D        ; Store it
  4203.     INX    H        ; To next "from"
  4204.     INX    D        ; To next "to"
  4205.     DCR    B        ; More?
  4206.     JNZ    MOVE        ; Yes, loop
  4207.     RET            ; No, return
  4208. ;.....
  4209. ;
  4210. ; Archive file subroutines
  4211. ;
  4212. CKADIR:    XRA    A
  4213.     DCR    A
  4214.     STA    GETABL        ; Say buffer is full (first read by lbr test)
  4215.     LHLD    LBTOTL        ; Bump library count total
  4216.     INX    H
  4217.     SHLD    LBTOTL
  4218.     MVI    A,4        ; LDA     MNPL
  4219.     STA    LNCNT        ; Reset names per line counter
  4220.  
  4221. ARCLP:    CALL    GET        ; Get the next character from buffer
  4222.     CPI    ARCMAR        ; Is it archive header marker?
  4223.     JNZ    BADLBR        ; And abort if not
  4224.     CALL    GET        ; Get header version
  4225.     ORA    A        ; If zero, that's logical end of file,
  4226.     JZ    LMLEXI        ; And we're done
  4227.     LXI    D,ANAME        ; Set to fill header buffer
  4228.     MVI    B,HDRSIZ    ; Setup normal header size less file name
  4229.     CPI    1        ; But test if version 1
  4230.     JNZ    GETHD1        ; Skip if not version 1
  4231.     LXI    B,HDRSIZ-4    ; Else, header is 4 bytes less
  4232.  
  4233. GETHD1:    CALL    GET        ; Get header byte
  4234.     STAX    D        ; Store in buffer
  4235.     INX    D
  4236.     DCR    B
  4237.     JNZ    GETHD1        ; Loop for all bytes
  4238.     LXI    H,ARCFIL    ; Prefill dummy arc FCB name with spaces
  4239.     MVI    B,11
  4240.  
  4241. FIXAN:    MVI    M,' '
  4242.     INX    H
  4243.     DCR    B
  4244.     JNZ    FIXAN
  4245.     MVI    B,5        ; Prefill rest of dummy FCB with zero
  4246.  
  4247. FIXAE:    MVI    M,0
  4248.     INX    H
  4249.     DCR    B
  4250.     JNZ    FIXAE
  4251.     LXI    H,ANAME        ; Get pointer to archive header buffer
  4252.     LXI    D,ARCFIL    ; Point to our dummy FCB
  4253.     MVI    B,8        ; Get name length
  4254.  
  4255. MANAME:    MOV    A,M        ; Get character from header
  4256.     INX    H
  4257.     ORA    A
  4258.     JZ    AEDONE        ; Nothing in buffer so we're done
  4259.     CPI    02EH        ; Is the char a point
  4260.     JZ    DAEXT        ; DO FILE EXTENT
  4261.     STAX    D
  4262.     INX    D
  4263.     DCR    B
  4264.     JNZ    MANAME
  4265.  
  4266. DAEXT:    LXI    D,ARCFIL+8    ; Get dummy file extent address
  4267.     MVI    B,3
  4268.     MOV    A,M
  4269.     CPI    2EH
  4270.     JNZ    AELOP
  4271.     INX    H
  4272.  
  4273. AELOP:    MOV    A,M        ; Fill in the file extent
  4274.     ORA    A
  4275.     JZ    AEDONE
  4276.     STAX    D
  4277.     INX    H
  4278.     INX    D
  4279.     DCR    B
  4280.     JNZ    AELOP
  4281.  
  4282. AEDONE:    LXI    H,ASIZE
  4283.     MOV    E,M        ; Fetch BCDE from (HL)
  4284.     INX    H
  4285.     MOV    D,M
  4286.     INX    H
  4287.     MOV    C,M
  4288.     XRA    A        ; Clear flags
  4289.     MOV    A,E        ; Convert file length count in bytes
  4290.     RAL            ; To length in records for output
  4291.     MOV    A,D
  4292.     RAL
  4293.     MOV    E,A
  4294.     MOV    A,C
  4295.     RAL
  4296.     MOV    D,A
  4297.     XCHG
  4298.     SHLD    ARCFIL+13    ; Save file length
  4299.     LXI    H,ARCFIL-1    ; Point to dummy FCB
  4300.     CALL    PRMNAM        ; List the file info
  4301.     LXI    H,ASIZE        ; Get remaining file size
  4302.     MOV    A,M
  4303.     ANI    7FH
  4304.     LHLD    ARCFIL+13    ; Save file length
  4305.     XCHG            ; Save record offset
  4306.     LXI    H,GETABL    ; Point to offset of last byte read
  4307.     ADD    M        ; Add byte offsets
  4308.     CPI    80H        ; Does it overflow current record?
  4309.     JC    NRAD
  4310.     SUI    80H        ; Adjust pointer
  4311.     INX    D        ; Bump record number
  4312.  
  4313. NRAD:    MOV    M,A        ; Update buffer pointer for new position
  4314.     MOV    A,D        ; Check record offset
  4315.     ORA    E
  4316.     JZ    LEXIT        ; Return if none (still in same record)
  4317.     PUSH    D        ; Save record offset
  4318.     LXI    D,LBRFCB
  4319.     MVI    C,RECORD    ; Compute current "random" record no.
  4320.     CALL    CPM        ; (I.e. next sequential record to read)
  4321.     LHLD    LBRFCB+FRN    ; Get result
  4322.     DCX    H        ; Adjust next record to current record
  4323.     POP    D        ; Restore record offset
  4324.     DAD    D        ; Compute new record no.
  4325.     JC    BADLBR        ; If >64k, it's past largest (8 Mb) file
  4326.     SHLD    LBRFCB+FRN    ; Save new record no.
  4327.     MVI    C,READRN    ; Read the random record
  4328.     CALL    GETREC
  4329.     ORA    A
  4330.     JNZ    BADLBR        ; File read error
  4331.     LXI    H,LBRFCB+FCR    ; Point to current record in extent
  4332.     INR    M        ; Bump for subsequent sequential read
  4333.  
  4334. LEXIT:    JMP    ARCLP        ; Loop for next file
  4335. ;.....
  4336. ;
  4337. ; Get next sequential byte from archive file
  4338. ;
  4339. GET:    PUSH    B        ; Save registers
  4340.     PUSH    D
  4341.     PUSH    H
  4342.     LDA    GETABL        ; Point to last byte read
  4343.     INR    A        ; At end of buffer?
  4344.     CPI    80H
  4345.     CNC    GETNXT        ; Yes, read next record and reset pointer
  4346.     STA    GETABL        ; Save new buffer pointer
  4347.     MOV    L,A
  4348.     MVI    H,0
  4349.     LXI    D,LBBUF
  4350.     DAD    D
  4351.     MOV    A,M        ; Fetch byte from there
  4352.     POP    H        ; Restore registers
  4353.     POP    D
  4354.     POP    B
  4355.     RET            ; Return
  4356. ;
  4357. ; Get next sequential record from archive file
  4358. ;
  4359. GETNXT:    MVI    C,READ        ; Setup read-sequential function code
  4360.     CALL    GETREC
  4361.     ORA    A
  4362.     JNZ    RDERR
  4363.     PUSH    PSW
  4364.     XRA    A
  4365.     DCR    A
  4366.     STA    GETABL
  4367.     POP    PSW
  4368.     RET
  4369. ;
  4370. RDERR:    POP    H        ; Strip GETNXT return
  4371.     POP    H        ; Clean up the get stack
  4372.     POP    D
  4373.     POP    B
  4374.     POP    H        ; Strip get calling address
  4375.     JMP    BADLBR        ; Show error
  4376. ;
  4377. ; Get record (sequential or random) from archive file
  4378. ;
  4379. GETREC:    PUSH    H
  4380.     PUSH    B
  4381.     CALL    SETLDMA        ; Set library DMA address
  4382.     LXI    D,LBRFCB    ; Setup FCB address
  4383.     POP    B        ; Restore read function
  4384.     CALL    CPM        ; Do it
  4385.     PUSH    PSW        ; Save read status
  4386.     CALL    SETFOP        ; Reset Print file DMA address
  4387.     POP    PSW        ; Restore read status
  4388.     POP    H        ; Restore buffer pointer
  4389.     RET
  4390. ;.....
  4391. ;
  4392. ; Test file extent for ARC/ARK
  4393. ;
  4394. CKARC:    PUSH    H
  4395.     PUSH    D
  4396.     PUSH    B
  4397.     XCHG
  4398.     LXI    H,ARCTYP
  4399.     MVI    C,2        ; Number for the loop to test
  4400. ;
  4401. CKARL:    LDAX    D
  4402.     ANI    7FH
  4403.     CMP    M
  4404.     JNZ    CKARX
  4405.     INX    H
  4406.     INX    D
  4407.     DCR    C
  4408.     JNZ    CKARL
  4409. ;
  4410. ; The first 2 match now see if C or K for .ARC or .ARK
  4411. ;
  4412.     LDAX    D
  4413.     ANI    7FH
  4414.     CPI    'C'        ; See if "C"
  4415.     JZ    CKARX
  4416.     CPI    'K'        ; See if "K"
  4417.  
  4418. CKARX:    POP    B
  4419.     POP    D
  4420.     POP    H
  4421.     RET
  4422. ;.....
  4423. ;
  4424. ; Test file extent for LBR
  4425. ;
  4426. CKLBR:    PUSH    H
  4427.     PUSH    D
  4428.     PUSH    B
  4429.     XCHG
  4430.     LXI    H,LBRTYP
  4431.     MVI    C,3
  4432.  
  4433. CKLBL:    LDAX    D
  4434.     ANI    7FH
  4435.     CMP    M
  4436.     JNZ    CKLBX
  4437.     INX    H
  4438.     INX    D
  4439.     DCR    C
  4440.     JNZ    CKLBL
  4441.  
  4442. CKLBX:    POP    B
  4443.     POP    D
  4444.     POP    H
  4445.     RET
  4446. ;
  4447. ; TIMEON routine
  4448. ;
  4449. ; Go through a search to see if BYE is active
  4450. ;
  4451.      IF    TIMEON
  4452. TIME:    LHLD    0001H        ; Point to warm boot again
  4453.     DCX    H        ; If BYE active,
  4454.     MOV    D,M        ; Pick up pointer to BYE variables
  4455.     DCX    H        ; (COVECT) followed by "BYE"
  4456.     MOV    E,M
  4457.     LXI    H,15        ; Calculate address of BYE variable
  4458.     DAD    D        ; Where ptr to orig BIOS vector stored
  4459.     MOV    E,M        ; Load that address into DE
  4460.     INX    H        ; If BIOS active, DE now points to
  4461.     MOV    D,M        ; Original BIOS console output vector
  4462.     INX    H        ; Point to BYE signon message
  4463.     MOV    A,M        ; Get letter
  4464.     ANI    05FH        ; Convert to upper case if needed
  4465.     CPI    'B'        ; Try to match "BYE"
  4466.     RNZ            ; Out if BYE not active
  4467.     INX    H
  4468.     MOV    A,M
  4469.     ANI    05FH        ; Convert to u-case if needed
  4470.     CPI    'Y'
  4471.     RNZ
  4472.     INX    H
  4473.     MOV    A,M
  4474.     ANI    05FH        ; Convert to u-case if needed
  4475.     CPI    'E'
  4476.     RNZ
  4477.  
  4478.     LXI    D,6        ; Bye running, point to RTCBUF
  4479.     DAD    D
  4480.     MOV    E,M        ; Get RTCBUF address
  4481.     INX    H        ; And copy
  4482.     MOV    D,M        ; In DE
  4483.     XCHG            ; Put in HL
  4484.     LXI    D,7        ; Offset to
  4485.     DAD    D        ; Time-on-system byte
  4486.     MOV    A,M        ; Load TOS byte
  4487.     LXI    H,TONMS1    ; Where to store in ASCII
  4488.     CALL    DEC8        ; Convert binary to ASCII
  4489.     LXI    D,TONMSG
  4490.     CALL    PUTS        ; Print the message
  4491.     RET            ; And return
  4492. ;.....
  4493. ;
  4494. ; DEC8 will convert an 8 bit binary number in A to 3 ASCII
  4495. ; bytes. HL points to the MSB location where the ASCII bytes
  4496. ; will be stored. Leading zeros are suppressed, store spaces
  4497. ; in your buffer before calling.
  4498. ;
  4499. DEC8:    PUSH    B
  4500.     PUSH    D
  4501.     MVI    E,0        ; Leading zero flag
  4502.     MVI    D,100
  4503.  
  4504. DEC81:    MVI    C,'0'-1
  4505.  
  4506. DEC82:    INR    C
  4507.     SUB    D        ; 100 or 10
  4508.     JNC    DEC82        ; Still +
  4509.     ADD    D        ; Now add it back
  4510.     MOV    B,A        ; Remainder
  4511.     MOV    A,C        ; Get 100/10
  4512.     CPI    '1'        ; Zero?
  4513.     JNC    DEC83        ; Yes
  4514.     MOV    A,E        ; Check flag
  4515.     ORA    A        ; Reset?
  4516.     MOV    A,C        ; Restore byte
  4517.     JZ    DEC84        ; Leading zeros are skipped
  4518.  
  4519. DEC83:    MOV    M,A        ; Store in buffer
  4520.     INX    H        ; Increment storage location
  4521.     MVI    E,0FFH        ; Set zero flag
  4522.  
  4523. DEC84:    MOV    A,D
  4524.     SUI    90        ; 100 to 10
  4525.     MOV    D,A
  4526.     MOV    A,B        ; Remainder
  4527.     JNC    DEC81        ; Do it again
  4528.     ADI    '0'        ; Make ASCII
  4529.     MOV    M,A        ; And store it
  4530.     POP    D
  4531.     POP    B
  4532.     RET
  4533.  
  4534. TONMSG:    DB    13,10,'Minutes on System: '
  4535. TONMS1:    DB    '    ',0
  4536.      ENDIF            ; TIMEON
  4537. ;
  4538. ;              end of TIMEON routine
  4539. ;-----------------------------------------------------------------------
  4540. ;               help routine
  4541. ;
  4542. ; Help menu if ? is typed, using a fancy ZCMD or ZCPR system
  4543. ;
  4544.      IF    WHEEL
  4545. HELPME:    LXI    D,OPTMSG    ; Point at message
  4546.     CALL    SHOW
  4547.  
  4548.      IF    ZCPR33
  4549.     PUSH    H
  4550.     LHLD    Z3WHLL        ; Point to enviorment
  4551.     MOV    A,M        ; Get it
  4552.     POP    H
  4553.      ENDIF        ;ZCPR33
  4554.  
  4555.      IF    NOT ZCPR33
  4556.     LDA    WHLOC        ; Get wheel byte
  4557.      ENDIF        ;NOT ZCPR33
  4558.  
  4559.     ORA    A        ; If set, help out poor SYSOP
  4560.     JZ    EXIT3        ; No - exit
  4561.     LXI    D,SYSOP1    ; Point at message
  4562.     CALL    SHOW
  4563.     JMP    EXIT3        ; And exit
  4564. ;
  4565. ; This menu of options will appear to normal users (WHEEL not set).
  4566. ; Modify the menus to accommodate your system requirements.
  4567. ;
  4568. OPTMSG:    DB    13,10,13,10
  4569.     DB    '  Available Options (start with a  $  or  /  or'
  4570.     DB    '  [ character):',13,10,13,10
  4571.     DB    '  A - all user areas               N - no page pause'
  4572.     DB    ' [more]',13,10
  4573.     DB    '  C - file sizes in records        Q - show non-$ARCHived'
  4574.     DB    ' files',13,10
  4575.     DB    '  D - all drives                   T - order files'
  4576.     DB    ' by EXT type',13,10
  4577.     DB    '  H - Current area to highest      V - show version'
  4578.     DB    ' number',13,10
  4579.     DB    '  L - list LBR/ARC/ARK members     X - aux. format'
  4580.     DB    ' (horiz/vert)'
  4581.  
  4582.      IF    Z80DOS
  4583.     DB    13,10
  4584.     DB    '  Z - Do not show dates',13,10
  4585.     DB    '  = - Exact date match             + - GE date match',13,10
  4586.     DB    '  - - LT date match                ! - Use creation date for'
  4587.     DB    ' match',13,10
  4588.     DB    '  % - Use alteration date match    @ - Use access date for'
  4589.     DB    ' match',13,10
  4590.     DB    '   A date input with no =+-!%@ will use =% default,'
  4591.     DB    ' * as date is current date'
  4592.      ENDIF        ;Z80DOS
  4593.  
  4594.     DB    13,10,13,10
  4595.  
  4596.      IF    Z80DOS
  4597.     DB    ' Example - to list all drives/users, no pauses,'
  4598.     DB    ' GE date match on access date:',13,10,13,10
  4599.     DB    '                     B0>SD $AND+@ 7/1/88'
  4600.      ENDIF        ;Z80DOS
  4601.  
  4602.      IF    NOT Z80DOS
  4603.     DB    '  Example - to list all drives and user areas,'
  4604.     DB    ' no pauses:',13,10,13,10
  4605.     DB    '                     B0>SD $AND <ret>'
  4606.      ENDIF        ;NOT Z80DOS
  4607.     DB    13,10,13,10,0
  4608. ;
  4609. ; This menu of options appears only when the WHEEL is set.
  4610. ;
  4611. SYSOP1:    DB    '  * * * Special SYSOP Options (WHEEL SET) * * *'
  4612.  
  4613.      IF    NOT FATTRIB
  4614.     DB    13,10,13,10
  4615.      ENDIF        ;NOT FATTRIB
  4616.  
  4617.      IF    FATTRIB
  4618.     DB    13,10
  4619.      ENDIF        ;FATTRIB
  4620.  
  4621.     DB    '  F - file output (DISK.DIR)       R - reset disk'
  4622.     DB    ' system',13,10
  4623.     DB    '  O - show $SYS files only         S - include'
  4624.     DB    ' $SYS files',13,10
  4625.     DB    '  P - printer output',13,10
  4626.  
  4627.      IF    FATTRIB
  4628.     DB    '  1 - Check attrib 1               2 - Check attrib 2',13,10
  4629.     DB    '  3 - Check attrib 3               4 - Check attrib 4',13,10
  4630.      ENDIF        ;FATTRIB
  4631.  
  4632.     DB    0
  4633.      ENDIF            ; WHEEL
  4634. ;
  4635. ; Help menu if ? is typed, NOT using any fancy ZCMD or ZCPR system
  4636. ;
  4637.      IF    NOT WHEEL
  4638. HELPME:    LXI    D,OPTMSG    ; Point at message
  4639.     CALL    SHOW
  4640.     JMP    EXIT3        ; And exit
  4641. ;
  4642. OPTMSG:    DB    13,10,13,10
  4643.     DB    '  Available Options (start with a  $  or  /  or'
  4644.     DB    '  [  character):',13,10
  4645.     DB    13,10
  4646.     DB    '  A - all user areas               P - printer output'
  4647.     DB    13,10
  4648.     DB    '  C - file sizes in records        Q - show non $ARChived'
  4649.     DB    ' files',13,10
  4650.     DB    '  D - all drives                   R - reset disk system'
  4651.     DB    13,10
  4652.     DB    '  F - file output (DISK.DIR)       S - include $SYS'
  4653.     DB    ' files',13,10
  4654.     DB    '  H - Current area to highest      T - order files'
  4655.     DB    ' by EXT type',13,10
  4656.     DB    '  L - list LBR/ARC/ARK members     V - show version'
  4657.     DB    ' number',13,10
  4658.     DB    '  N - no page pause [more]         X - aux. format'
  4659.     DB    ' (horiz/vert)',13,10
  4660.     DB    '  O - show $SYS files only'
  4661.  
  4662.      IF Z80DOS
  4663.     DB    '         Z - do not show dates'
  4664.      ENDIF            ; Z80DOS
  4665.     DB    13,10
  4666.  
  4667.      IF    FATTRIB
  4668.     DB    '  1 - Check attrib 1               2 - Check attrib 2',13,10
  4669.     DB    '  3 - Check attrib 3               4 - Check attrib 4',13,10
  4670.      ENDIF        ;FATTRIB
  4671.  
  4672.      IF    Z80DOS
  4673.     DB    '  = - Exact date match             + - GE date match',13,10
  4674.     DB    '  - - LT date match                ! - Use creation date for'
  4675.     DB    ' match',13,10
  4676.     DB    '  % - Use alteration date match    @ - Use access date for'
  4677.     DB    ' match',13,10
  4678.     DB    '   A date input with no =+-!%@ will use =% default,'
  4679.     DB    ' * as date is current date'
  4680.     DB    13,10,13,10
  4681.     DB    ' Example - to list all drives/users, no pauses,'
  4682.     DB    ' GE date match on access date:',13,10,13,10
  4683.     DB    '                     B0>SD $AND+@ 7/1/88',13,10,13,10,0
  4684.      ENDIF        ;Z80DOS
  4685.  
  4686.      IF    NOT Z80DOS
  4687.     DB    13,10,'  Example - to list all drives and user areas,'
  4688.     DB    ' no pauses:',13,10,13,10
  4689.     DB    '                     B0>SD $AND <ret>'
  4690.     DB    13,10,13,10,13,10,13,10,13,10,13,10,13,10
  4691.     DB    0
  4692.      ENDIF        ;NOT Z80ODS
  4693.  
  4694.      ENDIF            ; NOT WHEEL
  4695.  
  4696.  
  4697.      IF    Z80DOS
  4698. DISDAT:    PUSH    B
  4699.     PUSH    H        ; Save pointer to size field
  4700.     PUSH    D
  4701.     INX    H        ; and skip over size
  4702.     INX    H        ;
  4703.     MOV    E,M        ; Get JD in DE
  4704.     INX    H        ;
  4705.     MOV    D,M        ;
  4706.     XCHG            ; to HL
  4707.     CALL    DATEHL        ;
  4708.     PUSH    H        ; Month and Year in L,H
  4709.     PUSH    PSW        ; Day in A
  4710.     CALL    SPACE
  4711.     CALL    SPACE
  4712.     POP    PSW
  4713.     JNZ    DAYOK        ; NZ = was a day there
  4714.     POP    H
  4715.     CALL    NODATE
  4716.     JMP    DNOTOK
  4717. DAYOK:    PUSH    PSW
  4718.     MOV    A,L        ; Month out
  4719.     CALL    BCDOUT
  4720.     MVI    A,'/'
  4721.     CALL    PUTCHR
  4722.     POP    PSW
  4723.     CALL    BCDOUT        ; Day out
  4724.     MVI    A,'/'
  4725.     CALL    PUTCHR
  4726.     POP    H
  4727.     MOV    A,H        ; Year out
  4728.     CALL    BCDOUT
  4729. DNOTOK:    CALL    SPACE
  4730.     CALL    SPACE
  4731.     POP    D
  4732.     POP    H
  4733.     POP    B
  4734.     RET
  4735.  
  4736. NODATE:
  4737.     LXI    D,NODATM
  4738.     CALL    PUTS
  4739.     RET
  4740. NODATM:
  4741.     DB    '-- -- --',0
  4742.  
  4743. BCDOUT:
  4744.     PUSH    B        ; Save
  4745.     MOV    B,A        ; A holds BCD digits
  4746.     RAR
  4747.     RAR
  4748.     RAR
  4749.     RAR
  4750.     CALL    BCDOT1        ; Output high order
  4751.     MOV    A,B
  4752.     CALL    BCDOT1        ; And low order
  4753.     POP    B
  4754.     RET
  4755. BCDOT1:    ANI    0FH
  4756.     ADI    '0'
  4757.     CALL    PUTCHR
  4758.     RET
  4759.  
  4760.  
  4761. ;
  4762. ; DATEHL converts the value in HL to BCD year, month, day
  4763. ;     for use with Z80DOS time stamps.
  4764. ;
  4765. ;
  4766. ; Inputs:    HL contains hex days since December 31, 1977
  4767. ;
  4768. ; Outputs:    H contains BCD 20th century year
  4769. ;        L contains BCD month
  4770. ;        A contains BCD day
  4771. ;
  4772. ;        Zero flag set (Z) and A=0 if invalid date (zero) detected,
  4773. ;        Zero flag reset (NZ) and A=0ffh otherwise.
  4774.  
  4775. ; Converted to 8080 from DATEHL by Carson Wilson who Adapted from B5C-CPM3.INS
  4776.  
  4777. DateHL:
  4778.     MOV    A,H
  4779.     ORA    L        ; Test blank date (zero)
  4780.     RZ            ; Return Z and A=0 if so
  4781.     SHLD    DAYS        ; Save initial value
  4782.     MVI    B,78        ; Set years counter
  4783. loop:
  4784.     call    ckleap
  4785.     LXI    D,-365        ; Set up for subtract
  4786.     JNZ    NOLPY        ; Skip if no leap year
  4787.     DCX    D        ; Set for leap year
  4788. nolpy:
  4789.     DAD    D        ; Subtract
  4790.     JNC    YDONE        ; Continue if years done
  4791.     MOV    A,H
  4792.     ORA    L
  4793.     JZ    YDONE
  4794.     SHLD    DAYS        ; Else save days count
  4795.     INR    B        ; Increment years count
  4796.     JMP    LOOP        ; And do again
  4797. ;
  4798. ; The years are now finished, the years count is in 'B' (HL is invalid)
  4799. ;
  4800. ydone:
  4801.     MOV    A,B
  4802.     call    binbcd
  4803.     STA    YEARS        ; save BCD year
  4804. ;
  4805.     call    ckleap        ; Check if leap year
  4806.     MVI    A,-28
  4807.     JNZ    FEBNO        ; February not 29 days
  4808.     MVI    A,-29        ; Leap year
  4809. febno:
  4810.     STA    FEB        ; Set february
  4811.     LHLD    DAYS        ; Get days count
  4812.     LXI    D,MTABLE    ; Point to months table
  4813.     MVI    B,0FFH        ; Set up 'B' for subtract
  4814.     MVI    A,0        ; Set a for # of months
  4815. mloop:
  4816.     PUSH    PSW
  4817.     LDAX    D        ; Get month
  4818.     MOV    C,A        ; Put in 'C' for subtract
  4819.     POP    PSW
  4820.     SHLD    DAYS        ; save days count
  4821.     DAD    B        ; Subtract
  4822.     INX    D        ; Increment months counter
  4823.     INR    A
  4824.     JC    MLOOP        ; Loop for next month
  4825.  
  4826. ;
  4827. ; The months are finished, days count is on stack.  First, calculate
  4828. ; month.
  4829. ;
  4830. mdone:
  4831.     MOV    B,A        ; Save months
  4832.     LHLD    DAYS
  4833.     MOV    A,H
  4834.     ORA    L
  4835.     JNZ    NZD
  4836.     DCX    D
  4837.     DCX    D
  4838.     LDAX    D
  4839.     CMA
  4840.     INR    A
  4841.     MOV    L,A
  4842.     DCR    B
  4843. nzd:
  4844.     MOV    A,L        ; Retrieve binary day of month
  4845.     call    binbcd        ; Convert to BCD
  4846.     PUSH    PSW        ; Save day in A
  4847. ;
  4848.     MOV    A,B        ; Retrieve the binary month
  4849.     call    binbcd        ; Convert binary month to BCD
  4850.     MOV    L,A        ; Return month in L
  4851. ;
  4852.     LDA    YEARS
  4853.     MOV    H,A        ; Return year in H
  4854. ;
  4855.     POP    PSW        ; Restore day
  4856.     ORA    A        ; Set NZ flag
  4857.     ret
  4858.  
  4859. ;
  4860. ; Support Routines:
  4861. ;
  4862.  
  4863. ;
  4864. ; Check for leap years.
  4865. ;
  4866. ckleap:
  4867.     MOV    A,B
  4868.     ANI    0FCH
  4869.     CMP    B
  4870.     ret
  4871. ;
  4872. ; Convert A to BCD & store back in A
  4873. ;
  4874. BinBCD:
  4875.     ORA    A
  4876.     RZ
  4877.     PUSH    B
  4878.     MOV    B,A
  4879.     XRA    A
  4880. BinBCD1:
  4881.     ADI    1
  4882.     daa
  4883.     DCR    B
  4884.     JNZ    BINBCD1
  4885.     POP    B
  4886.     ret
  4887. ;
  4888. ; Buffers:
  4889. ;
  4890.  
  4891. ;
  4892. ; Months table
  4893. ;
  4894. mtable:
  4895.     db    -31        ;January
  4896. feb:
  4897.     db    -28        ;February
  4898.     db    -31,-30,-31,-30    ;Mar-Jun
  4899.     db    -31,-31,-30    ;Jul-Sep
  4900.     db    -31,-30,-31    ;Oct-Dec
  4901.  
  4902.      ENDIF    ;Z80DOS
  4903.  
  4904.  
  4905.  
  4906. ;
  4907. ; Messages and Error statements
  4908. ;
  4909. CKMS1:    DB    13,10,'++ ABORTED ++',0
  4910. CKMS2:    DB    8,' ',8,0
  4911. DRUMSG:    DB    'Drive/User',0
  4912. EOSMSG:    DB    '[more] ','$'
  4913.  
  4914.      IF    VSPAGE
  4915. MORERA:    DB    13,'                  ----------------------------------------'
  4916.     DB    13,10,'$'
  4917.      ENDIF            ;VSPAGE
  4918.  
  4919.      IF    NOT VSPAGE
  4920. MORERA:    DB    13,'        ',13,'$'
  4921.      ENDIF
  4922.  
  4923. ERRMS1:    DB    ' '
  4924. ERRMS2:    DB    'Error',0
  4925. ERRTAG:    DB    ' ->',0
  4926. NOFLM:    DB    '>> No detectable file(s) on ',0
  4927. NOFMS1:    DB    13,10,13,10,' ',0
  4928. NOFMS2:    DB    '  ',0
  4929. NOFMS3:    DB    ':  ',0
  4930. SOHFLG:    DB    0
  4931. TOTMS1:    DB    13,10,'         Drive ',0
  4932. TOTMS4:    DB    '/',0
  4933. TOTMS5:    DB    'k  ',0
  4934. TOTMS6:    DB    ' Files: ',0
  4935. TOTMS7:    DB    ' Free: ',0
  4936. TOTMS8:    DB    'k ',0
  4937. ALLTOT:    DB    13,10,'             Total files: ',0
  4938. ALLTO1:    DB    'k',13,10,0
  4939.  
  4940.      IF    PRBRDR
  4941. CONTM1:    DB    13,10,'** There are ',0
  4942. MFILES:    DB    ' member files in ',0
  4943. LIBR:    DB    ' library(s) and/or archive(s) **',0
  4944. AFMSP1:    DB    13,10,'** Archive directory for ',0
  4945. LFMSP1:    DB    13,10,'** Library directory for ',0
  4946. LFMSP3:    DB    'k'
  4947.     DB    ' **'
  4948.     DB    13,10,0
  4949.      ENDIF            ; PRBRDR
  4950.  
  4951.      IF    NOT PRBRDR
  4952. CONTM1:    DB    13,10,'There are ',0
  4953. MFILES:    DB    ' member files in ',0
  4954. LIBR:    DB    ' library(s) and/or archive(s)',0
  4955. AFMSP1:    DB    13,10,'Archive directory for ',0
  4956. LFMSP1:    DB    13,10,'Library directory for ',0
  4957. LFMSP3:    DB    'k'
  4958.     DB    13,10,0
  4959.      ENDIF            ; Not PRBRDR
  4960.  
  4961. NLBRF:    DB    '++ Not a library file ++',13,10
  4962. NARCF:    DB    '++ Not an archive file ++',13,10
  4963. LBRTYP:    DB    'LBR'
  4964. ARCTYP:    DB    'AR'        ; We only test the first 2 in the loop.
  4965.                 ; The C or K are tested separately.
  4966. ;
  4967. ; Permanently initialized data area
  4968. ;
  4969. VECTBL:    DW    DSKERR        ; BDOS record error intercept vector
  4970.     DW    DSKERR        ; BDOS select error intercept vector
  4971. ;
  4972. ; End of code that must be stored on disk in the .COM file
  4973. ;
  4974. ; Data area reinitialized by code when SD is run or rerun
  4975. ;
  4976. DATA0    EQU    $        ; Start of area to initialize
  4977.  
  4978. OTBL    EQU    $        ; Mark start of option table
  4979. VFLAG:    DS    1
  4980. AOPFLG:    DS    1
  4981. COPFLG:    DS    1
  4982. DOPFLG:    DS    1
  4983. FOPFLG:    DS    1
  4984. HOPFLG:    DS    1
  4985. LOPFLG:    DS    1
  4986. NOPFLG:    DS    1
  4987. OOPFLG:    DS    1
  4988. POPFLG:    DS    1
  4989. QOPFLG:    DS    1
  4990. ROPFLG:    DS    1
  4991. SOPFLG:    DS    1
  4992. TOPFLG:    DS    1
  4993. VOPFLG:    DS    1
  4994. XOPFLG:    DS    1
  4995.  
  4996.      IF    Z80DOS        ;
  4997. DEOPFL:    DS    1
  4998. DPOPFL:    DS    1
  4999. DMOPFL:    DS    1
  5000. DNOPFL: DS    1
  5001. DAOPFL: DS    1
  5002. DGOPFL:    DS    1
  5003. NODFLG:    DS    1
  5004.      ENDIF    ;Z80DOS
  5005.  
  5006.      IF    FATTRIB
  5007. ONEFLG:    DS    1
  5008. TWOFLG:    DS    1
  5009. THRFLG:    DS    1
  5010. FORFLG:    DS    1
  5011.      ENDIF
  5012.  
  5013. OEND    EQU    $        ; End of option table
  5014. ;
  5015. ; End of option lookup table
  5016. ;
  5017. BUFPNT:    DS    2        ; Next location in output buffer
  5018. BUFCNT:    DS    1        ; Number of bytes left in output buffer
  5019. OUTFCB:    DS    1+8+3        ; User number, filename, and filetype
  5020. ;
  5021. ; Beginning of area reinitialized to zero each time SD.COM is run
  5022. ;
  5023.     DS    21        ; Rest of DISK.DIR FCB
  5024. DISKNO:    DS    1        ; Disk number
  5025. USERNO:    DS    1        ; User number
  5026. OPNFLG:    DS    1        ; File open flag
  5027. DRVFLG:    DS    1        ; D option check for prior drive specificaton
  5028. FNDFLG:    DS    1        ; Files Matched Flag
  5029. BYEACT:    DS    1        ; BYE Active Flag
  5030.  
  5031. LINCNT:    DS    1        ; # lines printed on screen
  5032. LLENLOC:DS    2        ; Running total of .LBR length
  5033. LMTOTL:    DS    2
  5034. LBTOTL:    DS    2
  5035. LNCNT:    DS    1
  5036. LCOUNT:    DS    2
  5037. NEXTL:    DS    2
  5038. SLFILE:    DS    2
  5039. LINES:    DS    1        ; Number of lines to be printed
  5040. FIRSTT:    DS    1        ; First time flag for version number
  5041. ISARC:    DS    1
  5042. ;
  5043. ; Uninitialized data area
  5044. ;
  5045. BASUSR:    DS    1        ; Copy of original directory user #
  5046. BLKMAX:    DS    2        ; Highest block # on drive
  5047. BLKMSK:    DS    1        ; Records/block - 1
  5048. BLKSHF:    DS    1        ; Number shifts to mult by sec/blk
  5049. COUNT:    DS    2        ; Entry count
  5050. DIRMAX:    DS    2        ; Highest file # in directory
  5051. FILERC:    DS    2        ; File size in records
  5052. FREEBY:    DS    2        ; Number of k left on dir. drive
  5053. FSIZEC:    DS    1        ; File size character ('k' or 'r')
  5054. GAP:    DS    2        ; Sort routine storage
  5055. I:    DS    2        ; Sort routine storage
  5056. J:    DS    2        ; Sort routine storage
  5057. JG:    DS    2        ; Sort routine storage
  5058. LZFLG:    DS    1        ; 0 when printing leading zeros
  5059. MAXUSR:    DS    1        ; Max user # for drive
  5060. NEWUSR:    DS    1        ; User # selected by "$U" option
  5061. NEXTT:    DS    2        ; Next table entry
  5062. OLDDSK:    DS    1        ; Currently logged-in drive
  5063. OLDUSR:    DS    1        ; User number upon invocation
  5064. SCOUNT:    DS    2        ; # to sort
  5065. SUPSPC:    DS    1        ; Leading space flag
  5066. TBLOC:    DS    2        ; Start of name table
  5067. TOTFIL:    DS    2        ; Total number of files
  5068. TOTSIZ:    DS    2        ; Total size of all files
  5069. TOTFL1:    DS    2        ; Total files of all D/U
  5070. TOTSZ1:    DS    2        ; Total size of all D/U
  5071. TOTFRE:    DS    2
  5072. USRNR:    DS    1        ; User number
  5073. VERFLG:    DS    1        ; CP/M version number (0=pre-CP/M 2)
  5074. ZRDFLG:    DS    1        ; ZRDOS version number
  5075.  
  5076.     IF    Z80DOS        ;
  5077. DATCHK:    DS    2        ; Holds date to look for
  5078. DTMTCH:    DS    1        ; Holds <,>=,>
  5079. DATMOD:    DS    2        ; Holds date found for file
  5080. DAYS:    ds    2        ; temporary buffers
  5081. YEARS:    ds    1        ;
  5082. YEARS1:    DS    1
  5083. MONTHS:    DS    1
  5084. DAYS1:    DS    1
  5085. ASCII:    DS    5        ; holds date from system
  5086.     ENDIF        ;Z80DOS
  5087.  
  5088.  
  5089. DATA1    EQU    $        ; End of area to initialize
  5090.  
  5091.      IF    ZCPR33
  5092. Z3DRVL:    DS    2        ; Points to Z33 max drv location
  5093. Z3USRL:    DS    2        ; Points to Z33 max user location
  5094. Z3WHLL:    DS    2        ; Points to Z33 wheel location
  5095.      ENDIF        ;ZCPR33
  5096.  
  5097.      IF    NDIRS
  5098. NAMADR:    DS    2        ; Named Directory Buffer Address
  5099. NUMDIR:    DS    1        ; Number of entries
  5100. CURDIR:    DS    1        ; NDR Check counter
  5101.      ENDIF            ; NDIRS
  5102.  
  5103.      IF    SHOPUB
  5104. PUBDRV:    DS    1        ; Storage for Public Drive byte
  5105. PUBUSR:    DS    1        ; "    "    "      User     "
  5106.      ENDIF            ; SHOPUB
  5107.  
  5108. GETABL:    DS    1
  5109. LBRFCB:    DS    36
  5110. LBBUF:    DS    128
  5111.  
  5112. ANAME:    DS    13
  5113. ASIZE:    DS    14
  5114. ARCFIL:    DS    16
  5115.  
  5116. NEWPTR:    DS    2        ; Start of second table
  5117. XPOINT:    DS    2
  5118. JUMPER:    DS    2        ; Increment for second table to
  5119. WASHERE:
  5120.     DS    1
  5121. VSFRST:    DS    1
  5122. OUTBUF:    DS    128        ; Output file buffer
  5123. ;
  5124. ; BDOS equates
  5125. ;
  5126. BDOS    EQU    0005H        ; Entry Point for BDOS calls
  5127. FCB    EQU    005CH        ; Default FCB Address
  5128. TBUF    EQU    0080H        ; Default DMA Address
  5129.  
  5130. RDCON    EQU    1        ; Console input
  5131. WRCON    EQU    2        ; Console output
  5132. LIST    EQU    5        ; List output
  5133. PRINT    EQU    9        ; Print string
  5134. CONST    EQU    11        ; Get console status
  5135. CPMVER    EQU    12        ; Return CP/M version
  5136. RESET    EQU    13        ; Reset disk system
  5137. SELDSK    EQU    14        ; Select disk
  5138. OPEN    EQU    15        ; Open file
  5139. CLOSE    EQU    16        ; Close file
  5140. SRCHF    EQU    17        ; Search for first
  5141. SRCHN    EQU    18        ; Search for next
  5142. READ    EQU    20        ; Read sequential
  5143. WRITE    EQU    21        ; Write sequential
  5144. MAKE    EQU    22        ; Make file
  5145. CURDSK    EQU    25        ; Return current disk
  5146. STDMA    EQU    26        ; Set DMA Address
  5147. DSKALL    EQU    27        ; Get address of allocation vector
  5148. DSKPAR    EQU    31        ; Get address of disk parameters
  5149. STUSER    EQU    32        ; Set/get user number
  5150.  
  5151.      IF    ZRDOS
  5152. ZRDVER    EQU    48        ; Return version (ZRDOS)
  5153. SETWBT    EQU    50        ; Set warm boot trap (ZRDOS)
  5154. RESWBT    EQU    52        ; Reset warm boot trap (ZRDOS)
  5155.      ENDIF            ; ZRDOS
  5156.  
  5157.     DS    60        ; Stack area
  5158. STACK:    DS    2        ; Old stack pointer
  5159.  
  5160. ORDER    EQU    $        ; Order table starts here
  5161.  
  5162.     END
  5163.