This is version . It is not the current version, and thus it cannot be edited.
[Back to current version]   [Restore this version]

Forth83 Benchmarks#

Below is a collection of some Benchmarks for Forth83 systems like VolksForth.

I found most of these benchmarks on comp.lang.forth, Hans Bzemers 4th and Marcel Hendrix benchmark collection

Results#

Name System Forth Benchmark Time (sec/round)
Carsten Strotmann Atari Portfolio 8088 4.92Mhz VolksForth MS-DOS (ITC) Integer Calc 4.96
Carsten Strotmann Amstrad NC100 Z80 4.606Mhz VolksForth CP/M (ITC) Integer Calc 6.23
Andreas Böhm Commodore C64 6510 Audiogenic Forth-64 Integer Calc 526
Andreas Böhm Commodore C64 6510 Audiogenic Forth-64 Count Bits 140.22
Andreas Böhm Commodore C64 6510 Audiogenic Forth-64 Sieve Bench 18.1
Andreas Böhm Commodore C64 6510 Audiogenic Forth-64 GCD 1 215.52
Andreas Böhm Commodore C64 6510 Audiogenic Forth-64 GCD 2 84.84
H. Jakob c't 86 8086 5Mhz Laxen/Perry F83 Integer Calc 9
Neil Franklin HP 100LX 80186 7.9Mhz VolksForth 3.81.41 MS-DOS Integer Calc 2.8
Carsten Strotmann Atari 130XE 6502 1.79Mhz VolksForth 3.81 Integer Calc 596
Carsten Strotmann Atari 130XE 6502 1.79Mhz noDMA VolksForth 3.81 Integer Calc 438
J. Kunz DEC 3000-600 Alpha 21064 175Mhz pForth Integer Calc 0.091
J. Kunz DEC 3000-600 Alpha 21064 175Mhz pForth Fibonacci 1 0.0038
J. Kunz DEC 3000-600 Alpha 21064 175Mhz pForth Fibonacci 2 0.00001425
J. Kunz DEC 3000-600 Alpha 21064 175Mhz pForth Nesting 32Mil 22
J. Kunz DEC 3000-600 Alpha 21064 175Mhz pForth 6502emu 18
Ingo Soetebier Nextstation 68040 33Mhz pfe Nesting 1Mil 340

Benchme Helper#

: beep ( -- ) \ emits an audible beep signal
  7 con! ;    \ this is hardware and implementation dependent
 
: benchme ( xt n -- ) \ executes the word with the execution token 'xt' n-times
  dup >r              \ save number of iterations
  beep                \ signal of benchmark start
  0 do dup execute loop \ execute word. word must have a neutral stack effect
  beep                \ signal benchmark end
  cr r> . ." Iterations." cr \ emit message
;

Integer Calculations #

32000 constant intMax

variable intResult

: DoInt
  1 dup intResult dup >r !
  begin
    dup intMax <
  while
    dup negate r@ +! 1+
    dup r@ +! 1+
    r@ @ over * r@ ! 1+
    r@ @ over / r@ ! 1+
  repeat
  r> drop drop
;

Fibonacci 1#

: fib1 ( n1 -- n2 )
    dup 2 < if drop 1 exit then
    dup  1- recursive 
    swap 2- recursive  + ;
    
: fib1-bench 20 0 do i fib1 drop loop ;

Fibonacci 2#

: fib2 ( n1 -- n2 )                                                                
   0 1 rot 0 ?do 
      over + swap loop 
   drop ;
 
: fib2-bench 20 0 do i fib2 drop loop ;

Forth Nesting Benchmark#

 \ Forth nesting (NEXT) Benchmark                     cas20101204                   
 : bottom ;                                                                         
 : 1st bottom bottom ;  : 2nd 1st 1st ;      : 3rd 2nd 2nd ;                        
 : 4th 3rd 3rd ;        : 5th 4th 4th ;      : 6th 5th 5th ;                        
 : 7th 6th 6th ;        : 8th 7th 7th ;      : 9th 8th 8th ;                        
 : 10th 9th 9th ;       : 11th 10th 10th ;   : 12th 11th 11th ;                     
 : 13th 12th 12th ;     : 14th 13th 13th ;   : 15th 14th 14th ;                     
 : 16th 15th 15th ;     : 17th 16th 16th ;   : 18th 17th 17th ;                     
 : 19th 18th 18th ;     : 20th 19th 19th ;   : 21th 20th 20th ;                     
 : 22th 21th 21th ;     : 23th 22th 22th ;   : 24th 23th 23th ;                     
 : 25th 24th 24th ;                                                                 
                                                                                    
 : 32million   CR ." 32 million nest/unnest operations" 25th ;                      
 :  1million   CR ."  1 million nest/unnest operations" 20th ;                      
                                                                                    
 CR .( enter 1million or 32million )         

