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 / ENTERPRS / CPM / UTILS / S / SAP60.LBR / SAP60.AZM / SAP60.ASM
Assembly Source File  |  2000-06-30  |  27KB  |  1,302 lines
  1.  
  2. ; SAP v60         Sort And Pack directory        07/27/87
  3. ;
  4. VERS    EQU    60        ; Current version number
  5. ;
  6.     ASEG            ; Needed for M80, ignore any errors
  7. ;
  8.     ORG    100H        ; Ignore error with ASM, LASM, MAC, etc.
  9. ;
  10.     JMP    START        ; Bypasses the erase option
  11. ;
  12. ;
  13. ; This program reads the disk directory tracks, sorts them alphabeti-
  14. ; cally and then replaces them on the disk after first erasing the
  15. ; entire directory area with E5's.  This erasure clears all previous
  16. ; file names that might remain after the new list is replaced.    Sort-
  17. ; ing the directory in this manner offers several advantages:
  18. ;
  19. ;    1)  allows 'DIR' to show an alphabetized listing
  20. ;    2)  minimizes potential problems when using "UNERASE" pgms
  21. ;    3)  speeds up access via 'SD' and other special programs
  22. ;    4)  assists on working directly on the disk with 'DU', etc.
  23. ;    5)  prevents somebody else from reading files you erased
  24. ;    6)  option of erasing all files of zero-length (except those
  25. ;          starting with '-' for catalog use with MAST.CAT or to
  26. ;          name your disks, identify user areas, etc.
  27. ;
  28. ;                - Notes by Irv Hoff W6FFC
  29. ;
  30. ;-----------------------------------------------------------------------
  31. ;               recent updates
  32. ;
  33. ; 07/27/87  1. Rewrote setup routine so the program works on the current
  34. ;   v60        drive unless a different one is requested.  To select a
  35. ;           different drive (which will be displayed on the progress
  36. ;           line):
  37. ;
  38. ;          B>SAP    <ret>     -    default drive
  39. ;          B>SAP D: <ret>     -    with or without colon
  40. ;          B>SAP d  <ret>     -    upper or lower case
  41. ;
  42. ;        2. Added a small help guide per Paul Foote's suggestion:
  43. ;
  44. ;          B>SAP ?  <ret>     -    small help guide
  45. ;
  46. ;        3. Added a "please wait...' statement since the program
  47. ;         takes several seconds to see if there is enough memory
  48. ;         available to handle the requested disk directory, etc.
  49. ;         (A 50k TPA can handle more than 1300 filenames.)
  50. ;        5. Added the disk drive to the progress line so you know for
  51. ;         sure what drive it is actually working on.  12 bytes.
  52. ;        6. Added routine submitted by Bill Duerr to check the S2
  53. ;         byte to properly handle files in excess of 512k.
  54. ;        7. Added an assembly time option for erasing zero length
  55. ;         files, per earlier versions.  This does not affect
  56. ;         those special files for cataloging like -.123 or for
  57. ;         directory guides such as -MODEM, -UPLOADS. etc.  This
  58. ;         should put the versions back in synch once more as
  59. ;         there were two version 50 programs among others written
  60. ;         prior to this version 50.  (One of which was for Z80
  61. ;         only and required using the Z80MR assembler.)    If you
  62. ;         want to sit there typing "Yes, Yes, Yes, Yes" to erase
  63. ;         zero-length files, just stick with v54, I certainly
  64. ;         wasn't interested and several others weren't either.
  65. ;
  66. ;            103h = 00h  deletes zero-length files
  67. ;                 = 0FFh (anyting but zero) keeps them
  68. ;
  69. ;        8. Removed superfluous v1.4 routines.  Currently some 15
  70. ;         bytes still available to stay under 2k arbitrary limit.
  71. ;                    - Irv Hoff
  72. ;                      PRACSA RCPM
  73. ;
  74. ; 06/30/87  1. Exit program with warm boot upon disc error.
  75. ;   v54.1   2. Changed error messages in combination with BDOS error
  76. ;         messages not to exceed CRT width.
  77. ;        3. Added bell with indicated prompts.
  78. ;        4. Other message changes.
  79. ;        5. Changed 2 comments referencing DateStamper(TM) file which
  80. ;         caused ASM v2.2 errors.
  81. ;        6. Changed labels 'I' and 'J' to 'IND' and 'JND' for those
  82. ;         who want to change to Z80 mnemonics.
  83. ;        7. Other minor code changes.
  84. ;                    - Ernest Barnhard
  85. ;                      N8DVE on AB17 RCPM
  86. ;
  87. ; 05/21,87  1. Fixed 0-length file user code display for codes >9,
  88. ;   v54      shortened the write protect tab message a bit to make
  89. ;         room within our arbitrary-but-nice 2K.
  90. ;        2. Deleted $'s from labels and values for M80 and SYSLIB-
  91. ;         modified RMAC (ASM still does the trick).
  92. ;                    - Bruce Morgen
  93. ;                      North American 180 Group
  94. ;
  95. ; 09/15/87  Fixed non-CP/M v2.2 error exit.
  96. ;   v53                 - Bridger Mitchell
  97. ;                      (Plu*Perfect Systems)
  98. ;
  99. ; 07/01/85  1. Fixed unbalanced stack in DODATE which caused erratic
  100. ;   v52        exit behavior in some circumstances.
  101. ;        2. Minor tidy up of some comments and exit.
  102. ;                    - Bridger Mitchell
  103. ;                      (Plu*Perfect Systems)
  104. ;
  105. ; 02/23/85  Preserved original attributes of DateStamper(TM) file.
  106. ;   v51                 - Bridger Mitchell
  107. ;                      (Plu*Perfect Systems)
  108. ;
  109. ; 11/13/84  1. Added support for DateStamper(TM) time-and-date file, if
  110. ;   v50      present on disk.  The datestamp entries are rewritten
  111. ;         in the new directory order, with updated checksums.
  112. ;        2. New, faster sort routine swaps pointers rather than di-
  113. ;         rectory entries.
  114. ;        3. Directory writes speeded up by flushing only the final
  115. ;         record.
  116. ;        4. Zero-length files are erased only if confirmed by user.
  117. ;        5. Prompt for drive if no command line.
  118. ;        6. Erase temporary files of form 'filename.$$$'
  119. ;        7. Removed the 'PACK' routine.  As written, it converted
  120. ;         'FILENAME.N$$' extent=0 files to 'FILENAME.$$$'
  121. ;         extent=n-'0'.    If the intent was to erase temporary
  122. ;         files, it should be done BEFORE sorting, as v50 now
  123. ;         does.            - Bridger Mitchell
  124. ;                      (Plu*Perfect Systems)
  125. ;
  126. ; 09/17/84  Added 'Previously sorted' statement that was included in v37
  127. ;   v40     but got dropped from v38 when the Shell-Metnzer sort was put
  128. ;        in.  It still rewrites the directory even if previously
  129. ;        sorted, to insure erased programs at end of directory are
  130. ;        properly cleared.        - Irv Hoff W6FFC
  131. ;
  132. ; 07/27/84  Corrected sorting of last directory entry.
  133. ;   v39                 - WOD
  134. ;
  135. ; 10/16/83  Now using a Shell-Metzner sort which speeds the sorting time
  136. ;   v38     considerably, especially on large directories.
  137. ;                    ; Sigi Kluger
  138. ;
  139. ; 07/27/83  Shows an error flag for MP/M and CP/M+ both.  Rewrites the
  140. ;   v37     directory even if previously sorted, to insure erased pro-
  141. ;        grams at end of directory are properly cleared.
  142. ;                    - Irv Hoff W6FFC
  143. ;
  144. ; 1977    Written by L. E. Hughes.  Modified extensively since by Bruce
  145. ;    Ratoff, Keith Petersen, James Prest, Ron Fowler, Frank Gaude',
  146. ;    Sigi Kluger, Irv Hoff and likely others.
  147. ;
  148. ;=======================================================================
  149. ;
  150. NO    EQU    0
  151. YES    EQU    NOT NO
  152. ;
  153. ; Set the following equate to YES to erase 0-length files not having a
  154. ; '-' for catalog names.  NO retains all zero-length files.
  155. ;
  156. ERAZRO    EQU    YES        ; YES erases 0-length files with no '-'
  157. ;
  158. ; General equates
  159. ;
  160. BDOS    EQU    0005H
  161. CR    EQU    0DH
  162. LF    EQU    0AH
  163. BS    EQU    08H
  164. BEL    EQU    07H
  165. ;
  166. JMPUNC    EQU    0C3H        ; 8080 unconditional jump opcode
  167. DPBLEN    EQU    15        ; Size of CP/M 2.2 disk parameter block
  168. ;
  169. ZROERA:    DW    ERAZRO        ; 103h = 0FFh to erase files, 00h to not
  170.                 ;   (16 bit value to satisfy ASM.COM)
  171. ;
  172. ;-----------------------------------------------------------------------
  173. ;
  174. ;            START OF PROGRAM
  175. ;
  176. ;-----------------------------------------------------------------------
  177. ;
  178. ; Obtain BIOS vectors
  179. ;
  180. START:    LXI    D,WBOOT
  181.     LHLD    0001H        ; Get BIOS address
  182.     MVI    B,53
  183.     CALL    MOVE
  184. ;
  185.     LXI    SP,STACK    ; Use our own stack
  186. ;
  187.     CALL    ILPRT
  188.     DB    CR,LF,'Sort and pack directory v'
  189.     DB    VERS/10    +'0',(VERS MOD 10) +'0'
  190.     DB    ' - 07/27/87',CR,LF,CR,LF,0
  191. ;
  192.     LDA    FCB+1
  193.     CPI    '?'        ; Requesting some help?
  194.     JNZ    START1
  195. ;
  196.     CALL    ILPRT
  197.     DB    'Examples of how to use:',CR,LF,CR,LF
  198.     DB    '  B>SAP    <ret>   -  current drive',CR,LF
  199.     DB    '  B>SAP D: <ret>   -  with or without colon',CR,LF
  200.     DB    '  B>SAP d  <ret>   -  upper or lower case',CR,LF,0
  201.     RST    0        ; Finished
  202. ;
  203. START1:    CALL    ILPRT
  204.     DB    'please wait...',0
  205.     MVI    C,VERNO        ; Check for CP/M ver 2.2
  206.     CALL    BDOS
  207.     DCR    H        ; H=1 for MPM
  208.     JZ    MPMYES        ; Exit if MPM, we can't use it
  209.     MOV    A,L        ; HL = 0022H if CP/M ver 2.2
  210.     CPI    22H+1        ; Check for MPM or CP/M 3.0
  211.     JNC    MPMYES        ; Exit if CP/M 3.0, we can't use it
  212.     STA    VERFLG        ; Store the version
  213. ;
  214. ;-----------------------------------------------------------------------
  215. ;
  216. ;            MAIN PROGRAM LOOP
  217. ;
  218. ;-----------------------------------------------------------------------
  219. ;
  220. SAP:    CALL    SETUP
  221.     CALL    TSTWRT
  222.     CALL    RDDIR
  223.     CALL    CLEAN
  224.     CALL    SORT
  225.     CALL    WRDIR        ; Write directory and DateStamper(TM)
  226.     CALL    ILPRT        ;   file
  227. ;
  228.     DB    'DONE',CR,LF,0
  229. ;
  230. EXIT:    LDA    ODISK        ; Restore login status
  231.     MOV    E,A
  232.     MVI    C,SELDRV    ; Sets BIOS drive too
  233.     CALL    BDOS
  234.     LDA    OUSER
  235.     MOV    E,A
  236.     MVI    C,USERFN
  237.     CALL    BDOS
  238.     RST    0        ; Warm boot - required after
  239.                 ; Change in directory checksum
  240. ;
  241. ;-----------------------------------------------------------------------
  242. ;
  243. ;             INITIALIZATION
  244. ;
  245. ;-----------------------------------------------------------------------
  246. ;
  247. ; Setup for selecting drive and  loading disk parameter block
  248. ;
  249. SETUP:    XRA    A
  250.     STA    CLNFLG
  251.     MVI    C,USERFN    ; Save original drive and user number
  252.     MVI    E,0FFH
  253.     CALL    BDOS
  254.     STA    OUSER
  255.     MVI    C,GETDSK
  256.     CALL    BDOS
  257.     STA    ODISK
  258.     STA    CURDSK
  259. ;
  260. ; Checks to see if a specific drive was requested (with or without colon)
  261. ;
  262.     LDA    FCB+1        ; Requested drive include a colon?
  263.     CPI    'A'
  264.     JC    SETUP1        ; If not, exit
  265.     CPI    'P'
  266.     JNC    SETUP2        ; Acceptable drives A-P only
  267.     SUI    40H        ; Convert to binary
  268.     JMP    SETUP3        ; Go log it in
  269. ;
  270. SETUP1:    LDA    FCB        ; See if any drive was requsted
  271.     CPI    'A'-40H
  272.     JC    LOGIT        ; If a 0, log in current drive
  273.     CPI    'P'+1-40H    ; Acceptable drives A-P only
  274.     JC    SETUP3
  275. ;
  276. SETUP2:    CALL    ILPRT
  277.     DB    CR,'++ Drive out of range ++',CR,LF,0
  278.     JMP    EXIT        ; Out of range
  279. ;
  280. SETUP3:    DCR    A        ; Change to DRI's drive requirement
  281.     STA    CURDSK        ; Store for current disk
  282. ;
  283. LOGIT:    MOV    E,A        ; Log in designated drive thru BDOS
  284.     MVI    C,SELDRV
  285.     CALL    BDOS
  286. ;
  287.     MVI    E,0        ; Set user 0
  288.     MVI    C,USERFN
  289.     CALL    BDOS
  290. ;
  291.     LDA    CURDSK        ; BIOS call to get DPH to HL
  292.     MOV    C,A
  293.     CALL    SELDSK
  294. ;
  295.     CALL    CPM22
  296. ;
  297.     LHLD    DRM        ; Number of directory entries
  298.     INX    H        ; Relative to 1
  299.     SHLD    SCOUNT
  300.     PUSH    H
  301.     DAD    H        ; Allocate 2*#dir entries
  302.     LXI    D,BUFFER    ; For pointer words
  303.     DAD    D
  304.     SHLD    BUFBAS
  305.     POP    H
  306.     PUSH    H
  307.     CALL    ROTRHL        ; Divide by 4
  308.     CALL    ROTRHL        ; To get record count
  309.     SHLD    DIRLEN
  310.     CALL    ROTRHL        ; And by 8 for time&date
  311.     SHLD    TDCNT
  312. ;
  313. ; Check for sufficient memory
  314. ;
  315.     POP    H        ; # entries *32
  316.     DAD    H        ; x2
  317.     DAD    H        ; x4
  318.     DAD    H        ; x8
  319.     DAD    H        ; x16
  320.     DAD    H        ; x32
  321.     XCHG
  322.     LHLD    BUFBAS        ; + BUFBASE
  323.     DAD    D
  324.     XCHG
  325.     LHLD    6        ; - available TPA
  326.     CALL    SUBDE
  327.     RNC
  328.     CALL    ILPRT
  329.     DB    CR,LF
  330.     DB    'Not enough memory!'
  331.     DB    CR,LF,BEL,0
  332.     JMP    EXIT
  333. ;.....
  334. ;
  335. CPM22:    MOV    E,M        ; CP/M 2.2 routine
  336.     INX    H
  337.     MOV    D,M
  338.     INX    H
  339.     XCHG
  340.     SHLD    RECTBL
  341.     XCHG
  342.     LXI    D,8        ; Offset to DPB within header
  343.     DAD    D        ; Returned by SELDSK in CP/M 2.2
  344.     MOV    A,M        ; Get adrress of DPB
  345.     INX    H
  346.     MOV    H,M
  347.     MOV    L,A
  348.     LXI    D,DPB        ; Point to destestination: our DPB
  349.     MVI    B,DPBLEN
  350.     JMP    MOVE
  351. ;.....
  352. ;
  353. ; Read and write first directory record to ensure writable disk
  354. ;
  355. TSTWRT:    MVI    C,RESET
  356.     CALL    BDOS
  357.     CALL    SETCUR
  358.     LHLD    SYSTRK
  359.     CALL    DOTRAK
  360.     LXI    H,1
  361.     CALL    DOREC
  362.     LXI    H,TBUFF
  363.     MOV    B,H
  364.     MOV    C,L
  365.     CALL    SETDMA
  366.     CALL    READ
  367.     ORA    A
  368.     JNZ    RTERR
  369.     MVI    C,1        ; Directory write forces flush
  370.     CALL    WRITE
  371.     ORA    A
  372.     JNZ    WTERR
  373.     CALL    CKTD        ; See if DateStamper(TM) file is on disk
  374.     RET
  375. ;.....
  376. ;
  377. ;
  378. WTERR:    CALL    ILPRT
  379.     DB    CR,LF
  380.     DB    'Can''t write disk -- write-protect tab?'
  381.     DB    CR,LF,BEL,0
  382.     JMP    EXIT
  383. ;
  384. RTERR:    CALL    ILPRT
  385.     DB    CR,LF
  386.     DB    'Can''t read disk!'
  387.     DB    CR,LF,BEL,0
  388.     JMP    EXIT
  389. ;
  390. ;-----------------------------------------------------------------------
  391. ;
  392. ;              READ & WRITE DIRECTORY
  393. ;
  394. ;-----------------------------------------------------------------------
  395. ;
  396. ; Write directory
  397. ;
  398. WRDIR:    LDA    NOSWAP
  399.     ORA    A
  400.     JNZ    WRDIR1
  401.     CALL    ILPRT
  402.     DB    '(Previously sorted) - ',0
  403.     LDA    CLNFLG        ; If in sorted order
  404.     ORA    A        ; And no erasures
  405.     RZ            ; We're all done
  406. ;
  407. WRDIR1:    CALL    ILPRT
  408.     DB    'Writing, ',0
  409. ;
  410. WRDIR2:    CALL    DMA80        ; Set default DMA
  411.     LHLD    DIRLEN
  412.     SHLD    DIRCNT
  413.     LXI    H,BUFFER        ; Set initial pointer
  414.     SHLD    PTR
  415.     MVI    A,1        ; Flag write operation
  416.     CALL    DODIR
  417.     CALL    DODATE        ; Then update the DateStamper(TM) file
  418.     RET
  419. ;.....
  420. ;
  421. ; Read directory, get current drive to include in display
  422. ;
  423. RDDIR:    MVI    C,GETDSK    ; Get the current disk drive
  424.     CALL    BDOS
  425.     ADI    'A'        ; Convert to ASCII
  426.     STA    RDDIR1
  427.     CALL    ILPRT
  428.     DB    CR,'  '
  429. ;
  430. RDDIR1:    DB    ' : --> Reading, ',0
  431.     LHLD    DIRLEN
  432.     SHLD    DIRCNT
  433.     LHLD    BUFBAS
  434.     SHLD    ADDR        ; For read DMA address
  435.     LXI    H,BUFFER
  436.     SHLD    PTR
  437.     MVI    A,0        ; READFLG
  438. ;
  439. DODIR:    STA    WRFLAG
  440.     LHLD    SYSTRK
  441.     CALL    DOTRAK        ; Set the track
  442.     LXI    H,0
  443.     SHLD    RECORD
  444. ;
  445. DLOOP:    LHLD    RECORD        ; Get records per track
  446.     INX    H
  447.     XCHG
  448.     LHLD    SPT        ; Current record
  449.     CALL    SUBDE        ; Record - SPT
  450.     XCHG
  451.     JNC    NOTROV
  452. ;
  453. ; Track overflow, bump to next
  454. ;
  455.     LHLD    TRACK
  456.     INX    H
  457.     CALL    DOTRAK
  458.     LXI    H,1        ; Rewind record number
  459. ;
  460. NOTROV:    CALL    DOREC        ; Set current record
  461.     LDA    WRFLAG        ; Time to figure out
  462.     ORA    A        ; If we are reading
  463.     JNZ    DWRT        ; Or writing
  464. ;
  465. ; Reading
  466. ;
  467.     LHLD    ADDR
  468.     MOV    B,H        ; Set up DMA address
  469.     MOV    C,L
  470.     CALL    SETDMA
  471.     CALL    READ
  472.     ORA    A        ; Test flags on read
  473.     JNZ    RERROR        ; NZ=error
  474.     LHLD    ADDR
  475.     MVI    B,4        ; Install pointers for 4 entries in this
  476.     XCHG            ;   record.
  477.     LHLD    PTR
  478. ;
  479. PLP:    MOV    M,E
  480.     INX    H
  481.     MOV    M,D
  482.     INX    H
  483.     PUSH    H
  484.     LXI    H,32
  485.     DAD    D
  486.     XCHG
  487.     POP    H
  488.     DCR    B
  489.     JNZ    PLP
  490.     SHLD    PTR
  491.     XCHG
  492.     SHLD    ADDR        ; New DMA
  493. ;
  494. ; Common Read/write code
  495. ;
  496. MORE:    LHLD    DIRCNT        ; Countdown entries
  497.     DCX    H
  498.     SHLD    DIRCNT
  499.     MOV    A,H        ; Test for zero left
  500.     ORA    L
  501.     JNZ    DLOOP        ; Loop till zero
  502. ;
  503. ; Directory I/O done, reset DMA address
  504. ;
  505. DMA80:    LXI    B,TBUFF
  506.     JMP    SETDMA
  507. ;.....
  508. ;
  509. ; Write-directory code
  510. ;
  511. DWRT:    MVI    B,4
  512.     LXI    D,TBUFF
  513. ;
  514. DWRT1:    PUSH    B        ; Copy 4 sorted entries to buffer
  515.     CALL    NXTENT
  516.     CALL    MOVE32
  517.     POP    B
  518.     DCR    B
  519.     JNZ    DWRT1
  520.     MVI    C,0        ; Write allocated...
  521.     LHLD    DIRCNT
  522.     DCX    H
  523.     MOV    A,H
  524.     ORA    L
  525.     JNZ    DWRT3        ; Unless it's the last record
  526.     MVI    C,1        ; Which must be flushed
  527. ;
  528. DWRT3:    CALL    WRITE
  529.     ORA    A
  530.     JNZ    WERROR
  531.     JMP    MORE
  532. ;.....
  533. ;
  534. ; Return HL = pointer to next sorted entry
  535. ;
  536. NXTENT:    PUSH    D
  537.     LHLD    PTR
  538.     MOV    E,M
  539.     INX    H
  540.     MOV    D,M
  541.     INX    H
  542.     SHLD    PTR
  543.     XCHG
  544.     POP    D
  545.     RET
  546. ;.....
  547. ;
  548. ; Track and record update routines
  549. ;
  550. DOTRAK:    SHLD    TRACK
  551.     MOV    B,H
  552.     MOV    C,L
  553.     JMP    SETTRK
  554. ;
  555. DOREC:    SHLD    RECORD
  556.     MOV    B,H
  557.     MOV    C,L
  558.     LHLD    RECTBL
  559.     XCHG
  560.     DCX    B
  561.     CALL    RECTRN
  562.     MOV    B,H
  563.     MOV    C,L
  564.     LDA    VERFLG
  565.     ORA    A
  566.     RZ
  567.     JMP    SETREC
  568. ;
  569. ;-----------------------------------------------------------------------
  570. ;
  571. ;            CLEAN OUT ERASED ENTRIES
  572. ;
  573. ;-----------------------------------------------------------------------
  574. ;
  575. ; Also    any zero-length files, if affirmed by user.
  576. ; Preserve '-' zero-length (catalog) filenames.
  577. ;
  578. CLEAN:    LXI    H,0        ; IND = 0
  579. ;
  580. CLNLOP:    SHLD    IND
  581.     CALL    INDEX        ; HL = BUF + 32 * IND
  582.     MOV    A,M        ; Jump if this is a deleted file
  583.     CPI    0E5H
  584.     JZ    FILLE5
  585.     MOV    B,H        ; Save index in BC
  586.     MOV    C,L
  587.     LXI    D,9        ; If filetype is '$$$'
  588.     DAD    D
  589.     MVI    A,'$'
  590.     CMP    M
  591.     JNZ    CLN1
  592.     INX    H
  593.     CMP    M
  594.     JNZ    CLN1
  595.     INX    H
  596.     CMP    M
  597.     JZ    FILLE5        ; Erase it
  598. ;
  599. CLN1:    LXI    H,12
  600.     DAD    B
  601.     MOV    A,M        ; Check extent field
  602.     ORA    A
  603.     JNZ    CLBUMP        ; Skip if not extent 0
  604.     INX    H        ; Point to record count field
  605.     INX    H
  606.     MOV    A,M        ; Get S2 byte (extended RC)
  607.     ANI    0FH        ; For CP/M 2.2
  608.     MOV    E,A
  609.     INX    H
  610.     MOV    A,M        ; Check record count field
  611.     ORA    E
  612.     JNZ    CLBUMP        ; Jump if non-zero
  613. ;
  614.     LDA    ZROERA        ; Erase 0-length files?
  615.     ORA    A
  616.     JZ    CLBUMP        ; Zero does not erase so exit
  617. ;
  618.     LHLD    IND        ; Clear all 32 bytes of
  619.     CALL    INDEX        ; Directory entry to E5
  620.     INX    H
  621.     MOV    A,M        ; Get first character of filename
  622.     DCX    H        ; MAST.CAT catalog programs
  623.     CPI    '-'        ; Have diskname of zero length
  624.     JZ    CLBUMP        ; That starts with '-', do not erase
  625. ;
  626. FILLE5:    LHLD    IND        ; Recompute entry address of this file
  627.     CALL    INDEX
  628.     MVI    C,32        ; Number of bytes to clear
  629.     MVI    A,0E5H        ; Fill with E5's
  630. ;
  631. FILLE6:    CMP    M
  632.     JNZ    FILLE7
  633.     INX    H
  634.     DCR    C
  635.     JNZ    FILLE6
  636.     JMP    CLBUMP        ; Already clean
  637. ;
  638. FILLE7:    STA    CLNFLG
  639. ;
  640. FILLOP:    MOV    M,A        ; Make it all E5's
  641.     INX    H
  642.     DCR    C
  643.     JNZ    FILLOP
  644. ;
  645. CLBUMP:    LHLD    DRM        ; Get count of filenames
  646.     INX    H
  647.     XCHG
  648.     LHLD    IND        ; Our current count
  649.     INX    H
  650.     PUSH    H
  651.     CALL    SUBDE        ; Subtract
  652.     POP    H
  653.     JC    CLNLOP        ; Loop till all cleaned
  654.     RET
  655. ;.....
  656. ;
  657. ; Type 'FILENAME.TYP' at (HL)
  658. ;
  659. FNFT:    MVI    B,8
  660.     CALL    TYPEFN
  661.     MVI    A,'.'
  662.     CALL    AOUT
  663.     MVI    B,3
  664. ;
  665. TYPEFN:    PUSH    B
  666.     MOV    A,M
  667.     CALL    AOUT
  668.     INX    H
  669.     POP    B
  670.     DCR    B
  671.     JNZ    TYPEFN
  672.     RET
  673. ;.....
  674. ;
  675. ;
  676. AOUT:    PUSH    B
  677.     PUSH    H
  678.     MOV    C,A
  679.     CALL    CO
  680.     POP    H
  681.     POP    B
  682.     RET
  683. ;
  684. ;-----------------------------------------------------------------------
  685. ;
  686. ;              PRINT A STRING
  687. ;
  688. ;-----------------------------------------------------------------------
  689. ;
  690. ; Address is on top of stack, preserves 'BC'
  691. ;
  692. ILPRT:    XTHL            ; Get address from stack
  693.     MOV    A,M        ; Get character
  694.     INX    H        ; Point to next address
  695.     XTHL            ; Restore to stack
  696.     ORA    A        ; Are we done?
  697.     RZ            ; Yes, return past string
  698. ;
  699.     CALL    AOUT        ; Preserves HL,BC
  700.     JMP    ILPRT        ; Continue
  701. ;.....
  702. ;
  703. INDEX:    DAD    H        ; x2 for *32
  704.     DAD    H        ; x4
  705.     DAD    H        ; x8
  706.     DAD    H        ; x16
  707.     DAD    H        ; x32
  708.     XCHG
  709.     LHLD    BUFBAS
  710.     DAD    D
  711.     RET
  712. ;.....
  713. ;
  714. MOVE16:    MVI    B,16
  715.     JMP    MOVE
  716. ;
  717. MOVE32:    MVI    B,32
  718. ;
  719. ; Move (B) bytes from (HL) to (DE)
  720. ;
  721. MOVE:    MOV    A,M
  722.     STAX    D
  723.     INX    H
  724.     INX    D
  725.     DCR    B
  726.     JNZ    MOVE
  727.     RET
  728. ;
  729. ;-----------------------------------------------------------------------
  730. ;
  731. ;            SORT THE DIRECTORY
  732. ;
  733. ;    This sort routine is adapted from SOFTWARE TOOLS by
  734. ;     Kernigan and Plaugher.  Routine extracted from SD.
  735. ;
  736. ;-----------------------------------------------------------------------
  737. ;
  738. SORT:    XRA    A
  739.     STA    NOSWAP        ; Zero the flag in case already sorted
  740.     CALL    ILPRT
  741.     DB    'Sorting, '
  742.     DB    0
  743.     LHLD    SCOUNT        ; Number of entries
  744.     LDA    TDFLAG
  745.     ORA    A
  746.     JZ    L0
  747.     DCX    H        ; Skip past TIME&DAT entry
  748.     SHLD    SCOUNT
  749. ;
  750. L0:    ORA    A        ; Clear carry
  751.     MOV    A,H        ; GAP=GAP/2
  752.     RAR
  753.     MOV    H,A
  754.     MOV    A,L
  755.     RAR
  756.     MOV    L,A
  757.     ORA    H        ; Is it zero?
  758.     RZ            ; Then none left
  759.     MOV    A,L        ; Make GAP odd
  760.     ORI    1
  761.     MOV    L,A
  762.     SHLD    GAP
  763.     INX    H        ; IIN=GAP+1
  764. ;
  765. L2:    SHLD    IND
  766.     XCHG
  767.     LHLD    GAP
  768.     MOV    A,E        ; JND=IND-GAP
  769.     SUB    L
  770.     MOV    L,A
  771.     MOV    A,D
  772.     SBB    H
  773.     MOV    H,A
  774. ;
  775. L3:    SHLD    JND
  776.     XCHG
  777.     LHLD    GAP        ; JG=JND+GAP
  778.     DAD    D
  779.     SHLD    JG
  780.     CALL    COMPAR        ; Compare (JND) and (JG)
  781. ;
  782. L3A:    JP    L5        ; If A(JND)<=A(JG)
  783.     LHLD    JND
  784.     XCHG
  785.     LHLD    JG
  786.     CALL    SWAP        ; Exchange A(JND) and A(JG)
  787.     LHLD    JND        ; JND=JND-GAP
  788.     XCHG
  789.     LHLD    GAP
  790.     MOV    A,E
  791.     SUB    L
  792.     MOV    L,A
  793.     MOV    A,D
  794.     SBB    H
  795.     MOV    H,A
  796.     JM    L5        ; If JND>0 GOTO L3
  797.     ORA    L        ; Check for zero
  798.     JNZ    L3        ; * shortened
  799. ;
  800. L5:    LHLD    SCOUNT        ; For later
  801.     XCHG
  802.     LHLD    IND        ; IND=IND+1
  803.     INX    H
  804.     MOV    A,E        ; If IND<=N GOTO L2
  805.     SUB    L
  806.     MOV    A,D
  807.     SBB    H
  808.     JP    L2
  809.     LHLD    GAP
  810.     JMP    L0
  811. ;.....
  812. ;
  813. ; Returns SIGNED comparison
  814. ;
  815. COMPAR:    CALL    GETBAS
  816.     DAD    H        ; *2
  817.     DAD    B        ; +base
  818.     XCHG            ; 1st pointer to DE temporarily
  819.     DAD    H
  820.     DAD    B
  821.     XCHG            ; 2nd pointer now in DE, first in HL
  822.     MOV    C,M        ; Put 1st pointer in BC
  823.     INX    H
  824.     MOV    B,M
  825.     XCHG            ; 2nd pointer now in HL, first in BC
  826.     MOV    E,M
  827.     INX    H
  828.     MOV    D,M
  829.     XCHG
  830. ;
  831. ; Should be 1+11+ext+s2, sort by USERNO, NAME,TYPE, EXTENT and S2 byte
  832. ;
  833.     MVI    E,12        ; Will do S2 independently, making 13
  834. ;
  835. COMPBH:    MOV    A,M        ; 7-bit signed compare of (BC), (HL)
  836.     ANI    7FH        ; Strip high bit
  837.     MOV    D,A
  838.     LDAX    B
  839.     ANI    7FH        ; Strip high bit
  840.     CMP    D
  841.     INX    B
  842.     INX    H
  843.     RNZ
  844.     DCR    E
  845.     JNZ    COMPBH
  846. ;
  847. ; User number file name and file type are equal, now check S2 byte for
  848. ; any files in excess of 512k
  849. ;
  850.     INX    B
  851.     INX    H
  852.     INX    B
  853.     INX    H
  854.     MOV    A,M        ; 4-bit signed compare of (BC), (HL)
  855.     ANI    0FH        ; Strip all but low order nibble
  856.     MOV    D,A
  857.     LDAX    B
  858.     ANI    0FH        ; Strip all but low order nibble
  859.     CMP    D
  860.     RNZ
  861. ;
  862. ; S2 byte is equal, now go back to extent
  863. ;
  864.     DCX    B
  865.     DCX    H
  866.     DCX    B
  867.     DCX    H
  868.     MOV    A,M        ; 7-bit signed compare of (BC), (HL)
  869.     ANI    7FH        ; Strip any high bits set
  870.     MOV    D,A
  871.     LDAX    B
  872.     ANI    7FH        ; Strip any high bits set
  873.     CMP    D
  874.     RET
  875. ;.....
  876. ;
  877. ; Swap entries in the order table
  878. ;
  879. SWAP:    MVI    A,0FFH
  880.     STA    NOSWAP
  881.     CALL    GETBAS
  882.     DAD    H        ; *2
  883.     DAD    B        ; + base
  884.     XCHG
  885.     DAD    H        ; *2
  886.     DAD    B        ; + base
  887.     MOV    C,M
  888.     LDAX    D
  889.     XCHG
  890.     MOV    M,C
  891.     STAX    D
  892.     INX    H
  893.     INX    D
  894.     MOV    C,M
  895.     LDAX    D
  896.     XCHG
  897.     MOV    M,C
  898.     STAX    D
  899.     RET
  900. ;.....
  901. ;
  902. GETBAS:    LXI    B,BUFFER-2    ; If TIME&DAT file
  903.     LDA    TDFLAG
  904.     ORA    A
  905.     RZ
  906.     INX    B        ; Start at 2nd entry
  907.     INX    B
  908.     RET
  909. ;.....
  910. ;
  911. ;-----------------------------------------------------------------------
  912. ;
  913. ;            DATESTAMPER SUPPORT CODE
  914. ;
  915. ;    1. checks for presence of DateStamper(TM) file
  916. ;    2. re-writes time and date entries in sorted order
  917. ;         corresponding to the new directory order.
  918. ;-----------------------------------------------------------------------
  919. ;
  920. ; Check 1st directory entry for the DateStamper(TM) file
  921. ;
  922. CKTD:    LXI    H,TDNAM0    ; User # 0 too
  923.     MVI    B,12
  924.     PUSH    H
  925.     PUSH    B
  926.     LXI    D,TDFCB        ; Initialize USERNO.NAME in FCB now
  927.     CALL    MOVE
  928.     XRA    A
  929.     MVI    B,36-12
  930. ;
  931. ZLP:    STAX    D
  932.     INX    D
  933.     DCR    B
  934.     JNZ    ZLP
  935.     POP    B
  936.     POP    H
  937.     LXI    D,TBUFF        ; See if it's the time&dat file
  938.     CALL    MATCH7
  939.     JNZ    NOTD
  940.     MVI    A,0FFH
  941.     JMP    SETTD
  942. ;
  943. NOTD:    XRA    A
  944. ;
  945. SETTD:    STA    TDFLAG        ; Set flag if special file present
  946.     RET
  947. ;.....
  948. ;
  949. ; Rewrite the TIME&DAT file in sorted order
  950. ;
  951. ;    1. read the file to (bufbase)
  952. ;    2. use ptrs to index to each 16-byte entry
  953. ;    3. write new records
  954. ;
  955. DODATE:    LDA    TDFLAG
  956.     ORA    A
  957.     RZ            ; No TIME&DAT file
  958.     MVI    C,RESET        ; Directory has been changed
  959.     CALL    BDOS        ; Force new checksum in BDOS
  960.     CALL    SETCUR
  961. ;
  962. ; 1. open file to get all attributes
  963. ; 2. reset read-only bit
  964. ;
  965.     LXI    D,TDFCB
  966.     PUSH    D
  967.     MVI    C,OPEN
  968.     CALL    BDOS
  969.     INR    A
  970.     POP    D
  971.     JZ    TDOERR
  972.     LXI    H,TDFCB+9    ; Set file R/W
  973.     MOV    A,M
  974.     ANI    7FH
  975.     MOV    M,A
  976.     MVI    C,ATTFN
  977.     CALL    BDOS
  978. ;
  979. DOD1:    MVI    B,0        ; Record counter
  980.     LHLD    BUFBAS
  981. ;
  982. TDRLP:    XCHG
  983.     PUSH    D
  984.     PUSH    B
  985.     MVI    C,DMAFN
  986.     CALL    BDOS
  987.     LXI    D,TDFCB
  988.     MVI    C,READFN
  989.     CALL    BDOS
  990.     ORA    A
  991.     POP    B
  992.     POP    D
  993.     JNZ    RDDONE
  994.     INR    B
  995.     LXI    H,80H
  996.     DAD    D
  997.     JMP    TDRLP
  998. ;.....
  999. ;
  1000. RDDONE:    LHLD    BUFBAS
  1001. ;
  1002. ; Check the checksum for all records
  1003. ;
  1004. CKLP:    PUSH    B
  1005.     CALL    CKSUM
  1006.     CMP    M
  1007.     INX    H
  1008.     POP    B
  1009.     JZ    SOK
  1010.     CALL    ILPRT
  1011.     DB    CR,LF
  1012.     DB    'Checksum error in original '
  1013.     DB    '"!!!TIME&.DAT" file -- proceeding'
  1014.     DB    CR,LF,BEL,0
  1015. ;
  1016. SOK:    DCR    B
  1017.     JNZ    CKLP
  1018. ;
  1019. ; Initialize for writing
  1020. ;
  1021.     XRA    A
  1022.     STA    TDFCB+12    ; Extent
  1023.     STA    TDFCB+32    ; Currebt record
  1024.     CALL    DMA80
  1025.     LXI    H,BUFFER    ; Initialize pointer
  1026.     SHLD    PTR
  1027.     LHLD    TDCNT
  1028. ;
  1029. WTLP1:    PUSH    H
  1030. ;
  1031. ; Copy 8  Time&Date entries to TBUFF
  1032. ;
  1033.     LXI    D,TBUFF
  1034.     MVI    B,8
  1035. ;
  1036. WTLP2:    PUSH    B        ; +1
  1037.     PUSH    D        ; +2
  1038.     LHLD    PTR        ; Get  pointer to next entry
  1039.     MOV    E,M
  1040.     INX    H
  1041.     MOV    D,M
  1042.     INX    H
  1043.     SHLD    PTR        ; Save next pointer
  1044. ;
  1045. ; DateStamper(TM) entries are 16 bytes
  1046. ;
  1047.     LHLD    BUFBAS        ; Get: BUFBASE + [(PTR)-BUFBASE]/2
  1048.     PUSH    H
  1049.     XCHG
  1050.     CALL    SUBDE        ; (PTR)-BUFBASE
  1051.     CALL    ROTRHL        ; /2
  1052.     POP    D        ; + BUFBASE
  1053.     DAD    D        ;
  1054.     POP    D        ; Move it to tbuff
  1055.     CALL    MOVE16        ; De points to next slot in tbuff
  1056.     POP    B        ; +0
  1057.     DCR    B
  1058.     JNZ    WTLP2
  1059.     LXI    H,TBUFF        ; Update the record's checksum byte
  1060.     CALL    CKSUM
  1061.     MOV    M,A
  1062.     LXI    D,TDFCB        ; Write the record
  1063.     MVI    C,WRITFN
  1064. ;
  1065. DBUG:    CALL    BDOS
  1066.     ORA    A
  1067.     POP    H
  1068.     JNZ    TDWERR
  1069.     DCX    H        ; Count down
  1070.     MOV    A,H
  1071.     ORA    L
  1072.     JNZ    WTLP1
  1073.     LXI    D,TDFCB        ; Close TIME&DAT file
  1074.     PUSH    D
  1075.     MVI    C,CLOSE
  1076.     CALL    BDOS
  1077.     POP    D
  1078.     INR    A
  1079.     JZ    TDCERR
  1080.     LXI    H,TDFCB+9    ; Return file to R/O status
  1081.     MOV    A,M
  1082.     ORI    80H
  1083.     MOV    M,A
  1084.     MVI    C,ATTFN
  1085.     JMP    BDOS
  1086. ;
  1087. ; Checksum 1st 127 bytes at (HL)
  1088. ;
  1089. CKSUM:    MVI    B,127
  1090.     XRA    A
  1091. ;
  1092. CKSU1:    ADD    M
  1093.     INX    H
  1094.     DCR    B
  1095.     JNZ    CKSU1
  1096.     RET
  1097. ;.....
  1098. ;
  1099. TDNAM0:    DB    0,'!!!TIME&DAT'
  1100. ;
  1101. TDOERR:    CALL    ILPRT
  1102.     DB    CR,LF
  1103.     DB    'Can''t open ',0
  1104. ;
  1105. FNERR:    CALL    ILPRT
  1106.     DB    '"!!!TIME&.DAT" file!'
  1107.     DB    BEL,CR,LF,0
  1108.     RET
  1109. ;
  1110. TDWERR:    CALL    ILPRT
  1111.     DB    CR,LF
  1112.     DB    'Write error ',0
  1113.     JMP    FNERR
  1114. ;
  1115. TDCERR:    CALL    ILPRT
  1116.     DB    CR,LF
  1117.     DB    'Close error '
  1118.     DB    0
  1119.     JMP    FNERR
  1120. ;
  1121. ;-----------------------------------------------------------------------
  1122. ;
  1123. ;         MISCELLANEOUS SUPPORT ROUTINES
  1124. ;
  1125. ;-----------------------------------------------------------------------
  1126. ;
  1127. SETCUR:    LDA    CURDSK
  1128.     MOV    E,A        ; Put drive back
  1129.     MVI    C,SELDRV
  1130.     JMP    BDOS
  1131. ;.....
  1132. ;
  1133. ; Compare B bytes at DE and HL (without attributes )
  1134. ;
  1135. MATCH7:    LDAX    D
  1136.     XRA    M
  1137.     ANI    7FH        ; Ignore attributes
  1138.     RNZ
  1139.     INX    H
  1140.     INX    D
  1141.     DCR    B
  1142.     JNZ    MATCH7
  1143.     RET
  1144. ;.....
  1145. ;
  1146. ; Utility subtraction subroutine...HL = HL-DE
  1147. ;
  1148. SUBDE:    MOV    A,L
  1149.     SUB    E
  1150.     MOV    L,A
  1151.     MOV    A,H
  1152.     SBB    D
  1153.     MOV    H,A
  1154.     RET
  1155. ;.....
  1156. ;
  1157. ; Divide HL by 2
  1158. ;
  1159. ROTRHL:    ORA    A        ; Clear carry
  1160.     MOV    A,H
  1161.     RAR
  1162.     MOV    H,A
  1163.     MOV    A,L
  1164.     RAR
  1165.     MOV    L,A
  1166.     RET
  1167. ;.....
  1168. ;
  1169. ; Come here if we get a read error
  1170. ;
  1171. RERROR:    CALL    ILPRT
  1172.     DB    CR,LF
  1173.     DB    '=>  READ ERROR - NO CHANGE made'
  1174.     DB    CR,LF,BEL,0
  1175.     JMP    EXIT
  1176. ;.....
  1177. ;
  1178. ; Come here if we get a write error
  1179. ;
  1180. WERROR:    CALL    ILPRT
  1181.     DB    CR,LF
  1182.     DB    '=>  WRITE ERROR - directory left in UNKNOWN condition'
  1183.     DB    CR,LF,BEL,0
  1184.     JMP    EXIT
  1185. ;.....
  1186. ;
  1187. ; M/PM OR CP/M 3.0 not allowed with this program
  1188. ;
  1189. MPMYES:    CALL    ILPRT
  1190.     DB    'SAP v'
  1191.     DB    VERS/10    +'0',(VERS MOD 10) +'0'
  1192.     DB    ' runs with CP/M 1.4 or CP/M 2.2'
  1193.     DB    BEL,CR,LF,0
  1194.     RST    0        ; Warm boot
  1195. ;.....
  1196. ;
  1197. ;-----------------------------------------------------------------------
  1198. ;
  1199. ; Data area
  1200. ;
  1201. ADDR:    DS    2
  1202. DIRLEN:    DS    2
  1203. DIRCNT:    DS    2
  1204. IND:    DS    2
  1205. JND:    DS    2
  1206. GAP:    DS    2
  1207. JG:    DS    2
  1208. ;
  1209. RECTBL:    DS    2
  1210. RECORD:    DS    2
  1211. TRACK:    DS    2
  1212. ;
  1213. TDCNT:    DS    2
  1214. ;
  1215. NOSWAP:    DS    1
  1216. VERFLG:    DS    1
  1217. WRFLAG:    DS    1
  1218. TDFLAG:    DS    1
  1219. CLNFLG:    DS    1
  1220. ;
  1221. ;-----------------------------------------------------------------------
  1222. ;
  1223. ; Disk parameter block:
  1224. ;
  1225. DPB:
  1226. SPT:    DS    2
  1227. BSH:    DS    1
  1228. BLM:    DS    1
  1229. EXM:    DS    1
  1230. DSM:    DS    2
  1231. DRM:    DS    2
  1232. AL0:    DS    1
  1233. AL1:    DS    1
  1234. CKS:    DS    2
  1235. SYSTRK:    DS    2
  1236. CURDSK:    DS    1
  1237. ODISK:    DS    1
  1238. OUSER:    DS    1
  1239. BUFBAS:    DS    2
  1240. PTR:    DS    2
  1241. SCOUNT:    DS    2
  1242. ;
  1243. TDFCB:    DS    36        ; DateStamper(TM) file control block
  1244. ;.....
  1245. ;
  1246. ;-----------------------------------------------------------------------
  1247. ;
  1248. VECTRS:    DS    53        ; Room for jump vectors
  1249. ;
  1250. WBOOT    EQU    VECTRS+3    ; Do not change these equates
  1251. CSTS    EQU    VECTRS+6
  1252. CI    EQU    VECTRS+9
  1253. CO    EQU    VECTRS+12
  1254. LO    EQU    VECTRS+15
  1255. PO    EQU    VECTRS+18
  1256. RI    EQU    VECTRS+21
  1257. HOME    EQU    VECTRS+24
  1258. SELDSK    EQU    VECTRS+27
  1259. SETTRK    EQU    VECTRS+30
  1260. SETREC    EQU    VECTRS+33
  1261. SETDMA    EQU    VECTRS+36
  1262. READ    EQU    VECTRS+39
  1263. WRITE    EQU    VECTRS+42
  1264. LSTS    EQU    VECTRS+45
  1265. RECTRN    EQU    VECTRS+48
  1266. ;.....
  1267. ;
  1268. ;-----------------------------------------------------------------------
  1269. ;
  1270. ; BDOS functions
  1271. ;
  1272. VERNO    EQU    12        ; Provides CP/M version number
  1273. RESET    EQU    13        ; BDOS reset drives function
  1274. SELDRV    EQU    14        ; Select drive function
  1275. OPEN    EQU    15
  1276. CLOSE    EQU    16
  1277. USERFN    EQU    32        ; BDOS user # function
  1278. ATTFN    EQU    30
  1279. GETDSK    EQU    25        ; BDOS "get disk #" function
  1280. DMAFN    EQU    26
  1281. READFN    EQU    20
  1282. WRITFN    EQU    21
  1283. ;
  1284. BDOS    EQU    0005H
  1285. TBUFF    EQU    80H
  1286. FCB    EQU    5CH
  1287. ;.....
  1288. ;
  1289. ;-----------------------------------------------------------------------
  1290. ;
  1291.     DS    32        ; Minimum stack depth
  1292. ;
  1293. EVEN    EQU    ($+255)/256*256    ; Start buffer on even page, which also
  1294.                 ; Increase stack area greatly
  1295.     ORG    EVEN
  1296. ;
  1297. STACK    EQU    $-2
  1298. ;
  1299. BUFFER:    DS    0
  1300. ;
  1301.     END    START
  1302.