Pascal/srceval/primzerl.pas at master · StanfordPascal/Pascal · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
program PRIMZERL ( INPUT , OUTPUT ) ;


const TABSIZE = 100000 ;
      PRIMWIDTH = 8 ;
      PRIM_PER_LINE = 8 ;
      SHOW_TABLE_OF_PRIMES = FALSE ;


var PTAB : array [ 1 .. TABSIZE ] of INTEGER ;
    PLAUF : INTEGER ;
    PINDEX : INTEGER ;
    ZAHL , ZAHL1 , ZAHL2 : INTEGER ;
    PRIM_FOUND : BOOLEAN ;


function TESTPRIM ( TESTZAHL : INTEGER ; var IX : INTEGER ) : BOOLEAN ;

   var I : INTEGER ;
       REST : INTEGER ;

   begin (* TESTPRIM *)
     I := 2 ;
     TESTPRIM := FALSE ;
     while TRUE do
       begin
         if PTAB [ I ] * PTAB [ I ] > TESTZAHL then
           begin
             PTAB [ IX ] := TESTZAHL ;
             IX := IX + 1 ;
             TESTPRIM := TRUE ;
             break ;
           end (* then *) ;
         REST := TESTZAHL MOD PTAB [ I ] ;
         if REST = 0 then
           break ;
         I := I + 1 ;
       end (* while *)
   end (* TESTPRIM *) ;


procedure PRIMFAKTOR_ZERLEGUNG ( TESTZAHL : INTEGER ) ;

   var I : INTEGER ;
       REST : INTEGER ;
       ERSTE : BOOLEAN ;
       X : INTEGER ;

   begin (* PRIMFAKTOR_ZERLEGUNG *)
     ERSTE := TRUE ;
     I := 1 ;
     X := TESTZAHL ;
     while TRUE do
       begin
         if PTAB [ I ] * PTAB [ I ] > TESTZAHL then
           begin
             if ERSTE then
               WRITE ( TESTZAHL , ' ist Primzahl' )
             else
               WRITE ( X : 1 ) ;
             break ;
           end (* then *) ;
         REST := X MOD PTAB [ I ] ;
         if REST <> 0 then
           I := I + 1
         else
           begin
             if ERSTE then
               begin
                 WRITE ( TESTZAHL , ' = ' ) ;
                 ERSTE := FALSE
               end (* then *) ;
             X := X DIV PTAB [ I ] ;
             WRITE ( PTAB [ I ] : 1 ) ;
             if X = 1 then
               break ;
             WRITE ( ' * ' )
           end (* else *) ;
       end (* while *) ;
     WRITELN ;
   end (* PRIMFAKTOR_ZERLEGUNG *) ;


begin (* HAUPTPROGRAMM *)
  PTAB [ 1 ] := 2 ;
  PTAB [ 2 ] := 3 ;
  PTAB [ 3 ] := 5 ;
  PTAB [ 4 ] := 7 ;
  PTAB [ 5 ] := 11 ;
  PLAUF := 11 ;
  PINDEX := 6 ;
  if SHOW_TABLE_OF_PRIMES then
    WRITELN ( 'Tabelle der ersten ' , TABSIZE : 1 , ' Primzahlen' ) ;
  while PINDEX <= TABSIZE do
    begin
      PLAUF := PLAUF + 2 ;
      PRIM_FOUND := TESTPRIM ( PLAUF , PINDEX ) ;
      if PRIM_FOUND then
        if SHOW_TABLE_OF_PRIMES then
          begin
            if PINDEX MOD PRIM_PER_LINE = 1 then
              WRITELN ;
            WRITE ( PTAB [ PINDEX - 1 ] : PRIMWIDTH ) ;
          end (* then *)
        else
          if PINDEX MOD 5000 = 0 then
            WRITELN ( PINDEX , ' Primzahlen bereits gefunden' ) ;
    end (* while *) ;
  if SHOW_TABLE_OF_PRIMES then
    WRITELN ;
  while TRUE do
    begin
      WRITELN ;
      WRITELN ( 'Bitte Testzahlen von ... bis eingeben:' ) ;
      READLN ( ZAHL1 , ZAHL2 ) ;
      if ( ZAHL1 = 0 ) & ( ZAHL2 = 0 ) then
        break ;
      for ZAHL := ZAHL1 to ZAHL2 do
        begin
          PRIMFAKTOR_ZERLEGUNG ( ZAHL ) ;
        end (* for *) ;
      if EOF ( INPUT ) then
        break ;
    end (* while *) ;
end (* HAUPTPROGRAMM *) .