(     Title:  FNEXTUP, Andrew Haley's IEEE-FP reference
              implementation with tests
       File:  fnextup.fs
    Version:  0.9.0
    Revised:  July 28, 2009
     Author:  David N. Williams

The date above may reflect cosmetic changes not logged here.

Version 0.9.0
25Jul09 * Removed FNEXTAFTER.  Replaced the FNEXTUP's with
          Andrew Haley's c.l.f. version.
        * Replaced hexfloat.fs with rawfloat.fs, and with
          mixfloat.fs for the tests.
28Jul09 * Removed redundancy in FNEXTUP +inf case.
        * Added conditional def of +INF, and made -INF def
          conditional.

Version 0.1.0
11Jul09 * Version based on FNEXTAFTER posted by Marcel Hendrix
          at nntp://comp.lang.forth.
16Jul09 * Portability revision with tests.  Added pfe
          experimental ieeefp option for FNEXTAFTER.
18Jul09 * Added two versions using FLOGB and FSCALBN, one using
          FCLASSIFY, from pfe experimental ieeefp.
19Jul09 * Added more tests.
21Jul09 * Fixed error in FCLASSIFY version of FNEXTUP for
          negative powers of two.  Added FNEXTDOWN, and tests
          for more boundaries.
22Jul09 * Removed nonportable parts, expanded tests.
        * Removed unwanted FSCALB rounding from FCLASSIFY
          version of FNEXTUP.  Added more boundary tests.
)

s" rawfloat.fs" included  \ fails if bits/cell <> 32, or not two's complement
decimal

bits/float 64 <>
[IF] cr .( ***This code requires 64 bits/float.) ABORT [THEN]

[UNDEFINED] \\ [IF]  \ for degugging
: \\  ( -- )  -1 parse 2drop BEGIN refill 0= UNTIL ; [THEN]

[UNDEFINED] F-ROT [IF]  : F-ROT  frot frot ; [THEN]

[UNDEFINED] +INF [IF] 1e 0e f/     fconstant +inf [THEN]
[UNDEFINED] -INF [IF] +inf fnegate fconstant -inf [THEN]

: NAN?  ( f: r -- s: nan? )  fdup f= 0= ;

: FNEXTUP  ( f: x -- y)  \ aph
\   fdup nan?    IF EXIT THEN
\   fdup +inf f= IF EXIT THEN
   fdup nan? fdup +inf f= or IF EXIT THEN
   0.0e f+      \ convert -0 to +0
   f>raw dup 0< IF  1 0 d-  ELSE  1 0 d+  THEN raw>f ;

: FNEXTDOWN  ( f: x -- y )  fnegate fnextup fnegate ;

true [IF]  \ tests

s" mixfloat.fs" included  \ for mixed hex/decimal input, MIX>F
s" ttester.fs"  included
true verbose !
set-exact
decimal
variable #errors   0 #errors !

:noname  ( c-addr u -- )
(
Display an error message followed by the line that had the
error.
)
  1 #errors +! error1 ; error-xt !

0e fabs       fconstant +0
+0 fnegate    fconstant -0
0e 0e f/ fabs fconstant +nan
+nan fnegate  fconstant -nan
1e +0 f/      fconstant +inf

s"  1.F FFFF FFFF FFFF p+1023" mix>f fconstant  max-+n
s"  1.0 0000 0000 0000 p-1022" mix>f fconstant  min-+n 
s"  0.F FFFF FFFF FFFF p-1022" mix>f fconstant  max-+subn
s"  0.0 0000 0000 0001 p-1022" mix>f fconstant  min-+subn

s" -0.0 0000 0000 0001 p-1022" mix>f fconstant -min-+subn
s" -0.F FFFF FFFF FFFF p-1022" mix>f fconstant -max-+subn
s" -1.0 0000 0000 0000 p-1022" mix>f fconstant -min-+n 
s" -1.F FFFF FFFF FFFF p+1023" mix>f fconstant -max-+n

s"  1.0 0000 0000 0001 p-1022" mix>f fconstant min-+n-up
s" -1.0 0000 0000 0001 p-1022" mix>f fconstant [-min-+n]-down

