Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #20813
| From | "WJ" <w_a_x_man@yahoo.com> |
|---|---|
| Newsgroups | comp.lang.forth |
| Subject | Re: Pfannkuch revisited |
| Date | 2013-03-19 02:22 +0000 |
| Organization | NewsGuy - Unlimited Usenet $19.95 |
| Message-ID | <ki8i5i0v0@enews4.newsguy.com> (permalink) |
| References | <83979309918435@frunobulax.edu> |
Marcel Hendrix wrote:
> 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 *)
Here's a version in SP-Forth. On my tired, old laptop running
Windows-XP it takes 1078 milliseconds.
REQUIRE { lib/ext/locals.f
REQUIRE TIME&DATE lib/include/facil.f
REQUIRE .R lib/include/ansi.f
10 VALUE N
N 1- VALUE N-1
CREATE perm N ALLOT
CREATE permp N ALLOT
CREATE counts N ALLOT
perm 1+ VALUE perm+1
permp N-1 + VALUE permp_last
: .permp N 0 DO permp I + B@ 1+ 1 .R LOOP CR ;
: reverse ( adr len -- )
OVER + 1- ( adr1 adr2 )
BEGIN
2DUP <
WHILE
2DUP 2DUP B@ SWAP B@ ROT B! SWAP B!
1 -1 D+
REPEAT
2DROP ;
: shift-left { adr p -- }
adr B@
adr 1+ adr p CMOVE
adr p + B! ;
: fannkuch ( -- )
\ Locals.
{ | flips maxflips k r prn-count }
N -> r
N 0 DO I permp I + B! 0 counts I + B! LOOP
BEGIN
prn-count 30 <
IF .permp ^ prn-count 1+! THEN
r 1+ 2 ?DO I counts I 1- + B! LOOP
1 -> r
permp B@ 0=
permp_last B@ N-1 =
OR 0=
IF
permp perm N CMOVE
0 -> flips
perm B@ -> k
BEGIN
k
WHILE
perm+1 k 1- reverse \ ######
^ flips 1+!
perm k + B@
k perm k + B!
-> k
REPEAT
flips maxflips MAX -> maxflips
THEN
BEGIN
r N =
IF
." Pfannkuchen(" N 1 .R ." ) = "
maxflips 1 .R CR
EXIT
THEN
permp r shift-left \ ######
counts r + B@ 1- counts r + B!
counts r + B@ 0 >
IF
-1
ELSE
^ r 1+!
0
THEN
UNTIL
AGAIN
;
: doit ( -- )
ms@
fannkuch
ms@ SWAP - . ." milliseconds" CR ;
doit
Back to comp.lang.forth | Previous | Next | Find similar
Re: Pfannkuch revisited "WJ" <w_a_x_man@yahoo.com> - 2013-03-19 02:22 +0000
csiph-web