Forth Memory Move Benchmark#

\ Forth Memory Move Benchmark                       cas 20101204                   
  8192 CONSTANT bufsize                                                             
 VARIABLE buf1 HERE bufsize 1+ allot BUF1 !                                         
 VARIABLE buf2 HERE bufsize 1+ allot BUF2 !                                         
                                                                                    
 : test-CMOVE 49 0 DO BUF1 @ BUF2 @ bufsize CMOVE LOOP ;                            
                                                                                    
 : test-CMOVE> 49 0 DO BUF2 @ BUF1 @ bufsize CMOVE> LOOP ;                          
                                                                                    
 : test-MOVE> 49 0 DO BUF1 @ BUF2 @ bufsize MOVE LOOP ;                             
                                                                                    
 : test-<MOVE 49 0 DO BUF2 @ BUF1 @ bufsize MOVE LOOP ;     
 
 : move-bench test-CMOVE test-CMOVE> test-MOVE> test-<MOVE ;

count bits in byte#

 \ Forth Benchmark - count bits in byte              cas 20101204
 
 VARIABLE cnt
 
 : countbits ( uu -- #bits )
   cnt off
   8 0 DO dup %01010101  and cnt +!
          2/
   LOOP drop
   0 cnt 4 bounds DO i C@ + LOOP ;
 
 : bench5
   8192 DO I countbits . LOOP ;

Sieve Benchmark#

\ Sieve Benchmark -- the classic Forth benchmark    cas 20101204                   
                                                                                    
 8192 CONSTANT SIZE   VARIABLE FLAGS  0 FLAGS !  SIZE ALLOT                         
                                                                                    
 : DO-PRIME                                                                         
   FLAGS SIZE 1 FILL  ( set array )                                                 
   0 ( 0 COUNT ) SIZE 0                                                             
   DO FLAGS I + C@                                                                  
     IF I DUP + 3 + DUP I +                                                         
        BEGIN DUP SIZE <                                                            
        WHILE 0   OVER FLAGS +  C!  OVER +  REPEAT                                  
        DROP DROP 1+                                                                
     THEN                                                                           
 LOOP                                                                               
 . ." Primes" CR ;        

Greatest Common Divisor#

\ gcd - greatest common divisor                     cas 20101204                   
                                                                                    
 : gcd ( a b -- gcd )                                                               
   OVER IF                                                                          
     BEGIN                                                                          
       DUP WHILE                                                                    
          2DUP U> IF SWAP THEN OVER -                                               
     REPEAT DROP ELSE                                                               
     DUP IF NIP ELSE 2DROP 1 THEN                                                   
   THEN ;  
   
: gcd1-bench 100 0 DO 
      100 0 DO j i gcd drop loop
      loop ;  
\ another gcd O(2) runtime speed                    cas 20101204                   
                                                                                    
 : gcd2 ( a b -- gcd )                                                              
   2DUP        D0= IF  2DROP 1 EXIT   THEN                                          
   DUP          0= IF   DROP   EXIT   THEN                                          
   SWAP DUP     0= IF   DROP   EXIT   THEN                                          
   BEGIN  2DUP -                                                                    
   WHILE  2DUP < IF OVER -                                                          
                 ELSE SWAP OVER - SWAP                                              
                 THEN                                                               
   REPEAT NIP ;          

: gcd2-bench 100 0 DO 
      100 0 DO j i gcd2 drop loop
      loop ;  

Takeuchi#

( takeuchi benchmark in volksForth Forth-83 )
( see http://en.wikipedia.org/wiki/Tak_(function) )

 : 3dup 2 pick 2 pick 2 pick ;                                                        

 : tak ( x y z -- t )                                                                 
   over 3 pick < NEGATE IF nip nip exit then                                          
   3dup rot 1- -rot recursive >r                                                      
   3dup swap 1- -rot swap recursive >r                                                
             1- -rot recursive                                                        
   r> swap r> -rot recursive ;                                                        
                                                                                      
 : takbench ( -- )                                                                    
   0 &10000 0 DO DROP &18 &12 6 tak LOOP ;                                            
                                                    

simple 6502 emulator#

\ A simple 6502 emulattion benchmark                         cas                     
\ only 11 opcodes are implemented. The memory layout is:                             
\  2kB RAM at 0000-07FF, mirrored throughout 0800-7FFF                               
\ 16kB ROM at 8000-BFFF, mirrored at C000                                            
decimal                                                                              
create ram 2048 allot   : >ram $7FF  and ram + ;                                     
create rom 16384 allot  : >rom $3FFF and rom + ;                                     
\ 6502 registers                                                                     
variable reg-a   variable reg-x  variable reg-y                                      
variable reg-s   variable reg-pc  : reg-pc+ reg-pc +! ;                              
\ 6502 flags                                                                         
variable flag-c  variable flag-n   variable cycle                                    
variable flag-z  variable flag-v  : cycle+ cycle +! ;                                
hex                                                                                  
: w@ dup c@ swap 1+ c@ 100 * or ;                                                    
: cs@ c@ dup 80 and if 100 - then ;        

: read-byte ( address -- )                                                           
  dup 8000 < if >ram c@ else >rom c@ then ;                                          
: read-word ( address -- )                                                           
  dup 8000 < if >ram w@ else >rom w@ then ;                                          
: dojmp ( JMP aaaa )                                                                 
  reg-pc @ >rom w@ reg-pc ! 3 cycle+ ;                                               
: dolda ( LDA aa )                                                                   
  reg-pc @ >rom c@ ram + c@ dup dup reg-a !                                          
  flag-z ! 80 and flag-n ! 1 reg-pc+ 3 cycle+ ;                                      
: dosta ( STA aa )                                                                   
  reg-a @ reg-pc @ >rom c@ ram + c! 1 reg-pc+ 3 cycle+ ;                             
: dobeq ( BEQ <aa )                                                                  
  flag-z @ 0= if reg-pc @ >rom cs@ 1+ reg-pc+ else 1 reg-pc+ then 3 cycle+ ;   
: doldai ( LDA #aa )                                                                 
  reg-pc @ >rom c@ dup dup reg-a ! flag-z ! 80 and flag-n !                          
  1 reg-pc+ 2 cycle+ ;                                                               
: dodex ( DEX )                                                                      
  reg-x @ 1- FF and dup dup reg-x ! flag-z ! 80 and flag-n !                         
  2 cycle+ ;                                                                         
: dodey ( DEY )                                                                      
  reg-y @ 1- ff and dup dup reg-y ! flag-z ! 80 and flag-n !                         
  2 cycle+ ;                                                                         
: doinc ( INC aa )                                                                   
  reg-pc @ >rom c@ ram + dup c@ 1+ FF and dup -rot swap c! dup                       
  flag-z ! 80 and flag-n !  1 reg-pc+ 3 cycle+ ;                                     
: doldy ( LDY aa )                                                                   
  reg-pc @ >rom c@ dup dup reg-y ! flag-z ! 80 and flag-n !                          
  1 reg-pc+ 2 cycle+ ; 
: doldx ( LDX #aa )                                                                  
  reg-pc @ >rom c@ dup dup reg-x ! flag-z ! 80 and flag-n !                          
  1 reg-pc+ 2 cycle+ ;                                                               
: dobne ( BNE <aa )                                                                  
  flag-z @ if reg-pc @ >rom cs@ 1+ reg-pc+ else 1 reg-pc+ then                       
  3 cycle+ ;                                                                         
: 6502emu ( cycles -- )                                                              
  begin cycle @ over  < while                                                        
    reg-pc @ >rom c@ 1 reg-pc+                                                       
    dup 4C = if dojmp then      dup A5 = if dolda then                               
    dup 85 = if dosta then      dup F0 = if dobeq then                               
    dup D0 = if dobne then      dup A9 = if doldai then                              
    dup CA = if dodex then      dup 88 = if dodey then                               
    dup E6 = if doinc then      dup A0 = if doldy then                               
        A2 = if doldx then      repeat drop ; 

create testcode                                                                      
  A9 c, 00 c,  \ start: LDA #0                                                       
  85 c, 08 c,  \        STA 08                                                       
  A2 c, 0A c,  \        LDX #10                                                      
  A0 c, 0A c,  \ loop1: LDY #10                                                      
  E6 c, 08 c,  \ loop2: INC 08                                                       
  88 c,        \        DEY                                                          
  D0 c, FB c,  \        BNE loop2                                                    
  CA c,        \        DEX                                                          
  D0 c, F6 c,  \        BNE loop1                                                    
  4C c, 00 c, 80 C, \   JMP start 
                                                     
: init-vm 13 0 do i testcode + c@ i rom + c! loop                                    
          0 cycle ! 8000 reg-pc ! ;                                                  

: bench6502 100 0 do init-vm &6502 6502emu loop ;

Add new attachment

Only authorized users are allowed to upload new attachments.
« This particular version was published on 15-May-2011 15:16 by Carsten Strotmann.