alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Inline more floats.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-04 19:41:35 -08:00
parent 2111a6ca36
commit 4dd0d9e649
4 changed files with 41 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
ueforth/common/extra.fs
View File

@ -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 ;

14
ueforth/common/floats.fs
View File

@ -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 ;

15
ueforth/common/floats.h
View File

@ -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) \

22
ueforth/common/forth_namespace_tests.fs
View File

@ -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