home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / sap53.lbr / SAP53.AZM / SAP53.ASM
Encoding:
Assembly Source File  |  1993-10-25  |  20.3 KB  |  1,199 lines
  1. ; SAP v5.2  SORT AND PACK CP/M DISK DIRECTORY -- 09/15/86
  2. ;
  3. ; v 5.3 9-15-86  (BMM P*PS)
  4. ;    1. fixed non-cpm 2.2 error exit
  5. ; v 5.2 7-01-85  (DJM P*PS)
  6. ;    1.  Fixed unbalanced stack in dodate which caused
  7. ;        eratic exit behaviour in some circumstances
  8. ;    2.  Minor tidy up of some comments and exit
  9. ;
  10. ; v 5.1    2-23-85
  11. ;    1.  Preserved original attributes of !!!TIME&.DAT file
  12. ;
  13. ; Version 5.0 -- 11/13/84
  14. ;
  15. ;    1.  Added support for DateStamper time-and-date file, if
  16. ;        present on disk.  The datestamp entries are
  17. ;         rewritten in the new directory order, with updated
  18. ;        checksums.
  19. ;    2.  New, faster sort routine swaps pointers rather than
  20. ;        directory entries.
  21. ;    3.  Directory writes speeded up by flushing only the final
  22. ;        sector.
  23. ;    4.  Zero-length files are erased only if confirmed by user.
  24. ;    5.  Prompt for drive if no command line.
  25. ;    6.  Erase temporary files of form 'filename.$$$'
  26. ;    7.  Removed the 'PACK' routine.
  27. ;        As written, it converted 'filename.n$$' extent=0 files
  28. ;        to 'filename.$$$' extent=n-'0'.
  29. ;        If the intent was to erase temporary files it should
  30. ;        be done BEFORE sorting, as v 5.0 now does.
  31. ;
  32. ;    8.  Note: not tested on cp/m 1.4
  33. ;    
  34. ;                Bridger Mitchell (Plu*Perfect Systems)
  35. ;
  36. ;        ----------------------------------
  37. ;
  38. ; This program reads the disk directory tracks, sorts them alphabetically
  39. ; then replaces them on the disk.  All unused or erased areas on the di--
  40. ; rectory track are reformatted with continuous 'e5' characters.  (This
  41. ; erases previous file names which have been deactivated.)  Sorting the
  42. ; directory in this manner offers many advantages.  Some of them are:
  43. ;
  44. ;    1)  allows 'dir' to show an alphabetized listing
  45. ;    2)  eliminates potential problems with "unerase" programs
  46. ;    3)  speeds up access via 'sd' and other special programs
  47. ;    4)  assists on working directly on the disk with 'du', etc.
  48. ;    5)  removes files from the disk somebody else could recover
  49. ;    6)  erases all files of zero length (except those starting
  50. ;          with '-' for catalog use with mast.cat)
  51. ;
  52. ;                - notes by Irv Hoff W6FFC
  53. ;
  54. ;=======================================================================
  55. ;
  56. ; 09/17/84  Added 'Previously sorted' statement that was included in v37
  57. ;   v40     but got dropped from v38 when the Shell-Metnzer sort was put
  58. ;        in.  It still rewrites the directory even if previously
  59. ;        sorted, to insure erased programs at end of directory are
  60. ;        properly cleared.        - Irv Hoff
  61. ;
  62. ; 07/27/84  Corrected sorting of last directory entry.
  63. ;   v39                 - WOD
  64. ;
  65. ; 10/16/83  Now using a Shell-Metzner sort which speeds the sorting time
  66. ;   v38     considerably, especially on large directories. (SFK)
  67. ;
  68. ; 07/27/83  Shows an error flag for MP/M and CP/M+ both.  Rewrites the
  69. ;   v37     directory even if previously sorted, to insure erased pro-
  70. ;        grams at end of directory are properly cleared.
  71. ;                    - Irv Hoff
  72. ;
  73. ; 1977    Written by L. E. Hughes.  Modified extensively since by Bruce
  74. ;    Ratoff, Keith Petersen, James Prest, Ron Fowler, Frank Gaude,
  75. ;    Sigi Kluger, Irv Hoff and likely others.
  76. ;
  77. ;=======================================================================
  78. ;
  79. ;
  80. vers     equ    5$3
  81. ;
  82. ;
  83. BDOS    EQU    0005H
  84.  
  85. ;    bdos functions
  86. VERNO    EQU    12        ;provides CP/M version number
  87. RESET    equ    13        ;bdos reset drives fn
  88. SELDRV    EQU    14        ;select drive fn
  89. OPEN    EQU    15
  90. CLOSE    EQU    16
  91. USERFN    equ    32        ;bdos user # fn
  92. ATTFN    EQU    30
  93. GETDSK    EQU    25        ;BDOS "get disk #" function
  94. DMAFN    EQU    26
  95. READFN    EQU    20
  96. WRITFN    EQU    21
  97.  
  98. tbuff    equ    80h
  99. FCB    EQU    5CH
  100. ;
  101. CR    EQU    0DH
  102. LF    EQU    0AH
  103. BS    equ    08h
  104. ;
  105. DPBLEN    EQU    15        ;size of CP/M 2.2 disk parameter block
  106. ;
  107.     aseg        ; for RMAC
  108.     ORG    100H
  109. ;
  110. start:    LXI    SP,STACK    ;use our own stack
  111.     LXI    D,WBOOT        ;get bios vector
  112.     LHLD    0001H
  113.     MVI    B,16*3        ;DJM 7/1/85
  114.     CALL    MOVE
  115. ;
  116.     CALL    ILPRT
  117.     DB    CR,LF,'SAP v '
  118.     db    vers/10 +'0','.',(vers mod 10) +'0'
  119. verdat:    db    ' 09/15/86',CR,LF,LF
  120.     db    'Sort and Pack Directory -- '
  121.     db    'with DateStamper(tm) support.',CR,LF,0
  122. ;
  123.     MVI    C,VERNO        ;check for CP/M ver 2.2
  124.     CALL    BDOS
  125.     MOV    A,H        ;H=1 for MPM
  126.     ORA    A
  127.     JNZ    MPMYES        ;exit if MPM, we can't use it
  128.     MOV    A,L        ;HL = 0022H if CP/M ver 2.2
  129.     CPI    22H+1        ;check for MPM or CP/M 3.0
  130.     JNC    MPMYES        ;exit if CP/M 3.0, we can't use it
  131.     STA    VERFLG
  132. ;
  133. ;
  134. ;    MAIN PROGRAM
  135. ;
  136. ;----------------------------------------
  137. ;
  138. ;
  139. SAP:    CALL    SETUP
  140.     call    tstwrt
  141.     CALL    RDDIR
  142.     CALL    CLEAN
  143.     CALL    SORT
  144.     CALL    WRDIR    ;write directory and DateStamper file
  145.     CALL    ILPRT
  146.     DB    '... Done.',CR,LF,0
  147. ;
  148. EXIT:    lda    o$disk        ;restore login status
  149.     mov    e,a
  150.     mvi    c,SELDRV    ;sets bios drive too
  151.     call    bdos
  152.     lda    o$user
  153.     mov    e,a
  154. s8:    mvi    c,USERFN
  155.     call    bdos
  156.     rst    0        ;warm boot - required after
  157.                 ;change in directory checksum
  158. ;
  159. ;----------------------------------------
  160. ;
  161. ;    INITIALIZATION
  162. ;
  163. ; Setup for selecting drive and  loading disk parm block
  164. ;
  165. SETUP:    xra    a
  166.     sta    cleanflg
  167.     mvi    c,USERFN    ;save original drive & user number
  168.     mvi    e,0ffh
  169.     call    bdos
  170.     sta    o$user
  171.     MVI    C,GETDSK
  172.     call    bdos
  173.     sta    o$disk
  174.     sta    curdsk
  175. ;
  176.     LDA    FCB
  177.     ora    a
  178.     jnz    SETUP1
  179. ;
  180. ; prompt for drive before proceeding
  181. ;
  182. reask:    call    ilprt
  183.     db    CR,LF,'Which drive ?',BS,0
  184.     call    ci
  185.     cpi    'C'-'@'        ;abort on ^C bailout
  186.     jz    0
  187.     ani    5fh
  188.     push    psw
  189.     call    aout
  190.     pop    psw
  191. setup0:    sui    'A'-1
  192. setup1:    dcr    a
  193.     sta    curdsk
  194.     cpi    0
  195.     jc    baddrv
  196.     cpi    16
  197.     jc    logit
  198. baddrv:    mvi    c,7
  199.     call    aout
  200.     jmp    reask
  201. ;    
  202. logit:    MOV    e,A        ;login designated drive thru bdos
  203.     mvi    c,seldrv
  204.     CALL    bdos
  205.     mvi    e,0        ;set user 0
  206.     mvi    c,USERFN
  207.     call    bdos
  208.     lda    curdsk        ;bios call to get dph to hl
  209.     mov    c,a
  210.     call    seldsk
  211.     LDA    VERFLG        ;if CP/M 1.4
  212.     ORA    A
  213.     JZ    do14        ;if 1.4, then do it the 1.4 way
  214.     call    cpm22
  215.     jmp    setup2
  216. do14:    call    cpm14
  217. ;
  218. setup2:    LHLD    DRM        ;number of directory entries
  219.     INX    H        ;relative to 1
  220.     shld    scount
  221.     push    h
  222.     dad    h        ;allocate 2*#dir entries
  223.     lxi    d,order        ;for pointer words
  224.     dad    d
  225.     shld    bufbase
  226.     pop    h
  227.     push    h
  228.     CALL    ROTRHL        ;divide by 4
  229.     CALL    ROTRHL        ;..to get record count
  230.     shld    dirlen
  231.     CALL    ROTRHL        ; and by 8 for time&date
  232.     shld    tdcnt        ;
  233. ;
  234. ;check for sufficient memory--
  235.     pop    h        ;# entries *32
  236.     dad    h
  237.     dad    h
  238.     dad    h
  239.     dad    h
  240.     dad    h
  241.     xchg
  242.     lhld    bufbase        ; + bufbase
  243.     dad    d
  244.     xchg
  245.     lhld    6        ; - available tpa
  246.     call    subde
  247.     rnc
  248.     call    ilprt    
  249.     db    CR,LF,7,'Insufficient memory!',0
  250.     jmp    exit
  251. ;
  252. ;
  253. CPM22:    MOV    E,M        ; CP/M 2.2 routine
  254.     INX    H
  255.     MOV    D,M
  256.     INX    H
  257.     XCHG
  258.     SHLD    RECTBL
  259.     XCHG
  260.     LXI    D,8        ;offset to DPB within header
  261.     DAD    D        ;returned by seldsk in CP/M 2.2
  262.     MOV    A,M        ;get adrress of DPB
  263.     INX    H
  264.     MOV    H,M
  265.     MOV    L,A
  266.     LXI    D,DPB        ;point to destestination: our DPB
  267.     MVI    B,DPBLEN
  268.     jmp    MOVE
  269. ;.....
  270. ;
  271. ;
  272. ; CP/M 1.4 routine
  273. ;
  274. CPM14:    LHLD    BDOS+1
  275.     MVI    L,0
  276.     MVI    A,(JMP)
  277.     STA    RECTRN
  278.     PUSH    H
  279.     LXI    D,15        ;RECTRAN offset from BDOS in CP/M 1.4
  280.     DAD    D
  281.     SHLD    RECTRN+1
  282.     POP    H
  283.     LXI    D,3AH        ;offset from BDOS to 1.4 DPB
  284.     DAD    D
  285.     MVI    D,0
  286.     MOV    E,M
  287.     INX    H
  288.     XCHG
  289.     SHLD    SPT
  290.     XCHG
  291.     MOV    E,M
  292.     INX    H
  293.     XCHG
  294.     SHLD    DRM
  295.     XCHG
  296.     MOV    A,M
  297.     INX    H
  298.     STA    BSH
  299.     MOV    A,M
  300.     INX    H
  301.     STA    BLM
  302.     MOV    E,M
  303.     INX    H
  304.     XCHG
  305.     SHLD    DSM
  306.     XCHG
  307.     MOV    E,M
  308.     INX    H
  309.     XCHG
  310.     SHLD    AL0
  311.     XCHG
  312.     MOV    E,M
  313.     XCHG
  314.     SHLD    SYSTRK
  315.     RET
  316. ;
  317. ;
  318. ; read & write 1st directory record to ensure writable disk
  319. ;
  320. tstwrt:    mvi    c,RESET
  321.     CALL    BDOS
  322.     call    setcur
  323.     lhld    systrk
  324.     call    dotrak
  325.     lxi    h,1
  326.     call    dorec
  327.     lxi    h,tbuff
  328.     mov    b,h
  329.     mov    c,l
  330.     call    setdma
  331.     call    read
  332.     ora    a
  333.     jnz    rterr
  334.     mvi    c,1        ;directory write forces flush
  335.     call    write
  336.     ora    a
  337.     jnz    wterr
  338.     call    cktd        ;see if special DateStamper file is on disk
  339.     ret
  340.  
  341. wterr:    call    ilprt
  342.     db    CR,LF,7,'Can''t write disk -- check write-protect tab!',0
  343.     ret
  344. ;
  345. rterr:    call    ilprt
  346.     db    CR,LF,7,'Can''t read disk!',0
  347.     ret
  348.  
  349. ;
  350. ;----------------------------------------
  351. ;
  352. ;    READ & WRITE DIRECTORY
  353. ;
  354. ; write directory 
  355. ;
  356. WRDIR:    LDA    NOSWAP
  357.     ORA    A
  358.     JNZ    WRDIR1
  359.     CALL    ILPRT
  360.     DB    '(Previously sorted) ',0
  361.     lda    cleanflg        ;if in sorted order
  362.     ora    a            ;and no erasures
  363.     rz                ;we're all done
  364. ;
  365. WRDIR1:    CALL    ILPRT
  366.     DB    CR,LF,'          ---> Writing, ',0
  367. ;
  368. WRDIR2:    call    dma80        ;set default dma
  369.     lhld    dirlen
  370.     shld    dircnt
  371.     lxi    h,order        ;set initial pointer
  372.     shld    ptr
  373.     MVI    A,1        ;flag write operation
  374.     call    DODIR
  375.     call    dodate        ;then update the DateStamper file
  376.     ret
  377. ;.....
  378. ;
  379. ; read directory
  380. ;
  381. RDDIR:    CALL    ILPRT
  382.     DB    CR,LF,'---> Reading, ',0
  383.     lhld    dirlen
  384.     shld    dircnt
  385.     lhld    bufbase
  386.     SHLD    ADDR        ;for read DMA address
  387.     lxi    h,order
  388.     shld    ptr
  389.     mvi    a,0        ;readflg
  390. ;
  391. ;
  392. DODIR:    sta    wrflag
  393.     LHLD    SYSTRK
  394.     CALL    DOTRAK        ;set the track
  395.     LXI    H,0
  396.     SHLD    RECORD
  397. ;
  398. dloop:    LHLD    RECORD        ;get records per track
  399.     INX    H
  400.     XCHG
  401.     LHLD    SPT        ;current record
  402.     CALL    SUBDE        ;..record - SPT
  403.     XCHG
  404.     JNC    NOTROV
  405. ;
  406. ; Track overflow, bump to next
  407. ;
  408.     LHLD    TRACK
  409.     INX    H
  410.     CALL    DOTRAK
  411.     LXI    H,1        ;rewind record number
  412. ;
  413. NOTROV:    CALL    DOREC        ;set current record
  414.     LDA    WRFLAG        ;time to figure out
  415.     ORA    A        ;..if we are reading
  416.     jnz    dwrt        ;..or writing
  417. ;
  418. ;reading
  419.     LHLD    ADDR
  420.     MOV    B,H        ;set up DMA address
  421.     MOV    C,L
  422.     CALL    SETDMA
  423.     CALL    READ
  424.     ORA    A        ;test flags on read
  425.     JNZ    RERROR        ;NZ=error
  426.     LHLD    ADDR
  427.     mvi    b,4        ;install ptrs for 4 entries in this rec.
  428.     xchg
  429.     lhld    ptr
  430. plp:    mov    m,e
  431.     inx    h
  432.     mov    m,d
  433.     inx    h
  434.     push    h
  435.     lxi    h,32
  436.     dad    d
  437.     xchg
  438.     pop    h
  439.     dcr    b
  440.     jnz    plp
  441.     shld    ptr
  442.     xchg
  443.     SHLD    ADDR        ;new dma
  444. ;
  445. ;common r/w code
  446. ;
  447. MORE:    LHLD    DIRCNT        ;countdown entries
  448.     DCX    H
  449.     SHLD    DIRCNT
  450.     MOV    A,H        ;test for zero left
  451.     ORA    L
  452.     JNZ    dloop        ;loop till zero
  453. ;
  454. ; Directory I/O done, reset DMA address
  455. ;
  456. dma80:    LXI    B,tbuff
  457.     jmp    SETDMA
  458. ;
  459. ; write-directory code
  460. ;
  461. DWRT:    mvi    b,4
  462.     lxi    d,tbuff
  463. dwrt1:    push    b        ;copy 4 sorted entries to buffer
  464.     call    nxtent
  465.     call    move32    
  466.     pop    b
  467.     dcr    b
  468.     jnz    dwrt1
  469. ;
  470.     mvi    c,0        ;write allocated...
  471.     lhld    dircnt
  472.     dcx    h
  473.     mov    a,h
  474.     ora    l
  475.     jnz    dwrt3        ;unless it's the last record
  476.     mvi    c,1        ;..which must be flushed
  477. dwrt3:    call    write    
  478.     ora    a
  479.     jnz    werror
  480.     jmp    more
  481. ;
  482. ; return hl = ptr to next sorted entry
  483. ;
  484. nxtent:    push    d
  485.     lhld    ptr
  486.     mov    e,m
  487.     inx    h
  488.     mov    d,m
  489.     inx    h
  490.     shld    ptr
  491.     xchg        
  492.     pop    d
  493.     ret
  494. ;
  495. ;
  496. ; Track and record update routines
  497. ;
  498. DOTRAK:    SHLD    TRACK
  499.     MOV    B,H
  500.     MOV    C,L
  501.     jmp    SETTRK
  502. ;
  503. DOREC:    SHLD    RECORD
  504.     MOV    B,H
  505.     MOV    C,L
  506.     LHLD    RECTBL
  507.     XCHG
  508.     DCX    B
  509.     CALL    RECTRN
  510.     MOV    B,H
  511.     MOV    C,L
  512.     LDA    VERFLG
  513.     ORA    A
  514.     RZ
  515.     jmp    SETREC
  516. ;
  517. ;----------------------------------------
  518. ;
  519. ;    CLEAN OUT ERASED ENTRIES
  520. ;    Also  any zero-length files, if affirmed by user.
  521. ;    Preserve '-' zero-length (catalog) filenames.
  522. ;
  523. CLEAN:    LXI    H,0        ;I = 0
  524. ;
  525. CLNLOP:    SHLD    I
  526.     CALL    INDEX        ;HL = BUF + 32 * I
  527.     MOV    A,M        ;jump if this is a deleted file
  528.     CPI    0E5H
  529.     JZ    FILL$E5
  530.     mov    b,h        ;save index in bc
  531.     mov    c,l
  532.     lxi    d,9        ;if filetype is '$$$'
  533.     dad    d
  534.     mvi    a,'$'
  535.     cmp    m
  536.     jnz    cln1
  537.     inx    h
  538.     cmp    m
  539.     jnz    cln1
  540.     inx    h
  541.     cmp    m
  542.     jz    fill$e5        ;...erase it
  543. cln1:    lxi    h,12
  544.     dad    b
  545.     MOV    A,M        ;check extent field
  546.     ORA    A
  547.     JNZ    CLBUMP        ;skip if not extent 0
  548.     INX    H        ;point to record count field
  549.     INX    H
  550.     MOV    A,M        ;get S2 byte (extended RC)
  551.     ANI    0FH        ;..for CP/M 2.2, 0 for CP/M 1.4
  552.     MOV    E,A
  553.     INX    H
  554.     MOV    A,M        ;check record count field
  555.     ORA    E
  556.     JNZ    CLBUMP        ;jump if non-zero
  557. ;
  558.     LHLD    I        ;keep any files beginning with '-'
  559.     CALL    INDEX
  560.     INX    H
  561.     MOV    A,M        ;get first character of filename
  562.     DCX    H        ;..MAST.CAT catalog programs
  563.     CPI    '-'        ;..have diskname of zero length
  564.     JZ    CLBUMP        ;..that start with '-', do not delete
  565. ;
  566.     push    h        ;for other 0-length files...
  567.     call    ilprt        ; ask for confirmation before erasing
  568.     db    CR,LF,'Erase zero-length file: ',0
  569.     lda    curdsk
  570.     adi    'A'
  571.     call    aout
  572.     pop    h
  573.     push    h        ;+1
  574.     mov    a,m
  575.     cpi    10
  576.     jc    ones
  577.     push    psw
  578.     adi    '0'-10
  579.     call    aout
  580.     pop    psw    
  581. sulp:    sui    10
  582.     jp    sulp
  583.     adi    10
  584. ones:    adi    '0'
  585.     call    aout
  586.     mvi    a,':'
  587.     call    aout
  588. ;
  589.     pop    h
  590.     push    h        ;+1
  591.     inx    h
  592.     call    fnft
  593.     call    ilprt
  594.     db    ' ?',BS,0
  595.     call    ci
  596.     cpi    'Y'
  597.     pop    h        ;+0
  598.     jz    yesans
  599.     cpi    'y'
  600.     jz    yesans
  601.     mvi    a,'N'
  602.     call    aout
  603.     jmp    clbump
  604. yesans:    call    aout
  605. ;
  606. FILLE5:    lhld    i        ;recompute entry address
  607.     call    index
  608.     MVI    C,32        ;number of bytes to clear
  609.     mvi    a,0e5h
  610. fille6:    cmp    m
  611.     jnz    fille7
  612.     inx    h
  613.     dcr    c
  614.     jnz    fille6
  615.     jmp    clbump        ;already clean
  616. ;
  617. fille7:    sta    cleanflg
  618.  
  619. fillop:    mov    m,a        ;make it all E5'S
  620.     INX    H
  621.     DCR    C
  622.     JNZ    FILLOP
  623. ;
  624. CLBUMP:    LHLD    DRM        ;get count of filenames
  625.     INX    H
  626.     XCHG
  627.     LHLD    I        ;our current count
  628.     INX    H
  629.     PUSH    H
  630.     CALL    SUBDE        ;subtract
  631.     POP    H
  632.     JC    CLNLOP        ;loop till all cleaned
  633.     RET
  634. ;
  635. ; type 'filename.typ' at (hl)
  636. ;
  637. fnft:    mvi    b,8
  638.     call    typefn
  639.     mvi    a,'.'
  640.     call    aout
  641.     mvi    b,3
  642. typefn:    push    b
  643.     mov    a,m
  644.     call    aout
  645.     inx    h
  646.     pop    b
  647.     dcr    b
  648.     jnz    typefn
  649.     ret
  650.     
  651. aout:    push    b
  652.     push    h
  653.     mov    c,a
  654.     call    co
  655.     pop    h
  656.     pop    b
  657.     ret
  658. ;
  659. ;----------------------------------------
  660. ; Print a string:  Address is on top of stack
  661. ;    preserves bc
  662. ;
  663. ILPRT:    XTHL            ;get address from stack
  664.     MOV    A,M        ;get character
  665.     INX    H        ;point to next address
  666.     XTHL            ;restore to stack
  667.     ORA    A        ;are we done?
  668.     RZ            ;yes, return past string
  669.     call    aout        ;preserves hl,bc
  670.     JMP    ILPRT        ;continue
  671. ;
  672. ;
  673. INDEX:    DAD    H        ;*32
  674.     DAD    H
  675.     DAD    H
  676.     DAD    H
  677.     DAD    H
  678.     xchg
  679.     lhld    bufbase
  680.     DAD    D
  681.     RET
  682. ;
  683. ;
  684. move16:    mvi    b,16
  685.     jmp    move
  686. move32:    mvi    b,32
  687. ;
  688. ; Move (b) bytes from (hl) to (de)
  689. ;
  690. MOVE:    MOV    A,M
  691.     STAX    D
  692.     INX    H
  693.     INX    D
  694.     DCR    B
  695.     JNZ    MOVE
  696.     RET
  697. ;
  698. ;----------------------------------------
  699. ;
  700. ; Sort the directory
  701. ;
  702. SORT:    XRA    A
  703.     STA    NOSWAP        ;zero the flag in case already sorted
  704.     CALL    ILPRT
  705.     DB    CR,LF,'   ---> Sorting, ',0
  706. ;
  707. ; This sort routine is adapted from SOFTWARE TOOLS by Kernigan and
  708. ; Plaugher.  Routine extracted from SD.
  709. ;
  710.     LHLD    SCOUNT        ;number of entries
  711.     lda    tdflag
  712.     ora    a
  713.     jz    l0
  714.     dcx    h        ;skip past TIME&DAT entry
  715.     shld    scount
  716. ;
  717. L0:    ORA    A        ;clear carry
  718.     MOV    A,H        ;GAP=GAP/2
  719.     RAR
  720.     MOV    H,A
  721.     MOV    A,L
  722.     RAR
  723.     MOV    L,A
  724.     ORA    H        ;is it zero?
  725.     rz            ;then none left
  726.     MOV    A,L        ;make gap odd
  727.     ORI    1
  728.     MOV    L,A
  729.     SHLD    GAP
  730.     INX    H        ;I=GAP+1
  731. ;
  732. L2:    SHLD    I
  733.     XCHG
  734.     LHLD    GAP
  735.     MOV    A,E        ;J=I-GAP
  736.     SUB    L
  737.     MOV    L,A
  738.     MOV    A,D
  739.     SBB    H
  740.     MOV    H,A
  741. ;
  742. L3:    SHLD    J
  743.     XCHG
  744.     LHLD    GAP        ;JG=J+GAP
  745.     DAD    D
  746.     SHLD    JG
  747.     CALL    COMPARE     ;compare (J) and (JG)
  748. L3A:    JP    L5        ;if A(J)<=A(JG)
  749.     LHLD    J
  750.     XCHG
  751.     LHLD    JG
  752.     CALL    SWAP        ;exchange A(J) and A(JG)
  753.     LHLD    J        ;J=J-GAP
  754.     XCHG
  755.     LHLD    GAP
  756.     MOV    A,E
  757.     SUB    L
  758.     MOV    L,A
  759.     MOV    A,D
  760.     SBB    H
  761.     MOV    H,A
  762.     JM    L5        ;if J>0 GOTO L3
  763.     ORA    L        ;check for zero
  764.     jnz    l3        ;* shortened
  765. ;
  766. L5:    LHLD    SCOUNT        ;for later
  767.     XCHG
  768.     LHLD    I        ;I=I+1
  769.     INX    H
  770.     MOV    A,E        ;if I<=N GOTO L2
  771.     SUB    L
  772.     MOV    A,D
  773.     SBB    H
  774.     JP    L2
  775.     LHLD    GAP
  776.     JMP    L0
  777. ;
  778. ; returns SIGNED comparison 
  779. ;
  780. COMPARE:
  781.     call    getbas
  782.     DAD    H        ;*2
  783.     DAD    B        ;+base
  784.     XCHG            ;1st ptr to de
  785.     DAD    H
  786.     DAD    B
  787.     XCHG            ;2nd to hl
  788.     MOV    C,M        ;fetch 1st to bc
  789.     INX    H
  790.     MOV    B,M        
  791. ;
  792.     XCHG            ;fetch 2nd to hl
  793.     MOV    E,M
  794.     INX    H
  795.     MOV    D,M
  796.     xchg
  797. ;
  798. ; should be 1+11+ext
  799. ; sort by userno,NAME,TYPE,extent
  800. ;
  801.     mvi    e,13
  802. ;
  803. compbh:    mov    a,m    ;7-bit signed compare of (bc), (hl)
  804.     ani    7fh
  805.     mov    d,a
  806.     ldax    b
  807.     ani    7fh
  808.     cmp    d
  809.     inx    b
  810.     inx    h
  811.     rnz
  812.     dcr    e
  813.     jnz    compbh
  814.     ret
  815. ;
  816. ; Swap entries in the order table
  817. ;
  818. SWAP:    mvi    a,0ffh
  819.     sta    noswap
  820.     call    getbas
  821.     DAD    H        ;*2
  822.     DAD    B        ;+ base
  823.     XCHG
  824.     DAD    H        ;*2
  825.     DAD    B        ;+ base
  826.     MOV    C,M
  827.     LDAX    D
  828.     XCHG
  829.     MOV    M,C
  830.     STAX    D
  831.     INX    H
  832.     INX    D
  833.     MOV    C,M
  834.     LDAX    D
  835.     XCHG
  836.     MOV    M,C
  837.     STAX    D
  838.     RET
  839. ;
  840. getbas:    lxi    b,order-2    ;if TIME&DAT file
  841.     lda    tdflag
  842.     ora    a
  843.     rz
  844.     inx    b        ;...start at 2nd entry
  845.     inx    b
  846.     ret
  847. ;
  848. ;----------------------------------------
  849. ;
  850. ;    DATESTAMPER SUPPORT CODE
  851. ;
  852. ;    1. checks for presence of DateStamper(TM) file
  853. ;    2. re-writes time and date entries in sorted order
  854. ;       corresponding to the new directory order.
  855. ;
  856. ;    check 1st directory entry for !!!TIME&.DAT file
  857. ;
  858. cktd:    lxi    h,tdnam0    ;user # 0 too
  859.     mvi    b,12
  860.     push    h
  861.     push    b
  862.     lxi    d,tdfcb        ;initialize userno,name in fcb now
  863.     call    move
  864.     xra    a
  865.     mvi    b,36-12
  866. zlp:    stax    d
  867.     inx    d
  868.     dcr    b
  869.     jnz    zlp
  870.     pop    b
  871.     pop    h
  872.     lxi    d,tbuff        ;see if it's the time&dat file
  873.     call    match7        ;
  874.     jnz    notd
  875.     mvi    a,0ffh
  876.     jmp    settd
  877. notd:    xra    a
  878. settd:    sta    tdflag        ;set flag if special file present
  879.     ret
  880. ;
  881. ; rewrite the TIME&DAT file in sorted order
  882. ;    1. read the file to (bufbase)
  883. ;    2. use ptrs to index to each 16-byte entry
  884. ;    3. write new records
  885. ;
  886. dodate:    
  887.     lda    tdflag
  888.     ora    a
  889.     rz            ;no TIME&DAT file
  890.      mvi    c,RESET        ;directory has been changed
  891.     call    bdos        ; force new checksum in bdos
  892.     call    setcur
  893. ;
  894. ; 1. open file to get all attributes
  895. ; 2. reset r/o bit
  896.     lxi    d,tdfcb
  897.     push    d
  898.     mvi    c,OPEN
  899.     call    bdos
  900.     inr    a
  901.     pop    d
  902.     jz    tdoerr
  903. ;
  904.     lxi    h,tdfcb+9    ;set file r/w
  905.     mov    a,m
  906.     ani    7fh
  907.     mov    m,a
  908.  
  909. ;    push    d        ;BUG FIX Version 5.2 DJM 7/1/85
  910.  
  911.     mvi    c,ATTFN
  912.     call    bdos
  913. ;
  914. dod1:    mvi    b,0        ;record counter
  915.     lhld    bufbase
  916. tdrlp:    xchg
  917.     push    d
  918.     push    b
  919.     mvi    c,DMAFN
  920.     call    bdos
  921.     lxi    d,tdfcb
  922.     mvi    c,READFN
  923.     call    bdos
  924.     ora    a
  925.     pop    b
  926.     pop    d
  927.     jnz    rddone
  928.     inr    b
  929.     lxi    h,80h
  930.     dad    d
  931.     jmp    tdrlp
  932. ;
  933. rddone:    lhld    bufbase
  934. ;
  935. ;    check the checksum for all records
  936. cklp:    push    b
  937.     call    cksum
  938.     cmp    m
  939.     inx    h
  940.     pop    b
  941.     jz    sok
  942.     call    ilprt
  943.     db    CR,LF,'Checksum error in original "!!!TIME&.DAT" file'
  944.     db    ' -- proceeding',0
  945. sok:    dcr    b
  946.     jnz    cklp
  947. ;
  948. ; initialize for writing
  949. ;
  950.     xra    a
  951.     sta    tdfcb+12    ;extent
  952.     sta    tdfcb+32    ;currec
  953.     call    dma80
  954.     lxi    h,order        ;initialize ptr
  955.     shld    ptr
  956.     lhld    tdcnt
  957. wtlp1:    push    h
  958. ;
  959. ; copy 8  time&date entries to tbuff
  960.     lxi    d,tbuff        
  961.     mvi    b,8
  962. wtlp2:    push    b        ;+1
  963.     push    d        ;+2
  964.     lhld    ptr        ;get  ptr to next entry
  965.     mov    e,m
  966.     inx    h
  967.     mov    d,m
  968.     inx    h
  969.     shld    ptr        ;save next ptr
  970. ;
  971. ;DateStamper entries are 16 bytes
  972. ;
  973.     lhld    bufbase        ;get: bufbase + [(ptr)-bufbase]/2
  974.     push    h
  975.     xchg            
  976.     call    subde        ; (ptr)-bufbase
  977.     call    rotrhl        ; /2
  978.     pop    d        ; + bufbase
  979.     dad    d        ;
  980.     pop    d        ;move it to tbuff
  981.     call    move16        ;de points to next slot in tbuff
  982.     pop    b        ;+0
  983.     dcr    b
  984.     jnz    wtlp2
  985. ;
  986.     lxi    h,tbuff        ;update the record's checksum byte
  987.     call    cksum
  988.     mov    m,a
  989. ;
  990.     lxi    d,tdfcb        ;write the record
  991.     mvi    c,WRITFN
  992. dbug:    call    bdos
  993.     ora    a
  994.     pop    h
  995.     jnz    tdwerr
  996.     dcx    h        ;count down
  997.     mov    a,h
  998.     ora    l
  999.     jnz    wtlp1
  1000. ;
  1001.     lxi    d,tdfcb        ;close TIME&DAT file
  1002.     push    d
  1003.     mvi    c,CLOSE
  1004.     call    bdos
  1005.     pop    d
  1006.     inr    a
  1007.     jz    tdcerr
  1008.     lxi    h,tdfcb+9        ;return file to r/o status
  1009.     mov    a,m
  1010.     ori    80h
  1011.     mov    m,a
  1012.     mvi    c,ATTFN
  1013.     jmp    bdos    
  1014. ;
  1015.  
  1016. ; check-sum 1st 127 bytes at (hl)
  1017. ;
  1018. cksum:    mvi    b,127
  1019.     xra    a
  1020. cksu1:    add    m
  1021.     inx    h
  1022.     dcr    b
  1023.     jnz    cksu1
  1024.     ret
  1025.  
  1026. tdnam0:    db    0,'!!!TIME&DAT'
  1027. tdoerr:    call    ilprt
  1028.     db    CR,LF,7,'Can''t open',0
  1029. ;
  1030. fnerr:    call    ilprt
  1031.     db    ' "!!!TIME&.DAT" file!',CR,LF,0
  1032.     ret
  1033. ;
  1034. tdwerr:    call    ilprt
  1035.     db    CR,LF,7,'Write error',0
  1036.     jmp    fnerr
  1037. ;
  1038. tdcerr:    call    ilprt
  1039.     db    CR,LF,7,'Close error',0
  1040.     jmp    fnerr
  1041.  
  1042. ;----------------------------------------
  1043. ;
  1044. ;    MISCELLANEOUS SUPPORT ROUTINES
  1045. ;
  1046. setcur:    lda    curdsk
  1047.     mov    e,a        ;put drive back
  1048.     mvi    c,SELDRV
  1049.     jmp    bdos
  1050. ;
  1051. ;
  1052. ;compare B bytes at de and hl
  1053. ;    (w/o attributes )
  1054. ;
  1055. match7:    ldax    d
  1056.     xra    m
  1057.     ani    7fh        ;ignore attributes
  1058.     rnz
  1059.     inx    h
  1060.     inx    d
  1061.     dcr    b
  1062.     jnz    match7
  1063.     ret
  1064.  
  1065. ; Utility subtraction subroutine...HL = HL-DE
  1066. ;
  1067. SUBDE:    MOV    A,L
  1068.     SUB    E
  1069.     MOV    L,A
  1070.     MOV    A,H
  1071.     SBB    D
  1072.     MOV    H,A
  1073.     RET
  1074. ;
  1075. ; divide HL by 2
  1076. ;
  1077. ROTRHL:    ORA    A        ;clear carry
  1078.     MOV    A,H
  1079.     RAR
  1080.     MOV    H,A
  1081.     MOV    A,L
  1082.     RAR
  1083.     MOV    L,A
  1084.     RET
  1085. ;
  1086. ;
  1087. ; Come here if we get a read error
  1088. ;
  1089. RERROR:    CALL    ILPRT
  1090.     DB    '++ READ ERROR - NO CHANGE made'
  1091.     DB    CR,LF,0
  1092.     JMP    EXIT
  1093. ;.....
  1094. ;
  1095. ;
  1096. ; Come here if we get a write error
  1097. ;
  1098. WERROR:    CALL    ILPRT
  1099.     DB    '++ WRITE ERROR - '
  1100.     DB    'directory left in UNKNOWN condition',CR,LF,0
  1101.     JMP    EXIT
  1102. ;.....
  1103. ;
  1104. ;
  1105. ; M/PM OR CP/M 3.0 not allowed with this program
  1106. ;
  1107. MPMYES:    CALL    ILPRT
  1108.     DB    CR,LF,'SAP '
  1109.     db    vers/10 +'0','.',(vers mod 10) +'0'
  1110.     db    ' not useable with M/PM or CP/M 3.0',0
  1111.     rst    0        ; v 5.3 warm boot
  1112. ;.....
  1113. ;
  1114. ;
  1115. ; Data area
  1116. ;
  1117. ADDR:    DS    2
  1118. dirlen:    ds    2
  1119. DIRCNT:    DS    2
  1120. I:    DS    2
  1121. J:    DS    2
  1122. GAP:    ds    2
  1123. JG:    ds    2
  1124.  
  1125. RECTBL:    DS    2
  1126. RECORD:    DS    2
  1127. TRACK:    DS    2
  1128.  
  1129. tdcnt:    ds    2
  1130.  
  1131. NOSWAP:    DS    1
  1132. VERFLG:    DS    1
  1133. WRFLAG:    DS    1
  1134. tdflag:    ds    1
  1135. cleanflg:ds    1
  1136. ;
  1137. ;
  1138. ; Disk parameter block:
  1139. ;
  1140. DPB:
  1141. SPT:    DS    2
  1142. BSH:    DS    1
  1143. BLM:    DS    1
  1144. EXM:    DS    1
  1145. DSM:    DS    2
  1146. DRM:    DS    2
  1147. AL0:    DS    1
  1148. AL1:    DS    1
  1149. CKS:    DS    2
  1150. SYSTRK:    DS    2
  1151. curdsk:    ds    1
  1152. o$disk:    ds    1
  1153. o$user:    ds    1
  1154. bufbase:ds    2
  1155. ptr:    ds    2
  1156. scount:    ds    2
  1157. ;
  1158. tdfcb:    ds    36        ;DateStamper file control block
  1159. ;.....
  1160. ;
  1161. ;
  1162. VECTRS:    DS    17*3        ;room for jump vectors
  1163. ;
  1164. WBOOT:    EQU    VECTRS+3    ;do not change these equates
  1165. CSTS:    EQU    VECTRS+6
  1166. CI:    EQU    VECTRS+9
  1167. CO:    EQU    VECTRS+12
  1168. LO:    EQU    VECTRS+15
  1169. PO:    EQU    VECTRS+18
  1170. RI:    EQU    VECTRS+21
  1171. HOME:    EQU    VECTRS+24
  1172. SELDSK:    EQU    VECTRS+27
  1173. SETTRK:    EQU    VECTRS+30
  1174. SETREC:    EQU    VECTRS+33
  1175. SETDMA:    EQU    VECTRS+36
  1176. READ:    EQU    VECTRS+39
  1177. WRITE:    EQU    VECTRS+42
  1178. LSTS:    EQU    VECTRS+45    ;only in CP/M 2.2
  1179. RECTRN:    EQU    VECTRS+48    ;only in CP/M 2.2
  1180. ;.....
  1181. ;
  1182. ;
  1183. ;
  1184.     DS    32        ;minimum stack depth
  1185. ;
  1186. ;
  1187. EVEN:    EQU    ($+255)/256*256    ;start buffer on even page, which also
  1188.                 ;increase stack area greatly
  1189. ;
  1190.     ORG    EVEN
  1191. ;
  1192. STACK:    EQU    $-2
  1193. ;
  1194. order:    DS    0
  1195. ;
  1196. ;
  1197.     END
  1198.  
  1199.