Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.forth > #135061

IEEE floating point comparisons

From Krishna Myneni <krishna.myneni@ccreweb.org>
Newsgroups comp.lang.forth
Subject IEEE floating point comparisons
Date 2026-05-03 22:00 -0500
Organization A noiseless patient Spider
Message-ID <10t9259$3c72d$1@dont-email.me> (permalink)

Show all headers | View raw


Below is preliminary test code for floating point comparisons for 
systems with expected IEEE 754 behavior.

Relevant floating point exceptions should be masked.

Please let me know if you find any errors in the tests.

The tests pass on recent kForth-32/64 development versions (v2.8.0 and 
v0.8.0, respectively):
TESTING F=
TESTING F<>
TESTING F<
TESTING F>
TESTING F<=
TESTING F>=
TESTING F0=
TESTING F0<
TESTING F0>

The auxiliary code, ieee-754.4th, which defines special values is also 
attached below.

--
Krishna Myneni

2 attachments:

ieee-comparisons-test.4th
ieee-754.4th

\ ===== begin ieee-comparisons-test.4th =====
\ ieee-comparisons-test.4th
\
\ Comparison of IEEE 754 special values
\ Floating point exceptions should be masked.
\
\ include ans-words.4th (needed for kForth only)
include ttester.4th
include ieee-754.4th

TESTING F=
\ F= sanity tests
t{ -1e  -1e  F= -> true  }t
t{ -1e   1e  F= -> false }t
t{  1e  -1e  F= -> false }t
t{  1e   1e  F= -> true  }t

\ F= NAN tests
t{ +NAN +NAN F= -> false }t
t{ +NAN -NAN F= -> false }t
t{ +NAN +INF F= -> false }t
t{ -NAN +INF F= -> false }t
t{ +NAN -INF F= -> false }t
t{ -NAN -INF F= -> false }t
t{ +NAN  0e  F= -> false }t
t{ -NAN  0e  F= -> false }t
t{ +NAN -0e  F= -> false }t
t{ -NAN -0e  F= -> false }t

\ F= +/-0 and +/-INF tests
t{ -0e  -0e  F= -> true  }t
t{ -0e   0e  F= -> true  }t
t{  0e  -0e  F= -> true  }t
t{  0e   0e  F= -> true  }t
t{ -INF -0e  F= -> false }t
t{ -INF  0e  F= -> false }t
t{ +INF -0e  F= -> false }t
t{ +INF  0e  F= -> false }t
t{ +INF -INF F= -> false }t
t{ +INF +INF F= -> true  }t
t{ -INF -INF F= -> true  }t
t{ -INF +INF F= -> false }t


TESTING F<>
\ F<> sanity tests
t{ -1e  -1e  F<> -> false }t
t{ -1e   1e  F<> -> true  }t
t{  1e  -1e  F<> -> true  }t
t{  1e   1e  F<> -> false }t

\ F<> NAN tests
t{ +NAN +NAN F<> -> true }t
t{ +NAN -NAN F<> -> true }t
t{ +NAN +INF F<> -> true }t
t{ -NAN +INF F<> -> true }t
t{ +NAN -INF F<> -> true }t
t{ -NAN -INF F<> -> true }t
t{ +NAN  0e  F<> -> true }t
t{ -NAN  0e  F<> -> true }t
t{ +NAN -0e  F<> -> true }t
t{ -NAN -0e  F<> -> true }t

\ F<> +/-0 and +/-INF tests
t{ -0e  -0e  F<> -> false }t
t{ -0e   0e  F<> -> false }t
t{  0e  -0e  F<> -> false }t
t{  0e   0e  F<> -> false }t
t{ -INF -0e  F<> -> true  }t
t{ -INF  0e  F<> -> true  }t
t{ +INF -0e  F<> -> true  }t
t{ +INF  0e  F<> -> true  }t
t{ +INF -INF F<> -> true  }t
t{ +INF +INF F<> -> false }t
t{ -INF -INF F<> -> false }t
t{ -INF +INF F<> -> true  }t


TESTING F<
\ F< sanity tests
t{ -1e  -1e  F< -> false }t
t{ -1e   1e  F< -> true  }t
t{  1e  -1e  F< -> false }t
t{  1e   1e  F< -> false }t

