;redcode ;assert CORESIZE == 8000 ;author Kurt Franke ;name Kurt's Qsort ;strategy ;strategy Sorts enemy program -- prepare to die! ;strategy ;strategy Weaknesses : stones, imps, vampires, scanners, papers, hybrids, ;strategy things that wait for it to sort and kill itself, ;strategy and anything that happens to already be sorted. ;strategy (but other than that, it kicks butt) ;strategy ;strategy Seriously, I used a quicksort with a few modifications to optimize ;strategy for duplicate entries. The reverse ordering is handled by ;strategy inverting all the data, sorting normally, and then inverting again. ;strategy The option to allow duplicates is handled by modifying a few ;strategy instructions before sorting. The code is pretty long, but I think ;strategy it works. ;strategy a equ 4000 ;; array header location heap equ -8 ;; for debugging eqct equ -7 ;; counts calls to equal ct equ -6 ;; counter cc equ -5 ;; empty core s equ -4 ;; swap space b equ -3 ;; original bounds d equ -2 ;; clear (dat) c equ -1 ;; command z mov \$z+a, \$z+c ;; store command (z marks address 0) mov @stack, \$z+a ;; find array length size seq @z+a, \$z+d add.ab \$z+a, \$z+a div.a two, \$z+a sub.ab \$z+a, \$z+a jmn.a size, \$z+a dones mov.a \$one, \$z+a sne @z+a, \$z+d sub.b \$one, \$z+a mov \$z+a, \$z+b ;; save initial bounds mov \$z+b, @stack jmn.a descend, \$z+c ;; if dups allowed, need to modify mov \$mid, \$eq1 mov \$mid, \$eq2 ;; turn == jmps into nops mov \$mid, \$eq3 descend jmz.b qsort, \$z+c ;; check ordering neg1 mov.f \$neg, \$z+s sub.f @z+a, \$z+s mov.f \$z+s, @z+a ;; if descending, invert data djn neg1, \$z+a mov \$neg, \$z+d ;; use inverted dat as clear jmp qsort ;; wrap everything up finish jmz.b cmprs, \$z+c ;; check if data were inverted mov \$z+b, \$z+a neg2 mov.f \$neg, \$z+s ;; restore original numbers sub.f @z+a, \$z+s mov.f \$z+s, @z+a djn neg2, \$z+a cmprs jmz.a done, \$z+c ;; check if duplicates were allowed mov \$z+b, \$z+a mov \$z+b, \$mid add.f \$moffs, \$mid cmprs2 mov }mid, *z+a ;; copy, skipping empty places seq \$z+cc, *z+a nop }z+a djn.b cmprs2, \$z+a mov \$z+cc, *z+a ;; mark end of data done mov \$z+c, \$z+a ;; restore original command dat 0 ;; hasta la vista ;; pop stack and sort with those values pop sub.b \$one, \$stack ;; pop stack and check underflow sne.ab \$stack, \$stack jmp finish qsort mov @stack, \$z+a ;; get a,b indices ;; mov \$z+a, = i.b jmp f1 ;; y p.b < i.b t2 slt.b @z+a, @mid ;; test i.b < p.b jmp t3 ;; n p.b == i.b jmp part2 ;; y p.b > i.b t3 slt.a @z+a, @mid ;; test p.a > i.a jmp f1 ;; n p.a < i.a part2 sub.a \$one, \$z+a ;; find something higher f2 add.a \$one, \$z+a slt.ba \$z+a, \$z+a ;; stop when b < a jmp t15 jmp setp t15 sne *z+a, @mid eq2 jmp equal sne.f *z+a, @mid x3 jmp part3, }z+ct slt.b *z+a, @mid ;; test p.b > i.b ok jmp t4 ;; n p.b <= i.b ok jmp f2 ;; y p.b > i.b ok t4 slt.b @mid, *z+a ;; test p.b < i.b ok jmp t5 ;; n p.b == i.b ok jmp part3 ;; y p.b < i.b ok t5 slt.a @mid, *z+a ;; test p.a < i.a ok jmp f2 ;; n p.a >= i.a ok part3 slt.ab \$z+a, \$z+a ;; check if done with partition jmp setp mov @z+a, \$z+s ;; swap elements mov *z+a, @z+a mov \$z+s, *z+a nop }z+a, = mov \$x2, \$x1 ;; to <= | > mov \$z+s, \$x2 mov \$x3, \$z+s ;; (this should catch a single mov \$x4, \$x3 ;; different value stuck in mov \$z+s, \$x4 ;; with a lot of equal values) ;; mov \$exch, stack, @stack ;; make a,b to sort 2nd half mov.a \$z+a, @stack add.a \$one, @stack mov.ab \$z+a, = 2.b jmp pop ;; y 1.b < 2.b t6 slt.b @z+a,*z+a ;; test 1.b > 2.b jmp t7 ;; n 1.b == 2.b jmp t8 ;; y 1.b > 2.b (need to swap) t7 slt.a @z+a,*z+a ;; test 1.a > 2.a jmp pop ;; n 1.a <= 2.a t8 mov @z+a, \$z+s ;; out of order -> swap mov *z+a, @z+a mov \$z+s, *z+a jmp pop ;; equal case equal mov \$z+d, @mid ;; delete duplicate equala sub.b \$one, @stack jmp qsort, >z+eqct ;; start over equalf mov \$z+d, @z+a sub.b \$one, @stack jmp qsort, }z+eqct ;; data section x2 jmp part2-x1, }z+ct-x1 ;; swapped with x1 x4 jmp f2-x3, }z+ct-x3 ;; swapped with x3 seed dat \$2467,\$3247 ;; random numbers mid nop \$0,\$0 ;; pivot location (+code modifier) moffs dat \$z+a-mid, \$z+a-mid ;; pivot offset neg dat 7999,7999 ;; used to negate one dat 1,1 ;; constant one two dat 2,2 ;; constant two ;; stack stack dat 0,1 ;; the 0 is used to check underflow dat 512,512 ;; initial value to find array size end z