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 õ