Source code from Programming in Modula-2.
In this section of Fruttenboel I publish the sources of the examples that are used in PIM (Programming in Modula-2) by Niklaus Wirth. There may be small differences between these sources and the original sources for two reasons:
Biggest common divider
MODULE ggTkgV;
FROM InOut IMPORT ReadInt, WriteBf, WriteInt, WriteLn, WriteString;
VAR x, y, u, v : INTEGER;
BEGIN
WriteString ("x = "); WriteBf; ReadInt (x);
WriteString ("y = "); WriteBf; ReadInt (y);
u := x;
v := y;
WHILE x # y DO (* ggT (x, y) = ggT (x0, y0), x * v + y * u = 2 * x0 * y0 *)
IF x > y THEN
x := x - y;
u := u + v
ELSE
y := y - x;
v := v + u
END
END;
WriteString ("ggT ="); WriteInt (x, 6); WriteLn;
WriteString ("kgV ="); WriteInt ((u+v) DIV 2, 6); WriteLn
END ggTkgV.
Oscillation
MODULE Oscillation;
FROM InOut IMPORT ReadInt, ReadReal, WriteBf, WriteLn, WriteReal, WriteString;
FROM MathLib IMPORT exp, cos;
CONST dx = 0.19634953;
VAR i, n : INTEGER;
x, y, r : REAL;
BEGIN
WriteString ("n = "); WriteBf; ReadInt (n);
WriteString ("r = "); WriteBf; ReadReal (r);
i := 0;
x := 0.0;
REPEAT
x := x + dx;
INC (i);
y := exp (-r * x) * cos (x);
WriteReal (x, 15, 12); WriteReal (y, 20, 12); WriteLn
UNTIL i >= n
END Oscillation.
Power (I)
MODULE Power;
FROM InOut IMPORT ReadInt, WriteString, WriteBf, WriteLn,
ReadReal, Done, WriteReal, Write, WriteInt;
VAR i, j : INTEGER;
x, z : REAL;
BEGIN
WriteString ("x = "); WriteBf; ReadReal (x);
WHILE Done () DO
WriteString ("power = "); WriteBf; ReadInt (i);
j := i;
z := 1.0;
WHILE i > 0 DO
z := z * x;
DEC (i)
END;
WriteReal (x, 16, 12); Write ('^'); WriteInt (j, 3);
WriteString (" = ");
WriteReal (z, 16, 12); WriteLn; WriteBf;
WriteString ("x = "); WriteBf; ReadReal (x)
END;
WriteLn
END Power.
Power (II)
MODULE Power2;
FROM InOut IMPORT ReadInt, WriteString, WriteBf, WriteLn,
ReadReal, Done, WriteReal, Write, WriteInt;
VAR i, j : INTEGER;
x, z : REAL;
BEGIN
WriteString ("x = "); WriteBf; ReadReal (x);
WHILE Done () DO
WriteString ("power = "); WriteBf; ReadInt (i);
j := i;
z := 1.0;
WHILE i > 0 DO
IF ODD (i) THEN z := z * x END;
x := x * x;
i := i DIV 2
END;
WriteString ("Power x^i = ");
WriteReal (z, 16, 12); WriteLn; WriteBf;
WriteString ("x = "); WriteBf; ReadReal (x)
END;
WriteLn
END Power2.
Log2
MODULE Log2;
FROM InOut IMPORT WriteString, WriteLn, WriteBf,
ReadReal, Done, WriteReal;
VAR x, a, b, sum : REAL;
BEGIN
WriteString ("Enter X value : "); WriteBf; ReadReal (x);
WHILE Done () DO
WriteReal (x, 15, 12);
a := x;
b := 1.0;
sum := 0.0;
REPEAT
a := a * a;
b := b / 2.0;
IF a >= 2.0 THEN
sum := sum + b;
a := a / 2.0
END
UNTIL b < 1.0E-7;
WriteReal (sum, 16, 12); WriteLn;
WriteString ("Enter X value : "); WriteBf; ReadReal (x);
END;
WriteLn
END Log2.
Harmonic
MODULE Harmonic;
FROM InOut IMPORT ReadInt, Done, Write, WriteString, WriteBf, WriteLn, WriteReal;
VAR i, n : INTEGER;
x, d, s1, s2 : REAL;
BEGIN
WriteString ("n = "); WriteBf; ReadInt (n);
WHILE Done () DO
s1 := 0.0;
d := 0.0;
i := 0;
REPEAT
d := d + 1.0;
s1 := s1 + 1.0 / d;
INC (i)
UNTIL i >= n;
WriteReal (s1, 16, 12); WriteBf;
s2 := 0.0;
REPEAT
s2 := s2 + 1.0 / d;
d := d - 1.0;
DEC (i)
UNTIL i = 0;
WriteReal (s2, 16, 12);
WriteString (" Diff = "); WriteReal (100.0 * (s2 - s1) / s1, 5, 3);
Write ("%"); WriteLn;
WriteString ("n = "); WriteBf; ReadInt (n);
END;
WriteLn
END Harmonic.
Fractions
MODULE Fractions;
FROM InOut IMPORT Write, WriteLn, WriteString, WriteInt;
CONST Base = 10;
N = 32;
VAR i, j, m, rem : INTEGER;
d : ARRAY [1..N] OF INTEGER;
x : ARRAY [0..N] OF INTEGER;
BEGIN
FOR i := 2 TO N DO
FOR j := 0 TO i - 1 DO x[j] := 0 END;
m := 0;
rem := 1;
REPEAT
INC (m);
x[rem] := m;
rem := Base * rem;
d[m] := rem DIV i;
rem := rem MOD i
UNTIL x[rem] # 0;
WriteInt (i, 6);
WriteString (" 0.");
FOR j := 1 TO x[rem] - 1 DO Write (CHR (d[j] + ORD ("0"))) END;
Write ("'");
FOR j := x[rem] TO m DO Write (CHR (d[j] + ORD ("0"))) END;
WriteLn
END
END Fractions.
Powers of 2
MODULE PowersOf2;
FROM InOut IMPORT Write, WriteLn, WriteBf, WriteString, WriteInt;
CONST M = 11;
N = 32;
VAR i, j, k, exp,
carry, rest, t : INTEGER;
d : ARRAY [0..M] OF INTEGER;
f : ARRAY [0..N] OF INTEGER;
BEGIN
d[0] := 1;
k := 1;
FOR exp := 1 TO N DO
carry := 0;
FOR i := 0 TO k - 1 DO
t := 2 * d [i] + carry;
IF t >= 10 THEN
d [i] := t - 10;
carry := 1
ELSE
d [i] := t;
carry := 0
END
END;
IF carry > 0 THEN
d [k] := 1;
INC (k)
END;
i := M;
REPEAT
DEC (i);
Write (" ")
UNTIL i = k;
REPEAT
DEC (i);
Write (CHR (d [i] + ORD ("0")))
UNTIL i = 0;
WriteInt (exp, 5);
WriteString (" 0.");
rest := 0;
FOR j := 1 TO exp - 1 DO
rest := 10 * rest + f [j];
f [j] := rest DIV 2;
rest := rest MOD 2;
Write (CHR (f [j] + ORD ("0")))
END;
f [exp] := 5;
Write ("5");
WriteLn;
WriteBf
END
END PowersOf2.
Primes
MODULE Primes;
FROM InOut IMPORT WriteLn, WriteInt, WriteBf;
CONST N = 500;
M = 23;
LL = 10;
VAR i, k, x, inc, lim, square, L : INTEGER;
prime : BOOLEAN;
P, V : ARRAY [0..M] OF INTEGER;
BEGIN
L := 0;
x := 1;
inc := 4;
lim := 1;
square := 9;
FOR i := 3 TO N DO
REPEAT
x := x + inc;
inc := 6 - inc;
IF square <= x THEN
INC (lim);
V [lim] := square;
square := P [lim + 1] * P [lim + 1];
END;
k := 2;
prime := TRUE;
WHILE prime AND (k < lim) DO
INC (k);
IF V [k] < x THEN V [k] := V [k] + 2 * P [k] END;
prime := x # V [k]
END
UNTIL prime;
IF i < M THEN P [i] := x END;
WriteInt (x, 6);
INC (L);
IF L = LL THEN
WriteLn;
L := 0
END
END;
WriteLn
END Primes.
Page created April 2005,
Page equipped with FroogleBuster technology