Procedures in Algol 60 (chapter 3)

comment Procedures in Algol 60;
comment Sections 3.2 and 3.4;

comment Quadratic equation solver.  Results are written to x1 and x2.;

procedure quadratic(a, b, c, x1, x2);
     value a, b, c;
     real a, b, c, x1, x2;
begin
  real d;
  d := sqrt(b * b - 4 * a * c);
  x1 := (-b + d) / (2 * a);
  x2 := (-b - d) / (2 * a)
end;

comment Quadratic equation solver with error handling.
        Results are written to x1 and x2.
        If no roots, jump to label err;

procedure quadraticSafe(a, b, c, x1, x2, err);
     value a, b, c;
     real a, b, c, x1, x2;
     label err;
begin
  real d;
  d := b * b - 4 * a * c;
  if d < 0 then goto err;
  d := sqrt(d);
  x1 := (-b + d) / (2 * a);
  x2 := (-b - d) / (2 * a)
end;

comment A higher-order function.  Integrate the function f given as parameter.;

real procedure integral(f, a, b, steps);
    value a, b, steps;
    real procedure f; real a, b; integer steps;
begin
    real sum, x;
    sum := 0;
    for x := a step (b - a) / steps until b do
        sum := sum + f(x);
    integral := sum / steps
end;

comment An example of local function and of passing a function as argument.;

real procedure test(a, b);
    value a, b;  real a, b;
begin
    real procedure interpolate(x);
        value x; real x;
    begin
        interpolate := a * x + b * (1 - x)
    end;
    test := integral(interpolate, 0.0, 10.0, 200)
end;

comment Exchange its two arguments.  Shows the limitations of call by name.;

procedure swap(a, b);
    integer a, b;
begin
    integer temp;
    temp := a;
    a := b;
    b := temp
end;

comment A very general summation procedure.  Illustrates Jensen's device.;

real procedure sum(k, l, u, ak);
      value l, u;  integer k, l, u;  real ak;
begin
    real s;
    s := 0;
    for k := l step 1 until u do
        s := s + ak;
    sum := s
end;

begin

    comment An example of a nonlocal goto.;

    procedure fatalError;
    begin
        outstring(1, "Fatal error, exiting\n");
        goto terminate
    end;

    real x1, x2, r;
    integer i, j, s1, s2, s3;
    real array a[1:10], b[1:3, 1:3];

    quadratic(3, -8, 1, x1, x2);
    outstring(1, "Quadratic:\n");
    print(x1); print(x2);

    quadraticSafe(3, -8, 1, x1, x2, noSolution);
    outstring(1, "Quadratic (safe):\n");
    print(x1); print(x2);
    quadraticSafe(1, 0, 1, x1, x2, noSolution);
    fatalError;
  noSolution:
    outstring(1, "Quadratic (safe): no solution\n");
    
    outstring(1, "Test integral:\n");
    r := test(1.0, 4.0);
    print(r);

    for i := 1 step 1 until 10 do
        a[i] := 2 * i + 3;
    for i := 1 step 1 until 3 do
        for j := 1 step 1 until 3 do
            b[i,j] := 10 * i + j;

    outstring(1, "Jensen's device:\n");
    s1 := sum(i, 1, 10, a[i]);
    s2 := sum(i, 1, 100, i * i);
    s3 := sum(i, 1, 3, sum(j, 1, 3, b[i, j]));
    print(s1);
    print(s2);
    print(s3);

    outstring(1, "Swap:\n");
    swap(a[2], a[3]);
    print(a);
    outstring(1, "Bad swap:\n");
    i := 3;
    swap(i, a[i]);
    print(i);
    print(a);

  terminate:
end