6502.org

Code: Select all

   10 N=100
   20 P=0
   30 DIM S(N)
   40 FOR I=2 TO N
   50 IF S(I)<>0 THEN NEXT:STOP
   60 PRINT ;I;" ";
   70 P=P+1
   80 IF I+I>N THEN GOTO 130
   90 FOR J=I+I TO N STEP I
  100 S(J)=-1
  110 NEXT
  120 NEXT I
  130 FOR K=I+1 TO N
  140 IF S(K)=0 THEN PRINT ;K;" ";:P=P+1:IF P=20 STOP
  150 NEXT K

Code: Select all

   10 N=100
   20 P=0
   30 DIM S(N)
   40 FOR I=2 TO N
   50 IF S(I)<>0 THEN NEXT:STOP
   60 PRINT ;I;" ";
   70 P=P+1
   80 C=1
   90 FOR J=I+I TO N STEP I
  100 C=C+1
  110 S(J)=-1
  120 NEXT J
  130 IF C>I THEN NEXT I
  140 FOR K=I+1 TO N
  150 IF S(K)=0 THEN PRINT ;K;" ";:P=P+1:IF P=20 STOP
  160 NEXT K

Code: Select all

\ Implements the sieve of Eratosthenes for the first 1024 numbers

\ Begin borrowed code from http://www.forth.org/svfig/Len/bits.htm
\ Note: that code had a bug I fixed as indicated below.

\ Bit_array is a defining word that will create a bit array.
\ l is the number of bytes
create masks 128 c, 64 c, 32 c, 16 c, 8 c, 4 c, 2 c, 1 c,
: bit_array \ ( len -- ) ( i -- m a)
   create allot does>
      swap   \ a i
      8      \ a i 8
      /mod   \ a remainder whole
      swap   \ a whole remainder !MCH bug fix!
      masks  \ a whole remainder a
      +      \ a whole mask_a
      c@     \ a whole m
      -rot   \ m a whole
      + ;    \ m a

\ We also need words to store and fetch bits. The words .@ and .!
\ Will fetch and store, respectively, a Boolean flag on the stack to
\ a bit array. (Do not confuse .! with cset or .@ with creset.) 

: .! ( f m a -- ) rot if cset else creset then ;
: .@ ( m a -- f ) c@ and 0<> ;

\ Examples
\ 3 bit-array thflag  \ Create a bit array for 24 bit-flags
\ 11 thflag ctoggle    \ Toggle the 11th bit
\ 10 thFLAG .@ ( -- f) \ Extract the 10th bit and leave as well-formed Boolean flag

\ End of borrowed code.

\ Create a bit vector to hold the sieve.
\ 128 bytes allows for all primes less than 1024.
128 bit_array sieve

\ locates the index of the first non-zero bit in the sieve
\ with an index greater than the input.
: find_one ( n -- n )
   1+ dup 1024 swap do
      i sieve .@ \ get the bit corresponding to the integer.
      if
         leave
      else
         1+
      then
   loop ;

\ sets bits starting at n.
: set_bits ( n -- )
   1024 swap
   do
      i sieve cset
   loop ;

\ clears bits starting at n in steps of n. So n=2 starts at 2
\ and clears every other bit. While n=3 starts at three and
\ clears every third bit. However, it then resets the first
\ bit as that number is prime.
: clear_bits ( n -- )
   dup 1024 swap
   do
      i sieve creset
      dup
   +loop
   sieve cset ;

\ We'll waste two bits for integers 0 and 1 which can't be prime
: do_sieve
  2 set_bits   \ Assume all numbers 2 or greater are prime.
  2            \ Initially, let p equal 2, the first prime number.

  begin dup 1024 < while
     dup          \ n n
     clear_bits   \ n
     find_one     \ index of first one > n
  repeat ;

\ iterates through the bit vector printing the index of a prime number
: .sieve
   ." List of primes "
   1024 0 do
      i sieve .@ \ get the bit corresponding to the integer.
      if
         i . ." , "
      then
   loop ;

Code: Select all

   10 P=20: N=100
   20 I=2: DIM S(N)
   30 REPEAT
   40 IF S(I)=0 PRINT ;I;" ";: FOR J=I TO N STEP I: S(J)=J: NEXT: P=P-1: IF P=0 STOP
   50 I=I+1
   60 UNTIL I=N

Code: Select all

10 P=20
15 N=100
20 I=2
25 J=I
30 :J)=0
35 J=J+1
40 #=J<N*30
45 #=:I)*90
50 ?=I
55 $=32
60 J=I
65 :J)=1
70 J=J+I
75 #=N>J*65
80 P=P-1
85 #=P=0*99 
90 I=I+1
95 #=I<N*45

Code: Select all

; some constants
define ZERO $30
define SPACE $20
define COUNT   20 ; Primes left to find

; some zero page locations
define CHROUT $0f ; output device (visual6502)
define INDEX  $21 ; Index in decimal
define FLAGS  $30 ; Prime flags (sieve)

  LDY   #COUNT              ; Set target count
  LDA   #2                  ; And starting index
  STA   INDEX
  SED                      ; Use decimal
repeat:
  TAX                      ; Is this number prime?
  LDA   FLAGS,X
  BNE checknext
  LDA   #SPACE                  ; Yes, print it
  wdm   0 ; or STA CHROUT
  TXA
  LSR   A
  LSR   A
  LSR   A
  LSR   A
  BEQ skip  ; tens digit zero?
  ORA   #ZERO ; to ascii
  wdm   0 ; or STA CHROUT
skip:
  TXA
  AND   #$0f  ; units digit
  ORA   #ZERO ; to ascii
  wdm   0 ; or STA CHROUT
  DEY                          ; Found twenty?
  BEQ done                     ; Yes

  CLC
  TXA
marking:
  ADC   INDEX
  BCS clearcarry ; BREAK CS at 100 (decimal)
  TAX
  STA   FLAGS,X
  BNE marking ; UNTIL EQ ; until 100

clearcarry:
  CLC
checknext:       ; Check the next index
  LDA   INDEX
  ADC   #1 ; carry is clear
  STA   INDEX
  BNE repeat ; UNTIL EQ (to 100)

done:
  NOP            ; Done (previously an RTS)

Code: Select all

10 #=1000
100 N=N+F
110 #=S
120 N=N+G
150 !=T
200 C=!
210 #=N<U*Q
220 Q=M
230 V=V+F
250 U=V*V
300 D=H
310 A=N/D
320 #=%=O*C
330 D=D+F
340 #=D>V*R
350 A=N/D
360 #=%=O*C
370 D=D+G
380 #=D<V*P
400 ?=N
410 ?=""
420 X=X-E
430 #=X>E*C
440 #=9999
500 #=S
510 N=N+E
520 #=S
530 N=N+F
540 #=150
1000 E=1
1010 F=2
1020 G=4
1030 H=5
1050 O=0
1100 T=100
1110 S=200
1120 R=400
1130 Q=R
1140 P=310
1150 M=300
1200 V=5
1210 U=25
1220 X=20
1230 N=2
1240 #=500

Code: Select all

                     Table of Comparative Program Times
                     ----------------------------------
                      Running time in seconds on BBC B

         n     P(n)   Prime1   Prime2   Prime3   Prime4   Prime5   Prime6
         10      29      1.79     0.46     0.44     0.32     0.32     0.36
        100     541    221.61    11.96    10.31     7.43     7.98     8.63
       1000    7919  27500      331.74   268.75   175.77   185.05   195.74