\ templates for tests via mouse cut+paste
hp
(pw)
mc

\ --------------------------------------------------------------------------------------------------------------------
\ kbd ( note which chars require quoting or to be escaped):

f8 order cr hex "' .s hidden idx>xec 4th>abs (ok) !" cr also linux also editor also testvoc \
also fig also forth also cr order cr cr vocs;n=$?;[ "$n" == "0" ]||{ report -s $n;echo $n; }

./f8 "' .s idx>xec 4th>abs (ok) !" c0 @ 10 0 cr hex .s cr ] do i . i 0 do i j \* \#. loop cr \
[ hex state @ u. cr .s cr ] loop \$12345678 drop 0x90abcdef drop bel dup c-here cr .s cr \
[ over- .s dump cr 6 + \#dcm cr .s .\( alle meine entchen... \) .s cr .s 2>&1 |tee t

\ stderr to file, for debug output
f8 hex "' .s also hidden idx>xec 4th>abs (ok) !" .s cr also linux also editor also 
testvoc also forth also order words 2>t;n=$?;[ "$n" == "0" ]||{ report -s $n;echo $n; }

\ short start
./f8 "'" .s hidden idx\>xec 4th\>abs \(ok\) rvoc \!
   
\ --------------------------------------------------------------------------------------------------------------------
\ bh
include bh/bh.f8 77 0 do i msg enum@ type cr key #27 = -leave loop

   
\ --------------------------------------------------------------------------------------------------------------------
\ termcap
pad w@+ &. w@+ . ." names " w@+ . ." #bool " w@+ . ." #ints "  w@+ . ." #stgs " w@ . ." stgsiz" cr

\ --------------------------------------------------------------------------------------------------------------------
\ text

\ -trailing
s"       hallo     hu          ha hi !              ?" begin -trailing dup if 2dup type .s cr 1- endif -dup 0> 0= until drop

\ search strings
s" ene mene muh" pad place s" mene" pad count 2swap search . type cr pad count s" blh" search . type cr
hh s" <!--" pad place pad count s" -->" 2-rot ]] >rr search . r> [[ /string 2dup 2rot ]] >rr search . r> [[ /string
s" Ein Neger mit Gazelle zagt im Regen nie!" pad swap 2dup 4+ erase >move< pad zcount type
hex  hh s" &nbsp;" pad place pad count s" &NBSP;" 1 temp $1000    replace cr
sp> test s" me" pad place pad count s" 'na" sslice type "|< emit cr cr type "|< emit cr

s" ene mene mu gaga guh! tetitatu?" dup stg t1 s" e" dup stg s1 s" m" dup stg s2 s" X" dup stg r1
sp> pad 10 - 200 erase t1 s1 r1 -1 pad 200 replace rdump

\ escaped char by number, re-define "type": { ' [etype] idx>xec 4th>abs (type) ! }
sp> s" eins \#38 zwei, drei\46vier \\\a\n\t\\\t\422\$30\$31\$32: \41" type
    
\ display character sets
0 4 do cr i g1 #256 #32 do cr #16. do i j + dup #10 = over #127 = or if drop else dup -6 .r emit endif loop #16 +loop cr -1 +loop
512 32 do 0 g0 i .  3 g0  i emit 2 spaces i 16 mod 0= -cr loop cr 0 g0
forget cs : cs dup do cr i . cr i g0 #512. do i #16 mod 0= -cr 0 g0 i -6 .r i i #256 mod j g0
  range: 0 10 15 127 128 256 ; case: drop emit drop emit drop emit drop ; loop 0 g0 cr cr key #27 = -leave -1 +loop cr ;
forget pc : pc 0 4 do cr i . cr i g0 #512. do i #16 mod 0= -cr 0 g0 i -6 .r i i #256 mod j g0
  range: 0 10 15 127 128 256 ; case: drop emit drop emit drop emit drop ; loop 0 g0 cr cr key #27 = -leave -1 +loop cr ;
  
\ get env vari
s" HOME=" \
100 1 do i envstg dup 0= -leave dup if 2over rot drop dup -rot compare 0= if 2drop i envstg leave endif else 2sdrop endif loop
\ display all env's
0 begin 1+ dup envstg dup while type cr repeat 3drop 

\ --------------------------------------------------------------------------------------------------------------------
\ sys_select

4. sleep pad 100 erase 10 pad 20 + ! pad 20 + 4th>abs pad 8+ ! pad 12 + 4th>abs dup 4- dup 4- dup 4- 2 sp@ #142 syscall
sp> hex pad 100 erase pad 20 + on pad 30 #32 * 0 do dup i btst if i . key drop endif loop

\ --------------------------------------------------------------------------------------------------------------------
\ locals, recursion

[s] : kk 2468 local: haha 369c haha - to haha haha . -1234 +to haha haha [ lp ? s0 ? (locn) ? (locb) ? cr [s] cr ] . ;
: ha locals| drei zwei eins | eins zwei drei .s to eins to drei to zwei eins zwei drei -1 +to eins eins 0> 0= -exit recurse ;
: ho locals| eins zwei drei | eins . zwei . drei . eins zwei + +to drei drei . cr ;
: he local: eins s0 u? -1 +to eins eins . eins 0< -exit eins recurse eins 0= -cr eins . s0 u? ;
: hi local: eins s0 u? -1 +to eins eins 0> if eins recurse else eins 0= -cr eins . s0 u? endif ;
: fa local: nn nn 1 > if nn 1- recurse else 1 endif nn * ;
: fo local: nn nn nn 1 > if 1- recurse else drop 1 cr endif nn * ;
: fe locals| n1 n2 n3 n4 |
   n1 . n2 . n3 . n4 . 1 +to n1 2 +to n2 3 +to n3 n1 n2 n3 + + +to n4 n4 1000 < if n1 n2 n3 n4 recurse endif n1 n2 n3 n4 ;
: fi locals| eins zwei |  case eins of ." eins" endof zwei of ." zwei" endof default . endcase .s cr .rs cr ;
: nf locals| n1 | n1 . n1 1 >  if n1 1- s0 u? cr  recurse n1 endif loc-ptr n1 dup u. u? s0 u? cr ;
: qq locals| a1 a2 | a1 a2 - if a1 a2 > +to a1 a1 a2 recurse ." R:" a1 . a2 . cr endif ." E:" a1 . a2 . cr ;

\ multiple cells items
: t locals| n1 n2 n3 n4 | loc-ptr n4 4@ loc-ptr n4 >r 4dup r 4! r> loc-ptr n1 n1 . n2 . n3 . n4 . ;
\ specified size
: t4 s0 @ >r { 4: vier 0: null n1 n2 n3 n4 } 
  loc-ptr vier loc-ptr null loc-ptr n1 loc-ptr n2 loc-ptr n3 loc-ptr n4 u? u? u? u? 
  22 dump ." NULL" cr 22 dump ." VIER" cr r> 44 dump ." S0" cr ;
: t1 s0 @ >r { 4: vier | n1 n2 n3 n4 } vier loc-ptr 4 4@ uq. n1 n2 n3 n4 .  . . .  r> 44 dump ;

\ --------------------------------------------------------------------------------------------------------------------
\ deferred, sort, words

' dfdt >data 11 dump defer otto rdump ' bel is otto rdump ' bel is dfdt rdump ' otto deferred? rdump

: pp .s cr u< ; : cc $1000 0 do tick 2/ xor pad i 3 * + xor! loop pad $1000 4/ ; ' pp also util is precedes
: pp esc? if quit endif u< .s cr ; 
: cc $40   0 do tick 2/ xor pad i 3 * + xor! loop pad $10    ; ti-cal drop also util 
: h cc tick 2>r sorted u< tick 2r> d- cr pad $40   bounds do $20 0 do i j + u? 4 +loop cr $20 +loop cr ti-cal dfrac. cr ;

0 context @ wid>top begin  dup @ while dup @ - swap 1+ swap repeat
: cc context @ 0 >r begin 1 r+! dup @ - dup @ 0= until drop r> ;

defer (t) defer (w) s" *" dup stg s ' s is (t)
	: (r) lfa>nfa count (t) search -rot 2drop ; ' (r) is (w)
	: (s) begin dup 0= -exit dup (w) -exit dup @ - dup @ 0= until ;
	selected (s9 words
	"?   ' s >body 5 + c! selected (s) words
			
\ --------------------------------------------------------------------------------------------------------------------
\ ans compliance, benchmark

include 4th/util.f8 include 4th/4/core.f8
include 4/bench.f8 include 4/bm.f8 include 4/tt.f8

include 4th/util.f8 include 4th/4/tester.f8 include 4th/4/core.f8 include 4th/4/bench.4th include 4th/4/tt.fs

\ --------------------------------------------------------------------------------------------------------------------
\ ans LEAVE
ans ans  : t1 100 0 do i 50 > if cr leave endif ." :" i . loop cr ;
forth    : t2 100 0 do i 50 > if cr leave endif ." :" i . loop cr ;

\ --------------------------------------------------------------------------------------------------------------------
\ div-exception signal handler
: p 3dup p1 . . tab p2 . . ; 	10. 7 p cr -10. 7 p cr -10. -7 p cr 10. -7 p cr 0. 0 p cr -10. 0 p cr 10. 0 p cr
]] 10. 10000 0 tick 2>r do i i 2over p1 3drop loop tick 2r> d- d. 10000 0 tick 2>r do i i 2over p2 3drop loop tick 2r> d- d. sp> [[
10. 7 fm/mod . 1 . . 3 . cr  -10. 7 fm/mod . -2 . . 4 . cr 10. -7 fm/mod . -2 . . -4 . cr -10. -7 fm/mod . 1 . . -3 . cr
20. 7 sm/rem . 2 . . 6 . cr  -20. 7 sm/rem . -2 . . -6 . cr 20. -7 sm/rem . -2 . . 6 . cr -20. -7 sm/rem . 2 . . -6 . cr
sp> 1A2B3C4F 4D5E6F10 90A0B0 C0D0E0F0 10203040 50607080 depth dup 1+ ndup .s cr 8 nlshift .s cr  20 0 do sdrop 8 nlshift .s cr loop
sp> 3456789E 9ABCDE20 1214160 81A1C1E0 20406081 A0C0E100 6 1 nlshift ]] tick 2>r 1000 0 do sdrop 1- 1 nlshift loop tick 2r> d- [[

\ --------------------------------------------------------------------------------------------------------------------
\ loop

10   0    begin   dup . 2dup + >r 1+ 2dup + r> xor 2 pick >     until 2drop
10   0    begin   dup . 2dup + >r 1+ 2dup + r> xor 2 pick dup 0> if > else < endif until
  
\ --------------------------------------------------------------------------------------------------------------------
\ vocabularies, linkage to ram, definig words

fig sp! s" bye" over + off 1- ]] tick 2>r 10000 0 do dup find 2drop loop tick 2r> d- decimal d. hex [[

d0 @ here 4+ over- dump ' testvoc idx>lfa lfa>ifa 40 tdump ' root idx>lfa lfa>ifa ' forth idx>lfa lfa>ifa over- tdump
d0 @ here 4+ over- dump ' testvoc idx>lfa dup lfa>ifa 40 tdump lfa>wid wid>top d0 @ dup 40 tdump ifa>lfa dup lfa>wid dup wid>top 
(intermediately: ]] fld dup @ - voc-link @ swap minus voc-link + voc-link ! vocs voc-link ! [[ )
]] create EMIL bel c-here u. here u. cpl; [[ also assembler <ret> 1, previous

: EMIL bel c0 @ c-here over- 10 + dump ;
create OTTO bel c-here u. here u. smudge ' EMIL idx>xec c-here over- tdump
: HA ." H1" create c-here , ." H2" does> ." H3" ; : HO ." O1" HA here , ." O2" does> ." O3" ;
: hs 10 0 do i dup 5 <  if i .   else i 5 = -leave endif . loop bel ;
: HA ." H:" create c-here , ." H," does> @+ ." H>" ; : HO HA here , ." O," does> dup u. ." O>" ; ha hu cr ho he cr see ha cr see he
: h c-here u. ; c-here 90 dump : HA create a , ." A,"h does> @+ ." A>"; : HO h ." O:"HA f , ." O,"h does> ." O>"dup u. ; rdump
: h here u. c-here u. ; c-here 90 dump : HA create a , ." A" h does> @+ ; : HO h ." O:" HA f , ." O," h does> ." O>" dup u. ; rdump

-find meier sdrop 0= if [ 2variable meier ] 1234567890abcdef. meier 2! endif meier 2@ d. 
-find emil sdrop 0= if [ meier 2@ dminus 2constant emil ] endif emil 2dup cr d. 0. cr q. meier 2@ emil d+ d.
: HU create -1 , 2 , -3 , 4 , assembler ;code <nop> <nop> <nop> 1, 1, 1, end-code  HU ha <ret> 1, c0 @ 100 dump ' ha idx>xec
: TT cr c0 @ enter begin cr dup u. bs 3A  emit space #dcm char+ entry dup @ 0= esc? or until drop cr ;
: Cy flg 1 and ; : Z flg 40 and ; : Cy? cy . ; : Z? Z 0=/= 1abs . ; : flg? flg flg>smb type space ;

voc-link ddup u? @ - here c-here over $. dup $. voc-link ddup $. @ - $. cr wordlist emil cr c-here $. here $.

include" 4th/test.f8"  fence u? i-fence u? c-fence u? seal xprotect forth forth fence! fence u? i-fence u? c-fence u?
include" 4th/test.f8"  ]] here dup 11 dump ans bl word rvoc count type cr print cr [[ bel
include" 4th/test.f8"  include" /usr/src/forth/mhx/magic.frt" ]] noop here bel dup 10 u.r @ 10 u.r cr rdump [[    
compiler call-by-uot   tick include" 4th/test.f8"  compiler  call-by-uot   include" 4th/4/bench.4th" tick 2swap d-
also tools c-here 80 dump ]] 10 0 do i . i 5 = if i noop leave endif noop i . loop [ rdump dcm u. c-here u. ( ans-mode {leave} )

\ --------------------------------------------------------------------------------------------------------------------
\ uot vs immedate disp calling - {fast-call}

: fast-vari create 0 , ; : fast-create create ; fast-end : vari create 0 , ;  ' fast-vari idx>xec c-here 20 + over- dump
set-cal tick drop fld ! include" 4th/test.f8" tick drop minus fld +! fld @ #. fld @ 0 ti-cal um/mod . 100 u* ti-cal um/mod . .

\ --------------------------------------------------------------------------------------------------------------------
\ check non-/mmx words

1 if
 -1 0 10 2rshift 12 ud.r 0 -1 10 2rshift 12 ud.r -1 0 10 2lshift 12 ud.r 
 0 -1 10 2lshift 12 ud.r -1 0 10 2rshifta 12 ud.r 0 -1 10 2rshifta 12 ud.r cr
 -1 0 30 2rshift 12 ud.r 0 -1 30 2rshift 12 ud.r -1 0 30 2lshift 12 ud.r 
 0 -1 30 2lshift 12 ud.r -1 0 30 2rshifta 12 ud.r 0 -1 30 2rshifta 12 ud.r cr
endif
    
\ --------------------------------------------------------------------------------------------------------------------
\ timing tests, 'time&date'

] mtlock tick 2>r 100000 0 do i i 2drop loop tick 2r> d- d. mtunlock [
] mtlock tick 2>r 100000 0 do i i 2drop loop tick 2r> d- d. mtunlock [
] mtlock tick 2>r 100000 0 do i 1 and if i else i endif drop loop tick 2r> d- d. mtunlock [
] mtlock tick 2>r 10000 0 do in @ >r fig -find sp! r> in ! loop tick 2r> d- mtunlock d. [ 
\  !!!  1st push: 0. 7fffffff.
] mtlock tick 2>r 100000 0 do time&date 6 ndrop loop tick 2r> d- mtunlock 2dup 2rot dmin 2-rot dmax 2swap [
] mtlock tick 2>r 100000 0 do time&date 6 ndrop loop tick 2r> d- d. mtunlock [

\ \\\\\\\\\\\\\\\\\\\\\\\\\
: timer-reset s0 @ 2 >loc tick rot 2! ; 
: .elapsed tick 1 locals? if s0 @ 8- 2@ -2 >loc else 2dup endif d- drop ti-cal -dup 0= if set-cal ti-cal endif frac. ; 
: INNER #1000 0 DO 34 DROP  LOOP ; 
: BENCH TIMER-RESET #1000 0 DO INNER LOOP .ELAPSED ; 
: B*100 TIMER-RESET #100000 0 DO INNER LOOP .ELAPSED ; 
\ /////////////////////////

\ --------------------------------------------------------------------------------------------------------------------

\ conditional...
0 -dup -enter 10 enter begin 1- entry entry dup . dup 0= until drop
fig sp! 100 begin 1- dup while dup . dup 50 > dup . while dup minus . dup 0= until
] 1 2 3 4 2>r 2>r r0 @ rp@ - enter begin dup rp@ + @ abs>4th u. 4- entry dup 0< until 2rdrop 2rdrop [
ans 1 begin dup while dup 1+ dup 10 < while dup . repeat bel else dup ." hier " . then

\ --------------------------------------------------------------------------------------------------------------------

\ literal
fig sp! here ] 1 drop 1 drop 1 drop literal literal . . cr [

\ quad compiling
] bel bel quad 1234567890abcdef.fedcba0987654321 cr .s cr uq. cr dcm drop rdump [
] bel bel quad 1111111122222222.3333333344444444 cr .s cr uq. cr dcm drop rdump [

\ double mul -> quad
]] tick 2>r #1000000 0 do 1 2 100. umd* 4drop loop tick 2r> d- 2dup d. cr 
   tick 2>r #1000000 0 do 1 2 100. probier 4drop loop tick 2r> d- 2dup d. cr [[

\ +/- roll
fig sp! 10 1 do i 11 * loop cr .s 6 roll cr .s -6 roll cr

\ voc
current dup u. #17 8* dup -rot - swap dump fig sp!
here 100 erase here 40 dump head EMIL rdump c0 @ 20 tdump
 
\ exchange @tos and @tor
fig sp! cr ] 1 2 3 4 .s cr 2>r .s cr 2r>>2r .s cr 2r>>2r .s cr 2r> .s cr [ sp!
fig sp! cr ] 1 2 .s cr >r .s cr r>>r .s cr r>>r .s cr r> .s cr [ sp!

\ time->date ( n -- )
0 #60 um/ #60 um/ #24 um/ #365 um/ drop #1970 + ." Y:"#. #30 /mod 1+ ." M:"#. 1+ ." D:"#. ." h:"#. ." m:"#. ." s:" #.

\ numeric date, from {time} etc.
fig sp! time drop 0 #60 um/ #60 um/ #24 um/ 2dup #1461 um/ rotd d- #365 um/ drop \
#1970 + ." Y:"#. #30 /mod 1+ ." M:"#. 1+ ." D:"#. ." h:"#. ." m:"#. ." s:" #.

\ bits
sp> hex pad 100 erase pad 20 + on pad 30 #32 * 0 do dup i btst if i . key drop endif loop

\ constant, integer, value
hex 1234 constant ccc 5678 integer iii 90ab value vvv : ttt ." C:" ccc . ." I:" iii . ." V:" vvv . ; see ttt

\ --------------------------------------------------------------------------------------------------------------------
\ channels

\ open-file
s" /F/lib4th/lakerkak" r/w open-file .
s" /F/lib4th/lakerkak" r/w open-file . dup . pad 110 2dup erase dump pad 100 rot read-line . . rdump

\ test file-input:			    <eof> <error>   <flg>
7FFFFFFF begin pad 100 3 read-line 3dup 0 q0= swap 0< or swap 0= or 0= if pad over type - cr 1 endif 0= esc? or until

\ copy-file
s" /F/lib4th/lakerkak-cy" 2dup w/o create-file . -rot 3 - r/o open-file . 2dup swap over file-size pad off pad swap copy-file .

\ rename-file
pad2 80 + dup ( src:) s" /F/lib4th/kakerlak" rot place count ( dst:) s" /F/lib4th/lakerkak" rename-file . 
pad2 80 + dup ( src:) s" /F/lib4th/lakerkak" rot place count ( dst:) s" /F/lib4th/kakerlak" rename-file . 

\ test for include... and {key} variants w. console vs. file input
]] blk @ >r source-id >r stdin >r 3 (stdin) ! begin interpret refill 0= until r> (stdin) ! r> (source-id) ! r> blk ! [[
s" tests/in/f8t-17.in" r/o open-file . begin dup (stdin) ! key? if key . else [ stdin ] literal (stdin) ! 0 endif -dup 0= until
s" tests/in/f8t-17.in" r/o open-file . begin dup (stdin) ! key? if key emit else [ stdin ] literal (stdin) ! 0 endif -dup 0= until
s" tests/in/f8t-17.in" r/o open-file . begin dup (stdin) ! ?key if emit else [ stdin ] literal (stdin) ! 0 endif -dup 0= until
s" tests/in/f8t-17.in" r/o open-file . begin dup (stdin) ! ekey? if key emit else [ stdin ] literal (stdin) ! 0 endif -dup 0= until
s" tests/in/f8t-17.in" r/o open-file . begin dup (stdin) ! ?ekey if emit else [ stdin ] literal (stdin) ! 0 endif -dup 0= until
s" tests/lakerkak" r/o   open-file 0= if [_] \ endif new-chan dup value  infile is-chan .
#16 3 do i 2+ i chp ! i i . ch-eof . cr loop

\ --------------------------------------------------------------------------------------------------------------------
\ vt

sp> forget keys : keys key #27 over- if emit exit endif begin ?key -dup sdrop while emit repeat ;
max-xy 2/ swap 2/ swap cur! at-xy cur! 40 1 at-xy xy #. #. ."  <- hier " cur@ ." -> dorth "
forget t : t pad $200 2dup blanks $120    do i . i pad w! pad 4 0 write-file i #16 mod 0= -cr 2drop loop cr ;
 
\ --------------------------------------------------------------------------------------------------------------------
\ terminal colours
pad2 count 255 0 do 255 0 do 255 0 do i j 2 ni 7 set-palette esc? if reset-palette quit endif loop loop loop
   
\ --------------------------------------------------------------------------------------------------------------------
\ rational numbers, runtime test

\ f<->ieee
: d%. base@ (r) @ 2>r "0 (r) ! #64 binary ud.r space 2r> (r) ! base! ;
$3FBF9A6B.50B0F27C \ 0.12345	;
$3FF3C083.126E978D \ 1.2345e0	;
$405EDCCC.CCCCCCCD \ 123.45e0	;
$40934A00.00000000 \ 123.45e1	;
$40C81C80.00000000 \ 123.45e2	;
$BFBF9A6B.50B0F27C \ -0.12345 	;
$BFF3C083.126E978D \ -1.2345e0	;
$C05EDCCC.CCCCCCCD \ -123.45e0	;
$C0934A00.00000000 \ -123.45e1	;
$C0C81C80.00000000 \ -123.45e2	;

!timing   5 0 do   1 2 3 4 5 6 7  8  forth forth  ['] noop     (timing) .timing sp> loop cr

sp> quad \-12,3456 quad \912,3455 dv- <# 2dup 2-rot ud/mod 2swap base@ udm* drop 2rot 
places 0 do 2>rr ud/mod drop h>a hold base@ udm* drop 2r> loop
quad \123,45 4dup 4dup enter begin 8dup quad \01 dv+ 1/dv dv2* dv* 4rot 4drop 4swap entry .s cr 4over d2dup dv> 0= key 27 = or until
quad \1,0045 4integer q3 -713772291 -138712447 -743309312 116415321 4integer q2 q2 q3 dv* df.
\ e^dv {rational hidden also cons also forth also}, for {fa} := 1 to 33 :
1 =: fa double 0,999999999 dv>qv 1qv 1qv 
	begin 2 8pick fa s>qv qv/ qv* #16 ndup qv+ ?q0= 4 pick 0< or 0= while -2 8pick 1 +to fa repeat
\	single step:
	2 8pick fa s>qv qv/ qv* #16 ndup qv+ ?q0= . 3 pick 0< . -2 8pick 1 +to fa cr
\ ln(dv)
sp> double 1,5 dv>uqv qvdup qv1- qvswap qvsqrt 8dup qv>dv d= .
	8sover 4sover q+ s->d 0< if nos-qnegate qnegate then qv2* qv* qvswap qvsqrt 8dup qv>dv d= . cr
\ pi: pi/4=S[ -1^(n+1)/(2n-1) ] = 0,785398164328770 (after about two days)
double 1 s" max-float" environment? drop dv>n 4/ 2 do i 2* 1- s>dv 1/dv i 1 and 0if dvnegate endif dv+ loop df.
( nn ) : cpi >r quad 0 quad 1 r>    0 do  i 1 and if quad 4 else quad -4 endif i i + 1- 0 0. qv+  loop ;
0. 0. 1. 0. -1. 0. enter begin q1- quad 4 7 pick 1 and 0= q+- 4over q2* q1- 4 4roll 4 4roll qv+ 8swap entry ?q0= until 8dup qv. qf.

\ false display w/ {df.}; {dv.} ok
sp> double 1,19 dv>qv e^qv qvdup qv. qv>dv 4dup dv. 4dup df. dvsplit cr .s cr df. df. cr
qd ud/mod h>a emit drop base@ udm* 
sp> 123 for 40,49 +from  4,234 step idx      idx f. false @nx vt <esc> 2* dump key <esc> = if quit endif next
sp>  2,00  dv>qv    ln(qv) .s cr qvdup qf. ." D:" u. u. u. u. ." == N" u. u. u. u. cr

\ pi=1-1/3+1/5-1/7+...\ 4 forth also rational also hidden
quad 01 4dup ( qv=1 ) $10000000 do quad 01 i 1 and 0= q+- i i + 1- 0 0. qv+ loop .s cr qf. cr

\ arc tg
sp> flt   00001,5000  cr     tg(dv) 4dup f. cr         atg(dv) f.   cr
sp> s" 00001,5" flt >dfloat . int   cr     tg(qv) 8dup  qf. cr         atg(qv)      qf.   cr
sp> pi for 0,0900 step 0,0008 +from idx fdup f.       sin(dv) fdup f. fdup       asin(dv) f.       sin(dv) f. cr next
sp> 0,111 ftanh fdup f. fdup fatanh f. cr dv>qv 8dup qv1+ 1qv qvrot qv- qv/ 8dup qv1- 8swap qvsqrt
8sover 4sover q+ s->d if nos-qnegate qnegate endif qv2* qv* qvswap qvsqrt 8dup 8dup qvsqrt qv= .

\ --------------------------------------------------------------------------------------------------------------------
\ multi-praecision

fig tools
-1 dup 2dup pad 4! pad 0d ]] .rs cr m>r .rs cr r> 4th>abs u. r> 4th>abs u. r> 4th>abs u. r> 4th>abs u. cr .rs rp! [[
-1 dup 2dup pad 4! pad 0d over 40 dump ]] 2dup .rs .s cr m>r .rs .s cr swap 20 + swap r>m .rs .s cr rdump rp! [[
-0 1+ -1 -0 2dup 3 pick 3 pick ]] .rs .s cr 6 n>r .rs .s cr 6 nr> u. u. u. u. u. u. .rs .s cr rp! [[
-1. -1. 1 rshift 4dup uq. cr 80 0 do 4dup qslbits i #. dup #. qlshift uq. 1 qrshift cr key 1b = -leave loop sp>

/ 17.0+24: +v+ test uq*,  p1 test uqd*
sp> quad $1234567890abcdef12 quad 1000000000000001 8dup uq* uq. uq. .s cr +v+ uq. uq. cr .s cr sp>
sp> quad $1234567890abcdef12 1.000000000000001  6 ndup uqd* ud. uq. .s cr p1  ud. uq. cr .s cr sp>
sp> quad $1234567890abcdef12 quad 1.000000000000001  8 ndup  uq* uq. uq. .s cr +v+ uq. uq. cr .s cr sp>
sp> 1 2 3 4 5 6 7 8 timing'    uq* sp> 1 2 3 4 5 6 7 8 timing' +v+    sp> cr
sp> quad $1234567890abcdef12 quad 1.000000000000001  8 ndup  tuq/mod uq. uq. .s cr uq/mod uq. uq. cr .s cr sp>

\ --------------------------------------------------------------------------------------------------------------------

( lsof display columns: COMMAND     PID USER   FD   TYPE     DEVICE     SIZE      NODE NAME )
