Revised report on the algorithmic language Algol-68

a)proc @to bin = (ref le f, simplout x) [ ] char:

C a value of mode 'row of character' whose lower bound is one and whose upper bound depends on the value of 'book OF f' and on the mode and the value of 'x'; furthermore, x = from bin(f, x, to bin(f, x)) C;

b)proc @from bin = (ref le f, simplout y. [ ] char c)simplout:

C a value, if one exists, of the mode of the value yielded by 'y', such that c = to bin(f, from bin(f, y, c)) C;

10.3.6.1. Binary output

a) proc put bin = (ref le f, [ ] outtype ot)void: if opened of f then

set bin mood(f); set write mood(f); for k to upb ot

do [ ] simplout y = straightout ot [k ]; for j to upb y

do [ ] char bin = to bin(f, y[j ]); for i to upb bin

do next pos(f);

set bin mood(f);

ref pos cpos = cpos of f, lpos = lpos of book of f; case text of f in

( extext t2):

t2 [p of cpos ] [l of cpos ] [c of cpos ] := bin [i ]

esac;

c of cpos+:= 1;

if cpos beyond lpos then lpos := cpos elif :set possible(f)

^ pos(p of lpos, l of lpos, 1) beyond cpos then lpos := cpos;

(compressible(f) j

C the size of the line and page containing the logical end of the book and of all subsequent lines and pages may be increased C )

od

od

od

else unde ned

;

221

f

g

10.4. The system prelude and task list

10.4.1. The system prelude

The representation of the system-prelude is obtained from the following form, to which may be added further forms not de ned in this Report. fThe syntax of program-texts ensures that a declaration contained in the systemprelude may not contradict any declaration contained in the standard-prelude. It is intended that the further forms should contain declarations that are needed for the correct operation of any system-tasks that may be added (by the implementer, as provided in 10.1.2.d).g

a)sema @gremlins =(sema s; F of s := prim int := 0; s);

10.4.2. The system task list

The representation of the f rstg constituent system-task or the system- task-list is obtained from the following form. The other system-tasks, if any, are not de ned by this Report fbut may be de ned by the implementer in order to account for the particular features of his operating environment, especially in so far as they interact with the running of particular-programs (see, e.g., 10.3.1.1.dd)g.

a)do down gremlins; unde ned; up b leprotect od

fThe intention is that this call of unde ned, which is released by an up gremlins whenever a book is closed, may reorganize the chain of back les and

223

the chain of locked back les, such as by removing the book if it is not to be available for further opening, or by inserting it into the chain of back les several times over if it is to be permitted for several particular-programs to read it simultaneously. Note that, when an up gremlins is given, b leprotect is always down and remains so until such reorganization has taken place.g

f From ghoulies and ghosties and long-leggety beasties and things that go bump in the night.

Good Lord, deliver us!

Ancient Cornish litanyg

10.5. The particular preludes and postludes

10.5.1. The particular preludes

The representation of the particular-prelude of each user-task is obtained from the following forms, to which may be added such other forms as may be needed for the proper functioning of the facilities de ned in the constituent library-prelude of the program-text f, e.g., declarations and calls of open for additional standard lesg. However, for each QUALITY-new-new- PROPS1-LAYER2-de ning-indicator-with-TAX contained in such an additional form, the predicate where QUALITY TAX independent PROPS1 f7.1.1.a, cg must hold fi.e., no declaration contained in the standard-prelude may be contradictedg.

a)L int ` last random := round(` maxint / L 2);

