'===========================================================================
' Subject: PRIME NUMBER GENERATOR            Date: 03-19-00 (16:37)       
' Author:  Don Schullian                     Code: PB                     
' Origin:  d83@DASoftVSS.com               Packet: PB.ABC
'===========================================================================
$if 0

  Prime Number Generator
  Algorithm from Knuths "Sorting and Searching" Page 617
  Programmed by Rich Geldreich
    Coded for PowerBASIC by Don Schullian on 2000-03-19

  Notes:  This  prime   number   generator   uses   a   disk   file
  "PRIMEPB.BIN" to hold the prime numbers, so little RAM memory is
  needed.   Each  prime  number  is  represented  as the difference
  between the last prime number by  a single byte.  In other words,
  the gap between each prime number is stored instead of each prime
  number itself.  All gaps are even  numbers,  because  all  primes
  must be odd numbers.  Therefore, each byte can represent a gap of
  up  to  510, because the least significant bit of each gap length
  is always unused.  (Except for the special cases of 1-2, and 2-3.
  These primes arent stored in  the  disk file; theyre assumed to
  be present.) Since the maximum gap between all consecutive primes
  up to 436,273,009 is only 286, a single byte is good  enough  for
  this program!)

  The  program  stops  when  escape is pressed or when the priority
  queue is full.

$endif
'-----------------------------------------------------------------
$DIM ALL
$STRING 4
OPTION BINARY BASE 1
'-----------------------------------------------------------------
%HeapSize = 4096      'Maximum prime candidate = HeapSize*HeapSize
%IOSize   = 2048
'-----------------------------------------------------------------
DECLARE SUB       ClearKeyboard ()
DECLARE SUB       PutPrime      (SEG NewLast AS LONG)
DECLARE FUNCTION fGetPrime      () AS LONG
'-----------------------------------------------------------------
DIM PrimeBuf1         AS SHARED STRING * %IOSize
DIM Buf1Loc           AS SHARED INTEGER
DIM Buf1FLoc          AS SHARED LONG
DIM PrimeBuf2         AS SHARED STRING * %IOSize
DIM Buf2Loc           AS SHARED INTEGER
DIM Buf2FLoc          AS SHARED LONG
DIM LastPrime1        AS SHARED LONG
DIM LastPrime2        AS SHARED LONG
DIM SlideFlag         AS SHARED INTEGER
'-----------------------------------------------------------------
DIM HeapQ (%HeapSize) AS LONG    ' priority queue
DIM HeapQ1(%HeapSize) AS LONG
DIM HeapQ2(%HeapSize) AS LONG
DIM t                 AS LONG
DIM Q                 AS LONG
DIM Q1                AS LONG
DIM Q2                AS LONG
DIM TQ                AS LONG
DIM TQ1               AS LONG
DIM u                 AS LONG
DIM n                 AS LONG
DIM FileSpec          AS STRING
DIM i                 AS INTEGER
DIM j                 AS INTEGER
DIM d                 AS INTEGER
DIM r                 AS INTEGER
DIM Mask              AS STRING
'---------------------------------------------------------------------------
'--------------------  start of code  --------------------------------------
'---------------------------------------------------------------------------

FileSpec = "PrimePB.bin"

Buf1Loc    = 1 : Buf1FLoc   = 1
Buf2Loc    = 2 : Buf2FLoc   = 1
LastPrime1 = 3 : LastPrime2 = 5

n = 5
d = 2
r = 1
t = 25
HeapQ (1) = 25
HeapQ1(1) = 10
HeapQ2(1) = 30

IF LEN(DIR$(FileSpec)) THEN KILL FileSpec
OPEN FileSpec FOR BINARY AS #1

CLS
ClearKeyboard

