|
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: 16128 (0x3f00)
Types: TextFile
Names: »tsystest6 «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦f546e193b⟧
└─⟦this⟧ »tsystest6 «
message de enkelte måleprocedurer part 2 (tsystest6);
procedure mål_create (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål create *>
zone z (128, 1, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
close (z, false);
ia (1) := segm;
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := ia (10) := 0;
ia (6) := systime (7, 0, 0.0);
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
i := monitor (50, z, 2, ia);
if i <> 0 then system (9, i, <:<10>mon-50:>);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
monitor (40, z, 0, ia);
monitor (50, z, 2, ia);
monitor (48, z, 0, ia);
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 *>
end procedure mål_create;
\f
procedure mål_changesize (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål chengeentry tail (1) *>
zone z (128, 1, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
close (z, false);
ia (1) := segm;
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := ia (10) := 0;
ia (6) := systime (7, 0, 0.0);
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
i := monitor (50, z, 2, ia);
if i <> 0 then system (9, i, <:<10>mon-50:>);
systemtid (0, begin_tid);
i := 0;
for nr := antal step - 1 until 1 do
begin
ia (1) := i;
monitor (44, z, 0, ia);
i := i + buflgd;
if i >= segm then i := 0;
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 *>
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_changesize;
\f
procedure mål_changetail (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål changetail *>
zone z (128, 1, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
close (z, false);
ia (1) := segm;
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := ia (10) := 0;
ia (6) := systime (7, 0, 0.0);
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
i := monitor (50, z, 2, ia);
if i <> 0 then system (9, i, <:<10>mon-50:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
ia (10) := nr;
monitor (44, z, 0, ia);
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 *>
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_changetail;
\f
procedure mål_systime1 (antal);
long antal;
begin <* mål gettime *>
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
r := systime (1, 0, r1);
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 *>
end procedure mål_systime1;
\f
procedure mål_wseq (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål write seq *>
zone z (buflgd * 128 * shares, shares, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd;
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
setposition (z, 0, 0);
for i := 1 step buflgd until segm do
outrec6 (z, buflgd * 512);
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_wseq;
\f
procedure mål_rseq (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål read seq *>
zone z (buflgd * 128 * shares, shares, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd;
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
setposition (z, 0, 0);
for i := 1 step buflgd until segm do
inrec6 (z, buflgd * 512);
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_rseq;
\f
procedure mål_wrand (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål write random *>
zone z (buflgd * 128 * shares, shares, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd + buflgd; <* en extra buflgd lang *>
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
rand := 0;
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i := 1 step buflgd until segm do
begin
setposition (z, 0, entier (random (rand) * (segm - buflgd)));
outrec6 (z, buflgd * 512);
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_wrand;
\f
procedure mål_rrand (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål read random *>
zone z (buflgd * 128 * shares, shares, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd + buflgd; <* en extra buflgd lang *>
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
rand := 0;
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i := 1 step buflgd until segm do
begin
setposition (z, 0, entier (random (rand) * (segm - buflgd)));
inrec6 (z, buflgd * 512);
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_rrand;
\f
procedure mål_orand (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål opdat random *>
zone z (buflgd * 128 * shares, shares, xstderror);
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd + buflgd; <* en extra buflgd lang *>
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
rand := 0;
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
for i := 1 step buflgd until segm do
begin
j := entier (random (rand) * (segm - buflgd));
setposition (z, 0, j);
inrec6 (z, buflgd * 512);
setposition (z, 0, j);
outrec6 (z, buflgd * 512);
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_orand;
\f
procedure mål_wcross (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål write cross (først yderst, så inderst osv) *>
zone z (buflgd * 128 * shares, shares, xstderror);
boolean lav;
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd + buflgd; <* en extra buflgd lang *>
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
lav := true;
for i := 1 step buflgd until segm do
begin
j := if lav then (i - 1) else segm - (i - 1) - buflgd;
setposition (z, 0, j);
outrec6 (z, buflgd * 512);
lav := not lav;
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_wcross;
\f
procedure mål_rcross (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål read cross (først yderst, så inderst osv) *>
zone z (buflgd * 128 * shares, shares, xstderror);
boolean lav;
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd + buflgd; <* en extra buflgd lang *>
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
lav := true;
for i := 1 step buflgd until segm do
begin
j := if lav then (i - 1) else segm - (i - 1) - buflgd;
setposition (z, 0, j);
inrec6 (z, buflgd * 512);
lav := not lav;
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_rcross;
\f
procedure mål_ocross (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin
<* mål read/write cross
dvs. æs først yderst, skriv inderst, så læs inderst, skriv yderst osv.
*>
zone z (buflgd * 128 * shares, shares, xstderror);
boolean lav;
makename (1, la, 'nul');
open (z, 4, la, 0);
ia (1) := (segm + (buflgd - 1)) // buflgd * buflgd + buflgd; <* en extra buflgd lang *>
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, z, 0, ia); <* clear evt gammel fil *>
i := monitor (40, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-40:>);
systemtid (0, begin_tid);
for nr := antal step - 1 until 1 do
begin
lav := true;
for i := 1 step buflgd until segm do
begin
j := if lav then (i - 1) else segm - (i - 1) - buflgd;
setposition (z, 0, j);
inrec6 (z, buflgd * 512);
setposition (z, 0, j);
outrec6 (z, buflgd * 512);
lav := not lav;
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 *>
close (z, false);
i := monitor (48, z, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_ocross;
\f
procedure mål_dcopy (antal, buflgd, shares, segm, disc1, disc2);
long antal;
integer buflgd, shares, segm;
long array disc1, disc2;
begin <* mål disckopiering *>
zone zind, zud (128, 1, xstderror);
makename (1, la, 'i');
open (zind, 4, la, 0);
ia (1) := segm;
tofrom (ia.laf2, disc1, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, zind, 0, ia); <* clear evt gammel fil *>
i := monitor (40, zind, 0, ia); <* opret ny fil *>
if i <> 0 then system (9, i, <:<10>mon-40:>);
makename (1, la, 'o');
open (zud, 4, la, 0);
ia (1) := segm;
tofrom (ia.laf2, disc2, 8);
ia (7) := ia (8) := ia (9) := 0;
ia (6) := systime (7, 0, 0.0);
ia (10) := buflgd;
monitor (48, zud, 0, ia); <* clear evt gammel fil *>
i := monitor (40, zud, 0, ia); <* opret ny fil *>
if i <> 0 then system (9, i, <:<10>mon-40:>);
systemtid (0, begin_tid);
i := 0;
for nr := antal step - 1 until 1 do
begin
xcopyzone (zind, zud, extend segm * 512, buflgd * 512, shares);
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 *>
close (zind, false);
i := monitor (48, zind, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
close (zud, false);
i := monitor (48, zud, 0, ia);
if i <> 0 then system (9, i, <:<10>mon-48:>);
end procedure mål_dcopy;
▶EOF◀