\ F< NAN tests
t{ +NAN +NAN F< -> false }t
t{ +NAN -NAN F< -> false }t
t{ +NAN +INF F< -> false }t
t{ -NAN +INF F< -> false }t
t{ +NAN -INF F< -> false }t
t{ -NAN -INF F< -> false }t
t{ +NAN  0e  F< -> false }t
t{ -NAN  0e  F< -> false }t
t{ +NAN -0e  F< -> false }t
t{ -NAN -0e  F< -> false }t

\ F< +/-0 and +/-INF tests
t{ -0e  -0e  F< -> false }t
t{ -0e   0e  F< -> false }t
t{  0e  -0e  F< -> false }t
t{  0e   0e  F< -> false }t
t{ -INF -0e  F< -> true  }t
t{ -INF  0e  F< -> true  }t
t{ +INF -0e  F< -> false }t
t{ +INF  0e  F< -> false }t
t{ +INF -INF F< -> false }t
t{ +INF +INF F< -> false }t
t{ -INF -INF F< -> false }t
t{ -INF +INF F< -> true  }t


TESTING F>
\ F> sanity tests
t{ -1e  -1e  F> -> false }t
t{ -1e   1e  F> -> false }t
t{  1e  -1e  F> -> true  }t
t{  1e   1e  F> -> false }t

\ F> NAN tests
t{ +NAN +NAN F> -> false }t
t{ +NAN -NAN F> -> false }t
t{ +NAN +INF F> -> false }t
t{ -NAN +INF F> -> false }t
t{ +NAN -INF F> -> false }t
t{ -NAN -INF F> -> false }t
t{ +NAN  0e  F> -> false }t
t{ -NAN  0e  F> -> false }t
t{ +NAN -0e  F> -> false }t
t{ -NAN -0e  F> -> false }t

\ F> +/-0 and +/-INF tests
t{ -0e  -0e  F> -> false }t
t{ -0e   0e  F> -> false }t
t{  0e  -0e  F> -> false }t
t{  0e   0e  F> -> false }t
t{ -INF -0e  F> -> false }t
t{ -INF  0e  F> -> false }t
t{ +INF -0e  F> -> true  }t
t{ +INF  0e  F> -> true  }t
t{ +INF -INF F> -> true  }t
t{ +INF +INF F> -> false }t
t{ -INF -INF F> -> false }t
t{ -INF +INF F> -> false }t


TESTING F<=
\ F<= sanity tests
t{ -1e  -1e  F<= -> true }t
t{ -1e   1e  F<= -> true }t
t{  1e  -1e  F<= -> false }t
t{  1e   1e  F<= -> true }t

\ F<= NAN tests
t{ +NAN +NAN F<= -> false }t
t{ +NAN -NAN F<= -> false }t
t{ +NAN +INF F<= -> false }t
t{ -NAN +INF F<= -> false }t
t{ +NAN -INF F<= -> false }t
t{ -NAN -INF F<= -> false }t
t{ +NAN  0e  F<= -> false }t
t{ -NAN  0e  F<= -> false }t
t{ +NAN -0e  F<= -> false }t
t{ -NAN -0e  F<= -> false }t

\ F<= +/-0 and +/-INF tests
t{ -0e  -0e  F<= -> true }t
t{ -0e   0e  F<= -> true }t
t{  0e  -0e  F<= -> true }t
t{  0e   0e  F<= -> true }t
t{ -INF -0e  F<= -> true }t
t{ -INF  0e  F<= -> true }t
t{ +INF -0e  F<= -> false }t
t{ +INF  0e  F<= -> false }t
t{ +INF -INF F<= -> false }t
t{ +INF +INF F<= -> true }t
t{ -INF -INF F<= -> true }t
t{ -INF +INF F<= -> true }t


TESTING F>=
\ F>= sanity tests
t{ -1e  -1e  F>= -> true }t
t{ -1e   1e  F>= -> false }t
t{  1e  -1e  F>= -> true }t
t{  1e   1e  F>= -> true }t

\ F>= NAN tests
t{ +NAN +NAN F>= -> false }t
t{ +NAN -NAN F>= -> false }t
t{ +NAN +INF F>= -> false }t
t{ -NAN +INF F>= -> false }t
t{ +NAN -INF F>= -> false }t
t{ -NAN -INF F>= -> false }t
t{ +NAN  0e  F>= -> false }t
t{ -NAN  0e  F>= -> false }t
t{ +NAN -0e  F>= -> false }t
t{ -NAN -0e  F>= -> false }t

