Bitova mapa pre pol miliona prvocisel

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: KMP (Klub mladých programátorov)

Autor: Maros Zatko
Program: BIT_MAPA.PAS

Bitova mapa pre pol miliona prvocisel.
{ BIT_MAPA.PAS                            Copyright (c) Maros Zatko }
{                                     mail: facebook.zajo@gmail.com }
{ BitovaMapa pre pol miliona prvocisel.                             }
{                                                                   }
{ Datum:23.12.2022                             http://www.trsek.com }
 
program BitovaMapa;
 
uses crt;
 
label l;
 
const c500000=500000;  { BitovaMapa pre pol miliona prvocisel }
 
var
     p: array[0..64500] of byte;  {  Pole           }
   i,j: longint;                  {  0..2147483647  }
  w,op: word;                     {  OfsetPola      }
     v: byte;                     {  Vysledok       }
     s: text;                     {  textovy Subor  }
 
procedure VynulovaniePola(segment,zaciatok,velkost:word); assembler;
asm
        MOV AL,0
        MOV ES,segment
        MOV DI,zaciatok
        MOV CX,velkost
        CLD
        REP
        STOSB            { CX krat hodnota AL do ES:DI }
end;
{
procedure vlozit;
begin
    w:=i div 8;
  case i mod 8 of
    0: p[w]:=p[w] or 1;
    1: p[w]:=p[w] or 2;
    2: p[w]:=p[w] or 4;
    3: p[w]:=p[w] or 8;
    4: p[w]:=p[w] or 16;
    5: p[w]:=p[w] or 32;
    6: p[w]:=p[w] or 64;
    7: p[w]:=p[w] or 128;
  end;
end;
 
procedure vybrat;
begin
    w:=i div 8;
  case i mod 8 of
    0: v:=p[w] and 1;
    1: v:=p[w] and 2;
    2: v:=p[w] and 4;
    3: v:=p[w] and 8;
    4: v:=p[w] and 16;
    5: v:=p[w] and 32;
    6: v:=p[w] and 64;
    7: v:=p[w] and 128;
  end;
  if v<>0 then v:=1;
end;
}
procedure vlozit(d,a:word); assembler;
asm
        MOV  DX,d
        MOV  AX,a
        MOV  CX,8
        DIV  CX
        MOV  BX,op
        ADD  BX,AX      { DX:AX div 8         podiel }
 
        MOV  CL,DL      { DX:AX mod 8 = 0..7  zvysok }
        MOV  DL,1
        SHL  DL,CL
 
        MOV  AL,[BX]
        OR   AL,DL
        MOV  [BX],AL
end;
 
procedure vybrat(d,a:word); assembler;
asm
        MOV  DX,d
        MOV  AX,a
        MOV  CX,8
        DIV  CX
        MOV  BX,op
        ADD  BX,AX      { DX:AX div 8         podiel }
 
        MOV  CL,DL      { DX:AX mod 8 = 0..7  zvysok }
        MOV  DL,1
        MOV  v,DL       { MOV v,1                    }
        SHL  DL,CL
 
        MOV  AL,[BX]
        AND  AL,DL
        JNZ  @1
        MOV  v,AL       { MOV v,0                    }
@1:
end;
 
begin
  op:=ofs(p);
  VynulovaniePola(seg(p),ofs(p),sizeof(p));
 
  j:=2;
  i:=j+j;
 
l:  repeat
      vlozit(i div 65536,i mod 65536);
      i:=i+j;
    until i>c500000;
 
    repeat
      inc(j);
      vybrat(j div 65536,j mod 65536);
    until v=0;
    i:=j+j;
  if i<c500000 then goto l;
 
  Assign(s,'PRVOCISL.TXT');
  Rewrite(s);
  for i:=2 to c500000 div 3 do  { prvocisla ulozi do suboru 'PRVOCISLA.TXT' }
  begin
    vybrat(i div 65536,i mod 65536);
    if v=0 then                 { if v=1 then 4=2*2  6=2*3  8=2na3  9=3na2  }
      WriteLn(s,i:6);
  end;
  Close(s);
end.