DO
  DO
    Q   = HeapQ (1)
    Q1  = HeapQ1(1)
    Q2  = HeapQ2(1)
    TQ  = Q + Q1
    TQ1 = Q2 - Q1
    i   = 1
    DO
      j = i * 2
      IF j > r THEN EXIT DO
      IF ( j        < r            )  AND _
         ( HeapQ(j) > HeapQ(j + 1) ) THEN
        INCR j
      END IF
      IF TQ =< HeapQ(j) THEN EXIT DO
      HeapQ(i)  = HeapQ(j)
      HeapQ1(i) = HeapQ1(j)
      HeapQ2(i) = HeapQ2(j)
      i = j
    LOOP
    HeapQ(i)  = TQ
    HeapQ1(i) = TQ1
    HeapQ2(i) = Q2
  LOOP UNTIL n <= Q

  WHILE n < Q
    PutPrime n
    n = n + d
    d = 6 - d
  WEND

  IF n = t THEN
    u = fGetPrime
    t = u * u
    j = r + 1
    DO
      i = j \ 2
      IF i         = 0 THEN EXIT DO
      IF HeapQ(i) <= t THEN EXIT DO
      HeapQ(j)  = HeapQ(i)
      HeapQ1(j) = HeapQ1(i)
      HeapQ2(j) = HeapQ2(i)
      j = i
    LOOP
    HeapQ(j) = t
    IF (u MOD 3) = 2 THEN
      HeapQ1(j) = 2 * u
    ELSE
      HeapQ1(j) = 4 * u
    END IF
    HeapQ2(j) = 6 * u
    INCR r
    IF r = %HeapSize THEN EXIT DO
  END IF

  n = n + d
  d = 6 - d
LOOP UNTIL INSTAT

IF Buf1Loc > 1 THEN
  DECR Buf1Loc
  Mask = LEFT$(PrimeBuf1,Buf1Loc)
  PUT #1, Buf1FLoc, Mask
END IF

CLS
SEEK #1, 1
LastPrime1 = 3
Mask       = "#,###,###,###   "

PRINT "            1               2               3   ";

FOR i = 1 TO LOF(1) \ %IOSize
  GET #1, , PrimeBuf1
  FOR j = 1 TO %IOSize
    INCR LastPrime1, ASC(PrimeBuf1, j) * 2
    PRINT USING Mask; LastPrime1;
    IF CSRLIN = 25 THEN
      PRINT "Press <ESC> to end";
      ClearKeyboard
      WHILE NOT INSTAT : WEND
      IF INKEY$ = CHR$(27) THEN GOTO ByeBye
      CLS
    END IF
  NEXT
  IF INSTAT THEN EXIT FOR
NEXT

ByeBye:
  ClearKeyboard
  LOCATE 25, 1 : PRINT "THE END                   ";
  CLOSE #1
  END
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
FUNCTION fGetPrime () AS LONG

  DIM V AS LOCAL INTEGER

  IF SlideFlag = 0 THEN
    V = ASC(PrimeBuf1, Buf2Loc)
  ELSE
    V = ASC(PrimeBuf2, Buf2Loc)
  END IF
  SHIFT LEFT V, 1
  INCR LastPrime2, V

  INCR Buf2Loc

  IF Buf2Loc > %IOSize THEN
    INCR Buf2FLoc, %IOSize
    GET #1, Buf2FLoc, PrimeBuf2
    Buf2Loc = 1
  END IF

  FUNCTION = LastPrime2

END FUNCTION
'---------------------------------------------------------------------------
'----------
'---------------------------------------------------------------------------
SUB PutPrime (SEG NewLast AS LONG)

  DIM TotalPrimes AS STATIC LONG

  ASC(PrimeBuf1,Buf1Loc) = (NewLast - LastPrime1) \ 2
  INCR Buf1Loc
  LastPrime1 = NewLast

  IF Buf1Loc <= %IOSize THEN EXIT SUB

  INCR TotalPrimes, %IOSize
  LOCATE , 1
  PRINT "Primes found:"; TotalPrimes; _
        "Maximum candidate:"; NewLast;

  PUT #1, Buf1FLoc, PrimeBuf1
  Buf1Loc = 1
  INCR Buf1FLoc, %IOSize

  IF SlideFlag = 0 THEN
    SlideFlag = -1
    PrimeBuf2 = PrimeBuf1
  END IF

END SUB
'---------------------------------------------------------------------------
'----------
'---------------------------------------------------------------------------
SUB ClearKeyboard ()
  DIM D AS LOCAL STRING

  WHILE INSTAT : D$ = INKEY$ : WEND

END SUB