\ F>= +/-0 and +/-INF tests
t{ -0e  -0e  F>= -> true }t
t{ -0e   0e  F>= -> true }t
t{  0e  -0e  F>= -> true }t
t{  0e   0e  F>= -> true }t
t{ -INF -0e  F>= -> false }t
t{ -INF  0e  F>= -> false }t
t{ +INF -0e  F>= -> true }t
t{ +INF  0e  F>= -> true }t
t{ +INF -INF F>= -> true }t
t{ +INF +INF F>= -> true }t
t{ -INF -INF F>= -> true }t
t{ -INF +INF F>= -> false }t


TESTING F0=
\ F0= NAN tests
t{ +NAN F0= -> false }t
t{ -NAN F0= -> false }t

TESTING F0<
\ F0< NAN tests
t{ +NAN F0< -> false }t
t{ -NAN F0< -> false }t

TESTING F0>
\ F0> NAN tests
t{ +NAN F0> -> false }t
t{ -NAN F0> -> false }t

\ ===== end ieee-comparisons-test.4th =====


\ ===== begin ieee-754.4th =====
\ ieee-754.4th
\
\ Provides additional definitions for IEEE 754 double-precision
\ floating point arithmetic on x87 FPU.
\
\ GLOSSARY:
\
\ Generic construction of a double-precision float from its
\ binary fields:
\
\   MAKE-IEEE-DFLOAT ( signbit udfraction uexp -- r nerror )
\                    ( signbit udfraction uexp -- nerror ) ( F: -- r)
\
\ Binary fields of IEEE 754 floating point values
\
\   FSIGNBIT    ( F: r -- ) ( -- minus? )
\   FEXPONENT   ( F: r -- ) ( -- uexp )
\   FFRACTION   ( F: r -- ) ( -- udfraction )
\
\   FINITE?     ( F: r -- ) ( -- flag )
\   FNORMAL?    ( F: r -- ) ( -- flag )
\   FSUBNORMAL? ( F: r -- ) ( -- flag )
\   FINFINITE?  ( F: r -- ) ( -- flag )
\   FNAN?       ( F: r -- ) ( -- flag )
\
\ Exception flag words
\
\   GET-FFLAGS  ( excpts -- flags )
\   CLEAR-ALL-FFLAGS  ( -- )
\
\ IEEE 754 special values:
\
\   +INF        ( F: -- r )
\   -INF        ( F: -- r )
\   +NAN        ( F: -- r )
\   -NAN        ( F: -- r )
\
\ To be implemented:
\
\   FCOPYSIGN     ( F: r1 r2 -- r3 )
\   FNEARBYINT    ( F: r1 -- r2 )
\   FNEXTUP       ( F: r1 -- r2 )
\   FNEXTDOWN     ( F: r1 -- r2 )
\   FSCALBN       ( n -- ) ( F: r -- r*2^n )
\   FLOGB         ( F: r -- e )
\   FREMAINDER    ( F: x y -- r q )
\   CLEAR-FFLAGS  ( excepts -- )
\   SET-FFLAGS    ( excepts -- )
\   FENABLE       ( excepts -- )
\   FDISABLE      ( excepts -- )
\
\
\ These words are based on the Optional IEEE 754 Binary Floating
\ Point word set(s) proposed by David N. Williams [1]. A few of
\ the words provided here are additional convenience words which
\ are not part of the proposals in Ref. 1.
\
\ K. Myneni, 2020-08-20
\ Revs. 2020-08-27, 2022-08-02, 2026-02-08
\
\ References:
\ 1. David N. Williams, Proposal Drafts for Optional IEEE 754
\    Binary Floating Point Word Set, 27 August 2020.
\    http://www-personal.umich.edu/~williams/archive/forth/ieeefp-drafts/
\
BASE @
DECIMAL
0e fconstant F=ZERO
HEX


\ Make an IEEE 754 double precision floating point value from
\ the specified bits for the sign, binary fraction, and exponent.
\ Return the fp value and error code with the following meaning:
\   0  no error
\   1  exponent out of range
\   2  fraction out of range
fvariable temp

: MAKE-IEEE-DFLOAT ( signbit udfraction uexp -- r nerror )
     dup 800 u< invert IF 2drop 2drop F=ZERO 1 EXIT THEN
     14 lshift 3 pick 1F lshift or >r
     dup 100000 u< invert IF
       r> 2drop 2drop F=ZERO 2 EXIT
     THEN
     r> or [ temp 4 + ] literal L! temp L!
     drop temp df@ 0 ;

