\\ Ach ja, die leidigen Benchmarks.                    30jan93pyAlle Benchmarks auáer der auf Block 6 sind iterativ. Da FORTH   konzeptionell weder eine Ausdrucksverwertung machen muá noch    kann, gibt das nat�rlich im Vergleich mit Assembler ineffektivenCode. Als Beispiel habe ich die Iteration von "Wundersam" aus   Hofstadters "G”del, Escher, Bach" und den Byte-Benchmark        "Sieb des Erathostenes" auch in Assembler geschrieben, ersterer bietet hier einen Zeitvorteil um den Faktor 4.                  Wer nun neidisch nach Turbo-C schielt (weil das fast den selben Code produziert wie ich von Hand), dem sei gesagt: Ein Programm besteht ja auch zu einem nicht geringen Teil aus Subroutine-    Calls, und die sind in unserem FORTH nunmal konzeptionell       schneller, weil wir �berhaupt keine Register sichern m�ssen und keine Stack-Frames brauchen. Žtsch! Denn ganz um diesen unn”ti- gen Krampf wird Turbo-C auch nicht 'rumkommen. FORTH ist nunmal Subroutinen-optimiert, das kann niemand schneller.              \ Benchmarks                                           07aug10py                                                                VARIABLE TOFFSET                                                : .TIME BASE @ DECIMAL TIMER@ TIME @ - TOFFSET @ - 0              <<# # # # $2C HOLD #S #> TYPE #>> ."   sec " BASE ! ;         : TEST0 TOFFSET OFF !TIME                                         $FFFFF 0 DO LOOP TIMER@ TIME @ - .TIME TOFFSET ! ;            : TEST1 !TIME 0 $FFFFF 0 DO NEGATE LOOP DROP .TIME ;            : TEST2 !TIME 0 $FFFFF 0 DO 1 + LOOP DROP .TIME ;               : TEST3 !TIME 0 $FFFFF 0 DO $12345678 + LOOP DROP .TIME ;       : TEST4 !TIME 0 $FFFFF 0 DO DUP DROP LOOP DROP .TIME ;          : TEST5 !TIME 0 $FFFFF 0 DO I DROP LOOP DROP .TIME ;            : TEST6 !TIME 0 $FFFFF 0 DO I NIP LOOP DROP .TIME ;             : TEST7 !TIME $FFFFF 0 DO 5000 @ 5000 ! LOOP .TIME ;            : TEST8 PAD PAD ! PAD !TIME $FFFFF 0 DO @ LOOP DROP .TIME ;                                                                     \ Wundersam                                            25jul88py: wundersam ( n -- n trial# ) dup 0                               BEGIN  over 1-  WHILE  1+ under  0>  WHILE                             dup 1 and  IF  dup dup + + 1+  ELSE  2/  THEN  swap      REPEAT THEN nip ;                                             : .wundersam ( n -- ) wundersam                                   swap . ." ist " dup 0<  IF  ." nicht "  THEN                    ." 'wundersam'. (" . ." Versuche)" ;                          : seltsam ( start -- ) 0 >r                                       BEGIN wundersam r>                                                    2dup > IF  drop  2dup >r cr &10 .r ." :" &5 .r  ELSE                       >r drop  THEN                                        1+  stop?  UNTIL  rdrop drop ;                          \\ Eine Zahl ist seltsam, wenn zur Ableitung ihrer Wundersamkeit   mehr Schritte ben”tigt werden, als zur Ableitung derer aller    vorhergehenden Zahlen (wenn alle Zahlen wundersam sind...).  \ Wundersam                                            25jul88py                                                                Code wundersam  ( n -- n trial# )                                    SP ) D0 move   0 D1 moveq                                       BEGIN  1 # D0 lsr  cs IF  0= IF  D1 SP -) move  Next  THEN             D0 D0 addx   D0 D2 move                                         D2 D0 add   D2 D0 add   1 D0 addq   THEN                        1 D1 addq  cs  UNTIL                                     -1 D1 moveq   D1 SP -) move  Next end-code                                                                                 \\                                                              R: Eine gerade Zahl n ist wundersam, wenn n/2 wundersam ist.    R: Eine ungerade Zahl n ist wundersam, wenn 3n+1 wundersam ist. Axiom: 1 ist wundersam.                                         Nach: Theo Schildkr”te aus Hofstadters "G”del, Escher, Bach"    Wundersam in Assembler ist ungef„hr 4* so schnell, wie in FORTH \ Primes (Erathostenes, wie immer)                     16jan00py$1FFE CONSTANT 8190             CREATE FLAGS 8190 ALLOT         \ ^ die größte Zahl, die auch der blödste Compiler noch packt.  : PRIMZAHLEN   FLAGS 8190 1 FILL                                  0 8190 0  DO  FLAGS I + C@                                                    IF  I DUP + 3+ DUP I +                                              BEGIN  DUP 8190 <                                               WHILE  0 OVER FLAGS + C! OVER +                                 REPEAT  2DROP 1+                                            THEN                                                   LOOP                                                       1899 - ABORT" Fehler!" ;                                                                                                      : BENCHMARK  !TIME                                                           100 0  DO  PRIMZAHLEN  LOOP                                     .TIME  ;                                           \ So geht's schneller (optimiertes FORTH):             25jan04py$1FFE CONSTANT 8190             CREATE FLAGS 8190 ALLOT         \ ^ die größte Zahl, die auch der blödste Compiler noch packt.  : PRIMZAHLEN   FLAGS 8190 1 FILL  0 3  FLAGS 8190 + FLAGS         DO   I C@                                                            IF  DUP I + DUP [ 8190 FLAGS + ] ALITERAL <                         IF    [ 8190 FLAGS + ] ALITERAL OVER                                  DO  0 I C! OVER  +LOOP                                    THEN  DROP SWAP 1+ SWAP                                         THEN  2+                                                    LOOP  DROP ;                                                                                                             : BENCHMARK  !TIME                                                           &100 0  DO  PRIMZAHLEN &1899 - abort" Error!"  LOOP             .TIME  ;                                                                                                           \ Primes: Zum Vergleich in Assembler                   16jan00py$1FFE CONSTANT 8190             CREATE FLAGS 8190 ALLOT         \ ^ die größte Zahl, die auch der blödste Compiler noch packt.  : PRIMZAHLEN  DUP  FLAGS 8190 1 FILL                                 >c:  pusha  Flags A# SI mov  SI DI mov                          Flags 8190 + 1- A# BX mov  AX AX xor  DX DX xor                 8190 # CX mov  3 # BP mov  .align                               DO  .b 0 # SI ) cmp                                                 0<> IF   SI DI mov  DX inc  AHEAD  .align                                BEGIN  AL DI ) mov  BUT  THEN  BP DI add                               BX DI cmp  >=  UNTIL  THEN                      SI inc  2 # BP add                                          LOOP  DX $1C SP D) mov  popa  ;c: ;                                                                                        : BENCHMARK  !TIME  &100 0  DO  PRIMZAHLEN DROP  LOOP  .TIME  ;                                                                 \ Und hier noch 'n paar rekursive Benchmarks           07aug10py: fib ( n -- fib[n] ) recursive                                   2- dup 0<= IF drop 1 exit THEN                                  dup 1+ fib swap fib + ;                                       : fibi ( iterative version von FIB )                              2- dup 0> 0= IF drop 1 exit THEN 1 1 rot                        0 ?DO over + swap LOOP drop ;                                 \ Ach ja: Die Rekursive Version hat ein unm”gliches Zeitverhal- \ ten, jeder n„chste Wert braucht ~(1+û5)/2 mal solange!        ( x=1+1/x , Zeit der letzten plus Zeit der vorletzen Zahl )     : x=1+1/x ( -- ) base push decimal                                0 &1000000000  BEGIN  &1000000000 dup dup 3 pick */ + rot drop                        2dup - abs 2 < UNTIL                      0 <<#  # # #  bl hold  # # #  bl hold  # # #  ', hold           #S #> type #>> space drop ;                                                                                                   \ Ostertermine                                         07aug10py                                                                Create Dfeld &200 cells allot                                                                                                   : func ( n -- func ) dup &19 qmod dup 7 q* 1+ &19 q/ swap &11 q*  4+ swap - &29 qmod over 4/  rot + &31 + over - 7 qmod           &25 swap - swap - ;                                                                                                           : ostern  &200 0 DO  i func i cells dfeld + !  LOOP ;                                                                           : .2 0 <<# # # #> type #>> ;                                    : .ostern  cr ." Ostertermine:" cr  base push decimal             &200 0 DO  i cells dfeld + @ dup 0>                                        IF  .2 ." apr" ELSE &31 + .2 ." mar"                            THEN  i .2 2 spaces ?cr                              LOOP  ;                                                       \ Ackermann                                            13apr93py: .a  compile BEGIN drop ; immediate restrict                   : ack  ( m n -- ack ) recursive over 0=                           IF 1+ nip exit THEN dup 0= IF drop 1- 1 ack exit THEN           >r 1- dup 1+ r> 1- ack ack ;                                  : ackf ( m n -- ack ) recursive \ ?ack                            over 3 = IF  3 + >r 1 r> << 3 - nip exit  THEN                  over 2 = IF  2* 3 +             nip exit  THEN                  over 1 = IF  2+                 nip exit  THEN                  over 0=  IF  1+                 nip exit  THEN                  dup  0=  IF  drop 1- 1 ackf                                              ELSE  >r 1- dup 1+ r> 1- ackf ackf  THEN ;           : acki ( m n -- ack ) recursive \ ?ack \ <--f�r Speed weglassen!  BEGIN  BEGIN  over 0= IF 1+ nip exit .a THEN                                  dup 0= WHILE  drop 1- 1  AGAIN .a THEN                          >r 1- dup 1+ r> 1- acki  AGAIN  ;               \ falcon speed test                                    04mar08pyalso memory     $1000000 Constant memsz  $BA constant $code     : .kbs ( b/sec -- ) &10 rshift &1000000                           timer@ time @ - >us drop */ .  ." KBytes/sec " ;              : memtest cr base push decimal memsz 2+ NewPtr >r                 r@ memsz 5 / 5 * $code fill  $C3 r@ memsz 5 / 5 * + c!          ." Code: " !time  r@ $7F FOR dup execute NEXT drop              $80 memsz * .kbs ." (Core i7-3.4GHz 11264170"                   ." /P55-200 121594/486DX50 82397/386DX33 21801/ST 3775)" cr     ." Fill: " !time  r@ $7F FOR  dup memsz erase  NEXT  drop       $80 memsz * .kbs ." (Core i7-3.4GHz 29608245"                   ." /P55-200 82522/486DX50 47440/386DX33 25761/ST 2864)" cr      ." Move: " !time  r@ $7F FOR dup dup memsz 2/ + swap memsz 2/            move NEXT  drop $80 memsz 2/ * .kbs  r> DisposPtr      ." (Core i7-3.4GHz 10834523"                                    ." /P55-200 45189/486DX50 24561/386DX33 14160/ST 1360)" ; toss\ falcon speed test                                    17mar13py                                                                $A load 5 load 9 load  cr                                       : test  !time FOR  3 6 ack drop  NEXT  .time ;                  ." Primes: " benchmark ."  (Core i7-3.4GHz 0,009"               ." /P55-200 0,109/486DX50 1,281/386DX33 3,069/ST 28,375)" cr    ." recurse: "  9 test ."  (Core i7-3.4Ghz 0,011"                ." /P55-200 0,173/486DX50 1,466/386DX33 3,611/ST 34,770)"       memtest                                                         forget .kbs clear                                                                                                                                                                                                                                                                                                                                                                                                                                               \ Terminal test                                        07aug10py                                                                : char/sec  ( n -- )  base push decimal page timer@               over 0 ?DO  '# emit  LOOP  timer@ swap - >us drop swap          &1000 * &10000000 rot */ 0 <<# # # # # ', hold #S #> type       #>> ;                                                         \ Rafael Delianos EC-Benchmark                         02dec93py                                                                5 Constant five                                                 Variable bvar                                                   : bench                                                           $100 0 DO  1  BEGIN  dup swap tuck swap drop 1 and                                   IF five + ELSE 1- THEN                                          bvar ! bvar @ dup $100 and                               UNTIL  drop                                              LOOP ;                                                 \ taskswitch time                                      07aug10py                                                                : subtask ( n -- )  1 $200 $200 NewTask pass                      0 ?DO  pause  LOOP ;                                                                                                          : maintask ( n -- )  dup subtask 0 ?DO  pause  LOOP ;                                                                           : .3 ( u -- )  0 <<# # # # ', hold #S #> type #>> ;                                                                             : /task ( n -- )  !time  dup maintask 2*                          timer@ time @ - ( gives ms )                                    over cr . ." task switchs in "                                  dup .3 ."  seconds "                                            2dup / . ." task switchs/ms "                                   &1000000 rot */ .3 ."  us/task switch" ;