Oakland CPM Archive/oakcpm.iso/sigm/vol090/ssort.mac

Text File | 1984-04-29 | 13.3 KB | 563 lines

;
; SYSLIB Module Name:  SSORT
; Author:  Richard Conn
; SYSLIB Version Number:  2.0
; Module Version Number:  1.0
; Module Entry Points:
;    SSBINI        SORT
; Module External References:
;    MOVEB        PRINT
;
;*
;*  EXTERNALS
;*
    EXT    MOVEB
    EXT    PRINT

;*
;*  BASIC EQUATES
;*
CPM    EQU    0    ; CP/M WARM BOOT
BIOS    EQU    CPM+1    ; BIOS BASE ADDRESS
BDOS    EQU    CPM+5    ; BDOS ENTRY POINT
ESIZE    EQU    16    ; NUMBER OF BYTES/ENTRY IN MEMORY BUFFER
BUFF    EQU    CPM+80H    ; DEFAULT DMA BUFFER

;*
;*  SSBINI -- Initialize SSB
;*    This routine sets the value of FIRSTP and ORDER for the SORT
;* routine.  On Entry, HL pts to first available byte after user's
;* program (beginning of buffer area) and DE pts to an SSB.  On exit,
;* HL pts to first available byte for the user's in-memory data file
;* (same address as FIRSTP).  If the TPA is overflowed by the ORDER
;* table that would be generated by SORT, then the Z flag is returned set
;* (Z); if no error, NZ is returned.
;*    If the user has already loaded his data and just wants to
;* allocate an ORDER table, then he should have HL before calling SSBINI,
;* restore HL upon return from SSBINI, and then store HL into his FIRSTP
;* entry before calling SORT.
;*
SSBINI::
    PUSH    D    ; SAVE REGS
    PUSH    B
    PUSH    H    ; SAVE NEXT AVAILABLE BYTE ADDRESS
    XCHG        ; MAKE HL PT TO USER'S SSB
    SHLD    USRSSB    ; SAVE PTR TO USER'S SSB
    LXI    D,SSB    ; COPY INTO MY SSB
    MVI    B,12    ; 12 BYTES
    CALL    MOVEB
    POP    H    ; GET NEXT AVAILABLE BYTE ADDRESS
    SHLD    ORDER    ; SET PTR TO IT
    LHLD    RECNT    ; GET NUMBER OF RECORDS
    MOV    A,L    ; DOUBLE IT WITH ERROR CHECKING
    ADD    L
    MOV    L,A
    MOV    A,H
    ADC    H
    MOV    H,A
    JC    SSBOVFL    ; OVERFLOW IF CARRY
    XCHG        ; SIZE OF ORDER TABLE IN DE
    LHLD    ORDER    ; BASE ADDRESS OF ORDER TABLE IN HL
    MOV    A,L    ; ADD HL TO DE WITH ERROR CHECKING
    ADD    E
    MOV    L,A
    MOV    A,H
    ADC    D
    MOV    H,A    ; HL IS NOW ADDRESS OF BYTE AFTER ORDER TABLE
    JC    SSBOVFL    ; OVERFLOW IF CARRY
    SHLD    FIRSTP    ; SET PTR TO NEXT AVAILABLE BYTE
    LHLD    USRSSB    ; PT TO USER'S SSB
    XCHG        ; ... IN DE
    LXI    H,SSB    ; PT TO USER'S NEW SSB
    MVI    B,12    ; COPY IT BACK
    CALL    MOVEB
    POP    B    ; RESTORE REGS
    POP    D
    LHLD    FIRSTP    ; PT TO NEXT AVAILABLE MEMORY ADDRESS
    MVI    A,0FFH    ; SET NO ERROR CODE
    ORA    A
    RET
SSBOVFL:
    POP    B    ; RESTORE REGS
    POP    D
    LHLD    ORDER    ; RESTORE PTR TO USER'S BUFFER
    XRA    A    ; ERROR CODE
    RET
USRSSB:
    DS    2    ; BUFFER FOR ADDRESS OF USER'S SSB

