home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol148 / prime1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.6 KB  |  116 lines
  1. external  prime::prime1(2);
  2.  
  3. procedure instructions;
  4. {writes a screen full of instructions}
  5. begin
  6. writeln('PRIME gets a seed number from you and determines whether it');
  7. writeln('is prime.  It then decrements the number and tries again.');
  8. writeln('the process continues until a prime is found.');
  9. writeln; writeln;
  10. writeln('To exit without running the program enter a number less than three.');
  11. writeln;
  12. writeln('note: the long integer procedures, for some odd reason, require');
  13. writeln('two carriage returns after a number entry.  Otherwise the program');
  14. writeln('will hang.');
  15. writeln;
  16. writeln('The program will write periods to the screen to indicate that it');
  17. writeln('is indeed working.  ');
  18. end;
  19.  
  20. procedure get_n(var n:longint);
  21. {get the seed number from the operator}
  22. begin
  23. writeln;
  24. writeln('        2 <cr> to follow');
  25. write('Enter the starting number to test for prime:  ');
  26. getlong(stdin,n);
  27. end;
  28.  
  29. procedure if_even(var n:longint);
  30. {if the number is even, it is obviously not prime.  Therefore, subract
  31. 1 to make it odd.  The UNIT1 set has no function 'odd' as in Pascal integer
  32. arithmetic, but using the divlong procedure and checking the modulus works
  33. just fine}
  34. var
  35.   one, two, quot, modu: longint;
  36. begin
  37.   cvi(2,two);
  38.   cvi(1,one);
  39.   divlong(n,two,quot,modu);
  40.   if iszero(modu) then sub(n,one,n);
  41. end;
  42.  
  43. procedure n_prime(n:longint; var prm:boolean);
  44. {This is the Knuth algorithm that tests for primeness.  It is the real
  45. guts of the program.  
  46. }
  47. label
  48.   1;
  49. const
  50.   k = 10;
  51. var
  52.   two, one, zero,
  53.   modu,
  54.   n1, n2, x, y, z, r, p,
  55.   quot,
  56.   temp: longint;
  57.   rn, i: integer;
  58.  
  59. begin
  60.   seedrand;
  61.   cvi(2,two);
  62.   cvi(1,one);
  63.   cvi(0,zero);
  64.   repeat
  65.     for i := 1 to k do
  66.     begin        {x=2 + int((n-2)*rnd(0)}
  67.     rn := trunc(random(100));
  68.     writeln;
  69.     cvi(rn,r);  
  70.     sub(n,two,n1);
  71.     multlong(n1,r,n2);
  72.     divlong(n2,two,n2,modu);    {int}
  73.     multlong(n2,two,n2);
  74.     add(n2,two,x);
  75.     y := one;
  76.     sub(n,one,p);
  77.     repeat
  78.     write('.');
  79.       divlong(p,two,quot,modu);
  80.       if not iszero(modu) then
  81.       begin            {this section only if p is odd}
  82.         multlong(y,x,y);
  83.         divlong(y,n,temp,y);
  84.       end;            {no else clause}
  85.     multlong(x,x,x);
  86.     divlong(x,n,temp,x);
  87.     divlong(p,two,p,modu);
  88.     until iszero(p);
  89.     if equal(y,one) then
  90.     begin
  91.       prm := true;
  92.       goto 1;
  93.     end
  94.     else prm := false;
  95.     end;            {for i loop}
  96.   1:
  97.   if not prm then
  98.     begin
  99.     putlong(stdout,n,16);
  100.     writeln(' is not prime.');
  101.     sub(n,two,n);    
  102.     end
  103.   else
  104.     begin
  105.     putlong(stdout,n,16);
  106.     writeln(' is probably prime.');
  107.     sub(n,one,n1);
  108.     divlong(n1,three,quot,modu);
  109.     if iszero(modu) then writeln(' ... but poor choice.');
  110.     end;
  111.   until prm;
  112. end;
  113. .   
  114.  
  115.  
  116.