CP/M/CPM_CDROM.iso/lambda/soundpot/p/sap50.lbr/SAP45.AZM/SAP45.ASM

Assembly Source File | 1993-10-25 | 19.8 KB | 1,009 lines

; SAP v45 -- Sort & Pack Directory 06/28/86
;
    ASEG        ; Needed for M80, ignore error if using MAC
;
; THIS PROGRAM READS THE DISK DIRECTORY TRACKS, SORTS THEM ALPHABETICALLY
; THEN REPLACES THEM ON THE DISK.  ALL UNUSED OR ERASED AREAS ON THE DI-
; RECTORY TRACK ARE REFORMATTED WITH CONTINUOUS 'E5' CHARACTERS.  (THIS
; ERASES PREVIOUS FILE NAMES WHICH HAVE BEEN DEACTIVATED.)  SORTING THE
; DIRECTORY IN THIS MANNER OFFERS MANY ADVANTAGES.  SOME OF THEM ARE:
;
;    1)  ALLOWS 'DIR' TO SHOW AN ALPHABETIZED LISTING
;    2)  ELIMINATES POTENTIAL PROBLEMS WITH "UNERASE" PROGRAMS
;    3)  SPEEDS UP ACCESS VIA 'SD' AND OTHER SPECIAL PROGRAMS
;    4)  ASSISTS ON WORKING DIRECTLY ON THE DISK WITH 'DU', ETC.
;    5)  REMOVES FILES FROM THE DISK SOMEBODY ELSE COULD RECOVER
;    6)  OPTIONALLY ERASES ALL FILES OF ZERO LENGTH (EXCEPT THOSE
;        STARTING WITH '-' FOR CATALOG USE WITH MAST.CAT)
;
;                - Notes by Irv Hoff W6FFC
;
;=======================================================================
;
NO    EQU    0
YES    EQU    NOT NO
;
;=======================================================================
;
; User-customizable options:
;
ONLY22    EQU    YES        ; Set this to YES if SAP will be running ONLY
                ; Under CP/M v2.2.  If not sure, set to NO.

ONLY14    EQU    NO        ; Set this to YES if SAP will be running ONLY
                ; Under CP/M v1.4.  If not sure, set to NO.

CPMONLY    EQU    YES        ; Set this to YES if SAP will be running ONLY
                ; Under CP/M, either v1.4 or 2.2   If possi-
                ; Bility exists that SAP might be executed
                ; Under MP/M or CP/M+, set to NO.

DELZRO    EQU    YES        ; Set this to YES to cause SAP to delete all
                ; Zero-length files if SAVDASH is NO, or to delete
                ; All zero-length files not beginning with "-" if
                ; SAVDASH is YES.

SAVDASH    EQU    NO        ; Set this to YES and DELZRO to YES to cause SAP to
                ; Delete all zero-length files not beginning with
                ; "-" (as in SAP40).  Set this to NO to not check
                ; Filenames before deleting zero-length files (if
                ; DELZRO is set YES).

USE8080    EQU    NO        ; Set this to yes to be 8080 compatible and foolish.

USEZ80    EQU    YES        ; Set this to yes to be efficient with Z80 op codes.
;
;        End of user-selected options
;=======================================================================

;
; Various system equates
;
UNSPECI    EQU    NOT (ONLY22 OR ONLY14)

     IF    ONLY22 AND ONLY14
    ERROR    'you must set either only22 or only14 to yes, not both'
     ENDIF

     IF    USE8080    AND USEZ80
    ERROR    'you can not pick both use8080 and useZ80'
     ENDIF

     IF    NOT (USE8080 OR    USEZ80)
    ERROR    'you must pick either use8080 or useZ80'
     ENDIF

BYEBYE    EQU    0000H        ; BDOS warm boot vector
BDOS    EQU    0005H
PRINT    EQU    9        ; BDOS print string function
GETDSK    EQU    25        ; BDOS "get disk #" function
SELDRV    EQU    14        ; BDOS select drive function
VERNO    EQU    12        ; BDOS CP/M version number function

VCTRLEN    EQU    53        ; Length of BIOS jump vectors
DPBLEN    EQU    15        ; Size of CP/M 2.2 disk parameter block
FCB    EQU    5CH        ; Addr of default CP/M file control block
ENTRYLEN EQU    32        ; Length of directory entry on disk