;*
;*  SORT -- Sort memory-resident file of fixed-length records in an order
;*    specified by the user;  On entry, DE pts to a SORT Specification
;*    Block (SSB) which contains the following information:
;*
;*        Bytes 0&1:  Starting Address of File (1st byte of 1st record)
;*        Bytes 2&3:  Number of Records in the File
;*        Bytes 4&5:  Size of Each Record (in Bytes)
;*        Bytes 6&7:  Address of a Compare Routine Provided by the User
;*                This routine compares two records, one pted
;*                to by HL and the other pted to by DE; if the
;*                record pted to by DE is less in sorting order
;*                than that pted to by HL, this routine returns
;*                with Carry Set (C); if the records are equal
;*                in sorting order, this routine returns with
;*                Zero Set (Z); no registers asside from the PSW
;*                are to be affected by this routine
;*        Bytes 8&9:  Address of ORDER Buffer (RECNT*2 in size)
;*        Byte 10:  Flag; 0 means to use pointers, 0FFH means to not
;*                use pointers
;*        Byte 11:  Unused
;*
;*    SORT does not have any net affect on any registers
;*

;
;  SORT SPECIFICATION BLOCK (SSB) FOR USE BY SORT ROUTINE
;
SSB:
FIRSTP:
    DS    2    ; POINTER TO FIRST RECORD IN FILE
RECNT:
    DS    2    ; NUMBER OF RECORDS IN FILE
RECSIZ:
    DS    2    ; SIZE OF EACH RECORD
CMPADR:
    DS    2    ; ADDRESS OF COMPARE ROUTINE
ORDER:
    DS    2    ; ADDRESS OF ORDER TABLE
SFLAG:
    DS    1    ; USE POINTERS? 0=NO
    DS    1    ; UNUSED, BUT RESERVED, AT THIS TIME

;
;  SORT AND POINTER BUFFERS
;
N:
    DS    2    ; NUMBER OF RECS
GAP:
    DS    2    ; VARIABLE GAP
J:
    DS    2    ; REC PTR 1
JG:
    DS    2    ; REC PTR 2
PTPTR:
    DS    2    ; 2-LEVEL INDIRECT PTR
PTFIL:
    DS    2    ; REC PTR

;*
;*  START OF SORT ROUTINE
;*
SORT::
    PUSH    H    ; SAVE REGS
    PUSH    D
    PUSH    B
    PUSH    PSW
    XCHG        ; PTR IN HL
    LXI    D,SSB    ; COPY HIS SORT BLOCK INTO MINE FOR EASIER ACCESS
    MVI    B,12    ; 12 BYTES LONG
    CALL    MOVEB
    LHLD    RECNT    ; GET RECORD COUNT
    SHLD    N    ; SET "N"
    MOV    B,H    ; ... IN BC
    MOV    C,L

;*
;*  CHECK FOR TRIVIAL CASE - 0 OR 1; DON'T DO IT IF SO
;*
    MOV    A,B    ; SEE IF BC=1
    ORA    A    ; B=0?
    JNZ    SHELL    ; DO SORT IF B<>0
    MOV    A,C    ; C=0 OR 1?
    CPI    2
    JC    SEXIT

;*
;*  SHELL SORT --
;*    THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS"
;*    BY KERNIGAN AND PLAUGHER, PAGE 106.  COPYRIGHT, 1976, ADDISON-WESLEY.
;*  ON ENTRY, BC=NUMBER OF ENTRIES
;*
SHELL:
    LDA    SFLAG    ; USE POINTERS?
    ORA    A    ; 0=NO
    JZ    SORT2
    LHLD    FIRSTP    ; PT TO FIRST RECORD
    XCHG        ; POINTER TO 1ST RECORD IN DE
    LHLD    ORDER    ; PT TO ORDER TABLE
