From 4dd0d9e649a5f78f384e7a5df20e85610c965197 Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Fri, 4 Feb 2022 19:41:35 -0800
Subject: [PATCH] Inline more floats.

---
 ueforth/common/extra.fs                 | 16 ++++++++++++++++
 ueforth/common/floats.fs                | 14 --------------
 ueforth/common/floats.h                 | 15 ++++++++++++++-
 ueforth/common/forth_namespace_tests.fs | 22 +++++++++++-----------
 4 files changed, 41 insertions(+), 26 deletions(-)

diff --git a/ueforth/common/extra.fs b/ueforth/common/extra.fs
index 3c3948b..2d189bf 100644
--- a/ueforth/common/extra.fs
+++ b/ueforth/common/extra.fs
@@ -59,3 +59,19 @@
 : min 2dup < if drop else nip then ;
 : max 2dup < if nip else drop then ;
 : abs ( n -- +n ) dup 0< if negate then ;
+
+: 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 + ;
+
+3.14159265359e fconstant pi
+
+: fsqrt ( r -- r ) 1e 20 0 do fover fover f/ f+ 0.5e f* loop fnip ;
+
diff --git a/ueforth/common/floats.fs b/ueforth/common/floats.fs
index d9410a7..6e7c24f 100644
--- a/ueforth/common/floats.fs
+++ b/ueforth/common/floats.fs
@@ -12,16 +12,6 @@
 \ 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 ;
@@ -30,10 +20,6 @@
 : 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
 : set-precision ( n -- ) to precision ;
 
diff --git a/ueforth/common/floats.h b/ueforth/common/floats.h
index 081eed2..4c20050 100644
--- a/ueforth/common/floats.h
+++ b/ueforth/common/floats.h
@@ -26,6 +26,12 @@
   X("FNEGATE", FNEGATE, *fp = -*fp) \
   X("F0<", FZLESS, DUP; tos = *fp-- < 0.0f ? -1 : 0) \
   X("F0=", FZEQUAL, DUP; tos = *fp-- == 0.0f ? -1 : 0) \
+  X("F=", FEQUAL, DUP; tos = fp[-1] == fp[0] ? -1 : 0; fp -= 2) \
+  X("F<", FLESS, DUP; tos = fp[-1] < fp[0] ? -1 : 0; fp -= 2) \
+  X("F>", FGREATER, DUP; tos = fp[-1] > fp[0] ? -1 : 0; fp -= 2) \
+  X("F<>", FNEQUAL, DUP; tos = fp[-1] != fp[0] ? -1 : 0; fp -= 2) \
+  X("F<=", FLESSEQ, DUP; tos = fp[-1] <= fp[0] ? -1 : 0; fp -= 2) \
+  X("F>=", FGREATEREQ, DUP; tos = fp[-1] >= fp[0] ? -1 : 0; fp -= 2) \
   X("F+", FPLUS, fp[-1] += *fp; --fp) \
   X("F-", FMINUS, fp[-1] -= *fp; --fp) \
   X("F*", FSTAR, fp[-1] *= *fp; --fp) \
@@ -33,4 +39,11 @@
   X("1/F", FINVERSE, *fp = 1.0 / *fp) \
   X("S>F", STOF, *++fp = (float) tos; DROP) \
   X("F>S", FTOS, DUP; tos = (cell_t) *fp--) \
-  X("F>NUMBER?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp); --sp)
+  X("F>NUMBER?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp); --sp) \
+  Y(SFLOAT, DUP; tos = sizeof(float)) \
+  Y(SFLOATS, tos *= sizeof(float)) \
+  X("SFLOAT+", SFLOATPLUS, DUP; tos += sizeof(float)) \
+  Y(PI, *++fp = 3.14159265359f) \
+  Y(FSQRT, float fx = *fp; float ft = 1.0f; \
+      for (w = 0; w < 20; ++w) ft = (fx / ft + ft) * 0.5f; *fp = ft) \
+
diff --git a/ueforth/common/forth_namespace_tests.fs b/ueforth/common/forth_namespace_tests.fs
index 65d52db..a826a90 100644
--- a/ueforth/common/forth_namespace_tests.fs
+++ b/ueforth/common/forth_namespace_tests.fs
@@ -29,22 +29,11 @@ e: check-highlevel-floats
   out: #fs 
   out: set-precision 
   out: precision 
-  out: fsqrt 
-  out: pi 
   out: fvariable 
   out: fconstant 
   out: fliteral 
   out: afliteral 
   out: sf, 
-  out: sfloat+ 
-  out: sfloats 
-  out: sfloat 
-  out: f>= 
-  out: f<= 
-  out: f<> 
-  out: f> 
-  out: f< 
-  out: f= 
 ;e
 
 e: check-boot
@@ -258,6 +247,11 @@ e: check-core-opcodes
 ;e
 
 e: check-float-opcodes
+  out: FSQRT 
+  out: PI 
+  out: SFLOAT+ 
+  out: SFLOATS 
+  out: SFLOAT 
   out: F>NUMBER? 
   out: F>S 
   out: S>F 
@@ -266,6 +260,12 @@ e: check-float-opcodes
   out: F* 
   out: F- 
   out: F+ 
+  out: F>= 
+  out: F<= 
+  out: F<> 
+  out: F> 
+  out: F< 
+  out: F= 
   out: F0= 
   out: F0< 
   out: FNEGATE