Return to divspeed.fs CVS log

Up to [gforth] / gforth / contrib

Annotation of gforth/contrib/divspeed.fs, revision 1.1

1.1     ! anton       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