From: Tim Vaughan Date: Tue, 26 Apr 2016 08:48:23 +0000 (+1200) Subject: Working on LEAVE and example. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=ece6e5acc36b0b01b5abf93dde3858b37abd4874;p=forth.jl.git Working on LEAVE and example. --- diff --git a/examples/mandelbrot.4th b/examples/mandelbrot.4th new file mode 100644 index 0000000..2767738 --- /dev/null +++ b/examples/mandelbrot.4th @@ -0,0 +1,42 @@ +( --- Complex integer arithmetic --- ) + +: c* ( x1 y1 x2 y2 -- x3 y3 ) + swap rot ( x1 x2 y1 y2 ) + 2dup * negate ( x1 x2 y1 y2 -y1y2 ) + 4 pick 4 pick * + ( x1 x2 y1 y2 (x1x2-y1y2)) + 4 roll 2 roll * ( x2 y1 (x1x2-y1y2) x1y2 ) + 3 roll 3 roll * + ( (x1x2-y1y2) (x1y2+x2y1) ) +; + +: c+ ( x1 y1 x2 y2 -- x3 y3 ) + rot + + -rot + + swap +; + +: csq 2dup c* ; + +; cmagsq ( x1 y1 -- mag ) + csq abs +; + +( --- Mandelbrot set calculations --- ) + +: iterate ( cr ci zr zi -- cr ci z'r z'i ) + csq c+ +; + +: inSet? ( cr ci -- res ) + + 100 0 DO + + 2SWAP 2DUP 5 ROLL 5 ROLL + iterate + 2DUP cmagsq + 100 > IF + LEAVE + THEN + + LOOP +; + diff --git a/src/forth.jl b/src/forth.jl index 3a2509b..e2292e1 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -517,6 +517,11 @@ FROMR = defPrimWord("R>", () -> begin return NEXT end) +RFETCH = defPrimWord("R@", () -> begin + pushPS(mem[reg.RSP]) + return NEXT +end) + RSPFETCH = defPrimWord("RSP@", () -> begin pushPS(reg.RSP) return NEXT diff --git a/src/lib.4th b/src/lib.4th index 4b60a1e..b44fb65 100644 --- a/src/lib.4th +++ b/src/lib.4th @@ -1,5 +1,6 @@ -' 1+ , : / /MOD SWAP DROP ; +: / /MOD SWAP DROP ; : MOD /MOD DROP ; +: */ * / ; : '\n' 10 ; : BL 32 ; @@ -105,16 +106,25 @@ ; : DO IMMEDIATE - ' >R , ' >R , + ' LIT , + HERE @ + 0 , + ' >R , ' >R , ' >R , HERE @ ; +: I RSP@ 2- @ ; + +: LEAVE RDROP RDROP RDROP EXIT ; + : LOOP IMMEDIATE ' R> , ' R> , ' 1+ , ' 2DUP , ' - , ' SWAP , ' >R , ' SWAP , ' >R , ' 0<= , ' 0BRANCH , HERE @ - , - ' RDROP , ' RDROP , + ' RDROP , ' RDROP , ' RDROP , + DUP HERE @ SWAP - + SWAP ! ; @@ -145,6 +155,7 @@ @ ( and fetch ) ; + ( With the looping constructs, we can now write SPACES, which writes n spaces to stdout. ) : SPACES ( n -- ) BEGIN @@ -240,8 +251,6 @@ U. ; -: U. U. SPACE ; - : . 0 .R SPACE ; : .S ( -- ) @@ -256,6 +265,8 @@ DROP ; +: U. U. SPACE ; + ( ? fetches the integer at an address and prints it. ) : ? ( addr -- ) @ . ;