version 1.14, 2009/04/08 19:59:17
|
version 1.16, 2009/09/21 15:32:56
|
Line 77
|
Line 77
|
\ ones mentioned above will be needed for successful testing. |
\ ones mentioned above will be needed for successful testing. |
|
|
BASE @ |
BASE @ |
HEX |
DECIMAL |
|
|
VARIABLE ACTUAL-DEPTH \ stack record |
VARIABLE ACTUAL-DEPTH \ stack record |
CREATE ACTUAL-RESULTS 20 CELLS ALLOT |
CREATE ACTUAL-RESULTS 32 CELLS ALLOT |
VARIABLE START-DEPTH |
VARIABLE START-DEPTH |
VARIABLE XCURSOR \ for ...}T |
VARIABLE XCURSOR \ for ...}T |
VARIABLE ERROR-XT |
VARIABLE ERROR-XT |
Line 112 HAS-FLOATING [IF]
|
Line 112 HAS-FLOATING [IF]
|
\ Set the following to the relative and absolute tolerances you |
\ Set the following to the relative and absolute tolerances you |
\ want for approximate float equality, to be used with F~ in |
\ want for approximate float equality, to be used with F~ in |
\ FNEARLY=. Keep the signs, because F~ needs them. |
\ FNEARLY=. Keep the signs, because F~ needs them. |
FVARIABLE REL-NEAR DECIMAL 1E-12 HEX REL-NEAR F! |
FVARIABLE REL-NEAR 1E-12 REL-NEAR F! |
FVARIABLE ABS-NEAR DECIMAL 0E HEX ABS-NEAR F! |
FVARIABLE ABS-NEAR 0E ABS-NEAR F! |
|
|
\ When EXACT? is TRUE, }F uses FEXACTLY=, otherwise FNEARLY=. |
\ When EXACT? is TRUE, }F uses FEXACTLY=, otherwise FNEARLY=. |
|
|
Line 121 HAS-FLOATING [IF]
|
Line 121 HAS-FLOATING [IF]
|
: SET-EXACT ( -- ) TRUE TO EXACT? ; |
: SET-EXACT ( -- ) TRUE TO EXACT? ; |
: SET-NEAR ( -- ) FALSE TO EXACT? ; |
: SET-NEAR ( -- ) FALSE TO EXACT? ; |
|
|
DECIMAL |
|
: FEXACTLY= ( F: X Y -- S: FLAG ) |
: FEXACTLY= ( F: X Y -- S: FLAG ) |
( |
( |
Leave TRUE if the two floats are identical. |
Leave TRUE if the two floats are identical. |
) |
) |
0E F~ ; |
0E F~ ; |
HEX |
|
|
|
: FABS= ( F: X Y -- S: FLAG ) |
: FABS= ( F: X Y -- S: FLAG ) |
( |
( |
Line 168 HAS-FLOATING [IF]
|
Line 166 HAS-FLOATING [IF]
|
|
|
HAS-FLOATING-STACK [IF] |
HAS-FLOATING-STACK [IF] |
VARIABLE ACTUAL-FDEPTH |
VARIABLE ACTUAL-FDEPTH |
CREATE ACTUAL-FRESULTS 20 FLOATS ALLOT |
CREATE ACTUAL-FRESULTS 32 FLOATS ALLOT |
VARIABLE START-FDEPTH |
VARIABLE START-FDEPTH |
VARIABLE FCURSOR |
VARIABLE FCURSOR |
|
|
Line 179 HAS-FLOATING-STACK [IF]
|
Line 177 HAS-FLOATING-STACK [IF]
|
FDEPTH START-FDEPTH @ > IF |
FDEPTH START-FDEPTH @ > IF |
FDEPTH START-FDEPTH @ DO FDROP LOOP |
FDEPTH START-FDEPTH @ DO FDROP LOOP |
THEN ; |
THEN ; |
|
|
: F{ ( -- ) |
: F{ ( -- ) |
FDEPTH START-FDEPTH ! 0 FCURSOR ! ; |
FDEPTH START-FDEPTH ! 0 FCURSOR ! ; |
|
|
Line 226 HAS-FLOATING-STACK [IF]
|
Line 224 HAS-FLOATING-STACK [IF]
|
: F...}T ; |
: F...}T ; |
|
|
HAS-FLOATING [IF] |
HAS-FLOATING [IF] |
DECIMAL |
|
: COMPUTE-CELLS-PER-FP ( -- U ) |
: COMPUTE-CELLS-PER-FP ( -- U ) |
DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ; |
DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ; |
HEX |
|
|
|
COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP |
COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP |
|
|