0100 ;MACHINE LANGUAGE SORTS, PART 1
0110 ;BY KEVIN PECK
0120 ;(c)1987, ANTIC PUBLISHING
0130 FLAST = $00 ;End, outer loop
0140 FLENKEY = $CB ;Key length
0150 RLEN = $CC ;Record Length
0160 OFFSETKEY = $CF ;Key offset
0170 FIRST = $CD ;1st element ptr
0180 SECOND = $D4 ;2nd element ptr
0190 LAST = $D6 ;End, inner loop
0200 FENDKEY = $D8 ;End, key field
0210 ORDER = $E1 ;Order, sort 0,1
0220 FLENSEC = $D0 ;2nd field lngth
0230 OFFSETSEC = $E0 ;2nd " " offset
0240 FENDSEC = $D1 ;End 2nd field
0250 ;
0260 *= $4000
0270 ;
0280 CLD
0290 PLA
0300 ; Retrieve arguments from BASIC
0310 PLA
0320 STA FIRST+1
0330 PLA
0340 STA FIRST
0350 PLA
0360 STA LAST+1
0370 PLA
0380 STA LAST
0390 PLA
0400 PLA
0410 STA FLENKEY
0420 PLA
0430 PLA
0440 STA OFFSETKEY
0450 CLC ;Find end of
0460 ADC FLENKEY ;First key
0470 STA FENDKEY
0480 PLA
0490 PLA
0500 STA FLENSEC
0510 PLA
0520 PLA
0530 STA OFFSETSEC
0540 CLC
0550 ADC FLENSEC ;Find end of
0560 STA FENDSEC ;second key
0570 PLA
0580 PLA
0590 STA RLEN
0600 PLA
0610 PLA
0620 STA ORDER
0630 ;
0640 ; All parms. now in zero page.
0650 ; Next, set pointer to the end
0660 ; of the outer loop
0670 LDA LAST+1
0680 STA FLAST+1
0690 SEC
0700 LDA LAST
0710 SBC RLEN
0720 STA FLAST
0730 BCS SETSECOND
0740 ;
0750 DEC FLAST+1
0760 ; Start of outer loop.
0770 ; Adjust the second pointer to
0780 ; point to the first pointer
0790 ; plus the record length.
0800 ;
0810 SETSECOND
0820 CLC
0830 LDA FIRST+1
0840 STA SECOND+1
0850 LDA FIRST
0860 ADC RLEN
0870 STA SECOND
0880 BCC SORTKEY
0890 INC SECOND+1
0900 ; Start of the inner loop.
0910 ; 1. Compare the Key field of
0920 ; the two sort elements.
0930 ; 2. If we find a mismatch,
0940 ; do we need to swap them?
0950 SORTKEY
0960 LDY OFFSETKEY
0970 ;
0980 KEYLOOP
0990 ;
1000 LDA (FIRST),Y ;get a byte
1010 CMP (SECOND),Y ;of each.
1020 BEQ CHKMORE ;If = Continue.
1030 ;
1040 BCC NOSWAP ;If F<S no swap.
1050 ;
1060 BCS SWAP ;If F>S swap.
1070 ;
1080 CHKMORE
1090 ;
1100 INY ;Adjust pointer
1110 CPY FENDKEY ;All done?
1120 BNE KEYLOOP ;No. Continue.
1130 ;
1140 ; At this point, all bytes in
1150 ; the key field of both sort
1160 ; elements are equal. Drop to
1170 ; SORTSECOND and check the
1180 ; secondary fields.
1190 ; If their lengths = 0, then
1200 ; we don't have 2ndry fields.
1210 ; We are only doing a one-field
1220 ; sort--goto the Noswap routine.
1230 ; If the key fields are equal,
1240 ; there is no need to swap them.
1250 ;
1260 SORTSEC
1270 LDA FLENSEC ;A second field?
1280 BEQ NOSWAPBD ;No.
1290 ;
1300 LDY OFFSETSEC
1310 SECLOOP
1320 LDA (FIRST),Y ;Compare byte
1330 CMP (SECOND),Y ;by byte...
1340 BEQ CHKMORE2 ;If = do more.
1350 ;
1360 BCC NOSWAP ;If F<S Noswap.
1370 ;
1380 BCS SWAP ;If F>s Swap.
1390 ;
1400 CHKMORE2
1410 INY ;Point to next.
1420 CPY FENDSEC ;End of 2nd?
1430 BNE SECLOOP ;No, do more.
1440 ;
1450 ; Now, both the key and the
1460 ; secondary fields of both sort
1470 ; elemtents are equal. Goto
1480 ; the noswap routine through the
1490 ; "back door." No need to check
1500 ; the order, no need to swap.
1510 BEQ NOSWAPBD
1520 ;
1530 ; This is where the swapping
1540 ; occurs. First, check the
1550 ; swapping order.
1560 ; (Assume swapping in ascending
1570 ; order.) If order<>0, then
1580 ; sort in descending order.
1590 ;
1600 SWAP
1610 ;
1620 LDA ORDER ;Get order
1630 BNE NOSWAPBD ;Not 0, No swap
1640 ;
1650 ; Swap routine's back door.
1660 ; If NOSWAP decides we need to
1670 ; swap by checking the order,
1680 ; we need to come here (instead
1690 ; of SWAP) or we would go into
1700 ; a continuous loop.
1710 ;
1720 SWAPBD
1730 LDY #0
1740 SWAPLOOP
1750 LDA (FIRST),Y ;Key byte
1760 PHA ; to stack.
1770 LDA (SECOND),Y ; 2ndry byte
1780 STA (FIRST),Y ; to key.
1790 PLA ;Key from stack
1800 STA (SECOND),Y ;to 2ndry.
1810 INY ;Next byte.
1820 CPY RLEN ; More?
1830 BNE SWAPLOOP ;Yes. Continue.
1840 ;
1850 ; All bytes have been swapped.
1860 ; Now adjust pointers to the
1870 ; next elements for the sort.
1880 ; Goto the noswap back door.
1890 ;
1900 BEQ NOSWAPBD
1910 ;
1920 NOSWAP
1930 ;
1940 LDA ORDER ;Is ORDER=1?
1950 BNE SWAPBD ;Yes. Swap them
1960 ;
1970 NOSWAPBD
1980 CLC
1990 LDA SECOND
2000 ADC RLEN
2010 STA SECOND
2020 LDA SECOND+1
2030 ADC #0
2040 STA SECOND+1
2050 CMP LAST+1
2060 BNE SORTKEY
2070 ;
2080 LDA SECOND
2090 CMP LAST
2100 BNE SORTKEY
2110 ;
2120 ; We've made one pass through
2130 ; the sort's inner loop. Now,
2140 ; adjust the outer loop and
2150 ; check if we're done with it.
2160 ; If not, readjust the inner
2170 ; loop pointer to the outer loop
2180 ; pointer + the record length.
2190 ;
2200 CLC
2210 LDA FIRST
2220 ADC RLEN
2230 STA FIRST
2240 LDA FIRST+1
2250 ADC #0
2260 STA FIRST+1
2270 CMP FLAST+1
2280 BNE SETSECOND
2290 ;
2300 LDA FIRST
2310 CMP FLAST
2320 BNE SETSECOND
2330 ;
2340 RTS ;Goto BASIC
2350 .END
PROGRAM LISTING: 88-04/MULTISOR.M65