Diff for /gforth/contrib/divspeed.fs between versions 1.1 and 1.4

version 1.1, 2006/10/28 08:44:25 version 1.4, 2007/02/08 14:07:31
Line 2 Line 2
 \  \
 \ Measure speed of division words in gforth.  \ Measure speed of division words in gforth.
 \  \
 \ Krishna Myneni, 2006-10-26  \ Krishna Myneni, 2006-10-26;
   \ Revisions:
   \    2006-10-28  change DIVIDEND for 32-bit systems;
   \                add tests for */ and M*/  ae, km
 (  (
  In the development version of gforth, code has been added to test for division   In the development version of gforth, code has been added to test for division
  by zero in the division words. We want to measure the performance penalty   by zero in the division words. We want to measure the performance penalty
Line 16 Line 19
    FM/MOD     FM/MOD
    SM/REM     SM/REM
    UM/MOD     UM/MOD
      M*/
 )  )
   
 : ms@ ( -- u | return time in ms)  utime 1 1000 m*/ d>s ;  : ms@ ( -- u | return time in ms)  cputime d+ 1 1000 m*/ d>s ;
 : ?allot ( u -- a ) here swap allot ;  : ?allot ( u -- a ) here swap allot ;
 : table ( v1 v2 ... vn n <name> -- | create a table of singles )   : table ( v1 v2 ... vn n <name> -- | create a table of singles ) 
         create dup cells ?allot over 1- cells + swap          create dup cells ?allot over 1- cells + swap
Line 26 Line 30
   
 1 31 lshift 1- constant  DIVIDEND  1 31 lshift 1- constant  DIVIDEND
 DIVIDEND negate s>d 2constant D_DIVIDEND  DIVIDEND negate s>d 2constant D_DIVIDEND
 1000000     constant  N  10000000     constant  N
   
 \ Some helpful macros  \ Some helpful macros
 variable xt  variable xt
Line 43  s" :noname [ xt @ >name name>string ] 2l Line 47  s" :noname [ xt @ >name name>string ] 2l
     get-xt s1 evaluate      get-xt s1 evaluate
     s" DIVIDEND  N 1 DO dup I" evaluate xt @ compile,      s" DIVIDEND  N 1 DO dup I" evaluate xt @ compile,
     s" 2drop LOOP drop ;" evaluate ; immediate      s" 2drop LOOP drop ;" evaluate ; immediate
    
 : testC ( "op" -- )  : testC ( "op" -- )
     get-xt s1 evaluate      get-xt s1 evaluate
     s" D_DIVIDEND N 1 DO  2dup I" evaluate xt @ compile,      s" D_DIVIDEND N 1 DO  2dup I" evaluate xt @ compile,
Line 54  s" :noname [ xt @ >name name>string ] 2l Line 58  s" :noname [ xt @ >name name>string ] 2l
     s" DIVIDEND s>d N 1 DO  2dup I" evaluate xt @ compile,      s" DIVIDEND s>d N 1 DO  2dup I" evaluate xt @ compile,
     s" 2drop LOOP 2drop ;" evaluate ; immediate      s" 2drop LOOP 2drop ;" evaluate ; immediate
   
   : testE ( "op" -- )
       get-xt s1 evaluate
       s" D_DIVIDEND N 1 DO  2dup I" evaluate xt @ compile,
       s" drop LOOP 2drop ;" evaluate ; immediate
   
   : testF ( "op" -- )
       get-xt s1 evaluate
       s" D_DIVIDEND N 1 DO  2dup 1 I" evaluate xt @ compile,
       s" 2drop LOOP 2drop ;" evaluate ; immediate
   
 \ The tests return the start time in ms  \ The tests return the start time in ms
   
 testA  /  testA  /
 testA  MOD  testA  MOD
 testB  /MOD  testB  /MOD
   testE  */
 testC  */MOD  testC  */MOD
 testC  FM/MOD  testC  FM/MOD
 testC  SM/REM  testC  SM/REM
 testD  UM/MOD   ( testC causes overflow for UM/MOD )  testD  UM/MOD   ( testC causes overflow for UM/MOD )
   testF  M*/
   9 table tests
   
 7 table tests  : .elapsed ( starttime -- ) ms@ 9 emit swap - 4 .r ."  ms" ;
   
 : .elapsed ( starttime -- ) ms@ 9 emit swap - 4 .r ." ms" ;  
   
 : run-tests  : run-tests
     cr ." Speed Tests:"      cr ." Speed Tests:"
     7 0 DO  cr I cells tests + @ execute .elapsed LOOP cr ;      9 0 DO  cr I cells tests + @ execute .elapsed LOOP cr ;
   
   
 run-tests  run-tests

Removed from v.1.1  
changed lines
  Added in v.1.4


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