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 / ZCPR33 / S-Z / SPP10.LBR / SPP10.AZM / SPP10.ASM
Assembly Source File  |  2000-06-30  |  77KB  |  3,503 lines
  1. ;                 SUPER PURGE PROGRAM
  2. ;                   SPP
  3. ;                 2 AUG 88
  4. ;
  5. ;                Gene Nolan
  6. ;
  7. ;
  8. ;        This program is being distributed ready
  9. ;        to use on a CP/M v2.2 computer with two
  10. ;        disk drives , no Z80DOS, and no ZCPR/ZCMD in use.
  11. ;
  12. ; SPP gives you the full power of SD/SDZD in specifying files to be erased.
  13. ; With one command you can erase EVERY FILE ON EVERY DRIVE/USER, so be
  14. ; carefull. If you are running Z80DOS, you can also use dates to specify
  15. ; which files to be considered for erasure.
  16. ;
  17. ;  NOTE: If WHEEL is TRUE and not set, this program WILL NOT EXECUTE,
  18. ;     but merely display 'SPP ?' and return to CPM.
  19. ;
  20. ; Current versions of SPP automatically adjust for any block size and di-
  21. ; rectory length under CP/M 2.2,  3.0 or MP/M.    They can also handle any
  22. ; number of disk drives or skip those not available.  Current features:
  23. ;
  24. ;     1) Searching individual or multiple drives and/or user areas
  25. ;     2) Unconditional or optional disk system reset before execution
  26. ;        begins
  27. ;     3) Summary line output giving drive and user information, num-
  28. ;        ber of files erased, how much space they consumed and free
  29. ;        space remaining on the disk(s)
  30. ;     4) Selecting or suppressing "system" and R/O files
  31. ;     5) Accepting ambiguous filenames with or without a drive name
  32. ;     6) Optional help menu with '?' or '//' if ZCPR33 option TRUE
  33. ;     7) Summary line output optionally contains name of ZCPR3 named
  34. ;        directory, if selected
  35. ;     8) ZCPR3 named directory may be used in command line instead
  36. ;        of DU: if selected
  37. ;     9) Choose files based upon attributes 1-4
  38. ;    10) Z33 ENViorment support of wheel, maxdrv, maxusr location
  39. ;    11) Summary totals supplied as to number of files/total k erased
  40. ;
  41. ;-----------------------------------------------------------------------
  42. ;
  43. ;    ASEG            ; Needed for M80 and RMAC, ignore error
  44. ;
  45.     ORG    0100H
  46. ;
  47.     JMP    START
  48. ;
  49. NO    EQU    0
  50. YES    EQU    NOT NO        ; (Some assemblers don't like 0FFh)
  51. ;
  52. ; Define version number
  53. ;
  54. MAIN    EQU    1        ; Main block number
  55. VER    EQU    00        ; Current version
  56. MONTH    EQU    08        ; Month
  57. DAY    EQU    02        ; Day
  58. YEAR    EQU    88        ; Year
  59. ;
  60. ;-----------------------------------------------------------------------
  61. ;                 options
  62. ;
  63. MAXDRV    EQU    NO        ; *Yes if MAXD byte is supported
  64. MAXUR    EQU    NO        ; *Yes if MAXU byte is supported
  65. WHEEL    EQU    NO        ; *Yes if using ZCPR wheel byte
  66.  
  67. ; If using equate ZCPR33 set to YES, then the following 3 will be
  68. ; taken from the ENV descriptor automaticaly if the corresponding
  69. ; MAXDRV, MAXUR, or WHEEL equate is set YES
  70. MXDRV    EQU    3DH        ; *Set to max drive address if MAXDRV=Yes
  71. MXUSR    EQU    3FH        ; *Set to max user  address if MAXUR=Yes
  72. WHLOC    EQU    3EH        ; *Set to wheel location if WHEEL=Yes
  73.  
  74. MXZUSR    EQU    15        ; Maximum user # allowed with WHEEL set
  75.  
  76. EDATE    EQU    NO        ; No, use USA date format for version mess.
  77.  
  78. PRBRDR    EQU    NO        ; Yes = print quasi-borders for libraries
  79. WMBOOT    EQU    NO        ; If warmboot is needed on exit
  80.  
  81.     DB    'Z3ENV'        ; For ZCPR3 Environment ID
  82.     DB    1        ; Class 1, External
  83. Z3ENV:    DW    0        ; Environment Address.    If using ZCPR33
  84.                 ; This can be left as is.
  85. ;-------------------------------
  86. ;
  87. ; Drive/User area lookup table:
  88. ; ----------------------------
  89. ; Change the following table as appropriate for your version of CP/M.
  90. ; You can limit the maximum user area without wheel byte independently
  91. ; for any drive available.  Use 0FFh for drives that are not available.
  92. ;
  93. ;        CP/M  v2.2 has 16 user areas, 0-15
  94. ;        CP/M  v3.0 has 32 user areas, 0-31
  95. ;
  96. ; NOTE: Use your editor to move the "HIDRV" line below the correct
  97. ; number of drives for your system.  This not only saves time when the
  98. ; highest drive has been reached, but will display a drive/user error
  99. ; message which otherwise will not be shown.
  100. ;
  101. LODRV    EQU    $        ; Mark beginning of drive/user table
  102.  
  103.     DB    15        ; Maximum user area for drive A
  104.     DB    15        ; "      "    "    "    "     B
  105. HIDRV    EQU    $        ; Mark end of drive/user table
  106.     DB    0FFH        ; "      "    "    "    "     C
  107.     DB    0FFH        ; "      "    "    "    "     D
  108.     DB    0FFH        ; "      "    "    "    "     E
  109.     DB    0FFH        ; "      "    "    "    "     F
  110.     DB    0FFH        ; "      "    "    "    "     G
  111.     DB    0FFH        ; "      "    "    "    "     H
  112.     DB    0FFH        ; "      "    "    "    "     I
  113.     DB    0FFH        ; "      "    "    "    "     J
  114.     DB    0FFH        ; "      "    "    "    "     K
  115.     DB    0FFH        ; "      "    "    "    "     L
  116.     DB    0FFH        ; "      "    "    "    "     M
  117.     DB    0FFH        ; "      "    "    "    "     N
  118.     DB    0FFH        ; "      "    "    "    "     O
  119.     DB    0FFH        ; "      "    "    "    "     P
  120. ;
  121. ;
  122. ;-------------------------------
  123. ;
  124. ; Showing tagged attributes
  125. ; -------------------------
  126. ; Displaying files with tagged attributes ($R/O, $SYS, $ARC etc.) in an
  127. ; in an unique manner so they are easy to find, if present.
  128. ;
  129. ;    Example:
  130. ;        FILENAME.SyS    -  $SYS attribute set
  131. ;        FILENAME.doC    -  $SYS and $R/O both set
  132. ;        FILENAME.com    -  $SYS, $R/O and $ARC all set
  133. ;
  134. ; The following equates will permit SPP to display the files with tagged
  135. ; attributes in lower case letters (a-z) as in example above.
  136. ;
  137. USELC    EQU    YES        ; Allow lower case letters (a-z)
  138. USELCW    EQU    YES        ; *Allow lower case without wheel byte?
  139. ;
  140. ;-----------------------------------------------------------------------
  141. ;
  142. ; Reverse video options
  143. ; ---------------------
  144. ; The following equate will permit SPP to display the files with tagged
  145. ; attributes in either reverse video or bright/dim modes.  This will al-
  146. ; low any character tagged to be visible, as opposed to the USELD method.
  147. ; Up to 7 bytes for enter and exit video modes are provided.  These can
  148. ; be easily patched with DDT, etc.
  149. ;
  150. REVID    EQU    NO        ; Yes = inverse or bright/dim display
  151. ;
  152. ; The following equate will highlight/underline the summary line
  153. ;
  154. ULINE    EQU    NO        ; Yes = highlight/underline summary
  155. ;
  156. ;
  157. ; Reverse video control bytes
  158. ; ---------------------------
  159. ; If byte at RVON is 0, simple lower case will be used to display file
  160. ; attributes.
  161. ;
  162.      IF    REVID
  163. RVON:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for ENTER REVERSE
  164.     DB    0        ; String Terminator MUST BE 0
  165. ;
  166. RVOFF:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for EXIT REVERSE
  167.     DB    0        ; String Terminator MUST BE 0
  168.      ENDIF            ; REVID
  169. ;
  170. ; If byte at ULON is 0, no highlighting/underlining will be used in the
  171. ; banner line.
  172. ;
  173.      IF    ULINE
  174. ULON:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for ENTER ULINE
  175.     DB    0        ; String Terminator, MUST BE 0
  176. ;
  177. ULOFF:    DB    0,0,0,0,0,0,0    ; Up to 7 characters for EXIT ULINE
  178.     DB    0        ; String Terminator MUST BE 0
  179.      ENDIF            ; ULINE
  180. ;
  181. ;-------------------------------
  182. ;
  183. ; If using Z80DOS and you want date stamping support, set the following
  184. ; to YES.
  185. ;
  186. Z80DOS    EQU    NO
  187. ;
  188. ;-------------------------------
  189. ;
  190. ; If want to be able to specify files to be displayed based upon attribute
  191. ;    1 thru 4 , set the following to yes
  192. ;
  193. FATTRIB    EQU    YES
  194. ;
  195.  
  196. ;-------------------------------
  197. ;
  198. ; Z3CPR options
  199. ; -------------
  200. ; for ZCPR33 users - leave all set to NO if not using ZCPR3
  201. ;
  202. ZCPR33    EQU    NO        ; Allow named dir's and ENV support
  203. ZCPR3    EQU    NO        ; Allow named directory in command line
  204. NDIRS    EQU    NO        ; To display directory names
  205. ZRDOS    EQU    NO        ; Set to YES if using ZRDOS
  206. Z3DRV    EQU    44        ; Offset from ENV location to find drive max
  207. Z3USR    EQU    45        ; Offset from ENV location to find user max
  208. Z3WHL    EQU    41        ; Offset from ENV location to find wheel address
  209. Z3NDR    EQU    21        ; Offset from ENV location to find NDIR address
  210. ;
  211. ;            end of options
  212. ;-----------------------------------------------------------------------
  213. ;
  214. ; Reference items
  215. ; ---------------
  216. RECORD    EQU    36
  217. FRN    EQU    33
  218. FCR    EQU    32
  219. READRN    EQU    33
  220. HDRSIZ    EQU    27
  221. ARCMAR    EQU    26
  222.  
  223. TMPLT0    EQU    $        ; Start of initialization template
  224.  
  225.     DB    'A'        ; All-users option flag
  226.     DB    'D'        ; Multi-disk option flag
  227.  
  228.     DB    'H'        ; Show areas from current to highest
  229.     DB    'N'        ; No page-pause option flag
  230.  
  231.     DB    'O'        ; To show $SYS files only
  232.  
  233.     DB    'Q'        ; To show only non-$ARC files
  234.  
  235.     DB    'R'        ; Optional reset of disk system
  236.  
  237.     DB    'S'        ; Include $SYS files
  238.  
  239.     DB    'T'        ; Primary sort by file type
  240.  
  241.     DB    'V'        ; Show SD version
  242.  
  243.     DB    'L'        ; Include $R/O files
  244.  
  245.      IF    Z80DOS
  246.     DB    '='        ; Look for exact match of date given
  247.     DB    '+'        ; Look for files of date GE date given
  248.     DB    '-'        ; Look for files of date LT date given
  249.     DB    '!'        ; Match with creation date
  250.     DB    '%'        ; Match with alteration date
  251.     DB    '@'        ; Match with access date
  252.     DB    'Z'        ; Do not show dates
  253.      ENDIF        ;Z80DOS
  254.  
  255.      IF    FATTRIB        ; Allow spec of file attributes 1-4?
  256.     DB    '1'        ; Only files with attrib 1
  257.     DB    '2'        ; Only files woth attrib 2
  258.     DB    '3'        ; Only files with attrib 3
  259.     DB    '4'        ; Only files with attrib 4
  260.      ENDIF        ;FATTRIB
  261. ;
  262. ; End of option lookup table
  263. ;
  264.     DW    OUTBUF        ; Next location in output buffer
  265.     DB    128        ; # of bytes left in output buffer
  266.     DB    0,'DISK    DIR'    ; Output Filename.typ
  267. ;
  268. TMPLT1    EQU    $        ; End of initialization data template
  269.  
  270. VERNAME:DB    13,10,'SPP',MAIN+'0'
  271.     DB    VER/10+'0',VER MOD 10+'0',' -- '
  272.  
  273.      IF    NOT EDATE
  274.     DB    MONTH/10+'0',MONTH MOD 10+'0','/'
  275.      ENDIF            ; NOT EDATE
  276.  
  277.     DB    DAY/10+'0',DAY MOD 10+'0','/'
  278.  
  279.      IF    EDATE
  280.     DB    MONTH/10+'0',MONTH MOD 10+'0','/'
  281.      ENDIF            ; EDATE
  282.  
  283.     DB    YEAR/10+'0',YEAR MOD 10+'0'
  284.  
  285.      IF    Z80DOS
  286.     DB    ', Z80DOS'
  287.      ENDIF
  288.  
  289.      IF    ZCPR3         ;
  290.     DB    ', ZCPR3 Version'
  291.      ENDIF            ; ZCPR3 
  292.  
  293.      IF    ZCPR33         ;
  294.     DB    ', ZCPR33 Version'
  295.      ENDIF            ; ZCPR33
  296.  
  297.     DB    0
  298. ;
  299. ;-----------------------------------------------------------------------
  300. ;             Program starts here
  301. ;-----------------------------------------------------------------------
  302. ;
  303. START:    LXI    H,0
  304.     DAD    SP        ; HL=old stack
  305.     SHLD    STACK        ; Save it
  306.     LXI    SP,STACK    ; Get new stack
  307.  
  308.      IF    ZCPR33
  309.     LHLD    Z3ENV        ; Get ENV address
  310.     PUSH    H
  311.     LXI    D,Z3DRV        ; Point to max drv byte
  312.     DAD    D
  313.     SHLD    Z3DRVL        ; Save location away
  314.     POP    H
  315.     PUSH    H
  316.     LXI    D,Z3USR        ; Point to maxuser byte
  317.     DAD    D
  318.     SHLD    Z3USRL        ; Save location away
  319.     POP    H
  320.     PUSH    H
  321.     LXI    D,Z3WHL        ; Point to address pointer of wheel
  322.     DAD    D
  323.     MOV    E,M        ; Get address of wheel byte
  324.     INX    H
  325.     MOV    D,M
  326.     XCHG
  327.     SHLD    Z3WHLL        ; Save it away
  328.     POP    H
  329.      ENDIF        ; ZCPR33
  330.  
  331.      IF    NDIRS
  332.     LHLD    Z3ENV        ; Get Environment Address
  333.     LXI    D,Z3NDR        ; Point to named directory space
  334.     DAD    D
  335.     MOV    E,M
  336.     INX    H
  337.     MOV    D,M        ; DE Now contains NDR Address
  338.     INX    H
  339.     MOV    A,M
  340.     ADI    1
  341.     STA    NUMDIR        ; Maximum number of entries plus 1
  342.     XCHG
  343.     SHLD    NAMADR        ; Keep Address for later
  344.      ENDIF            ; NDIRS
  345.  
  346.      IF    WHEEL
  347.     XRA    A        ; Start at line 0
  348.     STA    LINCNT
  349.     INR    A
  350.     STA    NOPFLG        ; And assume verify in case of error or
  351.                 ; help wanted
  352.      IF    ZCPR33
  353.     LHLD    Z3WHLL        ; Get Z33 wheel location
  354.     MOV    A,M        ; Get the wheel
  355.      ENDIF        ; ZCPR33
  356.  
  357.      IF    NOT ZCPR33
  358.     LDA    WHLOC        ; Get the wheel
  359.      ENDIF        ; NOT ZCPR33
  360.  
  361.     ORA    A
  362.     JNZ    WHLOK        ; NZ=wheel set, continue
  363.     LXI    D,WHLERR
  364.     CALL    PUTS
  365.     JMP    EXIT3
  366. WHLOK:
  367.     ENDIF        ; WHEEL
  368.  
  369.  
  370. ;
  371. ; See if help is wanted
  372. ;
  373.     LXI    H,FCB+1        ; Filename
  374.     MOV    A,M        ; 1st Character
  375.  
  376.      IF    NOT ZCPR33
  377.     CPI    '?'        ; Is it "?"
  378.     JNZ    INIT        ; No, Continue
  379.     INX    H        ; Yes, Next Char
  380.     MOV    A,M        ; 2nd Character
  381.     CPI    ' '        ; Is it " "
  382.     JNZ    INIT        ; If not, did not want help guide
  383.     LDA    FCB+9        ; Check for any extent
  384.     CPI    ' '
  385.     JZ    HELPME        ; If none, wanted help
  386.      ENDIF        ; NOT ZCPR33
  387.  
  388.      IF    ZCPR33
  389.     CPI    '?'        ; Is it "?"
  390.     JNZ    CHKSLH        ; No, Continue
  391.     INX    H        ; Yes, Next Char
  392.     MOV    A,M        ; 2nd Character
  393.     CPI    ' '        ; Is it " "
  394.     JNZ    INIT        ; If not, did not want help guide
  395.     LDA    FCB+9        ; Check for any extent
  396.     CPI    ' '
  397.     JZ    HELPME        ; If none, wanted help
  398.     JMP    INIT
  399. CHKSLH: CPI    '/'        ; Is it a slash?
  400.     JNZ    INIT
  401.     INX    H
  402.     MOV    A,M        ; two slashes gets help
  403.     CPI    '/'
  404.     JZ    HELPME
  405.      ENDIF        ; ZCPR33
  406.  
  407. ;
  408. ; Zero out the entire initialization data area
  409. ;
  410. INIT:    LXI    H,DATA0        ; Point to start of initialized data area
  411.     PUSH    H        ; Save for non-zero filling later
  412.     MVI    C,DATA1-DATA0    ; Data area length
  413.     XRA    A        ; Clear the "A" register
  414.  
  415. ZFILL:    MOV    M,A        ; Null the address
  416.     INX    H        ; Pointer+1
  417.     DCR    C        ; One less to go
  418.     JNZ    ZFILL
  419.  
  420. ;
  421. ; Now copy non-zero initialization data from the template area
  422. ;
  423.     POP    H        ; Load A(DATA0)
  424.     LXI    D,TMPLT0    ; Load A(TMPLT0)
  425.     MVI    C,TMPLT1-TMPLT0    ; Template area length
  426.  
  427. NZFILL:    LDAX    D        ; Load template byte
  428.     MOV    M,A        ; Move to data area
  429.     INX    D        ; Next location to store data
  430.     INX    H        ; Next location to get data
  431.     DCR    C        ; One less to go
  432.     JNZ    NZFILL
  433.  
  434.     LXI    H,0        ; Clear HL
  435.  
  436.      IF    ZRDOS
  437.     MVI    C,ZRDVER    ; Get ZRDOS version
  438.     CALL    BDOS
  439.     MOV    A,L        ; ZRDOS Version #
  440.     STA    ZRDFLG        ; Save it
  441.      ENDIF            ; ZRDOS
  442.  
  443.  
  444.     MVI    C,CPMVER    ; Get CP/M  version
  445.     CALL    BDOS
  446.     MOV    A,L        ; CP/M Version number
  447.     STA    VERFLG        ; Save it
  448.     STA    SOHFLG        ; Prevents initial unwanted CRLF
  449.     CPI    20H        ; Set carry if CP/M 1.4
  450.     PUSH    PSW        ; Save for BYE test
  451.     MVI    E,0FFH        ; Load current user number if CP/M 2
  452.     MVI    C,STUSER    ; Fall through with A=0 if not
  453.     CNC    CPM        ; Only if CP/M 2.0 or ZRDOS
  454.     STA    OLDUSR        ; Initial user number
  455.     STA    NEWUSR        ; New user = Initial user
  456.     STA    BASUSR        ; Directories
  457.     POP    PSW        ; Recover Version Flag
  458.  
  459.      IF    ZCPR3 OR ZCPR33
  460.     LDA    FCB+13        ; Point to command line buffer (CLB)
  461.     STA    NEWUSR
  462.      ENDIF            ; ZCPR3
  463.  
  464.      IF    NOT ZCPR3 AND NOT ZCPR33
  465.     LXI    H,TBUF+1    ; Point to command line buffer (CLB)
  466.     MOV    A,M        ; CLB Character
  467.     CPI    '['        ; CP/M 3.0 style delimiter
  468.     JZ    CLOK        ; (may follow command in CP/M 3.0)
  469.     INX    H        ; CLB pointer +1
  470.     ORA    A        ; Terminator?
  471.     JNZ    CLOK        ; No, continue
  472.     MOV    M,A        ; Yes, set 2nd terminator
  473.  
  474. CLOK:    LXI    D,FCB        ; A(file control block)
  475.     CALL    FNAME        ; Process filename.typ
  476.     MOV    A,B        ; Disk specification
  477.     CPI    0FFH        ; Current?
  478.     JZ    CLUS        ; Yes
  479.     STAX    D        ; No, set disk specification
  480.  
  481. CLUS:    MOV    A,C        ; User specification
  482.     CPI    0FFH        ; Current?
  483.     JZ    CLNON        ; Yes
  484.     STA    NEWUSR        ; No, set user specification
  485.     STA    BASUSR
  486.      ENDIF            ; NOT ZCPR3 AND NOT ZCPR33
  487.  
  488. CLNON:    MVI    C,CURDSK
  489.     CALL    CPM        ; Load current disk number
  490.     STA    OLDDSK        ; Save for reset if needed
  491.     INR    A        ; Adjust
  492.     STA    OUTFCB        ; Save directory file drive
  493.     LXI    H,FCB        ; A(file control block)
  494.     MOV    A,M        ; Load directory search drive
  495.     ORA    A        ; Any specified?
  496.     JNZ    START1        ; Yes, skip next routine
  497.     LDA    OLDDSK        ; Otherwise, get default disk
  498.     INR    A        ; Adjust
  499.     JMP    START2
  500.  
  501. START1:    PUSH    PSW        ; Save status
  502.     MVI    A,1
  503.     STA    DRVFLG        ; Set DRVFLG = 1
  504.     POP    PSW        ; Load status
  505.  
  506. START2:    MOV    M,A        ; Absolute drive code in directory FCB
  507. ;
  508. ; If at least one option is allowed,  scan command line for the option
  509. ; field delimiter. The option field delimiter is considered valid only
  510. ; if it is preceded by at least 1 space  (otherwise may be part of the
  511. ; directory filename).     Any unrecognized options/illegal user numbers
  512. ; will be flagged.(We scan the command line buffer rather than the 2nd
  513. ; default FCB because all 8 options + 2 digit user number will not fit
  514. ; in the 2nd FCB name field).
  515. ;
  516.     LXI    H,TBUF        ; CLB pointer
  517.     MOV    B,M        ; CLB length
  518. ;
  519. ; Search for valid command line delimiter, if not found, assume no
  520. ; options.  Show help menu if single "?" entered.
  521. ;
  522. SCNDOL:    INX    H        ; CLB PTR+1
  523.     DCR    B        ; CLB LEN-1
  524.     JM    DOPTN        ; Exit if command line buffer empty
  525.     MOV    A,M        ; CLB Character
  526.     CPI    '['        ; CPM+ style delimiter?
  527.     JZ    OPTDLM        ; Yes
  528.     CPI    '$'        ; CPM2 style delimiter?
  529.     JZ    SPB4        ; Yes
  530.     CPI    '/'        ; ZCPR style delimiter?
  531.     JNZ    SCNDOL        ; No
  532.  
  533. SPB4:    DCX    H        ; '$' found, space must precede
  534.     MOV    A,M        ; Previous character
  535.     INX    H
  536.     CPI    ' '
  537.     JNZ    SCNDOL        ; No space, ignore '$'
  538. ;
  539. ; Valid delimiter found.  Scan the rest of the buffer for options.
  540. ; Errors past this point cause an abort.
  541. ;
  542. OPTDLM:    XCHG            ; DE = CLB pointer (swap pointers)
  543.  
  544. SCNOPT:    INX    D        ; CLB PRT+1
  545.     DCR    B        ; CLB LEN-1
  546.     JM    DOPTN        ; If option field exhausted, exit
  547.  
  548. SCNAGN:    LDAX    D        ; Load option character
  549.     CPI    ' '        ; Is it " "?
  550.  
  551.      IF    Z80DOS
  552.     JZ    LOKDAT        ; Space, go look for date info
  553.      ENDIF        ;Z80DOS
  554.  
  555.      IF    NOT Z80DOS
  556.     JZ    SCNOPT        ; Yes, Ignore it
  557.      ENDIF        ;NOT Z80DOS
  558.  
  559.     CPI    ']'        ; CPM+ style terminator?
  560.     JZ    SCNOPT        ; Options may follow terminator
  561.     LXI    H,OTBL-1    ; OTBL pointer
  562.     MVI    C,OEND-OTBL+1    ; OTLB length
  563.  
  564. NOMACH:    INX    H        ; OTLB pointer+1
  565.     DCR    C        ; OTLB length-1
  566.     JZ    CLERR        ; Error if option table end
  567.     CMP    M        ; Compare with table entry
  568.     JNZ    NOMACH        ; If no match, check next
  569.     MVI    M,0        ; Else, activate the option
  570.     JMP    SCNOPT        ; Continue scan
  571. ;.....
  572. ;
  573. ; Playback the command line up to the character that stopped the scan
  574. ; and exit
  575. ;
  576. CLERR:    XRA    A        ; Clear "A" register
  577.     INX    D        ; Tag end of CLB
  578.     STAX    D        ; With terminator
  579.     CALL    CRLF        ; New line
  580.     LXI    D,ERRMS2    ; 'Error'
  581.     CALL    PUTS
  582.     LXI    D,ERRTAG    ; '->'
  583.     CALL    PUTS
  584.     LXI    H,TBUF+1    ; Playback CLB to error point
  585.  
  586. CLELP:    MOV    A,M        ; Character
  587.     ORA    A        ; Zero?
  588.     JZ    CLEX        ; Yes, exit
  589.     CALL    PUTCHR        ; No, output to console
  590.     INX    H        ; CLB pointer+1
  591.     JMP    CLELP        ; Continue
  592.  
  593. CLEX:    MVI    A,'?'        ; Tag line with a '?' field
  594.     CALL    PUTCHR
  595.     CALL    CRLF        ; New Line
  596.  
  597.  
  598. ;;;;;    JMP    0000H        ; And reset CCP, all finished
  599.     JMP    EXIT2
  600.  
  601.      IF    Z80DOS
  602. LOKDAT:    INX    D
  603.     LDAX    D        ; Check to see if * was entered meaning
  604.     CPI    '*'        ; use current system time
  605.     JNZ    LOKDAT1        ; NZ=no
  606.     PUSH    D        ; Save pointer to input line
  607.     LXI    D,ASCII        ; Tell Z80DOS to put time here
  608.     MVI    C,105
  609.     CALL    5        ; Go get the time
  610.     LXI    D,ASCII
  611.     LDAX    D        ; Get LSB of JDAY
  612.     MOV    L,A
  613.     INX    D
  614.     LDAX    D        ; Get MSB of JDAY
  615.     MOV    H,A
  616.     POP    D        ; Get input pointer back
  617.     INX    D        ; Point ot next
  618.     LDAX    D
  619.     CPI    '-'        ; Does operator want a subtraction?
  620.     JNZ    LOKDAT2        ; NZ=no
  621.     PUSH    H
  622.     INX    D
  623.     CALL    EVAL10        ; Yes go get number
  624.     MOV    E,A
  625.     XRA    A
  626.     MOV    D,A
  627.     MOV    A,L
  628.     SBB    E
  629.     MOV    L,A
  630.     MOV    A,H
  631.     SBB    D
  632.     MOV    H,A
  633.     JMP    LOKDAT2        ; And continue
  634. LOKDAT1:
  635.     call    eval10        ; convert month to binary
  636.     ORA    A        ; month can't be 0
  637.     JZ    BADDATE
  638.     CPI    13         ; can't be >12
  639.     JNC    BADDATE
  640.     STA    MONTHS        ; store month
  641.     LDAX    D        ; End of input line?
  642.     ORA    A
  643.     JZ    BADDATE        ; Z=yes, a no-no
  644.     INX    D        ; Skip /
  645.     call    eval10        ; convert
  646.     ORA    A        ; day can't be 0
  647.     JZ    BADDATE
  648.     CPI    32        ; or >31
  649.     JNC    BADDATE
  650.     STA    DAYS1        ; store day
  651.     LDAX    D        ; End of input line?
  652.     ORA    A
  653.     JZ    BADDATE        ; Z=yes, a no-no
  654.     INX    D        ; Skip /
  655.     call    eval10
  656.     STA    YEARS1        ; store year
  657.     LXI    H,YEARS1        ; pt at date
  658.     call    bin2jul        ; get jul date in hl
  659. LOKDAT2:
  660.     SHLD    DATCHK
  661.     JMP    DOPTN
  662. EVAL10:
  663.     XRA    A
  664.     MOV    B,A        ; B holds current number input
  665. EVAL1:    LDAX    D        ; Get input
  666.     CPI    '/'        ; / is seperator
  667.     JZ    DEVAL10        ; Z= done
  668.     ORA    A
  669.     JZ    DEVAL10        ; Z= at end of line
  670.     SUI    '0'        ; Verify ascii 0-9
  671.     JC    BADDATE
  672.     CPI    10
  673.     JNC    BADDATE
  674.     INX    D
  675.     MOV    C,A        ; Old*10+new
  676.     MOV    A,B
  677.     ADD    A
  678.     ADD    A
  679.     ADD    B
  680.     ADD    A
  681.     ADD    C
  682.     MOV    B,A        ; B has current
  683.     JMP    EVAL1
  684. DEVAL10:
  685.     MOV    A,B
  686.     RET
  687. BADDATE:
  688.     PUSH    D
  689.     LXI    D,BDTMES
  690.     CALL    PUTS
  691.     POP    D
  692.     JMP    CLERR
  693. BDTMES:
  694.     DB    13,10,13,10
  695.     DB    ' *** Illegal Date Entered, form MM/DD/YY or MM/D/YY or M/DD/YY'
  696.     DB    13,10,13,10,0
  697. ;
  698. ;    Binary to Julian Date routine.
  699. ;
  700. ; >>    hl -> yr,mo,da in bin
  701. ; <<     hl = Julian date
  702. ;
  703. ;    Convert to 8080 code from the original
  704. ;    BCD2JUL
  705. ;    by Bridger Mitchel and Howard Goldstein - 4/16/88
  706. ;
  707. BIN2JUL:
  708.     PUSH    PSW
  709.     PUSH    B
  710.     PUSH    D
  711.     MOV    A,M        ; A=yr
  712.     INX    H
  713.     MOV    C,M        ;c = mo
  714.     INX    H
  715.     PUSH    H        ;save ptr to day
  716.     PUSH    PSW        ;save year
  717. ;
  718. ; set hl= initial julian value of 77/12/31
  719. ;
  720.     LXI    H,0
  721.     SUI    78
  722.     JZ    B2JUL3
  723.     JNC    B2JUL0
  724.     ADI    100        ;<78, assume next century
  725. B2JUL0:    MOV    B,A        ;b = # yrs > 78
  726.     MVI    A,1        ;init modulo 4 counter
  727.     LXI    D,365        ;days/yr
  728. B2JUL1:    DAD    D        ;calc julian val. of  (yr/01/01 - 1)
  729.     INR    A
  730.     ANI    3        ;every 4 yrs,
  731.     JNZ    B2JUL2
  732.     INX    H        ;..add 1 for leap year
  733. B2JUL2:    DCR    B
  734.     JNZ    B2JUL1
  735. ;
  736. ;     hl now = # days in years before current year
  737. ;
  738. B2JUL3:    POP    PSW
  739.     ANI    3        ;if current yr == leap year
  740.     JNZ    B2JUL5
  741.     MOV    A,C
  742.     CPI    3        ;..and mo >= march
  743.     JC    B2JUL5
  744.     INX    H        ;..add the extra day (Feb 29)
  745. ;
  746. B2JUL5:    MOV    B,C        ; b = month = # months +1 to sum
  747.     LXI    D,DPERMO    ;point at table
  748.     JMP    B2JUL7
  749. ;
  750. B2JUL6:    CALL    ADDHL        ;add # days in this month
  751.     INX    D        ;bump tbl ptr
  752. B2JUL7:    DCR    B
  753.     JNZ    B2JUL6
  754. ;
  755.     POP    D        ;ptr to day
  756.     CALL    ADDHL
  757.     POP    D
  758.     POP    B
  759.     POP    PSW
  760.     RET
  761.  
  762. ADDHL:    LDAX    D        ;add day of current month
  763. ;
  764. ADDA2HL:
  765.     ADD    L
  766.     MOV    L,A
  767.     RNC
  768.     INR    H
  769.     RET
  770.  
  771. ;
  772. ; table of days per month (non-leap year)
  773. ;
  774.  
  775. DPERMO:    DB    31        ;jan
  776.     DB    28        ;feb
  777.     DB    31        ;mar
  778.     DB    30        ;apr
  779.     DB    31        ;may
  780.     DB    30        ;jun
  781.     DB    31        ;jul
  782.     DB    31        ;aug
  783.     DB    30        ;sep
  784.     DB    31        ;oct
  785.     DB    30        ;nov
  786.     DB    31        ;dec
  787.  
  788.      ENDIF        ;Z80DOS
  789.  
  790.  
  791.  
  792. ;.....
  793. ;
  794. ; Options input or not specified, and associated flags set.
  795. ;
  796. ; If D-option, swap error vectors, then start at drive A if no
  797. ; drive specified on command line.
  798. ;
  799. DOPTN:    LDA    DOPFLG        ; If multi-disk flag set,
  800.     ORA    A        ; Need to set error traps
  801.     JNZ    AOPTN        ; If not, go check A-option
  802.     CALL    SWAPEM        ; Swap BDOS error vector tables
  803.     LDA    DRVFLG        ; Directory drive specified?
  804.     ORA    A
  805.     JNZ    AOPTN        ; No, don't reset
  806.     MVI    A,1        ; Yes, Set FCB to A:
  807.     STA    FCB
  808. ;
  809. ; Start user at 0 if A-option selected without U-option
  810. ;
  811. AOPTN:    LDA    AOPFLG        ; Check All-users option
  812.     ORA    A
  813.     JNZ    COPTN        ; Jump if not
  814.     LDA    HOPFLG        ; Asking to show all from current?
  815.     ORA    A
  816.     JZ    COPTN        ; If yes, do not reset "A" to zero
  817.     XRA    A        ; No, Start at user 0
  818.     STA    NEWUSR
  819.     STA    BASUSR
  820.  
  821. COPTN:
  822.     MVI    A,'k'
  823.  
  824. COPTN1:    STA    FSIZEC        ; Indicator char after size
  825. ;
  826. ; The following optionally resets the disk system.  The reset must
  827. ; be done OUTSIDE of the multiple drive loop if the $F option is
  828. ; enabled because CP/M 1.4 will clobber the DMA buffer on reset.
  829. ;
  830.     LDA    ROPFLG        ; Reset Disk?
  831.     ORA    A
  832.     JNZ    NOOPT
  833. ;
  834. ; Disk reset if R option entered on command line
  835. ;
  836.     MVI    C,RESET
  837.     CALL    CPM
  838. ;
  839. ; Validate drive code and user area numbers from the drive table
  840. ;
  841. NOOPT:    LXI    D,DRUMSG    ; Get drive/user error message
  842.     PUSH    D
  843.     LDA    FCB        ; Get directory drive code
  844.     DCR    A        ; Normalize to range of 0-31
  845.     CPI    HIDRV-LODRV    ; Compare with max drives on-line
  846.     JNC    ERXIT        ; Drive error exit if out of range
  847.  
  848.      IF    MAXDRV        ; Look for MXDRV
  849.  
  850.      IF    ZCPR33
  851.     LHLD    Z3DRVL        ; Point to ENV as loaded
  852.      ENDIF        ;ZCPR33
  853.  
  854.      IF    NOT ZCPR33
  855.     LXI    H,MXDRV        ; A(MXDRV) to HL
  856.      ENDIF        ;NOT ZCPR33
  857.  
  858.     MOV    L,M        ; (MXDRV) to L
  859.      ENDIF            ; MAXDRV
  860.  
  861.      IF    MAXDRV
  862.  
  863.      IF    NOT ZCPR33
  864.     INX    H        ; +1
  865.      ENDIF        ; NOT ZCPR33
  866.  
  867.     CMP    L        ; Check it
  868.     JNC    ERXIT        ; Oops if not bigger
  869.      ENDIF            ; MAXDRV
  870. ;
  871. ; Skips any drives marked 0FFh, some computers do not have contiguous
  872. ; drives, such as Heath H89, etc.
  873. ;
  874.     MOV    E,A        ; Drive code = table index
  875.     MVI    D,0
  876.     LXI    H,LODRV        ; DUTBL Pointer
  877.     DAD    D        ; DUTBL Pointer+INDEX
  878.     MOV    A,M        ; User Number
  879.     ORA    A        ; Set Status
  880.     JM    NDSK        ; If negative, ignore drive
  881.  
  882.      IF    WHEEL
  883.  
  884.      IF    ZCPR33
  885.     PUSH    H
  886.     LHLD    Z3WHLL        ; Point to enviorment
  887.     MOV    A,M        ; Get it
  888.     POP    H
  889.      ENDIF        ;ZCPR33
  890.  
  891.      IF    NOT ZCPR33
  892.     LDA    WHLOC        ; Get wheel byte
  893.      ENDIF        ;NOT ZCPR33
  894.  
  895.     ORA    A        ; Check it
  896.     JZ    USRCK        ; If reset, restrict user
  897.     MVI    A,MXZUSR    ; If set, max user = MXZUSR
  898.     JMP    USRCK1
  899.      ENDIF            ; WHEEL
  900.  
  901. USRCK:    LXI    H,LODRV        ; DUTBL PTR
  902.     DAD    D        ; DUTLB PTR+INDEX
  903.     MOV    A,M        ; Load max user for this drive
  904.  
  905.      IF    MAXUR        ; Use low memory values if smaller
  906.     MOV    H,A        ; Current value of MAXUSR
  907.  
  908.      IF    ZCPR33
  909.     PUSH    H
  910.     LHLD    Z3USRL        ; Point to ENV
  911.     MOV    A,M        ; Get user
  912.     POP    H
  913.      ENDIF        ;ZCPR33
  914.  
  915.      IF    NOT ZCPR33
  916.     LDA    MXUSR        ; Alternate value
  917.      ENDIF        ;NOT ZCPR33
  918.  
  919.      ENDIF            ; MAXUR
  920.  
  921.      IF    ( MAXUR AND NOT ZCPR3 ) AND NOT ZCPR33
  922.     SBI    1        ; MAXUSR is really maximum user+1
  923.      ENDIF            ; MAXUR AND NOT ZCPR3 AND NOT ZCPR33
  924.  
  925.      IF    MAXUR
  926.     CMP    H        ; Compare the two
  927.     JNC    USRCK1        ; OK if MAXU <= table value
  928.     STA    MAXUSR        ; Else replace it
  929.      ENDIF            ; MAXUR
  930.  
  931. USRCK1:    MOV    B,A        ; Save max user for later testing
  932.     ANI    1FH        ; Insure in range 0-31
  933.     STA    MAXUSR        ; Save it for later
  934.     LXI    H,NEWUSR    ; Point to directory user area
  935.     CMP    M        ; Compare with the maximum
  936.     JC    ERXIT        ; User number illegal, error exit
  937.     POP    D        ; Destroy error message pointer
  938.     MOV    A,B        ; Check to see if this drive
  939.     ORA    A        ; Has been mapped out
  940.     JM    NDSK        ; Yes, skip this drive
  941.     LXI    H,FCB+1        ; No, point to name
  942.     MOV    A,M        ; Any name specified?
  943.     CPI    '$'        ; Delimiter?
  944.     JZ    WCD        ; Yes, All files
  945.     CPI    '/'        ; Unix/ZCPR3 delimiter?
  946.     JZ    WCD        ; Yes, All files
  947.     CPI    '['        ; CP/M+ delimiter?
  948.     JZ    WCD
  949.     CPI    ' '        ; No, Filename specified
  950.     JNZ    GOTFCB
  951. ;
  952. ; No FCB - make FCB all '?'
  953. ;
  954. WCD:    MVI    B,11        ; Filename+typ length
  955.  
  956. QLOOP:    MVI    M,'?'        ; Store "?" in FCB
  957.     INX    H        ; FCB pointer+1
  958.     DCR    B        ; FCB length-1
  959.     JNZ    QLOOP        ; Continue
  960.  
  961. GOTFCB:    MVI    A,'?'        ; Force wild extent
  962.     STA    FCB+12
  963.     CALL    SETSRC        ; Set DMA for BDOS media change check
  964.     LXI    H,FCB        ; Point to FCB drive code for directory
  965.     MOV    E,M        ; Load drive code from FCB
  966.     DCR    E        ; Normalize drive code for select
  967.     MVI    C,SELDSK    ; Select directory drive to retrieve
  968.     CALL    CPM        ; The proper allocation vector
  969.     CALL    CKVER        ; Check version
  970.     JC    V14        ; Pre-2.x...get parameters the 1.4 way
  971.     MVI    C,DSKPAR    ; If 2.2 or MP/M...request DPB
  972.     CALL    BDOS
  973.     INX    H
  974.     INX    H
  975.     MOV    A,M        ; Load block shift
  976.     STA    BLKSHF        ; Block Shift
  977.     INX    H        ; Bump to block mask
  978.     MOV    A,M        ; Load block mask
  979.     STA    BLKMSK        ; Block Mask
  980.     INX    H
  981.     INX    H
  982.     MOV    E,M        ; Get maximum block #
  983.     INX    H
  984.     MOV    D,M
  985.     XCHG
  986.     SHLD    BLKMAX        ; Maximum Block #
  987.     XCHG
  988.     INX    H
  989.     MOV    E,M        ; Load directory size
  990.     INX    H
  991.     MOV    D,M
  992.     XCHG
  993.     JMP    FREE
  994.  
  995. V14:    LHLD    BDOS+1        ; Get parameters 1.4 style
  996.     MVI    L,3BH        ; Point to directory size
  997.     MOV    E,M        ; Get it
  998.     MVI    D,0        ; Force high order to 0
  999.     PUSH    D        ; Save for later
  1000.     INX    H        ; Point to block shift
  1001.     MOV    A,M        ; Fetch
  1002.     STA    BLKSHF        ; Save
  1003.     INX    H        ; Point to block mask
  1004.     MOV    A,M        ; Fetch it
  1005.     STA    BLKMSK        ; And save it
  1006.     INX    H
  1007.     MOV    E,M        ; Get maximum block #
  1008.     MVI    D,0
  1009.     XCHG
  1010.     SHLD    BLKMAX        ; Save it
  1011.     POP    H        ; Restore directory size
  1012.     JMP    FREE20        ; Calculate free space from alloc vector
  1013. ;
  1014. ; Calculate number of K free on selected drive now so the FREE figure
  1015. ; will not reflect either creation or additions to the DISK.DIR file.
  1016. ; Note: This routine will not always function correctly as coded.  To
  1017. ; insure the proper calculation when the $F option is specified and
  1018. ; cataloging multiple disks on a single drive, you should do a CTL-C
  1019. ; AFTER the disk to be cataloged has been readied.
  1020. ;
  1021. FREE:    SHLD    DIRMAX        ; Save max number of directory entries
  1022.     LDA    VERFLG        ; Check version number
  1023.     CPI    30H        ; CP/M 3.0?
  1024.     JC    FREE20        ; No, Use old method
  1025.     LDA    FCB        ; Load drive number
  1026.     DCR    A        ; Normalize
  1027.     MOV    E,A        ; Use compute free space BDOS call
  1028.     MVI    C,46        ; Calculate free space
  1029.     CALL    CPM
  1030.     MVI    C,3        ; Answer is a 24-bit integer
  1031.  
  1032. FRE3L1:    LXI    H,TBUF+2    ; Answer in 1st 3 bytes of TBUF
  1033.     MVI    B,3        ; Convert from records to k
  1034.     ORA    A        ; By dividing by 8
  1035.  
  1036. FRE3L2:    MOV    A,M        ; LS byte record count
  1037.     RAR            ; /2
  1038.     MOV    M,A        ; Replace
  1039.     DCX    H        ; Next byte record count
  1040.     DCR    B        ;
  1041.     JNZ    FRE3L2        ; Loop for 3 bytes
  1042.     DCR    C
  1043.     JNZ    FRE3L1        ; Shift 3 times
  1044.     LHLD    TBUF        ; Now get result in k
  1045.     JMP    SAVFRE        ; Save Free Space
  1046.  
  1047. FREE20:    MVI    C,DSKALL    ; Allocation vector address
  1048.     CALL    BDOS
  1049.     XCHG
  1050.     LHLD    BLKMAX        ; Max Block Number
  1051.     INX    H
  1052.     LXI    B,0        ; Init block count = 0
  1053.  
  1054. GSPBYT:    PUSH    D        ; Save allocation address
  1055.     LDAX    D
  1056.     MVI    E,8        ; Set to process 8 blocks
  1057.  
  1058. GSPLUP:    RAL            ; Test bit
  1059.     JC    NOTFRE
  1060.     INX    B
  1061.  
  1062. NOTFRE:    MOV    D,A        ; Save bits
  1063.     DCX    H        ; Count down blocks
  1064.     MOV    A,L
  1065.     ORA    H
  1066.     JZ    ENDALC        ; Quit if out of blocks
  1067.     MOV    A,D        ; Restore bits
  1068.     DCR    E        ; Count down 8 bits
  1069.     JNZ    GSPLUP        ; Do another bit
  1070.     POP    D        ; Bump to next byte of allocation vector
  1071.     INX    D
  1072.     JMP    GSPBYT        ; Process it
  1073.  
  1074. ENDALC:    POP    D        ; Clear stack of allocation vector pointer
  1075.     MOV    L,C        ; Copy blocks to HL
  1076.     MOV    H,B
  1077.     LDA    BLKSHF        ; Load block shift factor
  1078.     SUI    3        ; Convert from records to k
  1079.     JZ    SAVFRE        ; Skip shifts if 1k blocks return free in HL
  1080.  
  1081. FREKLP:    DAD    H        ; Multiply blocks by k/block
  1082.     DCR    A
  1083.     JNZ    FREKLP
  1084. ;
  1085. SAVFRE:    SHLD    FREEBY        ; Save free space for output later
  1086.     XCHG
  1087.     LHLD    TOTFRE
  1088.     DAD    D
  1089.     SHLD    TOTFRE
  1090. ;
  1091. ; Reenter here on subsequent passes while in the all-users mode
  1092. ;
  1093. SETTBL:    LHLD    DIRMAX        ; Load directory maximum size
  1094.     INX    H        ; Directory size is DIRMAX+1
  1095.     DAD    H        ; Double directory size
  1096.     LXI    D,ORDER        ; Too get order table size
  1097.     DAD    D        ; Allocate order table
  1098.     SHLD    TBLOC        ; Name tbl begins where order tbl ends
  1099.     SHLD    NEXTT
  1100.     XCHG
  1101.     LHLD    BDOS+1        ; Insure we have room to continue
  1102.     MOV    A,E
  1103.     SUB    L
  1104.     MOV    A,D
  1105.     SBB    H
  1106.     JNC    OUTMEM
  1107.     CALL    CKVER        ; Set carry if pre-CP/M 2
  1108.     LDA    NEWUSR        ; Load directory user area
  1109.     MOV    E,A
  1110.     MVI    C,STUSER    ; Get the user function
  1111.     CNC    CPM        ; Set new user number if CP/M 2
  1112. ;
  1113. ; Look up the FCB in the directory
  1114. ;
  1115.     MVI    A,'?'        ; Check for wild FCB extent
  1116.     LXI    H,FCB+12
  1117.     MOV    M,A        ; Match all extents
  1118.     INX    H
  1119.     MOV    M,A        ; Match all S1 bytes
  1120.     INX    H
  1121.     MOV    M,A        ; Match all S2 bytes
  1122.     LXI    H,0
  1123.     SHLD    COUNT        ; Initialize match counter
  1124.     SHLD    TOTFIL        ; "  total file counter
  1125.     SHLD    TOTSIZ        ; "  total size counter
  1126.     CALL    SETSRC        ; Set DMA for directory search
  1127.     MVI    C,SRCHF        ; Load 'search first' function
  1128.     JMP    LOOK        ; Go search for 1st match
  1129. ;
  1130. ; Read more directory entries
  1131. ;
  1132. MORDIR:    MVI    C,SRCHN        ; Search next function
  1133.  
  1134. LOOK:    LXI    D,FCB        ; A(file control block)
  1135.     CALL    CPM        ; Read directory entry
  1136.     INR    A        ; End (0FFH)?
  1137.     JZ    SPRINT        ; Yes, sort & print what we have
  1138. ;
  1139. ; Point to directory entry
  1140. ;
  1141.     DCR    A        ; Undo previous INR A
  1142.     ANI    3        ; Make modulus 4
  1143.     ADD    A        ; Multiply
  1144.     ADD    A        ; By 32 because
  1145.     ADD    A        ; Each directory
  1146.     ADD    A        ; Entry is 32
  1147.     ADD    A        ; Bytes long
  1148.     LXI    H,TBUF+1    ; Point to buffer (skip to FN/FT)
  1149.     ADD    L        ; Point to entry
  1150.  
  1151.      IF    FATTRIB
  1152.     MOV    L,A        ; HL now point to file name
  1153.     LDA    ONEFLG        ; Looking for only attribute 1?
  1154.     ORA    A
  1155.     JNZ    NOTONE        ; NZ=no
  1156.     MOV    A,M
  1157.     ORA    A
  1158.     JP    MORDIR        ; P=not attr 1
  1159. NOTONE:    INX    H
  1160.     LDA    TWOFLG        ; Only attribute 2?
  1161.     ORA    A
  1162.     JNZ    NOTTWO        ; NZ=no
  1163.     MOV    A,M
  1164.     ORA    A
  1165.     JP    MORDIR        ; P=not attr 2
  1166. NOTTWO:    INX    H
  1167.     LDA    THRFLG        ; Only attrib 3?
  1168.     ORA    A
  1169.     JNZ    NOTTHR        ; NZ=no
  1170.     MOV    A,M
  1171.     ORA    A
  1172.     JP    MORDIR        ; P= not attr 3
  1173. NOTTHR:    INX    H
  1174.     LDA    FORFLG        ; Only attr 4?
  1175.     ORA    A
  1176.     JNZ    NOTFOR        ; NZ=no
  1177.     MOV    A,M
  1178.     ORA    A
  1179.     JP    MORDIR        ; P= not attr 4
  1180. NOTFOR:    MOV    A,L
  1181.     ADI    5        ; POINT TO R/O BYTE
  1182.      ENDIF        ; FATTRIB
  1183.  
  1184.      IF    NOT FATTRIB
  1185.     ADI    8        ; Point to R/O BYTE
  1186.      ENDIF        ; NOT FATTRIB
  1187.  
  1188.     MOV    L,A
  1189.     LDA    LOPFLG        ; Should we allow R/O files?
  1190.     ORA    A
  1191.     JZ    QSYS        ; Z=yes
  1192.     MOV    A,M        ; Check for R/O
  1193.     ORA    A
  1194.     JM    MORDIR        ; M=yes, ignore this file
  1195. QSYS:    INX    H
  1196.     LDA    QOPFLG        ; Find only non-$ARC files?
  1197.     ORA    A
  1198.     JNZ    OSYS        ; No, check for only $SYS files
  1199.     INX    H        ; Yes, get the archive byte
  1200.     MOV    A,M
  1201.     DCX    H
  1202.     ORA    A        ; Check bit 7 for $ARC file
  1203.     JM    MORDIR        ; If set, ignore this filename
  1204.  
  1205. OSYS:    LDA    OOPFLG        ; Find only $SYS files?
  1206.     ORA    A
  1207.     JNZ    CKSYS
  1208.     MOV    A,M        ; Yes, get system byte
  1209.     ORA    A        ; Check bit 7 for $SYS file
  1210.     JP    MORDIR        ; If not set, ignore this filename
  1211.     JMP    SYSFOK        ; Else check for a match
  1212.  
  1213. CKSYS:    LDA    SOPFLG        ; Did user request $SYS files?
  1214.     ORA    A
  1215.     JZ    SYSFOK        ; If yes, exit
  1216.     MOV    A,M        ; Get system byte back
  1217.     ORA    A        ; Check bit 7 for $SYS file
  1218.     JM    MORDIR        ; Skip that file
  1219.  
  1220. SYSFOK:    MOV    A,L        ; Go back now
  1221.     SUI    10        ; Back to user number (allocation flag)
  1222.     MOV    L,A        ; HL points to entry now
  1223.     LDA    NEWUSR        ; Get current user
  1224.     CMP    M
  1225.     JNZ    MORDIR        ; Ignore if different
  1226.     INX    H
  1227.  
  1228.      IF    Z80DOS
  1229.     PUSH    B        ;
  1230.     PUSH    D        ;
  1231.     PUSH    H        ;
  1232.     MVI    C,54        ; Get time stamp from last search
  1233.     CALL    BDOS        ;
  1234.     LXI    D,6        ; Point to last access field
  1235.     LDA    DGOPFL
  1236.     ORA    A
  1237.     JZ    ACCESS        ; Z=what is wanted
  1238.     LXI    D,2        ; Point to last alteration field
  1239.     LDA    DAOPFL
  1240.     ORA    A
  1241.     JZ    ACCESS        ; Z=what is wanted
  1242.     LXI    D,0        ; Point to creation field
  1243.     LDA    DNOPFL
  1244.     ORA    A
  1245.     JZ    ACCESS        ; Z=what is wanted
  1246.  
  1247.     LXI    D,2        ; Didn't say, so give him alteration date
  1248.  
  1249. ACCESS: DAD    D        ; Point to right field in returned database
  1250.     MOV    E,M        ; Get the date in Julian
  1251.     INX    H
  1252.     MOV    D,M
  1253.     XCHG
  1254.     SHLD    DATMOD
  1255. ;
  1256.     POP    H
  1257.     POP    D
  1258.     POP    B
  1259.      ENDIF        ;Z80DOS
  1260. ;
  1261. ; Move entry to table
  1262. ;
  1263.     XCHG            ; Entry to DE
  1264.     LHLD    NEXTT        ; Next table entry to HL
  1265.     MVI    B,11        ; Entry length (name, type, extent)
  1266.  
  1267. TMOVE:    LDAX    D        ; Get entry character
  1268.  
  1269.      IF    NOT (USELC OR REVID)
  1270.     ANI    7FH        ; Remove attributes
  1271.      ENDIF            ; NOT (USELC OR REVID)
  1272.  
  1273.     MOV    M,A        ; Store in table
  1274.     INX    D
  1275.     INX    H
  1276.     DCR    B        ; More?
  1277.     JNZ    TMOVE
  1278.     INX    D        ; DE->> S1
  1279.     INX    D        ; DE->> S2
  1280.     LDAX    D        ; Get S2 byte, oflo=int(extents/32)
  1281.     PUSH    H        ; Save HL
  1282.     MOV    L,A        ; Set up 16-bit multiply
  1283.     MVI    H,0
  1284.     MVI    B,5
  1285.     CALL    SHLL        ; HL is now # of oflo extents
  1286.     DCX    D        ; DE->> S1
  1287.     DCX    D        ; DE->> extent
  1288.     LDAX    D        ; Get extent
  1289.     ADD    L
  1290.     MOV    L,A
  1291.     MOV    A,H
  1292.     ACI    0
  1293.     MOV    H,A        ; HL has total extents
  1294.     MVI    B,7
  1295.     CALL    SHLL        ; HL has total records less last ext
  1296.     INX    D        ; DE->> S1
  1297.     INX    D        ; DE->> S2
  1298.     INX    D        ; Point to sector count
  1299.     LDAX    D        ; Get it
  1300.     ADD    L
  1301.     MOV    L,A
  1302.     MOV    A,H
  1303.     ACI    0
  1304.     MOV    H,A        ; HL has total records
  1305.     XTHL            ; Do some fancy shuffling
  1306.     XCHG
  1307.     XTHL
  1308.     XCHG
  1309.     MOV    M,D
  1310.     INX    H
  1311.     MOV    M,E
  1312.     POP    D        ; All back to normal
  1313.     INX    H
  1314.  
  1315.      IF    Z80DOS
  1316.     LDA    DATMOD        ; Get LSB of last modified date
  1317.     MOV    M,A        ;
  1318.     INX    H        ;
  1319.     LDA    DATMOD+1    ; Get MSB of last modified date
  1320.     MOV    M,A        ;
  1321.     INX    H        ;
  1322.      ENDIF        ;Z80DOS
  1323.  
  1324.     SHLD    NEXTT        ; Save updated table address
  1325.     XCHG
  1326.     LHLD    COUNT        ; Bump the # of matches made
  1327.     INX    H
  1328.     SHLD    COUNT
  1329.  
  1330.      IF    Z80DOS
  1331.     LXI    H,15        ; Size of entry include date
  1332.      ENDIF        ;Z80DOS
  1333.  
  1334.      IF    NOT Z80DOS
  1335.     LXI    H,13        ; Size of next entry
  1336.      ENDIF        ;NOT Z80DOS
  1337.  
  1338.     DAD    D
  1339.     XCHG            ; Future NEXTT is in DE
  1340.     LHLD    BDOS+1        ; Pick up TPA end
  1341.     MOV    A,E
  1342.     SUB    L        ; Compare NEXTT-TPA end
  1343.     MOV    A,D
  1344.     SBB    H
  1345.     JC    MORDIR        ; If TPA end > NEXTT, loop back for more
  1346.  
  1347. OUTMEM:    CALL    ERXIT        ; Exit if directory too large
  1348.     DB    'Memory',0
  1349. ;
  1350. ; Shift HL left by B bits
  1351. ;
  1352. SHLL:    DAD    H
  1353.     DCR    B
  1354.     RZ
  1355.     JMP    SHLL
  1356. ;
  1357. ; Sort and print
  1358. ;
  1359. SPRINT:    CALL    SETFOP        ; Return to file output DMA & user #
  1360.     LHLD    COUNT        ; Get file name count
  1361.     MOV    A,L
  1362.     ORA    H        ; Any found?
  1363.     JZ    PRTOTL        ; Exit if no files found
  1364.     PUSH    H        ; Save file count
  1365.     STA    SUPSPC        ; Enable leading zero suppression
  1366. ;
  1367. ; Initialize the order table
  1368. ;
  1369.     LHLD    TBLOC        ; Get start of name table
  1370.     XCHG            ; Into DE
  1371.     LXI    H,ORDER        ; Point to order table
  1372.  
  1373.      IF    Z80DOS
  1374.     LXI    B,15        ; Entry length including date
  1375.      ENDIF        ;Z80DOS
  1376.  
  1377.      IF    NOT Z80DOS
  1378.     LXI    B,13        ; Entry length
  1379.      ENDIF        ;NOT Z80DOS
  1380.  
  1381. BLDORD:    MOV    M,E        ; Save low order address
  1382.     INX    H
  1383.     MOV    M,D        ; Save high order address
  1384.     INX    H
  1385.     XCHG            ; Table address to HL
  1386.     DAD    B        ; Point to next entry
  1387.     XCHG
  1388.     XTHL            ; Save table address, load loop counter
  1389.     DCX    H        ; Count down loop
  1390.     MOV    A,L
  1391.     ORA    H        ; More?
  1392.     XTHL            ; Load table address, save loop counter
  1393.     JNZ    BLDORD        ; Yes, go do another one
  1394.     POP    H        ; Clean loop counter off stack
  1395.     LHLD    COUNT        ; Get count
  1396.     SHLD    SCOUNT        ; Save as # to sort
  1397.     DCX    H        ; Only 1 entry?
  1398.     MOV    A,L
  1399.     ORA    H
  1400.     JZ    DONE        ; Yes, so skip sort
  1401. ;
  1402. ; This sort routine is adapted from SOFTWARE TOOLS
  1403. ;
  1404.     LHLD    SCOUNT        ; Number of entries
  1405.  
  1406. L1:    ORA    A        ; Clear carry
  1407.     MOV    A,H        ; GAP=GAP/2
  1408.     RAR
  1409.     MOV    H,A
  1410.     MOV    A,L
  1411.     RAR
  1412.     MOV    L,A
  1413.     ORA    H        ; Is it zero?
  1414.     JZ    DONE        ; Then none left
  1415.     MOV    A,L        ; Make gap odd
  1416.     ORI    1
  1417.     MOV    L,A
  1418.     SHLD    GAP
  1419.     INX    H        ; I=GAP+1
  1420.  
  1421. L2:    SHLD    I
  1422.     XCHG
  1423.     LHLD    GAP
  1424.     MOV    A,E        ; J=I-GAP
  1425.     SUB    L
  1426.     MOV    L,A
  1427.     MOV    A,D
  1428.     SBB    H
  1429.     MOV    H,A
  1430.  
  1431. L3:    SHLD    J
  1432.     XCHG
  1433.     LHLD    GAP        ; JG=J+GAP
  1434.     DAD    D
  1435.     SHLD    JG
  1436.     CALL    COMPARE        ; Compare (J) and (JG)
  1437.     JP    L4        ; If A(J)<=A(JG)
  1438.     LHLD    J
  1439.     XCHG
  1440.     LHLD    JG
  1441.     CALL    SWAP        ; Exchange a(J) and a(JG)
  1442.     LHLD    J        ; J=J-GAP
  1443.     XCHG
  1444.     LHLD    GAP
  1445.     MOV    A,E
  1446.     SUB    L
  1447.     MOV    L,A
  1448.     MOV    A,D
  1449.     SBB    H
  1450.     MOV    H,A
  1451.     JM    L4        ; If J>0 go to l3
  1452.     ORA    L        ; Check for zero
  1453.     JZ    L4
  1454.     JMP    L3
  1455.  
  1456. L4:    LHLD    SCOUNT        ; For later
  1457.     XCHG
  1458.     LHLD    I        ; I=I+1
  1459.     INX    H
  1460.     MOV    A,E        ; If I<=n go to l2
  1461.     SUB    L
  1462.     MOV    A,D
  1463.     SBB    H
  1464.     JP    L2
  1465.     LHLD    GAP
  1466.     JMP    L1
  1467. ;
  1468. ; Sort is all done - print entries
  1469. ;
  1470. DONE:
  1471. NOOUT:    LDA    FIRSTT        ; First time through?
  1472.     ORA    A
  1473.     JNZ    NOVOPT        ; No, we've been here before
  1474.     MVI    A,0FFH        ; Yes,
  1475.     STA    FIRSTT        ; Set first time flag
  1476.     LDA    VOPFLG        ; Version display flag
  1477.     ORA    A        ; Set?
  1478.     JNZ    NOVOPT        ; No, skip version print
  1479.     LXI    D,VERNAME    ; Yes, print version
  1480.     CALL    PUTS        ; Print the string
  1481.     CALL    CRLF
  1482.  
  1483. NOVOPT:    LHLD    COUNT
  1484.     LXI    H,ORDER        ; Initialize order table pointer
  1485.     SHLD    NEXTT
  1486.     LHLD    COUNT        ; Code computes end of name table
  1487.     CALL    MULT13        ; (or start of second table
  1488.     XCHG            ; Where files to be stored after
  1489.     LHLD    TBLOC        ; Redundant extents removed)
  1490.     DAD    D
  1491.     SHLD    NEWPTR        ; Save it twice
  1492.     SHLD    XPOINT        ; For later
  1493. ;
  1494. ; Output the directory files we've matched
  1495. ;
  1496. ENTRY:    LHLD    COUNT        ; Files matched count
  1497.     DCX    H        ; Count-1
  1498.     SHLD    COUNT
  1499.     MOV    A,H        ; Is this the last file?
  1500.     ORA    L
  1501.     JZ    OKPRNT        ; Yes, last file so skip compare
  1502. ;
  1503. ; Compare each entry to make sure that it isn't part of a multiple
  1504. ; extent file.    Go only when we have the last extent of the file.
  1505. ;
  1506.     PUSH    B        ; Save number of columns
  1507.     LHLD    NEXTT
  1508.     MVI    A,11
  1509.     CALL    COMPR        ; Does this entry match next one?
  1510.     POP    B        ; Restore number of columns
  1511.     JNZ    OKPRNT        ; No, print it
  1512. NOKPRN:    INX    H
  1513.     INX    H        ; Skip, highest extent last in list
  1514.     SHLD    NEXTT
  1515.     JMP    ENTRY        ; Loop back for next lowest extent
  1516. ;
  1517. ; OKPRINT moves unique filenames and sizes in "k" to a second table
  1518. ; above the first for use later.
  1519. ;
  1520. OKPRNT:
  1521. ;
  1522.      IF    Z80DOS
  1523.     PUSH    H
  1524.     PUSH    D
  1525.     PUSH    B
  1526.     LHLD    NEXTT        ; Get order table pointer
  1527.     MOV    E,M        ; Get low order address
  1528.     INX    H
  1529.     MOV    D,M        ; Get high order address
  1530.     LXI    H,13
  1531.     DAD    D
  1532. ;    XCHG
  1533.     MOV    E,M
  1534.     INX    H
  1535.     MOV    D,M
  1536.     LHLD    DATCHK        ; Get the date we are looking for
  1537.     MOV    A,H
  1538.     ORA    L
  1539.     JZ    GDTMTC        ; Z=not looking
  1540.     MOV    A,H
  1541.     CMP    D        ; Check if given date >,=,< the files date
  1542.     JZ    CHDLOW        ; High EQ, check low
  1543.     JC    DATLT        ; C=LT
  1544.     JMP    DATGE        ; Given date GT file date
  1545. CHDLOW:    MOV    A,L        ; Check low byte of date vs. file date
  1546.     CMP    E
  1547. DATGE:    MVI    A,0        ; Assume EQ
  1548.     JC    DATLT        ; C= given LT files date
  1549.     JZ    DATFLG        ; Z= they are EQ
  1550.     MVI    A,2        ; Given GT files date
  1551.     JMP    DATFLG
  1552. DATLT:    MVI    A,1        ; Given was less than files
  1553. DATFLG:    STA    DTMTCH
  1554.     LDA    DEOPFL        ; What kind of date match?
  1555.     ORA    A
  1556.     JZ    DTEXAC        ; Z=exact
  1557.     LDA    DPOPFL
  1558.     ORA    A
  1559.     JZ    DTABVE        ; Z=GE
  1560.     LDA    DMOPFL        ; LT wanted?
  1561.     ORA    A
  1562.     JNZ    DTEXAC        ; NZ=no, didn't tell us so do anything but gave
  1563.                 ; us a date so assume want exact match
  1564.     LDA    DTMTCH
  1565.     CPI    2
  1566.     JZ    GDTMTC        ; Date was below and they wanted below
  1567. NDTMTC:
  1568.     POP    B
  1569.     POP    D
  1570.     POP    H
  1571.     PUSH    H
  1572.     LHLD    COUNT
  1573.     MOV    A,L
  1574.     ORA    H
  1575.     POP    H
  1576.     JZ    PRTOTL
  1577.     JMP    NOKPRN
  1578.  
  1579. DTEXAC:    LDA    DTMTCH        ; They wanted exact, was it?
  1580.     ORA    A
  1581.     JZ    GDTMTC        ; Z=yes
  1582.     JMP    NDTMTC
  1583. DTABVE:    LDA    DTMTCH        ; They wanted GE
  1584.     CPI    1
  1585.     JZ    GDTMTC        ; Z=G
  1586.     ORA    A
  1587.     JNZ    NDTMTC        ; Must be 2, so not equal
  1588. GDTMTC:    POP    B
  1589.     POP    D
  1590.     POP    H
  1591.      ENDIF        ; Z80DOS
  1592.     
  1593.     LHLD    NEXTT        ; Get order table pointer
  1594.     MOV    E,M        ; Get low order address
  1595.     INX    H
  1596.     MOV    D,M        ; Get high order address
  1597.     INX    H
  1598.     SHLD    NEXTT        ; Save updated table pointer
  1599.     XCHG            ; Table entry to HL
  1600.     PUSH    H        ; Save address of byte to be moved
  1601.     LHLD    NEWPTR        ; Address in new table to put byte
  1602.     PUSH    H        ; Save address
  1603.  
  1604.      IF    Z80DOS
  1605.     LXI    D,15        ; Update address including date
  1606.      ENDIF        ;Z80DOS
  1607.  
  1608.      IF    NOT Z80DOS
  1609.     LXI    D,13        ; Update address
  1610.      ENDIF        ;NOT Z80DOS
  1611.  
  1612.     DAD    D
  1613.     SHLD    NEWPTR        ; Save for later (end of table)
  1614.     POP    H        ; Set current move  to    address
  1615.     XCHG            ; Swap pointers
  1616.     POP    H        ; Set current move from address
  1617.     MVI    B,11        ; Filename.typ length
  1618.     CALL    MOVE        ; Move it
  1619.  
  1620.      IF    Z80DOS
  1621.     PUSH    H
  1622.      ENDIF        ;Z80DOS
  1623.  
  1624.     PUSH    D
  1625. OKPR2:    
  1626.     CALL    SIZEFL
  1627.     LHLD    TOTSIZ        ; DE = rounded size in K
  1628.     DAD    D        ; Add to total used
  1629.     SHLD    TOTSIZ
  1630.     LHLD    TOTFIL        ; Increment filecount
  1631.     INX    H
  1632.     SHLD    TOTFIL
  1633.     XCHG
  1634. OKPR3:
  1635.     POP    D        ; A(size to go)
  1636.     MOV    A,H        ; Move size to table two
  1637.     STAX    D
  1638.     INX    D
  1639.     MOV    A,L
  1640.     STAX    D
  1641.  
  1642.      IF    Z80DOS
  1643.     POP    H        ; Currently pointing to file size
  1644.     INX    H        ; Skip size
  1645.     INX    H
  1646.     INX    D
  1647.     MOV    A,M        ; Get LSB of date
  1648.     STAX    D        ; Save it away
  1649.     INX    D
  1650.     INX    H
  1651.     MOV    A,M        ; Ditto for MSB of date
  1652.     STAX    D
  1653.      ENDIF        ;Z80DOS
  1654. ;
  1655. ; One File Moved - Test to see if we have to move another
  1656. ;
  1657.     LHLD    COUNT        ; Current file counter
  1658.     MOV    A,H
  1659.     ORA    L
  1660.     JZ    PRTOTL        ; Zero, output summary
  1661.     JMP    ENTRY
  1662. ;.....
  1663. ;
  1664. ; Compute the size of the file/library and update our summary datum.
  1665. ; This has been changed into a subroutine so that both the file size
  1666. ; computation and a library size (when printing out library members)
  1667. ; can be computed in K.
  1668. ;
  1669. SIZEFL:    MOV    D,M
  1670.     INX    H
  1671.     MOV    E,M        ; Size in DE (records)
  1672.     XCHG
  1673.     SHLD    FILERC        ; Save record count
  1674.     XCHG
  1675.     LDA    BLKMSK
  1676.     PUSH    PSW
  1677.     ADD    E
  1678.     MOV    E,A
  1679.     MOV    A,D
  1680.     ACI    0
  1681.     MOV    D,A
  1682.     POP    PSW
  1683.     CMA
  1684.     ANA    E
  1685.     MOV    E,A
  1686.     MVI    B,3
  1687.  
  1688. SHRR:    MOV    A,D
  1689.     ORA    A
  1690.     RAR
  1691.     MOV    D,A
  1692.     MOV    A,E
  1693.     RAR
  1694.     MOV    E,A
  1695.     DCR    B
  1696.     JNZ    SHRR
  1697.     RET
  1698. ;
  1699. ; Print HL in decimal with leading zero suppression
  1700. ;
  1701. DECPRT:    XRA    A        ; Clear leading zero flag
  1702.     STA    LZFLG
  1703.     LXI    D,-10000
  1704.     LDA    SUPSPC
  1705.     PUSH    PSW
  1706.     XRA    A
  1707.     STA    SUPSPC
  1708.     CALL    DIGIT
  1709.     POP    PSW
  1710.     STA    SUPSPC
  1711.     LXI    D,-1000        ; Print 1000's digit
  1712.     CALL    DIGIT
  1713.     LXI    D,-100        ; Etc.
  1714.     CALL    DIGIT
  1715.     LXI    D,-10
  1716.     CALL    DIGIT
  1717.     MVI    A,'0'        ; Get 1's digit
  1718.     ADD    L
  1719.     JMP    PUTCHR
  1720.  
  1721. DIGIT:    MVI    B,'0'        ; Start off with ASCII 0
  1722.  
  1723. DIGLP:    PUSH    H        ; Save current remainder
  1724.     DAD    D        ; Subtract
  1725.     JNC    DIGEX        ; Quit on overflow
  1726.     POP    PSW        ; Throw away remainder
  1727.     INR    B        ; Bump digit
  1728.     JMP    DIGLP        ; Loop back
  1729.  
  1730. DIGEX:    POP    H        ; Restore pointer
  1731.     MOV    A,B
  1732.     CPI    '0'        ; Zero digit?
  1733.     JNZ    DIGNZ        ; No, type it
  1734.     LDA    LZFLG        ; Leading zero?
  1735.     ORA    A
  1736.     MVI    A,'0'
  1737.     JNZ    PUTCHR        ; Print digit
  1738.     LDA    SUPSPC        ; Get space suppression flag
  1739.     ORA    A        ; See if printing file totals
  1740.     RZ            ; Yes, don't give leading spaces
  1741.     JMP    SPACE        ; Leading zero..print space
  1742. ;
  1743. DIGNZ:    STA    LZFLG        ; Leading zero flag set
  1744.     JMP    PUTCHR        ; Print leading zero & digit
  1745. ;.....
  1746. ;
  1747. ;-----------------------------------------------------------------------
  1748. ;
  1749. ;Multiply contents of HL register by 13
  1750. ;
  1751. MULT13:    MOV    D,H
  1752.     MOV    E,L
  1753.     DAD    H
  1754.     DAD    D
  1755.     DAD    H
  1756.     DAD    H
  1757.     DAD    D
  1758.  
  1759.      IF    Z80DOS
  1760.     DAD    D        ; Actually by 15
  1761.     DAD    D        ;
  1762.      ENDIF    ;Z80DOS
  1763.  
  1764.     RET
  1765. ;.....
  1766. ;
  1767. ; Main subroutine to output a filename to be erased
  1768. ;
  1769. VENTRY:
  1770. ;.....
  1771. ;
  1772. PFILE1:
  1773.     PUSH    H
  1774.     MVI    B,8        ; Print filename and type
  1775.     CALL    PUTSB
  1776.     MVI    A,'.'
  1777.     CALL    PUTCHR
  1778.     MVI    B,3
  1779.     CALL    PUTSB
  1780.     
  1781.      IF    Z80DOS
  1782.     LDA    NODFLG
  1783.     ORA    A
  1784.     JZ    NOD3
  1785.     CALL    DISDAT        ; Display the date
  1786. NOD3:
  1787.      ENDIF        ;Z80DOS
  1788.  
  1789.     MOV    D,M        ; Get it into DE
  1790.     INX    H
  1791.     MOV    E,M
  1792.     XCHG            ; HL <-> DE
  1793.     SHLD    TFSIZE
  1794.     CALL    DECPRT        ; Print it out
  1795.     LDA    FSIZEC        ; Follow with 'k'
  1796.     CALL    PUTCHR
  1797.     POP    B        ; B point to data base with file name
  1798.     PUSH    H
  1799.     LXI    H,OUTFCB    ; Build an FCB with file name to erase
  1800.     LDA    FCB        ; Get drive number
  1801.     MOV    M,A
  1802.     INX    H        ; Point to name field of FCB
  1803.     MVI    E,0CH        ; Copy 12 chars from data base to FCB
  1804. MOVFCB:
  1805.     LDAX    B
  1806.     MOV    M,A
  1807.     INX    H
  1808.     INX    B
  1809.     DCR    E
  1810.     JNZ    MOVFCB
  1811.     LDA    NOPFLG        ; Are we in NO VERIFY?
  1812.     ORA    A
  1813.     JNZ    ERA0        ; NZ= no
  1814.     CALL    CKABRT        ; Yes, check for abort
  1815.     MVI    A,'Y'        ; Force a YES answer to erase?
  1816.     JMP    ERA1
  1817. ERA0:    LXI    D,ERAMES    ; Ask operator if should erase
  1818.     CALL    PUTS
  1819.     MVI    C,RDCON
  1820.     CALL    BDOS
  1821. ERA1:    ANI    5FH        ; Convert to upper case
  1822.     PUSH    PSW
  1823.     CPI    3        ; CTRL-C?
  1824.     JZ    ERAABO        ; Z=yes, abort
  1825.     CPI    11        ; CTRL-K
  1826.     JZ    ERAABO        ; Z=yes, abort
  1827.     CPI    'Y'        ; Y(es)?
  1828.     JNZ    NOERAS        ; NZ=no, don't erase this one
  1829.     LDA    NEWUSR        ; Set user are currently working on
  1830.     MOV    E,A        ; And set it
  1831.     MVI    C,32
  1832.     CALL    5
  1833.     LDA    OUTFCB+9    ; Change potential R/O to R/W
  1834.     ANI    7FH
  1835.     STA    OUTFCB+9
  1836.     LXI    D,OUTFCB
  1837.     MVI    C,1EH
  1838.     CALL    5        ; And set file attributes
  1839.     LXI    D,OUTFCB
  1840.     MVI    C,13H
  1841.     CALL    5        ; And go erase the file
  1842.     INR    A
  1843.     JNZ    OKERA        ; NZ= no error
  1844.     LXI    D,ERAMSE    ; Tell operator had a problem
  1845.     CALL    PUTS
  1846.     JMP    NOERAS
  1847. OKERA:
  1848.     LHLD    TFSIZE        ; size of this file in 'K'
  1849.     XCHG
  1850.     LHLD    TOTSZ1        ; Add i total so far
  1851.     DAD    D
  1852.     SHLD    TOTSZ1        ; And save it away
  1853.     LHLD    TOTFL1
  1854.     INX    H
  1855.     SHLD    TOTFL1        ; Up count of files done
  1856.     LXI    D,ERAMS1    ; Say we did it fine
  1857.     CALL    PUTS
  1858. NOERAS:
  1859.     POP    PSW
  1860.     CALL    CRLF
  1861.     POP    H
  1862.     LHLD    TOTFIL        ; Load number of files left
  1863.     DCX    H        ; # files-1
  1864.     SHLD    TOTFIL        ; Resave it
  1865.     RET            ; This return
  1866. ERAABO:
  1867.     LXI    D,CKMS1        ; Say ABORTED
  1868.     CALL    PUTS
  1869.     JMP    EX0        ; And done
  1870.  
  1871. ;.....
  1872. ;
  1873. ;              End of routines
  1874. ;-----------------------------------------------------------------------
  1875. ;
  1876. ; Show total space and files used
  1877. ;
  1878. PRTOTL:    
  1879.  
  1880. PRTOT1:    XRA    A        ; Get a zero to
  1881.     STA    SUPSPC        ; Suppress leading spaces in totals
  1882.     LHLD    TOTFIL        ; How many files matched?
  1883.     MOV    A,H
  1884.     ORA    L
  1885.     JZ    NXTUSR        ; Skip summary if none found
  1886.     PUSH    H        ; Save TOTFIL
  1887.     STA    FNDFLG        ; Set file found flag
  1888.     LDA    SOHFLG
  1889.     ORA    A
  1890.     JZ    PRTOT2
  1891.     XRA    A
  1892.     STA    SOHFLG
  1893.     JMP    PRTOT3
  1894.  
  1895. PRTOT2: ;    CALL    CRLF
  1896.  
  1897. PRTOT3:    LXI    D,TOTMS1    ; Print "13,10,' Drive'"
  1898.     CALL    PUTS
  1899.     LDA    FCB
  1900.     ADI    'A'-1
  1901.     CALL    PUTCHR        ; Output the drive code
  1902.     CALL    CKVER
  1903.     JC    NOUSER
  1904.     CALL    PUTUSR        ; Output user number
  1905.  
  1906.      IF    NDIRS
  1907.     MVI    A,' '
  1908.     CALL    PUTCHR
  1909.     CALL    NAMDIR
  1910.      ENDIF            ; NDIRS
  1911.  
  1912.     LDA    USRNR
  1913.     CPI    10
  1914.  
  1915.      IF    ULINE
  1916.     LXI    D,ULON        ; Turn on underline
  1917.     CALL    COUTS        ; If not null
  1918.      ENDIF            ; ULINE
  1919.  
  1920. NOUSER:
  1921.     POP    H        ; Recall TOTFIL
  1922.  
  1923.      IF    ULINE
  1924.     LXI    D,ULOFF        ; Turn off underline
  1925.     CALL    COUTS        ; If not null
  1926.      ENDIF            ; ULINE
  1927.     CALL    CRLF
  1928. ;
  1929. ; Summary line printed, now print detail files, first compute total
  1930. ; printout lines.
  1931. ;
  1932. NPRNT:
  1933.  
  1934.     MVI    A,1
  1935.     STA    SUPSPC        ; Allow spaces preceding file sizes
  1936.     
  1937. ;
  1938. ; Fill a record with FF at the end of table 2
  1939. ;
  1940.     LHLD    NEWPTR        ; Now points to end of table 2
  1941.     MVI    B,128
  1942.     MVI    A,0FFH
  1943.  
  1944. NPRNT2:    MOV    M,A
  1945.     INX    H
  1946.     DCR    B
  1947.     JNZ    NPRNT2
  1948. ;
  1949. ; Increment the number of files for use later in VENTRY.  This insures
  1950. ; that a column delimiter will be printed after the last filename, if
  1951. ; the file appears in other than the last column of the display.
  1952. ;
  1953. ;     IF    NOT Z80DOS
  1954. ;    LXI    H,TOTFIL
  1955. ;    INR    M
  1956. ;     ENDIF        ;NOT Z80DOS
  1957. ;
  1958. ; Print first filename
  1959. ;
  1960. NPRNT3:    LHLD    XPOINT        ; XPOINT = to start of second table
  1961.     CALL    VENTRY        ; At entry. Below, it is incremented
  1962.                 ; For additional lines of printout
  1963.  
  1964. NLINE:    LHLD    XPOINT        ; Increment XPOINT to next file
  1965.  
  1966.      IF    Z80DOS
  1967.     LXI    D,15
  1968.      ENDIF        ;Z80DOS
  1969.  
  1970.      IF    NOT Z80DOS
  1971.     LXI    D,13
  1972.      ENDIF        ;NOT Z80DOS
  1973.  
  1974.     DAD    D
  1975.     SHLD    XPOINT
  1976.     LHLD    TOTFIL        ; Out of files?
  1977.     MOV    A,H
  1978.     ORA    L
  1979.     JZ    NXTUSR        ; Yes, Check for libraries
  1980.     JMP    NPRNT3
  1981. ;
  1982. ; Directory for one user area completed.  If all users option is select-
  1983. ; ed, then go do another directory on the next user number until we ex-
  1984. ; ceed the maximum user # for the selected drive.
  1985. ;
  1986. NXTUSR:    LDA    AOPFLG        ; All user flag
  1987.     ORA    A        ; Set?
  1988.     JZ    NXTUSU        ; Set if zero, show all user areas
  1989.     LDA    HOPFLG        ; "H" flag to show remaining areas
  1990.     ORA    A
  1991.     JNZ    GOCLZ        ; Non-zero, not set, exit
  1992.  
  1993. NXTUSU:    CALL    CKVER        ; Running CP/M 2?
  1994.     JC    GOCLZ        ; No, Skip user increment
  1995.     CALL    CKABRT        ; Yes, Check for user abort
  1996.     LDA    MAXUSR        ; No abort - get maximum user #
  1997.     LXI    H,NEWUSR    ; Increment directory user number
  1998.     INR    M
  1999.     CMP    M        ; Next user # exceed maximum?
  2000.     JNC    SETTBL        ; No, more user areas to go
  2001.     LDA    BASUSR        ; Reset base user number for
  2002.     MOV    M,A        ; The next directory search
  2003. ;
  2004. ; We've finished all of our outputting. Flush the remainder of the out-
  2005. ; put buffer and close the file before going to exit routine.
  2006. ;
  2007. GOCLZ:
  2008. NXTDSK:    LXI    H,FNDFLG    ; Load file found flag
  2009.     MOV    A,M
  2010.     MVI    M,0        ; Clear found flag for next drive
  2011.     ORA    A
  2012.     JNZ    NDSK        ; Continue if at least 1 file found
  2013.     LXI    D,NOFMS1    ; Print 1st part of no files message
  2014.     CALL    PUTS        ; Print it
  2015.     LXI    D,NOFLM
  2016.     CALL    PUTS        ; Print message
  2017.     LDA    FCB
  2018.     ADI    'A'-1
  2019.     CALL    PUTCHR        ; Output the drive
  2020.     CALL    CKVER
  2021.     JC    NOUSR1
  2022.     CALL    PUTUSR        ; Output the user number
  2023.  
  2024. NOUSR1:    CALL    CRLF
  2025.  
  2026. NDSK:    LDA    DOPFLG        ; Multi-disk selected?
  2027.     ORA    A
  2028.     JNZ    NPRT        ; No, skip next check
  2029.     CALL    CKABRT        ; Check for user abort
  2030.     MVI    A,HIDRV-LODRV    ; Load max drive code to search
  2031.     LXI    H,FCB        ; Increment directory FCB drive code
  2032.     INR    M
  2033.     CMP    M        ; Does next disk exceed maximum?
  2034.     JC    NPRT
  2035.  
  2036.      IF    MAXDRV
  2037.  
  2038.      IF    ZCPR33
  2039.     PUSH    H
  2040.     LHLD    Z3DRVL        ; Point to ENV
  2041.     MOV    A,M        ; Get it
  2042.     POP    H
  2043.      ENDIF        ;ZCPR33
  2044.  
  2045.      IF    NOT ZCPR33
  2046.     LDA    MXDRV        ; Look at another value limit
  2047.     INR    A
  2048.      ENDIF        ;NOT ZCPR33
  2049.  
  2050.     CMP    M        ; Is it lower?
  2051.     JC    NPRT        ; Bail out if too low
  2052.     JMP    NOOPT        ; Search next disk
  2053.      ENDIF            ; MAXDRV
  2054.  
  2055.     JNC    NOOPT        ; Search next disk if maxdr not true
  2056. ;
  2057. ; If no printer, fall through to EXIT
  2058. ;
  2059. NPRT:
  2060.     JMP    EXIT        ; All done - exit to CCP
  2061. ;.....
  2062. ;
  2063. ; Output the user number of the directory in decimal
  2064. ;
  2065. PUTUSR:    LDA    NEWUSR
  2066.     CPI    10        ; User no. < 10?
  2067.     JC    DUX        ; Yes, skip 10's digit
  2068.     STA    USRNR
  2069.     PUSH    B        ; No, process 10's digit
  2070.     MVI    C,'0'-1
  2071.  
  2072. DUY:    INR    C        ; Get tens digit
  2073.     SUI    10
  2074.     JNC    DUY        ; Loop until we've gone too far
  2075.     ADI    10
  2076.     MOV    B,A        ; Save units digit
  2077.     MOV    A,C        ; Print tens digit
  2078.     CALL    PUTCHR
  2079.     MOV    A,B        ; Recall units digit
  2080.     POP    B
  2081.  
  2082. DUX:    ADI    '0'        ; Make it ASCII
  2083.     JMP    PUTCHR
  2084.  
  2085. ;.....
  2086. ;
  2087. ; Force new line on output and check for page pause
  2088. ;
  2089. CRLF:    MVI    A,13        ; Send CR
  2090.     CALL    PUTCHR
  2091.     MVI    A,10        ; Send LF
  2092.     JMP    PUTCHR
  2093. ;.....
  2094.  
  2095. SPACE:    MVI    A,' '
  2096. ;
  2097. ; Output character in A to console, and optionally to printer
  2098. ; and/or the output file.  Detects user abort request.
  2099. ;
  2100. PUTCHR:    PUSH    B
  2101.     PUSH    D
  2102.     PUSH    H
  2103.     PUSH    PSW        ; Save the character to output
  2104.     CALL    HITYPE        ; Send it to console
  2105.     POP    PSW        ; Restore the output character
  2106.     ANI    7FH        ; Strip parity bit on character
  2107. ;
  2108. ; Test for erase mode no verify
  2109. ;
  2110.     MOV    B,A        ; Save stripped character to B
  2111.     CPI    10        ; At end of line?
  2112.     JNZ    NOTEOL
  2113.     PUSH    PSW
  2114.     LDA    NOPFLG
  2115.     ORA    A
  2116.     JNZ    PAUSON
  2117.     LDA    LINCNT        ; Load line count
  2118.     INR    A        ; Bump it
  2119.     STA    LINCNT
  2120.     MVI    L,23        ; Allows use of [more] to finish display
  2121.     CMP    L        ; End of the screen?
  2122.     JC    PAUSON
  2123.     LXI    D,EOSMSG    ; Else, display pause message
  2124.     MVI    C,PRINT        ; Without checking for line feeds
  2125.     CALL    BDOS
  2126.     CALL    GETCH        ; Wait for character
  2127.     CPI    'C'-40H        ; Abort on CTL-C
  2128.     JZ    EXIT1
  2129.     CPI    'K'-40H        ; Or CTL-K
  2130.     JZ    EXIT1
  2131.     CPI    'X'-40H        ; Or CTL-X
  2132.     JZ    EXIT1
  2133.     CPI    ' '        ; See if printing character
  2134.     JC    NOTEOS        ; Exit if not
  2135.     ANI    5FH        ; Change to upper-case
  2136.     CPI    'C'        ; Can abort with c, C
  2137.     JZ    EXIT1
  2138.     CPI    'K'        ; Can abort with k, K
  2139.     JZ    EXIT1
  2140.     CPI    'X'        ; Can abort with x, X
  2141.     JZ    EXIT1
  2142. NOTEOS:    XRA    A        ; Reset line count
  2143.     STA    LINCNT
  2144.     LXI    D,MORERA    ; Overwrite the [more] display
  2145.     MVI    C,PRINT
  2146.     CALL    BDOS
  2147. PAUSON:    POP    PSW
  2148.     CZ    CKABRT        ; Check for user abort request
  2149. NOTEOL:    POP    H        ; Exit from PUTCHR
  2150.     POP    D
  2151.     POP    B
  2152.     RET
  2153. ;.....
  2154. ;
  2155. ; Fetch character from console (without echo)
  2156. ;
  2157. GETCH:    LHLD    0000H+1        ; Warm Boot Address
  2158.     MVI    L,9        ; Direct Console
  2159.     CALL    GOHL        ; Get Character
  2160.     ANI    7FH        ; Strip off any parity
  2161.     RET
  2162.  
  2163. ;.....
  2164. ;
  2165. ; Output character, with low-case or reverse-video highlighting if high
  2166. ; bit set and conditionals enabled.
  2167. ;
  2168. HITYPE:    DS    0
  2169.  
  2170.      IF    USELC OR REVID
  2171.     ORA    A        ; Check for attributes not set
  2172.     JP    CONOUT        ; No attribute..ignore this one
  2173.     ANI    7FH        ; Attribute set, delete now
  2174.      ENDIF            ; USELC OR REVID
  2175.  
  2176.      IF    NOT USELCW AND WHEEL
  2177.     MOV    E,A        ; Save the character for later
  2178.  
  2179.      IF    ZCPR33
  2180.     PUSH    H
  2181.     LHLD    Z3WHLL        ; Point to enviorment
  2182.     MOV    A,M        ; Get it
  2183.     POP    H
  2184.      ENDIF        ;ZCPR33
  2185.  
  2186.      IF    NOT ZCPR33
  2187.     LDA    WHLOC        ; Get wheel byte
  2188.      ENDIF        ;NOT ZCPR33
  2189.  
  2190.     ORA    A        ; Don't use lower case or REVID
  2191.     MOV    A,E        ; Get back the character to display
  2192.     JZ    CONOUT
  2193.      ENDIF            ; NOT USELCW AND WHEEL
  2194.  
  2195.      IF    REVID
  2196.     PUSH    PSW        ; Save character
  2197.     LXI    D,RVON        ; Turn on reverse video
  2198.     CALL    COUTS        ; If not null
  2199.     POP    PSW        ; Restore character
  2200.      ENDIF            ; REVID
  2201.  
  2202.      IF    USELC
  2203.     CPI    'A'        ; Change only from A-Z
  2204.     JC    TYPEC
  2205.     CPI    'Z'+1
  2206.     JNC    TYPEC        ; Punctuation can change so leave it
  2207.     ORI    20H        ; If attribute, make lower case
  2208.      ENDIF            ; USELC
  2209.  
  2210.      IF    USELC OR REVID
  2211. TYPEC:    CALL    CONOUT        ; Send the processed character
  2212.      ENDIF            ; USELC OR REVID
  2213.  
  2214.      IF    REVID
  2215.     LXI    D,RVOFF        ; Turn off reverse video
  2216.     CALL    COUTS        ; If not null
  2217.      ENDIF            ; REVID
  2218.  
  2219.      IF    USELC OR REVID
  2220.     RET
  2221.      ENDIF            ; USELC OR REVID
  2222. ;.....
  2223. ;
  2224. ; Output character in A to console
  2225. ;
  2226. CONOUT:    MOV    E,A        ; Get character for BDOS entry
  2227.     MVI    C,WRCON
  2228.     JMP    BDOS        ; Console Output
  2229. ;.....
  2230. ;
  2231. ; Output (raw) null-terminated string at (DE) to console.
  2232. ;
  2233.  
  2234. COUTS:    LDAX    D        ; Get byte of string
  2235.     ORA    A        ; Null?
  2236.     RZ            ; Return if so
  2237.     PUSH    D
  2238.     CALL    CONOUT
  2239.     POP    D
  2240.     INX    D        ; Next byte
  2241.     JMP    COUTS
  2242. ;.....
  2243. ;
  2244. ; Output bytes at HL of length B to console/printer/file
  2245. ;
  2246. PUTSB:    MOV    A,M
  2247.     CALL    PUTCHR
  2248.     INX    H
  2249.     DCR    B
  2250.     JNZ    PUTSB
  2251.     RET
  2252. ;.....
  2253. ;
  2254. ; Output null-terminated string to console/printer/file
  2255. ;
  2256. PUTS:    LDAX    D        ; Load character from DE string
  2257.     ANI    7FH        ; Strip off parity
  2258.     ORA    A        ; Is a 0?
  2259.     RZ            ; Yes, Terminate
  2260.     CALL    PUTCHR        ; Display character
  2261.     INX    D        ; Next string position
  2262.     JMP    PUTS        ; Continue
  2263. ;
  2264. ; Check for a CTL-C or CTL-S entered from the keyboard.  Jump to EXIT if
  2265. ; CTL-C, pause on CTL-S.
  2266. ;
  2267. CKABRT:    PUSH    H
  2268.     PUSH    D
  2269.     PUSH    B
  2270.     MVI    C,CONST
  2271.     CALL    BDOS
  2272.     ORA    A
  2273.     JZ    CKAB3        ; No character, exit
  2274.     MVI    C,RDCON
  2275.     CALL    BDOS
  2276.     ANI    5FH
  2277.     CPI    'S'-40H
  2278.     JZ    CKAB0
  2279.     CPI    'S'
  2280.     JNZ    CKAB1
  2281.     CALL    CKAB4
  2282.  
  2283. CKAB0:    MVI    C,RDCON
  2284.     CALL    BDOS
  2285.     ANI    5FH
  2286.  
  2287. CKAB1:    CPI    'C'-40H        ; CTL-C?
  2288.     JZ    CKAB2        ; Yes, quit
  2289.     CPI    'K'-40H
  2290.     JZ    CKAB2
  2291.     CPI    'X'-40H
  2292.     JZ    CKAB2
  2293.     CPI    ' '        ; Any other CTL-character, abort
  2294.     JC    CKAB3
  2295.     CALL    CKAB4        ; Clear the character from screen
  2296.     CPI    'C'
  2297.     JZ    CKAB2
  2298.     CPI    'K'
  2299.     JZ    CKAB2
  2300.     CPI    'X'
  2301.     JNZ    CKAB3
  2302.  
  2303. CKAB2:    LXI    D,CKMS1
  2304.     CALL    PUTS
  2305.     POP    B
  2306.     POP    D
  2307.     POP    H
  2308.     JMP    EX0        ; All done
  2309.  
  2310. CKAB3:    POP    B
  2311.     POP    D
  2312.     POP    H
  2313.     RET
  2314.  
  2315. CKAB4:    PUSH    PSW
  2316.     LXI    D,CKMS2
  2317.     CALL    PUTS
  2318.     POP    PSW
  2319.     RET
  2320. ;.....
  2321. ;
  2322. ; Call here to call address in HL
  2323. ;
  2324. GOHL:    PCHL
  2325. ;
  2326. ; Enter BDOS, save all extended registers
  2327. ;
  2328. CPM:    PUSH    B        ; Save Registers
  2329.     PUSH    D
  2330.     PUSH    H
  2331.  
  2332.  
  2333.      IF    ZRDOS
  2334.     LDA    ZRDFLG        ; ZRDOS running?
  2335.     ORA    A
  2336.     JNZ    ZRD        ; ZRDOS error trap and DOSs call
  2337.      ENDIF            ; ZRDOS
  2338.  
  2339.     CALL    BDOS
  2340.     MOV    B,A        ; Save return code
  2341.     LDA    VERFLG        ; Is this 3.0?
  2342.     CPI    30H
  2343.     MOV    A,B
  2344.     JC    CPM20        ; No, exit normally
  2345.     CPI    0FFH        ; Yes, was return code FF?
  2346.     JNZ    CPM20        ; No, exit normally
  2347.     MOV    A,H        ; Yes, check for error code
  2348.     ORA    A
  2349.     JNZ    DSKERR        ; Exit if physical error
  2350.     MOV    A,B        ; Else, continue normally
  2351.  
  2352. CPM20:    POP    H
  2353.     POP    D
  2354.     POP    B
  2355.     RET
  2356.  
  2357. ;.....
  2358. ;
  2359. ; ZRDOS Error Trap and System Call exits to CPM20
  2360. ;
  2361.      IF    ZRDOS
  2362. ZRD:    CALL    SETTRAP        ; Set the warm boot trap
  2363.     CALL    BDOS        ; Do what we're told
  2364.     CALL    RESTRAP        ; Reset the trap
  2365.     JMP    CPM20        ; Error free exit
  2366. ;.....
  2367. ;
  2368. ; Set Warm Boot Trap in ZRDOS
  2369. ;
  2370. SETTRAP:PUSH    H
  2371.     PUSH    D
  2372.     PUSH    B
  2373.     MVI    C,SETWBT    ; Set warm boot trap to come here
  2374.     LXI    D,WBTRAP
  2375.     CALL    BDOS
  2376.     POP    B
  2377.     POP    D
  2378.     POP    H
  2379.     RET
  2380. ;.....
  2381. ;
  2382. ; WBTRAP is where the ZRDOS returns control on warm boot (error)
  2383. ;
  2384. WBTRAP:    LXI    H,DSKERR    ; Return here after trap reset
  2385.     PUSH    H        ; Save DSKERR on stack
  2386. ;
  2387. ; Reset Warm Boot Trap in ZRDOS
  2388. ;
  2389. RESTRAP:PUSH    H
  2390.     PUSH    D
  2391.     PUSH    B
  2392.     PUSH    PSW
  2393.     MVI    C,RESWBT    ; Reset warm boot trap
  2394.     CALL    BDOS
  2395.     POP    PSW
  2396.     POP    B
  2397.     POP    D
  2398.     POP    H
  2399.     RET
  2400.      ENDIF            ; ZRDOS
  2401.  
  2402.  
  2403. ;.....
  2404. ;
  2405. ; For file output mode, return to old user area and set DMA for the file
  2406. ; output buffer.
  2407. ;
  2408. SETFOP:    CALL    CKVER        ; Clear carry if CP/M 2 or later
  2409.     LDA    OLDUSR        ; Get user number at startup
  2410.     MOV    E,A
  2411.     MVI    C,STUSER
  2412.     CNC    CPM        ; Reset old user number if CP/M 2
  2413.     LXI    D,OUTBUF    ; Move DMA from search buffer into
  2414.     JMP    SET2        ; Output buffer
  2415.     RET
  2416. ;.....
  2417. ;
  2418. ; Move disk buffer DMA to default buffer for directory search operations
  2419. ; and BDOS media change routines (required for pre-CP/M 2 systems while
  2420. ; in file output mode with active buffer).
  2421. ;
  2422. SETSRC:    LXI    D,TBUF        ; Default DMA Address
  2423.  
  2424. SET2:    MVI    C,STDMA        ; Set DMA Address
  2425.     JMP    CPM
  2426. ;.....
  2427. ;
  2428. ; Print amount of free space remaining on selected drive
  2429. ;
  2430. PRTFRE:    LXI    D,TOTMS7    ; Print " Free: '
  2431.     CALL    PUTS
  2432.     LHLD    FREEBY
  2433.     CALL    DECPRT        ; Print k free
  2434.     LXI    D,TOTMS8    ; Print "k "
  2435.     CALL    PUTS
  2436.     RET
  2437. ;.....
  2438. ;
  2439. ; Show string on the console
  2440. ;
  2441. SHOW:    LDAX    D        ; Get character from DE string
  2442.     ANI    7FH        ; Strip off parity
  2443.     ORA    A        ; Is it a 0?
  2444.     RZ            ; Yes, terminate
  2445.     PUSH    B        ; Save registers
  2446.     PUSH    D
  2447.     PUSH    H
  2448.     CALL    CONOUT        ; Show character on console
  2449.     POP    H        ; Load registers
  2450.     POP    D
  2451.     POP    B
  2452.     INX    D        ; Next string position
  2453.     JMP    SHOW        ; Continue
  2454. ;.....
  2455. ;
  2456. ; Compare routine for last extent of file search
  2457. ;
  2458. COMPR:    PUSH    H        ; Save table address
  2459.     MOV    E,M        ; Load low order
  2460.     INX    H
  2461.     MOV    D,M        ; Load high order
  2462.     INX    H
  2463.     MOV    C,M
  2464.     INX    H
  2465.     MOV    B,M
  2466. ;
  2467. ; BC, DE now point to entries to be compared
  2468. ;
  2469.     XCHG
  2470.     MOV    E,A        ; Get count
  2471.  
  2472. CMPLP:    LDAX    B
  2473.     XRA    M        ; Copy bit 7 of M
  2474.     ANI    7FH        ; Into bit 7 of A
  2475.     XRA    M
  2476.     CMP    M        ; Then compare
  2477.     INX    H
  2478.     INX    B
  2479.     JNZ    NOTEQL        ; Quit on mismatch
  2480.     DCR    E        ; Or end of count
  2481.     JNZ    CMPLP
  2482. ;
  2483. NOTEQL:    POP    H
  2484.     RET            ; Condition code tells all
  2485. ;.....
  2486. ;
  2487. ; Swap entries in the order table
  2488. ;
  2489. SWAP:    LXI    B,ORDER-2    ; Table base
  2490.     DAD    H        ; *2
  2491.     DAD    B        ; + base
  2492.     XCHG
  2493.     DAD    H        ; *2
  2494.     DAD    B        ; + base
  2495.     MOV    C,M
  2496.     LDAX    D
  2497.     XCHG
  2498.     MOV    M,C
  2499.     STAX    D
  2500.     INX    H
  2501.     INX    D
  2502.     MOV    C,M
  2503.     LDAX    D
  2504.     XCHG
  2505.     MOV    M,C
  2506.     STAX    D
  2507.     RET
  2508. ;.....
  2509. ;
  2510. ; New compare routine for sorting
  2511. ;
  2512. COMPARE:LXI    B,ORDER-2
  2513.     DAD    H
  2514.     DAD    B
  2515.     XCHG
  2516.     DAD    H
  2517.     DAD    B
  2518.     XCHG
  2519.     MOV    C,M
  2520.     INX    H
  2521.     MOV    B,M
  2522.     XCHG
  2523.     MOV    E,C
  2524.     MOV    D,B
  2525.     MOV    C,M
  2526.     INX    H
  2527.     MOV    H,M
  2528.     MOV    L,C
  2529.     MVI    B,13        ; Count for normal sort
  2530.     LDA    TOPFLG        ; Check for sort by type
  2531.     ORA    A
  2532.     JNZ    CMPLPE        ; Jump if normal sort
  2533.     PUSH    H        ; Save name pointers for later
  2534.     PUSH    D
  2535.     LXI    B,8        ; Point to file types
  2536.     DAD    B
  2537.     XCHG
  2538.     DAD    B
  2539.     XCHG
  2540.     MVI    B,3        ; Count for type compare
  2541.     CALL    CMPLPE
  2542.     POP    D        ; Retrieve name pointers
  2543.     POP    H        ;
  2544.     RNZ
  2545.     MVI    B,8        ; Count for name compare
  2546.     CALL    CMPLPE
  2547.     RNZ
  2548.     INX    D        ; Point to extent
  2549.     INX    D
  2550.     INX    D
  2551.     INX    H
  2552.     INX    H
  2553.     INX    H
  2554.     MVI    B,2        ; Count for extent compare
  2555.  
  2556. CMPLPE:    LDAX    D        ;
  2557.     XRA    M        ; Copy bit 7 of M
  2558.     ANI    7FH        ; Into bit 7 of A
  2559.     XRA    M        ;
  2560.     CMP    M        ; Then compare
  2561.     INX    D
  2562.     INX    H
  2563.     RNZ
  2564.     DCR    B
  2565.     JNZ    CMPLPE
  2566.     RET
  2567. ;.....
  2568. ;
  2569. ; Error exit
  2570. ;
  2571. ERXIT:
  2572.     CALL    CRLF        ; Space down
  2573.     POP    D        ; Load message string pointer
  2574.     CALL    PUTS        ; Print message
  2575.     LXI    D,ERRMS1    ; " Error"
  2576.     CALL    PUTS        ; Print message
  2577.     CALL    CRLF        ; Space down
  2578. ;
  2579. ; Exit - all done, restore stack
  2580. ;
  2581. EXIT:    LDA    DOPFLG        ; Multi-disk selected?
  2582.     ORA    A
  2583.     JNZ    EX0        ; No, skip next
  2584.     CALL    CKABRT        ; Check for user abort
  2585.     MVI    A,HIDRV-LODRV    ; Maximum drive code to search
  2586.     LXI    H,FCB        ; Increment directory FCB drive code
  2587.     INR    M
  2588.     CMP    M        ; Does next disk exceed maximum?
  2589.     JC    EX0
  2590.  
  2591.      IF    MAXDRV
  2592.  
  2593.      IF    ZCPR33
  2594.     PUSH    H
  2595.     LHLD    Z3DRVL        ; Point to ENV
  2596.     MOV    A,M        ; Get it
  2597.     POP    H
  2598.      ENDIF        ;ZCPR33
  2599.  
  2600.      IF    NOT ZCPR33
  2601.     LDA    MXDRV        ; Look at another value limit
  2602.     INR    A
  2603.      ENDIF        ;NOT ZCPR33
  2604.  
  2605.     CMP    M        ; Is it lower?
  2606.     JC    EX0        ; Bail out if too low
  2607.     JMP    NOOPT        ; Search next disk
  2608.      ENDIF            ; MAXDRV
  2609.  
  2610.     JNC    NOOPT        ; Search next disk if MAXDR not true
  2611.  
  2612. EX0:
  2613.     CALL    CRLF
  2614.     MVI    C,CONST        ; Check console status
  2615.     CALL    CPM
  2616.     ORA    A        ; Character waiting?
  2617.     MVI    C,RDCON
  2618.     CNZ    CPM        ; Gobble up character
  2619.  
  2620.      IF    ZRDOS
  2621.     LDA    ZRDFLG        ; ZRDOS running?
  2622.     ORA    A
  2623.     JNZ    EXIT2        ; Yes
  2624.      ENDIF            ; ZRDOS
  2625.  
  2626.     LDA    VERFLG        ; Version flag
  2627.     CPI    30H        ; CP/M 3.0?
  2628.     JC    EXIT1        ; No
  2629.     MVI    C,2DH        ; Yes,
  2630.     MVI    E,0        ; Reset error mode to default
  2631.     CALL    CPM
  2632.     JMP    EXIT2        ; Quit
  2633.  
  2634. EXIT1:    LDA    DOPFLG        ; If they were swapped
  2635.     ORA    A
  2636.     CZ    SWAPEM
  2637.  
  2638. EXIT2    EQU    $
  2639.  
  2640.  
  2641.     LDA    AOPFLG        ; Doing all users
  2642.     MOV    C,A
  2643.     LDA    DOPFLG        ; Or disk?
  2644.     ANA    C
  2645.     MOV    C,A
  2646.     LDA    HOPFLG        ; Or higher users?
  2647.     ANA    C
  2648.     JNZ    TOTDONE        ; If no, skip totals
  2649.     LXI    D,ALLTOT    ; First part of message
  2650.     CALL    PUTS
  2651.     LHLD    TOTFL1        ; Total files found
  2652.     CALL    DECPRT
  2653.     LXI    D,TOTMS4
  2654.     CALL    PUTS
  2655.     LHLD    TOTSZ1        ; Total 'k' found
  2656.     CALL    DECPRT
  2657.     LXI    D,TOTMS8
  2658.     CALL    PUTS
  2659.     LXI    D,TOTMS7
  2660.     CALL    PUTS
  2661.     LHLD    TOTFRE
  2662.     XCHG
  2663.     LHLD    TOTSZ1
  2664.     DAD    D
  2665.     CALL    DECPRT
  2666.     LXI    D,ALLTO1
  2667.     CALL    PUTS
  2668. TOTDONE:
  2669.      IF    WMBOOT
  2670.     JMP    0000H
  2671.      ENDIF            ; WMBOOT
  2672.  
  2673.     LDA    OLDDSK        ; Restore original drive
  2674.     MOV    E,A
  2675.     MVI    C,14
  2676.     CALL    CPM
  2677.     LDA    OLDUSR        ; Restore original user area
  2678.     MOV    E,A
  2679.     MVI    C,32
  2680.     CALL    CPM
  2681.  
  2682. EXIT3:    LHLD    STACK        ; Get old stack pointer
  2683.     SPHL            ; Move back to old stack
  2684.     RET            ; And return to CCP
  2685. ;.....
  2686. ;
  2687.      IF    NDIRS
  2688. NAMDIR:    MVI    A,0
  2689.     STA    CURDIR        ; Initial check count
  2690.  
  2691. NAMDR1:    LHLD    NAMADR        ; Named directory buffer address
  2692.  
  2693. NAMDR2:    LDA    FCB        ; Get current Drive
  2694.     CMP    M        ; Does NDR entry match current drive?
  2695.     JNZ    NXTDIR        ; No, check next
  2696.     LDA    NEWUSR        ; Get current user
  2697.     INX    H
  2698.     CMP    M        ; Does NDR entry match current user?
  2699.     JNZ    NXTDIR        ; No, check next
  2700.     MVI    A,'['        ; Frame the name in brackets
  2701.     CALL    PUTCHR
  2702.     MVI    C,8        ; Number of Characters in entry
  2703.  
  2704. DIRCHR:    INX    H        ; Match, Point to Directory Name
  2705.     MOV    A,M        ; Get Character
  2706.     CPI    20H        ; End of entry?
  2707.     JNZ    DIRCH1        ; No
  2708.  
  2709. DIRCH0:    PUSH    PSW
  2710.     MVI    A,']'        ; Print closing bracket
  2711.     CALL    PUTCHR
  2712.     POP    PSW
  2713.     JMP    DIRCH2
  2714.  
  2715. DIRCH1:    CALL    PUTCHR
  2716.     DCR    C
  2717.     JNZ    DIRCHR        ; Output Eight characters
  2718.     JMP    DIRCH0
  2719.     RET            ; Done
  2720. DIRCH2:    MOV    A,C
  2721.     ORA    A
  2722.     RZ
  2723.     MVI    A,20H        ; Fill with spaces for neatness sake
  2724.     CALL    PUTCHR
  2725.     DCR    C
  2726.     JNZ    DIRCH2
  2727.     RET
  2728.  
  2729. NXTDIR:    LDA    CURDIR
  2730.     ADI    1        ; Increment Directory pointer
  2731.     STA    CURDIR
  2732.     LXI    H,NUMDIR
  2733.     CMP    M        ; Exceeded Max Entry?
  2734.     JZ    NODIR        ; Yes, there is no entry for this DU
  2735.     LHLD    NAMADR        ; Get base NDR address
  2736.     MVI    D,0
  2737.     MVI    E,18        ; Increment to next entry
  2738.  
  2739. NXTD:    DAD    D
  2740.     DCR    A        ; Decrement count
  2741.     JNZ    NXTD        ; Until current Offset reached
  2742.     JMP    NAMDR2        ; And check the entry for a match
  2743. NODIR:    MVI    C,10        ; No match, output ten spaces
  2744.  
  2745. NODIR1:    MVI    A,20H
  2746.     CALL    PUTCHR
  2747.     DCR    C
  2748.     JNZ    NODIR1
  2749.     RET
  2750.      ENDIF            ; NDIRS
  2751. ;.....
  2752. ;
  2753. ; Trap BDOS select and sector error vectors to our own intercept routine
  2754. ; so we can catch a reference to an illegal drive.
  2755. ;
  2756. SWAPEM:    DS    0
  2757.  
  2758.      IF    ZRDOS
  2759.     LDA    ZRDFLG        ; See if ZRDOS running
  2760.     ORA    A
  2761.     RNZ            ; Yes, quit this
  2762.      ENDIF            ; ZRDOS
  2763.  
  2764.     LDA    VERFLG        ; Version flag
  2765.     CPI    30H        ; Error mode call available?
  2766.     JC    SWAP20        ; No, use BDOS error vectors
  2767.     MVI    C,2DH        ; Yes, use error mode call
  2768.     MVI    E,0FFH        ;
  2769.     CALL    CPM        ; Set "return code only" mode
  2770.     RET
  2771.  
  2772. SWAP20:    LHLD    BDOS+1        ; Load pointer to base of BDOS
  2773.     INX    H        ; Swap new pointer if running a
  2774.     MOV    E,M        ; Program below the CCP
  2775.     INX    H
  2776.     MOV    D,M
  2777.     XCHG            ; HL points to the proper vector
  2778.     MVI    L,9        ; Point to record error vector
  2779.     LXI    D,VECTBL    ; Exchange with our vector table
  2780.     MVI    A,4        ; 4 bytes to swap
  2781.  
  2782. SWAPLP:    MOV    B,M        ; Load byte from HL
  2783.     XCHG
  2784.     MOV    C,M        ; Load byte from DE
  2785.     MOV    M,B        ; Save byte from HL
  2786.     XCHG
  2787.     MOV    M,C        ; Save byte from DE
  2788.     INX    H        ; Increment exchange pointers
  2789.     INX    D
  2790.     DCR    A        ; Counter-1
  2791.     JNZ    SWAPLP        ; Continue swapping
  2792.     RET
  2793. ;.....
  2794. ;
  2795. ; Check CP/M version number. Return carry flag set if pre-CP/M 2.  If
  2796. ; CP/M 2 or later or MP/M (any version), return carry clear.
  2797. ;
  2798. CKVER:    LDA    VERFLG        ; Version Flag
  2799.     CPI    20H        ; CP/M 2.0?
  2800.     RET
  2801. ;.....
  2802. ;
  2803. ; Return point from intercepted BDOS select and bad record errors.
  2804. ;
  2805. DSKERR:    LXI    SP,STACK    ; Get out of BDOS' stack
  2806.     JMP    EXIT        ; And exit back to CCP
  2807. ;.....
  2808. ;
  2809. ;-----------------------------------------------------------------------
  2810. ;             Start of FNAME routine
  2811. ;
  2812. ; Main module
  2813. ;    on entry, DE points to FCB to be filled, HL points to first
  2814. ;        byte of target string, RFCB is 36 bytes long
  2815. ;    on exit, B=disk number (1 for A, etc.) and C=user number
  2816. ;        HL points to terminating character
  2817. ;        A=0 and Z set if error in disk or user numbers
  2818. ;        A=0FFH and NZ if ok
  2819. ;
  2820. MAXDISK    EQU    16        ; Maximum number of disks
  2821. MAXUSER    EQU    31        ; Maximum user number
  2822.  
  2823. FNAME:    PUSH    D        ; Save DE
  2824.     MVI    A,0FFH        ; Set default disk and user
  2825.     STA    DISKNO
  2826.     STA    USERNO
  2827.     MVI    B,36        ; Initialize FCB
  2828.     PUSH    D        ; Save pointer
  2829.     XRA    A        ; A=0
  2830.  
  2831. FNINI:    STAX    D        ; Store zero
  2832.     INX    D        ; Point to next
  2833.     DCR    B        ; Count down
  2834.     JNZ    FNINI
  2835.     POP    D        ; Get pointer back
  2836.     PUSH    H        ; Save pointer
  2837. ;
  2838. ; Scan for colon, comma, or space in string
  2839. ;
  2840. COLON:    MOV    A,M        ; Scan for colon or space
  2841.     INX    H        ; Point to next
  2842.     CPI    ':'        ; Colon found?
  2843.     JZ    COLON1
  2844.     CPI    ','        ; Comma found?
  2845.     JZ    GETF1
  2846.     CPI    ' '+1        ; Delimiter?
  2847.     JC    GETF1
  2848.     JMP    COLON        ; Continue if not EOL
  2849. ;
  2850. COLON1:    POP    H        ; Clear stack
  2851.     MOV    A,M        ; Save possible drive specification
  2852.     CALL    CAPS        ; Capitalize
  2853.     CPI    'A'        ; Digit if less than "A"
  2854.     JC    USERCK        ; Process user number
  2855.     SUI    'A'        ; Change from ASCII to binary
  2856.     CPI    MAXDISK        ; Within bounds?
  2857.     JC    SVDISK
  2858. ;
  2859. ERREXIT:XRA    A        ; Error indicator
  2860.     POP    D        ; Restore DE
  2861.     RET
  2862. ;.....
  2863. ;
  2864. ; Log in specified disk
  2865. ;
  2866. SVDISK:    INR    A        ; Adjust to 1 for "A"
  2867.     STA    DISKNO        ; Save flag
  2868.     INX    H        ; Point to next character
  2869. ;
  2870. ; Check for user
  2871. ;
  2872. USERCK:    MOV    A,M        ; Get possible user #
  2873.     CPI    ':'        ; No user number
  2874.     JZ    GETFILE
  2875.     CPI    '?'        ; All user numbers?
  2876.     JNZ    USERC1
  2877.     STA    USERNO        ; Set value
  2878.     INX    H        ; Point to after
  2879.     MOV    A,M        ; Must be colon
  2880.     CPI    ':'
  2881.     JZ    GETFILE
  2882.     JMP    ERREXIT        ; Fatal error if not colon after ?
  2883.  
  2884. USERC1:    XRA    A        ; Zero user number
  2885.     MOV    B,A        ; B = A for user number
  2886.  
  2887. USRLOOP:MOV    A,M        ; Get digit
  2888.     INX    H        ; Point to next
  2889.     CPI    ':'        ; Done?
  2890.     JZ    USRDN
  2891.     SUI    '0'        ; Convert to binary
  2892.     JC    ERREXIT        ; User number error?
  2893.     CPI    10
  2894.     JNC    ERREXIT
  2895.     MOV    C,A        ; Next digit in C
  2896.     MOV    A,B        ; Old number in A
  2897.     ADD    A        ; *2
  2898.     ADD    A        ; *4
  2899.     ADD    B        ; *5
  2900.     ADD    A        ; *10
  2901.     ADD    C        ; *10+new digit
  2902.     MOV    B,A        ; Result in B
  2903.     JMP    USRLOOP
  2904.  
  2905. USRDN:    MOV    A,B        ; Get newer user number
  2906.     CPI    MAXUSER+1    ; Within range?
  2907.     JNC    ERREXIT
  2908.     STA    USERNO        ; Save in flag
  2909.     JMP    GETFILE
  2910. ;
  2911. ; Extract file name
  2912. ;
  2913. GETF1:    POP    H        ; Get pointer to byte
  2914. ;
  2915. GETFILE:MOV    A,M        ; Pointing to colon?
  2916.     CPI    ':'
  2917.     JNZ    GFILE1
  2918.     INX    H        ; Skip over colon
  2919.  
  2920. GFILE1:    MOV    A,M        ; Get next character
  2921.     CPI    ','        ; Delimiter?
  2922.     JZ    GFQUES
  2923.     CPI    ' '+1        ; Not a delimiter?
  2924.     JNC    GFILE2
  2925.  
  2926. GFQUES:    INX    D        ; Fill with ???
  2927.     MVI    B,11        ; 11 bytes
  2928.     MVI    A,'?'
  2929.  
  2930. GFFILL:    STAX    D        ; Put?
  2931.     INX    D        ; Point to next
  2932.     DCR    B        ; Count down
  2933.     JNZ    GFFILL
  2934.  
  2935. FNDONE:    LDA    DISKNO        ; Get disk number
  2936.     MOV    B,A        ; In 'B'
  2937.     LDA    USERNO        ; Get user number
  2938.     MOV    C,A        ; In 'C'
  2939.     POP    D        ; Restore registers
  2940.     MVI    A,0FFH        ; No error
  2941.     ORA    A        ; Set flags
  2942.     RET
  2943. ;
  2944. ; Get file name fields
  2945. ;
  2946. GFILE2:    MVI    B,8        ; At most, 8 byte filename
  2947.     CALL    SCANF        ; Scan and fill
  2948.     MVI    B,3        ; At most, 3 byte filetype
  2949.     MOV    A,M        ; Get delimiter
  2950.     CPI    '.'        ; Filename ending in "."?
  2951.     JNZ    GFILE3
  2952.     INX    H        ; Point to character after "."
  2953.     CALL    SCANF        ; Scan and fill
  2954.     JMP    FNDONE        ; Done, return to "args"
  2955.  
  2956. GFILE3:    CALL    SCANF4        ; Fill with spaces
  2957.     JMP    FNDONE
  2958. ;
  2959. ; Scanner routine
  2960. ;
  2961. SCANF:    CALL    DELCK        ; Check for delimiter
  2962.     JZ    SCANF4        ; Fill with spaces if found
  2963.     INX    D        ; Next byte in filename
  2964.     CPI    '*'        ; Question mark fill ?
  2965.     JNZ    SCANF1
  2966.     MVI    A,'?'        ; Place "?"
  2967.     STAX    D
  2968.     JMP    SCANF2
  2969.  
  2970. SCANF1:    STAX    D        ; Place character
  2971.     INX    H        ; Next position
  2972.  
  2973. SCANF2:    DCR    B        ; Count down
  2974.     JNZ    SCANF        ; Continue loop
  2975.  
  2976. SCANF3:    CALL    DELCK        ; Skip to delimiter
  2977.     RZ
  2978.     INX    H        ; Point to next
  2979.     JMP    SCANF3
  2980.  
  2981. SCANF4:    INX    D        ; Next filename or filetype
  2982.     MVI    A,' '        ; Fill with spaces
  2983.     STAX    D
  2984.     DCR    B        ; Count down
  2985.     JNZ    SCANF4
  2986.     RET
  2987. ;.....
  2988. ;
  2989. ; Check character pointed to by HL for a delimiter,
  2990. ; return with Zero flag set if the character is a delimiter
  2991. ;
  2992. DELCK:    MOV    A,M        ; Get the character
  2993.     CALL    CAPS        ; Capitalize
  2994.     ORA    A        ; 0=delimiter
  2995.     RZ
  2996.     CPI    ' '+1        ; Space character+1
  2997.     JC    DELCK1        ; Space character or less
  2998.     CPI    '='
  2999.     RZ
  3000.     CPI    5FH        ; Underscore
  3001.     RZ
  3002.     CPI    '.'
  3003.     RZ
  3004.     CPI    ':'
  3005.     RZ
  3006.     CPI    ';'
  3007.     RZ
  3008.     CPI    ','
  3009.     RZ
  3010.     CPI    '<'
  3011.     RZ
  3012.     CPI    '>'
  3013.     RET
  3014. ;
  3015. DELCK1:    CMP    M        ; Compare with self for OK
  3016.     RET
  3017. ;.....
  3018. ;
  3019. CAPS:    CPI    'a'
  3020.     RC
  3021.     CPI    'z'+1
  3022.     RNC
  3023.     SUI    20H
  3024.     RET
  3025. ;.....
  3026. ;              End of FNAME routine
  3027. ;
  3028. ;.....
  3029. ;
  3030. ; Move characters from "HL" to "DE" length in "B"
  3031. ;
  3032. MOVE:    MOV    A,M        ; Get a character
  3033.     STAX    D        ; Store it
  3034.     INX    H        ; To next "from"
  3035.     INX    D        ; To next "to"
  3036.     DCR    B        ; More?
  3037.     JNZ    MOVE        ; Yes, loop
  3038.     RET            ; No, return
  3039.  
  3040.  
  3041. ;-----------------------------------------------------------------------
  3042. ;               help routine
  3043. ;
  3044. ; Help menu if ? is typed, using a fancy ZCMD or ZCPR system
  3045. ;
  3046. ;
  3047. ; Help menu if ? is typed, NOT using any fancy ZCMD or ZCPR system
  3048. ;
  3049. HELPME:    LXI    D,OPTMSG    ; Point at message
  3050.     CALL    SHOW
  3051.     JMP    EXIT3        ; And exit
  3052. ;
  3053. OPTMSG:    DB    13,10,13,10
  3054.     DB    '  Available Options (start with a  $  or  /  or'
  3055.     DB    '  [  character):',13,10
  3056.     DB    13,10
  3057.     DB    '  A - all user areas               D - all drives',13,10
  3058.     DB    '  H - current area to highest      L - include $R/O files'
  3059.     DB    13,10
  3060.     DB    '  O - $SYS files only              Q - non $ARChived only'
  3061.     DB    13,10
  3062.     DB    '  R - reset disk system            S - include $SYS files'
  3063.     DB    13,10
  3064.     DB    '  T - order files by EXT type      V - show version'
  3065.     DB    13,10
  3066.  
  3067.      IF Z80DOS
  3068.     DB    '  Z - do not show dates',13,10
  3069.      ENDIF            ; Z80DOS
  3070.  
  3071.      IF    FATTRIB
  3072.     DB    '  1 - files with attrib 1          2 - files with attrib 2'
  3073.     DB    13,10
  3074.     DB    '  3 - files with attrib 3          4 - files with attrib 4'
  3075.     DB    13,10
  3076.      ENDIF        ;FATTRIB
  3077.  
  3078.      IF    Z80DOS
  3079.     DB    '  = - Exact date match             + - GE date match',13,10
  3080.     DB    '  - - LT date match                ! - Use creation date for'
  3081.     DB    ' match',13,10
  3082.     DB    '  % - Use alteration date match    @ - Use access date for'
  3083.     DB    ' match',13,10
  3084.     DB    ' A date input with no =+-!%@ will use =% default,'
  3085.     DB    ' * as date is current date'
  3086.     DB    13,10,13,10
  3087.     DB    ' Ex - to purge all drv/users of .BAK, no verify,'
  3088.     DB    ' GE date match on access date:',13,10,13,10
  3089.     DB    '                     B0>SD *.BAK $AND+@ 7/1/88',13,10,13,10,0
  3090.      ENDIF        ;Z80DOS
  3091.  
  3092.      IF    NOT Z80DOS
  3093.     DB    13,10,'  Example - to purge all drv/users of .BAK,'
  3094.     DB    ' no verify:',13,10,13,10
  3095.     DB    '                     B0>SD *.BAK $AND <ret>'
  3096.     DB    13,10,13,10,13,10,13,10,13,10
  3097.     DB    0
  3098.      ENDIF        ;NOT Z80ODS
  3099.  
  3100.      IF    Z80DOS
  3101. DISDAT:    PUSH    B
  3102.     PUSH    H        ; Save pointer to size field
  3103.     PUSH    D
  3104.     INX    H        ; and skip over size
  3105.     INX    H        ;
  3106.     MOV    E,M        ; Get JD in DE
  3107.     INX    H        ;
  3108.     MOV    D,M        ;
  3109.     XCHG            ; to HL
  3110.     CALL    DATEHL        ;
  3111.     PUSH    H        ; Month and Year in L,H
  3112.     PUSH    PSW        ; Day in A
  3113.     CALL    SPACE
  3114.     CALL    SPACE
  3115.     POP    PSW
  3116.     JNZ    DAYOK        ; NZ = was a day there
  3117.     POP    H
  3118.     CALL    NODATE
  3119.     JMP    DNOTOK
  3120. DAYOK:    PUSH    PSW
  3121.     MOV    A,L        ; Month out
  3122.     CALL    BCDOUT
  3123.     MVI    A,'/'
  3124.     CALL    PUTCHR
  3125.     POP    PSW
  3126.     CALL    BCDOUT        ; Day out
  3127.     MVI    A,'/'
  3128.     CALL    PUTCHR
  3129.     POP    H
  3130.     MOV    A,H        ; Year out
  3131.     CALL    BCDOUT
  3132. DNOTOK:    CALL    SPACE
  3133.     CALL    SPACE
  3134.     POP    D
  3135.     POP    H
  3136.     POP    B
  3137.     RET
  3138.  
  3139. NODATE:
  3140.     LXI    D,NODATM
  3141.     CALL    PUTS
  3142.     RET
  3143. NODATM:
  3144.     DB    '-- -- --',0
  3145.  
  3146. BCDOUT:
  3147.     PUSH    B        ; Save
  3148.     MOV    B,A        ; A holds BCD digits
  3149.     RAR
  3150.     RAR
  3151.     RAR
  3152.     RAR
  3153.     CALL    BCDOT1        ; Output high order
  3154.     MOV    A,B
  3155.     CALL    BCDOT1        ; And low order
  3156.     POP    B
  3157.     RET
  3158. BCDOT1:    ANI    0FH
  3159.     ADI    '0'
  3160.     CALL    PUTCHR
  3161.     RET
  3162.  
  3163.  
  3164. ;
  3165. ; DATEHL converts the value in HL to BCD year, month, day
  3166. ;     for use with Z80DOS time stamps.
  3167. ;
  3168. ;
  3169. ; Inputs:    HL contains hex days since December 31, 1977
  3170. ;
  3171. ; Outputs:    H contains BCD 20th century year
  3172. ;        L contains BCD month
  3173. ;        A contains BCD day
  3174. ;
  3175. ;        Zero flag set (Z) and A=0 if invalid date (zero) detected,
  3176. ;        Zero flag reset (NZ) and A=0ffh otherwise.
  3177.  
  3178. ; Converted to 8080 from DATEHL by Carson Wilson who Adapted from B5C-CPM3.INS
  3179.  
  3180. DATEHL:
  3181.     MOV    A,H
  3182.     ORA    L        ; Test blank date (zero)
  3183.     RZ            ; Return Z and A=0 if so
  3184.     SHLD    DAYS        ; Save initial value
  3185.     MVI    B,78        ; Set years counter
  3186. LOOP:
  3187.     CALL    CKLEAP
  3188.     LXI    D,-365        ; Set up for subtract
  3189.     JNZ    NOLPY        ; Skip if no leap year
  3190.     DCX    D        ; Set for leap year
  3191. NOLPY:
  3192.     DAD    D        ; Subtract
  3193.     JNC    YDONE        ; Continue if years done
  3194.     MOV    A,H
  3195.     ORA    L
  3196.     JZ    YDONE
  3197.     SHLD    DAYS        ; Else save days count
  3198.     INR    B        ; Increment years count
  3199.     JMP    LOOP        ; And do again
  3200. ;
  3201. ; The years are now finished, the years count is in 'B' (HL is invalid)
  3202. ;
  3203. YDONE:
  3204.     MOV    A,B
  3205.     CALL    BINBCD
  3206.     STA    YEARS        ; save BCD year
  3207. ;
  3208.     CALL    CKLEAP
  3209.     MVI    A,0E4H        ; -28
  3210.     JNZ    FEBNO        ; February not 29 days
  3211.     MVI    A,0E3H        ; Leap year -29
  3212. FEBNO:
  3213.     STA    FEB        ; Set february
  3214.     LHLD    DAYS        ; Get days count
  3215.     LXI    D,MTABLE    ; Point to months table
  3216.     MVI    B,0FFH        ; Set up 'B' for subtract
  3217.     MVI    A,0        ; Set a for # of months
  3218. MLOOP:
  3219.     PUSH    PSW
  3220.     LDAX    D        ; Get month
  3221.     MOV    C,A        ; Put in 'C' for subtract
  3222.     POP    PSW
  3223.     SHLD    DAYS        ; save days count
  3224.     DAD    B        ; Subtract
  3225.     INX    D        ; Increment months counter
  3226.     INR    A
  3227.     JC    MLOOP        ; Loop for next month
  3228.  
  3229. ;
  3230. ; The months are finished, days count is on stack.  First, calculate
  3231. ; month.
  3232. ;
  3233. MDONE:
  3234.     MOV    B,A        ; Save months
  3235.     LHLD    DAYS
  3236.     MOV    A,H
  3237.     ORA    L
  3238.     JNZ    NZD
  3239.     DCX    D
  3240.     DCX    D
  3241.     LDAX    D
  3242.     CMA
  3243.     INR    A
  3244.     MOV    L,A
  3245.     DCR    B
  3246. NZD:
  3247.     MOV    A,L        ; Retrieve binary day of month
  3248.     CALL    BINBCD        ; Convert to BCD
  3249.     PUSH    PSW        ; Save day in A
  3250. ;
  3251.     MOV    A,B        ; Retrieve the binary month
  3252.     CALL    BINBCD        ; Convert binary month to BCD
  3253.     MOV    L,A        ; Return month in L
  3254. ;
  3255.     LDA    YEARS
  3256.     MOV    H,A        ; Return year in H
  3257. ;
  3258.     POP    PSW        ; Restore day
  3259.     ORA    A        ; Set NZ flag
  3260.     RET
  3261.  
  3262. ;
  3263. ; Support Routines:
  3264. ;
  3265.  
  3266. ;
  3267. ; Check for leap years.
  3268. ;
  3269. CKLEAP:
  3270.     MOV    A,B
  3271.     ANI    0FCH
  3272.     CMP    B
  3273.     RET
  3274. ;
  3275. ; Convert A to BCD & store back in A
  3276. ;
  3277. BINBCD:
  3278.     ORA    A
  3279.     RZ
  3280.     PUSH    B
  3281.     MOV    B,A
  3282.     XRA    A
  3283. BINBCD1:
  3284.     ADI    1
  3285.     DAA
  3286.     DCR    B
  3287.     JNZ    BINBCD1
  3288.     POP    B
  3289.     RET
  3290. ;
  3291. ; Buffers:
  3292. ;
  3293.  
  3294. ;
  3295. ; Months table
  3296. ;
  3297. MTABLE:
  3298.     DB    0E1H            ;January -31
  3299. FEB:
  3300.     db    0E4H             ;February -28
  3301.     db    0E1H,0E2H,0E1H,0E2H     ;Mar-Jun -31,-30,-31,-30
  3302.     db    0E1H,0E1H,0E2H        ;Jul-Sep -31,-31,-30
  3303.     db    0E1H,0E2H,0E1H        ;Oct-Dec -31,-30,-31
  3304.  
  3305.      ENDIF    ;Z80DOS
  3306.  
  3307.  
  3308.  
  3309. ;
  3310. ; Messages and Error statements
  3311. ;
  3312. CKMS1:    DB    13,10,'++ ABORTED ++',0
  3313. CKMS2:    DB    8,' ',8,0
  3314. DRUMSG:    DB    'Drive/User',0
  3315.  
  3316. ERRMS1:    DB    ' '
  3317. ERRMS2:    DB    'Error',0
  3318. ERRTAG:    DB    ' ->',0
  3319. NOFLM:    DB    '>> No file(s) on ',0
  3320. NOFMS1:    DB    13,10,0
  3321. NOFMS2:    DB    '  ',0
  3322. NOFMS3:    DB    ':  ',0
  3323. SOHFLG:    DB    0
  3324. TOTMS1:    DB    13,10,'Drive ',0
  3325. TOTMS4:    DB    '/',0
  3326. TOTMS5:    DB    'k  ',0
  3327. TOTMS6:    DB    ' Files: ',0
  3328. TOTMS7:    DB    ' Free: ',0
  3329. TOTMS8:    DB    'k ',0
  3330. ALLTOT:    DB    13,10,'             Total files erased: ',0
  3331. ALLTO1:    DB    'k',13,10,0
  3332. ERAMES:    DB    '  Erase (Y/N)? ',0
  3333. ERAMS1:    DB    '  Erased',0
  3334. ERAMSE:    DB    ' ERROR, COULD NOT ERASE!!!',0
  3335. WHLERR:    DB    13,10,' SPP ?',13,10,0
  3336. EOSMSG:    DB    '[more] ','$'
  3337. MORERA:    DB    13,'        ',13,'$'
  3338.  
  3339. ;
  3340. ; Permanently initialized data area
  3341. ;
  3342. VECTBL:    DW    DSKERR        ; BDOS record error intercept vector
  3343.     DW    DSKERR        ; BDOS select error intercept vector
  3344. ;
  3345. ; End of code that must be stored on disk in the .COM file
  3346. ;
  3347. ; Data area reinitialized by code when SD is run or rerun
  3348. ;
  3349. DATA0    EQU    $        ; Start of area to initialize
  3350.  
  3351. OTBL    EQU    $        ; Mark start of option table
  3352. AOPFLG:    DS    1
  3353. DOPFLG:    DS    1
  3354. HOPFLG:    DS    1
  3355. NOPFLG:    DS    1
  3356. OOPFLG:    DS    1
  3357. QOPFLG:    DS    1
  3358. ROPFLG:    DS    1
  3359. SOPFLG:    DS    1
  3360. TOPFLG:    DS    1
  3361. VOPFLG:    DS    1
  3362. LOPFLG:    DS    1
  3363.  
  3364.      IF    Z80DOS        ;
  3365. DEOPFL:    DS    1
  3366. DPOPFL:    DS    1
  3367. DMOPFL:    DS    1
  3368. DNOPFL: DS    1
  3369. DAOPFL: DS    1
  3370. DGOPFL:    DS    1
  3371. NODFLG:    DS    1
  3372.      ENDIF    ;Z80DOS
  3373.  
  3374.      IF    FATTRIB
  3375. ONEFLG:    DS    1
  3376. TWOFLG:    DS    1
  3377. THRFLG:    DS    1
  3378. FORFLG:    DS    1
  3379.      ENDIF
  3380.  
  3381. OEND    EQU    $        ; End of option table
  3382. ;
  3383. ; End of option lookup table
  3384. ;
  3385. BUFPNT:    DS    2        ; Next location in output buffer
  3386. BUFCNT:    DS    1        ; Number of bytes left in output buffer
  3387. OUTFCB:    DS    1+8+3        ; User number, filename, and filetype
  3388. ;
  3389. ; Beginning of area reinitialized to zero each time SD.COM is run
  3390. ;
  3391.     DS    21        ; Rest of DISK.DIR FCB
  3392. DISKNO:    DS    1        ; Disk number
  3393. USERNO:    DS    1        ; User number
  3394. DRVFLG:    DS    1        ; D option check for prior drive specificaton
  3395. FNDFLG:    DS    1        ; Files Matched Flag
  3396.  
  3397. FIRSTT:    DS    1        ; First time flag for version number
  3398. ;
  3399. ; Uninitialized data area
  3400. ;
  3401. BASUSR:    DS    1        ; Copy of original directory user #
  3402. BLKMAX:    DS    2        ; Highest block # on drive
  3403. BLKMSK:    DS    1        ; Records/block - 1
  3404. BLKSHF:    DS    1        ; Number shifts to mult by sec/blk
  3405. COUNT:    DS    2        ; Entry count
  3406. DIRMAX:    DS    2        ; Highest file # in directory
  3407. FILERC:    DS    2        ; File size in records
  3408. FREEBY:    DS    2        ; Number of k left on dir. drive
  3409. FSIZEC:    DS    1        ; File size character ('k' or 'r')
  3410. GAP:    DS    2        ; Sort routine storage
  3411. I:    DS    2        ; Sort routine storage
  3412. J:    DS    2        ; Sort routine storage
  3413. JG:    DS    2        ; Sort routine storage
  3414. LZFLG:    DS    1        ; 0 when printing leading zeros
  3415. MAXUSR:    DS    1        ; Max user # for drive
  3416. NEWUSR:    DS    1        ; User # selected by "$U" option
  3417. NEXTT:    DS    2        ; Next table entry
  3418. OLDDSK:    DS    1        ; Currently logged-in drive
  3419. OLDUSR:    DS    1        ; User number upon invocation
  3420. SCOUNT:    DS    2        ; # to sort
  3421. SUPSPC:    DS    1        ; Leading space flag
  3422. TBLOC:    DS    2        ; Start of name table
  3423. TOTFIL:    DS    2        ; Total number of files
  3424. TOTSIZ:    DS    2        ; Total size of all files
  3425. TOTFL1:    DS    2        ; Total files of all D/U
  3426. TOTSZ1:    DS    2        ; Total size of all D/U
  3427. TFSIZE:    DS    2        ; Size of file currently erased
  3428. TOTFRE:    DS    2
  3429. USRNR:    DS    1        ; User number
  3430. VERFLG:    DS    1        ; CP/M version number (0=pre-CP/M 2)
  3431. ZRDFLG:    DS    1        ; ZRDOS version number
  3432.  
  3433.     IF    Z80DOS        ;
  3434. DATCHK:    DS    2        ; Holds date to look for
  3435. DTMTCH:    DS    1        ; Holds <,>=,>
  3436. DATMOD:    DS    2        ; Holds date found for file
  3437. DAYS:    ds    2        ; temporary buffers
  3438. YEARS:    ds    1        ;
  3439. YEARS1:    DS    1
  3440. MONTHS:    DS    1
  3441. DAYS1:    DS    1
  3442. ASCII:    DS    5        ; holds date from system
  3443.     ENDIF        ;Z80DOS
  3444.  
  3445.  
  3446. DATA1    EQU    $        ; End of area to initialize
  3447. LINCNT:    DS    1
  3448.      IF    ZCPR33
  3449. Z3DRVL:    DS    2        ; Points to Z33 max drv location
  3450. Z3USRL:    DS    2        ; Points to Z33 max user location
  3451. Z3WHLL:    DS    2        ; Points to Z33 wheel location
  3452.      ENDIF        ;ZCPR33
  3453.  
  3454.      IF    NDIRS
  3455. NAMADR:    DS    2        ; Named Directory Buffer Address
  3456. NUMDIR:    DS    1        ; Number of entries
  3457. CURDIR:    DS    1        ; NDR Check counter
  3458.      ENDIF            ; NDIRS
  3459.  
  3460. NEWPTR:    DS    2        ; Start of second table
  3461. XPOINT:    DS    2
  3462. OUTBUF:    DS    128        ; Output file buffer
  3463. ;
  3464. ; BDOS equates
  3465. ;
  3466. BDOS    EQU    0005H        ; Entry Point for BDOS calls
  3467. FCB    EQU    005CH        ; Default FCB Address
  3468. TBUF    EQU    0080H        ; Default DMA Address
  3469.  
  3470. RDCON    EQU    1        ; Console input
  3471. WRCON    EQU    2        ; Console output
  3472. LIST    EQU    5        ; List output
  3473. PRINT    EQU    9        ; Print string
  3474. CONST    EQU    11        ; Get console status
  3475. CPMVER    EQU    12        ; Return CP/M version
  3476. RESET    EQU    13        ; Reset disk system
  3477. SELDSK    EQU    14        ; Select disk
  3478. OPEN    EQU    15        ; Open file
  3479. CLOSE    EQU    16        ; Close file
  3480. SRCHF    EQU    17        ; Search for first
  3481. SRCHN    EQU    18        ; Search for next
  3482. READ    EQU    20        ; Read sequential
  3483. WRITE    EQU    21        ; Write sequential
  3484. MAKE    EQU    22        ; Make file
  3485. CURDSK    EQU    25        ; Return current disk
  3486. STDMA    EQU    26        ; Set DMA Address
  3487. DSKALL    EQU    27        ; Get address of allocation vector
  3488. DSKPAR    EQU    31        ; Get address of disk parameters
  3489. STUSER    EQU    32        ; Set/get user number
  3490.  
  3491.      IF    ZRDOS
  3492. ZRDVER    EQU    48        ; Return version (ZRDOS)
  3493. SETWBT    EQU    50        ; Set warm boot trap (ZRDOS)
  3494. RESWBT    EQU    52        ; Reset warm boot trap (ZRDOS)
  3495.      ENDIF            ; ZRDOS
  3496.  
  3497.     DS    60        ; Stack area
  3498. STACK:    DS    2        ; Old stack pointer
  3499.  
  3500. ORDER    EQU    $        ; Order table starts here
  3501.  
  3502.     END
  3503.