;*
;*  SET UP ORDER TABLE; HL PTS TO NEXT ENTRY IN ORDER TABLE, DE PTS TO NEXT
;*    REC IN FILE, BC = NUMBER OF RECS REMAINING
;*
SORT1:
    MOV    A,B    ; DONE?
    ORA    C    ; 0 IF SO
    JZ    SORT2
    DCX    B    ; COUNT DOWN
    MOV    M,E    ; STORE LOW-ORDER ADDRESS
    INX    H    ; PT TO NEXT ORDER BYTE
    MOV    M,D    ; STORE HIGH-ORDER ADDRESS
    INX    H    ; PT TO NEXT ORDER ENTRY
    PUSH    H    ; SAVE PTR
    LHLD    RECSIZ    ; HL=NUMBER OF BYTES/ENTRY
    DAD    D    ; PT TO NEXT DIR1 ENTRY
    XCHG        ; DE PTS TO NEXT ENTRY
    POP    H    ; GET PTR TO ORDER TABLE
    JMP    SORT1
;*
;*  THIS IS THE MAIN SORT LOOP FOR THE SHELL SORT IN "SOFTWARE TOOLS" BY K&P
;*
SORT2:
    LHLD    N    ; NUMBER OF ITEMS TO SORT
    SHLD    GAP    ; SET INITIAL GAP TO N FOR FIRST DIVISION BY 2

;*  FOR (GAP = N/2; GAP > 0; GAP = GAP/2)
SRTL0:
    ORA    A    ; CLEAR CARRY
    LHLD    GAP    ; GET PREVIOUS GAP
    MOV    A,H    ; ROTATE RIGHT TO DIVIDE BY 2
    RAR
    MOV    H,A
    MOV    A,L
    RAR
    MOV    L,A

;*  TEST FOR ZERO
    ORA    H
    JZ    SDONE    ; DONE WITH SORT IF GAP = 0

    SHLD    GAP    ; SET VALUE OF GAP
    SHLD    I    ; SET I=GAP FOR FOLLOWING LOOP

;*  FOR (I = GAP + 1; I <= N; I = I + 1)
SRTL1:
    LHLD    I    ; ADD 1 TO I
    INX    H
    SHLD    I

;*  TEST FOR I <= N
    XCHG        ; I IS IN DE
    LHLD    N    ; GET N
    MOV    A,L    ; COMPARE BY SUBTRACTION
    SUB    E
    MOV    A,H
    SBB    D    ; CARRY SET MEANS I > N
    JC    SRTL0    ; DON'T DO FOR LOOP IF I > N

    LHLD    I    ; SET J = I INITIALLY FOR FIRST SUBTRACTION OF GAP
    SHLD    J

;*  FOR (J = I - GAP; J > 0; J = J - GAP)
SRTL2:
    LHLD    GAP    ; GET GAP
    XCHG        ; ... IN DE
    LHLD    J    ; GET J
    MOV    A,L    ; COMPUTE J - GAP
    SUB    E
    MOV    L,A
    MOV    A,H
    SBB    D
    MOV    H,A
    SHLD    J    ; J = J - GAP
    JC    SRTL1    ; IF CARRY FROM SUBTRACTIONS, J < 0 AND ABORT
    MOV    A,H    ; J=0?
    ORA    L
    JZ    SRTL1    ; IF ZERO, J=0 AND ABORT

;*  SET JG = J + GAP
    XCHG        ; J IN DE
    LHLD    GAP    ; GET GAP
    DAD    D    ; J + GAP
    SHLD    JG    ; JG = J + GAP

;*  IF (V(J) <= V(JG))
    CALL    ICOMPARE    ; J IN DE, JG IN HL

;*  ... THEN BREAK
    JC    SRTL1

;*  ... ELSE EXCHANGE
    LHLD    J    ; SWAP J, JG
    XCHG
    LHLD    JG
    CALL    ISWAP    ; J IN DE, JG IN HL

;*  END OF INNER-MOST FOR LOOP
    JMP    SRTL2

;*
;*  SORT IS DONE -- RESTRUCTURE FILE IN SORTED ORDER IN PLACE
;*
SDONE:
    LDA    SFLAG    ; USE POINTERS?
    ORA    A    ; 0=NO
    JZ    SEXIT    ; DONE IF NO POINTERS
    LHLD    RECNT    ; NUMBER OF RECORDS
    SHLD    J    ; SAVE COUNT IN J
    LHLD    ORDER    ; PTR TO ORDERED POINTER TABLE
    SHLD    PTPTR    ; SET PTR PTR
    LHLD    FIRSTP    ; PTR TO UNORDERED FILE
    SHLD    PTFIL    ; SET PTR TO FILE BUFFER

