|
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: 8448 (0x2100)
Types: TextFile
Names: »timctest1 «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦f546e193b⟧
└─⟦this⟧ »timctest1 «
procedure io_proc (actno, nr, idx, input, c_nameimc, c_name_l, c_name_r);
value actno, nr, idx, input;
integer actno, nr, idx;
boolean input;
long array c_nameimc, c_name_l, c_name_r;
begin
<* proceduren laver io på nettet, hvis input=true læses ellers skrives
1. ord i data = 25 => end of data
connect og disconnect laves altid i zimc_ud, der er enkeltbufret
dette skal gøres før close på zimc_ind for at undgå deadlock
da close laver wait_answer ved ubesvarede inputs
*>
zone zimc_ind (buflgd_hw // 4 * shares, shares, xstderror),
zimc_ud (buflgd_hw // 4, 1, xstderror);
long array nameimc, name_l, name_r (1 : 2);
long reason, hw;
integer res, antio, ionr, testnr, rand, r_nr, r_idx, i, j, k;
boolean slut, ok, error;
real r;
integer array sh (1 : 12), zd, ia (1 : 20);
real begin_tid, begin_cpu, tid, cpu;
integer array field iaf;
procedure input_tom (z, ionr);
zone z;
integer ionr;
begin
if test then wr_test (nr, idx, <:før inrec6, io nr.:>, ionr);
antal_io (actno) := antal_io (actno) + 1;
inrec6 (z, buflgd_hw);
if ionr = 1 then
begin <* første så hent r_nr og r_idx *>
r_nr := z (2) shift (- 40) extract 8;
r_idx := z (2) shift (- 32) extract 8;
wr_test (nr, idx, <:connected to:>, - 1);
write (out, <<d>, r_nr, ".", 1, r_idx);
if online then setposition (out, 0, 0);
end;
if z (1) = real <:<25><25><25><25><25>:> add 25 then slut := true;
ok := true;
for j := if not datacheck then 2 else buflgd_hw // 4 step - 1 until 2 do
if z (j) <> real (extend r_nr shift 40
+ extend r_idx shift 32
+ extend (ionr extract 8) shift 24
+ j)
then
begin
fejl (nr, idx, <:*** datafejl, io.:>, ionr);
write (out, <<d>,
<: (port.link.ionr.adr / port<40+link<32+ionr<24+adr):>,
"nl", 1, <:ventet::>, r_nr, ".", 1, r_idx, ".", 1,
ionr extract 8, ".", 1, j,
<: modtaget::>, z (j) shift (- 40) extract 8, ".", 1,
z (j) shift (- 32) extract 8, ".", 1,
z (j) shift (- 24) extract 8, ".", 1,
z (j) extract 24);
if online then setposition (out, 0, 0);
system (9, 8, <:<10>break:>);
end fejl;
end procedure input_tom;
procedure output_tom (z, ionr);
zone z;
integer ionr;
begin
if test then wr_test (nr, idx, <:før outrec6, io nr.:>, ionr);
antal_io (actno) := antal_io (actno) + 1;
outrec6 (z, buflgd_hw);
for j := if not datacheck then 2 else buflgd_hw // 4 step - 1 until 2 do
z (j) := real (extend nr shift 40
+ extend idx shift 32
+ extend (ionr extract 8) shift 24
+ j);
if ionr <> antio
then z (1) := real <::>
else z (1) := real <:<25><25><25><25><25>:> add 25;
if duplex then setposition (z, 0, 0); <* tving data ud *>
end procedure output_tom;
xclaim (2048); <* extra program stack *>
trap (trap_fejlet);
error := false;
tofrom (nameimc, c_nameimc, 8);
tofrom (name_l, c_name_l, 8);
tofrom (name_r, c_name_r, 8);
systime (5, 0, r);
wr_test (nr, idx,
if input then <:begin input, kl.:> else <:begin output, kl.:>, r);
write (out,
<: m.:>, name_lan,
<: a.:>, name_imc,
<: p.:>, name_l, <: & :>, name_r);
if online then setposition (out, 0, 0);
rand := nr * 100 + idx; <* basis for random *>
for testnr := 1 step 1 until anttest do
begin <* pr connect *>
xnulstil (zimc_ind);
xnulstil (zimc_ud);
open (zimc_ind, 20, nameimc, 1 shift 9);
open (zimc_ud, 20, nameimc, 1 shift 9);
wr_test (nr, idx, <:connect:>, actno);
if x_lav_imc_connect (zimc_ud, idx, name_l, name_r, reason) then
begin <* connect ok *>
getzone6 (zimc_ud, ia);
getzone6 (zimc_ind, zd);
tofrom (zd, ia, 26); <* genbrug zd (1)..zd (13) *>
setzone6 (zimc_ind, zd);
trap (trap_rydop);
ionr := 0;
hw := 0;
begin_cpu := systime (1, 0, begin_tid);
if input then
begin <* read *>
if fil then
begin <* skriv i fil *>
zone z_fil (1, 1, xstderror);
open (z_fil, 4, filnavn, 1 shift 9);
close (z_fil, false);
hw := xcopyzone (zimc_ind, z_fil, - 1, buflgd_hw, shares);
ionr := (hw + (buflgd_hw - 1)) // buflgd_hw;
end skriv i fil
else
begin
slut := false;
repeat
ionr := ionr + 1;
input_tom (zimc_ind, ionr);
if duplex then output_tom (zimc_ud, ionr);
hw := hw + buflgd_hw;
if not datacheck
then zimc_ind (1) := real <::>
else xnulstil (zimc_ind);
until slut;
if duplex then
begin <* gange to *>
hw := hw * 2;
ionr := ionr * 2;
end duplex;
end;
end input
else
begin <* output *>
if maxio > 0 then antio := entier (random (rand) * (maxio - 1) + 1)
else antio := abs (maxio);
if fil then
begin <* læs fra fil *>
zone z_fil (1, 1, xstderror);
integer array ia, iax (1 : 20);
open (z_fil, 4, filnavn, 1 shift 9);
close (z_fil, false);
hw := xcopyzone (z_fil, zimc_ud, - 1, buflgd_hw, shares);
ionr := (hw + (buflgd_hw - 1)) // buflgd_hw;
<* send em, markeret v. 4 hw, over lan *>
getzone6 (zimc_ud, iax);
getzone6 (z_fil, ia);
tofrom (ia, iax, 26); <* overfør navn, kind mv. *>
setzone6 (z_fil, ia);
xinitoutput (z_fil, ia);
xsetoutput (z_fil, ia, 1, 4); <* gør klar til output *>
z_fil (1) := real <:<25><25><25><25><25>:> add 25;
xoutput (z_fil, ia, 1, 4); <* send *>
end læs fra fil
else
begin
ionr := 0;
repeat
ionr := ionr + 1;
output_tom (zimc_ud, ionr);
if duplex then input_tom (zimc_ind, ionr);
hw := hw + buflgd_hw;
if not duplex then <* glem det *> else
if not datacheck then zimc_ind (1) := real <::>
else xnulstil (zimc_ind);
until ionr >= antio;
if duplex then
begin <* gange to *>
hw := hw * 2;
ionr := ionr * 2;
end duplex;
end;
end output;
cpu := systime (1, begin_tid, tid) - begin_cpu;
cpu_ialt := cpu_ialt + cpu;
tid_ialt := tid_ialt + tid;
bytes_ialt := bytes_ialt + hw * 3 // 2;
io_ialt := io_ialt + ionr;
if test then wr_test (nr, idx, <:bytes transfered=:>, hw * 3 // 2);
if false then
trap_rydop:
begin <* error *>
error := true;
xwritealarm;
end error;
trap (0);
wr_test (nr, idx, <:disconnect:>, actno);
imcdisconn (zimc_ud, reason); <* skal gøres på ud zonen og før alt andet *>
close (zimc_ud, false);
close (zimc_ind, false);
if error then trap (nr);
end connect ok
else fejl_reason (nr, idx, <:imcconnect:>, name_r, reason);
end pr connect;
systime (5, 0, r);
wr_test (nr, idx, if input then <:end input, kl.:> else <:end output, kl.:>, r);
if false then
trap_fejlet:
begin <* error *>
error := true;
xwritealarm;
end error;
trap (0);
if error then trap (nr);
end procedure io_proc;
▶EOF◀