90 lines
1.5 KiB
Forth
90 lines
1.5 KiB
Forth
: prime? ( n -- ? ) here + c@ 0= ;
|
|
: notprime! ( n -- ) here + 1 swap c! ;
|
|
|
|
: sieve ( n -- )
|
|
here over erase
|
|
0 notprime!
|
|
1 notprime!
|
|
2
|
|
begin
|
|
2dup dup * >
|
|
while
|
|
dup prime? if
|
|
2dup dup * do
|
|
i notprime!
|
|
dup +loop
|
|
then
|
|
1+
|
|
repeat
|
|
2drop ;
|
|
|
|
: modpow { c b a -- a^b mod c }
|
|
c 1 = if 0 exit then
|
|
1
|
|
a c mod to a
|
|
begin
|
|
b 0>
|
|
while
|
|
b 1 and 1 = if
|
|
a * c mod
|
|
then
|
|
a a * c mod to a
|
|
b 2/ to b
|
|
repeat ;
|
|
|
|
: divide_out ( n1 n2 -- n )
|
|
begin
|
|
2dup mod 0=
|
|
while
|
|
tuck / swap
|
|
repeat drop ;
|
|
|
|
: long_prime? ( n -- ? )
|
|
dup prime? invert if drop false exit then
|
|
10 over mod 0= if drop false exit then
|
|
dup 1-
|
|
2 >r
|
|
begin
|
|
over r@ dup * >
|
|
while
|
|
r@ prime? if
|
|
dup r@ mod 0= if
|
|
over dup 1- r@ / 10 modpow 1 = if
|
|
2drop rdrop false exit
|
|
then
|
|
r@ divide_out
|
|
then
|
|
then
|
|
r> 1+ >r
|
|
repeat
|
|
rdrop
|
|
dup 1 = if 2drop true exit then
|
|
over 1- swap / 10 modpow 1 <> ;
|
|
|
|
: next_long_prime ( n -- n )
|
|
begin 2 + dup long_prime? until ;
|
|
|
|
500 constant limit1
|
|
512000 constant limit2
|
|
|
|
: main
|
|
limit2 1+ sieve
|
|
limit2 limit1 3
|
|
0 >r
|
|
." Long primes up to " over 1 .r ." :" cr
|
|
begin
|
|
2 pick over >
|
|
while
|
|
next_long_prime
|
|
dup limit1 < if dup . then
|
|
dup 2 pick > if
|
|
over limit1 = if cr then
|
|
." Number of long primes up to " over 6 .r ." : " r@ 5 .r cr
|
|
swap 2* swap
|
|
then
|
|
r> 1+ >r
|
|
repeat
|
|
2drop drop rdrop ;
|
|
|
|
main
|
|
bye
|