|
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: 18432 (0x4800)
Types: TextFile
Names: »htgarage «
└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
└─⟦6a563b143⟧
└─⟦this⟧ »htgarage «
garage.
:1: garage: parametererklæringer
:2: garage: parameterinitialisering
:3: garage: claiming
\f
message garage_claiming side 1 -810226/hko;
max_coru:= max_coru +1
+max_antal_garageterminaler;
max_semch:= max_semch +1
+max_antal_garageterminaler;
:4: garage: erklæringer
\f
message garage_erklæringer side 1 - 810415/hko;
zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
procedure gar_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;
getzone6(z,iz);
iaf:=raf:=2;
j:=læstegn(iz.iaf,7,i) - '0';
iaf:=(8+j)*terminal_beskr_længde;
k:=1;
j:= terminal_tab.iaf.terminal_tilstand;
if j shift(-21) < 6 and s <> (1 shift 21 +2) then
fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
1 shift 12 <*binært*> +1 <*fortsæt*>);
if s <> (1 shift 21 +2) then
terminal_tab.iaf.terminal_tilstand:= 6 shift 21
+ terminal_tab.iaf.terminal_tilstand extract 21;
if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
begin
z(1):=real <:<'?'><'em'>:>;
b:=2;
end;
end; <*disable*>
end gar_fejl;
integer cs_gar;
integer array cs_garage(1:max_antal_garageterminaler);
\f
message procedure h_garage side 1 - 810520/hko;
<* hovedmodulkorutine for garageterminaler *>
procedure h_garage;
begin
integer array field op_ref;
integer k,dest_sem;
procedure skriv_hgarage(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin integer i;
i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
write(zud,"sp",26-i);
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(300));
slut:
end;
end skriv_hgarage;
trap(hgar_trap);
stack_claim(if cm_test then 198 else 146);
<*+2*>
if testbit16 and overvåget or testbit28 then
skriv_hgarage(out,0);
<*-2*>
\f
message procedure h_garage side 2 - 811105/hko;
repeat
wait_ch(cs_gar,op_ref,true,-1);
<*+4*>
if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
<*-4*>
k:=d.op_ref.opkode extract 12;
dest_sem:=
if k=0 then cs_garage(d.op_ref.kilde mod 100) else
if k=7 or k=8 then cs_garage(d.op_ref.data(1))
else -1;
<*+4*>
if dest_sem=-1 then
begin
fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end
else
<*-4*>
if k=7<*inkluder*> then
begin
iaf:=(8+ d.op_ref.data(1))*terminal_beskr_længde;
if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
begin
d.op_ref.resultat:=3;
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
dest_sem:=-2;
end;
end
else
if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
begin
iaf:=(8+d.op_ref.data(1))*terminal_beskr_længde;
terminal_tab.iaf.terminal_tilstand:= 7 shift 21
+terminal_tab.iaf.terminal_tilstand extract 21;
end;
if dest_sem>0 then
signal_ch(dest_sem,op_ref,d.op_ref.optype);
until false;
hgar_trap:
disable skriv_hgarage(zbillede,1);
end h_garage;
\f
message procedure garage side 1 - 830310/cl;
procedure garage(nr);
value nr;
integer nr;
begin
integer array field op_ref,ref;
integer i,kode,aktion,status,opgave,retur_sem,
pos,indeks,sep,sluttegn,vogn,ll;
procedure skriv_garage(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin integer i;
i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
write(zud,"sp",26-i);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: op-ref: :>,op_ref,"nl",1,
<: kode: :>,kode,"nl",1,
<: ref: :>,ref,"nl",1,
<: i: :>,i,"nl",1,
<: aktion: :>,aktion,"nl",1,
<: retur-sem: :>,retur_sem,"nl",1,
<: vogn: :>,vogn,"nl",1,
<: ll: :>,ll,"nl",1,
<: status: :>,status,"nl",1,
<: opgave: :>,opgave,"nl",1,
<: pos: :>,pos,"nl",1,
<: indeks: :>,indeks,"nl",1,
<: sep: :>,sep,"nl",1,
<: sluttegn: :>,sluttegn,"nl",1,
<::>);
skriv_coru(zud,coru_no(300+nr));
slut:
end;
end skriv_garage;
\f
message procedure garage side 2 - 830310/hko;
trap(gar_trap);
stack_claim((if cm_test then 200 else 146)+24+48+80+75);
ref:= (8+nr)*terminal_beskr_længde;
<*+2*>
if testbit16 and overvåget or testbit28 then
skriv_garage(out,0);
<*-2*>
<* attention simulering
*>
if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
begin
wait_ch(cs_att_pulje,op_ref,true,-1);
start_operation(op_ref,300+nr,cs_garage(nr),0);
signal_ch(cs_garage(nr),op_ref,gen_optype);
end;
<*
*>
\f
message procedure garage side 3 - 830310/hko;
repeat
<*V*> wait_ch(cs_garage(nr),
op_ref,
true,
-1<*timeout*>);
<*+2*>
if testbit17 and overvåget then
disable begin
write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
<: til garage :>,nr);
skriv_op(out,op_ref);
end;
<*-2*>
kode:= d.op_ref.op_kode;
retur_sem:= d.op_ref.retur;
i:= terminal_tab.ref.terminal_tilstand;
status:= i shift(-21);
opgave:=
if kode=0 then 1 <* indlæs kommando *> else
if kode=7 then 2 <* inkluder *> else
if kode=8 then 3 <* ekskluder *> else
0; <* afvises *>
aktion:= case status +1 of(
<* status *> <* opgave: 0 1 2 3 *>
<* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
<* 1 - *>(-1),<* ulovlig tilstand *>
<* 2 - *>(-1),<* ulovlig tilstand *>
<* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
<* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
<* 5 - *>(-1),<* ulovlig tilstand *>
<* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
<* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
-1);
\f
message procedure garage side 4 - 810424/hko;
case aktion+6 of
begin
begin
<*-5: terminal optaget *>
d.op_ref.resultat:= 16;
afslut_operation(op_ref,cs_att_pulje); <*telex*>
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: ulovligt garageterminal_nr *>
fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
afslut_operation(op_ref,cs_att_pulje); <*telex*>
end;
begin
<*-1: ulovlig operatørtilstand *>
fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
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 garage side 5 - 851001/cl;
<* 1: indlæs kommando *>
<*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
if d.op_ref.resultat > 3 then
begin
<*V*> setposition(z_gar(nr),0,0);
if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
skriv_kvittering(z_gar(nr),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=11 or kode=12 or kode=20 or kode=24 then 1
else if kode=9 or kode=10 then 2
else 0;
if j > 0 then
begin
case j of
begin
begin
\f
message procedure garage side 6 - 851001/cl;
<* 1 indsæt/udtag/flyt bus i vogntabel *>
integer vogn,ll;
integer array field vtop;
vogn:=ia(1);
ll:=ia(2);
<*V*> wait_ch(cs_vt_adgang,
vt_op,
gen_optype,
-1<*timeout sek*>);
start_operation(vtop,300+nr,cs_garage(nr),
kode);
d.vt_op.data(1):=vogn;
if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
indeks:= vt_op;
signal_ch(cs_vt,
vt_op,
gen_optype or gar_optype);
<*V*> wait_ch(cs_garage(nr),
vt_op,
gar_optype,
-1<*timeout sek*>);
<*+2*> if testbit18 and overvåget then
disable begin
write(out,"nl",1,<:garage :>,<<d>,nr,
<:: operation retur fra vt:>);
skriv_op(out,vt_op);
end;
<*-2*>
<*+4*> if vt_op<>indeks then
fejl_reaktion(11<*fremmede op*>,op_ref,
<:garage-kommando:>,0);
<*-4*>
<*V*> setposition(z_gar(nr),0,0);
if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
skriv_kvittering(z_gar(nr),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:=gen_optype or vtoptype;
disable afslut_operation(vt_op,cs_vt_adgang);
end;
begin
\f
message procedure garage side 6a - 830310/cl;
<* 2 vogntabel,linienr/-,busnr *>
d.op_ref.retur:= cs_garage(nr);
tofrom(d.op_ref.data,ia,10);
indeks:= op_ref;
signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
wait_ch(cs_garage(nr),
op_ref,
gar_optype,
-1<*timeout*>);
<*+2*> if testbit18 and overvåget then
disable begin
write(out,"nl",1,<:garage operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*>
if indeks <> op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
<*-4*>
i:= d.op_ref.resultat;
if i = 0 or i > 3 then
begin
<*V*> setposition(z_gar(nr),0,0);
skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
end
else
begin
integer antal,fil_ref;
antal:= d.op_ref.data(6);
fil_ref:= d.op_ref.data(7);
<*V*> setposition(z_gar(nr),0,0);
write(z_gar(nr),"*",24,"sp",6,
<:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
<*V*> setposition(z_gar(nr),0,0);
\f
message procedure garage side 6c - 841213/cl;
pos:= 1;
while pos <= antal do
begin
integer bogst,løb;
disable i:= læs_fil(fil_ref,pos,j);
if i <> 0 then
fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
else
begin
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(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
false add bogst,1,"/",1,<<d__>,løb);
write(z_gar(nr),<<dddd>,vogn,"sp",1);
end;
end;
if pos mod 5 = 0 then
begin
write(z_gar(nr),"nl",1);
<*V*> setposition(z_gar(nr),0,0);
end
else write(z_gar(nr),"sp",3);
end;
pos:=pos+1;
end;
write(z_gar(nr),"nl",1,"*",77,"nl",1);
\f
message procedure garage side 6d- 830310/cl;
d.opref.opkode:=104; <*slet-fil*>
d.op_ref.data(4):=filref;
indeks:=op_ref;
signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
<*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
<*+2*> if testbit18 and overvåget then
disable begin
write(out,"nl",1,<:garage, slet-fil retur:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
<*-4*>
if d.op_ref.data(9)<>0 then
fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
<:garage, slet_fil:>,1);
end;
\f
message procedure garage side 7 -810424/hko;
end;
<*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
<*-4*>
end;<*case j *>
end <* j > 0 *>
else
begin
<*V*> setposition(z_gar(nr),0,0);
if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
skriv_kvittering(z_gar(nr),op_ref,pos,
4 <*kommando ukendt *>);
end;
end;<* godkendt *>
<*V*> setposition(z_gar(nr),0,0);
d.op_ref.opkode:=0; <*telex*>
disable afslut_operation(op_ref,cs_gar);
end; <* indlæs kommando *>
begin
\f
message procedure garage side 8 - 841213/cl;
<* 2: inkluder *>
d.op_ref.resultat:=3;
afslut_operation(op_ref,-1);
terminal_tab.ref.terminal_tilstand:=
terminal_tab.ref.terminal_tilstand extract 21;
<*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
start_operation(op_ref,300+nr,cs_att_pulje,0);
signal_ch(cs_garage(nr),op_ref,gen_optype);
end;
begin
<* 3: ekskluder *>
d.op_ref.resultat:= 3;
terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
terminal_tab.ref.terminal_tilstand extract 21;
afslut_operation(op_ref,-1);
end;
<*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
<*-4*>
end; <* case aktion+6 *>
until false;
gar_trap:
skriv_garage(zbillede,1);
end garage;
:5: garage: initialisering
\f
message garage_initialisering side 1 - 810521/hko;
cs_gar:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
<*-3*>
i:= next_coru(300,<*ident*>
10,<*prioritet*>
true<*test_maske*>);
j:= new_activity( i,
0,
h_garage);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
for k:= 1 step 1 until max_antal_garageterminaler do
begin
ref:= (8+k)*terminal_beskr_længde;
skriv_tegn(garage_terminal_navn,7,'0'+k);
open(z_gar(k),8,garage_terminal_navn,1 shift 21 + 1 shift 9);
i:=monitor(4)process address:(z_gar(k),0,ia);
if i = 0 then
begin
fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
terminal_tab.ref.terminal_tilstand:= 4 shift 21;
end
else
begin
terminal_tab.ref.terminal_tilstand:=
if garage_auto_include then 0 else 7 shift 21;
end;
cs_garage(k):= next_semch;
<*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
<*-3*>
i:= next_coru(300+k,<*ident*>
10,<*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
garage,k);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
end;
:7: garage trapaktion2.
\f
message garage_finale side 1 - 810428/hko;
write(out,<:lukker garager:>); ud;
for k:= 1 step 1 until max_antal_garageterminaler do
begin
close(z_gar(k),true);
end;
▶EOF◀