CR    EQU    0DH
LF    EQU    0AH
EOS    EQU    '$'        ; BDOS fcn #9, end of string marker

;
;=========================================================================
;

    ORG    100H

;
; Obtain BIOS vectors
;
    LXI    D,WBOOT        ; Destination
    LHLD    0001H        ; Source

     IF    USE8080
    MVI    B,VCTRLEN    ; Length
    CALL    MOVE
     ENDIF

     IF    USEZ80
    LXI    B,VCTRLEN
    DB    0EDH,0B0H    ; LDIR Z80 op code
     ENDIF

    LXI    SP,STACK    ; Use our own stack
    MVI    C,PRINT
    LXI    D,IDENTITY    ; Tell user who we are
    CALL    BDOS

     IF    UNSPECI
    MVI    C,VERNO        ; Check for CP/M ver 2.2
    CALL    BDOS
     ENDIF

     IF    UNSPECI    AND (NOT CPMONLY)
    DCR    H        ; H=1 for MPM
    JNZ    NOTMPM        ; Exit if MPM, we can't use it

BADOS:    MVI    C,PRINT
    LXI    D,BADOPSYS    ; Tell user can't work with MPM or CP/M 3.0
    CALL    BDOS
    JMP    BYEBYE

NOTMPM:    MOV    A,L        ; Hl = 0022h if CP/M ver 2.2
    CPI    30H        ; Check for MPM or CP/M 3.0
    JNC    BADOS        ; Exit if CP/M 3.0, we can't use it
     ENDIF            ; Unspeci and (not cpmonly)

     IF    UNSPECI
    STA    VERFLG        ; Store the version
     ENDIF
;
;
;=======================================================================
;
;            main program routine
;
SAP:    CALL    SETUP
    CALL    RDDIR
    CALL    CLEAN
    CALL    SORT
    CALL    PACK
    CALL    WRDIR
    MVI    C,PRINT
    LXI    D,FINISHED
    CALL    BDOS
    JMP    BYEBYE
;
;
;=======================================================================
;
;               subroutines
;
; Setup for selecting drive and loading disk parameter block
;
SETUP:    LDA    FCB
    DCR    A
    JP    SETUP1        ; Exit if disk drive mentioned
    MVI    C,GETDSK    ; Otherwise get current default drive
    CALL    BDOS

SETUP1:    MOV    C,A
    CALL    SELDSK        ; Returns addr of DPH in HL for selected drive.

     IF    UNSPECI
    LDA    VERFLG        ; If CP/M 1.4
    ORA    A
    JNZ    CPM22        ; If not 1.4, then do it the 2.2 way
                ; Else must be 1.4 since not MP/M
     ENDIF
;
; CP/M 1.4 routine
;
     IF    ONLY14 OR UNSPECI
CPM14:    LHLD    BDOS+1
    MVI    L,0
    MVI    A,(JMP)
    STA    RECTRN
    PUSH    H
    LXI    D,15        ; Rectran offset from BDOS in CP/M 1.4
    DAD    D
    SHLD    RECTRN+1
    POP    H
    LXI    D,3AH        ; Offset from BDOS to 1.4 dpb
    DAD    D
    MVI    D,0        ; Note that D=0 for this whole thing
    MOV    E,M

     IF    USE8080
    XCHG
    SHLD    SPT
    XCHG
     ENDIF

     IF    USEZ80
    .Z80
    LD    (SPT),DE
    .8080
     ENDIF

    INX    H
    MOV    E,M

     IF    USE8080
    XCHG
    SHLD    DRM
    XCHG
     ENDIF

     IF    USEZ80
    .Z80
    LD    (DRM),DE
    .8080
     ENDIF

    LXI    B,5        ; Offset to systrk field
    DAD    B
    MOV    E,M
    XCHG
    SHLD    SYSTRK

    JMP    CALCSPACE    ; Determine size of directory
     ENDIF            ; ONLY14 OR UNSPECI

;
; CP/M 2.2 routine
;
     IF    ONLY22 OR UNSPECI
