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