0 [if] \ 1 minforth <3c089374-8f18-4d6b-a31e-7322ed66b9f9n@googlegroups.com> : USQRT {: u | x0 x1 ct -- uroot ; positive integer square root :} 0 to ct u 2/ to x0 BEGIN u x0 / x0 + 2/ to x1 x1 x0 < WHILE x1 to x0 ct 1+ to ct REPEAT ." root:" x0 . ." iterations: " ct . ; \ 2 Hans Bezemer <20825001-4f51-4424-8e99-e4eb867f45bdn@googlegroups.com> : sqrt-rem ( n -- sqrt rem) >r 0 1 begin dup r@ > except 4 * repeat begin \ find a power of 4 greater than TORS dup 1 > \ compute while greater than unity while 2/ 2/ swap over over + negate r@ + \ integer divide by 4 dup 0< if drop 2/ else rdrop >r 2/ over + then swap repeat drop r> ( sqrt rem) ; \ 3 Hans Bezemer : usqrt >r 0 r@ 2/ ( ct x0 R: u) begin r@ over / over + 2/ swap over over < ( ct x1 x0 f) while drop swap 1+ swap repeat rdrop nip nip ; \ 4 dxforth : SQRT ( +n -- +root ) 0 over 2/ >r BEGIN over r@ / r@ + 2/ dup r@ < WHILE rdrop >r 1+ REPEAT drop ." root:" r> . ." iterations: " . drop ; \ 5 albert@cherry.(none) \ different start value \ For N return FLOOR of the square root of n. : SQRT DUP >R 10 RSHIFT 1024 MAX \ Minimize iterations. BEGIN R@ OVER / OVER + 1 RSHIFT 2DUP > WHILE NIP REPEAT DROP RDROP ; \ 6 minforth : USQRT {: u | T H B S -- uroot32 :} 0 to H $8000 to B 15 to S BEGIN H 2* B + S lshift to T T u < IF H B + to H u T - to u THEN S 1- to S B 2/ to B B 0= UNTIL ." root:" H . ; \ 7 Anton Ertl <2022Dec6.230125@mips.complang.tuwien.ac.at> \ different start value: : log2 ( n -- log2 ) -1 swap ( log2 n) dup $ffffffff00000000 and if swap 32 + swap 32 rshift then dup $00000000ffff0000 and if swap 16 + swap 16 rshift then dup $000000000000ff00 and if swap 8 + swap 8 rshift then dup $00000000000000f0 and if swap 4 + swap 4 rshift then dup $000000000000000c and if swap 2 + swap 2 rshift then dup $0000000000000002 and if swap 1 + swap 1 rshift then + ; With this function the initial value becomes: 1 u log2 2/ lshift \ 8 Gerry Jackson : usqrt ( u -- u1 ) dup 2 u< if exit then dup >r 2 rshift recurse 2* ( -- u sm ) 1+ dup ( -- u la la ) dup * ( -- u la la^2 ) r> u> if 1- then ( -- u1 ) ; \ 9 Anton Ertl original below \ try to be better adapted to the limitations of VFX \ a Anton Ertl original below \ try to be even better adapted to the limitations of VFX \ b dxforth \ code below \ c Anton Ertl original below \ inspired by b; reorder stack items, so that VFX never moves a value \ on the critical path to memory, switch to BEGIN..UNTIL \ d Anton Ertl original below \ use better start value \ log2 from <2022Dec8.183224@mips.complang.tuwien.ac.at> [then] \ for now only measure stack vs. locals; words are modified to \ eliminate iteration counting and output, and to produce the root as \ result. : USQRT1 {: u | x0 x1 -- uroot ; positive integer square root :} u 2/ to x0 BEGIN u x0 / x0 + 2/ to x1 x1 x0 < WHILE x1 to x0 REPEAT x0 ; : USQRT4-withct ( +n -- +root ) 0 over 2/ >r BEGIN ( +n ct r:x0 ) over r@ / r@ + 2/ ( +n ct x1 R:x0 ) dup r@ < WHILE r> drop >r 1+ REPEAT drop 2drop r> ; : USQRT4 ( +n -- +root ) dup 2/ >r BEGIN ( +n r:x0 ) dup r@ / r@ + 2/ ( +n x1 R:x0 ) dup r@ < WHILE r> drop >r REPEAT 2drop r> ; : usqrt9 ( u -- root ) dup >r 2/ begin ( x0 R:u ) r@ over / over + 2/ ( x0 x1 R:u ) 2dup > while nip repeat r> 2drop ; : usqrta ( u -- root ) dup >r 2/ r@ begin ( x0 u R:u ) over / over + 2/ ( x0 x1 R:u ) 2dup > while nip r@ repeat r> 2drop ; : USQRTb ( +n -- +root ) dup 2/ dup BEGIN drop 2dup / over + 2/ 2dup > WHILE swap REPEAT rot 2drop ; : usqrtc ( u -- root ) dup 2/ dup begin ( u x0 x1 ) nip ( u x1 ) 2dup / over + 2/ ( u x1 x2 ) 2dup <= until drop nip ; : uSQRT5 DUP >R 10 RSHIFT 1024 MAX \ Minimize iterations. BEGIN R@ OVER / OVER + 1 RSHIFT 2DUP > WHILE NIP REPEAT DROP R> DROP ; : log2 ( n -- log2 ) dup 0= swap ( log2' n ) dup $ffffffff u> 32 and rot over + -rot rshift dup $0000ffff u> 16 and rot over + -rot rshift dup $000000ff u> 8 and rot over + -rot rshift dup $0000000f u> 4 and rot over + -rot rshift dup $00000003 u> 2 and rot over + -rot rshift $00000001 u> 1 and + ; : usqrtd ( u -- root ) 2 over log2 2/ lshift dup begin ( u x0 x1 ) nip ( u x1 ) 2dup / over + 2/ ( u x1 x2 ) 2dup <= until drop nip ; : usqrte ( u -- root ) dup 10 rshift 1024 max dup begin ( u x0 x1 ) nip ( u x1 ) 2dup / over + 2/ ( u x1 x2 ) 2dup <= until drop nip ; : check {: xt -- :} 10000000 2 do i i xt execute dup dup * swap 1+ dup * within 0= if cr ." doesn't work for " i . then loop ; : bench {: xt -- :} 10000000 2 do i xt execute drop loop ;