|
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: 774144 (0xbd000)
Types: TextFile
Names: »buskomtex05 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomtex05 «
begin algol list.off;
<* variables for claiming (accumulating) basic entities *>
integer maxsem, maxsemch, maxop, maxcoru, maxmessext, maxprocext, maxnettoop;
<* fields defining current position in pools af basic entities
during initialization *>
integer array field firstsem, firstsim, firstcoru, firstop, optop;
<* variables used as pointers to 'current object' (work variables) *>
integer messext, procext, timeinterval, testbuffering;
integer array field timermessage, coru, sem, op, receiver, currevent,
baseevent, prevevent;
<* variables defining the size of basic entities (descriptors) *>
integer corusize, semsize, simsize, opheadsize;
integer array clockmess(1:2);
real array clock(1:3);
boolean eventqueueempty;
algol list.on;
\f
message sys_parametererklæringer side 1 - 810127/cl;
boolean testbit0 ,testbit1 ,testbit2 ,testbit3 ,testbit4 ,testbit5 ,
testbit6 ,testbit7 ,testbit8 ,testbit9 ,testbit10,testbit11,
testbit12,testbit13,testbit14,testbit15,testbit16,testbit17,
testbit18,testbit19,testbit20,testbit21,testbit22,testbit23,
testbit24,testbit25,testbit26,testbit27,testbit28,testbit29,
testbit30,testbit31,testbit32,testbit33,testbit34,testbit35,
testbit36,testbit37,testbit38,testbit39,testbit40,testbit41,
testbit42,testbit43,testbit44,testbit45,testbit46,testbit47;
boolean cl_overvåget,out_tw_lp,
cm_test;
integer låsning;
\f
message sys_parametererklæringer side 2 - 810310.hko;
<* hjælpevariable *>
integer i,j,k;
integer array ia(1:32);
integer array field iaf,ref;
real r;
real array ra(1:3);
real array field raf;
real field rf;
long array la(1:2);
long array field laf;
procedure ud;
begin
<*
outchar(out,'nl');
if out_tw_lp then setposition(out,0,0);
*>
flushout('nl');
end;
\f
message sys_parametererklæringer side 3 - 810310/hko;
<* hovedmodul_parametre *>
integer
sys_mod,
io_mod,
op_mod,
gar_mod,
rad_mod,
vt_mod;
<* operations_parametre *>
integer field
kilde,
retur,
resultat,
opkode;
real field
tid;
integer array field
data;
boolean
sys_optype,
io_optype,
op_optype,
gar_optype,
rad_optype,
vt_optype,
gen_optype;
\f
message sys_parametererklæringer side 4 - 820301/hko,cl;
<* trimme-variable *>
integer
max_antal_operatører,
max_antal_taleveje,
max_antal_garageterminaler,
max_antal_garager,
max_antal_områder,
max_antal_radiokanaler,
max_antal_pabx,
max_antal_kanaler,
max_antal_mobilopkald,
min_antal_nødopkald,
max_antal_grupper,
max_antal_gruppeopkald,
max_antal_spring,
max_antal_busser,
max_antal_linie_løb,
max_antal_fejltekster,
max_linienr,
op_maske_lgd,
tv_maske_lgd;
integer array
konsol_navn,
taleswitch_in_navn,
taleswitch_out_navn,
radio_fr_navn,
radio_rf_navn(1:4),
alfabet(0:255);
integer
tf_systællere,
tf_stoptabel,
tf_bplnavne,
tf_bpldef,
tf_alarmlgd;
\f
message filparm side 1 - 800529/jg/cl;
integer
fil_op_længde,
dbantez,dbantsz,dbanttz,
dbmaxtf, dbmaxsf, dbblokt,
dbmaxb,dbbidlængde,dbbidmax,
dbmaxef;
long array
dbsnavn, dbtnavn(1:2);
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;
message io_parametererklæringer side 1 - 820301/hko;
message operatør_parametererklæringer side 1 - 810422/hko;
integer field
cqf_bus, cqf_fejl,
alarm_kmdo, alarm_tilst, alarm_gtilst, alarm_lgd;
real field
cqf_ok_tid, cqf_næste_tid,
alarm_start;
long field
cqf_id;
integer
max_cqf, cqf_lgd,
op_spool_postlgd,
op_spool_postantal,
opk_alarm_tab_lgd;
\f
message procedure radio_parametererklæringer side 1 - 810524/hko;
integer
radio_giveup,
opkaldskø_postlængde,
kanal_beskr_længde,
radio_op_længde,
radio_pulje_størrelse;
\f
message vogntabel parametererklæringer side 1 - 810309/cl;
integer vt_op_længde, vt_logskift;
boolean vt_log_aktiv;
\f
algol list.off;
message coroutinemonitor - 2 ;
maxsem:= maxsemch:= maxop:= maxcoru:= maxnettoop:= 0;
maxmessext:= maxprocext:= 1;
corusize:= 20;
simsize:= 6;
semsize:= 8;
opheadsize:= 8;
testbuffering:= 1;
timeinterval:= 5;
algol list.on;
algol list.on;
\f
message sys_parameterinitialisering side 1 - 810305/hko;
copyout;
cl_overvåget:= false;
getzone6(out,ia);
out_tw_lp:= ia(1) extract 12 = 8 or ia(1) extract 12 = 14;
testbit0 :=testbit( 0);
testbit1 :=testbit( 1);
testbit2 :=testbit( 2);
testbit3 :=testbit( 3);
testbit4 :=testbit( 4);
testbit5 :=testbit( 5);
testbit6 :=testbit( 6);
testbit7 :=testbit( 7);
testbit8 :=testbit( 8);
testbit9 :=testbit( 9);
testbit10:=testbit(10);
testbit11:=testbit(11);
testbit12:=testbit(12);
testbit13:=testbit(13);
testbit14:=testbit(14);
testbit15:=testbit(15);
testbit16:=testbit(16);
testbit17:=testbit(17);
testbit18:=testbit(18);
testbit19:=testbit(19);
testbit20:=testbit(20);
testbit21:=testbit(21);
testbit22:=testbit(22);
testbit23:=testbit(23);
\f
message sys_parameterinitialisering side 2 - 810316/cl;
testbit24:=testbit(24);
testbit25:=testbit(25);
testbit26:=testbit(26);
testbit27:=testbit(27);
testbit28:=testbit(28);
testbit29:=testbit(29);
testbit30:=testbit(30);
testbit31:=testbit(31);
testbit32:=testbit(32);
testbit33:=testbit(33);
testbit34:=testbit(34);
testbit35:=testbit(35);
testbit36:=testbit(36);
testbit37:=testbit(37);
testbit38:=testbit(38);
testbit39:=testbit(39);
testbit40:=testbit(40);
testbit41:=testbit(41);
testbit42:=testbit(42);
testbit43:=testbit(43);
testbit44:=testbit(44);
testbit45:=testbit(45);
testbit46:=testbit(46);
testbit47:=testbit(47);
cm_test:= false;
\f
message sys_parameterinitialisering side 3 - 810409/cl,hko;
timeinterval:=1; <* tidsinterval for cmon's timeoutinspection *>
if findfpparam(<:låsning:>,true,ia) > 0 then låsning:= ia(1)
else låsning:= 0;
\f
message sys_parameterinitialisering side 4 - 820301/hko/cl;
<* initialisering af hovedmodul_parametre *>
i:=0; sys_mod:=i;
i:=i+1; io_mod:=i;
i:=i+1; op_mod:=i;
i:=i+1; gar_mod:=i;
i:=i+1; rad_mod:=i;
i:=i+1; vt_mod:=i;
<* initialisering af operationstyper *>
sys_optype:=false add (1 shift sys_mod);
io_optype:= false add (1 shift io_mod);
op_optype:= false add (1 shift op_mod);
gar_optype:=false add (1 shift gar_mod);
rad_optype:=false add (1 shift rad_mod);
vt_optype:= false add (1 shift vt_mod);
gen_optype:=false add (1 shift 11);
<* initialisering af fieldvariable for operationer *>
i:=2; kilde:=i;
i:=i+4; tid:=i;
i:=i+2; retur:=i;
i:=i+2; opkode:=i;
i:=i+2; resultat:=i;
i:=i+0; data:=i;
<* initialisering af trimme-variable *>
max_antal_operatører:=28; <* hvis > 32 skal tf_systællere udvides *>
max_antal_taleveje:=12;
max_antal_garageterminaler:=3;
max_antal_garager:=99;
max_antal_radiokanaler:=16;
max_antal_pabx:=2;
max_antal_kanaler:=14; <* 1 pabx + 13 radio *>
max_antal_områder:=11; <* hvis > 16 skal tf_systællere udvides *>
max_antal_mobilopkald:=100;
min_antal_nødopkald:=20;
max_antal_grupper:=16;
max_antal_gruppeopkald:=16;
max_antal_spring:=16;
max_antal_busser:=2000;
max_antal_linie_løb:=2000;
max_antal_fejltekster:=21;
max_linienr:=999; <*<=999*>
op_maske_lgd:= ((1+max_antal_operatører+23)//24)*2;
tv_maske_lgd:= ((1+max_antal_taleveje+23)//24)*2;
\f
message sys_parameterinitialisering side 5 - 880901/cl;
<* initialisering af konsol-navn *>
raf:= 0;
if findfpparam(<:io:>,false,ia)>0 then
begin
for i:= 1 step 1 until 4 do konsol_navn(i):= ia(i);
end
else
system(7,0,konsol_navn);
<*
movestring(konsol_navn.raf,1,<:console1:>);
*>
raf:= 0;
<* intialiserning af talevejsswitchens navn *>
movestring(taleswitch_in_navn.raf,1,<:taleswitchi:>);
movestring(taleswitch_out_navn.raf,1,<:taleswitch:>);
<* initialisering af radiokanalnavne *>
movestring(radio_fr_navn.raf,1,<:radiofr:>);
movestring(radio_rf_navn.raf,1,<:radiorf:>);
<* initialisering af 'input'-alfabet *>
isotable(alfabet);
alfabet('esc'):= 8 shift 12 + 'esc';
<* for i:='a' step 1 until 'å' do alfabet(i):=alfabet(i)-32; *>
for i:= 128 step 1 until 255 do alfabet(i):= 0 shift 12 + i;
intable(alfabet);
<* initialsering af tf_systællere *>
tf_systællere:= 1024<*tabelfil*> + 8;
tf_stoptabel := 1024<*tabelfil*> + 5;
tf_bpl_navne := 1024<*tabelfil*> + 12;
tf_bpl_def := 1024<*tabelfil*> + 13;
tf_alarmlgd := 1024<*tabelfil*> + 14;
\f
message filparminit side 1 - 801030/jg;
fil_op_længde:= data + 18 <*halvord*>;
dbantez:= 1;
dbantsz:= 2;
dbanttz:= 3; <* >=2 aht. samtidig tilgang*>
dbblokt:= 8;
dbmaxsf:= 7;
dbbidlængde:= 3;
dbbidmax:= 5;
dbmaxb:= dbmaxsf * dbbidmax;
dbmaxef:= 12;
movestring(dbsnavn,1,<:spoolfil:>);
movestring(dbtnavn,1,<:tabelfil:>);
if findfpparam(<:tabelfil:>,false,ia)>0 then
tofrom(dbtnavn,ia,8);
\f
message filparminit side 2 - 801030/jg;
<* reserver og check spoolfil og tabelfil *>
begin integer s,i,funk,f;
zone z(128,1,stderror); integer array tail(1:10);
for f:=1,2 do
begin
<*open(z,4,string (case f of(dbsnavn,dbtnavn)),0);*>
case f of
begin
open(z,4,dbsnavn,0);
open(z,4,dbtnavn,0);
end;
for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do
begin
s:=monitor(funk,z,i,tail);
if s<>0 then system(9,funk*100+s,
case f of(<:<10>spoolfil:>,<:<10>tabelfil:>));
end;
case f of begin
begin integer antseg; <*spoolfil*>
antseg:=dbmaxb * dbbidlængde;
if tail(1) < antseg then
begin
tail(1):=antseg;
s:=monitor(44<*change*>,z,i,tail);
if s<>0 then
system(9,44*100+s,<:<10>spoolfil:>);
end;
end;
begin <*tabelfil*>
dbmaxtf:=tail(10);
if dbmaxtf<1 or dbmaxtf>1023 then
system(9,dbmaxtf,<:<10>tabelfil:>);
end
end case;
close(z,false);
end for;
end;
\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;
message io_parameterinitialisering side 1 - 810421/hko;
message operatør_parameterinitialisering side 1 - 810422/hko;
<* felter i cqf_tabel *>
cqf_lgd:=
cqf_næste_tid:= 16;
cqf_ok_tid := 12;
cqf_id := 8;
cqf_fejl := 4;
cqf_bus := 2;
max_cqf:= 64;
<* felter i opkaldsalarmtabel *>
alarm_kmdo := 2;
alarm_tilst := 4;
alarm_gtilst:= 6;
alarm_lgd := 8;
alarm_start := 12;
opk_alarm_tab_lgd:= 12;
op_spool_postantal:= 16;
op_spool_postlgd:= 64;
\f
message procedure radio_parameterinitialisering side 1 - 810601/hko;
radio_giveup:= 1 shift 21 + 1 shift 9;
opkaldskø_postlængde:= 10+op_maske_lgd;
kanal_beskr_længde:= 12+op_maske_lgd+tv_maske_lgd;
radio_op_længde:= 30*2;
radio_pulje_størrelse:= 1+max_antal_taleveje;
\f
message vogntabel parameterinitialisering side 1 - 810309/cl;
vt_op_længde:= data + 16; <* halvord *>
if findfpparam(<:vtlogskift:>,true,ia) > 0 then
vt_logskift:= ia(1) else vt_logskift:= -1;
vt_log_aktiv:= (vt_logskift >= 0) and (vt_logskift < 240000);
\f
message filclaim, side 1 - 810202/cl;
maxcoru:= maxcoru+6;
maxsem:= maxsem+2;
maxsemch:= maxsemch+6;
\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;
\f
message io_claiming side 1 - 810421/hko;
max_coru:= max_coru
+ 1 <* hovedmodul io *>
+ 1 <* io kommando *>
+ 1 <* io operatørmeddelelser *>
+ 1 <* io spontane meddelelser *>
+ 1 <* io spoolkorutine *>
+ 1 <* io tællernulstilling *>
;
max_semch:= max_semch
+ 1 <* cs_io *>
+ 1 <* cs_io_komm *>
+ 1 <* cs_io_fil *>
+ 1 <* cs_io_medd *>
+ 1 <* cs_io_spool *>
+ 1 <* cs_io_nulstil *>
;
max_sem:= max_sem
+ 1 <* ss_io_spool_fulde *>
+ 1 <* ss_io_spool_tomme *>
+ 1; <* bs_zio_adgang *>
max_op:=max_op
+ 1; <* fil-operation *>
max_nettoop:=max_nettoop
+ (data+18); <* fil-operation *>
\f
message operatør_claiming side 1 - 810520/hko;
max_coru:= max_coru +1 <* h_op *>
+1 <* alarmur *>
+1 <* opkaldsalarmer *>
+1 <* talevejsswitch *>
+1 <* tv_switch_adm *>
+1 <* tv_switch_input *>
+1 <* op_spool *>
+1 <* op_medd *>
+1 <* op_cqftest *>
+max_antal_operatører;
max_sem:= 1 <* bs_opk_alarm *>
+1 <* ss_op_spool_tomme *>
+1 <* ss_op_spool_fulde *>
+max_sem;
max_semch:= max_semch +1 <* cs_op *>
+1 <* cs_op_retur *>
+1 <* cs_opk_alarm_ur *>
+1 <* cs_opk_alarm_ur_ret *>
+1 <* cs_opk_alarm *>
+1 <* cs_talevejsswitch *>
+1 <* cs_tv_switch_adm *>
+1 <* cs_tvswitch_adgang *>
+1 <* cs_tvswitch_input *>
+1 <* cs_op_iomedd *>
+1 <* cs_op_spool *>
+1 <* cs_op_medd *>
+1 <* cs_cqf *>
+max_antal_operatører<* cs_operatør *>
+max_antal_operatører<* cs_op_fil *>;
max_op:= max_op + 1 <* talevejsoperation *>
+ 2 <* tv_switch_input *>
+ 1 <* op_iomedd *>
+ 1 <* opk_alarm_ur *>
+ 1 <* op_spool_medd *>
+ 1 <* op_cqftest *>
+ max_antal_operatører;
max_netto_op:= filoplængde*max_antal_operatører
+ data+128 <* talevejsoperation *>
+ 2*(data+256) <* tv_switch_input *>
+ 60 <* op_iomedd *>
+ data <* opk_alarm_ur *>
+ data+op_spool_postlgd <* op_spool_med *>
+ 60 <* op_cqftest *>
+ max_netto_op;
\f
message garage_claiming side 1 -810226/hko;
max_coru:= max_coru +1
+max_antal_garageterminaler;
max_semch:= max_semch +1
+max_antal_garageterminaler;
\f
message procedure radio_claiming side 1 - 810526/hko;
max_coru:= max_coru
+1 <* hovedmodul radio *>
+1 <* opkaldskø_meddelelse *>
+1 <* radio_adm *>
+max_antal_taleveje <* radio *>
+2; <* radio ind/-ud*>
max_semch:= max_semch
+1 <* cs_rad *>
+max_antal_taleveje <* cs_radio *>
+1 <* cs_radio_pulje *>
+1 <* cs_radio_kø *>
+1 <* cs_radio_medd *>
+1 <* cs_radio_adm *>
+2 ; <* cs_radio_ind/-ud *>
max_sem:=
+1 <* bs_mobil_opkald *>
+1 <* bs_opkaldskø_adgang *>
+max_antal_kanaler <* ss_radio_aktiver *>
+max_antal_kanaler <* ss_samtale_nedlagt *>
+max_antal_taleveje <* bs_talevej_udkoblet *>
+max_sem;
max_op:=
+ radio_pulje_størrelse <* radio_pulje_operationer *>
+ 1 <* radio_medd *>
+ 1 <* radio_adm *>
+ max_antal_taleveje <* operationer for radio *>
+ 2 <* operationer for radio_ind/-ud *>
+ max_op;
max_netto_op:=
+ radio_pulje_størrelse * 60 <* radio_pulje_operationer *>
+ data + 6 <* radio_medd *>
+ max_antal_taleveje <* operationer for radio *>
* (data + radio_op_længde)
+ data + radio_op_længde <* operation for radio_adm *>
+ 2*(data + 64) <* operationer for radio_ind/-ud *>
+ max_netto_op;
\f
message vogntabel_claiming side 1 - 810413/cl;
maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
+ 1 <* coroutine vt_opdater *>
+ 1 <* coroutine vt_tilstand *>
+ 1 <* coroutine vt_rapport *>
+ 1 <* coroutine vt_gruppe *>
+ 1 <* coroutine vt_spring *>
+ 1 <* coroutine vt_auto *>
+ 1 <* coroutine vt_log *>
+ maxcoru;
maxsemch:= 1 <* cs_vt *>
+ 1 <* cs_vt_adgang *>
+ 1 <* cs_vt_logpool *>
+ 1 <* cs_vt_opd *>
+ 1 <* cs_vt_rap *>
+ 1 <* cs_vt_tilst *>
+ 1 <* cs_vtt_auto *>
+ 1 <* cs_vt_grp *>
+ 1 <* cs_vt_spring *>
+ 1 <* cs_vt_log *>
+ 5 <* cs_vt_filretur(coru) *>
+ maxsemch;
maxop:= 1 <* vt_op *>
+ 2 <* vt_log_op *>
+ 6 <* vt_fil_op + radop *>
+ maxop;
maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
+ 5*fil_op_længde
+ (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
+ maxnettoop;
\f
algol list.off;
message coroutinemonitor - 3 ;
begin
<* work variables - primarily used during initialization *>
integer array field simref, semref, coruref, opref;
integer proccount, corucount, messcount, cmi, cmj;
integer array zoneia(1:20);
<* field variables describing the format of basic entities *>
integer field
<* chain head *>
next, prev,
<* simple semaphore *>
simvalue, simcoru,
<* chained semaphore *>
semop, semcoru,
<* coroutine *>
coruop, corutimerchain, corutimer, corupriority, coruident,
<* operation head *>
opnext, opsize;
\f
message coroutinemonitor - 4 ;
boolean field
corutypeset, corutestmask, optype;
real starttime;
long corustate;
<* field variables used as queue identifiers (addresses) *>
integer array field current, readyqueue, idlequeue, timerqueue;
<* extensions (message- and process- extensions) *>
integer array messref, messcode, messop (1:maxmessext);
integer array procref, proccode, procop (1:maxprocext);
<* core array used for accessing the core using addresses as field
variables (as delivered by the monitor functions)
- descriptor array 'd' in which all basic entities are allocated
(except for extensions) *>
integer array core (1:1), d (1:(4 <* readyqueue *> +
4 <* idlequeue *> +
4 <* timerqueue *> +
maxcoru * corusize +
maxsem * simsize +
maxsemch * semsize +
maxop * opheadsize +
maxnettoop)/2);
\f
message coroutinemonitor - 5 ;
<*************** initialization procedures ***************>
procedure initchain (chainref);
value chainref;
integer array field chainref;
begin
integer array field cref;
cref:= chainref;
d.cref.next:= d.cref.prev:= cref;
end;
\f
message coroutinemonitor - 6 ;
<***** nextsem *****
this procedure allocates and initializes the next simple semaphore in the
pool of claimed semaphores.
the procedure returns the identification (the address) of the semaphore to
be used when calling 'signal', 'wait' and 'inspect'. *>
integer procedure nextsem;
begin
nextsem:= simref;
if simref >= firstsem then initerror(1, true);
initchain(simref + simcoru);
d.simref.simvalue:= 0;
simref:= simref + simsize;
end;
<***** nextsemch *****
this procedure allocates and initializes the next simple semaphore in the
pool of claimed semaphores.
the procedure returns the identification (the address) of the semaphore to
be used when calling 'signalch', 'waitch' and 'inspectch'. *>
integer procedure nextsemch;
begin
nextsemch:= semref;
if semref >= firstop-4 then initerror(2, true);
initchain(semref + semcoru);
initchain(semref + semop);
semref:= semref + semsize;
end;
\f
message coroutinemonitor - 7 ;
<***** nextcoru *****
this procedure initializes the next coroutine description in the pool of
claimed coroutine descriptions.
at initialization is defined the priority (an integer value), an identi-
fication (an integer value 0..8000) and a test pattern (a boolean). *>
integer procedure nextcoru(ident, priority, testmask);
value ident, priority, testmask;
integer ident, priority;
boolean testmask;
begin
corucount:= corucount + 1;
if corucount > maxcoru then initerror(3, true);
nextcoru:= corucount;
initchain(coruref + next);
initchain(coruref + corutimerchain);
initchain(coruref + coruop);
d.coruref.corupriority:= priority;
d.coruref.coruident:= ident * 1000 + corucount;
d.coruref.corutypeset:= false;
d.coruref.corutimer:= 0;
d.coruref.corutestmask:= testmask;
linkprio(coruref, readyqueue);
current:= coruref;
coruref:= coruref + corusize;
end;
\f
message coroutinemonitor - 8 ;
<***** nextop *****
this procedure initializes the next operation in the pool of claimed ope-
rations (heads and buffers).
the head is allocated and immediately following the head is allocated 'size'
halfwords forming the operation buffer.
the procedure returns an identification of the operation (an address) and
in case this address is held in a field variable 'op', the buffer area may
be accessed as: d.op(1), d.op(2), d.op(3) ... *>
integer procedure nextop (size);
value size;
integer size;
begin
nextop:= opref;
if opref >= optop then initerror(4, true);
initchain(opref + next);
d.opref.opsize:= size;
opref:= opref + size + opheadsize;
end;
\f
message coroutinemonitor - 9 ;
<***** nextprocext *****
this procedure initializes the next process extension in the series of
claimed process extensions.
the process description address is put into the process extension and the
state of the extension is initialized to be closed. *>
integer procedure nextprocext (processref);
value processref;
integer processref;
begin
proccount:= proccount + 1;
if proccount >= maxprocext then initerror(5, true);
nextprocext:= proccount;
procref(proccount):= processref;
proccode(proccount):= 1 shift 12;
end;
\f
message coroutinemonitor - 10 ;
<***** initerror *****
this procedure is activated in case the initialized set of resources does
not match the claimed set.
in case more resources are claimed than used, a warning is written,
in case too few resources are claimed, an error message is written and
the execution is terminated. *>
procedure initerror (resource, exceeded);
value resource, exceeded;
integer resource; boolean exceeded;
begin
write(out, false add 10, 1,
if exceeded then <:more :> else <:less :>,
case resource of (
<:simple semaphores:>,
<:chained semaphores:>,
<:coroutines:>,
<:operations:>,
<:process extensions:>),
<: initialized than claimed:>,
false add 10, 1);
if exceeded then goto dump;
end;
<***** stackclaim *****
this procedure is used by a coroutine from its first activation to it
arrives its first waiting point. the procedure is used to claim an addi-
tional amount of stack space. this must be done because the maximum
stack space for a coroutine is set to be the max amount used during its
very first activation. *>
procedure stackclaim (size);
value size; integer size;
begin
boolean array stackspace (1:size);
end;
algol list.on;
\f
message sys_erklæringer side 1 - 810406/cl,hko;
zone
zdummy(1,1,stderror),
zrl(128,1,stderror),
zbillede(128,1,stderror);
real array
fejltekst(1:max_antal_fejltekster);
real
systællere_nulstillet;
integer
nulstil_systællere,
top_bpl_gruppe;
integer array
ingen_operatører, alle_operatører(1:(op_maske_lgd//2)),
ingen_taleveje, alle_taleveje(1:(tv_maske_lgd//2)),
bpl_def(1:(128*(op_maske_lgd//2))),
bpl_tilst(0:127,1:2),
operatør_stop(0:max_antal_operatører,0:3),
område_id(1:max_antal_områder,1:2),
pabx_id(1:max_antal_pabx),
radio_id(1:max_antal_radiokanaler),
kanal_id(1:max_antal_kanaler),
opkalds_tællere(1:(max_antal_områder*5)), <* maxantal <= 16 *>
operatør_tællere(1:(max_antal_operatører*5)); <* maxantal <= 32 *>
boolean array
operatør_auto_include(1:max_antal_operatører),
garage_auto_include(1:max_antal_garageterminaler);
long array
terminal_navn(1:(2*max_antal_operatører)),
garage_terminal_navn(1:(2*max_antal_garageterminaler)),
bpl_navn(0:127),
område_navn(1:max_antal_områder),
kanal_navn(1:max_antal_kanaler);
\f
message procedure findområde side 1 - 880901/cl;
integer procedure find_bpl(navn);
value navn;
long navn;
begin
integer i;
find_bpl:= 0;
for i:= 0 step 1 until 127 do
if navn = bpl_navn(i) then find_bpl:= i;
end;
integer procedure findområde(omr);
value omr;
integer omr;
begin
integer i;
if omr = '*' shift 16 then findområde:= -1 else
begin
findområde:= 0;
for i:= 1 step 1 until max_antal_områder do
if (extend omr) shift 24=område_navn(i) then findområde:= i;
end;
end;
\f
message procedure tæl_opkald side 1 - 880926/cl;
procedure opdater_tf_systællere;
begin
integer zi;
integer array field iaf;
real field rf;
disable begin
skrivfil(tf_systællere,1,zi);
rf:= iaf:= 4;
fil(zi).rf:= systællere_nulstillet;
fil(zi).iaf(1):= nulstil_systællere;
iaf:= 32;
tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*10);
iaf:= 192;
tofrom(fil(zi).iaf,operatør_tællere,max_antal_operatører*10);
setposition(fil(zi),0,0);
end;
end;
procedure tæl_opkald(område,type);
value område,type;
integer område,type;
begin
increase(opkalds_tællere((område-1)*5+type));
disable opdater_tf_systællere;
end;
procedure tæl_opkald_pr_operatør(operatør,type);
value operatør,type;
integer operatør,type;
begin
increase(operatør_tællere((operatør-1)*5+type));
disable opdater_tf_systællere;
end;
procedure skriv_opkaldstællere(z);
zone z;
begin
integer omr,typ,rpc;
real r;
write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
<:omr ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
for omr:= 1 step 1 until max_antal_områder do
begin
write(z,true,6,string område_navn(omr),":",1);
for typ:= 1 step 1 until 5 do
write(z,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
outchar(z,'nl');
end;
write(z,"nl",1,
<:oper. ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
for omr:= 1 step 1 until max_antal_operatører do
begin
if bpl_navn(omr)=long<::> then
write(z,"sp",6-write(z,<:op:>,<<d>,omr),":",1)
else
write(z,true,6,string bpl_navn(omr),":",1);
for typ:= 1 step 1 until 5 do
write(z,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
outchar(z,'nl');
end;
rpc:= replace_char(1,':');
write(z,"nl",1,<:nulstilles :>);
if nulstil_systællere = (-1) then write(z,<:ikke automatisk:>,"nl",1)
else write(z,<:automatisk kl. :>,<<zd dd dd>,nulstil_systællere,"nl",1);
replace_char(1,'.');
write(z,<:nulstillet d. :>,<<zd dd dd>,
systime(4,systællere_nulstillet,r)," ",1);
replace_char(1,':');
write(z,<<zd dd dd>,r,"nl",1);
replace_char(1,rpc);
end;
\f
message procedure start_operation side 1 - 810521/hko;
procedure start_operation(op_ref,kor,ret_sem,kode);
value kor,ret_sem,kode;
integer array field op_ref;
integer kor,ret_sem,kode;
<*
op_ref: kald, reference til operation
kor: kald, kilde= hovedmodulnr*100 +løbenr
= korutineident.
ret_sem: kald, retursemafor
kode: kald, suppl shift 12 + operationskode
proceduren initialiserer en operations hoved med
parameterværdierne samt tidfeltet med aktueltid.
resultatfelt og datafelter nulstilles.
*>
begin
integer i;
d.op_ref.kilde:= kor;
systime(1,0,d.op_ref.tid);
d.op_ref.retur:=ret_sem;
d.op_ref.op_kode:=kode;
d.op_ref.resultat:=0;
for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
d.op_ref.data(i):=0;
end start_operation;
\f
message procedure afslut_operation side 1 - 810331/hko;
procedure afslut_operation(op_ref,sem);
value op_ref,sem;
integer op_ref,sem;
begin
integer array field op;
op:=op_ref;
if sem>0 then signal_ch(sem,op,d.op.optype) else
if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
;
end afslut_operation;
\f
message procedure fejlreaktion - side 1 - 810424/cl,hko;
procedure fejlreaktion(nr,værdi,str,måde);
value nr,værdi,måde;
integer nr,værdi,måde;
string str;
begin
disable begin
write(out,<:<10>!!! :>);
if nr>0 and nr <=max_antal_fejltekster then
write(out,string fejltekst(nr))
else write(out,<:fejl nr.:>,nr);
outchar(out,'sp');
if måde shift (-12) extract 2=1 then
outintbits(out,værdi)
else
if måde shift (-12) extract 2=2 then
write(out,<:":>,false add værdi,1,<:":>)
else
write(out,værdi);
write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
<: korutine nr=:>,<<d>, abs curr_coruno,
<: ident=:>,curr_coruid,"nl",0);
if testbit27 and måde extract 12=1 then
trace(1);
ud;
end;<*disable*>
if måde extract 12 =2 then trapmode:=1 shift 13;
if måde extract 12= 0 then trap(-1)
else if måde extract 12 = 2 then trap(-2);
end fejlreaktion;
procedure trace(n);
value n;
integer n;
begin
trap(finis);
trap(n);
finis:
end trace;
\f
message procedure overvåget side 1 - 810413/cl;
boolean procedure overvåget;
begin
disable begin
integer i,måde;
integer array field cor;
integer array ia(1:12);
i:= system(12,0,ia);
if i > 0 then
begin
i:= system(12,1,ia);
måde:= ia(3);
end
else måde:= 0;
if måde<>0 then
begin
cor:= coroutine(abs ia(3));
overvåget:= d.cor.corutestmask shift (-11);
end
else overvåget:= cl_overvåget;
end;
end;
\f
message procedure antal_bits_ia side 1 - 940424/cl;
integer procedure antal_bits_ia(ia,n,ø);
value n,ø;
integer array ia;
integer n,ø;
begin
integer i, ant;
ant:= 0;
for i:= n step 1 until ø do
if læsbit_ia(ia,i) then ant:= ant+1;
end;
message procedure trunk_til_omr side 1 - 881006/cl;
integer procedure trunk_til_omr(trunk);
value trunk; integer trunk;
begin
integer i,j;
j:=0;
for i:= 1 step 1 until max_antal_områder do
if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
trunk_til_omr:=j;
end;
integer procedure omr_til_trunk(omr);
value omr; integer omr;
begin
omr_til_trunk:= område_id(omr,2) extract 12;
end;
integer procedure port_til_omr(port);
value port; integer port;
begin
if port shift (-6) extract 6 = 2 then
port_til_omr:= pabx_id(port extract 6)
else
if port shift (-6) extract 6 = 3 then
port_til_omr:= radio_id(port extract 6)
else
port_til_omr:= 0;
end;
integer procedure kanal_til_port(kanal);
value kanal; integer kanal;
begin
kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
kanal_id(kanal) extract 5;
end;
integer procedure port_til_kanal(port);
value port; integer port;
begin
integer i,j;
j:=0;
for i:= 1 step 1 until max_antal_kanaler do
if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
port_til_kanal:= j;
end;
integer procedure kanal_til_omr(kanal);
value kanal; integer kanal;
begin
kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
end;
\f
message procedure out_xxx_bits side 1 - 810406/cl;
procedure outboolbits(zud,b);
value b;
zone zud;
boolean b;
begin
integer i;
for i:= -11 step 1 until 0 do
outchar(zud,if b shift i then '1' else '.');
end;
procedure outintbits(zud,j);
value j;
zone zud;
integer j;
begin
integer i;
for i:= -23 step 1 until 0 do
begin
outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
end;
end;
procedure outintbits_ia(zud,ia,n,ø);
value n,ø;
zone zud;
integer array ia;
integer n,ø;
begin
integer i;
for i:= n step 1 until ø do
begin
outintbits(zud,ia(i));
outchar(zud,'nl');
end;
end;
real procedure now;
begin
real f,r,r1; long l;
systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
systime(4,r,r1);
now:= r1+f;
end;
\f
message procedure skriv_id side 1 - 820301/cl;
procedure skriv_id(z,id,lgd);
value id,lgd;
integer id,lgd;
zone z;
begin
integer type,p,li,lø,bo;
type:= id shift (-22);
case type+1 of
begin
<* 1: bus *>
begin
p:= write(z,<<d>,id extract 14);
if id shift (-14) <> 0 then
p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
end;
<* 2: linie/løb *>
begin
li:= id shift (-12) extract 10;
bo:= id shift (-7) extract 5;
if bo<>0 then bo:= bo + 'A' - 1;
lø:= id extract 7;
p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
end;
<* 3: gruppe *>
begin
if id shift (-21) = 4 <* linie-gruppe *> then
begin
li:= id shift (-5) extract 10;
bo:= id extract 5;
if bo<>0 then bo:= bo + 'A' - 1;
p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
end
else <* special-gruppe *>
p:= write(z,"G",1,<<d>,id extract 7);
end;
<* 4: telefon *>
begin
bo:= id shift (-20) extract 2;
li:= id extract 20;
case bo+1 of
begin
p:= write(z,string kanalnavn(li));
p:= write(z,<:K*:>);
p:= write(z,<:OMR :>,string områdenavn(li));
p:= write(z,<:OMR*:>);
end;
end;
end case;
write(z,"sp",lgd-p);
end skriv_id;
<*+3*>
\f
message skriv_new_sem side 1 - 810520/cl;
procedure skriv_new_sem(z,type,ref,navn);
value type,ref;
zone z;
integer type,ref;
string navn;
<* skriver en identifikation af en semafor 'ref' i zonen z.
type: 1=binær sem
2=simpel sem
3=kædet sem
ref: semaforreference
navn: semafornavn, max 18 tegn
*>
begin
disable if testbit29 then
write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
true,5,<<zddd>,ref,true,19,navn);
end;
\f
message procedure skriv_newactivity side 1 - 810520/hko/cl;
<**> procedure skriv_newactivity(zud,actno,cause);
<**> value actno,cause;
<**> zone zud;
<**> integer actno,cause;
<**> begin
<*+2*>
<**> if testbit28 then
<**> begin integer array field cor;
<**> cor:= coroutine(actno);
<**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
<**> << zdd>,d.cor.coruident//1000);
<**> end;
<**> if -, testbit23 then goto skriv_newact_slut;
<*-2*>
<**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
<**> <:) cause=:>,<<-d>,cause);
<**> if cause<1 then write(zud,<: !!!:>);
<**> skriv_coru(zud,actno);
<**> skriv_newact_slut:
<**> end skriv_newactivity;
<*-3*>
<*+99*>
\f
message procedure skriv_activity side 1 - 810313/hko;
<**> procedure skriv_activity(zud,actno);
<**> value actno;
<**> zone zud;
<**> integer actno;
<**> begin
<**> integer i;
<**> integer array iact(1:12);
<**>
<**> i:=system(12,actno,iact);
<**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
<**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
<**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
<**> if i>0 and actno>0 and actno<=i then
<**> begin
<**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
<**> (<:tom:>,<:passivate:>,
<**> <:implicit passivate:>,<:activate:>));
<**> if iact(1)<>0 then
<**> write(zud,<: ventende på message:>,iact(1));
<**> if iact(7)>0 then
<**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
<**> <:hovedlager stak benyttes af activity(:>,<<d>,
<**> iact(2));
<**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
<**> iact(4),iact(5),iact(6),iact(10),iact(11));
<**> if iact(9)<> 1 shift 22 then
<**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
<**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
<**> end;
<**> end skriv_activity
<*-99*>
<*+98*>
\f
message procedure identificer side 1 - 810520/cl;
procedure identificer(z);
zone z;
begin
disable write(z,<:coroutine::>,<< dd>,curr_coruno,
<: ident::>,<< zdd >,curr_coruid);
end;
\f
message procedure skriv_coru side 1 - 810317/cl;
<**> procedure skriv_coru(zud,cor_no);
<**> value cor_no;
<**> zone zud;
<**> integer cor_no;
<**> begin
<**> integer i;
<**> integer array field cor;
<**>
<**>
<**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
<**>
<**> cor:= coroutine(cor_no);
<**> if cor = -1 then
<**> write(zud,<: eksisterer ikke !!!:>)
<**> else
<**> begin
<**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
<**> <: refbyte: :>,<<d>,cor,"nl",1,
<**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
<**> <: next: :>,d.cor.next,"nl",1,
<**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
<**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
<**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
<**> <: opchain.next: :>,d.cor.coruop,"nl",1,
<**> <: timer: :>,d.cor.corutimer,"nl",1,
<**> <: priority: :>,d.cor.corupriority,"nl",1,
<**> <: typeset: :>);
<**> for i:= -11 step 1 until 0 do
<**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
<**> write(zud,"nl",1,<: testmask: :>);
<**> for i:= -11 step 1 until 0 do
<**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
<*+99*>
<**> skriv_activity(zud,cor_no);
<*-99*>
<**> end;
<**> end skriv_coru;
<*-98*>
<*+98*>
\f
message procedure skriv_op side 1 - 810409/cl;
<**> procedure skriv_op(zud,opref);
<**> value opref;
<**> integer opref;
<**> zone zud;
<**> begin
<**> integer array field op;
<**> real array field raf;
<**> integer lgd,i;
<**> real t;
<**>
<**> raf:= data;
<**> op:= opref;
<**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
<**> if opref<first_op ! optop<=opref then
<**> begin
<**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
<**> goto slut_skriv_op;
<**> end;
<**>
<**> lgd:= d.op.opsize;
<**> write(zud,"nl",1,<<d>,
<**> <: opsize :>,d.op.opsize,"nl",1,
<**> <: optype :>);
<**> for i:= -11 step 1 until 0 do
<**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
<**> write(zud,"nl",1,<<d>,
<**> <: prev :>,d.op.prev,"nl",1,
<**> <: next :>,d.op.next);
<**> if lgd=0 then goto slut_skriv_op;
<**> write(zud,"nl",1,<<d>,
<**> <: kilde :>,d.op.kilde extract 10,"nl",1,
<**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
<**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
d.op.retur,"nl",1,
<**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
<**> d.op.opkode extract 12,"nl",1,
<**> <: resultat :>,d.op.resultat,"nl",2,
<**> <:data::>);
<**> skriv_hele(zud,d.op.raf,lgd-data,1278);
<**>slut_skriv_op:
<**> end skriv_op;
<*-98*>
\f
message procedure corutable side 1 - 810406/cl;
procedure corutable(zud);
zone zud;
begin
integer i;
integer array field cor;
write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
<:no id ref chain timerch opchain timer pr:>,
<: typeset testmask:>,"nl",2);
for i:= 1 step 1 until maxcoru do
begin
cor:= coroutine(i);
write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
d.cor.corutimer,<< dd>,d.cor.corupriority);
outchar(zud,'sp');
outboolbits(zud,d.cor.corutypeset);
outchar(zud,'sp');
outboolbits(zud,d.cor.corutestmask);
outchar(zud,'nl');
end;
end;
\f
message filglobal side 1 - 790302/jg;
integer
dbantsf,dbkatsfri,
dbantb,dbkatbfri,
dbantef,dbkatefri,
dbsidstesz,dbsidstetz,
dbsegmax,
filskrevet,fillæst;
integer
bs_kats_fri, bs_kate_fri,
cs_opret_fil, cs_tilknyt_fil,
cs_frigiv_fil, cs_slet_fil,
cs_opret_spoolfil, cs_opret_eksternfil;
integer array
dbkatt(1:dbmaxtf,1:2),
dbkats(1:dbmaxsf,1:2),
dbkate(1:dbmaxef,1:6),
dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
boolean array
dbkatb(1:dbmaxb);
zone array
fil(dbantez+dbantsz+dbanttz,128,1,stderror);
\f
message hentfildim side 1 - 781120/jg;
integer procedure hentfildim(fdim);
integer array fdim;
<*inddata filref i fdim(4),uddata fdim(1:8)*>
begin integer ftype,fno,katf,i,s;
ftype:=fdim(4) shift (-10);
fno:=fdim(4) extract 10;
if ftype>3 or ftype=0 or fno=0 then
begin s:=1; goto udgang; end;
if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
begin s:=1; goto udgang end; <*paramfejl*>
katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
if katf extract 9 = 0 then
begin s:=2; goto udgang end; <*tom indgang*>
fdim(1):=katf shift (-9); <*post antal*>
fdim(2):=katf extract 9; <*post længde*>
fdim(3):=case ftype of( <*seg antal*>
dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
dbkate(fno,2) extract 18);
for i:=5 step 1 until 8 do <*externt filnavn*>
fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
s:=0;
udgang:
hentfildim:=s;
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
<*tz*> pfdim(fdim); <*zt*>
<*tz*> ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
end hentfildim;
\f
message sætfildim side 1 - 780916/jg;
integer procedure sætfildim(fdim);
integer array fdim;
<*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
begin
integer ftype,fno,katf,s,pl;
integer array gdim(1:8);
gdim(4):=fdim(4);
s:=hentfildim(gdim);
if s>0 then
goto udgang;
fno:=fdim(4) extract 10;
ftype:=fdim(4) shift (-10);
pl:= fdim(2) extract 12;
if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
begin
s:=1; <*parameter fejl*>
goto udgang
end;
if fdim(1)>256//pl*fdim(3) then
begin
s:=1;
goto udgang;
end;
<*segant*>
if ftype=3 then
begin integer segant;
segant:= fdim(3);
if segant > dbsegmax then
begin
s:=4; <*ingen plads*>
goto udgang
end;
\f
message sætfildim side 2 - 780916/jg;
if segant<>gdim(3) then
begin integer i,z,s; array field enavn; integer array tail(1:10);
z:=dbkate(fno,2) shift (-19); if z>0 then begin
if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
begin integer array zd(1:20);
getzone6(fil(z),zd);
if zd(13)>5 and zd(9)>=segant then
begin <*dødt segment skal ikke udskrives*>
zd(13):=5;
setzone6(fil(z),zd)
end
end end;
\f
message sætfildim side 3 - 801031/jg;
enavn:=8; <*ændr fil størrelse*>
i:=1;
open(zdummy,0,string gdim.enavn(increase(i)),0);
s:=monitor(42,zdummy,0,tail); <*lookup*>
if s>0 then
fejlreaktion(1,s,<:lookup entry:>,0);
tail(1):=segant;
s:=monitor(44,zdummy,0,tail); <*change entry*>
close(zdummy,false);
if s<>0 then
begin
if s=6 then
begin <*ingen plads*>
s:=4; goto udgang
end
else fejlreaktion(1,s,<:change entry:>,0);
end;
dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
add segant;
\f
message sætfildim side 4 - 801013/jg;
end;
fdim(3):=segant
end
else
if fdim(3)>gdim(3) then
begin
s:=4; <*altid ingen plads*>
goto udgang
end
else fdim(3):=gdim(3); <*samme længde*>
<*postantal,postlængde*>
katf:=fdim(1) shift 9 add pl;
case ftype of begin
dbkatt(fno,1):=katf;
dbkats(fno,1):=katf;
dbkate(fno,1):=katf end;
udgang:
sætfildim:=s;
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin integer i; <*zt*>
<*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
<*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
<*tz*> pfdim(gdim); <*zt*>
<*tz*> ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
end sætfildim;
\f
message findfilenavn side 1 - 780916/jg;
integer procedure findfilenavn(navn);
real array navn;
begin
integer fno; array field enavn;
for fno:=1 step 1 until dbmaxef do
if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
begin
enavn:=fno*12+4;
if navn(1)=dbkate.enavn(1) and
navn(2)=dbkate.enavn(2) then
begin
findfilenavn:=fno;
goto udgang
end
end;
findfilenavn:=0;
udgang:
end findfilenavn;
\f
message læsfil side 1 - 781120/jg;
integer procedure læsfil(filref,postindex,zoneno);
value filref,postindex;
integer filref,postindex,zoneno;
<*+2*>
<*tz*> begin integer i,o,s; <*zt*>
<*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
<*-2*>
læsfil:=tilgangfil(filref,postindex,zoneno,5);
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*>
<*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
<*tz*> end; <*zt*>
<*tz*> end procedure; <*zt*>
<*-2*>
\f
message skrivfil side 1 - 781120/jg;
integer procedure skrivfil(filref,postindex,zoneno);
value filref,postindex;
integer filref,postindex,zoneno;
<*+2*>
<*tz*> begin integer i,o,s; <*zt*>
<*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
<*-2*>
skrivfil:=tilgangfil(filref,postindex,zoneno,6);
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
<*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
<*tz*> end; <*zt*>
<*tz*> end procedure; <*zt*>
<*-2*>
\f
message modiffil side 1 - 781120/jg;
integer procedure modiffil(filref,postindex,zoneno);
value filref,postindex;
integer filref,postindex,zoneno;
<*+2*>
<*tz*> begin integer i,o,s; <*zt*>
<*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
<*-2*>
modiffil:=tilgangfil(filref,postindex,zoneno,7);
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
<*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
<*tz*> end; <*zt*>
<*tz*> end procedure; <*zt*>
<*-2*>
\f
message tilgangfil side 1 - 781003/jg;
integer procedure tilgangfil(filref,postindex,zoneno,operation);
value filref,postindex,operation;
integer filref,postindex,zoneno,operation;
<*proceduren kaldes fra læsfil,skrivfil og modiffil*>
begin
integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
integer array zd(1:20),fdim(1:8);
<*hent katalog*>
fdim(4):=filref;
st:=hentfildim(fdim);
if st<>0 then
goto udgang; <*parameter fejl eller fil findes ikke*>
fno:=filref extract 10;
ftype:=filref shift (-10);
pl:=fdim(2);
katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
\f
message tilgangfil side 2 - 781003/jg;
<*find segment adr og check postindex*>
pps:=256//pl; <*poster pr segment*>
seg:=(postindex-1)//pps; <*relativt segment*>
pr:=(postindex-1) mod pps; <*post relativ til seg*>
if postindex <1 then
begin <*parameter fejl*>
st:=1;
goto udgang
end;
if seg>=fdim(3) then
begin <*post findes ikke*>
st:=3;
goto udgang
end;
case ftype of
begin <*find absolut segment*>
<*tabelfil*>
seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
begin <*spoolfil*>
integer i,bidno;
bidno:=katf extract 12;
for i:=seg//dbbidlængde step -1 until 1 do
bidno:=dbkatb(bidno) extract 12;
seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
end;
<*extern fil,seg ok*>
end case find abs seg;
\f
message tilgangfil side 3 - 801030/jg;
<*alloker zone*>
zno:=katf shift(-19);
case ftype of begin
begin <*tabelfil*>
integer førstetz;
førstetz:=dbkatz(dbsidstetz,2);
if zno=0 then
zno:=førstetz
else if dbkatz(zno,1)<>filref then
zno:=førstetz
else if zno <> førstetz and zno <> dbsidstetz then
begin integer z;
for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
dbkatz(z,2):=dbkatz(zno,2);
dbkatz(zno,2):=førstetz;
dbkatz(dbsidstetz,2):=zno;
end;
dbsidstetz:=zno
end;
\f
message tilgangfil side 4 - 801030/jg;
begin <*spoolfil*>
integer p,zslut,z;
if zno>0 then begin if dbkatz(zno,1) =filref then
goto udgangs end; <*strategi 1*>
p:=0;
zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
for z:=dbantez+dbantsz step -1 until zslut do
begin integer zfref;
zfref:=dbkatz(z,1);
if zfref extract 10=0 then <*fri zone*>
begin <*strategi 2*>
zno:=z;
goto udgangs
end
else
if zfref shift (-10)=2 then
begin <*zone tilknyttet spoolfil*>
integer q;
q:=dbkatz(z,2); <*prioritet*>
if q>p then
begin <*strategi 3*>
p:=q;
zno:=z
end
end;
end z;
udgangs:
if zno> dbantez then dbsidstesz:=zno;
end;
\f
message tilgangfil side 5 - 780916/jg;
begin <*extern fil*>
integer z;
if zno=0 then
zno:=1
else if dbkatz(zno,1) = filref then
goto udgange; <*strategi 1*>
for z:=1 step 1 until dbantez do
begin integer zfref;
zfref:=dbkatz(z,1);
if zfref=0 then <*zone fri*>
begin zno:=z; goto udgange end <*strategi 2*>
else if zfref shift (-10) =2 then <*spoolfil*>
zno:=z; <*strategi 3*> <*else strategi 4-5*>
end z;
udgange:
end
end case alloker zone;
<*åbn zone*>
if zno<=dbantez then
begin <*extern zone;spool og tabel zoner altid åbne*>
integer zfref;
zfref:=dbkatz(zno,1);
if zfref<>0 and zfref<>filref and ftype=3 then
begin <*luk hvis ny extern fil*>
getzone6(fil(zno),zd);
if zd(13)>5 then filskrevet:=filskrevet+1;
zfref:=0;
close(fil(zno),false);
end;
if zfref=0 then
begin <*åbn zone*>
array field enavn; integer i;
enavn:=4*2; i:=1;
open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
string fdim.enavn(increase(i))),0)
end
end;
\f
message tilgangfil side 6 - 780916/jg;
<*hent segment og sæt zone descriptor*>
getzone6(fil(zno),zd);
zstate:=zd(13);
if zstate=0 or zd(9)<>seg then
begin <*positioner*>
if zstate>5 then
filskrevet:=filskrevet+1;
setposition(fil(zno),0,seg);
if -,(operation=6 and pr=0) then
begin <*læs seg medmindre op er skriv første post*>
inrec6(fil(zno),512);
fillæst:=fillæst+1
end;
zstate:=operation
end
else <*zstate:=max(operation,zone state)*>
if operation>zstate then
zstate:=operation;
zd(9):=seg;
zd(13):=zstate;
zd(16):=pl shift 1;
zd(14):=zd(19)+pr*zd(16);
setzone6(fil(zno),zd);
\f
message tilgangfil side 7 - 780916/jg;
<*opdater kataloger*>
katf:=zno shift 19 add (katf extract 19);
case ftype of
begin
dbkatt(fno,2):=katf;
dbkats(fno,2):=katf;
dbkate(fno,2):=katf
end;
dbkatz(zno,1):= filref;
if ftype=3 then dbkatz(zno,2):=0 else
<*if ftype=1 then allerede opd under zoneallokering*>
if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
if zstate=5 then (if pr=pps-1 then 2 else 1)
else if zstate=6 and pr=pps-1 then 3 else 0;
<*udgang*>
udgang:
if st=0 then
zoneno:=zno
else zoneno:=0; <*fejl*>
tilgangfil:=st;
end tilgangfil;
\f
message pfilsystem side 1 - 781003/jg;
procedure pfilparm(z);
zone z;
write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
<:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
procedure pfilglobal(z);
zone z;
write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
<:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
<:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
<:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
<:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
<:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
procedure pdbkate(z,i);
value i; integer i;
zone z;
begin integer j; array field navn;
navn:=i*12+4; j:=1;
write(z,<:<10>dbkate(:>,i,<:)=:>,
dbkate(i,1) shift (-9),
dbkate(i,1) extract 9,
dbkate(i,2) shift (-19),
dbkate(i,2) shift (-18) extract 1,
dbkate(i,2) extract 18,
<: :>,string dbkate.navn(increase(j)));
end;
\f
message pfilsystem side 2 - 781003/jg;
procedure pdbkats(z,i);
value i; integer i;
zone z;
write(z,<:<10>dbkats(:>,i,<:)=:>,
dbkats(i,1) shift (-9),
dbkats(i,1) extract 9,
dbkats(i,2) shift (-19),
dbkats(i,2) shift (-18) extract 1,
dbkats(i,2) shift (-12) extract 6,
dbkats(i,2) extract 12);
procedure pdbkatb(z,i);
value i;integer i;
zone z;
write(z,<:<10>dbkatb(:>,i,<:)=:>,
dbkatb(i) extract 12);
procedure pdbkatt(z,i);
value i; integer i;
zone z;
write(z,<:<10>dbkatt(:>,i,<:)=:>,
dbkatt(i,1) shift (-9),
dbkatt(i,1) extract 9,
dbkatt(i,2) shift (-19),
dbkatt(i,2) shift (-18) extract 1,
dbkatt(i,2) extract 18);
procedure pdbkatz(z,i);
value i; integer i;
zone z;
write(z,<:<10>dbkatz(:>,i,<:)=:>,
dbkatz(i,1),dbkatz(i,2));
\f
message pfilsystem side 3 - 781003/jg;
procedure pfil(z,i);
value i; integer i;
zone z;
begin integer j,k; array field navn; integer array zd(1:20);
navn:=2; k:=1;
getzone6(fil(i),zd);
write(z,<:<10>fil(:>,i,<:)=:>,
zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
string zd.navn(increase(k)));
for j:=6 step 1 until 10 do write(z,zd(j));
write(z,<:<10>:>);
for j:=11 step 1 until 20 do write(z,zd(j));
end;
procedure pfilsystem(z);
zone z;
begin integer i;
write(z,<:<12>udskrift af variable i filsystem:>);
write(z,<:<10><10>filparm::>);
pfilparm(z);
write(z,<:<10><10>filglobal::>);
pfilglobal(z);
write(z,<:<10><10>fil: zone descriptor:>);
for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
for i :=1 step 1 until dbmaxef do pdbkate(z,i);
write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
write(z,<:<10><10>dbkatb: katbref:>);
for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
end pfilsystem;
\f
message pfilsystem side 4 - 781003/jg;
procedure pfdim(fdim);
integer array fdim;
begin
integer i;
array field navn;
i:=1;navn:=8;
write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
string fdim.navn(increase(i)));
end pfdim;
\f
message opretfil side 0 - 810529/cl;
procedure opretfil;
<* checker parametre og vidresender operation
til opret_spoolfil eller opret_eksternfil *>
begin
integer array field op;
integer status,pant,pl,segant,p_nøgle,fno,ftype;
procedure skriv_opret_fil(z,omfang);
value omfang;
zone z;
integer omfang;
begin
write(z,"nl",1,<:+++ opret fil :>);
if omfang > 0 then
disable
begin
skriv_coru(z,abs curr_coruno);
write(z,"nl",1,<<d>,
<:op :>,op,"nl",1,
<:status :>,status,"nl",1,
<:pant :>,pant,"nl",1,
<:pl :>,pl,"nl",1,
<:segant :>,segant,"nl",1,
<:p-nøgle:>,p_nøgle,"nl",1,
<:fno :>,fno,"nl",1,
<:ftype :>,ftype,"nl",1,
<::>);
end;
end skriv_opret_fil;
\f
message opretfil side 1 - 810526/cl;
trap(opretfil_trap);
<*+2*>
<**> disable if testbit28 then
<**> skriv_opret_fil(out,0);
<*-2*>
stack_claim(if cm_test then 200 else 150);
<*+2*>
<**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
<*-2*>
trin1:
waitch(cs_opret_fil,op,true,-1);
trin2: <* check parametre *>
disable begin
ftype:= d.op.data(4) shift (-10);
fno:= d.op.data(4) extract 10;
if ftype<2 or ftype>3 or fno<>0 then
begin
status:= 1; <*parameterfejl*>
goto returner;
end;
pant:= d.op.data(1);
pl:= d.op.data(2);
segant:= d.op.data(3);
p_nøgle:= d.op.opkode shift (-12);
if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
status:= 1 <*parameterfejl *>
else
if pant>256//pl*segant then status:= 1 else
if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
status:= 4 <*ingen plads*>
else
status:=0;
\f
message opretfil side 2 - 810526/cl;
returner:
d.op.data(9):= status;
<*+2*>
<*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
<*tz*> pfdim(d.op.data); <*zt*>
<*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
<*returner eller vidresend operation*>
signalch(if status>0 then d.op.retur else
case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
op,d.op.optype);
end;
goto trin1;
opretfil_trap:
disable skriv_opret_fil(zbillede,1);
end opretfil;
\f
message tilknytfil side 0 - 810526/cl;
procedure tilknytfil;
<* tilknytter ekstern fil og returnerer intern filid *>
begin
integer array field op;
integer status,i,fno,segant,pa,pl,sliceant,s;
array field enavn;
integer array tail(1:10);
procedure skriv_tilknyt_fil(z,omfang);
value omfang;
zone z;
integer omfang;
begin
write(z,"nl",1,<:+++ tilknyt fil :>);
if omfang > 0 then
disable
begin real array field raf;
skriv_coru(z,abs curr_coruno);
write(z,"nl",1,<<d>,
<:op :>,op,"nl",1,
<:status :>,status,"nl",1,
<:i :>,i,"nl",1,
<:fno :>,fno,"nl",1,
<:segant :>,segant,"nl",1,
<:pa :>,pa,"nl",1,
<:pl :>,pl,"nl",1,
<:sliceant:>,sliceant,"nl",1,
<:s :>,s,"nl",1,
<::>);
raf:= 0;
write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
end;
end skriv_tilknyt_fil;
\f
message tilknytfil side 1 - 810529/cl;
stack_claim(if cm_test then 200 else 150);
trap(tilknytfil_trap);
<*+2*>
<**> if testbit28 then
<**> skriv_tilknyt_fil(out,0);
<*-2*>
trin1:
waitch(cs_tilknyt_fil,op,true,-1);
trin2:
wait(bs_kate_fri);
trin3:
disable begin
<* find ekstern rapportfil *>
enavn:= 8;
if find_fil_enavn(d.op.data.enavn)>0 then
begin
status:= 6; <* fil i brug *>
goto returner;
end;
open(zdummy,0,d.op.data.enavn,0);
s:= monitor(42)lookup entry:(zdummy,0,tail);
if s<>0 then
begin
if s=3 then status:= 2 <* fil findes ikke *>
else if s=6 then status:= 1 <* parameterfejl, navn *>
else fejlreaktion(1,s,<:lookup entry:>,0);
goto returner;
end;
if tail(9)<>d.op.data(4) <* contentskey,subno *> then
begin
status:= 5; <* forkert indhold *> goto returner;
end;
segant:= tail(1);
if segant>db_seg_max then
segant:= db_seg_max;
pa:= tail(10);
pl:= tail(7) extract 12;
if pl < 1 or pl > 256 then
begin status:= 7; goto returner; end;
\f
message tilknytfil side 2 - 810529/cl;
if pa>256//pl*segant then
begin status:= 7; goto returner; end;
<* reserver *>
s:= monitor(52)create area:(zdummy,0,ia);
if s<>0 then
begin
if s=3 then status:= 2 <* fil findes ikke *>
else if s=1 <* areaclaims exeeded *> then
begin
status:= 4;
fejlreaktion(1,s,<:create area:>,1);
end
else fejlreaktion(1,s,<:create area:>,0);
goto returner;
end;
s:= monitor(8)reserve:(zdummy,0,ia);
if s<>0 then
begin
if s<3 then status:= 6 <* i brug *>
else fejlreaktion(1,s,<:reserve:>,0);
monitor(64)remove area:(zdummy,0,ia);
goto returner;
end;
tail(7):= 1 shift 12 +pl; <* tilknyttet *>
s:= monitor(44)change entry:(zdummy,0,tail);
if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
<* opdater katalog *>
dbantef:= dbantef+1;
fno:= dbkatefri;
dbkatefri:= dbkate(fno,2);
dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
dbkate(fno,2):= segant;
for i:= 5 step 1 until 8 do
dbkate(fno,i-2):= d.op.data(i);
<* returparametre *>
d.op.data(1):= pa;
d.op.data(2):= pl;
d.op.data(3):= segant;
d.op.data(4):= 3 shift 10 +fno;
status:= 0;
\f
message tilknytfil side 3 - 810526/cl;
returner:
close(zdummy,false);
d.op.data(9):= status;
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
<*tz*> pfdim(d.op.data); <*zt*>
<*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
signalch(d.op.retur,op,d.op.optype);
if dbantef < dbmaxef then
signalbin(bs_kate_fri);
end;
goto trin1;
tilknytfil_trap:
disable skriv_tilknyt_fil(zbillede,1);
end tilknyt_fil;
\f
message frigivfil side 0 - 810529/cl;
procedure frigivfil;
<* frigiver en tilknyttet ekstern fil *>
begin
integer array field op;
integer status,fref,ftype,fno,s,i,z;
array field enavn;
integer array tail(1:10);
procedure skriv_frigiv_fil(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ frigiv fil :>);
if omfang > 0 then
disable
begin real array field raf;
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:op :>,op,"nl",1,
<:status:>,status,"nl",1,
<:fref :>,fref,"nl",1,
<:ftype :>,ftype,"nl",1,
<:fno :>,fno,"nl",1,
<:s :>,s,"nl",1,
<:i :>,i,"nl",1,
<:z :>,z,"nl",1,
<::>);
raf:= 0;
write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
end;
end skriv_frigiv_fil;
\f
message frigivfil side 1 - 810526/cl;
stack_claim(if cm_test then 200 else 150);
trap(frigivfil_trap);
<*+2*>
<**> disable if testbit28 then
<**> skriv_frigiv_fil(out,0);
<*-2*>
trin1:
waitch(cs_frigiv_fil,op,true,-1);
trin2:
disable begin
<* find fil *>
fref:= d.op.data(4);
ftype:= fref shift (-10);
fno:= fref extract 10;
if ftype=0 or ftype>3 or fno=0 then
begin status:= 1; goto returner; end;
if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
begin status:= 1; goto returner; end;
if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
extract 9 = 0 then
begin
status:= 2; <* fil findes ikke *>
goto returner;
end;
if ftype <> 3 then
begin status:= 5; goto returner; end;
<* frigiv evt. tilknyttet zone og areaprocess *>
z:= dbkate(fno,2) shift (-19);
if z > 0 then
begin
if dbkatz(z,1)=fref then
begin integer array zd(1:20);
getzone6(fil(z),zd);
if zd(13)>5 then filskrevet:= filskrevet +1;
close(fil(z),true);
dbkatz(z,1):= 0;
end;
end;
\f
message frigivfil side 2 - 810526/cl;
<* opdater tail *>
enavn:= fno*12+4;
open(zdummy,0,dbkate.enavn,0);
s:= monitor(42)lookup entry:(zdummy,0,tail);
if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
s:= monitor(44)change entry:(zdummy,0,tail);
if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
monitor(64)remove process:(zdummy,0,tail);
close(zdummy,true);
<* frigiv indgang *>
for i:= 1, 3 step 1 until 6 do
dbkate(fno,1):= 0;
dbkate(fno,2):= dbkatefri;
dbkatefri:= fno;
dbantef:= dbantef -1;
signalbin(bs_kate_fri);
d.op.data(4):= 0; <* filref null *>
status:= 0;
returner:
d.op.data(9):= status;
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
<*tz*> pfdim(d.op.data); <*zt*>
<*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto trin1;
frigiv_fil_trap:
disable skriv_frigiv_fil(zbillede,1);
end frigivfil;
\f
message sletfil side 0 - 810526/cl;
procedure sletfil;
<* sletter en spool- eller ekstern fil *>
begin
integer array field op;
integer fref,fno,ftype,status;
procedure skriv_slet_fil(z,omfang);
value omfang;
zone z;
integer omfang;
begin
write(z,"nl",1,<:+++ slet fil :>);
if omfang > 0 then
disable
begin
skriv_coru(z,abs curr_coruno);
write(z,"nl",1,<<d>,
<:op :>,op,"nl",1,
<:fref :>,fref,"nl",1,
<:fno :>,fno,"nl",1,
<:ftype :>,ftype,"nl",1,
<:status:>,status,"nl",1,
<::>);
end;
end skriv_slet_fil;
\f
message sletfil side 1 - 810526/cl;
stack_claim(if cm_test then 200 else 150);
trap(sletfil_trap);
<*+2*>
<**> disable if testbit28 then
<**> skriv_slet_fil(out,0);
<*-2*>
trin1:
waitch(cs_slet_fil,op,true,-1);
trin2:
disable begin
<* find fil *>
fref:= d.op.data(4);
ftype:= fref shift (-10);
fno:= fref extract 10;
if ftype=0 or ftype>3 or fno=0 then
begin status:= 1; goto returner; end;
if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
begin status:= 1; goto returner; end;
if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
extract 9 = 0 then
begin
status:= 2; <* fil findes ikke *>
goto returner;
end;
<* slet spool- eller ekstern fil *>
case ftype of
begin
<* tabelfil - ingen aktion *>
;
\f
message sletfil side 2 - 810203/cl;
<* spoolfil *>
begin
integer z,bidno,bf,bidant,i;
<* hvis tilknyttet så frigiv *>
z:= dbkats(fno,2) shift (-19);
if z>0 then
begin
if dbkatz(z,1)=fref then
begin integer array zd(1:20);
dbkatz(z,1):= 2 shift 10;
getzone6(fil(z),zd); <*annuler evt. udskrivning*>
if zd(13)>5 then
begin zd(13):= 0; setzone6(fil(z),zd); end;
end;
end;
<* frigiv bidder *>
bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
bidant:= dbkats(fno,2) shift (-12) extract 6;
for i:= bidant -1 step -1 until 1 do
bidno:= dbkatb(bidno) extract 12;
dbkatb(bidno):= false add dbkatbfri;
dbkatbfri:= bf;
dbantb:= dbantb-bidant;
<* frigiv indgang *>
dbkats(fno,1):= 0;
dbkats(fno,2):= dbkatsfri;
dbkatsfri:= fno;
dbantsf:= dbantsf -1;
signalbin(bs_kats_fri);
end spoolfil;
\f
message sletfil side 3 - 810203/cl;
<* extern fil *>
begin
integer i,s,z;
real array field enavn;
integer array tail(1:10);
<* find head and tail *>
enavn:= fno*12+4;
open(zdummy,0,dbkate.enavn,0);
s:= monitor(42)lookup entry:(zdummy,0,tail);
if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
<*frigiv evt. tilknyttet zone og areaprocess*>
z:=dbkate(fno,2) shift (-19);
if z>0 then
begin
if dbkatz(z,1)=fref then
begin integer array zd(1:20);
getzone6(fil(z),zd);
if zd(13)>5 then <* udskrivning *>
begin <*annuler*>
zd(13):= 0;
setzone6(fil(z),zd);
end;
close(fil(z),true);
dbkatz(z,1):= 0;
end;
end;
<* fjern entry *>
s:= monitor(48)remove entry:(zdummy,0,tail);
if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
close(zdummy,true);
<* frigiv indgang *>
for i:=1, 3 step 1 until 6 do
dbkate(fno,i):= 0;
dbkate(fno,2):= dbkatefri;
dbkatefri:= fno;
dbantef:= dbantef -1;
signalbin(bs_kate_fri);
end eksternfil;
end ftype;
\f
message sletfil side 4 - 810526/cl;
status:= 0;
if ftype > 1 then
d.op.data(4):= 0; <*filref null*>
returner:
d.op.data(9):= status;
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
<*tz*> pfdim(d.op.data); <*zt*>
<*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto trin1;
sletfil_trap:
disable skriv_slet_fil(zbillede,1);
end sletfil;
\f
message opretspoolfil side 0 - 810526/cl;
procedure opretspoolfil;
<* opretter en spoolfil og returnerer intern filid *>
begin
integer array field op;
integer bidantal,fno,i,bs,bidstart;
procedure skriv_opret_spoolfil(z,omfang);
value omfang;
zone z;
integer omfang;
begin
write(z,"nl",1,<:+++ opret spoolfil :>);
if omfang > 0 then
disable
begin
skriv_coru(z,abs curr_coruno);
write(z,"nl",1,<<d>,
<:op :>,op,"nl",1,
<:bidantal:>,bidantal,"nl",1,
<:fno :>,fno,"nl",1,
<:i :>,i,"nl",1,
<:bs :>,bs,"nl",1,
<:bidstart:>,bidstart,"nl",1,
<::>);
end;
end skriv_opret_spoolfil;
\f
message opretspoolfil side 1 - 810526/cl;
stack_claim(if cm_test then 200 else 150);
signalbin(bs_kats_fri); <*initialiseres til åben*>
trap(opretspool_trap);
<*+2*>
<**> disable if testbit28 then
<**> skriv_opret_spoolfil(out,0);
<*-2*>
trin1:
waitch(cs_opret_spoolfil,op,true,-1);
trin2:
bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
wait(bs_kats_fri);
trin3:
if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
begin
wait(bs_kats_fri);
goto trin3;
end;
disable begin
<*alloker bidder*>
bs:= bidstart:= dbkatbfri;
for i:= bidantal-1 step -1 until 1 do
bs:= dbkatb(bs) extract 12;
dbkatbfri:= dbkatb(bs) extract 12;
dbkatb(bs):= false; <*sidste ref null*>
dbantb:= dbantb+bidantal;
<*alloker indgang*>
fno:= dbkatsfri;
dbkatsfri:= dbkats(fno,2);
dbantsf:= dbantsf +1;
dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
d.op.data(2) extract 9; <*postlængde*>
dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
\f
message opretspoolfil side 2 - 810526/cl;
<*returner*>
d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
d.op.data(4):= 2 shift 10 add fno; <*filref*>
for i:= 5 step 1 until 8 do <*filnavn null*>
d.op.data(i):= 0;
d.op.data(9):= 0; <*status ok*>
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
<*tz*> pfdim(d.op.data); <*zt*>
<*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
signalch(d.op.retur,op,d.op.optype);
if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
end;
goto trin1;
opretspool_trap:
disable skriv_opret_spoolfil(zbillede,1);
end opretspoolfil;
\f
message opreteksternfil side 0 - 810526/cl;
procedure opreteksternfil;
<* opretter og knytter en ekstern fil *>
begin
integer array field op;
integer status,s,i,fno,p_nøgle;
integer array tail(1:10),zd(1:20);
real r;
real array field enavn;
procedure skriv_opret_ekstfil(z,omfang);
value omfang;
zone z;
integer omfang;
begin
write(z,"nl",1,<:+++ opret ekstern fil :>);
if omfang > 0 then
disable
begin real array field raf;
skriv_coru(z,abs curr_coruno);
write(z,"nl",1,<<d>,
<:op :>,op,"nl",1,
<:status :>,status,"nl",1,
<:s :>,s,"nl",1,
<:i :>,i,"nl",1,
<:fno :>,fno,"nl",1,
<:p-nøgle:>,p_nøgle,"nl",1,
<::>);
raf:= 0;
write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
end;
end skriv_opret_ekstfil;
\f
message opreteksternfil side 1 - 810526/cl;
stack_claim(if cm_test then 200 else 150);
signalbin(bs_kate_fri); <*initialiseres til åben*>
trap(opretekst_trap);
<*+2*>
<**> disable if testbit28 then
<**> skriv_opret_ekstfil(out,0);
<*-2*>
trin1:
waitch(cs_opret_eksternfil,op,true,-1);
trin2:
wait(bs_kate_fri);
trin3:
<*opret temporær fil og tilknyt den*>
disable begin
enavn:= 8;
<*opret*>
open(zdummy,0,d.op.data.enavn,0);
tail(1):= d.op.data(3); <*segant*>
tail(2):= 1;
tail(6):= systime(7,0,r); <*shortclock*>
tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
tail(8):= 0;
tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
tail(10):= d.op.data(1); <*postantal*>
s:= monitor(40)create entry:(zdummy,0,tail);
if s<>0 then
begin
if s=4 <*claims exeeded*> then
begin
status:= 4;
fejlreaktion(1,s,<:create entry:>,1);
goto returner;
end;
if s=3 <*navn ikke unikt*> then
begin status:= 6; goto returner; end;
fejlreaktion(1,s,<:create entry:>,0);
end;
\f
message opreteksternfil side 2 - 810203/cl;
p_nøgle:= d.op.opkode shift (-12);
s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
if s<>0 then
begin
if s=6 then
begin <*claims exeeded*>
status:= 4;
fejlreaktion(1,s,<:permanent entry:>,1);
monitor(48)remove entry:(zdummy,0,tail);
goto returner;
end
else fejlreaktion(1,s,<:permanent entry:>,0);
end;
<*reserver*>
s:= monitor(52)create areaprocess:(zdummy,0,zd);
if s<>0 then
begin
fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
status:= 4;
monitor(48)remove entry:(zdummy,0,zd);
goto returner;
end;
s:= monitor(8)reserve:(zdummy,0,zd);
if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
<*tilknyt*>
dbantef:= dbantef +1;
fno:= dbkatefri;
dbkatefri:= dbkate(fno,2);
dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
dbkate(fno,2):= tail(1);
getzone6(zdummy,zd);
for i:= 2 step 1 until 5 do
dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
d.op.data(3):= tail(1);
d.op.data(4):= 3 shift 10 +fno;
status:= 0;
\f
message opreteksternfil side 3 - 810526/cl;
returner:
close(zdummy,false);
d.op.data(9):= status;
<*+2*>
<*tz*> if testbit24 and overvåget then <*zt*>
<*tz*> begin <*zt*>
<*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
<*tz*> pfdim(d.op.data); <*zt*>
<*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
<*tz*> end; <*zt*>
<*-2*>
signalch(d.op.retur,op,d.op.optype);
if dbantef<dbmaxef then signalbin(bs_kate_fri);
end;
goto trin1;
opretekst_trap:
disable skriv_opret_ekstfil(zbillede,1);
end opreteksternfil;
\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;
\f
message io_erklæringer side 1 - 810421/hko;
integer
cs_io,
cs_io_komm,
cs_io_fil,
cs_io_spool,
cs_io_medd,
cs_io_nulstil,
ss_io_spool_tomme,
ss_io_spool_fulde,
bs_zio_adgang,
io_spool_fil,
io_spool_postantal,
io_spool_postlængde;
integer array field
io_spool_post;
zone z_io(32,1,io_fejl);
procedure io_fejl(z,s,b);
integer s,b;
zone z;
begin
disable begin
integer array iz(1:20);
integer i,j,k;
integer array field iaf;
real array field raf;
if s<>(1 shift 21 + 2) then
begin
getzone6(z,iz);
raf:=2;
iaf:=0;
k:=1;
j:= terminal_tab.iaf.terminal_tilstand;
if j shift(-21)<>6 then
fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
1 shift 12 <*binært*> +1 <*fortsæt*>);
terminal_tab.iaf.terminal_tilstand:= 6 shift 21
+ terminal_tab.iaf.terminal_tilstand extract 21;
end;
z(1):=real <:<'?'><'?'><'em'>:>;
b:=2;
end; <*disable*>
end io_fejl;
\f
message procedure skriv_auto_spring_medd side 1 - 820301/hko;
procedure skriv_auto_spring_medd(z,medd,tid);
value tid;
zone z;
real tid;
integer array medd;
begin
disable begin
real t;
integer kode,bus,linie,bogst,løb,dato,kl;
long array indeks(1:1);
kode:= medd(1);
indeks(1):= extend medd(5) shift 24;
if kode > 0 and kode < 10 then
begin
write(z,"nl",0,<:-<'>'>:>,case kode of(
<*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
<*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
<*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
<*4*><:vogn optaget:>, <* - i - - / - *>
<*5*><:spring annulleret:>, <*udløb af ventetid *>
<*6*><::>, <* - af springliste *>
<*7*><::>, <*start af springsekvens *>
<*8*><::>, <*afvikling af springsekvens *>
<*9*><:område kan ikke opdateres:>,<*vt-ændring*>
<::>));
<* if kode = 5 then
begin
bogst:= medd(4);
linie:= bogst shift(-5) extract 10;
bogst:= bogst extract 5;
if bogst > 0 then bogst:= bogst +'A'-1;
write(z,"sp",1,<<z>,linie,false add bogst,1,
".",1,indeks);
end;
*>
outchar(z,'sp');
bus:= medd(2) extract 14;
if bus > 0 then
write(z,<<z>,bus,"/",1);
løb:= medd(3);
<*+4*> if løb shift(-22) <> 1 and løb <> 0 then
fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
<*-4*>
\f
message procedure skriv_auto_spring_medd side 2 - 810507/hko;
linie:= løb shift(-12) extract 10;
bogst:= løb shift(-7) extract 5;
if bogst > 0 then bogst:= bogst +'A'-1;
løb:= løb extract 7;
if medd(3) <> 0 or kode <> 5 then
begin
write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
if kode = 5 or kode = 6 then write(z,<:er frit :>);
end;
if kode = 7 or kode = 8 then
write(z,<*indeks,"sp",1,*>
if kode=7 then <:udtaget :> else <:indsat :>);
dato:= systime(4,tid,t);
kl:= t/100.0;
løb:= replace_char(1<*space in number*>,'.');
write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
replace_char(1,løb);
end
else <*kode < 1 or kode > 8*>
fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
end; <*disable*>
end skriv_auto_spring_medd;
\f
message procedure h_io side 1 - 810507/hko;
<* hovedmodulkorutine for io *>
procedure h_io;
begin
integer array field op_ref;
integer k,dest_sem;
procedure skriv_hio(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ hovedmodul io :>);
if omfang>0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: op_ref: :>,op_ref,"nl",1,
<: k: :>,k,"nl",1,
<: dest_sem: :>,dest_sem,"nl",1,
<::>);
skriv_coru(zud,coru_no(100));
slut:
end;
end skriv_hio;
trap(hio_trap);
stack_claim(if cm_test then 198 else 146);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_hio(out,0);
<*-2*>
\f
message procedure h_io side 2 - 810507/hko;
repeat
wait_ch(cs_io,op_ref,true,-1);
<*+4*>
if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
<*-4*>
k:=d.op_ref.opkode extract 12;
dest_sem:=
if k = 0 <*attention*> then cs_io_komm else
if k = 22 <*auto vt opdatering*>
or k = 23 <*generel meddelelse*>
or k = 36 <*spring meddelelse*>
or k = 44 <*udeladt i gruppeopkald*>
or k = 45 <*nødopkald modtaget*>
or k = 46 <*nødopkald besvaret*> then cs_io_spool else
if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
0;
<*+4*>
if dest_sem = 0 then
begin
fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end
else
<*-4*>
begin
signal_ch(dest_sem,op_ref,d.op_ref.optype);
end;
until false;
hio_trap:
disable skriv_hio(zbillede,1);
end h_io;
\f
message procedure io_komm side 1 - 810507/hko;
procedure io_komm;
begin
integer array field op_ref,ref,vt_op,iaf;
integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
pos,indeks,sep,sluttegn,operatør,i,j,k;
long navn;
procedure skriv_io_komm(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable
write(zud,"nl",1,<:+++ io_komm :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: op-ref: :>,op_ref,"nl",1,
<: kode: :>,kode,"nl",1,
<: aktion: :>,aktion,"nl",1,
<: ref: :>,ref,"nl",1,
<: vt_op: :>,vt_op,"nl",1,
<: status: :>,status,"nl",1,
<: opgave: :>,opgave,"nl",1,
<: dest-sem: :>,dest_sem,"nl",1,
<: iaf: :>,iaf,"nl",1,
<: i: :>,i,"nl",1,
<: j: :>,j,"nl",1,
<: k: :>,k,"nl",1,
<: navn: :>,string navn,"nl",1,
<: pos: :>,pos,"nl",1,
<: indeks: :>,indeks,"nl",1,
<: sep: :>,sep,"nl",1,
<: sluttegn: :>,sluttegn,"nl",1,
<: vogn: :>,vogn,"nl",1,
<: ll: :>,ll,"nl",1,
<: omr: :>,omr,"nl",1,
<: operatør: :>,operatør,"nl",1,
<::>);
skriv_coru(zud,coru_no(101));
slut:
end;
end skriv_io_komm;
\f
message procedure io_komm side 2 - 810424/hko;
trap(io_komm_trap);
stack_claim((if cm_test then 200 else 146)+24+200);
ref:=0;
navn:= long<::>;
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_komm(out,0);
<*-2*>
repeat
<*V*> wait_ch(cs_io_komm,
op_ref,
true,
-1<*timeout*>);
<*+2*>
if testbit1 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
<: til io :>);
skriv_op(out,op_ref);
end;
<*-2*>
kode:= d.op_ref.op_kode;
i:= terminal_tab.ref.terminal_tilstand;
status:= i shift(-21);
opgave:=
if kode=0 then 1 <* indlæs kommando *> else
0; <* afvises *>
aktion:= if opgave = 0 then 0 else
(case status +1 of(
<* status *>
<* 0 klar *>(1),
<* 1 - *>(-1),<* ulovlig tilstand *>
<* 2 - *>(-1),<* ulovlig tilstand *>
<* 3 stoppet *>(2),
<* 4 noneksist *>(-1),<* ulovlig tilstand *>
<* 5 - *>(-1),<* ulovlig tilstand *>
<* 6 - *>(-1),<* ulovlig tilstand *>
<* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
-1));
\f
message procedure io_komm side 3 - 810428/hko;
case aktion+6 of
begin
begin
<*-5: terminal optaget *>
d.op_ref.resultat:= 16;
afslut_operation(op_ref,-1);
end;
begin
<*-4: operation uden virkning *>
afslut_operation(op_ref,-1);
end;
begin
<*-3: ulovlig operationskode *>
fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
afslut_operation(op_ref,-1);
end;
begin
<*-2: ulovlig aktion *>
fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
afslut_operation(op_ref,-1);
end;
begin
<*-1: ulovlig io_tilstand *>
fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
afslut_operation(op_ref,-1);
end;
begin
<* 0: ikke implementeret *>
fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
afslut_operation(op_ref,-1);
end;
begin
\f
message procedure io_komm side 4 - 851001/cl;
<* 1: indlæs kommando *>
<*V*> wait(bs_zio_adgang);
<*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
if d.op_ref.resultat > 3 then
begin
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,pos,
d.op_ref.resultat);
end
else if d.op_ref.resultat>0 then
begin <*godkendt*>
kode:=d.op_ref.opkode;
i:= kode extract 12;
j:= if kode < 5 or
kode=7 or kode=8 or
kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
kode=20 or kode=24 then 4<*VO,F/VO,R*>else
if kode =21 then 5 <*AU*> else
if kode =25 then 6 <*GR,D*> else
if kode =26 then 5 <*GR,S*> else
if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
if kode =30 then 10 <*SP,D*> else
if kode =31 then 5 <*SP*> else
if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
if kode=71 then 11 <*FO,V*> else
if kode =75 then 12 <*TÆ,V *>else
if kode =76 then 12 <*TÆ,N *>else
if kode =65 then 13 <*BE,N *>else
if kode =66 then 14 <*BE,G *>else
if kode =67 then 15 <*BE,V *>else
if kode =68 then 16 <*ST,D *>else
if kode =69 then 17 <*ST,V *>else
if kode =36 then 18 <*AL *>else
if kode =37 then 19 <*CC *>else
if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
0;
if j > 0 then
begin
case j of
begin
begin
\f
message procedure io_komm side 5 - 810424/hko;
<* 1: inkluder/ekskluder ydre enhed *>
d.op_ref.retur:= cs_io_komm;
if kode=1 then d.opref.opkode:=
ia(2) shift 12 + d.opref.opkode extract 12;
d.op_ref.data(1):= ia(1);
signal_ch(if kode < 5 or kode>=72 then cs_rad
else cs_gar,
op_ref,gen_optype or io_optype);
indeks:= op_ref;
wait_ch(cs_io_komm,
op_ref,
true,
-1<*timeout*>);
<*+4*> if op_ref <> indeks then
fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,
d.op_ref.resultat);
end;
begin
\f
message procedure io_komm side 6 - 810501/hko;
<* 2: tid/attention,ja/attention,nej
slut/slut med billede *>
case d.op_ref.opkode -79 of
begin
<* 80: TI *> begin
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
if ia(1) <> 0 or ia(2) <> 0 then
begin real field rf;
rf:= 4;
trap(forbudt);
<*V*> setposition(z_io,0,0);
systime(3,ia.rf,0.0);
if false then
begin
forbudt: skriv_kvittering(z_io,0,-1,
43<*ændring af dato/tid ikke lovlig*>);
end
else
skriv_kvittering(z_io,0,-1,3);
end
else
begin
setposition(z_io,0,0);
write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
end;
end TI;
\f
message procedure io_komm side 7 - 810424/hko;
<*81: AT,J*> begin
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(zio,'nl');
monitor(10)release process:(z_io,0,ia);
skriv_kvittering(z_io,0,-1,3);
end;
<* 82: AT,N*> begin
i:= monitor(8)reserve process:(z_io,0,ia);
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(zio,'nl');
skriv_kvittering(z_io,0,-1,
if i = 0 then 3 else 0);
end;
<* 83: SL *> begin
errorbits:=0; <* warning.no ok.yes *>
trapmode:= 1 shift 13;
trap(-2);
end;
<* 84: SL,B *>begin
errorbits:=1; <* warning.no ok.no *>
trap(-3);
end;
<* 85: SL,K *>begin
errorbits:=1; <* warning.no ok.no *>
disable sæt_bit_i(trapmode,15,0);
trap(-3);
end;
\f
message procedure io_komm side 7a - 810511/cl;
<* 86: TE,J *>begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
for i:= 1 step 1 until indeks do
if 0<=ia(i) and ia(i)<=47 then
begin
case (ia(i)+1) of
begin
testbit0 := true;testbit1 := true;testbit2 := true;
testbit3 := true;testbit4 := true;testbit5 := true;
testbit6 := true;testbit7 := true;testbit8 := true;
testbit9 := true;testbit10:= true;testbit11:= true;
testbit12:= true;testbit13:= true;testbit14:= true;
testbit15:= true;testbit16:= true;testbit17:= true;
testbit18:= true;testbit19:= true;testbit20:= true;
testbit21:= true;testbit22:= true;testbit23:= true;
testbit24:= true;testbit25:= true;testbit26:= true;
testbit27:= true;testbit28:= true;testbit29:= true;
testbit30:= true;testbit31:= true;testbit32:= true;
testbit33:= true;testbit34:= true;testbit35:= true;
testbit36:= true;testbit37:= true;testbit38:= true;
testbit39:= true;testbit40:= true;testbit41:= true;
testbit42:= true;testbit43:= true;testbit44:= true;
testbit45:= true;testbit46:= true;testbit47:= true;
end;
end;
skriv_kvittering(z_io,0,-1,3);
end;
\f
message procedure io_komm side 7b - 810511/cl;
<* 87: TE,N *>begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
for i:= 1 step 1 until indeks do
if 0<=ia(i) and ia(i)<=47 then
begin
case (ia(i)+1) of
begin
testbit0 := false;testbit1 := false;testbit2 := false;
testbit3 := false;testbit4 := false;testbit5 := false;
testbit6 := false;testbit7 := false;testbit8 := false;
testbit9 := false;testbit10:= false;testbit11:= false;
testbit12:= false;testbit13:= false;testbit14:= false;
testbit15:= false;testbit16:= false;testbit17:= false;
testbit18:= false;testbit19:= false;testbit20:= false;
testbit21:= false;testbit22:= false;testbit23:= false;
testbit24:= false;testbit25:= false;testbit26:= false;
testbit27:= false;testbit28:= false;testbit29:= false;
testbit30:= false;testbit31:= false;testbit32:= false;
testbit33:= false;testbit34:= false;testbit35:= false;
testbit36:= false;testbit37:= false;testbit38:= false;
testbit39:= false;testbit40:= false;testbit41:= false;
testbit42:= false;testbit43:= false;testbit44:= false;
testbit45:= false;testbit46:= false;testbit47:= false;
end;
end;
skriv_kvittering(z_io,0,-1,3);
end;
<* 88: O *> begin
integer array odescr,zdescr(1:20);
long array field laf;
integer res, i, j;
i:= j:= 1;
while læstegn(ia,i,res)<>0 do
begin
if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
skrivtegn(ia,j,res);
end;
laf:= 2;
getzone6(out,odescr);
getzone6(z_io,zdescr);
close(out,zdescr.laf(1)<>odescr.laf(1) or
zdescr.laf(2)<>odescr.laf(2));
laf:= 0;
if ia(1)=0 then
begin
res:= 3;
j:= 0;
end
else
begin
j:= res:= openbs(out,j,ia,0);
if res<>0 then
res:= 46;
end;
if res<>0 then
begin
open(out,8,konsol_navn,0);
if j<>0 then
begin
i:= 1;
fejlreaktion(4,j,string ia.laf(increase(i)),1);
end;
end
else res:= 3;
setposition(z_io,0,0);
skriv_kvittering(z_io,0,-1,res);
end;
end;<*case d.op_ref.opkode -79*>
end;<*case 2*>
begin
\f
message procedure io_komm side 8 - 810424/hko;
<* 3: vogntabel,linienr/-,busnr*>
d.op_ref.retur:= cs_io_komm;
tofrom(d.op_ref.data,ia,10);
indeks:= op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
wait_ch(cs_io_komm,
op_ref,
io_optype,
-1<*timeout*>);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:io operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if indeks <> op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
<*-4*>
i:=d.op_ref.resultat;
if i<1 or i>3 then
begin
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end
else
begin
\f
message procedure io_komm side 9 - 820301/hko,cl;
integer antal,filref;
antal:= d.op_ref.data(6);
fil_ref:= d.op_ref.data(7);
pos:= 0;
<*V*> setposition(zio,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
for pos:= pos +1 while pos <= antal do
begin
integer bogst,løb;
disable i:= læsfil(fil_ref,pos,j);
if i <> 0 then
fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
vogn:= fil(j,1) shift (-24) extract 24;
løb:= fil(j,1) extract 24;
if d.op_ref.opkode=9 then
begin i:=vogn; vogn:=løb; løb:=i; end;
ll:= løb shift(-12) extract 10;
bogst:= løb shift(-7) extract 5;
if bogst > 0 then bogst:= bogst+'A'-1;
løb:= løb extract 7;
vogn:= vogn extract 14;
i:= d.op_ref.opkode -8;
for i:= i,i +1 do
begin
j:= (i+1) extract 1;
case j+1 of
begin
write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
false add bogst,1,"/",1,true,3,<<d>,løb);
write(zio,<<dddd>,vogn,"sp",1);
end;
end;
if pos mod 5 = 0 then
begin
outchar(zio,'nl');
<*V*> setposition(zio,0,0);
end
else write(zio,"sp",3);
end;
write(zio,"*",1);
\f
message procedure io_komm side 9a - 810505/hko;
d.op_ref.opkode:=104;<*slet fil*>
d.op_ref.data(4):=filref;
indeks:=op_ref;
signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:io operation retur fra sletfil:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
<*-4*>
if d.op_ref.data(9)<>0 then
fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
<:io-komm, sletfil:>,1);
end;
end;
begin
\f
message procedure io_komm side 10 - 820301/hko;
<* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
vogn:=ia(1);
ll:=ia(2);
omr:= if kode=11 or kode=19 then ia(3) else
if kode=12 then ia(2) else 0;
if kode=19 and omr<=0 then
begin
if omr=-1 then omr:= 0
else omr:= 14 shift 20 + 3; <*OMR TCT*>
end;
<*V*> wait_ch(cs_vt_adgang,
vt_op,
gen_optype,
-1<*timeout sek*>);
start_operation(vtop,101,cs_io_komm,
kode);
d.vt_op.data(1):=vogn;
d.vt_op.data(2):=ll;
d.vt_op.data(if kode=19 then 3 else 4):= omr;
indeks:= vt_op;
signal_ch(cs_vt,
vt_op,
gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,
vt_op,
io_optype,
-1<*timeout sek*>);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,
<:iooperation retur fra vt:>);
skriv_op(out,vt_op);
end;
<*-2*>
<*+4*> if vt_op<>indeks then
fejl_reaktion(11<*fremmede op*>,op_ref,
<:io-kommando:>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
d.vt_op.resultat = 12 then d.vt_op.data(3)
else vt_op,-1,d.vt_op.resultat);
d.vt_op.optype:= genoptype or vt_optype;
disable afslut_operation(vt_op,cs_vt_adgang);
end;
begin
\f
message procedure io_komm side 11 - 810428/hko;
<* 5 autofil-skift
gruppe,slet
spring (igangsæt)
spring,annuler
spring,reserve *>
tofrom(d.op_ref.data,ia,8);
d.op_ref.retur:=cs_io_komm;
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,
op_ref,
io_optype,
-1<*timeout*>);
<*+2*> if testbit2 and overvåget then
disable begin
skriv_io_komm(out,0);
write(out,"nl",1,<:io operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if indeks<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io-kommando(autofil):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
d.op_ref.resultat=12) and kode=34 <*SP,R*> then
d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
end;
begin
\f
message procedure io_komm side 12 - 820301/hko/cl;
<* 6 gruppedefinition *>
tofrom(d.op_ref.data,ia,indeks*2);
<*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
start_operation(vt_op,101,cs_io_komm,
101<*opret fil*>);
d.vt_op.data(1):=256;<*postantal*>
d.vt_op.data(2):=1; <*postlængde*>
d.vt_op.data(3):=1; <*segmentantal*>
d.vt_op.data(4):=
2 shift 10; <*spool fil*>
signal_ch(cs_opret_fil,vt_op,io_optype);
pos:=vt_op;<*variabel lånes*>
<*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
<*+4*> if vt_op<>pos then
fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
if d.vt_op.data(9)<>0 then
fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
<:io-kommando(gruppedefinition):>,0);
<*-4*>
iaf:=0;
for i:=1 step 1 until indeks-1 do
begin
disable k:=modif_fil(d.vt_op.data(4),i,j);
if k<>0 then
fejlreaktion(7<*modif-fil*>,k,
<:io kommando(gruppe-def):>,0);
fil(j).iaf(1):=d.op_ref.data(i+1);
end;
while sep = ',' do
begin
wait(bs_fortsæt_adgang);
pos:= 1; j:= 0;
while læs_store(z_io,i) < 8 do
begin
skrivtegn(fortsæt,pos,i);
if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
end;
skrivtegn(fortsæt,pos,'em');
afsluttext(fortsæt,pos);
sluttegn:= i;
if j<>0 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(zio,opref,-1,53);<*annulleret*>
goto gr_ann;
end;
\f
message procedure io_komm side 13 - 810512/hko/cl;
disable begin
integer array værdi(1:4);
integer a_pos,res;
pos:= 0;
repeat
apos:= pos;
læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
if res >= 0 then
begin
if res=0 and (sep=',' or indeks>2) then <*ok*>
else if res=0 then res:= -25 <*parameter mangler*>
else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
res:= -7 <*busnr ulovligt*>
else if res=2 or res=6 then
begin
k:=modiffil(d.vt_op.data(4),indeks,j);
if k<>0 then fejlreaktion(7<*modiffil*>,k,
<:io kommando(gruppe-def):>,0);
iaf:= 0;
fil(j).iaf(1):= værdi(1) +
(if res=6 then 1 shift 22 else 0);
indeks:= indeks+1;
if sep = ',' then res:= 0;
end
else res:= -27; <*parametertype*>
end;
if res>0 then pos:= a_pos;
until sep<>'sp' or res<=0;
if res<0 then
begin
d.op_ref.resultat:= -res;
i:=1;
hægt_tekst(d.op_ref.data,i,fortsæt,1);
afsluttext(d.op_ref.data,i);
end;
end;
\f
message procedure io_komm side 13a - 810512/hko/cl;
if d.op_ref.resultat > 3 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
goto gr_ann;
end;
signalbin(bs_fortsæt_adgang);
end while sep = ',';
d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
k:= sætfildim(d.vt_op.data);
if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
signalch(cs_io_fil,vt_op,io_optype or gen_optype);
d.op_ref.retur:=cs_io_komm;
pos:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if pos<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io kommando(gruppedef retur fra vt):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
if false then
begin
gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
waitch(cs_io_komm,vt_op,io_optype,-1);
signalch(cs_io_fil,vt_op,io_optype or vt_optype);
end;
end;
begin
\f
message procedure io_komm side 14 - 810525/hko/cl;
<* 7 gruppe(-oversigts-)rapport *>
d.op_ref.retur:=cs_io_komm;
d.op_ref.data(1):=ia(1);
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io-kommando(gruppe-rapport):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
if d.op_ref.resultat<>3 then
begin
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end
else
begin
integer bogst,løb;
if kode = 27 then <* gruppe,vis *>
begin
<*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
"G",1,<<z>,d.op_ref.data(1) extract 7,
"sp",2,"-",5,"nl",1);
\f
message procedure io_komm side 15 - 820301/hko;
for pos:=1 step 1 until d.op_ref.data(2) do
begin
disable i:=læsfil(d.op_ref.data(3),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io_kommando(gruppe,vis):>,0);
iaf:=0;
vogn:=fil(j).iaf(1);
if vogn shift(-22) =0 then
write(z_io,<<ddddddd>,vogn extract 14)
else
begin
løb:=vogn extract 7;
bogst:=vogn shift(-7) extract 5;
if bogst>0 then bogst:=bogst+'A'-1;
ll:=vogn shift(-12) extract 10;
write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
false add bogst,1,"/",1,true,3,<<d>,løb);
end;
if pos mod 8 =0 then outchar(z_io,'nl')
else write(z_io,"sp",2);
end;
write(z_io,"*",1);
\f
message procedure io_komm side 16 - 810512/hko/cl;
end
else if kode=28 then <* gruppe,oversigt *>
begin
write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
"sp",2,"-",5,"nl",2);
for pos:=1 step 1 until d.op_ref.data(1) do
begin
disable i:=læsfil(d.op_ref.data(2),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io-kommando(gruppe-oversigt):>,0);
iaf:=0;
ll:=fil(j).iaf(1);
write(z_io,"G",1,<<z>,true,3,ll extract 7);
if pos mod 10 =0 then outchar(z_io,'nl')
else write(z_io,"sp",3);
end;
write(z_io,"*",1);
end;
<* slet fil *>
d.op_ref.opkode:= 104;
d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
end; <* resultat=3 *>
end;
begin
\f
message procedure io_komm side 17 - 810525/cl;
<* 8 spring(-oversigts-)rapport *>
d.op_ref.retur:=cs_io_komm;
tofrom(d.op_ref.data,ia,4);
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io-kommando(spring-rapport):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
if d.op_ref.resultat<>3 then
begin
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end
else
begin
boolean p_skrevet;
integer bogst,løb;
if kode = 32 then <* spring,vis *>
begin
ll:= d.op_ref.data(1) shift (-5) extract 10;
bogst:= d.op_ref.data(1) extract 5;
if bogst<>0 then bogst:= bogst + 'A' - 1;
<*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
<<d>,ll,false add bogst,(bogst<>0) extract 1,
<:.:>,string (extend d.op_ref.data(2) shift 24));
raf:= data+8;
if d.op_ref.raf(1)<>0.0 then
write(z_io,<:, startet :>,<<zddddd>,round
systime(4,d.op_ref.raf(1),r),<:.:>,round r)
else
write(z_io,<:, ikke startet:>);
write(z_io,"sp",2,"-",5,"nl",1);
\f
message procedure io_komm side 18 - 810518/cl;
p_skrevet:= false;
for pos:=1 step 1 until d.op_ref.data(3) do
begin
disable i:=læsfil(d.op_ref.data(4),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io_kommando(spring,vis):>,0);
iaf:=0;
i:= fil(j).iaf(1);
if i < 0 and -, p_skrevet then
begin
outchar(z_io,'('); p_skrevet:= true;
end;
if i > 0 and p_skrevet then
begin
outchar(z_io,')'); p_skrevet:= false;
end;
if pos mod 2 = 0 then
write(z_io,<< dd>,abs i,<:.:>)
else
write(z_io,true,3,<<d>,abs i);
if pos mod 21 = 0 then outchar(z_io,'nl');
end;
write(z_io,"*",1);
\f
message procedure io_komm side 19 - 810525/cl;
end
else if kode=33 then <* spring,oversigt *>
begin
write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
"sp",2,"-",5,"nl",2);
for pos:=1 step 1 until d.op_ref.data(1) do
begin
disable i:=læsfil(d.op_ref.data(2),pos,j);
if i<>0 then
fejlreaktion(5<*læsfil*>,i,
<:io-kommando(spring-oversigt):>,0);
iaf:=0;
ll:=fil(j).iaf(1) shift (-5) extract 10;
bogst:=fil(j).iaf(1) extract 5;
if bogst<>0 then bogst:=bogst + 'A' - 1;
write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
string (extend fil(j).iaf(2) shift 24));
if fil(j,2)<>0.0 then
write(z_io,<:startet :>,<<zddddd>,
round systime(4,fil(j,2),r),<:.:>,round r);
outchar(z_io,'nl');
end;
write(z_io,"*",1);
end;
<* slet fil *>
d.op_ref.opkode:= 104;
if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
end; <* resultat=3 *>
end;
begin
\f
message procedure io_komm side 20 - 820302/hko;
<* 9 fordeling af linier/områder på operatører *>
d.op_ref.retur:=cs_io_komm;
disable
if kode=5 then
begin
integer array io_linietabel(1:max_linienr//3+1);
for ref:= 0 step 512 until (max_linienr//768*512) do
begin
i:= læs_fil(1035,ref//512+1,j);
if i <> 0 then
fejlreaktion(5,i,<:liniefordelingstabel:>,0);
tofrom(io_linietabel.ref,fil(j),
if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
else ((max_linienr+1 - (ref//2*3))+2)//3*2);
end;
ref:=0;
operatør:=ia(1);
for j:=2 step 1 until indeks do
begin
ll:=ia(j);
if ll<>0 then
skrivtegn(io_linietabel,abs(ll)+1,
if ll>0 then operatør else 0);
end;
for ref:= 0 step 512 until (max_linienr//768*512) do
begin
i:= skriv_fil(1035,ref//512+1,j);
if i <> 0 then
fejlreaktion(6,i,<:liniefordelingstabel:>,0);
tofrom(fil(j),io_linietabel.ref,
if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
);
end;
ref:=0;
end
else
begin
modiffil(1034,1,i);
ref:=0;
operatør:=ia(1);
for j:=2 step 1 until indeks do
begin
ll:=ia(j);
fil(i).ref(ll):= if ll>0 then operatør else 0;
end;
end;
indeks:=op_ref;
signal_ch(cs_rad,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fr.post*>,op_ref,
<:io-komm,liniefordeling retur fra rad:>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
end;
begin
\f
message procedure io_komm side 21 - 820301/cl;
<* 10 springdefinition *>
tofrom(d.op_ref.data,ia,indeks*2);
<*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
start_operation(vt_op,101,cs_io_komm,
101<*opret fil*>);
d.vt_op.data(1):=128;<*postantal*>
d.vt_op.data(2):=2; <*postlængde*>
d.vt_op.data(3):=1; <*segmentantal*>
d.vt_op.data(4):=
2 shift 10; <*spool fil*>
signal_ch(cs_opret_fil,vt_op,io_optype);
pos:=vt_op;<*variabel lånes*>
<*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
<*+4*> if vt_op<>pos then
fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
if d.vt_op.data(9)<>0 then
fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
<:io-kommando(springdefinition):>,0);
<*-4*>
iaf:=0;
for i:=1 step 1 until indeks-2 do
begin
disable k:=modif_fil(d.vt_op.data(4),i,j);
if k<>0 then
fejlreaktion(7<*modif-fil*>,k,
<:io kommando(spring-def):>,0);
fil(j).iaf(1):=d.op_ref.data(i+2);
end;
while sep = ',' do
begin
wait(bs_fortsæt_adgang);
pos:= 1; j:= 0;
while læs_store(z_io,i) < 8 do
begin
skrivtegn(fortsæt,pos,i);
if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
end;
skrivtegn(fortsæt,pos,'em');
afsluttext(fortsæt,pos);
sluttegn:= i;
if j<>0 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
goto sp_ann;
end;
\f
message procedure io_komm side 22 - 810519/cl;
disable begin
integer array værdi(1:4);
integer a_pos,res;
pos:= 0;
repeat
apos:= pos;
læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
if res >= 0 then
begin
if res=0 and (sep=',' or indeks>2) then <*ok*>
else if res=0 then res:= -25 <*parameter mangler*>
else if res=10 and (værdi(1)<1 or værdi(1)>99) then
res:= -44 <*intervalstørrelse ulovlig*>
else if res=10 and (værdi(2)<1 or værdi(2)>99) then
res:= -6 <*løbnr ulovligt*>
else if res=10 then
begin
k:=modiffil(d.vt_op.data(4),indeks-1,j);
if k<>0 then fejlreaktion(7<*modiffil*>,k,
<:io kommando(spring-def):>,0);
iaf:= 0;
fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
indeks:= indeks+1;
if sep = ',' then res:= 0;
end
else res:= -27; <*parametertype*>
end;
if res>0 then pos:= a_pos;
until sep<>'sp' or res<=0;
if res<0 then
begin
d.op_ref.resultat:= -res;
i:=1;
hægt_tekst(d.op_ref.data,i,fortsæt,1);
afsluttext(d.op_ref.data,i);
end;
end;
\f
message procedure io_komm side 23 - 810519/cl;
if d.op_ref.resultat > 3 then
begin
setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
goto sp_ann;
end;
signalbin(bs_fortsæt_adgang);
end while sep = ',';
d.vt_op.data(1):= indeks-2;
k:= sætfildim(d.vt_op.data);
if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
signalch(cs_io_fil,vt_op,io_optype or gen_optype);
d.op_ref.retur:=cs_io_komm;
pos:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or io_optype);
<*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
<*+4*> if pos<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:io kommando(springdef retur fra vt):>,0);
<*-4*>
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
if false then
begin
sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
waitch(cs_io_komm,vt_op,io_optype,-1);
signalch(cs_io_fil,vt_op,io_optype or vt_optype);
signalbin(bs_fortsæt_adgang);
end;
end;
begin
integer i,j,k,opr,lin,max_lin;
boolean o_ud, t_ud;
\f
message procedure io_komm side 23a - 820301/cl;
<* 11 fordelingsrapport *>
<*V*> setposition(z_io,0,0);
if sluttegn <> 'nl' then outchar(z_io,'nl');
max_lin:= max_linienr;
for opr:= 1 step 1 until max_antal_operatører, 0 do
begin
o_ud:= t_ud:= false;
k:= 0;
if opr<>0 then
begin
j:= k:= 0;
for lin:= 1 step 1 until max_lin do
begin
læs_tegn(radio_linietabel,lin+1,i);
if i<>0 then j:= lin;
if opr=i and opr<>0 then
begin
if -, o_ud then
begin
o_ud:= true;
if opr<>0 then
write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
"sp",2,string bpl_navn(opr))
else
write(z_io,"nl",1,<:ikke fordelte:>);
end;
if -, t_ud then
begin
write(z_io,<:<'nl'> linier: :>);
t_ud:= true;
end;
k:=k+1;
if k>1 and k mod 10 = 1 then
write(z_io,"nl",1,"sp",13);
write(z_io,<<ddd >,lin);
end;
if lin=max_lin then max_lin:= j;
end;
end;
k:= 0; t_ud:= false;
for i:= 1 step 1 until max_antal_områder do
begin
if radio_områdetabel(i)= opr then
begin
if -, o_ud then
begin
o_ud:= true;
if opr<>0 then
write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
"sp",2,string bpl_navn(opr))
else
write(z_io,"nl",1,<:ikke fordelte:>);
end;
if -, t_ud then
begin
write(z_io,<:<'nl'> områder: :>);
t_ud:= true;
end;
k:= k+1;
if k>1 and k mod 10 = 1 then
write(z_io,"nl",1,"sp",13);
write(z_io,true,4,string område_navn(i));
end;
end;
if o_ud then write(z_io,"nl",1);
end;
write(z_io,"*",1);
end;
begin
integer omr,typ,sum;
integer array ialt(1:5);
real r;
\f
message procedure io_komm side 24 - 810501/hko;
<* 12 vis/nulstil opkaldstællere *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
if kode=76 and indeks=1 then
begin <* TÆ,N <tid> *>
if ia(1)<(-1) or 2400<ia(1) then
skriv_kvittering(z_io,opref,-1,64)
else
begin
if ia(1)=(-1) then nulstil_systællere:= -1
else nulstil_systællere:= (ia(1) mod 2400)*100;
opdater_tf_systællere;
skriv_kvittering(z_io,opref,-1,3);
end;
end
else
begin
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,
<:område udgående alm. ind nød ind:>,
<: ind ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_områder do
begin
sum:= 0;
write(z_io,true,6,string område_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
sum:= sum + opkalds_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4), ialt(5), "nl",3);
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,
<:oper. udgående alm. ind nød ind:>,
<: ind ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_operatører do
begin
sum:= 0;
if bpl_navn(omr)=long<::> then
write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
else
write(z_io,true,6,string bpl_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
sum:= sum + operatør_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4),ialt(5),"nl",2);
typ:= replacechar(1,':');
write(z_io,<:tællere nulstilles :>);
if nulstil_systællere=(-1) then
write(z_io,<:ikke automatisk:>,"nl",1)
else
write(z_io,<:automatisk kl. :>,<<zd dd dd>,
nulstil_systællere,"nl",1);
replacechar(1,'.');
write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
systime(4,systællere_nulstillet,r));
replacechar(1,':');
write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
replacechar(1,typ);
write(z_io,"*",1,"nl",1);
setposition(z_io,0,0);
if kode = 76 <* nulstil tællere *> then
disable begin
for omr:= 1 step 1 until max_antal_områder*5 do
opkalds_tællere(omr):= 0;
for omr:= 1 step 1 until max_antal_operatører*5 do
operatør_tællere(omr):= 0;
systime(1,0.0,systællere_nulstillet);
opdater_tf_systællere;
typ:= replacechar(1,'.');
write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
systime(4,systællere_nulstillet,r));
replacechar(1,':');
write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
replacechar(1,typ);
setposition(z_io,0,0);
end;
end;
end;
begin
\f
message procedure io_komm side 25 - 940522/cl;
<* 13 navngiv betjeningsplads *>
boolean incl;
long field lf;
lf:=6;
operatør:= ia(1);
navn:= ia.lf;
incl:= false add (ia(4) extract 8);
if navn=long<::> then
begin
<* nedlæg navn - check for i brug *>
iaf:= operatør*terminal_beskr_længde;
if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
d.opref.resultat:= 48 <*i brug*>
else
begin
for i:= 65 step 1 until top_bpl_gruppe do
begin
iaf:= i*op_maske_lgd;
if læsbit_ia(bpl_def.iaf,operatør) then
d.opref.resultat:= 48<*i brug*>;
end;
end;
if d.opref.resultat <= 3 then
begin
for i:= 1 step 1 until sidste_bus do
if bustabel(i) shift (-14) extract 8 = operatør then
d.opref.resultat:= 48<*i brug*>;
end;
end
else
begin
<* opret/omdøb *>
i:= find_bpl(navn);
if i<>0 and i<>operatør then
d.opref.resultat:= 48 <*i brug*>;
end;
if d.opref.resultat<=3 then
begin
bpl_navn(operatør):= navn;
operatør_auto_include(operatør):= incl;
k:= modif_fil(tf_bpl_navne,operatør,ll);
if k<>0 then
fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
lf:= 4;
fil(ll).lf:= navn add (incl extract 8);
setposition(fil(ll),0,0);
<* skriv bplnavne *>
disable begin
zone z(128,1,stderror);
long array field laf;
integer array ia(1:10);
open(z,4,<:bplnavne:>,0);
laf:= 0;
outrec6(z,512);
for i:= 1 step 1 until 127 do
z.laf(i):= bpl_navn(i);
close(z,true);
monitor(42,z,0,ia);
ia(6):= systime(7,0,0.0);
monitor(44,z,0,ia);
end;
d.opref.resultat:= 3;<*udført*>
end;
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,d.opref.resultat);
end;
begin
\f
message procedure io_komm side 26 - 940522/cl;
<* 14 betjeningsplads - gruppe *>
integer ant_i_gruppe;
long field lf;
integer array maske(1:op_maske_lgd//2);
lf:= 4; ant_i_gruppe:= 0;
tofrom(maske,ingen_operatører,op_maske_lgd);
navn:= ia.lf;
operatør:= find_bpl(navn);
for i:= 3 step 1 until indeks do
if sætbit_ia(maske,ia(i),1)=0 then
ant_i_gruppe:= ant_i_gruppe+1;
if ant_i_gruppe=0 then
begin
<* slet gruppe *>
if operatør<=64 then
d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
else 62<*navn ulovligt*>)
else
begin
for i:= 1 step 1 until max_antal_operatører do
for j:= 1 step 1 until 3 do
if operatør_stop(i,j)=operatør then
d.opref.resultat:= 48<*i brug*>;
end;
navn:= long<::>;
end
else
begin
if 1<=operatør and operatør<=64 then
d.opref.resultat:= 62<*navn ulovligt*>
else
if operatør=0 then
begin
i:=65;
while i<=127 and operatør=0 do
begin
if bpl_navn(i)=long<::> then operatør:=i;
i:= i+1;
end;
if operatør=0 then
d.opref.resultat:= 32<*ikke plads*>
else if operatør>top_bpl_gruppe then
top_bpl_gruppe:= operatør;
end;
end;
if d.opref.resultat<=3 then
begin
bpl_navn(operatør):= navn;
iaf:= operatør*op_maske_lgd;
tofrom(bpl_def.iaf,maske,op_maske_lgd);
bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
for i:= 1 step 1 until max_antal_operatører do
begin
if læsbit_ia(maske,i) then
begin
bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
if læsbit_ia(operatør_maske,i) then
bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
end;
end;
k:=modif_fil(tf_bplnavne,operatør,ll);
if k<>0 then
fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
lf:= 4;
fil(ll).lf:= navn;
setposition(fil(ll),0,0);
iaf:= 0;
k:= modif_fil(tf_bpl_def,operatør-64,ll);
if k<>0 then
fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
for i:= 1 step 1 until op_maske_lgd//2 do
fil(ll).iaf(i):= maske(i);
fil(ll).iaf(4):= bpl_tilst(operatør,2);
setposition(fil(ll),0,0);
d.opref.resultat:= 3;
end;
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,d.opref.resultat);
end;
begin
\f
message procedure io_komm side 27 - 940522/cl;
<* 15 vis betjeningspladsdefinitioner *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
for i:= 1 step 1 until max_antal_operatører do
begin
write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
case operatør_auto_include(i) extract 2 + 1 of(
<:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
if i mod 4 = 0 then write(z_io,"nl",1)
else write(z_io,"sp",5);
end;
if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
write(z_io,"nl",1,<:grupper::>,"nl",1);
for i:= 65 step 1 until top_bpl_gruppe do
begin
ll:=0; iaf:= i*op_maske_lgd;
if bpl_navn(i)<>long<::> then
begin
write(z_io,true,6,string bpl_navn(i),":",1);
for j:= 1 step 1 until max_antal_operatører do
begin
if læsbit_ia(bpl_def.iaf,j) then
begin
if ll mod 8 = 0 and ll<>0 then
write(z_io,"nl",1,"sp",7);
write(z_io,"sp",2,string bpl_navn(j));
ll:=ll+1;
end;
end;
write(z_io,"nl",1);
end;
end;
write(z_io,"*",1);
end;
begin
\f
message procedure io_komm side 28 - 940522/cl;
<* 16 stopniveau,definer *>
operatør:= ia(1);
iaf:= operatør*terminal_beskr_længde;
for i:= 1 step 1 until 3 do
operatør_stop(operatør,i):= ia(i+1);
if -,læsbit_ia(operatørmaske,operatør) then
begin
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
signal_bin(bs_mobilopkald);
end;
k:=modif_fil(tf_stoptabel,operatør,ll);
if k<>0 then
fejlreaktion(7,k,<:stopniveau,definer:>,0);
iaf:= 0;
for i:= 0 step 1 until 3 do
fil(ll).iaf(i+1):= operatør_stop(operatør,i);
setposition(fil(ll),0,0);
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,0,-1,3);
end;
begin
\f
message procedure io_komm side 29 - 940522/cl;
<* 17 stopniveauer,vis *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
for operatør:= 1 step 1 until max_antal_operatører do
begin
iaf:=operatør*terminal_beskr_længde;
ll:=0;
ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
string bpl_navn(operatør),<:(:>,
case terminal_tab.iaf.terminal_tilstand shift (-21)
+ 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
<:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
for i:= 1 step 1 until 3 do
ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
if operatør_stop(operatør,i)=0 then <:ALLE:>
else string bpl_navn(operatør_stop(operatør,i)));
if operatør mod 2 = 1 then
write(z_io,"sp",40-ll)
else
write(z_io,"nl",1);
end;
if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
write(z_io,"*",1);
end;
begin
\f
message procedure io_komm side 30 - 941007/cl;
<* 18 alarmlængder *>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
for operatør:= 1 step 1 until max_antal_operatører do
begin
ll:=0;
ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
string bpl_navn(operatør));
iaf:=(operatør-1)*opk_alarm_tab_lgd;
if opk_alarm.iaf.alarm_lgd < 0 then
ll:= ll+write(z_io,<:uendelig:>)
else
ll:= ll+write(z_io,<<ddddddd>,
opk_alarm.iaf.alarm_lgd,<: sek.:>);
if operatør mod 2 = 1 then
write(z_io,"sp",40-ll)
else
write(z_io,"nl",1);
end;
if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
write(z_io,"*",1);
end;
begin
<* 19 CC *>
integer i, c;
i:= 1;
while læstegn(ia,i+0,c)<>0 and
i<(op_spool_postlgd-op_spool_text)//2*3
do skrivtegn(d.opref.data,i,c);
repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
d.opref.retur:= cs_io_komm;
signalch(cs_op,opref,io_optype or gen_optype);
<*V*> waitch(cs_io_komm,opref,io_optype,-1);
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,d.opref.resultat);
end;
begin
<* 20: CQF,I CQF,U CQF,V *>
integer kode, res, i, j;
integer array field iaf, iaf1;
long field navn;
kode:= d.opref.opkode extract 12;
navn:= 6; res:= 0;
if kode=90 <*CQF,I*> then
begin
if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
res:= 10 <*busnr ukendt*>
else
begin
j:= -1;
for i:= 1 step 1 until max_cqf do
begin
iaf:= (i-1)*cqf_lgd;
if ia(1) = cqf_tabel.iaf.cqf_bus or
ia.navn = cqf_tabel.iaf.cqf_id
then res:= 48; <*i brug*>
if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
end;
if res=0 and j<0 then res:= 32; <*ingen fri plads*>
if res=0 then
begin
iaf:= (j-1)*cqf_lgd;
cqf_tabel.iaf.cqf_bus:= ia(1);
cqf_tabel.iaf.cqf_fejl:= 0;
cqf_tabel.iaf.cqf_id:= ia.navn;
cqf_tabel.iaf.cqf_ok_tid:= real <::>;
cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
res:= 3;
end;
end;
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,res);
end
else
if kode=91 <*CQF,U*> then
begin
j:= -1;
for i:= 1 step 1 until max_cqf do
begin
iaf:= (i-1)*cqf_lgd;
if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
end;
if j>=0 then
begin
iaf:= (j-1)*cqf_lgd;
for i:= 1 step 1 until cqf_lgd//2 do
cqf_tabel.iaf(i):= 0;
res:= 3;
end
else res:= 13; <*bus ikke indsat*>
setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,opref,-1,res);
end
else
begin
setposition(z_io,0,0);
skriv_cqf_tabel(z_io,false);
outchar(z_io,'*');
setposition(z_io,0,0);
end;
if kode=90 or kode=91 then
begin
j:= skrivfil(1033,1,i);
if j<>0 then
fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
for k:= 1 step 1 until max_cqf do
begin
iaf1:= (k-1)*cqf_lgd;
iaf := (k-1)*cqf_id;
tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
end;
op_cqf_tab_ændret:= true;
end;
end;<*CQF*>
begin
\f
message procedure io_komm side xx - 940522/cl;
<*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
<*-3*>
end
end;<*case j *>
end <* j > 0 *>
else
begin
<*V*> setposition(z_io,0,0);
if sluttegn<>'nl' then outchar(z_io,'nl');
skriv_kvittering(z_io,op_ref,-1,
45 <* ikke implementeret *>);
end;
end;<* godkendt *>
<*V*> setposition(z_io,0,0);
signal_bin(bs_zio_adgang);
d.op_ref.retur:=cs_att_pulje;
disable afslut_kommando(op_ref);
end; <* indlæs kommando *>
begin
\f
message procedure io_komm side xx+1 - 810428/hko;
<* 2: aktiver efter stop *>
terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
terminal_tab.ref.terminal_tilstand extract 21;
afslut_operation(op_ref,-1);
signal_bin(bs_zio_adgang);
end;
<*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
<*-3*>
end; <* case aktion+6 *>
until false;
io_komm_trap:
if -,(alarmcause shift (-24) extract 24 = (-2) and
alarmcause extract 24 = (-13)) then
disable skriv_io_komm(zbillede,1);
end io_komm;
\f
message procedure io_spool side 1 - 810507/hko;
procedure io_spool;
begin
integer
næste_tomme,nr;
integer array field
op_ref;
procedure skriv_io_spool(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_spool :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: opref: :>,op_ref,"nl",1,
<: næstetomme::>,næste_tomme,"nl",1,
<: nr :>,nr,"nl",1,
<::>);
skriv_coru(zud,coru_no(102));
slut:
end;<*disable*>
end skriv_io_spool;
trap(io_spool_trap);
næste_tomme:= 1;
stack_claim((if cm_test then 200 else 146)+24 +48);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_spool(out,0);
<*-2*>
\f
message procedure io_spool side 2 - 810602/hko;
repeat
wait_ch(cs_io_spool,
op_ref,
true,
-1<*timeout*>);
i:= d.op_ref.opkode;
if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
begin
wait(ss_io_spool_tomme);
disable modif_fil(io_spoolfil,næste_tomme,nr);
næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
i:= d.op_ref.opsize;
<*+4*> if i > io_spool_postlængde*2 -io_spool_post then
begin
<* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
i:= io_spool_postlængde*2 -io_spool_post;
end;
<*-4*>
fil(nr,1):= real(extend d.op_ref.opsize shift 24);
tofrom(fil(nr).io_spool_post,d.op_ref,i);
signal(ss_io_spool_fulde);
d.op_ref.resultat:= 1;
end
else
begin
fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
<:io_spool_korutine:>,1);
end;
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
until false;
io_spool_trap:
disable skriv_io_spool(zbillede,1);
end io_spool;
\f
message procedure io_spon side 1 - 810507/hko;
procedure io_spon;
begin
integer
næste_fulde,nr,i,dato,kl;
real t;
procedure skriv_io_spon(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_spon :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: næste-fulde::>,næste_fulde,"nl",1,
<: nr :>,nr,"nl",1,
<::>);
skriv_coru(zud,coru_no(103));
slut:
end;<*disable*>
end skriv_io_spon;
trap(io_spon_trap);
næste_fulde:= 1;
stack_claim((if cm_test then 200 else 146) +24 +48);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_spon(out,0);
<*-2*>
\f
message procedure io_spon side 2 - 810602/hko/cl;
repeat
<*V*> wait(ss_io_spool_fulde);
<*V*> wait(bs_zio_adgang);
<*V*> setposition(zio,0,0);
disable modif_fil(io_spool_fil,næste_fulde,nr);
næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
laf:=data;
k:= fil(nr).io_spool_post.opkode;
if k = 22 or k = 36 then
disable begin
write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
if k=36 then
begin
i:= fil(nr).io_spool_post.data(4);
j:= i extract 5;
if j<>0 then j:=j+'A'-1;
i:= i shift (-5) extract 10;
write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
end;
skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
fil(nr).io_spool_post.tid)
end
else if k = 23 then
disable
begin
write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
dato:= systime(4,fil(nr).io_spool_post.tid,t);
kl:= round t;
i:= replace_char(1<*space in number*>,'.');
write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
replace_char(1,i);
end
else if k = 45 or k = 46 then
disable begin
integer vogn,linie,bogst,løb,t;
t:=fil(nr).io_spool_post.data(2);
outchar(z_io,'nl');
if k = 45 then
write(zio,<<zd.dd>,t/100.0,"sp",1);
write(zio,<:nødopkald fra :>);
vogn:= fil(nr).io_spool_post.data(1);
i:= vogn shift (-22);
if i < 2 then
skrivid(zio,vogn,9)
else
begin
fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
write(zio,<:!!!:>,vogn);
end;
\f
message procedure io_spon side 3 - 810507/hko;
if fil(nr).io_spool_post.data(3)<>0 then
write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
if k = 46 then
begin
write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
end;
end <*disable*>
else
fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
fil(nr,1):= fil(nr,1) add 1;
<*V*> setposition(zio,0,0);
signal_bin(bs_zio_adgang);
signal(ss_io_spool_tomme);
until false;
io_spon_trap:
skriv_io_spon(zbillede,1);
end io_spon;
\f
message procedure io_medd side 1;
procedure io_medd;
begin
integer array field opref;
integer afs, kl, i;
real dato, t;
procedure skriv_io_medd(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_medd :>);
if omfang > 0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: afs: :>,afs,"nl",1,
<: kl: :>,kl,"nl",1,
<: i: :>,i,"nl",1,
<: dato: :>,<<zddddd>,dato,"nl",1,
<: t: :>,t,"nl",1,
<::>);
skriv_coru(zud,coru_no(104));
slut:
end;<*disable*>
end skriv_io_medd;
trap(io_medd_trap);
stack_claim((if cm_test then 200 else 146) +24 +48);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_medd(out,0);
<*-2*>
\f
message procedure io_medd side 2;
repeat
<*V*> waitch(cs_io_medd,opref,gen_optype,-1);
<*V*> wait(bs_zio_adgang);
afs:= d.opref.data.op_spool_kilde;
dato:= systime(4,d.opref.data.op_spool_tid,t);
kl:= round t;
write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
if afs=0 then <:SYSOP:> else string bpl_navn(afs));
i:= replacechar(1,'.');
disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
replacechar(1,i);
write(z_io,d.opref.data.op_spool_text);
setposition(z_io,0,0);
signalbin(bs_zio_adgang);
signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
until false;
io_medd_trap:
skriv_io_medd(zbillede,1);
end io_medd;
procedure io_nulstil_tællere;
begin
real nu, dato, kl, forr, næste, et_døgn, r;
integer array field opref;
integer ventetid, omr, typ, sum;
integer array ialt(1:5);
procedure skriv_io_null(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
disable write(zud,"nl",1,<:+++ io_nulstil_tællere :>);
if omfang > 0 then
disable begin real t; real array field raf;
raf:=0;
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: ventetid: :>,ventetid,"nl",1,
<: omr: :>,omr,"nl",1,
<: typ: :>,typ,"nl",1,
<: sum: :>,sum,"nl",1,
<: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
<: forr: :>,systime(4,forr,t),t,"nl",1,
<: næste: :>,systime(4,næste,t),t,"nl",1,
<: r: :>,systime(4,r,t),t,"nl",1,
<: dato: :>,dato,"nl",1,
<: kl: :>,kl,"nl",1,
<: et-døgn: :>,<< dddddd>,et_døgn,"nl",1,
<::>);
write(zud,"nl",1,<:ialt: :>);
skriv_hele(zud,ialt.raf,10,2);
skriv_coru(zud,coru_no(105));
slut:
end;<*disable*>
end skriv_io_null;
trap(io_null_trap);
stack_claim(500);
<*+2*>
if testbit0 and overvåget or testbit28 then
skriv_io_null(out,0);
<*-2*>
et_døgn:= 24*60*60.0;
systime(1,0.0,nu);
dato:= systime(4,nu,kl);
if nulstil_systællere >= 0 then
begin
if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
+ et_døgn
else næste:= systid(dato,nulstil_systællere);
forr:= næste - et_døgn;
if (forr - systællere_nulstillet) > et_døgn then
næste:= nu;
end;
repeat
ventetid:= (if nulstil_systællere < 0 then (-1) else (næste - nu));
<*V*> waitch(cs_io_nulstil,opref,io_optype,ventetid);
if opref <= 0 then
begin
<* nulstil opkaldstællere *>
wait(bs_zio_adgang);
setposition(z_io,0,0);
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,"nl",1,<:!TÆ,N (automatisk):>,"nl",2,
<:område udgående alm. ind nød ind:>,
<: ind ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_områder do
begin
sum:= 0;
write(z_io,true,6,string område_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
sum:= sum + opkalds_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4), ialt(5), "nl",3);
for typ:= 1 step 1 until 5 do ialt(typ):= 0;
write(z_io,<:oper. udgående alm. ind nød ind:>,
<: ind ialt total ej forb. optaget:>,"nl",1);
for omr := 1 step 1 until max_antal_operatører do
begin
sum:= 0;
if bpl_navn(omr)=long<::> then
write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
else
write(z_io,true,6,string bpl_navn(omr),":",1);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
sum:= sum + operatør_tællere((omr-1)*5+typ);
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,<< ddddddd>,
sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
for typ:= 4 step 1 until 5 do
begin
write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
end;
write(z_io,"nl",1);
end;
sum:= 0;
write(z_io,"nl",1,<:ialt ::>);
for typ:= 1 step 1 until 3 do
begin
write(z_io,<< ddddddd>,ialt(typ));
sum:= sum+ialt(typ);
end;
write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
ialt(4),ialt(5),"nl",2);
typ:= replacechar(1,':');
write(z_io,<:tællere nulstilles :>);
if nulstil_systællere=(-1) then
write(z_io,<:ikke automatisk:>,"nl",1)
else
write(z_io,<:automatisk kl. :>,<<zd dd dd>,
nulstil_systællere,"nl",1);
replacechar(1,'.');
write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
systime(4,systællere_nulstillet,r));
replacechar(1,':');
write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
replacechar(1,typ);
write(z_io,"*",1,"nl",1);
setposition(z_io,0,0);
signal_bin(bs_zio_adgang);
for omr:= 1 step 1 until max_antal_områder*5 do
opkalds_tællere(omr):= 0;
for omr:= 1 step 1 until max_antal_operatører*5 do
operatør_tællere(omr):= 0;
systællere_nulstillet:= næste;
opdater_tf_systællere;
end
else
signalch(d.opref.retur,opref,d.opref.optype);
systime(1,0.0,nu);
dato:= systime(4,nu,kl);
if nulstil_systællere >= 0 then
begin
if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
+ et_døgn
else næste:= systid(dato,nulstil_systællere);
forr:= næste - et_døgn;
end;
until false;
io_null_trap:
skriv_io_null(zbillede,1);
end io_nulstil_tællere;
\f
message operatør_erklæringer side 1 - 810602/hko;
integer
cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
integer array
cqf_tabel(1:max_cqf*cqf_lgd//2),
operatørmaske(1:op_maske_lgd//2),
op_talevej(0:max_antal_operatører),
tv_operatør(0:max_antal_taleveje),
opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
ant_i_opkø,
cs_operatør,
cs_op_fil(1:max_antal_operatører);
boolean
op_cqf_tab_ændret;
integer field
op_spool_kilde;
real field
op_spool_tid;
long array field
op_spool_text;
zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
zone array z_op(max_antal_operatører,320,1,op_fejl);
\f
message procedure op_fejl side 1 - 830310/hko;
procedure op_fejl(z,s,b);
integer s,b;
zone z;
begin
disable begin
integer array iz(1:20);
integer i,j,k,n;
integer array field iaf,iaf1,msk;
boolean input;
real array field laf,laf1;
getzone6(z,iz);
iaf:=laf:=2;
input:= iz(13) = 1;
for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
if iz.laf(1)=terminal_navn.laf1(1) and
iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
<*+2*> if testbit31 then
<**> begin
<**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
<**> <:s=:>); outintbits(out,s);
<**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
<**> else <:output:>,"nl",1);
<**> setposition(out,0,0);
<**> end;
<*-2*>
iaf:=j*terminal_beskr_længde;
k:=1;
i:= terminal_tab.iaf.terminal_tilstand;
if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
1 shift 12 <*binært*> +1 <*fortsæt*>);
if s <> (1 shift 21 +2) then
begin
terminal_tab.iaf.terminal_tilstand:= 1 shift 23
+ terminal_tab.iaf.terminal_tilstand extract 23;
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
sæt_bit_ia(opkaldsflag,j,0);
if sæt_bit_ia(operatørmaske,j,0)=1 then
for k:= j, 65 step 1 until top_bpl_gruppe do
begin
msk:= k*op_maske_lgd;
if læsbit_ia(bpl_def.msk,j) then
<**> begin
n:= 0;
for i:= 1 step 1 until max_antal_operatører do
if læsbit_ia(bpl_def.msk,i) then
begin
iaf1:= i*terminal_beskr_længde;
if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
n:= n+1;
end;
bpl_tilst(j,1):= n;
end;
<**> <*
bpl_tilst(j,1):= bpl_tilst(j,1)-1;
*> end;
signal_bin(bs_mobil_opkald);
end;
if input or -,input then
begin
z(1):=real <:<'?'><'?'><'em'>:>;
b:=2;
end;
end; <*disable*>
end op_fejl;
\f
message procedure tvswitch_fejl side 1 - 940426/cl;
procedure tvswitch_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;
boolean input;
real array field raf;
getzone6(z,iz);
iaf:=raf:=2;
input:= iz(13) = 1;
<*+2*> if testbit31 then
<**> begin
<**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
<**> <:s=:>); outintbits(out,s);
<**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
<**> else <:output:>,"nl",1);
<**> skrivhele(out,z,b,5);
<**> setposition(out,0,0);
<**> end;
<*-2*>
k:=1;
if 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 input or -,input then
begin
z(1):=real <:<'em'>:>;
b:=2;
end;
end; <*disable*>
if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
end tvswitch_fejl;
procedure skriv_talevejs_tab(z);
zone z;
begin
write(z,"nl",2,<:talevejsswitch::>);
write(z,"nl",1,<: operatører::>,"nl",1);
for i:= 1 step 1 until max_antal_operatører do
begin
write(z,<< dd>,i,":",1,op_talevej(i));
if i mod 8=0 then outchar(z,'nl');
end;
write(z,"nl",1,<: taleveje::>,"nl",1);
for i:= 1 step 1 until max_antal_taleveje do
begin
write(z,<< dd>,i,":",1,tv_operatør(i));
if i mod 8=0 then outchar(z,'nl');
end;
write(z,"nl",3);
end;
\f
message procedure skriv_opk_alarm_tab side 1;
procedure skriv_opk_alarm_tab(z);
zone z;
begin
integer nr;
integer array field tab;
real t;
write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
<:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
for nr:=1 step 1 until max_antal_operatører do
begin
tab:= (nr-1)*opk_alarm_tab_lgd;
write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
<<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
<< zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
"nl",1);
end;
end;
\f
message procedure skriv_op_spool_buf side 1;
procedure skriv_op_spool_buf(z);
zone z;
begin
integer array field ref;
integer nr, kilde;
real dato, kl;
write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
for nr:= 1 step 1 until op_spool_postantal do
begin
write(z,"nl",1,<:nr.::>,<< dd>,nr);
ref:= (nr-1)*op_spool_postlgd;
if op_spool_buf.ref.op_spool_tid <> real<::> then
begin
kilde:= op_spool_buf.ref.op_spool_kilde;
dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
write(z,<: fra op:>,<<d>,kilde,"sp",1,
if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
"sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
op_spool_buf.ref.op_spool_text);
end;
outchar(z,'nl');
end;
end;
procedure skriv_cqf_tabel(z,lang);
value lang;
zone z;
boolean lang;
begin
integer array field ref;
integer i,ant;
real dato, kl;
ant:= 0;
write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
if -,lang then
<: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
<* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
else
<:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
<*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
for i:= 1 step 1 until max_cqf do
begin
ref:= (i-1)*cqf_lgd;
if cqf_tabel.ref.cqf_bus<>0 or lang then
begin
ant:= ant+1;
if lang then
write(z,<<dd>,i,":",1);
write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
if cqf_tabel.ref.cqf_ok_tid<>real<::> then
begin
dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
write(z,<< zddddd.dddddd>,dato+kl/1000000);
end
else
write(z,"sp",14,"?",1);
if lang then
begin
if cqf_tabel.ref.cqf_næste_tid<>real<::> then
begin
dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
write(z,<< zddddd.dddddd>,dato+kl/1000000);
end
else
write(z,"sp",14,"?",1);
end
else
write(z,"sp",2);
if lang or (ant mod 2)=0 then outchar(z,'nl');
end;
end;
if -,lang and (ant mod 2)=1 then outchar(z,'nl');
end;
procedure sorter_cqftab(l,u);
value l,u;
integer l,u;
begin
integer array field ii,jj;
integer array ww,xx(1:(cqf_lgd+1)//2);
ii:= ((l+u)//2 - 1)*cqf_lgd;
tofrom(xx,cqf_tabel.ii,cqf_lgd);
ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
repeat
while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
if ii <= jj then
begin
tofrom(ww,cqf_tabel.ii,cqf_lgd);
tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
tofrom(cqf_tabel.jj,ww,cqf_lgd);
ii:= ii+cqf_lgd;
jj:= jj-cqf_lgd;
end;
until ii>jj;
if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
end;
\f
message procedure ht_symbol side 1 - 851001/cl;
procedure ht_symbol(z);
zone z;
write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@ @@ @@
@@ @@ @@
@@ @@ @@
@@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
@@ @@
@@ @@
@@ @@
@@ @@@@@@@@@@@@@ @@
@@ @@ @@ @@
@@ @@ @@ @@
@@ @@ @@ @@
@@@@@@@@@@@@@ @@@@@@@@@@@@@
:>,"esc" add 128,1,<:Æ24;1H:>);
\f
message procedure definer_taster side 1 - 891214,cl;
procedure definer_taster(nr);
value nr;
integer nr;
begin
setposition(z_op(nr),0,0);
write(z_op(nr),
"esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
"esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
"esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
"esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
"esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
"esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
"esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
"esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
"esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
"esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
"esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
"esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
"esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
"esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
"esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
"esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
"esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
"esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
"esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
"esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
"esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
"esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
"esc" add 128,1, <:P1;2;1ø60/1B520D:>,
"esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
"esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
"esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
"esc" add 128,1, <:P1;2;0ø62/1B474520:>,
"esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
"esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
"esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
"esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
"esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
"esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
"esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
"esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
"esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
"esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
"esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
"esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
"esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
"esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
"esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
"esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
"esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
"esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
"esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
"esc" add 128,1, <:P1;2;0ø0E/082008:>,
"esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
<::>);
end;
\f
message procedure skriv_terminal_tab side 1 - 820301/hko;
procedure skriv_terminal_tab(z);
zone z;
begin
integer array field ref;
integer t1,i,j,id,k;
write(z,"ff",1,<:
******* terminalbeskrivelser ********
# a k l p m m n o
1 l a y a o o ø p
nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
<*
01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
*>
for i:=1 step 1 until max_antal_operatører do
begin
ref:=i*terminal_beskr_længde;
t1:=terminal_tab.ref(1);
id:=terminal_tab.ref(2);
k:=terminal_tab.ref(3);
write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
t1 shift(-16) extract 5,t1 shift(-12) extract 4,
"sp",1);
for j:=11 step -1 until 2 do
write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
"sp",1);
skriv_id(z,id,9);
skriv_id(z,k,9);
end;
write(z,"nl",2,<:samtaleflag::>,"nl",1);
outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
write(z,"nl",1);
end skriv_terminal_tab;
\f
message procedure h_operatør side 1 - 810520/hko;
<* hovedmodulkorutine for operatørterminaler *>
procedure h_operatør;
begin
integer array field op_ref;
integer k,nr,ant,ref,dest_sem;
procedure skriv_hoperatør(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ hovedmodul operatør :>);
if omfang>0 then
disable begin integer x;
trap(slut);
write(zud,"nl",1,
<: op_ref: :>,op_ref,"nl",1,
<: nr: :>,nr,"nl",1,
<: ant: :>,ant,"nl",1,
<: ref: :>,ref,"nl",1,
<: k: :>,k,"nl",1,
<: dest_sem: :>,dest_sem,"nl",1,
<::>);
skriv_coru(zud,coru_no(200));
slut:
end;
end skriv_hoperatør;
trap(hop_trap);
stack_claim(if cm_test then 198 else 146);
<*+2*>
if testbit8 and overvåget or testbit28 then
skriv_hoperatør(out,0);
<*-2*>
\f
message procedure h_operatør side 2 - 820304/hko;
repeat
wait_ch(cs_op,op_ref,true,-1);
<*+4*>
if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
<*-4*>
k:=d.op_ref.opkode extract 12;
dest_sem:=
if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
if k=4 then cs_operatør(d.op_ref.data(2)) else
if k=37 then cs_op_spool else
if k=40 or k=38 then 0
else -1;
<*+4*>
if dest_sem=-1 then
begin
fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end
else
<*-4*>
if k=40 then
begin
dest_sem:= d.op_ref.retur;
d.op_ref.retur:= cs_op_retur;
for nr:= 1 step 1 until max_antal_operatører do
begin
inspect_ch(cs_operatør(nr),genoptype,ant);
if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
or læsbit_ia(samtaleflag,nr))
and læsbit_ia(operatørmaske,nr) then
begin
ref:= op_ref;
signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
<*V*> wait_ch(cs_op_retur,op_ref,true,-1);
<*+4*> if op_ref <> ref then
fejlreaktion(11<*fr.post*>,op_ref,
<:opdater opkaldskø,retur:>,0);
<*-4*>
end;
end;
d.op_ref.retur:= dest_sem;
signal_ch(dest_sem,op_ref,d.op_ref.optype);
end
else
if k=38 then
begin
dest_sem:= d.opref.retur;
d.op_ref.retur:= cs_op_retur;
for nr:= 1 step 1 until max_antal_operatører do
begin
if d.opref.data.op_spool_kilde <> nr then
begin
ref:= op_ref;
signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
<*V*> wait_ch(cs_op_retur,op_ref,true,-1);
<*+4*> if op_ref <> ref then
fejlreaktion(11<*fr.post*>,op_ref,
<:opdater opkaldskø,retur:>,0);
<*-4*>
end;
end;
if d.opref.data.op_spool_kilde<>0 then
begin
ref:= op_ref;
nr:= d.opref.data.op_spool_kilde;
signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
<*V*> wait_ch(cs_op_retur,op_ref,true,-1);
<*+4*> if op_ref <> ref then
fejlreaktion(11<*fr.post*>,op_ref,
<:operatørmedddelelse, retur:>,0);
<*-4*>
d.op_ref.retur:= dest_sem;
signal_ch(dest_sem,op_ref,d.op_ref.optype);
end
else
begin
d.op_ref.retur:= dest_sem;
signal_ch(cs_io,op_ref,d.op_ref.optype);
end;
end
else
begin
\f
message procedure h_operatør side 3 - 810601/hko;
if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
begin
iaf:=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;
signal_ch(dest_sem,op_ref,d.op_ref.optype);
end;
until false;
hop_trap:
disable skriv_hoperatør(zbillede,1);
end h_operatør;
\f
message procedure operatør side 1 - 820304/hko;
procedure operatør(nr);
value nr;
integer nr;
begin
integer array field op_ref,ref,vt_op,iaf,tab;
integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
real kommstart,kommslut;
\f
message procedure operatør side 1a - 820301/hko;
procedure skriv_operatør(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin integer i;
i:= write(zud,"nl",1,<:+++ operatør 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,
<: aktion: :>,aktion,"nl",1,
<: ref: :>,ref,"nl",1,
<: vt_op: :>,vt_op,"nl",1,
<: iaf: :>,iaf,"nl",1,
<: status: :>,status,"nl",1,
<: tilstand: :>,tilstand,"nl",1,
<: bv: :>,bv,"nl",1,
<: bs: :>,bs,"nl",1,
<: bs-tilst: :>,bs_tilst,"nl",1,
<: kanal: :>,kanal,"nl",1,
<: opgave: :>,opgave,"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,
<: garage: :>,garage,"nl",1,
<: skærmmåde: :>,skærmmåde,"nl",1,
<: res: :>,res,"nl",1,
<: tab: :>,tab,"nl",1,
<: rkom: :>,rkom,"nl",1,
<: par1: :>,par1,"nl",1,
<: par2: :>,par2,"nl",1,
<::>);
skriv_coru(zud,coru_no(200+nr));
slut:
end;
end skriv_operatør;
\f
message procedure skærmstatus side 1 - 810518/hko;
integer
procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
integer tilstand,b_v,b_s,b_s_tilst;
begin
integer i,j;
i:= terminal_tab.ref(1);
b_s:= terminal_tab.ref(2);
b_s_tilst:= i extract 12;
j:= b_s_tilst extract 3;
b_v:= i shift (-12) extract 4;
tilstand:= i shift (-21);
skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
if b_v = 0 and j = 1<*opkald*> then 1 else
if b_v = 0 and j = 2<*specialopkald*> then 2 else
if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
end skærmstatus;
\f
message procedure skriv_skærm side 1 - 810522/hko;
procedure skriv_skærm(nr);
value nr;
integer nr;
begin
integer i;
disable definer_taster(nr);
skriv_skærm_maske(nr);
skriv_skærm_opkaldskø(nr);
skriv_skærm_b_v_s(nr);
for i:= 1 step 1 until max_antal_kanaler do
skriv_skærm_kanal(nr,i);
cursor(z_op(nr),1,1);
<*V*> setposition(z_op(nr),0,0);
end skriv_skærm;
\f
message procedure skriv_skærm_id side 1 - 830310/hko;
procedure skriv_skærm_id(nr,id,nød);
value nr,id,nød;
integer nr,id;
boolean nød;
begin
integer linie,løb,bogst,i,p;
i:= id shift (-22);
case i+1 of
begin
begin <* busnr *>
p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
(id extract 14) mod 10000);
if id shift (-14) extract 8 > 0 then
p:= p+write(z_op(nr),".",1,
string bpl_navn(id shift (-14) extract 8));
write(z_op(nr),"sp",11-p);
end;
begin <*linie/løb*>
linie:= id shift (-12) extract 10;
bogst:= id shift (-7) extract 5;
if bogst > 0 then bogst:= bogst +'A'-1;
løb:= id extract 7;
write(z_op(nr),if nød then "*" else "sp",1,
"sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
false add bogst,1,"/",1,løb,
"sp",if løb > 9 then 3 else 4);
end;
begin <*gruppe*>
write(z_op(nr),<:GRP :>);
if id shift (-21) extract 1 = 1 then
begin <*specialgruppe*>
løb:= id extract 7;
write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
<<d>,løb,"sp",2);
end
else
begin
linie:= id shift (-5) extract 10;
bogst:= id extract 5;
if bogst > 0 then bogst:= bogst +'A'-1;
write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
false add bogst,1,"sp",2);
end;
end;
<* kanal eller område *>
begin
linie:= (id shift (-20) extract 2) + 1;
case linie of
begin
write(z_op(nr),"sp",11-write(z_op(nr),
string kanal_navn(id extract 20)));
write(z_op(nr),<:K*:>,"sp",9);
write(z_op(nr),"sp",11-write(z_op(nr),
<:OMR :>,string område_navn(id extract 20)));
write(z_op(nr),<:ALLE:>,"sp",7);
end;
end;
end <* case i *>
end skriv_skærm_id;
\f
message procedure skriv_skærm_kanal side 1 - 820301/hko;
procedure skriv_skærm_kanal(nr,kanal);
value nr,kanal;
integer nr,kanal;
begin
integer i,j,k,t,omr;
integer array field tref,kref;
boolean nød;
tref:= nr*terminal_beskr_længde;
kref:= (kanal-1)*kanal_beskr_længde;
t:= kanaltab.kref.kanal_tilstand;
j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
cursor(z_op(nr),kanal+2,28);
write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
" ",1," ",1);
write(z_op(nr),true,6,string kanal_navn(kanal));
omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
pabx_id(kanal_id(kanal) extract 5)
else
radio_id(kanal_id(kanal) extract 5);
for i:= -2 step 1 until 0 do
begin
write(z_op(nr),
if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
else false add (område_id(omr,1) shift (8*i) extract 8),1);
end;
write(z_op(nr),<:: :>);
i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
begin
sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
<* write(z_op(nr),<:ALARM !:>,"bel",1); *>
end
else
if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
write(z_op(nr),<:-:><*UDE AF DRIFT*>)
else
if i > 0 and
( true <* i <> nr *> <* OPT også ud på egen skærm 960527/CL *> or
j = kanal <* kanal = kanalnr for ventepos *> or
(terminal_tab.tref.terminal_tilstand shift (-21) = 1
<*tilst=samtale*> and k extract 22 = kanal) ) then
begin
write(z_op(nr),<:OPT :>);
if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
else write(z_op(nr),string bpl_navn(i));
end
else
if false then
begin
i:= kanaltab.kref.kanal_id1;
nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
skriv_skærm_id(nr,i,nød);
write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
i:= kanaltab.kref.kanal_id2;
if i<>0 then skriv_skærm_id(nr,i,false);
end;
write(z_op(nr),"esc" add 128,1,<:ÆK:>);
end skriv_skærm_kanal;
\f
message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
procedure skriv_skærm_b_v_s(nr);
value nr;
integer nr;
begin
integer i,j,k,kv,ks,t;
integer array field tref,kref;
tref:= nr*terminal_beskr_længde;
i:= terminal_tab.tref.terminal_tilstand;
kv:= i shift (-12) extract 4;
ks:= terminaltab.tref(2) extract 20;
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),18,28);
write(z_op(nr),"esc" add 128,1,<:ÆK:>);
cursor(z_op(nr),20,28);
write(z_op(nr),"esc" add 128,1,<:ÆK:>);
cursor(z_op(nr),21,28);
write(z_op(nr),"esc" add 128,1,<:ÆK:>);
cursor(z_op(nr),20,28);
if op_talevej(nr)<>0 then
begin
cursor(z_op(nr),18,28);
write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
end;
if kv <> 0 then
begin
kref:= (kv-1)*kanal_beskr_længde;
j:= if kv<>ks then kanaltab.kref.kanal_id1
else kanaltab.kref.kanal_id2;
k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
else kanaltab.kref.kanal_alt_id2;
write(z_op(nr),true,6,string kanal_navn(kv));
skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
skriv_skærm_id(nr,k,false);
write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
end;
cursor(z_op(nr),21,28);
j:= terminal_tab.tref(2);
if i shift (-21) <> 0 <*ikke ledig*> then
begin
\f
message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
if i shift (-21) = 1 <*samtale*> then
begin
if j shift (-20) = 12 then
begin
write(z_op(nr),true,6,string kanal_navn(ks));
end
else
begin
write(z_op(nr),true,6,<:K*:>);
k:= 0;
while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
k:= k+1;
ks:= k;
end;
kref:= (ks-1)*kanal_beskr_længde;
t:= kanaltab.kref.kanaltilstand;
skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
t shift (-3) extract 1 = 1);
skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
if t shift (-5) extract 1 = 1 then <:MON :> else
if t shift (-4) extract 1 = 1 then <:BSV :> else
if t shift (-6) extract 1 = 1 then <:PAS :> else
if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
if t shift (-9) extract 1 = 1 then
write(z_op(nr),<:ALLE :>);
if t shift (-8) extract 1 = 1 then
write(z_op(nr),<:KATASTROFE :>);
k:= kanaltab.kref.kanal_spec;
if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
write(z_op(nr),<<zd.dd>,(k extract 12)/100);
end
else <* if i shift (-21) = 2 <+optaget+> then *>
begin
write(z_op(nr),<:K-:>,"sp",3);
if j <> 0 then
skriv_skærm_id(nr,j,false)
else
begin
j:=terminal_tab.tref(3);
skriv_skærm_id(nr,j,
false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
else 0));
end;
write(z_op(nr),<:OPT:>);
end;
end;
<*V*> setposition(z_op(nr),0,0);
end skriv_skærm_b_v_s;
\f
message procedure skriv_skærm_maske side 1 - 810511/hko;
procedure skriv_skærm_maske(nr);
value nr;
integer nr;
begin
integer i;
<*V*> setposition(z_op(nr),0,0);
write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
"sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
"sp",1,"*",5,"nl",1,"-",80);
for i:= 3 step 1 until 21 do
begin
cursor(z_op(nr),i,26);
outchar(z_op(nr),'!');
end;
cursor(z_op(nr),22,1);
write(z_op(nr),"-",80);
cursor(z_op(nr),1,1);
<*V*> setposition(z_op(nr),0,0);
end skriv_skærm_maske;
\f
message procedure skal_udskrives side 1 - 940522/cl;
boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
value fordelt_til,aktuel_skærm;
integer fordelt_til,aktuel_skærm;
begin
boolean skal_ud;
integer n;
integer array field iaf;
skal_ud:= true;
if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
begin
for n:= 0 step 1 until 3 do
begin
if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
begin
iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
goto returner;
end;
end;
end;
returner:
skal_udskrives:= skal_ud;
end;
message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
procedure skriv_skærm_opkaldskø(nr);
value nr;
integer nr;
begin
integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
integer array field ref,iaf,tab;
boolean skal_ud;
<*V*> wait(bs_opkaldskø_adgang);
setposition(z_op(nr),0,0);
ant:= 0; kmdo:= 0;
tab:= (nr-1)*opk_alarm_tab_lgd;
ref:= første_nødopkald;
if ref=0 then ref:=første_opkald;
while ref <> 0 do
begin
i:= opkaldskø.ref(4);
operatør:= i extract 8;
type:=i shift (-8) extract 4;
<* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
*>
if operatør > 64 then
begin
<* fordelt til gruppe af betjeningspladser *>
i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
while skal_ud and i<max_antal_operatører do
begin
i:=i+1;
if læsbit_ia(bpl_def.iaf,i) then
skal_ud:= skal_ud and skal_udskrives(i,nr);
end;
end
else
skal_ud:= skal_udskrives(operatør,nr);
if skal_ud then
begin
ant:= ant +1;
if ant < 6 then
begin
<*V*> cursor(z_op(nr),ant*2+1,3);
ttmm:= i shift (-12);
vogn:= opkaldskø.ref(3);
if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
skriv_skærm_id(nr,vogn,type=2);
write(z_op(nr),true,4,
string område_navn(opkaldskø.ref(5) extract 4),
<<zd.dd>,ttmm/100.0);
if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
begin
if opkaldskø.ref(5) extract 4 <= 2 or
opk_alarm.tab.alarm_lgd = 0 then
begin
if type=2 then
write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
else
write(z_op(nr),"bel",1);
end
else if type>kmdo then kmdo:= type;
sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
end;
end;<* ant < 6 *>
end;<* operatør ok *>
ref:= opkaldskø.ref(1) extract 12;
if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
end;
\f
message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
signal_bin(bs_opkaldskø_adgang);
if kmdo > opk_alarm.tab.alarm_tilst and
kmdo > opk_alarm.tab.alarm_kmdo then
begin
opk_alarm.tab.alarm_kmdo:= kmdo;
signal_bin(bs_opk_alarm);
end;
if ant > 5 then
begin
cursor(z_op(nr),13,9);
write(z_op(nr),<<+ddd>,ant-5);
end
else
begin
for i:= ant +1 step 1 until 6 do
begin
cursor(z_op(nr),i*2+1,1);
write(z_op(nr),"sp",25);
end;
end;
ant_i_opkø(nr):= ant;
cursor(z_op(nr),1,1);
<*V*> setposition(z_op(nr),0,0);
end skriv_skærm_opkaldskø;
\f
message procedure operatør side 2 - 810522/hko;
trap(op_trap);
stack_claim((if cm_test then 200 else 146)+24+48+80+175);
ref:= nr*terminal_beskr_længde;
tab:= (nr-1)*opk_alarm_tab_lgd;
skærmmåde:= 0; <*normal*>
if operatør_auto_include(nr) then
begin
waitch(cs_att_pulje,opref,true,-1);
i:= operatør_auto_include(nr) extract 2;
if i<>3 then i:= 0;
start_operation(opref,101,cs_att_pulje,i shift 12 +1);
d.opref.data(1):= nr;
signalch(cs_rad,opref,gen_optype or io_optype);
end;
<*+2*>
if testbit8 and overvåget or testbit28 then
skriv_operatør(out,0);
<*-2*>
\f
message procedure operatør side 3 - 810602/hko;
repeat
<*V*> wait_ch(cs_operatør(nr),
op_ref,
true,
-1<*timeout*>);
<*+2*>
if testbit9 and overvåget then
disable begin
write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
<: til operatør :>,nr);
skriv_op(out,op_ref);
end;
<*-2*>
monitor(8)reserve process:(z_op(nr),0,ia);
kode:= d.op_ref.op_kode extract 12;
i:= terminal_tab.ref.terminal_tilstand;
status:= i shift(-21);
opgave:=
if kode=0 then 1 <* indlæs kommando *> else
if kode=1 then 2 <* inkluder *> else
if kode=2 then 3 <* ekskluder *> else
if kode=40 then 4 <* opdater skærm *> else
if kode=43 then 5 <* opkald etableret *> else
if kode=4 then 6 <* radiokanal ekskluderet *> else
if kode=38 then 7 <* operatør meddelelse *> else
0; <* afvises *>
aktion:= case status +1 of(
<* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
<* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
<* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
<* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
<* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
<* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
<* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
<* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
<* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
-1);
\f
message procedure operatør side 4 - 810424/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: ulovligt operatørterminal_nr *>
fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
afslut_operation(op_ref,-1);
end;
begin
<*-1: ulovlig operatørtilstand *>
fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-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 operatør side 5 - 851001/cl;
<* 1: indlæs kommando *>
<*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
if opk_alarm.tab.alarm_tilst > 0 then
begin
opk_alarm.tab.alarm_kmdo:= 3;
signal_bin(bs_opk_alarm);
pass;
end;
if d.op_ref.resultat > 3 then
begin
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),op_ref,pos,
d.op_ref.resultat);
end
else if d.op_ref.resultat = -1 then
begin
skærmmåde:= 0;
skrivskærm(nr);
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 then 1 <*VO,I/VO,U*> else
if kode = 19 then 1 <*VO,S *> else
if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
if kode = 6 then 4 <*STop*> else
if 45<=kode and kode<=63 then 3 <*radiokom.*> else
if kode = 30 then 5 <*SP,D*> else
if kode = 31 then 6 <*SP*> else
if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
if kode = 83 then 8 <*SL*> else
if kode = 68 then 9 <*ST,D*> else
if kode = 69 then 10 <*ST,V*> else
if kode = 36 then 11 <*AL*> else
if kode = 37 then 12 <*CC*> else
if kode = 2 then 13 <*EX*> else
if kode = 92 then 14 <*CQF,V*> else
if kode = 38 then 15 <*AL,T*> else
0;
if j > 0 then
begin
case j of
begin
begin
\f
message procedure operatør side 6 - 851001/cl;
<* 1 indsæt/udtag/flyt bus i vogntabel *>
vogn:=ia(1);
ll:=ia(2);
kanal:= if kode=11 or kode=19 then ia(3) else
if kode=12 then ia(2) else 0;
<*V*> wait_ch(cs_vt_adgang,
vt_op,
gen_optype,
-1<*timeout sek*>);
start_operation(vtop,200+nr,cs_operatør(nr),
kode);
d.vt_op.data(1):=vogn;
if kode=11 or kode=19 or kode=20 or kode=24 then
d.vt_op.data(2):=ll;
if kode=19 then d.vt_op.data(3):= kanal else
if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
indeks:= vt_op;
signal_ch(cs_vt,
vt_op,
gen_optype or op_optype);
<*V*> wait_ch(cs_operatør(nr),
vt_op,
op_optype,
-1<*timeout sek*>);
<*+2*> if testbit10 and overvåget then
disable begin
write(out,"nl",1,<:operatør :>,<<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,
<:operatør-kommando:>,0);
<*-4*>
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
<*V*> skriv_kvittering(z_op(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 vt_optype;
disable afslut_operation(vt_op,cs_vt_adgang);
end;
begin
\f
message procedure operatør side 7 - 810921/hko,cl;
<* 2 vogntabel,linienr/-,busnr *>
d.op_ref.retur:= cs_operatør(nr);
tofrom(d.op_ref.data,ia,10);
indeks:= op_ref;
signal_ch(cs_vt,op_ref,gen_optype or op_optype);
wait_ch(cs_operatør(nr),
op_ref,
op_optype,
-1<*timeout*>);
<*+2*> if testbit10 and overvåget then
disable begin
write(out,"nl",1,<:operatør operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*>
if indeks <> op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
<*-4*>
i:= d.op_ref.resultat;
if i = 0 or i > 3 then
begin
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
end
else
begin
integer antal,fil_ref;
skærm_måde:= 1;
antal:= d.op_ref.data(6);
fil_ref:= d.op_ref.data(7);
<*V*> setposition(z_op(nr),0,0);
write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
"sp",14,"*",10,"sp",6,
<:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
<*V*> setposition(z_op(nr),0,0);
\f
message procedure operatør side 8 - 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,<:operatør: 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_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
false add bogst,1,"/",1,<<d__>,løb);
write(z_op(nr),<<dddd>,vogn,"sp",1);
end;
end;
if pos mod 5 = 0 then
begin
outchar(z_op(nr),'nl');
<*V*> setposition(z_op(nr),0,0);
end
else write(z_op(nr),"sp",3);
end;
pos:=pos+1;
end;
write(z_op(nr),"*",1,"nl",1);
\f
message procedure operatør side 8a- 810507/hko;
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 op_optype);
<*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
<*+2*> if testbit10 and overvåget then
disable begin
write(out,"nl",1,<:operatør, slet-fil retur:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
<*-4*>
if d.op_ref.data(9)<>0 then
fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
<:operatør, slet_fil:>,1);
end;
end;
begin
\f
message procedure operatør side 9 - 830310/hko;
<* 3 radio_kommandoer *>
kode:= d.op_ref.opkode;
rkom:= kode-44; par1:=ia(1); par2:=ia(2);
disable if testbit14 then
begin
integer i; <*lav en trap-bar blok*>
trap(test14_trap);
systime(1,0,kommstart);
write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
string bpl_navn(nr),<: start :>,case rkom of (
<:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
<:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
<:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
<:GE,T:>),<: :>);
if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
rkom=16 or rkom=17 or rkom=19)
then
begin
if par1<>0 then skriv_id(zrl,par1,0);
if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
write(zrl,"sp",1,string områdenavn(par2));
end
else
if rkom=10 and par1<>0 then
write(zrl,string kanalnavn(par1 extract 20))
else
if rkom=5 or rkom=6 then
begin
if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
if par1 shift (-20)=14 then
write(zrl,string områdenavn(par1 extract 20));
end;
test14_trap: outchar(zrl,'nl');
end;
d.op_ref.data(4):= nr; <*operatør*>
opgave:=
if kode = 45 <*OP *> then 1 else
if kode = 46 <*ME *> then 2 else
if kode = 47 <*OP,G*> then 3 else
if kode = 48 <*ME,G*> then 4 else
if kode = 49 <*OP,A*> then 5 else
if kode = 50 <*ME,A*> then 6 else
if kode = 51 <*KA,C*> then 7 else
if kode = 52 <*KA,P*> then 8 else
if kode = 53 <*OP,L*> then 9 else
if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
if kode = 55 <*VE *> then 14 else
if kode = 56 <*NE *> then 12 else
if kode = 57 <*OP,V*> then 1 else
if kode = 58 <*OP,T*> then 1 else
if kode = 59 <*R *> then 13 else
if kode = 60 <*GE *> then 15 else
if kode = 61 <*GE,G*> then 16 else
if kode = 62 <*GE,V*> then 15 else
if kode = 63 <*GE,T*> then 15 else
-1;
<*+4*> if opgave < 0 then
fejlreaktion(2<*operationskode*>,kode,
<:operatør, radio-kommando :>,0);
<*-4*>
status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
i:= d.op_ref.data(2):= ia(1); <* ident.*>
if 5<=opgave and opgave<=8 then
d.opref.data(2):= -1;
if opgave=13 then d.opref.data(2):=
(if læsbit_i(terminaltab.ref.terminaltilstand,11)
then 0 else 1);
if opgave = 14 then d.opref.data(2):= 1;
if opgave=7 or opgave=8 then
d.opref.data(3):= -1
else
if opgave=5 or opgave=6 then
begin
if ia(1) shift (-20) = 15 then
begin
d.opref.data(3):= 15 shift 20;
for j:= 1 step 1 until max_antal_kanaler do
begin
iaf:= (j-1)*kanalbeskrlængde;
if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
læsbit_i(ia(1),kanal_til_omr(j)) then
sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
end;
end
else
d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
else ia(1);
end
else
if kode = 57 then d.opref.data(3):= 2 else
if kode = 58 then d.opref.data(3):= 1 else
if kode = 62 then d.opref.data(3):= 2 else
if kode = 63 then d.opref.data(3):= 1 else
d.opref.data(3):= ia(2);
<* !!! i første if-sætning nedenfor er 'status>1'
rettet til 'status>0' for at forhindre
at opkald nr. 2 kan udføres med et allerede
etableret opkald i skærmens s-felt,
jvf. ulykke d. 7/2-1995
!!! *>
res:=
if (opgave=1 or opgave=3) and status>0
then 16 <*skærm optaget*> else
if (opgave=15 or opgave=16) and
status>1 then 16 <*skærm optaget*> else
if (opgave=1 or opgave=3) and status=0 then 1 else
if (opgave=15 or opgave=16) and status=0 then 21 else
if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
(if (d.opref.data(3)=1 or d.opref.data(3)=2) and
d.opref.data(3) = kanal_til_omr(bs extract 6)
then 52 else 1) else
if opgave<11 and status>0 then 16 else
if opgave=11 and status<2 then 21 else
if opgave=12 and status=0 then 22 else
if opgave=13 and status=0 then 49 else
if opgave=14 and status<>3 then 21 else 1;
if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
begin <* specialbetingelser for TLF og VHF *>
if (1<opgave and opgave<9) or opgave=16 then res:= 51;
end;
if skærmmåde<>0 then
begin skærm_måde:= 0; skriv_skærm(nr); end;
kode:= opgave;
if opgave = 15 then opgave:= 1 else
if opgave = 16 then opgave:= 3;
\f
message procedure operatør side 10 - 810616/hko;
<* tilknyt talevej (om nødvendigt) *>
if res = 1 and op_talevej(nr)=0 then
begin
i:= sidste_tv_brugt;
repeat
i:= (i mod max_antal_taleveje)+1;
if tv_operatør(i)=0 then
begin
tv_operatør(i):= nr;
op_talevej(nr):= i;
end;
until op_talevej(nr)<>0 or i=sidste_tv_brugt;
if op_talevej(nr)=0 then
res:=61
else
begin
sidste_tv_brugt:=
(sidste_tv_brugt mod max_antal_taleveje)+1;
<*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
start_operation(iaf,200+nr,cs_operatør(nr),
'A' shift 12 + 44);
d.iaf.data(1):= op_talevej(nr);
d.iaf.data(2):= nr+16;
ll:= 0;
repeat
signalch(cs_talevejsswitch,iaf,op_optype);
<*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
ll:= ll+1;
until ll=3 or d.iaf.resultat=3;
res:= if d.iaf.resultat=3 then 1 else 61;
<* ********* *>
delay(1);
start_operation(iaf,200+nr,cs_operatør(nr),
'R' shift 12 + 44);
ll:= 0;
repeat
signalch(cs_talevejsswitch,iaf,op_optype);
waitch(cs_operatør(nr),iaf,op_optype,-1);
ll:= ll+1;
until ll=3 or d.iaf.resultat=3;
<* ********* *>
signalch(cs_tvswitch_adgang,iaf,op_optype);
if res<>1 then
op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
end;
end;
if op_talevej(nr)=0 then res:= 61;
d.op_ref.data(1):= op_talevej(nr);
if res <= 1 then
begin
til_radio: <* send operation til radiomodul *>
d.op_ref.opkode:= opgave shift 12 + 41;
d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
else 0;
d.op_ref.data(6):= b_s;
d.op_ref.resultat:=0;
d.op_ref.retur:= cs_operatør(nr);
indeks:= op_ref;
<*+2*> if testbit11 and overvåget then
disable begin
skriv_operatør(out,0);
write(out,<: operation til radio:>);
skriv_op(out,op_ref); ud;
end;
<*-2*>
signal_ch(cs_rad,op_ref,gen_optype or op_optype);
<*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
<*+2*> if testbit12 and overvåget then
disable begin
skriv_operatør(out,0);
write(out,<: operation retur fra radio:>);
skriv_op(out,op_ref); ud;
end;
<*-2*>
<*+4*> if op_ref <> indeks then
fejlreaktion(11<*fr.post*>,op_ref,
<:operatør, retur fra radio:>,0);
<*-4*>
\f
message procedure operatør side 11 - 810529/hko;
res:= d.op_ref.resultat;
if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
begin
<*+4*> if res < 2 then
fejlreaktion(3<*prg.fejl*>,res,
<: operatør,radio_op,resultat:>,1);
<*-4*>
if res = 1 then res:= 0;
end
else
begin <* res = 2 eller 3 *>
s_kanal:= v_kanal:= 0;
opgave:= d.opref.opkode shift (-12);
bv:= d.op_ref.data(5) extract 4;
bs:= d.op_ref.data(6);
if opgave < 10 then
begin
j:= d.op_ref.data(7) <*type*>;
i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
i:= i + (if opgave=2 or opgave>3 then 2 else 1);
terminal_tab.ref(1):= i
+(if res=2 then 4 <*optaget*> else 0)
+(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
then 8 <*nød*> else 0)
+(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
then 16 else 0)
+ (if opgave mod 2 = 0 then 64 <*pas*> else 0)
+ (if opgave=9 then 128 else
if opgave>=7 then 256 else
if opgave>=5 then 512 else 0)
+ (if res = 2 then 2 shift 21 <*tilstand = optaget *>
else if b_s = 0 then 0 <*tilstand = ledig *>
else 1 shift 21 <*tilstand = samtale*>);
if (res=3 or res=20 or res=52) and 0<=j and j<3 then
disable tæl_opkald_pr_operatør(nr,
(if res=20 then 4 else if res=52 then 5 else j+1));
end
else if opgave=10 <*monitering*> or
opgave=14 <*ventepos *> then
begin
<*+4*> if res = 2 then
fejlreaktion(3<*prg.fejl*>,res,
<: operatør,moniter,res:>,1);
<*-4*>
iaf:= (bs extract 4 -1)*kanal_beskr_længde;
i:= if bs<0 then
kanaltab.iaf.kanal_tilstand extract 12 else 0;
terminal_tab.ref(1):= i +
(if bs < 0 then (1 shift 21) else 0);
if opgave=10 then
begin
s_kanal:= bs;
v_kanal:= d.opref.data(5);
end;
\f
message procedure operatør side 12 - 810603/hko;
end
else if opgave=11 or opgave=12 then
begin
<*+4*> if res = 2 then
fejlreaktion(3<*prg.fejl*>,res,
<: operatør,ge/ne,res:>,1);
<*-4*>
if opgave=11 <*GE*> and res<>49 then
begin
s_kanal:= terminal_tab.ref(2);
v_kanal:= 12 shift 20 +
(terminal_tab.ref(1) shift (-12) extract 4);
end;
terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
end
else
if opgave=13 then
begin
if res=2 then
fejlreaktion(3<*prg.fejl*>,res,
<:operatør,R,res:>,1);
sætbit_i(terminaltab.ref.terminaltilstand,11,
d.opref.data(2));
end
<*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
<*-4*>
;
<*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
terminal_tab.ref(2):= b_s;
terminal_tab.ref(3):= d.op_ref.data(11);
if (opgave<10 or opgave=14) and res=3 then
<*så henviser b_s til radiokanal*>
begin
if bs shift (-20) = 12 then
begin
iaf:= (bs extract 4 -1)*kanal_beskr_længde;
kanaltab.iaf.kanal_tilstand:=
kanaltab.iaf.kanal_tilstand shift(-10) shift 10
+terminal_tab.ref(1) extract 10;
end
else
begin
for i:= 1 step 1 until max_antal_kanaler do
begin
if læsbit_i(bs,i) then
begin
iaf:= (i-1)*kanal_beskr_længde;
kanaltab.iaf.kanaltilstand:=
kanaltab.iaf.kanaltilstand shift (-10) shift 10
+ terminal_tab.ref(1) extract 10;
end;
end;
end;
end;
if kode=15 or kode=16 then
begin
if opgave<10 then
begin
opgave:= 11;
kanal:= (12 shift 20) +
d.opref.data(6) extract 20;
goto til_radio;
end
else
if opgave=11 then
begin
opgave:= 10;
d.opref.data(2):= kanal;
goto til_radio;
end;
end
else
if (kode=1 or kode=3) then
begin
if opgave<10 and bv<>0 then
begin
opgave:= 14;
d.opref.data(2):= 2;
goto til_radio;
end;
end;
<*V*> skriv_skærm_b_v_s(nr);
<*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
skriv_skærm_opkaldskø(nr);
for i:= s_kanal, v_kanal do
if i<0 then skriv_skærm_kanal(nr,i extract 4);
tofrom(kanalflag,alle_operatører,op_maske_lgd);
signalbin(bs_mobilopkald);
<*V*> setposition(z_op(nr),0,0);
end; <* res = 2 eller 3 *>
end; <* res <= 1 *>
<* frigiv talevej (om nødvendigt) *>
if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
and terminal_tab.ref(2)=0 <*b_s*>
and op_talevej(nr)<>0
then
begin
<*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
start_operation(iaf,200+nr,cs_operatør(nr),
'D' shift 12 + 44);
d.iaf.data(1):= op_talevej(nr);
d.iaf.data(2):= nr+16;
ll:= 0;
repeat
signalch(cs_talevejsswitch,iaf,op_optype);
<*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
ll:= ll+1;
until ll=3 or d.iaf.resultat=3;
ll:= d.iaf.resultat;
signalch(cs_tvswitch_adgang,iaf,op_optype);
if ll<>3 then
fejlreaktion(21,op_talevej(nr)*100+nr,
<:frigiv operatør fejlet:>,1)
else
op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
skriv_skærm_b_v_s(nr);
end;
disable if testbit14 then
begin
integer t; <*lav en trap-bar blok*>
trap(test14_trap);
systime(1,0,kommslut);
write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
string bpl_navn(nr),<: slut :>,case rkom of (
<:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
<:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
<:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
<:GE,T:>),<: :>);
if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
rkom=16 or rkom=17 or rkom=19)
then
begin
if d.opref.data(7)=2 then outchar(zrl,'*');
if d.opref.data(9)<>0 then
begin
skriv_id(zrl,d.opref.data(9),0);
outchar(zrl,' ');
end;
if d.opref.data(8)<>0 then
begin
skriv_id(zrl,d.opref.data(8),0);
outchar(zrl,' ');
end;
if d.opref.data(8)=0 and d.opref.data(9)=0 and
d.opref.data(2)<>0 then
begin
skriv_id(zrl,d.opref.data(2),0);
outchar(zrl,' ');
end;
if d.opref.data(12)<>0 then
begin
if d.opref.data(12) shift (-20) = 15 then
write(zrl,<:OMR*:>)
else
if d.opref.data(12) shift (-20) = 14 then
write(zrl,
string områdenavn(d.opref.data(12) extract 20))
else
skriv_id(zrl,d.opref.data(12),0);
outchar(zrl,' ');
end;
t:= terminal_tab.ref.terminaltilstand extract 10;
if res=3 and rkom=1 and
(t shift (-4) extract 1 = 1) and
(t extract 2 <> 3)
then
begin
iaf:= (terminal_tab.ref(2) extract 20 - 1)*
kanal_beskr_længde;
write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
extract 12)/100," ",1);
end;
if d.opref.data(10)<>0 then
begin
skriv_id(zrl,d.opref.data(10),0);
outchar(zrl,' ');
end;
end
else
if rkom=10 and par1<>0 then
write(zrl,string kanalnavn(par1 extract 20),"sp",1)
else
if rkom=5 or rkom=6 then
begin
if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
if par1 shift (-20)=14 then
write(zrl,string områdenavn(par1 extract 20));
outchar(zrl,' ');
end;
if op_talevej(nr) > 0 then
write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
write(zrl,<:res=:>,<<d>,res,<: btid=:>,
<<dd.dd>,kommslut-kommstart);
test14_trap: outchar(zrl,'nl');
end;
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
<*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
end; <* radio-kommando *>
begin
\f
message procedure operatør side 13 - 810518/hko;
<* 4 stop kommando *>
status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
if tilstand <> 0 then
begin
d.op_ref.resultat:= 16; <*skærm optaget*>
end
else
begin
d.op_ref.retur:= cs_operatør(nr);
d.op_ref.resultat:= 0;
d.op_ref.data(1):= nr;
indeks:= op_ref;
<*+2*> if testbit11 and overvåget then
disable begin
skriv_operatør(out,0);
write(out,<: stop_operation til radio:>);
skriv_op(out,op_ref); ud;
end;
<*-2*>
if opk_alarm.tab.alarm_tilst > 0 then
begin
opk_alarm.tab.alarm_kmdo:= 3;
signal_bin(bs_opk_alarm);
end;
signal_ch(cs_rad,op_ref,gen_optype or op_optype);
<*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
<*+2*> if testbit12 and overvåget then
disable begin
skriv_operatør(out,0);
write(out,<: operation retur fra radio:>);
skriv_op(out,op_ref); ud;
end;
<*-2*>
<*+4*> if indeks <> op_ref then
fejlreaktion(11<*fr.post*>,op_ref,
<: operatør, retur fra radio:>,0);
<*-4*>
\f
message procedure operatør side 14 - 810527/hko;
if d.op_ref.resultat = 3 then
begin
integer k,n;
integer array field msk,iaf1;
terminal_tab.ref.terminal_tilstand:= 3 shift 21
+terminal_tab.ref.terminal_tilstand extract 21;
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
if sæt_bit_ia(operatørmaske,nr,0)=1 then
for k:= nr, 65 step 1 until top_bpl_gruppe do
begin
msk:= k*op_maske_lgd;
if læsbit_ia(bpl_def.msk,nr) then
<**> begin
n:= 0;
for i:= 1 step 1 until max_antal_operatører do
if læsbit_ia(bpl_def.msk,i) then
begin
iaf1:= i*terminal_beskr_længde;
if terminal_tab.iaf1.terminal_tilstand
shift (-21) < 3 then
n:= n+1;
end;
bpl_tilst(k,1):= n;
end;
<**> <*
bpl_tilst(k,1):= bpl_tilst(k,1)-1;
*> end;
signal_bin(bs_mobil_opkald);
<*V*> setposition(z_op(nr),0,0);
ht_symbol(z_op(nr));
end;
end;
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
if d.op_ref.resultat<> 3 then
skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
end;
begin
boolean l22;
\f
message procedure operatør side 15 - 810521/cl;
<* 5 springdefinition *>
l22:= false;
if sep=',' then
disable begin
setposition(z_op(nr),0,0);
cursor(z_op(nr),22,1);
write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
l22:= true; pos:= 1;
while læstegn(d.op_ref.data,pos,i)<>0 do
outchar(z_op(nr),i);
end;
tofrom(d.op_ref.data,ia,indeks*2);
<*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
start_operation(vt_op,200+nr,cs_operatør(nr),
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,op_optype);
pos:=vt_op;<*variabel lånes*>
<*V*> wait_ch(cs_operatør(nr),vt_op,op_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),
<:op 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,
<:op kommando(spring-def):>,0);
fil(j).iaf(1):=d.op_ref.data(i+2);
end;
\f
message procedure operatør side 15a - 820301/cl;
while sep = ',' do
begin
setposition(z_op(nr),0,0);
cursor(z_op(nr),23,1);
write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
setposition(z_op(nr),0,0);
wait(bs_fortsæt_adgang);
pos:= 1; j:= 0;
while læs_store(z_op(nr),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_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
cursor(z_op(nr),1,1);
goto sp_ann;
end;
\f
message procedure operatør side 16 - 810521/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,
<:op 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; j:= 1;
hægt_tekst(d.op_ref.data,i,fortsæt,j);
afsluttext(d.op_ref.data,i);
end;
end;
\f
message procedure operatør side 17 - 810521/cl;
if d.op_ref.resultat > 3 then
begin
setposition(z_op(nr),0,0);
if l22 then
begin
cursor(z_op(nr),22,1); l22:= false;
write(z_op(nr),"-",80);
end;
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
goto sp_ann;
end;
if sep=',' then
begin
setposition(z_op(nr),0,0);
cursor(z_op(nr),22,1);
write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
pos:= 1; l22:= true;
while læstegn(fortsæt,pos,i)<>0 do
outchar(z_op(nr),i);
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,<:op kommando(spring-def):>,0);
d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
d.op_ref.retur:=cs_operatør(nr);
pos:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or op_optype);
<*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
<*+4*> if pos<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:op kommando(springdef retur fra vt):>,0);
<*-4*>
\f
message procedure operatør side 18 - 810521/cl;
<*V*> setposition(z_op(nr),0,0);
if l22 then
begin
cursor(z_op(nr),22,1);
write(z_op(nr),"-",80);
end;
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
if false then
begin
sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
waitch(cs_operatør(nr),vt_op,op_optype,-1);
signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
signalbin(bs_fortsæt_adgang);
end;
end;
begin
\f
message procedure operatør side 19 - 810522/cl;
<* 6 spring (igangsæt)
spring,annuler
spring,reserve *>
tofrom(d.op_ref.data,ia,6);
d.op_ref.retur:=cs_operatør(nr);
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or op_optype);
<*V*> wait_ch(cs_operatør(nr),
op_ref,
op_optype,
-1<*timeout*>);
<*+2*> if testbit10 and overvåget then
disable begin
skriv_operatør(out,0);
write(out,"nl",1,<:op operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if indeks<>op_ref then
fejlreaktion(11<*fremmed post*>,op_ref,
<:op kommando(spring):>,0);
<*-4*>
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),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 operatør side 20 - 810525/cl;
<* 7 spring(-oversigts-)rapport *>
d.op_ref.retur:=cs_operatør(nr);
tofrom(d.op_ref.data,ia,4);
indeks:=op_ref;
signal_ch(cs_vt,op_ref,gen_optype or op_optype);
<*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
<*+2*> disable if testbit10 and overvåget then
begin
write(out,"nl",1,<:operatør operation retur fra vt:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*> if op_ref<>indeks then
fejlreaktion(11<*fremmed post*>,op_ref,
<:op kommando(spring-rapport):>,0);
<*-4*>
<*V*> setposition(z_op(nr),0,0);
if d.op_ref.resultat<>3 then
begin
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
end
else
begin
boolean p_skrevet;
integer bogst,løb;
skærmmåde:= 1;
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_op(nr),"esc" add 128,1,<:ÆH:>,
"esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
<: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_op(nr),<:, startet :>,<<zddddd>,
round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
else write(z_op(nr),<:, ikke startet:>);
write(z_op(nr),"sp",5,"*",5,"nl",2);
\f
message procedure operatør side 21 - 810522/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,
<:op kommando(spring,vis):>,0);
iaf:=0;
i:= fil(j).iaf(1);
if i < 0 and -, p_skrevet then
begin
outchar(z_op(nr),'('); p_skrevet:= true;
end;
if i > 0 and p_skrevet then
begin
outchar(z_op(nr),')'); p_skrevet:= false;
end;
if pos mod 2 = 0 then
write(z_op(nr),<< dd>,abs i,<:.:>)
else
write(z_op(nr),true,3,<<d>,abs i);
if pos mod 21 = 0 then outchar(z_op(nr),'nl');
end;
write(z_op(nr),"*",1);
\f
message procedure operatør side 22 - 810522/cl;
end
else if kode=33 then <* spring,oversigt *>
begin
write(z_op(nr),"esc" add 128,1,<:ÆH:>,
"esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
<:spring oversigt:>,"sp",5,"*",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,
<:op 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_op(nr),"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_op(nr),<:startet :>,<<zddddd>,
round systime(4,fil(j,2),r),<:.:>,round r);
outchar(z_op(nr),'nl');
end;
write(z_op(nr),"*",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 op_optype);
waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
end; <* resultat=3 *>
end;
begin
\f
message procedure operatør side 23 - 940522/cl;
<* 8 SLUT *>
trapmode:= 1 shift 13;
trap(-2);
end;
begin
<* 9 stopniveauer,definer *>
integer fno;
for i:= 1 step 1 until 3 do
operatør_stop(nr,i):= ia(i+1);
i:= modif_fil(tf_stoptabel,nr,fno);
if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
iaf:=0;
for i:= 0,1,2,3 do
fil(fno).iaf(i+1):= operatør_stop(nr,i);
setposition(fil(fno),0,0);
setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),0,-1,3);
end;
begin
\f
message procedure operatør side 24 - 940522/cl;
<* 10 stopniveauer,vis *>
integer bpl,j,k;
skærm_måde:= 1;
setposition(z_op(nr),0,0);
write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
<:stopniveauer: :>);
for i:= 0 step 1 until 3 do
begin
bpl:= operatør_stop(nr,i);
write(z_op(nr),if i=0 then <: :> else <: -> :>,
if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
end;
write(z_op(nr),"nl",2,<:operatørpladser: :>);
j:=0;
for bpl:= 1 step 1 until max_antal_operatører do
if bpl_navn(bpl)<>long<::> then
begin
if j mod 8 = 0 and j > 0 then
write(z_op(nr),"nl",1,"sp",18);
iaf:= bpl*terminal_beskr_længde;
write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
true,6,string bpl_navn(bpl));
j:=j+1;
end;
write(z_op(nr),"nl",2,<:operatørgrupper: :>);
j:=0;
for bpl:= 65 step 1 until top_bpl_gruppe do
if bpl_navn(bpl)<>long<::> then
begin
if j mod 8 = 0 and j > 0 then
write(z_op(nr),"nl",1,"sp",19);
write(z_op(nr),true,7,string bpl_navn(bpl));
j:=j+1;
end;
write(z_op(nr),"nl",1,"*",1);
end;
begin
<* 11 alarmlængde *>
integer fno;
if indeks > 0 then
begin
opk_alarm.tab.alarm_lgd:= ia(1);
i:= modiffil(tf_alarmlgd,nr,fno);
if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
iaf:= 0;
fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
setposition(fil(fno),0,0);
end;
setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
end;
begin
<* 12 CC *>
integer i, c;
i:= 1;
while læstegn(ia,i+0,c)<>0 and
i<(op_spool_postlgd-op_spool_text)//2*3
do skrivtegn(d.opref.data,i,c);
repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
d.opref.retur:= cs_operatør(nr);
signalch(cs_op_spool,opref,op_optype);
<*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
end;
<* 13 EXkluder skærmen *>
begin
d.opref.resultat:= 2;
setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
waitch(cs_op_fil(nr),vt_op,true,-1);
start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
d.vt_op.data(1):= nr;
signalch(cs_rad,vt_op,gen_optype);
end;
begin
<* 14 CQF-tabel,vis *>
skærm_måde:= 1;
setposition(z_op(nr),0,0);
write(z_op(nr),"esc" add 128,1,<:ÆH:>,
"esc" add 128,1,<:ÆJ:>);
skriv_cqf_tabel(z_op(nr),false);
write(z_op(nr),"*",1);
end;
begin
<* 15 ALarmlyd,Test *>
integer array field tab;
integer res;
tab:= (nr-1)*opk_alarm_tab_lgd;
setposition(z_op(nr),0,0);
if ia(1)<1 or ia(1)>2 then
res:= 64 <* ulovligt tal *>
else if opk_alarm.tab.alarm_lgd = 0 then
begin
if ia(1)=2 then
write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
else
write(z_op(nr),"bel",1);
res:= 3;
end
else if ia(1) > opk_alarm.tab.alarm_tilst and
ia(1) > opk_alarm.tab.alarm_kmdo then
begin
opk_alarm.tab.alarm_kmdo:= ia(1);
signal_bin(bs_opk_alarm);
res:= 3;
end
else
res:= 48; <* i brug *>
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),opref,-1,res);
end;
begin
d.op_ref.resultat:= 45; <*ikke implementeret*>
setposition(z_op(nr),0,0);
cursor(z_op(nr),24,1);
skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
end;
\f
message procedure operatør side x - 810522/hko;
<*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
<*-4*>
end;<*case j *>
end <* j > 0 *>
else
begin
<*V*> setposition(z_op(nr),0,0);
if sluttegn<>'nl' then outchar(z_op(nr),'nl');
skriv_kvittering(z_op(nr),op_ref,-1,
45 <*ikke implementeret *>);
end;
end;<* godkendt *>
<*V*> setposition(z_op(nr),0,0);
<*???*>
while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
skærmmåde = 0 do
begin
if sætbit_ia(samtaleflag,nr,0)=1 then
begin
skriv_skærm_bvs(nr);
<*940920 if op_talevej(nr)=0 then status:= 0
else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
if status>0 then
begin
for ll:= 1 step 1 until terminalbeskrlængde//2 do
terminaltab.ref(ll):= 0;
skriv_skærm_bvs(nr);
wait(bs_talevej_udkoblet(op_talevej(nr)));
end;
for i:= 1 step 1 until max_antal_kanaler do
begin
iaf:= (i-1)*kanalbeskrlængde;
inspect(ss_samtale_nedlagt(i),status);
if status>0 and
tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
begin
kanaltab.iaf.kanal_tilstand:=
kanaltab.iaf(1) shift (-10) extract 6 shift 10;
for ll:= 2 step 1 until kanalbeskrlængde//2 do
kanaltab.iaf(ll):= 0;
skriv_skærm_kanal(nr,i);
repeat
wait(ss_samtale_nedlagt(i));
inspect(ss_samtale_nedlagt(i),status);
until status=0;
end;
end;
940920*> cursor(z_op(nr),1,1);
setposition(z_op(nr),0,0);
end;
if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
and skærmmåde = 0
and læsbit_ia(operatørmaske,nr) then
begin
if sætbit_ia(opkaldsflag,nr,0) = 1 then
skriv_skærm_opkaldskø(nr);
if sætbit_ia(kanalflag,nr,0) = 1 then
begin
for i:= 1 step 1 until max_antal_kanaler do
skriv_skærm_kanal(nr,i);
end;
cursor(z_op(nr),1,1);
<*V*> setposition(z_op(nr),0,0);
end;
end;
d.op_ref.retur:=cs_att_pulje;
disable afslut_kommando(op_ref);
end; <* indlæs kommando *>
begin
\f
message procedure operatør side x+1 - 810617/hko;
<* 2: inkluder *>
integer k,n;
integer array field msk,iaf1;
i:=monitor(4) process address:(z_op(nr),0,ia);
if i=0 then
begin
fejlreaktion(3<*programfejl*>,nr,
<:operatør(nr) eksisterer ikke:>,1);
d.op_ref.resultat:=28;
end
else
begin
i:=monitor(8) reserve process:(z_op(nr),0,ia);
d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
else if d.op_ref.opkode = 0 then 0
else 3;<*udført*>
if i > 0 then
fejlreaktion(4<*monitor res*>,nr*100 +i,
<:operatørskærm reservation:>,1)
else
begin
i:=terminal_tab.ref.terminal_tilstand;
<*940418/cl inkluderet sættes i stop - start *>
kode:= d.opref.opkode extract 12;
if kode <> 0 then
terminal_tab.ref.terminal_tilstand:=
(d.opref.opkode shift (-12) shift 21) + (i extract 21)
else
<*940418/cl inkluderet sættes i stop - slut *>
terminal_tab.ref.terminal_tilstand:= i extract
(if i shift(-21) extract 2 = 3 then 21 else 23);
for i:= 1 step 1 until max_antal_kanaler do
begin
iaf:= (i-1)*kanalbeskrlængde;
sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
end;
skærm_måde:= 0;
sætbit_ia(operatørmaske,nr,
(if terminal_tab.ref.terminal_tilstand shift (-21) = 3
then 0 else 1));
for k:= nr, 65 step 1 until top_bpl_gruppe do
begin
msk:= k*op_maske_lgd;
if læsbit_ia(bpl_def.msk,nr) then
<**> begin
n:= 0;
for i:= 1 step 1 until max_antal_operatører do
if læsbit_ia(bpl_def.msk,i) then
begin
iaf1:= i*terminal_beskr_længde;
if terminal_tab.iaf1.terminal_tilstand
shift (-21) < 3 then
n:= n+1;
end;
bpl_tilst(k,1):= n;
end;
<**> <*
bpl_tilst(k,1):= bpl_tilst(k,1) +
(if læsbit_ia(operatørmaske,nr) then 1 else 0);
*> end;
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
sætbit_ia(opkaldsflag,nr,0);
signal_bin(bs_mobil_opkald);
<*940418/cl inkluderet sættes i stop - start *>
if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
<*V*> ht_symbol(z_op(nr))
else
<*940418/cl inkluderet sættes i stop - slut *>
<*V*> skriv_skærm(nr);
cursor(z_op(nr),24,1);
<*V*> setposition(z_op(nr),0,0);
end;
end;
if d.op_ref.opkode = 0 then
signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
else
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end;
begin
\f
message procedure operatør side x+2 - 820304/hko;
<* 3: ekskluder *>
integer k,n;
integer array field iaf1,msk;
write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
<*V*> setposition(z_op(nr),0,0);
monitor(10) release process:(z_op(nr),0,ia);
d.op_ref.resultat:=3;
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
terminal_tab.ref.terminal_tilstand extract 21;
if sæt_bit_ia(operatørmaske,nr,0)=1 then
for k:= nr, 65 step 1 until top_bpl_gruppe do
begin
msk:= k*op_maske_lgd;
if læsbit_ia(bpl_def.msk,nr) then
<**> begin
n:= 0;
for i:= 1 step 1 until max_antal_operatører do
if læsbit_ia(bpl_def.msk,i) then
begin
iaf1:= i*terminal_beskr_længde;
if terminal_tab.iaf1.terminal_tilstand
shift (-21) < 3 then
n:= n+1;
end;
bpl_tilst(k,1):= n;
end;
<**> <*
bpl_tilst(k,1):= bpl_tilst(k,1)-1;
*> end;
signal_bin(bs_mobil_opkald);
if opk_alarm.tab.alarm_tilst > 0 then
begin
opk_alarm.tab.alarm_kmdo:= 3;
signal_bin(bs_opk_alarm);
end;
end;
begin
<* 4: opdater skærm *>
signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
skærmmåde=0 do
begin
<*+2*> if testbit13 and overvåget then
disable begin
write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
<:) opkaldsflag::>,"nl",1);
outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
write(out,<: operatørmaske::>,"nl",1);
outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
ud;
end;
<*-2*>
if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
begin
skriv_skærm_bvs(nr);
<*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
if status>0 then
begin
for ll:= 1 step 1 until terminalbeskrlængde//2 do
terminaltab.ref(ll):= 0;
skriv_skærm_bvs(nr);
wait(bs_talevej_udkoblet(op_talevej(nr)));
end;
for i:= 1 step 1 until max_antal_kanaler do
begin
iaf:= (i-1)*kanalbeskrlængde;
inspect(ss_samtale_nedlagt(i),status);
if status>0 and
tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
begin
kanaltab.iaf.kanal_tilstand:=
kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
for ll:= 2 step 1 until kanalbeskrlængde//2 do
kanaltab.iaf(ll):= 0;
skriv_skærm_kanal(nr,i);
repeat
wait(ss_samtale_nedlagt(i));
inspect(ss_samtale_nedlagt(i),status);
until status=0;
end;
end;
940920*> cursor(z_op(nr),1,1);
setposition(z_op(nr),0,0);
end;
if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
begin
<*V*> setposition(z_op(nr),0,0);
if sætbit_ia(opkaldsflag,nr,0) =1 then
skriv_skærm_opkaldskø(nr);
if sætbit_ia(kanalflag,nr,0) =1 then
begin
for i:=1 step 1 until max_antal_kanaler do
skriv_skærm_kanal(nr,i);
end;
cursor(z_op(nr),1,1);
<*V*> setposition(z_op(nr),0,0);
end;
end;
end;
begin
\f
message procedure operatør side x+3 - 830310/hko;
<* 5: samtale etableret *>
res:= d.op_ref.resultat;
b_v:= d.op_ref.data(3) extract 4;
b_s:= d.op_ref.data(4);
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
begin
sætbit_i(terminal_tab.ref(1),21,1);
sætbit_i(terminal_tab.ref(1),22,0);
sætbit_i(terminal_tab.ref(1),2,0);
sæt_hex_ciffer(terminal_tab.ref,3,b_v);
terminal_tab.ref(2):= b_s;
sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
begin
<*V*> setposition(z_op(nr),0,0);
skriv_skærm_b_v_s(nr);
<*V*> setposition(z_op(nr),0,0);
end;
end
else
if terminal_tab.ref(1) shift(-21) = 2 then
begin
sætbit_i(terminal_tab.ref(1),22,0);
sætbit_i(terminal_tab.ref(1),2,0);
sæt_hex_ciffer(terminal_tab.ref,3,b_v);
terminal_tab.ref(2):= 0;
if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
begin
<*V*> setposition(z_op(nr),0,0);
cursor(z_op(nr),21,17);
write(z_op(nr),<:EJ FORB:>);
<*V*> setposition(z_op(nr),0,0);
end;
end
else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
<:terminal tilstand:>,1);
end;
begin
\f
message procedure operatør side x+4 - 810602/hko;
<* 6: radiokanal ekskluderet *>
læs_hex_ciffer(terminal_tab.ref,3,b_v);
pos:= d.op_ref.data(1);
signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
indeks:= terminal_tab.ref(2);
b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
then indeks extract 4 else 0;
if b_v = pos then
sæt_hex_ciffer(terminal_tab.ref,3,0);
if b_s = pos then
begin
terminal_tab.ref(2):= 0;
sætbit_i(terminal_tab.ref(1),21,0);
sætbit_i(terminal_tab.ref(1),22,0);
sætbit_i(terminal_tab.ref(1),2,0);
end;
if skærmmåde=0 then
begin
if b_v = pos or b_s = pos then
<*V*> skriv_skærm_b_v_s(nr);
<*V*> skriv_skærm_kanal(nr,pos);
cursor(z_op(nr),1,1);
setposition(z_op(nr),0,0);
end;
end;
begin
\f
message procedure operatør side x+5 - 950118/cl;
<* 7: operatørmeddelelse *>
integer afs, kl, i;
real dato, t;
cursor(z_op(nr),24,1);
write(z_op(nr),"esc" add 128,1,<:ÆK:>);
cursor(z_op(nr),23,1);
write(z_op(nr),"esc" add 128,1,<:ÆK:>);
afs:= d.opref.data.op_spool_kilde;
dato:= systime(4,d.opref.data.op_spool_tid,t);
kl:= round t;
write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
if afs=0 then <:SYSOP:> else string bpl_navn(afs));
i:= replacechar(1,'.');
disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
replacechar(1,i);
write(z_op(nr),d.opref.data.op_spool_text);
if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
begin
if opk_alarm.tab.alarm_lgd > 0 and
opk_alarm.tab.alarm_tilst < 1 and
opk_alarm.tab.alarm_kmdo < 1
then
begin
opk_alarm.tab.alarm_kmdo := 1;
signalbin(bs_opk_alarm);
end
else
if opk_alarm.tab.alarm_lgd = 0 then
write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
end;
setposition(z_op(nr),0,0);
signalch(d.opref.retur,opref,d.opref.optype);
end;
begin
<*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
<*-4*>
end
end; <* case aktion+6 *>
until false;
op_trap:
skriv_operatør(zbillede,1);
end operatør;
\f
message procedure op_cqftest side 1;
procedure op_cqftest;
begin
integer array field opref, ref, ref1;
integer i, j, tv, cqf, res, pausetid;
real nu, næstetid, kommstart, kommslut;
procedure skriv_op_cqftest(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ op-cqftest:>);
if omfang > 0 then
disable begin
real t;
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: ref: :>,ref,"nl",1,
<: i: :>,i,"nl",1,
<: tv: :>,tv,"nl",1,
<: cqf: :>,cqf,"nl",1,
<: res: :>,res,"nl",1,
<: pausetid: :>,pausetid,"nl",1,
<: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
<: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
<::>);
skriv_coru(zud,coru_no(292));
slut:
end;
end skriv_op_cqftest;
trap(op_cqf_trap);
stackclaim(1000);
<*+4*>if (testbit8 and overvåget) or testbit28 then
skriv_op_cqftest(out,0);
<*-4*>
<*V*> waitch(cs_cqf,opref,op_optype,-1);
repeat
i:= sidste_tv_brugt; tv:= 0;
repeat
i:= (i mod max_antal_taleveje) + 1;
if tv_operatør(i) = 0 then tv:= i;
until (tv<>0) or (i=sidste_tv_brugt);
if tv<>0 then
begin
tv_operatør(tv):= -1;
systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
for cqf:= 1 step 1 until max_cqf do
begin
ref:= (cqf-1)*cqf_lgd;
if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
begin
startoperation(opref,292,cs_cqf,1 shift 12 + 41);
d.opref.data(1):= tv;
d.opref.data(2):= cqf_tabel.ref.cqf_bus;
disable if testbit19 then
begin
integer i; <*lav en trap-bar blok*>
trap(test19_trap);
systime(1,0,kommstart);
write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
skriv_id(zrl,d.opref.data(2),0);
test19_trap: outchar(zrl,'nl');
end;
signalch(cs_rad,opref,op_optype or gen_optype);
<*V*> waitch(cs_cqf,opref,op_optype,-1);
res:= d.opref.resultat;
<*+2*>
disable if testbit19 then
begin
integer i; <*lav en trap-bar blok*>
trap(test19_trap);
systime(1,0,kommslut);
write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
if d.opref.data(7)=2 then outchar(zrl,'*');
if d.opref.data(9)<>0 then
begin
skriv_id(zrl,d.opref.data(9),0);
outchar(zrl,' ');
end;
if d.opref.data(8)<>0 then
begin
skriv_id(zrl,d.opref.data(8),0);
outchar(zrl,' ');
end;
if d.opref.data(12)<>0 then
begin
if d.opref.data(12) shift (-20) = 15 then
write(zrl,<:OMR*:>)
else
if d.opref.data(12) shift (-20) = 14 then
write(zrl,
string områdenavn(d.opref.data(12) extract 20))
else
skriv_id(zrl,d.opref.data(12),0);
outchar(zrl,' ');
end;
if d.opref.data(10)<>0 then
begin
skriv_id(zrl,d.opref.data(10),0);
outchar(zrl,' ');
end;
write(zrl,<:res=:>,<<d>,res,<: btid=:>,
<<dd.dd>,kommslut-kommstart);
test19_trap: outchar(zrl,'nl');
end;
<*-2*>
if res=3 and cqf_tabel.ref.cqf_bus > 0 then
begin
delay(3);
d.opref.opkode:= 12 shift 12 + 41;
d.opref.resultat:= 0;
disable if testbit19 then
begin
integer i; <*lav en trap-bar blok*>
trap(test19_trap);
systime(1,0,kommstart);
write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
test19_trap: outchar(zrl,'nl');
end;
signalch(cs_rad,opref,op_optype or gen_optype);
<*V*> waitch(cs_cqf,opref,op_optype,-1);
<*+2*>
disable if testbit19 then
begin
integer i; <*lav en trap-bar blok*>
trap(test19_trap);
systime(1,0,kommslut);
write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
<<dd.dd>,kommslut-kommstart);
test19_trap: outchar(zrl,'nl');
end;
<*-2*>
if d.opref.resultat <> 3 then
fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
begin
startoperation(opref,292,cs_cqf,23);
i:= 1;
hægtstring(d.opref.data,i,<:CQF-test bus :>);
anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
skriv_tegn(d.opref.data,i,' ');
hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
hægtstring(d.opref.data,i,<: ok!:>);
repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
signalch(cs_io,opref,gen_optype);
<*V*> waitch(cs_cqf,opref,gen_optype,-1);
end;
if cqf_tabel.ref.cqf_bus > 0 then
begin
cqf_tabel.ref.cqf_fejl:= 0;
systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
end;
end <*res=3*>
else
if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
cqf_tabel.ref.cqf_bus > 0
then
begin
cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
if cqf_tabel.ref.cqf_fejl >= 2 then
begin
startoperation(opref,292,cs_cqf,23);
i:= 1;
hægtstring(d.opref.data,i,<:CQF-test bus :>);
anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
skriv_tegn(d.opref.data,i,' ');
hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
signalch(cs_io,opref,gen_optype);
<*V*> waitch(cs_cqf,opref,gen_optype,-1);
end;
end;
delay(10);
end;
if cqf_tabel.ref.cqf_bus > 0 and
cqf_tabel.ref.cqf_næste_tid < næste_tid
then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
end; <*for cqf*>
tv_operatør(tv):= 0; tv:= 0;
if op_cqf_tab_ændret then
begin
j:= skrivfil(1033,1,i);
if j<>0 then
fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
sorter_cqftab(1,max_cqf);
for cqf:= 1 step 1 until max_cqf do
begin
ref:= (cqf-1)*cqf_lgd;
ref1:= (cqf-1)*cqf_id;
tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
end;
op_cqf_tab_ændret:= false;
end;
end; <*tv*>
systime(1,0.0,nu);
pausetid:= round(næste_tid - nu);
if pausetid < 30 then pausetid:= 30;
<*V*> delay(pausetid);
until false;
op_cqf_trap:
disable skriv_op_cqftest(zbillede,1);
end op_cqftest;
\f
message procedure op_spool side 1;
procedure op_spool;
begin
integer array field opref, ref;
integer næste_tomme, i;
procedure skriv_op_spool(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ op-spool:>);
if omfang > 0 then
disable begin
real t;
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: næste-tomme: :>,næste_tomme,"nl",1,
<: ref: :>,ref,"nl",1,
<: i: :>,i,"nl",1,
<::>);
skriv_coru(zud,coru_no(293));
slut:
end;
end skriv_op_spool;
trap(op_spool_trap);
stackclaim(400);
næste_tomme:= 0;
<*+4*>if (testbit8 and overvåget) or testbit28 then
skriv_op_spool(out,0);
<*-4*>
repeat
<*V*> waitch(cs_op_spool,opref,true,-1);
inspect(ss_op_spool_tomme,i);
if d.opref.opkode extract 12 <> 37 then
begin
d.opref.resultat:= 31;
fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
end
else
if i<=0 then
d.opref.resultat:= 32 <*ingen fri plads*>
else
begin
<*V*> wait(ss_op_spool_tomme);
ref:= næste_tomme*op_spool_postlgd;
næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
i:= d.opref.opsize - data;
if i > (op_spool_postlgd - op_spool_text) then
i:= (op_spool_postlgd - op_spool_text);
op_spool_buf.ref.op_spool_kilde:=
(if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
op_spool_buf.ref.op_spool_tid:= d.opref.tid;
tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
op_spool_buf.ref(op_spool_postlgd//2):=
op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
d.opref.resultat:= 3;
signal(ss_op_spool_fulde);
end;
signalch(d.opref.retur,opref,d.opref.optype);
until false;
op_spool_trap:
disable skriv_op_spool(zbillede,1);
end op_spool;
\f
message procedure op_medd side 1;
procedure op_medd;
begin
integer array field opref, ref;
integer næste_fulde, i;
procedure skriv_op_medd(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ op-medd:>);
if omfang > 0 then
disable begin
real t;
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: næste-fulde: :>,næste_fulde,"nl",1,
<: ref: :>,ref,"nl",1,
<: i: :>,i,"nl",1,
<::>);
skriv_coru(zud,coru_no(294));
slut:
end;
end skriv_op_medd;
trap(op_medd_trap);
næste_fulde:= 0;
stackclaim(400);
<*+4*>if (testbit8 and overvåget) or testbit28 then
skriv_op_medd(out,0);
<*-4*>
repeat
<*V*> wait(ss_op_spool_fulde);
<*V*> waitch(cs_op_medd,opref,true,-1);
ref:= næste_fulde*op_spool_postlgd;
næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
startoperation(opref,curr_coruid,cs_op_medd,38);
d.opref.resultat:= 0;
tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
opref,gen_optype);
signal(ss_op_spool_tomme);
until false;
op_medd_trap:
disable skriv_op_medd(zbillede,1);
end op_medd;
\f
message procedure alarmur side 1;
procedure alarmur;
begin
integer ventetid, nr;
integer array field opref, tab;
real nu;
procedure skriv_alarmur(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ alarmur:>);
if omfang > 0 then
disable begin
real t;
trap(slut);
write(zud,"nl",1,
<: ventetid: :>,ventetid,"nl",1,
<: nr: :>,nr,"nl",1,
<: opref: :>,opref,"nl",1,
<: tab: :>,tab,"nl",1,
<: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
<::>);
skriv_coru(zud,coru_no(295));
slut:
end;
end skriv_alarmur;
trap(alarmur_trap);
stackclaim(400);
systime(1,0.0,nu);
ventetid:= -1;
repeat
waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
if opref > 0 then
signalch(d.opref.retur,opref,op_optype);
ventetid:= -1;
systime(1,0.0,nu);
for nr:= 1 step 1 until max_antal_operatører do
begin
tab:= (nr-1)*opk_alarm_tab_lgd;
if opk_alarm.tab.alarm_tilst > 0 and
opk_alarm.tab.alarm_lgd >= 0 then
begin
if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
begin
opk_alarm.tab.alarm_kmdo:= 3;
signalbin(bs_opk_alarm);
if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
end
else
if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
ventetid:= (nu - opk_alarm.tab.alarm_start);
end;
end;
if ventetid=0 then ventetid:= 1;
until false;
alarmur_trap:
disable skriv_alarmur(zbillede,1);
end alarmur;
\f
message procedure opkaldsalarmer side 1;
procedure opkaldsalarmer;
begin
integer nr, ny_kommando, tilst, aktion, tt;
integer array field tab, opref, alarmop;
procedure skriv_opkaldsalarmer(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ opkaldsalarmer:>);
if omfang>0 then
disable begin
real array field raf;
trap(slut);
raf:=0;
write(zud,"nl",1,
<: nr: :>,nr,"nl",1,
<: ny-kommando: :>,ny_kommando,"nl",1,
<: tilst: :>,tilst,"nl",1,
<: aktion: :>,aktion,"nl",1,
<: tt: :>,false add tt,1,"nl",1,
<: tab: :>,tab,"nl",1,
<: opref: :>,opref,"nl",1,
<: alarmop: :>,alarmop,"nl",1,
<::>);
skriv_coru(zud,coru_no(296));
slut:
end;
end skriv_opkaldsalarmer;
trap(opk_alarm_trap);
stackclaim(400);
<*+2*>if (testbit8 and overvåget) or testbit28 then
skriv_opkaldsalarmer(out,0);
<*-2*>
repeat
wait(bs_opk_alarm);
alarmop:= 0;
for nr:= 1 step 1 until max_antal_operatører do
begin
tab:= (nr-1)*opk_alarm_tab_lgd;
ny_kommando:= opk_alarm.tab.alarm_kmdo;
tilst:= opk_alarm.tab.alarm_tilst;
aktion:= case ny_kommando+1 of (
<*ingenting*> case tilst+1 of (4,4,4),
<*normal *> case tilst+1 of (1,4,4),
<*nød *> case tilst+1 of (2,2,4),
<*sluk *> case tilst+1 of (4,3,3));
tt:= case aktion of ('B','C','F','-');
if tt<>'-' then
begin
<*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
d.opref.data(1):= nr+16;
signalch(cs_talevejsswitch,opref,op_optype);
<*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
if d.opref.resultat = 3 then
begin
opk_alarm.tab.alarm_kmdo:= 0;
opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
if aktion < 3 then
begin
systime(1,0.0,opk_alarm.tab.alarm_start);
if alarmop = 0 then
waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
end;
end;
signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
end;
end;
if alarmop<>0 then
begin
startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
signalch(cs_opk_alarm_ur,alarmop,op_optype);
end;
until false;
opk_alarm_trap:
disable skriv_opkaldsalarmer(zbillede,1);
end;
\f
message procedure tvswitch_input side 1 - 940810/cl;
procedure tv_switch_input;
begin
integer array field opref;
integer tt,ant;
boolean ok;
integer array ia(1:128);
procedure skriv_tvswitch_input(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ tvswitch-input:>);
if omfang>0 then
disable begin
real array field raf;
trap(slut);
raf:=0;
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
<: ant: :>,ant,"nl",1,
<: tt: :>,tt,"nl",1,
<::>);
write(zud,"nl",1,<:ia: :>);
skrivhele(zud,ia.raf,256,2);
skriv_coru(zud,coru_no(297));
slut:
end;
end skriv_tvswitch_input;
\f
boolean procedure læs_tlgr;
begin
integer kl,ch,i,pos,p;
long field lf;
boolean ok;
integer procedure readch(z,c);
zone z; integer c;
begin
readch:= readchar(z,c);
<*+2*> if testbit15 and overvåget then
disable begin
if ' ' <= c and c <= 'ü' then outchar(zrl,c)
else write(zrl,"<",1,<<d>,c,">",1);
if c='em' then write(zrl,<: *timeout*:>);
end;
<*-2*>
end;
ok:= false; tt:=' ';
repeat
readchar(z_tv_in,ch);
until ch<>'em';
repeatchar(z_tv_in);
<*+2*>if testbit15 and overvåget then
disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
<*-2*>
for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
if ch='%' then
begin
ant:= 0; pos:= 1; lf:= 4;
ok:= true;
for i:= 1 step 1 until 128 do ia(i):= 0;
for kl:=readch(z_tv_in,ch) while kl = 6 do
skrivtegn(ia,pos,ch);
p:=pos;
repeat afsluttext(ia,p) until p mod 6 = 1;
if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
if ok and ch=' ' then
for kl:=readch(z_tv_in,ch) while ch=' ' do ;
while kl = 2 do
begin
i:= ch - '0';
for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
if ant < 128 then
begin
ant:= ant+1;
ia(ant):= i;
end
else
ok:= false;
while ch=' ' do kl:=readch(z_tv_in,ch);
end;
if ch<>'nl' then ok:= false;
while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
<* !! setposition(z_tv_in,0,0); !! *>
<*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
<*-2*>
if tt='+' or tt='-' or tt='Q' or tt='E' then
ok:= ok
else if tt='C' or tt='N' or
tt='P' or tt='U' or tt='S' or tt='Z' then
ok:= ok and ant=1
else if tt='X' or tt='Y' then
ok:= ok and ant=2
else if tt='T' or tt='W' then
ok:= ok and ant=64
else if tt='R' then
ok:= ok and ant extract 1 = 0
else
begin
ok:= false;
fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
end;
end; <* if ch='%' *>
læs_tlgr:= ok;
end læs_tlgr;
\f
trap(tvswitch_input_trap);
stackclaim(400);
for ant:= 1 step 1 until 128 do ia(ant):= 0;
<*+2*>if (testbit8 and overvåget) or testbit28 then
skriv_tvswitch_input(out,0);
<*-2*>
repeat
ok:= læs_tlgr;
if ok then
begin
<*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
start_operation(opref,297,cs_tvswitch_input,0);
d.opref.resultat:= tt shift 12 + ant;
tofrom(d.opref.data,ia,ant*2);
signalch(cs_talevejsswitch,opref,op_optype);
end;
until false;
tvswitch_input_trap:
disable skriv_tvswitch_input(zbillede,1);
end tvswitch_input;
\f
message procedure tv_switch_adm side 1 - 940502/cl;
procedure tv_switch_adm;
begin
integer array field opref;
integer rc;
procedure skriv_tv_switch_adm(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ tv-switch-adm:>);
if omfang>0 then
disable begin
trap(slut);
write(zud,"nl",1,
<: opref: :>,opref,"nl",1,
<: rc: :>,rc,"nl",1,
<::>);
skriv_coru(zud,coru_no(298));
slut:
end;
end skriv_tv_switch_adm;
trap(tv_switch_adm_trap);
stackclaim(400);
<*+2*> if (testbit8 and overvåget) or testbit28 then
disable skriv_tv_switch_adm(out,0);
<*-2*>
<* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
waitch(cs_tvswitch_adm,opref,op_optype,-1);
*>
repeat
waitch(cs_tvswitch_adgang,opref,op_optype,-1);
start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
rc:= 0;
repeat
signalch(cs_talevejsswitch,opref,op_optype);
<*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
rc:= rc+1;
until rc=3 or d.opref.resultat=3;
signalch(cs_tvswitch_adgang,opref,op_optype);
<*V*> delay(15*60);
until false;
tv_switch_adm_trap:
disable skriv_tv_switch_adm(zbillede,1);
end;
\f
message procedure talevejsswitch side 1 -940426/cl;
procedure talevejsswitch;
begin
integer tt, ant, ventetid;
integer array field opref, gemt_op, tab;
boolean ok;
integer array ia(1:128);
procedure skriv_talevejsswitch(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ talevejsswitch:>);
if omfang>0 then
disable begin
real array field raf;
trap(slut);
raf:= 0;
write(zud,"nl",1,
<: tt: :>,tt,"nl",1,
<: ant: :>,ant,"nl",1,
<: ventetid: :>,ventetid,"nl",1,
<: opref: :>,opref,"nl",1,
<: gemt-op: :>,gemt_op,"nl",1,
<: tab: :>,tab,"nl",1,
<: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
<::>);
write(zud,"nl",1,<:ia: :>);
skriv_hele(zud,ia.raf,256,2);
skriv_coru(zud,coru_no(299));
slut:
end;
end skriv_talevejsswitch;
\f
trap(tvswitch_trap);
stackclaim(400);
for ant:= 1 step 1 until 128 do ia(ant):= 0;
<*+2*>if (testbit8 and overvåget) or testbit28 then
skriv_talevejsswitch(out,0);
<*-2*>
ventetid:= -1; ant:= 0; tt:= ' ';
repeat
waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
if opref > 0 then
begin
if d.opref.opkode extract 12 = 0 then
begin <*input fra talevejsswitchen *>
for ant:= 1 step 1 until 128 do ia(ant):= 0;
tt:= d.opref.resultat shift (-12) extract 12;
ant:= d.opref.resultat extract 12;
tofrom(ia,d.opref.data,ant*2);
signalch(d.opref.retur,opref,d.opref.optype);
if tt<>'+' and tt<>'-' then
begin
write(z_tv_out,"%",1,<:ACK:>,"cr",1);
setposition(z_tv_out,0,0);
<*+2*> if testbit15 and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
outchar(zrl,'nl');
end;
<*-2*>
end;
if (tt='+' or tt='-') and gemt_op<>0 then
begin
d.gemt_op.resultat:= (if tt='+' then 3 else 0);
signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
gemt_op:= 0;
ventetid:= -1;
end
else
if tt='R' then
begin
for i:= 1 step 2 until ant do
begin
if ia(i) <= max_antal_taleveje and
17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
then
begin
if op_talevej(ia(i+1)-16)<>ia(i) then
tv_operatør(op_talevej(ia(i+1)-16)):= 0;
if tv_operatør(ia(i))<>ia(i+1)-16 then
op_talevej(tv_operatør(ia(i))):= 0;
tv_operatør(ia(i)):= ia(i+1)-16;
op_talevej(ia(i+1)-16):= ia(i);
sætbit_ia(samtaleflag,ia(i+1)-16,1);
end
else
if ia(i+1) <= max_antal_taleveje and
17 <= ia(i) and ia(i) <= max_antal_operatører+16
then
begin
if op_talevej(ia(i))<>ia(i+1)-16 then
tv_operatør(op_talevej(ia(i))):= 0;
if tv_operatør(ia(i+1)-16)<>ia(i) then
op_talevej(tv_operatør(ia(i+1)-16)):= 0;
tv_operatør(ia(i+1)):= ia(i)-16;
op_talevej(ia(i)-16):= ia(i+1);
sætbit_ia(samtaleflag,ia(i)-16,1);
end;
end;
signal_bin(bs_mobil_opkald);
<*+2*> if testbit15 and testbit16 and overvåget then
disable begin
skriv_talevejs_tab(zrl); outchar(zrl,'nl');
end;
<*-2*>
end <* tt='R' and ant>0 *>
else
if tt='Y' then
begin
if ia(1) <= max_antal_taleveje and
17 <= ia(2) and ia(2) <= max_antal_operatører+16
then
begin
if tv_operatør(ia(1))=ia(2)-16 and
op_talevej(ia(2)-16)=ia(1)
then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
end
else
if ia(2) <= max_antal_taleveje and
17 <= ia(1) and ia(1) <= max_antal_operatører+16
then
begin
if tv_operatør(ia(2))=ia(1)-16 and
op_talevej(ia(1)-16)=ia(2)
then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
end;
end
else
if tt='C' or tt='N' or tt='P' or tt='U' then
begin
waitch(cs_op_iomedd,opref,gen_optype,-1);
startoperation(opref,299,cs_op_iomedd,23);
ant:= 1;
hægtstring(d.opref.data,ant,<:switch - port :>);
anbringtal(d.opref.data,ant,ia(1),2);
if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
begin
hægtstring(d.opref.data,ant,<: (:>);
if bpl_navn(ia(1)-16)=long<::> then
begin
hægtstring(d.opref.data,ant,<:op:>);
anbringtal(d.opref.data,ant,ia(1)-16,
if ia(1)-16 > 9 then 2 else 1);
end
else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
skrivtegn(d.opref.data,ant,')');
end;
hægtstring(d.opref.data,ant,
if tt='C' then <: Kontakt med kontrolbox etableret:> else
if tt='N' then <: Kontakt med kontrolbox tabt:> else
if tt='P' then <: Tilgængelig:> else
if tt='U' then <: Ikke tilgængelig:> else <::>);
repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
signalch(cs_io,opref,gen_optype);
end
else
if tt='Z' then
begin
tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
end
else
begin
<* ikke implementeret *>
end;
end
else
if d.opref.opkode extract 12 = 44 then
begin
tt:= d.opref.opkode shift (-12);
ok:= true;
if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
begin
<*+2*> if testbit15 and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
outchar(zrl,'nl');
end;
<*-2*>
write(z_tv_out,"%",1,false add tt,1,"cr",1);
setposition(z_tv_out,0,0);
end
else
if tt='B' or tt='C' or tt='F' then
begin
<*+2*> if testbit15 and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
" ",1,<<d>,d.opref.data(1));
outchar(zrl,'nl');
end;
<*-2*>
write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
d.opref.data(1),"cr",1);
setposition(z_tv_out,0,0);
end
else
if tt='A' or tt='D' or tt='T' then
begin
<*+2*> if testbit15 and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
" ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
outchar(zrl,'nl');
end;
<*-2*>
write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
setposition(z_tv_out,0,0);
end
else
ok:= false;
if ok then
begin
gemt_op:= opref;
ventetid:= 2;
end
else
begin
d.opref.resultat:= 4;
signalch(d.opref.retur,opref,d.opref.optype);
end;
end;
end
else
if gemt_op<>0 then
begin <*timeout*>
d.gemt_op.resultat:= 0;
signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
gemt_op:= 0;
ventetid:= -1;
<*+2*> if testbit15 and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
outchar(zrl,'nl');
end;
<*-2*>
end;
until false;
tvswitch_trap:
disable skriv_talevejsswitch(zbillede,1);
end talevejsswitch;
\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;
getnumber(iz.raf,7,j);
iaf:=(max_antal_operatører+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:=(max_antal_operatører+ 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:=(max_antal_operatører+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:= (max_antal_operatører+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);
monitor(8)reserve:(z_gar(nr),0,ia);
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;
monitor(10)release:(z_gar(nr),0,ia);
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;
\f
message procedure radio_erklæringer side 1 - 820304/hko;
zone z_fr_in(14,1,rad_in_fejl),
z_rf_in(14,1,rad_in_fejl),
z_fr_out(14,1,rad_out_fejl),
z_rf_out(14,1,rad_out_fejl);
integer array
radiofejl,
ss_samtale_nedlagt,
ss_radio_aktiver(1:max_antal_kanaler),
bs_talevej_udkoblet,
cs_radio(1:max_antal_taleveje),
radio_linietabel(1:max_linienr//3+1),
radio_områdetabel(0:max_antal_områder),
opkaldskø(opkaldskø_postlængde//2+1:
(max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
hookoff_maske(1:(tv_maske_lgd//2)),
samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
integer field
kanal_tilstand,
kanal_id1,
kanal_id2,
kanal_spec,
kanal_alt_id1,
kanal_alt_id2;
integer array field
kanal_mon_maske,
kanal_alarm,
opkald_meldt;
integer
cs_rad,
cs_radio_medd,
cs_radio_adm,
cs_radio_ind,
cs_radio_ud,
cs_radio_pulje,
cs_radio_kø,
bs_mobil_opkald,
bs_opkaldskø_adgang,
opkaldskø_ledige,
nødopkald_brugt,
første_frie_opkald,
første_opkald,
sidste_opkald,
første_nødopkald,
sidste_nødopkald,
optaget_flag;
boolean
mobil_opkald_aktiveret;
\f
message procedure læs_hex_ciffer side 1 - 810428/hko;
integer
procedure læs_hex_ciffer(tabel,linie,op);
value linie;
integer array tabel;
integer linie,op;
begin
integer i,j;
i:=(if linie>=0 then linie+6 else linie)//6;
j:=((i-1)*6-linie)*4;
læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
end læs_hex_ciffer;
message procedure sæt_hex_ciffer side 1 - 810505/hko;
integer
procedure sæt_hex_ciffer(tabel,linie,op);
value linie;
integer array tabel;
integer linie,op;
begin
integer i,j;
i:=(if linie>=0 then linie+6 else linie)//6;
j:=(linie-(i-1)*6)*4;
sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
shift j add (tabel(i) extract j);
end sæt_hex_ciffer;
message procedure hex_to_dec side 1 - 900108/cl;
integer procedure hex_to_dec(hex);
value hex;
integer hex;
begin
hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
else (hex-'0');
end;
message procedure dec_to_hex side 1 - 900108/cl;
integer procedure dec_to_hex(dec);
value dec;
integer dec;
begin
dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
else ('A'+dec-10);
end;
message procedure rad_out_fejl side 1 - 820304/hko;
procedure rad_out_fejl(z,s,b);
value s;
zone z;
integer s,b;
begin
integer array field iaf;
integer pos,tegn,max,i;
integer array ia(1:20);
long array field laf;
disable begin
laf:= iaf:= 2;
tegn:= 1;
getzone6(z,ia);
max:= ia(16)//2*3;
if s = 1 shift 21 + 2 then
begin
z(1):= real<:<'em'>:>;
b:= 2;
end
else
begin
pos:= 0;
for i:= 1 step 1 until max_antal_kanaler do
begin
iaf:= (i-1)*kanalbeskr_længde;
if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
if pos>0 then
begin
tofrom(kanalflag,alle_operatører,op_maske_lgd);
signalbin(bs_mobilopkald);
fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
1 shift 12<*binært*> +1<*fortsæt*>);
end;
end;
end;
end;
end;
\f
message procedure rad_in_fejl side 1 - 810601/hko;
procedure rad_in_fejl(z,s,b);
value s;
zone z;
integer s,b;
begin
integer array field iaf;
integer pos,tegn,max,i;
integer array ia(1:20);
long array field laf;
disable begin
laf:= iaf:= 2;
i:= 1;
getzone6(z,ia);
max:= ia(16)//2*3;
if s shift (-21) extract 1 = 0
and s shift(-19) extract 1 = 0 then
begin
if b = 0 then
begin
z(1):= real<:!:>;
b:= 2;
end;
end;
\f
message procedure rad_in_fejl side 2 - 820304/hko;
if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
begin
fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
1 shift 12<*binær*> +1<*fortsæt*>);
end
else
if s shift (-19) extract 1 = 1 then
begin
z(1):= real<:!<'nl'>:>;
b:= 2;
end
else
if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
begin
<*
if b = 0 then
begin
*>
z(1):= real <:<'em'>:>;
b:= 2;
<*
end
else
begin
tegn:= -1;
iaf:= 0;
pos:= b//2*3-2;
while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
skriv_tegn(z.iaf,pos,'?');
if pos<=max then
afslut_text(z.iaf,pos);
b:= (pos-1)//3*2;
end;
*>
end;<* s=1 shift 21+2 *>
end;
if testbit22 and
(s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
then
delay(60);
end rad_in_fejl;
\f
message procedure afvent_radioinput side 1 - 880901/cl;
integer procedure afvent_radioinput(z_in,tlgr,rf);
value rf;
zone z_in;
integer array tlgr;
boolean rf;
begin
integer i, p, pos, tegn, ac, sum, csum, lgd;
long array field laf;
laf:= 0;
pos:= 1;
repeat
i:=readchar(z_in,tegn);
if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
until (i=8 and pos>1) or (tegn='em') or (pos>=80);
p:=pos;
repeat afsluttext(tlgr,p) until p mod 6 = 1;
<*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
(rf and testbit39)) then
disable begin
write(zrl,<<zd dd dd.dd >,now,
(if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
if tegn='em' then <:*timeout*:> else
if pos>=80 then <:*for langt*:> else <::>);
outchar(zrl,'nl');
end;
<*-2*>
ac:= -1;
if pos >= 80 then
begin <* telegram for langt *>
repeat readchar(z_in,tegn)
until tegn='nl' or tegn='em';
end
else
if pos>1 and tegn='nl' then
begin
lgd:= 1;
while læstegn(tlgr,lgd,tegn)<>0 do ;
lgd:= lgd-2;
if lgd >= 5 then
begin
lgd:= lgd-2; <* se bort fra checksum *>
i:= lgd + 1;
csum:= (læstegn(tlgr,i,tegn) - '@')*16;
csum:= csum + (læstegn(tlgr,i,tegn) - '@');
i:= lgd + 1;
skrivtegn(tlgr,i,0);
skrivtegn(tlgr,i,0);
i:= 1; sum:= 0;
while i <= lgd do
sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
if csum >= 0 and csum <> sum then
begin
<*+2*> if overvåget and (testbit36 or
((-,rf) and testbit38) or (rf and testbit39)) then
disable begin
write(zrl,<<zd dd dd.dd >,now,
(if rf then <:rf:> else <:fr:>),
<:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
end;
<*-2*>
ac:= 6 <* checksumfejl *>
end
else
ac:= 0;
end
else ac:= 6; <* for kort telegram - retransmitter *>
end;
afvent_radioinput:= ac;
end;
\f
message procedure skriv_kanal_tab side 1 - 820304/hko;
procedure skriv_kanal_tab(z);
zone z;
begin
integer array field ref;
integer i,j,t,op,id1,id2;
write(z,"ff",1,"nl",1,<:
******** kanal-beskrivelser *******
a k l p m b n
l a y a o s ø
nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
<*
01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
*>
"nl",1);
for i:=1 step 1 until max_antal_kanaler do
begin
ref:=(i-1)*kanal_beskr_længde;
t:=kanal_tab.ref.kanal_tilstand;
id1:=kanal_tab.ref.kanal_id1;
id2:=kanal_tab.ref.kanal_id2;
write(z,"nl",1,"sp",4,
<<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
for j:=11 step -1 until 2 do
write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
write(z,case t extract 2 +1 of
(<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
"sp",1);
skriv_id(z,id1,9);
skriv_id(z,id2,9);
t:=kanal_tab.ref.kanal_spec;
write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
write(z,"nl",1,"sp",14,<:mon: :>);
for j:= max_antal_taleveje step -1 until 1 do
write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
else "."),1);
write(z,"sp",25-max_antal_taleveje);
skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
end;
write(z,"nl",2,<:kanalflag::>,"nl",1);
outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
write(z,"nl",2);
end skriv_kanal_tab;
\f
message procedure skriv_opkaldskø side 1 - 820301/hko;
procedure skriv_opkaldskø(z);
zone z;
begin
integer i,bogst,løb,j;
integer array field ref;
write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
<: ref næste foreg X bus linie/løb tid - op type :>,
<: sig omr :>,"nl",1);
for i:= 1 step 1 until max_antal_mobilopkald do
begin
ref:= i*opkaldskø_postlængde;
j:= opkaldskø.ref(1);
write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
j:= opkaldskø.ref(2);
write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
skriv_id(z,j extract 23,9);
j:= opkaldskø.ref(3);
skriv_id(z,j,7);
j:= opkaldskø.ref(4);
write(z,<< zd.dd>,(j shift (-12))/100.0,
<< zd>,j extract 8);
j:= j shift (-8) extract 4;
if j = 1 or j = 2 then
write(z,if j=1 then <: normal:> else <: nød :>)
else write(z,<<dddd>,j,"sp",3);
j:= opkaldskø.ref(5);
write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
string område_navn(j extract 8) else <:---:>);
outchar(z,'nl');
end;
write(z,"nl",1,<<z>,
<:første_frie_opkald=:>,første_frie_opkald,"nl",1,
<:første_opkald=:>,første_opkald,"nl",1,
<:sidste_opkald=:>,sidste_opkald,"nl",1,
<:første_nødopkald=:>,første_nødopkald,"nl",1,
<:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
<:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
<:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
"nl",1,<:opkaldsflag::>,"nl",1);
outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
write(z,"nl",2);
end skriv_opkaldskø;
\f
message procedure skriv_radio_linietabel side 1 - 820301/hko;
procedure skriv_radio_linie_tabel(z);
zone z;
begin
integer i,j,k;
write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
k:= 0;
for i:= 1 step 1 until max_linienr do
begin
læstegn(radio_linietabel,i+1,j);
if j > 0 then
begin
k:= k +1;
write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
"nl",if k mod 5=0 then 1 else 0);
end;
end;
write(z,"nl",if k mod 5=0 then 1 else 2);
end skriv_radio_linietabel;
procedure skriv_radio_områdetabel(z);
zone z;
begin
integer i;
write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
for i:= 1 step 1 until max_antal_områder do
begin
laf:= (i-1)*4;
if radio_områdetabel(i)<>0 then
write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
radio_områdetabel(i),"nl",1);
end;
end skriv_radio_områdetabel;
\f
message procedure h_radio side 1 - 810520/hko;
<* hovedmodulkorutine for radiokanaler *>
procedure h_radio;
begin
integer array field op_ref;
integer k,dest_sem;
procedure skriv_hradio(z,omfang);
value omfang;
zone z;
integer omfang;
begin integer i;
disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
write(z,"sp",26-i);
if omfang >0 then
disable begin integer x;
trap(slut);
write(z,"nl",1,
<: op_ref: :>,op_ref,"nl",1,
<: k: :>,k,"nl",1,
<: dest_sem: :>,dest_sem,"nl",1,
<::>);
skriv_coru(z,coru_no(400));
slut:
end;
end skriv_hradio;
trap(hrad_trap);
stack_claim(if cm_test then 198 else 146);
<*+2*> if testbit32 and overvåget or testbit28 then
skriv_hradio(out,0);
<*-2*>
\f
message procedure h_radio side 2 - 820304/hko;
repeat
wait_ch(cs_rad,op_ref,true,-1);
<*+2*>if testbit33 and overvåget then
disable begin
skriv_h_radio(out,0);
write(out,<: operation modtaget:>);
skriv_op(out,op_ref);
end;
<*-2*>
<*+4*>
if (d.op_ref.optype and
(gen_optype or rad_optype or vt_optype)) extract 12 =0
then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
<*-4*>
k:=d.op_ref.op_kode extract 12;
dest_sem:=
if k > 0 and k < 7
or k=11 or k=12 or k=19
or (72<=k and k<=74) or k = 77
<*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
then cs_radio_adm
else if k=41 <* radiokommando fra operatør *>
then cs_radio(d.opref.data(1)) else -1;
<*+4*>
if dest_sem<1 then
begin
if dest_sem<0 then
fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end
else
<*-4*>
begin <* operationskode ok *>
signal_ch(dest_sem,op_ref,d.op_ref.optype);
end;
until false;
hrad_trap:
disable skriv_hradio(zbillede,1);
end h_radio;
\f
message procedure radio side 1 - 820301/hko;
procedure radio(talevej,op);
value talevej,op;
integer talevej,op;
begin
integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
integer array felt,værdi(1:8);
boolean byt,nød,frigiv_samtale;
real kl;
real field rf;
procedure skriv_radio(z,omfang);
value omfang;
zone z;
integer omfang;
begin integer i1;
disable i1:= write(z,"nl",1,<:+++ radio:>);
write(z,"sp",26-i1);
if omfang > 0 then
disable begin real x;
trap(slut);
\f
message procedure radio side 1a- 820301/hko;
write(z,"nl",1,
<: op_ref: :>,op_ref,"nl",1,
<: opref1: :>,opref1,"nl",1,
<: iaf: :>,iaf,"nl",1,
<: iaf1: :>,iaf1,"nl",1,
<: vt-op: :>,vt_op,"nl",1,
<: rad-op: :>,rad_op,"nl",1,
<: rf: :>,rf,"nl",1,
<: nr: :>,nr,"nl",1,
<: i: :>,i,"nl",1,
<: j: :>,j,"nl",1,
<: k: :>,k,"nl",1,
<: operatør: :>,operatør,"nl",1,
<: tilst: :>,tilst,"nl",1,
<: res: :>,res,"nl",1,
<: opgave: :>,opgave,"nl",1,
<: type: :>,type,"nl",1,
<: bus: :>,bus,"nl",1,
<: ll: :>,ll,"nl",1,
<: ttmm: :>,ttmm,"nl",1,
<: vogn: :>,vogn,"nl",1,
<: tekn-inf: :>,tekn_inf,"nl",1,
<: vtop2: :>,vtop2,"nl",1,
<: vtop3: :>,vtop3,"nl",1,
<: sig: :>,sig,"nl",1,
<: omr: :>,omr,"nl",1,
<: garage: :>,garage,"nl",1,
<<-dddddd'-dd>,
<: kl: :>,kl,systime(4,kl,x),x,"nl",1,
<:samtaleflag: :>,"nl",1);
out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
skriv_coru(z,coru_no(410+talevej));
slut:
end;<*disable*>
end skriv_radio;
\f
message procedure udtag_opkald side 1 - 820301/hko;
integer
procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
value vogn, operatør;
integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
begin
integer res,tilst,nr,i,j,t,o,b,l,tm;
integer array field vt_op,ref,næste,forrige;
integer array field iaf1;
boolean skal_ud;
boolean procedure skal_udskrives(fordelt,aktuel);
value fordelt,aktuel;
integer fordelt,aktuel;
begin
boolean skal;
integer n;
integer array field iaf;
skal:= true;
if fordelt > 0 and fordelt<>aktuel then
begin
for n:= 0 step 1 until 3 do
begin
if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
begin
iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
skal:= læsbit_ia(bpl_def.iaf,aktuel);
goto returner;
end;
end;
end;
returner:
skal_udskrives:= skal;
end;
l:= b:= tm:= t:= 0;
garage:= sig:= 0;
res:= -1;
<*V*> wait(bs_opkaldskø_adgang);
ref:= første_nødopkald;
if ref <> 0 then
t:= 2
else
begin
ref:= første_opkald;
t:= if ref = 0 then 0 else 1;
end;
if t = 0 then res:= +19 <*kø er tom*> else
if vogn=0 and omr=0 then
begin
while ref <> 0 and res = -1 do
begin
nr:= opkaldskø.ref(4) extract 8;
if nr>64 then
begin
<*opk. primærfordelt til gruppe af btj.pl.*>
i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
while skal_ud and i<max_antal_operatører do
begin
i:=i+1;
if læsbit_ia(bpl_def.iaf1,i) then
skal_ud:= skal_ud and skal_udskrives(i,operatør);
end;
end
else
skal_ud:= skal_udskrives(nr,operatør);
if skal_ud then
<* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
*>
res:= 0
else
begin
ref:= opkaldskø.ref(1) extract 12;
if ref = 0 and t = 2 then
begin
ref:= første_opkald;
t:= if ref = 0 then 0 else 1;
end else if ref = 0 then t:= 0;
end;
end; <*while*>
\f
message procedure udtag_opkald side 2 - 820304/hko;
if ref <> 0 then
begin
b:= opkaldskø.ref(2);
<*+4*> if b < 0 then
fejlreaktion(19<*mobilopkald*>,bus extract 14,
<:nødopkald(besvaret/ej meldt):>,1);
<*-4*>
garage:=b shift(-14) extract 8;
b:= b extract 14;
l:= opkaldskø.ref(3);
tm:= opkaldskø.ref(4);
o:= tm extract 8;
tm:= tm shift(-12);
omr:= opkaldskø.ref(5) extract 8;
sig:= opkaldskø.ref(5) shift (-20);
end
else res:=19; <* kø er tom *>
end <*vogn=0 and omr=0 *>
else
begin
<* vogn<>0 or omr<>0 *>
i:= 0; tilst:= -1;
if vogn shift(-22) = 1 then
begin
i:= find_busnr(vogn,nr,garage,tilst);
l:= vogn;
end
else
if vogn<>0 and (omr=0 or omr>2) then
begin
o:= 0;
i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
if i=(-2) then
begin
o:= omr;
i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
end;
nr:= vogn extract 14;
end
else nr:= vogn extract 14;
if i<0 then ref:= 0;
while ref <> 0 and res = -1 do
begin
i:= opkaldskø.ref(2) extract 14;
j:= opkaldskø.ref(4) extract 8; <*operatør*>
if nr = i and
(omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
else
begin
ref:= opkaldskø.ref(1) extract 12;
if ref = 0 and t = 2 then
begin
ref:= første_opkald;
t:= if ref = 0 then 0 else 1;
end else if ref = 0 then t:= 0;
end;
end; <*while*>
\f
message procedure udtag_opkald side 3 - 810603/hko;
if ref <> 0 then
begin
b:= nr;
tm:= opkaldskø.ref(4);
o:= tm extract 8;
tm:= tm shift(-12);
omr:= opkaldskø.ref(5) extract 4;
sig:= opkaldskø.ref(5) shift (-20);
<*+4*> if tilst <> -1 then
fejlreaktion(3<*prg.fejl*>,tilst,
<:vogntabel_tilstand for vogn i kø:>,1);
<*-4*>
end;
end;
if ref <> 0 then
begin
næste:= opkaldskø.ref(1);
forrige:= næste shift(-12);
næste:= næste extract 12;
if forrige <> 0 then
opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
+ næste
else if t = 1 then første_opkald:= næste
else <*if t = 2 then*> første_nødopkald:= næste;
if næste <> 0 then
opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
+ forrige shift 12
else if t = 1 then sidste_opkald:= forrige
else <* if t = 2 then*> sidste_nødopkald:= forrige;
opkaldskø.ref(1):=første_frie_opkald;
første_frie_opkald:=ref;
opkaldskø_ledige:=opkaldskø_ledige + 1;
if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
if -,læsbit_ia(operatør_maske,o) or o = 0 then
tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
else
begin
sætbit_ia(opkaldsflag,operatør,1);
sætbit_ia(opkaldsflag,o,1);
end;
signal_bin(bs_mobil_opkald);
end;
\f
message procedure udtag_opkald side 4 - 810531/hko;
signal_bin(bs_opkaldskø_adgang);
bus:= b;
type:= t;
ll:= l;
ttmm:= tm;
udtag_opkald:= res;
end udtag opkald;
\f
message procedure frigiv_kanal side 1 - 810603/hko;
procedure frigiv_kanal(nr);
value nr;
integer nr;
begin
integer id1, id2, omr, i;
integer array field iaf, vt_op;
iaf:= (nr-1)*kanal_beskrlængde;
id1:= kanal_tab.iaf.kanal_id1;
id2:= kanal_tab.iaf.kanal_id2;
omr:= kanal_til_omr(nr);
if id1 <> 0 then
wait(ss_samtale_nedlagt(nr));
if id1 shift (-22) < 3 and omr > 2 then
begin
<*V*> waitch(cs_vt_adgang,vt_op,true,-1);
start_operation(vt_op,410+talevej,cs_radio(talevej),
if id1 shift (-22) = 2 then 18 else 17);
d.vt_op.data(1):= id1;
d.vt_op.data(4):= omr;
signalch(cs_vt,vt_op,vt_optype or genoptype);
<*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
signalch(cs_vt_adgang,vt_op,true);
end;
if id2 <> 0 and id2 shift(-20) <> 12 then
wait(ss_samtale_nedlagt(nr));
if id2 shift (-22) < 3 and omr > 2 then
begin
<*V*> waitch(cs_vt_adgang,vt_op,true,-1);
start_operation(vt_op,410+talevej,cs_radio(talevej),
if id2 shift (-22) = 2 then 18 else 17);
d.vt_op.data(1):= id2;
d.vt_op.data(4):= omr;
signalch(cs_vt,vt_op,vt_optype or genoptype);
<*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
signalch(cs_vt_adgang,vt_op,true);
end;
kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
shift (-10) extract 6 shift 10;
<* repeat
inspect(ss_samtale_nedlagt(nr),i);
if i>0 then wait(ss_samtale_nedlagt(nr));
until i<=0;
*>
end frigiv_kanal;
\f
message procedure hookoff side 1 - 880901/cl;
integer procedure hookoff(talevej,op,retursem,flash);
value talevej,op,retursem,flash;
integer talevej,op,retursem;
boolean flash;
begin
integer array field opref;
opref:= op;
start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
d.opref.data(1):= talevej;
d.opref.data(2):= if flash then 2 else 1;
signalch(cs_radio_ud,opref,rad_optype);
<*V*> waitch(retursem,opref,rad_optype,-1);
hookoff:= d.opref.resultat;
end;
\f
message procedure hookon side 1 - 880901/cl;
integer procedure hookon(talevej,op,retursem);
value talevej,op,retursem;
integer talevej,op,retursem;
begin
integer i,res;
integer array field opref;
if læsbit_ia(hookoff_maske,talevej) then
begin
inspect(bs_talevej_udkoblet(talevej),i);
if i<=0 then
begin
opref:= op;
start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
d.opref.data(1):= talevej;
signalch(cs_radio_ud,opref,rad_optype);
<*V*> waitch(retursem,opref,rad_optype,-1);
res:= d.opref.resultat;
end
else
res:= 0;
if res=0 then wait(bs_talevej_udkoblet(talevej));
end
else
res:= 0;
sætbit_ia(hookoff_maske,talevej,0);
hookon:= res;
end;
\f
message procedure radio side 2 - 820304/hko;
rad_op:= op;
trap(radio_trap);
stack_claim((if cm_test then 200 else 150) +200);
<*+2*>if testbit32 and overvåget or testbit28 then
skriv_radio(out,0);
<*-2*>
repeat
waitch(cs_radio(talevej),opref,true,-1);
<*+2*>
if testbit33 and overvåget then
disable begin
skriv_radio(out,0);
write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
skriv_op(out,opref);
end;
<*-2*>
k:= d.op_ref.opkode extract 12;
opgave:= d.opref.opkode shift (-12);
operatør:= d.op_ref.data(4);
<*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
<:radio:>,0);
<*-4*>
\f
message procedure radio side 3 - 880930/cl;
if k=41 <*radiokommando fra operatør*> then
begin
vogn:= d.opref.data(2);
res:= -1;
for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
sig:= 0; omr:= d.opref.data(3) extract 8;
bus:= garage:= ll:= 0;
if opgave=1 or opgave=9 then
begin <* opkald til enkelt vogn (CHF) *>
res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
<* ok at kø er tom når vogn er angivet eller VHF *>
d.opref.data(11):= if res=0 then
(if ll<>0 then ll else bus) else vogn;
if type=2 <*nød*> then
begin
waitch(cs_radio_pulje,opref1,true,-1);
start_operation(opref1,410+talevej,cs_radio_pulje,46);
d.opref1.data(1):= if ll<>0 then ll else bus;
systime(5,0,kl);
d.opref1.data(2):= entier(kl/100.0);
d.opref1.data(3):= omr;
signalch(cs_io,opref1,gen_optype or rad_optype);
end
end; <* enkeltvogn (CHF) *>
<* check enkeltvogn for ledig *>
if res<=0 and omr=2<*VHF*> and bus=0 and
(opgave=1 or opgave=9) then
begin
for i:= 1 step 1 until max_antal_kanaler do
if kanal_til_omr(i)=2 then nr:= i;
iaf:= (nr-1)*kanalbeskrlængde;
if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
kanal_tab.iaf.kanal_id1 extract 20 = 10000
then res:= 52;
end;
if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
d.opref.data(3)=0 <*std. omr*>) and
(opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
then
begin
type:= ttmm:= 0; omr:= 0; sig:= 0;
if vogn shift (-22) = 1 then
begin
find_busnr(vogn,bus,garage,res);
ll:= vogn;
end
else
if vogn shift (-22) = 0 then
begin
søg_omr_bus(vogn,ll,garage,omr,sig,res);
bus:= vogn;
end
else
fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
res:= if res=(-1) then 18 <* i kø *> else
(if res<>0 then 14 <*opt*> else 0);
end
else
if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
opgave <= 2 then
begin
bus:= vogn; garage:= type:= ttmm:= 0;
res:= 0; omr:= 0; sig:= 0;
end
else
if opgave>1 and opgave<>9 then
type:= ttmm:= res:= 0;
\f
message procedure radio side 4 - 880930/cl;
if res=0 and (opgave<=4 or opgave=9) and
(omr<1 or 2<omr) and
(d.opref.data(3)>2 or d.opref.data(3)=0) then
begin <* reserver i vogntabel *>
waitch(cs_vt_adgang,vt_op,true,-1);
start_operation(vt_op,410+talevej,cs_radio(talevej),
if opgave <=2 or opgave=9 then 15 else 16);
d.vt_op.data(1):= if opgave<=2 or opgave=9 then
(if vogn=0 then garage shift 14 + bus else
if ll<>0 then ll else garage shift 14 + bus)
else vogn <*gruppeid*>;
d.vt_op.data(4):= if d.opref.data(3)<>0 then
d.opref.data(3) extract 8
else omr extract 8;
signalch(cs_vt,vt_op,gen_optype or rad_optype);
<*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
res:= d.vt_op.resultat;
if res=3 then res:= 0;
vtop2:= d.vt_op.data(2);
vtop3:= d.vt_op.data(3);
tekn_inf:= d.vt_op.data(4);
signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
end;
if res<>0 then
begin
d.opref.resultat:= res;
signalch(d.opref.retur,opref,d.opref.optype);
end
else
if opgave <= 9 then
begin <* opkald *>
res:= hookoff(talevej,rad_op,cs_radio(talevej),
opgave<>9 and d.opref.data(6)<>0);
if res<>0 then
goto returner_op;
if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
begin
start_operation(rad_op,410+talevej,cs_radio(talevej),
'H' shift 12 + 60);
d.rad_op.data(1):= talevej;
d.rad_op.data(2):= 'D';
d.rad_op.data(3):= 6; <* rear *>
d.rad_op.data(4):= 1; <* rear no *>
d.rad_op.data(5):= 0; <* disconnect *>
signalch(cs_radio_ud,rad_op,rad_optype);
<*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
if d.rad_op.resultat<>0 then
begin
res:= d.rad_op.resultat;
goto returner_op;
end;
<*
while optaget_flag shift (-1) <> 0 do
delay(1);
*>
end;
\f
message procedure radio side 5 - 880930/cl;
start_operation(rad_op,410+talevej,cs_radio(talevej),
'B' shift 12 + 60);
d.rad_op.data(1):= talevej;
d.rad_op.data(2):= 'D';
d.rad_op.data(3):= if opgave=9 then 3 else
(2 - (opgave extract 1)); <* højttalerkode *>
if 5<=opgave and opgave <=8 then <* ALLE KALD *>
begin
j:= 0;
for i:= 2 step 1 until max_antal_områder do
begin
if opgave > 6 or
(d.opref.data(3) shift (-20) = 15 and
læsbiti(d.opref.data(3),i)) or
(d.opref.data(3) shift (-20) = 14 and
d.opref.data(3) extract 20 = i)
then
begin
for k:= 1 step 1 until (if i=3 then 2 else 1) do
begin
j:= j+1;
d.rad_op.data(10+(j-1)*2):=
område_id(i,2) shift 12 + <* tkt, tkn *>
(if i=2<*VHF*> then 4 else k)
shift 8 + <* signal type *>
1; <* antal tno *>
d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
end;
end;
end;
d.rad_op.data(4):= j;
d.rad_op.data(5):= 0;
end
else
if opgave>2 and opgave <= 4 then <* gruppekald *>
begin
d.rad_op.data(4):= vtop2;
d.rad_op.data(5):= vtop3;
end
else
begin <* enkeltvogn *>
if omr=0 then
begin
sig:= tekn_inf shift (-23);
omr:= if d.opref.data(3)<>0 then d.opref.data(3)
else tekn_inf extract 8;
end
else
if d.opref.data(3)<>0 then omr:= d.opref.data(3);
<* lytte-kald til nød i TCT, VHF og TLF *>
<* tvinges til alm. opkald *>
if (opgave=9) and (type=2) and (omr<=3) then
begin
d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
opgave:= 1;
d.radop.data(3):= 1;
end;
if omr=2 <*VHF*> then sig:= 4 else
if omr=1 <*TLF*> then sig:= 7 else
<*UHF*> sig:= sig+1;
d.rad_op.data(4):= 1;
d.rad_op.data(5):= 0;
d.rad_op.data(10):=
(område_id(omr,2) extract 12) shift 12 +
sig shift 8 +
1;
d.rad_op.data(11):= bus;
end;
\f
message procedure radio side 6 - 880930/cl;
signalch(cs_radio_ud,rad_op,rad_optype);
<*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
res:= d.rad_op.resultat;
d.rad_op.data(6):= 0;
for i:= 1 step 1 until max_antal_områder do
if læsbiti(d.rad_op.data(7),i) then
increase(d.rad_op.data(6));
returner_op:
if d.rad_op.data(6)=1 then
begin
for i:= 1 step 1 until max_antal_områder do
if d.rad_op.data(7) extract 20 = 1 shift i then
d.opref.data(12):= 14 shift 20 + i;
end
else
d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
d.opref.data(7):= type;
d.opref.data(8):= garage shift 14 + bus;
d.opref.data(9):= ll;
if res=0 then
begin
d.opref.resultat:= 3;
d.opref.data(5):= d.opref.data(6);
j:= 0;
for i:= 1 step 1 until max_antal_kanaler do
if læsbiti(d.rad_op.data(9),i) then j:= j+1;
if j>1 then
d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
else
begin
j:= 0;
for i:= 1 step 1 until max_antal_kanaler do
if læsbiti(d.rad_op.data(9),i) then j:= i;
d.opref.data(6):= 3 shift 22 + j;
end;
d.opref.data(7):= type;
d.opref.data(8):= garage shift 14 + bus;
d.opref.data(9):= ll;
d.opref.data(10):= d.opref.data(6);
for i:= 1 step 1 until max_antal_kanaler do
begin
if læsbiti(d.rad_op.data(9),i) then
begin
if kanal_id(i) shift (-5) extract 5 = 2 then
j:= pabx_id( kanal_id(i) extract 5 )
else
j:= radio_id( kanal_id(i) extract 5 );
if j>0 and type=0 and operatør>0 then tæl_opkald(j,1);
iaf:= (i-1)*kanalbeskrlængde;
skrivtegn(kanal_tab.iaf,1,talevej);
kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
kanal_tab.iaf.kanal_id1:=
if opgave<=2 or opgave=9 then
d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
else
d.opref.data(2);
kanal_tab.iaf.kanal_alt_id1:=
if opgave<=2 or opgave=9 then
d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
else
0;
if kanal_tab.iaf.kanal_id1=0 then
kanal_tab.iaf.kanal_id1:= 10000;
kanal_tab.iaf.kanal_spec:=
if opgave <= 2 or opgave = 9 then ttmm else 0;
end;
end;
if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
sætbit_ia(kanalflag,operatør,1);
\f
message procedure radio side 7 - 880930/cl;
end
else
begin
d.opref.resultat:= res;
if res=20 or res=52 then
begin <* tæl ej.forb og opt.kanal *>
for i:= 1 step 1 until max_antal_områder do
if læsbiti(d.rad_op.data(7),i) then
tæl_opkald(i,(if res=20 then 4 else 5));
end;
if d.opref.data(6)=0 then
res:= hookon(talevej,rad_op,cs_radio(talevej));
<* frigiv fra vogntabel hvis reserveret *>
if (opgave<=4 or opgave=9) and
(d.opref.data(3)=0 or d.opref.data(3)>2) then
begin
waitch(cs_vt_adgang,vt_op,true,-1);
startoperation(vt_op,410+talevej,cs_radio(talevej),
if opgave<=2 or opgave=9 then 17 else 18);
d.vt_op.data(1):= if opgave<=2 or opgave=9 then
(if vogn=0 then garage shift 14 + bus else
if ll<>0 then ll else garage shift 14 + bus)
else vogn;
d.vt_op.data(4):= omr;
signalch(cs_vt,vt_op,gen_optype or vt_optype);
waitch(cs_radio(talevej),vt_op,vt_optype,-1);
signalch(cs_vt_adgang,vt_op,true);
end;
end;
signalch(d.opref.retur,opref,d.opref.optype);
\f
message procedure radio side 8 - 880930/cl;
end <* opkald *>
else
if opgave = 10 <* MONITER *> then
begin
nr:= d.opref.data(2);
if nr shift (-20) <> 12 then
fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
nr:= nr extract 20;
iaf:= (nr-1)*kanalbeskrlængde;
inspect(ss_samtale_nedlagt(nr),i);
k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
kanal_tab.iaf.kanal_id2 extract 20
else
if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
(i<>0 or j<>0) then
begin
res:= 0;
d.opref.data(5):= 12 shift 20 + k;
d.opref.data(6):= 12 shift 20 + nr;
sætbit_ia(kanalflag,operatør,1);
goto radio_nedlæg;
end
else
if i<>0 or j<>0 then
res:= 49
else
if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
res:= 49 <* ingen samtale igang *>
else
begin
res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
if res=0 then
begin
start_operation(rad_op,410+talevej,cs_radio(talevej),
'B' shift 12 + 60);
d.rad_op.data(1):= talevej;
d.rad_op.data(2):= 'V';
d.rad_op.data(3):= 0;
d.rad_op.data(4):= 1;
d.rad_op.data(5):= 0;
d.rad_op.data(10):=
(kanal_id(nr) shift (-5) shift 18) +
(kanal_id(nr) extract 5 shift 12) + 0;
signalch(cs_radio_ud,rad_op,rad_optype);
<*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
res:= d.rad_op.resultat;
if res=0 then
begin
d.opref.data(5):= 0;
d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
res:= 3;
end;
end;
end;
\f
message procedure radio side 9 - 880930/cl;
if res=3 then
begin
if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
else
sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
d.opref.data(6):= 12 shift 20 + nr;
i:= kanal_tab.iaf.kanal_id2;
if i<>0 then
begin
if i shift (-20) = 12 then
begin <* ident2 henviser til anden kanal *>
iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
else
sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
d.opref.data(5):= 12 shift 20 + i;
end
else
d.opref.data(5):= 12 shift 20 + nr;
end
else
d.opref.data(5):= 0;
end;
if res<>3 then
begin
res:= 0;
sætbit_ia(kanalflag,operatør,1);
goto radio_nedlæg;
end;
d.opref.resultat:= res;
signalch(d.opref.retur,opref,d.opref.optype);
\f
message procedure radio side 10 - 880930/cl;
end <* MONITERING *>
else
if opgave = 11 then <* GENNEMSTILLING *>
begin
nr:= d.opref.data(6) extract 20;
k:= if d.opref.data(5) shift (-20) = 12 then
d.opref.data(5) extract 20
else
0;
inspect(ss_samtale_nedlagt(nr),i);
if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
if i<>0 and j<>0 then
begin
res:= hookon(talevej,rad_op,cs_radio(talevej));
goto radio_nedlæg;
end;
iaf:= (nr-1)*kanal_beskr_længde;
if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
begin
if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
kanal_tab.iaf.kanal_tilstand extract 2 = 3
then
res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
else
if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
d.opref.data(5)<>0
then
res:= 0
else
res:= 21; <* ingen at gennemstille til *>
end
else
res:= 50; <* kanalnr *>
if res=0 then
res:= hookon(talevej,rad_op,cs_radio(talevej));
if res=0 then
begin
sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
kanal_tab.iaf.kanal_tilstand:=
kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
d.opref.data(6):= 0;
if kanal_tab.iaf.kanal_id2=0 then
kanal_tab.iaf.kanal_id2:= d.opref.data(5);
if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
begin <* gennemstillet til anden kanal *>
iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
*kanalbeskrlængde;
sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
kanal_tab.iaf1.kanal_tilstand:=
kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
if kanal_tab.iaf1.kanal_id2=0 then
kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
end;
d.opref.data(5):= 0;
res:= 3;
end;
d.opref.resultat:= res;
signalch(d.opref.retur,opref,d.opref.optype);
\f
message procedure radio side 11 - 880930/cl;
end
else
if opgave = 12 then <* NEDLÆG *>
begin
res:= hookon(talevej,rad_op,cs_radio(talevej));
radio_nedlæg:
if res=0 then
begin
for k:= 5, 6 do
begin
if d.opref.data(k) shift (-20) = 12 then
begin
i:= d.opref.data(k) extract 20;
iaf:= (i-1)*kanalbeskrlængde;
if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
frigiv_kanal(d.opref.data(k) extract 20)
else
sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
end
else
if d.opref.data(k) shift (-20) = 13 then
begin
for i:= 1 step 1 until max_antal_kanaler do
if læsbiti(d.opref.data(k),i) then
begin
iaf:= (i-1)*kanalbeskrlængde;
if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
frigiv_kanal(i)
else
sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
end;
sætbit_ia(kanalflag,operatør,1);
end;
end;
d.opref.data(5):= 0;
d.opref.data(6):= 0;
d.opref.data(9):= 0;
res:= if opgave=12 then 3 else 49;
end;
d.opref.resultat:= res;
signalch(d.opref.retur,opref,d.opref.optype);
end
else
if opgave=13 then <* R *>
begin
startoperation(rad_op,410+talevej,cs_radio(talevej),
'H' shift 12 + 60);
d.rad_op.data(1):= talevej;
d.rad_op.data(2):= 'M';
d.rad_op.data(3):= 0; <*tkt*>
d.rad_op.data(4):= 0; <*tkn*>
d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
signalch(cs_radio_ud,rad_op,rad_optype);
<*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
res:= d.rad_op.resultat;
d.opref.resultat:= if res=0 then 3 else res;
signalch(d.opref.retur,opref,d.opref.optype);
end
else
if opgave=14 <* VENTEPOS *> then
begin
res:= 0;
while (res<=3 and d.opref.data(2)>0) do
begin
nr:= d.opref.data(6) extract 20;
k:= if d.opref.data(5) shift (-20) = 12 then
d.opref.data(5) extract 20
else
0;
inspect(ss_samtale_nedlagt(nr),i);
if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
if i<>0 or j<>0 then
begin
res:= hookon(talevej,radop,cs_radio(talevej));
goto radio_nedlæg;
end;
res:= hookoff(talevej,radop,cs_radio(talevej),true);
if res=0 then
begin
i:= d.opref.data(5);
d.opref.data(5):= d.opref.data(6);
d.opref.data(6):= i;
res:= 3;
end;
d.opref.data(2):= d.opref.data(2)-1;
end;
d.opref.resultat:= res;
signalch(d.opref.retur,opref,d.opref.optype);
end
else
begin
fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
d.opref.resultat:= 31;
signalch(d.opref.retur,opref,d.opref.optype);
end;
end <* radiokommando fra operatør *>
else
begin
d.op_ref.resultat:= 45; <* ikke implementeret *>
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end;
until false;
radio_trap:
disable skriv_radio(zbillede,1);
end radio;
\f
message procedure radio_ind side 1 - 810521/hko;
procedure radio_ind(op);
value op;
integer op;
begin
integer array field op_ref,ref,io_opref;
integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
integer array typ, val(1:6), answ, tlgr(1:32);
integer array field spec;
real field rf;
long array field laf;
procedure skriv_radio_ind(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin integer ii;
disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
if omfang > 0 then
disable begin integer x; long array field tx;
tx:= 0;
trap(slut);
write(zud,"nl",1,
<: op-ref: :>,op_ref,"nl",1,
<: ref: :>,ref,"nl",1,
<: io-opref: :>,io_opref,"nl",1,
<: ac: :>,ac,"nl",1,
<: lgd: :>,lgd,"nl",1,
<: ttyp: :>,ttyp,"nl",1,
<: ptyp: :>,ptyp,"nl",1,
<: pnum: :>,pnum,"nl",1,
<: pos: :>,pos,"nl",1,
<: tegn: :>,tegn,"nl",1,
<: bs: :>,bs,"nl",1,
<: b-pt: :>,b_pt,"nl",1,
<: b-pn: :>,b_pn,"nl",1,
<: antal-sendt: :>,antal_sendt,"nl",1,
<: antal-spec: :>,antal_spec,"nl",1,
<: sum: :>,sum,"nl",1,
<: csum: :>,csum,"nl",1,
<: i: :>,i,"nl",1,
<: j: :>,j,"nl",1,
<: k: :>,k,"nl",1,
<: filref :>,filref,"nl",1,
<: zno: :>,zno,"nl",1,
<: answ: :>,answ.tx,"nl",1,
<: tlgr: :>,tlgr.tx,"nl",1,
<: spec: :>,spec,"nl",1);
trap(slut);
slut:
end; <*disable*>
end skriv_radio_ind;
\f
message procedure indsæt_opkald side 1 - 811105/hko;
integer procedure indsæt_opkald(bus,type,omr,sig);
value bus,type,omr,sig;
integer bus,type,omr,sig;
begin
integer res,tilst,ll,operatør;
integer array field vt_op,ref,næste,forrige;
real r;
res:= -1;
begin
<*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
if vt_op <> 0 then
begin
wait(bs_opkaldskø_adgang);
if omr>2 then
begin
start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
d.vt_op.data(1):= bus;
d.vt_op.data(4):= omr;
tilst:= vt_op;
signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
<*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
<*+4*> if tilst <> vt_op then
fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
<*-4*>
<*+2*> if testbit34 and overvåget then
disable begin
write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
skriv_op(out,vt_op);
ud;
end;
end
else
begin
d.vt_op.data(1):= bus;
d.vt_op.data(2):= 0;
d.vt_op.data(3):= bus;
d.vt_op.data(4):= omr;
d.vt_op.resultat:= 0;
ref:= første_nødopkald;
if ref<>0 then tilst:= 2
else
begin
ref:= første_opkald;
tilst:= if ref=0 then 0 else 1;
end;
if tilst=0 then
d.vt_op.resultat:= 3
else
begin
while ref<>0 and d.vt_op.resultat=0 do
begin
if opkaldskø.ref(2) extract 14 = bus and
opkaldskø.ref(5) extract 8 = omr
then
d.vt_op.resultat:= 18
else
begin
ref:= opkaldskø.ref(1) extract 12;
if ref=0 and tilst=2 then
begin
ref:= første_opkald;
tilst:= if ref=0 then 0 else 1;
end
else
if ref=0 then tilst:= 0;
end;
end;
if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
end;
end;
<*-2*>
\f
message procedure indsæt_opkald side 1a- 820301/hko;
if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
begin
ref:=første_opkald;
tilst:=-1;
while ref<>0 and tilst=-1 do
begin
if opkaldskø.ref(2) extract 14 = bus extract 14 then
begin <* udtag normalopkald *>
næste:=opkaldskø.ref(1);
forrige:=næste shift(-12);
næste:=næste extract 12;
if forrige<>0 then
opkaldskø.forrige(1):=
opkaldskø.forrige(1) shift(-12) shift 12 +næste
else
første_opkald:=næste;
if næste<>0 then
opkaldskø.næste(1):=
opkaldskø.næste(1) extract 12 + forrige shift 12
else
sidste_opkald:=forrige;
opkaldskø.ref(1):=første_frie_opkald;
første_frie_opkald:=ref;
opkaldskø_ledige:=opkaldskø_ledige +1;
tilst:=0;
end
else
ref:=opkaldskø.ref(1) extract 12;
end; <*while*>
if tilst=0 then
d.vt_op.resultat:=3;
end; <*nødopkald bus i kø*>
\f
message procedure indsæt_opkald side 2 - 820304/hko;
if d.vt_op.resultat = 3 then
begin
ll:= d.vt_op.data(2);
tilst:= d.vt_op.data(3);
læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
if operatør < 0 or max_antal_operatører < operatør then
operatør:= 0;
if operatør=0 then
operatør:= (tilst shift (-14) extract 8);
if operatør=0 then
operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
else sæt_bit_ia(opkaldsflag,operatør,1);
ref:= første_frie_opkald; <* forudsættes <> 0 *>
første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
forrige:= (if type = 1 then sidste_opkald
else sidste_nødopkald);
opkaldskø.ref(1):= forrige shift 12;
if type = 1 then
begin
if første_opkald = 0 then første_opkald:= ref;
sidste_opkald:= ref;
end
else
begin <*type = 2*>
if første_nødopkald = 0 then første_nødopkald:= ref;
sidste_nødopkald:= ref;
end;
if forrige <> 0 then
opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
shift 12 +ref;
opkaldskø.ref(2):= tilst extract 22 add
(if type=2 then 1 shift 23 else 0);
opkaldskø.ref(3):= ll;
systime(5,0.0,r);
ll:= round r//100;<*ttmm*>
opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
opkaldskø.ref(5):= sig shift 20 + omr;
tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
res:= 0;
if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
opkaldskø_ledige:= opkaldskø_ledige -1;
<*meddel opkald til berørte operatører *>
signal_bin(bs_mobil_opkald);
tæl_opkald(omr,type+1);
end <* resultat = 3 *>
else
begin
\f
message procedure indsæt_opkald side 3 - 810601/hko;
<* d.vt_op.resultat <> 3 *>
res:= d.vt_op.resultat;
if res = 10 then
fejlreaktion(20<*mobilopkald, bus *>,bus,
<:er ikke i bustabel:>,1)
else
<*+4*> if res <> 14 and res <> 18 then
fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
<*-4*>
;
end;
signalbin(bs_opkaldskø_adgang);
signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
end
else
res:= -2; <*timeout for cs_vt_adgang*>
end;
indsæt_opkald:= res;
end indsæt_opkald;
\f
message procedure afvent_telegram side 1 - 880901/cl;
integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
integer array tlgr;
integer lgd,ttyp,ptyp,pnum;
begin
integer i, pos, tegn, ac, sum, csum;
pos:= 1;
lgd:= 0;
ttyp:= 'Z';
<*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
if ac >= 0 then
begin
lgd:= 1;
while læstegn(tlgr,lgd,tegn)<>0 do ;
lgd:= lgd-2;
if lgd >= 3 then
begin
i:= 1;
ttyp:= læstegn(tlgr,i,tegn);
ptyp:= læstegn(tlgr,i,tegn) - '@';
pnum:= læstegn(tlgr,i,tegn) - '@';
end
else ac:= 6; <* for kort telegram - retransmitter *>
end;
afvent_telegram:= ac;
end;
\f
message procedure b_answ side 1 - 880901/cl;
procedure b_answ(answ,ht,spec,more,ac);
value ht, more,ac;
integer array answ, spec;
boolean more;
integer ht, ac;
begin
integer pos, i, sum, tegn;
pos:= 1;
skrivtegn(answ,pos,'B');
skrivtegn(answ,pos,if more then 'B' else ' ');
skrivtegn(answ,pos,ac+'@');
skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
skrivtegn(answ,pos,'@');
skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
skrivtegn(answ,pos,spec(1) extract 8+'@');
for i:= 1 step 1 until spec(1) extract 8 do
if spec(1+i)=0 then skrivtegn(answ,pos,'@')
else
begin
skrivtegn(answ,pos,'D');
anbringtal(answ,pos,spec(1+i),-4);
end;
for i:= 1 step 1 until 4 do
skrivtegn(answ,pos,'@');
skrivtegn(answ,pos,ht+'@');
skrivtegn(answ,pos,'@');
i:= 1; sum:= 0;
while i < pos do
sum:= (sum + læstegn(answ,i,tegn)) mod 256;
skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
skrivtegn(answ,pos,sum extract 4 + '@');
repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
end;
\f
message procedure ann_opkald side 1 - 881108/cl;
integer procedure ann_opkald(vogn,omr);
value vogn,omr;
integer vogn,omr;
begin
integer array field vt_op,ref,næste,forrige;
integer res, t, i, o;
waitch(cs_vt_adgang,vt_op,true,-1);
res:= -1;
wait(bs_opkaldskø_adgang);
ref:= første_nødopkald;
if ref <> 0 then
t:= 2
else
begin
ref:= første_opkald;
t:= if ref<>0 then 1 else 0;
end;
if t=0 then
res:= 19 <* kø tom *>
else
begin
while ref<>0 and res=(-1) do
begin
if vogn=opkaldskø.ref(2) extract 14 and
omr=opkaldskø.ref(5) extract 8
then
res:= 0
else
begin
ref:= opkaldskø.ref(1) extract 12;
if ref=0 and t=2 then
begin
ref:= første_opkald;
t:= if ref=0 then 0 else 1;
end;
end;
end; <*while*>
\f
message procedure ann_opkald side 2 - 881108/cl;
if ref<>0 then
begin
start_operation(vt_op,401,cs_radio_ind,17);
d.vt_op.data(1):= vogn;
d.vt_op.data(4):= omr;
signalch(cs_vt,vt_op,gen_optype or vt_optype);
waitch(cs_radio_ind,vt_op,vt_optype,-1);
o:= opkaldskø.ref(4) extract 8;
næste:= opkaldskø.ref(1);
forrige:= næste shift (-12);
næste:= næste extract 12;
if forrige<>0 then
opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
+ næste
else
if t=2 then første_nødopkald:= næste
else første_opkald:= næste;
if næste<>0 then
opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
+ forrige shift 12
else
if t=2 then sidste_nødopkald:= forrige
else sidste_opkald:= forrige;
opkaldskø.ref(1):= første_frie_opkald;
første_frie_opkald:= ref;
opkaldskø_ledige:= opkaldskø_ledige + 1;
if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
if -, læsbit_ia(operatør_maske,o) or o=0 then
tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
else
begin
sætbit_ia(opkaldsflag,o,1);
end;
signalbin(bs_mobilopkald);
end;
end;
signalbin(bs_opkaldskø_adgang);
signalch(cs_vt_adgang, vt_op, true);
ann_opkald:= res;
end;
\f
message procedure frigiv_id side 1 - 881114/cl;
integer procedure frigiv_id(id,omr);
value id,omr;
integer id,omr;
begin
integer array field vt_op;
if id shift (-22) < 3 and omr > 2 then
begin
waitch(cs_vt_adgang,vt_op,true,-1);
start_operation(vt_op,401,cs_radio_ind,
if id shift (-22) = 2 then 18 else 17);
d.vt_op.data(1):= id;
d.vt_op.data(4):= omr;
signalch(cs_vt,vt_op,vt_optype or gen_optype);
waitch(cs_radio_ind,vt_op,vt_optype,-1);
frigiv_id:= d.vt_op.resultat;
signalch(cs_vt_adgang,vt_op,true);
end;
end;
\f
message procedure radio_ind side 2 - 810524/hko;
trap(radio_ind_trap);
laf:= 0;
stack_claim((if cm_test then 200 else 150) +135+75);
<*+2*>if testbit32 and overvåget or testbit28 then
skriv_radio_ind(out,0);
<*-2*>
answ.laf(1):= long<:<'nl'>:>;
io_opref:= op;
repeat
ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
pos:= 4;
if ac = 0 then
begin
\f
message procedure radio_ind side 3 - 881107/cl;
if ttyp = 'A' then
begin
if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
ac:= 1
else
begin
typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
val(1):= ttyp;
typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
val(2):= pnum;
typ(3):= -1;
getch(cs_radio_ind,opref,rad_optype,typ,val);
if opref>0 then
begin
if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
then
begin
ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
end
else
begin
ac:= 0;
d.opref.resultat:= 0;
sætbit_ia(hookoff_maske,pnum,1);
end;
signalch(d.opref.retur,opref,d.opref.optype);
end
else
ac:= 2;
end;
pos:= 1;
skrivtegn(answ,pos,'A');
skrivtegn(answ,pos,' ');
skrivtegn(answ,pos,ac+'@');
for i:= 1 step 1 until 5 do
skrivtegn(answ,pos,'@');
skrivtegn(answ,pos,'0');
i:= 1; sum:= 0;
while i < pos do
sum:= (sum + læstegn(answ,i,tegn)) mod 256;
skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
skrivtegn(answ,pos,sum extract 4 + '@');
repeat afsluttext(answ,pos) until pos mod 6 = 1;
write(z_fr_out,"nl",1,answ.laf,"cr",1);
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
disable setposition(z_fr_out,0,0);
ac:= -1;
\f
message procedure radio_ind side 4 - 881107/cl;
end <* ttyp=A *>
else
if ttyp = 'B' then
begin
if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
ac:= 1
else
begin
typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
typ(3):= -1;
getch(cs_radio_ind,opref,rad_optype,typ,val);
if opref > 0 then
begin
<*+2*> if testbit37 and overvåget then
disable begin
skriv_radio_ind(out,0);
write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
skriv_op(out,opref);
end;
<*-2*>
læstegn(tlgr,pos,bs);
if bs = 'V' then
begin
b_pt:= læstegn(tlgr,pos,tegn) - '@';
b_pn:= læstegn(tlgr,pos,tegn) - '@';
end;
if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
(b_pt<>d.opref.data(10) shift (-18) extract 6 or
b_pn<>d.opref.data(10) shift (-12) extract 6)
then
begin
ac:= 1;
d.opref.resultat:= 31; <* systemfejl *>
signalch(d.opref.retur,opref,d.opref.optype);
end
else
if bs='V' then
begin
ac:= 0;
d.opref.resultat:= 1;
d.opref.data(4):= 0;
d.opref.data(7):=
1 shift (if b_pt=2 then pabx_id(b_pn) else
radio_id(b_pn));
systime(1,0.0,d.opref.tid);
signalch(cs_radio_ind,opref,d.opref.optype);
spec:= data+18;
b_answ(answ,0,d.opref.spec,false,ac);
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
\f
message procedure radio_ind side 5 - 881107/cl;
end
else
begin
integer sig_type;
ac:= 0;
antal_spec:= d.opref.data(4);
filref:= d.opref.data(5);
spec:= d.opref.data(6);
if antal_spec>0 then
begin
antal_spec:= antal_spec-1;
if filref<>0 then
begin
læsfil(filref,1,zno);
b_pt:= fil(zno).spec(1) shift (-12);
sig_type:= fil(zno).spec(1) shift (-8) extract 4;
b_answ(answ,d.opref.data(3),fil(zno).spec,
antal_spec>0,ac);
spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
end
else
begin
b_pt:= d.opref.spec(1) shift (-12);
sig_type:= d.opref.spec(1) shift (-8) extract 4;
b_answ(answ,d.opref.data(3),d.opref.spec,
antal_spec>0,ac);
spec:= spec + d.opref.spec(1) extract 8*2 + 2;
end;
<* send answer *>
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
if ac<>0 then
begin
antal_spec:= 0;
ac:= -1;
end
else
begin
for i:= 1 step 1 until max_antal_områder do
if område_id(i,2)=b_pt then
begin
j:= (if b_pt=3 and sig_type=2 then 0 else i);
if sætbiti(d.opref.data(7),j,1)=0 then
d.opref.resultat:= d.opref.resultat + 1;
end;
end;
end;
\f
message procedure radio_ind side 6 - 881107/cl;
<* afvent nyt telegram *>
d.opref.data(4):= antal_spec;
d.opref.data(6):= spec;
ac:= -1;
systime(1,0.0,d.opref.tid);
<*+2*> if testbit37 and overvåget then
disable begin
skriv_radio_ind(out,0);
write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
ud;
end;
<*-2*>
signalch(cs_radio_ind,opref,d.opref.optype);
end;
end
else ac:= 2;
end;
if ac > 0 then
begin
for i:= 1 step 1 until 6 do val(i):= 0;
b_answ(answ,0,val,false,ac);
<*+2*>
if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
end;
\f
message procedure radio_ind side 7 - 881107/cl;
end <* ttyp = 'B' *>
else
if ttyp='C' or ttyp='J' then
begin
if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
ac:= 1
else
begin
typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
typ(3):= -1;
getch(cs_radio_ind,opref,rad_optype,typ,val);
if opref > 0 then
begin
d.opref.resultat:= d.opref.resultat - 1;
if ttyp = 'C' then
begin
b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
j:= 0;
for i:= 1 step 1 until max_antal_kanaler do
if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
if kanal_til_omr(j)=3 and d.opref.resultat>0 then
d.opref.resultat:= d.opref.resultat-1;
sætbiti(optaget_flag,j,1);
sætbiti(d.opref.data(9),j,1);
end
else
begin <* INGEN FORBINDELSE *>
sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
end;
ac:= 0;
if d.opref.resultat<>0 or d.opref.data(4)<>0 then
begin
systime(1,0,d.opref.tid);
signal_ch(cs_radio_ind,opref,d.opref.op_type);
end
else
begin
d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
if læsbiti(d.opref.data(8),9) then 52 else
if læsbiti(d.opref.data(8),10) then 20 else
if læsbiti(d.opref.data(8),2) then 52 else 59;
signalch(d.opref.retur, opref, d.opref.optype);
end;
end
else
ac:= 2;
end;
pos:= 1;
skrivtegn(answ,pos,ttyp);
skrivtegn(answ,pos,' ');
skrivtegn(answ,pos,ac+'@');
i:= 1; sum:= 0;
while i < pos do
sum:= (sum + læstegn(answ,i,tegn)) mod 256;
skrivtegn(answ,pos,sum shift (-4) + '@');
skrivtegn(answ,pos,sum extract 4 + '@');
repeat afsluttext(answ,pos) until pos mod 6 = 1;
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
\f
message procedure radio_ind side 8 - 881107/cl;
end <* ttyp = 'C' or 'J' *>
else
if ttyp = 'D' then
begin
if ptyp = 4 <* VDU *> then
begin
if pnum<1 or pnum>max_antal_taleveje then
ac:= 1
else
begin
inspect(bs_talevej_udkoblet(pnum),j);
if j>=0 then
begin
sætbit_ia(samtaleflag,pnum,1);
signal_bin(bs_mobil_opkald);
end;
if læsbit_ia(hookoff_maske,pnum) then
signalbin(bs_talevej_udkoblet(pnum));
ac:= 0;
end
end
else
if ptyp=3 or ptyp=2 then
begin
if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
ptyp=2 and pnum<>2
then
ac:= 1
else
begin
if læstegn(tlgr,5,tegn)='D' then
begin <* teknisk nr i telegram *>
b_pn:= 0;
for i:= 1 step 1 until 4 do
b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
end
else
b_pn:= 0;
b_pt:= port_til_omr(ptyp shift 6 + pnum);
i:= 0;
for j:= 1 step 1 until max_antal_kanaler do
if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
if i<>0 then
begin
ref:= (i-1)*kanalbeskrlængde;
inspect(ss_samtale_nedlagt(i),j);
if j>=0 then
begin
sætbit_ia(samtaleflag,
tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
signalbin(bs_mobil_opkald);
end;
signal(ss_samtale_nedlagt(i));
if b_pn<>0 then frigiv_id(b_pn,b_pt);
begin
if kanal_tab.ref.kanal_id1<>0 and
(kanal_tab.ref.kanal_id1 shift (-22)<>0 or
kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
if kanal_tab.ref.kanal_id2<>0 and
(kanal_tab.ref.kanal_id2 shift (-22)<>0 or
kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
end;
sætbiti(optaget_flag,i,0);
end;
ac:= 0;
end;
end
else ac:= 1;
if ac>=0 then
begin
pos:= i:= 1; sum:= 0;
skrivtegn(answ,pos,'D');
skrivtegn(answ,pos,' ');
skrivtegn(answ,pos,ac+'@');
skrivtegn(answ,pos,'@');
while i<pos do
sum:= (sum + læstegn(answ,i,tegn)) mod 256;
skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
skrivtegn(answ,pos, sum extract 4 + '@');
repeat afsluttext(answ,pos) until pos mod 6 = 1;
<*+2*>
if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
end;
\f
message procedure radio_ind side 9 - 881107/cl;
end <* ttyp = D *>
else
if ttyp='H' then
begin
integer htyp;
htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
if htyp='A' then
begin <*mobilopkald*>
if (ptyp=2 and pnum<>2) or (ptyp=3 and
(pnum<1 or pnum>max_antal_radiokanaler)) then
ac:= 1
else
begin
b_pt:= læstegn(tlgr,5,tegn)-'@';
if læstegn(tlgr,6,tegn)='D' then
begin <*teknisk nr. i telegram*>
b_pn:= 0;
for i:= 1 step 1 until 4 do
b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
end
else b_pn:= 0;
bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
<* opkaldstype *>
j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
if j>0 then
begin
if bs=10 then
ann_opkald(b_pn,j)
else
indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
ac:= 0;
end else ac:= 1;
end;
\f
message procedure radio_ind side 10 - 881107/cl;
end
else
if htyp='E' then
begin <* radiokanal status *>
long onavn;
ac:= 0;
j:= 0;
for i:= 1 step 1 until max_antal_kanaler do
if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
<* Alarmer for K12 = GLX ignoreres *>
<* 94.06.14/CL *>
<* Alarmer for K15 = HG ignoreres *>
<* 95.07.31/CL *>
<* Alarmer for K10 = FS ignoreres *>
<* 96.05.27/CL *>
if j>0 then
begin
onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
(onavn = long<:FS:>) then 0 else j);
end;
læstegn(tlgr,9,tegn);
if j<>0 and (tegn='A' or tegn='E') then
begin
ref:= (j-1)*kanalbeskrlængde;
bs:= if tegn='E' then 0 else 15;
if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
begin
tofrom(kanalflag,alle_operatører,op_maske_lgd);
signalbin(bs_mobil_opkald);
end;
end;
if tegn<>'A' and tegn<>'E' and j<>0 then
begin
waitch(cs_radio_pulje,opref,true,-1);
startoperation(opref,401,cs_radio_pulje,23);
i:= 1;
hægtstring(d.opref.data,i,<:radiofejl :>);
if læstegn(tlgr,4,k)<>'@' then
begin
if k-'@' = 17 then
hægtstring(d.opref.data,i,<: AMV:>)
else
if k-'@' = 18 then
hægtstring(d.opref.data,i,<: BHV:>)
else
begin
hægtstring(d.opref.data,i,<: BST:>);
anbringtal(d.opref.data,i,k-'@',1);
end;
end;
skrivtegn(d.opref.data,i,' ');
hægtstring(d.opref.data,i,string kanal_navn(j));
skrivtegn(d.opref.data,i,' ');
hægtstring(d.opref.data,i,
string område_navn(kanal_til_omr(j)));
if '@'<=tegn and tegn<='F' then
hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
<*@*> <:: ukendt fejl:>,
<*A*> <:: compad-fejl:>,
<*B*> <:: ladefejl:>,
<*C*> <:: dør åben:>,
<*D*> <:: senderfejl:>,
<*E*> <:: compad ok:>,
<*F*> <:: liniefejl:>,
<::>))
else
begin
hægtstring(d.opref.data,i,<:: fejlkode :>);
skrivtegn(d.opref.data,i,tegn);
end;
repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
signalch(cs_io,opref,gen_optype or rad_optype);
ref:= (j-1)*kanalbeskrlængde;
tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
tofrom(kanalflag,alle_operatører,op_maske_lgd);
signalbin(bs_mobilopkald);
end;
\f
message procedure radio_ind side 11 - 881107/cl;
end
else
if htyp='G' then
begin <* fjerninkludering/-ekskludering af område *>
bs:= læstegn(tlgr,9,tegn)-'@';
j:= 0;
for i:= 1 step 1 until max_antal_kanaler do
if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
if j<>0 then
begin
ref:= (j-1)*kanalbeskrlængde;
sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
end;
tofrom(kanalflag,alle_operatører,op_maske_lgd);
signalbin(bs_mobilopkald);
ac:= 0;
end
else
if htyp='L' then
begin <* vogntabelændringer *>
long field ll;
ll:= 10;
ac:= 0;
zno:= port_til_omr(ptyp shift 6 + pnum);
læstegn(tlgr,9,tegn);
if (tegn='N') or (tegn='O') then
begin
typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
typ(2):= -1;
getch(cs_radio_ind,opref,rad_optype,typ,val);
if opref>0 then
begin
d.opref.resultat:= if tegn='N' then 3 else 60;
signalch(d.opref.retur,opref,d.opref.optype);
end;
ac:= -1;
end
else
if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
ac:= -1
else
if tegn='G' then <*indkodning*>
begin
pos:= 10; i:= 0;
while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
i:= i*10 + (tegn-'0');
i:= i mod 1000;
b_pn:= (1 shift 22) + (i shift 12);
if pos=14 and 'A'<=tegn and tegn<='Å' then
b_pn:= b_pn + ((tegn-'@') shift 7);
pos:= 14; i:= 0;
while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
i:= i*10 + (tegn-'0');
b_pn:= b_pn + i;
pos:= 16; i:= 0;
while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
i:= i*10 + (tegn-'0');
b_pt:= i;
bs:= 11;
\f
message procedure radio_ind side 12 - 881107/cl;
end
else
if tegn='H' then <*udkodning*>
begin
pos:= 10; i:= 0;
while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
i:= i*10 + (tegn-'0');
b_pt:= i;
b_pn:= 0;
bs:= 12;
end
else
if tegn='I' then <*slet tabel*>
begin
b_pt:= 1; b_pn:= 999; bs:= 19;
pos:= 10; i:= 0;
i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
hex_to_dec(læstegn(tlgr,pos,tegn));
zno:= i;
end
else ac:= 2;
if ac<0 then
ac:= 0
else
if ac=0 then
begin
waitch(cs_vt_adgang,opref,true,-1);
startoperation(opref,401,cs_vt_adgang,bs);
d.opref.data(1):= b_pt;
d.opref.data(2):= b_pn;
d.opref.data(if bs=19 then 3 else 4):= zno;
signalch(cs_vt,opref,gen_optype or vt_optype);
end;
end
else
ac:= 2;
pos:= 1;
skrivtegn(answ,pos,'H');
skrivtegn(answ,pos,' ');
skrivtegn(answ,pos,ac+'@');
i:= 1; sum:= 0;
while i < pos do
sum:= (sum + læstegn(answ,i,tegn)) mod 256;
skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
skriv_tegn(answ,pos, sum extract 4 +'@');
repeat afsluttext(answ,pos) until pos mod 6 = 1;
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
\f
message procedure radio_ind side 13 - 881107/cl;
end
else
if ttyp = 'I' then
begin
typ(1):= -1;
repeat
getch(cs_radio_ind,opref,true,typ,val);
if opref<>0 then
begin
d.opref.resultat:= 31;
signalch(d.opref.retur,opref,d.opref.op_type);
end;
until opref=0;
for i:= 1 step 1 until max_antal_taleveje do
if læsbit_ia(hookoff_maske,i) then
begin
signalbin(bs_talevej_udkoblet(i));
sætbit_ia(samtaleflag,tv_operatør(i),1);
end;
if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
signal_bin(bs_mobil_opkald);
for i:= 1 step 1 until max_antal_kanaler do
begin
ref:= (i-1)*kanalbeskrlængde;
if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
begin
if kanal_tab.ref.kanal_id2<>0 and
kanal_tab.ref.kanal_id2 shift (-22)<>3
then
begin
signal(ss_samtale_nedlagt(i));
frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
end;
if kanal_tab.ref.kanal_id1<>0 then
begin
signal(ss_samtale_nedlagt(i));
frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
end;
end;
sæt_hex_ciffer(kanal_tab.ref,3,15);
end;
<*V*> waitch(cs_radio_pulje,opref,true,-1);
startoperation(opref,401,cs_radio_pulje,23);
i:= 1;
hægtstring(d.opref.data,i,<:radio-info: :>);
j:= 4;
while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
begin
skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
end;
repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
signalch(cs_io,opref,gen_optype or rad_optype);
optaget_flag:= 0;
pos:= i:= 1; sum:= 0;
skrivtegn(answ,pos,'I');
skrivtegn(answ,pos,' ');
skrivtegn(answ,pos,'@');
while i<pos do
sum:= (sum+læstegn(answ,i,tegn)) mod 256;
skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
skrivtegn(answ,pos,sum extract 4 + '@');
repeat afsluttext(answ,pos) until pos mod 6 = 1;
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
\f
message procedure radio_ind side 14 - 881107/cl;
end
else
if ttyp='L' then
begin
ac:= 0;
<****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
if testbit21 then
begin
waitch(cs_radio_pulje,opref,true,-1);
startoperation(opref,401,cs_radio_pulje,23);
i:= 1;
hægtstring(d.opref.data,i,<:radio-info: :>);
j:= 4;
while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
begin
skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
end;
repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
signalch(cs_io,opref,gen_optype or rad_optype);
end; <*testbit21*>
end
else
if ttyp='Z' then
begin
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
end
else
ac:= 1;
end; <* telegram modtaget ok *>
\f
message procedure radio_ind side 15 - 881107/cl;
if ac>=0 then
begin
pos:= i:= 1; sum:= 0;
skrivtegn(answ,pos,ttyp);
skrivtegn(answ,pos,' ');
skrivtegn(answ,pos,ac+'@');
while i<pos do
sum:= (sum+læstegn(answ,i,tegn)) mod 256;
skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
skrivtegn(answ,pos, sum extract 4 + '@');
repeat afsluttext(answ,pos) until pos mod 6 = 1;
<*+2*> if (testbit36 or testbit38) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
outchar(zrl,'nl');
end;
<*-2*>
write(z_fr_out,"nl",1,answ.laf,"cr",1);
disable setposition(z_fr_out,0,0);
ac:= -1;
end;
typ(1):= 0;
typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
rf:= 4;
systime(1,0.0,val.rf);
val.rf:= val.rf - 30.0;
typ(3):= -1;
repeat
getch(cs_radio_ind,opref,true,typ,val);
if opref>0 then
begin
d.opref.resultat:= 53; <*annuleret*>
signalch(d.opref.retur,opref,d.opref.optype);
end;
until opref=0;
until false;
radio_ind_trap:
disable skriv_radio_ind(zbillede,1);
end radio_ind;
\f
message procedure radio_ud side 1 - 820301/hko;
procedure radio_ud(op);
value op;
integer op;
begin
integer array field opref,io_opref;
integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
integer array answ, tlgr(1:32);
long array field laf;
procedure skriv_radio_ud(z,omfang);
value omfang;
zone z;
integer omfang;
begin integer i1;
disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
if omfang > 0 then
disable begin real x; long array field tx;
tx:= 0;
trap(slut);
write(z,"nl",1,
<: opref: :>,opref,"nl",1,
<: io-opref: :>,io_opref,"nl",1,
<: opgave: :>,opgave,"nl",1,
<: kode: :>,kode,"nl",1,
<: pos: :>,pos,"nl",1,
<: tegn: :>,tegn,"nl",1,
<: i: :>,i,"nl",1,
<: sum: :>,sum,"nl",1,
<: rc: :>,rc,"nl",1,
<: svar-status: :>,svar_status,"nl",1,
<: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
<: answ: ":>,answ.tx,<:":>,"nl",1,
<::>);
skriv_coru(z,coru_no(402));
slut:
end; <*disable*>
end skriv_radio_ud;
trap(radio_ud_trap);
laf:= 0;
stack_claim((if cm_test then 200 else 150) +35+100);
<*+2*>if testbit32 and overvåget or testbit28 then
skriv_radio_ud(out,0);
<*-2*>
io_opref:= op;
\f
message procedure radio_ud side 2 - 810529/hko;
repeat
<*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
kode:= d.op_ref.opkode;
opgave:= kode shift(-12);
kode:= kode extract 12;
if opgave < 'A' or opgave > 'I' then
begin
d.opref.resultat:= 31;
end
else
begin
pos:= 1;
if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
begin
skrivtegn(tlgr,pos,opgave);
if d.opref.data(1) = 0 then
begin
skrivtegn(tlgr,pos,'G');
skrivtegn(tlgr,pos,'A');
end
else
begin
skrivtegn(tlgr,pos,'D');
skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
end;
if opgave='A' then
begin
skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
end
else
if opgave='B' then
begin
skrivtegn(tlgr,pos,d.opref.data(2));
if d.opref.data(2)='V' then
begin
skrivtegn(tlgr,pos,
d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
skrivtegn(tlgr,pos,
d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
end;
d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
end
else
if opgave='H' then
begin
skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
hægtstring(tlgr,pos,<:@@@:>);
skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
skrivtegn(tlgr,pos,'A');
skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
if d.opref.data(2)='L' then
begin
if d.opref.data(5)=7 then
begin
anbringtal(tlgr,pos,
d.opref.data(8) shift (-12) extract 10,-4);
anbringtal(tlgr,pos,
d.opref.data(8) extract 7,-2);
end
else
if d.opref.data(5)=8 then
begin
hægtstring(tlgr,pos,<:FFFFFF:>);
end;
if d.opref.data(5)<>9 then
anbringtal(tlgr,pos,d.opref.data(7),-4);
skrivtegn(tlgr,pos,
dec_to_hex(d.opref.data(6) shift (-4) extract 4));
skrivtegn(tlgr,pos,
dec_to_hex(d.opref.data(6) extract 4));
skrivtegn(tlgr,10,pos-11+'@');
end;
end;
end
else
if opgave='I' then
begin
hægtstring(tlgr,pos,<:IGA:>);
end
else d.opref.resultat:= 31; <*systemfejl*>
end;
\f
message procedure radio_ud side 3 - 881107/cl;
if d.opref.resultat=0 then
begin
if (opgave <= 'B')
<* or (opgave='H' and d.opref.data(2)='L') *> then
begin
systime(1,0,d.opref.tid);
signalch(cs_radio_ind,opref,d.opref.optype);
opref:= 0;
end;
<* beregn checksum og send *>
i:= 1; sum:= 0;
while i < pos do
sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
skrivtegn(tlgr,pos,sum shift (-4) + '@');
skrivtegn(tlgr,pos,sum extract 4 + '@');
repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
<**********************************************>
<* specialaktion p.g.a. modtagebesvær i COMET *>
if opgave='B' then delay(1);
<* 94.04.19/cl *>
<**********************************************>
<*+2*> if (testbit36 or testbit39) and overvåget then
disable begin
write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
outchar(zrl,'nl');
end;
<*-2*>
setposition(z_rf_in,0,0);
write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
disable setposition(z_rf_out,0,0);
rc:= 0;
<* afvent svar*>
repeat
<*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
if svar_status=6 then
begin
svar_status:= -3;
goto radio_ud_check;
end;
pos:= 1;
while læstegn(answ,pos,i)<>0 do ;
pos:= pos-2;
if pos > 0 then
begin
if pos<3 then
svar_status:= -2 <*format error*>
else
begin
if læstegn(answ,3,tegn)<>'@' then
svar_status:= tegn - '@'
else
begin
pos:= 1;
læstegn(answ,pos,tegn);
if tegn<>opgave then
svar_status:= -4 <*gal type*>
else
if læstegn(answ,pos,tegn)<>' ' then
svar_status:= -tegn <*fejl*>
else
svar_status:= læstegn(answ,pos,tegn)-'@';
end;
end;
end
else
svar_status:= -1;
\f
message procedure radio_ud side 5 - 881107/cl;
radio_ud_check:
rc:= rc+1;
if -3<=svar_status and svar_status< -1 then
disable begin
write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
setposition(z_rf_out,0,0);
<*+2*> if (testbit36 or testbit39) and overvåget then
begin
write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
outchar(zrl,'nl');
end;
<*-2*>
end
else
if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
disable begin
write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
setposition(z_rf_out,0,0);
<*+2*> if (testbit36 or testbit39) and overvåget then
begin
write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
end;
<*-2*>
end
else
if svar_status=0 and opref<>0 then
d.opref.resultat:= 0
else
if opref<>0 then
d.opref.resultat:= 31;
until svar_status=0 or rc>3;
end;
if opref<>0 then
begin
if svar_status<>0 and rc>3 then
d.opref.resultat:= 53; <* annulleret *>
signalch(d.opref.retur,opref,d.opref.optype);
opref:= 0;
end;
until false;
radio_ud_trap:
disable skriv_radio_ud(zbillede,1);
end radio_ud;
\f
message procedure radio_medd_opkald side 1 - 810610/hko;
procedure radio_medd_opkald;
begin
integer array field ref,op_ref;
integer i;
procedure skriv_radio_medd_opkald(z,omfang);
value omfang;
zone z;
integer omfang;
begin integer x;
disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
write(z,"sp",26-x);
if omfang > 0 then
disable begin
trap(slut);
write(z,"nl",1,
<: ref: :>,ref,"nl",1,
<: opref: :>,op_ref,"nl",1,
<: i: :>,i,"nl",1,
<::>);
skriv_coru(z,abs curr_coruno);
slut:
end;<*disable*>
end skriv_radio_medd_opkald;
trap(radio_medd_opkald_trap);
stack_claim((if cm_test then 200 else 150) +1);
<*+2*>if testbit32 and overvåget or testbit28 then
disable skriv_radio_medd_opkald(out,0);
<*-2*>
\f
message procedure radio_medd_opkald side 2 - 820301/hko;
repeat
<*V*> wait(bs_mobil_opkald);
<*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
<*V*> wait(bs_opkaldskø_adgang);
ref:= første_nød_opkald;
while ref <> 0 do <* meld ikke meldt nødopkald til io *>
begin
i:= opkaldskø.ref(2);
if i < 0 then
begin
<* nødopkald ikke meldt *>
start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
d.op_ref.data(1):= <* vogn_id *>
if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
opkaldskø.ref(2):= i extract 22;
d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
i:= op_ref;
<*+2*> if testbit35 and overvåget then
disable begin
write(out,"nl",1,<:radio nød-medd:>);
skriv_op(out,op_ref);
ud;
end;
<*-2*>
signal_ch(cs_io,op_ref,gen_optype or rad_optype);
<*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
<*+4*> if i <> op_ref then
fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
<*-4*>
end;<*nødopkald ikke meldt*>
ref:= opkaldskø.ref(1) extract 12;
end; <* melding til io *>
\f
message procedure radio_medd_opkald side 3 - 820304/hko;
start_operation(op_ref,403,cs_radio_medd,
40<*opdater opkaldskøbill*>);
signal_bin(bs_opkaldskø_adgang);
<*+2*> if testbit35 and overvåget then
disable begin
write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
skriv_op(out,op_ref);
write(out, <:opkaldsflag: :>,"nl",1);
outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
write(out,"nl",1,<:kanalflag: :>,"nl",1);
outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
write(out,"nl",1,<:samtaleflag: :>,"nl",1);
outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
ud;
end;
<*-2*>
signal_ch(cs_op,op_ref,gen_optype or rad_optype);
until false;
radio_medd_opkald_trap:
disable skriv_radio_medd_opkald(zbillede,1);
end radio_medd_opkald;
\f
message procedure radio_adm side 1 - 820301/hko;
procedure radio_adm(op);
value op;
integer op;
begin
integer array field opref, rad_op, iaf;
integer nr,i,j,k,res,opgave,tilst,operatør;
procedure skriv_radio_adm(z,omfang);
value omfang;
zone z;
integer omfang;
begin integer i1;
disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
write(z,"sp",26-i1);
if omfang > 0 then
disable begin real x;
trap(slut);
\f
message procedure radio_adm side 2- 820301/hko;
write(z,"nl",1,
<: op_ref: :>,op_ref,"nl",1,
<: iaf: :>,iaf,"nl",1,
<: rad-op: :>,rad_op,"nl",1,
<: nr: :>,nr,"nl",1,
<: i: :>,i,"nl",1,
<: j: :>,j,"nl",1,
<: k: :>,k,"nl",1,
<: tilst: :>,tilst,"nl",1,
<: res: :>,res,"nl",1,
<: opgave: :>,opgave,"nl",1,
<: operatør: :>,operatør,"nl",1);
skriv_coru(z,coru_no(404));
slut:
end;<*disable*>
end skriv_radio_adm;
\f
message procedure radio_adm side 3 - 820304/hko;
rad_op:= op;
trap(radio_adm_trap);
stack_claim((if cm_test then 200 else 150) +50);
<*+2*>if testbit32 and overvåget or testbit28 then
skriv_radio_adm(out,0);
<*-2*>
pass;
if -,testbit22 then
begin
startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
signalch(cs_radio_ud,rad_op,rad_optype);
waitch(cs_radio_adm,rad_op,rad_optype,-1);
end;
repeat
waitch(cs_radio_adm,opref,true,-1);
<*+2*>
if testbit33 and overvåget then
disable begin
skriv_radio_adm(out,0);
write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
skriv_op(out,opref);
end;
<*-2*>
k:= d.op_ref.opkode extract 12;
opgave:= d.opref.opkode shift (-12);
nr:=operatør:=d.op_ref.data(1);
<*+4*> if (d.op_ref.optype and
(gen_optype or io_optype or op_optype or vt_optype))
extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
<:radio_adm:>,0);
<*-4*>
if k = 74 <* RA,I *> then
begin
startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
signalch(cs_radio_ud,rad_op,rad_optype);
waitch(cs_radio_adm,rad_op,rad_optype,-1);
d.opref.resultat:= if d.rad_op.resultat=0 then 3
else d.rad_op.resultat;
signalch(d.opref.retur,opref,d.opref.optype);
\f
message procedure radio_adm side 4 - 820301/hko;
end
else
if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
k = 5<*FO,L*> or k = 6<*ST *> then
begin
if k = 5 or k=77 then
begin
<*V*> wait(bs_opkaldskø_adgang);
if k=5 then
begin
disable for iaf:= 0 step 512 until (max_linienr//768*512) do
begin
i:= læs_fil(1035,iaf//512+1,nr);
if i <> 0 then
fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
tofrom(radio_linietabel.iaf,fil(nr),
if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
end;
for i:= 1 step 1 until max_antal_mobilopkald do
begin
iaf:= i*opkaldskø_postlængde;
nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
if nr>0 then
begin
læs_tegn(radio_linietabel,nr+1,operatør);
if operatør>max_antal_operatører then operatør:= 0;
opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
operatør;
end;
end;
end
else
if k=77 then
begin
disable i:= læsfil(1034,1,nr);
if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
for i:= 1 step 1 until max_antal_mobilopkald do
begin
iaf:= i*opkaldskø_postlængde;
nr:= opkaldskø.iaf(5) extract 4;
operatør:= radio_områdetabel(nr);
if operatør < 0 or max_antal_operatører < operatør then
operatør:= 0;
if opkaldskø.iaf(4) extract 8=0 and
opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
operatør;
end;
end;
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
signal_bin(bs_opkaldskø_adgang);
signal_bin(bs_mobil_opkald);
d.op_ref.resultat:= res:= 3;
\f
message procedure radio_adm side 5 - 820304/hko;
end <*k = 5 / k = 77*>
else
begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
res:= 3;
for nr:= 1 step 1 until max_antal_kanaler do
begin
iaf:= (nr-1)*kanal_beskr_længde;
if kanal_tab.iaf.kanal_tilstand shift (-16) =
op_talevej(operatør) then
begin
tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
if tilst <> 0 then
res:= 16; <*skærm optaget*>
end; <* kanal_tab(operatør) = operatør*>
end;
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
sæt_bit_ia(opkaldsflag,operatør,k extract 1);
signal_bin(bs_mobil_opkald);
d.op_ref.resultat:= res;
end;<*k=1,2 eller 6 *>
<*+2*> if testbit35 and overvåget then
disable begin
skriv_radio_adm(out,0);
write(out,<: sender til :>,
if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
else cs_op);
skriv_op(out,op_ref);
end;
<*-2*>
if k=5 or k=6 or k=77 or res > 3 then
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
else
begin <*k = (1 eller 2) og res = 3 *>
d.op_ref.resultat:=0;
signal_ch(cs_op,op_ref,d.op_ref.optype);
end;
\f
message procedure radio_adm side 6 - 816610/hko;
end <*k=1,2,5 eller 6*>
else
if k=3 <*IN,R*> or k=4 <*EK,R*> then
begin
nr:= d.op_ref.data(1);
res:= 3;
if nr<=3 then
res:= 51 <* afvist *>
else
begin
<* gennemstilling af område *>
j:= 1;
for i:= 1 step 1 until max_antal_kanaler do
begin
if kanal_id(i) shift (-5) extract 3 = 3 and
radio_id(kanal_id(i) extract 5) = nr then j:= i;
end;
nr:= j;
iaf:= (nr-1)*kanalbeskrlængde;
if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
begin
startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
d.rad_op.data(1):= 0;
d.rad_op.data(2):= 'G'; <* gennemstil område *>
d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
d.rad_op.data(4):= kanal_id(nr) extract 5;
d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
signalch(cs_radio_ud,rad_op,rad_optype);
waitch(cs_radio_adm,rad_op,rad_optype,-1);
res:= d.rad_op.resultat;
if res=0 then res:= 3;
sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
end;
end;
d.op_ref.resultat:=res;
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
tofrom(kanalflag,alle_operatører,op_maske_lgd);
signal_bin(bs_mobil_opkald);
\f
message procedure radio_adm side 7 - 880930/cl;
end <* k=3 eller 4 *>
else
if k=72<*EK,K*> or k=73<*IN,K*> then
begin
nr:= d.opref.data(1) extract 22;
res:= 3;
iaf:= (nr-1)*kanalbeskrlængde;
start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
d.rad_op.data(1):= 0;
d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
d.rad_op.data(4):= kanalid(nr) extract 5;
d.rad_op.data(5):= k extract 1;
signalch(cs_radio_ud,radop,rad_optype);
waitch(cs_radio_adm,radop,rad_optype,-1);
res:= d.radop.resultat;
if res=0 then res:= 3;
j:= if k=72 then 15 else 0;
if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
begin
tofrom(kanalflag,alle_operatører,op_maske_lgd);
signalbin(bs_mobilopkald);
end;
d.opref.resultat:= res;
signalch(d.opref.retur,opref,d.opref.optype);
end
else
if k=11 or k=12 or k=19 then <*vt_opd*>
begin
nr:= d.opref.data(1) extract 8;
opgave:= if k=19 then 9 else (k-4);
if nr<=3 then
res:= 51 <*afvist*>
else
begin
startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
d.radop.data(1):= 0;
d.radop.data(2):= 'L';
d.radop.data(3):= omr_til_trunk(nr) shift (-6);
d.radop.data(4):= omr_til_trunk(nr) extract 6;
d.radop.data(5):= opgave;
d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
d.radop.data(7):= d.opref.data(2);
d.radop.data(8):= d.opref.data(3);
signalch(cs_radio_ud,radop,rad_optype);
<*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
res:= d.radop.resultat;
if res=0 then res:= 3;
end;
d.opref.resultat:= res;
signalch(d.opref.retur,opref,d.opref.optype);
end
else
begin
d.op_ref.resultat:= 45; <* ikke implementeret *>
signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
end;
until false;
radio_adm_trap:
disable skriv_radio_adm(zbillede,1);
end radio_adm;
\f
message vogntabel erklæringer side 1 - 820301/cl;
integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
cs_vt_log;
integer sidste_bus,sidste_linie_løb,tf_vogntabel,
max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
vt_log_slicelgd;
integer array bustabel,bustabel1(0:max_antal_busser),
linie_løb_tabel(0:max_antal_linie_løb),
springtabel(1:max_antal_spring,1:3),
gruppetabel(1:max_antal_grupper),
gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
vt_logop(1:2),
vt_logdisc(1:4),
vt_log_tail(1:10);
boolean array busindeks(-1:max_antal_linie_løb),
bustilstand(-1:max_antal_busser),
linie_løb_indeks(-1:max_antal_busser);
real array springtid,springstart(1:max_antal_spring);
real vt_logstart;
integer field v_kode,v_bus,v_ll1,v_ll2;
integer array field v_tekst;
real field v_tid;
zone zvtlog(128,1,stderror);
\f
message vogntabel erklæringer side 2 - 851001/cl;
procedure skriv_vt_variable(zud);
zone zud;
begin integer i; long array field laf;
laf:= 0;
write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
<:vt-op-længde :>,vt_op_længde,"nl",1,
<:cs-vt :>,cs_vt,"nl",1,
<:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
<:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
<:cs-vt-opd :>,cs_vt_opd,"nl",1,
<:cs-vt-rap :>,cs_vt_rap,"nl",1,
<:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
<:cs-vt-auto :>,cs_vt_auto,"nl",1,
<:cs-vt-grp :>,cs_vt_grp,"nl",1,
<:cs-vt-spring :>,cs_vt_spring,"nl",1,
<:cs-vt-log :>,cs_vt_log,"nl",1,
<:vt-op :>,vt_op,"nl",1,
<:vt-logop(1) :>,vt_logop(1),"nl",1,
<:vt-logop(2) :>,vt_logop(2),"nl",1,
<:sidste-bus :>,sidste_bus,"nl",1,
<:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
<:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
<:tf-vogntabel :>,tf_vogntabel,"nl",1,
<:tf-gruppedef :>,tf_gruppedef,"nl",1,
<:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
<:tf-springdef :>,tf_springdef,"nl",1,
<:vt-logskift :>,vt_logskift,"nl",1,
<:vt-logdisc :>,vt_logdisc.laf,"nl",1,
<:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
<:vt-log-aktiv :>,
if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
<:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
<::>);
write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
laf:= 2;
write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
for i:= 6 step 1 until 10 do
write(zud,"sp",1,<<d>,vt_logtail(i));
write(zud,"nl",1);
end;
\f
message procedure p_vogntabel side 1 - 820301/cl;
procedure p_vogntabel(z);
zone z;
begin
integer i,b,s,o,t,li,lb,lø,g;
write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
<:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
<: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
for i:= 1 step 1 until sidste_bus do
begin
b:= bustabel(i) extract 14;
g:= bustabel(i) shift (-14);
s:= bustabel1(i) shift (-23);
o:= bustabel1(i) extract 8;
t:= intg(bustilstand(i));
li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
lø:= li extract 7;
lb:= li shift (-7) extract 5;
lb:= if lb=0 then 32 else lb+64;
li:= li shift (-12) extract 10;
write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
<<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
if g > 0 then string bpl_navn(g) else <: :>,
";",1,true,4,string område_navn(o),
<:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
end;
end p_vogntabel;
\f
message procedure p_gruppetabel side 1 - 810531/cl;
procedure p_gruppetabel(z);
zone z;
begin
integer i,nr,bogst;
boolean spc_gr;
write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
<:max-antal-grupper =:>,max_antal_grupper,
<: max-antal-i-gruppe =:>,max_antal_i_gruppe,
<: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
<:gruppetabel::>);
for i:= 1 step 1 until max_antal_grupper do
write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
gruppetabel(i) extract 7);
write(z,"nl",2,<:gruppeopkald::>);
for i:= 1 step 1 until max_antal_gruppeopkald do
begin
write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
if gruppeopkald(i,1) = 0 then
write(z,"sp",11)
else
begin
spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
if spc_gr then nr:= gruppeopkald(i,1) extract 7
else
begin
nr:= gruppeopkald(i,1) shift (-5) extract 10;
bogst:= gruppeopkald(i,1) extract 5 +'@';
if bogst = '@' then bogst:= 'sp';
end;
if spc_gr then
write(z,<:(G:>,<<d>,true,3,nr)
else
write(z,"(",1,<<ddd>,nr,false add bogst,1);
write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
end;
end;
end p_gruppetabel;
\f
message procedure p_springtabel side 1 - 810519/cl;
procedure p_springtabel(z);
zone z;
begin
integer li,bo,max,st,nr;
long indeks;
real t;
write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
<:max-antal-spring =:>,max_antal_spring,"nl",2,
<:nr spring-id max status næste-tid:>,"nl",1);
for nr:= 1 step 1 until max_antal_spring do
begin
write(z,<<dd>,nr);
<* if springtabel(nr,1)<>0 then *>
begin
li:= springtabel(nr,1) shift (-5) extract 10;
bo:= springtabel(nr,1) extract 5;
if bo<>0 then bo:= bo + 'A' - 1;
indeks:= extend springtabel(nr,2) shift 24;
st:= extend springtabel(nr,3) shift (-12) extract 24;
max:= springtabel(nr,3) extract 12;
write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
if springtid(nr)<>0.0 then
write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
else
write(z,<< d.d >,0.0);
if springstart(nr)<>0.0 then
write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
else
write(z,<< d.d >,0.0);
end
<* else
write(z,<: --------:>)*>;
write(z,"nl",1);
end;
end p_springtabel;
\f
message procedure find_busnr side 1 - 820301/cl;
integer procedure findbusnr(ll_id,busnr,garage,tilst);
value ll_id;
integer ll_id, busnr, garage, tilst;
begin
integer i,j;
j:= binærsøg(sidste_linie_løb,
(linie_løb_tabel(i) - ll_id), i);
if j<>0 then <* linie/løb findes ikke *>
begin
find_busnr:= -1;
busnr:= 0;
garage:= 0;
tilst:= 0;
end
else
begin
busnr:= bustabel(busindeks(i) extract 12);
tilst:= intg(bustilstand(intg(busindeks(i))));
garage:= busnr shift (-14);
busnr:= busnr extract 14;
find_busnr:= busindeks(i) extract 12;
end;
end find_busnr;
\f
message procedure søg_omr_bus side 1 - 881027/cl;
integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
value bus;
integer bus,ll,gar,omr,sig,tilst;
begin
integer i,j,nr,bu,bi,bl;
j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
nr:= -1;
if j=0 then
begin
bl:= bu:= bi;
while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
while bu<sidste_bus and
bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
if bl<>bu then
begin
<* flere busser med samme tekniske nr. omr skal passe *>
nr:= -2;
for bi:= bl step 1 until bu do
if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
end
else
nr:= bi;
end;
if nr<0 then
begin
<* bus findes ikke *>
ll:= gar:= tilst:= sig:= 0;
end
else
begin
tilst:= intg(bustilstand(nr));
gar:= bustabel(nr) shift (-14);
ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
if omr=0 then omr:= bustabel1(nr) extract 8;
sig:= bustabel1(nr) shift (-23);
end;
søg_omr_bus:= nr;
end;
\f
message procedure find_linie_løb side 1 - 820301/cl;
integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
value busnr;
integer busnr, linie_løb, garage, tilst;
begin
integer i,j;
j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
if j<>0 then <* bus findes ikke *>
begin
find_linie_løb:= -1;
linie_løb:= 0;
garage:= 0;
tilst:= 0;
end
else
begin
tilst:= intg(bustilstand(i));
garage:= bustabel(i) shift (-14);
linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
find_linie_løb:= linie_løb_indeks(i) extract 12;
end;
end find_linie_løb;
\f
message procedure h_vogntabel side 1 - 810413/cl;
<* hovedmodulcorutine for vogntabelmodul *>
procedure h_vogntabel;
begin
integer array field op;
integer dest_sem,k;
procedure skriv_h_vogntabel(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
if omfang<>0 then
disable
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-vt :>,cs_vt,"nl",1,
<:op :>,op,"nl",1,
<:dest-sem :>,dest_sem,"nl",1,
<:k :>,k,"nl",1,
<::>);
end;
end;
\f
message procedure h_vogntabel side 2 - 820301/cl;
stackclaim(if cm_test then 198 else 146);
trap(h_vt_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_h_vogntabel(out,0);
<*-2*>
repeat
waitch(cs_vt,op,true,-1);
<*+4*>
if (d.op.optype and gen_optype) extract 12 = 0 and
(d.op.optype and vt_optype) extract 12 = 0 then
fejlreaktion(12,op,<:vogntabel:>,0);
<*-4*>
disable
begin
k:= d.op.opkode extract 12;
dest_sem:=
if k = 9 then cs_vt_rap else
if k = 10 then cs_vt_rap else
if k = 11 then cs_vt_opd else
if k = 12 then cs_vt_opd else
if k = 13 then cs_vt_opd else
if k = 14 then cs_vt_tilst else
if k = 15 then cs_vt_tilst else
if k = 16 then cs_vt_tilst else
if k = 17 then cs_vt_tilst else
if k = 18 then cs_vt_tilst else
if k = 19 then cs_vt_opd else
if k = 20 then cs_vt_opd else
if k = 21 then cs_vt_auto else
if k = 24 then cs_vt_opd else
if k = 25 then cs_vt_grp else
if k = 26 then cs_vt_grp else
if k = 27 then cs_vt_grp else
if k = 28 then cs_vt_grp else
if k = 30 then cs_vt_spring else
if k = 31 then cs_vt_spring else
if k = 32 then cs_vt_spring else
if k = 33 then cs_vt_spring else
if k = 34 then cs_vt_spring else
if k = 35 then cs_vt_spring else
-1;
\f
message procedure h_vogntabel side 3 - 810422/cl;
<*+2*>
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
end;
if dest_sem = -1 then
fejlreaktion(2,k,<:vogntabel:>,0);
disable signalch(dest_sem,op,d.op.optype);
until false;
h_vt_trap:
disable skriv_h_vogntabel(zbillede,1);
end h_vogntabel;
\f
message procedure vt_opdater side 1 - 810317/cl;
procedure vt_opdater(op1);
value op1;
integer op1;
begin
integer array field op,radop;
integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
flin,slin,finx,sinx;
integer field bn,ll;
procedure skriv_vt_opd(zud,omfang);
value omfang; integer omfang;
zone zud;
begin
write(zud,"nl",1,<:+++ vt_opdater :>);
if omfang <> 0 then
disable
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,
<: op: :>,op,"nl",1,
<: radop::>,radop,"nl",1,
<: funk: :>,funk,"nl",1,
<: res: :>,res,"nl",1,
<::>);
end;
end skriv_vt_opd;
integer procedure opd_omr(fnk,omr,bus,ll);
value fnk,omr,bus,ll;
integer fnk,omr,bus,ll;
begin
opd_omr:= 3;
<*GØR PROCEDUREN TIL DUMMYPROCEDURE -
ændringer skal ikke længere meldes til yderområder *>
goto dummy_retur;
if omr extract 8 > 3 then
begin
startoperation(radop,501,cs_vt_opd,fnk);
d.radop.data(1):= omr;
d.radop.data(2):= bus;
d.radop.data(3):= ll;
signalch(cs_rad,radop,vt_optype);
<*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
opd_omr:= d.radop.resultat;
end
else
opd_omr:= 0;
dummy_retur:
end;
message procedure vt_opdater side 1a - 920517/cl;
procedure opd_log(kilde,kode,bus,ll1,ll2);
value kilde,kode,bus,ll1,ll2;
integer kilde,kode,bus,ll1,ll2;
begin
integer array field op;
<*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
startoperation(op,curr_coruid,cs_vt_logpool,0);
systime(1,0.0,d.op.data.v_tid);
d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
d.op.data.v_bus:= bus;
d.op.data.v_ll1:= ll1;
d.op.data.v_ll2:= ll2;
signalch(cs_vt_log,op,vt_optype);
end;
stackclaim((if cm_test then 198 else 146)+125);
bn:= 4; ll:= 2;
radop:= op1;
trap(vt_opd_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_opd(out,0);
<*-2*>
\f
message procedure vt_opdater side 2 - 851001/cl;
vent_op:
waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_opd(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
<*+4*>
<**>if op<>vt_op then
<**>begin
<**> disable begin
<**> fejlreaktion(11,op,<:vt-opdater:>,1);
<**> d.op.resultat:= 31; <*systemfejl*>
<**> signalch(d.op.retur,op,d.op.optype);
<**> end;
<**> goto vent_op;
<**>end;
<*-4*>
disable
begin integer opk;
opk:= d.op.opkode extract 12;
funk:= if opk=11 then 1 else
if opk=12 then 2 else
if opk=13 then 3 else
if opk=19 then 4 else
if opk=20 then 5 else
if opk=24 then 6 else
0;
if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
end;
res:= 0;
goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
\f
message procedure vt_opdater side 3 - 820301/cl;
indsæt:
begin
integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
<*+4*>
<**> if d.op.data(1) shift (-22) <> 0 then
<**> begin
<**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
<**> goto slut_indsæt;
<**> end;
<*-4*>
busnr:= d.op.data(1) extract 14;
<*+4*>
<**> if d.op.data(2) shift (-22) <> 1 then
<**> begin
<**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
<**> goto slut_indsæt;
<**> end;
<*-4*>
ll_id:= d.op.data(2);
s:= omr:= d.op.data(4) extract 8;
bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
if bi<0 then
begin
if bi=(-1) then res:=10 <*bus ukendt*> else
if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
end
else
if s<>0 and s<>omr then
res:= 58 <* ulovligt område for bus *>
else
if intg(bustilstand(bi)) <> 0 then
res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
else 14 <* optaget *>)
else
begin
if linie_løb_indeks(bi) extract 12 <> 0 then
begin <* linie/løb allerede indsat *>
res:= 11;
d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
end
else
begin
\f
message procedure vt_opdater side 3a - 900108/cl;
if d.op.kilde//100 <> 4 then
res:= opd_omr(11,gar shift 8 +
bustabel1(bi) extract 8,busnr,ll_id);
if res>3 then goto slut_indsæt;
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
if s=0 then <* linie/løb findes allerede *>
begin
sig:= busindeks(li) extract 12;
d.op.data(3):= bustabel(sig);
linie_løb_indeks(sig):= false;
disable modiffil(tf_vogntabel,sig,zi);
fil(zi).ll:= 0;
fil(zi).bn:= bustabel(sig) extract 14 add
(bustabel1(sig) extract 8 shift 14);
opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
linie_løb_indeks(bi):= false add li;
busindeks(li):= false add bi;
disable modiffil(tf_vogntabel,bi,zi);
fil(zi).ll:= ll_id;
fil(zi).bn:= bustabel(bi) extract 14 add
(bustabel1(bi) extract 8 shift 14);
opd_log(d.op.kilde,1,busnr,0,ll_id);
res:= 3;
end
else
begin
\f
message procedure vt_opdater side 4 - 810527/cl;
if s<0 then li:= li +1;
if sidste_linie_løb=max_antal_linie_løb then
begin
fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
res:= 31;
end
else
begin
for i:= sidste_linie_løb step -1 until li do
begin
linie_løb_tabel(i+1):=linie_løb_tabel(i);
linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
bus_indeks(i+1):=bus_indeks(i);
end;
sidste_linie_løb:= sidste_linie_løb +1;
linie_løb_tabel(li):= ll_id;
linie_løb_indeks(bi):= false add li;
busindeks(li):= false add bi;
disable s:= modiffil(tf_vogntabel,bi,zi);
if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
fil(zi).bn:= busnr extract 14 add
(bustabel1(bi) extract 8 shift 14);
fil(zi).ll:= ll_id;
opd_log(d.op.kilde,1,busnr,0,ll_id);
res:= 3; <* ok *>
end;
end;
end;
end;
slut_indsæt:
d.op.resultat:= res;
end;
goto returner;
\f
message procedure vt_opdater side 5 - 820301/cl;
udtag:
begin
integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
busnr:= ll_id:= 0;
omr:= s:= d.op.data(2) extract 8;
format:= d.op.data(1) shift (-22);
if format=0 then <*busnr*>
begin
busnr:= d.op.data(1) extract 14;
bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
if bi<0 then
begin
if bi=-1 then res:= 10 else
if s<>0 then res:= 58 else res:= 57;
goto slut_udtag;
end;
if bi>0 and s<>0 and s<>omr then
begin
res:= 58; goto slut_udtag;
end;
li:= linie_løb_indeks(bi) extract 12;
busnr:= bustabel(bi);
if li=0 or linie_løb_tabel(li)=0 then
begin <* bus ej indsat *>
res:= 13;
goto slut_udtag;
end;
ll_id:= linie_løb_tabel(li);
end
else
if format=1 then <* linie_løb *>
begin
ll_id:= d.op.data(1);
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
if s<>0 then
begin <* linie/løb findes ikke *>
res:= 9;
goto slut_udtag;
end;
bi:= busindeks(li) extract 12;
busnr:= bustabel(bi);
end
else <* ulovlig identifikation *>
begin
res:= 31;
fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
goto slut_udtag;
end;
\f
message procedure vt_opdater side 6 - 820301/cl;
tilst:= intg(bustilstand(bi));
if tilst<>0 then
begin
res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
goto slut_udtag;
end;
if d.op.kilde//100 <> 4 then
res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
if res>3 then goto slut_udtag;
linie_løb_indeks(bi):= false;
for i:= li step 1 until sidste_linie_løb -1 do
begin
linie_løb_tabel(i):= linie_løb_tabel(i+1);
linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
bus_indeks(i):= bus_indeks(i+1);
end;
linie_løb_tabel(sidste_linie_løb):= 0;
bus_indeks(sidste_linie_løb):= false;
sidste_linie_løb:= sidste_linie_løb -1;
disable s:= modif_fil(tf_vogntabel,bi,zi);
if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
fil(zi).ll:= 0;
fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
opd_log(d.op.kilde,2,busnr,ll_id,0);
res:= 3; <* ok *>
slut_udtag:
d.op.resultat:= res;
d.op.data(2):= ll_id;
d.op.data(3):= busnr;
end;
goto returner;
\f
message procedure vt_opdater side 7 - 851001/cl;
omkod:
flyt:
roker:
begin
integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
inf1:= inf2:= 0;
ll_id1:= d.op.data(1);
ll_id2:= d.op.data(2);
if ll_id1=ll_id2 then
begin
res:= 24; inf1:= ll_id2;
goto slut_flyt;
end;
<*+4*>
<**> for i:= 1,2 do
<**> if d.op.data(i) shift (-22) <> 1 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(i),case i of (
<**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
<**> goto slut_flyt;
<**> end;
<*-4*>
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
if s<>0 and funk=6 <* roker *> then
begin
i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
end;
if s<>0 then
begin
res:= 9; <* ukendt linie/løb *>
goto slut_flyt;
end;
bi1:= busindeks(li1) extract 12;
inf1:= bustabel(bi1);
tilst:= intg(bustilstand(bi1));
if tilst<>0 then <* bus ikke fri *>
begin
res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
goto slut_flyt;
end;
\f
message procedure vt_opdater side 7a- 851001/cl;
if d.op.kilde//100 <> 4 then
res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
if res>3 then goto slut_flyt;
s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
if s=0 then
begin <* ll_id2 er indkodet *>
bi2:= busindeks(li2) extract 12;
inf2:= bustabel(bi2);
tilst:= intg(bustilstand(bi2));
if funk=3 then res:= 12 <* ulovlig ved omkod *> else
if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
if res>3 then
begin
inf1:= inf2; inf2:= 0;
goto slut_flyt;
end;
if d.op.kilde//100 <> 4 then
res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
if res>3 then goto slut_flyt;
<* flyt bus *>
if funk=6 then
linie_løb_indeks(bi2):= false add li1
else
linie_løb_indeks(bi2):= false;
linie_løb_indeks(bi1):= false add li2;
if funk=6 then
busindeks(li1):= false add bi2
else
busindeks(li1):= false;
busindeks(li2):= false add bi1;
if funk<>6 then
begin
<* fjern ll_id1 *>
for i:= li1 step 1 until sidste_linie_løb - 1 do
begin
linie_løb_tabel(i):= linie_løb_tabel(i+1);
linie_løb_indeks(intg(busindeks(i+1))):= false add i;
busindeks(i):= busindeks(i+1);
end;
linie_løb_tabel(sidste_linie_løb):= 0;
bus_indeks(sidste_linie_løb):= false;
sidste_linie_løb:= sidste_linie_løb-1;
end;
<* opdater vogntabelfil *>
disable s:= modiffil(tf_vogntabel,bi2,zi);
if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
fil(zi).ll:= if funk=6 then ll_id1 else 0;
fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
if funk=6 then
opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
else
opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
disable s:= modiffil(tf_vogntabel,bi1,zi);
if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
fil(zi).ll:= ll_id2;
fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
\f
message procedure vt_opdater side 8 - 820301/cl;
end <* ll_id2 indkodet *>
else
begin
if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
<* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
pm1:= sgn(li2-li1);
for i:= li1 step pm1 until li2-pm1 do
begin
linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
busindeks(i):= busindeks(i+pm1);
linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
end;
linie_løb_tabel(li2):= ll_id2;
busindeks(li2):= false add bi1;
linie_løb_indeks(bi1):= false add li2;
disable s:= modiffil(tf_vogntabel,bi1,zi);
if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
fil(zi).ll:= ll_id2;
fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
end;
res:= 3; <*udført*>
slut_flyt:
d.op.resultat:= res;
d.op.data(3):= inf1;
if funk=5 then d.op.data(4):= inf2;
end;
goto returner;
\f
message procedure vt_opdater side 9 - 851001/cl;
slet:
begin
integer flin,slin,finx,sinx,s,li,bi,omr,gar;
boolean test24;
if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
omr:= d.op.data(3);
if d.op.data(1) > d.op.data(2) then
begin
res:= 44; <* intervalstørrelse ulovlig *>
goto slut_slet;
end;
flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
if s<0 then finx:= finx+1;
s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
if s>0 then sinx:= sinx-1;
for li:= finx step 1 until sinx do
begin
bi:= busindeks(li) extract 12;
gar:= bustabel(bi) shift (-14) extract 8;
if intg(bustilstand(bi))=0 and
(omr = 0 or (omr > 0 and omr = gar) or
(omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
begin
opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
linie_løb_indeks(bi):= busindeks(li):= false;
linie_løb_tabel(li):= 0;
end;
end;
\f
message procedure vt_opdater side 10 - 850820/cl;
sinx:= finx-1;
for li:= finx step 1 until sidste_linie_løb do
begin
if linie_løb_tabel(li)<>0 then
begin
sinx:= sinx+1;
if sinx<>li then
begin
linie_løb_tabel(sinx):= linie_løb_tabel(li);
busindeks(sinx):= busindeks(li);
linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
linie_løb_tabel(li):= 0;
busindeks(li):= false;
end;
end;
end;
sidste_linie_løb:= sinx;
test24:= testbit24; testbit24:= false;
for bi:= 1 step 1 until sidste_bus do
disable
begin
s:= modiffil(tf_vogntabel,bi,finx);
if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
fil(finx).bn:= bustabel(bi) extract 14 add
(bustabel1(bi) extract 8 shift 14);
fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
end;
testbit24:= test24;
res:= 3;
slut_slet:
d.op.resultat:= res;
end;
goto returner;
\f
message procedure vt_opdater side 11 - 810409/cl;
returner:
disable
begin
<*+2*>
<**> if testbit40 and overvåget then
<**> begin
<**> skriv_vt_opd(out,0);
<**> write(out,<: vogntabel efter ændring:>);
<**> p_vogntabel(out);
<**> end;
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_opd(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_opd_trap:
disable skriv_vt_opd(zbillede,1);
end vt_opdater;
\f
message procedure vt_tilstand side 1 - 810424/cl;
procedure vt_tilstand(cs_fil,fil_opref);
value cs_fil,fil_opref;
integer cs_fil,fil_opref;
begin
integer array field op,filop;
integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
g_type,gr,antal,ej_res,zi,li,filref;
integer array identer(1:max_antal_i_gruppe);
procedure skriv_vt_tilst(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
real array field raf;
raf:= 0;
write(zud,"nl",1,<:+++ vt_tilstand :>);
if omfang <> 0 then
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-fil :>,cs_fil,"nl",1,
<:filop :>,filop,"nl",1,
<:op :>,op,"nl",1,
<:funk :>,funk,"nl",1,
<:format :>,format,"nl",1,
<:busid :>,busid,"nl",1,
<:res :>,res,"nl",1,
<:bi :>,bi,"nl",1,
<:tilst :>,tilst,"nl",1,
<:opk :>,opk,"nl",1,
<:opk-indeks :>,opk_indeks,"nl",1,
<:g-type :>,g_type,"nl",1,
<:gr :>,gr,"nl",1,
<:antal :>,antal,"nl",1,
<:ej-res :>,ej_res,"nl",1,
<:zi :>,zi,"nl",1,
<:li :>,li,"nl",1,
<::>);
write(zud,"nl",1,<:identer:>);
skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
end;
end;
procedure sorter_gruppe(tab,l,u);
value l,u;
integer array tab;
integer l,u;
begin
integer array field ii,jj;
integer array ww, xx(1:2);
integer procedure sml(a,b);
integer array a,b;
begin
integer res;
res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
if res = 0 then
res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
if res = 0 then
res:=
sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
if res = 0 then
res:= sign((a(2) extract 14) - (b(2) extract 14));
sml:= res;
end;
ii:= ((l+u)//2 - 1)*4;
tofrom(xx,tab.ii,4);
ii:= (l-1)*4; jj:= (u-1)*4;
repeat
while sml(tab.ii,xx) < 0 do ii:= ii+4;
while sml(xx,tab.jj) < 0 do jj:= jj-4;
if ii <= jj then
begin
tofrom(ww,tab.ii,4);
tofrom(tab.ii,tab.jj,4);
tofrom(tab.jj,ww,4);
ii:= ii+4;
jj:= jj-4;
end;
until ii>jj;
if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
end;
\f
message procedure vt_tilstand side 2 - 820301/cl;
filop:= filopref;
stackclaim(if cm_test then 550 else 500);
trap(vt_tilst_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_tilst(out,0);
<*-2*>
vent_op:
waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
<*+2*>disable
<**> if (testbit41 and overvåget) or
(testbit46 and overvåget and
(d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
then
<**> begin
<**> skriv_vt_tilst(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
<*+4*>
<**> if op <> vt_op then
<**> begin
<**> disable begin
<**> d.op.resultat:= 31;
<**> fejlreaktion(11,op,<:vt-tilstand:>,1);
<**> end;
<**> goto returner;
<**> end;
<*-4*>
opk:= d.op.opkode extract 12;
funk:= if opk = 14 <*bus i kø*> then 1 else
if opk = 15 <*bus res *> then 2 else
if opk = 16 <*grp res *> then 4 else
if opk = 17 <*bus fri *> then 3 else
if opk = 18 <*grp fri *> then 5 else
0;
if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
res:= 0;
format:= d.op.data(1) shift (-22);
goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
\f
message procedure vt_tilstand side 3 - 820301/cl;
enkelt_bus:
<* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
disable
begin integer busnr,i,s,tilst,ll,gar,omr,sig;
<*+4*>
<**>if format <> 0 and format <> 1 then
<**>begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
<**> goto slut_enkelt_bus;
<**>end;
<*-4*>
<* find busnr og tilstand *>
case format+1 of
begin
<* 0: budident *>
begin
busnr:= d.op.data(1) extract 14;
s:= omr:= d.op.data(4) extract 8;
bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
if bi<0 then
begin
res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
goto slut_enkelt_bus;
end
else
begin
tilst:= intg(bustilstand(bi));
end;
end;
<* 1: linie_løb_ident *>
begin
bi:= findbusnr(d.op.data(1),busnr,i,tilst);
if bi < 0 then <* ukendt linie_løb *>
begin
res:= 9;
goto slut_enkelt_bus;
end;
end;
end case;
\f
message procedure vt_tilstand side 4 - 830310/cl;
if funk < 3 then
begin
d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
linie_løb_tabel(linie_løb_indeks(bi) extract 12)
else 0;
d.op.data(3):= bustabel(bi);
d.op.data(4):= bustabel1(bi);
end;
<* check tilstand *>
if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
res:= 39 <* bus ikke reserveret *>
else
if tilst <> 0 and tilst <> (-1) and funk < 3 then
res:= 14 <* bus optaget *>
else
if funk = 1 <* i kø *> and tilst = (-1) then
res:= 18 <* i kø *>
else
res:= 3; <*udført*>
if res = 3 then
bustilstand(bi):= false add (case funk of (-1,-2,0));
slut_enkelt_bus:
d.op.resultat:= res;
end <*disable*>;
goto returner;
\f
message procedure vt_tilstand side 5 - 810424/cl;
grp_res: <* reserver gruppe *>
disable
begin
<*+4*>
<**> if format <> 2 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
<**> goto slut_grp_res_1;
<**> end;
<*-4*>
<* find frit indeks i opkaldstabel *>
opk_indeks:= 0;
for i:= max_antal_gruppeopkald step -1 until 1 do
begin
if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
end;
if opk_indeks = 0 then res:= 32; <* ingen plads *>
if res <> 0 then goto slut_grp_res_1;
g_type:= d.op.data(1) shift (-21) extract 1;
if g_type = 1 <*special gruppe*> then
begin <*check eksistens*>
gr:= 0;
for i:= 1 step 1 until max_antal_grupper do
if gruppetabel(i) = d.op.data(1) then gr:= i;
if gr = 0 then <*gruppe ukendt*>
begin
res:= 8;
goto slut_grp_res_1;
end;
end;
<* reserver i opkaldstabel *>
gruppeopkald(opk_indeks,1):= d.op.data(1);
\f
message procedure vt_tilstand side 6 - 810428/cl;
<* tilknyt fil *>
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= 0; <*postantal*>
d.filop.data(2):= 256; <*postlængde*>
d.filop.data(3):= 1; <*segmentantal*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
signalch(cs_opret_fil,filop,vt_optype);
slut_grp_res_1:
if res <> 0 then d.op.resultat:= res;
end;
if res <> 0 then goto returner;
waitch(cs_fil,filop,vt_optype,-1);
<* check filsys-resultat *>
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
filref:= d.filop.data(4);
\f
message procedure vt_tilstand side 7 - 820301/cl;
disable if g_type = 0 <*linie-gruppe*> then
begin
integer s,i,ll_id;
integer array field iaf1;
ll_id:= 1 shift 22 + d.op.data(1) shift 7;
iaf1:= 2;
s:= binærsøg(sidste_linie_løb,
linie_løb_tabel(i) - ll_id, i);
if s < 0 then i:= i +1;
antal:= ej_res:= 0;
skrivfil(filref,1,zi);
if i <= sidste_linie_løb then
begin
while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
begin
if (intg(bustilstand(intg(busindeks(i))))<>0) or
(bustabel1(intg(busindeks(i))) extract 8 <> 3) then
ej_res:= ej_res+1
else
begin
antal:= antal+1;
bi:= busindeks(i) extract 12;
fil(zi).iaf1(1):=
område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
(bustabel1(bi) shift (-23) + 1) shift 8 + 1;
fil(zi).iaf1(2):= bustabel(bi);
iaf1:= iaf1+4;
bustilstand(bi):= false add opk_indeks;
end;
i:= i +1;
if i > sidste_linie_løb then goto slut_l_grp;
end;
end;
\f
message procedure vt_tilstand side 8 - 820301/cl;
slut_l_grp:
end
else
begin <*special gruppe*>
integer i,s,li,omr,gar,tilst;
integer array field iaf1;
iaf1:= 2;
antal:= ej_res:= 0;
s:= læsfil(tf_gruppedef,gr,zi);
if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
tofrom(identer,fil(zi),max_antal_i_gruppe*2);
s:= skrivfil(filref,1,zi);
if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
i:= 1;
while identer(i) <> 0 do
begin
if identer(i) shift (-22) = 0 then
begin <*busident*>
omr:= 0;
bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
if bi<0 then goto næste_ident;
li:= linie_løb_indeks(bi) extract 12;
end
else
begin <*linie/løb ident*>
s:= binærsøg(sidste_linie_løb,
linie_løb_tabel(li) - identer(i), li);
if s <> 0 then goto næste_ident;
bi:= busindeks(li) extract 12;
end;
if (intg(bustilstand(bi))<>0) or
(bustabel1(bi) extract 8 <> 3) then
ej_res:= ej_res+1
else
begin
antal:= antal +1;
fil(zi).iaf1(1):=
område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
(bustabel1(bi) shift (-23) + 1) shift 8 + 1;
fil(zi).iaf1(2):= bustabel(bi);
iaf1:= iaf1+4;
bustilstand(bi):= false add opk_indeks;
end;
næste_ident:
i:= i +1;
if i > max_antal_i_gruppe then goto slut_s_grp;
end;
slut_s_grp:
end;
\f
message procedure vt_tilstand side 9 - 820301/cl;
if antal > 0 then <*ok*>
disable begin
integer array field spec,akt;
integer a;
integer field antal_spec;
antal_spec:= 2; a:= 0;
spec:= 2; akt:= 2;
sorter_gruppe(fil(zi).spec,1,antal);
fil(zi).antal_spec:= 0;
while akt//4 < antal do
begin
fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
a:= 0;
while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
and a<15 do
begin
a:= a+1;
fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
akt:= akt+4;
end;
fil(zi).spec(1):= fil(zi).spec(1) + a;
fil(zi).antal_spec:= fil(zi).antal_spec+1;
spec:= spec + 2*a + 2;
end;
antal:= fil(zi).antal_spec;
gruppeopkald(opk_indeks,2):= filref;
d.op.resultat:= 3;
d.op.data(2):= antal;
d.op.data(3):= filref;
d.op.data(4):= ej_res;
end
else
begin
disable begin
d.filop.opkode:= 104; <*slet fil*>
signalch(cs_slet_fil,filop,vt_optype);
gruppeopkald(opk_indeks,1):= 0; <*fri*>
d.op.resultat:= 54;
d.op.data(2):= antal;
d.op.data(3):= 0;
d.op.data(4):= ej_res;
end;
waitch(cs_fil,filop,vt_optype,-1);
if d.filop.data(9) <> 0 then
fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
end;
goto returner;
\f
message procedure vt_tilstand side 10 - 820301/cl;
grp_fri: <* frigiv gruppe *>
disable
begin integer i,j,s,ll,gar,omr,tilst;
integer array field spec;
<*+4*>
<**> if format <> 2 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
<**> goto slut_grp_fri;
<**> end;
<*-4*>
<* find indeks i opkaldstabel *>
opk_indeks:= 0;
for i:= 1 step 1 until max_antal_gruppeopkald do
if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
if opk_indeks = 0 <*ikke fundet*> then
begin
res:= 40; <*gruppe ej reserveret*>
goto slut_grp_fri;
end;
filref:= gruppeopkald(opk_indeks,2);
start_operation(filop,curr_coruid,cs_fil,104);
d.filop.data(4):= filref;
hentfildim(d.filop.data);
læsfil(filref,1,zi);
spec:= 0;
antal:= fil(zi).spec(1);
spec:= spec+2;
for i:= 1 step 1 until antal do
begin
for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
begin
busid:= fil(zi).spec(1+j) extract 14;
omr:= 0;
bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
if bi>=0 then bustilstand(bi):= false;
end;
spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
end;
slut_grp_fri:
d.op.resultat:= res;
end;
if res <> 0 then goto returner;
gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
signalch(cs_slet_fil,filop,vt_optype);
\f
message procedure vt_tilstand side 11 - 810424/cl;
waitch(cs_fil,filop,vt_optype,-1);
if d.filop.data(9) <> 0 then
fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
d.op.resultat:= 3;
returner:
disable
begin
<*+2*>
<**> if testbit40 and overvåget then
<**> begin
<**> skriv_vt_tilst(out,0);
<**> write(out,<: vogntabel efter ændring:>);
<**> p_vogntabel(out);
<**> end;
<**> if testbit43 and overvåget and (funk=4 or funk=5) then
<**> begin
<**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
<**> p_gruppetabel(out);
<**> end;
<**> if (testbit41 and overvåget) or
<**> (testbit46 and overvåget and (funk=4 or funk=5)) then
<**> begin
<**> skriv_vt_tilst(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_tilst_trap:
disable skriv_vt_tilst(zbillede,1);
end vt_tilstand;
\f
message procedure vt_rapport side 1 - 810428/cl;
procedure vt_rapport(cs_fil,fil_opref);
value cs_fil,fil_opref;
integer cs_fil,fil_opref;
begin
integer array field op,filop;
integer funk,filref,antal,id_ant,res;
integer field i1,i2;
procedure skriv_vt_rap(z,omfang);
value omfang;
zone z;
integer omfang;
begin
write(z,"nl",1,<:+++ vt_rapport :>);
if omfang <> 0 then
begin
skriv_coru(z,abs curr_coruno);
write(z,"nl",1,<<d>,
<: cs_fil :>,cs_fil,"nl",1,
<: filop :>,filop,"nl",1,
<: op :>,op,"nl",1,
<: funk :>,funk,"nl",1,
<: filref :>,filref,"nl",1,
<: antal :>,antal,"nl",1,
<: id-ant :>,id_ant,"nl",1,
<: res :>,res,"nl",1,
<::>);
end;
end skriv_vt_rap;
stackclaim(if cm_test then 198 else 146);
filop:= fil_opref;
i1:= 2; i2:= 4;
trap(vt_rap_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_rap(out,0);
<*-2*>
\f
message procedure vt_rapport side 2 - 810505/cl;
vent_op:
waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
<*+2*>
<**> disable begin
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_rap(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> ud;
<**> end;
<**> end;<*disable*>
<*-2*>
disable
begin
integer opk;
opk:= d.op.opkode extract 12;
funk:= if opk = 9 then 1 else
if opk =10 then 2 else
0;
if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
<* opret og tilknyt fil *>
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= 0; <*postantal(midlertidigt)*>
d.filop.data(2):= 2; <*postlængde*>
d.filop.data(3):=10; <*segmenter*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
signalch(cs_opretfil,filop,vt_optype);
end;
waitch(cs_fil,filop,vt_optype,-1);
<* check resultat *>
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
filref:= d.filop.data(4);
antal:= 0;
goto case funk of (l_rapport,b_rapport);
\f
message procedure vt_rapport side 3 - 850820/cl;
l_rapport:
disable
begin
integer i,j,s,ll,zi;
idant:= 0;
for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
<*+4*>
<**> if d.op.data(id_ant) shift (-22) <> 2 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
<**> goto l_rap_slut;
<**> end;
<*-4*>
;
for i:= 1 step 1 until id_ant do
begin
ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
s:= binærsøg(sidste_linie_løb,
linie_løb_tabel(j) - ll, j);
if s < 0 then j:= j +1;
if j<= sidste_linie_løb then
begin <* skriv identer *>
while linie_løb_tabel(j) shift (-7) shift 7 = ll do
begin
antal:= antal +1;
s:= skrivfil(filref,antal,zi);
if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
fil(zi).i1:= linie_løb_tabel(j);
fil(zi).i2:= bustabel(busindeks(j) extract 12);
j:= j +1;
if j > sidste_bus then goto linie_slut;
end;
end;
linie_slut:
end;
res:= 3;
l_rap_slut:
end <*disable*>;
goto returner;
\f
message procedure vt_rapport side 4 - 820301/cl;
b_rapport:
disable
begin
integer i,j,s,zi,busnr1,busnr2;
<*+4*>
<**> for i:= 1,2 do
<**> if d.op.data(i) shift (-14) <> 0 then
<**> begin
<**> res:= 31;
<**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
<**> goto bus_slut;
<**> end;
<*-4*>
busnr1:= d.op.data(1) extract 14;
busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
if busnr1 = 0 or busnr2 < busnr1 then
begin
res:= 7; <* fejl i busnr *>
goto bus_slut;
end;
s:= binærsøg(sidste_bus,bustabel(j) extract 14
- busnr1,j);
if s < 0 then j:= j +1;
while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
if j <= sidste_bus then
begin <* skriv identer *>
while bustabel(j) extract 14 <= busnr2 do
begin
i:= linie_løb_indeks(j) extract 12;
if i<>0 then
begin
antal:= antal +1;
s:= skriv_fil(filref,antal,zi);
if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
fil(zi).i1:= bustabel(j);
fil(zi).i2:= linie_løb_tabel(i);
end;
j:= j +1;
if j > sidste_bus then goto bus_slut;
end;
end;
bus_slut:
end <*disable*>;
res:= 3; <*ok*>
\f
message procedure vt_rapport side 5 - 810409/cl;
returner:
disable
begin
d.op.resultat:= res;
d.op.data(6):= antal;
d.op.data(7):= filref;
d.filop.data(1):= antal;
d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
i:= sæt_fil_dim(d.filop.data);
if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
<*+2*>
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_rap(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_rap_trap:
disable skriv_vt_rap(zbillede,1);
end vt_rapport;
\f
message procedure vt_gruppe side 1 - 810428/cl;
procedure vt_gruppe(cs_fil,fil_opref);
value cs_fil,fil_opref;
integer cs_fil,fil_opref;
begin
integer array field op, fil_op, iaf;
integer funk, res, filref, gr, i, antal, zi, s;
integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
max_antal_grupper else max_antal_i_gruppe));
procedure skriv_vt_gruppe(zud,omfang);
value omfang;
integer omfang;
zone zud;
begin
integer øg;
write(zud,"nl",1,<:+++ vt_gruppe :>);
if omfang <> 0 then
disable
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<: cs_fil :>,cs_fil,"nl",1,
<: op :>,op,"nl",1,
<: filop :>,filop,"nl",1,
<: funk :>,funk,"nl",1,
<: res :>,res,"nl",1,
<: filref :>,filref,"nl",1,
<: gr :>,gr,"nl",1,
<: i :>,i,"nl",1,
<: antal :>,antal,"nl",1,
<: zi :>,zi,"nl",1,
<: s :>,s,"nl",1,
<::>);
raf:= 0;
system(3,øg,identer);
write(zud,"nl",1,<:identer::>);
skriv_hele(zud,identer.raf,øg*2,2);
end;
end;
stackclaim(if cm_test then 198 else 146);
filop:= fil_opref;
trap(vt_grp_trap);
iaf:= 0;
\f
message procedure vt_gruppe side 2 - 810409/cl;
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_gruppe(out,0);
<*-2*>
vent_op:
waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
<*+2*>
<**>disable
<**>begin
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_gruppe(out,0);
<**> write(out,<: modtaget operation:>);
<**> skriv_op(out,op);
<**> ud;
<**> end;
<**>end;
<*-2*>
disable
begin
integer opk;
opk:= d.op.opkode extract 12;
funk:= if opk=25 then 1 else
if opk=26 then 2 else
if opk=27 then 3 else
if opk=28 then 4 else
0;
if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
end;
<*+4*>
<**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
<**> begin
<**> disable begin
<**> d.op.resultat:= 31;
<**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
<**> end;
<**> goto returner;
<**> end;
<*-4*>
goto case funk of(definer,slet,vis,oversigt);
\f
message procedure vt_gruppe side 3 - 810505/cl;
definer:
disable
begin
gr:= 0; res:= 0;
for i:= max_antal_grupper step -1 until 1 do
begin
if gruppetabel(i)=0 then gr:= i <*fri plads*> else
if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
end;
if gr=0 then res:= 32; <*ingen plads*>
end;
if res<>0 then goto slut_definer;
disable
begin <*fri plads fundet*>
antal:= d.op.data(2);
if antal <=0 or max_antal_i_gruppe<antal then
res:= 33 <*fejl i gruppestørrelse*>
else
begin
for i:= 1 step 1 until antal do
begin
s:= læsfil(d.op.data(3),i,zi);
if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
identer(i):= fil(zi).iaf(1);
end;
s:= modif_fil(tf_gruppedef,gr,zi);
if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
tofrom(fil(zi).iaf,identer,antal*2);
for i:= antal+1 step 1 until max_antal_i_gruppe do
fil(zi).iaf(i):= 0;
gruppetabel(gr):= d.op.data(1);
s:= modiffil(tf_gruppeidenter,gr,zi);
if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
fil(zi).iaf(1):= gruppetabel(gr);
res:= 3;
end;
end;
slut_definer:
<*slet fil*>
start_operation(fil_op,curr_coruid,cs_fil,104);
d.filop.data(4):= d.op.data(3);
signalch(cs_slet_fil,filop,vt_optype);
waitch(cs_fil,filop,vt_optype,-1);
if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
d.op.resultat:= res;
goto returner;
\f
message procedure vt_gruppe side 4 - 810409/cl;
slet:
disable
begin
gr:= 0; res:= 0;
for i:= 1 step 1 until max_antal_grupper do
begin
if gruppetabel(i)=d.op.data(1) then gr:= i;
end;
if gr = 0 then res:= 8 <*gruppe ej defineret*>
else
begin
for i:= 1 step 1 until max_antal_gruppeopkald do
if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
if res = 0 then
begin
gruppetabel(gr):= 0;
s:= modif_fil(tf_gruppeidenter,gr,zi);
if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
fil(zi).iaf(1):= gruppetabel(gr);
res:= 3;
end;
end;
d.op.resultat:= res;
end;
goto returner;
\f
message procedure vt_gruppe side 5 - 810505/cl;
vis:
disable
begin
res:= 0; gr:= 0; antal:= 0; filref:= 0;
for i:= 1 step 1 until max_antal_grupper do
if gruppetabel(i) = d.op.data(1) then gr:= i;
if gr = 0 then res:= 8
else
begin
s:= læsfil(tf_gruppedef,gr,zi);
if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
for i:= 1 step 1 until max_antal_i_gruppe do
begin
identer(i):= fil(zi).iaf(i);
if identer(i) <> 0 then antal:= antal +1;
end;
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= antal; <*postantal*>
d.filop.data(2):= 1; <*postlængde*>
d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
d.filop.data(5):= d.filop.data(6):=
d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
signalch(cs_opret_fil,filop,vt_optype);
end;
end;
if res <> 0 then goto slut_vis;
waitch(cs_fil,filop,vt_optype,-1);
disable
begin
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
filref:= d.filop.data(4);
for i:= 1 step 1 until antal do
begin
s:= skrivfil(filref,i,zi);
if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
fil(zi).iaf(1):= identer(i);
end;
res:= 3;
end;
slut_vis:
d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
goto returner;
\f
message procedure vt_gruppe side 6 - 810508/cl;
oversigt:
disable
begin
res:= 0; antal:= 0; filref:= 0; iaf:= 0;
for i:= 1 step 1 until max_antal_grupper do
begin
if gruppetabel(i) <> 0 then
begin
antal:= antal +1;
identer(antal):= gruppetabel(i);
end;
end;
start_operation(filop,curr_coruid,cs_fil,101);
d.filop.data(1):= antal; <*postantal*>
d.filop.data(2):= 1; <*postlængde*>
d.filop.data(3):= if antal = 0 then 1 else
(antal-1)//256 +1; <*segm.antal*>
d.filop.data(4):= 2 shift 10; <*spool fil*>
d.filop.data(5):= d.filop.data(6):=
d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
signalch(cs_opretfil,filop,vt_optype);
end;
waitch(cs_fil,filop,vt_optype,-1);
disable
begin
if d.filop.data(9) <> 0 then
fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
filref:= d.filop.data(4);
for i:= 1 step 1 until antal do
begin
s:= skriv_fil(filref,i,zi);
if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
fil(zi).iaf(1):= identer(i);
end;
d.op.resultat:= 3; <*ok*>
d.op.data(1):= antal;
d.op.data(2):= filref;
end;
\f
message procedure vt_gruppe side 7 - 810505/cl;
returner:
disable
begin
<*+2*>
<**> if testbit43 and overvåget and (funk=1 or funk=2) then
<**> begin
<**> skriv_vt_gruppe(out,0);
<**> write(out,<: gruppetabel efter ændring:>);
<**> p_gruppetabel(out);
<**> end;
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_gruppe(out,0);
<**> write(out,<: returner operation:>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
end;
goto vent_op;
vt_grp_trap:
disable skriv_vt_gruppe(zbillede,1);
end vt_gruppe;
\f
message procedure vt_spring side 1 - 810506/cl;
procedure vt_spring(cs_spring_retur,spr_opref);
value cs_spring_retur,spr_opref;
integer cs_spring_retur,spr_opref;
begin
integer array field komm_op,spr_op,iaf;
real nu;
integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
procedure skriv_vt_spring(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ vt_spring :>);
if omfang <> 0 then
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-spring-retur:>,cs_spring_retur,"nl",1,
<:spr-op :>,spr_op,"nl",1,
<:komm-op :>,komm_op,"nl",1,
<:funk :>,funk,"nl",1,
<:interval :>,interval,"nl",1,
<:nr :>,nr,"nl",1,
<:i :>,i,"nl",1,
<:s :>,s,"nl",1,
<:id1 :>,id1,"nl",1,
<:id2 :>,id2,"nl",1,
<:res :>,res,"nl",1,
<:res-inf :>,res_inf,"nl",1,
<:medd-kode :>,medd_kode,"nl",1,
<:zi :>,zi,"nl",1,
<:nu :>,<<zddddd.dddd>,nu,"nl",1,
<::>);
end;
end;
\f
message procedure vt_spring side 2 - 810506/cl;
procedure vt_operation(aktion,id1,id2,res,res_inf);
value aktion,id1,id2;
integer aktion,id1,id2,res,res_inf;
begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
integer array field akt_op;
<* vent på adgang til vogntabel *>
waitch(cs_vt_adgang,akt_op,true,-1);
<* start operation *>
disable
begin
start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
d.akt_op.data(1):= id1;
d.akt_op.data(2):= id2;
signalch(cs_vt_opd,akt_op,vt_optype);
end;
<* afvent svar *>
waitch(cs_spring_retur,akt_op,vt_optype,-1);
res:= d.akt_op.resultat;
res_inf:= d.akt_op.data(3);
<*+2*>
<**> disable
<**> if testbit45 and overvåget then
<**> begin
<**> real t;
<**> skriv_vt_spring(out,0);
<**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
<**> skriv_id(out,springtabel(nr,1),0);
<**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
<**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
<**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
<**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
<**> d.akt_op.resultat,"sp",2);
<**> skriv_id(out,d.akt_op.data(1),8);
<**> skriv_id(out,d.akt_op.data(2),8);
<**> skriv_id(out,d.akt_op.data(3),8);
<**> systime(4,springtid(nr),t);
<**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
<**> end;
<*-2*>
<* åbn adgang til vogntabel *>
disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
end vt_operation;
\f
message procedure vt_spring side 2a - 810506/cl;
procedure io_meddelelse(medd_no,bus,linie,springno);
value medd_no,bus,linie,springno;
integer medd_no,bus,linie,springno;
begin
disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
d.spr_op.data(1):= medd_no;
d.spr_op.data(2):= bus;
d.spr_op.data(3):= linie;
d.spr_op.data(4):= springtabel(springno,1);
d.spr_op.data(5):= springtabel(springno,2);
disable signalch(cs_io,spr_op,io_optype or gen_optype);
waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
end;
procedure returner_op(op,res);
value res;
integer array field op;
integer res;
begin
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
d.op.resultat:= res;
signalch(d.op.retur,op,d.op.optype);
end;
\f
message procedure vt_spring side 3 - 810603/cl;
iaf:= 0;
spr_op:= spr_opref;
stack_claim((if cm_test then 198 else 146) + 24);
trap(vt_spring_trap);
for i:= 1 step 1 until max_antal_spring do
begin
springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
springtid(i):= springstart(i):= 0.0;
end;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0);
<**> write(out,<: springtabel efter initialisering:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_spring(out,0);
<*-2*>
\f
message procedure vt_spring side 4 - 810609/cl;
næste_tid: <* find næste tid *>
disable
begin
interval:= -1; <*vent uendeligt*>
systime(1,0.0,nu);
for i:= 1 step 1 until max_antal_spring do
if springtabel(i,3) < 0 then
interval:= 5
else
if springtid(i) <> 0.0 and
( (springtid(i)-nu) < interval or interval < 0 ) then
interval:= (if springtid(i) <= nu then 0 else
round(springtid(i) -nu));
if interval=0 then interval:= 1;
end;
\f
message procedure vt_spring side 4a - 810525/cl;
<* afvent operation eller timeout *>
waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
if komm_op <> 0 then goto afkod_operation;
<* timeout *>
systime(1,0.0,nu);
nr:= 1;
næste_sekv:
if nr > max_antal_spring then goto næste_tid;
if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
begin
nr:= nr +1;
goto næste_sekv;
end;
disable s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
if springtabel(nr,3) < 0 then
begin <* hængende spring *>
if springtid(nr) <= nu then
begin <* spring ikke udført indenfor angivet interval - annuler *>
<* find frit løb *>
disable
begin
id2:= 0;
for i:= 1 step 1 until springtabel(nr,3) extract 12 do
if fil(zi).iaf(2+i) shift (-22) = 1 then
id2:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
end;
<* send meddelelse til io *>
io_meddelelse(5,0,id2,nr);
<* annuler spring*>
for i:= 1,2,3 do springtabel(nr,i):= 0;
springtid(nr):= springstart(nr):= 0.0;
end
else
begin <* forsøg igen *>
\f
message procedure vt_spring side 5 - 810525/cl;
i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
if i = 2 <* første spring ej udført *> then
begin
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
id2:= id1;
vt_operation(12<*udtag*>,id1,id2,res,res_inf);
end
else
begin
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
id2:= id1 shift (-7) shift 7
+ fil(zi).iaf(2+i-2) shift (-12) extract 7;
vt_operation(13<*omkod*>,id1,id2,res,res_inf);
end;
<* check resultat *>
medd_kode:= if res = 3 and i = 2 then 7 else
if res = 3 and i > 2 then 8 else
<* if res = 9 then 1 else
if res =12 then 2 else
if res =14 then 4 else
if res =18 then 3 else *>
0;
if medd_kode > 0 then
io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
id2 else id1,nr);
if res = 3 then
begin <* spring udført *>
disable s:= modiffil(tf_springdef,nr,zi);
if s<>0 then fejlreaktion(7,s,<:spring:>,0);
springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
if i > 2 then fil(zi).iaf(2+i-2):=
fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
end;
end;
end <* hængende spring *>
else
begin
i:= spring_tabel(nr,3) shift (-12);
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
+ id1 shift (-7) shift 7;
vt_operation(13<*omkod*>,id1,id2,res,res_inf);
\f
message procedure vt_spring side 6 - 820304/cl;
<* check resultat *>
medd_kode:= if res = 3 then 8 else
if res = 9 then 1 else
if res =12 then 2 else
if res =14 then 4 else
if res =18 then 3 else
if res =60 then 9 else 0;
if medd_kode > 0 then
io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
<* opdater springtabel *>
disable s:= modiffil(tf_springdef,nr,zi);
if s<>0 then fejlreaktion(7,s,<:spring:>,0);
if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
begin
io_meddelelse(if res=3 then 6 else 5,0,
if res=3 then id1 else id2,nr);
for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
springtid(nr):= springstart(nr):= 0.0;
end
else
begin
springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
if res = 3 then
begin
fil(zi).iaf(2+i-1):= (1 shift 23) add
(fil(zi).iaf(2+i-1) extract 22);
fil(zi).iaf(2+i) := (1 shift 22) add
(fil(zi).iaf(2+i) extract 22);
springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
end
else
springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
end;
end;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
nr:= nr +1;
goto næste_sekv;
\f
message procedure vt_spring side 7 - 810506/cl;
afkod_operation:
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
<**> skriv_op(out,komm_op);
<**> end;
<*-2*>
disable
begin integer opk;
opk:= d.komm_op.opkode extract 12;
funk:= if opk = 30 <*sp,d*> then 5 else
if opk = 31 <*sp. *> then 1 else
if opk = 32 <*sp,v*> then 4 else
if opk = 33 <*sp,o*> then 6 else
if opk = 34 <*sp,r*> then 2 else
if opk = 35 <*sp,a*> then 3 else
0;
if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
if funk <> 6 <*sp,o*> then
begin <* find nr i springtabel *>
nr:= 0;
for i:= 1 step 1 until max_antal_spring do
if springtabel(i,1) = d.komm_op.data(1) and
springtabel(i,2) = d.komm_op.data(2) then nr:= i;
end;
end;
if funk = 6 then goto oversigt;
if funk = 5 then goto definer;
if nr = 0 then
begin
returner_op(komm_op,37<*spring ukendt*>);
goto næste_tid;
end;
goto case funk of(start,indsæt,annuler,vis);
\f
message procedure vt_spring side 8 - 810525/cl;
start:
if springtabel(nr,3) shift (-12) <> 0 then
begin returner_op(komm_op,38); goto næste_tid; end;
disable
begin <* find linie_løb_og_udtag *>
s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
id1:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
id2:= 0;
end;
vt_operation(12,id1,id2,res,res_inf);
disable <* check resultat *>
medd_kode:= if res = 3 <*ok*> then 7 else
if res = 9 <*linie/løb ukendt*> then 1 else
if res =14 <*optaget*> then 4 else
if res =18 <*i kø*> then 3 else 0;
returner_op(komm_op,3);
if medd_kode = 0 then goto næste_tid;
<* send spring-meddelelse til io *>
io_meddelelse(medd_kode,res_inf,id1,nr);
<* opdater springtabel *>
disable
begin
s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
add (springtabel(nr,3) extract 12);
systime(1,0.0,nu);
springstart(nr):= nu;
springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
end;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
\f
message procedure vt_spring side 9 - 810506/cl;
indsæt:
if springtabel(nr,3) shift (-12) = 0 then
begin <* ikke igangsat *>
returner_op(komm_op,41);
goto næste_tid;
end;
<* find frie linie/løb *>
disable
begin
s:= læs_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
id2:= 0;
for i:= 1 step 1 until springtabel(nr,3) extract 12 do
if fil(zi).iaf(2+i) shift (-22) = 1 then
id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
+fil(zi).iaf(2+i) shift (-12) extract 7;
id1:= d.komm_op.data(3);
end;
if id2<>0 then
vt_operation(11,id1,id2,res,res_inf)
else
res:= 42;
disable <* check resultat *>
medd_kode:= if res = 3 <*ok*> then 8 else
if res =10 <*bus ukendt*> then 0 else
if res =11 <*bus allerede indsat*> then 0 else
if res =12 <*linie/løb allerede besat*> then 2 else
if res =42 <*intet frit linie/løb*> then 5 else 0;
if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
returner_op(komm_op,res);
if medd_kode = 0 then goto næste_tid;
<* send springmeddelelse til io *>
if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
io_meddelelse(5,0,0,nr);
\f
message procedure vt_spring side 9a - 810525/cl;
<* annuler springtabel *>
for i:= 1,2,3 do springtabel(nr,i):= 0;
springtid(nr):= springstart(nr):= 0.0;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
\f
message procedure vt_spring side 10 - 810525/cl;
annuler:
disable
begin <* find evt. frit linie/løb *>
s:= læs_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
id1:= id2:= 0;
for i:= 1 step 1 until springtabel(nr,3) extract 12 do
if fil(zi).iaf(2+i) shift (-22) = 1 then
id2:= fil(zi).iaf(1) extract 15 shift 7
+ fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
returner_op(komm_op,3);
end;
<* send springmeddelelse til io *>
io_meddelelse(5,id1,id2,nr);
<* annuler springtabel *>
for i:= 1,2,3 do springtabel(nr,i):= 0;
springtid(nr):= springstart(nr):= 0.0;
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
definer:
if nr <> 0 then <* allerede defineret *>
begin
res:= 36;
goto slut_definer;
end;
<* find frit nr *>
i:= 0;
for i:= i+1 while i<= max_antal_spring and nr = 0 do
if springtabel(i,1) = 0 then nr:= i;
if nr = 0 then
begin
res:= 32; <* ingen fri plads *>
goto slut_definer;
end;
\f
message procedure vt_spring side 11 - 810525/cl;
disable
begin integer array fdim(1:8),ia(1:32);
<* læs sekvens *>
fdim(4):= d.komm_op.data(3);
s:= hent_fil_dim(fdim);
if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
if fdim(1) > 30 then
res:= 35 <* springsekvens for stor *>
else
begin
for i:= 1 step 1 until fdim(1) do
begin
s:= læs_fil(fdim(4),i,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
ia(i):= fil(zi).iaf(1) shift 12;
if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
end;
s:= modif_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
iaf:= 4;
tofrom(fil(zi).iaf,ia,60);
iaf:= 0;
springtabel(nr,3):= fdim(1);
springtid(nr):= springstart(nr):= 0.0;
res:= 3;
end;
end;
\f
message procedure vt_spring side 11a - 81-525/cl;
slut_definer:
<* slet fil *>
start_operation(spr_op,curr_coruid,cs_spring_retur,104);
d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
signalch(cs_slet_fil,spr_op,vt_optype);
waitch(cs_spring_retur,spr_op,vt_optype,-1);
if d.spr_op.data(9) <> 0 then
fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
returner_op(komm_op,res);
<*+2*>
<**> disable
<**> if testbit44 and overvåget then
<**> begin
<**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
<**> p_springtabel(out); ud;
<**> end;
<*-2*>
goto næste_tid;
\f
message procedure vt_spring side 12 - 810525/cl;
vis:
disable
begin
<* tilknyt fil *>
start_operation(spr_op,curr_coruid,cs_spring_retur,101);
d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
d.spr_op.data(2):= 1;
d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
signalch(cs_opret_fil,spr_op,vt_optype);
end;
<* afvent svar *>
waitch(cs_spring_retur,spr_op,vt_optype,-1);
if d.spr_op.data(9) <> 0 then
fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
disable
begin integer array ia(1:30);
s:= læs_fil(tf_springdef,nr,zi);
if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
iaf:= 4;
tofrom(ia,fil(zi).iaf,60);
iaf:= 0;
for i:= 1 step 1 until d.spr_op.data(1) do
begin
s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
ia(i) shift (-12) extract 7
else -(ia(i) shift (-12) extract 7);
s:= skriv_fil(d.spr_op.data(4),2*i,zi);
if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
fil(zi).iaf(1):= if i < d.spr_op.data(1) then
(if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
else ia(i) extract 12)
else 0;
end;
d.spr_op.data(1):= d.spr_op.data(1) - 1;
sæt_fil_dim(d.spr_op.data);
d.komm_op.data(3):= d.spr_op.data(1);
d.komm_op.data(4):= d.spr_op.data(4);
raf:= data+8;
d.komm_op.raf(1):= springstart(nr);
returner_op(komm_op,3);
end;
goto næste_tid;
\f
message procedure vt_spring side 13 - 810525/cl;
oversigt:
disable
begin
<* opret fil *>
start_operation(spr_op,curr_coruid,cs_spring_retur,101);
d.spr_op.data(1):= max_antal_spring;
d.spr_op.data(2):= 4;
d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
signalch(cs_opret_fil,spr_op,vt_optype);
end;
<* afvent svar *>
waitch(cs_spring_retur,spr_op,vt_optype,-1);
if d.spr_op.data(9) <> 0 then
fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
disable
begin
nr:= 0;
for i:= 1 step 1 until max_antal_spring do
begin
if springtabel(i,1) <> 0 then
begin
nr:= nr +1;
s:= skriv_fil(d.spr_op.data(4),nr,zi);
if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
fil(zi).iaf(1):= springtabel(i,1);
fil(zi).iaf(2):= springtabel(i,2);
fil(zi,2):= springstart(i);
end;
end;
d.spr_op.data(1):= nr;
s:= sæt_fil_dim(d.spr_op.data);
if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
d.komm_op.data(1):= nr;
d.komm_op.data(2):= d.spr_op.data(4);
returner_op(komm_op,3);
end;
goto næste_tid;
vt_spring_trap:
disable skriv_vt_spring(zbillede,1);
end vt_spring;
\f
message procedure vt_auto side 1 - 810505/cl;
procedure vt_auto(cs_auto_retur,auto_opref);
value cs_auto_retur,auto_opref;
integer cs_auto_retur,auto_opref;
begin
integer array field op,auto_op,iaf;
integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
res_inf,i,s,zi,kl,døgnstart;
real t,nu,næste_tid;
boolean optaget;
integer array filnavn,nytnavn(1:4);
procedure skriv_vt_auto(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
long array field laf;
laf:= 0;
write(zud,"nl",1,<:+++ vt_auto :>);
if omfang<>0 then
begin
skriv_coru(zud,abs curr_coruno);
write(zud,"nl",1,<<d>,
<:cs-auto-retur :>,cs_auto_retur,"nl",1,
<:op :>,op,"nl",1,
<:auto-op :>,auto_op,"nl",1,
<:filref :>,filref,"nl",1,
<:id1 :>,id1,"nl",1,
<:id2 :>,id2,"nl",1,
<:aktion :>,aktion,"nl",1,
<:postnr :>,postnr,"nl",1,
<:sidste-post :>,sidste_post,"nl",1,
<:interval :>,interval,"nl",1,
<:res :>,res,"nl",1,
<:res-inf :>,res_inf,"nl",1,
<:i :>,i,"nl",1,
<:s :>,s,"nl",1,
<:zi :>,zi,"nl",1,
<:kl :>,kl,"nl",1,
<:døgnstart :>,døgnstart,"nl",1,
<:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
<:t :>,<<zddddd.dddd>,t,"nl",1,
<:nu :>,nu,"nl",1,
<:næste-tid :>,næste_tid,"nl",1,
<:filnavn :>,filnavn.laf,"nl",1,
<:nytnavn :>,nytnavn.laf,"nl",1,
<::>);
end;
end skriv_vt_auto;
\f
message procedure vt_auto side 2 - 810507/cl;
iaf:= 0;
auto_op:= auto_opref;
filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
optaget:= false;
næste_tid:= 0.0;
for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
stack_claim(if cm_test then 298 else 246);
trap(vt_auto_trap);
<*+2*>
<**> disable if testbit47 and overvåget or testbit28 then
<**> skriv_vt_auto(out,0);
<*-2*>
vent:
systime(1,0.0,nu);
interval:= if filref=0 then (-1) <*uendeligt*> else
if næste_tid > nu then round(næste_tid-nu) else
if optaget then 5 else 0;
if interval=0 then interval:= 1;
<*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
if op<>0 then goto filskift;
<* vent på adgang til vogntabel *>
<*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
<* afsend relevant operation til opdatering af vogntabel *>
start_operation(op,curr_coruid,cs_auto_retur,aktion);
d.op.data(1):= id1;
d.op.data(2):= id2;
signalch(cs_vt_opd,op,vt_optype);
<*v*> waitch(cs_auto_retur,op,vt_optype,-1);
res:= d.op.resultat;
id2:= d.op.data(2);
res_inf:= d.op.data(3);
<* åbn for vogntabel *>
signalch(cs_vt_adgang,op,vt_optype or gen_optype);
\f
message procedure vt_auto side 3 - 810507/cl;
<* behandl svar fra opdatering *>
<*+2*>
<**> disable
<**> if testbit45 and overvåget then
<**> begin
<**> integer li,lø,bo;
<**> skriv_vt_auto(out,0);
<**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
<**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
<**> <:: OMKOD:>,<: - RES=:>,res);
<**> for i:= 1,2 do
<**> begin
<**> li:= d.op.data(i);
<**> lø:= li extract 7; bo:= li shift (-7) extract 5;
<**> if bo<>0 then bo:= bo + 'A' - 1;
<**> li:= li shift (-12) extract 10;
<**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
<**> end;
<**> systime(4,næste_tid,t);
<**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
<**> << zd.dd>,t/10000,"nl",1);
<**> end;
<*-2*>
if res=31 then
fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
else
if res<>3 then
begin
if -, optaget then
begin
disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
if res=18 then 3 else if res=60 then 9 else 4;
d.auto_op.data(2):= res_inf;
d.auto_op.data(3):= if res=12 then id2 else id1;
signalch(cs_io,auto_op,io_optype or gen_optype);
waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
end;
if res=14 or res=18 then <* i kø eller optaget *>
begin
optaget:= true;
goto vent;
end;
end;
optaget:= false;
\f
message procedure vt_auto side 4 - 810507/cl;
<* find næste post *>
disable
begin
if postnr=sidste_post then
begin <* døgnskift *>
postnr:= 1;
døgnstart:= systime(4,systid(døgnstart+1,120000),t);
end
else postnr:= postnr+1;
s:= læsfil(filref,postnr,zi);
if s<>0 then fejlreaktion(5,s,<:auto:>,0);
aktion:= fil(zi).iaf(1);
næste_tid:= systid(døgnstart,fil(zi).iaf(2));
id1:= fil(zi).iaf(3);
id2:= fil(zi).iaf(4);
end;
goto vent;
\f
message procedure vt_auto side 5 - 810507/cl;
filskift:
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_auto(out,0);
<**> write(out,<: modtaget operation::>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
res:= 46;
if d.op.opkode extract 12 <> 21 then
fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
if filref = 0 then goto knyt;
<* gem filnavn til io-meddelelse *>
disable begin
integer array fdim(1:8);
integer array field navn;
fdim(4):= filref;
hentfildim(fdim);
navn:= 8;
tofrom(filnavn,fdim.navn,8);
end;
<* frivgiv tilknyttet autofil *>
disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
d.auto_op.data(4):= filref;
signalch(cs_frigiv_fil,auto_op,vt_optype);
<*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
if d.auto_op.data(9) <> 0 then
fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
optaget:= false;
næste_tid:= 0.0;
res:= 3;
\f
message procedure vt_auto side 6 - 810507/cl;
<* tilknyt evt. ny autofil *>
knyt:
if d.op.data(1)<>0 then
begin
disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
disable
begin integer pos1,pos2;
pos1:= pos2:= 13;
while læstegn(d.auto_op.data,pos1,i)<>0 do
begin
if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
skrivtegn(d.auto_op.data,pos2,i);
end;
end;
signalch(cs_tilknyt_fil,auto_op,vt_optype);
<*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
s:= d.auto_op.data(9);
if s=0 then res:= 3 <* ok *> else
if s=1 or s=2 then res:= 46 <* ukendt navn *> else
if s=5 or s=7 then res:= 47 <* galt indhold *> else
if s=6 then res:= 48 <* i brug *> else
fejlreaktion(14,2,<:auto,filskift:>,0);
if res<>3 then goto returner;
tofrom(nytnavn,d.op.data,8);
<* find første post *>
disable
begin
døgnstart:= systime(5,0.0,t);
kl:= round t;
filref:= d.auto_op.data(4);
sidste_post:= d.auto_op.data(1);
postnr:= 0;
for postnr:= postnr+1 while postnr <= sidste_post do
begin
s:= læsfil(filref,postnr,zi);
if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
if fil(zi).iaf(2) > kl then goto post_fundet;
end;
postnr:= 1;
døgnstart:= systime(4,systid(døgnstart+1,120000),t);
\f
message procedure vt_auto side 7 - 810507/cl;
post_fundet:
s:= læsfil(filref,postnr,zi);
if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
aktion:= fil(zi).iaf(1);
næste_tid:= systid(døgnstart,fil(zi).iaf(2));
id1:= fil(zi).iaf(3);
id2:= fil(zi).iaf(4);
res:= 3;
end;
end ny fil;
returner:
d.op.resultat:= res;
<*+2*>
<**> disable
<**> if testbit41 and overvåget then
<**> begin
<**> skriv_vt_auto(out,0);
<**> write(out,<: returner operation::>);
<**> skriv_op(out,op);
<**> end;
<*-2*>
signalch(d.op.retur,op,d.op.optype);
if vt_log_aktiv then
begin
waitch(cs_vt_logpool,op,vt_optype,-1);
startoperation(op,curr_coruid,cs_vt_logpool,0);
if nytnavn(1)=0 then
hægtstring(d.op.data.v_tekst,1,<:ophør:>)
else
skriv_text(d.op.data.v_tekst,1,nytnavn);
d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
systime(1,0.0,d.op.data.v_tid);
signalch(cs_vt_log,op,vt_optype);
end;
if filnavn(1)<>0 then
begin <* meddelelse til io om annulering *>
disable begin
start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
i:= 1;
hægtstring(d.auto_op.data,i,<:auto :>);
skriv_text(d.auto_op.data,i,filnavn);
hægtstring(d.auto_op.data,i,<: annuleret:>);
repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
signalch(cs_io,auto_op,io_optype or gen_optype);
end;
waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
end;
goto vent;
vt_auto_trap:
disable skriv_vt_auto(zbillede,1);
end vt_auto;
message procedure vt_log side 1 - 920517/cl;
procedure vt_log;
begin
integer i,j,ventetid;
real dg,t,nu,skiftetid;
boolean fil_åben;
integer array ia(1:10),dp,dp1(1:8);
integer array field op, iaf;
procedure skriv_vt_log(zud,omfang);
value omfang;
zone zud;
integer omfang;
begin
write(zud,"nl",1,<:+++ vt-log :>);
if omfang<>0 then
begin
skriv_coru(zud, abs curr_coruno);
write(zud,"nl",1,<<d>,
<:i :>,i,"nl",1,
<:j :>,j,"nl",1,
<:ventetid :>,ventetid,"nl",1,
<:dg :>,<<zddddd.dd>,dg,"nl",1,
<:t :>,t,"nl",1,
<:nu :>,nu,"nl",1,
<:skiftetid :>,skiftetid,"nl",1,
<:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
<:op :>,<<d>,op,"nl",1,
<::>);
raf:= 0;
write(zud,"nl",1,<:ia::>);
skrivhele(zud,ia.raf,20,2);
write(zud,"nl",2,<:dp::>);
skrivhele(zud,dp.raf,16,2);
write(zud,"nl",2,<:dp1::>);
skrivhele(zud,dp1.raf,16,2);
end;
end;
message procedure vt_log side 2 - 920517/cl;
procedure slet_fil;
begin
integer segm,res;
integer array tail(1:10);
res:= monitor(42)lookup_entry:(zvtlog,0,tail);
if res=0 then
begin
segm:= tail(10);
res:=monitor(48)remove_entry:(zvtlog,0,tail);
if res=0 then
begin
close(zvtlog,true);
open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
res:=monitor(42)lookup_entry:(zvtlog,0,tail);
if res=0 then
begin
tail(1):= tail(1)+segm;
monitor(44)change_entry:(zvtlog,0,tail);
end;
end;
end;
end;
boolean procedure udvid_fil;
begin
integer res,spos;
integer array tail(1:10);
zone z(1,1,stderror);
udvid_fil:= false;
open(z,0,<:vtlogpool:>,0); close(z,true);
res:= monitor(42)lookup_entry:(z,0,tail);
if (res=0) and (tail(1) >= vt_log_slicelgd) then
begin
tail(1):=tail(1) - vt_log_slicelgd;
res:=monitor(44)change_entry:(z,0,tail);
if res=0 then
begin
spos:= vt_logtail(1);
vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
if res<>0 then
begin
vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
tail(1):= tail(1) + vt_log_slicelgd;
monitor(44)change_entry:(z,0,tail);
end
else
begin
setposition(zvtlog,0,spos);
udvid_fil:= true;
end;
end;
end;
end;
message procedure vt_log side 3 - 920517/cl;
boolean procedure ny_fil;
begin
integer res,i,j;
integer array nyt(1:4), ia,tail(1:10);
long array field navn;
real t;
navn:=0;
if fil_åben then
begin
close(zvtlog,true);
fil_åben:= false;
nyt.navn(1):= long<:vtlo:>;
nyt.navn(2):= long<::>;
anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
j:= 'a' - 1;
repeat
res:=monitor(46)rename_entry:(zvtlog,0,nyt);
if res=3 then
begin
j:= j+1;
if j <= 'å' then skrivtegn(nyt,11,j);
end;
until (res<>3) or (j > 'å');
if res=0 then
begin
open(zvtlog,4,<:vtlogklar:>,0);
res:=monitor(42)lookup_entry:(zvtlog,0,tail);
if res=0 then
res:=monitor(52)create_areaproc:(zvtlog,0,ia);
if res=0 then
begin
res:=monitor(8)reserve_process:(zvtlog,0,ia);
if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if res=0 then
begin
setposition(zvtlog,0,tail(10)//64);
navn:= (tail(10) mod 64)*8;
if (tail(1) <= tail(10)//64) then
outrec6(zvtlog,512)
else
swoprec6(zvtlog,512);
tofrom(zvtlog.navn,nyt,8);
tail(10):= tail(10)+1;
setposition(zvtlog,0,tail(10)//64);
monitor(44)change_entry:(zvtlog,0,tail);
close(zvtlog,true);
end
else
begin
navn:= 0;
close(zvtlog,true);
open(zvtlog,4,<:vtlog:>,0);
slet_fil;
end;
end
else
slet_fil;
end;
<* logfilen er nu omdøbt og indskrevet i vtlogklar *>
<* eller den er blevet slettet. *>
open(zvtlog,4,<:vtlog:>,0);
for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
vt_logtail(6):= systime(7,0,t);
res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
if res=0 then
begin
monitor(50)permanent_entry:(zvtlog,3,ia);
if res<>0 then
monitor(48)remove_entry:(zvtlog,0,ia);
end;
if res=0 then fil_åben:= true;
ny_fil:= fil_åben;
end ny_fil;
message procedure vt_log side 4 - 920517/cl;
procedure skriv_post(logpost);
integer array logpost;
begin
integer array field post;
real t;
if vt_logtail(10)//32 < vt_logtail(1) then
begin
outrec6(zvtlog,512);
post:= (vt_logtail(10) mod 32)*16;
tofrom(zvtlog.post,logpost,16);
vt_logtail(10):= vt_logtail(10)+1;
setposition(zvtlog,0,vt_logtail(10)//32);
vt_logtail(6):= systime(7,0,t);
monitor(44)change_entry:(zvtlog,0,vt_logtail);
end;
end;
procedure sletsendte;
begin
zone z(128,1,stderror), zpool,zlog(1,1,stderror);
integer array pooltail,tail,ia(1:10);
integer i,res;
open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
res:=monitor(42,zpool,0,pooltail);
open(z,4,<:vtlogslet:>,0);
if monitor(42,z,0,tail)=0 and tail(10)>0 then
begin
if monitor(52,z,0,tail)=0 then
begin
if monitor(8,z,0,tail)=0 then
begin
for i:=1 step 1 until tail(10) do
begin
inrec6(z,8);
open(zlog,0,z,0); close(zlog,true);
if monitor(42,zlog,0,ia)=0 then
begin
if monitor(48,zlog,0,ia)=0 then
begin
pooltail(1):=pooltail(1)+ia(1);
end;
end;
end;
tail(10):=0;
monitor(44,z,0,tail);
end
else
monitor(64,z,0,tail);
end;
if res=0 then monitor(44,zpool,0,pooltail);
end;
close(z,true);
end;
message procedure vt_log side 5 - 920517/cl;
trap(vt_log_trap);
stack_claim(200);
fil_åben:= false;
if -, vt_log_aktiv then goto init_slut;
open(zvtlog,4,<:vtlog:>,0);
i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
if i=0 then
i:=monitor(52)create_areaproc:(zvtlog,0,ia);
if i=0 then
begin
i:=monitor(8)reserve_process:(zvtlog,0,ia);
if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if (i=0) and (vt_logtail(1)=0) then
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
i:= 1;
end;
disable
if i=0 then
begin
fil_åben:= true;
inrec6(zvtlog,512);
vt_logstart:= zvtlog.v_tid;
systime(1,0.0,nu);
if (nu - vt_logstart) < 24*60*60.0 then
begin
setposition(zvtlog,0,vt_logtail(10)//32);
if (vt_logtail(10)//32) < vt_logtail(1) then
begin
inrec6(zvtlog,512);
setposition(zvtlog,0,vt_logtail(10)//32);
end;
end
else
begin
if ny_fil then
begin
if udvid_fil then
begin
systime(1,0.0,dp.v_tid);
vt_logstart:= dp.v_tid;
dp.v_kode:=0;
skriv_post(dp);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
end
else
begin
close(zvtlog,true);
if ny_fil then
begin
if udvid_fil then
begin
systime(1,0.0,dp.v_tid);
vt_logstart:= dp.v_tid;
dp.v_kode:=0;
skriv_post(dp);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
init_slut:
dg:= systime(5,0,t);
if t < vt_logskift then
skiftetid:= systid(dg,vt_logskift)
else
skiftetid:= systid(dg+1,vt_logskift);
message procedure vt_log side 6 - 920517/cl;
vent:
systime(1,0.0,nu); dg:= systime(5,0.0,t);
ventetid:= round(skiftetid - nu);
if ventetid < 1 then ventetid:= 1;
<*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
systime(1,0.0,nu); dg:=systime(4,nu,t);
if op <> 0 then
begin
tofrom(dp,d.op.data,16);
signalch(cs_vt_logpool,op,vt_optype);
end;
if -, vt_log_aktiv then goto vent;
disable if (op=0) or (nu > skiftetid) then
begin
if fil_åben then
begin
dp1.v_tid:= systid(dg,vt_logskift);
dp1.v_kode:= 1;
if (vt_logtail(10)//32) >= vt_logtail(1) then
begin
if udvid_fil then
skriv_post(dp1);
end
else
skriv_post(dp1);
end;
if (op=0) or (nu > skiftetid) then
skiftetid:= skiftetid + 24*60*60.0;
sletsendte;
if ny_fil then
begin
if udvid_fil then
begin
vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
dp1.v_kode:= 0;
skriv_post(dp1);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
disable if op<>0 and fil_åben then
begin
if (vt_logtail(10)//32) >= vt_logtail(1) then
begin
if -, udvid_fil then
begin
if ny_fil then
begin
if udvid_fil then
begin
systime(1,0.0,dp1.v_tid);
vt_logstart:= dp1.v_tid;
dp1.v_kode:= 0;
skriv_post(dp1);
end
else
begin
close(zvtlog,true);
monitor(48)remove_entry:(zvtlog,0,ia);
fil_åben:= false;
end;
end;
end;
end;
if fil_åben then skriv_post(dp);
end;
goto vent;
vt_log_trap:
disable skriv_vt_log(zbillede,1);
end vt_log;
\f
algol list.off;
message coroutinemonitor - 11 ;
<*************** coroutine monitor procedures ***************>
<***** delay *****
this procedure links the calling coroutine into the timerqueue and sets
the timeout value to 'timeout'. *>
procedure delay (timeout);
value timeout;
integer timeout;
begin
link(current, idlequeue);
link(current + corutimerchain, timerqueue);
d.current.corutimer:= timeout;
passivate;
d.current.corutimer:= 0;
end;
\f
message coroutinemonitor - 12 ;
<***** pass *****
this procedure moves the calling coroutine from the head of the ready
queue down below all coroutines of lower or equal priority. *>
procedure pass;
begin
linkprio(current, readyqueue);
passivate;
end;
<***** signal ****
this procedure increases the value af 'semaphore' by 1.
in case some coroutine is already waiting, it is linked into the ready
queue for activation. the calling coroutine continues execution. *>
procedure signal (semaphore);
value semaphore;
integer semaphore;
begin
integer array field sem;
sem:= semaphore;
if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
d.sem.simvalue:= d.sem.simvalue + 1;
end;
\f
message coroutinemonitor - 13 ;
<***** wait *****
this procedure decreases the value of 'semaphore' by 1.
in case the value of the semaphore is negative after the decrease, the
calling coroutine is linked into the semaphore queue waiting for a
coroutine to signal this semaphore. *>
procedure wait (semaphore);
value semaphore;
integer semaphore;
begin
integer array field sem;
sem:= semaphore;
d.sem.simvalue:= d.sem.simvalue - 1;
linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
passivate;
end;
\f
message coroutinemonitor - 14 ;
<***** inspect *****
this procedure inspects the value of the semaphore and returns it in
'elements'.
the semaphore is left unchanged. *>
procedure inspect (semaphore, elements);
value semaphore;
integer semaphore, elements;
begin
integer array field sem;
sem:= semaphore;
elements:= d.sem.simvalue;
end;
\f
message coroutinemonitor - 15 ;
<***** signalch *****
this procedure delivers an operation at 'semaphore'.
in case another coroutine is already waiting for an operation of the
kind 'operationtype' this coroutine will get the operation and it will
be put into the ready queue for activation.
in case no coroutine is waiting for the actial kind of operation it is
linked into the semaphore queue, at the end of the queue
if operation is positive and at the beginning if operation is negative.
the calling coroutine continues execution. *>
procedure signalch (semaphore, operation, operationtype);
value semaphore, operation, operationtype;
integer semaphore, operation;
boolean operationtype;
begin
integer array field firstcoru, currcoru, op,currop;
op:= abs operation;
d.op.optype:= operationtype;
firstcoru:= semaphore + semcoru;
currcoru:= d.firstcoru.next;
while currcoru <> firstcoru do
begin
if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
begin
link(operation, 0);
d.currcoru.coruop:= operation;
linkprio(currcoru, readyqueue);
link(currcoru + corutimerchain, idlequeue);
goto exit;
end else currcoru:= d.currcoru.next;
end;
currop:=semaphore + semop;
if operation < 0 then currop:=d.currop.next;
link(op, currop);
exit:
end;
\f
message coroutinemonitor - 16 ;
<***** waitch *****
this procedure fetches an operation from a semaphore.
in case an operation matching 'operationtypeset' is already waiting at
'semaphore' it is handed over to the calling coroutine.
in case no matching operation is waiting, the calling coroutine is
linked to the semaphore.
in any case the calling coroutine will be stopped and all corouti-
nes are rescheduled. *>
procedure waitch (semaphore, operation, operationtypeset, timeout);
value semaphore, operationtypeset, timeout;
integer semaphore, operation, timeout;
boolean operationtypeset;
begin
integer array field firstop, currop;
firstop:= semaphore + semop;
currop:= d.firstop.next;
while currop <> firstop do
begin
if (d.currop.optype and operationtypeset) extract 12 <> 0 then
begin
link(currop, 0);
d.current.coruop:= currop;
operation:= currop;
\f
message coroutinemonitor - 17 ;
linkprio(current, readyqueue);
passivate;
goto exit;
end else currop:= d.currop.next;
end;
linkprio(current, semaphore + semcoru);
if timeout > 0 then
begin
link(current + corutimerchain, timerqueue);
d.current.corutimer:= timeout;
end else d.current.corutimer:= 0;
d.current.corutypeset:= operationtypeset;
passivate;
if d.current.corutimer < 0 then operation:= 0
else operation:= d.current.coruop;
d.current.corutimer:= 0;
currop:= operation;
d.current.coruop:= currop;
link(current+corutimerchain, idlequeue);
exit:
end;
\f
message coroutinemonitor - 18 ;
<***** inspectch *****
this procedure inspects the queue of operations waiting at 'semaphore'.
the number of matching operations are counted and delivered in 'elements'.
if no operations are found the number of coroutines waiting
for operations of the typeset are counted and delivered as
negative value in 'elements'.
the semaphore is left unchanged. *>
procedure inspectch (semaphore, operationtypeset, elements);
value semaphore, operationtypeset;
integer semaphore, elements;
boolean operationtypeset;
begin
integer array field firstop, currop,firstcoru,currcoru;
integer counter;
counter:= 0;
firstop:= semaphore + semop;
currop:= d.firstop.next;
while currop <> firstop do
begin
if (operationtypeset and d.currop.optype) extract 12 <> 0 then
counter:= counter + 1;
currop:= d.currop.next;
end;
if counter=0 then
begin
firstcoru:=semaphore + sem_coru;
curr_coru:=d.firstcoru.next;
while curr_coru<>first_coru do
begin
if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
counter:=counter - 1;
curr_coru:=d.curr_coru.next;
end;
end;
elements:= counter;
end;
\f
message coroutinemonitor - 19 ;
<***** csendmessage *****
this procedure sends the message in 'mess' to the process defined by the name
in 'receiver', and returns an identification of the message extension used
for sending the message (this identification is to be used for calling 'cwait-
answer' or 'cregretmessage'. *>
procedure csendmessage (receiver, mess, messextension);
real array receiver;
integer array mess;
integer messextension;
begin
integer bufref, messext;
messref(maxmessext):= 0;
messext:= 1;
while messref(messext) <> 0 do messext:= messext + 1;
if messext = maxmessext then <* no resources *> messext:= 0 else
begin
messcode(messext):= 1 shift 12 add 2;
mon(16) send message :(0, mess, 0, receiver);
messref(messext):= monw2;
if monw2 > 0 then messextension:= messext else messextension:= 0;
end;
end;
\f
message coroutinemonitor - 20 ;
<***** cwaitanswer *****
this procedure asks the coroutine monitor to get an answer to the message
corresponding to 'messextension'. in case the answer has already arrived
it stays in the eventqueue until 'cwaitanswer' is called.
in case 'timeout' is positive, the coroutine is linked into the timer
queue, and in case the answer does not arrive within 'timout' seconds the
coroutine is restarted with result = 0. *>
procedure cwaitanswer (messextension, answer, result, timeout);
value messextension, timeout;
integer messextension, result, timeout;
integer array answer;
begin
integer messext;
messext:= messextension;
messcode(messext):= messcode(messext) extract 12;
link(current, idlequeue);
messop(messext):= current;
if timeout > 0 then
begin
link(current + corutimerchain, timerqueue);
d.current.corutimer:= timeout;
end else d.current.corutimer:= 0;
passivate;
if d.current.corutimer < 0 then result:= 0 else
begin
mon(18) wait answer :(0, answer, messref(messextension), 0);
result:= monw0;
baseevent:= 0;
messref(messextension):= 0;
end;
d.current.corutimer:= 0;
link(current+corutimerchain, idlequeue);
end;
\f
message coroutinemonitor - 21 ;
<***** cwaitmessage *****
this procedure asks the coroutine monitor to give it a message, when some-
one arrives. in case a message has arrived already it stays at the event queue
until 'cwaitmessage' is called.
in case 'timeout' is positive, the coroutine is linked into the timer queue,
if no message arrives within 'timeout' seconds, the coroutine is restarted
with messbufferref = 0. *>
procedure cwaitmessage (processextension, mess, messbufferref, timeout);
value timeout, processextension;
integer processextension, messbufferref, timeout;
integer array mess;
begin
integer i;
integer array field messbuf;
proccode(processextension):= 2;
procop(processextension):= current;
link(current, idlequeue);
if timeout > 0 then
begin
link(current + corutimerchain, timerqueue);
d.current.corutimer:= timeout;
end else d.current.corutimer:= 0;
passivate;
if d.current.corutimer < 0 then messbufferref:= 0 else
begin
messbuf:= procop(processextension);
for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
proccode(procext):= 1 shift 12;
messbufferref:= messbuf;
baseevent:= 0;
end;
d.current.corutimer:= 0;
link(current+corutimerchain, idlequeue);
end;
\f
message coroutinemonitor - 22 ;
<***** cregretmessage *****
this procedure regrets the message corresponding to messageexten-
sion, to release message buffer and message extension.
i/o messages are not regretable. *>
procedure cregretmessage (messageextension);
value messageextension;
integer messageextension;
begin
integer array field messbuf;
messbuf:= messref(messageextension);
mon(82) regret message :(0, 0, messbuf, 0);
messref(messageextension):= 0;
end;
\f
message coroutinemonitor - 23 ;
<***** semsendmessage *****
this procedure sends the message 'mess' to 'receiver' and at the same time it
defines a 'signalch(semaphore, operation, operationtype)' to be performed
by the monitor, when the answer arrives.
in case there are too few resources to send the message, the operation is
returned immediately with the result field set to zero. *>
procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
value semaphore, operation, operationtype;
real array receiver;
integer array mess;
integer semaphore, operation;
boolean operationtype;
begin
integer array field op;
integer messext;
op:= operation;
messref(maxmessext):= 0;
messext:= 1;
while messref(messext) <> 0 do messext:= messext + 1;
if messext < maxmessext then
begin
messop(messext):= op;
messcode(messext):=1;
d.op(1):= semaphore;
d.op.optype:= operationtype;
mon(16) send message :(0, mess, 0, receiver);
messref(messext):= monw2;
end;
if messext = maxmessext or messref(messext) = 0 <* no resources *> then
begin <* return the operation immediately with result = 0 *>
d.op(9):= 0;
signalch(semaphore, op, operationtype);
end;
end;
\f
message coroutinemonitor - 24 ;
<***** semwaitmessage *****
this procedure defines a 'signalch(semaphore, operation, operationtype)' to
be performed by the coroutine monitor when a message arrives to the process
corresponding to 'processextension'. *>
procedure semwaitmessage (processextension, semaphore, operation, operationtype);
value processextension, semaphore, operation, operationtype;
integer processextension, semaphore, operation;
boolean operationtype;
begin
integer array field op;
op:= operation;
procop(processextension):= operation;
d.op(1):= semaphore;
d.op.optype:= operationtype;
proccode(processextension):= 1;
end;
\f
message coroutinemonitor - 25 ;
<***** semregretmessage *****
this procedure regrets a message sent by semsendmessage.
the message is identified by the operation in which the answer should be
returned.
the procedure sets the result field of the operation to zero, and then
returns it by performing a signalch. *>
procedure semregretmessage (operation);
value operation;
integer operation;
begin
integer i, j;
integer array field op, sem;
op:= operation;
i:= 1;
while i < maxmessext do
begin
if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
begin
mon(82) regret message :(0, 0, messref(i), 0);
messref(i):= 0;
sem:= d.op(1);
for j:=1 step 1 until 9 do d.op(j):= 0;
signalch(sem, op, d.op.optype);
i:= maxmessext;
end;
i:= i + 1;
end;
end;
\f
message coroutinemonitor - 26 ;
<***** link *****
this procedure links an object (allocated in the descriptor array 'd') into
a queue of alements (allocated in the descriptor array 'd'). the queues
are all double chained, and the chainhead is of the same format as the chain
fields of the objects.
the procedure links the object immediately after the head. *>
procedure link (object, chainhead);
value object, chainhead;
integer object, chainhead;
begin
integer array field prevelement, nextelement, chead, obj;
obj:= object;
chead:= chainhead;
prevelement:= d.obj.prev;
nextelement:= d.obj.next;
d.prevelement.next:= nextelement;
d.nextelement.prev:= prevelement;
if chead > 0 then <* link into queue *>
begin
prevelement:= d.chead.prev;
d.obj.prev:= prevelement;
d.prevelement.next:= obj;
d.obj.next:= chead;
d.chead.prev:= obj;
end else
begin <* link onto itself *>
d.obj.prev:= obj;
d.obj.next:= obj;
end;
end;
\f
message coroutinemonitor - 27 ;
<***** linkprio *****
this procedure is used to link coroutines into queues corresponding to
the priorities of the actual coroutine and the queue elements.
the object is linked immediately before the first coroutine of lower prio-
rity. *>
procedure linkprio (object, chainhead);
value object, chainhead;
integer object, chainhead;
begin
integer array field currelement, chead, obj;
obj:= object;
chead:= chainhead;
currelement:= d.chead.next;
while currelement <> chead
and d.currelement.corupriority <= d.obj.corupriority
do currelement:= d.currelement.next;
link(obj, currelement);
end;
\f
message coroutinemonitor - 28 ;
\f
message coroutinemonitor - 30a ;
<*************** extention to coroutine monitor procedures **********>
<***** signalbin *****
this procedure simulates a binary semaphore on a simple semaphore
by testing the value of the semaphore before signaling the
semaphore. if the value of the semaphore is one (=open) nothing is
done, otherwise a normal signal is carried out. *>
procedure signalbin(semaphore);
value semaphore;
integer semaphore;
begin
integer array field sem;
integer val;
sem:= semaphore;
inspect(sem,val);
if val<1 then signal(sem);
end;
\f
message coroutinemonitor - 30b ;
<***** coruno *****
delivers the coroutinenumber for a give coroutine id.
if the coroutine does not exists the value 0 is delivered *>
integer procedure coru_no(coru_id);
value coru_id;
integer coru_id;
begin
integer array field cor;
coru_no:= 0;
for cor:= firstcoru step corusize until (coruref-1) do
if d.cor.coruident//1000 = coru_id then
coru_no:= d.cor.coruident mod 1000;
end;
\f
message coroutinemonitor - 30c ;
<***** coroutine *****
delivers the referencebyte for the coroutinedescriptor for
a coroutine identified by coroutinenumber *>
integer procedure coroutine(cor_no);
value cor_no;
integer cor_no;
coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
firstcoru + (cor_no-1)*corusize;
\f
message coroutinemonitor - 30d ;
<***** curr_coruno *****
delivers number of calling coroutine
curr_coruno:
< 0 = -current_coroutine_number in disabled mode
= 0 = procedure not called from coroutine
> 0 = current_coroutine_number in enabled mode *>
integer procedure curr_coruno;
begin
integer i;
integer array ia(1:12);
i:= system(12,0,ia);
if i > 0 then
begin
i:= system(12,1,ia);
curr_coruno:= ia(3);
end else curr_coruno:= 0;
end curr_coruno;
\f
message coroutinemonitor - 30e ;
<***** curr_coruid *****
delivers coruident of calling coroutine :
curr_coruid:
> 0 = coruident of calling coroutine
= 0 = procedure not called from coroutine *>
integer procedure curr_coruid;
begin
integer cor_no;
integer array field cor;
cor_no:= abs curr_coruno;
if cor_no <> 0 then
begin
cor:= coroutine(cor_no);
curr_coruid:= d.cor.coruident // 1000;
end
else curr_coruid:= 0;
end curr_coruid;
\f
message coroutinemonitor - 30f.1 ;
<**** getch *****
this procedure searches the queue of operations waiting at 'semaphore'
to find an operation that matches the operationstypeset and a set of
select-values. each select value is specified by type and fieldvalue
in integer array 'type' and by the value in integer array 'val'.
0: eq 0: not used
1: lt 1: boolean
2: le 2: integer
3: gt 3: long
4: ge 4: real
5: ne
*>
procedure getch(semaphore,operation,operationtypeset,type,val);
value semaphore,operationtypeset;
integer semaphore,operation;
boolean operationtypeset;
integer array type,val;
begin
integer array field firstop,currop;
integer ø,n,i,f,t,rel,i1,i2;
boolean field bf,bfval;
integer field intf;
long field lf,lfval; long l1,l2;
real field rf,rfval; real r1,r2;
boolean match;
operation:= 0;
n:= system(3,ø,type);
match:= false;
firstop:= semaphore + semop;
currop:= d.firstop.next;
while currop <> firstop and -,match do
begin
if (operationtypeset and d.currop.optype) extract 12 <> 0 then
begin
i:= n;
match:= true;
\f
message coroutinemonitor - 30f.2 ;
while match and (if i <= ø then type(i) >= 0 else false) do
begin
rel:= type(i) shift(-18);
t:= type(i) shift(-12) extract 6;
f:= type(i) extract 12;
if f > 2047 then f:= f -4096;
case t+1 of
begin
; <* not used *>
begin <*boolean or signed short integer*>
bf:= f;
bfval:= 2*i;
i1:= d.currop.bf extract 12;
if i1 > 2047 then i1:= i1-4096;
i2:= val.bfval extract 12;
if i2 > 2047 then i2:= i2-4096;
match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
end;
begin <*integer*>
intf:= f;
i1:= d.currop.intf;
i2:= val(i);
match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
end;
begin <*long*>
lf:= f;
lfval:= i*2;
l1:= d.currop.lf;
l2:= val.lfval;
match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
end;
begin <*real*>
rf:= f;
rfval:= i*2;
r1:= d.currop.rf;
r2:= val.rfval;
match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
end;
end;<*case t+1*>
i:= i+1;
end; <*while match and i<=ø and t>=0 *>
\f
message coroutinemonitor - 30f.3 ;
end; <* if operationtypeset and ---*>
if -,match then currop:= d.currop.next;
end; <*while currop <> firstop and -,match*>
if match then
begin
link(currop,0);
d.current.coruop:= currop;
operation:= currop;
end;
end getch;
\f
message coroutinemonitor - 31 ;
activity(maxcoru);
goto initialization;
<*************** event handling ***************>
takeexternal:
currevent:= baseevent;
eventqueueempty:= false;
repeat
current:= 0;
prevevent:= currevent;
mon(66) test event :(0, 0, currevent, 0);
currevent:= monw2;
if monw0 < 0 <* no event *> then goto takeinternal;
if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
cmi:= monw1
else
cmi:= - monw0;
if cmi > 0 then
begin <* answer to activity zone *>
current:= firstcoru + (cmi - 1) * corusize;
linkprio(current, readyqueue);
baseevent:= 0;
end else
if cmi = 0 then
begin <* message arrived *>
\f
message coroutinemonitor - 32 ;
receiver:= core.currevent(3);
if receiver < 0 then receiver:= - receiver;
procref(maxprocext):= receiver;
procext:= 1;
while procref(procext) <> receiver do procext:= procext + 1;
if procext = maxprocext then
begin <* receiver unknown *>
<* leave the message unchanged *>
end else
if proccode(procext) shift (-12) = 0 then
begin <* the receiver is ready for accepting messages *>
mon(26) get event :(0, 0, currevent, 0);
case proccode(procext) of
begin
begin <* message received by semwaitmessage *>
op:= procop(procext);
sem:= d.op(1);
for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
d.op(9):= currevent;
signalch(sem, op, d.op.optype);
proccode(procext):= 1 shift 12;
end;
begin <* message received by cwaitmessage *>
current:= procop(procext);
procop(procext):= currevent;
linkprio(current, readyqueue);
link(current + corutimerchain, idlequeue);
end;
end; <* case *>
currevent:= baseevent;
proccode(procext):= 1 shift 12;
end;
end <* message *> else
if cmi = -1 then
begin <* answer arrived *>
\f
message coroutinemonitor - 33 ;
if currevent = timermessage then
begin
mon(26) get event :(0, 0, currevent, 0);
coru:= d.timerqueue.next;
while coru <> timerqueue do
begin
current:= coru - corutimerchain;
d.current.corutimer:= d.current.corutimer - clockmess(2);
coru:= d.coru.next;
if d.current.corutimer <= 0 then
begin <* timer perion expired *>
d.current.corutimer:= -1;
linkprio(current, readyqueue);
link(current + corutimerchain, idlequeue);
end;
end;
mon(16) send message :(0, clockmess, 0, clock);
timermessage:= monw2;
currevent:= baseevent;
end <* timer answer *> else
begin
messref(maxmessext):= currevent;
messext:= 1;
while messref(messext) <> currevent do messext:= messext + 1;
if messext = maxmessext then
begin <* the answer is unknown *>
<* leave the answer unchanged - it may belong to an activity *>
end else
if messcode(messext) shift (-12) = 0 then
begin
case messcode(messext) extract 12 of
begin
\f
message coroutinemonitor - 34 ;
begin <* answer arrived after semsendmessage *>
op:= messop(messext);
sem:= d.op(1);
mon(18) wait answer :(0, d.op, currevent, 0);
d.op(9):= monw0;
signalch(sem, op, d.op.optype);
messref(messext):= 0;
baseevent:= 0;
end;
begin <* answer arrived after csendmessage *>
current:= messop(messext);
linkprio(current, readyqueue);
link(current + corutimerchain, idlequeue);
end;
end;
end else baseevent:= currevent;
end;
end;
until eventqueueempty;
\f
message coroutinemonitor - 35 ;
<*************** coroutine activation ***************>
takeinternal:
current:= d.readyqueue.next;
if current = readyqueue then
begin
mon(24) wait event :(0, 0, prevevent, 0);
goto takeexternal;
end;
<*+2*> if testbit30 and d.current.corutestmask shift(-11) then
<**> begin
<**> systime(5,0,r);
<**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
<**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
<**> d.current.coruident//1000,<: aktiveres:>);
<**> end;
<*-2*>
corustate:= activate(d.current.coruident mod 1000);
cmi:= corustate extract 24;
<*+2*> if testbit30 and d.current.corutestmask shift(-11) then
<**> begin
<**> systime(5,0,r);
<**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
<**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
<**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
<**> end;
<*-2*>
if cmi = 1 then
begin <* programmed passivate *>
goto takeexternal;
end;
if cmi = 2 then
begin <* implicit passivate in activity *>
link(current, idlequeue);
goto takeexternal;
end;
\f
message coroutinemonitor - 36 ;
<* coroutine termination (normal or abnormal) *>
<* aktioner ved normal og unormal coroutineterminering insættes her *>
coru_term:
begin
if false and alarmcause extract 24 = (-9) <* break *> and
alarmcause shift (-24) extract 24 = 0 then
begin
endaction:= 2;
goto program_slut;
end;
if alarmcause extract 24 = (-9) <* break *> and
alarmcause shift (-24) = 8 <* parent *>
then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
if alarmcause shift (-24) extract 24 <> -2 or
alarmcause extract 24 <> -13 then
begin
write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
alarmcause shift (-24),<:,:>,
alarmcause extract 24);
for i:=1 step 1 until max_coru do
j:=activate(-i); <* kill *>
<* skriv billede *>
end
else
begin
errorbits:= 0; <* ok.yes warning.no *>
goto finale;
end;
end;
goto dump;
link(current, idlequeue);
goto takeexternal;
\f
message coroutinemonitor - 37 ;
initialization:
<*************** initialization ***************>
<* chain head *>
prev:= -2; <* -2 prev *>
next:= 0; <* +0 next *>
<* corutine descriptor *>
<* -2 prev *>
<* +0 next *>
<* +2 (link field) *>
corutimerchain:= next + 4; <* +4 corutimerchain *>
<* +6 (link field) *>
coruop:= corutimerchain + 4; <* +8 coruop *>
corutimer:= coruop + 2; <*+10 corutimer *>
coruident:= corutimer + 2; <*+12 coruident *>
corupriority:= coruident + 2; <*+14 corupriority *>
corutypeset:= corupriority + 1; <*+15 corutypeset *>
corutestmask:= corutypeset + 1; <*+16 corutestmask *>
<* simple semaphore *>
<* -2 (link field) *>
simcoru:= next; <* +0 simcoru *>
simvalue:= simcoru + 2; <* +2 simvalue *>
<* chained semaphore *>
<* -2 (link field) *>
semcoru:= next; <* +0 semcoru *>
<* +2 (link field) *>
semop:= semcoru + 4; <* +4 semop *>
\f
message coroutinemonitor - 38 ;
<* operation *>
opsize:= next - 6; <* -6 opsize *>
optype:= opsize + 1; <* -5 optype *>
<* -2 prev *>
<* +0 next *>
<* +2 operation(1) *>
<* +4 operation(2) *>
<* +6 - *>
<* . - *>
<* . - *>
\f
message coroutinemonitor - 39 ;
trap(dump);
systime(1, 0, starttime);
for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
clockmess(1):= 0;
clockmess(2):= timeinterval;
clock(1):= real <:clock:>;
clock(2):= real <::>;
mon(16) send message :(0, clockmess, 0, clock);
timermessage:= monw2;
readyqueue:= 4;
initchain(readyqueue);
idlequeue:= readyqueue + 4;
initchain(idlequeue);
timerqueue:= idlequeue + 4;
initchain(timerqueue);
current:= 0;
corucount:= 0;
proccount:= 0;
baseevent:= 0;
coruref:= timerqueue + 4;
firstcoru:= coruref;
simref:= coruref + maxcoru * corusize;
firstsim:= simref;
semref:= simref + maxsem * simsize;
firstsem:= semref;
opref:= semref + maxsemch * semsize + 4;
firstop:= opref;
optop:= opref + maxop * opheadsize + maxnettoop - 6;
for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
reflectcore(core);
algol list.on;
\f
message sys_initialisering side 1 - 810601/hko;
trapmode:= 1 shift 15;
errorbits:= 1; <* warning.no ok.no *>
trap(coru_term);
open(zbillede,4,<:billede:>,0);
write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
<<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
system(2,0,ia);
open(zdummy,4,ia,0); close(zdummy,false);
monitor(42,zdummy,0,ia);
laf:= 0;
write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
systime(6,ia(6),r)+r/1000000,"nl",2,
<:konsolnavn: :>,konsol_navn.laf,"nl",1);
open(zrl,4,<:radiolog:>,0);
if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
monitor(52)create_areaproc:(zrl,0,ia)<>0 or
monitor(8)reserve_process:(zrl,0,ia)<>0 then
begin
ia(1):=1; ia(2):= 3;
for i:= 3 step 1 until 10 do ia(i):= 0;
monitor(40)create_area:(zrl,0,ia);
end;
for i:=1 step 1 until max_antal_fejltekster do
fejltekst(i):= real (case i of (
<* 1*><:filsystem:>,
<* 2*><:operationskode:>,
<* 3*><:programfejl:>,
<* 4*><:monitor<'_'>resultat=:>,
<* 5*><:læs<'_'>fil:>,
<* 6*><:skriv<'_'>fil:>,
<* 7*><:modif<'_'>fil:>,
<* 8*><:hent<'_'>fil<'_'>dim:>,
<* 9*><:sæt<'_'>fil<'_'>dim:>,
<*10*><:vogntabel:>,
<*11*><:fremmed operation:>,
<*12*><:operationstype:>,
<*13*><:opret<'_'>fil:>,
<*14*><:tilknyt<'_'>fil:>,
<*15*><:frigiv<'_'>fil:>,
<*16*><:slet<'_'>fil:>,
<*17*><:ydre enhed, status=:>,
<*18*><:tabelfil:>,
<*19*><:radio:>,
<*20*><:mobilopkald, bus:>,
<*21*><:talevejsswitch:>,
<*99*><:ftslut:>));
for i:= 1 step 1 until max_antal_områder do
begin
område_navn(i):= long (case i of
(<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
<:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
område_id(i,1):= område_navn(i) shift (-24) extract 24;
område_id(i,2):=
(case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
(case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
end;
pabx_id(1):= -1;
pabx_id(2):= 1;
for i:= 1 step 1 until max_antal_radiokanaler do
begin
radio_id(i):=
case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
end;
for i:=1 step 1 until max_antal_kanaler do
begin
kanal_navn(i):= long (case i of (
<:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
<:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
kanal_id(i):=
(case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
(case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
end;
for i:= 1 step 1 until op_maske_lgd//2 do
ingen_operatører(i):= alle_operatører(i):= 0;
for i:= 1 step 1 until tv_maske_lgd//2 do
ingen_taleveje(i):= alle_taleveje(i):= 0;
begin
long array navn(1:2);
long array field doc, ref;
doc:= 2; iaf:= 0;
movestring(navn,1,<:terminal0:>);
for i:= 1 step 1 until max_antal_operatører do
begin
ref:=(i-1)*8; k:=9;
if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
skrivtegn(navn.iaf,k,'0'+ i mod 10);
open(zdummy,8,navn,0); close(zdummy,true);
k:= monitor(42,zdummy,0,ia);
if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
else tofrom(terminal_navn.ref,navn,8);
operatør_auto_include(i):= false;
sætbit_ia(alle_operatører,i,1);
end;
movestring(navn,1,<:garage0:>);
for i:= 1 step 1 until max_antal_garageterminaler do
begin
ref:=(i-1)*8; k:=7;
if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
skrivtegn(navn.iaf,k,'0'+ i mod 10);
open(zdummy,8,navn,0); close(zdummy,true);
k:= monitor(42,zdummy,0,ia);
if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
else tofrom(garage_terminal_navn.ref,navn,8);
garage_auto_include(i):= false;
end;
end;
for i:= 1 step 1 until max_antal_taleveje do
sætbit_ia(alle_taleveje,i,1);
for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
if 1<=ia(i) and ia(i)<=max_antal_operatører then
operatør_auto_include(ia(i)):= true;
for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
garage_auto_include(ia(i)):= true;
\f
message fil_init side 1 - 801030/jg;
begin integer i,antz,tz,s;
real array field raf;
filskrevet:=fillæst:=0; <*fil*>
dbsegmax:= 2**18-1;
tz:=dbantez+dbantsz; antz:=tz+dbanttz;
for i:=1 step 1 until dbantez do
begin open(fil(i),4,<::>,0); close(fil(i),false) end;
for i:=dbantez+1 step 1 until tz do
open(fil(i),4,dbsnavn,0);
for i:=tz+1 step 1 until antz do
open(fil(i),4,dbtnavn,0);
for i:=1 step 1 until dbantez do <*dbkatz*>
dbkatz(i,1):=dbkatz(i,2):=0;
for i:=dbantez+1 step 1 until tz do
begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
for i:=tz+1 step 1 until antz do
begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
dbkatz(antz,2):=tz+1;
dbsidstetz:=antz;
dbsidstesz:=tz;
for i:=1 step 1 until dbmaxef do <*dbkate*>
begin integer j;
for j:=1,3 step 1 until 6 do
dbkate(i,j):=0;
dbkate(i,2):=i+1;
end;
dbkate(dbmaxef,2):=0;
dbkatefri:=1;
dbantef:=0;
\f
message fil_init side 2 - 801030/jg;
for i:= 1 step 1 until dbmaxsf do <*dbkats*>
begin
dbkats(i,1):=0;
dbkats(i,2):=i+1;
end;
dbkats(dbmaxsf,2):=0;
dbkatsfri:=1;
dbantsf:=0;
for i:=1 step 1 until dbmaxb do <*dbkatb*>
dbkatb(i):=false add (i+1);
dbkatb(dbmaxb):=false;
dbkatbfri:=1;
dbantb:=0;
raf:=4;
for i:=1 step 1 until dbmaxtf do
begin
inrec6(fil(antz),4);
dbkatt.raf(i):=fil(antz,1);
end;
inrec6(fil(antz),4);
if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
setposition(fil(antz),0,0);
end filsystem;
\f
message fil_init side 3 - 810209/cl;
bs_kats_fri:= nextsem;
<*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
<*-3*>
bs_kate_fri:= nextsem;
<*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
<*-3*>
cs_opret_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
<*-3*>
cs_tilknyt_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
<*-3*>
cs_frigiv_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
<*-3*>
cs_slet_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
<*-3*>
cs_opret_spoolfil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
<*-3*>
cs_opret_eksternfil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
<*-3*>
\f
message fil_init side 4 810209/cl;
<* initialisering af filsystemcoroutiner *>
i:= nextcoru(001,10,true);
j:= newactivity(i,0,opretfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(002,10,true);
j:= newactivity(i,0,tilknytfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(003,10,true);
j:= newactivity(i,0,frigivfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(004,10,true);
j:= newactivity(i,0,sletfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(005,10,true);
j:= newactivity(i,0,opretspoolfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(006,10,true);
j:= newactivity(i,0,opreteksternfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
\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*>
\f
message io_initialisering side 1 - 810507/hko;
io_spoolfil:= 1028;
begin
integer array fdim(1:8);
fdim(4):= io_spoolfil;
hent_fildim(fdim);
io_spool_postantal:= fdim(1);
io_spool_postlængde:= fdim(2);
end;
io_spool_post:= 4;
cs_io:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
<*-3*>
i:= next_coru(100,<*ident *>
5,<*prioritet *>
true<*test_maske*>);
j:= new_activity( i,
0,
h_io);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_io_komm:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
<*-3*>
i:= next_coru(101,<*ident*>
10,<*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
io_komm);<*ingen parametre*>
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
\f
message io_initialisering side 2 - 810520/hko/cl;
bs_zio_adgang:= next_sem;
<*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
<*-3*>
signal_bin(bs_zio_adgang);
cs_io_spool:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
<*-3*>
cs_io_fil:=next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
<*-3*>
signal_ch(cs_io_fil,next_op(data+18),gen_optype);
ss_io_spool_fulde:= next_sem;
<*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
<*-3*>
ss_io_spool_tomme:= next_sem;
<*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
<*-3*>
for i:= 1 step 1 until io_spool_postantal do
signal(ss_io_spool_tomme);
\f
message io_initialisering side 3 - 880901/cl;
i:= next_coru(102,
5,
true);
j:= new_activity(i,0,io_spool);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
i:= next_coru(103,
10,
true);
j:= new_activity(i,0,io_spon);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_io_medd:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
<*-3*>
i:= next_coru(104,<*ident *>
10,<*prioritet *>
true<*test_maske*>);
j:= new_activity( i,
0,
io_medd);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_io_nulstil:= next_semch;
<*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
<*-3*>
i:= next_coru(105,<*ident *>
10,<*prioritet *>
true<*test_maske*>);
j:= new_activity( i,
0,
io_nulstil_tællere);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
i:= monitor(8)reserve process:(z_io,0,ia);
if i <> 0 then
begin
fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
end
else
begin
ref:= 0;
terminal_tab.ref.terminal_tilstand:= 0;
write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
<<zddddd>,systime(5,0.0,r),".",1,r,
"sp",1,"*",15,"nl",1);
setposition(z_io,0,0);
end;
\f
message operatør_initialisering side 1 - 810520/hko;
top_bpl_gruppe:= 64;
bpl_navn(0):= long<::>;
for i:= 1 step 1 until 127 do
begin
k:= læsfil(tf_bpl_navne,i,j);
if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
if i<=max_antal_operatører then
operatør_auto_include(i):= false add (fil(j,1) extract 8);
if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
top_bpl_gruppe:= i;
end;
for i:= 0 step 1 until 64 do
begin
iaf:= i*op_maske_lgd;
tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
if 1<=i and i<= max_antal_operatører then
begin
bpl_tilst(i,2):= 1;
sætbit_ia(bpl_def.iaf,i,1);
end;
end;
for i:= 65 step 1 until 127 do
begin
k:= læsfil(tf_bpl_def,i-64,j);
if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
iaf:= i*op_maske_lgd;
tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
bpl_tilst(i,1):= 0;
bpl_tilst(i,2):= fil(j,2) extract 24;
end;
for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
iaf:= 0;
for i:= 1 step 1 until max_antal_operatører do
begin
k:= læsfil(tf_stoptabel,i,j);
if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
operatør_stop(i,0):= i;
for k:= 1,2,3 do
operatør_stop(i,k):= fil(j).iaf(k+1);
ant_i_opkø(i):= 0;
end;
tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
sidste_tv_brugt:= max_antal_taleveje;
for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
opk_alarm(i):= 0;
for i:= 1 step 1 until max_antal_operatører do
begin
integer array field tab;
k:= læsfil(tf_alarmlgd,i,j);
if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
tab:= (i-1)*opk_alarm_tab_lgd;
opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
opk_alarm.tab.alarm_start:= 0.0;
end;
op_spool_kilde:= 2;
op_spool_tid := 6;
op_spool_text := 6;
begin
long array field laf1, laf2;
laf2:= 4; laf1:= 0;
op_spool_buf.laf1(1):= long<::>;
tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
op_spool_postantal*op_spool_postlgd-4);
end;
k:=læsfil(1033,1,j);
systime(1,0.0,r);
if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
for i:= 1 step 1 until max_cqf do
begin
ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
tofrom(cqf_tabel.ref,fil(j).iaf,8);
cqf_tabel.ref.cqf_næste_tid:=
(if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
cqf_tabel.ref.cqf_ok_tid:= real<::>;
end;
op_cqf_tab_ændret:= true;
laf:= raf:= 0;
open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
i:= monitor(8)reserve_process:(z_tv_in,0,ia);
j:= 1;
if i<>0 then
fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
i:= monitor(8)reserve_process:(z_tv_in,0,ia);
j:= 1;
if i<>0 then
fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
ia(1):= 3; <*canonical*>
ia(2):= 0; <*no echo*>
ia(3):= 0; <*prompt*>
ia(4):= 2; <*timeout*>
setcspterm(taleswitch_in_navn.laf,ia);
setcspterm(taleswitch_out_navn.laf,ia);
cs_op:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
<*-3*>
cs_op_retur:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
<*-3*>
i:= nextcoru(200,<*ident*>
10,<*prioitet*>
true<*test_maske*>);
j:= new_activity( i,
0,
h_operatør);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
\f
message operatør_initialisering side 2 - 810520/hko;
for k:= 1 step 1 until max_antal_operatører do
begin
ref:= (k-1)*8;
open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
i:= monitor(4) processaddress:(z_op(k),0,ia);
ref:=k*terminal_beskr_længde;
if i = 0 then
begin
fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
terminal_tab.ref.terminal_tilstand:= 4 shift 21;
end
else
begin
terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
end;
cs_operatør(k):= next_semch;
<*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
<*-3*>
cs_op_fil(k):= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
<*-3*>
signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
i:= next_coru(200+k,<*ident*>
10,<*prioitet*>
true<*testmaske*>);
j:= new_activity( i,
0,
operatør,k);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
end;
cs_cqf:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
<*-3*>
signalch(cs_cqf,nextop(60),true);
i:= next_coru(292, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
op_cqftest);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
cs_op_spool:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
<*-3*>
cs_op_medd:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
<*-3*>
ss_op_spool_tomme:= next_sem;
<*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
<*-3*>
for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
ss_op_spool_fulde:= next_sem;
<*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
<*-3*>
signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
i:= next_coru(293, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
op_spool);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
i:= next_coru(294, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
op_medd);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
cs_op_iomedd:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
<*-3*>
bs_opk_alarm:= next_sem;
<*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
<*-3*>
cs_opk_alarm:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
<*-3*>
cs_opk_alarm_ur:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
<*-3*>
cs_opk_alarm_ur_ret:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
<*-3*>
cs_tvswitch_adgang:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
<*-3*>
cs_tv_switch_input:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
<*-3*>
cs_tv_switch_adm:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
<*-3*>
cs_talevejsswitch:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
<*-3*>
signalch(cs_op_iomedd,nextop(60),gen_optype);
iaf:= nextop(data+128);
if testbit22 then
signal_ch(cs_tv_switch_adgang,iaf,op_optype)
else
begin
startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
signal_ch(cs_talevejsswitch,iaf,op_optype);
end;
i:= next_coru(295, <*ident*>
8, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
alarmur);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
i:= next_coru(296, <*ident*>
8, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
opkaldsalarmer);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
i:= next_coru(297, <*ident*>
3, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
tv_switch_input);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
for i:= 1,2 do
signalch(cs_tvswitch_input,nextop(data+256),op_optype);
i:= next_coru(298, <*ident*>
20, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
tv_switch_adm);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
i:= next_coru(299, <*ident*>
3, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
talevejsswitch);
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
\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:= (k-1)*8;
open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
ref:= (max_antal_operatører+k)*terminal_beskr_længde;
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(k) then 0 else 7 shift 21;
if garage_auto_include(k) then
monitor(8)reserve:(z_gar(k),0,ia);
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;
\f
message radio_initialisering side 1 - 820301/hko;
cs_rad:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
<*-3*>
i:= next_coru(400,<*ident*>
10,<*prioritet*>
true<*test_maske*>);
j:= new_activity( i,
0,
h_radio);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
opkalds_kø_ledige:= max_antal_mobilopkald;
nødopkald_brugt:= 0;
læsfil(1034,1,i);
tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
for i:= system(3,j,opkaldskø) step 1 until j do
opkaldskø(i):= 0;
første_frie_opkald:=opkaldskø_postlængde;
første_opkald:=sidste_opkald:=
første_nødopkald:=sidste_nødopkald:=j:=0;
for i:=1 step 1 until max_antal_mobil_opkald -1 do
begin
ref:=i*opkaldskø_postlængde;
opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
end;
ref:=ref+opkaldskø_postlængde;
opkaldskø.ref(1):=j shift 12;
for ref:= 0 step 512 until (max_linienr//768*512) do
begin
i:= læs_fil(1035,ref//512+1,j);
if i <> 0 then
fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
tofrom(radio_linietabel.ref,fil(j),
if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
else ((max_linienr+1 - (ref//2*3))+2)//3*2);
end;
for i:= system(3,j,kanal_tab) step 1 until j do
kanal_tab(i):= 0;
kanal_tilstand:= 2;
kanal_id1:= 4;
kanal_id2:= 6;
kanal_spec:= 8;
kanal_alt_id1:= 10;
kanal_alt_id2:= 12;
kanal_mon_maske:= 12;
kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
for i:= 1 step 1 until max_antal_kanaler do
begin
ref:= (i-1)*kanalbeskrlængde;
sæthexciffer(kanal_tab.ref,3,15);
if kanal_id(i) shift (-5) extract 3 = 2 or
kanal_id(i) shift (-5) extract 3 = 3 and
radio_id(kanal_id(i) extract 5)<=3
then
begin
sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
end;
end;
tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
optaget_flag:= 0;
\f
message radio_initialisering side 2 - 810524/hko;
bs_mobil_opkald:= next_sem;
<*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
<*-3*>
bs_opkaldskø_adgang:= next_sem;
signal_bin(bs_opkaldskø_adgang);
<*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
<*-3*>
cs_radio_medd:=next_semch;
signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
<*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
<*-3*>
i:= next_coru(403,
5,<*prioritet*>
true<*testmaske*>);
j:= new_activity( i,
0,
radio_medd_opkald);
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_radio_adm:= nextsemch;
<*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
<*-3*>
i:= next_coru(404,
10,
true);
j:= new_activity(i,
0,
radio_adm,next_op(data+radio_op_længde));
<*+3*>skriv_new_activity(out,i,j);
<*-3*>
\f
message radio_initialisering side 3 - 810526/hko;
for k:= 1 step 1 until max_antal_taleveje do
begin
cs_radio(k):=next_semch;
<*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
<*-3*>
bs_talevej_udkoblet(k):= nextsem;
<*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
<*-3*>
i:=next_coru(410+k,
10,
true);
j:=new_activity( i,
0,
radio,k,next_op(data + radio_op_længde));
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
end;
cs_radio_pulje:=next_semch;
<*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
<*-3*>
for i:= 1 step 1 until radiopulje_størrelse do
signal_ch(cs_radio_pulje,
next_op(60),
gen_optype or rad_optype);
cs_radio_kø:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
<*-3*>
mobil_opkald_aktiveret:= true;
\f
message radio_initialisering side 4 - 810522/hko;
laf:=raf:=0;
open(z_fr_in,8,radio_fr_navn,radio_giveup);
i:= monitor(8)reserve process:(z_fr_in,0,ia);
j:=1;
if i <> 0 then
fejlreaktion(4<*monitor resultat*>,i,
string radio_fr_navn.raf(increase(j)),1);
open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
i:= monitor(8)reserve process:(z_fr_out,0,ia);
j:=1;
if i <> 0 then
fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
ia(1):= 3 <*canonical*>;
ia(2):= 0 <*no echo*>;
ia(3):= 0 <*prompt*>;
ia(4):= 5 <*timeout*>;
setcspterm(radio_fr_navn.laf,ia);
open(z_rf_in,8,radio_rf_navn,radio_giveup);
i:= monitor(8)reserve process:(z_rf_in,0,ia);
j:= 1;
if i <> 0 then
fejlreaktion(4<*monitor resultat*>,i,
string radio_rf_navn.raf(increase(j)),1);
open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
i:= monitor(8)reserve process:(z_rf_out,0,ia);
j:= 1;
if i <> 0 then
fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
ia(1):= 3 <*canonical*>;
ia(2):= 0 <*no echo*>;
ia(3):= 0 <*prompt*>;
ia(4):= 5 <*timeout*>;
setcspterm(radio_rf_navn.laf,ia);
\f
message radio_initialisering side 5 - 810521/hko;
for k:= 1 step 1 until max_antal_kanaler do
begin
ss_radio_aktiver(k):=next_sem;
<*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
<*-3*>
ss_samtale_nedlagt(k):=next_sem;
<*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
<*-3*>
end;
cs_radio_ind:= next_semch;
<*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
<*-3*>
i:= next_coru(401,<*ident radio_ind*>
3, <*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
radio_ind,next_op(data + 64));
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
cs_radio_ud:=next_semch;
<*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
<*-3*>
i:= next_coru(402,<*ident radio_out*>
10,<*prioritet*>
true <*testmaske*>);
j:= new_activity( i,
0,
radio_ud,next_op(data + 64));
<*+3*>skriv_newactivity(out,i,j);
<*-3*>
\f
message vogntabel initialisering side 1 - 820301;
sidste_bus:= sidste_linie_løb:= 0;
tf_vogntabel:= 1 shift 10 + 2;
tf_gruppedef:= ia(4):= 1 shift 10 +3;
tf_gruppeidenter:= 1 shift 10 +6;
tf_springdef:= 1 shift 10 +7;
hent_fil_dim(ia);
max_antal_i_gruppe:= ia(2);
if ia(1) < max_antal_grupper then
max_antal_grupper:= ia(1);
<* initialisering af interne vogntabeller *>
begin
long array field laf1,laf2;
integer array fdim(1:8);
zone z(128,1,stderror);
integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
long omr,garageid;
integer field ll, bn;
boolean binær, test24;
ll:= 2; bn:= 4;
<* nulstil tabellerne *>
laf1:= -2;
laf2:= 2;
bustabel1.laf2(0):=
bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
\f
message vogntabel initialisering side 1a - 810505/cl;
<* initialisering af intern busnummertabel *>
open(z,4,<:busnumre:>,0);
busnr:= -1;
read(z,busnr);
while busnr > 0 do
begin
if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
sidste_bus:= sidste_bus+1;
if sidste_bus > max_antal_busser then
fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
repeatchar(z); readchar(z,tegn);
garageid:= extend 0; binær:= false; omr:= extend 0;
g_nr:= o_nr:= 0;
if tegn='!' then
begin
binær:= true;
readchar(z,tegn);
end;
if tegn='/' then <*garageid*>
begin
readchar(z,tegn); repeatchar(z);
if '0'<=tegn and tegn<='9' then
begin
read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
if g_nr<>0 then garageid:=bpl_navn(g_nr);
if g_nr<>0 and garageid=long<::> then
begin
fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
g_nr:= 0;
end;
end
else
begin
while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
begin
garageid:= garageid shift 8 + tegn;
readchar(z,tegn);
end;
while garageid shift (-40) extract 8 = 0 do
garageid:= garageid shift 8;
g_nr:= find_bpl(garageid);
if g_nr=0 then
fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
end;
repeatchar(z); readchar(z,tegn);
end;
if tegn=';' then
begin
readchar(z,tegn); repeatchar(z);
if '0'<=tegn and tegn<='9' then
begin
read(z,o_nr);
if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
if o_nr<>0 then omr:= område_navn(o_nr);
if o_nr<>0 and omr=long<::> then
begin
fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
o_nr:= 0;
end;
end
else
begin
while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
begin
omr:= omr shift 8 + tegn;
readchar(z,tegn);
end;
while omr shift (-40) extract 8 = 0 do
omr:= omr shift 8;
if omr=long<:TCT:> then omr:=long<:KBH:>;
i:= 1;
while i<=max_antal_områder and o_nr=0 do
begin
if omr=område_navn(i) then o_nr:= i;
i:= i+1;
end;
if o_nr=0 then
fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
end;
repeatchar(z); readchar(z,tegn);
end;
if o_nr=0 then o_nr:= 3;
bustabel (sidste_bus):= g_nr shift 14 + busnr;
bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
busnr:= -1;
read(z,busnr);
end;
close(z,true);
\f
message vogntabel initialisering side 2 - 820301/cl;
<* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
test24:= testbit24;
testbit24:= false;
i:= 1;
s:= læsfil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
while fil(zi).bn<>0 do
begin
if fil(zi).ll <> 0 then
begin <* indsæt linie/løb *>
res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
fil(zi).ll,j);
if res < 0 then j:= j+1;
if res = 0 then fejlreaktion(10,fil(zi).bn,
<:dobbeltregistrering i vogntabel:>,1)
else
begin
o_nr:= fil(zi).bn shift (-14) extract 8;
b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
<:ukendt bus i vogntabel:>,1)
else
begin
if sidste_linie_løb >= max_antal_linie_løb then
fejlreaktion(10,fil(zi).bn extract 14,
<:for mange linie/løb i vogntabel:>,0);
for ll_nr:= sidste_linie_løb step (-1) until j do
begin
linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
end;
linie_løb_tabel(j):= fil(zi).ll;
bus_indeks(j):= false add b_nr;
sidste_linie_løb:= sidste_linie_løb + 1;
end;
end;
end;
i:= i+1;
s:= læsfil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
end;
\f
message vogntabel initialisering side 3 - 810428/cl;
<* initialisering af intern linie/løb-indekstabel *>
for ll_nr:= 1 step 1 until sidste_linie_løb do
linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
<* gem ny vogntabel i tabelfil *>
for i:= 1 step 1 until sidste_bus do
begin
s:= skriv_fil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
fil(zi).bn:= bustabel(i) extract 14 add
(bustabel1(i) extract 8 shift 14);
fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
end;
fdim(4):= tf_vogntabel;
hent_fil_dim(fdim);
pant:= fdim(3) * (256//fdim(2));
for i:= sidste_bus+1 step 1 until pant do
begin
s:= skriv_fil(tf_vogntabel,i,zi);
if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
fil(zi).ll:= fil(zi).bn:= 0;
end;
<* initialisering/nulstilling af gruppetabeller *>
for i:= 1 step 1 until max_antal_grupper do
begin
s:= læs_fil(tf_gruppeidenter,i,zi);
if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
gruppetabel(i):= fil(zi).ll;
end;
for i:= 1 step 1 until max_antal_gruppeopkald do
gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
testbit24:= test24;
end;
<*+2*>
<**> if testbit40 then p_vogntabel(out);
<**> if testbit43 then p_gruppetabel(out);
<*-2*>
message vogntabel initialisering side 3a -920517/cl;
<* initialisering for vt_log *>
v_tid:= 4;
v_kode:= 6;
v_bus:= 8;
v_ll1:= 10;
v_ll2:= 12;
v_tekst:= 6;
for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
if vt_log_aktiv then
begin
integer i;
real t;
integer array field iaf;
integer array
tail(1:10),ia(1:10),chead(1:20);
open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
i:= monitor(42)lookup_entry:(zvtlog,0,tail);
if i=0 then
i:=monitor(52)create_areaproc:(zvtlog,0,ia);
if i=0 then
begin
i:=monitor(8)reserve_process:(zvtlog,0,ia);
monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if i=0 then
begin
iaf:= 2;
tofrom(vt_logdisc,tail.iaf,8);
i:=slices(vt_logdisc,0,tail,chead);
if i > (-2048) then
begin
vt_log_slicelgd:= chead(15);
i:= 0;
end;
end;
if i=0 then
begin
open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
i:=monitor(42)lookup_entry:(zvtlog,0,tail);
if i=0 then
i:= monitor(52)create_areapproc:(zvtlog,0,ia);
if i=0 then
begin
i:=monitor(8)reserve_process:(zvtlog,0,ia);
monitor(64)remove_areaproc:(zvtlog,0,ia);
end;
if i<>0 then
begin
for i:= 1 step 1 until 10 do tail(i):= 0;
tail(1):= 1;
iaf:= 2;
tofrom(tail.iaf,vt_logdisc,8);
tail(6):=systime(7,0,t);
i:=monitor(40)create_entry:(zvtlog,0,tail);
if i=0 then
i:=monitor(50)permanent_entry:(zvtlog,3,ia);
end;
end;
if i<>0 then vt_log_aktiv:= false;
end;
\f
message vogntabel initialisering side 4 - 810520/cl;
cs_vt:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
<*-3*>
cs_vt_adgang:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
<*-3*>
cs_vt_opd:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
<*-3*>
cs_vt_rap:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
<*-3*>
cs_vt_tilst:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
<*-3*>
cs_vt_auto:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
<*-3*>
cs_vt_grp:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
<*-3*>
cs_vt_spring:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
<*-3*>
cs_vt_log:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
<*-3*>
cs_vt_logpool:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
<*-3*>
vt_op:= nextop(vt_op_længde);
signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
vt_logop(1):= nextop(vt_op_længde);
signalch(cs_vt_logpool,vt_logop(1),vt_optype);
vt_logop(2):= nextop(vt_op_længde);
signalch(cs_vt_logpool,vt_logop(2),vt_optype);
\f
message vogntabel initialisering side 5 - 81-520/cl;
i:= nextcoru(500, <*ident*>
10, <*prioitet*>
true <*testmaske*>);
j:= new_activity( i,
0,
h_vogntabel);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(501, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
iaf:= nextop(filop_længde);
j:= new_activity(i,
0,
vt_opdater,iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(502, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= newactivity(i,
0,
vt_tilstand,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
\f
message vogntabel initialisering side 6 - 810520/cl;
i:= nextcoru(503, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= newactivity(i,
0,
vt_rapport,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(504, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= new_activity(i,
0,
vt_gruppe,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
\f
message vogntabel initialisering side 7 - 810520/cl;
i:= nextcoru(505, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
<*-3*>
iaf:= nextop(fil_op_længde);
j:= newactivity(i,
0,
vt_spring,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:= nextcoru(506, <*ident*>
10,
true <*testmaske*>);
k:= nextsemch;
<*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
<*-3*>
iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
j:= newactivity(i,
0,
vt_auto,
k,
iaf);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
i:=nextcoru(507, <*ident*>
10, <*prioritet*>
true <*testmaske*>);
j:=newactivity(i,
0,
vt_log);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
<*+2*>
<**> if testbit42 then skriv_vt_variable(out);
<*-2*>
\f
message sysslut initialisering side 1 - 810406/cl;
begin
zone z(128,1,stderror);
integer i,coruid,j,k;
integer array field cor;
open(z,4,<:overvågede:>,0);
for i:= read(z,coruid) while i > 0 do
begin
if coruid = 0 then
begin
for coruid:= 1 step 1 until maxcoru do
begin
cor:= coroutine(coruid);
d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
end
end
else
begin
cor:= coroutine(coru_no(abs coruid));
if cor > 0 then
begin
d.cor.corutestmask:=
(d.cor.corutestmask shift 1 shift (-1)) add
((coruid > 0) extract 1 shift 11);
end;
end;
end;
close(z,true);
læsfil(tf_systællere,1,k);
rf:=iaf:= 4;
systællere_nulstillet:= fil(k).rf;
nulstil_systællere:= fil(k).iaf(1);
if systællere_nulstillet=real<::> then
begin
systællere_nulstillet:= 0.0;
nulstil_systællere:= -1;
end;
iaf:= 32;
tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*10);
iaf:= 192;
tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*10);
end;
\f
message sysslut initialisering side 2 - 810603/cl;
if låsning > 0 then
<* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
if låsning > 1 then
<* låsning 2 : *> lock(readchar,1,write,2);
if låsning > 2 then
<* låsning 3 : *> lock(activate,1,link,1,setposition,1);
if låsning > 0 then
begin
i:= locked(ia);
write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
end;
\f
message sysslut initialisering side 3 - 810406/cl;
write(z_io,"nl",2,<:initialisering slut:>);
system(2)free core:(i,ra);
write(z_io,"nl",1,<:free core =:>,i,"nl",1);
setposition(z_io,0,0);
write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
"nl",1);
errorbits:= 3; <* ok.no warning.yes *>
\f
algol list.off;
message coroutinemonitor - 40 ;
if simref <> firstsem then initerror(1, false);
if semref <> firstop - 4 then initerror(2, false);
if coruref <> firstsim then initerror(3, false);
if opref <> optop + 6 then initerror(4, false);
if proccount <> maxprocext -1 then initerror(5, false);
goto takeexternal;
dump:
op:= op;
\f
message sys trapaktion side 1 - 810521/hko/cl;
trap(finale);
write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
begin
k:= 0;
write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
<:timerqueue->:>));
iaf:= i;
for iaf:= d.iaf.next while iaf<>i do
begin
ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
end;
end;
outchar(zbillede,'nl');
skriv_opkaldstællere(zbillede);
pfilsystem(zbillede);
\f
message operatør trapaktion1 side 1 - 810521/hko;
write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
for i:= 1 step 1 until max_antal_operatører do
begin
laf:= (i-1)*8;
write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
case operatør_auto_include(i) extract 2 + 1 of (
<:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
terminal_navn.laf,"nl",1);
end;
write(zbillede,"nl",1);
write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
<:betjeningspladsgrupper::>,"nl",1);
for i:= 1 step 1 until 127 do
if bpl_navn(i)<>long<::> then
begin
k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
write(zbillede,"sp",16-k,<:= :>);
iaf:= i*op_maske_lgd; j:=0;
for k:= 1 step 1 until max_antal_operatører do
begin
if læsbit_ia(bpl_def.iaf,k) then
begin
if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
write(zbillede,true,6,string bpl_navn(k));
j:= j+1;
end;
end;
write(zbillede,"nl",1);
end;
write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
for i:= 1 step 1 until max_antal_operatører do
begin
write(zbillede,<<dd >,i);
for j:= 0 step 1 until 3 do
begin
k:= operatør_stop(i,j);
write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
else string bpl_navn(k));
end;
write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
end;
skriv_terminal_tab(zbillede);
write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
skriv_opk_alarm_tab(zbillede);
skriv_talevejs_tab(zbillede);
skriv_op_spool_buf(zbillede);
skriv_cqf_tabel(zbillede,true);
write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
for i:= 1 step 1 until max_antal_garageterminaler do
begin
laf:= (i-1)*8;
write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
<:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
end;
\f
message radio trapaktion side 1 - 820301/hko;
write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
skriv_kanal_tab(zbillede);
skriv_opkaldskø(zbillede);
skriv_radio_linietabel(zbillede);
skriv_radio_områdetabel(zbillede);
\f
message vogntabel trapaktion side 1 - 810520/cl;
write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
skriv_vt_variable(zbillede);
p_vogntabel(zbillede);
p_gruppetabel(zbillede);
p_springtabel(zbillede);
\f
message sysslut trapaktion side 1 - 810519/cl;
write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
corutable(zbillede);
write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
<: ref værdi prev next:>,"nl",1);
iaf:= firstsim;
repeat
write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
iaf:= iaf + simsize;
until iaf>=simref;
write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
<: ref prev.coru next.coru prev.op next.op:>,"nl",1);
iaf:= firstsem;
repeat
write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
iaf:= iaf+semsize;
until iaf>=semref;
write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
iaf:= firstop;
repeat
skriv_op(zbillede,iaf);
iaf:= iaf+opheadsize+d.iaf.opsize;
until iaf>=optop;
write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
<: messref messcode messop:>,"nl",1);
for i:= 1 step 1 until maxmessext do
write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
<: procref proccode procop:>,"nl",1);
for i:= 1 step 1 until maxprocext do
write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
\f
message sys_finale side 1 - 810428/hko;
finale:
trap(slut_finale);
<* algol_pause:=algol_pause shift 24 shift (-24); *>
endaction:=0;
\f
message filsystem finale side 1 - 810428/cl;
<* lukning af zoner *>
write(out,<:lukker filsystem:>); ud;
for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
close(fil(i),true);
\f
message operatør_finale side 1 - 810428/hko;
goto op_trap2_slut;
write(out,<:lukker operatører:>); ud;
for k:= 1 step 1 until max_antal_operatører do
begin
close(z_op(k),true);
end;
op_trap2_slut:
k:=k;
\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;
\f
message radio_finale side 1 - 810525/hko;
write(out,<:lukker radio:>); ud;
close(z_fr_in,true);
close(z_fr_out,true);
close(z_rf_in,true);
close(z_rf_out,true);
\f
message sysslut finale side 1 - 810530/cl;
slut_finale:
trap(exit_finale);
outchar(zrl,'em');
close(zrl,true);
write(zbillede,
"nl",2,<:blocksread=:>,blocksread,
"nl",1,<:blocksout= :>,blocksout,
"nl",1,<:fillæst= :>,fillæst,
"nl",1,<:filskrevet=:>,filskrevet,
"nl",3,<:********** billede genereret :>,<<zddddd>,
systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
close(zbillede,true);
monitor(42,zbillede,0,ia);
ia(6):= systime(7,0,0.0);
monitor(44,zbillede,0,ia);
setposition(z_io,0,0);
write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
close(z_io,true);
exit_finale: trapmode:= 1 shift 10;
end;
algol list.on;
message programslut;
program_slut:
end
▶EOF◀