\ Eratosthenes sieve benchmark program 06/23/86 ) FORTH DEFINITIONS DECIMAL ( for size 8190 should print "1899 primes" ) ( counts primes in range 3..size*2+1 ) 8190 CONSTANT SIZE CREATE FLAGS SIZE ALLOT : PRIMES FLAGS SIZE 1 FILL 0 SIZE 0 DO FLAGS I + C@ IF I DUP + 3 + DUP I + BEGIN DUP SIZE < WHILE 0 OVER FLAGS + C! OVER + REPEAT 2DROP 1+ THEN LOOP . ." Primes " ; : 10PRIMES 10 0 DO PRIMES LOOP ." Done" CR ; \ Interface Age benchmark FORTH Dimensions, II/4 p. 112 ) ( Prints list of primes in 1..1000 ) : BENCH 1000 DUP 2/ 1+ SWAP CR 1 DO DUP I 1 ROT 2 DO DROP DUP I /MOD DUP 0= IF 2DROP 1 LEAVE ELSE 1 = IF DROP 1 ELSE DUP 0 > IF DROP 1 ELSE 0= IF 0 LEAVE THEN THEN THEN THEN LOOP IF 4 .R ELSE DROP THEN LOOP DROP CR ." Done" CR ; \ DUMP 09/27/86 ) FORTH DEFINITIONS DECIMAL : DUMP ( addr n --- : dumps address and range ) BASE @ >R HEX CR OVER ( addr ) .H CR 10 SPACES 16 0 DO I 3 .R LOOP 2 SPACES ( 0 .. F ) 16 0 DO I 0 <# # #> TYPE LOOP CR OVER + SWAP DUP 15 AND XOR ( mask out low 4 bits ) DO CR I ( line start addr ) .H I 16 + I 2DUP DO I C@ SPACE 0 <# # # #> ( contents in hex ) TYPE LOOP 2 SPACES DO I C@ DUP 32 < OVER 126 > OR IF DROP 46 THEN ( contents as char or . ) EMIT LOOP 16 +LOOP CR R> BASE ! ; \ USING : USING ( -- : in form USING C:FORTH.BLK ) FLUSH CLOSE-CACHE CACHE-NAME 40 BLANK ( wipe out old name ) BL WORD COUNT ( addr len new name ) 40 MIN CACHE-NAME SWAP CMOVE OPEN-CACHE DISK-ERROR @ ABORT" No such file" ( no need for EMPTY-BUFFERS as FLUSH did that ) ; ' USING ALIAS using \ LOAD-USING : LOAD-USING ( n -- ) ( used in form 7 LOAD-USING C:\BBL\FORTH.BLK ) ( remember current file name ) ( MORE TO COME ??? ) ; \ Last Screen
