X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Ffloat.4th;h=51ba1585f268468981c40b3cb1c9b0fb59069bed;hb=2899e37fdb0ecf89bb949cfcc0a9db2cac54677f;hp=2305749a9a8a51fcfee643d5a38a521fba17ac7d;hpb=a7e883b206fc496d7c0faaf713bb7bdd91ff29d3;p=scheme.forth.jl.git

diff --git a/src/float.4th b/src/float.4th
index 2305749..51ba158 100644
--- a/src/float.4th
+++ b/src/float.4th
@@ -2,9 +2,9 @@
 
 ( Cheating for now by using forth.jl CODE/END-CODE to
   access Julia's floating point support.  This isn't
-  at all portable.  That said, the year is 2016 and most
-  CPUs implement these operations - even the trig functions,
-  so I don't feel too bad! )
+  at all portable.  That said, the year is 2016 and
+  I've only cheated for words that have corresponding
+  x87 FPU instructions, so I don't feel too bad! )
 
 CODE f+
     b = reinterpret(Float64, popPS())
@@ -21,19 +21,24 @@ END-CODE
 CODE f*
     b = reinterpret(Float64, popPS())
     a = reinterpret(Float64, popPS())
-    pushPS(reinterpret(Int64, a*b))
+    pushPS(reinterpret(Int64, a*b + 0.0))
 END-CODE
 
 CODE f/
     b = reinterpret(Float64, popPS())
     a = reinterpret(Float64, popPS())
-    pushPS(reinterpret(Int64, a/b))
+    pushPS(reinterpret(Int64, a/b + 0.0))
 END-CODE
 
 CODE f^
     b = reinterpret(Float64, popPS())
     a = reinterpret(Float64, popPS())
-    pushPS(reinterpret(Int64, a^b))
+    pushPS(reinterpret(Int64, a^b + 0.0))
+END-CODE
+
+CODE fsqrt
+    a = reinterpret(Float64, popPS())
+    pushPS(reinterpret(Int64, sqrt(a)))
 END-CODE
 
 CODE f>
@@ -75,7 +80,7 @@ END-CODE
 CODE fmod
     b = reinterpret(Float64, popPS())
     a = reinterpret(Float64, popPS())
-    pushPS(reinterpret(Int64, a%b))
+    pushPS(reinterpret(Int64, a%b + 0.0))
 END-CODE
 
 CODE flog
@@ -88,6 +93,26 @@ CODE fexp
     pushPS(reinterpret(Int64, exp(a)))
 END-CODE
 
+CODE fsin
+    a = reinterpret(Float64, popPS())
+    pushPS(reinterpret(Int64, sin(a)))
+END-CODE
+
+CODE fcos
+    a = reinterpret(Float64, popPS())
+    pushPS(reinterpret(Int64, cos(a)))
+END-CODE
+
+CODE ftan
+    a = reinterpret(Float64, popPS())
+    pushPS(reinterpret(Int64, tan(a)))
+END-CODE
+
+CODE fatan
+    a = reinterpret(Float64, popPS())
+    pushPS(reinterpret(Int64, atan(a)))
+END-CODE
+
 CODE fnan?
     a = reinterpret(Float64, popPS())
     if isnan(a)
@@ -115,6 +140,16 @@ CODE f->i
     pushPS(Int64(round(a)))
 END-CODE
 
+CODE fabs
+    a = reinterpret(Float64, popPS())
+    pushPS(reinterpret(Int64, abs(a)))
+END-CODE
+
+CODE fround
+    a = reinterpret(Float64, popPS())
+    pushPS(reinterpret(Int64, round(a)))
+END-CODE
+
 : f/mod
     2dup fmod -rot f/ ;
 
@@ -133,15 +168,12 @@ END-CODE
 : flog10
     flog [ 10 i->f flog ] literal f/ ;
 
-: fabs
-    dup 0.0 f< if
-        -1.0 f*
-    then
-;
+: truncate
+    dup 1.0 fmod f- ;
 
 : floor
     dup 0.0 f>= if
-        dup 1.0 fmod f-
+        truncate
     else
         dup 1.0 fmod dup 0.0 <> if
             f- 1.0 f-
@@ -151,6 +183,31 @@ END-CODE
     then
 ;
 
+: ceiling
+    dup 0.0 f>= if
+        dup 1.0 fmod dup 0.0 <> if
+            f- 1.0 f+
+        else
+            drop
+        then
+    else
+        truncate
+    then
+;
+
+: fasin ( float -- res )
+    dup
+    dup f* 1.0 swap f- fsqrt
+    f/
+
+    fatan
+;
+
+: facos ( float -- res )
+    dup f* 1.0 swap f/ 1.0 f- fsqrt
+    fatan
+;
+
 : fhead ( float -- )
     floor f->i
     0 .R  ;
@@ -210,12 +267,13 @@ variable precision
     ." e" f->i 0 .R
 ;
 
-: f. ( float -- )
+: f.nospace ( float -- )
     dup fabs dup 1000000 i->f f>= swap 1 i->f 10000 i->f f/ f< or if
         f.scientific
     else
         f.plain
     then
-
-    space
 ;
+
+: f. ( float -- )
+    f.nospace space ;