WHETSTONE| begin comment library A0, A1, A4, A5, A15; real x1, x2, x3, x4, x, y, z , t, t1, t2; array e[1:4]; integer i, j , k, l, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11; procedure pa(ep); real array ep; begin integer j ; j := 0; lab: ep[1] := (ep[1] + ep[2] + ep[3] - ep[4]) × t; ep[2] := (ep[1] + ep[2] - ep[3] + ep[4]) × t; ep[3] := (ep[1] - ep[2] + ep[3] + ep[4]) × t; ep[4] := (-ep[1] + ep[2] + ep[3] + ep[4]) / t2; j := j + 1; if j < 6 then goto lab; end procedure pa; procedure p0; begin e[j] := e[k]; e[k] := e[l]; e[l] := e[j]; end procedure p0; procedure p3(x, y, z ); value x, y; real x, y, z ; begin x := t × (x + y); y := t × (x + y); z := (x + y)/t2; end procedure p3; procedure pout(n, j , k, x1, x2, x3, x4); value n, j , k, x1, x2, x3, x4; integer n, j , k; real x1, x2, x3, x4; begin writetext(30, [n=]); write(30, format([nnnd_]), n); writetext(30, [ * j=]); write(30, format([nnnd_]), j); writetext(30, [ * k=]); write(30, format([nnnd_]), k); writetext(30, [ * x1=]); write(30, format([+d.dddddddd_]), x1); writetext(30, [ * x2=]); write(30, format([+d.dddddddd_]), x2); writetext(30, [ * x3=]); write(30, format([+d.dddddddd_]), x3); writetext(30, [ * x4=]); write(30, format([+d.dddddddd_]), x4); writetext(30, [[c_]]); end procedure pout; open(30); comment initialise constants; t := 0.499975; t1 := 0.50025; t2 := 2.0; comment read i, controlling total weight: if i=1 the total weight is one million Whetstone instructions: Walgol ran at 2.4KWIPS, so this should take 417 KDF9 CPU seconds; i := 1; i := i × 10; n1 := 0; n2 := 12 × i; n3 := 14 × i; n4 := 345 × i; n5 := 0; n6 := 210 × i; n7 := 32 × i; n8 := 899 × i; n9 := 616 × i; n10 := 0; n11 := 93 × i; comment module 1: simple identifiers; x1 := 1.0; x2 := x3 := x4 := -1.0; for i := 1 step 1 until n1 do begin x1 := (x1 + x2 + x3 - x4) × t; x2 := (x1 + x2 - x3 + x4) × t; x3 := (x1 - x2 + x3 + x4) × t; x4 := (-x1 + x2 + x3 + x4) × t; end module 1; pout(n1, n1, n1, x1, x2, x3, x4); comment module 2: array elements; e[1] := 1.0; e[2] := e[3] :=e[4] := -1.0; for i := 1 step 1 until n2 do begin e[1] := (e[1] + e[2] + e[3] - e[4]) × t; e[2] := (e[1] + e[2] - e[3] + e[4]) × t; e[3] := (e[1] - e[2] + e[3] + e[4]) × t; e[4] := (-e[1] + e[2] + e[3] + e[4]) × t; end module 2; pout(n2, n3, n2, e[1], e[2], e[3], e[4]); comment module 3: array as parameter; for i := 1 step 1 until n3 do pa(e); pout(n3, n2, n2, e[1], e[2], e[3], e[4]); comment module 4: conditional jumps; j := 1; for i := 1 step 1 until n4 do begin if j = 1 then j := 2 else j := 3; if j > 2 then j := 0 else j := 1; if j < 1 then j := 1 else j := 0; end module 4; pout(n4, j , j , x1, x2, x3, x4); comment module 5: omitted; comment module 6: integer arithmetic; j := 1; k := 2; l := 3; for i := 1 step 1 until n6 do begin j := j × (k - j ) × (l - k); k := l × k - (l - j ) × k; l := (l - k) × (k + j ); e[l - 1] := j + k + l; e[k - 1] := j × k × l; end module 6; pout(n6, j , k, e[1], e[2], e[3], e[4]); comment module 7: trig. functions; x := y := 0.5; for i := 1 step 1 until n7 do begin x := t × arctan(t2 × sin(x) × cos(x) / (cos(x + y) + cos(x - y) - 1.0)); y := t × arctan(t2 × sin(y) × cos(y) / (cos(x + y) + cos(x - y) - 1.0)); end module 7; pout(n7, j , k, x, x, y, y); comment module 8: procedure calls; x := y := z := 1.0; for i := 1 step 1 until n8 do begin p3(x, y, z ); end module 8; pout(n8, j , k, x, y, z , z ); comment module 9: array references; j := 1; k := 2; l := 3; e[1] := 1.0; e[2] := 2.0; e[3] := 3.0; for i := 1 step 1 until n9 do p0; pout(n9, j , k, e[1], e[2], e[3], e[4]); comment module 10: integer arithmetic; j := 2; k := 3; for i := 1 step 1 until n10 do begin j := j + k; k := j + k; j := k - j ; k := k - j - j ; end module 10; pout(n10, j , k, x1, x2, x3, x4); comment module 11: standard functions; x := 0.75; for i := 1 step 1 until n11 do begin x := sqrt(exp(ln(x)/t1)); end module 11; pout(n11, j , k, x, x, x, x); close(30); end |