program testMiller; 
{---------------------------------------------------------------
   Test di primalita' di Miller
 (implementato da N. Renzoni)
   ---------------------------------------------------------------
 Attenzione: in questo programma usiamo i soli tipi predefinti del
   (turbo)Pascal. Per x del tipo longint, il prodotto
   x*x mod n e' corretto solo per
 x < 46.340 = sqrt(2.147.483.647 = maxLongint).
 Non e' tuttavia difficile modificare l'algoritmo
   includendo la definizione di tipi numerici di
   dimensioni maggiori di longint, usando ad esempio
   record o array.}

const 
   nt = 10; {# volte cui si esegue il test}
   dim = 16; {dimensione massima dei numeri testati}
var
   n : longint; {Elemento che si vuole testare}
   n2 : array[0..dim] of 0..1; {Array con la rappresentazione binaria di n}
   b : longint; {Numero casuale usato nel test}
   sw : boolean;
   i : 0..nt;
   {creazione di un vettore con la codifica binaria di a}
   procedure creaN2(a:longint);
   var i : 0..dim;
   begin
   	for i := 0 to dim do begin
   		n2[i] := a mod 2;
   		a := a div 2;
   	end;
   end;
   {test di Miller}
   function test(a,m:longint):boolean;
   var x,d : longint;
   	   i : 0..dim;
   begin
   {si suppone il numero primo, ovvero si suppone falso il test di Miller};
   	test := false;
 	{seconda condizone del test di M.}
   	d := 1;
   	i := dim;
   	repeat
   		x := d;
   		d := (d*d) mod m;
   		if ((d=1) and (x<>1) and (x<>m-1)) then test := true;
   		if n2[i]=1 then d := (d*b) mod m;
   		i := i-1;
   	until i<0;
 	{prima condizone del test di M.}
   	if d<>1 then test := true;
   end;
   {programma principale}
   begin;
   	randomize;
   	writeln('Test di primalita'' di Miller-Rabin versione Pascal');
   	writeln(' (realizzato con Turbo pascal 7.0)');
   	write ('Inserisci il numero da testare: ');
   	readln (n);
 	creaN2(n-1);
   
   	sw := false; {si suppone il numero primo};
   	i := 0;
   	while (i<nt) and (not sw) do begin
   		{generazione numeri casuali}
   		repeat
   			b := random(n);
   		until (b<>0);
   	{effettuazione test}
   		sw := sw or test(b,n);
   		i := i+1;
   	end;
   
   	if sw then
   		writeln (n,' composto')
   	else
   		writeln (n,' primo con margine di errore minore di 2^-',nt);
   	readln;
   end.


Per scaricare il sorgente Pascal fare clic qui col destro e scegliere "Salva oggetto con nome".