aboutsummaryrefslogtreecommitdiff
path: root/forth/forth/sieve2.fs
blob: 87911c2abef18b34d1e1f46e60a398840a561484 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
\ *******************************************************************
\                                                                   *
\    Filename:      sieve2.txt                                      *
\    Date:          22.02.2014                                      *
\    MCU:           PIC 18 24 30 33  Atmega                         *
\    Copyright:     Mikael Nordman                                  *
\    Author:        Mikael Nordman                                  *
\ *******************************************************************
\ FlashForth is licensed according to the GNU General Public License*
\ *******************************************************************
\ sieve2 requires 1 Kbyte of RAM.
-sieve2
marker -sieve2
decimal ram

 ( addr n c -- ) \ fill addr to addr+n with c
: fill rot !p>r swap for dup pc! p+ next r>p drop ;

8192 constant size2
ram variable flags2 size2 8 / allot
: bit-addr ( addr bit -- eff-addr )
  3 rshift  ( -- addr off)
  +         ( -- eff-addr) ;

: bit? ( addr bit -- f )
  swap over bit-addr swap ( -- eff-addr bit )
  7 and 1 swap lshift     ( -- eff-addr bitmask)
  swap c@ and             ( -- f) ;

: bit-reset ( addr bit -- )
  swap over bit-addr swap ( -- eff-addr bit )
  7 and 1 swap lshift     ( -- eff-addr bitmask)
  invert over c@ and swap c! ;

: sieve2      
  flags2 [ size2 8 / ] literal -1 fill
  0 0 !p>r size2 
  for 
     flags2 @p bit? 
     if 
        @p 2*  3 +
        dup  @p +
        begin  
          dup size2 u< 
        while  
          flags2 over bit-reset
          over +
        repeat
        2drop 1+
     then
     p+
  next
  r>p   . ." primes " cr
;

: bench2 ticks sieve2 ticks swap - u. ." milliseconds" cr ;

bench2