|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 51456 (0xc900)
Types: TextFile
Names: »tsystest5 «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦f546e193b⟧
└─⟦this⟧ »tsystest5 «
message de enkelte måleprocedurer part 1 (tsystest5);
procedure mål_for (antal);
long antal;
begin <* mål for-løkke *>
systemtid (0, test_tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
;
end;
systemtid (begin_tid, tid);
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_for;
\f
procedure mål_repeat (antal);
long antal;
begin <* mål repeat-løkke *>
systemtid (0, test_tid);
nr := antal;
systemtid (0, begin_tid);
repeat
nr := nr - 1;
until nr = 1;
systemtid (begin_tid, tid);
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_repeat;
\f
procedure mål_while (antal);
long antal;
begin <* mål while-løkke *>
systemtid (0, test_tid);
nr := antal;
systemtid (0, begin_tid);
while nr <> 1 do nr := nr - 1;
systemtid (begin_tid, tid);
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_while;
\f
procedure mål_i_plus_pos (antal);
long antal;
begin <* mål integer plus positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* 10 stk *>
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_plus_pos;
\f
procedure mål_i_plus_neg (antal);
long antal;
begin <* mål integer plus negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
i3 := i1 + i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_plus_neg;
\f
procedure mål_i_minus_pos (antal);
long antal;
begin <* mål integer minus positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* 10 stk *>
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_minus_pos;
\f
procedure mål_i_minus_neg (antal);
long antal;
begin <* mål integer minus negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
i3 := i1 - i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_minus_neg;
\f
procedure mål_i_gange_pos (antal);
long antal;
begin <* mål integer gange positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* 10 stk *>
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_gange_pos;
\f
procedure mål_i_gange_neg (antal);
long antal;
begin <* mål integer gange negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
i3 := i1 * i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_gange_neg;
\f
procedure mål_i_div_pos (antal);
long antal;
begin <* mål integer div positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* 10 stk *>
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_div_pos;
\f
procedure mål_i_div_neg (antal);
long antal;
begin <* mål integer div negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
i3 := i1 // i2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := - 1 step - 1 until - 100 do
for i2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_div_neg;
\f
procedure mål_i_exp (antal);
long antal;
begin <* mål integer exponentation *>
systemtid (0, test_tid);
antal := (antal + 9999) // 10000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := - 49 step 1 until 50 do r := i1 ** i2;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i1 := 1 step 1 until 100 do
for i2 := - 49 step 1 until 50 do ;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 10000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_i_exp;
\f
procedure mål_l_plus_pos (antal);
long antal;
begin <* mål long plus positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* 10 stk *>
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_plus_pos;
\f
procedure mål_l_plus_neg (antal);
long antal;
begin <* mål long plus negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
l3 := l1 + l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_plus_neg;
\f
procedure mål_l_minus_pos (antal);
long antal;
begin <* mål long minus positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* 10 stk *>
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_minus_pos;
\f
procedure mål_l_minus_neg (antal);
long antal;
begin <* mål long minus negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
l3 := l1 - l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_minus_neg;
\f
procedure mål_l_gange_pos (antal);
long antal;
begin <* mål long gange positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* 10 stk *>
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_gange_pos;
\f
procedure mål_l_gange_neg (antal);
long antal;
begin <* mål long gange negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
l3 := l1 * l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_gange_neg;
\f
procedure mål_l_div_pos (antal);
long antal;
begin <* mål long div positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* 10 stk *>
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_div_pos;
\f
procedure mål_l_div_neg (antal);
long antal;
begin <* mål long div negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
l3 := l1 // l2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := - 1 step - 1 until - 100 do
for l2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_div_neg;
\f
procedure mål_l_exp (antal);
long antal;
begin <* mål long exponentation *>
systemtid (0, test_tid);
antal := (antal + 9999) // 10000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := - 49 step 1 until 50 do r := l1 ** l2;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for l1 := 1 step 1 until 100 do
for l2 := - 49 step 1 until 50 do ;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 10000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_l_exp;
\f
procedure mål_r_plus_pos (antal);
long antal;
begin <* mål real plus positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* 10 stk *>
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_plus_pos;
\f
procedure mål_r_plus_neg (antal);
long antal;
begin <* mål real plus negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
r3 := r1 + r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_plus_neg;
\f
procedure mål_r_minus_pos (antal);
long antal;
begin <* mål real minus positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* 10 stk *>
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_minus_pos;
\f
procedure mål_r_minus_neg (antal);
long antal;
begin <* mål real minus negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
r3 := r1 - r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_minus_neg;
\f
procedure mål_r_gange_pos (antal);
long antal;
begin <* mål real gange positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* 10 stk *>
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_gange_pos;
\f
procedure mål_r_gange_neg (antal);
long antal;
begin <* mål real gange negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
r3 := r1 * r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_gange_neg;
\f
procedure mål_r_div_pos (antal);
long antal;
begin <* mål real div positive tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* 10 stk *>
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := 1 step 1 until 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_div_pos;
\f
procedure mål_r_div_neg (antal);
long antal;
begin <* mål real div negative tal *>
systemtid (0, test_tid);
antal := (antal + 99999) // 100000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* 10 stk *>
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
r3 := r1 / r2;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := - 1 step - 1 until - 100 do
for r2 := - 1 step - 1 until - 100 do
begin <* dummy *>
end;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 100000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_div_neg;
\f
procedure mål_r_exp (antal);
long antal;
begin <* mål real exponentation *>
systemtid (0, test_tid);
antal := (antal + 9999) // 10000; <* pga indre loop *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := - 49 step 1 until 50 do r := r1 ** r2;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for r1 := 1 step 1 until 100 do
for r2 := - 49 step 1 until 50 do ;
end;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
antal := antal * 10000;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_r_exp;
\f
procedure mål_tofrom (antal);
long antal;
begin
<* mål tofrom, antal angiver antal 1024 words af 24 bit *>
integer array buf, buf1 (1 : 1024); <* 3 kbyte *>
systemtid (0, test_tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
tofrom (buf, buf1, 1024);
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do ;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_tofrom;
\f
procedure mål_system5 (antal);
long antal;
begin
<* mål system5, antal angiver antal 1024 words af 24 bit *>
integer array buf (1 : 1024); <* 3 kbyte *>
systemtid (0, test_tid);
if system (5, 0, buf) <> 1 then system (9, 5, <:<10>system:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
system (5, 0, buf);
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do ;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_system5;
\f
procedure mål_sieve (antal, size);
long antal;
integer size;
begin
integer i, prime, k, count, nr, ejok;
boolean array flags (0 : size);
ejok := 0;
systemtid (0, test_tid);
if datawrite then
begin <* gem data *>
d_init (testno); <* open og positioner *>
d_iwrite (size); <* write size *>
end datawrite
else
if datatest then
begin <* check data *>
d_init (testno); <* open og positioner *>
if size <> d_iread <* read size *>
then fejl (<:Fejl ved aftestningssize:>, size);
end datatest;
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
count := 0;
for i := 0 step 1 until size do flags (i) := true;
for i := 0 step 1 until size do
begin
if flags (i) then
begin
prime := i + i + 3;
for k := i + prime step prime until size do flags (k) := false;
count := count + 1;
if not datatest then <* intet *> else
if datawrite then d_iwrite (prime) <* gem data *>
else
if prime <> d_iread then
begin <* fejl *>
ejok := ejok + 1;
fejl (<:Fejl ved primtalsberegning, idx no.:>, i);
if ejok >= stop then
begin <* for mange fejl *>
wr_test (<:for mange fejl observeret, testen stoppes:>, - 1);
i := size;
end for mange fejl;
end fejl;
end;
end;
end;
systemtid (begin_tid, tid);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do ;
systemtid (begin_tid, loop_tid);
tid := tid - loop_tid; <* træk loop fra *>
if datawrite then
begin <* gem data *>
d_iwrite (count); <* write antal primtal *>
d_exit; <* close *>
end datawrite
else
if datatest then
begin <* check data *>
if count <> d_iread <* read antal primtal *>
then fejl (<:Fejl ved primtalsberegning, antal:>, count);
d_exit; <* close *>
end datatest;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_sieve;
\f
procedure mål_qsort (antal, size);
value size;
long antal;
integer size;
begin
integer array ar (0 : size - 1);
integer nr, i, j, x, ejok;
procedure qsort (ar, bot, top);
value bot, top;
integer array ar;
integer bot, top;
begin
integer i, j, temp;
x := x + 1;
while bot < top do
begin
i := bot;
j := top;
temp := ar (bot);
while i < j do
begin
comment test
write (out, "nl", 1, <<ddd>, x, <:: :>, <<d>, bot, <:/:>, top, <: :>, i, <:/:>, j);
while ar (j) > temp do j := j - 1;
ar (i) := ar (j);
while (i < j) and (ar (i) <= temp) do i := i + 1;
ar (j) := ar (i);
end;
ar (i) := temp;
qsort (ar, bot, i - 1);
bot := i + 1;
end;
x := x - 1;
end procedure qsort;
ejok := 0;
systemtid (0, test_tid);
tid := 0;
for nr := antal step - 1 until 1 do
begin
resetrandom;
for i := 0 step 1 until size - 1 do ar (i) := irandom (1, size);
x := 0;
systemtid (0, begin_tid);
qsort (ar, 0, size - 1);
systemtid (0, end_tid);
tid := tid + end_tid - begin_tid;
end;
if datawrite then
begin <* gem data *>
d_init (testno); <* open og positioner *>
d_iwrite (size); <* size for sieve *>
for i := 0 step 1 until size - 1 do d_iwrite (ar (i)); <* gem data *>
d_exit; <* close *>
end datawrite
else
if datatest then
begin <* check data *>
d_init (testno); <* open og positioner *>
if size <> d_iread <* read data *>
then fejl (<:Fejl ved aftestningssize:>, size)
else
for i := 0 step 1 until size - 1 do
if ar (i) <> d_iread then
begin <* fejl *>
ejok := ejok + 1;
fejl (<:Fejl ved sortering, uventet data, idx no.:>, i);
if ejok >= stop then
begin <* for mange fejl *>
wr_test (<:for mange fejl observeret, testen stoppes:>, - 1);
i := size;
end for mange fejl;
end fejl;
d_exit; <* close *>
end datatest;
for nr := 1 step 1 until size - 1 do if ar (nr) < ar (nr - 1)
then fejl (<:sortering ikke stigende, element nr.:>, nr);
if test and not datatest then
begin
for nr := 0 step 1 until size - 1 do
write (out, "nl", if nr mod 8 <> 0 then 0 else 1,
<<-ddddddddd>, ar (nr));
write (out, "nl", 1);
end;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_qsort;
\f
procedure mål_ssort (antal, size);
value size;
long antal;
integer size;
begin
integer array ar (0 : size - 1);
integer nr, i, j, ejok;
procedure ssort (ar, bot, top);
value bot, top;
integer array ar;
integer bot, top;
begin
integer i, gap, temp;
boolean nex;
gap := (top - bot) // 2;
repeat
repeat
nex := true;
for i := 0 step 1 until top - gap do
begin
comment test
write (out, "nl", 1, <:bot::>, bot, <: top::>, top,
<: gap::>, gap, <: nex::>, if nex then <:true:> else <:false:>, <: i::>, i);
if ar (i) > ar (i + gap) then
begin
temp := ar (i);
ar (i) := ar (i + gap);
ar (i + gap) := temp;
nex := false;
end;
end;
until nex;
gap := gap // 2;
until gap = 0;
end procedure ssort;
ejok := 0;
systemtid (0, test_tid);
tid := 0;
for nr := antal step - 1 until 1 do
begin
resetrandom;
for i := 0 step 1 until size - 1 do ar (i) := irandom (1, size);
systemtid (0, begin_tid);
ssort (ar, 0, size - 1);
systemtid (0, end_tid);
tid := tid + end_tid - begin_tid;
end;
if datawrite then
begin <* gem data *>
d_init (testno); <* open og positioner *>
d_iwrite (size); <* size for sieve *>
for i := 0 step 1 until size - 1 do d_iwrite (ar (i)); <* gem data *>
d_exit; <* close *>
end datawrite
else
if datatest then
begin <* check data *>
d_init (testno); <* open og positioner *>
if size <> d_iread <* read data *>
then fejl (<:Fejl ved aftestningssize:>, size)
else
for i := 0 step 1 until size - 1 do
if ar (i) <> d_iread then
begin <* fejl *>
ejok := ejok + 1;
fejl (<:Fejl ved sortering, uventet data, idx no.:>, i);
if ejok >= stop then
begin <* for mange fejl *>
wr_test (<:for mange fejl observeret, testen stoppes:>, - 1);
i := size;
end for mange fejl;
end fejl;
d_exit; <* close *>
end datatest;
for nr := 1 step 1 until size - 1 do if ar (nr) < ar (nr - 1)
then fejl (<:sortering ikke stigende, element nr.:>, nr);
if test and not datatest then
begin
for nr := 0 step 1 until size - 1 do
write (out, "nl", if nr mod 8 <> 0 then 0 else 1,
<<-ddddddddd>, ar (nr));
write (out, "nl", 1);
end;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_ssort;
\f
procedure mål_hsort (antal, size);
value size;
long antal;
integer size;
begin
integer array ar (0 : size - 1);
integer nr, i, j, ejok;
procedure hsort (ar, bot, top);
value bot, top;
integer array ar;
integer bot, top;
begin
integer i, temp;
procedure sift (ar, i, j);
value i, j;
integer array ar;
integer i, j;
begin
integer k, temp;
while 2 * i <= j do
begin
k := 2 * i;
comment test
write (out, "nl", 1, <<dddddddd>, i, j, k, ar (i), ar (k), ar (k + 1));
if k < j then
begin
if ar (k) < ar (k + 1) then k := k + 1;
end;
if ar (i) < ar (k) then
begin
temp := ar (k);
ar (k) := ar (i);
ar (i) := temp;
i := k;
end
else i := j + 1;
end;
end procedure sift;
i := top // 2;
while i >= 1 do <* ifølge Byte jun/1988: i > 1 *>
begin
sift (ar, i, top);
i := i - 1;
end;
i := top;
while i > 1 do
begin
sift (ar, 0, i);
temp := ar (0);
ar (0) := ar (i);
ar (i) := temp;
i := i - 1;
end;
end procedure hsort;
ejok := 0;
systemtid (0, test_tid);
tid := 0;
for nr := antal step - 1 until 1 do
begin
resetrandom;
for i := 0 step 1 until size - 1 do ar (i) := irandom (1, size);
systemtid (0, begin_tid);
hsort (ar, 0, size - 1);
systemtid (0, end_tid);
tid := tid + end_tid - begin_tid;
end;
if datawrite then
begin <* gem data *>
d_init (testno); <* open og positioner *>
d_iwrite (size); <* size for sieve *>
for i := 0 step 1 until size - 1 do d_iwrite (ar (i)); <* gem data *>
d_exit; <* close *>
end datawrite
else
if datatest then
begin <* check data *>
d_init (testno); <* open og positioner *>
if size <> d_iread <* read data *>
then fejl (<:Fejl ved aftestningssize:>, size)
else
for i := 0 step 1 until size - 1 do
if ar (i) <> d_iread then
begin <* fejl *>
ejok := ejok + 1;
fejl (<:Fejl ved sortering, uventet data, idx no.:>, i);
if ejok >= stop then
begin <* for mange fejl *>
wr_test (<:for mange fejl observeret, testen stoppes:>, - 1);
i := size;
end for mange fejl;
end fejl;
d_exit; <* close *>
end datatest;
for nr := 1 step 1 until size - 1 do if ar (nr) < ar (nr - 1)
then fejl (<:sortering ikke stigende, element nr.:>, nr);
if test and not datatest then
begin
for nr := 0 step 1 until size - 1 do
write (out, "nl", if nr mod 8 <> 0 then 0 else 1,
<<-ddddddddd>, ar (nr));
write (out, "nl", 1);
end;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_hsort;
\f
procedure mål_matrix (antal, size);
value size;
long antal;
integer size;
begin
integer nr, i, j, ejok;
integer array mx1, mx2, mx_r1, mx_r2, mx_r3 (1 : size, 1 : size);
procedure mxadd (mx1, mx2, mx_r, size);
value size;
integer array mx1, mx2, mx_r;
integer size;
begin <* adds two square matrices *>
integer r, c;
for r := 1 step 1 until size do
for c := 1 step 1 until size do mx_r (r, c) := mx1 (r, c) + mx2 (r, c);
end procedure mxadd;
procedure mxmult (mx1, mx2, mx_r, size);
value size;
integer array mx1, mx2, mx_r;
integer size;
begin <* multiplies two square matrices *>
integer r, c, i;
for r := 1 step 1 until size do
for c := 1 step 1 until size do
begin
mx_r (r, c) := 0;
for i := 1 step 1 until size do mx_r (r, c) := mx_r (r, c) + mx1 (r, i) * mx2 (i, c);
end;
end procedure mxmult;
procedure mxtrans (mx1, mx_r, size);
value size;
integer array mx1, mx_r;
integer size;
begin <* transputation of square matrice *>
integer r, c;
for r := 1 step 1 until size do
for c := 1 step 1 until size do mx_r (c, r) := mx1 (r, c);
end procedure mxtrans;
ejok := 0;
systemtid (0, test_tid);
tid := 0;
for nr := antal step - 1 until 1 do
begin
resetrandom;
k := 0;
for i := 1 step 1 until size do
for j := 1 step 1 until size do
begin
mx1 (i, j) := irandom (- size, size);
mx2 (i, j) := irandom (- size, size);
mx_r1 (i, j) := irandom (- size, size);
mx_r2 (i, j) := irandom (- size, size);
mx_r3 (i, j) := irandom (- size, size);
end;
systemtid (0, begin_tid);
mxadd (mx1, mx2, mx_r1, size);
mxmult (mx1, mx2, mx_r2, size);
mxtrans (mx1, mx_r3, size);
systemtid (0, end_tid);
tid := tid + end_tid - begin_tid;
end;
if datawrite then
begin <* gem data *>
d_init (testno); <* open og positioner *>
d_iwrite (size); <* size for sieve *>
for i := 1 step 1 until size do
for j := 1 step 1 until size do
begin
d_iwrite (mx_r1 (i, j));
d_iwrite (mx_r2 (i, j));
d_iwrite (mx_r3 (i, j));
end;
d_exit; <* close *>
end datawrite
else
if datatest then
begin <* check data *>
d_init (testno); <* open og positioner *>
if size <> d_iread <* read data *>
then fejl (<:Fejl ved aftestningssize:>, size)
else
for i := 1 step 1 until size do
for j := 1 step 1 until size do
begin
i1 := d_iread;
i2 := d_iread;
i3 := d_iread;
if mx_r1 (i, j) <> i1
or mx_r2 (i, j) <> i2
or mx_r3 (i, j) <> i3 then
begin <* fejl *>
ejok := ejok + 1;
fejl (<:Fejl ved integer-matrixberegning:>, - 1);
write (out, <<d>, <: element :>, i, ",", 1, j,
"nl", 1,
true, 10, <:forventet:>, true, 10, <:fundet:>, true, 10, <:forskel:>);
if mx_r1 (i, j) <> i1 then
begin
write (out, "nl", 1, << -bddddddd>,
i1, mx_r1 (i, j), i1 - mx_r1 (i, j), <:(addition):>,
"nl", 1, <:beregning: :>,
mx1 (i, j), <: + :>, mx2 (i, j));
end;
if mx_r2 (i, j) <> i2 then
begin
write (out, "nl", 1, << -bddddddd>,
i2, mx_r2 (i, j), i2 - mx_r2 (i, j), <:(multiplikation):>,
"nl", 1, <:beregning: :>);
for k := 1 step 1 until size do
write (out, "nl", 1, << -bddddddd>,
<:+ :>, mx1 (i, k), <: * :>, mx2 (k, j),
<: (=:>, mx1 (i, k) * mx2 (k, j), <:):>);
end;
if mx_r3 (i, j) <> i3 then
begin
write (out, "nl", 1, << -bddddddd>,
i3, mx_r3 (i, j), i3 - mx_r3 (i, j), <:(transcription):>,
"nl", 1, true, 10, <:beregning: :>, mx1 (j, i));
end;
if online then setposition (out, 0, 0);
if ejok >= stop then
begin <* for mange fejl *>
wr_test (<:for mange fejl observeret, testen stoppes:>, - 1);
i := j := size;
end for mange fejl;
end fejl;
end check;
d_exit; <* close *>
end datatest;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_matrix;
\f
procedure mål_fmatrix (antal, size);
value size;
long antal;
integer size;
begin
integer nr, i, j, ejok;
real array mx1, mx2, mx_r1, mx_r2, mx_r3 (1 : size, 1 : size);
procedure mxadd (mx1, mx2, mx_r, size);
value size;
real array mx1, mx2, mx_r;
integer size;
begin <* adds two square matrices *>
integer r, c;
for r := 1 step 1 until size do
for c := 1 step 1 until size do mx_r (r, c) := mx1 (r, c) + mx2 (r, c);
end procedure mxadd;
procedure mxmult (mx1, mx2, mx_r, size);
value size;
real array mx1, mx2, mx_r;
integer size;
begin <* multiplies two square matrices *>
integer r, c, i;
for r := 1 step 1 until size do
for c := 1 step 1 until size do
begin
mx_r (r, c) := 0;
for i := 1 step 1 until size do mx_r (r, c) := mx_r (r, c) + mx1 (r, i) * mx2 (i, c);
end;
end procedure mxmult;
procedure mxtrans (mx1, mx_r, size);
value size;
real array mx1, mx_r;
integer size;
begin <* transputation of square matrice *>
integer r, c;
for r := 1 step 1 until size do
for c := 1 step 1 until size do mx_r (c, r) := mx1 (r, c);
end procedure mxtrans;
ejok := 0;
systemtid (0, test_tid);
tid := 0;
for nr := antal step - 1 until 1 do
begin
resetrandom;
k := 0;
for i := 1 step 1 until size do
for j := 1 step 1 until size do
begin
mx1 (i, j) := rrandom (- size, size);
mx2 (i, j) := rrandom (- size, size);
mx_r1 (i, j) := rrandom (- size, size);
mx_r2 (i, j) := rrandom (- size, size);
mx_r3 (i, j) := rrandom (- size, size);
end;
systemtid (0, begin_tid);
mxadd (mx1, mx2, mx_r1, size);
mxmult (mx1, mx2, mx_r2, size);
mxtrans (mx1, mx_r3, size);
systemtid (0, end_tid);
tid := tid + end_tid - begin_tid;
end;
if datawrite then
begin <* gem data *>
d_init (testno); <* open og positioner *>
d_iwrite (size); <* size for sieve *>
for i := 1 step 1 until size do
for j := 1 step 1 until size do
begin
d_rwrite (mx_r1 (i, j));
d_rwrite (mx_r2 (i, j));
d_rwrite (mx_r3 (i, j));
end;
d_exit; <* close *>
end datawrite
else
if datatest then
begin <* check data *>
d_init (testno); <* open og positioner *>
if size <> d_iread <* read data *>
then fejl (<:Fejl ved aftestningssize:>, size)
else
for i := 1 step 1 until size do
for j := 1 step 1 until size do
begin
r1 := d_rread;
r2 := d_rread;
r3 := d_rread;
if mx_r1 (i, j) <> r1
or mx_r2 (i, j) <> r2
or mx_r3 (i, j) <> r3 then
begin <* fejl *>
ejok := ejok + 1;
fejl (<:Fejl ved flydende-matrixberegning:>, - 1);
write (out, <<d>, <: element :>, i, ",", 1, j,
"nl", 1,
true, 18, <:forventet:>, true, 18, <:fundet:>, true, 18, <:forskel:>);
if mx_r1 (i, j) <> r1 then
begin
write (out, "nl", 1, <<-d.ddddddddd'-dd__>,
r1, mx_r1 (i, j), r1 - mx_r1 (i, j), <:(addition):>,
"nl", 1, true, 18, <:beregning: :>,
mx1 (i, j), <: + :>, mx2 (i, j));
end;
if mx_r2 (i, j) <> r2 then
begin
write (out, "nl", 1, <<-d.ddddddddd'-dd__>,
r2, mx_r2 (i, j), r2 - mx_r2 (i, j), <:(multiplikation):>,
"nl", 1, <:beregning: :>);
for k := 1 step 1 until size do
write (out, "nl", 1, <<-d.ddddddddd'-dd__>,
<:+ :>, mx1 (i, k), <: * :>, mx2 (k, j),
<: (=:>, mx1 (i, k) * mx2 (k, j), <:):>);
end;
if mx_r3 (i, j) <> r3 then
begin
write (out, "nl", 1, <<-d.ddddddddd'-dd__>,
r3, mx_r3 (i, j), r3 - mx_r3 (i, j), <:(transcription):>,
"nl", 1, true, 18, <:beregning: :>, mx1 (j, i));
end;
if online then setposition (out, 0, 0);
if ejok >= stop then
begin <* for mange fejl *>
wr_test (<:for mange fejl observeret, testen stoppes:>, - 1);
i := j := size;
end for mange fejl;
end fejl;
end check;
d_exit; <* close *>
end datatest;
systemtid (test_tid, test_tid);
if kl then wr_test (<:antalsfaktor::>, antal * 10000 // test_tid);
end procedure mål_fmatrix;
▶EOF◀