home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / ZCPR33 / A-R / MKDIR32.LBR / MKDIR32.MZC / MKDIR32.MAC
Text File  |  2000-06-30  |  19KB  |  1,020 lines
  1. ;
  2. ; Program: MKDIR
  3. ; Author: Richard Conn
  4. ; Version: 3.2
  5. ; Date: 20 Nov 84
  6. ; Previous Versions: 3.1 (28 Aug 84), 3.0 (5 Mar 84)
  7. ;
  8. version    equ    32
  9.  
  10. ;
  11. ;    MKDIR is used to edit existing named directory files and to
  12. ; create new ones.
  13. ;
  14.  
  15. ;
  16. ; Basic Equates
  17. ;
  18. z3env    SET    0f400h    ;address of ZCPR3 Environment
  19. ;
  20. fcb    equ    5ch
  21. tbuff    equ    80h
  22. cr    equ    0dh
  23. lf    equ    0ah
  24.  
  25. ;
  26. ;  SYSLIB Routines
  27. ;
  28.     ext    print,putud,getud,logud,retud,zfname,getenv
  29.     ext    cout,crlf,compb,capine,pfn1
  30.     ext    f$open,f$read,f$close
  31.     ext    f$make,f$write,initfcb,f$delete,f$exist,gfa
  32.     ext    bbline,padc,codend,sksp
  33.     ext    hmovb,hfilb
  34.     ext    sort
  35.     ext    z3init,getndr,getwhl
  36.  
  37. ;
  38. ; Environment Definition
  39. ;
  40.     if    z3env ne 0
  41. ;
  42. ; External ZCPR3 Environment Descriptor
  43. ;
  44.     jmp    start
  45.     db    'Z3ENV'    ;This is a ZCPR3 Utility
  46.     db    1    ;External Environment Descriptor
  47. z3eadr:
  48.     dw    z3env
  49. start:
  50.     lhld    z3eadr    ;pt to ZCPR3 environment
  51. ;
  52.     else
  53. ;
  54. ; Internal ZCPR3 Environment Descriptor
  55. ;
  56.     MACLIB    Z3BASE.LIB
  57.     MACLIB    SYSENV.LIB
  58. z3eadr:
  59.     jmp    start
  60.     SYSENV
  61. start:
  62.     lxi    h,z3eadr    ;pt to ZCPR3 environment
  63.     endif
  64.  
  65. ;
  66. ; Start of Program -- Initialize ZCPR3 Environment
  67. ;
  68.     call    z3init    ;initialize the ZCPR3 Env and the VLIB Env
  69. ;
  70. ; Print Banner
  71. ;
  72.     call    print    ;check quiet flag
  73.     db    'MKDIR, Version '
  74.     db    (version/10)+'0','.',(version mod 10)+'0'
  75.     db    cr,lf,0
  76. ;
  77. ; Check for Wheel Powers
  78. ;
  79.     call    getwhl    ;get wheel byte
  80.     jnz    ndir0
  81.     call    print
  82.     db    ' Permission to Run MKDIR Denied - Not Wheel',0
  83.     ret
  84. ;
  85. ; Check for Availability of Named Directory
  86. ;
  87. ndir0:
  88.     call    getndr    ;get location of directory
  89.     jnz    ndir1
  90.     call    print
  91.     db    ' Named Directory Buffer Not Available',0
  92.     ret
  93. ndir1:
  94.     xra    a    ; A=0
  95.     sta    chflag    ; set no changes
  96.     sta    flflag    ; set no file loaded
  97.     sta    ecount    ; set no entries
  98.     lda    fcb+1    ; check for help
  99.     cpi    '/'
  100.     jnz    start1
  101.     call    print    ; print help message
  102.     db    cr,lf,'    MKDIR is used to read and edit named directory files.'
  103.     db    cr,lf,'It is invoked by the following forms --'
  104.     db    cr,lf
  105.     db    cr,lf,'        MKDIR            <-- Enter System'
  106.     db    cr,lf,'        MKDIR dir:filename.typ    <-- Define File First'
  107.     db    cr,lf,'        MKDIR //            <-- Print this Help'
  108.     db    cr,lf,0
  109.     ret
  110.  
  111. start1:
  112.     call    putud    ; save current dir for quick return
  113.     lxi    h,dnfile    ; set default file name
  114.     lxi    d,dfcb+1    ; copy into fcb
  115.     mvi    b,11    ; 11 chars
  116.     call    hmovb
  117.     lxi    h,fcb+1    ; pt to fcb
  118.     mov    a,m    ; get name
  119.     cpi    ' '    ; no entry?
  120.     jz    mkdir    ; enter system
  121.     dcx    h    ; pt to name
  122.     lxi    d,dfcb    ; store name in DFCB
  123.     mvi    b,16    ; copy 16 chars
  124.     call    hmovb
  125.     jmp    loadf0    ; enter load file
  126.  
  127. ;
  128. ;  Main Entry Point for Loading a File
  129. ;
  130. loadfile:
  131.     lxi    d,dfcb    ; set up default file name
  132.     call    zfname    ; extract info
  133. loadf0:
  134.     call    retud    ; get UD in CB
  135.     lda    dfcb    ; get disk
  136.     ora    a    ; current?
  137.     jz    loadf1
  138.     dcr    a    ; A=0
  139.     mov    b,a    ; disk in B
  140. loadf1:
  141.     lda    dfcb+13    ; get user
  142.     mov    c,a    ; in C
  143.     call    logud    ; log into UD to begin search
  144. ;
  145. ;  Entry Point for Loading File in DFCB
  146. ;
  147. ffile:
  148.     lxi    d,dfcb    ; pt to FCB
  149.     call    initfcb    ; init it
  150.     call    f$open    ; try to open file
  151.     jz    ffile1
  152.     call    print
  153.     db    cr,lf,'File ',0
  154.     lxi    d,dfcb+1    ; print name
  155.     call    pfn1
  156.     call    print
  157.     db    ' Not Found',0
  158.     jmp    mkdir
  159. ffile1:
  160.     call    getnd    ; get max size of file
  161.     mov    b,a    ; ... in B
  162.     inr    b    ; add 1 for overflow
  163.     call    codend    ; pt to scratch buffer
  164. readf:
  165.     lxi    d,dfcb    ; pt to FCB
  166.     call    f$read    ; read next block
  167.     jnz    readd    ; done if EOF
  168.     push    b    ; save count
  169.     mvi    b,128    ; copy 128 bytes
  170.     lxi    d,tbuff    ; ... from TBUFF
  171.     xchg
  172.     call    hmovb
  173.     xchg        ; HL pts to next block to copy into
  174.     pop    b    ; get count
  175.     dcr    b    ; count down
  176.     jnz    readf
  177.     call    print
  178.     db    cr,lf,'Named Directory File too Large for System',0
  179.     call    getud    ; return home
  180.     jmp    mkdir    ; reset parameters
  181. readd:
  182.     call    f$close    ; close file
  183.     call    getud    ; return home
  184. ;
  185. ; Fill in empty space at end of buffer
  186. ;
  187. readd1:
  188.     mov    a,b    ; get count
  189.     cpi    1    ; done?
  190.     jz    readd2
  191.     push    b    ; save count
  192.     mvi    b,128    ; fill 128 bytes with 0
  193.     xra    a
  194.     call    hfilb
  195.     pop    b    ; get count
  196.     dcr    b    ; count down
  197.     jmp    readd1    
  198. readd2:
  199.     mvi    a,0ffh
  200.     mov    m,a    ; set EOF mark
  201.     sta    flflag    ; set file loaded flag
  202. ;
  203. ; Determine Entry Count
  204. ;
  205.     call    codend    ; pt to first entry
  206.     mvi    b,0    ; set entry count
  207.     lxi    d,18    ; size of entry
  208. readd3:
  209.     mov    a,m    ; get first char of next entry
  210.     ora    a    ; done?
  211.     jz    readd4
  212.     inr    b    ; increment count
  213.     dad    d    ; pt to next
  214.     jmp    readd3
  215. readd4:
  216.     mov    a,b    ; set entry count
  217.     sta    ecount
  218.     jmp    mkdir1    ; enter MKDIR
  219. ;
  220. ;  Enter MKDIR System and Init Environ
  221. ;    Enter at MKDIR if no file loaded, enter at MKDIR1 if file loaded
  222. ;
  223. mkdir:
  224.     call    dinit0    ; init directory
  225.     xra    a    ; A=0
  226.     sta    ecount    ; set no entries present
  227.     sta    flflag    ; set no file loaded
  228.     sta    chflag    ; set no changes
  229. mkdir1:
  230.     call    print
  231.     db    cr,lf,'MKDIR Command (? for Help)? ',0
  232.     call    capine    ; get command
  233.     lxi    d,mkdir1    ; set ret address
  234.     push    d
  235.     lxi    h,ctable    ; scan command table for it
  236.     mov    c,a    ; command in C
  237. mkdir2:
  238.     mov    a,m    ; get command letter
  239.     ora    a    ; end of table?
  240.     jz    mkdirh
  241.     cmp    c    ; match?
  242.     jz    mkdir3
  243.     inx    h    ; skip over address
  244.     inx    h
  245.     inx    h
  246.     jmp    mkdir2
  247. mkdir3:
  248.     inx    h    ; get address in HL
  249.     mov    a,m    ; low
  250.     inx    h
  251.     mov    h,m
  252.     mov    l,a    ; HL is address of routine
  253.     pchl        ; "call" routine
  254. ;
  255. ;  Print MKDIR Command Help
  256. ;
  257. mkdirh:
  258.     call    print
  259.     db    cr,lf,'MKDIR Commands are --'
  260.     db    cr,lf,'    C -- Change Directory (Add/Rename/Delete Entries)'
  261.     db    cr,lf,'    I -- Initialize Directory'
  262.     db    cr,lf,'    P -- Print Directory'
  263.     db    cr,lf,'    R -- Read Directory File'
  264.     db    cr,lf,'    S -- Status of MKDIR Environment'
  265.     db    cr,lf,'    W -- Write Directory File'
  266.     db    cr,lf,'    X -- Exit Program'
  267.     db    cr,lf,0
  268.     ret
  269. ;
  270. ;  Command Table
  271. ;
  272. ctable:
  273.     db    'C'    ; change directory
  274.     dw    change
  275.     db    'I'    ; init directory
  276.     dw    dinit
  277.     db    'P'    ; print directory
  278.     dw    pwd
  279.     db    'R'    ; read file
  280.     dw    read
  281.     db    'S'    ; status
  282.     dw    status
  283.     db    'W'    ; write file
  284.     dw    write
  285.     db    'X'    ; exit
  286.     dw    exit
  287.     db    0    ; end of table
  288. ;
  289. ;  Status
  290. ;
  291. status:
  292.     call    print
  293.     db    cr,lf,'** MKDIR Status **',cr,lf,cr,lf,0
  294.     call    prec    ; print entry count
  295.     call    print
  296.     db    cr,lf,'Working File Name: ',0
  297.     lxi    d,dfcb+1
  298.     call    pfn1
  299.     call    crlf    ; new line
  300.     call    crlf
  301.     lda    chflag    ; changes made?
  302.     ora    a
  303.     jnz    stat1
  304.     call    print
  305.     db    'No ',0
  306. stat1:
  307.     call    print
  308.     db    'Changes made to Directory since Startup'
  309.     db    cr,lf,0
  310.     lda    flflag    ; file loaded?
  311.     ora    a    ; 0=no
  312.     jnz    stat2
  313.     call    print
  314.     db    'No ',0
  315. stat2:
  316.     call    print
  317.     db    'File has been loaded',cr,lf,0
  318.     ret
  319.  
  320. ;
  321. ;  Init Directory
  322. ;
  323. dinit:
  324.     call    print
  325.     db    cr,lf,'    Are you sure you want to Initialize the Directory '
  326.     db    '(Y/N/<CR>=N)? ',0
  327.     call    capine    ; get response
  328.     call    crlf
  329.     cpi    'Y'    ; Yes is only valid reply
  330.     rnz
  331. dinit0:
  332.     xra    a    ; A=0
  333.     sta    ecount
  334.     cma
  335.     sta    chflag    ; set change flag
  336.     call    getnd    ; get directory size
  337.     mov    b,a    ; ... in B
  338.     call    codend    ; pt to directory
  339. dinit1:
  340.     push    b    ; save counter
  341.     xra    a    ; zero fill
  342.     mvi    b,128    ; 128 bytes
  343.     call    hfilb
  344.     pop    b    ; get counter
  345.     dcr    b    ; count down
  346.     jnz    dinit1
  347.     mvi    m,0ffh    ; store ending mark
  348.     ret
  349. ;
  350. ;  Read File
  351. ;
  352. read:
  353.     pop    psw        ; clear stack
  354.     call    getfname    ; get file name
  355.     ora    a        ; none?
  356.     jz    ffile        ; just find default file and load it
  357.     jmp    loadfile    ; parse entry and load file
  358. ;
  359. ;  Get File Name from User
  360. ;
  361. getfname:
  362.     call    print
  363.     db    cr,lf,'Name of File (<RETURN> = ',0
  364.     call    retud    ; get current DU
  365.     mov    a,b    ; print disk
  366.     adi    'A'
  367.     call    cout
  368.     mov    a,c    ; print user
  369.     call    padc
  370.     call    print
  371.     db    ': ',0
  372.     lxi    d,dfcb+1    ; print default name
  373.     call    pfn1
  374.     call    print
  375.     db    ')? ',0
  376.     mvi    a,0ffh    ; capitalize
  377.     call    bbline    ; get user input
  378.     call    sksp    ; skip to non-blank
  379.     mov    a,m
  380.     ora    a    ; default?
  381.     ret
  382. ;
  383. ;  Write File
  384. ;
  385. write:
  386.     call    getfname    ; get file name
  387.     jz    write1
  388.     lxi    d,dfcb    ; parse into DFCB
  389.     call    zfname    ; parse file name
  390.     call    retud    ; get current DU
  391.     lda    dfcb    ; get disk
  392.     ora    a    ; current?
  393.     jz    write0
  394.     dcr    a    ; adjust for A=0
  395.     mov    b,a    ; ... in B
  396. write0:
  397.     lda    dfcb+13    ; get user
  398.     mov    c,a    ; ... in C
  399.     call    logud    ; log into new dir
  400. write1:
  401.     lxi    d,dfcb    ; open file for output
  402.     call    initfcb
  403.     call    f$exist    ; does file exist?
  404.     jz    wf0
  405.     call    gfa    ; get file attributes
  406.     ani    1    ; R/O?
  407.     jz    wf0
  408.     call    print
  409.     db    cr,lf,'File is R/O',0
  410.     jmp    getud    ; go home
  411. wf0:
  412.     call    f$make    ; open file
  413.     inr    a    ; a was 0ffh if error
  414.     jz    werr    ; write error and abort
  415.     call    print
  416.     db    cr,lf,'Writing Directory to Disk ... ',0
  417.     call    getnd    ; get size of file
  418.     mov    b,a    ; count in B
  419.     call    codend    ; pt to start of buffer
  420. wf1:
  421.     push    b    ; save counter
  422.     lxi    d,tbuff    ; copy into buffer
  423.     mvi    b,128    ; 128 bytes
  424.     call    hmovb
  425.     lxi    d,dfcb    ; pt to FCB
  426.     call    f$write    ; write block
  427.     pop    b    ; get ptr
  428.     jnz    werr
  429.     dcr    b    ; count down
  430.     jnz    wf1
  431.     lxi    d,dfcb    ; pt to FCB
  432.     call    f$close    ; close file
  433.     call    getud    ; go home
  434.     xra    a    ; A=0
  435.     sta    chflag    ; set no changes flag
  436.     call    print
  437.     db    'Done',0
  438.     ret
  439. werr:
  440.     call    print
  441.     db    cr,lf,'Error in Disk Write',0
  442.     jmp    getud    ; go home
  443. ;
  444. ;  Exit from MKDIR
  445. ;
  446. exit:
  447.     pop    psw    ; clear stack
  448.     lda    chflag    ; check for any changes
  449.     ora    a    ; 0=No
  450.     rz
  451.     call    print
  452.     db    cr,lf
  453.     db    cr,lf,'Directory has changed since last Write'
  454.     db    cr,lf,'Do you want to write Directory to Disk '
  455.     db    '(Y/N)? ',0
  456.     call    capine    ; get response
  457.     call    crlf    ; new line
  458.     cpi    'N'    ; no?
  459.     cnz    write    ; write if not No
  460.     ret
  461. ;
  462. ;  Change Directory Contents
  463. ;
  464. change:
  465.     call    setduok    ; save old DUOK flag and set new one
  466.     call    print
  467.     db    cr,lf,'** MKDIR Change Mode **',0
  468. ch0:
  469.     call    print
  470.     db    cr,lf,'Directory Entry (?<RETURN> for Help)? ',0
  471.     mvi    a,0ffh    ; caps
  472.     call    bbline    ; get user input
  473.     call    sksp    ; skip to non-blank
  474.     mov    a,m    ; get char
  475.     ora    a    ; no input?
  476.     jz    chprint    ; done, so print directory
  477.     mov    a,m    ; get first char
  478.     cpi    'X'    ; Exit?
  479.     jz    chexit    ; if so, sort and then exit
  480.     cpi    '/'    ; help?
  481.     jz    chhelp
  482.     cpi    '?'    ; help?
  483.     jnz    ch1
  484. chhelp:
  485.     call    print
  486.     db    cr,lf
  487.     db    cr,lf,'MKDIR Change Mode --'
  488.     db    cr,lf,'    You may issue the following commands at this point:'
  489.     db    cr,lf
  490.     db    cr,lf,'        DU:dirname    <-- Create/Rename Dir Entry'
  491.     db    cr,lf,'        DU:        <-- Delete Dir Entry'
  492.     db    cr,lf,'        <RETURN>    <-- Print Directory'
  493.     db    cr,lf,'        X        <-- Exit'
  494.     db    cr,lf,'        ?        <-- Print this Help'
  495.     db    cr,lf,0
  496.     jmp    ch0
  497. chprint:
  498.     call    dsort    ; use dsort routine
  499.     call    pwd    ; use pwd routine
  500.     jmp    ch0    ; continue
  501. ch1:
  502.     lxi    d,tfcb    ; extract user and disk info as well as name
  503.     call    zfname    ; get info
  504.     call    retud    ; get DU
  505.     lda    tfcb    ; get disk
  506.     ora    a    ; default?
  507.     jz    ch2
  508.     dcr    a
  509.     mov    b,a    ; A=0
  510. ch2:
  511.     inr    b    ; A=1
  512.     lda    tfcb+13    ; get user
  513.     mov    c,a    ; ... in C
  514.     mov    a,b    ; save as temp disk and user
  515.     sta    tdisk
  516.     mov    a,c
  517.     sta    tuser
  518. ;
  519. ;  Scan Directory for Temp Disk and User
  520. ;
  521.     call    codend    ; pt to first entry
  522. scanud:
  523.     mov    a,m    ; done?
  524.     ora    a
  525.     jz    scanud2
  526.     inx    h    ; pt to name
  527.     inx    h
  528.     mov    a,m    ; get first char of name
  529.     dcx    h
  530.     dcx    h    ; pt to disk
  531.     cpi    ' '    ; deleted entry?
  532.     jz    scanud1
  533.     mov    a,m    ; get disk
  534.     cmp    b
  535.     jnz    scanud1
  536.     inx    h    ; pt to user
  537.     mov    a,m    ; get user
  538.     dcx    h    ; pt back
  539.     cmp    c    ; compare it
  540.     jz    udfound
  541. scanud1:
  542.     lxi    d,18    ; pt to next
  543.     dad    d
  544.     jmp    scanud
  545. ;
  546. ; DU not found
  547. ;
  548. scanud2:
  549.     lda    tfcb+1    ; delete?
  550.     cpi    ' '    ; space if so
  551.     jnz    addname
  552.     call    print
  553.     db    cr,lf,'    DU not Found',0
  554.     jmp    ch0
  555. ;
  556. ;  Found Possible Directory Entry
  557. ;
  558. udfound:
  559.     inx    h    ; found existing entry
  560.     inx    h    ; pt to name
  561.     lda    tfcb+1    ; delete?
  562.     cpi    ' '    ; space if so
  563.     jz    delname
  564. ;
  565. ;  Rename Function
  566. ;
  567.     call    print
  568.     db    cr,lf,'    Renaming ',0
  569.     mvi    b,8    ; 8 chars
  570.     call    prhlb    ; print name
  571.     push    h    ; save ptr to name
  572.     call    etest    ; check for duplicate name
  573.     pop    d    ; restore ptr to name
  574.     jz    ch0    ; abort since duplicate
  575.     lxi    h,tfcb+1    ; pt to new name
  576.     mvi    b,8    ; 8 chars
  577.     call    hmovb    ; copy
  578.     mvi    a,0ffh    ; set change
  579.     sta    chflag
  580.     jmp    ch0
  581. ;
  582. ;  Add Function
  583. ;
  584. addname:
  585.     call    print
  586.     db    cr,lf,'    Adding ',0
  587.     lxi    h,tfcb+1    ; print name of entry to add
  588.     mvi    b,8
  589.     call    prhlb
  590. ;
  591. ; Test for Duplicate Name
  592. ;
  593. putname:
  594.     call    etest    ; test for duplicate name
  595.     jz    ch0    ; abort if duplicate
  596. ;
  597. ; Test to see if there is room for another entry
  598. ;
  599. putn1:
  600.     mvi    b,18    ; 18 bytes required for entry
  601.     push    h    ; save ptr
  602. putn2:
  603.     mov    a,m    ; check for 0FFH
  604.     cpi    0ffh
  605.     jz    putn3
  606.     inx    h    ; pt to next
  607.     dcr    b
  608.     jnz    putn2
  609.     pop    h    ; get ptr to entry
  610.     jmp    putn4    ; make entry
  611. putn3:
  612.     pop    psw    ; clear stack
  613.     call    print
  614.     db    cr,lf,'** Directory Full **',0
  615.     jmp    ch0
  616. ;
  617. ; Make Directory Entry
  618. ;
  619. putn4:
  620.     mvi    a,0ffh    ; set change flag
  621.     sta    chflag
  622.     lda    tdisk    ; set disk and user
  623.     mov    m,a
  624.     inx    h
  625.     lda    tuser
  626.     mov    m,a
  627.     inx    h
  628.     lxi    d,tfcb+1    ; pt to new name
  629.     xchg
  630.     mvi    b,8    ; 8 chars
  631.     call    hmovb    ; set new name
  632.     call    password    ; enter password into buffer at DE
  633.     lda    ecount    ; print count
  634.     inr    a    ; increment entry count
  635.     sta    ecount
  636.     jmp    precount    ; print count
  637. ;
  638. ; Test for Duplicate Directory Name
  639. ;
  640. etest:
  641.     call    codend    ; pt to first entry
  642. etest0:
  643.     mov    a,m    ; done?
  644.     ora    a
  645.     jz    etest2
  646.     inx    h    ; pt to name
  647.     inx    h
  648.     lxi    d,tfcb+1    ; pt to new name
  649.     mvi    b,8    ; 8 chars
  650.     call    compb    ; compare
  651.     jnz    etest1
  652.     call    crlf
  653.     lxi    h,tfcb+1
  654.     mvi    b,8    ; 8 chars
  655.     call    prhlb    ; print dir name
  656.     call    print
  657.     db    ' is a Duplicate Name',0
  658.     xra    a    ; return Z
  659.     ret
  660. ;
  661. ; Last Entry was OK - Pt to Next
  662. ;
  663. etest1:
  664.     lxi    d,16    ; pt to next entry
  665.     dad    d
  666.     jmp    etest0
  667. ;
  668. ; No Duplicate Entries - Return NZ and HL pts to after last entry
  669. ;
  670. etest2:
  671.     dcr    a    ; set NZ
  672.     ret
  673. ;
  674. ; Enter 8-char password into memory pted to by HL
  675. ;
  676. password:
  677.     push    d    ; save ptr
  678.     call    print
  679.     db    ' -- Password? ',0
  680.     mvi    a,0ffh    ; caps
  681.     call    bbline    ; get line from user
  682.     call    crlf    ; new line
  683.     mvi    b,8    ; 8 chars max
  684.     pop    d    ; pt to destination
  685. pword1:
  686.     mov    a,m    ; get char
  687.     ora    a    ; done?
  688.     jz    pword2
  689.     stax    d    ; put char
  690.     inx    h    ; pt to next
  691.     inx    d
  692.     dcr    b    ; count down
  693.     jnz    pword1
  694.     ret
  695. pword2:
  696.     mvi    a,' '    ; rest are spaces
  697.     stax    d    ; store space
  698.     inx    d    ; pt to next
  699.     dcr    b    ; count down
  700.     jnz    pword2
  701.     ret
  702.  
  703. ;
  704. ;  Delete Function
  705. ;
  706. delname:
  707.     mvi    a,0ffh    ; change made
  708.     sta    chflag
  709.     call    print
  710.     db    cr,lf,'    Deleting ',0
  711.     mvi    b,8    ; 8 chars
  712.     call    prhlb
  713.     mvi    m,' '    ; space fill
  714.     call    dirpack    ; pack directory
  715.     call    print
  716.     db    ' -- ',0
  717.     lda    ecount    ; decrement entry count
  718.     dcr    a
  719.     sta    ecount
  720. ;
  721. ; Print Number of Remaining Entries in Directory
  722. ;
  723. precount:
  724.     call    prec    ; print count
  725.     jmp    ch0
  726. prec:
  727.     lda    ecount    ; print remaining count
  728.     call    padc
  729.     call    print
  730.     db    ' Entries in Directory',0
  731.     ret
  732. ;
  733. ;  Pack Memory-Based Directory -- One Entry has been Deleted
  734. ;
  735. dirpack:
  736.     call    codend    ; get address of first entry
  737.     mov    d,h    ; DE pts to it also
  738.     mov    e,l
  739. dirp0:
  740.     mov    a,m    ; get first byte
  741.     ora    a    ; done if zero
  742.     jz    dirp2
  743.     push    b    ; save counts
  744.     inx    h    ; pt to name
  745.     inx    h
  746.     mov    a,m    ; get char
  747.     dcx    h    ; pt back to disk
  748.     dcx    h
  749.     cpi    ' '    ; no entry if space
  750.     jz    dirp1
  751.     mvi    b,18    ; copy 18 bytes
  752.     call    hmovb
  753.     pop    b    ; get counts
  754.     jmp    dirp0
  755. dirp1:
  756.     lxi    b,18    ; pt to next entry
  757.     dad    b
  758.     pop    b    ; get counts
  759.     jmp    dirp0
  760. dirp2:
  761.     mvi    b,18    ; fill last entry with zeroes
  762.     xra    a
  763.     xchg        ; HL pts to last entry
  764.     jmp    hfilb
  765. ;
  766. ;  Exit Change Routine
  767. ;
  768. chexit:
  769.     call    resduok    ; restore DUOK flag and fall thru to DSORT
  770. ;
  771. ;  Sort Directory
  772. ;
  773. dsort:
  774.     lda    ecount    ; number of elements
  775.     ora    a    ; any?
  776.     rz        ; done if none
  777.     sta    ssbcnt    ; set count
  778.     call    codend    ; pt to first element
  779.     shld    ssbstrt    ; set starting address
  780.     lxi    d,ssb    ; pt to sort specifiction block
  781.     jmp    sort    ; sort
  782. ;
  783. ;  Sort Compare Routine
  784. ;
  785. compare:
  786.     push    h    ; don't change regs
  787.     push    d
  788.     ldax    d    ; compare disk
  789.     cmp    m
  790.     jnz    comp1
  791.     inx    h    ; pt to user
  792.     inx    d
  793.     ldax    d    ; compare user
  794.     cmp    m
  795. comp1:
  796.     pop    d    ; restore regs
  797.     pop    h
  798.     ret
  799.  
  800. ;
  801. ; SETDUOK - Save Old DUOK Flag and Set Flag to TRUE
  802. ; RESDUOK - Restore Old DUOK Flag
  803. ;
  804. setduok:
  805.     push    h    ;save regs
  806.     push    d
  807.     call    getenv    ;get ptr to environment descriptor
  808.     lxi    d,2EH    ;offset to DUOK Flag
  809.     dad    d
  810.     mov    a,m    ;get flag
  811.     sta    duoksav    ;save flag
  812.     mvi    m,1    ;turn flag on
  813.     pop    d    ;restore regs
  814.     pop    h
  815.     ret
  816. resduok:
  817.     push    h    ;save regs
  818.     push    d
  819.     call    getenv    ;get ptr to environment descriptor
  820.     lxi    d,2EH    ;offset to DUOK Flag
  821.     dad    d
  822.     lda    duoksav    ;get save flag
  823.     mov    m,a    ;set flag
  824.     pop    d    ;restore regs
  825.     pop    h
  826.     ret
  827.  
  828. ;
  829. ; Print Names of Directory Elements
  830. ;
  831. pwd:
  832.     call    crlf    ; new line
  833.     lda    ecount    ;check count first
  834.     ora    a    ;no entries?
  835.     jnz    pwd01
  836.     call    print
  837.     db    ' No Entries in Directory',0
  838.     ret
  839. ;
  840. ; Print Header for Password Entries
  841. ;
  842. pwd01:
  843.     mvi    b,2    ;2 times
  844. pwd0a:
  845.     call    print
  846.     db    ' DU : DIR Name - Password    ',0
  847.     dcr    b    ;count down
  848.     jnz    pwd0a
  849.     call    crlf
  850.     mvi    b,2
  851. pwd0b:
  852.     call    print
  853.     db    '----  --------   --------    ',0
  854.     dcr    b    ;count down
  855.     jnz    pwd0b
  856.     call    crlf
  857. ;
  858. ; Begin Output Processing
  859. ;
  860.     mvi    c,0    ;set entry count
  861.     mvi    b,1    ;set disk 1
  862.     call    codend    ;pt to buffer containing new directory
  863. ;
  864. ; Print Each Resident Command Name
  865. ;
  866. pwd1:
  867.     mov    a,m    ;get table entry
  868.     ora    a    ;end of table?
  869.     rz        ;exit
  870.     cmp    b    ;same disk?
  871.     jz    pwd2
  872. ;
  873. ; Advance to Next Set of Entries for New Disk
  874. ;
  875.     mov    b,a    ;set new disk
  876.     mov    a,c    ;get count
  877.     ani    3    ;see if newline already given
  878.     cnz    crlf    ;complete current line
  879.     call    crlf    ;1 additional line
  880.     mvi    c,0    ;reset count
  881. pwd2:
  882.     push    b    ;save counters
  883. ;
  884. ; Print DU:
  885. ;
  886.     mov    a,m    ;get disk
  887.     adi    '@'    ;convert to letter (A to P)
  888.     call    cout
  889.     inx    h    ;pt to user
  890.     mov    a,m    ;get user
  891.     call    padc    ;print user number
  892.     call    print    ;print separator
  893.     db    ': ',0
  894.     inx    h    ;pt to name
  895. ;
  896. ; Print DIR
  897. ;
  898.     call    prname    ;print name of directory
  899.     call    print
  900.     db    ' - ',0
  901.     call    prname    ;print name of password
  902.     pop    b    ;get counters
  903.     inr    c    ;another entry
  904.     push    b    ;save counters
  905. ;
  906. ; Print Separator
  907. ;
  908.     call    print    ;print separator
  909.     db    '    ',0
  910.     pop    b    ;get counters
  911. ;
  912. ; New Line Counter
  913. ;
  914.     inr    c    ;increment entry counter
  915.     mov    a,c    ;check for done
  916.     ani    3    ;every 4
  917.     cz    crlf    ;new line
  918.     jmp    pwd1
  919. ;
  920. ; Print 8-char name (directory or password) and advance ptr
  921. ;
  922. prname:
  923.     mvi    b,8    ;print name
  924. prn1:
  925.     mov    a,m    ;get char
  926.     call    cout
  927.     inx    h    ;pt to next
  928.     dcr    b    ;count down
  929.     jnz    prn1
  930.     ret
  931.  
  932. ;
  933. ;  Utilities
  934. ;
  935.  
  936. ;
  937. ;  Print chars pted to by HL for B bytes
  938. ;
  939. prhlb:
  940.     push    h    ; save HL
  941. prhlb1:
  942.     mov    a,m    ; print chars
  943.     inx    h    ; pt to next
  944.     call    cout
  945.     dcr    b    ; count down
  946.     jnz    prhlb1
  947.     pop    h    ; get HL
  948.     ret
  949.  
  950. ;
  951. ;  Compute Number of 128-byte blocks in Named Dir
  952. ;    Return with Number in A and HL pting to it
  953. ;
  954. getnd:
  955.     call    getndr    ; get ptr to NDR and number of entries in A
  956.     push    h    ; save ptr
  957.     mvi    h,0    ; HL = value
  958.     mov    l,a
  959.     dad    h    ; *2
  960.     mov    d,h    ; DE = value * 2
  961.     mov    e,l
  962.     dad    h    ; *4
  963.     dad    h    ; *8
  964.     dad    h    ; *16
  965.     dad    d    ; *18
  966.     mov    a,h    ; /128
  967.     rlc
  968.     ani    0feh
  969.     mov    h,a
  970.     mov    a,l
  971.     rlc
  972.     ani    1
  973.     ora    h    ; A = value * 18 / 128
  974.     inr    a    ; +1
  975.     pop    h    ; get ptr
  976.     ret
  977.  
  978. ;
  979. ;  Default File Name
  980. ;
  981. dnfile:
  982.     db    'NAMES   '
  983.     db    'NDR'
  984.  
  985. ;
  986. ;  Sort Specification Block
  987. ;
  988. ssb:
  989. ssbstrt:
  990.     ds    2    ; start address of dir
  991. ssbcnt:
  992.     dw    0    ; number of records to sort
  993.     dw    18    ; 18 bytes/record
  994.     dw    compare    ; compare routine
  995.     dw    0    ; no ptr table
  996.     db    0,0    ; don't use ptrs
  997. ;
  998. ;  Buffers
  999. ;
  1000. duoksav:
  1001.     ds    1    ; save value for DUOK flag
  1002. tdisk:
  1003.     ds    1    ; temp disk
  1004. tuser:
  1005.     ds    1    ; temp user
  1006. flflag:
  1007.     ds    1    ; file loaded flag
  1008. chflag:
  1009.     ds    1    ; dir changed flag
  1010. ecount:
  1011.     ds    1    ; entry count
  1012. crcnt:
  1013.     ds    1    ; new line count
  1014. tfcb:
  1015.     ds    36    ; temp FCB
  1016. dfcb:
  1017.     ds    36    ; Default FCB
  1018.  
  1019.     end
  1020.