$MACROFILE NOGEN

;     'Copyright 1981,1983 Intel Corporation'.  All rights reserved.
;      No part of this program or publication may be reproduced,
;      transmitted, transcribed, stored in a retrievel system, or
;      translated into any language or computer language, in any
;      form or by any means, electronic, mechanical, magnetic,
;      optical, chemical, manual or otherwise, without the prior
;      written permission of Intel Corporation, 3065 Bowers
;      Avenue, Santa Clara, California, 95051, Attn: Software
;      License Administration.

; SORT: PROCEDURE (PTR,COUNT,PROC$ADDR) EXTERNAL;
;   DECLARE (PTR,COUNT,PROC$ADDR) ADDRESS;
; END;
;
; SORT ACCEPTS AN ARRAY OF POINTERS AND SORTS THE POINTERS.
;   "COUNT" IS THE NUMBER OF POINTERS.
;   "PTR" IS THE LOCATION OF THE POINTERS
;   "PROC$ADDR" IS THE ADDRESS OF THE FOLLOWING PROCEDURE:
;
; GREATER$THAN: PROCEDURE (PTR1,PTR2);
;   DECLARE (PTR1,PTR2) ADDRESS;
;   ...
; END;
;
; "GREATER$THAN" ACCEPTS AS INPUT TWO POINTERS INTO THE ARRAY
;   OF POINTERS.  IT RETURNS TRUE IFF THE RECORD ASSOCIATED
;   WITH PTR1 IS GREATER THAN THE RECORD ASSOCIATED WITH PTR2.
;
; SORT SORTS THE POINTERS SO THAT THE ASSOCIATED RECORDS ARE IN
;   INCREASING ORDER.
$EJECT
        NAME SORT
        CSEG
        PUBLIC SORT

        MIDPOINT MACRO  ;; LOCATE POINTER IN THE MIDDLE OF THE ARRAY
        MOV A,L
        ADD E
        MOV C,A
        MOV A,H
        ADC D           ;; AC NOW EQUALS (HL+DE) -- NOW DIVIDE BY 2
        RAR
        MOV B,A
        MOV A,C
        RAR             ;; BA NOW EQUALS (HL+DE)/2 -- NOW INSURE THAT IT
                        ;;   HAS THE SAME PARITY AS ALL THE OTHER POINTERS
        XRA L
        ANI 0FEH
        XRA L
        MOV C,A         ;; BC IS THE ANSWER.
        ENDM

        CENTER MACRO    ;;SET HA TO (HL+BC)/2
        DAD B
        MOV A,H
        RAR
        MOV H,A
        MOV A,L
        RAR
        ENDM

        JFALSE MACRO PARAM    ;; JUMP IF BCGTDE WAS FALSE I.E. IF BC <= DE
        JNC PARAM
        ENDM

        SKIP1 MACRO        ;; SKIP NEXT 1 INSTRUCTION BYTE  -- WIPES OUT A
        DB (MVI A,0)
        ENDM

        SKIP2 MACRO        ;; SKIP NEXT 2 INSTRUCTION BYTES  -- WIPES OUT HL
        DB (LXI H,0)
        ENDM

        IFCROSS MACRO ADR  ;; JUMP TO ADR IF BC AND DE HAVE CROSSED.
        MOV A,E
        SUB C
        MOV A,D
        SBB B
        JC ADR
        ENDM
$EJECT
SORT:                 ; BC=COUNT   DE=PROC$ADDR   HL=???   S1=RET   S2=PTR
        XCHG
        SHLD PADDR    ; BC=COUNT   DE=???   HL=PROC$ADDR
        POP H
        XTHL          ; BC=COUNT   DE=???   HL=PTR
        MOV D,H
        MOV E,L       ; BC=COUNT   DE=START$PTR   HL=START$PTR
        DAD B
        DAD B
        DCX H
        DCX H
        XCHG          ; BC=COUNT   DE=END$PTR   HL=START$PTR

HDSORT:                ; INTERIOR SORT ROUTINE WHICH IS CALLED RECURSIVELY.
                      ; SORTS POINTERS AT HL THRU DE.     A,B,C IGNORED.

        MOV A,E
        SUB L
        MOV C,A
        MOV A,D
        SBB H
        RC            ; RETURN IF END$PTR < START$PTR
        ORA C
        RZ            ;   ...OR IF END$PTR = START$PTR
