Skip to content

Instantly share code, notes, and snippets.

@eparadis
Last active February 5, 2022 03:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save eparadis/ee436d65f30e57b6f459839d472a096a to your computer and use it in GitHub Desktop.
Save eparadis/ee436d65f30e57b6f459839d472a096a to your computer and use it in GitHub Desktop.
classic terminal mandelbrot in FORTH
\ from proposal http://www.forth200x.org/fvalue.html
variable %var
: to 1 %var ! ;
: fvalue create f, does> %var @ if f! else f@ then 0 %var ! ;
0e0 fvalue i3
0e0 fvalue r3
59 value x1
21 value y1
-1e0 fvalue i1
1e0 fvalue i2
-2e0 fvalue r1
1e0 fvalue r2
r2 r1 f- x1 s>f f/ fvalue s1 \ L30
i2 i1 f- y1 s>f f/ fvalue s2 \ L31
: single_iter { F: z1 F: z2 } ( F: z1 F: z2 -- F: z1' F: z2' F: mag )
z1 fdup f* fdup \ L90 ( -- a a )
z2 fdup f* fdup \ L91 ( -- a a b b )
frot \ ( -- a b b a )
f+ \ ( -- a b mag ) L100
frot frot \ ( -- mag a b )
f- r3 f+ \ z1 \ L111 ( -- mag z1' )
2e0 z1 z2 f* f* i3 f+ \ z2 L110 ( -- mag z1' z2' )
frot \ ( -- z1' z2' mag )
;
: print_char ( F: x F: y -- )
62 \ character to emit w/ a single iteration
30 \ push the max in case we don't exit early
30 0 do \ L80
single_iter
4e0 f> if
drop i \ replace the max with the actual number of times we iterated
leave
then
loop \ L120
fdrop fdrop \ clean z1 and z2 left from single_iter
- emit \ L130
;
: calc_i3 { y }
y s>f s2 f* i1 f+ to i3 \ L50
;
: calc_r3 { x }
x s>f s1 f* r1 f+ to r3 \ L70
;
: mandel
cr \ always start on a fresh clean line
y1 0 do \ L40
i calc_i3
x1 0 do \ L60
i calc_r3
r3 i3 print_char
loop \ L140
cr \ L150
loop \ L160
;
mandel
bye
@eparadis
Copy link
Author

This is a refactor of a naive translation from BASIC into FORTH, given in a comment here.

The comments of style \ L123 refer to line numbers in that original BASIC version, although they don't line up perfectly after the refactor.

I'm still pretty new at FORTH, but this exercise has taught me a lot. I know the rule of thumb is "three line word definitions" and while my spacing is probably a bit odd, I don't think single_iter, print_char, or mandel are short enough.

My biggest challenge here is that I'm trying to preserve the "only calculate anything you need once" aspect of the original implementation. This goal, along with the variable-heavy origins as a straight translation, means that I find factoring difficult.

I attempted to factor out the use of variable a and variable b inside single_iter but it turned into a stack swizzling mess.

@eparadis
Copy link
Author

I refactored this using value (and fvalue), but my unscientific tests shows that it might be nearly twice as slow! That could be because of my definition of fvalue. If feels a bajillion times more readable, though.

\ from proposal http://www.forth200x.org/fvalue.html
variable %var
: to 1 %var ! ;
: fvalue create f, does> %var @ if f! else f@ then 0 %var ! ;

0e0 fvalue i3
0e0 fvalue r3

59 value x1
21 value y1
-1e0 fvalue i1 
1e0 fvalue i2
-2e0 fvalue r1
1e0 fvalue r2
r2 r1 f- x1 s>f f/ fvalue s1 \ L30
i2 i1 f- y1 s>f f/ fvalue s2 \ L31

0e0 fvalue a
0e0 fvalue b
: single_iter { F: z1 F: z2 } ( F: z1 F: z2 -- F: z1' F: z2' F: mag )
  z1 fdup f* to a \ L90
  z2 fdup f* to b \ L91
  a b f- r3  f+ \ z1 \ L111
  2e0 z1 z2 f* f* i3 f+ \ z2 L110
  a b f+ \ mag \ line 100
;

: print_char ( F: x F: y -- )
  30 \ push the max incase we don't exit early
  30 0 do                          \ L80
    single_iter
    4e0 f> if drop i leave then
  loop                             \ L120
  fdrop fdrop \ clean z1 and z2
  62 swap - emit                   \ L130
;

: calc_i3 { y }
  i1 s2 y s>f f* f+ to i3 \ L50
;

: calc_r3 { x }
  r1 s1 x s>f f* f+ to r3 \ L70
;

: mandel
cr \ always start on a fresh clean line
y1 0 do                         \ L40
  i calc_i3
  x1 0 do                       \ L60
    i calc_r3
    r3 i3 print_char
  loop                            \ L140
  cr                              \ L150
loop                              \ L160
;

mandel

bye

@eparadis
Copy link
Author

eparadis commented Feb 5, 2022

Unpacking the "polyfill" fvalue at the top:

variable %var \ make a variable named "%var"
: to 1 %var ! ; \ make a word "to" that stores decimal 1 into %var
: fvalue
  create   \ make a new dictionary entry. Its name is the next word in the parse stream. It puts the address of its body on the data stack when executed
  f,       \ allocate dictionary space for a floating point number in the body of the new dictionary entry
  does>    \ set what the body of the dictionary word created just now to:
    %var @ \ push the value of %var on to the stack
    if     \ if the top of the stack is true (non-zero) ...
      f!   \ ... store the top of the floating point stack into the address at the top of the data stack (ie: the address of the space reserved in the body of the new dictionary word)
    else   \ otherwise, when the TOS was false (non-zero )...
      f@   \ ... fetch the value of the floating point number at the address on the top of the data stack (ie: what was stored in the body above)
    then   \ afterwards,
    0 %var ! \ store zero into %var
;

So there is one use of fvalue:

1e0 fvalue foobar
Create a new word named foobar and store 1.0 into its dictionary entry, along with setting the run-time behavior of foobar

You can then use that word two ways:

foobar \ Put the value of foobar onto the (floating point) stack
The default operation of foobar just pushes a copy of the value stored inside it's dictionary entry.

3e0 to foobar \ Set foobar to the new value of 3.0.
to puts foobar into "storing mode", which sets the value held in it's dictionary entry.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment