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 / ZSYS / SIMTEL20 / ZCPR3 / CLEANDIR.MAC < prev    next >
Text File  |  2000-06-30  |  15KB  |  857 lines
  1. ;
  2. ; Program:  CLEANDIR
  3. ; Derivation:  SAP 3.8 (see following history for authors)
  4. ; Derivation By:  Richard Conn
  5. ; Version: 1.1
  6. ; Date:  28 November 1984
  7. ; Previous Versions: 1.0 (20 June 84)
  8. ; 
  9. ; bug fix ;841201    Peter T Lyman
  10. ; Version 1.1P
  11. ;
  12. ;    Search for ';841201' to locate the code
  13. ;
  14. ;    CLEANDIR can and does wipe out the operating system
  15. ;    (also known as a crash) whenever the maximum size of
  16. ;    the directory (DRM) exceeds the available memory....
  17. ;
  18. ;    Maybe that is a good feature, since you at least don't
  19. ;    hurt the disk...
  20. ;
  21. ;    However on my hard disk I have two platters with
  22. ;    DRM equal to 2048....  In this case CLEANDIR crashes...
  23. ;
  24. ;    The fix that I have added (I did this with an early version
  25. ;    of SAP) gives you a choice....  If DRM is greater than
  26. ;    the space available betwwen BUF and BDOS,  you are given
  27. ;    a choice with proceeding if the actual number of directory
  28. ;    entries is less than or equal to the space available....
  29. ;    If not you ABORT.....
  30. ;
  31. ;    The down side risk of this modification is that if you
  32. ;    proceed ("Y") when the actual number of files exceeds
  33. ;    the space available,  you lose all the directories entries
  34. ;    which don't fit in the available space....
  35. ;
  36. ;    With out the fix the system crashes and you cannot clean the
  37. ;    directory...  With the fix you can clean the directory, but
  38. ;    you can lose files if you don't pay attention....
  39. ;
  40.  
  41. vers    equ    11
  42. z3env    equ    0f400h
  43.  
  44. ;
  45. ;  SYSLIB and Z3LIB References
  46. ;
  47.     ext    z3init,z3log
  48.     ext    eprint,cout
  49.     ext    codend
  50.     ext    phlfdc                        ;841201
  51.  
  52. ;
  53. ; Environment Definition
  54. ;
  55.     if    z3env ne 0
  56. ;
  57. ; External ZCPR3 Environment Descriptor
  58. ;
  59.     jmp    start
  60.     db    'Z3ENV'    ;This is a ZCPR3 Utility
  61.     db    1    ;External Environment Descriptor
  62. z3eadr:
  63.     dw    z3env
  64. start:
  65.     lhld    z3eadr    ;pt to ZCPR3 environment
  66. ;
  67.     else
  68. ;
  69. ; Internal ZCPR3 Environment Descriptor
  70. ;
  71.     MACLIB    Z3BASE.LIB
  72.     MACLIB    SYSENV.LIB
  73. z3eadr:
  74.     jmp    start
  75.     SYSENV
  76. start:
  77.     lxi    h,z3eadr    ;pt to ZCPR3 environment
  78.     endif
  79.  
  80. ;
  81. ; Start of Program -- Initialize ZCPR3 Environment
  82. ;
  83.     call    z3init    ;initialize the ZCPR3 Environment
  84.  
  85. ; v3.8 SORT AND PACK CP/M DISK DIRECTORY - 10/16/83
  86. ;
  87. ; THIS PROGRAM READS THE DISK DIRECTORY TRACKS, SORTS THEM ALPHABETICALLY
  88. ; THEN REPLACES THEM ON THE DISK.  ALL UNUSED OR ERASED AREAS ON THE DIR-
  89. ; ECTORY TRACK ARE REFORMATTED WITH CONTINUOUS 'E5' CHARACTERS.  (THIS
  90. ; ERASES PREVIOUS FILE NAMES WHICH HAVE BEEN DEACTIVATED.)  SORTING THE
  91. ; DIRECTORY IN THIS MANNER OFFERS MANY ADVANTAGES.  SOME OF THEM ARE:
  92. ;
  93. ;    1)  ALLOWS 'DIR' TO SHOW AN ALPHABETIZED LISTING
  94. ;    2)  ELIMINATES POTENTIAL PROBLEMS WITH "UNERASE" PROGRAMS
  95. ;    3)  SPEEDS UP ACCESS VIA 'SD' AND OTHER SPECIAL PROGRAMS
  96. ;    4)  ASSISTS ON WORKING DIRECTLY ON THE DISK WITH 'DUU', ETC.
  97. ;    5)  REMOVES FILES FROM THE DISK SOMEBODY ELSE COULD RECOVER
  98. ;
  99. ;                - Notes by Irv Hoff W6FFC
  100. ;
  101. ; 1977    Written by L. E. Hughes.  Modified extensively since by Bruce
  102. ;     Ratoff, Keith Petersen, James Prest, Ron Fowler, Frank Gaude,
  103. ;    Irv Hoff and likely others.
  104. ;
  105. ; 10/16/83 Now using a Shell-Metzner sort which speeds the sorting time
  106. ;       considerably, especially on large directories. (SFK)
  107. ;
  108. ; 07/27/83 Shows an error flag for MP/M and CP/M+ both.  Rewrites dir-
  109. ;       tory even if previously sorted, to insure erased programs at
  110. ;   v3.7   end of directory are properly cleared.
  111. ;                    - Irv Hoff
  112. ;                                                              
  113. TRUE    EQU    0FFH
  114. FALSE    EQU    0
  115. ;
  116. BDOS    EQU    5
  117. CR    EQU    0DH
  118. DPBLEN    EQU    15        ;SIZE OF CP/M2 DISK PARAMETER BLOCK
  119. FCB    EQU    5CH
  120. FCB2    EQU    6CH
  121. GETDSK    EQU    25        ;BDOS "GET DISK #" FUNCTION
  122. LF    EQU    0AH
  123. SELDRV    EQU    14        ;SELECT DRIVE
  124. ;.....
  125. ; 
  126. ;
  127. ; OBTAIN BIOS VECTORS
  128. ;
  129. VECTRS:
  130.     JMP    GETVEC
  131. ;
  132.     DS    53        ;ROOM FOR JUMP VECTORS
  133. ;
  134. WBOOT    EQU    VECTRS+3    ;DO NOT CHANGE THESE EQUATES
  135. CSTS    EQU    VECTRS+6
  136. CI    EQU    VECTRS+9
  137. CO    EQU    VECTRS+12
  138. LO    EQU    VECTRS+15
  139. PO    EQU    VECTRS+18
  140. RI    EQU    VECTRS+21
  141. HOME    EQU    VECTRS+24
  142. SELDSK    EQU    VECTRS+27
  143. SETTRK    EQU    VECTRS+30
  144. SETSEC    EQU    VECTRS+33
  145. SETDMA    EQU    VECTRS+36
  146. READ    EQU    VECTRS+39
  147. WRITE    EQU    VECTRS+42
  148. LSTS    EQU    VECTRS+45    ;ONLY IN CP/M2
  149. SECTRN    EQU    VECTRS+48    ;ONLY IN CP/M2
  150. ;
  151. ;  GET BIOS VECTORS
  152. ;
  153. GETVEC:
  154.     LXI    D,WBOOT
  155.     LHLD    1
  156.     MVI    B,53
  157.     CALL    MOVE
  158. ;
  159. ;  PROGRAM STARTS HERE
  160. ;
  161.     LXI    H,0
  162.     DAD    SP        ;GET ADDRESS OF CP/M STACK
  163.     SHLD    STACK        ;STORE IT SO WE CAN GO BACK TO IT
  164.     CALL    CODEND        ;DETERMINE FREE SPACE
  165.     LXI    D,80H        ;ALLOW 80H BYTES FOR STACK
  166.     SHLD    BUF        ;SET BUFFER ADDRESS
  167.     SPHL            ;SET TOP OF STACK
  168.     lda    bdos+2        ;fetch bdos page        ;841201
  169.     dcr    a        ; less one            ;
  170.     lhld    buf        ;fetch buf pntr            ;
  171.     sub    h        ;available space for dir    ;
  172.     mvi    h,0        ;                ;
  173.     mov    l,a        ;number of pages available    ;
  174.     dad    h        ;x2->number of sectors        ;
  175.     dad    h        ;x2                ;
  176.     dad    h        ;x2->number of directory    ;
  177.                 ;    entries which will fit    ;
  178.     shld    maxdir        ;save for later            ;
  179.     XRA    A        ;SET NO REVERSE OF USER AREAS
  180.     STA    REVERSE
  181.        CALL    EPRINT        ;PRINT MSG:
  182.     DB    'CLEANDIR, Version '
  183.     DB    (vers/10)+'0','.',(vers mod 10)+'0','P'        ;841201
  184.     DB    0
  185.     LDA    FCB+1        ;CHECK FOR HELP REQUEST
  186.     CPI    '/'        ;ANY OPTION MEANS HELP
  187.     JZ    HELP
  188.     CPI    'D'        ;SELECT DESCENDING ORDER?
  189.     JZ    DESC
  190.     LDA    FCB2+1        ;CHECK FOR OPTION CHAR
  191.     CPI    'D'        ;DESCENDING ORDER OF USER AREAS?
  192.     JNZ    SAP
  193. DESC:
  194.     MVI    A,0FFH        ;ENABLE REVERSE
  195.     STA    REVERSE
  196.     JMP    SAP
  197. ;
  198. ;  PRINT HELP MESSAGE
  199. ;
  200. HELP:
  201.     CALL    EPRINT
  202.     DB    CR,LF,'Syntax:'
  203.     DB    CR,LF,'  CLEANDIR dir: o'
  204.     DB    CR,LF,'Options:'
  205.     DB    CR,LF,'  D - sort in Descending Order (users and files)'
  206.     DB    CR,LF,'Note:'
  207.     DB    CR,LF,'  Only disk ref is used in dir: form'
  208.     DB    0
  209.     JMP    EXIT1
  210. ;
  211. ;  MAIN PROGRAM ROUTINE
  212. ;
  213. SAP:
  214.     CALL    SETUP
  215.     call    ckdrsz        ;check available memory space    ;841201
  216.     CALL    RDDIR
  217.     CALL    CLEAN
  218.     CALL    SORT
  219.     CALL    PACK
  220.     CALL    WRDIR
  221.     CALL    EPRINT
  222.     DB    'Done',0
  223.     JMP    EXIT
  224.  
  225. ckdrsz:    lhld    drm        ;fetch max dir size        ;841201
  226.     xchg            ;                ;
  227.     lhld    maxdir        ;fetch memory available for dir    ;
  228.     call    hlmde        ;subtract            ;
  229.     rnc            ;return if room            ;
  230.     call    eprint        ;else...            ;
  231.     db    lf,lf,lf,lf,lf,lf                ;
  232.     db    cr,lf,'Your maximum directory size is ',0    ;
  233.     lhld    drm        ;print max dir size        ;
  234.     inx    h        ;                ;
  235.     call    phlfdc        ;                ;
  236.     call    eprint        ;                ;
  237.     db    ' directory entries.',0                ;
  238.     call    eprint        ;                ;
  239.     db    cr,lf,'your memory can only handle    ',0    ;
  240.     lhld    maxdir        ;print space available        ;
  241.     call    phlfdc        ;                ;
  242.     call    eprint        ;                ;
  243.     db    ' directory entries.'                ;
  244.     db    cr,lf,lf,'IF.....your directory DOES NOT exceed ',0;
  245.     lhld    maxdir        ;                ;
  246.     call    phlfdc        ;                ;
  247.     call    eprint        ;                ;
  248.     db    ' directory entries,'                ;
  249.     db    cr,lf,'                 (Directory entries  NOT  Files)';
  250.     db    cr,lf,'       you may enter "Y" to proceed,'    ;
  251.     db    cr,lf,lf,'ELSE...any other key ABORTS.'        ;
  252.     db    cr,lf,lf,lf,lf,lf,lf,lf,lf,'..............> ',7,0;
  253. ck1:    mvi    c,6        ;get input            ;
  254.     mvi    e,-1        ;                ;
  255.     call    bdos        ;                ;
  256.     cpi    0        ;                ;
  257.     jz    ck1        ;                ;
  258.     ani    5fh        ;                ;
  259.     cpi    'Y'        ;                ;
  260.     jnz    exit1        ;                ;    
  261.     lhld    maxdir        ;                ;
  262.     shld    drm        ;                ;
  263.     ret            ;                ;
  264.                 ;                ;
  265. hlmde:    mov    a,h        ;                ;
  266.     cmp    d        ;                ;
  267.     rnz            ;                ;
  268.     mov    a,l        ;                ;
  269.     cmp    e        ;                ;
  270.     ret            ;                ;
  271. ;
  272. ;    SUBROUTINES
  273. ;
  274. ;
  275. CLEAN:
  276.     LXI    H,0        ;I = 0
  277. ;
  278. CLNLOP:
  279.     SHLD    I
  280.     CALL    INDEX        ;HL = BUF + 16 * I
  281.     MOV    A,M        ;JUMP IF THIS IS A DELETED FILE
  282.     CPI    0E5H
  283.     JZ    FILLE5
  284.     LXI    D,12
  285.     DAD    D        ;HL = HL + 12
  286.     MOV    A,M        ;CHECK EXTENT FIELD
  287.     ORA    A
  288.     JNZ    CLBUMP        ;SKIP IF NOT EXTENT ZERO
  289.     INX    H        ;POINT TO RECORD COUNT FIELD
  290.     INX    H
  291.     MOV    A,M        ;GET S2 BYTE (EXTENDED RC)
  292.     ANI    0FH        ;  FOR CPM2, 0 FOR CPM1
  293.     MOV    E,A
  294.     INX    H
  295.     MOV    A,M        ;CHECK RECORD COUNT FIELD
  296.     ORA    E
  297.     JNZ    CLBUMP        ;JUMP IF NON-ZERO
  298.     LHLD    I        ;CLEAR ALL 32 BYTES OF
  299.     CALL    INDEX        ;  DIRECTORY ENTRY TO E5
  300.     INX    H
  301.     MOV    A,M        ;GET FIRST CHAR OF FILENAME
  302.     DCX    H        ;  WARD CHRISTENSONS CAT PGMS
  303.     CPI    '-'        ;  HAVE DISKNAME OF ZERO LENGTH
  304.     JZ    CLBUMP        ;  THAT START WITH '-', DON'T DELETE
  305.     CPI    ' '        ;  DISCAT USES DISKNAME OF ZERO LENGTH
  306.     JZ    CLBUMP        ;  THAT STARTS WITH ' ', DON'T DELETE
  307. ;
  308. FILLE5:
  309.     MVI    C,32        ;NUMBER OF BYTES TO CLEAR
  310. ;
  311. FILLOP:
  312.     MVI    M,0E5H        ;MAKE IT ALL E5'S
  313.     INX    H
  314.     DCR    C
  315.     JNZ    FILLOP
  316. ;
  317. CLBUMP:
  318.     LHLD    DRM        ;GET COUNT OF FILENAMES
  319.     INX    H
  320.     XCHG
  321.     LHLD    I        ;OUR CURRENT COUNT
  322.     INX    H
  323.     PUSH    H
  324.     CALL    SUBDE        ;SUBTRACT
  325.     POP    H
  326.     JC    CLNLOP        ;LOOP TILL ALL CLEANED
  327.     RET
  328. ;
  329. DODIR:
  330.     STA    WRFLAG
  331.     LHLD    SYSTRK
  332.     CALL    DOTRAK        ;SET THE TRACK
  333.     LXI    H,0
  334.     SHLD    SECTOR
  335.     LHLD    DRM        ;NUMBER OF DIR ENTRIES
  336.     INX    H        ;RELATIVE TO 1
  337.     CALL    ROTRHL        ;DIVIDE BY 4
  338.     CALL    ROTRHL        ;  TO GET SECTOR COUNT
  339.     SHLD    DIRCNT
  340.     LHLD    BUF
  341.     SHLD    ADDR        ;FOR DMA ADDRESS
  342. ;
  343. DIRLOP:
  344.     LHLD    SECTOR        ;GET SECTORS PER TRACK
  345.     INX    H
  346.     XCHG
  347.     LHLD    SPT        ;CURRENT SECTOR
  348.     CALL    SUBDE        ;  SECTOR - SPT
  349.     XCHG
  350.     JNC    NOTROV
  351. ;
  352. ; TRACK OVERFLOW, BUMP TO NEXT
  353. ;
  354.     LHLD    TRACK
  355.     INX    H
  356.     CALL    DOTRAK
  357.     LXI    H,1        ;REWIND SECTOR NUMBER
  358. ;
  359. NOTROV:
  360.     CALL    DOSEC        ;SET CURRENT SECTOR
  361.     LHLD    ADDR
  362.     MOV    B,H        ;SET UP DMA ADDRESS
  363.     MOV    C,L
  364.     CALL    SETDMA
  365.     LDA    WRFLAG        ;TIME TO FIGURE OUT
  366.     ORA    A        ;  IF WE ARE READING
  367.     JNZ    DWRT        ;  OR WRITING
  368. ;
  369. ;
  370. ; READ
  371. ;
  372.     CALL    READ
  373.     ORA    A        ;TEST FLAGS ON READ
  374.     JNZ    RERROR        ;NZ=ERROR
  375.     JMP    MORE        ;GOOD READ, GO DO MORE
  376. ;
  377. ; TRACK AND SECTOR UPDATE ROUTINES
  378. ;
  379. DOTRAK:
  380.     SHLD    TRACK
  381.     MOV    B,H
  382.     MOV    C,L
  383.     CALL    SETTRK
  384.     RET
  385. DOSEC:
  386.     SHLD    SECTOR
  387.     MOV    B,H
  388.     MOV    C,L
  389.     LHLD    SECTBL
  390.     XCHG
  391.     DCX    B
  392.     CALL    SECTRN
  393.     MOV    B,H
  394.     MOV    C,L
  395.     CALL    SETSEC
  396.     RET
  397. ;
  398. ; WRITE
  399. ;
  400. DWRT:
  401.     MVI    C,1        ;FOR CPM/2 DEBLOCKING BIOS'S
  402.     CALL    WRITE
  403.     ORA    A        ;TEST FLAGS ON WRITE
  404.     JNZ    WERROR        ;NZ=BAD DIRECTORY WRITE
  405.     JMP    MORE
  406. ;
  407. ; Exit Program
  408. ;
  409. EXIT:
  410.     LDA    NOBOOT        ;SEE IF BOOT IS NEEDED
  411.     ORA    A
  412.     JNZ    EXIT1        ;FLAG IS SET IF ALREADY ALPHABETIZED
  413.     JMP    0000H        ;A REWRITTEN DIRECTORY NEEDS A WARM BOOT
  414. ;
  415. EXIT1:
  416.     LHLD    STACK        ;GET ADDRESS OF ORIGINAL CP/M STACK
  417.     SPHL            ;RESET STACK ADDRESS
  418.     RET
  419. ;
  420. INDEX:
  421.     DAD    H
  422.     DAD    H
  423.     DAD    H
  424.     DAD    H
  425.     DAD    H
  426.     XCHG
  427.     LHLD    BUF    ;GET ADDRESS OF BUF
  428.     XCHG
  429.     DAD    D
  430.     RET
  431. ;
  432. ; GOOD READ OR WRITE
  433. ;
  434. MORE:
  435.     LHLD    ADDR        ;BUMP DMA ADRS FOR NEXT PASS
  436.     LXI    D,80H
  437.     DAD    D
  438.     SHLD    ADDR
  439.     LHLD    DIRCNT        ;COUNTDOWN ENTRIES
  440.     DCX    H
  441.     SHLD    DIRCNT
  442.     MOV    A,H        ;TEST FOR ZERO LEFT
  443.     ORA    L
  444.     JNZ    DIRLOP        ;LOOP TILL ZERO
  445. ;
  446. ;
  447. ; DIRECTORY I/O DONE, RESET DMA ADDRESS
  448. ;
  449.     LXI    B,80H
  450.     CALL    SETDMA
  451.     RET
  452. ;
  453. ; MOVE UTILITY SUBROUTINE
  454. ;
  455. MOVE:
  456.     MOV    A,M
  457.     STAX    D
  458.     INX    H
  459.     INX    D
  460.     DCR    B
  461.     JNZ    MOVE
  462.     RET
  463. ;
  464. ; PACK DIRECTORY
  465. ;
  466. PACK:
  467.     LXI    H,0        ;I = 0
  468. ;
  469. PACK1:
  470.     SHLD    I
  471.     CALL    INDEX        ;HL = BUF + 16 * I
  472.     LXI    D,9
  473.     DAD    D        ;HL = HL + 9
  474.     MOV    A,M        ;JUMP IF FILETYPE NOT 'X$$'
  475.     SUI    '0'        ;  WHERE 0.LE.X.LE.9
  476.     JC    PACK2
  477.     CPI    10
  478.     JNC    PACK2
  479.     STA    J
  480.     INX    H
  481.     MOV    A,M
  482.     CPI    '$'
  483.     JNZ    PACK2
  484.     INX    H
  485.     MOV    A,M
  486.     CPI    '$'
  487.     JNZ    PACK2
  488.     INX    H        ;SET EXTENT NUMBER TO X
  489.     LDA    J
  490.     MOV    M,A
  491.     DCX    H        ;SET FILETYPE TO '$$$'
  492.     MVI    M,'$'
  493.     DCX    H
  494.     MVI    M,'$'
  495.     DCX    H
  496.     MVI    M,'$'
  497. ;
  498. PACK2:
  499.     LHLD    I        ;I = I + 1
  500.     INX    H
  501.     XCHG
  502.     LHLD    DRM
  503.     INX    H
  504.     XCHG
  505.     PUSH    H
  506.     CALL    SUBDE
  507.     POP    H        ;LOOP UNTIL I > DRM
  508.     JC    PACK1
  509.     RET
  510. ;
  511. ; READ AND WRITE DIRECTORY ROUTINES
  512. ;
  513. RDDIR:
  514.     CALL    EPRINT
  515.     DB    ' --> Reading, ',0
  516.     XRA    A
  517.     STA    NOBOOT        ;ZERO THE FLAG
  518.     JMP    DODIR        ;ZERO THE WRITE FLAG FOR NOW
  519. ;
  520. ; COME HERE IF WE GET A READ ERROR
  521. ;
  522. RERROR:
  523.     CALL    EPRINT        ;PRINT:
  524.     DB    ' READ ERROR - No Change Made',0
  525.     JMP    EXIT
  526. ;
  527. ; DIVIDE HL BY 2
  528. ;
  529. ROTRHL:
  530.     ORA    A        ;CLEAR CARRY
  531.     MOV    A,H
  532.     RAR
  533.     MOV    H,A
  534.     MOV    A,L
  535.     RAR
  536.     MOV    L,A
  537.     RET
  538. ;
  539. ; SETUP FOR SELECTING DRIVE AND LOADING DISK PARM BLOCK
  540. ;
  541. SETUP:
  542.     LXI    D,FCB
  543.     CALL    Z3LOG        ;LOG INTO DISK SPECIFIED BY USER
  544.     MVI    C,GETDSK    ;OTHERWISE GET CURRENT DEFAULT DRIVE
  545.     CALL    BDOS        ;SO QUERY 'BDOS' FOR DRIVE
  546.     MOV    C,A        ;PREP FOR OBTAINING DPB
  547.     CALL    EPRINT
  548.     DB    CR,LF,' Disk ',0
  549.     MOV    A,C        ;GET DISK NUMBER
  550.     ADI    'A'        ;CONVERT TO ASCII
  551.     CALL    COUT
  552.     CALL    SELDSK
  553. ;
  554. ; GET CP/M 2.2 DPB DATA
  555. ;
  556.     MOV    E,M
  557.     INX    H
  558.     MOV    D,M
  559.     INX    H
  560.     XCHG
  561.     SHLD    SECTBL
  562.     XCHG
  563.     LXI    D,8        ;OFFSET TO DPB WITHIN HEADER
  564.     DAD    D        ;RETURNED BY SELDSK IN CPM2
  565.     MOV    A,M        ;GET ADRS OF DPB
  566.     INX    H
  567.     MOV    H,M
  568.     MOV    L,A
  569.     LXI    D,DPB        ;POINT TO DEST: OUR DPB
  570.     MVI    B,DPBLEN
  571.     CALL    MOVE
  572.     RET
  573. ;
  574. ; SORT THE DIRECTORY
  575. ;
  576. SORT:
  577.     CALL    EPRINT
  578.     DB    'Sorting (',0
  579.     LDA    REVERSE        ;INDICATE ASC OR DSC
  580.     ORA    A        ;0=ASC
  581.     JZ    SORTASC
  582.     CALL    EPRINT
  583.     DB    'Descending',0
  584.     JMP    SORTDO
  585. SORTASC:
  586.     CALL    EPRINT
  587.     DB    'Ascending',0
  588. ;
  589. ; SHELL-METZNER SORT
  590. ;
  591. SORTDO:
  592.     CALL    EPRINT
  593.     DB    ' Order), ',0
  594.     LHLD    I
  595.     SHLD    SNUMRECW
  596.     LHLD    BUF
  597.     SHLD    SSTADR
  598.     PUSH    H        ;  AND SAVE IT
  599.     LXI    H,32
  600.     SHLD    SRECLEN
  601.     PUSH    H        ;  AND SAVE IT
  602. ;
  603. ; NOW DIVIDE # OF FIELDS BY 2
  604. ;
  605. DIVIDE:
  606.     LHLD    SNUMRECW    ;GET VALUE
  607.     CALL    ROTRHL
  608.     SHLD    SNUMRECW    ;SAVE RESULT
  609.     MOV    A,L        ;IF SNUMRECW<>0
  610.     ORA    H        ;  THEN
  611.     JNZ    NOTDONE        ;    NOT DONE
  612. ;
  613. ; ALL FIELDS SORTED
  614. ;
  615.     POP    B        ;CLEAN UP STACK
  616.     POP    D
  617.     RET
  618. ;
  619. NOTDONE:
  620.     XCHG
  621.     LHLD    I
  622.     MOV    A,L
  623.     SUB    E
  624.     MOV    L,A
  625.     MOV    A,H
  626.     SBB    D
  627.     MOV    H,A
  628.     SHLD    SRECLEN
  629.     LXI    H,1
  630.     SHLD    SSORTV1
  631.     SHLD    SSTADR
  632.     DCR    L
  633.     POP    B
  634.     PUSH    B
  635. NDONE1:
  636.     DAD    D
  637.     DCX    B
  638.     MOV    A,B
  639.     ORA    C
  640.     JNZ    NDONE1
  641.     SHLD    SSORTV2
  642.     XCHG
  643.     POP    B
  644.     POP    H
  645.     PUSH    H
  646.     PUSH    B
  647. NDONE2:
  648.     SHLD    SSORTV4
  649.     SHLD    SSORTV3
  650.     XCHG
  651.     DAD    D
  652.     XCHG
  653. COMPARE:
  654.     POP    B
  655.     PUSH    B
  656. COMPAR1:
  657.     LDAX    D
  658.     ANI    7FH
  659.     PUSH    B
  660.     MOV    C,A
  661.     MOV    A,M
  662.     ANI    7FH
  663.     MOV    B,A
  664.     MOV    A,C
  665.     SUB    B
  666.     POP    B
  667.     JNZ    NOTEQU
  668.     INX    H
  669.     INX    D
  670.     DCX    B
  671.     MOV    A,B
  672.     ORA    C
  673.     JNZ    COMPAR1
  674.     JMP    NOSWITCH
  675. ;
  676. ; THE CONDITION AT NOTEQU: HAS TO
  677. ; BE CHANGED FOR DESCENDING SORT -- IF REVERSE=0, JNC TO NOSWITCH, ELSE
  678. ; JC TO NOSWITCH
  679. ;
  680. NOTEQU:
  681.     PUSH    PSW    ;SAVE CONDITION
  682.     LDAX    D    ;GET (DE)
  683.     CPI    0E5H    ;IF ERASED, SELECT ASCENDING
  684.     JZ    ASCENDING
  685.     MOV    A,M    ;GET (HL)
  686.     CPI    0E5H    ;IF ERASED, SELECT ASCENDING
  687.     JZ    ASCENDING
  688.     LDA    REVERSE    ;DESCENDING SORT?
  689.     ORA    A    ;0=NO
  690.     JZ    ASCENDING
  691.     POP    PSW    ;GET CONDITION FOR DESCENDING SORT
  692.     JC    NOSWITCH
  693.     JMP    SWITCH
  694. ASCENDING:
  695.     POP    PSW    ;GET CONDITION FOR ASCENDING SORT
  696.     JNC    NOSWITCH
  697. SWITCH:
  698.     PUSH    B
  699.     MOV    B,M
  700.     LDAX    D
  701.     MOV    M,A
  702.     MOV    A,B
  703.     STAX    D
  704.     INX    H
  705.     INX    D
  706.     POP    B
  707.     DCX    B
  708.     MOV    A,B
  709.     ORA    C
  710.     JNZ    SWITCH
  711.     LHLD    SNUMRECW
  712.     MOV    A,H
  713.     CMA
  714.     MOV    D,A
  715.     MOV    A,L
  716.     CMA
  717.     MOV    E,A
  718.     LHLD    SSORTV1
  719.     DAD    D
  720.     JNC    NOSWITCH
  721.     INX    H
  722.     SHLD    SSORTV1
  723.     LHLD    SSORTV3
  724.     XCHG
  725.     LHLD    SSORTV2
  726.     MOV    A,E
  727.     SUB    L
  728.     MOV    L,A
  729.     MOV    A,D
  730.     SBB    H
  731.     MOV    H,A
  732.     SHLD    SSORTV3
  733.     JMP    COMPARE
  734. ;
  735. NOSWITCH:
  736.     LHLD    SSTADR
  737.     INX    H
  738.     SHLD    SSTADR
  739.     SHLD    SSORTV1
  740.     XCHG
  741.     LHLD    SRECLEN
  742.     MOV    A,L
  743.     SUB    E
  744.     MOV    A,H
  745.     SBB    D
  746.     JC    DIVIDE
  747.     LHLD    SSORTV4
  748.     POP    D
  749.     PUSH    D
  750.     DAD    D
  751.     XCHG
  752.     LHLD    SSORTV2
  753.     XCHG
  754.     JMP    NDONE2
  755. ;
  756. ; UTILITY SUBTRACTION SUBROUTINE...
  757. ; HL=HL-DE
  758. ;
  759. SUBDE:
  760.     MOV    A,L
  761.     SUB    E
  762.     MOV    L,A
  763.     MOV    A,H
  764.     SBB    D
  765.     MOV    H,A
  766.     RET
  767. ;.....
  768. ;
  769. ;
  770. WRDIR:
  771.     CALL    EPRINT
  772.     DB    'Writing, ',0
  773.     MVI    A,1
  774.     JMP    DODIR
  775. ;
  776. ; COME HERE IF WE GET A WRITE ERROR
  777. ;
  778. WERROR:
  779.     CALL    EPRINT        ;PRINT:
  780.     DB    ' WRITE ERROR - Directory Left in UNKNOWN Condition',0
  781.     JMP    EXIT
  782. ;
  783. ; DATA AREA
  784. ;
  785. ADDR:
  786.     DS    2
  787. BUF:
  788.     DS    2
  789. DIRCNT:
  790.     DS    2
  791. I:
  792.     DS    2
  793. J:
  794.     DS    2
  795. MAPPTR:
  796.     DS    2
  797. maxdir:
  798.     ds    2                        ;841201
  799. NOBOOT:
  800.     DS    1
  801. NOSWAP:
  802.     DS    1
  803. REVERSE:
  804.     DS    1
  805. SECTBL:
  806.     DS    2
  807. SECTOR:
  808.     DS    2
  809. TRACK:
  810.     DS    2
  811. WRFLAG:
  812.     DS    1
  813. SRECLEN:
  814.     DS    2
  815. SSTADR:
  816.     DS    2
  817. SSORTV1:
  818.     DS    2
  819. SSORTV2:
  820.     DS    2
  821. SSORTV3:
  822.     DS    2
  823. SSORTV4:
  824.     DS    2
  825. SNUMRECW:
  826.     DS    2
  827. ;
  828. ; DISK PARAMETER BLOCK:
  829. ;
  830. DPB:
  831. SPT:
  832.     DS    2
  833. BSH:
  834.     DS    1
  835. BLM:
  836.     DS    1
  837. EXM:
  838.     DS    1
  839. DSM:
  840.     DS    2
  841. DRM:
  842.     DS    2
  843. AL0:
  844.     DS    1
  845. AL1:
  846.     DS    1
  847. CKS:
  848.     DS    2
  849. SYSTRK:
  850.     DS    2
  851. ;
  852. STACK:
  853.     DS    2        ;SPACE FOR OLD STACK ADDRESS
  854. ;
  855.     END
  856. ;
  857.