|
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: 96768 (0x17a00)
Types: TextFile
Names: »htio «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »htio «
io.
:1: io: parametererklæringer
message io_parametererklæringer side 1 - 820301/hko;
:2: io: parameterinitialisering
message io_parameterinitialisering side 1 - 810421/hko;
:3: io: claiming
\f
message io_claiming side 1 - 810421/hko;
max_coru:= max_coru
+ 1 <* hovedmodul io *>
+ 1 <* io kommando *>
+ 1 <* io operatørmeddelelser *>
+ 1 <* io spontane meddelelser *>
+ 1 <* io spoolkorutine *>
+ 1 <* io tællernulstilling *>
;
max_semch:= max_semch
+ 1 <* cs_io *>
+ 1 <* cs_io_komm *>
+ 1 <* cs_io_fil *>
+ 1 <* cs_io_medd *>
+ 1 <* cs_io_spool *>
+ 1 <* cs_io_nulstil *>
;
max_sem:= max_sem
+ 1 <* ss_io_spool_fulde *>
+ 1 <* ss_io_spool_tomme *>
+ 1; <* bs_zio_adgang *>
max_op:=max_op
+ 1; <* fil-operation *>
max_nettoop:=max_nettoop
+ (data+18); <* fil-operation *>
:4: io: erklæringer
\f
message io_erklæringer side 1 - 810421/hko;
integer
cs_io,
cs_io_komm,
cs_io_fil,
cs_io_spool,
cs_io_medd,
cs_io_nulstil,
ss_io_spool_tomme,
ss_io_spool_fulde,
bs_zio_adgang,
io_spool_fil,
io_spool_postantal,
io_spool_postlængde;
integer array field
io_spool_post;
zone z_io(32,1,io_fejl);
procedure io_fejl(z,s,b);
integer s,b;
zone z;
begin
disable begin
integer array iz(1:20);
integer i,j,k;
integer array field iaf;
real array field raf;
if s<>(1 shift 21 + 2) then
begin
getzone6(z,iz);
raf:=2;
iaf:=0;
k:=1;
j:= terminal_tab.iaf.terminal_tilstand;
if j shift(-21)<>6 then
fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
1 shift 12 <*binært*> +1 <*fortsæt*>);
terminal_tab.iaf.terminal_tilstand:= 6 shift 21
+ terminal_tab.iaf.terminal_tilstand extract 21;
end;
z(1):=real <:<'?'><'?'><'em'>:>;
b:=2;
end; <*disable*>
end io_fejl;
\f
message procedure skriv_auto_spring_medd side 1 - 820301/hko;
procedure skriv_auto_spring_medd(z,medd,tid);
value tid;
zone z;
real tid;
integer array medd;
begin
disable begin
real t;
integer kode,bus,linie,bogst,løb,dato,kl;
long array indeks(1:1);
kode:= medd(1);
indeks(1):= extend medd(5) shift 24;
if kode > 0 and kode < 10 then
begin
write(z,"nl",0,<:-<'>'>:>,case kode of(
<*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
<*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
<*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
<*4*><:vogn optaget:>, <* - i - - / - *>
<*5*><:spring annulleret:>, <*udløb af ventetid *>
<*6*><::>, <* - af springliste *>
<*7*><::>, <*start af springsekvens *>
<*8*><::>, <*afvikling af springsekvens *>
<*9*><:område kan ikke opdateres:>,<*vt-ændring*>
<::>));
<* if kode = 5 then
begin
bogst:= medd(4);
linie:= bogst shift(-5) extract 10;
bogst:= bogst extract 5;
if bogst > 0 then bogst:= bogst +'A'-1;
write(z,"sp",1,<<z>,linie,false add bogst,1,
".",1,indeks);
end;
*>
outchar(z,'sp');
bus:= medd(2) extract 14;
if bus > 0 then
write(z,<<z>,bus,"/",1);
løb:= medd(3);
<*+4*> if løb shift(-22) <> 1 and løb <> 0 then
fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
<*-4*>
\f
message procedure skriv_auto_spring_medd side 2 - 810507/hko;
linie:= løb shift(-12) extract 10;
bogst:= løb shift(-7) extract 5;
if bogst > 0 then bogst:= bogst +'A'-1;
løb:= løb extract 7;
if medd(3) <> 0 or kode <> 5 then
begin
write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
if kode = 5 or kode = 6 then write(z,<:er frit :>);
end;
if kode = 7 or kode = 8 then
write(z,<*indeks,"sp",1,*>
if kode=7 then <:udtaget :> else <:indsat :>);
dato:= systime(4,tid,t);
kl:= t/100.0;
løb:= replace_char(1<*space in number*>,'.');
write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
replace_char(1,løb);
end
else <*kode < 1 or kode > 8*>
fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
end; <*disable*>
end skriv_auto_spring_medd;
\f
message procedure h_io side 1 - 810507/hko;
<* hovedmodulkorutine for io *>
procedure h_io;
begin
integer array field op_ref;
integer k,dest_sem;
procedure skriv_hio(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ hovedmodul io :>);
if omfang>0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: op_ref: :>,op_ref,"nl",1,
<: k: :>,k,"nl",1,
<: dest_sem: :>,dest_sem,"nl",1,
<::>);
skriv_coru(zud,coru_no(100));
slut:
end;
end skriv_hio;
trap(hio_trap);
stack_claim(if cm_test then 198 else 146);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_hio(out,0);
<*-2*>
\f
message procedure h_io side 2 - 810507/hko;
repeat
wait_ch(cs_io,op_ref,true,-1);
<*+4*>
if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
<*-4*>
k:=d.op_ref.opkode extract 12;
dest_sem:=
if k = 0 <*attention*> then cs_io_komm else
if k = 22 <*auto vt opdatering*>
or k = 23 <*generel meddelelse*>
or k = 36 <*spring meddelelse*>
or k = 44 <*udeladt i gruppeopkald*>
or k = 45 <*nødopkald modtaget*>
or k = 46 <*nødopkald besvaret*> then cs_io_spool else
if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
0;
<*+4*>
if dest_sem = 0 then
begin
fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end
else
<*-4*>
begin
signal_ch(dest_sem,op_ref,d.op_ref.optype);
end;
until false;
hio_trap:
disable skriv_hio(zbillede,1);
end h_io;
\f
message procedure io_komm side 1 - 810507/hko;
procedure io_komm;
begin
integer array field op_ref,ref,vt_op,iaf;
integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
pos,indeks,sep,sluttegn,operatør,i,j,k;
long navn;
procedure skriv_io_komm(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable
write(zud,"nl",1,<:+++ io_komm :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: op-ref: :>,op_ref,"nl",1,
<: kode: :>,kode,"nl",1,
<: aktion: :>,aktion,"nl",1,
<: ref: :>,ref,"nl",1,
<: vt_op: :>,vt_op,"nl",1,
<: status: :>,status,"nl",1,
<: opgave: :>,opgave,"nl",1,
<: dest-sem: :>,dest_sem,"nl",1,
<: iaf: :>,iaf,"nl",1,
<: i: :>,i,"nl",1,
<: j: :>,j,"nl",1,
<: k: :>,k,"nl",1,
<: navn: :>,string navn,"nl",1,
<: pos: :>,pos,"nl",1,
<: indeks: :>,indeks,"nl",1,
<: sep: :>,sep,"nl",1,
<: sluttegn: :>,sluttegn,"nl",1,
<: vogn: :>,vogn,"nl",1,
<: ll: :>,ll,"nl",1,
<: omr: :>,omr,"nl",1,
<: operatør: :>,operatør,"nl",1,
<::>);
skriv_coru(zud,coru_no(101));
slut:
end;
end skriv_io_komm;
\f
message procedure io_komm side 2 - 810424/hko;
trap(io_komm_trap);
stack_claim((if cm_test then 200 else 146)+24+200);
ref:=0;
navn:= long<::>;
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_komm(out,0);
<*-2*>
repeat
<*V*> wait_ch(cs_io_komm,
op_ref,
true,
-1<*timeout*>);
<*+2*>
if testbit1 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
<: til io :>);
skriv_op(out,op_ref);
end;
<*-2*>
kode:= d.op_ref.op_kode;
i:= terminal_tab.ref.terminal_tilstand;
status:= i shift(-21);
opgave:=
if kode=0 then 1 <* indlæs kommando *> else
0; <* afvises *>
aktion:= if opgave = 0 then 0 else
(case status +1 of(
<* status *>
<* 0 klar *>(1),
<* 1 - *>(-1),<* ulovlig tilstand *>
<* 2 - *>(-1),<* ulovlig tilstand *>
<* 3 stoppet *>(2),
<* 4 noneksist *>(-1),<* ulovlig tilstand *>
<* 5 - *>(-1),<* ulovlig tilstand *>
<* 6 - *>(-1),<* ulovlig tilstand *>
<* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
-1));
\f
message procedure io_komm side 3 - 810428/hko;
case aktion+6 of
begin
begin
<*-5: terminal optaget *>
d.op_ref.resultat:= 16;
afslut_operation(op_ref,-1);
end;
begin
<*-4: operation uden virkning *>
afslut_operation(op_ref,-1);
end;
begin
<*-3: ulovlig operationskode *>
fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
afslut_operation(op_ref,-1);
end;
begin
<*-2: ulovlig aktion *>
fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
afslut_operation(op_ref,-1);
end;
begin
<*-1: ulovlig io_tilstand *>
fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
afslut_operation(op_ref,-1);
end;
begin
<* 0: ikke implementeret *>
fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
afslut_operation(op_ref,-1);
end;
begin
\f
message procedure io_komm side 4 - 851001/cl;
<* 1: indlæs kommando *>
<*V*> wait(bs_zio_adgang);
<*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
if d.op_ref.resultat > 3 then
begin
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,pos,
d.op_ref.resultat);
end
else if d.op_ref.resultat>0 then
begin <*godkendt*>
kode:=d.op_ref.opkode;
i:= kode extract 12;
j:= if kode < 5 or
kode=7 or kode=8 or
kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
kode=20 or kode=24 then 4<*VO,F/VO,R*>else
if kode =21 then 5 <*AU*> else
if kode =25 then 6 <*GR,D*> else
if kode =26 then 5 <*GR,S*> else
if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
if kode =30 then 10 <*SP,D*> else
if kode =31 then 5 <*SP*> else
if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
if kode=71 then 11 <*FO,V*> else
if kode =75 then 12 <*TÆ,V *>else
if kode =76 then 12 <*TÆ,N *>else
if kode =65 then 13 <*BE,N *>else
if kode =66 then 14 <*BE,G *>else
if kode =67 then 15 <*BE,V *>else
if kode =68 then 16 <*ST,D *>else
if kode =69 then 17 <*ST,V *>else
if kode =36 then 18 <*AL *>else
if kode =37 then 19 <*CC *>else
if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
0;
if j > 0 then
begin
case j of
begin
begin
\f
message procedure io_komm side 5 - 810424/hko;
<* 1: inkluder/ekskluder ydre enhed *>
d.op_ref.retur:= cs_io_komm;
if kode=1 then d.opref.opkode:=
ia(2) shift 12 + d.opref.opkode extract 12;
d.op_ref.data(1):= ia(1);
signal_ch(if kode < 5 or kode>=72 then cs_rad
else cs_gar,
op_ref,gen_optype or io_optype);
indeks:= op_ref;
wait_ch(cs_io_komm,
op_ref,
true,
-1<*timeout*>);
<*+4*> if op_ref <> indeks then
fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,
d.op_ref.resultat);
end;
begin
\f
message procedure io_komm side 6 - 810501/hko;
<* 2: tid/attention,ja/attention,nej
slut/slut med billede *>
case d.op_ref.opkode -79 of
begin
<* 80: TI *> begin
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
if ia(1) <> 0 or ia(2) <> 0 then
begin real field rf;
rf:= 4;
trap(forbudt);
<*V*> setposition(z_io,0,0);
systime(3,ia.rf,0.0);
if false then
begin
forbudt: skriv_kvittering(z_io,0,-1,
43<*ændring af dato/tid ikke lovlig*>);
end
else
skriv_kvittering(z_io,0,-1,3);
end
else
begin
setposition(z_io,0,0);
write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
end;
end TI;
\f
message procedure io_komm side 7 - 810424/hko;
<*81: AT,J*> begin
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(zio,'nl');
monitor(10)release process:(z_io,0,ia);
skriv_kvittering(z_io,0,-1,3);
end;
<* 82: AT,N*> begin
i:= monitor(8)reserve process:(z_io,0,ia);
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(zio,'nl');
skriv_kvittering(z_io,0,-1,
if i = 0 then 3 else 0);
end;
<* 83: SL *> begin
errorbits:=0; <* warning.no ok.yes *>
trapmode:= 1 shift 13;
trap(-2);
end;
<* 84: SL,B *>begin
errorbits:=1; <* warning.no ok.no *>
trap(-3);
end;
<* 85: SL,K *>begin
errorbits:=1; <* warning.no ok.no *>
disable sæt_bit_i(trapmode,15,0);
trap(-3);
end;
\f
message procedure io_komm side 7a - 810511/cl;
<* 86: TE,J *>begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
for i:= 1 step 1 until indeks do
if 0<=ia(i) and ia(i)<=47 then
begin
case (ia(i)+1) of
begin
testbit0 := true;testbit1 := true;testbit2 := true;
testbit3 := true;testbit4 := true;testbit5 := true;
testbit6 := true;testbit7 := true;testbit8 := true;
testbit9 := true;testbit10:= true;testbit11:= true;
testbit12:= true;testbit13:= true;testbit14:= true;
testbit15:= true;testbit16:= true;testbit17:= true;
testbit18:= true;testbit19:= true;testbit20:= true;
testbit21:= true;testbit22:= true;testbit23:= true;
testbit24:= true;testbit25:= true;testbit26:= true;
testbit27:= true;testbit28:= true;testbit29:= true;
testbit30:= true;testbit31:= true;testbit32:= true;
testbit33:= true;testbit34:= true;testbit35:= true;
testbit36:= true;testbit37:= true;testbit38:= true;
testbit39:= true;testbit40:= true;testbit41:= true;
testbit42:= true;testbit43:= true;testbit44:= true;
testbit45:= true;testbit46:= true;testbit47:= true;
end;
end;
skriv_kvittering(z_io,0,-1,3);
end;
\f
message procedure io_komm side 7b - 810511/cl;
<* 87: TE,N *>begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
for i:= 1 step 1 until indeks do
if 0<=ia(i) and ia(i)<=47 then
begin
case (ia(i)+1) of
begin
testbit0 := false;testbit1 := false;testbit2 := false;
testbit3 := false;testbit4 := false;testbit5 := false;
testbit6 := false;testbit7 := false;testbit8 := false;
testbit9 := false;testbit10:= false;testbit11:= false;
testbit12:= false;testbit13:= false;testbit14:= false;
testbit15:= false;testbit16:= false;testbit17:= false;
testbit18:= false;testbit19:= false;testbit20:= false;
testbit21:= false;testbit22:= false;testbit23:= false;
testbit24:= false;testbit25:= false;testbit26:= false;
testbit27:= false;testbit28:= false;testbit29:= false;
testbit30:= false;testbit31:= false;testbit32:= false;
testbit33:= false;testbit34:= false;testbit35:= false;
testbit36:= false;testbit37:= false;testbit38:= false;
testbit39:= false;testbit40:= false;testbit41:= false;
testbit42:= false;testbit43:= false;testbit44:= false;
testbit45:= false;testbit46:= false;testbit47:= false;
end;
end;
skriv_kvittering(z_io,0,-1,3);
end;
<* 88: O *> begin
integer array odescr,zdescr(1:20);
long array field laf;
integer res, i, j;
i:= j:= 1;
while læstegn(ia,i,res)<>0 do
begin
if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
skrivtegn(ia,j,res);
end;
laf:= 2;
getzone6(out,odescr);
getzone6(z_io,zdescr);
close(out,zdescr.laf(1)<>odescr.laf(1) or
zdescr.laf(2)<>odescr.laf(2));
laf:= 0;
if ia(1)=0 then
begin
res:= 3;
j:= 0;
end
else
begin
j:= res:= openbs(out,j,ia,0);
if res<>0 then
res:= 46;
end;
if res<>0 then
begin
open(out,8,konsol_navn,0);
if j<>0 then
begin
i:= 1;
fejlreaktion(4,j,string ia.laf(increase(i)),1);
end;
end
else res:= 3;
setposition(z_io,0,0);
skriv_kvittering(z_io,0,-1,res);
end;
end;<*case d.op_ref.opkode -79*>
end;<*case 2*>
begin
\f
message procedure io_komm side 8 - 810424/hko;
<* 3: vogntabel,linienr/-,busnr*>
d.op_ref.retur:= cs_io_komm;
tofrom(d.op_ref.data,ia,10);
indeks:= op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
wait_ch(cs_io_komm,
op_ref,
io_optype,
-1<*timeout*>);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:io operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if indeks <> op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
<*-4*>
i:=d.op_ref.resultat;
if i<1 or i>3 then
begin
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end
else
begin
\f
message procedure io_komm side 9 - 820301/hko,cl;
integer antal,filref;
antal:= d.op_ref.data(6);
fil_ref:= d.op_ref.data(7);
pos:= 0;
<*V*> setposition(zio,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
for pos:= pos +1 while pos <= antal do
begin
integer bogst,løb;
disable i:= læsfil(fil_ref,pos,j);
if i <> 0 then
fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
vogn:= fil(j,1) shift (-24) extract 24;
løb:= fil(j,1) extract 24;
if d.op_ref.opkode=9 then
begin i:=vogn; vogn:=løb; løb:=i; end;
ll:= løb shift(-12) extract 10;
bogst:= løb shift(-7) extract 5;
if bogst > 0 then bogst:= bogst+'A'-1;
løb:= løb extract 7;
vogn:= vogn extract 14;
i:= d.op_ref.opkode -8;
for i:= i,i +1 do
begin
j:= (i+1) extract 1;
case j+1 of
begin
write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
false add bogst,1,"/",1,true,3,<<d>,løb);
write(zio,<<dddd>,vogn,"sp",1);
end;
end;
if pos mod 5 = 0 then
begin
outchar(zio,'nl');
<*V*> setposition(zio,0,0);
end
else write(zio,"sp",3);
end;
write(zio,"*",1);
\f
message procedure io_komm side 9a - 810505/hko;
d.op_ref.opkode:=104;<*slet fil*>
d.op_ref.data(4):=filref;
indeks:=op_ref;
signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:io operation retur fra sletfil:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
<*-4*>
if d.op_ref.data(9)<>0 then
fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
<:io-komm, sletfil:>,1);
end;
end;
begin
\f
message procedure io_komm side 10 - 820301/hko;
<* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
vogn:=ia(1);
ll:=ia(2);
omr:= if kode=11 or kode=19 then ia(3) else
if kode=12 then ia(2) else 0;
if kode=19 and omr<=0 then
begin
if omr=-1 then omr:= 0
else omr:= 14 shift 20 + 3; <*OMR TCT*>
end;
<*V*> wait_ch(cs_vt_adgang,
vt_op,
gen_optype,
-1<*timeout sek*>);
start_operation(vtop,101,cs_io_komm,
kode);
d.vt_op.data(1):=vogn;
d.vt_op.data(2):=ll;
d.vt_op.data(if kode=19 then 3 else 4):= omr;
indeks:= vt_op;
signal_ch(cs_vt,
vt_op,
gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,
vt_op,
io_optype,
-1<*timeout sek*>);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,
<:iooperation retur fra vt:>);
skriv_op(out,vt_op);
end;
<*-2*>
<*+4*> if vt_op<>indeks then
fejl_reaktion(11<*fremmede op*>,op_ref,
<:io-kommando:>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
d.vt_op.resultat = 12 then d.vt_op.data(3)
else vt_op,-1,d.vt_op.resultat);
d.vt_op.optype:= genoptype or vt_optype;
disable afslut_operation(vt_op,cs_vt_adgang);
end;
begin
\f
message procedure io_komm side 11 - 810428/hko;
<* 5 autofil-skift
gruppe,slet
spring (igangsæt)
spring,annuler
spring,reserve *>
tofrom(d.op_ref.data,ia,8);
d.op_ref.retur:=cs_io_komm;
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,
op_ref,
io_optype,
-1<*timeout*>);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:io operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if indeks<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io-kommando(autofil):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
d.op_ref.resultat=12) and kode=34 <*SP,R*> then
d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
end;
begin
\f
message procedure io_komm side 12 - 820301/hko/cl;
<* 6 gruppedefinition *>
tofrom(d.op_ref.data,ia,indeks*2);
<*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
start_operation(vt_op,101,cs_io_komm,
101<*opret fil*>);
d.vt_op.data(1):=256;<*postantal*>
d.vt_op.data(2):=1; <*postlængde*>
d.vt_op.data(3):=1; <*segmentantal*>
d.vt_op.data(4):=
2 shift 10; <*spool fil*>
signal_ch(cs_opret_fil,vt_op,io_optype);
pos:=vt_op;<*variabel lånes*>
<*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
<*+4*> if vt_op<>pos then
fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
if d.vt_op.data(9)<>0 then
fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
<:io-kommando(gruppedefinition):>,0);
<*-4*>
iaf:=0;
for i:=1 step 1 until indeks-1 do
begin
disable k:=modif_fil(d.vt_op.data(4),i,j);
if k<>0 then
fejlreaktion(7<*modif-fil*>,k,
<:io kommando(gruppe-def):>,0);
fil(j).iaf(1):=d.op_ref.data(i+1);
end;
while sep = ',' do
begin
wait(bs_fortsæt_adgang);
pos:= 1; j:= 0;
while læs_store(z_io,i) < 8 do
begin
skrivtegn(fortsæt,pos,i);
if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
end;
skrivtegn(fortsæt,pos,'em');
afsluttext(fortsæt,pos);
sluttegn:= i;
if j<>0 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(zio,opref,-1,53);<*annulleret*>
goto gr_ann;
end;
\f
message procedure io_komm side 13 - 810512/hko/cl;
disable begin
integer array værdi(1:4);
integer a_pos,res;
pos:= 0;
repeat
apos:= pos;
læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
if res >= 0 then
begin
if res=0 and (sep=',' or indeks>2) then <*ok*>
else if res=0 then res:= -25 <*parameter mangler*>
else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
res:= -7 <*busnr ulovligt*>
else if res=2 or res=6 then
begin
k:=modiffil(d.vt_op.data(4),indeks,j);
if k<>0 then fejlreaktion(7<*modiffil*>,k,
<:io kommando(gruppe-def):>,0);
iaf:= 0;
fil(j).iaf(1):= værdi(1) +
(if res=6 then 1 shift 22 else 0);
indeks:= indeks+1;
if sep = ',' then res:= 0;
end
else res:= -27; <*parametertype*>
end;
if res>0 then pos:= a_pos;
until sep<>'sp' or res<=0;
if res<0 then
begin
d.op_ref.resultat:= -res;
i:=1;
hægt_tekst(d.op_ref.data,i,fortsæt,1);
afsluttext(d.op_ref.data,i);
end;
end;
\f
message procedure io_komm side 13a - 810512/hko/cl;
if d.op_ref.resultat > 3 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
goto gr_ann;
end;
signalbin(bs_fortsæt_adgang);
end while sep = ',';
d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
k:= sætfildim(d.vt_op.data);
if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
signalch(cs_io_fil,vt_op,io_optype or gen_optype);
d.op_ref.retur:=cs_io_komm;
pos:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if pos<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io kommando(gruppedef retur fra vt):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
if false then
begin
gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
waitch(cs_io_komm,vt_op,io_optype,-1);
signalch(cs_io_fil,vt_op,io_optype or vt_optype);
end;
end;
begin
\f
message procedure io_komm side 14 - 810525/hko/cl;
<* 7 gruppe(-oversigts-)rapport *>
d.op_ref.retur:=cs_io_komm;
d.op_ref.data(1):=ia(1);
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io-kommando(gruppe-rapport):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
if d.op_ref.resultat<>3 then
begin
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end
else
begin
integer bogst,løb;
if kode = 27 then <* gruppe,vis *>
begin
<*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
"G",1,<<z>,d.op_ref.data(1) extract 7,
"sp",2,"-",5,"nl",1);
\f
message procedure io_komm side 15 - 820301/hko;
for pos:=1 step 1 until d.op_ref.data(2) do
begin
disable i:=læsfil(d.op_ref.data(3),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io_kommando(gruppe,vis):>,0);
iaf:=0;
vogn:=fil(j).iaf(1);
if vogn shift(-22) =0 then
write(z_io,<<ddddddd>,vogn extract 14)
else
begin
løb:=vogn extract 7;
bogst:=vogn shift(-7) extract 5;
if bogst>0 then bogst:=bogst+'A'-1;
ll:=vogn shift(-12) extract 10;
write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
false add bogst,1,"/",1,true,3,<<d>,løb);
end;
if pos mod 8 =0 then outchar(z_io,'nl')
else write(z_io,"sp",2);
end;
write(z_io,"*",1);
\f
message procedure io_komm side 16 - 810512/hko/cl;
end
else if kode=28 then <* gruppe,oversigt *>
begin
write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
"sp",2,"-",5,"nl",2);
for pos:=1 step 1 until d.op_ref.data(1) do
begin
disable i:=læsfil(d.op_ref.data(2),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io-kommando(gruppe-oversigt):>,0);
iaf:=0;
ll:=fil(j).iaf(1);
write(z_io,"G",1,<<z>,true,3,ll extract 7);
if pos mod 10 =0 then outchar(z_io,'nl')
else write(z_io,"sp",3);
end;
write(z_io,"*",1);
end;
<* slet fil *>
d.op_ref.opkode:= 104;
d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
end; <* resultat=3 *>
end;
begin
\f
message procedure io_komm side 17 - 810525/cl;
<* 8 spring(-oversigts-)rapport *>
d.op_ref.retur:=cs_io_komm;
tofrom(d.op_ref.data,ia,4);
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io-kommando(spring-rapport):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
if d.op_ref.resultat<>3 then
begin
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end
else
begin
boolean p_skrevet;
integer bogst,løb;
if kode = 32 then <* spring,vis *>
begin
ll:= d.op_ref.data(1) shift (-5) extract 10;
bogst:= d.op_ref.data(1) extract 5;
if bogst<>0 then bogst:= bogst + 'A' - 1;
<*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
<<d>,ll,false add bogst,(bogst<>0) extract 1,
<:.:>,string (extend d.op_ref.data(2) shift 24));
raf:= data+8;
if d.op_ref.raf(1)<>0.0 then
write(z_io,<:, startet :>,<<zddddd>,round
systime(4,d.op_ref.raf(1),r),<:.:>,round r)
else
write(z_io,<:, ikke startet:>);
write(z_io,"sp",2,"-",5,"nl",1);
\f
message procedure io_komm side 18 - 810518/cl;
p_skrevet:= false;
for pos:=1 step 1 until d.op_ref.data(3) do
begin
disable i:=læsfil(d.op_ref.data(4),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io_kommando(spring,vis):>,0);
iaf:=0;
i:= fil(j).iaf(1);
if i < 0 and -, p_skrevet then
begin
outchar(z_io,'('); p_skrevet:= true;
end;
if i > 0 and p_skrevet then
begin
outchar(z_io,')'); p_skrevet:= false;
end;
if pos mod 2 = 0 then
write(z_io,<< dd>,abs i,<:.:>)
else
write(z_io,true,3,<<d>,abs i);
if pos mod 21 = 0 then outchar(z_io,'nl');
end;
write(z_io,"*",1);
\f
message procedure io_komm side 19 - 810525/cl;
end
else if kode=33 then <* spring,oversigt *>
begin
write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
"sp",2,"-",5,"nl",2);
for pos:=1 step 1 until d.op_ref.data(1) do
begin
disable i:=læsfil(d.op_ref.data(2),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io-kommando(spring-oversigt):>,0);
iaf:=0;
ll:=fil(j).iaf(1) shift (-5) extract 10;
bogst:=fil(j).iaf(1) extract 5;
if bogst<>0 then bogst:=bogst + 'A' - 1;
write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
string (extend fil(j).iaf(2) shift 24));
if fil(j,2)<>0.0 then
write(z_io,<:startet :>,<<zddddd>,
round systime(4,fil(j,2),r),<:.:>,round r);
outchar(z_io,'nl');
end;
write(z_io,"*",1);
end;
<* slet fil *>
d.op_ref.opkode:= 104;
if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
end; <* resultat=3 *>
end;
begin
\f
message procedure io_komm side 20 - 820302/hko;
<* 9 fordeling af linier/områder på operatører *>
d.op_ref.retur:=cs_io_komm;
disable
if kode=5 then
begin
integer array io_linietabel(1:max_linienr//3+1);
for ref:= 0 step 512 until (max_linienr//768*512) do
begin
i:= læs_fil(1035,ref//512+1,j);
if i <> 0 then
fejlreaktion(5,i,<:liniefordelingstabel:>,0);
tofrom(io_linietabel.ref,fil(j),
if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
else ((max_linienr+1 - (ref//2*3))+2)//3*2);
end;
ref:=0;
operatør:=ia(1);
for j:=2 step 1 until indeks do
begin
ll:=ia(j);
if ll<>0 then
skrivtegn(io_linietabel,abs(ll)+1,
if ll>0 then operatør else 0);
end;
for ref:= 0 step 512 until (max_linienr//768*512) do
begin
i:= skriv_fil(1035,ref//512+1,j);
if i <> 0 then
fejlreaktion(6,i,<:liniefordelingstabel:>,0);
tofrom(fil(j),io_linietabel.ref,
if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
);
end;
ref:=0;
end
else
begin
modiffil(1034,1,i);
ref:=0;
operatør:=ia(1);
for j:=2 step 1 until indeks do
begin
ll:=ia(j);
fil(i).ref(ll):= if ll>0 then operatør else 0;
end;
end;
indeks:=op_ref;
signal_ch(cs_rad,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fr.post*>,op_ref,
<:io-komm,liniefordeling retur fra rad:>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end;
begin
\f
message procedure io_komm side 21 - 820301/cl;
<* 10 springdefinition *>
tofrom(d.op_ref.data,ia,indeks*2);
<*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
start_operation(vt_op,101,cs_io_komm,
101<*opret fil*>);
d.vt_op.data(1):=128;<*postantal*>
d.vt_op.data(2):=2; <*postlængde*>
d.vt_op.data(3):=1; <*segmentantal*>
d.vt_op.data(4):=
2 shift 10; <*spool fil*>
signal_ch(cs_opret_fil,vt_op,io_optype);
pos:=vt_op;<*variabel lånes*>
<*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
<*+4*> if vt_op<>pos then
fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
if d.vt_op.data(9)<>0 then
fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
<:io-kommando(springdefinition):>,0);
<*-4*>
iaf:=0;
for i:=1 step 1 until indeks-2 do
begin
disable k:=modif_fil(d.vt_op.data(4),i,j);
if k<>0 then
fejlreaktion(7<*modif-fil*>,k,
<:io kommando(spring-def):>,0);
fil(j).iaf(1):=d.op_ref.data(i+2);
end;
while sep = ',' do
begin
wait(bs_fortsæt_adgang);
pos:= 1; j:= 0;
while læs_store(z_io,i) < 8 do
begin
skrivtegn(fortsæt,pos,i);
if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
end;
skrivtegn(fortsæt,pos,'em');
afsluttext(fortsæt,pos);
sluttegn:= i;
if j<>0 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
goto sp_ann;
end;
\f
message procedure io_komm side 22 - 810519/cl;
disable begin
integer array værdi(1:4);
integer a_pos,res;
pos:= 0;
repeat
apos:= pos;
læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
if res >= 0 then
begin
if res=0 and (sep=',' or indeks>2) then <*ok*>
else if res=0 then res:= -25 <*parameter mangler*>
else if res=10 and (værdi(1)<1 or værdi(1)>99) then
res:= -44 <*intervalstørrelse ulovlig*>
else if res=10 and (værdi(2)<1 or værdi(2)>99) then
res:= -6 <*løbnr ulovligt*>
else if res=10 then
begin
k:=modiffil(d.vt_op.data(4),indeks-1,j);
if k<>0 then fejlreaktion(7<*modiffil*>,k,
<:io kommando(spring-def):>,0);
iaf:= 0;
fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
indeks:= indeks+1;
if sep = ',' then res:= 0;
end
else res:= -27; <*parametertype*>
end;
if res>0 then pos:= a_pos;
until sep<>'sp' or res<=0;
if res<0 then
begin
d.op_ref.resultat:= -res;
i:=1;
hægt_tekst(d.op_ref.data,i,fortsæt,1);
afsluttext(d.op_ref.data,i);
end;
end;
\f
message procedure io_komm side 23 - 810519/cl;
if d.op_ref.resultat > 3 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
goto sp_ann;
end;
signalbin(bs_fortsæt_adgang);
end while sep = ',';
d.vt_op.data(1):= indeks-2;
k:= sætfildim(d.vt_op.data);
if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
signalch(cs_io_fil,vt_op,io_optype or gen_optype);
d.op_ref.retur:=cs_io_komm;
pos:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if pos<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io kommando(springdef retur fra vt):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
if false then
begin
sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
waitch(cs_io_komm,vt_op,io_optype,-1);
signalch(cs_io_fil,vt_op,io_optype or vt_optype);
signalbin(bs_fortsæt_adgang);
end;
end;
begin
integer i,j,k,opr,lin,max_lin;
boolean o_ud, t_ud;
\f
message procedure io_komm side 23a - 820301/cl;
<* 11 fordelingsrapport *>
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
max_lin:= max_linienr;
for opr:= 1 step 1 until max_antal_operatører, 0 do
begin
o_ud:= t_ud:= false;
k:= 0;
if opr<>0 then
begin
j:= k:= 0;
for lin:= 1 step 1 until max_lin do
begin
læs_tegn(radio_linietabel,lin+1,i);
if i<>0 then j:= lin;
if opr=i and opr<>0 then
begin
if -, o_ud then
begin
o_ud:= true;
if opr<>0 then
write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
"sp",2,string bpl_navn(opr))
else
write(z_io,"nl",1,<:ikke fordelte:>);
end;
if -, t_ud then
begin
write(z_io,<:<'nl'> linier: :>);
t_ud:= true;
end;
k:=k+1;
if k>1 and k mod 10 = 1 then
write(z_io,"nl",1,"sp",13);
write(z_io,<<ddd >,lin);
end;
if lin=max_lin then max_lin:= j;
end;
end;
k:= 0; t_ud:= false;
for i:= 1 step 1 until max_antal_områder do
begin
if radio_områdetabel(i)= opr then
begin
if -, o_ud then
begin
o_ud:= true;
if opr<>0 then
write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
"sp",2,string bpl_navn(opr))
else
write(z_io,"nl",1,<:ikke fordelte:>);
end;
if -, t_ud then
begin
write(z_io,<:<'nl'> områder: :>);
t_ud:= true;
end;
k:= k+1;
if k>1 and k mod 10 = 1 then
write(z_io,"nl",1,"sp",13);
write(z_io,true,4,string område_navn(i));
end;
end;
if o_ud then write(z_io,"nl",1);
end;
write(z_io,"*",1);
end;
begin
integer omr,typ,sum;
integer array ialt(1:5);
real r;
\f
message procedure io_komm side 24 - 810501/hko;
<* 12 vis/nulstil opkaldstællere *>
if kode=76 and indeks=1 then
begin <* TÆ,N <tid> *>
if ia(1)<(-1) or 2400<ia(1) then
begin
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,64);
end
else
begin
if ia(1)=(-1) then nulstil_systællere:= -1
else nulstil_systællere:= (ia(1) mod 2400)*100;
opdater_tf_systællere;
typ:= opref; <* typ lånes til gemmevariabel *>
d.opref.retur:= cs_io_komm;
signal_ch(cs_io_nulstil,opref,io_optype);
<*V*> wait_ch(cs_io_komm,opref,io_optype,-1);
<*+4*> if opref <> typ then
fejlreaktion(11<*fremmed post*>,opref,
<:io_kommando:>,0);
<*-4*>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,3);
end;
end
else
begin
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,
<:område udgående alm.ind nød ind:>,
<: ind-ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_områder do
begin
sum:= 0;
write(z_io,true,6,string område_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
sum:= sum + opkalds_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4), ialt(5), "nl",3);
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,
<:oper. udgående alm.ind nød ind:>,
<: ind-ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_operatører do
begin
sum:= 0;
if bpl_navn(omr)=long<::> then
write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
else
write(z_io,true,6,string bpl_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
sum:= sum + operatør_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4),ialt(5),"nl",2);
typ:= replacechar(1,':');
write(z_io,<:tællere nulstilles :>);
if nulstil_systællere=(-1) then
write(z_io,<:ikke automatisk:>,"nl",1)
else
write(z_io,<:automatisk kl. :>,<<zd dd dd>,
nulstil_systællere,"nl",1);
replacechar(1,'.');
write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
systime(4,systællere_nulstillet,r));
replacechar(1,':');
write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
replacechar(1,typ);
write(z_io,"*",1,"nl",1);
setposition(z_io,0,0);
if kode = 76 <* nulstil tællere *> then
disable begin
for omr:= 1 step 1 until max_antal_områder*5 do
opkalds_tællere(omr):= 0;
for omr:= 1 step 1 until max_antal_operatører*5 do
operatør_tællere(omr):= 0;
systime(1,0.0,systællere_nulstillet);
opdater_tf_systællere;
typ:= replacechar(1,'.');
write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
systime(4,systællere_nulstillet,r));
replacechar(1,':');
write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
replacechar(1,typ);
setposition(z_io,0,0);
end;
end;
end;
begin
\f
message procedure io_komm side 25 - 940522/cl;
<* 13 navngiv betjeningsplads *>
boolean incl;
long field lf;
lf:=6;
operatør:= ia(1);
navn:= ia.lf;
incl:= false add (ia(4) extract 8);
if navn=long<::> then
begin
<* nedlæg navn - check for i brug *>
iaf:= operatør*terminal_beskr_længde;
if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
d.opref.resultat:= 48 <*i brug*>
else
begin
for i:= 65 step 1 until top_bpl_gruppe do
begin
iaf:= i*op_maske_lgd;
if læsbit_ia(bpl_def.iaf,operatør) then
d.opref.resultat:= 48<*i brug*>;
end;
end;
if d.opref.resultat <= 3 then
begin
for i:= 1 step 1 until sidste_bus do
if bustabel(i) shift (-14) extract 8 = operatør then
d.opref.resultat:= 48<*i brug*>;
end;
end
else
begin
<* opret/omdøb *>
i:= find_bpl(navn);
if i<>0 and i<>operatør then
d.opref.resultat:= 48 <*i brug*>;
end;
if d.opref.resultat<=3 then
begin
bpl_navn(operatør):= navn;
operatør_auto_include(operatør):= incl;
k:= modif_fil(tf_bpl_navne,operatør,ll);
if k<>0 then
fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
lf:= 4;
fil(ll).lf:= navn add (incl extract 8);
setposition(fil(ll),0,0);
<* skriv bplnavne *>
disable begin
zone z(128,1,stderror);
long array field laf;
integer array ia(1:10);
open(z,4,<:bplnavne:>,0);
laf:= 0;
outrec6(z,512);
for i:= 1 step 1 until 127 do
z.laf(i):= bpl_navn(i);
close(z,true);
monitor(42,z,0,ia);
ia(6):= systime(7,0,0.0);
monitor(44,z,0,ia);
end;
d.opref.resultat:= 3;<*udført*>
end;
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,d.opref.resultat);
end;
begin
\f
message procedure io_komm side 26 - 940522/cl;
<* 14 betjeningsplads - gruppe *>
integer ant_i_gruppe;
long field lf;
integer array maske(1:op_maske_lgd//2);
lf:= 4; ant_i_gruppe:= 0;
tofrom(maske,ingen_operatører,op_maske_lgd);
navn:= ia.lf;
operatør:= find_bpl(navn);
for i:= 3 step 1 until indeks do
if sætbit_ia(maske,ia(i),1)=0 then
ant_i_gruppe:= ant_i_gruppe+1;
if ant_i_gruppe=0 then
begin
<* slet gruppe *>
if operatør<=64 then
d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
else 62<*navn ulovligt*>)
else
begin
for i:= 1 step 1 until max_antal_operatører do
for j:= 1 step 1 until 3 do
if operatør_stop(i,j)=operatør then
d.opref.resultat:= 48<*i brug*>;
end;
navn:= long<::>;
end
else
begin
if 1<=operatør and operatør<=64 then
d.opref.resultat:= 62<*navn ulovligt*>
else
if operatør=0 then
begin
i:=65;
while i<=127 and operatør=0 do
begin
if bpl_navn(i)=long<::> then operatør:=i;
i:= i+1;
end;
if operatør=0 then
d.opref.resultat:= 32<*ikke plads*>
else if operatør>top_bpl_gruppe then
top_bpl_gruppe:= operatør;
end;
end;
if d.opref.resultat<=3 then
begin
bpl_navn(operatør):= navn;
iaf:= operatør*op_maske_lgd;
tofrom(bpl_def.iaf,maske,op_maske_lgd);
bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
for i:= 1 step 1 until max_antal_operatører do
begin
if læsbit_ia(maske,i) then
begin
bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
if læsbit_ia(operatør_maske,i) then
bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
end;
end;
k:=modif_fil(tf_bplnavne,operatør,ll);
if k<>0 then
fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
lf:= 4;
fil(ll).lf:= navn;
setposition(fil(ll),0,0);
iaf:= 0;
k:= modif_fil(tf_bpl_def,operatør-64,ll);
if k<>0 then
fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
for i:= 1 step 1 until op_maske_lgd//2 do
fil(ll).iaf(i):= maske(i);
fil(ll).iaf(4):= bpl_tilst(operatør,2);
setposition(fil(ll),0,0);
d.opref.resultat:= 3;
end;
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,d.opref.resultat);
end;
begin
\f
message procedure io_komm side 27 - 940522/cl;
<* 15 vis betjeningspladsdefinitioner *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
for i:= 1 step 1 until max_antal_operatører do
begin
write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
case operatør_auto_include(i) extract 2 + 1 of(
<:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
if i mod 4 = 0 then write(z_io,"nl",1)
else write(z_io,"sp",5);
end;
if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
write(z_io,"nl",1,<:grupper::>,"nl",1);
for i:= 65 step 1 until top_bpl_gruppe do
begin
ll:=0; iaf:= i*op_maske_lgd;
if bpl_navn(i)<>long<::> then
begin
write(z_io,true,6,string bpl_navn(i),":",1);
for j:= 1 step 1 until max_antal_operatører do
begin
if læsbit_ia(bpl_def.iaf,j) then
begin
if ll mod 8 = 0 and ll<>0 then
write(z_io,"nl",1,"sp",7);
write(z_io,"sp",2,string bpl_navn(j));
ll:=ll+1;
end;
end;
write(z_io,"nl",1);
end;
end;
write(z_io,"*",1);
end;
begin
\f
message procedure io_komm side 28 - 940522/cl;
<* 16 stopniveau,definer *>
operatør:= ia(1);
iaf:= operatør*terminal_beskr_længde;
for i:= 1 step 1 until 3 do
operatør_stop(operatør,i):= ia(i+1);
if -,læsbit_ia(operatørmaske,operatør) then
begin
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
signal_bin(bs_mobilopkald);
end;
k:=modif_fil(tf_stoptabel,operatør,ll);
if k<>0 then
fejlreaktion(7,k,<:stopniveau,definer:>,0);
iaf:= 0;
for i:= 0 step 1 until 3 do
fil(ll).iaf(i+1):= operatør_stop(operatør,i);
setposition(fil(ll),0,0);
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,0,-1,3);
end;
begin
\f
message procedure io_komm side 29 - 940522/cl;
<* 17 stopniveauer,vis *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
for operatør:= 1 step 1 until max_antal_operatører do
begin
iaf:=operatør*terminal_beskr_længde;
ll:=0;
ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
string bpl_navn(operatør),<:(:>,
case terminal_tab.iaf.terminal_tilstand shift (-21)
+ 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
<:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
for i:= 1 step 1 until 3 do
ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
if operatør_stop(operatør,i)=0 then <:ALLE:>
else string bpl_navn(operatør_stop(operatør,i)));
if operatør mod 2 = 1 then
write(z_io,"sp",40-ll)
else
write(z_io,"nl",1);
end;
if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
write(z_io,"*",1);
end;
begin
\f
message procedure io_komm side 30 - 941007/cl;
<* 18 alarmlængder *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
for operatør:= 1 step 1 until max_antal_operatører do
begin
ll:=0;
ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
string bpl_navn(operatør));
iaf:=(operatør-1)*opk_alarm_tab_lgd;
if opk_alarm.iaf.alarm_lgd < 0 then
ll:= ll+write(z_io,<:uendelig:>)
else
ll:= ll+write(z_io,<<ddddddd>,
opk_alarm.iaf.alarm_lgd,<: sek.:>);
if operatør mod 2 = 1 then
write(z_io,"sp",40-ll)
else
write(z_io,"nl",1);
end;
if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
write(z_io,"*",1);
end;
begin
<* 19 CC *>
integer i, c;
i:= 1;
while læstegn(ia,i+0,c)<>0 and
i<(op_spool_postlgd-op_spool_text)//2*3
do skrivtegn(d.opref.data,i,c);
repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
d.opref.retur:= cs_io_komm;
signalch(cs_op,opref,io_optype or gen_optype);
<*V*> waitch(cs_io_komm,opref,io_optype,-1);
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,d.opref.resultat);
end;
begin
<* 20: CQF,I CQF,U CQF,V *>
integer kode, res, i, j;
integer array field iaf, iaf1;
long field navn;
kode:= d.opref.opkode extract 12;
navn:= 6; res:= 0;
if kode=90 <*CQF,I*> then
begin
if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
res:= 10 <*busnr ukendt*>
else
begin
j:= -1;
for i:= 1 step 1 until max_cqf do
begin
iaf:= (i-1)*cqf_lgd;
if ia(1) = cqf_tabel.iaf.cqf_bus or
ia.navn = cqf_tabel.iaf.cqf_id
then res:= 48; <*i brug*>
if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
end;
if res=0 and j<0 then res:= 32; <*ingen fri plads*>
if res=0 then
begin
iaf:= (j-1)*cqf_lgd;
cqf_tabel.iaf.cqf_bus:= ia(1);
cqf_tabel.iaf.cqf_fejl:= 0;
cqf_tabel.iaf.cqf_id:= ia.navn;
cqf_tabel.iaf.cqf_ok_tid:= real <::>;
cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
res:= 3;
end;
end;
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,res);
end
else
if kode=91 <*CQF,U*> then
begin
j:= -1;
for i:= 1 step 1 until max_cqf do
begin
iaf:= (i-1)*cqf_lgd;
if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
end;
if j>=0 then
begin
iaf:= (j-1)*cqf_lgd;
for i:= 1 step 1 until cqf_lgd//2 do
cqf_tabel.iaf(i):= 0;
res:= 3;
end
else res:= 13; <*bus ikke indsat*>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,res);
end
else
begin
setposition(z_io,0,0);
skriv_cqf_tabel(z_io,false);
outchar(z_io,'*');
setposition(z_io,0,0);
end;
if kode=90 or kode=91 then
begin
j:= skrivfil(1033,1,i);
if j<>0 then
fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
for k:= 1 step 1 until max_cqf do
begin
iaf1:= (k-1)*cqf_lgd;
iaf := (k-1)*cqf_id;
tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
end;
op_cqf_tab_ændret:= true;
end;
end;<*CQF*>
begin
\f
message procedure io_komm side xx - 940522/cl;
<*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
<*-3*>
end
end;<*case j *>
end <* j > 0 *>
else
begin
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,
45 <* ikke implementeret *>);
end;
end;<* godkendt *>
<*V*> setposition(z_io,0,0);
signal_bin(bs_zio_adgang);
d.op_ref.retur:=cs_att_pulje;
disable afslut_kommando(op_ref);
end; <* indlæs kommando *>
begin
\f
message procedure io_komm side xx+1 - 810428/hko;
<* 2: aktiver efter stop *>
terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
terminal_tab.ref.terminal_tilstand extract 21;
afslut_operation(op_ref,-1);
signal_bin(bs_zio_adgang);
end;
<*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
<*-3*>
end; <* case aktion+6 *>
until false;
io_komm_trap:
if -,(alarmcause shift (-24) extract 24 = (-2) and
alarmcause extract 24 = (-13)) then
disable skriv_io_komm(zbillede,1);
end io_komm;
\f
message procedure io_spool side 1 - 810507/hko;
procedure io_spool;
begin
integer
næste_tomme,nr;
integer array field
op_ref;
procedure skriv_io_spool(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_spool :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: opref: :>,op_ref,"nl",1,
<: næstetomme::>,næste_tomme,"nl",1,
<: nr :>,nr,"nl",1,
<::>);
skriv_coru(zud,coru_no(102));
slut:
end;<*disable*>
end skriv_io_spool;
trap(io_spool_trap);
næste_tomme:= 1;
stack_claim((if cm_test then 200 else 146)+24 +48);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_spool(out,0);
<*-2*>
\f
message procedure io_spool side 2 - 810602/hko;
repeat
wait_ch(cs_io_spool,
op_ref,
true,
-1<*timeout*>);
i:= d.op_ref.opkode;
if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
begin
wait(ss_io_spool_tomme);
disable modif_fil(io_spoolfil,næste_tomme,nr);
næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
i:= d.op_ref.opsize;
<*+4*> if i > io_spool_postlængde*2 -io_spool_post then
begin
<* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
i:= io_spool_postlængde*2 -io_spool_post;
end;
<*-4*>
fil(nr,1):= real(extend d.op_ref.opsize shift 24);
tofrom(fil(nr).io_spool_post,d.op_ref,i);
signal(ss_io_spool_fulde);
d.op_ref.resultat:= 1;
end
else
begin
fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
<:io_spool_korutine:>,1);
end;
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
until false;
io_spool_trap:
disable skriv_io_spool(zbillede,1);
end io_spool;
\f
message procedure io_spon side 1 - 810507/hko;
procedure io_spon;
begin
integer
næste_fulde,nr,i,dato,kl;
real t;
procedure skriv_io_spon(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_spon :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: næste-fulde::>,næste_fulde,"nl",1,
<: nr :>,nr,"nl",1,
<::>);
skriv_coru(zud,coru_no(103));
slut:
end;<*disable*>
end skriv_io_spon;
trap(io_spon_trap);
næste_fulde:= 1;
stack_claim((if cm_test then 200 else 146) +24 +48);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_spon(out,0);
<*-2*>
\f
message procedure io_spon side 2 - 810602/hko/cl;
repeat
<*V*> wait(ss_io_spool_fulde);
<*V*> wait(bs_zio_adgang);
<*V*> setposition(zio,0,0);
disable modif_fil(io_spool_fil,næste_fulde,nr);
næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
laf:=data;
k:= fil(nr).io_spool_post.opkode;
if k = 22 or k = 36 then
disable begin
write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
if k=36 then
begin
i:= fil(nr).io_spool_post.data(4);
j:= i extract 5;
if j<>0 then j:=j+'A'-1;
i:= i shift (-5) extract 10;
write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
end;
skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
fil(nr).io_spool_post.tid)
end
else if k = 23 then
disable
begin
write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
dato:= systime(4,fil(nr).io_spool_post.tid,t);
kl:= round t;
i:= replace_char(1<*space in number*>,'.');
write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
replace_char(1,i);
end
else if k = 45 or k = 46 then
disable begin
integer vogn,linie,bogst,løb,t;
t:=fil(nr).io_spool_post.data(2);
outchar(z_io,'nl');
if k = 45 then
write(zio,<<zd.dd>,t/100.0,"sp",1);
write(zio,<:nødopkald fra :>);
vogn:= fil(nr).io_spool_post.data(1);
i:= vogn shift (-22);
if i < 2 then
skrivid(zio,vogn,9)
else
begin
fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
write(zio,<:!!!:>,vogn);
end;
\f
message procedure io_spon side 3 - 810507/hko;
if fil(nr).io_spool_post.data(3)<>0 then
write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
if k = 46 then
begin
write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
end;
end <*disable*>
else
fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
fil(nr,1):= fil(nr,1) add 1;
<*V*> setposition(zio,0,0);
signal_bin(bs_zio_adgang);
signal(ss_io_spool_tomme);
until false;
io_spon_trap:
skriv_io_spon(zbillede,1);
end io_spon;
\f
message procedure io_medd side 1;
procedure io_medd;
begin
integer array field opref;
integer afs, kl, i;
real dato, t;
procedure skriv_io_medd(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_medd :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: afs: :>,afs,"nl",1,
<: kl: :>,kl,"nl",1,
<: i: :>,i,"nl",1,
<: dato: :>,<<zddddd>,dato,"nl",1,
<: t: :>,t,"nl",1,
<::>);
skriv_coru(zud,coru_no(104));
slut:
end;<*disable*>
end skriv_io_medd;
trap(io_medd_trap);
stack_claim((if cm_test then 200 else 146) +24 +48);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_medd(out,0);
<*-2*>
\f
message procedure io_medd side 2;
repeat
<*V*> waitch(cs_io_medd,opref,gen_optype,-1);
<*V*> wait(bs_zio_adgang);
afs:= d.opref.data.op_spool_kilde;
dato:= systime(4,d.opref.data.op_spool_tid,t);
kl:= round t;
write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
if afs=0 then <:SYSOP:> else string bpl_navn(afs));
i:= replacechar(1,'.');
disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
replacechar(1,i);
write(z_io,d.opref.data.op_spool_text);
setposition(z_io,0,0);
signalbin(bs_zio_adgang);
signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
until false;
io_medd_trap:
skriv_io_medd(zbillede,1);
end io_medd;
procedure io_nulstil_tællere;
begin
real nu, dato, kl, forr, næste, et_døgn, r;
integer array field opref;
integer ventetid, omr, typ, sum;
integer array ialt(1:5);
procedure skriv_io_null(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_nulstil_tællere :>);
if omfang > 0 then
disable begin real t; real array field raf;
raf:=0;
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: ventetid: :>,ventetid,"nl",1,
<: omr: :>,omr,"nl",1,
<: typ: :>,typ,"nl",1,
<: sum: :>,sum,"nl",1);
write(zud,
<: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1);
write(zud,
<: forr: :>,<< zddddd>,systime(4,forr,t),t,"nl",1);
write(zud,
<: næste: :>,<< zddddd>,systime(4,næste,t),t,"nl",1);
write(zud,
<: r: :>,<< zddddd>,systime(4,r,t),t,"nl",1,
<: dato: :>,dato,"nl",1,
<: kl: :>,kl,"nl",1,
<: et-døgn: :>,<< dddddd>,et_døgn,"nl",1,
<::>);
write(zud,"nl",1,<:ialt: :>);
skriv_hele(zud,ialt.raf,10,2);
skriv_coru(zud,coru_no(105));
slut:
end;<*disable*>
end skriv_io_null;
trap(io_null_trap);
et_døgn:= 24*60*60.0;
stack_claim(500);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_null(out,0);
<*-2*>
pass;
systime(1,0.0,nu);
dato:= systime(4,nu,kl);
if nulstil_systællere >= 0 then
begin
if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
+ et_døgn
else næste:= systid(dato,nulstil_systællere);
forr:= næste - et_døgn;
if (forr - systællere_nulstillet) > et_døgn then
næste:= nu;
end;
repeat
ventetid:= (if nulstil_systællere < 0 then (-1) else (næste - nu));
<*V*> waitch(cs_io_nulstil,opref,io_optype,ventetid);
if opref <= 0 then
begin
<* nulstil opkaldstællere *>
wait(bs_zio_adgang);
setposition(z_io,0,0);
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,"nl",1,<:!TÆ,N (automatisk):>,"nl",2,
<:område udgående alm.ind nød ind:>,
<: ind-ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_områder do
begin
sum:= 0;
write(z_io,true,6,string område_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
sum:= sum + opkalds_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4), ialt(5), "nl",3);
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,<:oper. udgående alm.ind nød ind:>,
<: ind-ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_operatører do
begin
sum:= 0;
if bpl_navn(omr)=long<::> then
write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
else
write(z_io,true,6,string bpl_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
sum:= sum + operatør_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4),ialt(5),"nl",2);
typ:= replacechar(1,':');
write(z_io,<:tællere nulstilles :>);
if nulstil_systællere=(-1) then
write(z_io,<:ikke automatisk:>,"nl",1)
else
write(z_io,<:automatisk kl. :>,<<zd dd dd>,
nulstil_systællere,"nl",1);
replacechar(1,'.');
write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
systime(4,systællere_nulstillet,r));
replacechar(1,':');
write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
replacechar(1,typ);
write(z_io,"*",1,"nl",1);
setposition(z_io,0,0);
signal_bin(bs_zio_adgang);
for omr:= 1 step 1 until max_antal_områder*5 do
opkalds_tællere(omr):= 0;
for omr:= 1 step 1 until max_antal_operatører*5 do
operatør_tællere(omr):= 0;
systællere_nulstillet:= næste;
opdater_tf_systællere;
end
else
signalch(d.opref.retur,opref,d.opref.optype);
systime(1,0.0,nu);
dato:= systime(4,nu,kl);
if nulstil_systællere >= 0 then
begin
if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
+ et_døgn
else næste:= systid(dato,nulstil_systællere);
forr:= næste - et_døgn;
end;
until false;
io_null_trap:
skriv_io_null(zbillede,1);
end io_nulstil_tællere;
:5: io: initialisering
\f
message io_initialisering side 1 - 810507/hko;
io_spoolfil:= 1028;
begin
integer array fdim(1:8);
fdim(4):= io_spoolfil;
hent_fildim(fdim);
io_spool_postantal:= fdim(1);
io_spool_postlængde:= fdim(2);
end;
io_spool_post:= 4;
cs_io:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
<*-3*>
i:= next_coru(100,<*ident *>
5,<*prioritet *>
true<*test_maske*>);
j:= new_activity( i,
0,
h_io);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_io_komm:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
<*-3*>
i:= next_coru(101,<*ident*>
10,<*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
io_komm);<*ingen parametre*>
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
\f
message io_initialisering side 2 - 810520/hko/cl;
bs_zio_adgang:= next_sem;
<*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
<*-3*>
signal_bin(bs_zio_adgang);
cs_io_spool:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
<*-3*>
cs_io_fil:=next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
<*-3*>
signal_ch(cs_io_fil,next_op(data+18),gen_optype);
ss_io_spool_fulde:= next_sem;
<*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
<*-3*>
ss_io_spool_tomme:= next_sem;
<*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
<*-3*>
for i:= 1 step 1 until io_spool_postantal do
signal(ss_io_spool_tomme);
\f
message io_initialisering side 3 - 880901/cl;
i:= next_coru(102,
5,
true);
j:= new_activity(i,0,io_spool);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
i:= next_coru(103,
10,
true);
j:= new_activity(i,0,io_spon);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_io_medd:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
<*-3*>
i:= next_coru(104,<*ident *>
10,<*prioritet *>
true<*test_maske*>);
j:= new_activity( i,
0,
io_medd);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_io_nulstil:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
<*-3*>
i:= next_coru(105,<*ident *>
10,<*prioritet *>
true<*test_maske*>);
j:= new_activity( i,
0,
io_nulstil_tællere);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
i:= monitor(8)reserve process:(z_io,0,ia);
if i <> 0 then
begin
fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
end
else
begin
ref:= 0;
terminal_tab.ref.terminal_tilstand:= 0;
write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
<<zddddd>,systime(5,0.0,r),".",1,r,
"sp",1,"*",15,"nl",1);
setposition(z_io,0,0);
end;
▶EOF◀