Initial import of abandoned HQEMU version 2.5.2HEADmaster

1 files changed, 35 insertions, 0 deletions

diff --git a/src/roms/openbios/forth/testsuite/fract.fs b/src/roms/openbios/forth/testsuite/fract.fs
new file mode 100644
index 0000000..39c9840
--- /dev/null
+++ b/src/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
+;