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 / PACK10A.LBR / PACK10A.ZZ0 / PACK10A.Z80
Text File  |  2000-06-30  |  29KB  |  1,554 lines
  1.     .title    'Pack Disk'
  2.  
  3. ;     FDC, 29 August 1987
  4.  
  5. version    equ    10
  6.  
  7. fcb1:    equ    5ch
  8. fcb2:    equ    6ch
  9. buff:    equ    80h
  10.  
  11. lf:    equ    10
  12. cr:    equ    13
  13. ctrlz:    equ    26
  14.  
  15. MAXLIN:    equ    128        ; maximum input line length
  16.  
  17.     extrn    print,cout,cin,condin,crlf,pfn2,pa2hc,phlfdc,phl4hc
  18.     extrn    caps,issp,sksp,compb,getcrt,getmdisk
  19.     extrn    z3init,z3log,getwhl,getefcb,retud,dnscan
  20.     extrn    f$open,f$read,f$close,bdos,bios
  21.     extrn    mulhd,divhd
  22.     public    $memry
  23.  
  24. start:    jp    pack
  25.     db    'Z3ENV'
  26.     db    1        ; external environment
  27. z3eadr    dw    0f000h        ; environment address
  28.  
  29. dirflg:    db    0        ; always set C=1 on directory writes if non-zero
  30.  
  31. pack:    ld    hl,(z3eadr)
  32.     call    z3init        ; initialise z3lib routines
  33.     call    assign        ; assign data areas
  34.     ld    c,12        ; get cp/m version number
  35.     call    bdos
  36.     ld    a,h
  37.     or    a
  38.     jr    nz,badver
  39.     ld    a,l
  40.     cp    22h
  41.     jr    z,chkwhl
  42. badver:    call    pname
  43.     call    print
  44.     db    ' requires CP/M 2.2 (or ZRDOS)',cr,lf,0
  45. quit:    rst    0
  46. chkwhl:    call    getwhl        ; priviledged?
  47.     jr    z,quit        ; silently deny access if not
  48.     ld    a,(fcb1+1)    ; help requested?
  49.     cp    '/'
  50.     jr    z,ghelp
  51.     cp    ' '
  52.     jr    nz,pack1
  53. ghelp:    call    help
  54.     rst    0        ; warm boot
  55.  
  56. pack1:    call    options        ; process options
  57.     call    gnames        ; read input file and build name tables
  58.     xor    a
  59.     ld    (fixmob),a
  60.     ld    hl,wild
  61.     call    fnam        ; terminate mobile list with *:*.*
  62.     ld    de,fcb1
  63.     call    f$close
  64.     call    quitif        ; quit if errors
  65.     ld    a,(verbose)
  66.     or    a
  67.     call    nz,showlist
  68.     call    maktab        ; make group table
  69.     call    quitif        ; quit if errors
  70.     ld    a,(verbose)
  71.     or    a
  72.     call    nz,showtab
  73.     ld    hl,0
  74.     ld    (rdcnt),hl    ; clear counters
  75.     ld    (wrcnt),hl
  76.     ld    a,(stats)    ; just statistics?
  77.     or    a
  78.     jr    nz,pack5
  79.     ld    a,(blshf)
  80.     ld    b,a
  81.     ld    hl,128
  82. pack2:    add    hl,hl        ; find group size
  83.     djnz    pack2
  84.     ex    de,hl
  85.     call    getheap        ; reserve 2 buffers
  86.     ld    (grp1),hl
  87.     call    getheap
  88.     ld    (grp2),hl
  89.     call    chkro        ; check for read only disk
  90.     call    print
  91.     db    'Ready to pack disk ',0
  92.     ld    a,(disk)
  93.     add    'A'
  94.     call    cout
  95.     call    print
  96.     db    cr,lf,'Are you sure you wish to proceed? (y/n) - ',0
  97. pack3:    call    cin
  98.     and    5fh
  99.     cp    'Y'
  100.     jr    z,pack4
  101.     cp    'N'
  102.     jr    nz,pack3
  103.     rst    0
  104. pack4:    call    cout
  105.     call    crlf
  106. pack5:    call    sort        ; sort groups
  107.     ld    a,(stats)
  108.     or    a
  109.     jr    nz,pack6
  110.     call    fixdir        ; fix directory
  111.     call    resdrv        ; reset drive
  112.     call    print
  113.     db    'Disk packed',cr,lf,0
  114.     rst    0
  115. pack6:    ld    hl,(rdcnt)
  116.     call    phlfdc
  117.     call    print
  118.     db    ' group reads and ',0
  119.     ld    hl,(wrcnt)
  120.     call    phlfdc
  121.     call    print
  122.     db    ' group writes required to pack disk.',cr,lf,0
  123.     rst    0
  124.  
  125. assign:    pop    bc        ; return address
  126.     ld    hl,($memry)
  127.     ld    de,128        ; stack size
  128.     add    hl,de
  129.     ld    sp,hl        ; assign stack above program
  130.     push    bc
  131.     ld    (inline),hl    ; input line buffer
  132.     ld    de,MAXLIN
  133.     add    hl,de
  134.     ld    (heap),hl    ; set top of heap
  135.     ret
  136.  
  137. ; Read input file and build fixed and mobile name tables
  138. gnames:    ld    hl,0
  139.     ld    (errors),hl    ; no errors yet
  140.     ld    de,fcb1
  141.     call    z3log        ; log in to file DU
  142.     call    f$open        ; open it
  143.     jr    z,opok
  144.     call    print        ; report file missing
  145.     db    'Can''t find ',0
  146.     inc    de
  147.     call    pfn2
  148.     call    crlf
  149.     rst    0        ; and quit
  150. opok:    xor    a
  151.     ld    (fixmob),a    ; initially expect mobile names
  152.     ld    h,a
  153.     ld    l,a
  154.     ld    (fixcnt),hl    ; no fixed or
  155.     ld    (mobcnt),hl    ;  mobile files yet
  156.     ld    hl,(heap)
  157.     ld    (fixpnt),hl    ; this is where they go
  158.     ld    (mobpnt),hl
  159.     ld    hl,0
  160.     ld    (linnum),hl    ; line number
  161.     ld    (bufcnt),a    ; no bytes in buffer
  162. gnam1:    call    getlin        ; get next input line
  163.     ret    z        ; all done
  164.     ld    hl,(inline)    ; point to line
  165.     call    sksp        ; skip spaces
  166.     ld    a,(hl)
  167.     or    a        ; empty line?
  168.     jr    z,gnam1        ; ignore
  169.     cp    ';'        ; fixed / mobile spec?
  170.     jr    nz,gnam2
  171.     call    cmd        ; process fixed / mobile spec
  172.     jr    gnam1
  173. gnam2:    call    fnam        ; process filename
  174.     jr    gnam1
  175.  
  176. ; Process command line
  177. cmd:    inc    hl        ; skip over ';'
  178.     call    sksp        ; and spaces
  179.     ld    de,fixstr    ; 'FIXED'
  180.     ld    b,5
  181.     call    compb
  182.     ld    a,1        ; flag if fixed
  183.     jr    z,cmd1
  184.     ld    de,mobstr    ; 'MOBILE'
  185.     ld    b,6
  186.     call    compb
  187.     ld    a,0        ; flag if mobile
  188.     ret    nz
  189. cmd1:    ld    (fixmob),a    ; set new flag value
  190.     ret
  191.  
  192. ; Extract filename from input line
  193. fnam:    call    gdir        ; get directory
  194.     ret    nz        ; ignore if error
  195.     push    hl        ; save pointer to start of name
  196.     push    bc        ;  and user number
  197.     ld    de,16
  198.     call    getheap        ; extend heap
  199.     ld    hl,(mobcnt)
  200.     add    hl,hl        ; x 2
  201.     add    hl,hl        ; x 4
  202.     add    hl,hl        ; x 8
  203.     add    hl,hl        ; x 16 (size of mobile list)
  204.     ld    a,(fixmob)
  205.     or    a        ; fixed or mobile?
  206.     jr    z,fnam2
  207.     ld    a,h
  208.     or    l        ; empty?
  209.     jr    z,fnam1
  210.     ld    b,h
  211.     ld    c,l
  212.     ld    hl,(mobpnt)
  213.     dec    hl
  214.     add    hl,bc        ; last byte of current location
  215.     ld    de,16        ; offset
  216.     ex    de,hl
  217.     add    hl,de
  218.     ex    de,hl
  219.     lddr            ; make space to expand fixed list
  220. fnam1:    ld    hl,(fixcnt)
  221.     inc    hl        ; increment number of fixed files
  222.     ld    (fixcnt),hl
  223.     ld    hl,(mobpnt)
  224.     ld    de,16
  225.     ex    de,hl
  226.     add    hl,de        ; shift mobile base up
  227.     ld    (mobpnt),hl
  228.     ex    de,hl        ; address of next fixed entry in hl
  229.     jr    fnam3
  230. fnam2:    ld    de,(mobpnt)
  231.     add    hl,de        ; address of next mobile entry
  232.     push    hl
  233.     ld    hl,(mobcnt)
  234.     inc    hl
  235.     ld    (mobcnt),hl
  236.     pop    hl
  237. fnam3:    pop    bc        ; retrieve user number
  238.     ld    (hl),c        ; and store it in list
  239.     inc    hl
  240.     pop    de        ; retrieve pointer to name
  241.     ld    b,8        ; max length of name part
  242.     call    cpyfn
  243.     ld    a,(de)
  244.     cp    '.'        ; typ specified?
  245.     jr    nz,fnam4
  246.     inc    de
  247.     ld    b,3
  248.     call    cpyfn
  249.     jr    fnam5
  250. fnam4:    ld    b,3
  251.     call    cpyfsp        ; blank typ
  252. fnam5:    ld    b,4
  253.     call    cpyf?        ; any extents
  254.     ld    a,(de)        ; valid end?
  255.     or    a
  256.     ret    z
  257.     cp    ' '
  258.     ret    z
  259.     call    plnum
  260.     call    print
  261.     db    ': invalid filename',cr,lf,0
  262. incerr:    ld    hl,(errors)
  263.     inc    hl        ; increment error count
  264.     ld    (errors),hl
  265.     ret
  266.  
  267. ; copy part of filename from (de) to (hl), max b bytes
  268. cpyfn:    ld    a,(de)
  269.     or    a
  270.     jr    z,cpyfsp
  271.     cp    '.'
  272.     jr    z,cpyfsp
  273.     cp    ' '
  274.     jr    z,cpyfsp
  275.     inc    de
  276.     cp    '*'
  277.     jr    z,cpyf?
  278.     ld    (hl),a
  279.     inc    hl
  280.     djnz    cpyfn
  281.     ret
  282. cpyfsp:    ld    a,' '
  283.     jr    cpyflp
  284. cpyf?:    ld    a,'?'
  285. cpyflp:    ld    (hl),a
  286.     inc    hl
  287.     djnz    cpyflp
  288.     ret
  289.  
  290. ; Analyse directory specified in file name
  291.  
  292. ; Possibilities are:
  293. ;    none        - use default DU (as input file or option spec)
  294. ;    *: or ?:    - all users on default D
  295. ;    D:        - default DU, D must match default
  296. ;    D*: or D?:    - all users on D (must be default)
  297. ;    DU:        - DU, D must match default
  298. ;    DIR:        - corresponding DU, D must match default
  299.  
  300. ; Entry: hl points to start of filespec
  301. ; Exit:  hl points to start of filename
  302. ;        c  contains user (0..31 or '?')
  303. ;     nz  means error detected (discard line)
  304. gdir:    ld    bc,9*256    ; char and wildcard count
  305.     ld    de,dnbuf    ; copy possible directory spec to buf
  306.     push    hl
  307. gdir1:    ld    a,(hl)
  308.     inc    hl
  309.     cp    ':'
  310.     jr    z,gdir4
  311.     ld    (de),a
  312.     inc    de
  313.     cp    '?'
  314.     jr    z,gdir2
  315.     cp    '*'
  316.     jr    nz,gdir3
  317. gdir2:    inc    c        ; count wildcards
  318. gdir3:    djnz    gdir1
  319.     ld    a,(user)    ; no dir specified
  320.     ld    c,a
  321.     pop    hl
  322.     xor    a        ; return with Z (ok)
  323.     ret
  324. gdir4:    xor    a
  325.     ld    (de),a
  326.     ld    de,dnbuf
  327.     ld    a,(de)
  328.     or    a
  329.     jp    z,baddn        ; null - no good
  330.     ld    a,c        ; any wildcards used?
  331.     or    a
  332.     jr    z,gdir8
  333.     ld    a,(de)
  334.     sub    'A'        ; disk specified?
  335.     jr    c,gdir5
  336.     cp    'P'-'A'+1
  337.     jr    nc,gdir5
  338.     inc    de
  339.     push    hl
  340.     ld    hl,disk
  341.     cp    (hl)        ; does disk match?
  342. gdir4a:    pop    hl
  343.     jr    z,gdir5
  344.     call    plnum
  345.     call    print
  346.     db    ' specifies disk ',0
  347.     add    a,'A'
  348.     call    cout
  349.     call    print
  350.     db    ', (',0
  351.     ld    a,(disk)
  352.     add    'A'
  353.     call    cout
  354.     call    print
  355.     db    ' expected)',cr,lf,0
  356.     pop    hl
  357.     jp    incerr
  358. gdir5:    ld    a,(de)
  359.     cp    '*'
  360.     jr    z,gdir6        ; expect just 1 wild card
  361.     cp    '?'
  362.     jr    nz,baddn
  363. gdir6:    inc    de
  364.     ld    a,(de)
  365.     or    a
  366.     jr    nz,baddn
  367.     ld    c,'?'        ; wildcard user
  368. gdir7    pop    af        ; discard start pointer
  369.     xor    a        ; return with Z (ok)
  370.     ret
  371. gdir8:    ex    de,hl        ; directory pointer to hl
  372.     xor    a        ; DU before DIR
  373.     call    dnscan
  374.     ex    de,hl
  375.     jr    z,baddn
  376.     ld    a,b
  377.     push    hl
  378.     ld    hl,disk
  379.     cp    (hl)        ; does disk match?
  380.     jr    nz,gdir4a
  381.     pop    hl
  382.     jr    gdir7
  383. baddn:    call    plnum
  384.     call    print
  385.     db    ': can''t interpret directory specification',cr,lf,0
  386.     pop    hl
  387.     jp    incerr
  388.  
  389. ; get a line from the input file
  390. getlin:    ld    hl,(linnum)
  391.     inc    hl
  392.     ld    (linnum),hl    ; increment line count
  393.     ld    hl,(inline)    ; start of line
  394.     ld    bc,MAXLIN-1    ; space left
  395.     call    getch        ; get first input character
  396.     cp    ctrlz        ; end of file?
  397.     ret    z
  398. getl1:    cp    ctrlz
  399.     jr    nz,getl2
  400.     ld    a,lf        ; simulate eol
  401. getl2:    ld    (hl),a
  402.     inc    hl
  403.     cp    lf        ; end of line?
  404.     jr    z,getl3
  405.     dec    bc
  406.     ld    a,b
  407.     or    c
  408.     jr    z,getl4
  409.     call    getch        ; get next character
  410.     jr    getl1
  411. getl3:    ld    (hl),0        ; terminate line
  412.     dec    hl
  413.     ld    a,(hl)
  414.     call    issp        ; eliminate trailing whitespace
  415.     jr    z,getl3
  416.     or    1        ; return with NZ
  417.     ret
  418. getl4:    call    plnum        ; print line number
  419.     call    print
  420.     db    ' too long: truncated.',cr,lf,0
  421. getl5:    call    getch        ; skip rest of line
  422.     cp    lf
  423.     jr    z,getl3
  424.     cp    ctrlz
  425.     jr    z,getl3
  426.     jr    getl5
  427.  
  428. ; Get next input character
  429. getch:    push    hl
  430.     push    de
  431.     push    bc
  432.     ld    hl,bufcnt
  433.     ld    a,(hl)
  434.     or    a        ; anything left in buffer?
  435.     jr    nz,getch1
  436.     ld    de,fcb1
  437.     call    f$read        ; read sector
  438.     or    a        ; end of file?
  439.     jr    nz,geteof
  440.     ld    a,128
  441.     ld    (hl),a        ; 128 bytes available now
  442. getch1:    dec    (hl)        ; decrement count
  443.     neg            ; convert to address
  444.     ld    e,a
  445.     ld    d,0
  446.     ld    a,(de)        ; pick up character
  447.     and    7fh
  448.     call    caps        ; capitalize it
  449.     cp    ctrlz        ; end of file?
  450.     jr    nz,getch2
  451. geteof:    ld    (hl),80h    ; stick at eof
  452.     ld    a,ctrlz
  453.     ld    (80h),a
  454. getch2:    pop    bc
  455.     pop    de
  456.     pop    hl
  457.     ret
  458.     
  459.  
  460. ; Display input line number
  461. plnum:    push    hl
  462.     push    de
  463.     push    bc
  464.     push    af
  465.     call    print
  466.     db    'Line ',0
  467.     ld    hl,(linnum)
  468.     call    phlfdc
  469.     pop    af
  470.     pop    bc
  471.     pop    de
  472.     pop    hl
  473.     ret
  474.  
  475. ; Make table of group numbers
  476. ; Table format is:
  477. ;
  478. ;        +----------------+----------------+
  479. ;    Index -> 0 | Current number | Position where |
  480. ;               | of group which | group which is |
  481. ;               | should go at   | currently here |
  482. ;               | this position  | should go      |
  483. ;               | on the disk    |                |
  484. ;               |                |                |
  485. ;                      :                 :
  486. ;           dsm |                |                |
  487. ;               +----------------+----------------+
  488.  
  489. maktab:    ld    a,(disk)
  490.     ld    e,a
  491.     ld    c,14        ; select disk via bdos
  492.     call    bdos
  493.     ld    c,e
  494.     ld    b,0
  495.     ld    a,9        ; select disk via bios (to get dph)
  496.     call    bios
  497.     ld    e,(hl)
  498.     inc    hl
  499.     ld    d,(hl)        ; pick up sector table address
  500.     ld    (sectab),de
  501.     ld    de,9        ; offset to dpb address
  502.     add    hl,de
  503.     ld    e,(hl)
  504.     inc    hl
  505.     ld    d,(hl)
  506.     ex    de,hl        ; dpb address in hl
  507.     ld    de,dpb
  508.     ld    bc,15
  509.     ldir            ; make a local copy of disk params
  510.     ld    hl,(dsm)
  511.     inc    hl
  512.     add    hl,hl        ; table size is 4 * (dsm+1)
  513.     add    hl,hl
  514.     ex    de,hl
  515.     push    de        ; save size
  516.     call    getheap        ; get space for it
  517.     ld    (grptab),hl    ; save base of group table
  518.     pop    bc        ; size of table
  519. mtab1:    ld    (hl),-1        ; clear table
  520.     inc    hl
  521.     dec    bc
  522.     ld    a,b
  523.     or    c
  524.     jr    nz,mtab1
  525.     ld    hl,(alloc)    ; initial allocation
  526.     ld    a,h
  527.     ld    h,l
  528.     ld    l,a        ; get in right order
  529.     ld    de,0        ; group number
  530. mtab2:    ld    a,h
  531.     or    l
  532.     jr    z,mtab3
  533.     call    fixgrp        ; fix directory group
  534.     inc    de        ; next group
  535.     add    hl,hl        ; shift a bit out
  536.     jr    mtab2
  537. mtab3:    ld    hl,fixgrp
  538.     ld    (proc),hl    ; what to do for each group
  539.     ld    hl,(heap)
  540.     ld    (mark),hl    ; remember top of heap
  541.     ld    hl,(fixpnt)    ; fixed file table
  542.     ld    bc,(fixcnt)    ; how many
  543. mtab4:    ld    a,b
  544.     or    c
  545.     jr    z,mtab5
  546.     call    dofile        ; do it for these files
  547.     ld    de,16        ; size of file entry
  548.     add    hl,de
  549.     dec    bc
  550.     jr    mtab4
  551. mtab5:    ld    hl,-1
  552.     ld    (group),hl    ; last group allocated
  553.     ld    hl,nxtgrp    ; what to do for each group
  554.     ld    (proc),hl
  555.     ld    hl,(mobpnt)    ; mobile file table
  556.     ld    bc,(mobcnt)    ; how many
  557. mtab6:    ld    a,b
  558.     or    c
  559.     jr    z,mtab7
  560.     call    dofile
  561.     ld    de,16
  562.     add    hl,de
  563.     dec    bc
  564.     jr    mtab6
  565. mtab7:    ld    hl,(mark)
  566.     ld    (heap),hl    ; reset heap
  567.     ret
  568.  
  569. ; Do proc for each group allocated to the files matching
  570. ; the afn pointed to by hl
  571. dofile:    push    bc
  572.     push    de
  573.     push    hl
  574.     ex    de,hl
  575.     ld    bc,0        ; first directory slot
  576. dof0:    call    getdir        ; get next entry
  577.     jr    nz,dofend
  578.     inc    bc
  579.     call    match        ; check match
  580.     jr    nz,dof0
  581.     push    bc        ; save slot number
  582.     push    de        ; and afn pointer
  583.     ld    de,16        ; offset to group map
  584.     add    hl,de
  585.     ld    b,16        ; size of map in bytes
  586. dof1:    ld    e,(hl)
  587.     ld    d,0
  588.     inc    hl
  589.     ld    a,(dsm+1)    ; high byte of disk size
  590.     or    a
  591.     jr    z,dof2        ; 1 byte group numbers
  592.     ld    d,(hl)
  593.     inc    hl
  594.     dec    b
  595. dof2:    ld    a,d
  596.     or    e        ; assigned?
  597.     jr    z,dof3
  598.     push    hl
  599.     ld    hl,(proc)
  600.     call    ihl        ; do procedure on this group
  601.     pop    hl
  602. dof3:    djnz    dof1
  603.     pop    de        ; afn
  604.     pop    bc        ; slot number
  605.     jr    dof0
  606. dofend:    pop    hl
  607.     pop    de
  608.     pop    bc
  609.     ret
  610.  
  611. ; Indirect jump to (hl)
  612. ihl:    jp    (hl)
  613.  
  614. ; Get directory entry for slot bc
  615. ; Return pointer to entry in hl or nz if no more entries
  616. getdir:    ld    hl,(drm)    ; last directory entry
  617.     or    a
  618.     sbc    hl,bc
  619.     ret    c        ; past end of directory
  620.     push    de
  621.     ld    h,b
  622.     ld    l,c
  623.     srl    h
  624.     rr    l
  625.     srl    h
  626.     rr    l        ; required sector number
  627.     ld    (sector),hl
  628.     ld    hl,(heap)    ; how many sectors are cached?
  629.     ld    de,(mark)
  630.     xor    a
  631.     sbc    hl,de        ; bytes on heap
  632.     sla    l
  633.     rl    h
  634.     rla
  635.     ld    e,h
  636.     ld    d,a        ; divide by 128
  637.     ld    hl,(sector)
  638.     sbc    hl,de
  639.     jr    nc,getd1    ; must read if not (yet) on heap
  640.     ld    hl,(sector)
  641.     xor    a
  642.     srl    h
  643.     rr    l
  644.     ld    h,l
  645.     rra
  646.     ld    l,a        ; multiply by 128
  647.     ld    de,(mark)
  648.     add    hl,de
  649.     jr    getd4
  650. getd1:    ld    hl,(heap)
  651.     ld    de,80h
  652.     add    hl,de
  653.     ex    de,hl
  654.     ld    hl,(6)
  655.     or    a
  656.     sbc    hl,de        ; enough space on heap?
  657.     jr    nc,getd2
  658.     ld    hl,buff        ; use temp buffer
  659.     jr    getd3
  660. getd2:    ld    de,80h
  661.     call    getheap
  662. getd3:    ld    a,c        ; is it first slot in sector?
  663.     and    3
  664.     jr    nz,getd4
  665.     push    hl
  666.     ex    de,hl
  667.     call    getsec        ; read sector
  668.     pop    hl
  669.     jr    z,getd4
  670.     call    print
  671.     db    'Can''t read directory',cr,lf,0
  672.     rst    0
  673. getd4:    ld    a,c
  674.     and    3        ; which slot?
  675.     rrca
  676.     rrca
  677.     rrca
  678.     add    l
  679.     ld    l,a
  680.     ld    a,0
  681.     adc    h
  682.     ld    h,a        ; point to directory entry
  683.     inc    hl
  684.     ld    a,(hl)        ; 1st byte of filename
  685.     dec    hl
  686.     pop    de
  687.     cp    0e5h        ; ever used?
  688.     jr    z,getd5
  689.     xor    a
  690.     ret
  691. getd5:    or    a
  692.     ret
  693.  
  694. ; Check if directory entry matches afn pattern
  695. match:    push    hl
  696.     push    de
  697.     push    bc
  698.     ld    b,16        ; length to compare
  699.     ld    a,(hl)
  700.     cp    0e5h        ; erased?
  701.     jr    nz,match1
  702.     or    a
  703.     jr    match3        ; reject it
  704. match1:    ld    a,(de)
  705.     cp    '?'        ; wild card?
  706.     jr    z,match2
  707.     ld    c,a
  708.     ld    a,(hl)
  709.     and    7fh        ; mask off attributes
  710.     cp    c
  711.     jr    nz,match3
  712. match2:    inc    hl
  713.     inc    de
  714.     djnz    match1
  715. match3:    pop    bc
  716.     pop    de
  717.     pop    hl
  718.     ret
  719.  
  720. ; Fix group position by setting up a 1-1 mapping
  721. ; group number is in de
  722. fixgrp:    push    hl
  723.     ld    h,d
  724.     ld    l,e
  725.     call    makent        ; make 1-1 entry
  726.     pop    hl
  727.     ret
  728.  
  729. ; Allocate the next free group to the one in de
  730. nxtgrp:    push    hl
  731.     push    bc
  732.     call    getnew        ; has it already been given a position?
  733.     inc    hl
  734.     ld    a,h
  735.     or    l
  736.     jr    nz,ngrpe
  737.     push    de
  738. ngrp2:    ld    de,(group)    ; where to start looking for a space
  739. ngrp3:    ld    hl,(dsm)
  740.     or    a
  741.     sbc    hl,de        ; end of disk?
  742.     jr    nz,ngrp4
  743.     call    print
  744.     db    'Disk overflow (can''t happen!)',cr,lf,0
  745.     rst    0
  746. ngrp4:    inc    de
  747.     call    chkfre
  748.     jr    nz,ngrp3
  749.     ex    de,hl
  750.     ld    (group),hl    ; remember where we got to
  751.     pop    de
  752.     call    makent        ; make table entry to move de -> hl
  753. ngrpe:    pop    bc        ; group already dealt with
  754.     pop    hl
  755.     ret
  756.  
  757. ; Make an entry in the group table
  758. ; de is current group number, hl is desired group number
  759. makent:    push    af
  760.     push    de
  761.     push    hl
  762.     call    getadr        ; desired group as index
  763.     ld    (hl),e
  764.     inc    hl
  765.     ld    (hl),d        ; assign current group
  766.     ex    de,hl
  767.     call    getadr        ; current group as index
  768.     inc    hl
  769.     inc    hl
  770.     pop    de
  771.     ld    (hl),e
  772.     inc    hl
  773.     ld    (hl),d        ; assign desired group
  774.     ex    de,hl
  775.     pop    de
  776.     pop    af
  777.     ret
  778.  
  779. ; Get disk groups into the required order
  780. sort:    ld    hl,-1
  781.     ld    (group),hl    ; scan from start of disk
  782.     xor    a
  783.     ld    (grpsel),a    ; initialise selector switch
  784.     ld    (dirwr),a    ; not writing directory yet
  785. sort1:    call    ctrlc?        ; check for user interrupt
  786.     jp    z,abort
  787.     ld    hl,(group)
  788.     inc    hl        ; next group
  789.     ld    (group),hl
  790.     ex    de,hl
  791.     ld    hl,(dsm)
  792.     or    a
  793.     sbc    hl,de        ; end of disk?
  794.     ret    c
  795.     call    getold        ; what should go here?
  796.     inc    hl
  797.     ld    a,h
  798.     or    l        ; free?
  799.     ret    z        ; done if so
  800.     dec    hl
  801.     ex    de,hl
  802.     push    hl
  803.     sbc    hl,de        ; here already?
  804.     pop    hl
  805.     jr    z,sort1
  806.     call    getgrp        ; get it into memory
  807.     jp    nz,abort
  808. sort2:    call    flip        ; swap buffers
  809.     ex    de,hl
  810.     call    getnew        ; where should present contents go?
  811.     inc    hl
  812.     ld    a,h
  813.     or    l
  814.     dec    hl
  815.     push    af
  816.     jr    z,sort3        ; not needed?
  817.     pop    af
  818.     ex    de,hl
  819.     push    hl
  820.     call    getold
  821.     or    a
  822.     sbc    hl,de
  823.     pop    hl
  824.     ex    de,hl
  825.     push    af
  826.     call    nz,getgrp    ; read if not already there
  827. sort3:    call    z,putgrp    ; put if no read error
  828.     push    af        ; save error flags
  829.     push    hl
  830.     ld    h,d
  831.     ld    l,e
  832.     call    getadr
  833.     ld    (hl),e        ; adjust table to reflect disk contents
  834.     inc    hl
  835.     ld    (hl),d
  836.     pop    hl
  837.     pop    af
  838.     jp    nz,abort    ; read/write error?
  839.     pop    af
  840.     jr    z,sort1        ; end of chain?
  841.     jr    sort2
  842.  
  843. ; Make directory correspond to new order of groups on disk
  844. fixdir:    xor    a
  845.     ld    (grpsel),a    ; initialise selector
  846.     ld    a,(dirflg)    ; be pessimistic on dir writes?
  847.     or    a
  848.     ld    a,1
  849.     jr    z,fixd0
  850.     inc    a
  851. fixd0:    ld    (dirwr),a
  852.     ld    bc,(drm)    ; directory size
  853.     ld    de,-1        ; group number
  854. fixd1:    ld    a,b
  855.     or    c
  856.     ret    z        ; finished?
  857.     inc    de        ; next dir group
  858.     call    getgrp
  859.     push    bc
  860.     ld    a,(blshf)    ; block shift factor
  861.     ld    b,a
  862.     ld    a,4
  863. fixd2:    add    a,a        ; calculate entries per group
  864.     djnz    fixd2
  865.     pop    bc
  866.     push    af
  867.     ld    hl,(grp1)    ; data location
  868. fixd3:    call    fixent        ; fix entry
  869.     jr    z,fixd4        ; finished?
  870.     pop    af
  871.     dec    a
  872.     push    af
  873.     jr    nz,fixd3
  874. fixd4:    pop    af
  875.     call    flip
  876.     call    putgrp        ; write back
  877.     call    flip
  878.     jr    fixd1
  879.  
  880. ; Fix a directory entry
  881. fixent:    ld    a,b
  882.     or    c
  883.     ret    z        ; any more?
  884.     inc    hl
  885.     ld    a,(hl)
  886.     dec    hl
  887.     cp    0e5h        ; top of used area?
  888.     jr    nz,fixe0
  889.     ld    bc,0
  890.     ret
  891. fixe0:    dec    bc
  892.     ld    a,(hl)
  893.     push    bc
  894.     push    de
  895.     ld    b,16        ; size of map
  896.     ld    de,16
  897.     add    hl,de        ; point to group map
  898.     cp    0e5h        ; erased entry?
  899.     jr    nz,fixe1
  900.     add    hl,de        ; skip it
  901.     jr    fixe4
  902. fixe1:    ld    d,0
  903.     ld    e,(hl)
  904.     ld    a,(dsm+1)    ; 2 byte numbers?
  905.     or    a
  906.     jr    z,fixe2
  907.     inc    hl
  908.     ld    d,(hl)
  909.     dec    hl
  910. fixe2:    push    hl
  911.     call    getnew        ; where is group now?
  912.     ex    de,hl
  913.     pop    hl
  914.     ld    (hl),e
  915.     inc    hl
  916.     ld    a,(dsm+1)
  917.     or    a
  918.     jr    z,fixe3
  919.     ld    (hl),d
  920.     inc    hl
  921.     dec    b
  922. fixe3:    djnz    fixe1
  923. fixe4:    pop    de
  924.     pop    bc
  925.     or    1
  926.     ret
  927.  
  928. ; Use hl as index into group table
  929. getadr:    add    hl,hl
  930.     add    hl,hl
  931.     push    de
  932.     ld    de,(grptab)
  933.     add    hl,de
  934.     pop    de
  935.     ret
  936.  
  937. ; Check if entry for group in de is free
  938. ; Z - yes, NZ - no
  939. chkfre:    push    hl
  940.     call    getold
  941.     inc    hl
  942.     ld    a,h
  943.     or    l
  944.     pop    hl
  945.     ret
  946.  
  947. ; Translate old (de) group number to new (hl)
  948. getold:    push    de
  949.     ex    de,hl
  950.     call    getadr
  951.     ld    e,(hl)
  952.     inc    hl
  953.     ld    d,(hl)
  954.     ex    de,hl
  955.     pop    de
  956.     ret
  957.  
  958. ; Translate new (de) group number to old (hl)
  959. getnew:    push    de
  960.     ex    de,hl
  961.     call    getadr
  962.     inc    hl
  963.     inc    hl
  964.     ld    e,(hl)
  965.     inc    hl
  966.     ld    d,(hl)
  967.     ex    de,hl
  968.     pop    de
  969.     ret
  970.  
  971. ; Flip group buffers
  972. flip:    push    af
  973.     push    hl
  974.     ld    hl,grpsel
  975.     ld    a,1        ; flip buffers
  976.     xor    (hl)
  977.     ld    (hl),a
  978.     pop    hl
  979.     pop    af
  980.     ret
  981.  
  982. ; Get group de
  983. getgrp:    push    hl
  984.     push    de
  985.     push    bc
  986.     ld    hl,(rdcnt)
  987.     inc    hl        ; increment counter
  988.     ld    (rdcnt),hl
  989.     ld    hl,(grp1)
  990.     ld    a,(grpsel)    ; which buffer?
  991.     or    a
  992.     jr    z,ggrp1
  993.     ld    hl,(grp2)
  994. ggrp1:    ld    a,(stats)    ; statistics only?
  995.     or    a
  996.     jr    nz,ggrp4
  997.     ex    de,hl
  998.     ld    a,(blshf)    ; block shift factor
  999.     ld    b,a
  1000. ggrp2:    add    hl,hl        ; convert group to sector number
  1001.     djnz    ggrp2
  1002.     ld    (sector),hl
  1003.     ld    a,(blmsk)    ; block mask
  1004.     inc    a        ; number of sectors in group
  1005.     ld    b,a
  1006. ggrp3:    call    getsec
  1007.     jr    nz,ggrp5    ; error?
  1008.     ld    hl,128
  1009.     add    hl,de
  1010.     ex    de,hl
  1011.     djnz    ggrp3
  1012. ggrp4:    xor    a
  1013. ggrp5:    pop    bc
  1014.     pop    de
  1015.     pop    hl
  1016.     ret
  1017.  
  1018. ; Put group de
  1019. putgrp:    push    hl
  1020.     push    de
  1021.     push    bc
  1022.     ld    hl,(wrcnt)
  1023.     inc    hl        ; increment counter
  1024.     ld    (wrcnt),hl
  1025.     ld    hl,(grp1)
  1026.     ld    a,(grpsel)    ; which buffer?
  1027.     or    a
  1028.     jr    nz,pgrp1
  1029.     ld    hl,(grp2)
  1030. pgrp1:    ld    a,(stats)    ; statistics only?
  1031.     or    a
  1032.     jr    nz,pgrp4
  1033.     ex    de,hl
  1034.     ld    a,(blshf)    ; block shift factor
  1035.     ld    b,a
  1036. pgrp2:    add    hl,hl        ; convert group to sector number
  1037.     djnz    pgrp2
  1038.     ld    c,2        ; write unallocated data
  1039.     ld    (sector),hl
  1040.     ld    a,(blmsk)    ; block mask
  1041.     inc    a        ; number of sectors in group
  1042.     ld    b,a
  1043. pgrp3:    ld    a,(dirwr)
  1044.     cp    2        ; pessimistic about dir writes?
  1045.     jr    nz,pgrp30
  1046.     ld    c,1
  1047. pgrp30:    call    putsec
  1048.     jr    nz,pgrp5    ; error?
  1049.     ld    c,0        ; normal writes for rest of group
  1050.     ld    a,(dirwr)    ; writing to directory?
  1051.     or    a
  1052.     jr    z,pgrp3a
  1053.     ld    a,b
  1054.     cp    2        ; last sector of directory group?
  1055.     jr    nz,pgrp3a
  1056.     ld    c,1        ; signal directory write
  1057. pgrp3a:    ld    hl,128
  1058.     add    hl,de
  1059.     ex    de,hl
  1060.     djnz    pgrp3
  1061. pgrp4:    xor    a
  1062. pgrp5:    pop    bc
  1063.     pop    de
  1064.     pop    hl
  1065.     ret
  1066.  
  1067. ; Read sector
  1068. getsec:    push    bc
  1069.     push    de
  1070.     push    hl
  1071.     ld    a,2
  1072.     ld    (curop),a
  1073.     call    setsec
  1074.     ld    a,13
  1075.     call    bios
  1076.     or    a
  1077.     pop    hl
  1078.     pop    de
  1079.     pop    bc
  1080.     ret
  1081.  
  1082. ; Write sector
  1083. putsec:    push    bc
  1084.     push    de
  1085.     push    hl
  1086.     ld    a,3
  1087.     ld    (curop),a
  1088.     call    setsec
  1089.     ld    a,14
  1090.     call    bios
  1091.     pop    hl
  1092.     pop    de
  1093.     pop    bc
  1094.     or    a
  1095.     ret
  1096.  
  1097. ; Prepare for sector read/write.  Data address is in de.
  1098. setsec:    push    hl
  1099.     push    de
  1100.     push    bc
  1101.     push    af
  1102.     ld    b,d
  1103.     ld    c,e
  1104.     ld    a,12        ; set dma address
  1105.     call    bios
  1106.     ld    hl,(sector)    ; required sector
  1107.     ld    de,(spt)    ; sectors per track
  1108.     call    divhd        ; get relative track in hl
  1109.     push    hl
  1110.     ld    de,(toff)    ; track offset
  1111.     add    hl,de        ; absolute track in hl
  1112.     ld    b,h
  1113.     ld    c,l
  1114.     ld    a,10        ; set track
  1115.     call    bios
  1116.     pop    hl
  1117.     ld    de,(spt)
  1118.     call    mulhd        ; sector at start of this track
  1119.     ex    de,hl
  1120.     ld    hl,(sector)
  1121.     inc    hl        ; increment for next time
  1122.     ld    (sector),hl
  1123.     dec    hl
  1124.     or    a
  1125.     sbc    hl,de        ; relative sector on track
  1126.     ld    b,h
  1127.     ld    c,l
  1128.     ld    de,(sectab)
  1129.     ld    a,d
  1130.     or    e        ; table defined?
  1131.     jr    z,ssec1
  1132.     ld    a,16        ; translate logical to physical sector
  1133.     call    bios
  1134.     ld    b,h
  1135.     ld    c,l
  1136. ssec1:    ld    a,11        ; set sector
  1137.     call    bios
  1138.     pop    af
  1139.     pop    bc
  1140.     pop    de
  1141.     pop    hl
  1142.     ret
  1143.  
  1144. ; Prematurely terminate disk sort
  1145. abort:    ld    a,(curop)    ; reason for abort
  1146.     ld    (whyab),a
  1147.     ld    hl,(sector)    ; sector if it was read/write
  1148.     dec    hl        ; correct for pre-increment
  1149.     ld    (badsec),hl
  1150.     ld    a,(stats)
  1151.     or    a
  1152.     jr    nz,ab0
  1153.     call    fixtab        ; make table reflect where we reached
  1154.     call    fixdir        ; update directory
  1155.     call    resdrv        ; reset drive
  1156. ab0:    call    pname
  1157.     ld    a,(whyab)
  1158.     dec    a        ; console interrupt?
  1159.     jr    nz,ab1
  1160.     call    print
  1161.     db    ' interrupted by user',cr,lf,0
  1162.     rst    0
  1163. ab1:    dec    a        ; sector read?
  1164.     jr    nz,ab2
  1165.     call    print
  1166.     db    ' read',0
  1167.     jr    ab3
  1168. ab2:    call    print        ; must be write
  1169.     db    ' write',0
  1170. ab3:    call    print
  1171.     db    ' error at group ',0
  1172.     ld    hl,(badsec)
  1173.     ld    a,(blshf)
  1174. ab4:    srl    h        ; convert sector to group
  1175.     rr    l
  1176.     dec    a
  1177.     jr    nz,ab4
  1178.     call    phl4hc        ; display group
  1179.     ld    a,':'
  1180.     call    cout
  1181.     ld    a,(badsec)
  1182.     ld    b,a
  1183.     ld    a,(blmsk)
  1184.     and    b
  1185.     call    pa2hc        ; and sector within group
  1186.     call    crlf
  1187.     rst    0
  1188.  
  1189. ; Restore consistancy  between two halves of group table
  1190. fixtab:    ld    de,0        ; first group
  1191. fixt1:    ld    hl,(dsm)
  1192.     or    a
  1193.     sbc    hl,de        ; finished?
  1194.     ret    c
  1195.     call    getold        ; what were we going to move here?
  1196.     push    hl
  1197.     or    a
  1198.     sbc    hl,de
  1199.     pop    hl
  1200.     inc    de
  1201.     jr    z,fixt1        ; no action if 1-1 or already moved
  1202.     push    de
  1203.     ld    d,h
  1204.     ld    e,l
  1205.     call    getadr        ; table address of group which
  1206.     inc    hl        ;  not been moved
  1207.     inc    hl
  1208.     ld    (hl),e        ; it is still where it started
  1209.     inc    hl
  1210.     ld    (hl),d
  1211.     pop    de
  1212.     jr    fixt1
  1213.  
  1214. ; Expand heap and check for overflow
  1215. ; entry: de is number of bytes needed
  1216. ; exit: hl is old top of heap (start of new space)
  1217. getheap: ld    hl,(heap)
  1218.     push    hl
  1219.     push    de
  1220.     add    hl,de
  1221.     ld    (heap),hl
  1222.     ex    de,hl
  1223.     ld    hl,(6)
  1224.     or    a
  1225.     sbc    hl,de
  1226.     pop    de
  1227.     pop    hl
  1228.     ret    nc
  1229.     call    print
  1230.     db    'Out of memory',cr,lf,0
  1231.     rst    0
  1232.  
  1233. ; Process options
  1234. options: xor    a
  1235.     ld    (stats),a    ; clear statistics option
  1236.     ld    (verbose),a    ;  and verbose flag
  1237.     call    retud        ; get default disk
  1238.     ld    (user),bc
  1239.     ld    a,(fcb1)    ; input file on default disk?
  1240.     or    a
  1241.     jr    z,opt1
  1242.     dec    a
  1243.     ld    b,a        ; default to specified disk
  1244. opt1:    ld    a,b
  1245.     ld    (disk),a    ; default disk
  1246.     ld    hl,fcb2+1    ; point to option string
  1247. opt2:    ld    a,(hl)
  1248.     inc    hl
  1249.     cp    ' '+1        ; any left?
  1250.     ret    c
  1251.     cp    'S'
  1252.     jr    z,opts
  1253.     cp    'V'
  1254.     jr    z,optv
  1255.     cp    'D'
  1256.     jr    z,optd
  1257.     cp    '/'        ; ignore /
  1258.     jr    z,opt2
  1259. opterr:    call    print
  1260.     db    'Option not recognized: ',0
  1261. opter1:    call    cout
  1262.     call    crlf
  1263.     rst    0
  1264. opts:    ld    a,1
  1265.     ld    (stats),a
  1266.     jr    opt2
  1267. optv:    ld    a,1
  1268.     ld    (verbose),a
  1269.     jr    opt2
  1270. optd:    call    getmdisk    ; what is max available disk?
  1271.     ld    b,a
  1272.     ld    a,(hl)        ; get disk
  1273.     inc    hl
  1274.     cp    ' '        ; specified?
  1275.     jr    z,optdn
  1276.     sub    'A'
  1277.     jr    c,optde        ; in range ?
  1278.     cp    b
  1279.     jr    nc,optde
  1280.     ld    (disk),a
  1281.     jr    opt2
  1282. optde:    call    print
  1283.     db    'No such disk: ',0
  1284.     add    a,'A'
  1285.     jr    opter1
  1286. optdn:    call    print
  1287.     db    'Disk specification missing',cr,lf,0
  1288.     rst    0
  1289.  
  1290. ; quit if errors have occurred
  1291. quitif:    ld    hl,(errors)
  1292.     ld    a,h
  1293.     or    l        ; any errors?
  1294.     ret    z
  1295.     rst    0
  1296.  
  1297. ; Get vector bit corresponding to disk into de
  1298. getbit:    ld    de,1
  1299.     ld    a,(disk)
  1300. gbit1:    or    a
  1301.     ret    z
  1302.     dec    a
  1303.     ex    de,hl
  1304.     add    hl,hl
  1305.     ex    de,hl
  1306.     jr    gbit1
  1307.  
  1308. ; Is disk set to read only?
  1309. chkro:    ld    c,29        ; get r/o vector
  1310.     call    bdos
  1311.     call    getbit        ; get our disk's vector bit
  1312.     ld    a,d
  1313.     and    h        ; are we r/o?
  1314.     jr    nz,isro
  1315.     ld    a,e
  1316.     and    l
  1317.     ret    z
  1318. isro:    call    pname
  1319.     call    print
  1320.     db    ': Disk ',0
  1321.     ld    a,(disk)
  1322.     add    'A'
  1323.     call    cout
  1324.     call    print
  1325.     db    ' is set read only',cr,lf,0
  1326.     rst    0        ; abort
  1327.  
  1328. ; Reset the drive we just packed
  1329. resdrv:    call    getbit
  1330.     ld    c,37        ; reset drive
  1331.     jp    bdos
  1332.  
  1333. ; Check for ^C at console
  1334. ctrlc?:    xor    a
  1335.     call    condin
  1336.     cp    3
  1337.     ret    nz
  1338.     ld    a,1
  1339.     ld    (curop),a
  1340.     ret
  1341.  
  1342. ; Show lists
  1343. showlist:
  1344.     call    print
  1345.     db    cr,lf,'Fixed filespecs:',cr,lf,0
  1346.     ld    hl,(fixpnt)
  1347.     ld    bc,(fixcnt)
  1348.     call    showl
  1349.     call    print
  1350.     db    cr,lf,'Mobile filespecs:',cr,lf,0
  1351.     ld    hl,(mobpnt)
  1352.     ld    bc,(mobcnt)
  1353.     call    showl
  1354.     jp    crlf
  1355.  
  1356. showl:    ld    a,b
  1357.     or    c
  1358.     ret    z
  1359.     push    bc
  1360.     ld    b,0
  1361.     ld    a,(hl)        ; user number
  1362.     inc    hl
  1363.     cp    '?'
  1364.     jr    nz,showl1
  1365.     call    cout
  1366.     jr    showl4
  1367. showl1:    cp    10
  1368.     jr    c,showl2
  1369.     inc    b
  1370.     sub    10
  1371.     jr    showl1
  1372. showl2:    push    af
  1373.     ld    a,b
  1374.     add    '0'
  1375.     cp    '0'
  1376.     jr    nz,showl3
  1377.     ld    a,' '
  1378. showl3:    call    cout
  1379.     pop    af
  1380.     add    '0'
  1381. showl4:    call    cout
  1382.     ld    a,':'
  1383.     call    cout
  1384.     ld    b,15
  1385. showl5:    ld    a,(hl)
  1386.     inc    hl
  1387.     call    cout
  1388.     djnz    showl5
  1389.     call    crlf
  1390.     pop    bc
  1391.     dec    bc
  1392.     jr    showl
  1393.  
  1394. ; Show group number table
  1395. showtab: call    getcrt
  1396.     ld    a,(hl)        ; crt width
  1397.     and    0f0h
  1398.     rept    4
  1399.     rrca            ; divide by 16
  1400.     endm
  1401.     ld    c,a        ; groups per line
  1402.     inc    hl
  1403.     inc    hl
  1404.     ld    b,(hl)        ; text lines per screen
  1405.     push    bc
  1406.     ld    de,0        ; start at the beginning
  1407. showt1:    call    getold        ; get entry
  1408.     inc    hl
  1409.     ld    a,h
  1410.     or    l        ; free?
  1411.     jr    z,showt4
  1412.     dec    hl
  1413.     push    hl
  1414.     or    a
  1415.     sbc    hl,de        ; 1 to 1?
  1416.     pop    hl
  1417.     jr    z,showt4
  1418.     call    phl4hc
  1419.     call    print
  1420.     db    ' --> ',0
  1421.     ex    de,hl
  1422.     call    phl4hc
  1423.     ex    de,hl
  1424.     dec    c
  1425.     jr    z,showt2
  1426.     ld    a,' '
  1427.     call    cout
  1428.     call    cout
  1429.     call    cout
  1430.     jr    showt4
  1431. showt2:    call    crlf
  1432.     dec    b
  1433.     jr    nz,showt3
  1434.     push    hl
  1435.     call    print
  1436.     db    '[pause]',0
  1437.     call    cin
  1438.     cp    3
  1439.     jp    z,quit
  1440.     call    print
  1441.     db    cr,'       ',cr,0
  1442.     pop    hl
  1443.     pop    bc
  1444.     push    bc
  1445.     jr    showt4
  1446. showt3:    ld    a,b
  1447.     pop    bc
  1448.     push    bc
  1449.     ld    b,a
  1450. showt4:    ld    hl,(dsm)
  1451.     or    a
  1452.     sbc    hl,de
  1453.     inc    de
  1454.     jr    nz,showt1
  1455.     ld    a,c
  1456.     pop    bc
  1457.     cp    c
  1458.     ret    z
  1459.     call    crlf
  1460.     ret
  1461.  
  1462. ; Display help info
  1463. help:    call    crlf
  1464.     call    pname        ; print program name
  1465.     call    print
  1466.     db    ' v',[version/10]+'0','.',[version mod 10]+'0'
  1467.     db    '    --    Sort and pack disk allocation groups',cr,lf,lf,0
  1468.     call    pname
  1469.     call    print
  1470.     db    ' <list> <s>',cr,lf,lf
  1471.     db    '<list> is a file specifying fixed files and the desired ',cr,lf
  1472.     db    'order of mobile files.  If the option S is given, ',cr,lf
  1473.     db    'statistics on the state of disorder of the disk are ',cr,lf
  1474.     db    'produced, but no groups are moved.',cr,lf,0
  1475.     ret
  1476.  
  1477. ; Display program name from efcb
  1478. pname:    push    af
  1479.     push    hl
  1480.     call    getefcb
  1481.     jr    z,pname3    ; no efcb (not expected)
  1482.     ld    b,8        ; max length
  1483. pname1:    inc    hl
  1484.     ld    a,(hl)
  1485.     cp    ' '
  1486.     jr    z,pname2
  1487.     call    cout
  1488.     djnz    pname1
  1489. pname2:    pop    hl
  1490.     pop    af
  1491.     ret
  1492. pname3:    call    print
  1493.     db    'PACK',0    ; default name
  1494.     jr    pname2
  1495.     
  1496. fixstr:    db    'FIXED'
  1497. mobstr:    db    'MOBILE'
  1498. wild:    db    '*:*.*'
  1499.  
  1500. proc    ds    2        ; routine to do for each group
  1501. errors:    ds    2        ; error count while analysing file list
  1502. dnbuf:    ds    9        ; space for dn spec
  1503. user:    ds    1        ; default user number
  1504. disk:    ds    1        ; disk to be packed
  1505. group:    ds    2        ; last group to be allocated
  1506. sectab:    ds    2        ; pointer to sector translation table
  1507.  
  1508. dpb:    equ    $        ; disk parameters
  1509. spt:    ds    2        ; sectors per track
  1510. blshf:    ds    1        ; block shift factor
  1511. blmsk:    ds    1        ; block mask
  1512. exmsk:    ds    1        ; extent mask
  1513. dsm:    ds    2        ; disk size
  1514. drm:    ds    2        ; directory size
  1515. alloc:    ds    2        ; initial allocation
  1516. chks:    ds    2        ; checked directory sectors
  1517. toff:    ds    2        ; track offset
  1518.  
  1519. inline:    ds    2        ; input line address
  1520. linnum:    ds    2        ; line number in input file
  1521. bufcnt:    ds    1        ; bytes left in input buffer
  1522. stats:    ds    1        ; just display statistics if <> 0
  1523. verbose: ds    1        ; display debugging info
  1524. fixmob:    ds    1        ; fixed files if <> 0
  1525. fixcnt:    ds    2        ; fixed file count
  1526. fixpnt:    ds    2        ; base of fixed file list
  1527. mobcnt:    ds    2        ; mobile file count
  1528. mobpnt:    ds    2        ; base of mobile file list
  1529. grptab:    ds    2        ; base of group table
  1530. sector:    ds    2        ; relative sector number for getsec/putsec
  1531. dirwr:    ds    1        ; directory write flag
  1532. grp1:    ds    2        ; group buffer 1 address
  1533. grp2:    ds    2        ; group buffer 2 address
  1534. grpsel:    ds    1        ; =0 : get to 1, put from 2
  1535.                 ; <>0: get to 2, put from 1
  1536. rdcnt:    ds    2        ; groups read
  1537. wrcnt:    ds    2        ; groups written
  1538. curop:    ds    1        ; current operation in case of abort
  1539. whyab:    ds    1        ; reason for abort
  1540.                 ;  1 - ^C
  1541.                 ;  2 - sector read error
  1542.                 ;  3 - sector write error
  1543. badsec:    ds    1        ; sector in error
  1544.  
  1545. mark:    ds    2        ; heap mark
  1546. heap:    ds    2        ; top of heap
  1547. $memry:    ds    2        ; end of program address (supplied by linker)
  1548.  
  1549.     end
  1550. or
  1551.  
  1552. mark:    ds    2        ; heap mark
  1553. heap:    ds    2        ; top of heap
  1554. $memry:    ds    2        ; end of pro