|
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: 94464 (0x17100)
Types: TextFile
Names: »htvogntabel «
└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
└─⟦6a563b143⟧
└─⟦this⟧ »htvogntabel «
vogntabel.
:1: vogntabel: parametererklæringer
\f
message vogntabel parametererklæringer side 1 - 810309/cl;
integer vt_op_længde;
:2: vogntabel: parameterinitialisering
\f
message vogntabel parameterinitialisering side 1 - 810309/cl;
vt_op_længde:= data + 16; <* halvord *>
:3: vogntabel: claiming
\f
message vogntabel_claiming side 1 - 810413/cl;
maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
+ 1 <* coroutine vt_opdater *>
+ 1 <* coroutine vt_tilstand *>
+ 1 <* coroutine vt_rapport *>
+ 1 <* coroutine vt_gruppe *>
+ 1 <* coroutine vt_spring *>
+ 1 <* coroutine vt_auto *>
+ maxcoru;
maxsemch:= 1 <* cs_vt *>
+ 1 <* cs_vt_adgang *>
+ 1 <* cs_vt_opd *>
+ 1 <* cs_vt_rap *>
+ 1 <* cs_vt_tilst *>
+ 1 <* cs_vtt_auto *>
+ 1 <* cs_vt_grp *>
+ 1 <* cs_vt_spring *>
+ 5 <* cs_vt_filretur(coru) *>
+ maxsemch;
maxop:= 1 <* vt_op *>
+ 6 <* vt_fil_op + radop *>
+ maxop;
maxnettoop:= vt_op_længde
+ 5*fil_op_længde
+ (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
+ maxnettoop;
:4: vogntabel: erklæringer
\f
message vogntabel erklæringer side 1 - 820301/cl;
integer cs_vt, cs_vt_adgang,cs_vt_opd,cs_vt_rap,
cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op;
integer sidste_bus,sidste_linie_løb,tf_vogntabel,
max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef;
integer array bustabel,bustabel1(0:max_antal_busser),
linie_løb_tabel(0:max_antal_linie_løb),
garageomr(0:max_antal_garager),
springtabel(1:max_antal_spring,1:3),
gruppetabel(1:max_antal_grupper),
gruppeopkald(1:max_antal_gruppeopkald,1:2); <* ident , filref *>
boolean array busindeks(-1:max_antal_linie_løb),
bustilstand(-1:max_antal_busser),
linie_løb_indeks(-1:max_antal_busser);
real array springtid,springstart(1:max_antal_spring);
long array garagenavn(0:max_antal_garager);
integer procedure find_garagenr(navn);
value navn; integer navn;
begin
long n;
integer i,j;
n:= extend navn shift 24;
j:= 0;
for i:= 1 step 1 until max_antal_garager do
if n=garagenavn(i) then j:= i;
find_garagenr:= j;
end;
\f
message vogntabel erklæringer side 2 - 851001/cl;
procedure skriv_vt_variable(zud);
zone zud;
begin integer i;
write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
<:vt-op-længde :>,vt_op_længde,"nl",1,
<:cs-vt :>,cs_vt,"nl",1,
<:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
<:cs-vt-opd :>,cs_vt_opd,"nl",1,
<:cs-vt-rap :>,cs_vt_rap,"nl",1,
<:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
<:cs-vt-auto :>,cs_vt_auto,"nl",1,
<:cs-vt-grp :>,cs_vt_grp,"nl",1,
<:cs-vt-spring :>,cs_vt_spring,"nl",1,
<:vt-op :>,vt_op,"nl",1,
<:sidste-bus :>,sidste_bus,"nl",1,
<:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
<:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
<:tf-vogntabel :>,tf_vogntabel,"nl",1,
<:tf-gruppedef :>,tf_gruppedef,"nl",1,
<:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
<:tf-springdef :>,tf_springdef,"nl",1,
<::>);
write(zud,<:garagenavn:<'nl'>:>);
for i:= 1 step 1 until max_antal_garager do
write(zud,<<dd>,i,<:: :>,string garagenavn(i),"nl",1);
end;
\f
message procedure p_vogntabel side 1 - 820301/cl;
procedure p_vogntabel(z);
zone z;
begin
integer i,b,s,o,t,li,lb,lø,g;
write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
<:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
<: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
for i:= 1 step 1 until sidste_bus do
begin
b:= bustabel(i) extract 14;
g:= bustabel(i) shift (-14);
s:= bustabel1(i) shift (-23);
o:= bustabel1(i) extract 8;
t:= intg(bustilstand(i));
li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
lø:= li extract 7;
lb:= li shift (-7) extract 5;
lb:= if lb=0 then 32 else lb+64;
li:= li shift (-12) extract 10;
write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
<<zddd>,b,"B",s,"sp",1,if g > 0 then string garagenavn(g) else <: :>,
";",1,string område_navn(o),
<: (:>,<<-dd>,t,<:) :>,li,false add lb,1,<:/:>,<<zd>,lø);
end;
end p_vogntabel;
\f
message procedure p_gruppetabel side 1 - 810531/cl;
procedure p_gruppetabel(z);
zone z;
begin
integer i,nr,bogst;
boolean spc_gr;
write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
<:max-antal-grupper =:>,max_antal_grupper,
<: max-antal-i-gruppe =:>,max_antal_i_gruppe,
<: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
<:gruppetabel::>);
for i:= 1 step 1 until max_antal_grupper do
write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
gruppetabel(i) extract 7);
write(z,"nl",2,<:gruppeopkald::>);
for i:= 1 step 1 until max_antal_gruppeopkald do
begin
write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
if gruppeopkald(i,1) = 0 then
write(z,"sp",11)
else
begin
spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
if spc_gr then nr:= gruppeopkald(i,1) extract 7
else
begin
nr:= gruppeopkald(i,1) shift (-5) extract 10;
bogst:= gruppeopkald(i,1) extract 5 +'@';
if bogst = '@' then bogst:= 'sp';
end;
if spc_gr then
write(z,<:(G:>,<<d>,true,3,nr)
else
write(z,"(",1,<<ddd>,nr,false add bogst,1);
write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
end;
end;
end p_gruppetabel;
\f
message procedure p_springtabel side 1 - 810519/cl;
procedure p_springtabel(z);
zone z;
begin
integer li,bo,max,st,nr;
long indeks;
real t;
write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
<:max-antal-spring =:>,max_antal_spring,"nl",2,
<:nr spring-id max status næste-tid:>,"nl",1);
for nr:= 1 step 1 until max_antal_spring do
begin
write(z,<<dd>,nr);
<* if springtabel(nr,1)<>0 then *>
begin
li:= springtabel(nr,1) shift (-5) extract 10;
bo:= springtabel(nr,1) extract 5;
if bo<>0 then bo:= bo + 'A' - 1;
indeks:= extend springtabel(nr,2) shift 24;
st:= extend springtabel(nr,3) shift (-12) extract 24;
max:= springtabel(nr,3) extract 12;
write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
if springtid(nr)<>0.0 then
write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
else
write(z,<< d.d >,0.0);
if springstart(nr)<>0.0 then
write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
else
write(z,<< d.d >,0.0);
end
<* else
write(z,<: --------:>)*>;
write(z,"nl",1);
end;
end p_springtabel;
\f
message procedure find_busnr side 1 - 820301/cl;
integer procedure findbusnr(ll_id,busnr,garage,tilst);
value ll_id;
integer ll_id, busnr, garage, tilst;
begin
integer i,j;
j:= binærsøg(sidste_linie_løb,
(linie_løb_tabel(i) - ll_id), i);
if j<>0 then <* linie/løb findes ikke *>
begin
find_busnr:= -1;
busnr:= 0;
garage:= 0;
tilst:= 0;
end
else
begin
busnr:= bustabel(busindeks(i) extract 12);
tilst:= intg(bustilstand(intg(busindeks(i))));
garage:= busnr shift (-14);
busnr:= busnr extract 14;
find_busnr:= busindeks(i) extract 12;
end;
end find_busnr;
\f
message procedure søg_omr_bus side 1 - 881027/cl;
integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
value bus;
integer bus,ll,gar,omr,sig,tilst;
begin
integer i,j,nr,bu,bi,bl;
j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
nr:= -1;
if j=0 then
begin
bl:= bu:= bi;
while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
while bu<sidste_bus and
bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
if bl<>bu then
begin
<* flere busser med samme tekniske nr. omr skal passe *>
nr:= -2;
for bi:= bl step 1 until bu do
if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
end
else
nr:= bi;
end;
if nr<0 then
begin
<* bus findes ikke *>
ll:= gar:= tilst:= sig:= 0;
end
else
begin
tilst:= intg(bustilstand(nr));
gar:= bustabel(nr) shift (-14);
ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
if omr=0 then omr:= bustabel1(nr) extract 8;
sig:= bustabel1(nr) shift (-23);
end;
søg_omr_bus:= nr;
end;
\f
message procedure find_linie_løb side 1 - 820301/cl;
integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
value busnr;
integer busnr, linie_løb, garage, tilst;
begin
integer i,j;
j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
if j<>0 then <* bus findes ikke *>
begin
find_linie_løb:= -1;
linie_løb:= 0;
garage:= 0;
tilst:= 0;
end
else
begin
tilst:= intg(bustilstand(i));
garage:= bustabel(i) shift (-14);
linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
find_linie_løb:= linie_løb_indeks(i) extract 12;
end;
end find_linie_løb;
\f
message procedure h_vogntabel side 1 - 810413/cl;
<* hovedmodulcorutine for vogntabelmodul *>
procedure h_vogntabel;
begin
integer array field op;
integer dest_sem,k;
procedure skriv_h_vogntabel(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
if omfang<>0 then
disable
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-vt :>,cs_vt,"nl",1,
<:op :>,op,"nl",1,
<:dest-sem :>,dest_sem,"nl",1,
<:k :>,k,"nl",1,
<::>);
end;
end;
\f
message procedure h_vogntabel side 2 - 820301/cl;
stackclaim(if cm_test then 198 else 146);
trap(h_vt_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_h_vogntabel(out,0);
<*-2*>
repeat
waitch(cs_vt,op,true,-1);
<*+4*>
if (d.op.optype and gen_optype) extract 12 = 0 and
(d.op.optype and vt_optype) extract 12 = 0 then
fejlreaktion(12,op,<:vogntabel:>,0);
<*-4*>
disable
begin
k:= d.op.opkode extract 12;
dest_sem:=
if k = 9 then cs_vt_rap else
if k = 10 then cs_vt_rap else
if k = 11 then cs_vt_opd else
if k = 12 then cs_vt_opd else
if k = 13 then cs_vt_opd else
if k = 14 then cs_vt_tilst else
if k = 15 then cs_vt_tilst else
if k = 16 then cs_vt_tilst else
if k = 17 then cs_vt_tilst else
if k = 18 then cs_vt_tilst else
if k = 19 then cs_vt_opd else
if k = 20 then cs_vt_opd else
if k = 21 then cs_vt_auto else
if k = 24 then cs_vt_opd else
if k = 25 then cs_vt_grp else
if k = 26 then cs_vt_grp else
if k = 27 then cs_vt_grp else
if k = 28 then cs_vt_grp else
if k = 30 then cs_vt_spring else
if k = 31 then cs_vt_spring else
if k = 32 then cs_vt_spring else
if k = 33 then cs_vt_spring else
if k = 34 then cs_vt_spring else
if k = 35 then cs_vt_spring else
-1;
\f
message procedure h_vogntabel side 3 - 810422/cl;
<*+2*>
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
end;
if dest_sem = -1 then
fejlreaktion(2,k,<:vogntabel:>,0);
disable signalch(dest_sem,op,d.op.optype);
until false;
h_vt_trap:
disable skriv_h_vogntabel(zbillede,1);
end h_vogntabel;
\f
message procedure vt_opdater side 1 - 810317/cl;
procedure vt_opdater(op1);
value op1;
integer op1;
begin
integer array field op,radop;
integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
flin,slin,finx,sinx;
integer field bn,ll;
procedure skriv_vt_opd(zud,omfang);
value omfang; integer omfang;
zone zud;
begin
write(zud,"nl",1,<:+++ vt_opdater :>);
if omfang <> 0 then
disable
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,
<: op: :>,op,"nl",1,
<: radop::>,radop,"nl",1,
<: funk: :>,funk,"nl",1,
<: res: :>,res,"nl",1,
<::>);
end;
end skriv_vt_opd;
integer procedure opd_omr(fnk,omr,bus,ll);
value fnk,omr,bus,ll;
integer fnk,omr,bus,ll;
begin
if omr extract 8 > 3 then
begin
startoperation(radop,501,cs_vt_opd,fnk);
d.radop.data(1):= omr;
d.radop.data(2):= bus;
d.radop.data(3):= ll;
signalch(cs_rad,radop,vt_optype);
<*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
opd_omr:= d.radop.resultat;
end
else
opd_omr:= 0;
end;
stackclaim((if cm_test then 198 else 146)+75);
bn:= 4; ll:= 2;
radop:= op1;
trap(vt_opd_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_opd(out,0);
<*-2*>
\f
message procedure vt_opdater side 2 - 851001/cl;
vent_op:
waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_opd(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
<*+4*>
<**>if op<>vt_op then
<**>begin
<**> disable begin
<**> fejlreaktion(11,op,<:vt-opdater:>,1);
<**> d.op.resultat:= 31; <*systemfejl*>
<**> signalch(d.op.retur,op,d.op.optype);
<**> end;
<**> goto vent_op;
<**>end;
<*-4*>
disable
begin integer opk;
opk:= d.op.opkode extract 12;
funk:= if opk=11 then 1 else
if opk=12 then 2 else
if opk=13 then 3 else
if opk=19 then 4 else
if opk=20 then 5 else
if opk=24 then 6 else
0;
if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
end;
res:= 0;
goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
\f
message procedure vt_opdater side 3 - 820301/cl;
indsæt:
begin
integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
<*+4*>
<**> if d.op.data(1) shift (-22) <> 0 then
<**> begin
<**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
<**> goto slut_indsæt;
<**> end;
<*-4*>
busnr:= d.op.data(1) extract 14;
<*+4*>
<**> if d.op.data(2) shift (-22) <> 1 then
<**> begin
<**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
<**> goto slut_indsæt;
<**> end;
<*-4*>
ll_id:= d.op.data(2);
s:= omr:= d.op.data(4) extract 8;
bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
if bi<0 then
begin
if bi=(-1) then res:=10 <*bus ukendt*> else
if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
end
else
if s<>0 and s<>omr then
res:= 58 <* ulovligt område for bus *>
else
if intg(bustilstand(bi)) <> 0 then
res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
else 14 <* optaget *>)
else
begin
if linie_løb_indeks(bi) extract 12 <> 0 then
begin <* linie/løb allerede indsat *>
res:= 11;
d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
end
else
begin
\f
message procedure vt_opdater side 3a - 900108/cl;
if d.op.kilde//100 <> 4 then
res:= opd_omr(11,gar shift 8 +
bustabel1(bi) extract 8,busnr,ll_id);
if res>3 then goto slut_indsæt;
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
if s=0 then <* linie/løb findes allerede *>
disable
begin
sig:= busindeks(li) extract 12;
d.op.data(3):= bustabel(sig);
linie_løb_indeks(sig):= false;
modiffil(tf_vogntabel,sig,zi);
fil(zi).ll:= 0;
fil(zi).bn:= bustabel(sig) extract 14 add
(bustabel1(sig) extract 8 shift 14);
linie_løb_indeks(bi):= false add li;
busindeks(li):= false add bi;
modiffil(tf_vogntabel,bi,zi);
fil(zi).ll:= ll_id;
fil(zi).bn:= bustabel(bi) extract 14 add
(bustabel1(bi) extract 8 shift 14);
res:= 3;
end
else
begin
\f
message procedure vt_opdater side 4 - 810527/cl;
if s<0 then li:= li +1;
if sidste_linie_løb=max_antal_linie_løb then
begin
fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
res:= 31;
end
else
disable
begin
for i:= sidste_linie_løb step -1 until li do
begin
linie_løb_tabel(i+1):=linie_løb_tabel(i);
linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
bus_indeks(i+1):=bus_indeks(i);
end;
sidste_linie_løb:= sidste_linie_løb +1;
linie_løb_tabel(li):= ll_id;
linie_løb_indeks(bi):= false add li;
busindeks(li):= false add bi;
s:= modiffil(tf_vogntabel,bi,zi);
if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
fil(zi).bn:= busnr extract 14 add
(bustabel1(bi) extract 8 shift 14);
fil(zi).ll:= ll_id;
res:= 3; <* ok *>
end;
end;
end;
end;
slut_indsæt:
d.op.resultat:= res;
end;
goto returner;
\f
message procedure vt_opdater side 5 - 820301/cl;
udtag:
begin
integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
busnr:= ll_id:= 0;
omr:= s:= d.op.data(2) extract 8;
format:= d.op.data(1) shift (-22);
if format=0 then <*busnr*>
begin
busnr:= d.op.data(1) extract 14;
bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
if bi<0 then
begin
if bi=-1 then res:= 10 else
if s<>0 then res:= 58 else res:= 57;
goto slut_udtag;
end;
if bi>0 and s<>0 and s<>omr then
begin
res:= 58; goto slut_udtag;
end;
li:= linie_løb_indeks(bi) extract 12;
busnr:= bustabel(bi);
if li=0 or linie_løb_tabel(li)=0 then
begin <* bus ej indsat *>
res:= 13;
goto slut_udtag;
end;
ll_id:= linie_løb_tabel(li);
end
else
if format=1 then <* linie_løb *>
begin
ll_id:= d.op.data(1);
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
if s<>0 then
begin <* linie/løb findes ikke *>
res:= 9;
goto slut_udtag;
end;
bi:= busindeks(li) extract 12;
busnr:= bustabel(bi);
end
else <* ulovlig identifikation *>
begin
res:= 31;
fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
goto slut_udtag;
end;
\f
message procedure vt_opdater side 6 - 820301/cl;
tilst:= intg(bustilstand(bi));
if tilst<>0 then
begin
res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
goto slut_udtag;
end;
if d.op.kilde//100 <> 4 then
res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
if res>3 then goto slut_udtag;
linie_løb_indeks(bi):= false;
for i:= li step 1 until sidste_linie_løb -1 do
begin
linie_løb_tabel(i):= linie_løb_tabel(i+1);
linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
bus_indeks(i):= bus_indeks(i+1);
end;
linie_løb_tabel(sidste_linie_løb):= 0;
bus_indeks(sidste_linie_løb):= false;
sidste_linie_løb:= sidste_linie_løb -1;
disable s:= modif_fil(tf_vogntabel,bi,zi);
if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
fil(zi).ll:= 0;
fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
res:= 3; <* ok *>
slut_udtag:
d.op.resultat:= res;
d.op.data(2):= ll_id;
d.op.data(3):= busnr;
end;
goto returner;
\f
message procedure vt_opdater side 7 - 851001/cl;
omkod:
flyt:
roker:
begin
integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
inf1:= inf2:= 0;
ll_id1:= d.op.data(1);
ll_id2:= d.op.data(2);
if ll_id1=ll_id2 then
begin
res:= 24; inf1:= ll_id2;
goto slut_flyt;
end;
<*+4*>
<**> for i:= 1,2 do
<**> if d.op.data(i) shift (-22) <> 1 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(i),case i of (
<**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
<**> goto slut_flyt;
<**> end;
<*-4*>
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
if s<>0 and funk=6 <* roker *> then
begin
i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
end;
if s<>0 then
begin
res:= 9; <* ukendt linie/løb *>
goto slut_flyt;
end;
bi1:= busindeks(li1) extract 12;
inf1:= bustabel(bi1);
tilst:= intg(bustilstand(bi1));
if tilst<>0 then <* bus ikke fri *>
begin
res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
goto slut_flyt;
end;
\f
message procedure vt_opdater side 7a- 851001/cl;
if d.op.kilde//100 <> 4 then
res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
if res>3 then goto slut_flyt;
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
if s=0 then
begin <* ll_id2 er indkodet *>
bi2:= busindeks(li2) extract 12;
inf2:= bustabel(bi2);
tilst:= intg(bustilstand(bi2));
if funk=3 then res:= 12 <* ulovlig ved omkod *> else
if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
if res>3 then
begin
inf1:= inf2; inf2:= 0;
goto slut_flyt;
end;
if d.op.kilde//100 <> 4 then
res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
if res>3 then goto slut_flyt;
<* flyt bus *>
if funk=6 then
linie_løb_indeks(bi2):= false add li1
else
linie_løb_indeks(bi2):= false;
linie_løb_indeks(bi1):= false add li2;
if funk=6 then
busindeks(li1):= false add bi2
else
busindeks(li1):= false;
busindeks(li2):= false add bi1;
if funk<>6 then
begin
<* fjern ll_id1 *>
for i:= li1 step 1 until sidste_linie_løb - 1 do
begin
linie_løb_tabel(i):= linie_løb_tabel(i+1);
linie_løb_indeks(intg(busindeks(i+1))):= false add i;
busindeks(i):= busindeks(i+1);
end;
linie_løb_tabel(sidste_linie_løb):= 0;
bus_indeks(sidste_linie_løb):= false;
sidste_linie_løb:= sidste_linie_løb-1;
end;
<* opdater vogntabelfil *>
disable s:= modiffil(tf_vogntabel,bi2,zi);
if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
fil(zi).ll:= if funk=6 then ll_id1 else 0;
fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
<*
fil(zi).ll:= 0; fil(zi).bn:= inf2;
*>
disable s:= modiffil(tf_vogntabel,bi1,zi);
if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
fil(zi).ll:= ll_id2;
fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
\f
message procedure vt_opdater side 8 - 820301/cl;
end <* ll_id2 indkodet *>
else
begin
if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
<* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
pm1:= sgn(li2-li1);
for i:= li1 step pm1 until li2-pm1 do
begin
linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
busindeks(i):= busindeks(i+pm1);
linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
end;
linie_løb_tabel(li2):= ll_id2;
busindeks(li2):= false add bi1;
linie_løb_indeks(bi1):= false add li2;
disable s:= modiffil(tf_vogntabel,bi1,zi);
if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
fil(zi).ll:= ll_id2;
fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
end;
res:= 3; <*udført*>
slut_flyt:
d.op.resultat:= res;
d.op.data(3):= inf1;
if funk=5 then d.op.data(4):= inf2;
end;
goto returner;
\f
message procedure vt_opdater side 9 - 851001/cl;
slet:
begin
integer flin,slin,finx,sinx,s,li,bi,omr,gar;
boolean test24;
if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
omr:= d.op.data(3);
if d.op.data(1) > d.op.data(2) then
begin
res:= 44; <* intervalstørrelse ulovlig *>
goto slut_slet;
end;
for bi:= 1 step 1 until max_antal_garager do
begin
if garageomr(bi) > 0 then
begin
if omr=0 or omr=bi or (omr<0 and
omr extract 8 = garageomr(bi)) then
begin
if d.op.kilde//100 <> 4 then
res:= opd_omr(19, bi shift 8 + garageomr(bi), 0, 0);
if res>3 then goto slut_slet;
end;
end;
end;
flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
if s<0 then finx:= finx+1;
s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
if s>0 then sinx:= sinx-1;
for li:= finx step 1 until sinx do
begin
bi:= busindeks(li) extract 12;
gar:= bustabel(bi) shift (-14) extract 8;
if intg(bustilstand(bi))=0 and
(omr = 0 or (omr > 0 and omr = gar) or
(omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
begin
linie_løb_indeks(bi):= busindeks(li):= false;
linie_løb_tabel(li):= 0;
end;
end;
\f
message procedure vt_opdater side 10 - 850820/cl;
sinx:= finx-1;
for li:= finx step 1 until sidste_linie_løb do
begin
if linie_løb_tabel(li)<>0 then
begin
sinx:= sinx+1;
if sinx<>li then
begin
linie_løb_tabel(sinx):= linie_løb_tabel(li);
busindeks(sinx):= busindeks(li);
linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
linie_løb_tabel(li):= 0;
busindeks(li):= false;
end;
end;
end;
sidste_linie_løb:= sinx;
test24:= testbit24; testbit24:= false;
for bi:= 1 step 1 until sidste_bus do
disable
begin
s:= modiffil(tf_vogntabel,bi,finx);
if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
fil(finx).bn:= bustabel(bi) extract 14 add
(bustabel1(bi) extract 8 shift 14);
fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
end;
testbit24:= test24;
res:= 3;
slut_slet:
d.op.resultat:= res;
end;
goto returner;
\f
message procedure vt_opdater side 11 - 810409/cl;
returner:
disable
begin
<*+2*>
<**> if testbit40 and overvåget then
<**> begin
<**> skriv_vt_opd(out,0);
<**> write(out,<: vogntabel efter ændring:>);
<**> p_vogntabel(out);
<**> end;
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_opd(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_opd_trap:
disable skriv_vt_opd(zbillede,1);
end vt_opdater;
\f
message procedure vt_tilstand side 1 - 810424/cl;
procedure vt_tilstand(cs_fil,fil_opref);
value cs_fil,fil_opref;
integer cs_fil,fil_opref;
begin
integer array field op,filop;
integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
g_type,gr,antal,ej_res,zi,li,filref;
integer array identer(1:max_antal_i_gruppe);
procedure skriv_vt_tilst(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
real array field raf;
raf:= 0;
write(zud,"nl",1,<:+++ vt_tilstand :>);
if omfang <> 0 then
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-fil :>,cs_fil,"nl",1,
<:filop :>,filop,"nl",1,
<:op :>,op,"nl",1,
<:funk :>,funk,"nl",1,
<:format :>,format,"nl",1,
<:busid :>,busid,"nl",1,
<:res :>,res,"nl",1,
<:bi :>,bi,"nl",1,
<:tilst :>,tilst,"nl",1,
<:opk :>,opk,"nl",1,
<:opk-indeks :>,opk_indeks,"nl",1,
<:g-type :>,g_type,"nl",1,
<:gr :>,gr,"nl",1,
<:antal :>,antal,"nl",1,
<:ej-res :>,ej_res,"nl",1,
<:zi :>,zi,"nl",1,
<:li :>,li,"nl",1,
<::>);
write(zud,"nl",1,<:identer:>);
skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
end;
end;
procedure sorter_gruppe(tab,l,u);
value l,u;
integer array tab;
integer l,u;
begin
integer array field ii,jj,xx;
integer array ww(1:2);
ii:= (l-1)*4; jj:= (u-1)*4;
xx:= ((l+u)//2 - 1)*4;
repeat
while
(tab.ii(1) shift (-8) extract 4 < tab.xx(1) shift (-8) extract 4)
or
(tab.ii(1) shift (-18) > tab.xx(1) shift (-18) and
tab.ii(1) shift (-12) extract 6 < tab.xx(1) shift (-12) extract 6)
do ii:= ii+4;
while
(tab.xx(1) shift(-8) extract 4 < tab.jj(1) shift(-8) extract 4)
or
(tab.xx(1) shift (-18) > tab.jj(1) shift (-18) and
tab.xx(1) shift (-12) extract 6 < tab.jj(1) shift (-12) extract 6)
do jj:= jj-4;
if ii <= jj then
begin
tofrom(ww,tab.ii,4);
tofrom(tab.ii,tab.jj,4);
tofrom(tab.jj,ww,4);
ii:= ii+4;
jj:= jj-4;
end;
until ii>jj;
if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
end;
\f
message procedure vt_tilstand side 2 - 820301/cl;
filop:= filopref;
stackclaim(if cm_test then 198 else 146);
trap(vt_tilst_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_tilst(out,0);
<*-2*>
vent_op:
waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
<*+2*>disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_tilst(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
<*+4*>
<**> if op <> vt_op then
<**> begin
<**> disable begin
<**> d.op.resultat:= 31;
<**> fejlreaktion(11,op,<:vt-tilstand:>,1);
<**> end;
<**> goto returner;
<**> end;
<*-4*>
opk:= d.op.opkode extract 12;
funk:= if opk = 14 <*bus i kø*> then 1 else
if opk = 15 <*bus res *> then 2 else
if opk = 16 <*grp res *> then 4 else
if opk = 17 <*bus fri *> then 3 else
if opk = 18 <*grp fri *> then 5 else
0;
if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
res:= 0;
format:= d.op.data(1) shift (-22);
goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
\f
message procedure vt_tilstand side 3 - 820301/cl;
enkelt_bus:
<* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
disable
begin integer busnr,i,s,tilst,ll,gar,omr,sig;
<*+4*>
<**>if format <> 0 and format <> 1 then
<**>begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
<**> goto slut_enkelt_bus;
<**>end;
<*-4*>
<* find busnr og tilstand *>
case format+1 of
begin
<* 0: budident *>
begin
busnr:= d.op.data(1) extract 14;
s:= omr:= d.op.data(4) extract 8;
bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
if bi<0 then
begin
res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
goto slut_enkelt_bus;
end
else
begin
tilst:= intg(bustilstand(bi));
end;
end;
<* 1: linie_løb_ident *>
begin
bi:= findbusnr(d.op.data(1),busnr,i,tilst);
if bi < 0 then <* ukendt linie_løb *>
begin
res:= 9;
goto slut_enkelt_bus;
end;
end;
end case;
\f
message procedure vt_tilstand side 4 - 830310/cl;
if funk < 3 then
begin
d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
linie_løb_tabel(linie_løb_indeks(bi) extract 12)
else 0;
d.op.data(3):= bustabel(bi);
d.op.data(4):= bustabel1(bi);
end;
<* check tilstand *>
if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
res:= 39 <* bus ikke reserveret *>
else
if tilst <> 0 and tilst <> (-1) and funk < 3 then
res:= 14 <* bus optaget *>
else
if funk = 1 <* i kø *> and tilst = (-1) then
res:= 18 <* i kø *>
else
res:= 3; <*udført*>
if res = 3 then
bustilstand(bi):= false add (case funk of (-1,-2,0));
slut_enkelt_bus:
d.op.resultat:= res;
end <*disable*>;
goto returner;
\f
message procedure vt_tilstand side 5 - 810424/cl;
grp_res: <* reserver gruppe *>
disable
begin
<*+4*>
<**> if format <> 2 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
<**> goto slut_grp_res_1;
<**> end;
<*-4*>
<* find frit indeks i opkaldstabel *>
opk_indeks:= 0;
for i:= max_antal_gruppeopkald step -1 until 1 do
begin
if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
end;
if opk_indeks = 0 then res:= 32; <* ingen plads *>
if res <> 0 then goto slut_grp_res_1;
g_type:= d.op.data(1) shift (-21) extract 1;
if g_type = 1 <*special gruppe*> then
begin <*check eksistens*>
gr:= 0;
for i:= 1 step 1 until max_antal_grupper do
if gruppetabel(i) = d.op.data(1) then gr:= i;
if gr = 0 then <*gruppe ukendt*>
begin
res:= 8;
goto slut_grp_res_1;
end;
end;
<* reserver i opkaldstabel *>
gruppeopkald(opk_indeks,1):= d.op.data(1);
\f
message procedure vt_tilstand side 6 - 810428/cl;
<* tilknyt fil *>
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= 0; <*postantal*>
d.filop.data(2):= 256; <*postlængde*>
d.filop.data(3):= 1; <*segmentantal*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
signalch(cs_opret_fil,filop,vt_optype);
slut_grp_res_1:
if res <> 0 then d.op.resultat:= res;
end;
if res <> 0 then goto returner;
waitch(cs_fil,filop,vt_optype,-1);
<* check filsys-resultat *>
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
filref:= d.filop.data(4);
\f
message procedure vt_tilstand side 7 - 820301/cl;
disable if g_type = 0 <*linie-gruppe*> then
begin
integer s,i,ll_id;
integer array field iaf1;
ll_id:= 1 shift 22 + d.op.data(1) shift 7;
iaf1:= 0;
s:= binærsøg(sidste_linie_løb,
linie_løb_tabel(i) - ll_id, i);
if s < 0 then i:= i +1;
antal:= ej_res:= 0;
skrivfil(filref,1,zi);
if i <= sidste_linie_løb then
begin
while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
begin
if (intg(bustilstand(intg(busindeks(i))))<>0) or
(bustabel1(intg(busindeks(i))) extract 8 <> 3) then
ej_res:= ej_res+1
else
begin
antal:= antal+1;
bi:= busindeks(i) extract 12;
fil(zi).iaf1(1):=
område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
(bustabel1(bi) shift (-23) + 1) shift 8 + 1;
fil(zi).iaf1(2):= bustabel(bi);
iaf1:= iaf1+4;
bustilstand(bi):= false add opk_indeks;
end;
i:= i +1;
if i > sidste_linie_løb then goto slut_l_grp;
end;
end;
\f
message procedure vt_tilstand side 8 - 820301/cl;
slut_l_grp:
end
else
begin <*special gruppe*>
integer i,s,li,omr,gar,tilst;
integer array field iaf1;
iaf1:= 0;
antal:= ej_res:= 0;
s:= læsfil(tf_gruppedef,gr,zi);
if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
tofrom(identer,fil(zi),max_antal_i_gruppe*2);
s:= skrivfil(filref,1,zi);
if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
i:= 1;
while identer(i) <> 0 do
begin
if identer(i) shift (-22) = 0 then
begin <*busident*>
omr:= 0;
bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
if bi<0 then goto næste_ident;
li:= linie_løb_indeks(bi) extract 12;
end
else
begin <*linie/løb ident*>
s:= binærsøg(sidste_linie_løb,
linie_løb_tabel(li) - identer(i), li);
if s <> 0 then goto næste_ident;
bi:= busindeks(li) extract 12;
end;
if (intg(bustilstand(bi))<>0) or
(bustabel1(bi) extract 8 <> 3) then
ej_res:= ej_res+1
else
begin
antal:= antal +1;
fil(zi).iaf1(1):=
område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
(bustabel1(bi) shift (-23) + 1) shift 8 + 1;
fil(zi).iaf1(2):= bustabel(bi);
iaf1:= iaf1+4;
bustilstand(bi):= false add opk_indeks;
end;
næste_ident:
i:= i +1;
if i > max_antal_i_gruppe then goto slut_s_grp;
end;
slut_s_grp:
end;
\f
message procedure vt_tilstand side 9 - 820301/cl;
if antal > 0 then <*ok*>
disable begin
integer array field spec,akt;
integer a,antal_spec;
antal_spec:= 0; a:= 0;
spec:= 0; akt:= 0;
sorter_gruppe(fil(zi).spec,1,antal);
while akt//4 < antal do
begin
fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
a:= 0;
while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
and a<15 do
begin
a:= a+1;
fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
akt:= akt+4;
end;
fil(zi).spec(1):= fil(zi).spec(1) + a;
antal_spec:= antal_spec+1;
spec:= spec + 2*a + 2;
end;
antal:= antal_spec;
gruppeopkald(opk_indeks,2):= filref;
d.op.resultat:= 3;
d.op.data(2):= antal;
d.op.data(3):= filref;
d.op.data(4):= ej_res;
d.filop.data(1):= antal;
disable sæt_fil_dim(d.filop.data);
end
else
begin
disable begin
d.filop.opkode:= 104; <*slet fil*>
signalch(cs_slet_fil,filop,vt_optype);
gruppeopkald(opk_indeks,1):= 0; <*fri*>
d.op.resultat:= 54;
d.op.data(2):= antal;
d.op.data(3):= 0;
d.op.data(4):= ej_res;
end;
waitch(cs_fil,filop,vt_optype,-1);
if d.filop.data(9) <> 0 then
fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
end;
goto returner;
\f
message procedure vt_tilstand side 10 - 820301/cl;
grp_fri: <* frigiv gruppe *>
disable
begin integer i,j,s,ll,gar,omr,tilst;
integer array field spec;
<*+4*>
<**> if format <> 2 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
<**> goto slut_grp_fri;
<**> end;
<*-4*>
<* find indeks i opkaldstabel *>
opk_indeks:= 0;
for i:= 1 step 1 until max_antal_gruppeopkald do
if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
if opk_indeks = 0 <*ikke fundet*> then
begin
res:= 40; <*gruppe ej reserveret*>
goto slut_grp_fri;
end;
filref:= gruppeopkald(opk_indeks,2);
start_operation(filop,curr_coruid,cs_fil,104);
d.filop.data(4):= filref;
hentfildim(d.filop.data);
antal:= d.filop.data(1);
læsfil(filref,1,zi);
spec:= 0;
for i:= 1 step 1 until antal do
begin
for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
begin
busid:= fil(zi).spec(1+j) extract 14;
omr:= 0;
bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
if bi>=0 then bustilstand(bi):= false;
end;
spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
end;
slut_grp_fri:
d.op.resultat:= res;
end;
if res <> 0 then goto returner;
gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
signalch(cs_slet_fil,filop,vt_optype);
\f
message procedure vt_tilstand side 11 - 810424/cl;
waitch(cs_fil,filop,vt_optype,-1);
if d.filop.data(9) <> 0 then
fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
d.op.resultat:= 3;
returner:
disable
begin
<*+2*>
<**> if testbit40 and overvåget then
<**> begin
<**> skriv_vt_tilst(out,0);
<**> write(out,<: vogntabel efter ændring:>);
<**> p_vogntabel(out);
<**> end;
<**> if testbit43 and overvåget and (funk=4 or funk=5) then
<**> begin
<**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
<**> p_gruppetabel(out);
<**> end;
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_tilst(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_tilst_trap:
disable skriv_vt_tilst(zbillede,1);
end vt_tilstand;
\f
message procedure vt_rapport side 1 - 810428/cl;
procedure vt_rapport(cs_fil,fil_opref);
value cs_fil,fil_opref;
integer cs_fil,fil_opref;
begin
integer array field op,filop;
integer funk,filref,antal,id_ant,res;
integer field i1,i2;
procedure skriv_vt_rap(z,omfang);
value omfang;
zone z;
integer omfang;
begin
write(z,"nl",1,<:+++ vt_rapport :>);
if omfang <> 0 then
begin
skriv_coru(z,abs curr_coruno);
write(z,"nl",1,<<d>,
<: cs_fil :>,cs_fil,"nl",1,
<: filop :>,filop,"nl",1,
<: op :>,op,"nl",1,
<: funk :>,funk,"nl",1,
<: filref :>,filref,"nl",1,
<: antal :>,antal,"nl",1,
<: id-ant :>,id_ant,"nl",1,
<: res :>,res,"nl",1,
<::>);
end;
end skriv_vt_rap;
stackclaim(if cm_test then 198 else 146);
filop:= fil_opref;
i1:= 2; i2:= 4;
trap(vt_rap_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_rap(out,0);
<*-2*>
\f
message procedure vt_rapport side 2 - 810505/cl;
vent_op:
waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
<*+2*>
<**> disable begin
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_rap(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> ud;
<**> end;
<**> end;<*disable*>
<*-2*>
disable
begin
integer opk;
opk:= d.op.opkode extract 12;
funk:= if opk = 9 then 1 else
if opk =10 then 2 else
0;
if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
<* opret og tilknyt fil *>
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= 0; <*postantal(midlertidigt)*>
d.filop.data(2):= 2; <*postlængde*>
d.filop.data(3):=10; <*segmenter*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
signalch(cs_opretfil,filop,vt_optype);
end;
waitch(cs_fil,filop,vt_optype,-1);
<* check resultat *>
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
filref:= d.filop.data(4);
antal:= 0;
goto case funk of (l_rapport,b_rapport);
\f
message procedure vt_rapport side 3 - 850820/cl;
l_rapport:
disable
begin
integer i,j,s,ll,zi;
idant:= 0;
for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
<*+4*>
<**> if d.op.data(id_ant) shift (-22) <> 2 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
<**> goto l_rap_slut;
<**> end;
<*-4*>
;
for i:= 1 step 1 until id_ant do
begin
ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
s:= binærsøg(sidste_linie_løb,
linie_løb_tabel(j) - ll, j);
if s < 0 then j:= j +1;
if j<= sidste_linie_løb then
begin <* skriv identer *>
while linie_løb_tabel(j) shift (-7) shift 7 = ll do
begin
antal:= antal +1;
s:= skrivfil(filref,antal,zi);
if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
fil(zi).i1:= linie_løb_tabel(j);
fil(zi).i2:= bustabel(busindeks(j) extract 12);
j:= j +1;
if j > sidste_bus then goto linie_slut;
end;
end;
linie_slut:
end;
res:= 3;
l_rap_slut:
end <*disable*>;
goto returner;
\f
message procedure vt_rapport side 4 - 820301/cl;
b_rapport:
disable
begin
integer i,j,s,zi,busnr1,busnr2;
<*+4*>
<**> for i:= 1,2 do
<**> if d.op.data(i) shift (-14) <> 0 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
<**> goto bus_slut;
<**> end;
<*-4*>
busnr1:= d.op.data(1) extract 14;
busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
if busnr1 = 0 or busnr2 < busnr1 then
begin
res:= 7; <* fejl i busnr *>
goto bus_slut;
end;
s:= binærsøg(sidste_bus,bustabel(j) extract 14
- busnr1,j);
if s < 0 then j:= j +1;
while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
if j <= sidste_bus then
begin <* skriv identer *>
while bustabel(j) extract 14 <= busnr2 do
begin
i:= linie_løb_indeks(j) extract 12;
if i<>0 then
begin
antal:= antal +1;
s:= skriv_fil(filref,antal,zi);
if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
fil(zi).i1:= bustabel(j);
fil(zi).i2:= linie_løb_tabel(i);
end;
j:= j +1;
if j > sidste_bus then goto bus_slut;
end;
end;
bus_slut:
end <*disable*>;
res:= 3; <*ok*>
\f
message procedure vt_rapport side 5 - 810409/cl;
returner:
disable
begin
d.op.resultat:= res;
d.op.data(6):= antal;
d.op.data(7):= filref;
d.filop.data(1):= antal;
d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
i:= sæt_fil_dim(d.filop.data);
if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
<*+2*>
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_rap(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_rap_trap:
disable skriv_vt_rap(zbillede,1);
end vt_rapport;
\f
message procedure vt_gruppe side 1 - 810428/cl;
procedure vt_gruppe(cs_fil,fil_opref);
value cs_fil,fil_opref;
integer cs_fil,fil_opref;
begin
integer array field op, fil_op, iaf;
integer funk, res, filref, gr, i, antal, zi, s;
integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
max_antal_grupper else max_antal_i_gruppe));
procedure skriv_vt_gruppe(zud,omfang);
value omfang;
integer omfang;
zone zud;
begin
integer øg;
write(zud,"nl",1,<:+++ vt_gruppe :>);
if omfang <> 0 then
disable
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<: cs_fil :>,cs_fil,"nl",1,
<: op :>,op,"nl",1,
<: filop :>,filop,"nl",1,
<: funk :>,funk,"nl",1,
<: res :>,res,"nl",1,
<: filref :>,filref,"nl",1,
<: gr :>,gr,"nl",1,
<: i :>,i,"nl",1,
<: antal :>,antal,"nl",1,
<: zi :>,zi,"nl",1,
<: s :>,s,"nl",1,
<::>);
raf:= 0;
system(3,øg,identer);
write(zud,"nl",1,<:identer::>);
skriv_hele(zud,identer.raf,øg*2,2);
end;
end;
stackclaim(if cm_test then 198 else 146);
filop:= fil_opref;
trap(vt_grp_trap);
iaf:= 0;
\f
message procedure vt_gruppe side 2 - 810409/cl;
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_gruppe(out,0);
<*-2*>
vent_op:
waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
<*+2*>
<**>disable
<**>begin
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_gruppe(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> ud;
<**> end;
<**>end;
<*-2*>
disable
begin
integer opk;
opk:= d.op.opkode extract 12;
funk:= if opk=25 then 1 else
if opk=26 then 2 else
if opk=27 then 3 else
if opk=28 then 4 else
0;
if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
end;
<*+4*>
<**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
<**> begin
<**> disable begin
<**> d.op.resultat:= 31;
<**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
<**> end;
<**> goto returner;
<**> end;
<*-4*>
goto case funk of(definer,slet,vis,oversigt);
\f
message procedure vt_gruppe side 3 - 810505/cl;
definer:
disable
begin
gr:= 0; res:= 0;
for i:= max_antal_grupper step -1 until 1 do
begin
if gruppetabel(i)=0 then gr:= i <*fri plads*> else
if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
end;
if gr=0 then res:= 32; <*ingen plads*>
end;
if res<>0 then goto slut_definer;
disable
begin <*fri plads fundet*>
antal:= d.op.data(2);
if antal <=0 or max_antal_i_gruppe<antal then
res:= 33 <*fejl i gruppestørrelse*>
else
begin
for i:= 1 step 1 until antal do
begin
s:= læsfil(d.op.data(3),i,zi);
if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
identer(i):= fil(zi).iaf(1);
end;
s:= modif_fil(tf_gruppedef,gr,zi);
if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
tofrom(fil(zi).iaf,identer,antal*2);
for i:= antal+1 step 1 until max_antal_i_gruppe do
fil(zi).iaf(i):= 0;
gruppetabel(gr):= d.op.data(1);
s:= modiffil(tf_gruppeidenter,gr,zi);
if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
fil(zi).iaf(1):= gruppetabel(gr);
res:= 3;
end;
end;
slut_definer:
<*slet fil*>
start_operation(fil_op,curr_coruid,cs_fil,104);
d.filop.data(4):= d.op.data(3);
signalch(cs_slet_fil,filop,vt_optype);
waitch(cs_fil,filop,vt_optype,-1);
if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
d.op.resultat:= res;
goto returner;
\f
message procedure vt_gruppe side 4 - 810409/cl;
slet:
disable
begin
gr:= 0; res:= 0;
for i:= 1 step 1 until max_antal_grupper do
begin
if gruppetabel(i)=d.op.data(1) then gr:= i;
end;
if gr = 0 then res:= 8 <*gruppe ej defineret*>
else
begin
for i:= 1 step 1 until max_antal_gruppeopkald do
if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
if res = 0 then
begin
gruppetabel(gr):= 0;
s:= modif_fil(tf_gruppeidenter,gr,zi);
if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
fil(zi).iaf(1):= gruppetabel(gr);
res:= 3;
end;
end;
d.op.resultat:= res;
end;
goto returner;
\f
message procedure vt_gruppe side 5 - 810505/cl;
vis:
disable
begin
res:= 0; gr:= 0; antal:= 0; filref:= 0;
for i:= 1 step 1 until max_antal_grupper do
if gruppetabel(i) = d.op.data(1) then gr:= i;
if gr = 0 then res:= 8
else
begin
s:= læsfil(tf_gruppedef,gr,zi);
if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
for i:= 1 step 1 until max_antal_i_gruppe do
begin
identer(i):= fil(zi).iaf(i);
if identer(i) <> 0 then antal:= antal +1;
end;
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= antal; <*postantal*>
d.filop.data(2):= 1; <*postlængde*>
d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
d.filop.data(5):= d.filop.data(6):=
d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
signalch(cs_opret_fil,filop,vt_optype);
end;
end;
if res <> 0 then goto slut_vis;
waitch(cs_fil,filop,vt_optype,-1);
disable
begin
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
filref:= d.filop.data(4);
for i:= 1 step 1 until antal do
begin
s:= skrivfil(filref,i,zi);
if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
fil(zi).iaf(1):= identer(i);
end;
res:= 3;
end;
slut_vis:
d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
goto returner;
\f
message procedure vt_gruppe side 6 - 810508/cl;
oversigt:
disable
begin
res:= 0; antal:= 0; filref:= 0; iaf:= 0;
for i:= 1 step 1 until max_antal_grupper do
begin
if gruppetabel(i) <> 0 then
begin
antal:= antal +1;
identer(antal):= gruppetabel(i);
end;
end;
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= antal; <*postantal*>
d.filop.data(2):= 1; <*postlængde*>
d.filop.data(3):= if antal = 0 then 1 else
(antal-1)//256 +1; <*segm.antal*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
d.filop.data(5):= d.filop.data(6):=
d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
signalch(cs_opretfil,filop,vt_optype);
end;
waitch(cs_fil,filop,vt_optype,-1);
disable
begin
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
filref:= d.filop.data(4);
for i:= 1 step 1 until antal do
begin
s:= skriv_fil(filref,i,zi);
if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
fil(zi).iaf(1):= identer(i);
end;
d.op.resultat:= 3; <*ok*>
d.op.data(1):= antal;
d.op.data(2):= filref;
end;
\f
message procedure vt_gruppe side 7 - 810505/cl;
returner:
disable
begin
<*+2*>
<**> if testbit43 and overvåget and (funk=1 or funk=2) then
<**> begin
<**> skriv_vt_gruppe(out,0);
<**> write(out,<: gruppetabel efter ændring:>);
<**> p_gruppetabel(out);
<**> end;
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_gruppe(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_grp_trap:
disable skriv_vt_gruppe(zbillede,1);
end vt_gruppe;
\f
message procedure vt_spring side 1 - 810506/cl;
procedure vt_spring(cs_spring_retur,spr_opref);
value cs_spring_retur,spr_opref;
integer cs_spring_retur,spr_opref;
begin
integer array field komm_op,spr_op,iaf;
real nu;
integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
procedure skriv_vt_spring(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ vt_spring :>);
if omfang <> 0 then
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-spring-retur:>,cs_spring_retur,"nl",1,
<:spr-op :>,spr_op,"nl",1,
<:komm-op :>,komm_op,"nl",1,
<:funk :>,funk,"nl",1,
<:interval :>,interval,"nl",1,
<:nr :>,nr,"nl",1,
<:i :>,i,"nl",1,
<:s :>,s,"nl",1,
<:id1 :>,id1,"nl",1,
<:id2 :>,id2,"nl",1,
<:res :>,res,"nl",1,
<:res-inf :>,res_inf,"nl",1,
<:medd-kode :>,medd_kode,"nl",1,
<:zi :>,zi,"nl",1,
<:nu :>,<<zddddd.dddd>,nu,"nl",1,
<::>);
end;
end;
\f
message procedure vt_spring side 2 - 810506/cl;
procedure vt_operation(aktion,id1,id2,res,res_inf);
value aktion,id1,id2;
integer aktion,id1,id2,res,res_inf;
begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
integer array field akt_op;
<* vent på adgang til vogntabel *>
waitch(cs_vt_adgang,akt_op,true,-1);
<* start operation *>
disable
begin
start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
d.akt_op.data(1):= id1;
d.akt_op.data(2):= id2;
signalch(cs_vt_opd,akt_op,vt_optype);
end;
<* afvent svar *>
waitch(cs_spring_retur,akt_op,vt_optype,-1);
res:= d.akt_op.resultat;
res_inf:= d.akt_op.data(3);
<*+2*>
<**> disable
<**> if testbit45 and overvåget then
<**> begin
<**> real t;
<**> skriv_vt_spring(out,0);
<**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
<**> skriv_id(out,springtabel(nr,1),0);
<**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
<**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
<**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
<**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
<**> d.akt_op.resultat,"sp",2);
<**> skriv_id(out,d.akt_op.data(1),8);
<**> skriv_id(out,d.akt_op.data(2),8);
<**> skriv_id(out,d.akt_op.data(3),8);
<**> systime(4,springtid(nr),t);
<**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
<**> end;
<*-2*>
<* åbn adgang til vogntabel *>
disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
end vt_operation;
\f
message procedure vt_spring side 2a - 810506/cl;
procedure io_meddelelse(medd_no,bus,linie,springno);
value medd_no,bus,linie,springno;
integer medd_no,bus,linie,springno;
begin
disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
d.spr_op.data(1):= medd_no;
d.spr_op.data(2):= bus;
d.spr_op.data(3):= linie;
d.spr_op.data(4):= springtabel(springno,1);
d.spr_op.data(5):= springtabel(springno,2);
disable signalch(cs_io,spr_op,io_optype or gen_optype);
waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
end;
procedure returner_op(op,res);
value res;
integer array field op;
integer res;
begin
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
d.op.resultat:= res;
signalch(d.op.retur,op,d.op.optype);
end;
\f
message procedure vt_spring side 3 - 810603/cl;
iaf:= 0;
spr_op:= spr_opref;
stack_claim((if cm_test then 198 else 146) + 24);
trap(vt_spring_trap);
for i:= 1 step 1 until max_antal_spring do
begin
springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
springtid(i):= springstart(i):= 0.0;
end;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0);
<**> write(out,<: springtabel efter initialisering:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_spring(out,0);
<*-2*>
\f
message procedure vt_spring side 4 - 810609/cl;
næste_tid: <* find næste tid *>
disable
begin
interval:= -1; <*vent uendeligt*>
systime(1,0.0,nu);
for i:= 1 step 1 until max_antal_spring do
if springtabel(i,3) < 0 then
interval:= 5
else
if springtid(i) <> 0.0 and
( (springtid(i)-nu) < interval or interval < 0 ) then
interval:= (if springtid(i) <= nu then 0 else
round(springtid(i) -nu));
if interval=0 then interval:= 1;
end;
\f
message procedure vt_spring side 4a - 810525/cl;
<* afvent operation eller timeout *>
waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
if komm_op <> 0 then goto afkod_operation;
<* timeout *>
systime(1,0.0,nu);
nr:= 1;
næste_sekv:
if nr > max_antal_spring then goto næste_tid;
if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
begin
nr:= nr +1;
goto næste_sekv;
end;
disable s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
if springtabel(nr,3) < 0 then
begin <* hængende spring *>
if springtid(nr) <= nu then
begin <* spring ikke udført indenfor angivet interval - annuler *>
<* find frit løb *>
disable
begin
id2:= 0;
for i:= 1 step 1 until springtabel(nr,3) extract 12 do
if fil(zi).iaf(2+i) shift (-22) = 1 then
id2:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
end;
<* send meddelelse til io *>
io_meddelelse(5,0,id2,nr);
<* annuler spring*>
for i:= 1,2,3 do springtabel(nr,i):= 0;
springtid(nr):= springstart(nr):= 0.0;
end
else
begin <* forsøg igen *>
\f
message procedure vt_spring side 5 - 810525/cl;
i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
if i = 2 <* første spring ej udført *> then
begin
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
id2:= id1;
vt_operation(12<*udtag*>,id1,id2,res,res_inf);
end
else
begin
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
id2:= id1 shift (-7) shift 7
+ fil(zi).iaf(2+i-2) shift (-12) extract 7;
vt_operation(13<*omkod*>,id1,id2,res,res_inf);
end;
<* check resultat *>
medd_kode:= if res = 3 and i = 2 then 7 else
if res = 3 and i > 2 then 8 else
<* if res = 9 then 1 else
if res =12 then 2 else
if res =14 then 4 else
if res =18 then 3 else *>
0;
if medd_kode > 0 then
io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
id2 else id1,nr);
if res = 3 then
begin <* spring udført *>
disable s:= modiffil(tf_springdef,nr,zi);
if s<>0 then fejlreaktion(7,s,<:spring:>,0);
springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
if i > 2 then fil(zi).iaf(2+i-2):=
fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
end;
end;
end <* hængende spring *>
else
begin
i:= spring_tabel(nr,3) shift (-12);
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
+ id1 shift (-7) shift 7;
vt_operation(13<*omkod*>,id1,id2,res,res_inf);
\f
message procedure vt_spring side 6 - 820304/cl;
<* check resultat *>
medd_kode:= if res = 3 then 8 else
if res = 9 then 1 else
if res =12 then 2 else
if res =14 then 4 else
if res =18 then 3 else
if res =60 then 9 else 0;
if medd_kode > 0 then
io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
<* opdater springtabel *>
disable s:= modiffil(tf_springdef,nr,zi);
if s<>0 then fejlreaktion(7,s,<:spring:>,0);
if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
begin
io_meddelelse(if res=3 then 6 else 5,0,
if res=3 then id1 else id2,nr);
for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
springtid(nr):= springstart(nr):= 0.0;
end
else
begin
springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
if res = 3 then
begin
fil(zi).iaf(2+i-1):= (1 shift 23) add
(fil(zi).iaf(2+i-1) extract 22);
fil(zi).iaf(2+i) := (1 shift 22) add
(fil(zi).iaf(2+i) extract 22);
springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
end
else
springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
end;
end;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
nr:= nr +1;
goto næste_sekv;
\f
message procedure vt_spring side 7 - 810506/cl;
afkod_operation:
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
<**> skriv_op(out,komm_op);
<**> end;
<*-2*>
disable
begin integer opk;
opk:= d.komm_op.opkode extract 12;
funk:= if opk = 30 <*sp,d*> then 5 else
if opk = 31 <*sp. *> then 1 else
if opk = 32 <*sp,v*> then 4 else
if opk = 33 <*sp,o*> then 6 else
if opk = 34 <*sp,r*> then 2 else
if opk = 35 <*sp,a*> then 3 else
0;
if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
if funk <> 6 <*sp,o*> then
begin <* find nr i springtabel *>
nr:= 0;
for i:= 1 step 1 until max_antal_spring do
if springtabel(i,1) = d.komm_op.data(1) and
springtabel(i,2) = d.komm_op.data(2) then nr:= i;
end;
end;
if funk = 6 then goto oversigt;
if funk = 5 then goto definer;
if nr = 0 then
begin
returner_op(komm_op,37<*spring ukendt*>);
goto næste_tid;
end;
goto case funk of(start,indsæt,annuler,vis);
\f
message procedure vt_spring side 8 - 810525/cl;
start:
if springtabel(nr,3) shift (-12) <> 0 then
begin returner_op(komm_op,38); goto næste_tid; end;
disable
begin <* find linie_løb_og_udtag *>
s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
id2:= 0;
end;
vt_operation(12,id1,id2,res,res_inf);
disable <* check resultat *>
medd_kode:= if res = 3 <*ok*> then 7 else
if res = 9 <*linie/løb ukendt*> then 1 else
if res =14 <*optaget*> then 4 else
if res =18 <*i kø*> then 3 else 0;
returner_op(komm_op,3);
if medd_kode = 0 then goto næste_tid;
<* send spring-meddelelse til io *>
io_meddelelse(medd_kode,res_inf,id1,nr);
<* opdater springtabel *>
disable
begin
s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
add (springtabel(nr,3) extract 12);
systime(1,0.0,nu);
springstart(nr):= nu;
springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
end;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
\f
message procedure vt_spring side 9 - 810506/cl;
indsæt:
if springtabel(nr,3) shift (-12) = 0 then
begin <* ikke igangsat *>
returner_op(komm_op,41);
goto næste_tid;
end;
<* find frie linie/løb *>
disable
begin
s:= læs_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
id2:= 0;
for i:= 1 step 1 until springtabel(nr,3) extract 12 do
if fil(zi).iaf(2+i) shift (-22) = 1 then
id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
+fil(zi).iaf(2+i) shift (-12) extract 7;
id1:= d.komm_op.data(3);
end;
if id2<>0 then
vt_operation(11,id1,id2,res,res_inf)
else
res:= 42;
disable <* check resultat *>
medd_kode:= if res = 3 <*ok*> then 8 else
if res =10 <*bus ukendt*> then 0 else
if res =11 <*bus allerede indsat*> then 0 else
if res =12 <*linie/løb allerede besat*> then 2 else
if res =42 <*intet frit linie/løb*> then 5 else 0;
if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
returner_op(komm_op,res);
if medd_kode = 0 then goto næste_tid;
<* send springmeddelelse til io *>
if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
io_meddelelse(5,0,0,nr);
\f
message procedure vt_spring side 9a - 810525/cl;
<* annuler springtabel *>
for i:= 1,2,3 do springtabel(nr,i):= 0;
springtid(nr):= springstart(nr):= 0.0;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
\f
message procedure vt_spring side 10 - 810525/cl;
annuler:
disable
begin <* find evt. frit linie/løb *>
s:= læs_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
id1:= id2:= 0;
for i:= 1 step 1 until springtabel(nr,3) extract 12 do
if fil(zi).iaf(2+i) shift (-22) = 1 then
id2:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
returner_op(komm_op,3);
end;
<* send springmeddelelse til io *>
io_meddelelse(5,id1,id2,nr);
<* annuler springtabel *>
for i:= 1,2,3 do springtabel(nr,i):= 0;
springtid(nr):= springstart(nr):= 0.0;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
definer:
if nr <> 0 then <* allerede defineret *>
begin
res:= 36;
goto slut_definer;
end;
<* find frit nr *>
i:= 0;
for i:= i+1 while i<= max_antal_spring and nr = 0 do
if springtabel(i,1) = 0 then nr:= i;
if nr = 0 then
begin
res:= 32; <* ingen fri plads *>
goto slut_definer;
end;
\f
message procedure vt_spring side 11 - 810525/cl;
disable
begin integer array fdim(1:8),ia(1:32);
<* læs sekvens *>
fdim(4):= d.komm_op.data(3);
s:= hent_fil_dim(fdim);
if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
if fdim(1) > 30 then
res:= 35 <* springsekvens for stor *>
else
begin
for i:= 1 step 1 until fdim(1) do
begin
s:= læs_fil(fdim(4),i,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
ia(i):= fil(zi).iaf(1) shift 12;
if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
end;
s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
iaf:= 4;
tofrom(fil(zi).iaf,ia,60);
iaf:= 0;
springtabel(nr,3):= fdim(1);
springtid(nr):= springstart(nr):= 0.0;
res:= 3;
end;
end;
\f
message procedure vt_spring side 11a - 81-525/cl;
slut_definer:
<* slet fil *>
start_operation(spr_op,curr_coruid,cs_spring_retur,104);
d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
signalch(cs_slet_fil,spr_op,vt_optype);
waitch(cs_spring_retur,spr_op,vt_optype,-1);
if d.spr_op.data(9) <> 0 then
fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
returner_op(komm_op,res);
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
\f
message procedure vt_spring side 12 - 810525/cl;
vis:
disable
begin
<* tilknyt fil *>
start_operation(spr_op,curr_coruid,cs_spring_retur,101);
d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
d.spr_op.data(2):= 1;
d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
signalch(cs_opret_fil,spr_op,vt_optype);
end;
<* afvent svar *>
waitch(cs_spring_retur,spr_op,vt_optype,-1);
if d.spr_op.data(9) <> 0 then
fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
disable
begin integer array ia(1:30);
s:= læs_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
iaf:= 4;
tofrom(ia,fil(zi).iaf,60);
iaf:= 0;
for i:= 1 step 1 until d.spr_op.data(1) do
begin
s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
ia(i) shift (-12) extract 7
else -(ia(i) shift (-12) extract 7);
s:= skriv_fil(d.spr_op.data(4),2*i,zi);
if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
fil(zi).iaf(1):= if i < d.spr_op.data(1) then
(if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
else ia(i) extract 12)
else 0;
end;
d.spr_op.data(1):= d.spr_op.data(1) - 1;
sæt_fil_dim(d.spr_op.data);
d.komm_op.data(3):= d.spr_op.data(1);
d.komm_op.data(4):= d.spr_op.data(4);
raf:= data+8;
d.komm_op.raf(1):= springstart(nr);
returner_op(komm_op,3);
end;
goto næste_tid;
\f
message procedure vt_spring side 13 - 810525/cl;
oversigt:
disable
begin
<* opret fil *>
start_operation(spr_op,curr_coruid,cs_spring_retur,101);
d.spr_op.data(1):= max_antal_spring;
d.spr_op.data(2):= 4;
d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
signalch(cs_opret_fil,spr_op,vt_optype);
end;
<* afvent svar *>
waitch(cs_spring_retur,spr_op,vt_optype,-1);
if d.spr_op.data(9) <> 0 then
fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
disable
begin
nr:= 0;
for i:= 1 step 1 until max_antal_spring do
begin
if springtabel(i,1) <> 0 then
begin
nr:= nr +1;
s:= skriv_fil(d.spr_op.data(4),nr,zi);
if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
fil(zi).iaf(1):= springtabel(i,1);
fil(zi).iaf(2):= springtabel(i,2);
fil(zi,2):= springstart(i);
end;
end;
d.spr_op.data(1):= nr;
s:= sæt_fil_dim(d.spr_op.data);
if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
d.komm_op.data(1):= nr;
d.komm_op.data(2):= d.spr_op.data(4);
returner_op(komm_op,3);
end;
goto næste_tid;
vt_spring_trap:
disable skriv_vt_spring(zbillede,1);
end vt_spring;
\f
message procedure vt_auto side 1 - 810505/cl;
procedure vt_auto(cs_auto_retur,auto_opref);
value cs_auto_retur,auto_opref;
integer cs_auto_retur,auto_opref;
begin
integer array field op,auto_op,iaf;
integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
res_inf,i,s,zi,kl,døgnstart;
real t,nu,næste_tid;
boolean optaget;
integer array filnavn(1:4);
procedure skriv_vt_auto(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ vt_auto :>);
if omfang<>0 then
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-auto-retur :>,cs_auto_retur,"nl",1,
<:op :>,op,"nl",1,
<:auto-op :>,auto_op,"nl",1,
<:filref :>,filref,"nl",1,
<:id1 :>,id1,"nl",1,
<:id2 :>,id2,"nl",1,
<:aktion :>,aktion,"nl",1,
<:postnr :>,postnr,"nl",1,
<:sidste-post :>,sidste_post,"nl",1,
<:interval :>,interval,"nl",1,
<:res :>,res,"nl",1,
<:res-inf :>,res_inf,"nl",1,
<:i :>,i,"nl",1,
<:s :>,s,"nl",1,
<:zi :>,zi,"nl",1,
<:kl :>,kl,"nl",1,
<:døgnstart :>,døgnstart,"nl",1,
<:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
<:t :>,<<zddddd.dddd>,t,"nl",1,
<:nu :>,nu,"nl",1,
<:næste-tid :>,næste_tid,"nl",1,
<::>);
end;
end skriv_vt_auto;
\f
message procedure vt_auto side 2 - 810507/cl;
iaf:= 0;
auto_op:= auto_opref;
filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
optaget:= false;
næste_tid:= 0.0;
stack_claim(if cm_test then 198 else 146);
trap(vt_auto_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_auto(out,0);
<*-2*>
vent:
systime(1,0.0,nu);
interval:= if filref=0 then (-1) <*uendeligt*> else
if næste_tid > nu then round(næste_tid-nu) else
if optaget then 5 else 0;
if interval=0 then interval:= 1;
<*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
if op<>0 then goto filskift;
<* vent på adgang til vogntabel *>
<*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
<* afsend relevant operation til opdatering af vogntabel *>
start_operation(op,curr_coruid,cs_auto_retur,aktion);
d.op.data(1):= id1;
d.op.data(2):= id2;
signalch(cs_vt_opd,op,vt_optype);
<*v*> waitch(cs_auto_retur,op,vt_optype,-1);
res:= d.op.resultat;
id2:= d.op.data(2);
res_inf:= d.op.data(3);
<* åbn for vogntabel *>
signalch(cs_vt_adgang,op,vt_optype or gen_optype);
\f
message procedure vt_auto side 3 - 810507/cl;
<* behandl svar fra opdatering *>
<*+2*>
<**> disable
<**> if testbit45 and overvåget then
<**> begin
<**> integer li,lø,bo;
<**> skriv_vt_auto(out,0);
<**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
<**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
<**> <:: OMKOD:>,<: - RES=:>,res);
<**> for i:= 1,2 do
<**> begin
<**> li:= d.op.data(i);
<**> lø:= li extract 7; bo:= li shift (-7) extract 5;
<**> if bo<>0 then bo:= bo + 'A' - 1;
<**> li:= li shift (-12) extract 10;
<**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
<**> end;
<**> systime(4,næste_tid,t);
<**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
<**> << zd.dd>,t/10000,"nl",1);
<**> end;
<*-2*>
if res=31 then
fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
else
if res<>3 then
begin
if -, optaget then
begin
disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
if res=18 then 3 else if res=60 then 9 else 4;
d.auto_op.data(2):= res_inf;
d.auto_op.data(3):= if res=12 then id2 else id1;
signalch(cs_io,auto_op,io_optype or gen_optype);
waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
end;
if res=14 or res=18 then <* i kø eller optaget *>
begin
optaget:= true;
goto vent;
end;
end;
optaget:= false;
\f
message procedure vt_auto side 4 - 810507/cl;
<* find næste post *>
disable
begin
if postnr=sidste_post then
begin <* døgnskift *>
postnr:= 1;
døgnstart:= systime(4,systid(døgnstart+1,120000),t);
end
else postnr:= postnr+1;
s:= læsfil(filref,postnr,zi);
if s<>0 then fejlreaktion(5,s,<:auto:>,0);
aktion:= fil(zi).iaf(1);
næste_tid:= systid(døgnstart,fil(zi).iaf(2));
id1:= fil(zi).iaf(3);
id2:= fil(zi).iaf(4);
end;
goto vent;
\f
message procedure vt_auto side 5 - 810507/cl;
filskift:
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_auto(out,0);
<**> write(out,<: modtaget operation::>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
for i:= 1 step 1 until 4 do filnavn(i):= 0;
res:= 46;
if d.op.opkode extract 12 <> 21 then
fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
if filref = 0 then goto knyt;
<* gem filnavn til io-meddelelse *>
disable begin
integer array fdim(1:8);
integer array field navn;
fdim(4):= filref;
hentfildim(fdim);
navn:= 8;
tofrom(filnavn,fdim.navn,8);
end;
<* frivgiv tilknyttet autofil *>
disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
d.auto_op.data(4):= filref;
signalch(cs_frigiv_fil,auto_op,vt_optype);
<*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
if d.auto_op.data(9) <> 0 then
fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
optaget:= false;
næste_tid:= 0.0;
res:= 3;
\f
message procedure vt_auto side 6 - 810507/cl;
<* tilknyt evt. ny autofil *>
knyt:
if d.op.data(1)<>0 then
begin
disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
disable
begin integer pos1,pos2;
pos1:= pos2:= 13;
while læstegn(d.auto_op.data,pos1,i)<>0 do
begin
if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
skrivtegn(d.auto_op.data,pos2,i);
end;
end;
signalch(cs_tilknyt_fil,auto_op,vt_optype);
<*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
s:= d.auto_op.data(9);
if s=0 then res:= 3 <* ok *> else
if s=1 or s=2 then res:= 46 <* ukendt navn *> else
if s=5 or s=7 then res:= 47 <* galt indhold *> else
if s=6 then res:= 48 <* i brug *> else
fejlreaktion(14,2,<:auto,filskift:>,0);
if res<>3 then goto returner;
<* find første post *>
disable
begin
døgnstart:= systime(5,0.0,t);
kl:= round t;
filref:= d.auto_op.data(4);
sidste_post:= d.auto_op.data(1);
postnr:= 0;
for postnr:= postnr+1 while postnr <= sidste_post do
begin
s:= læsfil(filref,postnr,zi);
if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
if fil(zi).iaf(2) > kl then goto post_fundet;
end;
postnr:= 1;
døgnstart:= systime(4,systid(døgnstart+1,120000),t);
\f
message procedure vt_auto side 7 - 810507/cl;
post_fundet:
s:= læsfil(filref,postnr,zi);
if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
aktion:= fil(zi).iaf(1);
næste_tid:= systid(døgnstart,fil(zi).iaf(2));
id1:= fil(zi).iaf(3);
id2:= fil(zi).iaf(4);
res:= 3;
end;
end ny fil;
returner:
d.op.resultat:= res;
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_auto(out,0);
<**> write(out,<: returner operation::>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
if filnavn(1)<>0 then
begin <* meddelelse til io om annulering *>
disable begin
start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
i:= 1;
hægtstring(d.auto_op.data,i,<:auto :>);
skriv_text(d.auto_op.data,i,filnavn);
hægtstring(d.auto_op.data,i,<: annuleret:>);
repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
signalch(cs_io,auto_op,io_optype or gen_optype);
end;
waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
end;
goto vent;
vt_auto_trap:
disable skriv_vt_auto(zbillede,1);
end vt_auto;
:5: vogntabel: initialisering
\f
message vogntabel initialisering side 1 - 820301;
sidste_bus:= sidste_linie_løb:= 0;
tf_vogntabel:= 1 shift 10 + 2;
tf_gruppedef:= ia(4):= 1 shift 10 +3;
tf_gruppeidenter:= 1 shift 10 +6;
tf_springdef:= 1 shift 10 +7;
hent_fil_dim(ia);
max_antal_i_gruppe:= ia(2);
if ia(1) < max_antal_grupper then
max_antal_grupper:= ia(1);
for i:= 0 step 1 until max_antal_garager do
begin
garagenavn(i):= long( case i+1 of (
<:___:>,<:DSV:>,<:UNI:>,<:CIT:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:TCT:>,<:IRL:>,<:ART:>,<:RYV:>,<:ØRV:>,<:ISL:>,<:VAL:>,<:HUS:>,<:___:>,
<:___:>,<:HHL:>,<:DHB:>,<:BIB:>,<:KOK:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:GLX:>,<:DBB:>,<:HCS:>,<:THR:>,<:BAB:>,<:___:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:KJ:> ,<:THO:>,<:HVR:>,<:STT:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:HI:> ,<:HIB:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:HG:> ,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:BA:> ,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:RO:> ,<:ROT:>,<:ALJ:>,<:TÅB:>,<:ROM:>,<:KWK:>,<:___:>,<:___:>,<:___:>,
<:___:>,<:FS:> ,<:CHS:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,<:___:>,
<::>));
garageomr(i):= case i+1 of (
0,3,3,3,0,0,0,0,0,0,
0,3,3,3,3,3,3,3,3,0,
0,6,6,6,6,0,0,0,0,0,
0,7,7,7,7,11,0,0,0,0,
0,8,8,8,8,0,0,0,0,0,
0,9,9,0,0,0,0,0,0,0,
0,10,0,0,0,0,0,0,0,0,
0,11,0,0,0,0,0,0,0,0,
0,4,4,4,4,4,4,0,0,0,
0,5,5,0,0,0,0,0,0,0,
0);
end;
<* initialisering af interne vogntabeller *>
begin
long array field laf1,laf2;
integer array fdim(1:8);
zone z(128,1,stderror);
integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
long omr,garageid;
integer field ll, bn;
boolean binær, test24;
ll:= 2; bn:= 4;
<* nulstil tabellerne *>
laf1:= -2;
laf2:= 2;
bustabel1.laf2(0):=
bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
\f
message vogntabel initialisering side 1a - 810505/cl;
<* initialisering af intern busnummertabel *>
open(z,4,<:busnumre:>,0);
busnr:= -1;
read(z,busnr);
while busnr > 0 do
begin
if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
sidste_bus:= sidste_bus+1;
if sidste_bus > max_antal_busser then
fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
repeatchar(z); readchar(z,tegn);
garageid:= extend 0; binær:= false; omr:= extend 0;
if tegn='!' then
begin
binær:= true;
readchar(z,tegn);
end;
if tegn='/' then <*garageid*>
begin
readchar(z,tegn);
while ('A'<= tegn and tegn <='Å') do
begin
garageid:= garageid shift 8 + tegn;
readchar(z,tegn);
end;
end;
g_nr:= 0;
if garageid<>0 then
begin
while garageid shift (-40) extract 8 = 0 do
garageid:= garageid shift 8;
i:= 1;
while i<=max_antal_garager and g_nr=0 do
begin
if garageid=garagenavn(i) then g_nr:= i;
i:= i+1;
end;
if g_nr=0 and garageid<>0 then
fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
end;
if tegn=';' then
begin
readchar(z,tegn);
while ('A'<=tegn and tegn<='Å') do
begin
omr:= omr shift 8 + tegn;
readchar(z,tegn);
end;
end;
o_nr:= 0;
if omr<>0 then
begin
while omr shift (-40) extract 8 = 0 do
omr:= omr shift 8;
i:= 1;
while i<=max_antal_områder and o_nr=0 do
begin
if omr=område_navn(i) then o_nr:= i;
i:= i+1;
end;
if o_nr=0 then
fejlreaktion(10,busnr,<:ukendt område for bus:>,1);
end;
if o_nr=0 then o_nr:= 3;
if g_nr=0 then
begin
i:= 1;
while i<=max_antal_garager and g_nr=0 do
begin
if områdenavn(o_nr) = garagenavn(i) then g_nr:= i;
i:= i+1;
end;
end;
bustabel (sidste_bus):= g_nr shift 14 + busnr;
bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
busnr:= -1;
read(z,busnr);
end;
close(z,true);
\f
message vogntabel initialisering side 2 - 820301/cl;
<* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
test24:= testbit24;
testbit24:= false;
i:= 1;
s:= læsfil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
while fil(zi).bn<>0 do
begin
if fil(zi).ll <> 0 then
begin <* indsæt linie/løb *>
res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
fil(zi).ll,j);
if res < 0 then j:= j+1;
if res = 0 then fejlreaktion(10,fil(zi).bn,
<:dobbeltregistrering i vogntabel:>,1)
else
begin
o_nr:= fil(zi).bn shift (-14) extract 8;
b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
<:ukendt bus i vogntabel:>,1)
else
begin
if sidste_linie_løb >= max_antal_linie_løb then
fejlreaktion(10,fil(zi).bn extract 14,
<:for mange linie/løb i vogntabel:>,0);
for ll_nr:= sidste_linie_løb step (-1) until j do
begin
linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
end;
linie_løb_tabel(j):= fil(zi).ll;
bus_indeks(j):= false add b_nr;
sidste_linie_løb:= sidste_linie_løb + 1;
end;
end;
end;
i:= i+1;
s:= læsfil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
end;
\f
message vogntabel initialisering side 3 - 810428/cl;
<* initialisering af intern linie/løb-indekstabel *>
for ll_nr:= 1 step 1 until sidste_linie_løb do
linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
<* gem ny vogntabel i tabelfil *>
for i:= 1 step 1 until sidste_bus do
begin
s:= skriv_fil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
fil(zi).bn:= bustabel(i) extract 14 add
(bustabel1(i) extract 8 shift 14);
fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
end;
fdim(4):= tf_vogntabel;
hent_fil_dim(fdim);
pant:= fdim(3) * (256//fdim(2));
for i:= sidste_bus+1 step 1 until pant do
begin
s:= skriv_fil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
fil(zi).ll:= fil(zi).bn:= 0;
end;
<* initialisering/nulstilling af gruppetabeller *>
for i:= 1 step 1 until max_antal_grupper do
begin
s:= læs_fil(tf_gruppeidenter,i,zi);
if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
gruppetabel(i):= fil(zi).ll;
end;
for i:= 1 step 1 until max_antal_gruppeopkald do
gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
testbit24:= test24;
end;
<*+2*>
<**> if testbit40 then p_vogntabel(out);
<**> if testbit43 then p_gruppetabel(out);
<*-2*>
\f
message vogntabel initialisering side 4 - 810520/cl;
cs_vt:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
<*-3*>
cs_vt_adgang:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
<*-3*>
cs_vt_opd:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
<*-3*>
cs_vt_rap:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
<*-3*>
cs_vt_tilst:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
<*-3*>
cs_vt_auto:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
<*-3*>
cs_vt_grp:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
<*-3*>
cs_vt_spring:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
<*-3*>
vt_op:= nextop(vt_op_længde);
signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
\f
message vogntabel initialisering side 5 - 81-520/cl;
i:= nextcoru(500, <*ident*>
10, <*prioitet*>
true <*testmaske*>);
j:= new_activity( i,
0,
h_vogntabel);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(501, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
iaf:= nextop(filop_længde);
j:= new_activity(i,
0,
vt_opdater,iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(502, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= newactivity(i,
0,
vt_tilstand,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
\f
message vogntabel initialisering side 6 - 810520/cl;
i:= nextcoru(503, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= newactivity(i,
0,
vt_rapport,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(504, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= new_activity(i,
0,
vt_gruppe,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
\f
message vogntabel initialisering side 7 - 810520/cl;
i:= nextcoru(505, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= newactivity(i,
0,
vt_spring,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(506, <*ident*>
10,
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
<*-3*>
iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
j:= newactivity(i,
0,
vt_auto,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
<*+2*>
<**> if testbit42 then skriv_vt_variable(out);
<*-2*>
:6: vogntabel: trap
\f
message vogntabel trapaktion side 1 - 810520/cl;
skriv_vt_variable(zbillede);
p_vogntabel(zbillede);
p_gruppetabel(zbillede);
p_springtabel(zbillede);
▶EOF◀