Diff for /gforth/test/ttester.fs between versions 1.14 and 1.16

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
   

Removed from v.1.14  
changed lines
  Added in v.1.16


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>