begin library A0, A6;
comment program to integrate f(x,y) over triangle (0,0), (1,0), (1,1);
comment extra parameter to intint makes it work;
real procedure f(x, y);
value x,y; real x,y;
f:= x + x + y + y;
real procedure int(a, b, f);
comment integrates f(x) over range a to b;
value a, b; real a, b; real procedure f;
begin comment adding extra parameter makes it work;
real procedure intint(a, b, fa, fb, d);
value a, b, fa, fb, d; real a, b, fa, fb;
integer d;
begin
real c, fc, ff;
c := (a + b) * 0.5;
fc := f(c);
ff := (fa + 4.0*fc + fb);
comment answer is good enough if simrule no better than trapezoidal;
if abs( (fa + fb)*3.0 - ff ) < 0.001
then
intint := ff * (b - a) * 0.16666666667
else
intint := intint(a, c, fa, fc, d-1) + intint(c, b, fc, fb, d-1);
end;
int := intint(a, b, f(a), f(b), 5);
end;
real procedure intfy(x);
comment integral 0 to x of ff(x,y) dy;
value x; real x;
begin
real procedure fx(y);
value y; real y;
fx := f(x,y);
intfy := int(0, x, fx);
end;
real procedure minitest(x);
value x; real x;
begin
minitest := x*x*x;
end;
real answer, pi;
integer ii;
writetext(30, {minitest_0_to_2_x^3 _ = _ });
answer := int(0, 2, minitest);
output(30, answer);
writetext(30, {Now _ for _ the _ square _ root });
output(30, sqrt(answer));
pi := answer*arctan(1.0);
writetext(30, {This _ is _ the _ value _ of _ pi _ calculated _ using _ arctan _ });
output(30, pi);
answer := sin(pi/6.0);
writetext(30, {sin _ pi/6 _ which _ should _ be _ a _ half _ });
output(30, answer);
answer := cos(pi/6.0);
writetext(30, {cos _ pi/6 _ which _ should _ be _ a _ the _ same _ as _ the _ next _ result _ });
output(30, answer);
writetext(30, {should _ be _ same _ as _ the _ previous _ });
answer := sqrt(3.0)/2.0;
output(30, answer);
writetext(30, {Now _ square _ it _ to _ get _ 3/4 _ });
output(30, answer^2);
ii := 3;
writetext(30, {3^3 _ = _ });
output(30, ii^ii);
writetext(30, {Integer _ divide _ 3 _ squared _ by _ 2 _ });
output(30, ii^2 % 2);
writetext(30, {Calculate _ e _ using _ exp _ });
answer := exp(1.0);
output(30, answer);
writetext(30, {... _ and _ take _ its _ log _ });
output(30, ln(answer));
writetext(30, {{c}fulltest_0_to_1_triangle_ = _});
answer := int(0, 1, intfy);
output(30, answer);
writetext(30, {Testing _ exponentiation: _ 2 ^ 4 _ = _});
answer := 4.0;
output(30, 2^answer);
writetext(30, {Testing _ exponentiation: _ 2 ^ 4.0 _ = _});
output(30, 2.0^answer);
end
****
begin library A0, A6;
comment program to integrate f(x,y) over triangle (0,0), (1,0), (1,1);
real procedure f(x, y);
value x,y; real x,y;
f:= x + x + y + y;
real procedure int(a, b, f);
comment integrates f(x) over range a to b;
value a, b; real a, b; real procedure f;
begin
real procedure intint(a, b, fa, fb);
value a, b, fa, fb; real a, b, fa, fb;
begin
real c, fc, ff;
c := (a + b) * 0.5;
fc := f(c);
ff := (fa + 4.0*fc + fb);
comment answer is good enough if simrule no better than trapezoidal;
if abs( (fa + fb)*3.0 - ff ) < 0.1
then
intint := ff * (b - a) * 0.16666666667
else
intint := intint(a, c, fa, fc) + intint(c, b, fc, fb);
end;
int := intint(a, b, f(a), f(b));
end;
real procedure intfy(x);
comment integral 0 to x of ff(x,y) dy;
value x; real x;
begin
real procedure fx(y);
value y; real y;
fx := f(x,y);
intfy := int(0, x, fx);
end;
real procedure minitest(x);
value x; real x;
begin
minitest := x*x*x;
end;
real answer;
writetext(30, {minitest_0_to_2_x^3{c}});
answer := int(0, 2, minitest);
output(30, answer);
output(30, answer*100);
writetext(30, {fulltest_0_to_1_triangle_=_});
answer := int(0, 1, intfy);
output(30, answer*100);
end
****
begin library A0, A6;
comment program to integrate f(x,y) over triangle (0,0), (1,0), (1,1);
real procedure f(x, y);
value x,y; real x,y;
f:= x + x + y + y;
real procedure int(a, b, f);
comment integrates f(x) over range a to b;
value a, b; real a, b; real procedure f;
begin
real procedure intint(a, b, fa, fb);
value a, b, fa, fb; real a, b, fa, fb;
begin
real c, fc, ff;
c := (a + b) / 2;
fc := f(c);
ff := (fa + 4*fc + fb)/6;
comment answer is good enough if simrule no better than trapezoidal;
if abs( (fa + fb)/2 - ff ) < 0.01
then
intint := ff + (b - a)
else
intint := intint(a, c, fa, fc) + intint(c, b, fc, fb);
end;
int := intint(a, b, f(a), f(b));
end;
real procedure intfy(x);
comment integral 0 to x of ff(x,y) dy;
value x; real x;
begin
real procedure fx(y);
value y; real y;
fx := f(x,y);
intfy := int(0, x, fx);
end;
real answer;
answer := int(0, 1, intfy);
output(30, answer);
output(30, answer*100);
end
****
begin library A0, A6;
comment progam to investigate formal procedure calls;
integer procedure iz;
kdf9 0/0/0/0;
ZERO; exit;
algol;
procedure call2f(i, p1, ip2);
value i; integer i;
procedure p1;
integer procedure ip2;
begin
integer procedure inner(ii);
value ii; integer ii;
inner := ii + ip2(ii);
integer loc;
loc := ip2(4);
p1(5, iz);
end call2f;
procedure act2(i, j);
value i, j; integer i, j;
begin
i := 1;
end act2;
integer procedure iact1(j);
value j; integer j;
begin
iact1 := 2;
end iact1;
call2f(22, act2, iact1);
end
**** FAIL 17/20
begin library A0, A6;
comment DavidHu/formalproc;
integer procedure onetwothree(formal);
integer procedure formal;
begin;
onetwothree := formal(+345678);
end;
integer procedure actual(i);
value i;
integer i;
begin
actual := i;
end;
integer result;
result := onetwothree(actual);
output(30, result);
output(30, -result);
end
**** OK
begin library A0, A6;
comment DavidHu/manorboy - modified to do Hello World first;
integer procedure A(k, x1, x2, x3, x4, x5);
value k; integer k, x1, x2,x3,x4,x5;
begin
integer procedure B;
begin
k := k - 1 ;
B := A := A(k, B, x1, x2, x3, x4);
end;
if k <= 0 then A := x4 + x5 else B;
end;
integer res;
writetext(30, {Hello _ World {cc}});
writetext(30, {Here _ goes _ with _ Man _ or _ Boy {c}});
res := A(10, 1, -1, -1, 1, 0);
output(30, res);
res := res * res;
end
****
begin library A0, A6;
comment Hello World + a bit;
real x;
writetext(30, {Hello _ World{c}});
x := 123;
output(30, x);
writetext(30, {What {s} a _ 'real' _ 'procedure' _ this {s} is {c}});
end
****
begin library A0, A6;
comment DavidHu/manorboy - modified to do Hello World first;
integer procedure A(k, x1, x2, x3, x4, x5);
value k; integer k, x1, x2,x3,x4,x5;
begin
integer procedure B;
begin
k := k - 1 ;
B := A := A(k, B, x1, x2, x3, x4);
end;
if k <= 0 then A := x4 + x5 else B;
end;
integer res;
writetext(30, {Hello _ World {cc}});
writetext(30, {Here _ goes _ with _ Man _ or _ Boy {c}});
res := A(10, 1, -1, -1, 1, 0);
output(30, res);
res := res * res;
end
****
begin library A0, A6;
comment DavidHu/procsPlusCode;
real x;
x := 123;
begin
procedure P1( x);
real x;
begin
integer i;
x :=0;
end;
real procedure P2( x);
real x;
begin
integer i;
x :=0;
P2 := x;
end;
integer procedure P3( x);
real x;
begin
integer i;
x :=0;
P3 := x;
end;
boolean procedure P4( x);
real x;
begin
integer i;
x :=0;
P4 := x> 0;
end;
end;
writetext(30, {Hello _ World{c}});
x := 123;
output(30, x);
writetext(30, {What {s} a _ 'real' _ 'procedure' _ this {s} is {c}});
end
****
begin comment progam to investigate formal procedure calls;
procedure call2f(i, p1, ip2);
value i; integer i;
procedure p1;
integer procedure ip2;
begin
integer loc;
loc := ip2(4);
p1(5, loc);
end call2f;
procedure act1(i, j);
value i, j; integer i, j;
begin
i := 1;
end act1;
integer procedure act2(j);
value j; integer j;
begin
j := 2;
end act2;
call2f(22, act1, act2);
end
****
begin comment DavidHu/firstOpt;
procedure onetwothree(i);
value i;
integer i;
begin
integer array a[1:10]; integer index;
for index := 0 step 1 until 10 do
a[index] := 0;
a[5]:= a[10] + 2.0;
end;
procedure four(i);
value i;
integer i;
begin
integer array a[1:10]; integer index;
for index := 0 step 1 until 10 do
a[index] := 0;
a[5]:= a[10] + 2.0;
end;
integer j, index;
array aa[1:10];
index := 1000;
for index := 0 step 1 until 10 do
begin
comment 'for' j := 0 'step' 1 'until' 10 'do' 'begin'
'comment' aa[index] := 0;
comment aa[j] := 10;
comment 'end';
end;
aa[5]:= aa[10] + 2.0;
end
****
begin comment DavidHu/first;
procedure onetwothree(i);
value i;
integer i;
begin;
j := i;
end;
boolean a12345678;
integer j;
onetwothree(j);
end
****
begin comment DavidHu/namechain;
integer procedure p(i);
integer i;
begin
p := f(i);
p := f(i);
p := f(i);
p := f(i);
p := f(i);
p := f(i);
p := f(i);
end p;
integer procedure f (n);
integer n;
begin
f := n;
end p;
integer j;
j:= f( j + p(10));
j:= f( j + p(10));
j:= f( j + p(10));
j:= f( j + p(10));
comment signs that we have floater if we do any more;
j:= f( j + p(10));
comment j:= f( j + p(10));
comment j:= f( j + p(10));
comment j:= f( j + p(10));
comment j:= f( j + p(10));
comment j:= f( j + p(10));
end
****
begin comment DavidHu/firstfor;
procedure onetwothree(i);
value i;
integer i;
begin;
j := i;
end;
boolean a12345678;
integer j, k;
for k:=0 step 1 until k < 4 do
begin integer loop; onetwothree(k); end;
end
****
begin comment DavidHu/HoGrammar;
procedure jim( p);
integer p;
begin
real jinx;
end;
procedure james ( nI, vR);
value vR;
integer nI;
real vR;
begin
nI := vR;
end;
real x; real y; real z;
integer i; integer j; integer k;
boolean a; boolean b; boolean c;
begin
real x; real y; real z;
integer i; integer j; integer k;
boolean a; boolean b; boolean c;
begin
switch Sw := label1; comment ,label2;
label1: i:=10; j:=100; c := (-0.1 < 0);
label2: goto Sw[1];
end;
end;
begin
real x; real y; real z;
integer i; integer j; integer k;
boolean a; boolean b; boolean c;
begin
i:=10; j:=100; z := -0.1;
begin
array p[1:i,0:j]; array q[1:i,0:j]; array r[1:i,0:j];
integer array fred[0:if z < 0 then 1 else 4:20];
y := fred[i];
z := p[2,3];
end;
end;
james( x, 1000);
b := (i+j+k - x) < (x+y+z );
x := x- y - z;
end;
end
****
begin comment DavidHu/grammarTest;
procedure jim( p);
integer p;
begin
real jinx;
end;
procedure james ( nI, vR);
value vR;
integer nI;
real vR;
begin
nI := vR;
end;
real x,y,z;
integer i,j,k;
boolean a,b,c;
begin
real x,y,z;
integer i,j,k;
boolean a,b,c;
begin
switch Sw := i,j;
i:=10; j:=100; c := (-0.1 < 0);
k := Sw[0];
end;
end;
begin
real x,y,z;
integer i,j,k;
boolean a,b,c;
begin
i:=10; j:=100; z := -0.1;
begin
array p,q,r[1:i,0:j];
integer array fred[0:if z < 0 then 1 else 4:20];
y := fred[i];
z := p[2,3];
end;
end;
james( b, 1000);
b := (i+j+k - x) < (x+y+z );
x := x- y - z;
end;
end
****
begin comment DavidHu/procsPlusCode;
real x;
x := 0;
begin
procedure P1( x);
real x;
begin
integer i;
x :=0;
end;
real procedure P2( x);
real x;
begin
integer i;
x :=0;
P2 := x;
end;
integer procedure P3( x);
real x;
begin
integer i;
x :=0;
P3 := x;
end;
boolean procedure P4( x);
real x;
begin
integer i;
x :=0;
P4 := x> 0;
end;
end;
end
****
begin comment progam to investigate formal procedure calls;
integer procedure iz;
kdf9 0/0/0/0;
ZERO; exit;
algol;
procedure call2f(i, p1, ip2);
value i; integer i;
procedure p1;
integer procedure ip2;
begin
integer procedure inner(ii);
value ii; integer ii;
inner := ii + ip2(ii);
integer loc;
loc := ip2(4);
p1(5, iz);
end call2f;
procedure act2(i, j);
value i, j; integer i, j;
begin
i := 1;
end act2;
integer procedure iact1(j);
value j; integer j;
begin
iact1 := 2;
end iact1;
call2f(22, act2, iact1);
end
****
begin comment DavidHu/arraytest;
begin
comment 'real' xyz;
comment 'array' peter[6:7];
switch S := 20, 30, 40;
procedure jimmy(a);
string a;
begin
procedure nest(i);
integer i;
begin
i := 0;
end;
nest(100);
end;
integer anne;
array fred[1:3,2:4];
real procedure jim(x,i,b,a, p, l )switch:(sw);
value x, i, b,a;
real x; integer i; boolean b;
integer array a;
integer procedure p;
label l;
switch sw;
begin
boolean procedure nested( x);
real x;
begin
x := 100;
end;
nested(x);
x := S[1];
end;
begin
integer array ken[0:100];
boolean array boo[1:99];
real x;
next: jim(x, x,x);
jimmy({string}); goto next;
end;
end;
end
****
begin comment DavidHu/etcparam;
real procedure A(k, x1, x2, x3, x4, x5);
value k, x2, x3; integer k;
label x1; switch x2; integer array x3; integer array x4; integer x5;
begin
real procedure B;
begin
k := k - 1 ;
end;
goto x1; goto x2[1]; x3[1] := x4[1];
B;
end;
integer i,j,k1; real z;
begin
switch Town := Bath, Exeter, if i >0 then Exeter else Bath;
comment; switch Village := Exeter, Bath;
integer array fred[1:i];
Exeter: A(10, Town[1], Town, fred, fred, 0);
Bath: goto Town[fred[if i >= 0 then i else i+1 ]];
comment; i := fred[ if i = 0 then 10 else 150];
comment; i := (i+j) + 2 - (i+j);
z := -118.7 +260 / z -130 / z^2;
end;
end
****
begin
integer i, j;
procedure open(dv);
value dv;
integer dv;
begin
dv := 0;
end open;
real procedure read(dv);
value dv;
integer dv;
begin
read := 0;
end open;
open(20);
i := read(20);
for j:=1 step 1 until i do
output(30, j);
end
**** FAIL 00/02 after "undeclared identifier outpu t"
begin comment David's formalproc;
integer procedure onetwothree(formal);
integer procedure formal;
begin;
onetwothree := formal(10);
end;
integer procedure actual(i);
value i;
integer i;
begin
actual := i;
end;
integer result;
result := onetwothree(actual);
end
****
begin comment Knuth's manorboy all integer;
integer procedure A(k, x1, x2, x3, x4, x5);
value k; integer k; integer x1, x2,x3,x4,x5;
begin
integer procedure B;
begin comment; k := k - 1 ;
B := A := A(k, B, x1, x2, x3, x4);
end;
if k <= 0 then A := x4 + x5 else B;
end;
A(10, 1, -1, -1, 1, 0);
end
****
begin comment progam to investigate formal procedure calls;
integer procedure iabs(x);
value x; integer x; comment 2;
kdf9 0/0/0/0;
{x}; ABS; exit;
algol;
procedure call2f(i, p1, ip2);
value i; integer i; comment 3;
procedure p1; comment 97;
integer procedure ip2; comment 98;
begin
integer procedure inner(ii);
value ii; integer ii; comment 4;
inner := ii + ip2(ii); comment this is a bit hard;
integer loc;
loc := ip2(4) + inner(7);;
p1(5, iabs(loc));
end call2f;
procedure act2(i, j);
value i, j; integer i, j; comment 5;
begin
i := 1;
end act2;
integer procedure iact1(j);
value j; integer j; comment 6;
begin
iact1 := 2;
end iact1;
call2f(22, act2, iact1);
end
****
begin comment David's test for the Les Hodges version of KAB20;
integer iabc; integer j; comment was a comma seperated list;
procedure open(dv);
value dv;
integer dv;
begin
real x;
x := 3.14159;
dv := 1234567;
end open;
real procedure read(dv);
value dv;
integer dv;
kdf9 1/0/0/0;
ZERO; ={dv}; ZERO;
algol;
open(20);
iabc := read(20);
begin
integer j; integer jim;
for j:=1 step 1 until iabc do
begin jim := read(1); end;
end;
end
****
begin
real procedure proc1(a);
value a; real a;
begin
proc1 := proc2(0.0);
end proc1;
real procedure proc2(a);
value a; real a;
begin
proc2 := proc3(0.0);
end proc2;
real procedure proc3(a);
value a; real a;
begin
proc3 := proc1(0.0);
end proc3;
proc1(0);
end
****
begin comment second attempt at first;
procedure onetwothree(i);
value i;
integer i;
begin;
begin real abc;
own real array ken[1:100];
i := (i + i) + ( i + i);
i := ken[50];
end;
end;
boolean a12345678;
integer j;
switch sw := if j = 0 then L1 else L2, L1;
comment; array ar[1:10,1:10];
L1: ;
begin
real array fred[1:j];
j := ar[j,j];
begin real c,b,a;
real array fred[10:j];
goto sw[2];
j := fred[j];
onetwothree(j);
c := c + (a-b)^4 - c / (a-b) + a/b;
end;
ar[1,2] := ar[3,4];
end;
L2: comment; j := ar[1,j];
end
****
begin
real procedure proc1(a);
value a; real a;
begin
proc1 := proc2(0.0);
end proc1;
real procedure proc2(a);
value a; real a;
begin
proc2 := proc1(0.0);
end proc2;
proc1(0);
end
****
begin comment all sorts of proc calls;
real procedure abs(x);
value x; real x;
kdf9 0/0/0/0;
{x}; ABSF; exit;
algol;
integer procedure onetwothree(formal);
integer procedure formal;
begin;
onetwothree := formal(10);
end;
integer procedure actual(i);
value i;
integer i;
begin
actual := i;
end;
integer result;
real procedure threepars(i,j,x);
value i, j, x;
integer i,j; real x;
begin
threepars := i + j + actual(123);
end;
procedure test;
begin
integer k;
k := abs(threepars(1, 2, 11.11));
end;
test;
result := onetwothree(actual);
end
****
begin comment formalproc;
real procedure onetwothree(formal);
real procedure formal;
begin;
onetwothree := formal(10);
end;
procedure nopars;
begin
real x;
x := 13;
end;
real procedure actual(i);
value i;
real i;
begin
actual := i;
end;
real result;
result := onetwothree(actual);
nopars;
end
****
begin comment formalproc;
integer procedure onetwothree(formal);
integer procedure formal;
begin;
onetwothree := formal(10);
end;
integer procedure actual(i);
value i;
integer i;
begin
actual := i;
end;
integer result;
result := onetwothree(actual);
end
****
begin comment etcparams;
real procedure A(k, x1, x2, x3, x4, x5);
value k, x2, x3; integer k;
label x1; switch x2; integer array x3; integer array x4; integer x5;
begin
real procedure B;
begin
k := k - 1 ;
end;
goto x1; goto x2[1]; x3[1] := x4[1]; goto stop; goto veryend;
B;
stop:
end;
integer i,j,k1; real z;
begin
switch Town := Bath, Exeter, if i >0 then Exeter else Bath;
comment; switch Village := Exeter, Bath;
integer array fred[1:i];
Exeter: A(10, Town[1], Town, fred, fred, 0);
Bath: goto Town[fred[if i >= 0 then i else i+1 ]];
comment; i := fred[ if i = 0 then 10 else 150];
comment; i := (i+j) + 2 - (i+j);
z := -118.7 +260 / z -130 / z^(+2);
end;
veryend:
end
****
begin comment DHu's second test;
procedure onetwothree(i);
value i;
integer i;
begin
i := 0;
end;
real x,y;
begin
integer i;
end;
if y = 0 then x := (x+2) + (x+2) else
y := x:= 23.0 + 1.0;
y := 0.0;
end
****
begin
real procedure abs(x);
value x; real x;
kdf9 0/0/0/0;
{x}; ABSF; exit;
algol;
real procedure veryveryveryslowabs(x);
value x; real x;
begin
veryveryveryslowabs := if x<0 then -x else x;
end;
begin
integer i, j, k123456789;
for i:= 1 step 1 until 99 do
j := i + 1;
end;
end
****
begin
real procedure abs(x1);
value x1; real x1;
kdf9 0/0/0/0;
{x1}; ABSF; exit;
algol;
real procedure veryveryveryslowabs(x);
value x; real x;
begin
veryveryveryslowabs := if x<0 then -x else x;
end;
begin
integer i, j, k123456789;
for i:= 1 step 1 until 99 do
j := i + 1;
end;
end
****
begin comment David Hu's "first";
procedure one(i);
value i;
integer i;
begin;
j := i;
end;
integer j;
one(j);
end
****
begin comment David Hus procsPlusCode;
real x;
x := 0;
begin
procedure P1( x);
real x;
begin
integer i;
x :=0;
end;
real procedure P2( x);
real x;
begin
integer i;
x :=0;
P2 := x;
end;
integer procedure P3( x);
real x;
begin
integer i;
x :=0;
P3 := x;
end;
boolean procedure P4( x);
real x;
begin
integer i;
x :=0;
P4 := x> 0;
end;
end;
end
****
begin comment David Hus grammarTest;
procedure jim( p);
integer p;
begin
real jinx;
end;
procedure james ( nI, vR);
value vR;
integer nI;
real vR;
begin
nI := vR;
end;
real x,y,z;
integer i,j,k;
boolean a,b,c;
begin
real x,y,z;
integer i,j,k;
boolean a,b,c;
begin
switch Sw := i,j;
i:=10; j:=100; c := (-0.1 < 0);
k := Sw[0];
end;
end;
begin
real x,y,z;
integer i,j,k;
boolean a,b,c;
begin
i:=10; j:=100; z := -0.1;
begin
array p,q,r[1:i,0:j];
integer array fred[0:if z < 0 then 1 else 4:20];
y := fred[i];
z := p[2,3];
end;
end;
james( b, 1000);
b := (i+j+k - x) < (x+y+z );
x := x- y - z;
end;
end
****
begin integer i, j, k;
i:= 0;
comment 'for' j := 1 'step' 1 'until' 7 'do' ;
if i = 0
then
k := i * j;
end
****
begin
real procedure abs(x);
value x; real x;
kdf9 0/0/0/0;
{x}; ABSF; exit;
algol;
begin
integer i, j, k;
for i:= 1 step 1 until 99 do
j := i + 1;
end;
end
****
begin
comment program to integrate f(x,y) over triangle (0,0), (1,0), (1,1);
real procedure abs(x);
value x; real x;
kdf9 0/0/0/0;
{x}; ABSF; exit;
algol;
real procedure f(x, y);
value x,y; real x,y;
f:= x*x + y*y;
real procedure int(a, b, f);
comment integrates f(x) over range a to b;
value a, b; real a, b; real procedure f;
begin
real procedure intint(a, b, fa, fb);
value a, b, fa, fb; real a, b, fa, fb;
begin
real c, fc, ff;
c := (a + b) / 2;
fc := f(c);
ff := (fa + 4*fc + fb)/6;
comment answer is good enough if simrule no better than trapezoidal;
if abs( (fa + fb)/2 - ff ) < 0.001
then
intint := ff * (b - a)
else
intint := intint(a, c, fa, fc) + intint(c, b, fc, fb);
end;
int := intint(a, b, f(a), f(b));
end;
real procedure intfy(x);
comment integral 0 to x of f(x,y) dy;
value x; real x;
begin
real procedure fx(y);
value y; real y;
fx := f(x,y);
intfy := int(0, x, fx);
end;
real answer;
answer := int(0, 1, intfy);
end
****
begin
integer i, j;
procedure open(dv);
value dv;
integer dv;
begin
dv := 0;
end open;
real procedure read(dv);
value dv;
integer dv;
kdf9 1/0/0/0;
ZERO; ={dv}; ZERO; exit;
algol;
procedure output(dv, i);
value dv, i;
integer dv, i;
kdf9 1/0/0/0;
{dv}; {i}; JS789P295; exit;
algol;
open(20);
i := read(20);
for j:=1 step 1 until i do
output(30, j);
end
****
begin integer i, j, k;
comment no longer FAILS Tape format error;
comment now fails 18/22;
integer procedure nopars;
kdf9 1/0/0/0;
ZERO; =Q15; ZERO; exit;
algol;
i:= 0;
for j := 1 step 1 until i do
if i = 0
then
k := i + j;
end
****
begin integer i, j, k;
comment no longer FAILS Tape format error;
comment now fails 18/22;
procedure nopars;
begin
end nopars;
i:= 0;
for j := 1 step 1 until 7 do
if i = 0
then
k := i + j;
end
****
begin
begin
end
end
****
begin
integer i, j;
i := j;
end
****
begin
real b;
begin
real x;
begin
boolean b;
end;
begin
begin
real y;
begin
integer i;
i:= i +1; end;end;end;end;
end
****
begin
comment Knuth's Man or Boy program;
procedure output(dv, i);
value dv, i;
integer dv, i;
kdf9 1/0/0/0;
{dv}; {i}; MRWDQ0; exit;
algol;
real procedure A(k, x1, x2, x3, x4, x5);
value k; integer k, x1, x2, x3, x4, x5;
begin
real procedure B;
begin k := k - 1;
B := A := A(k, B, x1, x2, x3, x4);
end;
if k <= 0 then A := x4 + x5 else B;
end;
output(30, A(10, 1, -1, -1, 1, 0));
end
****
begin
procedure writetext(dv, s);
value dv;
integer dv; string s;
kdf9 1/1/1/1; {dv}; {s}; JS22P295; MRWDQ0;
exit;
algol;
switch S := l1, l2;
switch S2 := S[p(1)], S[p(p(1))];
integer i;
integer procedure p(i);
integer i;
begin
p := i;
end;
goto l2;
i := 0;
l1: l2: writetext(30, {Labels _ were _ a _ bad _ idea{c}});
i := i+1; goto S2[i];
end
****
l0:begin
switch S := l1, l2, l0;
switch S2 := S[p(2)], S[p(p(2))];
integer procedure p(i);
integer i;
begin
p := i + i;
end;
goto l2;
l1: l2: writetext(30, {Labels _ were _ a _ bad _ idea{c}}); goto S2[1];
end;
****
begin comment Knuth's monorboy;
real procedure A(k, x1, x2, x3, x4, x5);
value k; integer k, x1, x2, x3, x4, x5;
begin
real procedure B;
begin k := k - 1;
B := A := A(k, B, x1, x2, x3, x4);
end;
if k <= 0 then A := x4 + x5 else B;
end;
A(10, 1, -1, -1, 1, 0);
end
****
begin comment test to explore level parameters;
real procedure abs(z);
value z; real z;
kdf9 0/0/0/0;
{z}; ABSF; exit;
algol;
real procedure p0(x);
value x; real x;
begin
real procedure p1(x, y);
value x, y; real x, y;
p1 := x + y;
p0 := x + p1(x, x)'
end;
begin
integer i, j; real qqqqq;
for i:= -3 step 1 until +3 do
qqqqq := p0(abs(i));
end;
end
****
begin
procedure T(x);
value x;
integer x;
kdf9 7/5/0/2;
ZERO; DUP; DUP; =V1; =V2;
SET1; +; ={x};
algol;
T(100);
end
****
begin comment invalid progam to investigate FAILS 00N in KAB01;
integer procedure iabs(x)
value x; integer x;
kdf9 0/0/0/0;
{x}; ABS; exit;
algol;
integer res;
res := iabs(-9);
end
****
begin comment progam to investigate formal procedure calls;
integer procedure iz;
kdf9 0/0/0/0;
ZERO; exit;
algol;
procedure call2f(i, p1, ip2);
value i; integer i;
procedure p1;
integer procedure ip2;
begin
integer procedure inner(ii);
value ii; integer ii;
inner := ii + ip2(ii);
integer loc;
loc := ip2(4);
p1(5, iz);
end call2f;
procedure act2(i, j);
value i, j; integer i, j;
begin
i := 1;
end act2;
integer procedure iact1(j);
value j; integer j;
begin
iact1 := 2;
end iact1;
call2f(22, act2, iact1);
end
****
begin library A0, A6;
comment program to integrate f(x,y) over triangle (0,0), (1,0), (1,1);
real procedure f(x, y);
value x,y; real x,y;
f:= x + x + y + y;
real procedure int(a, b, f);
comment integrates f(x) over range a to b;
value a, b; real a, b; real procedure f;
begin
real procedure intint(a, b, fa, fb);
value a, b, fa, fb; real a, b, fa, fb;
begin
real c, fc, ff;
c := (a + b) * 0.5;
fc := f(c);
ff := (fa + 4.0*fc + fb);
comment answer is good enough if simrule no better than trapezoidal;
if abs( (fa + fb)*3.0 - ff ) < 0.1
then
intint := ff * (b - a) * 0.16666666667
else
intint := intint(a, c, fa, fc) + intint(c, b, fc, fb);
end;
int := intint(a, b, f(a), f(b));
end;
real procedure minitest(x);
value x; real x;
begin
minitest := x*x*x;
end;
real answer;
writetext(30, {minitest_0_to_2_x^3{c}});
answer := int(0, 2, minitest);
output(30, answer);
output(30, answer*100);
end
****
Output from Whetstone Algol
MINITEST 0 TO 2 X**3
0.0000 - 2.0000
0.0000 - 1.0000
0.0000 - 0.5000
0.0000 - 0.2500
0.2500 - 0.5000
0.5000 - 1.0000
0.5000 - 0.7500
0.5000 - 0.6250
0.6250 - 0.7500
0.7500 - 1.0000
0.7500 - 0.8750
0.8750 - 1.0000
1.0000 - 2.0000
1.0000 - 1.5000
1.0000 - 1.2500
1.0000 - 1.1250
1.1250 - 1.2500
1.2500 - 1.5000
1.2500 - 1.3750
1.3750 - 1.5000
1.5000 - 2.0000
1.5000 - 1.7500
1.5000 - 1.6250
1.6250 - 1.7500
1.7500 - 2.0000
1.7500 - 1.8750
1.8750 - 2.0000
+4.0000 0000 009 *+ 0;
+4.0000 0000 008 *+ 2;
RAN/EL/000M02S/000M02S
****
begin library A0, A6;
comment testing I/O;
real x;
open(20); open(30);
for x := read(20) while x < 1000000 do
output(30, x);
close(20); close(30);
end
****
begin comment 'library' A0;
comment program to integrate f(x,y) over triangle (0,0), (1,0), (1,1);
comment using Jensen's device -- David Ho;
real x, y;
real procedure f(x, y);
value x,y; real x,y;
f:= x + x + y + y;
real procedure int(a, b, x, f);
comment integrates f(x) over range a to b;
value a, b; real a, b, x, f;
begin
real procedure intint(a, b, fa, fb);
value a, b, fa, fb; real a, b, fa, fb;
begin
real c, fc, ff;
x := c := (a + b) / 2;
fc := f;
ff := (fa + 4*fc + fb)/6;
comment answer is good enough if simrule no better than trapezoidal;
if abs( (fa + fb)/2 - ff ) < 0.001
then
intint := ff * (b - a)
else
intint := intint(a, c, fa, fc) + intint(c, b, fc, fb);
end;
real fa;
x := a; fa := f; x := b;
int := intint(a, b, fa, f);
end;
real answer;
real procedure minitest(x);
value x; real x;
begin
minitest := x*x*x;
end;
writetext(30, {minitest_0_to_2_x^3{c}});
answer := int(0, 2, x, minitest(x));
output(30, answer);
output(30, answer*100);
comment writetext(30, {fulltest_0_to_1_triangle_=_});
comment answer := int(0, 1, x, int(0, x, y, f(x,y)));
comment output(30, answer*100);
end
****