Bitova mapa pre pol miliona prvocisel
Delphi & Pascal (česká wiki)
Kategória: KMP (Klub mladých programátorov)
Autor: Maros Zatko
Program: BIT_MAPA.PAS
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.