CPM22:    MOV    E,M
    INX    H
    MOV    D,M

     IF    USE8080
    XCHG
    SHLD    RECTBL
    XCHG
     ENDIF

     IF    USEZ80
    .Z80
    LD    (RECTBL),DE
    .8080
     ENDIF

    LXI    D,9        ; Offset to dpb within header
    DAD    D        ; Returned by seldsk in CP/M 2.2
    MOV    E,M        ; Get adrress of dpb
    INX    H
    MOV    D,M
    XCHG            ; Now HL = addr of real dpb
    MOV    E,M
    INX    H
    MOV    D,M        ; Now DE = spt

     IF    USE8080
    XCHG
    SHLD    SPT
    XCHG
     ENDIF

     IF    USEZ80
    .Z80
    LD    (SPT),DE
    .8080
     ENDIF

    LXI    D,6        ; Offset to drm within dpb
    DAD    D
    MOV    E,M
    INX    H
    MOV    D,M        ; Now DE = DRM

     IF    USE8080
    XCHG
    SHLD    DRM
    XCHG
     ENDIF

     IF    USEZ80
    .Z80
    LD    (DRM),DE
    .8080
     ENDIF

    LXI    D,5        ; Offset to SYSTRK
    DAD    D
    MOV    E,M
    INX    H
    MOV    D,M        ; Now DE = SYSTRK
    XCHG
    SHLD    SYSTRK        ; Now drop into calcspace
     ENDIF            ; ONLY22 OR UNSPECI

;
;======================================================================
;
; Determine if directory will fit in available memory.
; if not, determine how much of it will.
;
CALCSPACE:
                ; First compute amount of free space
                ;   in 128-byte records
    LHLD    BDOS+1        ; Get addr of 1st byte of BDOS
    LXI    D,BUF        ; Get addr of 1st byte of buffer

;     IF    USE8080
;    CALL    SUBDE        ; Now HL = # free bytes for buffer
;     ENDIF
;
;     IF    USEZ80
;    ORA    A        ; clear carry
;    DB    0EDH,52H    ; A SBC HL,DE Z80 opcode
;     ENDIF
;
; Since we know that buf starts on an even page boundary, E=0, so just go:
;
    MOV    A,H
    SUB    D
    MOV    H,A        ; Now HL = HL - DE,  (since E=0).

    MOV    A,L        ; Compute HL = HL/128 by . . .
    RAL            ; Carry flag = high bit of L
    MOV    A,H        ; No affect on flags
    RAL            ; Move carry flag into low bit of A
                ; Now carry flag = high bit of H
    MOV    L,A        ; No affect on flags
    MVI    A,0        ; No affect on flags
    RAL            ; Move carry flag into low bit of A
    MOV    H,A        ; Now HL = HL/128

    SHLD    NUMDIRRECS    ; Assume that we need them all until proven false

                ; Now determine how many 128-byte records the directory takes up
    LHLD    DRM        ; Get # 32-byte directory entries . . .
    INX    H        ; Relative to 1.
    SHLD    NUMFNAMES    ; Save as a more convenient count
    CALL    ROTRHL        ; Divide by 2
    CALL    ROTRHL        ; Divide by 2.    now hl = # 128-byte records needed

                ; Now see if it all fits in available memory
    XCHG            ; Now DE = needed records
    LHLD    NUMDIRRECS    ; Now HL = available space in records

     IF    USE8080
    CALL    SUBDE        ; Now HL = HL-DE
     ENDIF

     IF    USEZ80
    ORA    A        ; Clear carry
    DB    0EDH,52H    ; A SBC HL,DE Z80 opcode
     ENDIF

    JC    NOMEM        ; If need > space then process exception
    XCHG            ; Now HL = need
    SHLD    NUMDIRRECS    ; Save as number records we'll process
    RET

NOMEM:    LHLD    NUMDIRRECS    ; Recall available space (in records)
    DAD    H        ; Mult by 2.
    DAD    H        ; Now HL = available space (in directory entries)
    SHLD    NUMFNAMES    ; Save as new number of directory entries

    MVI    C,PRINT
    LXI    D,LACKMEMORY    ; Tell user we'll do as much as we can
    JMP    BDOS        ; BDOS will return for me

;
;==================================================================
;
; Entry point to routines for directory read.
;
RDDIR:    MVI    C,PRINT
    LXI    D,READING    ; Tell user we're about to read directory.
    CALL    BDOS
    XRA    A        ; Zero A to indicate directory read.
    JMP    DODIR        ; Enter main directory routines
;
; Entry point to routines for directory write.
;
WRDIR:    LDA    NOSWAP
    ORA    A        ; Is noswap = 0?
    JNZ    WRDIR1        ; If not then not previously sorted
    MVI    C,PRINT
    LXI    D,PREVIOUS    ; Tell user no swaps were needed
    CALL    BDOS

