|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 72960 (0x11d00)
Types: TextFile
Names: »htattention «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »htattention «
attention.
attention venter på attention_message fra operatør_skærme og
io_skrivemaskine.
message fra operatør_skærme, der ikke er sat i drift (inkluderede)
afvises med result=4 'disconnected'
message fra andre processer afvises med result=2 'rejected'
message fra operatørskærme i drift og fra io_skrivemaskinen
besvares med result=1 'normal' og der hentes en operation fra
'cs_att_pulje' som sendes til den relevante hovedmodul_semafor,
der vidersender operationen til den relevante kommando_semafor.
efter endt brug skal operationen returneres til cs_att_pulje
v.hj.a. procedure afslut_kommando(operatør_nr,operation);
hver operatørskærm, garageterminal eller io_skrivemaskinen
kan kun have en attention operation under behandling ad gangen,
d.v.s. attention fra en terminal, der er "optaget", er uden virkning.
:1: attention: parameter erklæringer
message attention parametererklæringer side 1 - 810318/hko;
integer
att_op_længde,
att_maske_lgd,
terminal_beskr_længde;
integer field
terminal_tilstand,
terminal_suppl;
:2: attention: parameter initialisering
\f
message attention parameterinitialisering side 1 - 810318/hko;
att_op_længde:= 40;
att_maske_lgd:=
(1+max_antal_operatører+max_antal_garageterminaler+1+23)//24*2;
terminal_beskr_længde:=6;
terminal_tilstand:= 2;
terminal_suppl:=4;
:3: attention: claiming
\f
message attention_claiming side 1 - 810318/hko;
maxcoru:=maxcoru+1;
max_op:=max_op +1
+max_antal_operatører
+max_antal_garageterminaler;
max_nettoop:=maxnettoop+(data+att_op_længde)
*(1+max_antal_operatører
+max_antal_garageterminaler);
max_procext:=max_procext+1;
max_sem:= max_sem+1;
max_semch:=maxsemch+1;
:4: attention: erklæringer
\f
message attention_erklæringer side 1 - 850820/cl;
integer
tf_kommandotabel,
cs_att_pulje,
bs_fortsæt_adgang,
att_proc_ref;
integer array
att_flag,
att_signal(1:att_maske_lgd//2);
integer array
terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
max_antal_operatører+max_antal_garageterminaler)),
fortsæt(1:32);
\f
message procedure afslut_kommando side 1 - 810507/hko;
procedure afslut_kommando(op_ref);
integer array field op_ref;
begin integer nr,i,sem;
i:= d.op_ref.kilde;
nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
sætbit_ia(att_flag,nr,0);
d.op_ref.optype:=gen_optype;
<* "husket" attention disabled ****************
if sætbit_ia(att_signal,nr,0)=1 then
begin
sem:=if i=299 then cs_talevejsswitch else
case i//100 of (cs_io_komm,cs_operatør(i mod 100),
cs_garage(i mod 100));
afslut_operation(op_ref,0);
start_operation(op_ref,i,cs_att_pulje,0);
signal_ch(sem,op_ref,gen_optype);
end
else
********************* disable "husket" attention *>
afslut_operation(op_ref,cs_att_pulje);
end;
\f
message procedure læs_store side 1 - 880919/cl;
integer procedure læs_store(z,c);
zone z;
integer c;
begin
læs_store:= readchar(z,c);
if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
end;
\f
message procedure param side 1 - 810226/cl;
integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
value tabel_id;
integer pos, tabel_id, type, sep;
integer array txt, spec, værdi;
<*************************************>
<* *>
<* CLAUS LARSEN: 15.07.77 *>
<* *>
<*************************************>
<* param syntax-analyserer en parameterliste, og *>
<* bestemmer næste parameter og den separator der *>
<* afslutter parameteren *>
begin
integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
real array indgang(1:2);
integer i, j, tegn, tegn_pos, tal, hashnøgle,
zone_nr, top, max_segm, start_segm, lpos;
boolean minus, separator;
lpos := pos;
type:=-1;
for i:=1 step 1 until 4 do værdi(i):=0;
\f
message procedure param side 2 - 810428/cl,hko;
<* grænsecheck for pos *>
begin
integer nedre, øvre;
nedre := system(3,øvre,txt);
nedre := nedre * 3 - 2;
øvre := øvre * 3;
if lpos < (nedre - 1) or øvre < lpos then
begin
sep:= -1;
param:= 5;
goto slut;
end;
<* er parameterlisten slut *>
lpos:= lpos+1;
læs_tegn(txt,lpos,tegn);
if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
begin
lpos := lpos - 2;
sep := tegn;
param := 5;
goto slut;
end else lpos:= lpos-1;
end;
\f
message procedure param side 3 - 810428/cl;
<* initialisering *>
for i := 1 step 1 until 4 do
aktuel_param(i) := 0;
minus := separator := false;
<* initialiser klassetabel *>
for i := 65 step 1 until 93,
97 step 1 until 125 do klasse(i) := 1;
for i := 48 step 1 until 57 do klasse(i) := 2;
for i := 0 step 1 until 47, 58 step 1 until 64,
94, 95, 96, 126, 127 do klasse(i) := 4;
<* sæt specialtegn *>
i := 1;
læs_tegn(spec,i,tegn);
while tegn <> 0 do
begin
if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
klasse(tegn) := 3;
læs_tegn(spec,i,tegn);
end;
\f
message procedure param side 4 - 810226/cl;
<* læs første tegn i ny parameter og bestem typen *>
læs_tegn(txt,lpos,tegn);
case klasse(tegn) of
begin
<* case 1 - bogstav *>
begin
type := 0;
param := 0;
tegn_pos := 1;
hashnøgle := 0;
<* læs parameter *>
while tegn_pos < 12 and klasse(tegn) <> 4 do
begin
hashnøgle := hashnøgle + tegn;
skriv_tegn(aktuel_param,tegn_pos,tegn);
læs_tegn(txt,lpos,tegn);
end;
<* find separator *>
while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
sep := tegn;
\f
message procedure param side 5 - 810226/cl;
<* tabelopslag *>
if tabel_id <> 0 then
begin
<* hent max_segm *>
fdim(4) := tabel_id;
j := hent_fil_dim(fdim);
if j > 0 then
begin
param := 4;
for i := 1 step 1 until 4 do
værdi(i) := aktuel_param(i);
goto slut;
end;
max_segm := fdim(3);
<* forbered opslag *>
start_segm := (hashnøgle mod max_segm) + 1;
indgang(1) := 0.0 shift 48 add aktuel_param(1)
shift 24 add aktuel_param(2);
indgang(2) := 0.0 shift 48 add aktuel_param(3)
shift 24 add aktuel_param(4);
hashnøgle := start_segm;
\f
message procedure param side 6 - 810226/cl;
<* søg navn *>
repeat
<* læs segment *>
læs_fil(tabel_id,hashnøgle,zone_nr);
<* beregn sidste element *>
top := fil(zone_nr,1) extract 24;
top := (top - 1) * 4 + 2;
<* søg *>
for i := 2 step 4 until top do
if fil(zone_nr,i) = indgang(1) and
fil(zone_nr,i+1) = indgang(2) then
begin
<* fundet *>
værdi(1) := fil(zone_nr,i+2) shift (-24)
extract 24;
værdi(2) := fil(zone_nr,i+2) extract 24;
værdi(3) := fil(zone_nr,i+3) shift (-24)
extract 24;
værdi(4) := fil(zone_nr,i+3) extract 24;
goto fundet;
end;
if top = 122 then <*overløb *>
hashnøgle := (hashnøgle mod max_segm) + 1;
until top < 122 or hashnøgle = start_segm;
<* navn findes ikke *>
param := 2;
for j := 1 step 1 until 4 do
værdi(j) := aktuel_param(j);
fundet: ;
end <*tabel_id <> 0 *>
else
for i := 1 step 1 until 4 do
værdi(i) := aktuel_param(i);
end <* case 1 *>;
\f
message procedure param side 7 - 810310/cl,hko;
<* case 2 - ciffer *>
cif: begin
type:=tal := 0;
while klasse(tegn) = 2 do
begin
type:=type+1;
tal := tal * 10 + (tegn - 48);
læs_tegn(txt,lpos,tegn);
end;
if minus then tal := -tal;
værdi(1) := tal;
sep := tegn;
param := 0;
end <* case 2 *>;
\f
message procedure param side 8 - 810428/cl;
<* case 3 - specialtegn *>
spc: begin
if tegn = '-' then
begin
læs_tegn(txt,lpos,tegn);
if klasse(tegn) = 2 then
begin
minus := true;
goto cif;
end
else
begin
tegn := '-';
lpos := lpos - 1;
end;
end;
<* syntaxfejl *>
param := if separator then 1 else 3;
sep := tegn;
end <* case 3 *>;
<* case 4 - separator *>
begin
separator := true;
goto spc;
end <* case 4 *>;
end <* case *>;
lpos := lpos - 1;
slut:
pos := lpos;
end;
\f
message procedure læs_param_sæt side 1 - 830310/cl;
integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
integer array tekst, parm;
integer pos,ant, term,res;
<* proceduren læser et sammenhørende sæt parametre
afsluttet med (sp),(nl),(;),(,) eller (nul)
læs_param_sæt returstatus eller 'typen' af det læste parametersæt
(retur,int)
type ant parm indeholder:
<0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
0: 0 (ingenting) 'rest kommando er tom'
1: 1 (tekst) 'indtil 11 tegn'
2: 1 (pos.tal)
3: 1 (neg.tal)
4: 1 (pos.tal<1000)(bogstav) 'linienummer'
5: 1 G(pos.tal<100) 'gruppe_ident'
6: 2 (linie)/(løb) 'vogn_ident'
7: 3 (bus)/(linie)/(løb)
8: 3 (linie).(indeks):(løb)
9: 2 (linie).(indeks)
10: 2 (pos.tal).(pos.tal)
11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
12: 3 D.(dato).(tid)
tekst indeholder teksten hvori parametersættet
(kald,int.arr.) skal søges.
pos
(kald/retur,int.) position efter hvilken søgningen starter, og
ved retur positionen for afsluttende tegn.
(ikke ændret ved fejl)
ant hvis kaldeværdien er >0 skal parametersættet
(kald/retur,int) indeholde det angivne antal enkeltparametre,
i modsat fald returneres med fejltype -26
(skilletegn) eller -25 (parameter mangler).
ellers læses op til 3 enkeltparametre. retur-
værdien afhænger af det læste parametersæts
type, se ovenfor under læs_param_sæt.
\f
message procedure læs_param_sæt side 2 - 810428/hko;
parm skal omfatte elementerne 1 til 4.
(retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
terne værdien 0.
type (element,indhold)
1: 1-4,teksten
2-3: 1, talværdien
4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
5: 1, talværdi (uden G)
6: 1, (som'4') shift 7 + løb
7: 1, bus
2, linie/løb som '6'
8: 1, tal shift 5 eller som '4'
2, tekst (1-3 bogstaver)
3, løb
9: 1 og 2, som '8'
10: 1, talværdi
2, talværdi
11: 1, som '5'
2, vogn (bus eller linie/løb)
12: 1, dato
2, tid
term iso-tegnværdien for tegnet der afslutter
(retur,int) parameter_sættet.
res som læs_param_sæt.
(retur,int)
*>
\f
message procedure læs_param_sæt side 3 - 810310/hko;
begin
integer max_ant;
max_ant:= 3;
begin
integer
i,j,k, <* hjælpe variable *>
nr, <* nummer på parameter i sættet *>
apos, <* aktuel tegnposition *>
cifre, <* parametertype (param: 0=tekst, >1=tal) *>
sep; <* afsluttende skilletegn ved param *>
integer array field
iaf; <* hjælpe variabel *>
integer array
par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
s, <* 1 element med separator for hver parameter *>
t(1:max_ant), <* 1 element med typen for hver parameter *>
værdi(1:4), <* værdi af aktuel parameter jvf. param *>
spec(1:1); <* specialtegn i navne jvf. param *>
<* de interne typer af enkeltparametre er
type parameter
1: 1-3 tegn tekst (1 ord)
2: 4-6 tegn (2 ord)
3: 7-9 tegn (3 ord)
4:10-11 tegn (4 ord)
5: positivt heltal
6: negativt heltal
7: positivt heltal<1000 efterfulgt af stort bogstav
8: G efterfulgt af positivt heltal<100
*>
\f
message procedure læs_param_sæt side 4 - 810408/hko;
nr:= 0;
res:= -1;
spec(1):= 0; <* ingen specialtegn *>
apos:= pos;
for i:= 1 step 1 until 4 do parm(i):= 0;
for i:= 1 step 1 until max_ant do
begin
s(i):= t(i):= 0;
for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
end;
repeat
<* skip foranstillede sp-tegn *>
for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
while i=1 and sep='sp' do;
<*+2*>
begin
if testbit25 and testbit26 then
disable begin
write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
i,apos,cifre,sep);
laf:=0;
if cifre<>0 then
write(out,<: værdi(1-4)::>,
<< -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
else write(out,<: værdi::>,værdi.laf);
ud;
end;
end;
<*-2*>
;
if i<>0 then <* ikke ok *>
begin
if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
begin
apos:= apos -1;
res:= 0;
end
else if i=1 then res:=-26 <* skilletegn *>
else <* i=5 *> res:= -25 <* parameter mangler *>
end
else <* i=0 *>
begin
if sep=',' or sep=';' then apos:=apos-1;
iaf:= nr*8;
nr:= nr +1;
\f
message procedure læs_param_sæt side 5 - 810520/hko/cl;
if cifre=0 <* navne_parameter *> then
begin
if værdi(2)=0
and læstegn(værdi,1,i)='G'
and læstegn(værdi,2,j)>'0' and j<='9'
and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
then
begin <* gruppenavn, repræsenteres som tal *>
t(nr):= 8;
j:= j -'0';
par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
s(nr):= sep;
end
else
begin <* generel tekst *>
i:= 0;
for i:= i +1 while i<=4 do
begin
if værdi(i)<>0 then
begin
t(nr):= i;
par.iaf(i):= værdi(i);
end
else i:= 4;
end;
s(nr):= sep;
end <* generel tekst *>
end <* navne_parameter *>
else
begin <* talparameter *>
i:= if værdi(1)<0 then 6 <* neg.tal *>
else if værdi(1)>0 and værdi(1)<1000
and sep>='A' and sep<='Å' then 7
else 5 <* positivt tal *>;
t(nr):= i;
par.iaf(1):= if i<>7 then værdi(1)
else værdi(1) shift 5 +(sep+1-'A');
par.iaf(2):= cifre;
apos:= apos+1;
s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
apos:= apos-1;
end;
end;<* i=0 *>
until (ant>0 and nr=ant)
or nr=max_ant
or res<> -1
or sep='sp' or sep=';' or sep='em'
or sep=',' or sep='nl' or sep='nul';
\f
message procedure læs_param_sæt side 6 - 810508/hko;
if ant>nr then res:= -25 <*parameter mangler*>
else
if nr=0 or t(1)=0 then
begin <* ingen parameter før skilletegn *>
if res=-25 then res:= 0;
end
else if sep<>'sp' and sep<>'nl' and sep <> 'em'
and sep<>';' and sep<>',' then
begin <* ulovligt afsluttende skilletegn *>
res:= -26;
end
else
begin <* en eller flere lovligt afsluttede parametre *>
if t(1)<5 and nr=1 then
<* 1 navne_parameter *>
begin
res:= 1;
tofrom(parm,par,8);
end
else if <*t(1)<9 and *> nr=1 then
<* 1 parameter af anden type *>
begin <*tal,linie eller gruppe *>
res:= t(1) -3;
parm(1):= par(1);
end
else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
<* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
begin
i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
j:= par(5); <* internt *>
k:= par(9); <* *>
if nr=2 then
<* 2 parametre i sættet *>
begin
res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
else if s(1)='.' and t(2)=1 then 9
else if s(1)='-' and t(1)=5 and t(2)=5 then 10
else if s(1)<>'/' and s(1)<>'.'
and s(1)<>'-' then -26 <* skilletegn *>
else -27;<* parametertype*>
\f
message procedure læs_param_sæt side 7 - 810501/hko;
<* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
<* 2 parametre i sættet *>
if res=6 then
begin
if (i<1 or i>999) and t(1)=5 then
res:= -5 <* ulovligt linienr *>
else if (j<1 or j>99) then
res:= -6 <* ulovligt løbsnr *>
else
begin
if t(1)=5 then i:= i shift 5;
parm(1):= i shift 7 +j;
end;
end <* res=6 *>
else if res=9 then
begin
if t(1)=5 and (i<1 or 999<i) then
res:= -5 <*ulovligt linienr*>
else
begin
if t(1)=5 then i:=i shift 5;
parm(1):= i;
parm(2):= j;
end;
end <* res=9 *>
else if res=10 then
begin
begin
parm(1):= i;
parm(2):= j;
end;
end; <* res=10 *>
end <* nr=2 *>
else
if nr=3 then
<* 3 paramtre i sættet *>
begin
res:= if (s(1)='/' or s(1)='.') and
(s(2)='/' or s(2)='.') then 7
else if s(1)='.' and s(2)=':' then 8
else -26; <* skilletegn *>
\f
message procedure læs_param_sæt side 8 - 810501/hko;
<* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
<* 3 parametre i sættet *>
if res=7 then
begin
if t(1)<>5 or (t(2)<>5 and t(2)<>7)
or t(3)<>5 then
res:= -27 <* parametertype *>
else
if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
else if k<1 or k>99 then res:= -6 <* løb *>
else
begin <* ok *>
parm(1):= i;
if t(2)=5 then j:= j shift 5;
parm(2):= j shift 7 +k;
end;
end
else if res=8 then
begin
if t(2)<>1 or t(3)<>5 then res:= -27
else if t(1)=5 and (i<1 or i>999) then res:= -5
else if k<1 or k>99 then res:= -6
else
begin
if t(1)=5 then i:= i shift 5;
parm(1):= i;
parm(2):= j;
parm(3):= k;
end;
end;
end <* nr=3 *>
else res:=-24; <* syntaks *>
\f
message procedure læs_param_sæt side 9 - 810428/hko;
end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
else if t(1)=8 <* gruppe_id *> then
begin
<* mere end 1 parameter , hvoraf den første
er en gruppe_identifikation ved navn.
lovlige parametre er alle internt repræsenteret i et ord *>
i:=par(1);
j:=par(5);
k:=par(9);
if nr=2 then
<* 2 parametre *>
begin
res:=if s(1)=':' and t(2)=5 then 11
else if s(1)<>':' then -26 <* skilletegn *>
else -27; <*param.type *>
if res=11 then
begin
if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
else
begin
parm(1):=i;
parm(2):=j;
end;
end;
\f
message procedure læs_param_sæt side 10 - 810428/hko;
<* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
end <*nr=2*>
else if nr=3 then
<* 3 parametre *>
begin
res:=if s(1)=':' and s(2)='/' then 11
else -26; <* skilletegn *>
if res=11 then
begin
if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
else
begin
if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
else
begin
parm(1):=i;
if t(2)=5 then j:=j shift 5;
parm(2):= 1 shift 22 +j shift 7 +k;
end;
end;
end;
end <* nr=3 *>
else res:=-24; <* syntaks *>
\f
message procedure læs_param_sæt side 11 - 810501/hko;
end <* t(1)=8 *>
else if t(1)=1 and par(1)= 'D' shift 16 then
begin
<* mere end 1 parameter i sættet og 1. parameter er et 'D'.
lovlige parametre er alle internt repræsenteret i et ord. *>
i:=par(1);
j:=par(5);
k:=par(9);
if nr=3 then
begin
res:=if s(1)='.' and s(2)='.' then 12
else -26; <* skilletegn *>
if res=12 then
begin
if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
else
begin
integer år,md,dg,tt,mm,ss;
real dato,tid;
år:=j//10000;
md:=(j//100) mod 100;
dg:=j mod 100;
cifre:= par(10);
tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
else k;
mm:=if cifre>4 then (k//100) mod 100
else if cifre>2 then k mod 100 else 0;
ss:=if cifre>4 then k mod 100 else 0;
\f
message procedure læs_param_sæt side 12 - 810501/hko;
dato:=systime(5,0.0,tid);
if j=0 then dg:=round dato mod 100;
if år=0 and md=0 then md:=(round dato//100) mod 100;
if år=0 then år:=round dato//10000;
if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
res:=-24 <* syntaks *>
else if dg<1 or dg > (case md of (
31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
31,31,30, 31,30,31)) then res:=-24
else
begin
parm(1):=år*10000+md*100+dg;
parm(2):=tt*10000+mm*100+ss;
end;
end;
end; <* res=12 *>
end <* nr=3 *>
else res:=-24; <*syntaks*>
end <* t(1)=1 and par(1)='D' shift 16 *>
else res:=-27;<*parametertype*>
end; <* en eller flere parametre *>
læs_param_sæt:= res;
term:= sep;
if res>= 0 then pos:= apos;
end;
end læs_param_sæt;
\f
message procedure læs_kommando side 1 - 810428/hko;
integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
value kilde;
zone z;
integer kilde, pos,indeks,sep,slut_tegn;
integer array field op_ref;
<* proceduren indlæser er kommmando fra en terminal (telex,
skærm eller skrivemaskine). ved indlæsning fra skærm eller
skrivemaskine inviteres først ved udskrivning af '>'-tegn.
for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
23'ende linie inden invitation.
*>
\f
message procedure læs_kommando side 2 - 810428/hko;
begin
integer
a_pos,
a_res,res,
i,j,k;
boolean
skip;
<*V*>setposition(z,0,0);
case kilde//100 of
begin
begin <* io *>
write(z,"nl",1,">",1);
end;
begin <* operatør *>
cursor(z,24,1);
write(z,"esc" add 128,1,<:ÆK:>);
cursor(z,23,1);
write(z,"esc" add 128,1,<:ÆK:>);
outchar(z,'>');
end;
begin <* garageterminal *> ;
outchar(z,'nl');
end
end;
<*V*>setposition(z,0,0);
\f
message procedure læs_kommando side 3 - 810921/hko,cl;
res:=0;
skip:= false;
<*V*>
k:=læs_store(z,i);
apos:= 1;
while k<=6 <*klasse=bogstav*> do
begin
if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
<*V*> k:= læs_store(z,i);
end;
skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
if i=',' and a_pos>1 then
begin
skrivtegn(d.op_ref.data,a_pos,i);
repeat
<*V*> k:= læs_store(z,i);
if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
until k>=7;
end;
pos:=a_pos;
while k<8 do
begin
if a_pos< (att_op_længde//2*3-2) then
skriv_tegn(d.op_ref.data,a_pos,i);
skip:= skip or i='?';
<*V*> k:= læs_store(z,i);
pos:=pos+1;
end;
skip:= skip or i='?' or i='esc';
slut_tegn:= i;
skrivtegn(d.op_ref.data,apos,'em');
afslut_text(d.op_ref.data,apos);
\f
message procedure læs_kommando side 4 - 820301/hko/cl;
disable
begin
integer
i1,
nr,
partype,
cifre;
integer array
spec(1:1),
værdi(1:4);
<*+2*>
if testbit25 and overvåget then
disable begin
real array field raf;
write(out,"nl",1,<:kommando læst::>);
laf:=data;
write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
<: skip=:>,if skip then <:true:> else <:false:>);
ud;
end;
<*-2*>
for i:=1 step 1 until 32 do ia(i):=0;
if skip then
begin
res:=53; <*annulleret*>
pos:= -1;
goto slut_læskommando;
end;
\f
message procedure læs_kommando side 5 - 850820/cl;
i:= kilde//100; <* hovedmodul *>
k:= kilde mod 100; <* løbenr *>
<* if pos>79 then linieoverløb; *>
pos:=a_pos:=0;
spec(1):= ',' shift 16;
<*+4*>
if k<1 or k>(case i of (1,max_antal_operatører,
max_antal_garageterminaler)) then
begin
fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
res:=31;
end
else
<*-4*>
if i>0 and i<4 then <* io, operatør eller garageterminal *>
begin
<* læs operationskode *>
j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
else if j=2 then 4 <*ukendt kommando*>
else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
else if sep<>'sp' and sep<>','
and sep<>'nl' and sep<>';'
and sep<>'nul' and sep<>'em' then 26
<*skilletegn*>
else if -, læsbit_i(værdi(4),i-1) then 4
<* logand(extend 0 add værdi(4)
extend 1 shift (case i of (0,k,8+k)))=0 then 4
*> <*ukendt kommando*>
else 1;
\f
message procedure læs_kommando side 5a- 810409/hko;
<*+2*>if testbit25 and overvåget then
begin
write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
<< -dddd>,j,apos,cifre,sep,res,
<: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
"nl",0);
if j<>0 then skriv_op(out,op_ref);
ud;
end;
<*-2*>
if res=31 then fejlreaktion(18<*tabelfil*>,j,
<:=res, filnr 1025, læskommando:>,0);
if res=1 then <* operationskode ok *>
begin
if sep<>'sp' then apos:=apos-1;
d.op_ref.opkode:=værdi(1);
indeks:=værdi(2);
partype:= værdi(3);
nr:= 0;
pos:= apos;
\f
message procedure læs_kommando side 6 - 810409/hko;
while res=1 do
begin
læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
værdi,sep,a_res);
nr:= nr +1;
i1:= værdi(1);
<*+2*> if testbit25 and overvåget then
begin
write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
apos,sep,ares,<: værdi(1-4)::>,
værdi(1),værdi(2),værdi(3),værdi(4),
"nl",0);
ud;
end;
<*-2*>
case par_type of
begin
<*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
begin
if nr=1 then
begin
if a_res=0 then res:=2 <*godkendt*>
else if a_res=2 and (i1<1 or i1>9999)
then res:=7 <*busnr ulovligt*>
else if a_res=2 or a_res=6 then
begin
ia(1):= if a_res=2 then i1
else 1 shift 22 +i1;
end
else res:= 27; <*parametertype*>
if res<4 then pos:= apos;
end <*nr=1*>
else
if nr=2 then
begin
if ares=0 then res:= 2 <*godkendt*>
else if ares=1 then
begin
ia(2):= find_område(i1);
if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
end
else res:= 27; <* syntaks, parametertype *>
end
else
if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
end;
\f
message procedure læs_kommando side 7 - 810226/hko;
<*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <*parameter mangler*>
else if a_res=2 and (i1<1 or i1>9999)
then res:=7 <*busnr ulovligt*>
else if a_res=2 or a_res=6 then
begin
ia(1):=if a_res=2 then i1
else 1 shift 22 +i1;
end
else res:= 27; <*parametertype*>
if res<4 then pos:=a_pos;
end
else
if nr=2 then
begin
if ares=0 then res:= 2 <*godkendt*> else
if ares=1 and ia(1) shift (-21) = 0 then
begin
ia(2):= findområde(i1);
if ia(2)=0 then res:= 56; <*område ukendt*>
end
else res:= 27;
if res<4 then pos:= apos;
end
else
if ares=0 then res:= 2 else res:= 24<*syntaks*>;
end;
\f
message procedure læs_kommando side 8 - 810223/hko;
<*3: (<linie>!G<nr>) *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <*parameter mangler*>
else if a_res=2 and (i1<1 or i1>999) then res:=5
<*linienr ulovligt*>
else if a_res=2 or a_res=4 or a_res=5 then
begin
ia(1):=
if a_res=2 then 4 shift 21 +i1 shift 5
else if a_res=4 then 4 shift 21 +i1
else <* a_res=5 *> 5 shift 21 +i1;
end
else res:=27; <* parametertype *>
if res<4 then pos:= a_pos;
end
else
res:= if nr=2 and a_res<>0 then 24<*syntaks*>
else 2;<*godkendt*>
end;
<*4: <ingenting> *>
begin
res:= if a_res<>0 then 24<*syntaks*>
else 2;<*godkendt*>
end;
\f
message procedure læs_kommando side 9 - 810226/hko;
<*5: (<kanalnr>) *>
begin
long field lf;
if nr=1 then
begin
if a_res=0 then res:= 25
else if a_res<>1 then res:=27<*parametertype*>
else
begin
j:= 0; lf:= 4;
for i:= 1 step 1 until max_antal_kanaler do
if kanal_navn(i)=værdi.lf then j:= i;
if j<>0 then
begin
ia(1):= 3 shift 22 + j;
res:= 2;
end
else
res:= 17; <* kanal ukendt *>
end;
if res<4 then pos:= a_pos;
end
else
res:=if nr=2 and a_res<>0 then 24<*syntaks*>
else 2;<*godkendt*>
end;
\f
message procedure læs_kommando side 10 - 810415/hko;
<*6: <busnr>/<linie>/<løb> (<område>) *>
begin
if nr=1 then
begin
if a_res=0 then res:=25<*parameter mangler*>
else if a_res=7 then
begin
ia(1):= i1;
ia(2):= 1 shift 22 + værdi(2);
end
else res:=27;<*parametertype*>
if res<4 then pos:= apos;
end
else
if nr=2 then
begin
if ares=0 then res:= 2 <*godkendt*> else
if ares=1 then
begin
ia(3):= findområde(i1);
if ia(3)=0 then res:= 56; <* område ukendt *>
end
else res:= 27; <*parametertype*>
if res<4 then pos:= apos;
end
else
if ares=0 then res:= 2 else res:= 24;
end;
\f
message procedure læs_kommando side 11 - 810512/hko/cl;
<* att_op_længde//2-2 *>
<*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
<* 1 *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <*parameter mangler*>
else if a_res=8 then
begin
ia(1):= 4 shift 21 + i1;
ia(2):= værdi(2);
ia(3):= værdi(3);
indeks:= 3;
end
else res:=27;<*parametertype*>
end
else if nr<=att_op_længde//2-2 then
begin
if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
else if a_res=0 then res:=25 <* parameter mangler *>
else if a_res=10 then
begin
if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
begin
ia(nr+2):= i1 shift 12 + værdi(2);
indeks:= nr +2;
end
else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
else res:=6; <*løb-nr ulovligt*>
end
else res:=27;<*parametertype*>
end
else
res:= if a_res=0 then 2 else 24;<* syntaks *>
if res<4 then pos:=a_pos;
end;
\f
message procedure læs_kommando side 12 - 810306/hko;
<*8: (<operatør>!<radiokanal>!<garageterminal>) *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <* parameter mangler *>
else if a_res=2 then
begin
j:=d.op_ref.opkode;
ia(1):=i1;
k:=(j+1)//2;
if k<1 or k=3 or k>4 then
fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
else
begin
if k=4 then k:=3;
if i1<1 or i1> (case k of
(max_antal_operatører,max_antal_radiokanaler,
max_antal_garageterminaler))
then res:=case k of (28,29,17);
end;
end
else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
begin
laf:= 0;
ia(1):= find_bpl(værdi.laf(1));
if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
end
else res:=27; <*parametertype*>
end
else
if nr=2 and d.opref.opkode=1 then
begin
<* åbningstilstand for operatørplads *>
if a_res=0 then res:= 2 <*godkendt*>
else if a_res<>1 then res:= 27 <*parametertype*>
else begin
res:= 2<*godkendt*>;
j:= værdi(1) shift (-16);
if j='S' then ia(2):= 3 else
if j<>'Å' then res:= 24; <*syntaks*>
end;
end
else
begin
res:=if a_res=0 then 2 <* godkendt *>
else 24;<* syntaks *>
end;
if res<4 then pos:=a_pos;
end; <* partype 8 *>
\f
message procedure læs_kommando side 13 - 810306/hko;
<* att_op_længde//2 *>
<*9: <operatør>((+!-)<linienr>) *>
<* 1 *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <* parameter mangler *>
else if a_res=2 then
begin
ia(1):=i1;
if i1<1 or i1>max_antal_operatører then res:=28;
end
else if a_res=1 then
begin
laf:= 0;
ia(1):= find_bpl(værdi.laf(1));
if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
end
else res:=27; <* parametertype *>
end
else if nr<=att_op_længde//2 then
begin <* nr>1 *>
if a_res=0 then res:=(if nr>2 then 2 else 25)
else if a_res=2 or a_res=3 then
begin
ia(nr):=i1; indeks:= nr;
if i1=0 or abs(i1)>999 then res:=5;
end
else res:=27; <* parametertype *>
if res<4 then pos:=a_pos;
end
else
res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
else 2;
end; <* partype 9 *>
\f
message procedure læs_kommando side 14 - 810428/hko;
<* 2 *>
<*10: (bus) *>
<* 1 *>
begin
if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
else if a_res=0 then res:=2 <* godkendt *>
else if a_res<>2 then res:=27 <* parametertype *>
else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
else
ia(nr):=i1;
end;
<* 5 *>
<*11: (<linie>) *>
<* 1 *>
begin
if a_res=0 and nr=1 then res:=25
else if a_res<>0 and nr>5 then res:=24
else if a_res=0 then res:=2
else if a_res<>2 and a_res<>4 then res:=27
else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
else
ia(nr):=
(if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
end;
\f
message procedure læs_kommando side 15 - 810306/hko;
<*12: (<ingenting>!<navn>) *>
begin
if nr=1 then
begin
if a_res=0 then res:=2 <*godkendt*>
else if a_res=1 then
tofrom(ia,værdi,8)
else res:=27; <* parametertype *>
end
else
res:=if a_res<>0 then 24 <* syntaks (for mange) *>
else 2;
end; <* partype 12 *>
\f
message procedure læs_kommando side 16 - 810512/hko/cl;
<* 15 *>
<*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
<* 1 *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <* parameter mangler *>
else
if a_res=11 then
begin
ia(1):= 5 shift 21 + i1;
ia(2):=værdi(2);
indeks:= 2;
end
else res:=27; <* parametertype *>
end
else if nr<= att_op_længde//2-1 then
begin
if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
else if a_res=0 then res:=25 <* parameter mangler *>
else if ares=2 and (i1<1 or i1>9999) then
res:= 7 <*busnr ulovligt*>
else if a_res=2 or a_res=6 then
begin
ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
indeks:= nr+1;
end
else res:=27; <* parametertype *>
end
else
res:=if a_res=0 then 2 <*godkendt *>
else 24;<* syntaks *>
if res<4 then pos:=a_pos;
end; <* partype 13 *>
\f
message procedure læs_kommando side 17 - 810311/hko;
<*14: <linie>.<indeks> *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <* parameter mangler *>
else if a_res=9 then
begin
ia(1):= 1 shift 23 +i1;
ia(2):= værdi(2);
end
else res:=27; <* parametertype *>
end
else <* nr>1 *>
res:= if a_res=0 then 2 <* godkendt *>
else 24;<* syntaks *>
end; <* partype 14 *>
\f
message procedure læs_kommando side 18 - 810313/hko;
<*15: <linie>.<indeks> <bus> *>
begin
if nr=1 then
begin
if a_res=0 then res:= 25 <* parameter mangler *>
else if a_res=9 then
begin
ia(1):= 1 shift 23 +i1;
ia(2):= værdi(2);
end
else res:=27; <* parametertype *>
end
else if nr=2 then
begin
if a_res=0 then res:=25
else if a_res=2 then
begin
if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
else ia(3):= i1;
end
else res:=27; <*parametertype *>
end
else
res:=if a_res=0 then 2 <* godkendt *>
else 24;<* syntaks *>
if res<4 then pos:=a_pos;
end; <* partype 15 *>
\f
message procedure læs_kommando side 19 - 810311/hko;
<*16: (<ingenting>!D.<dato>.<klokkeslet> *>
begin
if nr=1 then
begin
if a_res=0 then res:=2 <* godkendt *>
else if a_res=12 then
begin
raf:=0;
ia.raf(1):= systid(i1,værdi(2));
end
else res:=27; <* parametertype *>
end
else
res:= if a_res=0 then 2 <* godkendt *>
else 24;<* syntaks *>
if res<4 then pos:=a_pos;
end; <* partype 16 *>
\f
message procedure læs_kommando side 20 - 810511/hko;
<*17: G<grp.nr> *>
begin
if nr=1 then
begin
if a_res=0 then res:=25 <*parameter mangler *>
else if a_res=5 then
begin
ia(1):= 5 shift 21 +i1;
end
else res:=27; <* parametertype *>
end
else
res:= if a_res=0 then 2 <* godkendt *>
else 24;<* syntaks *>
end; <* partype 17 *>
<* att_op_længde//2 *>
<*18: (<heltal>) *>
<* 1 *>
begin
if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
else
if nr<=att_op_længde//2 then
begin
if a_res=2 or a_res=3 <* pos/neg heltal *> then
begin
ia(nr):= i1; indeks:= nr;
end
else if a_res=0 then res:= 2
else res:= 27; <*parametertype*>
end
else
res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
end;
\f
message procedure læs_kommando side 21 - 820302/cl;
<*19: <linie>/<løb> <linie>/<løb> *>
begin
if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
else if nr<3 then
begin
ia(nr):=i1 + 1 shift 22;
end
else
res:= if a_res=0 then 2 <*godkendt*>
else 24;<*syntaks (for mange)*>
if res<4 then pos:= a_pos;
end; <* partype 19 *>
<*20: <busnr> <kortnavn> *>
begin
if nr=1 then
begin
if ares=0 then res:= 25 else
if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
if ares<>2 then res:= 27 else ia(1):= i1;
end
else
if nr=2 then
begin
if ares=1 and værdi(2) extract 8 = 0 then
begin
ia(2):= værdi(1); ia(3):= værdi(2);
end
else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
end
else
if ares=0 then res:= 2 else res:= 24;
end; <* partype 20 *>
\f
message procedure læs_kommando side 22 - 851001/cl;
<* 2 *>
<*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
<* 0 *>
begin
laf:= 0;
if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
else if a_res=0 then res:= 2 <*godkendt*>
else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
else if (a_res=2 or a_res=4) and nr<=2 then
begin
if ia(3)<>0 then res:= 27 else
ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
end
else
if ares=1 then
begin
if nr=1 then
begin
ia(1):= (4 shift 21) + (1 shift 5);
ia(2):= (4 shift 21) + (999 shift 5);
end;
if ia(3)=-2 then
begin
if i1=long<:ALL:> shift (-24) extract 24 then
ia(3):= -1
else
begin
ia(3):= findområde(i1);
if ia(3)=0 then res:= 56 else
ia(3):= 14 shift 20 + ia(3);
end;
end
else
if ia(3) = 0 then
begin
if i1 = long<:OMR:> shift (-24) extract (24) then
ia(3):= -2
else
ia(3):= find_bpl(værdi.laf(1));
if ia(3)=0 then res:= 55;
end
else res:= 24;
end
else res:= 27; <*parametertype*>
if res<4 then pos:= apos;
end;
<*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
begin
if nr=1 then
begin
if ares=0 then res:= 25 <*parameter mangler*>
else if ares=2 and (i1<1 or i1>9999)
then res:= 7 <* busnr ulovligt *>
else if ares=2 or ares=6 then
begin
ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
end
else res:= 27 <* parametertype *>
end
else
if nr=2 then
begin
if ares=0 then res:= 2 <* godkendt *>
else if ares=1 then
begin
ia(2):= findområde(i1);
if ia(2)=0 then res:= 17 <*kanal ukendt*>
end
else
res:= 27; <* parametertype *>
end
else if ares=0 then res:= 2 <*godkendt*>
else res:= 24; <*syntaks*>
if res < 4 then pos:= apos;
end;
<*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
begin
if nr=1 then
begin
if ares=0 then res:= 25 else
if ares=2 and (i1<1 or i1>999) then res:= 5 else
if ares=2 or ares=4 or ares=5 then
begin
ia(1):=
if ares=2 then 4 shift 21 + i1 shift 5 else
if ares=4 then 4 shift 21 + i1 else
5 shift 21 + i1;
end
else res:= 27;
if res < 4 then pos:= apos;
end
else
if nr=2 then
begin
if ares=0 then res:= 2 else
if ares=1 then
begin
ia(2):= findområde(i1);
if ia(2)=0 then res:= 17;
end
else res:= 27;
end
else
if ares=0 then res:= 2 else res:= 24;
end;
<*24: ( <ingenting> ! <område> ! * ) *>
begin
if nr=1 then
begin
if ares=0 then res:= 2 else
if ares=1 then
begin
if i1=long<:ALL:> shift (-24) extract 24 then
ia(1):= (-1) shift (-3) shift 3
else
begin
k:= findområde(i1);
if k=0 then res:= 17 else
ia(1):= 14 shift 20 + k;
end;
end
else res:= 27;
end
else
if ares=0 then res:= 2 else res:= 24;
if res < 4 then pos:= apos;
end;
<*25: <område> *>
begin
if nr=1 then
begin
if ares=0 then res:= 25 else
if ares=1 then
begin
if i1 = '*' shift 16 then ia(1):= -1 else
ia(1):= findområde(i1);
if ia(1)=0 then res:= 17;
end
else res:= 27;
end
else
if ares=0 then res:= 2 else res:= 24;
if res < 4 then pos:= apos;
end;
<*26: <busnr> *>
begin
if nr=1 then
begin
if ares=0 then res:= 25 else
if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
if ares<>2 then res:= 27 else ia(1):= i1;
end
else
if ares=0 then res:= 2 else res:= 24;
end;
<* 8 *>
<*27: <operatørnr> (<område>) *>
<* 1 *>
begin
if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
else if nr=1 then
begin
if a_res=2 then
begin
ia(1):= i1;
if i1 < 0 or max_antal_operatører < i1 then res:= 28;
end
else if a_res=1 then
begin
laf:= 0;
ia(1):= find_bpl(værdi.laf(1));
if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
end
else res:= 27; <*parametertype*>
end
else
begin
if a_res=0 then res:= (if nr > 2 then 2 else 25)
else if nr > 9 then res:= 24
else if a_res=1 then
begin
ia(nr):= find_område(i1);
indeks:= nr;
if ia(nr)=0 then res:= 56;
end
else res:= 27;
end;
if res < 4 then pos:= a_pos;
end <* partype 27 *>;
<*28: (<ingenting>!<kanalnr>) *>
begin
long field lf;
if nr=1 then
begin
if ares=0 then res:= 2 else
if ares=1 then
begin
j:= 0; lf:= 4;
for i:= 1 step 1 until max_antal_kanaler do
if kanal_navn(i)=værdi.lf then j:= i;
if j<>0 then
begin
ia(1):= 3 shift 22 + j;
res:= 2;
end
else
res:= 17; <*kanal ukendt*>
end
else
res:= 27; <*parametertype*>
if res < 4 then pos:= apos;
end
else
res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
end;
<* n *>
<*29: <btj.pl.navn> ( <operatørnavn>) *>
<* 0 *>
begin
laf:= 0;
if nr=1 then
begin
if a_res=0 then res:= 25 <*parameter mangler*>
else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
else begin
indeks:= 2;
ia(1):= værdi(1); ia(2):= værdi(2);
j:= find_bpl(værdi.laf(1));
if 0<j and j<=max_antal_operatører then
res:= 62; <*ulovligt navn*>
end;
end
else
begin
if a_res=0 then res:= 2 <*godkendt*>
else if a_res<>1 then res:= 27 <*parametertype*>
else begin
indeks:= indeks+1;
ia(indeks):= find_bpl(værdi.laf(1));
if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
res:= 28; <*ukendt operatør*>
end;
end;
if res<4 then pos:= a_pos;
end;
<* 3 *>
<*30: (<operatørnavn>) ( <btj.pl.navn>) *>
<* io 0 *>
begin
boolean io;
io:= (kilde//100 = 1);
laf:= 0;
if -,io and nr=1 then
begin
indeks:= 1;
ia(1):= kilde mod 100; <*egen operatørplads*>
end;
if io and nr=1 then
begin
if a_res=0 then res:= 25 <*parameter mangler*>
else if a_res<>1 then res:= 27 <*parametertype*>
else begin
indeks:= nr;
ia(indeks):= find_bpl(værdi.laf(1));
if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
res:= 28; <*ukendt operatør*>
end;
end
else
begin
if a_res=0 then res:= 2<*godkendt*>
else if indeks=4 then res:= 24 <*syntaks, for mange*>
else if a_res<>1 then res:= 27 <*parametertype*>
else begin
indeks:= indeks+1;
ia(indeks):= find_bpl(værdi.laf(1));
if ia(indeks)=0 then res:= 46 <*navn ukendt*>
else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
end;
end;
if res<4 then pos:= a_pos;
end;
<* *>
<*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
<* *>
begin
laf:= 0;
if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
else
if nr=1 then
begin
if a_res=2 then
begin
ia(1):= i1;
if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
end else res:= 27; <*parametertype*>
end
else
if nr=2 then
begin
if a_res=1 and værdi(2) extract 8 = 0 then
begin
ia(2):= værdi(1); ia(3):= værdi(2);
j:= find_bpl(værdi.laf(1));
if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
end
else res:= if a_res=0 then 2 <*godkendt*>
else 27 <*parametertype*>;
end
else
if nr=3 then
begin
if a_res=0 then res:=2 <*godkendt*>
else if a_res<>1 then res:= 27 <*parametertype*>
else begin
j:= værdi(1) shift (-16);
if j='Å' then ia(4):= 1 else
if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
end;
end
else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
if res<4 then pos:= a_pos;
end;
<* 1 *>
<*32: (heltal) *>
<* 0 *>
begin
if nr=1 then
begin
if ares=0 then
begin
indeks:= 0; res:= 2;
end
else
if ares=2 or ares=3 then
begin
ia(nr):= i1; indeks:= nr;
end
else res:=27; <*parametertype*>
end
else
res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
if res < 4 then pos:= a_pos;
end;
<*33 generel tekst*>
begin
integer p,p1,ch,lgd;
if nr=1 and a_res<>0 then
begin
p:=pos; p1:=1;
lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
if 95<lgd then lgd:=95;
repeat læstegn(d.opref.data,p,ch) until ch<>' ';
while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
begin
skrivtegn(ia,p1,ch);
læstegn(d.opref.data,p,ch);
end;
if p1=1 then res:= 25 else res:= 2;
repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
end
else
if a_res=0 then res:= 25 else res:= 24;
end;
<*34: (heltal) *>
begin
if nr=1 then
begin
if ares=0 then res:= 25 else
if ares=2 or ares=3 then
begin
ia(nr):= i1; indeks:= nr;
end
else res:=27; <*parametertype*>
end
else
res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
if res < 4 then pos:= a_pos;
end;
<*+4*> begin
fejlreaktion(4<*systemfejl*>,partype,
<:parametertype fejl i kommandofil:>,1);
res:=31;
end
<*-4*>
end;<*case partype*>
end;<* while læs_param_sæt *>
end; <* operationskode ok *>
end
else
begin
fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
end;
if a_res<0 then res:= -a_res;
slut_læskommando:
læs_kommando:=d.op_ref.resultat:= res;
end;<* disable-blok*>
end læs_kommando;
\f
message procedure skriv_kvittering side 1 - 820301/hko/cl;
procedure skriv_kvittering(z,ref,pos,res);
value ref,pos,res;
zone z;
integer ref,pos,res;
begin
integer array field op;
integer pos1,tegn;
op:=ref;
if res<1 or res>3 then write(z,<:*** :>);
write(z,case res+1 of (
<* 0*><:ubehandlet:>,
<* 1*><:ok:>,
<* 2*><:godkendt:>,
<* 3*><:udført:>,
<* 4*><:kommando ukendt:>,
<* 5*><:linie-nr ulovligt:>,
<* 6*><:løb-nr ulovligt:>,
<* 7*><:bus-nr ulovligt:>,
<* 8*><:gruppe ukendt:>,
<* 9*><:linie/løb ukendt:>,
<*10*><:bus-nr ukendt:>,
<*11*><:bus allerede indsat på :>,
<*12*><:linie/løb allerede besat af :>,
<*13*><:bus ikke indsat:>,
<*14*><:bus optaget:>,
<*15*><:gruppe optaget:>,
<*16*><:skærm optaget:>,
<*17*><:kanal ukendt:>,
<*18*><:bus i kø:>,
<*19*><:kø er tom:>,
<*20*><:ej forbindelse :>,
<*21*><:ingen at gennemstille til:>,
<*22*><:ingen samtale at nedlægge:>,
<*23*><:ingen samtale at monitere:>,
<*24*><:syntaks:>,
<*25*><:syntaks, parameter mangler:>,
<*26*><:syntaks, skilletegn:>,
<*27*><:syntaks, parametertype:>,
<*28*><:operatør ukendt:>,
<*29*><:garageterminal ukendt:>,
\f
<*30*><:rapport kan ikke dannes:>,
<*31*><:systemfejl:>,
<*32*><:ingen fri plads:>,
<*33*><:gruppe for stor:>,
<*34*><:gruppe allerede defineret:>,
<*35*><:springsekvens for stor:>,
<*36*><:spring allerede defineret:>,
<*37*><:spring ukendt:>,
<*38*><:spring allerede igangsat:>,
<*39*><:bus ikke reserveret:>,
<*40*><:gruppe ikke reserveret:>,
<*41*><:spring ikke igangsat:>,
<*42*><:intet frit linie/løb:>,
<*43*><:ændring af dato/tid ikke lovlig:>,
<*44*><:interval-størrelse ulovlig:>,
<*45*><:ikke implementeret:>,
<*46*><:navn ukendt:>,
<*47*><:forkert indhold:>,
<*48*><:i brug:>,
<*49*><:ingen samtale igang:>,
<*50*><:kanal:>,
<*51*><:afvist:>,
<*52*><:kanal optaget :>,
<*53*><:annulleret:>,
<*54*><:ingen busser at kalde op:>,
<*55*><:garagenavn ukendt:>,
<*56*><:område ukendt:>,
<*57*><:område nødvendigt:>,
<*58*><:ulovligt område for bus:>,
<*59*><:radiofejl :>,
<*60*><:område kan ikke opdateres:>,
<*61*><:ingen talevej:>,
<*62*><:ulovligt navn:>,
<*63*><:alarmlængde: :>,
<*64*><:ulovligt tal:>,
<*99*><:- <'?'> -:>));
\f
message procedure skriv_kvittering side 3 - 820301/hko;
if res=3 and op<>0 then
begin
if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
begin
i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
if i<>0 then write(z,i,<: udtaget:>);
end;
end;
if res = 11 or res = 12 then
i:=ref;
if res=11 then write(z,i shift(-12) extract 10,
if i shift(-7) extract 5 =0 then false
else "A" add (i shift(-7) extract 5 -1),1,
<:/:>,<<d>,i extract 7) else
if res=12 then write(z,i extract 14) else
if res = 20 or res = 52 or res = 59 then
begin
i:= d.op.data(12);
if i <> 0 then skriv_id(z,i,8);
i:=d.op.data(2);
if i=0 then i:=d.op.data(9);
if i=0 then i:=d.op.data(8);
skriv_id(z,i,8);
end;
if res=63 then
begin
i:= ref;
if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
end;
if pos>=0 then
begin
pos:=pos+1;
outchar(z,':');
tegn:=-1;
while tegn<>10 and tegn<>0 do
outchar(z,læs_tegn(d.op.data,pos,tegn));
end;
<*V*>setposition(z,0,0);
end skriv_kvittering;
\f
message procedure cursor, side 1 - 810213/hko;
procedure cursor(z,linie,pos);
value linie,pos;
zone z;
integer linie,pos;
begin
if linie>0 and linie<25
and pos>0 and pos<81 then
begin
write(z,"esc" add 128,1,<:Æ:>,
<<d>,linie,<:;:>,pos,<:H:>);
end;
end cursor;
\f
message procedure attention side 1 - 810529/hko;
procedure attention;
begin
integer i, j, k;
integer array field op_ref,mess_ref;
integer array att_message(1:9);
long array field laf1, laf2;
boolean optaget;
procedure skriv_attention(zud,omfang);
integer omfang;
zone zud;
begin
write(zud,"nl",1,<:+++ attention :>);
if omfang <> 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: i: :>,i,"nl",1,
<: j: :>,j,"nl",1,
<: k: :>,k,"nl",1,
<: op-ref: :>,op_ref,"nl",1,
<: mess-ref: :>,mess_ref,"nl",1,
<: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
<: laf2 :>,laf2,"nl",1,
<: att-message::>,"nl",1,
<::>);
raf:= 0;
skriv_hele(zud,att_message.raf,18,127);
skriv_coru(zud,coru_no(010));
slut:
end;
end skriv_attention;
integer procedure udtag_tal(tekst,pos);
long array tekst;
integer pos;
begin
integer i;
if getnumber(tekst,pos,i) >= 0 then
udtag_tal:= i
else
udtag_tal:= 0;
end;
for i:= 1 step 1 until att_maske_lgd//2 do
att_signal(i):=att_flag(i):=0;
trap(att_trap);
stack_claim((if cm_test then 198 else 146)+50);
<*+2*>
if testbit26 and overvåget or testbit28 then
skriv_attention(out,0);
<*-2*>
\f
message procedure attention side 2 - 810406/hko;
repeat
wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
repeat
<*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
raf:= laf1:= 0;
laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
<*+2*>if testbit7 and overvåget then
disable begin
laf2:= abs(laf);
write(out,"nl",1,<:attention - :>);
if laf<=0 then write(out,<:Regrettet :>);
write(out,<:Message modtaget fra :>);
if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
skriv_hele(out,att_message.raf,16,127);
ud;
end;
<*-2*>
\f
message procedure attention side 3 - 830310/cl;
if laf <= 0 then
i:= -1
else
if core.laf(1)=konsol_navn.laf1(1)
and core.laf(2)=konsol_navn.laf1(2) then
i:= 101
else
begin
i:= -1; j:= 1;
while i=(-1) and (j <= max_antal_operatører) do
begin
laf2:= (j-1)*8;
if core.laf(1) = terminal_navn.laf2(1)
and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
j:= j+1;
end;
j:= 1;
while i=(-1) and (j<=max_antal_garageterminaler) do
begin
laf2:= (j-1)*8;
if core.laf(1) = garage_terminal_navn.laf2(1)
and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
j:= j+1;
end;
end;
if i=101 or (201<=i and i<=200+max_antal_operatører)
<* or (301<=i and i<=300+max_antal_garageterminaler) *>
then
begin
j:= if i=101 then 0
else max_antal_operatører*(i//100-2)+i mod 100;
ref:=j*terminal_beskr_længde;
att_message(9):=
if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
else 4 <*disconnected*>;
optaget:=læsbit_ia(att_flag,j);
if optaget and att_message(9)=1 then
sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
else optaget:=optaget or att_message(9)<>1;
if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
begin <* att fra ekskluderet operatør - inkluder *>
start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
d.op_ref.data(1):= i mod 100;
signalch(cs_rad,op_ref,gen_optype);
waitch(cs_att_pulje,op_ref,true,-1);
end;
end
else
begin
optaget:= true;
att_message(9):= 2 <*rejected*>;
end;
monitor(22)send_answer:(zdummy,mess_ref,att_message);
until -,optaget;
\f
message procedure attention side 4 - 810424/hko;
sætbit_ia(att_flag,j,1);
start_operation(op_ref,i,cs_att_pulje,0);
signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
until false;
att_trap:
skriv_attention(zbillede,1);
end attention;
:5: attention: initialisering
\f
message attention_initialisering side 1 - 850820/cl;
tf_kommandotabel:= 1 shift 10 + 1;
begin
integer i, s, zno;
zone z(128,1,stderror);
integer array fdim(1:8);
fdim(4):= tf_kommandotabel;
hentfildim(fdim);
open(z,4,<:htkommando:>,0);
for i:= 1 step 1 until fdim(3) do
begin
inrec6(z,512);
s:= skrivfil(tf_kommandotabel,i,zno);
if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
tofrom(fil(zno),z,512);
end;
close(z,true);
end;
\f
message attention_initialisering side 1a - 810428/hko;
for j:= system(3,i,terminal_tab) step 1 until i do
terminal_tab(j):= 0;
cs_att_pulje:=next_semch;
<*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
<*-3*>
bs_fortsæt_adgang:= nextsem;
<*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
<*-3*>
signalbin(bs_fortsæt_adgang);
for i:= 1,
1 step 1 until max_antal_operatører,
1 step 1 until max_antal_garageterminaler do
<* initialisering af pulje med attention_operationer *>
signalch(cs_att_pulje, <* pulje_semafor *>
nextop(data+att_op_længde), <* næste_operation *>
gen_optype);
att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
i:=next_coru(010,<*ident*>
2,<*prioritet*>
true<*test_maske*>);
j:=newactivity( i, <*activityno *>
0, <*ikke virtual *>
attention);<*ingen parametre*>
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
:6: attention trapaktion1.
write(zbillede,"nl",2,"=",20,<: attentionmodul :>,"=",20,"nl",1);
write(zbillede,"nl",1,<:attention-flag: :>,"nl",1);
outintbits_ia(zbillede,att_flag,1,att_maske_lgd//2);
write(zbillede,"nl",1,<:attention-signal: :>,"nl",1);
outintbits_ia(zbillede,att_signal,1,att_maske_lgd//2);
▶EOF◀