OSP.Compile @ TestOberon0.Permutations 2 3 4~ TestOberon0.MagicSquares 3~. TestOberon0.PrimeNumbers 12 TestOberon0.Fractions 16 TestOberon0.Powers 16 MODULE TestOberon0; VAR n: INTEGER; a: ARRAY 10 OF INTEGER; PROCEDURE perm(k: INTEGER); VAR i, x: INTEGER; BEGIN IF k = 0 THEN i := 0; WHILE i < n DO WriteInt(a[i], 5); i := i+1 END ; WriteLn; ELSE perm(k-1); i := 0; WHILE i < k-1 DO x := a[i]; a[i] := a[k-1]; a[k-1] := x; perm(k-1); x := a[i]; a[i] := a[k-1]; a[k-1] := x; i := i+1 END END END perm; PROCEDURE Permutations*; BEGIN OpenInput; n := 0; WHILE ~eot() DO ReadInt(a[n]); n := n+1 END ; perm(n) END Permutations; PROCEDURE MagicSquares*; (*magic square of order 3, 5, 7, ... *) VAR i, j, x, nx, nsq, n: INTEGER; M: ARRAY 13 OF ARRAY 13 OF INTEGER; BEGIN OpenInput; IF ~eot() THEN ReadInt(n); nsq := n*n; x := 0; i := n DIV 2; j := n-1; WHILE x < nsq DO nx := n + x; j := (j-1) MOD n; x := x+1; M[i][j] := x; WHILE x < nx DO i := (i+1) MOD n; j := (j+1) MOD n; x := x+1; M[i][j] := x END END ; i := 0; WHILE i < n DO j := 0; WHILE j < n DO WriteInt(M[i][j], 6); j := j+1 END ; i := i+1; WriteLn END END END MagicSquares; PROCEDURE PrimeNumbers*; VAR i, k, m, x, inc, lim, sqr: INTEGER; prim: BOOLEAN; p: ARRAY 400 OF INTEGER; v: ARRAY 20 OF INTEGER; BEGIN OpenInput; ReadInt(n); x := 1; inc := 4; lim := 1; sqr := 4; m := 0; i := 3; WHILE i <= n DO REPEAT x := x + inc; inc := 6 - inc; IF sqr <= x THEN (*sqr = p[lim]^2*) v[lim] := sqr; lim := lim + 1; sqr := p[lim]*p[lim] END ; k := 2; prim := TRUE; WHILE prim & (k < lim) DO k := k+1; IF v[k] < x THEN v[k] := v[k] + p[k] END ; prim := x # v[k] END UNTIL prim; p[i] := x; WriteInt(x, 5); i := i+1; IF m = 10 THEN WriteLn; m := 0 ELSE m := m+1 END END ; IF m > 0 THEN WriteLn END END PrimeNumbers; PROCEDURE Fractions*; (* Tabulate fractions 1/n*) CONST Base = 10; N = 32; VAR i, j, m, r, n: INTEGER; d: ARRAY N OF INTEGER; (*digits*) x: ARRAY N OF INTEGER; (*index*) BEGIN OpenInput; IF ~eot() THEN ReadInt(n); i := 2; WHILE i <= n DO j := 0; WHILE j < i DO x[j] := 0; j := j+1 END ; m := 0; r := 1; WHILE x[r] = 0 DO x[r] := m; r := Base*r; d[m] := r DIV i; r := r MOD i; m := m+1 END ; WriteInt(i, 5); WriteChar(9); WriteChar(46); j := 0; WHILE j < x[r] DO WriteChar(d[j] + 48); j := j+1 END ; WriteChar(32); (*blank*) WHILE j < m DO WriteChar(d[j] + 48); j := j+1 END ; WriteLn; i := i+1 END END END Fractions; PROCEDURE Powers*; CONST N = 32; M = 11; (*M ~ N*log2*) VAR i, k, n, exp: INTEGER; c, r, t: INTEGER; d: ARRAY M OF INTEGER; f: ARRAY N OF INTEGER; BEGIN OpenInput; IF ~eot() THEN ReadInt(n); d[0] := 1; k := 1; exp := 1; WHILE exp < n DO (*compute d = 2^exp*) c := 0; (*carry*) i := 0; WHILE i < k DO t := 2*d[i] + c; IF t < 10 THEN d[i] := t; c := 0 ELSE d[i] := t - 10; c := 1 END ; i := i+1 END ; IF c = 1 THEN d[k] := 1; k := k+1 END ; (*write d*) i := M; WHILE i > k DO i := i-1; WriteChar(32) (*blank*) END ; WHILE i > 0 DO i := i-1; WriteChar(d[i] + 48) END ; WriteInt(exp, M); (*compute f = 2^-exp*) WriteChar(9);; WriteChar(46); r := 0; i := 1; WHILE i < exp DO r := 10*r + f[i]; f[i] := r DIV 2; r := r MOD 2; WriteChar(f[i] + 48); i := i+1 END ; f[exp] := 5; WriteChar(53); (*5*) WriteLn; exp := exp + 1 END END END Powers; END TestOberon0.