WRDIR1:    MVI    C,PRINT
    LXI    D,WRITING    ; Tell user we're now writing out the directory
    CALL    BDOS

    MVI    A,1        ; A = 1 signals writes versus reads.
                ; Fall into dodir.
;
;===================================================================
;
; This is the main read/write directory routine.
;
DODIR:    STA    WRFLAG        ; Save read/write flag
    LHLD    SYSTRK        ; Get track num of directory
    SHLD    TRACK        ; Save as current track
    MOV    B,H
    MOV    C,L
    CALL    SETTRK
    LXI    H,0
    SHLD    RECORD        ; Set current record to 0
    LHLD    NUMDIRRECS    ; Get number of 128-byte records to process
    SHLD    DIRCNT        ; Save in a loop counter
    LXI    H,BUF        ; Start at buf . . .
    SHLD    ADDR        ; For dma address

DIRLOP:    LHLD    RECORD        ; Get current record
    INX    H        ; Bump to next
    XCHG
    LHLD    SPT        ; Get num records per track

     IF    USE8080
    CALL    SUBDE        ; Now HL = HL-DE
     ENDIF

     IF    USEZ80
    XRA    A        ; Clear carry (and reg A)
    DB    0EDH,52H    ; A SBC HL,DE Z80 opcode
     ENDIF

    XCHG
    JNC    NOTROV        ; If SPT >= record then we're ok
                ; Else we drop into track bumping
;
; Track overflow, bump to next
;
    LHLD    TRACK
    INX    H
    SHLD    TRACK
    MOV    B,H
    MOV    C,L
    CALL    SETTRK
    LXI    H,1        ; Rewind record number

NOTROV:    SHLD    RECORD
    MOV    B,H
    MOV    C,L
    LHLD    RECTBL
    XCHG
    DCX    B
    CALL    RECTRN
    MOV    B,H
    MOV    C,L

     IF    UNSPECI
    LDA    VERFLG
    ORA    A
    CNZ    SETREC        ; If CP/M 2.2 then call setrec
     ENDIF

     IF    ONLY22
    CALL    SETREC
     ENDIF

    LHLD    ADDR
    MOV    B,H        ; Set up dma address
    MOV    C,L
    CALL    SETDMA
    LDA    WRFLAG        ; Time to figure out . . .
    ORA    A        ; If we are reading . . .
    JNZ    DWRT        ; Or writing
;
; read
;
    CALL    READ
    ORA    A        ; Test flags on read
    JZ    MORE        ; If z then ok, else fall through to read error
;
; Come here if we get a read error
;
    MVI    C,PRINT
    LXI    D,RDERR
    CALL    BDOS
    JMP    BYEBYE
;
; Write
;
DWRT:    MVI    C,1        ; For CP/M 2.2 deblocking bios's
    CALL    WRITE
    ORA    A        ; Test flags on write
    JZ    MORE        ; If z then ok, else fall through to write error
;
; Come here if we get a write error
;
    MVI    C,PRINT
    LXI    D,WRTERR
    CALL    BDOS
    JMP    BYEBYE

;
; Good read or write
;
MORE:    LHLD    ADDR        ; Bump DMA address for next pass
    LXI    D,80H        ; By 128 bytes = 1 record.
    DAD    D
    SHLD    ADDR
    LHLD    DIRCNT        ; Countdown entries
    DCX    H
    SHLD    DIRCNT
    MOV    A,H        ; Test for zero left
    ORA    L
    JNZ    DIRLOP        ; Loop till zero
    RET            ; And then we're done.
;
;====================================================================
;
; Clean out all of the erased file entries to all E5's.
;
CLEAN:    LXI    H,0        ; i = 0