s"  1.0 0000 0000 0001 p0"     mix>f fconstant 1-up
s"  1.F FFFF FFFF FFFF p-1"    mix>f fconstant 1-down
s" -1.F FFFF FFFF FFFF p-1"    mix>f fconstant [-1]-up
s" -1.0 0000 0000 0001 p0"     mix>f fconstant [-1]-down
s"  1.0 0000 0000 0001 p1"     mix>f fconstant 2-up
s"  1.F FFFF FFFF FFFF p0"     mix>f fconstant 2-down
s" -1.F FFFF FFFF FFFF p0"     mix>f fconstant [-2]-up
s" -1.0 0000 0000 0001 p1"     mix>f fconstant [-2]-down

s"  1.F FFFF FFFF FFFE p+1023" mix>f fconstant max-+n-down
s" -1.F FFFF FFFF FFFE p+1023" mix>f fconstant [-max-+n]-up

cr
testing FNEXTUP

\ nan propagation
t{ +nan FNEXTUP -> +nan }t
t{ -nan FNEXTUP -> -nan }t

\ max-+n boundary
t{ +inf         FNEXTUP -> +inf }t
t{  max-+n      FNEXTUP -> +inf }t
t{  max-+n-down FNEXTUP ->  max-+n }t

\ +normal integer boundaries
t{  2e     FNEXTUP ->  2-up }t
t{  2-down FNEXTUP ->  2e }t
t{  1e     FNEXTUP ->  1-up }t
t{  1-down FNEXTUP ->  1e }t

\ +subnormal boundaries
t{  min-+subn FNEXTUP ->  min-+subn f2* }t
t{  max-+subn FNEXTUP ->  min-+n }t
t{  min-+n    FNEXTUP ->  min-+n-up }t

\ +/-0 boundaries
t{ +0         FNEXTUP ->  min-+subn }t
t{ -0         FNEXTUP ->  min-+subn }t
t{ -min-+subn FNEXTUP -> -0 }t

\ -subnormal boundaries
t{ -min-+subn f2* FNEXTUP -> -min-+subn }t
t{ [-min-+n]-down FNEXTUP -> -min-+n }t
t{ -min-+n        FNEXTUP -> -max-+subn }t

\ -normal integer boundaries
t{ -1e        FNEXTUP -> [-1]-up }t 
t{  [-1]-down FNEXTUP -> -1e }t
t{ -2e        FNEXTUP -> [-2]-up }t 
t{  [-2]-down FNEXTUP -> -2e }t

\ -max-+n boundary
t{ -max-+n FNEXTUP -> [-max-+n]-up }t
t{ -inf    FNEXTUP -> -max-+n }t

testing FNEXTDOWN

\ nan propagation
t{ +nan FNEXTDOWN -> +nan }t
t{ -nan FNEXTDOWN -> -nan }t

\ max-+n boundary
t{ +inf    FNEXTDOWN ->  max-+n }t
t{  max-+n FNEXTDOWN ->  max-+n-down }t

\ +normal integer boundaries
t{  2-up FNEXTDOWN ->  2e }t
t{  2e   FNEXTDOWN ->  2-down }t
t{  1-up FNEXTDOWN ->  1e }t
t{  1e   FNEXTDOWN ->  1-down }t

\ +subnormal boundaries
t{  min-+n-up     FNEXTDOWN ->  min-+n }t
t{  min-+n        FNEXTDOWN ->  max-+subn }t 
t{  min-+subn f2* FNEXTDOWN ->  min-+subn }t 

\ +/-0 boundaries
t{ min-+subn FNEXTDOWN -> +0 }t
t{ +0        FNEXTDOWN ->  -min-+subn }t
t{ -0        FNEXTDOWN ->  -min-+subn }t

\ -subnormal boundaries
t{ -min-+subn FNEXTDOWN -> -min-+subn f2* }t
t{ -max-+subn FNEXTDOWN -> -min-+n }t
t{ -min-+n    FNEXTDOWN -> [-min-+n]-down }t

\ -normal integer boundaries
t{ [-1]-up FNEXTDOWN -> -1e }t 
t{ -1e     FNEXTDOWN -> [-1]-down }t 
t{ [-2]-up FNEXTDOWN -> -2e }t 
t{ -2e     FNEXTDOWN -> [-2]-down }t 

\ -max-+n boundary
t{ [-max-+n]-up FNEXTDOWN -> -max-+n }t
t{ -max-+n FNEXTDOWN -> -inf }t
t{ -inf    FNEXTDOWN -> -inf }t

verbose @ [IF]
cr .( #ERRORS: ) #errors @ . cr
[THEN]

[THEN]  \ tests