( *
  * LANGUAGE    : ANS Forth
  * PROJECT     : Forth Environments
  * DESCRIPTION : experiments on Forth run time costs
  * CATEGORY    : Example 
  * AUTHOR      : Marcel Hendrix 
  * LAST CHANGE : June 15, 2002, Marcel Hendrix 
  * )



S" c:\Program Files\ForthInc\SwiftForth\LIB\OPTIONS\FpMath.f" INCLUDED
S" c:\Program Files\ForthInc\SwiftForth\Unsupported\Fslib\Library\FSL-UTIL.F" INCLUDED

CREATE idiot$ 0 C, #255 ALLOT
  S" Tcl is an interpreter for a tool command language.  It consists of a library " idiot$ APPEND
  S" package that is embedded in tools (such as editors, debuggers, etc.) as the "  idiot$ APPEND       
  S" basic command interpreter."                                                    idiot$ APPEND


100000 CONSTANT MAXN
CREATE x MAXN CELLS ALLOT
100 VALUE startn 

\ FUNCTIONS TO BE TIMED 

: intcmp ( 'i 'j -- u )
        S" >R @ R> @ - " EVALUATE ; IMMEDIATE

: swapmac ( i j -- ) 
        S" x []CELL >R " EVALUATE
        S" x []CELL DUP @  R@ @  ROT !  R> ! " EVALUATE ; IMMEDIATE

: swapfunc ( i j -- )
        x []CELL >R
        x []CELL DUP @  R@ @  ROT !  R> ! ;

: maxmac ( a b -- u ) 
        S" MAX " EVALUATE ; IMMEDIATE

: maxfunc ( a b -- u )
        2DUP > IF NIP ELSE DROP ENDIF ;


\ WORKHORSE 

CREATE temp 256 CHARS ALLOT

: T"    0 temp C! 
        S~ CR CR ." ~ temp +PLACE
        [char] " WORD COUNT temp +PLACE
        S~  (n=" n 0 .R [char] ) EMIT~ temp +PLACE
        temp COUNT EVALUATE ; IMMEDIATE

15 CONSTANT STRIALS
20 CONSTANT  TRIALS

: M" ( -- )
        0 tmp2 C!  [char] " WORD COUNT tmp2 +PLACE tmp2 COUNT POSTPONE SLITERAL
        S" CR 55 OVER - >R TYPE R> SPACES "     EVALUATE
        S" 0 TO kk  0 TO tsum "                 EVALUATE
        S" TRIALS 0 DO "                        EVALUATE
        S"        TICKS-RESET"                  EVALUATE
        S"      n 1+ 1 DO  I S>F fi F! "        EVALUATE
        S"                 n 1+ 1 DO"           EVALUATE
                                     tmp2 COUNT EVALUATE 
        S"                      LOOP "          EVALUATE
        S"           LOOP "                     EVALUATE
        S"       TICKS? DROP DUP "              EVALUATE 
        S"       I STRIALS >= IF #1000 / 6 .R " EVALUATE 
        S"                  ELSE 2DROP 0 "      EVALUATE
        S"                 ENDIF "              EVALUATE 
        S"       tsum + TO tsum "               EVALUATE
        S"       LOOP "                         EVALUATE
        S" tsum  n n * TRIALS STRIALS - * / 8 .R " EVALUATE ; IMMEDIATE

FVARIABLE fi
FVARIABLE fj
FVARIABLE fk

: TIMES ( -- )
        0 0 0 0 LOCALS| kk tsum n file |
        MAXN 0 DO  RANDOM x I CELL[] !  LOOP
        startn TO n  0 TO kk

        CR ." iForth Time Cost Model, n=" n DEC.
        TIMER-RESET

        T" Integer Arithmetic" 
        M" ( )"
        M" kk  1+  TO kk"
        M" I J  +  TO kk"
        M" i j -   TO kk"
        M" i j *   TO kk" 
        M" i j /   TO kk" 
        M" i j MOD TO kk" 
        M" i j AND TO kk" 
        M" i j OR  TO kk" 

        T" Floating Point Arithmetic" 
        M" j S>F fj F!"
        M" j S>F fj F!  fi F@ fj F@ F+ fk F!"
        M" j S>F fj F!  fi F@ fj F@ F- fk F!"
        M" j S>F fj F!  fi F@ fj F@ F* fk F!"
        M" j S>F fj F!  fi F@ fj F@ F/ fk F!"

        T" Array Operations"
        M" i            j            +   TO kk"
        M" i x []CELL @ j            +   TO kk"
        M" i            j x []CELL @ +   TO kk"
        M" i x []CELL @ j x []CELL @ +   TO kk"

        T" Comparisons"
        M" I J < IF kk 1+ TO kk ENDIF"
        M" x I CELL[] @  x J CELL[] @ < IF kk 1+ TO kk ENDIF"

        T" Array Comparisons and Swaps" 
        M" x I CELL[] @  x kk CELL[] @ < IF -1 ELSE 1 ENDIF TO kk"
        M" x I CELL[]  x J CELL[]  intcmp TO kk"
        M" I J swapmac"
        M" I J swapfunc"

        T" Max Function, Macro and Inline" 
        M" I J MAX     TO kk"
        M" I J maxmac  TO kk"
        M" I J maxfunc TO kk"

        startn 2/ TO n
        T" Math Functions" 
        M" j S>F fi F@ F+ fk F!"
        M" RANDOM S>F  fk F!"
        M" j S>F fi F@ F+ FSQRT fk F!"
        M" j S>F fi F@ F+ FSIN  fk F!"
        M" j S>F fi F@ F+ FSINH fk F!"
        M" j S>F fi F@ F+ FASIN fk F!"
        M" j S>F fi F@ F+ FCOS  fk F!"
        M" j S>F fi F@ F+ FTAN  fk F!"

        startn 10 / TO n
        T" Memory Allocation" 
        M"   16 ALLOCATE DROP FREE DROP"
        M"  100 ALLOCATE DROP FREE DROP"
        M" 2000 ALLOCATE DROP FREE DROP"

        T" Input and Output" 
        S" c:/tm.dat" R/W BIN CREATE-FILE THROW TO file
           M" idiot$ COUNT file WRITE-LINE THROW" 
        file CLOSE-FILE THROW
        S" c:/tm.dat" R/O BIN OPEN-FILE THROW TO file
           M" PAD 256 file READ-LINE THROW 2DROP"       
        file CLOSE-FILE THROW

        CR .ELAPSED ;


: .ABOUT CR ." Try: TIMES" ;

                .ABOUT CR

                              ( * End of Source * )