home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / FORTH / WIMPFO.ZIP / !WimpForth / ssort < prev    next >
Text File  |  1996-03-21  |  514b  |  28 lines
  1. \ shell sort
  2. anew shellsort
  3.  
  4. 0 value anf
  5. defer s@
  6. : _s@ + c@ ; ' _s@ is s@
  7. defer s!
  8. : _s! + c! ; ' _s! is s!
  9. defer s>     ' >   is s>
  10. variable x
  11.  
  12. : shellsort ( ad len -- )
  13.     swap to anf
  14.     1 begin 2dup > while 2* repeat 1-
  15.     begin 2/ dup
  16.     while 2dup
  17.       do i dup anf s@ 0 x s!
  18.         over -
  19.         begin dup anf s@ 0 x s@ s>
  20.         while 2dup + >r
  21.           dup anf s@ r> anf s!
  22.           over -
  23.           dup 0<
  24.         until then over +
  25.         0 x s@ over anf s! drop
  26.       loop
  27.     repeat 2drop ;
  28.