|
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: 63744 (0xf900)
Types: TextFile
Names: »htio «
└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
└─⟦6a563b143⟧
└─⟦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 spontane meddelelser *>
+ 1; <* io spoolkorutine *>
max_semch:= max_semch
+ 1 <* cs_io *>
+ 1 <* cs_io_komm *>
+ 1 <* cs_io_fil *>
+ 1; <* cs_io_spool *>
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,
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(16,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
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;
integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
pos,indeks,sep,sluttegn,operatør;
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,
<: 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+88);
ref:=0;
<*+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=70 or kode=77 then 9 <*FO,L/VO,G*>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>=80 and kode <=88 then 2 <*sys-spec.*>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;
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
trapmode:= 1 shift 13;
trap(-2);
end;
<* 84: SL,B *>begin
trap(-3);
end;
<* 85: SL,K *>begin
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/garager på operatører *>
d.op_ref.retur:=cs_io_komm;
disable modiffil(if kode=5 then 1029 else
if kode=70 then 1033 else 1034,1,i);
ref:=0;
operatør:=ia(1);
if operatør=0 and kode=5 then operatør:= 15;
for j:=2 step 1 until indeks do
begin
ll:=ia(j);
if kode=5 then
begin
if ll<>0 then
sæt_hex_ciffer(fil(i).ref,abs(ll),
if ll>0 then operatør else 15);
end
else fil(i).ref(ll):= if ll>0 then operatør else 0;
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 opr,lin,max_lin;
\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, 15 do
begin
write(z_io,"nl",1);
if opr<>15 then
write(z_io,<:operatør:>,<< dd>,opr)
else
write(z_io,<:ikke fordelte:>);
write(z_io,<:<'nl'> garager: :>);
k:= 0;
for i:= 1 step 1 until max_antal_garager do
if (radio_garage_tabel(i) = opr mod 15) and
(garagenavn(i)<>long<:___:>) then
begin
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 garagenavn(i));
end;
write(z_io,<:<'nl'> linier: :>);
j:= k:= 0;
for lin:= 1 step 1 until max_lin do
begin
læs_hex_ciffer(radio_linietabel,lin,i);
if i<>0 then j:= lin;
if opr=i then
begin
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;
write(z_io,<:<'nl'> områder: :>);
k:= 0;
for i:= 1 step 1 until max_antal_områder do
begin
if radio_områdetabel(i)= opr mod 15 then
begin
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;
write(z_io,"nl",1);
end;
write(z_io,"*",1);
end;
begin
integer omr,typ,sum;
integer array ialt(1:3);
\f
message procedure io_komm side 24 - 810501/hko;
<* vis opkaldstællere *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
for typ:= 1 step 1 until 3 do ialt(typ):= 0;
write(z_io,
<:område udgående alm. ind nød ind:>,
<: ind ialt total:>,"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)*3+typ));
sum:= sum + opkalds_tællere((omr-1)*3+typ);
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*3+typ);
end;
write(z_io,<< ddddddd>,
sum-opkalds_tællere((omr-1)*3+1),sum,"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,"nl",1);
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*3 do
opkalds_tællere(omr):= 0;
skrivfil(tf_systællere,1,omr);
tofrom(fil(omr),opkaldstællere,max_antal_områder*6);
setposition(fil(omr),0,0);
write(z_io,<:!!! tabeller nusltillet !!!:>,"nl",1);
end;
end;
begin
\f
message procedure io_komm side 24a - 810501/hko;
<*+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 25 - 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<*programfejl*>,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
begin
write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
dato:= systime(4,fil(nr).io_spool_post.tid,t);
kl:= t/100.0;
i:= replace_char(1<*space in number*>,'.');
write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_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;
: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*>
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◀