CLNLOP:    PUSH    H        ; Save index i
    DAD    H
    DAD    H
    DAD    H
    DAD    H
    DAD    H        ; Compute HL = 32 * i
    LXI    D,BUF
    DAD    D        ; Now HL = buf + 32 * i = addr of deleted status
    MOV    A,M        ; Get user area/deleted status byte
    CPI    0E5H        ; Is this file deleted ?

     IF    DELZRO
    JZ    FILLE5        ; If marked deleted then fill it w/E5's
    LXI    B,12
    DAD    B        ; Hl = hl + 12
    MOV    A,M        ; Check extent field
    ORA    A
    JNZ    CLBUMP        ; Skip if not extent 0
    INX    H        ; Point to record count field
    INX    H
    MOV    A,M        ; Get s2 byte (extended rc)
    ANI    0FH        ; For CP/M 2.2, 0 for CP/M 1.4
    MOV    B,A
    INX    H
    MOV    A,M        ; Check record count field
    ORA    B
    JNZ    CLBUMP        ; Jump if non-zero
     ENDIF            ; Delzro

     IF    DELZRO AND SAVDASH
    LXI    B,65522        ; -14 = 65536 - 14 = 65522 in two's complement
    DAD    B        ; Now HL = addr of 1st char of file name
    MOV    A,M        ; Get first character of filename
    DCX    H        ; Point back to 1st byte of directory entry
    CPI    '-'        ; Mast.cat catalog programs have 0 length files
    JZ    CLBUMP        ; W/names that start with '-', don't delete
     ENDIF

     IF    NOT DELZRO
    JNZ    CLBUMP        ; If not a deleted file then skip it
     ENDIF

FILLE5:    MVI    B,ENTRYLEN    ; Number of bytes to clear

    MVI    A,0E5H        ; Load up char to replicate
FILLOP:    MOV    M,A        ; Make it all E5's
    INX    H

     IF    USE8080
    DCR    B
    JNZ    FILLOP
     ENDIF

     IF    USEZ80
    .Z80
    DJNZ    FILLOP
    .8080
     ENDIF

CLBUMP:    POP    D        ; Recall index i
    INX    D        ; DE = i + 1
    LHLD    NUMFNAMES    ; HL = count of filenames

     IF    USE8080
    CALL    SUBDE        ; Now hl = hl - de
     ENDIF

     IF    USEZ80
    ORA    A        ; Clear carry
    DB    0EDH,52H    ; A sbc hl,de Z80 opcode
     ENDIF

    XCHG            ; HL = i
    JNZ    CLNLOP        ; Loop till all cleaned (i.e. i = numfnames)
    RET

;
;==============================================================
;
; Sort the directory
;
SORT:    XRA    A
    STA    NOSWAP        ; Zero the flag in case already sorted
    MVI    C,PRINT
    LXI    D,SORTING
    CALL    BDOS
;
; Shell-Metzner sort
;
    LHLD    NUMFNAMES    ; Get # file names to process
    SHLD    SNUMRECW
;
; Now divide # of fields by 2
;
DIVIDE:    LHLD    SNUMRECW    ; Get value
    CALL    ROTRHL        ; Divide by 2
    SHLD    SNUMRECW    ; Save result
    MOV    A,L        ; If snumrecw = 0 . . .
    ORA    H        ; Then . . .
    RZ            ; We're done
;
; Not done yet
;
NOTDONE:
    XCHG            ; DE = snumrecw
    LHLD    NUMFNAMES    ; Get # file names to process

     IF    USE8080
    MOV    A,L        ; This is SUBDE put inline for speed
    SUB    E
    MOV    L,A
    MOV    A,H
    SBB    D
    MOV    H,A
     ENDIF

     IF    USEZ80
    ORA    A        ; Clear carry
    DB    0EDH,52H    ; A sbc hl,de Z80 opcode
     ENDIF

    SHLD    SRECLEN
    LXI    H,1
    SHLD    SSORTV1
    SHLD    SSTADR
    DCR    L        ; Now HL = 0

    XCHG            ; Now HL = old DE, DE = 0
    DAD    H        ; Now take advantage of entrylen = 32 = 2 ^ 5
    DAD    H
    DAD    H
    DAD    H
    DAD    H        ; Now HL = old DE * 32

    SHLD    SSORTV2
    XCHG
    LXI    H,BUF

NDONE2:    SHLD    SSORTV4
    SHLD    SSORTV3
    XCHG
    DAD    D
    XCHG

COMPARE:
    MVI    B,ENTRYLEN

COMPAR1:
    MOV    A,M
    ANI    7FH
    MOV    C,A        ; C = (HL) AND 7Fh
    LDAX    D
    ANI    7FH        ; A = (DE) AND 7Fh
    SUB    C        ; Form A - C == (DE) - (HL)
    JNZ    NOTEQU
    INX    H
    INX    D

     IF    USE8080
    DCR    B
    JNZ    COMPAR1
     ENDIF

     IF    USEZ80
    .Z80
    DJNZ    COMPAR1
    .8080
     ENDIF
