' version 06-07-2018
' compile with: fbc -s console

Const As ULongInt trillion = 1000000000000ull
Const As ULong max = Sqr(trillion + 145)

Dim As UByte list(), sieve()
Dim As ULong prime()
ReDim list(max), prime(max\12), sieve(max)

Dim As ULong a, b, c, i, k, stop_ = Sqr(max)

For i = 4 To max Step 2   ' prime sieve remove even numbers except 2
    sieve(i) = 1
Next
For i = 3 To stop_ Step 2 ' proces odd numbers
    If sieve(i) = 0 Then
        For a = i * i To max Step i * 2
            sieve(a) = 1
        Next
    End If
Next

For i = 2 To max          ' move primes to a list
    If sieve(i) = 0 Then
        c += 1
        prime(c) = i
    End If
Next

ReDim sieve(145): ReDim Preserve prime(c)

For i = 1 To c  ' find all square free integers between 1 and 1000000
    a = prime(i) * prime(i)
    If a > 1000000 Then Exit For
    For k = a To 1000000 Step a
        list(k) = 1
    Next
Next

k = 0
For i = 1 To 145          ' show all between 1 and 145
    If list(i) = 0 Then
        Print Using"####"; i;
        k +=1
        If k Mod 20 = 0 Then Print
    End If
Next
Print : Print

sieve(0) = 1              ' = trillion
For i = 1 To 5            ' process primes 2, 3, 5, 7, 11
    a = prime(i) * prime(i)
    b = a - trillion Mod a
    For k = b To 145 Step a
        sieve(k) = 1
    Next
Next

For i = 6 To c            ' process the rest of the primes
    a = prime(i) * prime(i)
    k = a - trillion Mod a
    If k <= 145 Then sieve(k) = 1
Next

k = 0
For i = 0 To 145
    If sieve(i) = 0 Then
        Print Using "################"; (trillion + i);
        k += 1
        If k Mod 5 = 0 Then print
    End If
Next
Print : Print

a = 1 : b = 100 : k = 0
Do Until b > 1000000      ' count them
    For i = a To b
        If list(i) = 0 Then k += 1
    Next
    Print "There are "; k; " square free integers between 1 and "; b
    a = b : b *= 10
Loop

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End