|
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 - download
Length: 109056 (0x1aa00)
Types: TextFile
Names: »htvogntabel «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »htvogntabel «
vogntabel.
:1: vogntabel: parametererklæringer
\f
message vogntabel parametererklæringer side 1 - 810309/cl;
integer vt_op_længde, vt_logskift;
boolean vt_log_aktiv;
:2: vogntabel: parameterinitialisering
\f
message vogntabel parameterinitialisering side 1 - 810309/cl;
vt_op_længde:= data + 16; <* halvord *>
if findfpparam(<:vtlogskift:>,true,ia) > 0 then
vt_logskift:= ia(1) else vt_logskift:= -1;
vt_log_aktiv:= (vt_logskift >= 0) and (vt_logskift < 240000);
: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 *>
+ 1 <* coroutine vt_log *>
+ maxcoru;
maxsemch:= 1 <* cs_vt *>
+ 1 <* cs_vt_adgang *>
+ 1 <* cs_vt_logpool *>
+ 1 <* cs_vt_opd *>
+ 1 <* cs_vt_rap *>
+ 1 <* cs_vt_tilst *>
+ 1 <* cs_vtt_auto *>
+ 1 <* cs_vt_grp *>
+ 1 <* cs_vt_spring *>
+ 1 <* cs_vt_log *>
+ 5 <* cs_vt_filretur(coru) *>
+ maxsemch;
maxop:= 1 <* vt_op *>
+ 2 <* vt_log_op *>
+ 6 <* vt_fil_op + radop *>
+ maxop;
maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
+ 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_logpool,cs_vt_opd,cs_vt_rap,
cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
cs_vt_log;
integer sidste_bus,sidste_linie_løb,tf_vogntabel,
max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
vt_log_slicelgd;
integer array bustabel,bustabel1(0:max_antal_busser),
linie_løb_tabel(0:max_antal_linie_løb),
springtabel(1:max_antal_spring,1:3),
gruppetabel(1:max_antal_grupper),
gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
vt_logop(1:2),
vt_logdisc(1:4),
vt_log_tail(1:10);
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);
real vt_logstart;
integer field v_kode,v_bus,v_ll1,v_ll2;
integer array field v_tekst;
real field v_tid;
zone zvtlog(128,1,stderror);
\f
message vogntabel erklæringer side 2 - 851001/cl;
procedure skriv_vt_variable(zud);
zone zud;
begin integer i; long array field laf;
laf:= 0;
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-logpool :>,cs_vt_logpool,"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,
<:cs-vt-log :>,cs_vt_log,"nl",1,
<:vt-op :>,vt_op,"nl",1,
<:vt-logop(1) :>,vt_logop(1),"nl",1,
<:vt-logop(2) :>,vt_logop(2),"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,
<:vt-logskift :>,vt_logskift,"nl",1,
<:vt-logdisc :>,vt_logdisc.laf,"nl",1,
<:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
<:vt-log-aktiv :>,
if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
<:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
<::>);
write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
laf:= 2;
write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
for i:= 6 step 1 until 10 do
write(zud,"sp",1,<<d>,vt_logtail(i));
write(zud,"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,if s=1 then <:B:> else <: :>,"sp",1,
if g > 0 then string bpl_navn(g) else <: :>,
";",1,true,4,string område_navn(o),
<:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
li,false add lb,if lb=' ' then 0 else 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
opd_omr:= 3;
<*GØR PROCEDUREN TIL DUMMYPROCEDURE -
ændringer skal ikke længere meldes til yderområder *>
goto dummy_retur;
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;
dummy_retur:
end;
message procedure vt_opdater side 1a - 920517/cl;
procedure opd_log(kilde,kode,bus,ll1,ll2);
value kilde,kode,bus,ll1,ll2;
integer kilde,kode,bus,ll1,ll2;
begin
integer array field op;
<*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
startoperation(op,curr_coruid,cs_vt_logpool,0);
systime(1,0.0,d.op.data.v_tid);
d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
d.op.data.v_bus:= bus;
d.op.data.v_ll1:= ll1;
d.op.data.v_ll2:= ll2;
signalch(cs_vt_log,op,vt_optype);
end;
stackclaim((if cm_test then 198 else 146)+125);
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 *>
begin
sig:= busindeks(li) extract 12;
d.op.data(3):= bustabel(sig);
linie_løb_indeks(sig):= false;
disable modiffil(tf_vogntabel,sig,zi);
fil(zi).ll:= 0;
fil(zi).bn:= bustabel(sig) extract 14 add
(bustabel1(sig) extract 8 shift 14);
opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
linie_løb_indeks(bi):= false add li;
busindeks(li):= false add bi;
disable modiffil(tf_vogntabel,bi,zi);
fil(zi).ll:= ll_id;
fil(zi).bn:= bustabel(bi) extract 14 add
(bustabel1(bi) extract 8 shift 14);
opd_log(d.op.kilde,1,busnr,0,ll_id);
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
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;
disable 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;
opd_log(d.op.kilde,1,busnr,0,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);
opd_log(d.op.kilde,2,busnr,ll_id,0);
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);
if funk=6 then
opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
else
opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
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);
opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
\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);
opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
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;
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
opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
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;
integer array ww, xx(1:2);
integer procedure sml(a,b);
integer array a,b;
begin
integer res;
res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
if res = 0 then
res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
if res = 0 then
res:=
sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
if res = 0 then
res:= sign((a(2) extract 14) - (b(2) extract 14));
sml:= res;
end;
ii:= ((l+u)//2 - 1)*4;
tofrom(xx,tab.ii,4);
ii:= (l-1)*4; jj:= (u-1)*4;
repeat
while sml(tab.ii,xx) < 0 do ii:= ii+4;
while sml(xx,tab.jj) < 0 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 550 else 500);
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) or
(testbit46 and overvåget and
(d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
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:= 2;
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:= 2;
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;
integer field antal_spec;
antal_spec:= 2; a:= 0;
spec:= 2; akt:= 2;
sorter_gruppe(fil(zi).spec,1,antal);
fil(zi).antal_spec:= 0;
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;
fil(zi).antal_spec:= fil(zi).antal_spec+1;
spec:= spec + 2*a + 2;
end;
antal:= fil(zi).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;
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);
læsfil(filref,1,zi);
spec:= 0;
antal:= fil(zi).spec(1);
spec:= spec+2;
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) or
<**> (testbit46 and overvåget and (funk=4 or funk=5)) 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,nytnavn(1:4);
procedure skriv_vt_auto(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
long array field laf;
laf:= 0;
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,
<:filnavn :>,filnavn.laf,"nl",1,
<:nytnavn :>,nytnavn.laf,"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;
for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
stack_claim(if cm_test then 298 else 246);
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):=nytnavn(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;
tofrom(nytnavn,d.op.data,8);
<* 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 vt_log_aktiv then
begin
waitch(cs_vt_logpool,op,vt_optype,-1);
startoperation(op,curr_coruid,cs_vt_logpool,0);
if nytnavn(1)=0 then
hægtstring(d.op.data.v_tekst,1,<:ophør:>)
else
skriv_text(d.op.data.v_tekst,1,nytnavn);
d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
systime(1,0.0,d.op.data.v_tid);
signalch(cs_vt_log,op,vt_optype);
end;
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;
message procedure vt_log side 1 - 920517/cl;
procedure vt_log;
begin
integer i,j,ventetid;
real dg,t,nu,skiftetid;
boolean fil_åben;
integer array ia(1:10),dp,dp1(1:8);
integer array field op, iaf;
procedure skriv_vt_log(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ vt-log :>);
if omfang<>0 then
begin
skriv_coru(zud, abs curr_coruno);
write(zud,"nl",1,<<d>,
<:i :>,i,"nl",1,
<:j :>,j,"nl",1,
<:ventetid :>,ventetid,"nl",1,
<:dg :>,<<zddddd.dd>,dg,"nl",1,
<:t :>,t,"nl",1,
<:nu :>,nu,"nl",1,
<:skiftetid :>,skiftetid,"nl",1,
<:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
<:op :>,<<d>,op,"nl",1,
<::>);
raf:= 0;
write(zud,"nl",1,<:ia::>);
skrivhele(zud,ia.raf,20,2);
write(zud,"nl",2,<:dp::>);
skrivhele(zud,dp.raf,16,2);
write(zud,"nl",2,<:dp1::>);
skrivhele(zud,dp1.raf,16,2);
end;
end;
message procedure vt_log side 2 - 920517/cl;
procedure slet_fil;
begin
integer segm,res;
integer array tail(1:10);
res:= monitor(42)lookup_entry:(zvtlog,0,tail);
if res=0 then
begin
segm:= tail(10);
res:=monitor(48)remove_entry:(zvtlog,0,tail);
if res=0 then
begin
close(zvtlog,true);
open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
res:=monitor(42)lookup_entry:(zvtlog,0,tail);
if res=0 then
begin
tail(1):= tail(1)+segm;
monitor(44)change_entry:(zvtlog,0,tail);
end;
end;
end;
end;
boolean procedure udvid_fil;
begin
integer res,spos;
integer array tail(1:10);
zone z(1,1,stderror);
udvid_fil:= false;
open(z,0,<:vtlogpool:>,0); close(z,true);
res:= monitor(42)lookup_entry:(z,0,tail);
if (res=0) and (tail(1) >= vt_log_slicelgd) then
begin
tail(1):=tail(1) - vt_log_slicelgd;
res:=monitor(44)change_entry:(z,0,tail);
if res=0 then
begin
spos:= vt_logtail(1);
vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
if res<>0 then
begin
vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
tail(1):= tail(1) + vt_log_slicelgd;
monitor(44)change_entry:(z,0,tail);
end
else
begin
setposition(zvtlog,0,spos);
udvid_fil:= true;
end;
end;
end;
end;
message procedure vt_log side 3 - 920517/cl;
boolean procedure ny_fil;
begin
integer res,i,j;
integer array nyt(1:4), ia,tail(1:10);
long array field navn;
real t;
navn:=0;
if fil_åben then
begin
close(zvtlog,true);
fil_åben:= false;
nyt.navn(1):= long<:vtlo:>;
nyt.navn(2):= long<::>;
anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
j:= 'a' - 1;
repeat
res:=monitor(46)rename_entry:(zvtlog,0,nyt);
if res=3 then
begin
j:= j+1;
if j <= 'å' then skrivtegn(nyt,11,j);
end;
until (res<>3) or (j > 'å');
if res=0 then
begin
open(zvtlog,4,<:vtlogklar:>,0);
res:=monitor(42)lookup_entry:(zvtlog,0,tail);
if res=0 then
res:=monitor(52)create_areaproc:(zvtlog,0,ia);
if res=0 then
begin
res:=monitor(8)reserve_process:(zvtlog,0,ia);
if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if res=0 then
begin
setposition(zvtlog,0,tail(10)//64);
navn:= (tail(10) mod 64)*8;
if (tail(1) <= tail(10)//64) then
outrec6(zvtlog,512)
else
swoprec6(zvtlog,512);
tofrom(zvtlog.navn,nyt,8);
tail(10):= tail(10)+1;
setposition(zvtlog,0,tail(10)//64);
monitor(44)change_entry:(zvtlog,0,tail);
close(zvtlog,true);
end
else
begin
navn:= 0;
close(zvtlog,true);
open(zvtlog,4,<:vtlog:>,0);
slet_fil;
end;
end
else
slet_fil;
end;
<* logfilen er nu omdøbt og indskrevet i vtlogklar *>
<* eller den er blevet slettet. *>
open(zvtlog,4,<:vtlog:>,0);
for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
vt_logtail(6):= systime(7,0,t);
res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
if res=0 then
begin
monitor(50)permanent_entry:(zvtlog,3,ia);
if res<>0 then
monitor(48)remove_entry:(zvtlog,0,ia);
end;
if res=0 then fil_åben:= true;
ny_fil:= fil_åben;
end ny_fil;
message procedure vt_log side 4 - 920517/cl;
procedure skriv_post(logpost);
integer array logpost;
begin
integer array field post;
real t;
if vt_logtail(10)//32 < vt_logtail(1) then
begin
outrec6(zvtlog,512);
post:= (vt_logtail(10) mod 32)*16;
tofrom(zvtlog.post,logpost,16);
vt_logtail(10):= vt_logtail(10)+1;
setposition(zvtlog,0,vt_logtail(10)//32);
vt_logtail(6):= systime(7,0,t);
monitor(44)change_entry:(zvtlog,0,vt_logtail);
end;
end;
procedure sletsendte;
begin
zone z(128,1,stderror), zpool,zlog(1,1,stderror);
integer array pooltail,tail,ia(1:10);
integer i,res;
open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
res:=monitor(42,zpool,0,pooltail);
open(z,4,<:vtlogslet:>,0);
if monitor(42,z,0,tail)=0 and tail(10)>0 then
begin
if monitor(52,z,0,tail)=0 then
begin
if monitor(8,z,0,tail)=0 then
begin
for i:=1 step 1 until tail(10) do
begin
inrec6(z,8);
open(zlog,0,z,0); close(zlog,true);
if monitor(42,zlog,0,ia)=0 then
begin
if monitor(48,zlog,0,ia)=0 then
begin
pooltail(1):=pooltail(1)+ia(1);
end;
end;
end;
tail(10):=0;
monitor(44,z,0,tail);
end
else
monitor(64,z,0,tail);
end;
if res=0 then monitor(44,zpool,0,pooltail);
end;
close(z,true);
end;
message procedure vt_log side 5 - 920517/cl;
trap(vt_log_trap);
stack_claim(200);
fil_åben:= false;
if -, vt_log_aktiv then goto init_slut;
open(zvtlog,4,<:vtlog:>,0);
i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
if i=0 then
i:=monitor(52)create_areaproc:(zvtlog,0,ia);
if i=0 then
begin
i:=monitor(8)reserve_process:(zvtlog,0,ia);
if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if (i=0) and (vt_logtail(1)=0) then
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
i:= 1;
end;
disable
if i=0 then
begin
fil_åben:= true;
inrec6(zvtlog,512);
vt_logstart:= zvtlog.v_tid;
systime(1,0.0,nu);
if (nu - vt_logstart) < 24*60*60.0 then
begin
setposition(zvtlog,0,vt_logtail(10)//32);
if (vt_logtail(10)//32) < vt_logtail(1) then
begin
inrec6(zvtlog,512);
setposition(zvtlog,0,vt_logtail(10)//32);
end;
end
else
begin
if ny_fil then
begin
if udvid_fil then
begin
systime(1,0.0,dp.v_tid);
vt_logstart:= dp.v_tid;
dp.v_kode:=0;
skriv_post(dp);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
end
else
begin
close(zvtlog,true);
if ny_fil then
begin
if udvid_fil then
begin
systime(1,0.0,dp.v_tid);
vt_logstart:= dp.v_tid;
dp.v_kode:=0;
skriv_post(dp);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
init_slut:
dg:= systime(5,0,t);
if t < vt_logskift then
skiftetid:= systid(dg,vt_logskift)
else
skiftetid:= systid(dg+1,vt_logskift);
message procedure vt_log side 6 - 920517/cl;
vent:
systime(1,0.0,nu); dg:= systime(5,0.0,t);
ventetid:= round(skiftetid - nu);
if ventetid < 1 then ventetid:= 1;
<*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
systime(1,0.0,nu); dg:=systime(4,nu,t);
if op <> 0 then
begin
tofrom(dp,d.op.data,16);
signalch(cs_vt_logpool,op,vt_optype);
end;
if -, vt_log_aktiv then goto vent;
disable if (op=0) or (nu > skiftetid) then
begin
if fil_åben then
begin
dp1.v_tid:= systid(dg,vt_logskift);
dp1.v_kode:= 1;
if (vt_logtail(10)//32) >= vt_logtail(1) then
begin
if udvid_fil then
skriv_post(dp1);
end
else
skriv_post(dp1);
end;
if (op=0) or (nu > skiftetid) then
skiftetid:= skiftetid + 24*60*60.0;
sletsendte;
if ny_fil then
begin
if udvid_fil then
begin
vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
dp1.v_kode:= 0;
skriv_post(dp1);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
disable if op<>0 and fil_åben then
begin
if (vt_logtail(10)//32) >= vt_logtail(1) then
begin
if -, udvid_fil then
begin
if ny_fil then
begin
if udvid_fil then
begin
systime(1,0.0,dp1.v_tid);
vt_logstart:= dp1.v_tid;
dp1.v_kode:= 0;
skriv_post(dp1);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
end;
if fil_åben then skriv_post(dp);
end;
goto vent;
vt_log_trap:
disable skriv_vt_log(zbillede,1);
end vt_log;
: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);
<* 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;
g_nr:= o_nr:= 0;
if tegn='!' then
begin
binær:= true;
readchar(z,tegn);
end;
if tegn='/' then <*garageid*>
begin
readchar(z,tegn); repeatchar(z);
if '0'<=tegn and tegn<='9' then
begin
read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
if g_nr<>0 then garageid:=bpl_navn(g_nr);
if g_nr<>0 and garageid=long<::> then
begin
fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
g_nr:= 0;
end;
end
else
begin
while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
begin
garageid:= garageid shift 8 + tegn;
readchar(z,tegn);
end;
while garageid shift (-40) extract 8 = 0 do
garageid:= garageid shift 8;
g_nr:= find_bpl(garageid);
if g_nr=0 then
fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
end;
repeatchar(z); readchar(z,tegn);
end;
if tegn=';' then
begin
readchar(z,tegn); repeatchar(z);
if '0'<=tegn and tegn<='9' then
begin
read(z,o_nr);
if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
if o_nr<>0 then omr:= område_navn(o_nr);
if o_nr<>0 and omr=long<::> then
begin
fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
o_nr:= 0;
end;
end
else
begin
while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
begin
omr:= omr shift 8 + tegn;
readchar(z,tegn);
end;
while omr shift (-40) extract 8 = 0 do
omr:= omr shift 8;
if omr=long<:TCT:> then omr:=long<:KBH:>;
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ådeidentifikation for bus:>,1);
end;
repeatchar(z); readchar(z,tegn);
end;
if o_nr=0 then o_nr:= 3;
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*>
message vogntabel initialisering side 3a -920517/cl;
<* initialisering for vt_log *>
v_tid:= 4;
v_kode:= 6;
v_bus:= 8;
v_ll1:= 10;
v_ll2:= 12;
v_tekst:= 6;
for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
if vt_log_aktiv then
begin
integer i;
real t;
integer array field iaf;
integer array
tail(1:10),ia(1:10),chead(1:20);
open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
i:= monitor(42)lookup_entry:(zvtlog,0,tail);
if i=0 then
i:=monitor(52)create_areaproc:(zvtlog,0,ia);
if i=0 then
begin
i:=monitor(8)reserve_process:(zvtlog,0,ia);
monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if i=0 then
begin
iaf:= 2;
tofrom(vt_logdisc,tail.iaf,8);
i:=slices(vt_logdisc,0,tail,chead);
if i > (-2048) then
begin
vt_log_slicelgd:= chead(15);
i:= 0;
end;
end;
if i=0 then
begin
open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
i:=monitor(42)lookup_entry:(zvtlog,0,tail);
if i=0 then
i:= monitor(52)create_areapproc:(zvtlog,0,ia);
if i=0 then
begin
i:=monitor(8)reserve_process:(zvtlog,0,ia);
monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if i<>0 then
begin
for i:= 1 step 1 until 10 do tail(i):= 0;
tail(1):= 1;
iaf:= 2;
tofrom(tail.iaf,vt_logdisc,8);
tail(6):=systime(7,0,t);
i:=monitor(40)create_entry:(zvtlog,0,tail);
if i=0 then
i:=monitor(50)permanent_entry:(zvtlog,3,ia);
end;
end;
if i<>0 then vt_log_aktiv:= false;
end;
\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*>
cs_vt_log:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
<*-3*>
cs_vt_logpool:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
<*-3*>
vt_op:= nextop(vt_op_længde);
signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
vt_logop(1):= nextop(vt_op_længde);
signalch(cs_vt_logpool,vt_logop(1),vt_optype);
vt_logop(2):= nextop(vt_op_længde);
signalch(cs_vt_logpool,vt_logop(2),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*>
i:=nextcoru(507, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
j:=newactivity(i,
0,
vt_log);
<*+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;
write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
skriv_vt_variable(zbillede);
p_vogntabel(zbillede);
p_gruppetabel(zbillede);
p_springtabel(zbillede);
▶EOF◀