0100 ;NUMSORT.M65õ0110 ;BY KEVIN PECKõ0120 ;(c)1988, ANTIC PUBLISHINGõ0130     .OPT NO LISTõ0140 ;õ0150 ; Define zero page pointersõ0160 FLAST = $00     ;End, loop 1õ0170 FLEN =  $CB     ;Field lengthõ0180 RLEN =  $CC     ;Record lengthõ0190 FIRST = $CD     ;Pointer to 1stõ0200 ;                sort element.õ0210 OFFSET = $CF    ;Offset intoõ0220 ;                DATA string.õ0230 LENF =  $D0     ;Length of firstõ0240 ;                sort element.õ0250 LENS =  $D1     ;Length of 2ndõ0260 ;                sort element.õ0270 SECOND = $D4    ;Pointer toõ0280 ;                second element.õ0290 LAST =  $D6     ;End of DATAõ0300 ;                string pointer.õ0310 FEND =  $D8     ;End, Field ptr.õ0320 TEMP =  $E0     ;Temp storageõ0330 ;                for ORDER.õ0340 ORDER = $E1     ;Order of sort:õ0350 ;       0-ascending 1-descendingõ0360 SIGN =  $E2     ;Sign of secondõ0370 ;            element 0-POS 1-NEGõ0380     *=  $4000õ0390 ;õ0400     CLD õ0410     PLA õ0420     PLA õ0430     STA FIRST+1 ;Start of sort.õ0440     PLA õ0450     STA FIRSTõ0460     PLA õ0470     STA LAST+1  ;End of sort.õ0480     PLA õ0490     STA LASTõ0500     PLA õ0510     PLA õ0520     STA FLEN    ;Field lengthõ0530     PLA õ0540     PLA õ0550     STA OFFSET  ;Field offsetõ0560     CLC õ0570     ADC FLENõ0580     STA FENDõ0590     PLA õ0600     PLA õ0610     STA RLEN    ;Record length.õ0620     PLA õ0630     PLA õ0640     STA ORDER   ;Sort order:õ0650 ;                0-ASC 1-DECõ0660 ; Find the last position ofõ0670 ; sort string for outer loop.õ0680 ;õ0690     LDA LAST+1õ0700     STA FLAST+1õ0710     SEC õ0720     LDA LASTõ0730     SBC RLENõ0740     STA FLASTõ0750     BCS INITFIRSTõ0760 ;õ0770     DEC FLAST+1õ0780 ;õ0790 ; INITFIRST begins outer loop.õ0800 ; INITSECOND is the inner loop.õ0810 ;õ0820 INITFIRSTõ0830     LDY OFFSETõ0840     LDX #0õ0850     LDA (FIRST),Yõ0860     CMP #'-õ0870     BNE FINDFLENõ0880 ;õ0890     INX õ0900 FINDFLEN ;      Find length ofõ0910 ;              1st sort element.õ0920     LDA (FIRST),Yõ0930     CMP #'.õ0940     BEQ SAVELENFõ0950 ;õ0960     CMP #32õ0970     BEQ SAVELENFõ0980 ;õ0990     INY õ1000     CPY FENDõ1010     BNE FINDFLENõ1020 ;õ1030 SAVELENF ;      Save the length.õ1040     STY LENFõ1050 ; Set SECOND element to FIRSTõ1060 ; plus record length.õ1070 ;õ1080 SETSECONDõ1090     CLC õ1100     LDA FIRST+1õ1110     STA SECOND+1õ1120     LDA FIRSTõ1130     ADC RLENõ1140     STA SECONDõ1150     BCC INITSECONDõ1160 ;õ1170     INC SECOND+1õ1180 ; Inner loop's 1st routine,õ1190 ; Finds sign of 2nd element.õ1200 ;õ1210 INITSECONDõ1220     LDY OFFSETõ1230     LDA #0õ1240     STA SIGNõ1250     LDA (SECOND),Yõ1260     CMP #'-õ1270     BNE SETSECLENõ1280 ;õ1290     INC SIGNõ1300 SETSECLENõ1310     LDA (SECOND),Yõ1320     CMP #'.õ1330     BEQ SAVELENSõ1340 ;õ1350     CMP #32õ1360     BEQ SAVELENSõ1370 ;õ1380     INY õ1390     CPY FENDõ1400     BNE SETSECLENõ1410 ;õ1420 SAVELENSõ1430 ;õ1440     STY LENS    ;Save length ofõ1450 ;                second element.õ1460 ;õ1470 ; Examine & test sort elements.õ1480 ; Test signs, then lengths,õ1490 ; then test byte-by-byte.õ1500 ;õ1510 TESTSIGNõ1520 ;õ1530     LDA ORDERõ1540     STA TEMPõ1550     CPX SIGNõ1560     BEQ TESTLEN ;If = test signõ1570 ;õ1580     BCC CHKORDER ;If < swap chkõ1590 ;õ1600     BCS CHKTEMP ;If > noswap chkõ1610 ;õ1620 X2INITFIRSTõ1630 ;õ1640     BNE INITFIRSTõ1650 ;õ1660 TESTLENõ1670     LDA LENS    ;Compare lengthsõ1680     CMP LENFõ1690     BEQ XBYTETESTõ1700 ;õ1710     BCC SWAPõ1720 ;õ1730     BCS ADJPOINTõ1740 ;õ1750 XINITSECONDõ1760     BNE INITSECONDõ1770 ; Routines are only set forõ1780 ; positive numbers inõ1790 ; ascending order. If bothõ1800 ; numbers are negative thenõ1810 ; reverse the order.õ1820 SWAPõ1830     LDA ORDERõ1840     STA TEMPõ1850     CLC õ1860     TXA õ1870     ADC SIGNõ1880     CMP #2õ1890     BNE CHKORDERõ1900 ;õ1910 ; Both numbers are negative.õ1920 ; temporarily reverse order.õ1930 ;  Subtract current orderõ1940 ; from one to flip the order.õ1950     LDA #1õ1960     SBC ORDERõ1970     STA TEMPõ1980 ;õ1990 ; If order is 1 goto "Back Door"õ2000 ; of the adjust pointer routine.õ2010 CHKORDERõ2020     LDA TEMPõ2030     BNE ADJPOINTBDõ2040 ;õ2050 SWAPBD ;        Swap's backdoorõ2060     LDY #0õ2070 SWAPLOOPõ2080     LDA (FIRST),Yõ2090     PHA õ2100     LDA (SECOND),Yõ2110     STA (FIRST),Yõ2120     PLA õ2130     STA (SECOND),Yõ2140     INY õ2150     CPY RLENõ2160     BNE SWAPLOOPõ2170 ;õ2180     LDA LENSõ2190     STA LENFõ2200     LDX SIGNõ2210     CLC õ2220     BCC ADJPOINTBDõ2230 ;õ2240 XINITFIRSTõ2250     BNE X2INITFIRSTõ2260 ;õ2270 XSWAPõ2280     BCS SWAPõ2290 ;õ2300 XBYTETESTõ2310 ;õ2320     BEQ BYTETESTõ2330 ;õ2340 ; Due to postive-ascendingõ2350 ; nature of program we checkõ2360 ; if both are negative or ifõ2370 ; the order is descending.õ2380 ;õ2390 ADJPOINTõ2400     LDA ORDERõ2410     STA TEMPõ2420     CLC õ2430     TXA õ2440     ADC SIGNõ2450     CMP #2õ2460     BNE CHKTEMPõ2470 ;õ2480     LDA #1õ2490     SBC ORDERõ2500     STA TEMPõ2510 CHKTEMPõ2520     LDA TEMPõ2530     BNE SWAPBDõ2540 ;õ2550 ADJPOINTBD ;    The back door.õ2560     CLC õ2570     LDA SECONDõ2580     ADC RLENõ2590     STA SECONDõ2600     LDA SECOND+1õ2610     ADC #0õ2620     STA SECOND+1õ2630 ;õ2640 ; We have adjusted the 2ndõ2650 ; Decide if inner loop is doneõ2660 ; by comparing 2nd to last toõ2670 ; see if it is pointing to endõ2680 ; of data string. If not thenõ2690 ; branch to the inner loop.õ2700 ;õ2710     CMP LAST+1õ2720     BNE XINITSECONDõ2730 ;õ2740     LDA SECONDõ2750     CMP LASTõ2760     BNE XINITSECONDõ2770 ;õ2780 ; Adjust outer loop pointer,õ2790 ; check if done.  If not,õ2800 ; then go to SETSECONDõ2810 ; to reset the 2nd element toõ2820 ; point one record away from theõ2830 ; new 1st element.õ2840 ;õ2850     CLC õ2860     LDA FIRSTõ2870     ADC RLEN    ;Compare 1st &õ2880 ; 2nd on a byte-by-byte basis.õ2890 ; When we find non-equal bytes,õ2900 ; check for swap.õ2910 ;õ2920     STA FIRSTõ2930     LDA FIRST+1õ2940     ADC #0õ2950     STA FIRST+1õ2960     CMP FLAST+1õ2970     BNE XINITFIRSTõ2980 ;õ2990     LDA FIRSTõ3000     CMP FLASTõ3010     BNE XINITFIRSTõ3020 ;õ3030     RTS         ;Return to BASICõ3040 ;õ3050 ; We make it to here if theõ3060 ; signs and the lengths areõ3070 ; both equal. Now compare 1stõ3080 ; to 2nd (byte-by-byte).õ3090 ;õ3100 BYTETESTõ3110 ;õ3120     LDY OFFSETõ3130 ;õ3140 TESTLOOPõ3150     LDA (FIRST),Yõ3160     CMP (SECOND),Yõ3170     BEQ TESTMOREõ3180 ;õ3190     BCS XSWAPõ3200 ;õ3210     BCC ADJPOINTõ3220 ;õ3230 TESTMOREõ3240     INY õ3250     CPY FENDõ3260     BEQ ADJPOINTBDõ3270 ;õ3280     BNE TESTLOOPõ3290 ;õ3300     .END õ