diff options
| author | fishsoupisgood <github@madingley.org> | 2019-04-29 01:17:54 +0100 | 
|---|---|---|
| committer | fishsoupisgood <github@madingley.org> | 2019-05-27 03:43:43 +0100 | 
| commit | 3f2546b2ef55b661fd8dd69682b38992225e86f6 (patch) | |
| tree | 65ca85f13617aee1dce474596800950f266a456c /roms/openbios/forth/testsuite/fract.fs | |
| download | qemu-master.tar.gz qemu-master.tar.bz2 qemu-master.zip  | |
Diffstat (limited to 'roms/openbios/forth/testsuite/fract.fs')
| -rw-r--r-- | roms/openbios/forth/testsuite/fract.fs | 35 | 
1 files changed, 35 insertions, 0 deletions
diff --git a/roms/openbios/forth/testsuite/fract.fs b/roms/openbios/forth/testsuite/fract.fs new file mode 100644 index 00000000..39c98405 --- /dev/null +++ b/roms/openbios/forth/testsuite/fract.fs @@ -0,0 +1,35 @@ +\ tag: forth fractal example +\  +\ Copyright (C) 2002, 2003 Volker Poplawski <volker@poplawski.de> +\                          Stefan Reinauer + +\ This example even fits in a signature ;-) + +\ hex 4666 dup negate do i 4000 dup 2* negate do 2a 0 dup 2dup 1e 0 do +\ 2swap * d >>a 4 pick + -rot - j + dup dup * e >>a rot dup dup * e >>a  +\ rot swap 2dup + 10000 > if 3drop 2drop 20 0 dup 2dup leave then loop  +\ 2drop 2drop type 268 +loop cr drop 5de +loop + + +: fract +4666 dup negate +do +    i 4000 dup 2* negate +    do +        2a 0 dup 2dup 1e 0 +	do +	    2swap * d >>a 4 pick + +	    -rot - j + +	    dup dup * e >>a rot +	    dup dup * e >>a rot +	    swap +	    2dup + 10000 > if +	        3drop 2drop 20 0 dup 2dup leave +	    then +	loop +	2drop 2drop +	emit +    268 +loop +    cr drop +5de +loop +;  | 