;*  FIND PTR TO NEXT FILE ENTRY
SRTDN:
    LHLD    J    ; GET ENTRY COUNT
    MOV    B,H    ; ... IN BC
    MOV    C,L
    LHLD    PTPTR    ; PT TO REMAINING POINTERS
    XCHG        ; ... IN DE
    LHLD    PTFIL    ; HL PTS TO NEXT FILE ENTRY

;*  FIND PTR TABLE ENTRY
SRTDN1:
    LDAX    D    ; GET CURRENT POINTER TABLE ENTRY VALUE
    INX    D    ; PT TO HIGH-ORDER POINTER BYTE
    CMP    L    ; COMPARE AGAINST FILE ADDRESS LOW
    JNZ    SRTDN2    ; NOT FOUND YET
    LDAX    D    ; LOW-ORDER BYTES MATCH -- GET HIGH-ORDER POINTER BYTE
    CMP    H    ; COMPARE AGAINST FILE ADDRESS HIGH
    JZ    SRTDN3    ; MATCH FOUND
SRTDN2:
    INX    D    ; PT TO NEXT PTR TABLE ENTRY
    DCX    B    ; COUNT DOWN
    MOV    A,C    ; END OF TABLE?
    ORA    B
    JNZ    SRTDN1    ; CONTINUE IF NOT

;*  FATAL ERROR -- INTERNAL ERROR; POINTER TABLE NOT CONSISTENT
FERR$PTR:
    CALL    PRINT
    DB    0DH,0AH,'SORT Pointer Error',0
    JMP    CPM

;*  FOUND THE POINTER TABLE ENTRY WHICH POINTS TO THE NEXT UNORDERED FILE ENTRY
;*    MAKE BOTH POINTERS (PTR TO NEXT, PTR TO CURRENT UNORDERED FILE ENTRY)
;*    POINT TO SAME LOCATION (PTR TO NEXT FILE ENTRY TO BE ORDERED)
SRTDN3:
    LHLD    PTPTR    ; GET PTR TO NEXT ORDERED ENTRY
    DCX    D    ; DE PTS TO LOW-ORDER POINTER ADDRESS
    MOV    A,M    ; MAKE PTR TO NEXT UNORDERED REC PT TO BUFFER FOR
    STAX    D    ;   FILE REC TO BE MOVED TO NEXT UNORDERED FILE POS
    INX    H    ; PT TO NEXT PTR ADDRESS
    INX    D
    MOV    A,M    ; MAKE HIGH POINT SIMILARLY
    STAX    D

;*  INTERCHANGE NEXT ENTRY IN LINE WITH THE ENTRY CURRENTLY IN ITS POSITION
    LHLD    RECSIZ    ; HL=NUMBER OF BYTES/ENTRY
    MOV    B,H    ; BC=NUMBER OF BYTES/ENTRY
    MOV    C,L
    LHLD    PTFIL    ; PT TO ENTRY
    XCHG

;*  COPY TO-BE-ORDERED FILE ENTRY TO NEXT ORDERED FILE POSITION
    LHLD    PTPTR    ; POINT TO ITS POINTER
    MOV    A,M    ; GET LOW-ADDRESS POINTER
    INX    H
    MOV    H,M    ; GET HIGH-ADDRESS POINTER
    MOV    L,A    ; HL IS ADDRESS OF UNORDERED ENTRY
    XCHG        ; HL PTS TO ORDERED ENTRY TO BE MOVED, DE PTS TO REPL
SRTDN4:
    PUSH    B    ; SAVE COUNT
    LDAX    D    ; GET BYTES
    MOV    C,M
    XCHG        ; EXCHANGE PTRS
    STAX    D    ; PUT BYTE
    MOV    M,C
    XCHG        ; RESTORE PTRS TO ORIGINAL
    POP    B    ; GET COUNT
    INX    H    ; PT TO NEXT
    INX    D
    DCX    B    ; COUNT DOWN
    MOV    A,B    ; DONE?
    ORA    C
    JNZ    SRTDN4

