Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #18282

Pfannkuch revisited

Show all headers | View raw

Pfannkuch (Computer Language Shootout) was mentioned recently ... 

Back in 2006 I wasn't happy that 580 ms was the best 
iForth could do, compared to 330 ms in 'C'.

Tonight I looked at it again. Based on Stephen Pelc's remarks I removed 
all local variables -- that shaved off about 100 ms. Doing the I/O
differently speeded it up another 100 ms. The Forth and C version now 
behave nearly the same. The C version is using ints where Forth uses bytes.
Timings are done on the same machine, I recompiled and optimized the C 
version as good as it would go. (It is a 64bit program, but ints are 32 bits
on Windows).

-marcel

-- -------------------------------------------
(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Fannkuch benchmark
 * CATEGORY    : Benchmarks
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : June 10, 2006, Marcel Hendrix 
 * LAST CHANGE : Wednesday, December 26, 2012, 00:12, Marcel Hendrix 
 *)


	NEEDS -miscutil

	REVISION -fannkuch5 "--- Fannkuch (C)        Version 5.00 ---"


DOC
(*
 fannkuch benchmark | C gcc | fannkuch full data 

 fannkuch C gcc program
 N  Full CPU Time s   Memory Use KB   GZip Bytes 
 10      0.45              16,384         612 

/*
 * The Computer Language Shootout
 * http://shootout.alioth.debian.org/
 * Contributed by Heiner Marxen
 *
 * "fannkuch"	for C gcc
 *
 * $Id: fannkuch-gcc.code,v 1.33 2006/02/25 16:38:58 igouy-guest Exp $
 */

	PROGRAM OUTPUT
	==============
	12345678910
	21345678910
	23145678910
	32145678910
	31245678910
	13245678910
	23415678910
	32415678910
	34215678910
	43215678910
	42315678910
	24315678910
	34125678910
	43125678910
	41325678910
	14325678910
	13425678910
	31425678910
	41235678910
	14235678910
	12435678910
	21435678910
	24135678910
	42135678910
	23451678910
	32451678910
	34251678910
	43251678910
	42351678910
	24351678910
	Pfannkuchen(10) = 38
*)
ENDDOC

 #10 =: N
N 1- =: N1

CREATE perm   N ALLOT 
CREATE perm1  N ALLOT
CREATE counts N ALLOT

0 VALUE didpr
0 VALUE flips
0 VALUE flipsMax

CREATE obuffer #4096 CHARS ALLOT

: oinit ( -- ) obuffer 0! ;
: >out ( c-addr u -- ) obuffer CELLPLACE+ ;
: CR>out ( -- ) $CR COUNT >out ;
: .pan ( -- ) CR>out  N 0 DO  perm1 I + C@ 1+ (0DEC.R) >out  LOOP ;

: XCH ( ix1 ix2 -- ) 
	perm + SWAP perm + 
	DUP C@ >R  SWAP DUP C@ ( -- addr1 addr2 n2 )
	ROT C!  R> SWAP C! ;

-- N = 10
64BIT? 
  [IF]
: special-move ( -- )
	  perm1 1+   @   perm 1+   !
	  perm1 9 + C@   perm 9 + C! ; 
[ELSE]
: special-move ( -- )
	  perm1 1+   @   perm 1+   !
	  perm1 5 +  @   perm 5 +  ! 
	  perm1 9 + C@   perm 9 + C! ; 
[THEN]

: fannkuch ( -- u )
	N 1 < IF  0 EXIT  ENDIF
	CLEAR didpr CLEAR flips CLEAR flipsMaX
	N >R
	perm1 N 0 DO  I SWAP C!+  LOOP	DROP \ initial (trivial) permute 
	BEGIN
		didpr #30 < IF  .pan 1 +TO didpr  ENDIF

		counts R@ 1- + R>
		BEGIN  DUP 1 <>  
		WHILE  DUP 2 PICK C!  
		       1-   SWAP 1- SWAP
		REPEAT >R DROP

		perm1 C@ 0=  
		perm1 N1 + C@ N1 = OR  0= 
		   IF  	0 TO flips
			special-move 
			perm1 C@ >R			\ cache perm[0] on R
			BEGIN				\ k1 != 0 ==> k1>0 
				1  R@ 1-     	( -- i1 j1 )
				BEGIN	2DUP <
				WHILE 	2DUP XCH
					1- SWAP 1+ SWAP
				REPEAT  2DROP
				R> DUP perm + DUP C@ >R C! ( R: -- j1 )  
				1 +TO flips
				R@ 0=
			UNTIL 	-R
			flipsMax flips < IF  flips TO flipsMax  ENDIF
		ENDIF
		BEGIN  R@ N = IF  flipsMax -R EXIT  ENDIF \ rotate down perm[0..r] by one 
		       perm1 C@ ( perm0)  0 
		       BEGIN  DUP R@ <
		       WHILE  1+ 
		              DUP perm1 +  DUP C@  SWAP 1- C!
		       REPEAT DROP ( perm0)  
		       perm1  R@ + C!
		       counts R@ + DUP C@ 1-  DUP ROT C!  0<=
		WHILE  R> 1+ >R
		REPEAT
	AGAIN ;

: main ( -- ) 
	oinit
	TIMER-RESET 
	 fannkuch 
	 CR>out S" Pfannkuchen(" >out N (0DEC.R) >out S" ) = " >out (.) >out 
	CR .ELAPSED 
	obuffer @+ TYPE ;

:ABOUT	CR ." Try: main -- Standard Shootout test (VC++ 6.0: 333 ms). Should be around 352 ms." 
	CR ." Using TYPE gives 450 ms."  ;

		.ABOUT -fannkuch5 CR

                              (* End of Source *)

Back to comp.lang.forth | Previous | Next — Next in thread | Find similar

Thread

Pfannkuch revisited mhx@iae.nl (Marcel Hendrix) - 2012-12-26 10:06 +0200
  Re: Pfannkuch revisited "A. K." <akk@nospam.org> - 2012-12-26 10:26 +0100

csiph-web