Return to divspeed.fs CVS log

Up to [gforth] / gforth / contrib

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

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