Return to divspeed.fs CVS log

Up to [gforth] / gforth / contrib

rearranged tests
added contrib/divspeed.fs by Krishna Myneni

    1: \ divspeed.fs
    2: \
    3: \ Measure speed of division words in gforth.
    4: \
    5: \ Krishna Myneni, 2006-10-26
    6: (
    7:  In the development version of gforth, code has been added to test for division
    8:  by zero in the division words. We want to measure the performance penalty
    9:  introduced by these tests. Words to be checked are:
   10: 
   11:    /
   12:    MOD
   13:    /MOD
   14:    */
   15:    */MOD
   16:    FM/MOD
   17:    SM/REM
   18:    UM/MOD
   19: )
   20: 
   21: : ms@ ( -- u | return time in ms)  utime 1 1000 m*/ d>s ;
   22: : ?allot ( u -- a ) here swap allot ;
   23: : table ( v1 v2 ... vn n <name> -- | create a table of singles ) 
   24:         create dup cells ?allot over 1- cells + swap
   25:         0 ?do dup >r ! r> 1 cells - loop drop ;
   26: 
   27: 1 31 lshift 1- constant  DIVIDEND
   28: DIVIDEND negate s>d 2constant D_DIVIDEND
   29: 1000000     constant  N
   30: 
   31: \ Some helpful macros
   32: variable xt
   33: s" :noname [ xt @ >name name>string ] 2literal type ms@" 2constant s1
   34:     
   35: : get-xt ( "op" -- ) bl word find 0= ABORT" Unknown word!" xt ! ;
   36: 
   37: : testA ( "op" -- )
   38:     get-xt s1 evaluate
   39:     s" DIVIDEND  N 1 DO dup I" evaluate xt @ compile,
   40:     s" drop LOOP drop ;" evaluate ; immediate
   41: 
   42: : testB ( "op" -- )
   43:     get-xt s1 evaluate
   44:     s" DIVIDEND  N 1 DO dup I" evaluate xt @ compile,
   45:     s" 2drop LOOP drop ;" evaluate ; immediate
   46: 
   47: : testC ( "op" -- )
   48:     get-xt s1 evaluate
   49:     s" D_DIVIDEND N 1 DO  2dup I" evaluate xt @ compile,
   50:     s" 2drop LOOP 2drop ;" evaluate ; immediate
   51: 
   52: : testD ( "op" -- )
   53:     get-xt s1 evaluate
   54:     s" DIVIDEND s>d N 1 DO  2dup I" evaluate xt @ compile,
   55:     s" 2drop LOOP 2drop ;" evaluate ; immediate
   56: 
   57: \ The tests return the start time in ms
   58: 
   59: testA  /
   60: testA  MOD
   61: testB  /MOD
   62: testC  */MOD
   63: testC  FM/MOD
   64: testC  SM/REM
   65: testD  UM/MOD   ( testC causes overflow for UM/MOD )
   66: 
   67: 7 table tests
   68: 
   69: : .elapsed ( starttime -- ) ms@ 9 emit swap - 4 .r ." ms" ;
   70: 
   71: : run-tests
   72:     cr ." Speed Tests:"
   73:     7 0 DO  cr I cells tests + @ execute .elapsed LOOP cr ;
   74: 
   75: 
   76: run-tests