|
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: 6144 (0x1800)
Types: TextFile
Names: »sendvtlogtx «
└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
└─⟦6a563b143⟧
└─⟦this⟧ »sendvtlogtx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »sendvtlogtx «
begin
real array programnavn(1:2);
boolean gentag,testlist;
integer antal_navne,res;
integer array tail(1:10);
real array navnefil(1:2);
zone zhelp(1,1,stderror);
procedure flyt_navne(sendte);
value sendte;
boolean sendte;
begin
integer i;
real array field raf;
zone zfra,ztil(128,1,stderror);
integer array fratail,tiltail(1:10);
if sendte then
begin
open(zfra,4,<:vtlogsendt:>,0);
open(ztil,4,<:vtlogslet:>,0);
end
else
begin
open(zfra,4,<:vtlogklar:>,0);
open(ztil,4,<:vtlogsendt:>,0);
end;
if monitor(42,ztil,0,tiltail)=0 then
begin
if monitor(52,ztil,0,tiltail)=0 then
begin
if monitor(8,ztil,0,tiltail)=0 then
begin
if monitor(42,zfra,0,fratail)=0 then
begin
if monitor(52,zfra,0,fratail)=0 then
begin
for i:= 1 step 1 until fratail(10) do
begin
inrec6(zfra,8);
setposition(ztil,0,(tiltail(10)+i-1)//64);
if (tiltail(10)+i-1)//64 >= tiltail(1) then
outrec6(ztil,512)
else
swoprec6(ztil,512);
raf:= ((tiltail(10)+i-1) mod 64)*8;
tofrom(ztil.raf,zfra,8);
end;
tiltail(10):=tiltail(10)+fratail(10);
fratail(10):=0;
monitor(44,ztil,0,tiltail);
monitor(44,zfra,0,fratail);
end;
end;
end;
end;
end;
close(ztil,true);
close(zfra,true);
end;
if system(4,1,programnavn) <> 6 shift 12 + 10 then system(4,0,programnavn);
gentag:= programnavn(1)=real<:genta:> add'g';
testlist:= -,gentag and programnavn(1)<>real<:sendv:> add 't';
movestring(navnefil,1,if gentag then <:vtlogsendt:> else <:vtlogklar:>);
open(zhelp,0,navnefil,0); close(zhelp,true);
res:= monitor(42)lookup_entry:(zhelp,0,tail);
antal_navne:= if res=0 then tail(10) else 0;
if antal_navne > 0 then
begin
integer i,j,d,antal_poster;
real dato,tid,t;
integer array ia(1:10);
long array filnavne(1:antal_navne*2);
real array field raf;
zone z(128,1,stderror);
integer field v_kode,v_bus,v_ll1,v_ll2;
real field v_tid;
long array field v_tekst;
v_tid:= 4;
v_kode:=v_tekst:= 6;
v_bus:= 8;
v_ll1:= 10;
v_ll2:= 12;
open(z,4,navnefil,0);
for i:= 1 step 1 until antal_navne do
begin
raf:= (i-1)*8;
inrec6(z,8);
tofrom(filnavne.raf,z,8);
end;
close(z,true);
for i:= 1 step 1 until antal_navne do
begin
raf:= (i-1)*8;
open(z,4,filnavne.raf,0);
if monitor(42)lookup_entry:(z,0,ia) = 0 then
begin
if monitor(52)create_areaprocess:(z,0,ia) = 0 then
begin
antal_poster:= 0;
for j:= 1 step 1 until ia(10) do
begin
inrec6(z,16);
antal_poster:=antal_poster+1;
dato:=systime(4,z.v_tid,tid);
d:= entier(dato); t:= entier(tid/100)/100;
if z.v_kode=7 and z.v_ll1=0 then z.v_kode:= 5;
if 0 <= z.v_kode and z.vkode <= 1 then
begin
write(out, case (z.v_kode+1) of (<:ST:>,<:SL:>),
<< zd>,d mod 100,".",1,<<zd>,(d//100) mod 100,".",1,
<<zddd>,(d//10000)+1900,"sp",1,<<zd.dd>,t,
"sp",1);
if z.v_kode = 1 then
write(out,<<ddddddd>,antal_poster,"cr",1,"nl",1)
else
write(out,"sp",7,"cr",1,"nl",1);
end
else
if z.v_kode = 4 then
begin
write(out,<:PS :>,<<zd.dd>,t,"sp",1);
write(out,"sp",20-write(out,z.v_tekst),"cr",1,"nl",1);
end
else
if z.v_kode <= 7 then
begin
write(out,case (z.v_kode+1) of (<::>,<::>,<:AU:>,<:AO:>,
<::>,<:MI:>,<:MU:>,<:MO:>),"sp",1,<<zd.dd>,t,"sp",1,
<<dddd>,z.v_bus extract 14,"sp",1);
if z.v_ll1 <> 0 then
begin
if z.v_ll1 shift (-7) extract 5 = 0 then
write(out,<< ddd>,z.v_ll1 shift (-12) extract 10,"/",1)
else
write(out,<<ddd>,z.v_ll1 shift (-12) extract 10,
false add (z.v_ll1 shift (-7) extract 5 + '@'),1,"/",1);
write(out,<<d>,z.v_ll1 extract 7,
"sp",if z.v_ll1 extract 7 < 10 then 2 else 1);
end
else
write(out,"sp",8);
if z.v_ll2 <> 0 then
begin
if z.v_ll2 shift (-7) extract 5 = 0 then
write(out,<< ddd>,z.v_ll2 shift (-12) extract 10,"/",1)
else
write(out,<<ddd>,z.v_ll2 shift (-12) extract 10,
false add (z.v_ll2 shift (-7) extract 5 + '@'),1,"/",1);
write(out,<<d>,z.v_ll2 extract 7,
"sp",if z.v_ll2 extract 7 < 10 then 1 else 0);
end
else
write(out,"sp",7);
write(out,"cr",1,"nl",1);
end;
ud(out);
end for j;
end if areaprocess;
end if lookup;
close(z,true);
end for i;
if -, (gentag or testlist) then
begin
flyt_navne(true);
flyt_navne(false);
end;
end antal navne > 0;
write(out,<:EX:>,"sp",27,"cr",1,"nl",1);
trapmode:= 1 shift 10;
end
▶EOF◀