;*  POINT TO NEXT TARGET RECORD POSITION
    LHLD    RECSIZ    ; GET SIZE OF RECORD
    XCHG        ; ... IN DE
    LHLD    PTFIL    ; PT TO ENTRY JUST PLACED
    DAD    D    ; PT TO NEXT ENTRY
    SHLD    PTFIL    ; SET POINTER FOR NEXT LOOP

;*  POINT TO NEXT ENTRY IN POINTER TABLE
    LHLD    PTPTR    ; POINTER TO CURRENT REC
    INX    H    ; PT TO NEXT REC
    INX    H
    SHLD    PTPTR

;*  COUNT DOWN
    LHLD    J    ; GET COUNT
    DCX    H    ; COUNT DOWN
    SHLD    J    ; PUT COUNT
    MOV    A,H    ; DONE?
    ORA    L
    JNZ    SRTDN

;*  EXIT
SEXIT:
    POP    PSW    ; RESTORE REGS
    POP    B
    POP    D
    POP    H
    RET        ; DONE

;*
;*  ISWAP -- Perform exchange of elements whose indices are in HL and DE
;*
ISWAP:
    LDA    SFLAG    ; USE POINTERS?
    ORA    A    ; 0=NO
    JNZ    SWAP    ; DO POINTER SWAP
    CALL    ADRCOMP    ; COMPUTE ADDRESS OF RECORDS FROM THEIR INDICES
    PUSH    H    ; SAVE HL PTR
    LHLD    RECSIZ    ; SIZE OF RECORD
    MOV    B,H    ; ... IN BC
    MOV    C,L
    POP    H    ; GET HL PTR
SWAPC:
    PUSH    B    ; SAVE COUNT
    LDAX    D    ; GET BYTES
    MOV    C,M
    MOV    M,A    ; PUT BYTES
    MOV    A,C
    STAX    D    ; PUT BYTES
    INX    H    ; PT TO NEXT
    INX    D
    POP    B    ; GET COUNT
    DCX    B    ; COUNT DOWN
    MOV    A,B    ; DONE?
    ORA    C
    JNZ    SWAPC
    RET

;*
;*  GIVEN INDICES IN HL AND DE, RETURN ADDRESSES OF RECORDS PTED TO BY
;*    THESE INDICES IN HL AND DE, RESP
;*
ADRCOMP:
    PUSH    H    ; SAVE HL RECORD
    CALL    ADROFF    ; COMPUTE OFFSET TO RECORD PTED TO BY DE
    SHLD    REC1    ; SAVE ADDRESS OF RECORD
    POP    D    ; GET OLD HL INDEX
    CALL    ADROFF    ; COMPUTE OFFSET TO THE DESIRED RECORD
    XCHG        ; ADDRESS IN DE
    LHLD    REC1    ; GET ADDRESS
    XCHG        ; ORIGINAL ORDER
    RET
REC1:
    DS    2    ; TEMP STORAGE FOR SWAPC

ADROFF:
    LHLD    RECSIZ    ; SIZE OF RECORD
    MOV    B,H    ; ... IN BC
    MOV    C,L
    LXI    H,0    ; OFFSET IN HL
ADRO1:
    DCX    D    ; DECREMENT BY 1 SO BASE-RELATIVE
    MOV    A,D    ; DONE WITH LOOP?
    ORA    E
    JZ    ADRO2
    DAD    B    ; ADD IN RECORD SIZE
    JMP    ADRO1
ADRO2:
    XCHG        ; OFFSET IN DE
    LHLD    FIRSTP    ; PT TO FIRST ENTRY
    DAD    D    ; ADD IN OFFSET
    RET