;
; Either drop into here from compare or jump in from switch or NOTEQU
;
NOSWITCH:
    LHLD    SSTADR
    INX    H
    SHLD    SSTADR
    SHLD    SSORTV1
    XCHG
    LHLD    SRECLEN
    MOV    A,L
    SUB    E
    MOV    A,H
    SBB    D
    JC    DIVIDE
    LHLD    SSORTV4
    LXI    D,ENTRYLEN
    DAD    D
    XCHG
    LHLD    SSORTV2
    XCHG
    JMP    NDONE2

;
; The condition at NOTEQU has to be changed for descending sort.
; Note that on entry B contains the number of chars we need to move.
;
NOTEQU:    JNC    NOSWITCH    ; If (DE) > (HL) then don't switch
    MVI    A,1
    STA    NOSWAP        ; Mark that we've switched something once

SWITCH:    MOV    C,M
    LDAX    D
    MOV    M,A        ; (HL) <== (DE)
    MOV    A,C
    STAX    D        ; (HL) ==> (DE)
    INX    H        ; Bump both . . .
    INX    D        ; Pointers

     IF    USE8080
    DCR    B
    JNZ    SWITCH
     ENDIF

     IF    USEZ80
    .Z80
    DJNZ    SWITCH
    .8080
     ENDIF

     IF    USE8080
    LHLD    SNUMRECW
    MOV    A,H        ; These first few instructions . . .
    CMA
    MOV    D,A
    MOV    A,L
    CMA
    MOV    E,A        ; Just form HL = - DE - 1
    LHLD    SSORTV1
    DAD    D        ; Now HL = HL - DE - 1
     ENDIF

     IF    USEZ80
    LHLD    SNUMRECW
    XCHG            ; DE = snumrecw
    LHLD    SSORTV1
    STC            ; Set carry flag
    DB    0EDH,52H    ; An SBC HL,DE    Z80 opcode
     ENDIF

    JNC    NOSWITCH
    INX    H
    SHLD    SSORTV1
    LHLD    SSORTV3
    XCHG
    LHLD    SSORTV2
    MOV    A,E
    SUB    L
    MOV    L,A
    MOV    A,D
    SBB    H
    MOV    H,A
    SHLD    SSORTV3
    JMP    COMPARE

;
;=======================================================================
;
; Pack the directory entries.
;
PACK:    LXI    H,0        ; I = 0
    LXI    B,BUF+9        ; This is a constant taken out of the loop

PACK1:    PUSH    H        ; Save index i
    DAD    H
    DAD    H
    DAD    H
    DAD    H
    DAD    H        ; Compute HL = 32 * i
    DAD    B        ; Now HL = buf + 9 + 32 * i = addr of file type

    MOV    A,M        ; Jump if filetype not 'x??'
    SUI    '0'
    JC    PACK2
    CPI    10
    JNC    PACK2

     IF    USE8080
    STA    J        ; Save value of x
     ENDIF

     IF    USEZ80
    DB    08H        ; A Z80 opcode:  EX AF,AF'
     ENDIF

    INX    H        ; Make sure file type is .x$$
    MOV    A,M
    CPI    '$'
    JNZ    PACK2
    INX    H
    MOV    A,M
    CPI    '$'
    JNZ    PACK2

    INX    H        ; Bump to extent number field

     IF    USE8080
    LDA    J        ; Recall x
     ENDIF

     IF    USEZ80
    DB    08H        ; A Z80 opcode:  EX AF,AF'
     ENDIF

    MOV    M,A        ; Set extent number to x
    DCX    H
    DCX    H
    DCX    H        ; Point back to the x
    MVI    M,'$'        ; Make file type .$$$ once again

PACK2:    POP    D        ; Recall index i
    INX    D        ; DE = i + 1
    LHLD    NUMFNAMES    ; HL = number of file names

     IF    USE8080
    CALL    SUBDE        ; Now HL = HL-DE
     ENDIF

     IF    USEZ80
    ORA    A        ; Clear carry
    DB    0EDH,52H    ; A SBC HL,DE Z80 opcode
     ENDIF

    XCHG            ; Now HL = i
    JNZ    PACK1        ; Loop until i = # file names process
    RET

