home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / UTILS / DIRUTL / RENAME.LBR / RENAME.AQM / RENAME.ASM
Assembly Source File  |  2000-06-30  |  26KB  |  1,182 lines
  1. *  PROGRAM:  RENAME
  2. *  AUTHOR:  RICHARD CONN
  3. *  VERSION:  1.1
  4. *  DATE:  26 OCT 81
  5. *  PREVIOUS VERSIONS:  1.0 (26 OCT 81)
  6.  
  7. VERS    EQU    11    ; Version Number
  8.  
  9. *
  10. *  RENAME --
  11. *    RENAME is used to change the name of one or more files.  Unlike
  12. * the CCP-resident REN function, RENAME permits ambiguous file names and
  13. * supports an Inspect mode that allows the user to confirm each rename
  14. * before it is done.
  15. *
  16. *    RENAME supports the following forms:
  17. *        RENAME afn1=afn2    <-- Normal Rename
  18. *        RENAME afn1=afn2 /I    <-- Rename with Inspect
  19. *        RENAME afn1=afn2 /S    <-- Include System Files
  20. *        RENAME afn1=afn2 /I/S    <-- Combine I and S Options
  21. *
  22. *    Examples:
  23. *        RENAME *.MAC=*.ASM    <-- Rename all ASM files to MAC
  24. *        RENAME *.MAC=*.* /I    <-- Rename selected files to MAC
  25. *        RENAME *.OBJ=*.COM /S    <-- Rename all COM files to OBJ
  26. *                        (incl System Files)
  27. *
  28.  
  29. *
  30. *  REN CONSTANTS
  31. *
  32. DELIM        EQU    '/'    ; OPTION DELIMITER CHAR
  33. INSP$OPT    EQU    'I'    ; OPTION LETTER FOR INSPECTION
  34. SYS$OPT        EQU    'S'    ; OPTION LETTER FOR SYSTEM FILES
  35. ENTRY$SIZE    EQU    12    ; NUMBER OF BYTES/DIRECTORY ENTRY STORED
  36.  
  37. *
  38. *  CP/M CONSTANTS
  39. *
  40. BDOS    EQU    5    ; BDOS ENTRY
  41. FCB    EQU    5CH    ; FIRST FCB
  42. FCB2    EQU    5CH+16    ; 2ND FCB
  43. TBUFF    EQU    80H    ; INPUT LINE
  44. CR    EQU    0DH    ; <CR>
  45. LF    EQU    0AH    ; <LF>
  46.  
  47.     ORG    100H
  48.  
  49. *
  50. *  SAVE OLD STACK PTR AND SET NEW
  51. *
  52.     LXI    H,0    ; SAVE STACK PTR
  53.     DAD    SP
  54.     SHLD    STACK    ; SAVE SP IN BUFFER
  55.     LXI    SP,STACK    ; RESET STACK PTR
  56.  
  57. *
  58. *  PRINT PROGRAM NAME
  59. *
  60.     CALL    PRINT$MESSAGE
  61.     DB    'RENAME  Version '
  62.     DB    VERS/10+'0','.',(VERS MOD 10)+'0'
  63.     DB    0
  64.  
  65. *
  66. *  CHECK FOR USER-SPECIFIED DRIVE AND LOG IN IF SELECTED
  67. *
  68.     LDA    FCB    ; GET FROM FCB BYTE
  69.     STA    UDRIVE    ; SET FLAG
  70.     ORA    A    ; 0=DEFAULT
  71.     JZ    REN1
  72.     DCR    A    ; ADJUST FOR LOGIN
  73.     PUSH    PSW    ; SAVE A
  74.     MVI    C,25    ; GET CURRENT DISK
  75.     CALL    BDOS
  76.     INR    A    ; ADJUST TO 1-16
  77.     STA    UDRIVE    ; SET FLAG
  78.     POP    PSW    ; GET NEW DISK
  79.     MOV    E,A    ; NUMBER IN E
  80.     MVI    C,14    ; SELECT DRIVE
  81.     CALL    BDOS
  82.     JMP    REN1
  83.  
  84. *
  85. *  RETURN TO OS
  86. *
  87. RETURN:
  88.     LDA    UDRIVE    ; GET SELECTED DRIVE
  89.     ORA    A    ; 0=DEFAULT
  90.     JZ    RETURN1
  91.     DCR    A    ; ADJUST TO 0-15
  92.     MOV    E,A
  93.     MVI    C,14    ; SELECT DISK
  94.     CALL    BDOS
  95. RETURN1:
  96.     LHLD    STACK    ; GET ORIGINAL STACK PTR
  97.     SPHL        ; SET IT
  98.     RET        ; RETURN TO OS
  99.  
  100. *
  101. *  CONTINUE PROCESSING
  102. *
  103. REN1:
  104.     XRA    A    ; A=0
  105.     STA    INSP$FLAG    ; CLEAR INSPECT FLAG
  106.     STA    SYS$FLAG    ; CLEAR SYSTEM FLAG
  107.  
  108.     LXI    H,TBUFF    ; PT TO INPUT LINE
  109.     MOV    B,M    ; CHAR COUNT IN B
  110.     MOV    A,B    ; CHECK FOR EMPTY LINE
  111.     ORA    A    ; 0 CHARS = HELP
  112.     JNZ    REN2
  113.  
  114. *
  115. *  PRINT REN HELP MESSAGE
  116. *
  117. REN$HELP:
  118.     CALL    PRINT$MESSAGE
  119.     DB    CR,LF,'RENAME is invoked by a command of the form:'
  120.     DB    CR,LF,'    RENAME afn1=afn2    <-- Rename all matches'
  121.     DB    CR,LF,'             \    \__ Old File Name'
  122.     DB    CR,LF,'              \__ New File Name'
  123.     DB    CR,LF,'    RENAME afn1=afn2 /I    <-- Inspect mode'
  124.     DB    CR,LF,'    RENAME afn1=afn2 /S    <-- Include System Files'
  125.     DB    CR,LF,'Note:  /I and /S Options may be combined'
  126.     DB    CR,LF
  127.     DB    CR,LF,'  Examples:'
  128.     DB    CR,LF,'    RENAME *.MAC=*.ASM    <-- Rename *.ASM to *.MAC'
  129.     DB    CR,LF,'    RENAME *.MAC=*.* /I    <-- Rename *.* to *.MAC with'
  130.     DB    ' inspection'
  131.     DB    CR,LF,'    RENAME *.OBJ=*.COM /I/S    <-- Rename *.COM to *.OBJ '
  132.     DB    'with both I and S'
  133.     DB    0
  134.     JMP    RETURN
  135.  
  136. *
  137. *  CONTINUE PROCESSING
  138. *
  139. REN2:
  140.     INX    H    ; PT TO FIRST CHAR
  141.     MOV    A,M    ; GET IT
  142.     CPI    DELIM    ; OPTION?
  143.     JNZ    REN3
  144.     DCR    B    ; COUNT DOWN
  145.     JZ    REN$HELP
  146.     INX    H    ; PT TO NEXT
  147.     MOV    A,M    ; GET OPTION CHAR
  148.     CPI    SYS$OPT        ; INCLUDE SYSTEM FILES?
  149.     JZ    REN$SYS
  150.     CPI    INSP$OPT    ; INSPECT?
  151.     JNZ    REN$HELP    ; HELP OTHERWISE
  152.     MVI    A,0FFH    ; SET FLAG
  153.     STA    INSP$FLAG
  154.     JMP    REN3
  155. REN$SYS:
  156.     MVI    A,0FFH    ; SET FLAG
  157.     STA    SYS$FLAG
  158. REN3:
  159.     DCR    B    ; COUNT DOWN
  160.     JNZ    REN2
  161.     INX    H    ; PT TO AFTER LAST CHAR
  162.     MVI    M,0    ; STORE ENDING 0
  163.     CALL    EXTRACT$SRC    ; LOAD 2ND FILE NAME INTO FCB2
  164.  
  165. *
  166. *  CHECK FOR FILE NAME SPECIFIED
  167. *
  168.     LDA    FCB+1    ; GET FIRST LETTER OF FILE NAME
  169.     CPI    DELIM    ; DELIMITER CAUGHT?
  170.     JZ    FN$ERR
  171.     CPI    ' '    ; NO FILE SPECIFIED?
  172.     JZ    FN$ERR
  173.     LDA    FCB2+1    ; GET FIRST BYTE OF NAME
  174.     CPI    DELIM    ; OPTION CAUGHT?
  175.     JZ    FN$ERR
  176.     CPI    ' '    ; EMPTY?
  177.     JZ    FN$ERR
  178.     JMP    REN4
  179. FN$ERR:
  180.     CALL    PRINT$MESSAGE
  181.     DB    CR,LF,'ERROR -- File Name not specified'
  182.     DB    CR,LF,'    Error FCB: ',0
  183.     LXI    H,FCB    ; PRINT ERROR
  184.     CALL    PRINT$FN
  185.     MVI    A,'='
  186.     CALL    CHAR$OUT
  187.     LXI    H,FCB2
  188.     CALL    PRINT$FN
  189.     JMP    RETURN
  190.  
  191. *
  192. *  COPY 2ND FCB INTO DESTINATION BUFFER
  193. *
  194. REN4:
  195.     LXI    H,FCB2        ; PT TO FCB2
  196.     LXI    D,FCB$SRC    ; PT TO FCB$SRC
  197.     MVI    B,12        ; COPY 12 BYTES
  198.     CALL    MOVE
  199.     XCHG            ; FILL IN REST
  200.     MVI    B,24        ; EMPTY
  201.     XRA    A        ; A=0
  202.     CALL    FILL
  203.  
  204. *
  205. *  ALL SET TO GO --
  206. *    FCB CONTAINS FILE NAME/TYPE
  207. *    FCB$SRC CONTAINS SOURCE FILE NAME/TYPE
  208. *    INSP$FLAG IS SET CORRECTLY
  209. *
  210.  
  211. *  LOAD DIRECTORY INTO DIR1 BUFFER
  212. DIR:
  213.     LXI    H,ENDALL        ; PT TO END OF PROGRAM
  214.     SHLD    DIR1            ;  AND SET PTR TO DIR1
  215.     LXI    H,0            ; HL=0
  216.     SHLD    FILE$COUNT        ; TOTAL SELECTED FILES = 0
  217. DIR$USER:
  218.     MVI    C,17    ; SEARCH FOR FILE
  219.     LXI    D,FCB$SRC    ; PT TO FILE NAME
  220.     CALL    BDOS
  221.     CPI    255    ; NO MATCH?
  222.     JZ    DIR$LOOP1
  223. DIR$LOOP:
  224.     CALL    PUT$ENTRY    ; PLACE ENTRY IN DIR
  225.     MVI    C,18    ; SEARCH FOR NEXT MATCH
  226.     CALL    BDOS
  227.     CPI    255    ; DONE?
  228.     JNZ    DIR$LOOP
  229.  
  230. *  CHECK FOR ANY SELECTIONS
  231. DIR$LOOP1:
  232.     LHLD    FILE$COUNT    ; GET COUNT
  233.     MOV    A,H        ; ZERO?
  234.     ORA    L
  235.     JNZ    COMP$ORDER
  236.     CALL    PRINT$MESSAGE
  237.     DB    CR,LF,'No Files Selected -- Aborting'
  238.     DB    CR,LF,'    Selected FCB: ',0
  239.     LXI    H,FCB$SRC    ; PRINT FILE NAME
  240.     CALL    PRINT$FN
  241.     JMP    RETURN
  242.  
  243. *  COMPUTE POINTER TO ORDER TABLE
  244. COMP$ORDER:
  245.     MVI    B,ENTRY$SIZE-1    ; B=NUMBER OF BYTES/ENTRY-1
  246.     MOV    D,H        ; DE=HL=NUMBER OF ENTRIES
  247.     MOV    E,L
  248. COMP$ORDER$LOOP:
  249.     DAD    D        ; HL=HL+DE
  250.     DCR    B        ; COUNT DOWN
  251.     JNZ    COMP$ORDER$LOOP
  252.     XCHG            ; DE=NUMBER OF BYTES OCCUPIED BY ENTRIES
  253.     LHLD    DIR1        ; HL PTS TO FIRST ENTRY
  254.     DAD    D        ; HL PTS TO AFTER LAST ENTRY
  255.     INR    H        ; HL PTS TO NEXT PAGE
  256.     MVI    L,0
  257.     SHLD    ORDER        ; ORDER PTR SET
  258.  
  259. *  ALPHABETIZE DIRECTORY ENTRIES
  260.     CALL    ALPHABETIZE
  261.  
  262. *  SET RENECTION ATTRIBUTES
  263.     CALL    RENAME
  264.  
  265. *  RETURN TO CP/M
  266.     JMP    RETURN
  267.  
  268. *
  269. *  EXTRACT SOURCE FILE NAME AND PLACE IN FCB2
  270. *
  271. EXTRACT$SRC:
  272.     LXI    H,FCB2    ; CLEAR FCB2
  273.     MVI    M,0    ; STORE BEGINNING ZERO
  274.     INX    H    ; PT TO FIRST BYTE OF FILE NAME
  275.     MVI    A,' '    ; <SP> FILL
  276.     MVI    B,11    ; 11 BYTES
  277.     CALL    FILL
  278.  
  279. *  LOOK FOR = DELIMITER
  280.     LXI    H,TBUFF    ; LOOK FOR =
  281. ES1:
  282.     MOV    A,M    ; GET CHAR
  283.     INX    H    ; PT TO NEXT
  284.     ORA    A    ; ERROR IF END OF LINE
  285.     JZ    FORMAT$ERR
  286.     CPI    '='    ; EQUAL?
  287.     JNZ    ES1
  288.  
  289. *  PLACE FILE NAME INTO FCB2
  290.     LXI    D,FCB2+1    ; PT TO FIRST CHAR OF FCB2 FILE NAME
  291.     MVI    B,8    ; UP TO 8 CHARS
  292.     CALL    PUT$CHARS    ; COPY HL TO DE
  293.     CPI    '.'    ; MUST BE SEPARATED BY DECIMAL DELIMITER
  294.     RNZ
  295.     LXI    D,FCB2+9    ; PT TO FIRST CHAR OF FCB2 FILE TYPE
  296.     MVI    B,3    ; UP TO 3 CHARS
  297.     CALL    PUT$CHARS    ; COPY HL TO DE
  298.     RET
  299.  
  300. *  FORMAT ERROR MESSAGE
  301. FORMAT$ERR:
  302.     CALL    PRINT$MESSAGE
  303.     DB    CR,LF,'Format Error -- Missing =',0
  304.     JMP    RETURN
  305.  
  306. *
  307. *  COPY HL TO DE FOR UP TO B BYTES
  308. *    RECOGNIZE DELIMITERS OF '.', ' ', AND 0
  309. *    EXPAND *
  310. *
  311. PUT$CHARS:
  312.     MOV    A,M    ; GET CHAR
  313.     INX    H    ; PT TO NEXT
  314.     CPI    '.'    ; DELIMITER?
  315.     RZ
  316.     CPI    ' '    ; DELIMITER?
  317.     RZ
  318.     ORA    A    ; DELIMITER?
  319.     RZ
  320.     CPI    '*'    ; EXPAND?
  321.     JZ    PUT$CHARSX
  322.     STAX    D    ; STORE CHAR
  323.     INX    D    ; PT TO NEXT
  324.     DCR    B    ; COUNT DOWN
  325.     JNZ    PUT$CHARS
  326.     MOV    A,M    ; GET NEXT CHAR
  327.     INX    H    ; PT TO CHAR AFTER
  328.     RET
  329. PUT$CHARSX:
  330.     MVI    A,'?'    ; '?' FILL
  331.     STAX    D    ; PUT CHAR
  332.     INX    D    ; PT TO NEXT
  333.     DCR    B    ; COUNT DOWN
  334.     JNZ    PUT$CHARSX
  335.     MOV    A,M    ; GET CHAR AFTER '*'
  336.     INX    H    ; PT TO CHAR AFTER THAT
  337.     RET
  338.  
  339. *
  340. *  PLACE ENTRY IN DIR1 IF:
  341. *    1 -- NOT AN ERASED ENTRY
  342. *    2 -- SELECTED USER NUMBER
  343. *    3 -- MATCHES SPECIFICATION FCB
  344. *    4 -- ATTRIBUTES CORRESPOND
  345. *
  346. *  ON INPUT,  A=0-3 FOR ADR INDEX IN BUFF OF ENTRY FCB
  347. *          FILE$COUNT=NUMBER OF SELECTED FILES
  348. *  ON OUTPUT, FILE$COUNT=NUMBER OF SELECTED FILES
  349. *
  350. PUT$ENTRY:
  351.     PUSH PSW ! PUSH B ! PUSH D ! PUSH H
  352.     RRC        ; MULTIPLY BY 32 FOR OFFSET COMPUTATION
  353.     RRC
  354.     RRC
  355.     ANI    60H    ; A=BYTE OFFSET
  356.     LXI    D,TBUFF    ; PT TO BUFFER ENTRY
  357.     MOV    L,A    ; LET HL=OFFSET
  358.     MVI    H,0
  359.     DAD    D    ; HL=PTR TO FCB
  360.     MOV    A,M    ; GET USER NUMBER
  361.     CPI    0E5H    ; DELETED?
  362.     JZ    PE4    ; SKIP IT IF DELETED
  363.     XCHG        ; DE=PTR TO FCB
  364.     PUSH    D    ; SAVE IT
  365.     LHLD    FILE$COUNT    ; GET NUMBER OF ENTRIES SO FAR
  366.     SHLD    ECOUNTER
  367.     MOV    A,H    ; NONE?
  368.     ORA    L    ; ZERO FLAG SET IF SO
  369.     LHLD    DIR1    ; PT TO DIR1
  370.     JZ    PE2    ; IF NO ENTRIES, THIS IS THE FIRST
  371.     LXI    D,ENTRY$SIZE    ; HL PTS TO DIR1 BASE, DE=NUMBER OF BYTES/ENTRY
  372. PE1:
  373.     DAD    D    ; PT TO NEXT
  374.     CALL    ECOUNT    ; ECOUNTER=ECOUNTER-1
  375.     JNZ    PE1
  376. PE2:
  377.     POP    D    ; DE PTS TO FCB TO PLACE IN DIR1
  378.     XCHG
  379. *
  380. *    ON INPUT, DE=ADR TO PLACE ENTRY IN DIR1
  381. *          HL=ADR OF FCB IN BUFF
  382. *
  383.  
  384. *  COMPARE ENTRY AGAINST FILE SELECTION FCB
  385. PE2$COMP:
  386.     PUSH    H    ; SAVE HL, DE PTRS
  387.     PUSH    D
  388.     MVI    B,11    ; 11 BYTES IN FILE NAME AND FILE TYPE
  389.     LXI    D,FCB$SRC+1    ; PT TO FILE NAME IN FCB
  390.     INX    H    ; PT TO FILE NAME OF ENTRY
  391.  
  392. *  COMPARISON LOOP
  393. PE2$COMP1:
  394.     LDAX    D    ; GET FCB BYTE
  395.     ANI    7FH    ; MASK MSB
  396.     CPI    '?'    ; WILD?
  397.     JZ    PE2$COMP2
  398.     MOV    C,A    ; SAVE BYTE
  399.     MOV    A,M    ; GET ENTRY BYTE
  400.     ANI    7FH    ; MASK MSB
  401.     CMP    C    ; COMPARE
  402.     JZ    PE2$COMP2    ; MATCH
  403.     POP    D    ; RESTORE DE, HL
  404.     POP    H
  405.     JMP    PE4    ; ABORT
  406. PE2$COMP2:
  407.     INX    H    ; PARTIAL MATCH -- PT TO NEXT
  408.     INX    D
  409.     DCR    B    ; COUNT DOWN
  410.     JNZ    PE2$COMP1
  411.     POP    D    ; RESTORE DE, HL
  412.     POP    H
  413.  
  414. *  ENTRY COMPLETELY ACCEPTED -- HL PTS TO ENTRY, DE PTS TO DIRECTORY
  415. PE2$COPY:
  416.     PUSH    H    ; SAVE PTR
  417.     LXI    B,12    ; CHECK FOR ZERO EXTENT
  418.     DAD    B    ; HL PTS TO EXTENT
  419.     MOV    A,M    ; GET EXTENT
  420.     POP    H    ; RESTORE HL
  421.     ORA    A    ; ZERO?
  422.     JNZ    PE4    ; ABORT IF NOT
  423.  
  424. *  CHECK FOR SYSTEM FILE INCLUSION AND DO OR DON'T DEPENDING
  425.     LDA    SYS$FLAG    ; GET FLAG
  426.     ORA    A        ; 0=NO
  427.     JNZ    PE3        ; INCLUDE ALL IF YES
  428.     PUSH    H    ; SAVE PTR
  429.     LXI    B,10    ; CHECK FOR SYSTEM ATTRIBUTE
  430.     DAD    B    ; HL PTS TO SYSTEM ATTRIBUTE
  431.     MOV    A,M    ; GET ATTRIBUTE BYTE
  432.     POP    H    ; RESTORE PTR
  433.     ANI    80H    ; SELECT BIT
  434.     JNZ    PE4    ; ABORT IF SYSTEM ATTRIBUTE SET
  435.  
  436. *  FILE ACCEPTED -- COPY IT
  437. PE3:
  438.     MVI    B,ENTRY$SIZE    ; B=NUMBER OF BYTES/ENTRY
  439.     CALL    MOVE    ; COPY INTO DIRECTORY
  440.  
  441. *  INCREMENT FILE COUNT
  442.     LHLD    FILE$COUNT    ; INCREMENT FILE COUNT
  443.     INX    H
  444.     SHLD    FILE$COUNT
  445.  
  446. *  DONE WITH PUT$ENTRY
  447. PE4:
  448.     POP H ! POP D ! POP B ! POP PSW
  449.     RET
  450.  
  451. *
  452. *  COUNT DOWN WITH 16-BIT COUNTER ECOUNTER; SET ZERO FLAG IF IT HITS ZERO
  453. *
  454. ECOUNT:
  455.     PUSH    H    ; SAVE HL
  456.     LHLD    ECOUNTER    ; GET COUNT
  457.     DCX    H    ; COUNT DOWN
  458.     SHLD    ECOUNTER    ; NEW COUNT
  459.     MOV    A,H    ; ZERO?
  460.     ORA    L    ; ZERO FLAG SET IF SO
  461.     POP    H    ; RESTORE HL
  462.     RET
  463.  
  464. *
  465. *  ALPHABETIZE -- ALPHABETIZES DIR1; FILE$COUNT CONTAINS
  466. *    THE NUMBER OF FILES IN DIR1
  467. *
  468. ALPHABETIZE:
  469.     LHLD    FILE$COUNT    ; GET FILE COUNT
  470.     MOV    A,H    ; ANY ENTRIES?
  471.     ORA    L
  472.     RZ
  473. *
  474. *  SHELL SORT --
  475. *    THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS"
  476. *    BY KERNIGAN AND PLAUGHER, PAGE 106.  COPYRIGHT, 1976, ADDISON-WESLEY.
  477. *  ON ENTRY, HL=NUMBER OF ENTRIES
  478. *
  479. SORT:
  480.     MOV    B,H    ; COUNT IN BC
  481.     MOV    C,L
  482.     LHLD    DIR1    ; SET UP POINTERS TO DIRECTORY ENTRIES
  483.     XCHG        ; ... IN DE
  484.     LHLD    ORDER    ; PT TO ORDER TABLE
  485. *
  486. *  SET UP ORDER TABLE; HL PTS TO NEXT ENTRY IN ORDER TABLE, DE PTS TO NEXT
  487. *    ENTRY IN DIRECTORY, BC = NUMBER OF ELEMENTS REMAINING
  488. *
  489. SORT1:
  490.     MOV    M,E    ; STORE LOW-ORDER ADDRESS
  491.     INX    H    ; PT TO NEXT ORDER BYTE
  492.     MOV    M,D    ; STORE HIGH-ORDER ADDRESS
  493.     INX    H    ; PT TO NEXT ORDER ENTRY
  494.     PUSH    H    ; SAVE PTR
  495.     LXI    H,ENTRY$SIZE    ; HL=NUMBER OF BYTES/ENTRY
  496.     DAD    D    ; PT TO NEXT DIR1 ENTRY
  497.     XCHG        ; DE PTS TO NEXT ENTRY
  498.     POP    H    ; GET PTR TO ORDER TABLE
  499.     DCX    B    ; COUNT DOWN
  500.     MOV    A,B    ; DONE?
  501.     ORA    C
  502.     JNZ    SORT1
  503. *
  504. *  THIS IS THE MAIN SORT LOOP FOR THE SHELL SORT IN "SOFTWARE TOOLS" BY K&P
  505. *
  506.  
  507. *
  508. *  SHELL SORT FROM "SOFTWARE TOOLS" BY KERNINGHAN AND PLAUGER
  509. *
  510.     LHLD    FILE$COUNT    ; NUMBER OF ITEMS TO SORT
  511.     SHLD    GAP    ; SET INITIAL GAP TO N FOR FIRST DIVISION BY 2
  512.  
  513. *  FOR (GAP = N/2; GAP > 0; GAP = GAP/2)
  514. SRT$LOOP0:
  515.     ORA    A    ; CLEAR CARRY
  516.     LHLD    GAP    ; GET PREVIOUS GAP
  517.     MOV    A,H    ; ROTATE RIGHT TO DIVIDE BY 2
  518.     RAR
  519.     MOV    H,A
  520.     MOV    A,L
  521.     RAR
  522.     MOV    L,A
  523.  
  524. *  TEST FOR ZERO
  525.     ORA    H
  526.     JZ    SORT$DONE    ; DONE WITH SORT IF GAP = 0
  527.  
  528.     SHLD    GAP    ; SET VALUE OF GAP
  529.     SHLD    I    ; SET I=GAP FOR FOLLOWING LOOP
  530.  
  531. *  FOR (I = GAP + 1; I <= N; I = I + 1)
  532. SRT$LOOP1:
  533.     LHLD    I    ; ADD 1 TO I
  534.     INX    H
  535.     SHLD    I
  536.  
  537. *  TEST FOR I <= N
  538.     XCHG        ; I IS IN DE
  539.     LHLD    FILE$COUNT    ; GET N
  540.     MOV    A,L    ; COMPARE BY SUBTRACTION
  541.     SUB    E
  542.     MOV    A,H
  543.     SBB    D    ; CARRY SET MEANS I > N
  544.     JC    SRT$LOOP0    ; DON'T DO FOR LOOP IF I > N
  545.  
  546.     LHLD    I    ; SET J = I INITIALLY FOR FIRST SUBTRACTION OF GAP
  547.     SHLD    J
  548.  
  549. *  FOR (J = I - GAP; J > 0; J = J - GAP)
  550. SRT$LOOP2:
  551.     LHLD    GAP    ; GET GAP
  552.     XCHG        ; ... IN DE
  553.     LHLD    J    ; GET J
  554.     MOV    A,L    ; COMPUTE J - GAP
  555.     SUB    E
  556.     MOV    L,A
  557.     MOV    A,H
  558.     SBB    D
  559.     MOV    H,A
  560.     SHLD    J    ; J = J - GAP
  561.     JC    SRT$LOOP1    ; IF CARRY FROM SUBTRACTIONS, J < 0 AND ABORT
  562.     MOV    A,H    ; J=0?
  563.     ORA    L
  564.     JZ    SRT$LOOP1    ; IF ZERO, J=0 AND ABORT
  565.  
  566. *  SET JG = J + GAP
  567.     XCHG        ; J IN DE
  568.     LHLD    GAP    ; GET GAP
  569.     DAD    D    ; J + GAP
  570.     SHLD    JG    ; JG = J + GAP
  571.  
  572. *  IF (V(J) <= V(JG))
  573.     CALL    ICOMPARE    ; J IN DE, JG IN HL
  574.  
  575. *  ... THEN BREAK
  576.     JC    SRT$LOOP1
  577.  
  578. *  ... ELSE EXCHANGE
  579.     LHLD    J    ; SWAP J, JG
  580.     XCHG
  581.     LHLD    JG
  582.     CALL    ISWAP    ; J IN DE, JG IN HL
  583.  
  584. *  END OF INNER-MOST FOR LOOP
  585.     JMP    SRT$LOOP2
  586.  
  587. *
  588. *  SORT IS DONE -- RESTRUCTURE DIR1 IN SORTED ORDER IN PLACE
  589. *
  590. SORT$DONE:
  591.     LHLD    FILE$COUNT    ; NUMBER OF ENTRIES
  592.     MOV    B,H        ; ... IN BC
  593.     MOV    C,L
  594.     LHLD    ORDER    ; PTR TO ORDERED POINTER TABLE
  595.     SHLD    PTPTR    ; SET PTR PTR
  596.     LHLD    DIR1    ; PTR TO UNORDERED DIRECTORY
  597.     SHLD    PTDIR1    ; SET PTR DIR1
  598.  
  599. *  FIND PTR TO NEXT DIR1 ENTRY
  600. SRTDN:
  601.     LHLD    PTPTR    ; PT TO REMAINING POINTERS
  602.     XCHG        ; ... IN DE
  603.     LHLD    PTDIR1    ; HL PTS TO NEXT DIR1 ENTRY
  604.     PUSH    B    ; SAVE COUNT OF REMAINING ENTRIES
  605.  
  606. *  FIND PTR TABLE ENTRY
  607. SRTDN1:
  608.     LDAX    D    ; GET CURRENT POINTER TABLE ENTRY VALUE
  609.     INX    D    ; PT TO HIGH-ORDER POINTER BYTE
  610.     CMP    L    ; COMPARE AGAINST DIR1 ADDRESS LOW
  611.     JNZ    SRTDN2    ; NOT FOUND YET
  612.     LDAX    D    ; LOW-ORDER BYTES MATCH -- GET HIGH-ORDER POINTER BYTE
  613.     CMP    H    ; COMPARE AGAINST DIR1 ADDRESS HIGH
  614.     JZ    SRTDN3    ; MATCH FOUND
  615. SRTDN2:
  616.     INX    D    ; PT TO NEXT PTR TABLE ENTRY
  617.     DCX    B    ; COUNT DOWN
  618.     MOV    A,C    ; END OF TABLE?
  619.     ORA    B
  620.     JNZ    SRTDN1    ; CONTINUE IF NOT
  621.  
  622. *  FATAL ERROR -- INTERNAL XDIR ERROR; POINTER TABLE NOT CONSISTENT
  623. FERR$PTR:
  624.     CALL    PRINT$MESSAGE
  625.     DB    CR,LF,'RENAME ERROR -- Pointer Table Not Consistent',0
  626.     JMP    RETURN
  627.  
  628. *  FOUND THE POINTER TABLE ENTRY WHICH POINTS TO THE NEXT UNORDERED DIR1 ENTRY
  629. *    MAKE BOTH POINTERS (PTR TO NEXT, PTR TO CURRENT UNORDERED DIR1 ENTRY)
  630. *    POINT TO SAME LOCATION (PTR TO NEXT DIR1 ENTRY TO BE ORDERED)
  631. SRTDN3:
  632.     LHLD    PTPTR    ; GET PTR TO NEXT ORDERED ENTRY
  633.     DCX    D    ; DE PTS TO LOW-ORDER POINTER ADDRESS
  634.     MOV    A,M    ; MAKE PTR TO NEXT UNORDERED DIR1 PT TO BUFFER FOR
  635.     STAX    D    ;   DIR1 ENTRY TO BE MOVED TO NEXT UNORDERED DIR1 POS
  636.     INX    H    ; PT TO NEXT PTR ADDRESS
  637.     INX    D
  638.     MOV    A,M    ; MAKE HIGH POINT SIMILARLY
  639.     STAX    D
  640.  
  641. *  COPY NEXT UNORDERED DIR1 ENTRY TO HOLD BUFFER
  642.     MVI    B,ENTRY$SIZE    ; B=NUMBER OF BYTES/ENTRY
  643.     LHLD    PTDIR1    ; PT TO ENTRY
  644.     LXI    D,HOLD    ; PT TO HOLD BUFFER
  645.     PUSH    B    ; SAVE B=NUMBER OF BYTES/ENTRY
  646.     CALL    MOVE
  647.     POP    B
  648.  
  649. *  COPY TO-BE-ORDERED DIR1 ENTRY TO NEXT ORDERED DIR1 POSITION
  650.     LHLD    PTPTR    ; POINT TO ITS POINTER
  651.     MOV    E,M    ; GET LOW-ADDRESS POINTER
  652.     INX    H
  653.     MOV    D,M    ; GET HIGH-ADDRESS POINTER
  654.     LHLD    PTDIR1    ; DESTINATION ADDRESS FOR NEXT ORDERED DIR1 ENTRY
  655.     XCHG        ; HL PTS TO ENTRY TO BE MOVED, DE PTS TO DEST
  656.     PUSH    B    ; SAVE B=NUMBER OF BYTES/ENTRY
  657.     CALL    MOVE
  658.     POP    B
  659.     XCHG        ; HL PTS TO NEXT UNORDERED DIR1 ENTRY
  660.     SHLD    PTDIR1    ; SET POINTER FOR NEXT LOOP
  661.  
  662. *  COPY ENTRY IN HOLD BUFFER TO LOC PREVIOUSLY HELD BY LATEST ORDERED ENTRY
  663.     LHLD    PTPTR    ; GET PTR TO PTR TO THE DESTINATION
  664.     MOV    E,M    ; GET LOW-ADDRESS POINTER
  665.     INX    H
  666.     MOV    D,M    ; HIGH-ADDRESS POINTER
  667.     LXI    H,HOLD    ; HL PTS TO HOLD BUFFER, DE PTS TO ENTRY DEST
  668.     CALL    MOVE    ; B=NUMBER OF BYTES/ENTRY
  669.  
  670. *  POINT TO NEXT ENTRY IN POINTER TABLE
  671.     LHLD    PTPTR    ; POINTER TO CURRENT ENTRY
  672.     INX    H    ; SKIP OVER IT
  673.     INX    H
  674.     SHLD    PTPTR
  675.  
  676. *  COUNT DOWN
  677.     POP    B    ; GET COUNTER
  678.     DCX    B    ; COUNT DOWN
  679.     MOV    A,C    ; DONE?
  680.     ORA    B
  681.     JNZ    SRTDN
  682.     RET        ; DONE
  683.  
  684. *
  685. *  SWAP (Exchange) the pointers in the ORDER table whose indexes are in
  686. *    HL and DE
  687. *
  688. ISWAP:
  689.     PUSH    H        ; SAVE HL
  690.     LHLD    ORDER        ; ADDRESS OF ORDER TABLE - 2
  691.     MOV    B,H        ; ... IN BC
  692.     MOV    C,L
  693.     POP    H
  694.     DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
  695.     DAD    H        ; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
  696.                 ;   OF ORIGINAL HL (1, 2, ...)
  697.     DAD    B        ; HL NOW PTS TO POINTER INVOLVED
  698.     XCHG            ; DE NOW PTS TO POINTER INDEXED BY HL
  699.     DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
  700.     DAD    H        ; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
  701.                 ;   OF ORIGINAL DE (1, 2, ...)
  702.     DAD    B        ; HL NOW PTS TO POINTER INVOLVED
  703.     MOV    C,M        ; EXCHANGE POINTERS -- GET OLD (DE)
  704.     LDAX    D        ; -- GET OLD (HL)
  705.     XCHG            ; SWITCH
  706.     MOV    M,C        ; PUT NEW (HL)
  707.     STAX    D        ; PUT NEW (DE)
  708.     INX    H        ; PT TO NEXT BYTE OF POINTER
  709.     INX    D
  710.     MOV    C,M        ; GET OLD (HL)
  711.     LDAX    D        ; GET OLD (DE)
  712.     XCHG            ; SWITCH
  713.     MOV    M,C        ; PUT NEW (DE)
  714.     STAX    D        ; PUT NEW (HL)
  715.     RET
  716. *
  717. *  ICOMPARE compares the entry pointed to by the pointer pointed to by HL
  718. *    with that pointed to by DE (1st level indirect addressing); on entry,
  719. *    HL and DE contain the numbers of the elements to compare (1, 2, ...);
  720. *    on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)),
  721. *    and Non-Zero and No-Carry means ((DE)) > ((HL))
  722. *
  723. ICOMPARE:
  724.     PUSH    H        ; SAVE HL
  725.     LHLD    ORDER        ; ADDRESS OF ORDER - 2
  726.     MOV    B,H        ; ... IN BC
  727.     MOV    C,L
  728.     POP    H
  729.     DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
  730.     DAD    H        ; DOUBLE THE ELEMENT NUMBER TO POINT TO THE PTR
  731.     DAD    B        ; ADD TO THIS THE BASE ADDRESS OF THE PTR TABLE
  732.     XCHG            ; RESULT IN DE
  733.     DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
  734.     DAD    H        ; DO THE SAME WITH THE ORIGINAL DE
  735.     DAD    B
  736.     XCHG
  737.  
  738. *
  739. *  HL NOW POINTS TO THE POINTER WHOSE INDEX WAS IN HL TO BEGIN WITH
  740. *  DE NOW POINTS TO THE POINTER WHOSE INDEX WAS IN DE TO BEGIN WITH
  741. *    FOR EXAMPLE, IF DE=5 AND HL=4, DE NOW POINTS TO THE 5TH PTR AND HL
  742. * TO THE 4TH POINTER
  743. *
  744.     MOV    C,M        ; BC IS MADE TO POINT TO THE OBJECT INDEXED TO
  745.     INX    H        ; ... BY THE ORIGINAL HL
  746.     MOV    B,M
  747.     XCHG
  748.     MOV    E,M        ; DE IS MADE TO POINT TO THE OBJECT INDEXED TO
  749.     INX    H        ; ... BY THE ORIGINAL DE
  750.     MOV    D,M
  751.     MOV    H,B        ; SET HL = OBJECT PTED TO INDIRECTLY BY BC
  752.     MOV    L,C
  753.  
  754. *
  755. *  COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE;
  756. *    NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE<HL
  757. *    RET W/ZERO SET MEANS DE=HL
  758. *
  759. CMP$ENTRY:
  760.  
  761. *  COMPARE BY FILE NAME, FILE TYPE, EXTENSION, AND USER NUM (IN THAT ORDER)
  762. CMP$FN$FT:
  763.     PUSH D ! PUSH H
  764.     INX    H    ; PT TO FN
  765.     INX    D
  766.     MVI    B,11    ; COMPARE FN, FT
  767.     CALL    COMP
  768.     POP H ! POP D
  769.     RET
  770. *
  771. *  COMP COMPARES DE W/HL FOR B BYTES; RET W/CARRY IF DE<HL
  772. *    MSB IS DISREGARDED
  773. *
  774. COMP:
  775.     MOV    A,M    ; GET (HL)
  776.     ANI    7FH    ; MASK MSB
  777.     MOV    C,A    ; ... IN C
  778.     LDAX    D    ; COMPARE
  779.     ANI    7FH    ; MASK MSB
  780.     CMP    C
  781.     RNZ
  782.     INX    H    ; PT TO NEXT
  783.     INX    D
  784.     DCR    B    ; COUNT DOWN
  785.     JNZ    COMP
  786.     RET
  787.  
  788. *
  789. *  PERFORM RENAME FUNCTION
  790. *
  791. RENAME:
  792.     LHLD    FILE$COUNT    ; HL=NUMBER OF FILES
  793.     XCHG
  794.     LHLD    DIR1        ; HL PTS TO DIR1, DE=NUMBER OF FILES
  795.  
  796. *  PRINT FILE NAMES AND PERFORM RENAME FUNCTION
  797. RENAME$LOOP:
  798.     PUSH    H        ; SAVE PTR
  799.     PUSH    D        ; SAVE COUNTER
  800.  
  801. *  BUILD NEW FILE NAME
  802.     INX    H        ; PT TO FIRST CHAR OF FILE NAME
  803.     LXI    B,FCB+1        ; PT TO NEW FILE NAME FORMAT
  804.     LXI    D,FCB$NEW+1    ; PT TO NEW FILE NAME TO BUILD
  805.     MVI    A,11        ; COPY 11 CHARS WITH TRANSLATION
  806. RENAME$LOOP1:
  807.     PUSH    PSW        ; SAVE COUNT
  808.     LDAX    B        ; GET CHAR OF NEW FILE NAME
  809.     CPI    '?'        ; CARRY OVER IF WILD
  810.     JNZ    RENAME$LOOP2
  811.     MOV    A,M        ; GET CHAR FROM CURRENT FILE NAME
  812. RENAME$LOOP2:
  813.     STAX    D        ; STORE INTO NEW FILE NAME
  814.     INX    H        ; PT TO NEXT
  815.     INX    D
  816.     INX    B
  817.     POP    PSW        ; GET COUNT
  818.     DCR    A        ; COUNT DOWN
  819.     JNZ    RENAME$LOOP1
  820.  
  821. *  PRINT RENAME FILES
  822.     POP    D        ; RESTORE COUNTER
  823.     CALL    PRINT$MESSAGE
  824.     DB    CR,LF,'Rename ',0
  825.     LXI    H,FCB$NEW        ; PT TO NEW FILE NAME
  826.     CALL    PRINT$FN    ; PRINT FILE NAME
  827.     CALL    PRINT$MESSAGE    ; SEPARATOR
  828.     DB    ' from ',0
  829.     POP    H        ; GET PTR
  830.     CALL    PRINT$FN    ; PRINT FILE NAME
  831.  
  832. *  PERFORM INSPECTION AND/OR RENAME FUNCTION
  833.     CALL    INSPECT        ; INSPECT IF FLAG SET ELSE SET ATTRIBUTES
  834.  
  835. *  POINT TO NEXT ENTRY
  836.     LXI    B,ENTRY$SIZE    ; PT TO NEXT ENTRY
  837.     DAD    B        ; HL PTS TO NEXT ENTRY
  838.     DCX    D        ; COUNT DOWN
  839.     MOV    A,D        ; DONE?
  840.     ORA    E
  841.     JNZ    RENAME$LOOP
  842.     RET
  843.  
  844. *
  845. *  PRINT FILE NAME PTED TO BY HL+1
  846. *
  847. PRINT$FN:
  848.     PUSH    H        ; SAVE PTR
  849.     INX    H        ; PT TO FIRST CHAR
  850.     MVI    B,8        ; 8 CHARS
  851.     CALL    PRFN        ; PRINT NAME PART
  852.     MVI    A,'.'        ; PRINT DOT
  853.     CALL    CHAR$OUT
  854.     MVI    B,3        ; 3 CHARS
  855.     CALL    PRFN        ; PRINT TYPE PART
  856.     POP    H        ; RESTORE PTR
  857.     RET
  858. PRFN:
  859.     MOV    A,M        ; GET CHAR
  860.     ANI    7FH        ; MASK OUT MSB
  861.     CALL    CHAR$OUT
  862.     INX    H        ; PT TO NEXT
  863.     DCR    B        ; COUNT DOWN
  864.     JNZ    PRFN
  865.     RET
  866.  
  867. *
  868. *  PERFORM INSPECTION IF OPTION SET -- ELSE, SET KEYS
  869. *
  870. INSPECT:
  871.     LDA    INSP$FLAG    ; GET FLAG
  872.     ORA    A        ; 0=NO
  873.     JZ    RENAMEX        ; RENAME IF NOT
  874.     CALL    PRINT$MESSAGE
  875.     DB    ' -- Ok (Y/N)? ',0
  876. INSP1:
  877.     CALL    CHAR$IN
  878.     CALL    CAPS        ; CAPITALIZE
  879.     CPI    'Y'        ; OK?
  880.     JZ    RENAMEX        ; RENAME IF SO
  881.     CPI    'N'        ; NOT OK?
  882.     RZ
  883.     CALL    PRINT$MESSAGE
  884.     DB    CR,LF,'Type Y or N -- Ok (Y/N)? ',0
  885.     JMP    INSP1
  886.  
  887. *
  888. *  RENAME FILE PTED TO BY HL
  889. *
  890. RENAMEX:
  891.     PUSH    H        ; SAVE PTR
  892.     PUSH    D        ; SAVE COUNTER
  893.     INX    H        ; PT TO 1ST BYTE OF SOURCE FILE NAME
  894.     LXI    D,FCB$OLD    ; CLEAR DRIVE
  895.     XRA    A        ; A=0
  896.     STAX    D
  897.     INX    D        ; PT TO 1ST BYTE OF DEST FILE NAME
  898.     MVI    B,11        ; 11 BYTES
  899.     CALL    MOVE
  900.     XCHG            ; HL PTS TO FCB$NEW
  901.     MVI    B,5        ; CLEAR REST OF FCB$OLD AND 1ST OF FCB$NEW
  902.     XRA    A        ; A=0
  903.     CALL    FILL
  904.     LXI    H,FCB$NEW+12    ; CLEAR REST OF FCB$NEW
  905.     MVI    B,4
  906.     CALL    FILL
  907.     LXI    D,FCB$NEW    ; CHECK FOR PRESENCE OF NEW FILE NAME
  908.     CALL    FCHECK        ; CHECK FOR FILE
  909.     JNZ    FNEW$ERR    ; FILE FOUND
  910.     CALL    CLEAR$ATT    ; CLEAR ATTRIBUTES (R/O, SYS, TAGS)
  911.     LXI    D,FCB$OLD    ; PT TO FCB
  912.     MVI    C,23        ; RENAME FILE
  913.     CALL    BDOS
  914.     CALL    RESET$ATT    ; RESET ATTRIBUTES (R/O, SYS, TAGS)
  915.     POP    D        ; RESTORE COUNTER
  916.     POP    H        ; RESTORE PTR
  917.     RET
  918. FNEW$ERR:
  919.     CALL    PRINT$MESSAGE
  920.     DB    CR,LF,'ERROR -- Rename Destination File Exists -- Skipping'
  921.     DB    CR,LF,'    File in Error is: ',0
  922.     LXI    H,FCB$NEW    ; PRINT NEW FILE NAME
  923.     CALL    PRINT$FN    ; PRINT FILE NAME
  924.     POP    D        ; RESTORE COUNTER
  925.     POP    H        ; RESTORE PTR
  926.     RET
  927.  
  928. *
  929. *  IF CP/M 2.X, SAVE CURRENT ATTRIBUTES AND CLEAR THEM ON OBJECT FILE PTED
  930. *    TO BY HL
  931. *
  932. CLEAR$ATT:
  933.     MVI    C,12    ; GET VERS NUMBER
  934.     CALL    BDOS
  935.     MOV    A,H    ; CP/M 1.4?
  936.     ORA    L
  937.     RZ        ; DO NOTHING IF CP/M 1.4
  938.  
  939. *  SAVE OLD ATTRIBUTES IN ATTR BUFFER
  940.     LXI    H,FCB$OLD+1    ; PT TO OLD NAME
  941.     LXI    D,ATTR    ; SAVE ATTRIBUTES
  942.     MVI    B,11    ; 11 BYTES
  943. CLA1:
  944.     MOV    A,M    ; GET BYTE
  945.     ANI    80H    ; MASK FOR ATTRIBUTE
  946.     STAX    D    ; PUT BYTE
  947.     MOV    A,M    ; PLACE CLEARED FILE NAME INTO FCB$OLD
  948.     ANI    7FH    ; MASK
  949.     MOV    M,A
  950.     INX    H    ; PT TO NEXT
  951.     INX    D
  952.     DCR    B    ; COUNT DOWN
  953.     JNZ    CLA1
  954.  
  955. *  SAVE NEW FILE NAME WITH PROPER ATTRIBUTES INTO ATTR
  956.     LXI    H,FCB$NEW+1    ; PT TO NEW FILE NAME
  957.     LXI    D,ATTR    ; PT TO ATTRIBUTES
  958.     MVI    B,11    ; 11 BYTES
  959. CLA2:
  960.     MOV    A,M    ; CLEAR ATTRIBUTE BIT
  961.     ANI    7FH    ; MASK
  962.     MOV    M,A
  963.     LDAX    D    ; GET ATTRIBUTE BIT
  964.     ORA    M    ; MASK IN BIT
  965.     STAX    D    ; PUT NAME BACK
  966.     INX    H    ; PT TO NEXT
  967.     INX    D
  968.     DCR    B    ; COUNT DOWN
  969.     JNZ    CLA2
  970.  
  971. *  CREATE FCB FOR CLEARING ATTRIBUTES
  972.     LXI    H,FCB$OLD    ; PT TO OLD FILE NAME
  973.     LXI    D,FCB$TEMP    ; COPY INTO TEMP
  974.     XRA    A    ; A=0
  975.     STAX    D    ; SET FIRST BYTE
  976.     INX    H    ; PT TO FIRST BYTE OF FILE NAME
  977.     INX    D
  978.     MVI    B,11    ; COPY TO NAME
  979. CLA3:
  980.     MOV    A,M    ; GET BYTE
  981.     ANI    7FH    ; MASK
  982.     STAX    D    ; PUT BYTE
  983.     INX    H    ; PT TO NEXT
  984.     INX    D
  985.     DCR    B    ; COUNT DOWN
  986.     JNZ    CLA3
  987.     XCHG        ; HL PTS TO NEXT BYTE
  988.     MVI    B,24    ; CLEAR REST OF FCB
  989.     XRA    A    ; A=0
  990.     CALL    FILL
  991.     LXI    D,FCB$TEMP    ; CLEAR ALL ATTRIBUTES
  992.     MVI    C,30    ; SET ATTRIBUTES
  993.     CALL    BDOS
  994.     RET
  995.  
  996. *
  997. *  IF CP/M 2.X, RESTORE CURRENT ATTRIBUTES
  998. *
  999. RESET$ATT:
  1000.     MVI    C,12    ; GET VERS NUMBER
  1001.     CALL    BDOS
  1002.     MOV    A,H    ; CP/M 1.4?
  1003.     ORA    L
  1004.     RZ        ; DO NOTHING IF CP/M 1.4
  1005.  
  1006. *  COPY FILE NAME/TYPE IN ATTR INTO FCB$TEMP FOR RESET OF ATTRIBUTES
  1007.     LXI    D,FCB$TEMP    ; COPY INTO TEMP
  1008.     XRA    A    ; A=0
  1009.     STAX    D    ; SET FIRST BYTE
  1010.     LXI    H,ATTR    ; PT TO FIRST BYTE OF FILE NAME
  1011.     INX    D
  1012.     MVI    B,11    ; COPY TO NAME
  1013. RES1:
  1014.     MOV    A,M    ; GET BYTE
  1015.     STAX    D    ; PUT BYTE
  1016.     INX    H    ; PT TO NEXT
  1017.     INX    D
  1018.     DCR    B    ; COUNT DOWN
  1019.     JNZ    RES1
  1020.     XCHG        ; HL PTS TO NEXT BYTE
  1021.     MVI    B,24    ; CLEAR REST OF FCB
  1022.     XRA    A    ; A=0
  1023.     CALL    FILL
  1024.     LXI    D,FCB$TEMP    ; RESET ALL ATTRIBUTES
  1025.     MVI    C,30    ; SET ATTRIBUTES
  1026.     CALL    BDOS
  1027.     RET
  1028.  
  1029. *
  1030. *  CHECK FOR PRESENCE OF FILE PTED TO BY DE
  1031. *    ... RET W/ZERO SET IF NOT FOUND
  1032. *
  1033. FCHECK:
  1034.     LXI    H,FCB$TEMP    ; COPY INTO TEMP
  1035.     XCHG            ; COPY FROM HL TO DE
  1036.     MVI    B,12        ; 12 BYTES
  1037.     CALL    MOVE
  1038.     XCHG            ; HL PTS TO TEMP FCB
  1039.     MVI    B,24        ; FILL OUT REST WITH ZEROES
  1040.     XRA    A        ; A=0
  1041.     CALL    FILL
  1042.     LXI    D,FCB$TEMP    ; FIND FILE
  1043.     MVI    C,17        ; SEARCH FOR FIRST
  1044.     CALL    BDOS
  1045.     CPI    0FFH        ; FILE FOUND?
  1046.     RET
  1047.  
  1048. *
  1049. *  CHARACTER INPUT ROUTINE
  1050. *
  1051. CHAR$IN:
  1052.     PUSH    H    ; SAVE REGS
  1053.     PUSH    D
  1054.     PUSH    B
  1055.     MVI    C,1    ; CONSOLE INPUT
  1056.     CALL    BDOS
  1057.     POP    B    ; RESTORE REGS
  1058.     POP    D
  1059.     POP    H
  1060.     ANI    7FH    ; MASK OUT MSB
  1061.     RET
  1062.  
  1063. *
  1064. *  CHARACTER OUTPUT ROUTINE
  1065. *
  1066. CHAR$OUT:
  1067.     PUSH    H    ; SAVE REGS
  1068.     PUSH    D
  1069.     PUSH    B
  1070.     PUSH    PSW
  1071.     MOV    E,A    ; CHAR IN E
  1072.     MVI    C,2    ; CONSOLE OUTPUT
  1073.     CALL    BDOS
  1074.     POP    PSW    ; RESTORE REGS
  1075.     POP    B
  1076.     POP    D
  1077.     POP    H
  1078.     RET
  1079.  
  1080. *
  1081. *  PRINT MESSAGE PTED TO BY RET ADR ENDING IN 0
  1082. *
  1083. PRINT$MESSAGE:
  1084.     XTHL        ; SAVE HL AND SET HL TO MESSAGE
  1085. PM1:
  1086.     MOV    A,M    ; GET BYTE
  1087.     INX    H    ; PT TO NEXT
  1088.     ORA    A    ; DONE?
  1089.     JZ    PM2
  1090.     CALL    CHAR$OUT    ; PRINT
  1091.     JMP    PM1
  1092. PM2:
  1093.     XTHL        ; RESTORE HL AND RET ADR
  1094.     RET
  1095.  
  1096. *
  1097. *  CAPITALIZE CHAR IN A
  1098. *
  1099. CAPS:
  1100.     ANI    7FH    ; MASK OUT MSB
  1101.     CPI    61H    ; SMALL A
  1102.     RC
  1103.     CPI    7BH    ; SMALL B + 1
  1104.     RNC
  1105.     ANI    5FH    ; CAPITALIZE
  1106.     RET
  1107.  
  1108. *
  1109. *  MOVE (HL) TO (DE) FOR (B) BYTES
  1110. *
  1111. MOVE:
  1112.     MOV    A,M    ; GET
  1113.     STAX    D    ; PUT
  1114.     INX    H    ; PT TO NEXT
  1115.     INX    D
  1116.     DCR    B    ; COUNT DOWN
  1117.     JNZ    MOVE
  1118.     RET
  1119.  
  1120. *
  1121. *  FILL (HL) FOR (B) BYTES WITH (A)
  1122. *
  1123. FILL:
  1124.     MOV    M,A    ; PUT
  1125.     INX    H    ; PT TO NEXT
  1126.     DCR    B    ; COUNT DOWN
  1127.     JNZ    FILL
  1128.     RET
  1129.  
  1130. *
  1131. *  BUFFERS
  1132. *
  1133.     DS    100    ; WHY NOT?
  1134. STACK    DS    2    ; OLD SP
  1135.  
  1136. ATTR:
  1137.     DS    11    ; ATTRIBUTE BYTES/FILE NAME
  1138. DIR1:
  1139.     DS    2    ; DIR1 PTR
  1140. ORDER:
  1141.     DS    2    ; ORDER TABLE PTR
  1142. UDRIVE:
  1143.     DS    1    ; USER-SELECTED DRIVE NUMBER (1-16)
  1144. INSP$FLAG:
  1145.     DS    1    ; INSPECT FLAG (0=NO)
  1146. SYS$FLAG:
  1147.     DS    1    ; SYSTEM FILE FLAG (0=NO)
  1148. FILE$COUNT:
  1149.     DS    2    ; NUMBER OF FILES SELECTED
  1150. ECOUNTER:
  1151.     DS    2    ; COUNTER FOR PUT$ENTRY
  1152. PTPTR:
  1153.     DS    2    ; SORT PTR
  1154. PTDIR1:
  1155.     DS    2    ; SORT DIR1 PTR
  1156. GAP:
  1157.     DS    2    ; SORT NUMBER
  1158. I:
  1159.     DS    2    ; SORT NUMBER
  1160. J:
  1161.     DS    2    ; SORT NUMBER
  1162. JG:
  1163.     DS    2    ; SORT NUMBER
  1164. HOLD:
  1165.     DS    ENTRY$SIZE    ; HOLD BUFFER FOR SORT
  1166. FCB$SRC:
  1167.     DS    36    ; SOURCE FCB
  1168. FCB$OLD:
  1169.     DS    16    ; FCB BUFFER FOR OLD FILE NAME
  1170. FCB$NEW:
  1171.     DS    16    ; FCB BUFFER FOR NEW FILE NAME
  1172.     DS    4    ; ... FOR REST OF FCB
  1173. FCB$TEMP:
  1174.     DS    36    ; FCB BUFFER FOR NEW FILE NAME SCAN
  1175.  
  1176. *
  1177. *  BEGINNING OF DYNAMIC BUFFER REGION
  1178. *
  1179. ENDALL    EQU    $/256*256+256    ; PAGE BOUNDARY
  1180.  
  1181.     END
  1182.