[BACK]Return to ttester.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / test

Diff for /gforth/test/ttester.fs between versions 1.1 and 1.4

version 1.1, 2007/08/19 21:33:50 version 1.4, 2007/08/28 19:15:03
Line 1 Line 1
   \ for the original tester
 \ From: John Hayes S1I  \ From: John Hayes S1I
 \ Subject: tester.fr  \ Subject: tester.fr
 \ Date: Mon, 27 Nov 95 13:10:09 PST    \ Date: Mon, 27 Nov 95 13:10:09 PST  
   
 \ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY  \ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
 \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.  \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
 \ VERSION 1.1  \ VERSION 1.1
   
 \ revised by Anton Ertl 2007-08-12, 2007-08-19  \ for the FNEARLY= stuff:
   \ from ftester.fs written by David N. Williams, based on the idea of
   \ approximate equality in Dirk Zoller's float.4th
   \ public domain
   
   \ for the rest:
   \ revised by Anton Ertl 2007-08-12, 2007-08-19, 2007-08-28
   \ public domain
   
 \ The original has the following shortcomings:  \ The original has the following shortcomings:
   
 \ - It does not work as expected if the stack is non-empty before the {.  \ - It does not work as expected if the stack is non-empty before the {.
Line 22 Line 30
 \ http://www.forth200x.org/tests/ttester.fs  \ http://www.forth200x.org/tests/ttester.fs
   
 \ tester.fs is intended to be a drop-in replacement of the original.  \ tester.fs is intended to be a drop-in replacement of the original.
 \ ttester.fs is a version that uses T{ and }T instead of { and }.  
   \ ttester.fs is a version that uses T{ and }T instead of { and } and
   \ keeps the BASE as it was before loading ttester.fs
   
 \ In spirit of the original, I have strived to avoid any potential  \ In spirit of the original, I have strived to avoid any potential
 \ non-portabilities and stayed as much within the CORE words as  \ non-portabilities and stayed as much within the CORE words as
Line 50 Line 60
 \ system or if you need only exact matching, you can use the plain }T  \ system or if you need only exact matching, you can use the plain }T
 \ instead.  \ instead.
   
   BASE @
 HEX  HEX
   
 \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY  \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
Line 205  HAS-FLOATING-STACK [IF] Line 216  HAS-FLOATING-STACK [IF]
     : F} ;      : F} ;
     : F...}T ;      : F...}T ;
   
       DECIMAL
     : COMPUTE-CELLS-PER-FP ( -- U )      : COMPUTE-CELLS-PER-FP ( -- U )
         DEPTH 0E DEPTH >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
           
Line 238  HAS-FLOATING-STACK [IF] Line 251  HAS-FLOATING-STACK [IF]
 ' ERROR1 ERROR-XT !  ' ERROR1 ERROR-XT !
   
 : T{            \ ( -- ) SYNTACTIC SUGAR.  : T{            \ ( -- ) SYNTACTIC SUGAR.
    DEPTH START-DEPTH ! F{ ;     DEPTH START-DEPTH ! 0 XCURSOR ! F{ ;
   
 : ->            \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.  : ->            \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
    DEPTH DUP ACTUAL-DEPTH !             \ RECORD DEPTH     DEPTH DUP ACTUAL-DEPTH !             \ RECORD DEPTH
Line 315  HAS-FLOATING-STACK [IF] Line 328  HAS-FLOATING-STACK [IF]
    IF DUP >R TYPE CR R> >IN !     IF DUP >R TYPE CR R> >IN !
    ELSE >IN ! DROP     ELSE >IN ! DROP
    THEN ;     THEN ;
   
   BASE !
   
Removed from v.1.1  
changed lines
  Added in v.1.4

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