$EJECT
; THE TOPMOST POINTER IS GOING TO BE SWITCHED INTO ITS FINAL POSITION ON
; THE NEXT PAGE.  ON THIS PAGE, WE INCREASE THE PROBABILITY THAT THAT
; FINAL POSITION IS NEAR THE MIDDLE.  THIS SPEEDS THINGS UP.  WE DO SO
; BY LOOKING AT THE BOTTOM, MID, AND TOP POINTERS, AND SWITCHING THE
; SECOND HIGHEST OF THE THREE TO THE TOP POSITION.

                      ; POINTER ARRAY LOOKS LIKE THIS:
                      ; HL . . .    . . . DE
        PUSH H        ; S1 . . .    . . . DE
        MIDPOINT      ; S1 . . . BC . . . DE
        CALL BCGTDE
        CC SWITCH     ; GUARANTEES MID < TOP
        POP H         ; HL . . . BC . . . DE
        PUSH B        ; HL . . . S1 . . . DE
        MOV B,H
        MOV C,L       ; BC . . . S1 . . . DE
        CALL BCGTDE   ; BOTTOM > TOP?
        POP H         ; BC . . . HL . . . DE
        JC ALLSET     ; IF SO THEN TOP IS ALREADY GOOD
        XCHG          ; BC . . . DE . . . HL
        PUSH H        ; BC . . . DE . . . S1
        CALL BCGTDE
        CNC SWITCH    ; GUARANTEES TOP > BOTTOM > MID
        POP D         ; BC . . .    . . . DE
        CALL SWITCH   ; NOW BOTTOM > TOP > MID   SO TOP IS GOOD.
ALLSET:
        PUSH B
        PUSH D        ; S2=BC . . . . . . S1=DE
$EJECT
; IN THIS STAGE, SWITCHES OF POINTERS ARE MADE UNTIL THERE IS A
; SINGLE POINTER IN ITS FINAL POSITION, WITH ALL LESSER POINTERS
; TO THE LEFT AND ALL GREATER POINTERS TO THE RIGHT.

CMPF:
        CALL BCGTDE
        JFALSE CRUZF
        CALL SWITCH
CRUZB:
        DCX D
        DCX D
        IFCROSS RCURS2
CMPB:
        CALL BCGTDE
        JFALSE CRUZB
        CALL SWITCH
CRUZF:
        INX B
        INX B
        IFCROSS RCURS1

        JMP CMPF
$EJECT
; NOW WE CAN SPLIT THE SORT INTO TWO HALF SORTS AND DO THE HALF SORTS
; BY RECURSION.
; AN ADJUSTMENT OF BC OR DE MUST FIRST BE MADE, DEPENDING ON THE ENTRY POINT.

RCURS1:                  ; S2 . . . . . DE BC . . . . . S1
                         ;             GOOD
        DCX D
        DCX D
        SKIP2
RCURS2:                  ; S2 . . . . . DE BC . . . . . S1
                         ;                GOOD
        INX B
        INX B

; NOW COMPUTE WHICH HALF IS SMALLER AND DO IT FIRST.

RCURS:                   ; S2 . . . . . DE GOOD BC . . . . . S1
        MOV H,B
        MOV L,C
        POP B            ; S1 . . . . . DE      HL . . . . . BC
        XTHL             ; HL . . . . . DE      S1 . . . . . BC
        PUSH H           ; S1 . . . . . DE      S2 . . . . . BC
        CENTER
        SUB E
        MOV A,H
        SBB D
        POP H            ; HL . . . . . DE      S1 . . . . . BC
        JNC LEFT
RIGHT:
        XTHL             ; S1 . . . . . . DE   HL . . . BC
        PUSH D           ; S2 . . . . . . S1   HL . . . BC
        MOV D,B
        MOV E,C          ; S2 . . . . . . S1   HL . . . DE
        SKIP1
LEFT:
        PUSH B           ; HL . . . DE   S2 . . . . . . S1

        CALL HDSORT       ; SORT THE FIRST HALF
        POP D
        POP H            ; POP OFF THE POINTERS TO THE OTHER HALF
        JMP HDSORT        ; SORT THE OTHER HALF
$EJECT

SWITCH:           ; SWITCH WORD POINTED AT BY BC WITH WORD POINTED AT BY DE
                  ; SAVE B,C,D,E

        MOV H,B
        MOV L,C
        LDAX D
        MOV C,M
        MOV M,A
        XCHG
        MOV M,C
        INX H
        INX D
        LDAX D
        MOV C,M
        MOV M,A
        XCHG
        MOV M,C
        DCX D
        DCX H
        MOV C,L
        RET

        DSEG
BCGTDE:                  ; CALL EXTERNALLY-PASSED "BC GREATER THAN DE"
                         ; ROUTINE SO AS TO PRESERVE B,C,D,E AND RETURN
                         ; THE ANSWER IN THE CARRY FLAG (CARRY=TRUE)

        PUSH B
        PUSH D
        DB (CALL 0)
PADDR:
        DW 0
        RAR
        POP D
        POP B
        RET

        STKLN 100

$EJECT
        END