From 830e6b40d7d3a4c67302c65359c4989e2ff5a5de Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Sun, 19 Sep 2021 23:21:24 -0700
Subject: [PATCH] Adding docs high level float words.

---
 ueforth/Makefile              | 10 +++---
 ueforth/common/float_tests.fs | 37 +++++++++++++++++++++
 ueforth/common/floats.fs      | 29 +++++++++++-----
 ueforth/common/floats.h       |  3 +-
 ueforth/esp32/fuse_ino.js     |  6 ++--
 ueforth/site/common.html      | 62 +++++++++++++++++++++++++++++++++++
 6 files changed, 130 insertions(+), 17 deletions(-)

diff --git a/ueforth/Makefile b/ueforth/Makefile
index 7b8dc8d..0103708 100644
--- a/ueforth/Makefile
+++ b/ueforth/Makefile
@@ -12,7 +12,7 @@
 # See the License for the specific language governing permissions and
 # limitations under the License.
 
-VERSION=7.0.6.4
+VERSION=7.0.6.5
 STABLE_VERSION=7.0.5.4
 REVISION=$(shell git rev-parse HEAD)
 REVSHORT=$(shell echo $(REVISION) | head -c 7)
@@ -248,8 +248,8 @@ $(POSIX):
 $(POSIX)/ueforth: \
     posix/posix_main.c \
     common/opcodes.h \
-    common/floats.h \
     common/calls.h \
+    common/floats.h \
     common/interp.h \
     common/core.h \
     $(GEN)/posix_boot.h | $(POSIX)
@@ -264,8 +264,8 @@ $(WINDOWS):
 $(WINDOWS)/uEf32.obj: \
     windows/windows_main.c \
     common/opcodes.h \
-    common/floats.h \
     common/calls.h \
+    common/floats.h \
     common/core.h \
     windows/windows_interp.h \
     $(GEN)/windows_boot.h | $(WINDOWS)
@@ -279,8 +279,8 @@ $(WINDOWS)/uEf32.exe: \
 $(WINDOWS)/uEf64.obj: \
     windows/windows_main.c \
     common/opcodes.h \
-    common/floats.h \
     common/calls.h \
+    common/floats.h \
     common/core.h \
     windows/windows_interp.h \
     $(GEN)/windows_boot.h | $(WINDOWS)
@@ -298,8 +298,8 @@ $(ESP32)/ESP32forth:
 
 ESP32_PARTS = esp32/template.ino \
               common/opcodes.h \
-              common/floats.h \
               common/calling.h \
+              common/floats.h \
               common/core.h \
               common/interp.h \
               $(GEN)/esp32_boot.h
diff --git a/ueforth/common/float_tests.fs b/ueforth/common/float_tests.fs
index a7e4f86..12b68d5 100644
--- a/ueforth/common/float_tests.fs
+++ b/ueforth/common/float_tests.fs
@@ -62,3 +62,40 @@ e: test-throw
   foo cr
   out: 1 99.000000 
 ;e
+
+e: test-fconstant
+  100e fconstant foo
+  foo f. cr
+  out: 100.000000 
+;e
+
+e: test-fvariable
+  fvariable foo
+  100e foo sf!
+  foo sf@ fdup f* foo sf!
+  foo sf@ f. cr
+  out: 10000.000000 
+;e
+
+e: test-fcompare
+  123e 245e f< assert
+  123e 66e f> assert
+  123e 123e f>= assert
+  124e 123e f>= assert
+  123e 123e f<= assert
+  123e 124e f<= assert
+  123e 124e f<> assert
+  123e 123e f= assert
+;e
+
+e: test-fliteral
+  : foo [ 123e ] fliteral f. cr ;
+  foo
+  out: 123.000000 
+;e
+
+e: test-afliteral
+  : foo [ 123e afliteral ] f. cr ;
+  foo
+  out: 123.000000 
+;e
diff --git a/ueforth/common/floats.fs b/ueforth/common/floats.fs
index 61cf616..c61bf60 100644
--- a/ueforth/common/floats.fs
+++ b/ueforth/common/floats.fs
@@ -12,6 +12,26 @@
 \ See the License for the specific language governing permissions and
 \ limitations under the License.
 