b)proc ` random = L real: ` next random(` last random);

c)le stand in, stand out, stand back;

open(stand in, }}, stand in channel); open(stand out, }}, stand out channel); open(stand back, }}, stand back channel);

d) proc print = ([ ] union(outtype, proc(ref le )void) x)void: put(stand out, x),

proc write = ([ ] union(outtype, proc(ref le )void) x)void: put(stand out, x);

e)proc read = ([ ] union(intype, proc(ref le )void) x)void: get(stand in, x);

f)proc printf = ([ ] union(outtype, format) x)void: putf(stand out, x), proc writef = ([ ] union(outtype, format) x)void: putf(stand out, x);

g)proc readf = ([ ] union(intype, format) x)void: getf(stand in, x);

224

h)proc write bin = ([ ] outtype x)void: put bin(stand back, x);

i)proc read bin = ([ ] intype x)void: get bin(stand back, x);

10.5.2. The particular postludes

The representation of the particular-postlude of each user-task is obtained from the following form, to which may be added such other forms as may be needed for the proper functioning of the facilities de ned in the constituent library-prelude of the program-text f, e.g., calls of lock for additional standardlesg.

a)stop: lock(stand in); lock(stand out); lock(stand back )

B Examples

11.1. Complex square root

proc compsqrt = (compl z) compl :

/c the square root whose real part is nonnegative of the complex number

'z' /c

begin real x = re z, y = im z;

real rp = sqrt ((abs x + sqrt (x " 2 + y " 2)) / 2); real ip = (rp = 0 j 0 j y / (2 rp));

if x 0 then rp i ip else abs ip i (y 0 j rp j -rp) end

Calls f5.4.3g using compsqrt:

compsqrt(w) compsqrt(-3.14) compsqrt(-1)

11.2. Innerproduct 1

proc innerproduct 1 = ( int n, proc ( int ) real x, y) real :

/c the innerproduct of two vectors, each with 'n' components, x(i ), y(i ), i = 1, : : : , n, where 'x' and 'y' are arbitrary mappings from integer to real number /c

begin long real s := long 0;

for i to n do s +:= leng x(i ) leng y(i ) od; shorten s

end

Real-calls using innerproduct 1:

innerproduct 1(m, (int j )real: x1 [j ],(int j )real: y1 [j ]) innerproduct 1(n, nsin, ncos)

225

Section ALGOL 68 Revised Report B5

11.3. Innerproduct 2

proc innerproduct 2= (ref [ ] real a, b) real : if upb a - lwb a= upb b - lwb b

then /c the innerproduct of two vectors 'a' and 'b' with equal numbers of elements /c

long real s := long 0;

ref [ ] real a1=a[@1], b1=b[@1];

/c note that the bounds of 'a [@1]' are [1: upb a- lwb a+1]/c for i to upb a1 do s+:= leng a1 [i ] leng b1 [i ] od; shorten s

Real-calls using innerproduct 2: innerproduct2(x1, y1) innerproduct2(y2 [2, ], y2 [ ,3])

11.4. Largest element

proc absmax = (ref [, ] real a, /c result /c ref real y, /c subscripts /c ref int i, k ) void:

/c the absolute value of the element of greatest absolute value of the matrix 'a' is assigned to 'y', and the subscripts of this element to 'i' and 'k'/c

begin y := -1;

for p from 1 lwb a to 1 upb a do

for q from 2 lwb a to 2 upb a do

if abs a[p, q]>y then y := abs a[i := p, k := q]

od

od end

Calls using absmax:

absmax(x2, x, i,j ) absmax(x2, x, loc int, loc int )

is terminated when the absolute values of the terms of the transformed series are found to be less than 'eps' 'tim' times in

226

SectionB7 van Wijngaarden, et al.

succession. this transformation is particularly e cient in the case of a slowly convergent or divergent alternating series /c

begin int n := 1, t; real mn, ds := eps; [1:16] real m; real sum := (m [1] := f(1)) / 2;

for i from 2 while (t := (abs ds < eps j t+1 j 1)) tim do mn := f(i );

for k to n do mn := ((ds := mn)+m [k ]) / 2; m [k ] := ds od; sum +:=(ds :=(abs mn < abs m[n] ^ n < 16 j n +:= 1; m[n] :=

mn; mn / 2 j mn))

od; sum

end

A call using euler:

euler((int i )real: (odd i j -1/i j 1/i ), 1.e-5, 2)

11.6. The norm of a vector

proc norm = (ref [ ] real a) real :

/c the euclidean norm of the vector 'a' /c ( long real s := long 0;

for k from lwb a to upb a do s+:= leng a [k ] " 2 od; shorten long sqrt (s))

For a use of norm in a call, see 11.7.

11.7. Determinant of a matrix

proc det = (ref [, ] real x, ref [ ] int p) real : if ref [, ] real a=x[@1, @1];

1 upb a=2 upb a^1 upb a= upb p - lwb p+1 then int n=1 upb a;

/c the determinant of the square matrix 'a' of order 'n' by the method of crout with row interchanges: 'a' is replaced by its triangular decomposition, l u, with all u [k, k ] = 1.

the vector 'p' gives as output the pivotal row indices; the k-th pivot is chosen in the k-th column of t such that abs l [i, k ] /

row norm is maximal /c

[ 1: n] real v; real d := 1, s, pivot; for i to n do v[i ] := norm(a [i, ]) od; for k to n

do int k1=k-1; ref int pk=p[@1] [k ]; real r := -1; ref [ , ]real al=a[, 1:k1], au=a[1: k1, ];

ref [ ]real ak=a[k, ], ka=a[, k ], alk=al[k, ], kau=au[, k ]; 227

Section ALGOL 68 Revised Report BA

for i from k to n

do ref real aik=ka [i ];

if (s := abs (aik -:= innerproduct 2(al [i, ], kau)) / v [i ])> r then r := s; pk := i

od;

v[pk ]:= v[k ]; pivot := ka[pk ]; ref [ ]real apk=a[pk, ]; for j to n

do ref real akj=ak[j ], apkj=apk [j ]; r := akj;

akj := if j k then apkj

else (apkj - innerproduct 2 (alk, au [, j ])) / pivot ; if pk /= k then apkj := -r

od;

d := pivot

od; d

Acall using det: det(y2,i1)

11.8.Greatest common divisor

proc gcd = (int a, b) int:

/c the greatest common divisor of two integers /c ( b=0 j abs a j gcd(b, a mod b))

A call using gcd: gcd(n, 124)

11.9. Continued fraction

op / = ([ ]real a, [ ]real b)real:

/c the value of a / b is that of the continued fraction a1 / (b1 +a2 / (b2+: : : an / bn): : : )/c

if lwb a=1 ^ lwb b=1 ^ upb a= upb b

then ( upb a=0 j 0 j a[1]/(b[1]+a[2: ] / b[2: ]))

A formula using /: x1 / y1

fThe use of recursion may often be elegant rather than e cient as in the recursive procedure 11.8 and the recursive operation 11.9. See, however, 11.10 and 11.13 for examples in which recursion is of the essence.g

228

SectionBA van Wijngaarden, et al.

11.10. Formula manipulation

begin

mode form = union(ref const, ref var, ref triple, ref call); mode const = struct (real value);

mode var = struct (string name, real value);

mode triple = struct (form left operand, int operator, form right operand);

mode function = struct (ref var bound var, form body);

mode call = struct (ref function function name, form parameter); int plus=1, minus =2, times =3, by =4, to =5;

heap const zero, one; value of zero := 0; value of one := 1;

op = = (form a, ref const b) bool: (a j (ref const ec): ec :=: b j false); op + = (form a, b) form:

( a=zero j b j: b=zero j a j heap triple := (a, plus, b));

op - = (form a, b) form: (b=zero j a j heap triple := (a, minus, b)); op = (form a, b)form: (a=zero or b=zero j zero j: a=one j b j:

b=one j a j heap triple := (a, times, b));

op / = (form a, b)form: (a=zero^(b=zero) j zero j: b=one j a j heap triple := (a, by, b));

op " = (form a, ref const b) form:

( a=one or (b:=:zero) j one j: b:=:one j a j heap triple := (a,to,b)); proc derivative of = (form e, /c with respect to /c ref var x) form:

case e in

( ref const): zero,

( ref var ev): (ev :=: x j one j zero), ( ref triple et):

case form u = left operand of et, v = right operand of et; form udash = derivative of(u, /c with respect to /c x),

vdash = derivative of(v, /c with respect to /c x); operator of et

in

udash + vdash, udash - vdash,

u vdash + udash v, (udash - et vdash) / v,

(v j (ref const ec): v u " (heap const c;

value of c := value of ec - 1; c) udash)

esac,

( ref call ef):

begin ref function f= function name of ef; 229

form g = parameter of ef; ref var y = bound var of f; heap function fdash := (y, derivative of (body of f, y)); ( heap call := (fdash, g)) derivative of(g, x)

end

esac;

proc value of = (form e) real: case e in

( ref const ec): value of ec, ( ref var ev): value of ev, ( ref triple et):

case real u = value of (left operand of et), v = value of (right operand of et); operator of et

in u + v, u - v, u v, u / v, exp (v ln (u)) esac,

( ref call ef):

begin ref function f = function name of ef;

value of bound var of f := value of (parameter of ef); value of (body of f)

end

esac;

heap form f, g;

heap var a := (}a}, skip), b := (}b}, skip), x := (}x}, skip); /c start here/c

read ((value of a, value of b, value of x)); f := a +x / (b + x);

g := (f+one) / (f-one);

print ((value of a, value of b, value of x,

value of (derivative of(g, /c with respect to /c x))))

end /c example of formula manipulation /c

11.11. Information retrieval

begin

mode ra = ref auth, rb = ref book;

mode auth = struct (string name, ra next, rb book ), book = struct (string title, rb next);

ra auth, rst auth := nil, last auth;

rb book; string name, title; int i; le input, output;

open (input, }}, remote in); open (output, }}, remote out); putf(output, ($ p

230