;
;====================================================================
;
; Various Quickie Routines
;
; Divide HL by 2
;
ROTRHL:    ORA    A        ; Clear carry
    MOV    A,H
    RAR
    MOV    H,A
    MOV    A,L
    RAR
    MOV    L,A
    RET

     IF    USE8080
;
; Move utility subroutine
;
MOVE:    MOV    A,M
    STAX    D
    INX    H
    INX    D
    DCR    B
    JNZ    MOVE
    RET

;
; Utility subtraction subroutine:  HL = HL-DE
;
SUBDE:    MOV    A,L
    SUB    E
    MOV    L,A
    MOV    A,H
    SBB    D
    MOV    H,A
    RET
     ENDIF            ; Use8080

;
;====================================================================
;
; Various messages
;

IDENTITY:
    DB    CR,LF,'Sort and Pack Directory V'
    DB    '45 06/28/86'
    DB    CR,LF,EOS

READING:
    DB    CR,LF,'---> Reading, ',0

SORTING:
    DB    'Sorting, ',EOS

PREVIOUS:
    DB    '(previously sorted) - ',EOS

WRITING:
    DB    'Writing, ',EOS

FINISHED:
    DB    'done'
    DB    CR,LF,EOS

RDERR:
    DB    '++ Read Error - no change made ++'
    DB    CR,LF,EOS

WRTERR:
    DB    '++ Write Error - '
    DB    'directory left in unknown condition ++'
    DB    CR,LF,EOS

     IF    UNSPECI    AND (NOT CPMONLY)
BADOPSYS:
    DB    CR,LF
    DB    '++ SAP not useable with MP/M or CP/M 3.0 ++'
    DB    CR,LF,EOS
     ENDIF            ; Unspeci and (not cpmonly)

LACKMEMORY:
    DB    '++ directory too large - '
    DB    'SAP will process as much as possible. ++'
    DB    CR,LF,EOS

;
;====================================================================
;
; Data area
;
VECTRS:    DS    VCTRLEN        ; Room for jump vectors (53 bytes)

WBOOT    EQU    VECTRS+3    ; Do not change these equates
CSTS    EQU    VECTRS+6
CI    EQU    VECTRS+9
CO    EQU    VECTRS+12
LO    EQU    VECTRS+15
PO    EQU    VECTRS+18
RI    EQU    VECTRS+21
HOME    EQU    VECTRS+24
SELDSK    EQU    VECTRS+27    ; Used
SETTRK    EQU    VECTRS+30    ; Used
SETREC    EQU    VECTRS+33    ; Used
SETDMA    EQU    VECTRS+36    ; Used
READ    EQU    VECTRS+39    ; Used
WRITE    EQU    VECTRS+42    ; Used
LSTS    EQU    VECTRS+45    ; Only in CP/M 2.2  (not used)
RECTRN    EQU    VECTRS+48    ; Only in CP/M 2.2  (used)

     IF    UNSPECI
VERFLG    EQU    VECTRS+45    ; Squeeze him in where he fits!
     ENDIF

NUMDIRRECS EQU    VECTRS+46    ; Squeeze him in where he fits!

;
; Disk parameter block variables
;
SPT    EQU    VECTRS+0
DRM    EQU    VECTRS+2
SYSTRK    EQU    VECTRS+4
RECTBL    EQU    VECTRS+6
NUMFNAMES EQU    DRM        ; This is drm+1 = # direc entries after calcspace

;
; The rest of the variables for reads/writes
;
ADDR    EQU    VECTRS+8
DIRCNT    EQU    VECTRS+10
WRFLAG    EQU    VECTRS+12
RECORD    EQU    VECTRS+13
TRACK    EQU    VECTRS+15

     IF    USE8080
J    EQU    VECTRS+17
     ENDIF

;
; The rest of the variables for sorting
;
NOSWAP    EQU    VECTRS+8
SRECLEN    EQU    VECTRS+9
SSTADR    EQU    VECTRS+11
SSORTV1    EQU    VECTRS+13
SSORTV2    EQU    VECTRS+15
SSORTV3    EQU    VECTRS+17
SSORTV4    EQU    VECTRS+19
SNUMRECW EQU    VECTRS+21

    DS    32          ; Minimum stack depth
EVEN    EQU    (($+255)/256)*256 ; Start buffer on even page, which
                  ;   also increases stack area greatly
    ORG    EVEN
STACK    EQU    $-2
BUF    EQU    $

    END