+: f= ( r r -- f ) f- f0= ;
+: f< ( r r -- f ) f- f0< ;
+: f> ( r r -- f ) fswap f< ;
+: f<> ( r r -- f ) f= 0= ;
+: f<= ( r r -- f ) f> 0= ;
+: f>= ( r r -- f ) f< 0= ;
+
+4 constant sfloat
+: sfloats ( n -- n*4 ) sfloat * ;
+: sfloat+ ( a -- a ) sfloat + ;
+: sf, ( r -- ) here sf! sfloat allot ;
+
+: afliteral ( r -- ) ['] DOFLIT , sf, align ;
+: fliteral   afliteral ; immediate
+
+: fconstant ( r "name" ) create sf, align does> sf@ ;
+: fvariable ( "name" ) create sfloat allot align ;
+
+3.14159265359e fconstant pi
+
 : fsqrt ( r -- r ) 1e 20 0 do fover fover f/ f+ 0.5e f* loop fnip ;
 
 6 value precision
@@ -21,17 +41,10 @@ internals definitions
 : #f+s ( r -- ) fdup precision 0 ?do 10e f* loop
                 precision 0 ?do fdup f>s 10 mod [char] 0 + hold 0.1e f* loop
                 [char] . hold fdrop f>s #s ;
+transfer doflit
 forth definitions internals
 
 : #fs ( r -- ) fdup f0< if fnegate #f+s [char] - hold else #f+s then ;
 : f. ( r -- ) <# #fs #> type space ;
 
-(
-internals definitions
-$80000000 constant sign-mask
-$7f800000 constant exp-mask
-$3f000000 constant half-mask
-$007fffff constant mantissa-mask
-)
-
 forth definitions
diff --git a/ueforth/common/floats.h b/ueforth/common/floats.h
index 4aeeb05..c070a4e 100644
--- a/ueforth/common/floats.h
+++ b/ueforth/common/floats.h
@@ -24,7 +24,8 @@
   X("FOVER", FOVER, fp[1] = fp[-1]; ++fp) \
   X("FSWAP", FSWAP, float ft = fp[-1]; fp[-1] = *fp; *fp = ft) \
   X("FNEGATE", FNEGATE, *fp = -*fp) \
-  X("F0<", FZLESS, DUP; tos = *fp-- < 0 ? -1 : 0) \
+  X("F0<", FZLESS, DUP; tos = *fp-- < 0.0f ? -1 : 0) \
+  X("F0=", FZEQUAL, DUP; tos = *fp-- == 0.0f ? -1 : 0) \
   X("F+", FPLUS, fp[-1] += *fp; --fp) \
   X("F-", FMINUS, fp[-1] -= *fp; --fp) \
   X("F*", FSTAR, fp[-1] *= *fp; --fp) \
diff --git a/ueforth/esp32/fuse_ino.js b/ueforth/esp32/fuse_ino.js
index 5c11010..776d693 100755
--- a/ueforth/esp32/fuse_ino.js
+++ b/ueforth/esp32/fuse_ino.js
@@ -33,9 +33,9 @@ function DropCopyright(source) {
 var version = process.argv[2];
 var revision = process.argv[3];
 var code = fs.readFileSync(process.argv[4]).toString();
-var floats = DropCopyright(fs.readFileSync(process.argv[5]).toString());
-var opcodes = DropCopyright(fs.readFileSync(process.argv[6]).toString());
-var calling = DropCopyright(fs.readFileSync(process.argv[7]).toString());
+var opcodes = DropCopyright(fs.readFileSync(process.argv[5]).toString());
+var calling = DropCopyright(fs.readFileSync(process.argv[6]).toString());
+var floats = DropCopyright(fs.readFileSync(process.argv[7]).toString());
 var core = DropCopyright(fs.readFileSync(process.argv[8]).toString());
 var interp = DropCopyright(fs.readFileSync(process.argv[9]).toString());
 var boot = DropCopyright(fs.readFileSync(process.argv[10]).toString());
diff --git a/ueforth/site/common.html b/ueforth/site/common.html
index bbec5bc..080551f 100644
--- a/ueforth/site/common.html
+++ b/ueforth/site/common.html
@@ -124,6 +124,68 @@ <h5>Utilities</h5>
 ECHO ( -- a ) -- Address of flag that determines if commands are echoed
 </pre>
 
+<h5>Floating-Point</h5>
+<p><b>(Requires v7.0.6.5+)</b></p>
+<p>
+Single precision floating-point support is available as a work in progress.
+While initially left out in the name of minimalism,
+hardware support for floating-point argues some advantages to limited support.
+</p>
+<p>
+Floating point is kept on a separate stack.
+</p>
+<p>
+<b>NOTE: Tasks currently don't correctly support floating point.</b>
+A single floating point stack is shared by all tasks.
+</p>
+<pre>
+FLOAT OPCODES
+-------------
+DOFLIT ( --- ) Puts a float from the next cell onto float stack.
+FP@ ( -- a )
+FP! ( a -- )
+SF@ ( a -- r ) Single precision load
+SF! ( r a -- ) Single precision store
+FDUP ( r -- r r )
+FNIP ( ra rb -- rb )
+FDROP ( r -- )
+FOVER ( ra rb -- ra rb ra )
+FSWAP ( ra rb -- rb ra )
+F0&lt; ( r -- f )
+F0= ( r -- f )
+F+ ( r r -- r )
+F- ( r r -- r )
+F* ( r r -- r )
+F/ ( r r -- r )
+1/F ( r -- r )
+S&gt;F ( n -- r )
+F&gt;S ( r -- n )
+
+HIGH LEVEL
+----------
+F= ( r r -- f )
+F&lt; ( r r -- f )
+F&gt; ( r r -- f )
+F&lt;= ( r r -- f )
+F&gt;= ( r r -- f )
+F&lt;&gt; ( r r -- f )
+
+SFLOAT ( -- 4 )
+SFLOATS ( n -- n*4 )
+SFLOAT+ ( a -- a+4 )
+SF, ( r -- )
+
+AFLITERAL ( r -- )
+FLITERAL ( r -- ) IMMEDIATE
+
+FCONSTANT ( r "name" )
+FVARAIABLE ( "name" )
+
+PI ( -- r )
+
+FSQRT ( r r -- r )
+</pre>
+
 <h5>Locals</h5>
 
 <p>