\                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ( binary sort)                                                                                                                  ( Written by Ewald Pfau @ 2:316/9@fidonet, Apr/1994                                                                             Distribution only with the unchanged version of this file       at least as a part of what is distributed. )                                                                                    ( ------------------------------------------------------------)    2 4 thru                                                     ( ------------------------------------------------------------)                                                                                                                                                                                                                                                                                                                                                                                                 \                                                                                                                               : BXCHG         ( a1 a2 --)                                        over @ over @ swap rot ! swap ! ;                                                                                            : MXCHG         ( a1 a2 -- 'a1 a2)                                 over @ over @ swap u< if nip dup then ;                                                                                      : HALFCELLS+    ( a diff -- a a+)                                  1 rshift 1 cells negate and over + ;                                                                                                                                                                                                                                                                                                                                                                                                                         \                                                                                                                               : BINSORT       ( a len --)                                        cells        over + >R                                          begin        dup cell+ R@ u<                                    while        dup dup                                               begin     cell+ dup R@ u<                                       while     mxchg                                                 repeat    drop 2dup -                                                     if 2dup bxchg then                                              drop cell+                                         repeat       R> 2drop ;                                                                                                                                                                                                                                                                                                      \                                                                                                                               : BINFIND       ( a len val -- ax/0)                               >R cells     over + swap                                        begin        2dup - ?dup                                        while        halfcells+                                                      tuck @ R@ 2dup -                                   while        swap u<                                               if        rot drop                                              else      drop cell+                                         then repeat  2drop R> 2drop nip exit                            then         2drop R> drop 0 ;