;*
;*  SWAP (Exchange) the pointers in the ORDER table whose indexes are in
;*    HL and DE
;*
SWAP:
    PUSH    H        ; SAVE HL
    LHLD    ORDER        ; ADDRESS OF ORDER TABLE
    MOV    B,H        ; ... IN BC
    MOV    C,L
    POP    H
    DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
    DAD    H        ; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
                ;   OF ORIGINAL HL (0, 2, 4, ...)
    DAD    B        ; HL NOW PTS TO POINTER INVOLVED
    XCHG            ; DE NOW PTS TO POINTER INDEXED BY HL
    DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
    DAD    H        ; HL PTS TO OFFSET ADDRESS INDICATED BY INDEX
                ;   OF ORIGINAL DE (0, 2, 4, ...)
    DAD    B        ; HL NOW PTS TO POINTER INVOLVED
    MOV    C,M        ; EXCHANGE POINTERS -- GET OLD (DE)
    LDAX    D        ; -- GET OLD (HL)
    XCHG            ; SWITCH
    MOV    M,C        ; PUT NEW (HL)
    STAX    D        ; PUT NEW (DE)
    INX    H        ; PT TO NEXT BYTE OF POINTER
    INX    D
    MOV    C,M        ; GET OLD (HL)
    LDAX    D        ; GET OLD (DE)
    XCHG            ; SWITCH
    MOV    M,C        ; PUT NEW (DE)
    STAX    D        ; PUT NEW (HL)
    RET

;*
;*  ICOMPARE - Compares entries whose indices are in HL and DE; on exit,
;*    Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE))
;*
ICOMPARE:
    LDA    SFLAG    ; USE POINTERS?
    ORA    A    ; 0=NO
    JNZ    COMPARE
    CALL    ADRCOMP    ; COMPUTE ADDRESSES
    JMP    CALLCMP    ; CALL COMPARE ROUTINE OF USER

;*
;*  COMPARE compares the entry pointed to by the pointer pointed to by HL
;*    with that pointed to by DE (1st level indirect addressing); on entry,
;*    HL and DE contain the numbers of the elements to compare (1, 2, ...);
;*    on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)),
;*    and Non-Zero and No-Carry means ((DE)) > ((HL))
;*
COMPARE:
    PUSH    H        ; SAVE HL
    LHLD    ORDER        ; ADDRESS OF ORDER
    MOV    B,H        ; ... IN BC
    MOV    C,L
    POP    H
    DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
    DAD    H        ; DOUBLE THE ELEMENT NUMBER TO POINT TO THE PTR
    DAD    B        ; ADD TO THIS THE BASE ADDRESS OF THE PTR TABLE
    XCHG            ; RESULT IN DE
    DCX    H        ; ADJUST INDEX TO 0...N-1 FROM 1...N
    DAD    H        ; DO THE SAME WITH THE ORIGINAL DE
    DAD    B
    XCHG

;*
;*  HL NOW POINTS TO THE POINTER WHOSE INDEX WAS IN HL TO BEGIN WITH
;*  DE NOW POINTS TO THE POINTER WHOSE INDEX WAS IN DE TO BEGIN WITH
;*    FOR EXAMPLE, IF DE=5 AND HL=4, DE NOW POINTS TO THE 5TH PTR AND HL
;* TO THE 4TH POINTER
;*
    MOV    C,M        ; BC IS MADE TO POINT TO THE OBJECT INDEXED TO
    INX    H        ; ... BY THE ORIGINAL HL
    MOV    B,M
    XCHG
    MOV    E,M        ; DE IS MADE TO POINT TO THE OBJECT INDEXED TO
    INX    H        ; ... BY THE ORIGINAL DE
    MOV    D,M
    MOV    H,B        ; SET HL = OBJECT PTED TO INDIRECTLY BY BC
    MOV    L,C

;*
;*  COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE;
;*    NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE<HL
;*    RET W/ZERO SET MEANS DE=HL
;*
CALLCMP:
    PUSH    H    ; SAVE HL ON STACK
    LHLD    CMPADR    ; GET ADDRESS OF COMPARE ROUTINE IN HL
    XTHL        ; ADDRESS OF COMPARE ROUTINE ON STACK AND RESTORE HL
    RET        ; "CALL" ROUTINE AND RETURN TO SORT CORRECTLY

    END