: FSIGNBIT ( F: r -- ) ( -- minus? )
     temp df! [ temp 4 + ] literal UL@ 80000000 and 0<> ;

: FEXPONENT ( F: r -- ) ( -- u )
     temp df! [ temp 4 + ] literal UL@ 14 rshift 7FF and ;

: FFRACTION ( F: r -- ) ( -- ud )
     temp df! temp UL@  [ temp 4 + ] literal UL@ 000FFFFF and ;

: FINITE?  ( F: r -- ) ( -- [normal|subnormal]? ) fexponent 7FF <> ;

: FNORMAL? ( F: r -- ) ( -- normal? )  fexponent 0<> ;

: FSUBNORMAL? ( F: r -- ) ( -- subnormal? )  fexponent 0= ;

: FINFINITE? ( F: r -- ) ( -- [+/-]Inf? )
    finite? invert ;

: FNAN? ( F: r -- ) ( -- nan? )
    fdup FEXPONENT 7FF = >r FFRACTION D0= invert r> and ;


\ Exception bits in fpu status word

  1  constant  FINVALID
  4  constant  FDIVBYZERO
  8  constant  FOVERFLOW
10  constant  FUNDERFLOW
20  constant  FINEXACT

FINVALID FDIVBYZERO or FOVERFLOW or FUNDERFLOW or FINEXACT or
constant ALL-FEXCEPTS

1 cells 4 = [IF]

[DEFINED] getFPUstatusX86 [IF]

: GET-FFLAGS ( excepts -- flags )
     getFPUstatusX86 fpu-status @ and ;

: CLEAR-ALL-FFLAGS ( -- ) clearFPUexceptionsX86 ;

: CLEAR-FFLAGS ( excepts -- )
;

: SET-FFLAGS ( excepts -- )
;

: FENABLE ( excepts -- )
;

: FDISABLE ( excepts -- )
;

: FCOPYSIGN ( F: r1 r2 -- r3 )
;

: FNEARBYINT ( F: r1 -- r2 )
;

: FNEXTUP ( F: r1 -- r2 )
;

: FNEXTDOWN ( F: r1 -- r2 )
;

: FSCALBN ( r n -- r*2^n )
;

: FLOGB ( F: r -- e )
;

: FREMAINDER ( F: x y -- r q )

;
[ELSE]
cr .( Some functions are not available.) cr
[THEN]
[ELSE]
cr .( Some functions are for 32-bit system only!) cr
[THEN]

\ Constants representing  -INF  +INF  -NAN  +NAN
true  0 0 7FF make-ieee-dfloat 0= [IF] fconstant -INF [ELSE] fdrop [THEN]
[DEFINED] -INF [IF] -INF fnegate fconstant +INF [THEN]
true  1 0 7FF make-ieee-dfloat 0= [IF] fconstant -NAN [ELSE] fdrop [THEN]
[DEFINED] -NAN [IF] -NAN fnegate fconstant +NAN [THEN]


BASE !
\ ===== end ieee-754.4th =====

Back to comp.lang.forth | Previous | NextNext in thread | Find similar | Unroll thread


Thread

IEEE floating point comparisons Krishna Myneni <krishna.myneni@ccreweb.org> - 2026-05-03 22:00 -0500
  Re: IEEE floating point comparisons Krishna Myneni <krishna.myneni@ccreweb.org> - 2026-05-03 22:18 -0500
  Re: IEEE floating point comparisons peter <peter.noreply@tin.it> - 2026-05-04 09:43 +0200
    Re: IEEE floating point comparisons Krishna Myneni <krishna.myneni@ccreweb.org> - 2026-05-04 07:29 -0500
      Re: IEEE floating point comparisons minforth <minforth@gmx.net> - 2026-05-04 21:53 +0200
        Re: IEEE floating point comparisons Krishna Myneni <krishna.myneni@ccreweb.org> - 2026-05-04 17:20 -0500
        Re: IEEE floating point comparisons dxf <dxforth@gmail.com> - 2026-05-05 11:32 +1000
  Re: IEEE floating point comparisons Krishna Myneni <krishna.myneni@ccreweb.org> - 2026-05-06 08:23 -0500

csiph-web