|
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: 981504 (0xefa00)
Types: TextFile
Names: »buskomudx06 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomudx06 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.12720604.0012
0 1 begin algol list.off;
1 2
1 2 <* variables for claiming (accumulating) basic entities *>
1 3 integer maxsem, maxsemch, maxop, maxcoru, maxmessext, maxprocext, maxnettoop;
1 4
1 4 <* fields defining current position in pools af basic entities
1 5 during initialization *>
1 6 integer array field firstsem, firstsim, firstcoru, firstop, optop;
1 7
1 7 <* variables used as pointers to 'current object' (work variables) *>
1 8 integer messext, procext, timeinterval, testbuffering;
1 9 integer array field timermessage, coru, sem, op, receiver, currevent,
1 10 baseevent, prevevent;
1 11
1 11 <* variables defining the size of basic entities (descriptors) *>
1 12 integer corusize, semsize, simsize, opheadsize;
1 13 integer array clockmess(1:2);
1 14 real array clock(1:3);
1 15 boolean eventqueueempty;
1 16 algol list.on;
1 17
1 17 \f
1 17 message sys_parametererklæringer side 1 - 810127/cl;
1 18
1 18 boolean testbit0 ,testbit1 ,testbit2 ,testbit3 ,testbit4 ,testbit5 ,
1 19 testbit6 ,testbit7 ,testbit8 ,testbit9 ,testbit10,testbit11,
1 20 testbit12,testbit13,testbit14,testbit15,testbit16,testbit17,
1 21 testbit18,testbit19,testbit20,testbit21,testbit22,testbit23,
1 22 testbit24,testbit25,testbit26,testbit27,testbit28,testbit29,
1 23 testbit30,testbit31,testbit32,testbit33,testbit34,testbit35,
1 24 testbit36,testbit37,testbit38,testbit39,testbit40,testbit41,
1 25 testbit42,testbit43,testbit44,testbit45,testbit46,testbit47;
1 26 boolean cl_overvåget,out_tw_lp,
1 27 cm_test;
1 28
1 28 integer låsning;
1 29 \f
1 29 message sys_parametererklæringer side 2 - 810310.hko;
1 30
1 30 <* hjælpevariable *>
1 31
1 31 integer i,j,k;
1 32 integer array ia(1:32);
1 33 integer array field iaf,ref;
1 34
1 34 real r;
1 35 real array ra(1:3);
1 36 real array field raf;
1 37 real field rf;
1 38
1 38 long array la(1:2);
1 39 long array field laf;
1 40
1 40 procedure ud;
1 41 begin
2 42 <*
2 43 outchar(out,'nl');
2 44 if out_tw_lp then setposition(out,0,0);
2 45 *>
2 46 flushout('nl');
2 47 end;
1 48 \f
1 48 message sys_parametererklæringer side 3 - 810310/hko;
1 49
1 49 <* hovedmodul_parametre *>
1 50
1 50 integer
1 51 sys_mod,
1 52 io_mod,
1 53 op_mod,
1 54 gar_mod,
1 55 rad_mod,
1 56 vt_mod;
1 57
1 57 <* operations_parametre *>
1 58
1 58 integer field
1 59 kilde,
1 60 retur,
1 61 resultat,
1 62 opkode;
1 63
1 63 real field
1 64 tid;
1 65
1 65 integer array field
1 66 data;
1 67
1 67 boolean
1 68 sys_optype,
1 69 io_optype,
1 70 op_optype,
1 71 gar_optype,
1 72 rad_optype,
1 73 vt_optype,
1 74 gen_optype;
1 75 \f
1 75 message sys_parametererklæringer side 4 - 820301/hko,cl;
1 76
1 76 <* trimme-variable *>
1 77
1 77 integer
1 78 max_antal_operatører,
1 79 max_antal_taleveje,
1 80 max_antal_garageterminaler,
1 81 max_antal_garager,
1 82 max_antal_områder,
1 83 max_antal_radiokanaler,
1 84 max_antal_pabx,
1 85 max_antal_kanaler,
1 86 max_antal_mobilopkald,
1 87 min_antal_nødopkald,
1 88 max_antal_grupper,
1 89 max_antal_gruppeopkald,
1 90 max_antal_spring,
1 91 max_antal_busser,
1 92 max_antal_linie_løb,
1 93 max_antal_fejltekster,
1 94 max_linienr,
1 95 op_maske_lgd,
1 96 tv_maske_lgd;
1 97
1 97 integer array
1 98 konsol_navn,
1 99 taleswitch_in_navn,
1 100 taleswitch_out_navn,
1 101 radio_fr_navn,
1 102 radio_rf_navn(1:4),
1 103 alfabet(0:255);
1 104
1 104 integer
1 105 tf_systællere,
1 106 tf_stoptabel,
1 107 tf_bplnavne,
1 108 tf_bpldef,
1 109 tf_alarmlgd;
1 110 \f
1 110 message filparm side 1 - 800529/jg/cl;
1 111
1 111 integer
1 112 fil_op_længde,
1 113 dbantez,dbantsz,dbanttz,
1 114 dbmaxtf, dbmaxsf, dbblokt,
1 115 dbmaxb,dbbidlængde,dbbidmax,
1 116 dbmaxef;
1 117 long array
1 118 dbsnavn, dbtnavn(1:2);
1 119
1 119 message attention parametererklæringer side 1 - 810318/hko;
1 120
1 120 integer
1 121 att_op_længde,
1 122 att_maske_lgd,
1 123 terminal_beskr_længde;
1 124 integer field
1 125 terminal_tilstand,
1 126 terminal_suppl;
1 127
1 127 message io_parametererklæringer side 1 - 820301/hko;
1 128
1 128 message operatør_parametererklæringer side 1 - 810422/hko;
1 129
1 129 integer field
1 130 cqf_bus, cqf_fejl,
1 131 alarm_kmdo, alarm_tilst, alarm_gtilst, alarm_lgd;
1 132 real field
1 133 cqf_ok_tid, cqf_næste_tid,
1 134 alarm_start;
1 135 long field
1 136 cqf_id;
1 137
1 137 integer
1 138 max_cqf, cqf_lgd,
1 139 op_spool_postlgd,
1 140 op_spool_postantal,
1 141 opk_alarm_tab_lgd;
1 142
1 142
1 142 \f
1 142 message procedure radio_parametererklæringer side 1 - 810524/hko;
1 143
1 143 integer
1 144 radio_giveup,
1 145 opkaldskø_postlængde,
1 146 kanal_beskr_længde,
1 147 radio_op_længde,
1 148 radio_pulje_størrelse;
1 149
1 149
1 149 \f
1 149 message vogntabel parametererklæringer side 1 - 810309/cl;
1 150
1 150 integer vt_op_længde, vt_logskift;
1 151 boolean vt_log_aktiv;
1 152
1 152 \f
1 152
1 152 algol list.off;
1 153 message coroutinemonitor - 2 ;
1 154
1 154 maxsem:= maxsemch:= maxop:= maxcoru:= maxnettoop:= 0;
1 155 maxmessext:= maxprocext:= 1;
1 156 corusize:= 20;
1 157 simsize:= 6;
1 158 semsize:= 8;
1 159 opheadsize:= 8;
1 160 testbuffering:= 1;
1 161 timeinterval:= 5;
1 162 algol list.on;
1 163 algol list.on;
1 164
1 164 \f
1 164 message sys_parameterinitialisering side 1 - 810305/hko;
1 165
1 165 copyout;
1 166
1 166 cl_overvåget:= false;
1 167 getzone6(out,ia);
1 168 out_tw_lp:= ia(1) extract 12 = 8 or ia(1) extract 12 = 14;
1 169
1 169 testbit0 :=testbit( 0);
1 170 testbit1 :=testbit( 1);
1 171 testbit2 :=testbit( 2);
1 172 testbit3 :=testbit( 3);
1 173 testbit4 :=testbit( 4);
1 174 testbit5 :=testbit( 5);
1 175 testbit6 :=testbit( 6);
1 176 testbit7 :=testbit( 7);
1 177 testbit8 :=testbit( 8);
1 178 testbit9 :=testbit( 9);
1 179 testbit10:=testbit(10);
1 180 testbit11:=testbit(11);
1 181 testbit12:=testbit(12);
1 182 testbit13:=testbit(13);
1 183 testbit14:=testbit(14);
1 184 testbit15:=testbit(15);
1 185 testbit16:=testbit(16);
1 186 testbit17:=testbit(17);
1 187 testbit18:=testbit(18);
1 188 testbit19:=testbit(19);
1 189 testbit20:=testbit(20);
1 190 testbit21:=testbit(21);
1 191 testbit22:=testbit(22);
1 192 testbit23:=testbit(23);
1 193 \f
1 193 message sys_parameterinitialisering side 2 - 810316/cl;
1 194
1 194 testbit24:=testbit(24);
1 195 testbit25:=testbit(25);
1 196 testbit26:=testbit(26);
1 197 testbit27:=testbit(27);
1 198 testbit28:=testbit(28);
1 199 testbit29:=testbit(29);
1 200 testbit30:=testbit(30);
1 201 testbit31:=testbit(31);
1 202 testbit32:=testbit(32);
1 203 testbit33:=testbit(33);
1 204 testbit34:=testbit(34);
1 205 testbit35:=testbit(35);
1 206 testbit36:=testbit(36);
1 207 testbit37:=testbit(37);
1 208 testbit38:=testbit(38);
1 209 testbit39:=testbit(39);
1 210 testbit40:=testbit(40);
1 211 testbit41:=testbit(41);
1 212 testbit42:=testbit(42);
1 213 testbit43:=testbit(43);
1 214 testbit44:=testbit(44);
1 215 testbit45:=testbit(45);
1 216 testbit46:=testbit(46);
1 217 testbit47:=testbit(47);
1 218 cm_test:= false;
1 219 \f
1 219 message sys_parameterinitialisering side 3 - 810409/cl,hko;
1 220
1 220 timeinterval:=1; <* tidsinterval for cmon's timeoutinspection *>
1 221
1 221 if findfpparam(<:låsning:>,true,ia) > 0 then låsning:= ia(1)
1 222 else låsning:= 0;
1 223 \f
1 223 message sys_parameterinitialisering side 4 - 820301/hko/cl;
1 224
1 224 <* initialisering af hovedmodul_parametre *>
1 225
1 225 i:=0; sys_mod:=i;
1 226 i:=i+1; io_mod:=i;
1 227 i:=i+1; op_mod:=i;
1 228 i:=i+1; gar_mod:=i;
1 229 i:=i+1; rad_mod:=i;
1 230 i:=i+1; vt_mod:=i;
1 231
1 231 <* initialisering af operationstyper *>
1 232
1 232 sys_optype:=false add (1 shift sys_mod);
1 233 io_optype:= false add (1 shift io_mod);
1 234 op_optype:= false add (1 shift op_mod);
1 235 gar_optype:=false add (1 shift gar_mod);
1 236 rad_optype:=false add (1 shift rad_mod);
1 237 vt_optype:= false add (1 shift vt_mod);
1 238 gen_optype:=false add (1 shift 11);
1 239
1 239 <* initialisering af fieldvariable for operationer *>
1 240
1 240 i:=2; kilde:=i;
1 241 i:=i+4; tid:=i;
1 242 i:=i+2; retur:=i;
1 243 i:=i+2; opkode:=i;
1 244 i:=i+2; resultat:=i;
1 245 i:=i+0; data:=i;
1 246
1 246 <* initialisering af trimme-variable *>
1 247
1 247 max_antal_operatører:=28;
1 248 max_antal_taleveje:=12;
1 249 max_antal_garageterminaler:=3;
1 250 max_antal_garager:=99;
1 251 max_antal_radiokanaler:=16;
1 252 max_antal_pabx:=2;
1 253 max_antal_kanaler:=14; <* 1 pabx + 13 radio *>
1 254 max_antal_områder:=11;
1 255 max_antal_mobilopkald:=100;
1 256 min_antal_nødopkald:=20;
1 257 max_antal_grupper:=16;
1 258 max_antal_gruppeopkald:=16;
1 259 max_antal_spring:=16;
1 260 max_antal_busser:=2000;
1 261 max_antal_linie_løb:=2000;
1 262 max_antal_fejltekster:=21;
1 263 max_linienr:=999; <*<=999*>
1 264
1 264 op_maske_lgd:= ((1+max_antal_operatører+23)//24)*2;
1 265 tv_maske_lgd:= ((1+max_antal_taleveje+23)//24)*2;
1 266 \f
1 266 message sys_parameterinitialisering side 5 - 880901/cl;
1 267
1 267 <* initialisering af konsol-navn *>
1 268 raf:= 0;
1 269 if findfpparam(<:io:>,false,ia)>0 then
1 270 begin
2 271 for i:= 1 step 1 until 4 do konsol_navn(i):= ia(i);
2 272 end
1 273 else
1 274 system(7,0,konsol_navn);
1 275 <*
1 276 movestring(konsol_navn.raf,1,<:console1:>);
1 277 *>
1 278
1 278 raf:= 0;
1 279
1 279 <* intialiserning af talevejsswitchens navn *>
1 280
1 280 movestring(taleswitch_in_navn.raf,1,<:taleswitchi:>);
1 281 movestring(taleswitch_out_navn.raf,1,<:taleswitch:>);
1 282
1 282 <* initialisering af radiokanalnavne *>
1 283
1 283 movestring(radio_fr_navn.raf,1,<:radiofr:>);
1 284 movestring(radio_rf_navn.raf,1,<:radiorf:>);
1 285
1 285 <* initialisering af 'input'-alfabet *>
1 286
1 286 isotable(alfabet);
1 287 alfabet('esc'):= 8 shift 12 + 'esc';
1 288 <* for i:='a' step 1 until 'å' do alfabet(i):=alfabet(i)-32; *>
1 289 for i:= 128 step 1 until 255 do alfabet(i):= 0 shift 12 + i;
1 290 intable(alfabet);
1 291
1 291 <* initialsering af tf_systællere *>
1 292
1 292 tf_systællere:= 1024<*tabelfil*> + 8;
1 293 tf_stoptabel := 1024<*tabelfil*> + 5;
1 294 tf_bpl_navne := 1024<*tabelfil*> + 12;
1 295 tf_bpl_def := 1024<*tabelfil*> + 13;
1 296 tf_alarmlgd := 1024<*tabelfil*> + 14;
1 297
1 297 \f
1 297 message filparminit side 1 - 801030/jg;
1 298
1 298 fil_op_længde:= data + 18 <*halvord*>;
1 299
1 299
1 299 dbantez:= 1;
1 300 dbantsz:= 2;
1 301 dbanttz:= 3; <* >=2 aht. samtidig tilgang*>
1 302 dbblokt:= 8;
1 303 dbmaxsf:= 7;
1 304 dbbidlængde:= 3;
1 305 dbbidmax:= 5;
1 306 dbmaxb:= dbmaxsf * dbbidmax;
1 307 dbmaxef:= 12;
1 308 movestring(dbsnavn,1,<:spoolfil:>);
1 309 movestring(dbtnavn,1,<:tabelfil:>);
1 310 if findfpparam(<:tabelfil:>,false,ia)>0 then
1 311 tofrom(dbtnavn,ia,8);
1 312 \f
1 312 message filparminit side 2 - 801030/jg;
1 313
1 313
1 313 <* reserver og check spoolfil og tabelfil *>
1 314 begin integer s,i,funk,f;
2 315 zone z(128,1,stderror); integer array tail(1:10);
2 316
2 316 for f:=1,2 do
2 317 begin
3 318 <*open(z,4,string (case f of(dbsnavn,dbtnavn)),0);*>
3 319 case f of
3 320 begin
4 321 open(z,4,dbsnavn,0);
4 322 open(z,4,dbtnavn,0);
4 323 end;
3 324 for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do
3 325 begin
4 326 s:=monitor(funk,z,i,tail);
4 327 if s<>0 then system(9,funk*100+s,
4 328 case f of(<:<10>spoolfil:>,<:<10>tabelfil:>));
4 329 end;
3 330 case f of begin
4 331 begin integer antseg; <*spoolfil*>
5 332 antseg:=dbmaxb * dbbidlængde;
5 333 if tail(1) < antseg then
5 334 begin
6 335 tail(1):=antseg;
6 336 s:=monitor(44<*change*>,z,i,tail);
6 337 if s<>0 then
6 338 system(9,44*100+s,<:<10>spoolfil:>);
6 339 end;
5 340 end;
4 341 begin <*tabelfil*>
5 342 dbmaxtf:=tail(10);
5 343 if dbmaxtf<1 or dbmaxtf>1023 then
5 344 system(9,dbmaxtf,<:<10>tabelfil:>);
5 345 end
4 346 end case;
3 347 close(z,false);
3 348 end for;
2 349 end;
1 350 \f
1 350 message attention parameterinitialisering side 1 - 810318/hko;
1 351
1 351 att_op_længde:= 40;
1 352 att_maske_lgd:=
1 353 (1+max_antal_operatører+max_antal_garageterminaler+1+23)//24*2;
1 354 terminal_beskr_længde:=6;
1 355 terminal_tilstand:= 2;
1 356 terminal_suppl:=4;
1 357
1 357 message io_parameterinitialisering side 1 - 810421/hko;
1 358
1 358
1 358 message operatør_parameterinitialisering side 1 - 810422/hko;
1 359
1 359 <* felter i cqf_tabel *>
1 360 cqf_lgd:=
1 361 cqf_næste_tid:= 16;
1 362 cqf_ok_tid := 12;
1 363 cqf_id := 8;
1 364 cqf_fejl := 4;
1 365 cqf_bus := 2;
1 366
1 366 max_cqf:= 64;
1 367
1 367 <* felter i opkaldsalarmtabel *>
1 368 alarm_kmdo := 2;
1 369 alarm_tilst := 4;
1 370 alarm_gtilst:= 6;
1 371 alarm_lgd := 8;
1 372 alarm_start := 12;
1 373
1 373 opk_alarm_tab_lgd:= 12;
1 374 op_spool_postantal:= 16;
1 375 op_spool_postlgd:= 64;
1 376
1 376
1 376 \f
1 376 message procedure radio_parameterinitialisering side 1 - 810601/hko;
1 377
1 377 radio_giveup:= 1 shift 21 + 1 shift 9;
1 378 opkaldskø_postlængde:= 10+op_maske_lgd;
1 379 kanal_beskr_længde:= 12+op_maske_lgd+tv_maske_lgd;
1 380 radio_op_længde:= 30*2;
1 381 radio_pulje_størrelse:= 1+max_antal_taleveje;
1 382
1 382 \f
1 382 message vogntabel parameterinitialisering side 1 - 810309/cl;
1 383
1 383 vt_op_længde:= data + 16; <* halvord *>
1 384
1 384 if findfpparam(<:vtlogskift:>,true,ia) > 0 then
1 385 vt_logskift:= ia(1) else vt_logskift:= -1;
1 386
1 386 vt_log_aktiv:= (vt_logskift >= 0) and (vt_logskift < 240000);
1 387
1 387
1 387 \f
1 387 message filclaim, side 1 - 810202/cl;
1 388
1 388 maxcoru:= maxcoru+6;
1 389 maxsem:= maxsem+2;
1 390 maxsemch:= maxsemch+6;
1 391 \f
1 391 message attention_claiming side 1 - 810318/hko;
1 392
1 392
1 392 maxcoru:=maxcoru+1;
1 393
1 393 max_op:=max_op +1
1 394 +max_antal_operatører
1 395 +max_antal_garageterminaler;
1 396
1 396 max_nettoop:=maxnettoop+(data+att_op_længde)
1 397 *(1+max_antal_operatører
1 398 +max_antal_garageterminaler);
1 399
1 399 max_procext:=max_procext+1;
1 400
1 400 max_sem:= max_sem+1;
1 401
1 401 max_semch:=maxsemch+1;
1 402
1 402
1 402 \f
1 402 message io_claiming side 1 - 810421/hko;
1 403
1 403 max_coru:= max_coru
1 404 + 1 <* hovedmodul io *>
1 405 + 1 <* io kommando *>
1 406 + 1 <* io operatørmeddelelser *>
1 407 + 1 <* io spontane meddelelser *>
1 408 + 1; <* io spoolkorutine *>
1 409
1 409 max_semch:= max_semch
1 410 + 1 <* cs_io *>
1 411 + 1 <* cs_io_komm *>
1 412 + 1 <* cs_io_fil *>
1 413 + 1 <* cs_io_medd *>
1 414 + 1; <* cs_io_spool *>
1 415
1 415 max_sem:= max_sem
1 416 + 1 <* ss_io_spool_fulde *>
1 417 + 1 <* ss_io_spool_tomme *>
1 418 + 1; <* bs_zio_adgang *>
1 419
1 419 max_op:=max_op
1 420 + 1; <* fil-operation *>
1 421
1 421 max_nettoop:=max_nettoop
1 422 + (data+18); <* fil-operation *>
1 423
1 423 \f
1 423 message operatør_claiming side 1 - 810520/hko;
1 424
1 424 max_coru:= max_coru +1 <* h_op *>
1 425 +1 <* alarmur *>
1 426 +1 <* opkaldsalarmer *>
1 427 +1 <* talevejsswitch *>
1 428 +1 <* tv_switch_adm *>
1 429 +1 <* tv_switch_input *>
1 430 +1 <* op_spool *>
1 431 +1 <* op_medd *>
1 432 +1 <* op_cqftest *>
1 433 +max_antal_operatører;
1 434
1 434 max_sem:= 1 <* bs_opk_alarm *>
1 435 +1 <* ss_op_spool_tomme *>
1 436 +1 <* ss_op_spool_fulde *>
1 437 +max_sem;
1 438
1 438 max_semch:= max_semch +1 <* cs_op *>
1 439 +1 <* cs_op_retur *>
1 440 +1 <* cs_opk_alarm_ur *>
1 441 +1 <* cs_opk_alarm_ur_ret *>
1 442 +1 <* cs_opk_alarm *>
1 443 +1 <* cs_talevejsswitch *>
1 444 +1 <* cs_tv_switch_adm *>
1 445 +1 <* cs_tvswitch_adgang *>
1 446 +1 <* cs_tvswitch_input *>
1 447 +1 <* cs_op_iomedd *>
1 448 +1 <* cs_op_spool *>
1 449 +1 <* cs_op_medd *>
1 450 +1 <* cs_cqf *>
1 451 +max_antal_operatører<* cs_operatør *>
1 452 +max_antal_operatører<* cs_op_fil *>;
1 453
1 453 max_op:= max_op + 1 <* talevejsoperation *>
1 454 + 2 <* tv_switch_input *>
1 455 + 1 <* op_iomedd *>
1 456 + 1 <* opk_alarm_ur *>
1 457 + 1 <* op_spool_medd *>
1 458 + 1 <* op_cqftest *>
1 459 + max_antal_operatører;
1 460
1 460 max_netto_op:= filoplængde*max_antal_operatører
1 461 + data+128 <* talevejsoperation *>
1 462 + 2*(data+256) <* tv_switch_input *>
1 463 + 60 <* op_iomedd *>
1 464 + data <* opk_alarm_ur *>
1 465 + data+op_spool_postlgd <* op_spool_med *>
1 466 + 60 <* op_cqftest *>
1 467 + max_netto_op;
1 468
1 468 \f
1 468 message garage_claiming side 1 -810226/hko;
1 469
1 469 max_coru:= max_coru +1
1 470 +max_antal_garageterminaler;
1 471
1 471 max_semch:= max_semch +1
1 472 +max_antal_garageterminaler;
1 473
1 473 \f
1 473 message procedure radio_claiming side 1 - 810526/hko;
1 474
1 474 max_coru:= max_coru
1 475 +1 <* hovedmodul radio *>
1 476 +1 <* opkaldskø_meddelelse *>
1 477 +1 <* radio_adm *>
1 478 +max_antal_taleveje <* radio *>
1 479 +2; <* radio ind/-ud*>
1 480
1 480 max_semch:= max_semch
1 481 +1 <* cs_rad *>
1 482 +max_antal_taleveje <* cs_radio *>
1 483 +1 <* cs_radio_pulje *>
1 484 +1 <* cs_radio_kø *>
1 485 +1 <* cs_radio_medd *>
1 486 +1 <* cs_radio_adm *>
1 487 +2 ; <* cs_radio_ind/-ud *>
1 488
1 488 max_sem:=
1 489 +1 <* bs_mobil_opkald *>
1 490 +1 <* bs_opkaldskø_adgang *>
1 491 +max_antal_kanaler <* ss_radio_aktiver *>
1 492 +max_antal_kanaler <* ss_samtale_nedlagt *>
1 493 +max_antal_taleveje <* bs_talevej_udkoblet *>
1 494 +max_sem;
1 495
1 495 max_op:=
1 496 + radio_pulje_størrelse <* radio_pulje_operationer *>
1 497 + 1 <* radio_medd *>
1 498 + 1 <* radio_adm *>
1 499 + max_antal_taleveje <* operationer for radio *>
1 500 + 2 <* operationer for radio_ind/-ud *>
1 501 + max_op;
1 502
1 502 max_netto_op:=
1 503 + radio_pulje_størrelse * 60 <* radio_pulje_operationer *>
1 504 + data + 6 <* radio_medd *>
1 505 + max_antal_taleveje <* operationer for radio *>
1 506 * (data + radio_op_længde)
1 507 + data + radio_op_længde <* operation for radio_adm *>
1 508 + 2*(data + 64) <* operationer for radio_ind/-ud *>
1 509 + max_netto_op;
1 510 \f
1 510 message vogntabel_claiming side 1 - 810413/cl;
1 511
1 511 maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
1 512 + 1 <* coroutine vt_opdater *>
1 513 + 1 <* coroutine vt_tilstand *>
1 514 + 1 <* coroutine vt_rapport *>
1 515 + 1 <* coroutine vt_gruppe *>
1 516 + 1 <* coroutine vt_spring *>
1 517 + 1 <* coroutine vt_auto *>
1 518 + 1 <* coroutine vt_log *>
1 519 + maxcoru;
1 520
1 520 maxsemch:= 1 <* cs_vt *>
1 521 + 1 <* cs_vt_adgang *>
1 522 + 1 <* cs_vt_logpool *>
1 523 + 1 <* cs_vt_opd *>
1 524 + 1 <* cs_vt_rap *>
1 525 + 1 <* cs_vt_tilst *>
1 526 + 1 <* cs_vtt_auto *>
1 527 + 1 <* cs_vt_grp *>
1 528 + 1 <* cs_vt_spring *>
1 529 + 1 <* cs_vt_log *>
1 530 + 5 <* cs_vt_filretur(coru) *>
1 531 + maxsemch;
1 532
1 532 maxop:= 1 <* vt_op *>
1 533 + 2 <* vt_log_op *>
1 534 + 6 <* vt_fil_op + radop *>
1 535 + maxop;
1 536
1 536 maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
1 537 + 5*fil_op_længde
1 538 + (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
1 539 + maxnettoop;
1 540
1 540 \f
1 540
1 540 algol list.off;
1 541 message coroutinemonitor - 3 ;
1 542
1 542 begin
2 543
2 543 <* work variables - primarily used during initialization *>
2 544 integer array field simref, semref, coruref, opref;
2 545 integer proccount, corucount, messcount, cmi, cmj;
2 546 integer array zoneia(1:20);
2 547
2 547 <* field variables describing the format of basic entities *>
2 548 integer field
2 549 <* chain head *>
2 550 next, prev,
2 551 <* simple semaphore *>
2 552 simvalue, simcoru,
2 553 <* chained semaphore *>
2 554 semop, semcoru,
2 555 <* coroutine *>
2 556 coruop, corutimerchain, corutimer, corupriority, coruident,
2 557 <* operation head *>
2 558 opnext, opsize;
2 559
2 559 \f
2 559
2 559 message coroutinemonitor - 4 ;
2 560
2 560 boolean field
2 561 corutypeset, corutestmask, optype;
2 562 real starttime;
2 563 long corustate;
2 564
2 564 <* field variables used as queue identifiers (addresses) *>
2 565 integer array field current, readyqueue, idlequeue, timerqueue;
2 566
2 566 <* extensions (message- and process- extensions) *>
2 567 integer array messref, messcode, messop (1:maxmessext);
2 568 integer array procref, proccode, procop (1:maxprocext);
2 569
2 569 <* core array used for accessing the core using addresses as field
2 570 variables (as delivered by the monitor functions)
2 571 - descriptor array 'd' in which all basic entities are allocated
2 572 (except for extensions) *>
2 573 integer array core (1:1), d (1:(4 <* readyqueue *> +
2 574 4 <* idlequeue *> +
2 575 4 <* timerqueue *> +
2 576 maxcoru * corusize +
2 577 maxsem * simsize +
2 578 maxsemch * semsize +
2 579 maxop * opheadsize +
2 580 maxnettoop)/2);
2 581 \f
2 581
2 581 message coroutinemonitor - 5 ;
2 582
2 582
2 582
2 582 <*************** initialization procedures ***************>
2 583
2 583
2 583
2 583 procedure initchain (chainref);
2 584 value chainref;
2 585 integer array field chainref;
2 586 begin
3 587 integer array field cref;
3 588 cref:= chainref;
3 589 d.cref.next:= d.cref.prev:= cref;
3 590 end;
2 591 \f
2 591
2 591 message coroutinemonitor - 6 ;
2 592
2 592
2 592 <***** nextsem *****
2 593
2 593 this procedure allocates and initializes the next simple semaphore in the
2 594 pool of claimed semaphores.
2 595 the procedure returns the identification (the address) of the semaphore to
2 596 be used when calling 'signal', 'wait' and 'inspect'. *>
2 597
2 597 integer procedure nextsem;
2 598 begin
3 599 nextsem:= simref;
3 600 if simref >= firstsem then initerror(1, true);
3 601 initchain(simref + simcoru);
3 602 d.simref.simvalue:= 0;
3 603 simref:= simref + simsize;
3 604 end;
2 605
2 605
2 605 <***** nextsemch *****
2 606
2 606 this procedure allocates and initializes the next simple semaphore in the
2 607 pool of claimed semaphores.
2 608 the procedure returns the identification (the address) of the semaphore to
2 609 be used when calling 'signalch', 'waitch' and 'inspectch'. *>
2 610
2 610 integer procedure nextsemch;
2 611 begin
3 612 nextsemch:= semref;
3 613 if semref >= firstop-4 then initerror(2, true);
3 614 initchain(semref + semcoru);
3 615 initchain(semref + semop);
3 616 semref:= semref + semsize;
3 617 end;
2 618 \f
2 618
2 618 message coroutinemonitor - 7 ;
2 619
2 619
2 619 <***** nextcoru *****
2 620
2 620 this procedure initializes the next coroutine description in the pool of
2 621 claimed coroutine descriptions.
2 622 at initialization is defined the priority (an integer value), an identi-
2 623 fication (an integer value 0..8000) and a test pattern (a boolean). *>
2 624
2 624 integer procedure nextcoru(ident, priority, testmask);
2 625 value ident, priority, testmask;
2 626 integer ident, priority;
2 627 boolean testmask;
2 628 begin
3 629 corucount:= corucount + 1;
3 630 if corucount > maxcoru then initerror(3, true);
3 631 nextcoru:= corucount;
3 632 initchain(coruref + next);
3 633 initchain(coruref + corutimerchain);
3 634 initchain(coruref + coruop);
3 635 d.coruref.corupriority:= priority;
3 636 d.coruref.coruident:= ident * 1000 + corucount;
3 637 d.coruref.corutypeset:= false;
3 638 d.coruref.corutimer:= 0;
3 639 d.coruref.corutestmask:= testmask;
3 640 linkprio(coruref, readyqueue);
3 641 current:= coruref;
3 642 coruref:= coruref + corusize;
3 643 end;
2 644 \f
2 644
2 644 message coroutinemonitor - 8 ;
2 645
2 645
2 645 <***** nextop *****
2 646
2 646 this procedure initializes the next operation in the pool of claimed ope-
2 647 rations (heads and buffers).
2 648 the head is allocated and immediately following the head is allocated 'size'
2 649 halfwords forming the operation buffer.
2 650 the procedure returns an identification of the operation (an address) and
2 651 in case this address is held in a field variable 'op', the buffer area may
2 652 be accessed as: d.op(1), d.op(2), d.op(3) ... *>
2 653
2 653 integer procedure nextop (size);
2 654 value size;
2 655 integer size;
2 656 begin
3 657 nextop:= opref;
3 658 if opref >= optop then initerror(4, true);
3 659 initchain(opref + next);
3 660 d.opref.opsize:= size;
3 661 opref:= opref + size + opheadsize;
3 662 end;
2 663 \f
2 663
2 663 message coroutinemonitor - 9 ;
2 664
2 664
2 664 <***** nextprocext *****
2 665
2 665 this procedure initializes the next process extension in the series of
2 666 claimed process extensions.
2 667 the process description address is put into the process extension and the
2 668 state of the extension is initialized to be closed. *>
2 669
2 669 integer procedure nextprocext (processref);
2 670 value processref;
2 671 integer processref;
2 672 begin
3 673 proccount:= proccount + 1;
3 674 if proccount >= maxprocext then initerror(5, true);
3 675 nextprocext:= proccount;
3 676 procref(proccount):= processref;
3 677 proccode(proccount):= 1 shift 12;
3 678 end;
2 679 \f
2 679
2 679 message coroutinemonitor - 10 ;
2 680
2 680
2 680 <***** initerror *****
2 681
2 681 this procedure is activated in case the initialized set of resources does
2 682 not match the claimed set.
2 683 in case more resources are claimed than used, a warning is written,
2 684 in case too few resources are claimed, an error message is written and
2 685 the execution is terminated. *>
2 686
2 686 procedure initerror (resource, exceeded);
2 687 value resource, exceeded;
2 688 integer resource; boolean exceeded;
2 689 begin
3 690 write(out, false add 10, 1,
3 691 if exceeded then <:more :> else <:less :>,
3 692 case resource of (
3 693 <:simple semaphores:>,
3 694 <:chained semaphores:>,
3 695 <:coroutines:>,
3 696 <:operations:>,
3 697 <:process extensions:>),
3 698 <: initialized than claimed:>,
3 699 false add 10, 1);
3 700 if exceeded then goto dump;
3 701 end;
2 702
2 702
2 702 <***** stackclaim *****
2 703
2 703 this procedure is used by a coroutine from its first activation to it
2 704 arrives its first waiting point. the procedure is used to claim an addi-
2 705 tional amount of stack space. this must be done because the maximum
2 706 stack space for a coroutine is set to be the max amount used during its
2 707 very first activation. *>
2 708
2 708
2 708 procedure stackclaim (size);
2 709 value size; integer size;
2 710 begin
3 711 boolean array stackspace (1:size);
3 712 end;
2 713 algol list.on;
2 714
2 714 \f
2 714 message sys_erklæringer side 1 - 810406/cl,hko;
2 715
2 715 zone
2 716 zdummy(1,1,stderror),
2 717 zrl(128,1,stderror),
2 718 zbillede(128,1,stderror);
2 719
2 719 real array
2 720 fejltekst(1:max_antal_fejltekster);
2 721
2 721 real
2 722 systællere_nulstillet;
2 723
2 723 integer
2 724 nulstil_systællere,
2 725 top_bpl_gruppe;
2 726
2 726 integer array
2 727 ingen_operatører, alle_operatører(1:(op_maske_lgd//2)),
2 728 ingen_taleveje, alle_taleveje(1:(tv_maske_lgd//2)),
2 729 bpl_def(1:(128*(op_maske_lgd//2))),
2 730 bpl_tilst(0:127,1:2),
2 731 operatør_stop(0:max_antal_operatører,0:3),
2 732 område_id(1:max_antal_områder,1:2),
2 733 pabx_id(1:max_antal_pabx),
2 734 radio_id(1:max_antal_radiokanaler),
2 735 kanal_id(1:max_antal_kanaler),
2 736 opkalds_tællere(1:(max_antal_områder*8)), <* maxantal < 16 *>
2 737 operatør_tællere(1:(max_antal_operatører*4)); <* maxantal <= 32 *>
2 738
2 738 boolean array
2 739 operatør_auto_include(1:max_antal_operatører),
2 740 garage_auto_include(1:max_antal_garageterminaler);
2 741
2 741 long array
2 742 terminal_navn(1:(2*max_antal_operatører)),
2 743 garage_terminal_navn(1:(2*max_antal_garageterminaler)),
2 744 bpl_navn(0:127),
2 745 område_navn(1:max_antal_områder),
2 746 kanal_navn(1:max_antal_kanaler);
2 747 \f
2 747 message procedure findområde side 1 - 880901/cl;
2 748
2 748 integer procedure find_bpl(navn);
2 749 value navn;
2 750 long navn;
2 751 begin
3 752 integer i;
3 753
3 753 find_bpl:= 0;
3 754 for i:= 0 step 1 until 127 do
3 755 if navn = bpl_navn(i) then find_bpl:= i;
3 756 end;
2 757
2 757 integer procedure findområde(omr);
2 758 value omr;
2 759 integer omr;
2 760 begin
3 761 integer i;
3 762
3 762 if omr = '*' shift 16 then findområde:= -1 else
3 763 begin
4 764 findområde:= 0;
4 765 for i:= 1 step 1 until max_antal_områder do
4 766 if (extend omr) shift 24=område_navn(i) then findområde:= i;
4 767 end;
3 768 end;
2 769 \f
2 769 message procedure tæl_opkald side 1 - 880926/cl;
2 770
2 770 procedure opdater_tf_systællere;
2 771 begin
3 772 integer zi;
3 773 integer array field iaf;
3 774 real field rf;
3 775
3 775 disable begin
4 776 skrivfil(tf_systællere,1,zi);
4 777 rf:= iaf:= 4;
4 778 fil(zi).rf:= systællere_nulstillet;
4 779 fil(zi).iaf(1):= nulstil_systællere;
4 780 iaf:= 16;
4 781 tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*16);
4 782 iaf:= 256;
4 783 tofrom(fil(zi).iaf,operatør_tællere,max_antal_operatører*8);
4 784 setposition(fil(zi),0,0);
4 785 end;
3 786 end;
2 787
2 787 procedure tæl_opkald(område,type);
2 788 value område,type;
2 789 integer område,type;
2 790 begin
3 791 increase(opkalds_tællere((område-1)*8+type));
3 792 disable opdater_tf_systællere;
3 793 end;
2 794
2 794 procedure tæl_opkald_pr_operatør(operatør,type);
2 795 value operatør,type;
2 796 integer operatør,type;
2 797 begin
3 798 increase(operatør_tællere((operatør-1)*4+type));
3 799 disable opdater_tf_systællere;
3 800 end;
2 801
2 801 procedure skriv_opkaldstællere(z);
2 802 zone z;
2 803 begin
3 804 integer omr,typ,rpc;
3 805 real r;
3 806
3 806 write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
3 807 <:omr ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 808 for omr:= 1 step 1 until max_antal_områder do
3 809 begin
4 810 write(z,true,6,string område_navn(omr),":",1);
4 811 for typ:= 1 step 1 until 5 do
4 812 write(z,<< ddddddd>,opkalds_tællere((omr-1)*8+typ));
4 813 outchar(z,'nl');
4 814 end;
3 815
3 815 write(z,"nl",1,
3 816 <:oper. ud ind-alm ind-nød:>,"nl",1);
3 817 for omr:= 1 step 1 until max_antal_operatører do
3 818 begin
4 819 if bpl_navn(omr)=long<::> then
4 820 write(z,"sp",6-write(z,<:op:>,<<d>,omr),":",1)
4 821 else
4 822 write(z,true,6,string bpl_navn(omr),":",1);
4 823 for typ:= 1 step 1 until 3 do
4 824 write(z,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
4 825 outchar(z,'nl');
4 826 end;
3 827
3 827 rpc:= replace_char(1,':');
3 828 write(z,"nl",1,<:nulstilles :>);
3 829 if nulstil_systællere = (-1) then write(z,<:ikke automatisk:>,"nl",1)
3 830 else write(z,<:automatisk kl. :>,<<zd dd dd>,nulstil_systællere,"nl",1);
3 831 replace_char(1,'.');
3 832 write(z,<:nulstillet d. :>,<<zd dd dd>,
3 833 systime(4,systællere_nulstillet,r)," ",1);
3 834 replace_char(1,':');
3 835 write(z,<<zd dd dd>,r,"nl",1);
3 836 replace_char(1,rpc);
3 837 end;
2 838 \f
2 838 message procedure start_operation side 1 - 810521/hko;
2 839
2 839 procedure start_operation(op_ref,kor,ret_sem,kode);
2 840 value kor,ret_sem,kode;
2 841 integer array field op_ref;
2 842 integer kor,ret_sem,kode;
2 843 <*
2 844 op_ref: kald, reference til operation
2 845
2 845 kor: kald, kilde= hovedmodulnr*100 +løbenr
2 846 = korutineident.
2 847 ret_sem: kald, retursemafor
2 848
2 848 kode: kald, suppl shift 12 + operationskode
2 849
2 849 proceduren initialiserer en operations hoved med
2 850 parameterværdierne samt tidfeltet med aktueltid.
2 851 resultatfelt og datafelter nulstilles.
2 852
2 852 *>
2 853 begin
3 854 integer i;
3 855 d.op_ref.kilde:= kor;
3 856 systime(1,0,d.op_ref.tid);
3 857 d.op_ref.retur:=ret_sem;
3 858 d.op_ref.op_kode:=kode;
3 859 d.op_ref.resultat:=0;
3 860 for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
3 861 d.op_ref.data(i):=0;
3 862 end start_operation;
2 863 \f
2 863 message procedure afslut_operation side 1 - 810331/hko;
2 864
2 864 procedure afslut_operation(op_ref,sem);
2 865 value op_ref,sem;
2 866 integer op_ref,sem;
2 867 begin
3 868 integer array field op;
3 869 op:=op_ref;
3 870 if sem>0 then signal_ch(sem,op,d.op.optype) else
3 871 if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
3 872 ;
3 873 end afslut_operation;
2 874 \f
2 874 message procedure fejlreaktion - side 1 - 810424/cl,hko;
2 875
2 875 procedure fejlreaktion(nr,værdi,str,måde);
2 876 value nr,værdi,måde;
2 877 integer nr,værdi,måde;
2 878 string str;
2 879 begin
3 880 disable begin
4 881 write(out,<:<10>!!! :>);
4 882 if nr>0 and nr <=max_antal_fejltekster then
4 883 write(out,string fejltekst(nr))
4 884 else write(out,<:fejl nr.:>,nr);
4 885 outchar(out,'sp');
4 886 if måde shift (-12) extract 2=1 then
4 887 outintbits(out,værdi)
4 888 else
4 889 if måde shift (-12) extract 2=2 then
4 890 write(out,<:":>,false add værdi,1,<:":>)
4 891 else
4 892 write(out,værdi);
4 893 write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
4 894 <: korutine nr=:>,<<d>, abs curr_coruno,
4 895 <: ident=:>,curr_coruid,"nl",0);
4 896 if testbit27 and måde extract 12=1 then
4 897 trace(1);
4 898 ud;
4 899 end;<*disable*>
3 900 if måde extract 12 =2 then trapmode:=1 shift 13;
3 901 if måde extract 12= 0 then trap(-1)
3 902 else if måde extract 12 = 2 then trap(-2);
3 903 end fejlreaktion;
2 904
2 904 procedure trace(n);
2 905 value n;
2 906 integer n;
2 907 begin
3 908 trap(finis);
3 909 trap(n);
3 910 finis:
3 911 end trace;
2 912 \f
2 912 message procedure overvåget side 1 - 810413/cl;
2 913
2 913 boolean procedure overvåget;
2 914 begin
3 915 disable begin
4 916 integer i,måde;
4 917 integer array field cor;
4 918 integer array ia(1:12);
4 919
4 919 i:= system(12,0,ia);
4 920 if i > 0 then
4 921 begin
5 922 i:= system(12,1,ia);
5 923 måde:= ia(3);
5 924 end
4 925 else måde:= 0;
4 926
4 926 if måde<>0 then
4 927 begin
5 928 cor:= coroutine(abs ia(3));
5 929 overvåget:= d.cor.corutestmask shift (-11);
5 930 end
4 931 else overvåget:= cl_overvåget;
4 932 end;
3 933 end;
2 934 \f
2 934 message procedure antal_bits_ia side 1 - 940424/cl;
2 935
2 935 integer procedure antal_bits_ia(ia,n,ø);
2 936 value n,ø;
2 937 integer array ia;
2 938 integer n,ø;
2 939 begin
3 940 integer i, ant;
3 941
3 941 ant:= 0;
3 942 for i:= n step 1 until ø do
3 943 if læsbit_ia(ia,i) then ant:= ant+1;
3 944 end;
2 945
2 945 message procedure trunk_til_omr side 1 - 881006/cl;
2 946
2 946 integer procedure trunk_til_omr(trunk);
2 947 value trunk; integer trunk;
2 948 begin
3 949 integer i,j;
3 950
3 950 j:=0;
3 951 for i:= 1 step 1 until max_antal_områder do
3 952 if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
3 953 trunk_til_omr:=j;
3 954 end;
2 955
2 955 integer procedure omr_til_trunk(omr);
2 956 value omr; integer omr;
2 957 begin
3 958 omr_til_trunk:= område_id(omr,2) extract 12;
3 959 end;
2 960
2 960 integer procedure port_til_omr(port);
2 961 value port; integer port;
2 962 begin
3 963 if port shift (-6) extract 6 = 2 then
3 964 port_til_omr:= pabx_id(port extract 6)
3 965 else
3 966 if port shift (-6) extract 6 = 3 then
3 967 port_til_omr:= radio_id(port extract 6)
3 968 else
3 969 port_til_omr:= 0;
3 970 end;
2 971
2 971 integer procedure kanal_til_port(kanal);
2 972 value kanal; integer kanal;
2 973 begin
3 974 kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
3 975 kanal_id(kanal) extract 5;
3 976 end;
2 977
2 977 integer procedure port_til_kanal(port);
2 978 value port; integer port;
2 979 begin
3 980 integer i,j;
3 981
3 981 j:=0;
3 982 for i:= 1 step 1 until max_antal_kanaler do
3 983 if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
3 984 port_til_kanal:= j;
3 985 end;
2 986
2 986 integer procedure kanal_til_omr(kanal);
2 987 value kanal; integer kanal;
2 988 begin
3 989 kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
3 990 end;
2 991
2 991 \f
2 991 message procedure out_xxx_bits side 1 - 810406/cl;
2 992
2 992 procedure outboolbits(zud,b);
2 993 value b;
2 994 zone zud;
2 995 boolean b;
2 996 begin
3 997 integer i;
3 998
3 998 for i:= -11 step 1 until 0 do
3 999 outchar(zud,if b shift i then '1' else '.');
3 1000 end;
2 1001
2 1001 procedure outintbits(zud,j);
2 1002 value j;
2 1003 zone zud;
2 1004 integer j;
2 1005 begin
3 1006 integer i;
3 1007
3 1007 for i:= -23 step 1 until 0 do
3 1008 begin
4 1009 outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
4 1010 if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
4 1011 end;
3 1012 end;
2 1013
2 1013 procedure outintbits_ia(zud,ia,n,ø);
2 1014 value n,ø;
2 1015 zone zud;
2 1016 integer array ia;
2 1017 integer n,ø;
2 1018 begin
3 1019 integer i;
3 1020
3 1020 for i:= n step 1 until ø do
3 1021 begin
4 1022 outintbits(zud,ia(i));
4 1023 outchar(zud,'nl');
4 1024 end;
3 1025 end;
2 1026
2 1026 real procedure now;
2 1027 begin
3 1028 real f,r,r1; long l;
3 1029
3 1029 systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
3 1030 systime(4,r,r1);
3 1031 now:= r1+f;
3 1032 end;
2 1033 \f
2 1033 message procedure skriv_id side 1 - 820301/cl;
2 1034
2 1034 procedure skriv_id(z,id,lgd);
2 1035 value id,lgd;
2 1036 integer id,lgd;
2 1037 zone z;
2 1038 begin
3 1039 integer type,p,li,lø,bo;
3 1040
3 1040 type:= id shift (-22);
3 1041 case type+1 of
3 1042 begin
4 1043 <* 1: bus *>
4 1044 begin
5 1045 p:= write(z,<<d>,id extract 14);
5 1046 if id shift (-14) <> 0 then
5 1047 p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
5 1048 end;
4 1049
4 1049 <* 2: linie/løb *>
4 1050 begin
5 1051 li:= id shift (-12) extract 10;
5 1052 bo:= id shift (-7) extract 5;
5 1053 if bo<>0 then bo:= bo + 'A' - 1;
5 1054 lø:= id extract 7;
5 1055 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
5 1056 end;
4 1057
4 1057 <* 3: gruppe *>
4 1058 begin
5 1059 if id shift (-21) = 4 <* linie-gruppe *> then
5 1060 begin
6 1061 li:= id shift (-5) extract 10;
6 1062 bo:= id extract 5;
6 1063 if bo<>0 then bo:= bo + 'A' - 1;
6 1064 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
6 1065 end
5 1066 else <* special-gruppe *>
5 1067 p:= write(z,"G",1,<<d>,id extract 7);
5 1068 end;
4 1069
4 1069 <* 4: telefon *>
4 1070 begin
5 1071 bo:= id shift (-20) extract 2;
5 1072 li:= id extract 20;
5 1073 case bo+1 of
5 1074 begin
6 1075 p:= write(z,string kanalnavn(li));
6 1076 p:= write(z,<:K*:>);
6 1077 p:= write(z,<:OMR :>,string områdenavn(li));
6 1078 p:= write(z,<:OMR*:>);
6 1079 end;
5 1080 end;
4 1081 end case;
3 1082 write(z,"sp",lgd-p);
3 1083 end skriv_id;
2 1084 <*+3*>
2 1085 \f
2 1085 message skriv_new_sem side 1 - 810520/cl;
2 1086
2 1086 procedure skriv_new_sem(z,type,ref,navn);
2 1087 value type,ref;
2 1088 zone z;
2 1089 integer type,ref;
2 1090 string navn;
2 1091 <* skriver en identifikation af en semafor 'ref' i zonen z.
2 1092
2 1092 type: 1=binær sem
2 1093 2=simpel sem
2 1094 3=kædet sem
2 1095
2 1095 ref: semaforreference
2 1096
2 1096 navn: semafornavn, max 18 tegn
2 1097 *>
2 1098 begin
3 1099 disable if testbit29 then
3 1100 write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
3 1101 true,5,<<zddd>,ref,true,19,navn);
3 1102 end;
2 1103 \f
2 1103 message procedure skriv_newactivity side 1 - 810520/hko/cl;
2 1104
2 1104 <**> procedure skriv_newactivity(zud,actno,cause);
2 1105 <**> value actno,cause;
2 1106 <**> zone zud;
2 1107 <**> integer actno,cause;
2 1108 <**> begin
3 1109 <*+2*>
3 1110 <**> if testbit28 then
3 1111 <**> begin integer array field cor;
4 1112 <**> cor:= coroutine(actno);
4 1113 <**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
4 1114 <**> << zdd>,d.cor.coruident//1000);
4 1115 <**> end;
3 1116 <**> if -, testbit23 then goto skriv_newact_slut;
3 1117 <*-2*>
3 1118 <**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
3 1119 <**> <:) cause=:>,<<-d>,cause);
3 1120 <**> if cause<1 then write(zud,<: !!!:>);
3 1121 <**> skriv_coru(zud,actno);
3 1122 <**> skriv_newact_slut:
3 1123 <**> end skriv_newactivity;
2 1124 <*-3*>
2 1125 <*+99*>
2 1126 \f
2 1126 message procedure skriv_activity side 1 - 810313/hko;
2 1127
2 1127 <**> procedure skriv_activity(zud,actno);
2 1128 <**> value actno;
2 1129 <**> zone zud;
2 1130 <**> integer actno;
2 1131 <**> begin
3 1132 <**> integer i;
3 1133 <**> integer array iact(1:12);
3 1134 <**>
3 1135 <**> i:=system(12,actno,iact);
3 1136 <**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
3 1137 <**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
3 1138 <**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
3 1139 <**> if i>0 and actno>0 and actno<=i then
3 1140 <**> begin
4 1141 <**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
4 1142 <**> (<:tom:>,<:passivate:>,
4 1143 <**> <:implicit passivate:>,<:activate:>));
4 1144 <**> if iact(1)<>0 then
4 1145 <**> write(zud,<: ventende på message:>,iact(1));
4 1146 <**> if iact(7)>0 then
4 1147 <**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
4 1148 <**> <:hovedlager stak benyttes af activity(:>,<<d>,
4 1149 <**> iact(2));
4 1150 <**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
4 1151 <**> iact(4),iact(5),iact(6),iact(10),iact(11));
4 1152 <**> if iact(9)<> 1 shift 22 then
4 1153 <**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
4 1154 <**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
4 1155 <**> end;
3 1156 <**> end skriv_activity
2 1157 <*-99*>
2 1158 <*+98*>
2 1159 \f
2 1159 message procedure identificer side 1 - 810520/cl;
2 1160
2 1160 procedure identificer(z);
2 1161 zone z;
2 1162 begin
3 1163 disable write(z,<:coroutine::>,<< dd>,curr_coruno,
3 1164 <: ident::>,<< zdd >,curr_coruid);
3 1165 end;
2 1166 \f
2 1166 message procedure skriv_coru side 1 - 810317/cl;
2 1167
2 1167 <**> procedure skriv_coru(zud,cor_no);
2 1168 <**> value cor_no;
2 1169 <**> zone zud;
2 1170 <**> integer cor_no;
2 1171 <**> begin
3 1172 <**> integer i;
3 1173 <**> integer array field cor;
3 1174 <**>
3 1175 <**>
3 1176 <**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
3 1177 <**>
3 1178 <**> cor:= coroutine(cor_no);
3 1179 <**> if cor = -1 then
3 1180 <**> write(zud,<: eksisterer ikke !!!:>)
3 1181 <**> else
3 1182 <**> begin
4 1183 <**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
4 1184 <**> <: refbyte: :>,<<d>,cor,"nl",1,
4 1185 <**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
4 1186 <**> <: next: :>,d.cor.next,"nl",1,
4 1187 <**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
4 1188 <**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
4 1189 <**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
4 1190 <**> <: opchain.next: :>,d.cor.coruop,"nl",1,
4 1191 <**> <: timer: :>,d.cor.corutimer,"nl",1,
4 1192 <**> <: priority: :>,d.cor.corupriority,"nl",1,
4 1193 <**> <: typeset: :>);
4 1194 <**> for i:= -11 step 1 until 0 do
4 1195 <**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
4 1196 <**> write(zud,"nl",1,<: testmask: :>);
4 1197 <**> for i:= -11 step 1 until 0 do
4 1198 <**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
4 1199 <*+99*>
4 1200 <**> skriv_activity(zud,cor_no);
4 1201 <*-99*>
4 1202 <**> end;
3 1203 <**> end skriv_coru;
2 1204 <*-98*>
2 1205 <*+98*>
2 1206 \f
2 1206 message procedure skriv_op side 1 - 810409/cl;
2 1207
2 1207 <**> procedure skriv_op(zud,opref);
2 1208 <**> value opref;
2 1209 <**> integer opref;
2 1210 <**> zone zud;
2 1211 <**> begin
3 1212 <**> integer array field op;
3 1213 <**> real array field raf;
3 1214 <**> integer lgd,i;
3 1215 <**> real t;
3 1216 <**>
3 1217 <**> raf:= data;
3 1218 <**> op:= opref;
3 1219 <**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
3 1220 <**> if opref<first_op ! optop<=opref then
3 1221 <**> begin
4 1222 <**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
4 1223 <**> goto slut_skriv_op;
4 1224 <**> end;
3 1225 <**>
3 1226 <**> lgd:= d.op.opsize;
3 1227 <**> write(zud,"nl",1,<<d>,
3 1228 <**> <: opsize :>,d.op.opsize,"nl",1,
3 1229 <**> <: optype :>);
3 1230 <**> for i:= -11 step 1 until 0 do
3 1231 <**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
3 1232 <**> write(zud,"nl",1,<<d>,
3 1233 <**> <: prev :>,d.op.prev,"nl",1,
3 1234 <**> <: next :>,d.op.next);
3 1235 <**> if lgd=0 then goto slut_skriv_op;
3 1236 <**> write(zud,"nl",1,<<d>,
3 1237 <**> <: kilde :>,d.op.kilde extract 10,"nl",1,
3 1238 <**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
3 1239 <**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
3 1240 d.op.retur,"nl",1,
3 1241 <**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
3 1242 <**> d.op.opkode extract 12,"nl",1,
3 1243 <**> <: resultat :>,d.op.resultat,"nl",2,
3 1244 <**> <:data::>);
3 1245 <**> skriv_hele(zud,d.op.raf,lgd-data,1278);
3 1246 <**>slut_skriv_op:
3 1247 <**> end skriv_op;
2 1248 <*-98*>
2 1249 \f
2 1249 message procedure corutable side 1 - 810406/cl;
2 1250
2 1250 procedure corutable(zud);
2 1251 zone zud;
2 1252 begin
3 1253 integer i;
3 1254 integer array field cor;
3 1255
3 1255 write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
3 1256 <:no id ref chain timerch opchain timer pr:>,
3 1257 <: typeset testmask:>,"nl",2);
3 1258 for i:= 1 step 1 until maxcoru do
3 1259 begin
4 1260 cor:= coroutine(i);
4 1261 write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
4 1262 d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
4 1263 d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
4 1264 d.cor.corutimer,<< dd>,d.cor.corupriority);
4 1265 outchar(zud,'sp');
4 1266 outboolbits(zud,d.cor.corutypeset);
4 1267 outchar(zud,'sp');
4 1268 outboolbits(zud,d.cor.corutestmask);
4 1269 outchar(zud,'nl');
4 1270 end;
3 1271 end;
2 1272 \f
2 1272 message filglobal side 1 - 790302/jg;
2 1273
2 1273 integer
2 1274 dbantsf,dbkatsfri,
2 1275 dbantb,dbkatbfri,
2 1276 dbantef,dbkatefri,
2 1277 dbsidstesz,dbsidstetz,
2 1278 dbsegmax,
2 1279 filskrevet,fillæst;
2 1280 integer
2 1281 bs_kats_fri, bs_kate_fri,
2 1282 cs_opret_fil, cs_tilknyt_fil,
2 1283 cs_frigiv_fil, cs_slet_fil,
2 1284 cs_opret_spoolfil, cs_opret_eksternfil;
2 1285 integer array
2 1286 dbkatt(1:dbmaxtf,1:2),
2 1287 dbkats(1:dbmaxsf,1:2),
2 1288 dbkate(1:dbmaxef,1:6),
2 1289 dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
2 1290 boolean array
2 1291 dbkatb(1:dbmaxb);
2 1292 zone array
2 1293 fil(dbantez+dbantsz+dbanttz,128,1,stderror);
2 1294 \f
2 1294 message hentfildim side 1 - 781120/jg;
2 1295
2 1295
2 1295 integer procedure hentfildim(fdim);
2 1296 integer array fdim;
2 1297 <*inddata filref i fdim(4),uddata fdim(1:8)*>
2 1298
2 1298 begin integer ftype,fno,katf,i,s;
3 1299 ftype:=fdim(4) shift (-10);
3 1300 fno:=fdim(4) extract 10;
3 1301 if ftype>3 or ftype=0 or fno=0 then
3 1302 begin s:=1; goto udgang; end;
3 1303 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
3 1304 begin s:=1; goto udgang end; <*paramfejl*>
3 1305 katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
3 1306 if katf extract 9 = 0 then
3 1307 begin s:=2; goto udgang end; <*tom indgang*>
3 1308
3 1308 fdim(1):=katf shift (-9); <*post antal*>
3 1309 fdim(2):=katf extract 9; <*post længde*>
3 1310 fdim(3):=case ftype of( <*seg antal*>
3 1311 dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
3 1312 extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
3 1313 dbkate(fno,2) extract 18);
3 1314 for i:=5 step 1 until 8 do <*externt filnavn*>
3 1315 fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
3 1316 s:=0;
3 1317 udgang:
3 1318 hentfildim:=s;
3 1319 <*+2*>
3 1320 <*tz*> if testbit24 and overvåget then <*zt*>
3 1321 <*tz*> begin <*zt*>
4 1322 <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
4 1323 <*tz*> pfdim(fdim); <*zt*>
4 1324 <*tz*> ud; <*zt*>
4 1325 <*tz*> end; <*zt*>
3 1326 <*-2*>
3 1327 end hentfildim;
2 1328 \f
2 1328 message sætfildim side 1 - 780916/jg;
2 1329
2 1329 integer procedure sætfildim(fdim);
2 1330 integer array fdim;
2 1331 <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
2 1332
2 1332 begin
3 1333 integer ftype,fno,katf,s,pl;
3 1334 integer array gdim(1:8);
3 1335 gdim(4):=fdim(4);
3 1336 s:=hentfildim(gdim);
3 1337 if s>0 then
3 1338 goto udgang;
3 1339 fno:=fdim(4) extract 10;
3 1340 ftype:=fdim(4) shift (-10);
3 1341 pl:= fdim(2) extract 12;
3 1342 if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
3 1343 begin
4 1344 s:=1; <*parameter fejl*>
4 1345 goto udgang
4 1346 end;
3 1347 if fdim(1)>256//pl*fdim(3) then
3 1348 begin
4 1349 s:=1;
4 1350 goto udgang;
4 1351 end;
3 1352
3 1352 <*segant*>
3 1353 if ftype=3 then
3 1354 begin integer segant;
4 1355 segant:= fdim(3);
4 1356 if segant > dbsegmax then
4 1357 begin
5 1358 s:=4; <*ingen plads*>
5 1359 goto udgang
5 1360 end;
4 1361 \f
4 1361 message sætfildim side 2 - 780916/jg;
4 1362
4 1362
4 1362 if segant<>gdim(3) then
4 1363 begin integer i,z,s; array field enavn; integer array tail(1:10);
5 1364 z:=dbkate(fno,2) shift (-19); if z>0 then begin
6 1365 if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
6 1366 begin integer array zd(1:20);
7 1367 getzone6(fil(z),zd);
7 1368 if zd(13)>5 and zd(9)>=segant then
7 1369 begin <*dødt segment skal ikke udskrives*>
8 1370 zd(13):=5;
8 1371 setzone6(fil(z),zd)
8 1372 end
7 1373 end end;
5 1374 \f
5 1374 message sætfildim side 3 - 801031/jg;
5 1375
5 1375
5 1375 enavn:=8; <*ændr fil størrelse*>
5 1376 i:=1;
5 1377 open(zdummy,0,string gdim.enavn(increase(i)),0);
5 1378 s:=monitor(42,zdummy,0,tail); <*lookup*>
5 1379 if s>0 then
5 1380 fejlreaktion(1,s,<:lookup entry:>,0);
5 1381 tail(1):=segant;
5 1382 s:=monitor(44,zdummy,0,tail); <*change entry*>
5 1383 close(zdummy,false);
5 1384 if s<>0 then
5 1385 begin
6 1386 if s=6 then
6 1387 begin <*ingen plads*>
7 1388 s:=4; goto udgang
7 1389 end
6 1390 else fejlreaktion(1,s,<:change entry:>,0);
6 1391 end;
5 1392 dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
5 1393 add segant;
5 1394 \f
5 1394 message sætfildim side 4 - 801013/jg;
5 1395
5 1395
5 1395 end;
4 1396 fdim(3):=segant
4 1397 end
3 1398 else
3 1399 if fdim(3)>gdim(3) then
3 1400 begin
4 1401 s:=4; <*altid ingen plads*>
4 1402 goto udgang
4 1403 end
3 1404 else fdim(3):=gdim(3); <*samme længde*>
3 1405 <*postantal,postlængde*>
3 1406 katf:=fdim(1) shift 9 add pl;
3 1407 case ftype of begin
4 1408 dbkatt(fno,1):=katf;
4 1409 dbkats(fno,1):=katf;
4 1410 dbkate(fno,1):=katf end;
3 1411 udgang:
3 1412 sætfildim:=s;
3 1413 <*+2*>
3 1414 <*tz*> if testbit24 and overvåget then <*zt*>
3 1415 <*tz*> begin integer i; <*zt*>
4 1416 <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
4 1417 <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
4 1418 <*tz*> pfdim(gdim); <*zt*>
4 1419 <*tz*> ud; <*zt*>
4 1420 <*tz*> end; <*zt*>
3 1421 <*-2*>
3 1422 end sætfildim;
2 1423 \f
2 1423 message findfilenavn side 1 - 780916/jg;
2 1424
2 1424 integer procedure findfilenavn(navn);
2 1425 real array navn;
2 1426
2 1426 begin
3 1427 integer fno; array field enavn;
3 1428 for fno:=1 step 1 until dbmaxef do
3 1429 if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
3 1430 begin
4 1431 enavn:=fno*12+4;
4 1432 if navn(1)=dbkate.enavn(1) and
4 1433 navn(2)=dbkate.enavn(2) then
4 1434 begin
5 1435 findfilenavn:=fno;
5 1436 goto udgang
5 1437 end
4 1438 end;
3 1439 findfilenavn:=0;
3 1440 udgang:
3 1441 end findfilenavn;
2 1442 \f
2 1442 message læsfil side 1 - 781120/jg;
2 1443
2 1443 integer procedure læsfil(filref,postindex,zoneno);
2 1444 value filref,postindex;
2 1445 integer filref,postindex,zoneno;
2 1446 <*+2*>
2 1447 <*tz*> begin integer i,o,s; <*zt*>
3 1448 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1449 <*-2*>
3 1450
3 1450 læsfil:=tilgangfil(filref,postindex,zoneno,5);
3 1451
3 1451 <*+2*>
3 1452 <*tz*> if testbit24 and overvåget then <*zt*>
3 1453 <*tz*> begin <*zt*>
4 1454 <*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*>
4 1455 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1456 <*tz*> end; <*zt*>
3 1457 <*tz*> end procedure; <*zt*>
2 1458 <*-2*>
2 1459 \f
2 1459 message skrivfil side 1 - 781120/jg;
2 1460
2 1460 integer procedure skrivfil(filref,postindex,zoneno);
2 1461 value filref,postindex;
2 1462 integer filref,postindex,zoneno;
2 1463 <*+2*>
2 1464 <*tz*> begin integer i,o,s; <*zt*>
3 1465 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1466 <*-2*>
3 1467
3 1467 skrivfil:=tilgangfil(filref,postindex,zoneno,6);
3 1468
3 1468 <*+2*>
3 1469 <*tz*> if testbit24 and overvåget then <*zt*>
3 1470 <*tz*> begin <*zt*>
4 1471 <*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
4 1472 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1473 <*tz*> end; <*zt*>
3 1474 <*tz*> end procedure; <*zt*>
2 1475 <*-2*>
2 1476 \f
2 1476 message modiffil side 1 - 781120/jg;
2 1477
2 1477 integer procedure modiffil(filref,postindex,zoneno);
2 1478 value filref,postindex;
2 1479 integer filref,postindex,zoneno;
2 1480 <*+2*>
2 1481 <*tz*> begin integer i,o,s; <*zt*>
3 1482 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1483 <*-2*>
3 1484
3 1484 modiffil:=tilgangfil(filref,postindex,zoneno,7);
3 1485
3 1485 <*+2*>
3 1486 <*tz*> if testbit24 and overvåget then <*zt*>
3 1487 <*tz*> begin <*zt*>
4 1488 <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
4 1489 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1490 <*tz*> end; <*zt*>
3 1491 <*tz*> end procedure; <*zt*>
2 1492 <*-2*>
2 1493 \f
2 1493 message tilgangfil side 1 - 781003/jg;
2 1494
2 1494 integer procedure tilgangfil(filref,postindex,zoneno,operation);
2 1495 value filref,postindex,operation;
2 1496 integer filref,postindex,zoneno,operation;
2 1497 <*proceduren kaldes fra læsfil,skrivfil og modiffil*>
2 1498
2 1498 begin
3 1499 integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
3 1500 integer array zd(1:20),fdim(1:8);
3 1501
3 1501
3 1501
3 1501 <*hent katalog*>
3 1502
3 1502 fdim(4):=filref;
3 1503 st:=hentfildim(fdim);
3 1504 if st<>0 then
3 1505 goto udgang; <*parameter fejl eller fil findes ikke*>
3 1506 fno:=filref extract 10;
3 1507 ftype:=filref shift (-10);
3 1508 pl:=fdim(2);
3 1509 katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
3 1510 \f
3 1510 message tilgangfil side 2 - 781003/jg;
3 1511
3 1511
3 1511
3 1511 <*find segment adr og check postindex*>
3 1512
3 1512 pps:=256//pl; <*poster pr segment*>
3 1513 seg:=(postindex-1)//pps; <*relativt segment*>
3 1514 pr:=(postindex-1) mod pps; <*post relativ til seg*>
3 1515 if postindex <1 then
3 1516 begin <*parameter fejl*>
4 1517 st:=1;
4 1518 goto udgang
4 1519 end;
3 1520 if seg>=fdim(3) then
3 1521 begin <*post findes ikke*>
4 1522 st:=3;
4 1523 goto udgang
4 1524 end;
3 1525 case ftype of
3 1526 begin <*find absolut segment*>
4 1527
4 1527 <*tabelfil*>
4 1528 seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
4 1529
4 1529 begin <*spoolfil*>
5 1530 integer i,bidno;
5 1531 bidno:=katf extract 12;
5 1532 for i:=seg//dbbidlængde step -1 until 1 do
5 1533 bidno:=dbkatb(bidno) extract 12;
5 1534 seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
5 1535 end;
4 1536
4 1536 <*extern fil,seg ok*>
4 1537
4 1537 end case find abs seg;
3 1538 \f
3 1538 message tilgangfil side 3 - 801030/jg;
3 1539
3 1539 <*alloker zone*>
3 1540
3 1540 zno:=katf shift(-19);
3 1541 case ftype of begin
4 1542
4 1542 begin <*tabelfil*>
5 1543 integer førstetz;
5 1544 førstetz:=dbkatz(dbsidstetz,2);
5 1545 if zno=0 then
5 1546 zno:=førstetz
5 1547 else if dbkatz(zno,1)<>filref then
5 1548 zno:=førstetz
5 1549 else if zno <> førstetz and zno <> dbsidstetz then
5 1550 begin integer z;
6 1551 for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
6 1552 dbkatz(z,2):=dbkatz(zno,2);
6 1553 dbkatz(zno,2):=førstetz;
6 1554 dbkatz(dbsidstetz,2):=zno;
6 1555 end;
5 1556 dbsidstetz:=zno
5 1557 end;
4 1558 \f
4 1558 message tilgangfil side 4 - 801030/jg;
4 1559
4 1559
4 1559 begin <*spoolfil*>
5 1560 integer p,zslut,z;
5 1561 if zno>0 then begin if dbkatz(zno,1) =filref then
6 1562 goto udgangs end; <*strategi 1*>
5 1563 p:=0;
5 1564 zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
5 1565 zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
5 1566 for z:=dbantez+dbantsz step -1 until zslut do
5 1567 begin integer zfref;
6 1568 zfref:=dbkatz(z,1);
6 1569 if zfref extract 10=0 then <*fri zone*>
6 1570 begin <*strategi 2*>
7 1571 zno:=z;
7 1572 goto udgangs
7 1573 end
6 1574 else
6 1575 if zfref shift (-10)=2 then
6 1576 begin <*zone tilknyttet spoolfil*>
7 1577 integer q;
7 1578 q:=dbkatz(z,2); <*prioritet*>
7 1579 if q>p then
7 1580 begin <*strategi 3*>
8 1581 p:=q;
8 1582 zno:=z
8 1583 end
7 1584 end;
6 1585 end z;
5 1586 udgangs:
5 1587 if zno> dbantez then dbsidstesz:=zno;
5 1588 end;
4 1589 \f
4 1589 message tilgangfil side 5 - 780916/jg;
4 1590
4 1590 begin <*extern fil*>
5 1591 integer z;
5 1592 if zno=0 then
5 1593 zno:=1
5 1594 else if dbkatz(zno,1) = filref then
5 1595 goto udgange; <*strategi 1*>
5 1596 for z:=1 step 1 until dbantez do
5 1597 begin integer zfref;
6 1598 zfref:=dbkatz(z,1);
6 1599 if zfref=0 then <*zone fri*>
6 1600 begin zno:=z; goto udgange end <*strategi 2*>
6 1601 else if zfref shift (-10) =2 then <*spoolfil*>
6 1602 zno:=z; <*strategi 3*> <*else strategi 4-5*>
6 1603 end z;
5 1604 udgange:
5 1605 end
4 1606 end case alloker zone;
3 1607
3 1607
3 1607
3 1607 <*åbn zone*>
3 1608
3 1608 if zno<=dbantez then
3 1609 begin <*extern zone;spool og tabel zoner altid åbne*>
4 1610 integer zfref;
4 1611 zfref:=dbkatz(zno,1);
4 1612 if zfref<>0 and zfref<>filref and ftype=3 then
4 1613 begin <*luk hvis ny extern fil*>
5 1614 getzone6(fil(zno),zd);
5 1615 if zd(13)>5 then filskrevet:=filskrevet+1;
5 1616 zfref:=0;
5 1617 close(fil(zno),false);
5 1618 end;
4 1619 if zfref=0 then
4 1620 begin <*åbn zone*>
5 1621 array field enavn; integer i;
5 1622 enavn:=4*2; i:=1;
5 1623 open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
5 1624 string fdim.enavn(increase(i))),0)
5 1625 end
4 1626 end;
3 1627 \f
3 1627 message tilgangfil side 6 - 780916/jg;
3 1628
3 1628
3 1628
3 1628 <*hent segment og sæt zone descriptor*>
3 1629
3 1629 getzone6(fil(zno),zd);
3 1630 zstate:=zd(13);
3 1631 if zstate=0 or zd(9)<>seg then
3 1632 begin <*positioner*>
4 1633 if zstate>5 then
4 1634 filskrevet:=filskrevet+1;
4 1635 setposition(fil(zno),0,seg);
4 1636 if -,(operation=6 and pr=0) then
4 1637 begin <*læs seg medmindre op er skriv første post*>
5 1638 inrec6(fil(zno),512);
5 1639 fillæst:=fillæst+1
5 1640 end;
4 1641 zstate:=operation
4 1642 end
3 1643 else <*zstate:=max(operation,zone state)*>
3 1644 if operation>zstate then
3 1645 zstate:=operation;
3 1646 zd(9):=seg;
3 1647 zd(13):=zstate;
3 1648 zd(16):=pl shift 1;
3 1649 zd(14):=zd(19)+pr*zd(16);
3 1650 setzone6(fil(zno),zd);
3 1651 \f
3 1651 message tilgangfil side 7 - 780916/jg;
3 1652
3 1652
3 1652
3 1652 <*opdater kataloger*>
3 1653
3 1653 katf:=zno shift 19 add (katf extract 19);
3 1654 case ftype of
3 1655 begin
4 1656 dbkatt(fno,2):=katf;
4 1657 dbkats(fno,2):=katf;
4 1658 dbkate(fno,2):=katf
4 1659 end;
3 1660 dbkatz(zno,1):= filref;
3 1661 if ftype=3 then dbkatz(zno,2):=0 else
3 1662 <*if ftype=1 then allerede opd under zoneallokering*>
3 1663 if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
3 1664 if zstate=5 then (if pr=pps-1 then 2 else 1)
3 1665 else if zstate=6 and pr=pps-1 then 3 else 0;
3 1666
3 1666
3 1666
3 1666 <*udgang*>
3 1667
3 1667 udgang:
3 1668 if st=0 then
3 1669 zoneno:=zno
3 1670 else zoneno:=0; <*fejl*>
3 1671 tilgangfil:=st;
3 1672 end tilgangfil;
2 1673 \f
2 1673
2 1673 message pfilsystem side 1 - 781003/jg;
2 1674
2 1674 procedure pfilparm(z);
2 1675 zone z;
2 1676 write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
2 1677 dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
2 1678 <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
2 1679 dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
2 1680
2 1680 procedure pfilglobal(z);
2 1681 zone z;
2 1682 write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
2 1683 <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
2 1684 <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
2 1685 <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
2 1686 <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
2 1687 <:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
2 1688
2 1688
2 1688 procedure pdbkate(z,i);
2 1689 value i; integer i;
2 1690 zone z;
2 1691 begin integer j; array field navn;
3 1692 navn:=i*12+4; j:=1;
3 1693 write(z,<:<10>dbkate(:>,i,<:)=:>,
3 1694 dbkate(i,1) shift (-9),
3 1695 dbkate(i,1) extract 9,
3 1696 dbkate(i,2) shift (-19),
3 1697 dbkate(i,2) shift (-18) extract 1,
3 1698 dbkate(i,2) extract 18,
3 1699 <: :>,string dbkate.navn(increase(j)));
3 1700 end;
2 1701 \f
2 1701 message pfilsystem side 2 - 781003/jg;
2 1702
2 1702
2 1702
2 1702 procedure pdbkats(z,i);
2 1703 value i; integer i;
2 1704 zone z;
2 1705 write(z,<:<10>dbkats(:>,i,<:)=:>,
2 1706 dbkats(i,1) shift (-9),
2 1707 dbkats(i,1) extract 9,
2 1708 dbkats(i,2) shift (-19),
2 1709 dbkats(i,2) shift (-18) extract 1,
2 1710 dbkats(i,2) shift (-12) extract 6,
2 1711 dbkats(i,2) extract 12);
2 1712
2 1712 procedure pdbkatb(z,i);
2 1713 value i;integer i;
2 1714 zone z;
2 1715 write(z,<:<10>dbkatb(:>,i,<:)=:>,
2 1716 dbkatb(i) extract 12);
2 1717
2 1717 procedure pdbkatt(z,i);
2 1718 value i; integer i;
2 1719 zone z;
2 1720 write(z,<:<10>dbkatt(:>,i,<:)=:>,
2 1721 dbkatt(i,1) shift (-9),
2 1722 dbkatt(i,1) extract 9,
2 1723 dbkatt(i,2) shift (-19),
2 1724 dbkatt(i,2) shift (-18) extract 1,
2 1725 dbkatt(i,2) extract 18);
2 1726
2 1726 procedure pdbkatz(z,i);
2 1727 value i; integer i;
2 1728 zone z;
2 1729 write(z,<:<10>dbkatz(:>,i,<:)=:>,
2 1730 dbkatz(i,1),dbkatz(i,2));
2 1731 \f
2 1731 message pfilsystem side 3 - 781003/jg;
2 1732
2 1732
2 1732
2 1732 procedure pfil(z,i);
2 1733 value i; integer i;
2 1734 zone z;
2 1735 begin integer j,k; array field navn; integer array zd(1:20);
3 1736 navn:=2; k:=1;
3 1737 getzone6(fil(i),zd);
3 1738 write(z,<:<10>fil(:>,i,<:)=:>,
3 1739 zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
3 1740 string zd.navn(increase(k)));
3 1741 for j:=6 step 1 until 10 do write(z,zd(j));
3 1742 write(z,<:<10>:>);
3 1743 for j:=11 step 1 until 20 do write(z,zd(j));
3 1744 end;
2 1745
2 1745 procedure pfilsystem(z);
2 1746 zone z;
2 1747 begin integer i;
3 1748
3 1748 write(z,<:<12>udskrift af variable i filsystem:>);
3 1749 write(z,<:<10><10>filparm::>);
3 1750 pfilparm(z);
3 1751 write(z,<:<10><10>filglobal::>);
3 1752 pfilglobal(z);
3 1753 write(z,<:<10><10>fil: zone descriptor:>);
3 1754 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
3 1755 write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
3 1756 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
3 1757 write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
3 1758 for i :=1 step 1 until dbmaxef do pdbkate(z,i);
3 1759 write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
3 1760 for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
3 1761 write(z,<:<10><10>dbkatb: katbref:>);
3 1762 for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
3 1763 write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
3 1764 for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
3 1765 end pfilsystem;
2 1766 \f
2 1766 message pfilsystem side 4 - 781003/jg;
2 1767
2 1767
2 1767
2 1767 procedure pfdim(fdim);
2 1768 integer array fdim;
2 1769 begin
3 1770 integer i;
3 1771 array field navn;
3 1772 i:=1;navn:=8;
3 1773 write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
3 1774 string fdim.navn(increase(i)));
3 1775 end pfdim;
2 1776 \f
2 1776 message opretfil side 0 - 810529/cl;
2 1777
2 1777 procedure opretfil;
2 1778 <* checker parametre og vidresender operation
2 1779 til opret_spoolfil eller opret_eksternfil *>
2 1780
2 1780 begin
3 1781 integer array field op;
3 1782 integer status,pant,pl,segant,p_nøgle,fno,ftype;
3 1783
3 1783 procedure skriv_opret_fil(z,omfang);
3 1784 value omfang;
3 1785 zone z;
3 1786 integer omfang;
3 1787 begin
4 1788 write(z,"nl",1,<:+++ opret fil :>);
4 1789 if omfang > 0 then
4 1790 disable
4 1791 begin
5 1792 skriv_coru(z,abs curr_coruno);
5 1793 write(z,"nl",1,<<d>,
5 1794 <:op :>,op,"nl",1,
5 1795 <:status :>,status,"nl",1,
5 1796 <:pant :>,pant,"nl",1,
5 1797 <:pl :>,pl,"nl",1,
5 1798 <:segant :>,segant,"nl",1,
5 1799 <:p-nøgle:>,p_nøgle,"nl",1,
5 1800 <:fno :>,fno,"nl",1,
5 1801 <:ftype :>,ftype,"nl",1,
5 1802 <::>);
5 1803 end;
4 1804 end skriv_opret_fil;
3 1805 \f
3 1805 message opretfil side 1 - 810526/cl;
3 1806
3 1806 trap(opretfil_trap);
3 1807 <*+2*>
3 1808 <**> disable if testbit28 then
3 1809 <**> skriv_opret_fil(out,0);
3 1810 <*-2*>
3 1811
3 1811 stack_claim(if cm_test then 200 else 150);
3 1812
3 1812 <*+2*>
3 1813 <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
3 1814 <*-2*>
3 1815
3 1815 trin1:
3 1816 waitch(cs_opret_fil,op,true,-1);
3 1817
3 1817 trin2: <* check parametre *>
3 1818 disable begin
4 1819
4 1819 ftype:= d.op.data(4) shift (-10);
4 1820 fno:= d.op.data(4) extract 10;
4 1821 if ftype<2 or ftype>3 or fno<>0 then
4 1822 begin
5 1823 status:= 1; <*parameterfejl*>
5 1824 goto returner;
5 1825 end;
4 1826
4 1826 pant:= d.op.data(1);
4 1827 pl:= d.op.data(2);
4 1828 segant:= d.op.data(3);
4 1829 p_nøgle:= d.op.opkode shift (-12);
4 1830 if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
4 1831 or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
4 1832 status:= 1 <*parameterfejl *>
4 1833 else
4 1834 if pant>256//pl*segant then status:= 1 else
4 1835 if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
4 1836 status:= 4 <*ingen plads*>
4 1837 else
4 1838 status:=0;
4 1839 \f
4 1839 message opretfil side 2 - 810526/cl;
4 1840
4 1840
4 1840 returner:
4 1841
4 1841 d.op.data(9):= status;
4 1842
4 1842 <*+2*>
4 1843 <*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
4 1844 <*tz*> begin <*zt*>
5 1845 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 1846 <*tz*> pfdim(d.op.data); <*zt*>
5 1847 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1848 <*tz*> end; <*zt*>
4 1849 <*-2*>
4 1850
4 1850 <*returner eller vidresend operation*>
4 1851 signalch(if status>0 then d.op.retur else
4 1852 case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
4 1853 op,d.op.optype);
4 1854 end;
3 1855 goto trin1;
3 1856 opretfil_trap:
3 1857 disable skriv_opret_fil(zbillede,1);
3 1858
3 1858 end opretfil;
2 1859 \f
2 1859 message tilknytfil side 0 - 810526/cl;
2 1860
2 1860 procedure tilknytfil;
2 1861 <* tilknytter ekstern fil og returnerer intern filid *>
2 1862
2 1862 begin
3 1863 integer array field op;
3 1864 integer status,i,fno,segant,pa,pl,sliceant,s;
3 1865 array field enavn;
3 1866 integer array tail(1:10);
3 1867
3 1867 procedure skriv_tilknyt_fil(z,omfang);
3 1868 value omfang;
3 1869 zone z;
3 1870 integer omfang;
3 1871 begin
4 1872 write(z,"nl",1,<:+++ tilknyt fil :>);
4 1873 if omfang > 0 then
4 1874 disable
4 1875 begin real array field raf;
5 1876 skriv_coru(z,abs curr_coruno);
5 1877 write(z,"nl",1,<<d>,
5 1878 <:op :>,op,"nl",1,
5 1879 <:status :>,status,"nl",1,
5 1880 <:i :>,i,"nl",1,
5 1881 <:fno :>,fno,"nl",1,
5 1882 <:segant :>,segant,"nl",1,
5 1883 <:pa :>,pa,"nl",1,
5 1884 <:pl :>,pl,"nl",1,
5 1885 <:sliceant:>,sliceant,"nl",1,
5 1886 <:s :>,s,"nl",1,
5 1887 <::>);
5 1888 raf:= 0;
5 1889 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 1890 write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
5 1891 end;
4 1892 end skriv_tilknyt_fil;
3 1893 \f
3 1893 message tilknytfil side 1 - 810529/cl;
3 1894
3 1894 stack_claim(if cm_test then 200 else 150);
3 1895 trap(tilknytfil_trap);
3 1896
3 1896 <*+2*>
3 1897 <**> if testbit28 then
3 1898 <**> skriv_tilknyt_fil(out,0);
3 1899 <*-2*>
3 1900
3 1900 trin1:
3 1901 waitch(cs_tilknyt_fil,op,true,-1);
3 1902
3 1902 trin2:
3 1903 wait(bs_kate_fri);
3 1904
3 1904 trin3:
3 1905 disable begin
4 1906
4 1906 <* find ekstern rapportfil *>
4 1907 enavn:= 8;
4 1908 if find_fil_enavn(d.op.data.enavn)>0 then
4 1909 begin
5 1910 status:= 6; <* fil i brug *>
5 1911 goto returner;
5 1912 end;
4 1913 open(zdummy,0,d.op.data.enavn,0);
4 1914 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 1915 if s<>0 then
4 1916 begin
5 1917 if s=3 then status:= 2 <* fil findes ikke *>
5 1918 else if s=6 then status:= 1 <* parameterfejl, navn *>
5 1919 else fejlreaktion(1,s,<:lookup entry:>,0);
5 1920 goto returner;
5 1921 end;
4 1922 if tail(9)<>d.op.data(4) <* contentskey,subno *> then
4 1923 begin
5 1924 status:= 5; <* forkert indhold *> goto returner;
5 1925 end;
4 1926 segant:= tail(1);
4 1927 if segant>db_seg_max then
4 1928 segant:= db_seg_max;
4 1929 pa:= tail(10);
4 1930 pl:= tail(7) extract 12;
4 1931 if pl < 1 or pl > 256 then
4 1932 begin status:= 7; goto returner; end;
4 1933 \f
4 1933 message tilknytfil side 2 - 810529/cl;
4 1934 if pa>256//pl*segant then
4 1935 begin status:= 7; goto returner; end;
4 1936
4 1936 <* reserver *>
4 1937 s:= monitor(52)create area:(zdummy,0,ia);
4 1938 if s<>0 then
4 1939 begin
5 1940 if s=3 then status:= 2 <* fil findes ikke *>
5 1941 else if s=1 <* areaclaims exeeded *> then
5 1942 begin
6 1943 status:= 4;
6 1944 fejlreaktion(1,s,<:create area:>,1);
6 1945 end
5 1946 else fejlreaktion(1,s,<:create area:>,0);
5 1947 goto returner;
5 1948 end;
4 1949
4 1949 s:= monitor(8)reserve:(zdummy,0,ia);
4 1950 if s<>0 then
4 1951 begin
5 1952 if s<3 then status:= 6 <* i brug *>
5 1953 else fejlreaktion(1,s,<:reserve:>,0);
5 1954 monitor(64)remove area:(zdummy,0,ia);
5 1955 goto returner;
5 1956 end;
4 1957
4 1957 tail(7):= 1 shift 12 +pl; <* tilknyttet *>
4 1958 s:= monitor(44)change entry:(zdummy,0,tail);
4 1959 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 1960
4 1960 <* opdater katalog *>
4 1961 dbantef:= dbantef+1;
4 1962 fno:= dbkatefri;
4 1963 dbkatefri:= dbkate(fno,2);
4 1964 dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
4 1965 dbkate(fno,2):= segant;
4 1966 for i:= 5 step 1 until 8 do
4 1967 dbkate(fno,i-2):= d.op.data(i);
4 1968
4 1968 <* returparametre *>
4 1969 d.op.data(1):= pa;
4 1970 d.op.data(2):= pl;
4 1971 d.op.data(3):= segant;
4 1972 d.op.data(4):= 3 shift 10 +fno;
4 1973 status:= 0;
4 1974 \f
4 1974 message tilknytfil side 3 - 810526/cl;
4 1975
4 1975
4 1975 returner:
4 1976 close(zdummy,false);
4 1977 d.op.data(9):= status;
4 1978
4 1978
4 1978 <*+2*>
4 1979 <*tz*> if testbit24 and overvåget then <*zt*>
4 1980 <*tz*> begin <*zt*>
5 1981 <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
5 1982 <*tz*> pfdim(d.op.data); <*zt*>
5 1983 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1984 <*tz*> end; <*zt*>
4 1985 <*-2*>
4 1986
4 1986 signalch(d.op.retur,op,d.op.optype);
4 1987 if dbantef < dbmaxef then
4 1988 signalbin(bs_kate_fri);
4 1989 end;
3 1990 goto trin1;
3 1991 tilknytfil_trap:
3 1992 disable skriv_tilknyt_fil(zbillede,1);
3 1993 end tilknyt_fil;
2 1994 \f
2 1994 message frigivfil side 0 - 810529/cl;
2 1995
2 1995 procedure frigivfil;
2 1996 <* frigiver en tilknyttet ekstern fil *>
2 1997
2 1997 begin
3 1998 integer array field op;
3 1999 integer status,fref,ftype,fno,s,i,z;
3 2000 array field enavn;
3 2001 integer array tail(1:10);
3 2002
3 2002 procedure skriv_frigiv_fil(zud,omfang);
3 2003 value omfang;
3 2004 zone zud;
3 2005 integer omfang;
3 2006 begin
4 2007 write(zud,"nl",1,<:+++ frigiv fil :>);
4 2008 if omfang > 0 then
4 2009 disable
4 2010 begin real array field raf;
5 2011 skriv_coru(zud,abs curr_coruno);
5 2012 write(zud,"nl",1,<<d>,
5 2013 <:op :>,op,"nl",1,
5 2014 <:status:>,status,"nl",1,
5 2015 <:fref :>,fref,"nl",1,
5 2016 <:ftype :>,ftype,"nl",1,
5 2017 <:fno :>,fno,"nl",1,
5 2018 <:s :>,s,"nl",1,
5 2019 <:i :>,i,"nl",1,
5 2020 <:z :>,z,"nl",1,
5 2021 <::>);
5 2022 raf:= 0;
5 2023 write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
5 2024 end;
4 2025 end skriv_frigiv_fil;
3 2026 \f
3 2026 message frigivfil side 1 - 810526/cl;
3 2027
3 2027
3 2027 stack_claim(if cm_test then 200 else 150);
3 2028 trap(frigivfil_trap);
3 2029
3 2029 <*+2*>
3 2030 <**> disable if testbit28 then
3 2031 <**> skriv_frigiv_fil(out,0);
3 2032 <*-2*>
3 2033
3 2033 trin1:
3 2034 waitch(cs_frigiv_fil,op,true,-1);
3 2035
3 2035 trin2:
3 2036 disable begin
4 2037
4 2037 <* find fil *>
4 2038 fref:= d.op.data(4);
4 2039 ftype:= fref shift (-10);
4 2040 fno:= fref extract 10;
4 2041 if ftype=0 or ftype>3 or fno=0 then
4 2042 begin status:= 1; goto returner; end;
4 2043 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2044 begin status:= 1; goto returner; end;
4 2045 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2046 extract 9 = 0 then
4 2047 begin
5 2048 status:= 2; <* fil findes ikke *>
5 2049 goto returner;
5 2050 end;
4 2051 if ftype <> 3 then
4 2052 begin status:= 5; goto returner; end;
4 2053
4 2053 <* frigiv evt. tilknyttet zone og areaprocess *>
4 2054 z:= dbkate(fno,2) shift (-19);
4 2055 if z > 0 then
4 2056 begin
5 2057 if dbkatz(z,1)=fref then
5 2058 begin integer array zd(1:20);
6 2059 getzone6(fil(z),zd);
6 2060 if zd(13)>5 then filskrevet:= filskrevet +1;
6 2061 close(fil(z),true);
6 2062 dbkatz(z,1):= 0;
6 2063 end;
5 2064 end;
4 2065 \f
4 2065 message frigivfil side 2 - 810526/cl;
4 2066
4 2066 <* opdater tail *>
4 2067 enavn:= fno*12+4;
4 2068 open(zdummy,0,dbkate.enavn,0);
4 2069 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 2070 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
4 2071 tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
4 2072 tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
4 2073 s:= monitor(44)change entry:(zdummy,0,tail);
4 2074 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 2075 monitor(64)remove process:(zdummy,0,tail);
4 2076 close(zdummy,true);
4 2077
4 2077 <* frigiv indgang *>
4 2078 for i:= 1, 3 step 1 until 6 do
4 2079 dbkate(fno,1):= 0;
4 2080 dbkate(fno,2):= dbkatefri;
4 2081 dbkatefri:= fno;
4 2082 dbantef:= dbantef -1;
4 2083 signalbin(bs_kate_fri);
4 2084 d.op.data(4):= 0; <* filref null *>
4 2085 status:= 0;
4 2086
4 2086 returner:
4 2087 d.op.data(9):= status;
4 2088 <*+2*>
4 2089 <*tz*> if testbit24 and overvåget then <*zt*>
4 2090 <*tz*> begin <*zt*>
5 2091 <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
5 2092 <*tz*> pfdim(d.op.data); <*zt*>
5 2093 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2094 <*tz*> end; <*zt*>
4 2095 <*-2*>
4 2096
4 2096 signalch(d.op.retur,op,d.op.optype);
4 2097 end;
3 2098 goto trin1;
3 2099 frigiv_fil_trap:
3 2100 disable skriv_frigiv_fil(zbillede,1);
3 2101 end frigivfil;
2 2102 \f
2 2102 message sletfil side 0 - 810526/cl;
2 2103
2 2103 procedure sletfil;
2 2104 <* sletter en spool- eller ekstern fil *>
2 2105
2 2105 begin
3 2106 integer array field op;
3 2107 integer fref,fno,ftype,status;
3 2108
3 2108 procedure skriv_slet_fil(z,omfang);
3 2109 value omfang;
3 2110 zone z;
3 2111 integer omfang;
3 2112 begin
4 2113 write(z,"nl",1,<:+++ slet fil :>);
4 2114 if omfang > 0 then
4 2115 disable
4 2116 begin
5 2117 skriv_coru(z,abs curr_coruno);
5 2118 write(z,"nl",1,<<d>,
5 2119 <:op :>,op,"nl",1,
5 2120 <:fref :>,fref,"nl",1,
5 2121 <:fno :>,fno,"nl",1,
5 2122 <:ftype :>,ftype,"nl",1,
5 2123 <:status:>,status,"nl",1,
5 2124 <::>);
5 2125 end;
4 2126 end skriv_slet_fil;
3 2127 \f
3 2127 message sletfil side 1 - 810526/cl;
3 2128
3 2128 stack_claim(if cm_test then 200 else 150);
3 2129
3 2129 trap(sletfil_trap);
3 2130 <*+2*>
3 2131 <**> disable if testbit28 then
3 2132 <**> skriv_slet_fil(out,0);
3 2133 <*-2*>
3 2134
3 2134 trin1:
3 2135 waitch(cs_slet_fil,op,true,-1);
3 2136
3 2136 trin2:
3 2137 disable begin
4 2138
4 2138 <* find fil *>
4 2139 fref:= d.op.data(4);
4 2140 ftype:= fref shift (-10);
4 2141 fno:= fref extract 10;
4 2142 if ftype=0 or ftype>3 or fno=0 then
4 2143 begin status:= 1; goto returner; end;
4 2144 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2145 begin status:= 1; goto returner; end;
4 2146 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2147 extract 9 = 0 then
4 2148 begin
5 2149 status:= 2; <* fil findes ikke *>
5 2150 goto returner;
5 2151 end;
4 2152
4 2152
4 2152 <* slet spool- eller ekstern fil *>
4 2153 case ftype of
4 2154 begin
5 2155
5 2155 <* tabelfil - ingen aktion *>
5 2156 ;
5 2157 \f
5 2157 message sletfil side 2 - 810203/cl;
5 2158
5 2158 <* spoolfil *>
5 2159 begin
6 2160 integer z,bidno,bf,bidant,i;
6 2161
6 2161 <* hvis tilknyttet så frigiv *>
6 2162 z:= dbkats(fno,2) shift (-19);
6 2163 if z>0 then
6 2164 begin
7 2165 if dbkatz(z,1)=fref then
7 2166 begin integer array zd(1:20);
8 2167 dbkatz(z,1):= 2 shift 10;
8 2168 getzone6(fil(z),zd); <*annuler evt. udskrivning*>
8 2169 if zd(13)>5 then
8 2170 begin zd(13):= 0; setzone6(fil(z),zd); end;
8 2171 end;
7 2172 end;
6 2173
6 2173 <* frigiv bidder *>
6 2174 bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
6 2175 bidant:= dbkats(fno,2) shift (-12) extract 6;
6 2176 for i:= bidant -1 step -1 until 1 do
6 2177 bidno:= dbkatb(bidno) extract 12;
6 2178 dbkatb(bidno):= false add dbkatbfri;
6 2179 dbkatbfri:= bf;
6 2180 dbantb:= dbantb-bidant;
6 2181
6 2181 <* frigiv indgang *>
6 2182 dbkats(fno,1):= 0;
6 2183 dbkats(fno,2):= dbkatsfri;
6 2184 dbkatsfri:= fno;
6 2185 dbantsf:= dbantsf -1;
6 2186 signalbin(bs_kats_fri);
6 2187 end spoolfil;
5 2188 \f
5 2188 message sletfil side 3 - 810203/cl;
5 2189
5 2189 <* extern fil *>
5 2190 begin
6 2191 integer i,s,z;
6 2192 real array field enavn;
6 2193 integer array tail(1:10);
6 2194
6 2194 <* find head and tail *>
6 2195 enavn:= fno*12+4;
6 2196 open(zdummy,0,dbkate.enavn,0);
6 2197 s:= monitor(42)lookup entry:(zdummy,0,tail);
6 2198 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
6 2199
6 2199 <*frigiv evt. tilknyttet zone og areaprocess*>
6 2200 z:=dbkate(fno,2) shift (-19);
6 2201 if z>0 then
6 2202 begin
7 2203 if dbkatz(z,1)=fref then
7 2204 begin integer array zd(1:20);
8 2205 getzone6(fil(z),zd);
8 2206 if zd(13)>5 then <* udskrivning *>
8 2207 begin <*annuler*>
9 2208 zd(13):= 0;
9 2209 setzone6(fil(z),zd);
9 2210 end;
8 2211 close(fil(z),true);
8 2212 dbkatz(z,1):= 0;
8 2213 end;
7 2214 end;
6 2215
6 2215 <* fjern entry *>
6 2216 s:= monitor(48)remove entry:(zdummy,0,tail);
6 2217 if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
6 2218 close(zdummy,true);
6 2219
6 2219 <* frigiv indgang *>
6 2220 for i:=1, 3 step 1 until 6 do
6 2221 dbkate(fno,i):= 0;
6 2222 dbkate(fno,2):= dbkatefri;
6 2223 dbkatefri:= fno;
6 2224 dbantef:= dbantef -1;
6 2225 signalbin(bs_kate_fri);
6 2226 end eksternfil;
5 2227
5 2227 end ftype;
4 2228 \f
4 2228 message sletfil side 4 - 810526/cl;
4 2229
4 2229
4 2229 status:= 0;
4 2230 if ftype > 1 then
4 2231 d.op.data(4):= 0; <*filref null*>
4 2232
4 2232 returner:
4 2233 d.op.data(9):= status;
4 2234
4 2234 <*+2*>
4 2235 <*tz*> if testbit24 and overvåget then <*zt*>
4 2236 <*tz*> begin <*zt*>
5 2237 <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
5 2238 <*tz*> pfdim(d.op.data); <*zt*>
5 2239 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2240 <*tz*> end; <*zt*>
4 2241 <*-2*>
4 2242
4 2242 signalch(d.op.retur,op,d.op.optype);
4 2243 end;
3 2244 goto trin1;
3 2245 sletfil_trap:
3 2246 disable skriv_slet_fil(zbillede,1);
3 2247 end sletfil;
2 2248 \f
2 2248 message opretspoolfil side 0 - 810526/cl;
2 2249
2 2249 procedure opretspoolfil;
2 2250 <* opretter en spoolfil og returnerer intern filid *>
2 2251
2 2251 begin
3 2252 integer array field op;
3 2253 integer bidantal,fno,i,bs,bidstart;
3 2254
3 2254 procedure skriv_opret_spoolfil(z,omfang);
3 2255 value omfang;
3 2256 zone z;
3 2257 integer omfang;
3 2258 begin
4 2259 write(z,"nl",1,<:+++ opret spoolfil :>);
4 2260 if omfang > 0 then
4 2261 disable
4 2262 begin
5 2263 skriv_coru(z,abs curr_coruno);
5 2264 write(z,"nl",1,<<d>,
5 2265 <:op :>,op,"nl",1,
5 2266 <:bidantal:>,bidantal,"nl",1,
5 2267 <:fno :>,fno,"nl",1,
5 2268 <:i :>,i,"nl",1,
5 2269 <:bs :>,bs,"nl",1,
5 2270 <:bidstart:>,bidstart,"nl",1,
5 2271 <::>);
5 2272 end;
4 2273 end skriv_opret_spoolfil;
3 2274 \f
3 2274 message opretspoolfil side 1 - 810526/cl;
3 2275
3 2275 stack_claim(if cm_test then 200 else 150);
3 2276
3 2276 signalbin(bs_kats_fri); <*initialiseres til åben*>
3 2277
3 2277 trap(opretspool_trap);
3 2278 <*+2*>
3 2279 <**> disable if testbit28 then
3 2280 <**> skriv_opret_spoolfil(out,0);
3 2281 <*-2*>
3 2282 trin1:
3 2283 waitch(cs_opret_spoolfil,op,true,-1);
3 2284
3 2284 trin2:
3 2285 bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
3 2286 wait(bs_kats_fri);
3 2287
3 2287 trin3:
3 2288 if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
3 2289 begin
4 2290 wait(bs_kats_fri);
4 2291 goto trin3;
4 2292 end;
3 2293 disable begin
4 2294
4 2294 <*alloker bidder*>
4 2295 bs:= bidstart:= dbkatbfri;
4 2296 for i:= bidantal-1 step -1 until 1 do
4 2297 bs:= dbkatb(bs) extract 12;
4 2298 dbkatbfri:= dbkatb(bs) extract 12;
4 2299 dbkatb(bs):= false; <*sidste ref null*>
4 2300 dbantb:= dbantb+bidantal;
4 2301
4 2301 <*alloker indgang*>
4 2302 fno:= dbkatsfri;
4 2303 dbkatsfri:= dbkats(fno,2);
4 2304 dbantsf:= dbantsf +1;
4 2305 dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
4 2306 d.op.data(2) extract 9; <*postlængde*>
4 2307 dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
4 2308 \f
4 2308 message opretspoolfil side 2 - 810526/cl;
4 2309
4 2309 <*returner*>
4 2310 d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
4 2311 d.op.data(4):= 2 shift 10 add fno; <*filref*>
4 2312 for i:= 5 step 1 until 8 do <*filnavn null*>
4 2313 d.op.data(i):= 0;
4 2314 d.op.data(9):= 0; <*status ok*>
4 2315
4 2315 <*+2*>
4 2316 <*tz*> if testbit24 and overvåget then <*zt*>
4 2317 <*tz*> begin <*zt*>
5 2318 <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
5 2319 <*tz*> pfdim(d.op.data); <*zt*>
5 2320 <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
5 2321 <*tz*> end; <*zt*>
4 2322 <*-2*>
4 2323
4 2323 signalch(d.op.retur,op,d.op.optype);
4 2324 if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
4 2325 end;
3 2326 goto trin1;
3 2327
3 2327 opretspool_trap:
3 2328 disable skriv_opret_spoolfil(zbillede,1);
3 2329
3 2329 end opretspoolfil;
2 2330 \f
2 2330 message opreteksternfil side 0 - 810526/cl;
2 2331
2 2331 procedure opreteksternfil;
2 2332 <* opretter og knytter en ekstern fil *>
2 2333
2 2333 begin
3 2334 integer array field op;
3 2335 integer status,s,i,fno,p_nøgle;
3 2336 integer array tail(1:10),zd(1:20);
3 2337 real r;
3 2338 real array field enavn;
3 2339
3 2339 procedure skriv_opret_ekstfil(z,omfang);
3 2340 value omfang;
3 2341 zone z;
3 2342 integer omfang;
3 2343 begin
4 2344 write(z,"nl",1,<:+++ opret ekstern fil :>);
4 2345 if omfang > 0 then
4 2346 disable
4 2347 begin real array field raf;
5 2348 skriv_coru(z,abs curr_coruno);
5 2349 write(z,"nl",1,<<d>,
5 2350 <:op :>,op,"nl",1,
5 2351 <:status :>,status,"nl",1,
5 2352 <:s :>,s,"nl",1,
5 2353 <:i :>,i,"nl",1,
5 2354 <:fno :>,fno,"nl",1,
5 2355 <:p-nøgle:>,p_nøgle,"nl",1,
5 2356 <::>);
5 2357 raf:= 0;
5 2358 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 2359 write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
5 2360 end;
4 2361 end skriv_opret_ekstfil;
3 2362 \f
3 2362 message opreteksternfil side 1 - 810526/cl;
3 2363
3 2363 stack_claim(if cm_test then 200 else 150);
3 2364
3 2364 signalbin(bs_kate_fri); <*initialiseres til åben*>
3 2365
3 2365 trap(opretekst_trap);
3 2366 <*+2*>
3 2367 <**> disable if testbit28 then
3 2368 <**> skriv_opret_ekstfil(out,0);
3 2369 <*-2*>
3 2370 trin1:
3 2371 waitch(cs_opret_eksternfil,op,true,-1);
3 2372
3 2372 trin2:
3 2373 wait(bs_kate_fri);
3 2374
3 2374 trin3:
3 2375 <*opret temporær fil og tilknyt den*>
3 2376 disable begin
4 2377
4 2377 enavn:= 8;
4 2378 <*opret*>
4 2379 open(zdummy,0,d.op.data.enavn,0);
4 2380 tail(1):= d.op.data(3); <*segant*>
4 2381 tail(2):= 1;
4 2382 tail(6):= systime(7,0,r); <*shortclock*>
4 2383 tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
4 2384 tail(8):= 0;
4 2385 tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
4 2386 tail(10):= d.op.data(1); <*postantal*>
4 2387 s:= monitor(40)create entry:(zdummy,0,tail);
4 2388 if s<>0 then
4 2389 begin
5 2390 if s=4 <*claims exeeded*> then
5 2391 begin
6 2392 status:= 4;
6 2393 fejlreaktion(1,s,<:create entry:>,1);
6 2394 goto returner;
6 2395 end;
5 2396 if s=3 <*navn ikke unikt*> then
5 2397 begin status:= 6; goto returner; end;
5 2398 fejlreaktion(1,s,<:create entry:>,0);
5 2399 end;
4 2400 \f
4 2400 message opreteksternfil side 2 - 810203/cl;
4 2401
4 2401 p_nøgle:= d.op.opkode shift (-12);
4 2402 s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
4 2403 if s<>0 then
4 2404 begin
5 2405 if s=6 then
5 2406 begin <*claims exeeded*>
6 2407 status:= 4;
6 2408 fejlreaktion(1,s,<:permanent entry:>,1);
6 2409 monitor(48)remove entry:(zdummy,0,tail);
6 2410 goto returner;
6 2411 end
5 2412 else fejlreaktion(1,s,<:permanent entry:>,0);
5 2413 end;
4 2414
4 2414 <*reserver*>
4 2415 s:= monitor(52)create areaprocess:(zdummy,0,zd);
4 2416 if s<>0 then
4 2417 begin
5 2418 fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
5 2419 status:= 4;
5 2420 monitor(48)remove entry:(zdummy,0,zd);
5 2421 goto returner;
5 2422 end;
4 2423
4 2423 s:= monitor(8)reserve:(zdummy,0,zd);
4 2424 if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
4 2425
4 2425 <*tilknyt*>
4 2426 dbantef:= dbantef +1;
4 2427 fno:= dbkatefri;
4 2428 dbkatefri:= dbkate(fno,2);
4 2429 dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
4 2430 dbkate(fno,2):= tail(1);
4 2431 getzone6(zdummy,zd);
4 2432 for i:= 2 step 1 until 5 do
4 2433 dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
4 2434 d.op.data(3):= tail(1);
4 2435 d.op.data(4):= 3 shift 10 +fno;
4 2436 status:= 0;
4 2437 \f
4 2437 message opreteksternfil side 3 - 810526/cl;
4 2438
4 2438 returner:
4 2439
4 2439 close(zdummy,false);
4 2440 d.op.data(9):= status;
4 2441
4 2441 <*+2*>
4 2442 <*tz*> if testbit24 and overvåget then <*zt*>
4 2443 <*tz*> begin <*zt*>
5 2444 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 2445 <*tz*> pfdim(d.op.data); <*zt*>
5 2446 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2447 <*tz*> end; <*zt*>
4 2448 <*-2*>
4 2449
4 2449 signalch(d.op.retur,op,d.op.optype);
4 2450 if dbantef<dbmaxef then signalbin(bs_kate_fri);
4 2451 end;
3 2452 goto trin1;
3 2453
3 2453 opretekst_trap:
3 2454 disable skriv_opret_ekstfil(zbillede,1);
3 2455
3 2455 end opreteksternfil;
2 2456
2 2456 \f
2 2456 message attention_erklæringer side 1 - 850820/cl;
2 2457
2 2457 integer
2 2458 tf_kommandotabel,
2 2459 cs_att_pulje,
2 2460 bs_fortsæt_adgang,
2 2461 att_proc_ref;
2 2462
2 2462 integer array
2 2463 att_flag,
2 2464 att_signal(1:att_maske_lgd//2);
2 2465
2 2465 integer array
2 2466 terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
2 2467 max_antal_operatører+max_antal_garageterminaler)),
2 2468 fortsæt(1:32);
2 2469 \f
2 2469 message procedure afslut_kommando side 1 - 810507/hko;
2 2470
2 2470 procedure afslut_kommando(op_ref);
2 2471 integer array field op_ref;
2 2472 begin integer nr,i,sem;
3 2473 i:= d.op_ref.kilde;
3 2474 nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
3 2475 else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
3 2476 sætbit_ia(att_flag,nr,0);
3 2477 d.op_ref.optype:=gen_optype;
3 2478 <* "husket" attention disabled ****************
3 2479 if sætbit_ia(att_signal,nr,0)=1 then
3 2480 begin
3 2481 sem:=if i=299 then cs_talevejsswitch else
3 2482 case i//100 of (cs_io_komm,cs_operatør(i mod 100),
3 2483 cs_garage(i mod 100));
3 2484 afslut_operation(op_ref,0);
3 2485 start_operation(op_ref,i,cs_att_pulje,0);
3 2486 signal_ch(sem,op_ref,gen_optype);
3 2487 end
3 2488 else
3 2489 ********************* disable "husket" attention *>
3 2490 afslut_operation(op_ref,cs_att_pulje);
3 2491 end;
2 2492 \f
2 2492 message procedure læs_store side 1 - 880919/cl;
2 2493
2 2493 integer procedure læs_store(z,c);
2 2494 zone z;
2 2495 integer c;
2 2496 begin
3 2497 læs_store:= readchar(z,c);
3 2498 if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
3 2499 end;
2 2500 \f
2 2500 message procedure param side 1 - 810226/cl;
2 2501
2 2501
2 2501
2 2501 integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
2 2502 value tabel_id;
2 2503 integer pos, tabel_id, type, sep;
2 2504 integer array txt, spec, værdi;
2 2505
2 2505
2 2505
2 2505 <*************************************>
2 2506 <* *>
2 2507 <* CLAUS LARSEN: 15.07.77 *>
2 2508 <* *>
2 2509 <*************************************>
2 2510
2 2510
2 2510
2 2510
2 2510 <* param syntax-analyserer en parameterliste, og *>
2 2511 <* bestemmer næste parameter og den separator der *>
2 2512 <* afslutter parameteren *>
2 2513
2 2513
2 2513
2 2513 begin
3 2514 integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
3 2515 real array indgang(1:2);
3 2516 integer i, j, tegn, tegn_pos, tal, hashnøgle,
3 2517 zone_nr, top, max_segm, start_segm, lpos;
3 2518 boolean minus, separator;
3 2519 lpos := pos;
3 2520 type:=-1;
3 2521 for i:=1 step 1 until 4 do værdi(i):=0;
3 2522 \f
3 2522 message procedure param side 2 - 810428/cl,hko;
3 2523
3 2523
3 2523
3 2523 <* grænsecheck for pos *>
3 2524 begin
4 2525 integer nedre, øvre;
4 2526
4 2526 nedre := system(3,øvre,txt);
4 2527 nedre := nedre * 3 - 2;
4 2528 øvre := øvre * 3;
4 2529 if lpos < (nedre - 1) or øvre < lpos then
4 2530 begin
5 2531 sep:= -1;
5 2532 param:= 5;
5 2533 goto slut;
5 2534 end;
4 2535
4 2535 <* er parameterlisten slut *>
4 2536 lpos:= lpos+1;
4 2537 læs_tegn(txt,lpos,tegn);
4 2538 if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
4 2539 begin
5 2540 lpos := lpos - 2;
5 2541 sep := tegn;
5 2542 param := 5;
5 2543
5 2543 goto slut;
5 2544 end else lpos:= lpos-1;
4 2545 end;
3 2546 \f
3 2546 message procedure param side 3 - 810428/cl;
3 2547
3 2547
3 2547 <* initialisering *>
3 2548 for i := 1 step 1 until 4 do
3 2549 aktuel_param(i) := 0;
3 2550 minus := separator := false;
3 2551
3 2551 <* initialiser klassetabel *>
3 2552 for i := 65 step 1 until 93,
3 2553 97 step 1 until 125 do klasse(i) := 1;
3 2554 for i := 48 step 1 until 57 do klasse(i) := 2;
3 2555 for i := 0 step 1 until 47, 58 step 1 until 64,
3 2556 94, 95, 96, 126, 127 do klasse(i) := 4;
3 2557
3 2557
3 2557 <* sæt specialtegn *>
3 2558 i := 1;
3 2559 læs_tegn(spec,i,tegn);
3 2560 while tegn <> 0 do
3 2561 begin
4 2562 if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
4 2563 klasse(tegn) := 3;
4 2564 læs_tegn(spec,i,tegn);
4 2565 end;
3 2566 \f
3 2566 message procedure param side 4 - 810226/cl;
3 2567
3 2567
3 2567 <* læs første tegn i ny parameter og bestem typen *>
3 2568 læs_tegn(txt,lpos,tegn);
3 2569
3 2569 case klasse(tegn) of
3 2570 begin
4 2571
4 2571 <* case 1 - bogstav *>
4 2572 begin
5 2573 type := 0;
5 2574 param := 0;
5 2575 tegn_pos := 1;
5 2576 hashnøgle := 0;
5 2577
5 2577 <* læs parameter *>
5 2578 while tegn_pos < 12 and klasse(tegn) <> 4 do
5 2579 begin
6 2580 hashnøgle := hashnøgle + tegn;
6 2581 skriv_tegn(aktuel_param,tegn_pos,tegn);
6 2582 læs_tegn(txt,lpos,tegn);
6 2583 end;
5 2584
5 2584 <* find separator *>
5 2585 while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
5 2586 sep := tegn;
5 2587 \f
5 2587 message procedure param side 5 - 810226/cl;
5 2588
5 2588 <* tabelopslag *>
5 2589 if tabel_id <> 0 then
5 2590 begin
6 2591 <* hent max_segm *>
6 2592
6 2592 fdim(4) := tabel_id;
6 2593 j := hent_fil_dim(fdim);
6 2594 if j > 0 then
6 2595 begin
7 2596 param := 4;
7 2597 for i := 1 step 1 until 4 do
7 2598 værdi(i) := aktuel_param(i);
7 2599 goto slut;
7 2600 end;
6 2601 max_segm := fdim(3);
6 2602
6 2602 <* forbered opslag *>
6 2603 start_segm := (hashnøgle mod max_segm) + 1;
6 2604 indgang(1) := 0.0 shift 48 add aktuel_param(1)
6 2605 shift 24 add aktuel_param(2);
6 2606 indgang(2) := 0.0 shift 48 add aktuel_param(3)
6 2607 shift 24 add aktuel_param(4);
6 2608 hashnøgle := start_segm;
6 2609 \f
6 2609 message procedure param side 6 - 810226/cl;
6 2610
6 2610 <* søg navn *>
6 2611 repeat
6 2612 <* læs segment *>
6 2613 læs_fil(tabel_id,hashnøgle,zone_nr);
6 2614
6 2614 <* beregn sidste element *>
6 2615 top := fil(zone_nr,1) extract 24;
6 2616 top := (top - 1) * 4 + 2;
6 2617
6 2617 <* søg *>
6 2618 for i := 2 step 4 until top do
6 2619 if fil(zone_nr,i) = indgang(1) and
6 2620 fil(zone_nr,i+1) = indgang(2) then
6 2621 begin
7 2622 <* fundet *>
7 2623 værdi(1) := fil(zone_nr,i+2) shift (-24)
7 2624 extract 24;
7 2625 værdi(2) := fil(zone_nr,i+2) extract 24;
7 2626 værdi(3) := fil(zone_nr,i+3) shift (-24)
7 2627 extract 24;
7 2628 værdi(4) := fil(zone_nr,i+3) extract 24;
7 2629 goto fundet;
7 2630 end;
6 2631
6 2631 if top = 122 then <*overløb *>
6 2632 hashnøgle := (hashnøgle mod max_segm) + 1;
6 2633 until top < 122 or hashnøgle = start_segm;
6 2634
6 2634 <* navn findes ikke *>
6 2635 param := 2;
6 2636 for j := 1 step 1 until 4 do
6 2637 værdi(j) := aktuel_param(j);
6 2638 fundet: ;
6 2639 end <*tabel_id <> 0 *>
5 2640 else
5 2641 for i := 1 step 1 until 4 do
5 2642 værdi(i) := aktuel_param(i);
5 2643 end <* case 1 *>;
4 2644 \f
4 2644 message procedure param side 7 - 810310/cl,hko;
4 2645
4 2645 <* case 2 - ciffer *>
4 2646 cif: begin
5 2647 type:=tal := 0;
5 2648 while klasse(tegn) = 2 do
5 2649 begin
6 2650 type:=type+1;
6 2651 tal := tal * 10 + (tegn - 48);
6 2652 læs_tegn(txt,lpos,tegn);
6 2653 end;
5 2654 if minus then tal := -tal;
5 2655 værdi(1) := tal;
5 2656 sep := tegn;
5 2657 param := 0;
5 2658 end <* case 2 *>;
4 2659 \f
4 2659 message procedure param side 8 - 810428/cl;
4 2660
4 2660 <* case 3 - specialtegn *>
4 2661 spc: begin
5 2662 if tegn = '-' then
5 2663 begin
6 2664 læs_tegn(txt,lpos,tegn);
6 2665 if klasse(tegn) = 2 then
6 2666 begin
7 2667 minus := true;
7 2668 goto cif;
7 2669 end
6 2670 else
6 2671 begin
7 2672 tegn := '-';
7 2673 lpos := lpos - 1;
7 2674 end;
6 2675 end;
5 2676 <* syntaxfejl *>
5 2677 param := if separator then 1 else 3;
5 2678 sep := tegn;
5 2679 end <* case 3 *>;
4 2680
4 2680 <* case 4 - separator *>
4 2681 begin
5 2682 separator := true;
5 2683 goto spc;
5 2684 end <* case 4 *>;
4 2685
4 2685 end <* case *>;
3 2686
3 2686 lpos := lpos - 1;
3 2687 slut:
3 2688 pos := lpos;
3 2689 end;
2 2690 \f
2 2690 message procedure læs_param_sæt side 1 - 830310/cl;
2 2691
2 2691 integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
2 2692 integer array tekst, parm;
2 2693 integer pos,ant, term,res;
2 2694
2 2694 <* proceduren læser et sammenhørende sæt parametre
2 2695 afsluttet med (sp),(nl),(;),(,) eller (nul)
2 2696
2 2696 læs_param_sæt returstatus eller 'typen' af det læste parametersæt
2 2697 (retur,int)
2 2698 type ant parm indeholder:
2 2699 <0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
2 2700 0: 0 (ingenting) 'rest kommando er tom'
2 2701 1: 1 (tekst) 'indtil 11 tegn'
2 2702 2: 1 (pos.tal)
2 2703 3: 1 (neg.tal)
2 2704 4: 1 (pos.tal<1000)(bogstav) 'linienummer'
2 2705 5: 1 G(pos.tal<100) 'gruppe_ident'
2 2706 6: 2 (linie)/(løb) 'vogn_ident'
2 2707 7: 3 (bus)/(linie)/(løb)
2 2708 8: 3 (linie).(indeks):(løb)
2 2709 9: 2 (linie).(indeks)
2 2710 10: 2 (pos.tal).(pos.tal)
2 2711 11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
2 2712 12: 3 D.(dato).(tid)
2 2713
2 2713 tekst indeholder teksten hvori parametersættet
2 2714 (kald,int.arr.) skal søges.
2 2715
2 2715 pos
2 2716 (kald/retur,int.) position efter hvilken søgningen starter, og
2 2717 ved retur positionen for afsluttende tegn.
2 2718 (ikke ændret ved fejl)
2 2719
2 2719 ant hvis kaldeværdien er >0 skal parametersættet
2 2720 (kald/retur,int) indeholde det angivne antal enkeltparametre,
2 2721 i modsat fald returneres med fejltype -26
2 2722 (skilletegn) eller -25 (parameter mangler).
2 2723 ellers læses op til 3 enkeltparametre. retur-
2 2724 værdien afhænger af det læste parametersæts
2 2725 type, se ovenfor under læs_param_sæt.
2 2726 \f
2 2726 message procedure læs_param_sæt side 2 - 810428/hko;
2 2727
2 2727 parm skal omfatte elementerne 1 til 4.
2 2728 (retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
2 2729 terne værdien 0.
2 2730
2 2730 type (element,indhold)
2 2731 1: 1-4,teksten
2 2732 2-3: 1, talværdien
2 2733 4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
2 2734 5: 1, talværdi (uden G)
2 2735 6: 1, (som'4') shift 7 + løb
2 2736 7: 1, bus
2 2737 2, linie/løb som '6'
2 2738 8: 1, tal shift 5 eller som '4'
2 2739 2, tekst (1-3 bogstaver)
2 2740 3, løb
2 2741 9: 1 og 2, som '8'
2 2742 10: 1, talværdi
2 2743 2, talværdi
2 2744 11: 1, som '5'
2 2745 2, vogn (bus eller linie/løb)
2 2746 12: 1, dato
2 2747 2, tid
2 2748
2 2748 term iso-tegnværdien for tegnet der afslutter
2 2749 (retur,int) parameter_sættet.
2 2750
2 2750 res som læs_param_sæt.
2 2751 (retur,int)
2 2752
2 2752 *>
2 2753 \f
2 2753 message procedure læs_param_sæt side 3 - 810310/hko;
2 2754
2 2754 begin
3 2755 integer max_ant;
3 2756
3 2756 max_ant:= 3;
3 2757
3 2757 begin
4 2758 integer
4 2759 i,j,k, <* hjælpe variable *>
4 2760 nr, <* nummer på parameter i sættet *>
4 2761 apos, <* aktuel tegnposition *>
4 2762 cifre, <* parametertype (param: 0=tekst, >1=tal) *>
4 2763 sep; <* afsluttende skilletegn ved param *>
4 2764
4 2764 integer array field
4 2765 iaf; <* hjælpe variabel *>
4 2766
4 2766 integer array
4 2767 par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
4 2768 s, <* 1 element med separator for hver parameter *>
4 2769 t(1:max_ant), <* 1 element med typen for hver parameter *>
4 2770 værdi(1:4), <* værdi af aktuel parameter jvf. param *>
4 2771 spec(1:1); <* specialtegn i navne jvf. param *>
4 2772
4 2772 <* de interne typer af enkeltparametre er
4 2773
4 2773 type parameter
4 2774
4 2774 1: 1-3 tegn tekst (1 ord)
4 2775 2: 4-6 tegn (2 ord)
4 2776 3: 7-9 tegn (3 ord)
4 2777 4:10-11 tegn (4 ord)
4 2778 5: positivt heltal
4 2779 6: negativt heltal
4 2780 7: positivt heltal<1000 efterfulgt af stort bogstav
4 2781 8: G efterfulgt af positivt heltal<100
4 2782
4 2782 *>
4 2783 \f
4 2783 message procedure læs_param_sæt side 4 - 810408/hko;
4 2784
4 2784 nr:= 0;
4 2785 res:= -1;
4 2786 spec(1):= 0; <* ingen specialtegn *>
4 2787 apos:= pos;
4 2788 for i:= 1 step 1 until 4 do parm(i):= 0;
4 2789 for i:= 1 step 1 until max_ant do
4 2790 begin
5 2791 s(i):= t(i):= 0;
5 2792 for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
5 2793 end;
4 2794 repeat
4 2795 <* skip foranstillede sp-tegn *>
4 2796 for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
4 2797 while i=1 and sep='sp' do;
4 2798 <*+2*>
4 2799 begin
5 2800 if testbit25 and testbit26 then
5 2801 disable begin
6 2802 write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
6 2803 i,apos,cifre,sep);
6 2804 laf:=0;
6 2805 if cifre<>0 then
6 2806 write(out,<: værdi(1-4)::>,
6 2807 << -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
6 2808 else write(out,<: værdi::>,værdi.laf);
6 2809 ud;
6 2810 end;
5 2811 end;
4 2812 <*-2*>
4 2813 ;
4 2814 if i<>0 then <* ikke ok *>
4 2815 begin
5 2816 if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
5 2817 begin
6 2818 apos:= apos -1;
6 2819 res:= 0;
6 2820 end
5 2821 else if i=1 then res:=-26 <* skilletegn *>
5 2822 else <* i=5 *> res:= -25 <* parameter mangler *>
5 2823 end
4 2824 else <* i=0 *>
4 2825 begin
5 2826 if sep=',' or sep=';' then apos:=apos-1;
5 2827 iaf:= nr*8;
5 2828 nr:= nr +1;
5 2829 \f
5 2829 message procedure læs_param_sæt side 5 - 810520/hko/cl;
5 2830
5 2830 if cifre=0 <* navne_parameter *> then
5 2831 begin
6 2832 if værdi(2)=0
6 2833 and læstegn(værdi,1,i)='G'
6 2834 and læstegn(værdi,2,j)>'0' and j<='9'
6 2835 and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
6 2836 then
6 2837 begin <* gruppenavn, repræsenteres som tal *>
7 2838 t(nr):= 8;
7 2839 j:= j -'0';
7 2840 par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
7 2841 s(nr):= sep;
7 2842 end
6 2843 else
6 2844 begin <* generel tekst *>
7 2845 i:= 0;
7 2846 for i:= i +1 while i<=4 do
7 2847 begin
8 2848 if værdi(i)<>0 then
8 2849 begin
9 2850 t(nr):= i;
9 2851 par.iaf(i):= værdi(i);
9 2852 end
8 2853 else i:= 4;
8 2854 end;
7 2855 s(nr):= sep;
7 2856 end <* generel tekst *>
6 2857 end <* navne_parameter *>
5 2858 else
5 2859 begin <* talparameter *>
6 2860 i:= if værdi(1)<0 then 6 <* neg.tal *>
6 2861 else if værdi(1)>0 and værdi(1)<1000
6 2862 and sep>='A' and sep<='Å' then 7
6 2863 else 5 <* positivt tal *>;
6 2864 t(nr):= i;
6 2865 par.iaf(1):= if i<>7 then værdi(1)
6 2866 else værdi(1) shift 5 +(sep+1-'A');
6 2867 par.iaf(2):= cifre;
6 2868 apos:= apos+1;
6 2869 s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
6 2870 apos:= apos-1;
6 2871 end;
5 2872 end;<* i=0 *>
4 2873 until (ant>0 and nr=ant)
4 2874 or nr=max_ant
4 2875 or res<> -1
4 2876 or sep='sp' or sep=';' or sep='em'
4 2877 or sep=',' or sep='nl' or sep='nul';
4 2878 \f
4 2878 message procedure læs_param_sæt side 6 - 810508/hko;
4 2879
4 2879 if ant>nr then res:= -25 <*parameter mangler*>
4 2880 else
4 2881 if nr=0 or t(1)=0 then
4 2882 begin <* ingen parameter før skilletegn *>
5 2883 if res=-25 then res:= 0;
5 2884 end
4 2885 else if sep<>'sp' and sep<>'nl' and sep <> 'em'
4 2886 and sep<>';' and sep<>',' then
4 2887 begin <* ulovligt afsluttende skilletegn *>
5 2888 res:= -26;
5 2889 end
4 2890 else
4 2891 begin <* en eller flere lovligt afsluttede parametre *>
5 2892 if t(1)<5 and nr=1 then
5 2893
5 2893 <* 1 navne_parameter *>
5 2894
5 2894 begin
6 2895 res:= 1;
6 2896 tofrom(parm,par,8);
6 2897 end
5 2898 else if <*t(1)<9 and *> nr=1 then
5 2899
5 2899 <* 1 parameter af anden type *>
5 2900
5 2900 begin <*tal,linie eller gruppe *>
6 2901 res:= t(1) -3;
6 2902 parm(1):= par(1);
6 2903 end
5 2904 else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
5 2905
5 2905 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
5 2906
5 2906 begin
6 2907 i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
6 2908 j:= par(5); <* internt *>
6 2909 k:= par(9); <* *>
6 2910 if nr=2 then
6 2911 <* 2 parametre i sættet *>
6 2912 begin
7 2913 res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
7 2914 else if s(1)='.' and t(2)=1 then 9
7 2915 else if s(1)='-' and t(1)=5 and t(2)=5 then 10
7 2916 else if s(1)<>'/' and s(1)<>'.'
7 2917 and s(1)<>'-' then -26 <* skilletegn *>
7 2918 else -27;<* parametertype*>
7 2919 \f
7 2919 message procedure læs_param_sæt side 7 - 810501/hko;
7 2920
7 2920 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2921
7 2921 <* 2 parametre i sættet *>
7 2922 if res=6 then
7 2923 begin
8 2924 if (i<1 or i>999) and t(1)=5 then
8 2925 res:= -5 <* ulovligt linienr *>
8 2926 else if (j<1 or j>99) then
8 2927 res:= -6 <* ulovligt løbsnr *>
8 2928 else
8 2929 begin
9 2930 if t(1)=5 then i:= i shift 5;
9 2931 parm(1):= i shift 7 +j;
9 2932 end;
8 2933 end <* res=6 *>
7 2934 else if res=9 then
7 2935 begin
8 2936 if t(1)=5 and (i<1 or 999<i) then
8 2937 res:= -5 <*ulovligt linienr*>
8 2938 else
8 2939 begin
9 2940 if t(1)=5 then i:=i shift 5;
9 2941 parm(1):= i;
9 2942 parm(2):= j;
9 2943 end;
8 2944 end <* res=9 *>
7 2945 else if res=10 then
7 2946 begin
8 2947 begin
9 2948 parm(1):= i;
9 2949 parm(2):= j;
9 2950 end;
8 2951 end; <* res=10 *>
7 2952 end <* nr=2 *>
6 2953 else
6 2954 if nr=3 then
6 2955 <* 3 paramtre i sættet *>
6 2956 begin
7 2957 res:= if (s(1)='/' or s(1)='.') and
7 2958 (s(2)='/' or s(2)='.') then 7
7 2959 else if s(1)='.' and s(2)=':' then 8
7 2960 else -26; <* skilletegn *>
7 2961 \f
7 2961 message procedure læs_param_sæt side 8 - 810501/hko;
7 2962
7 2962 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2963 <* 3 parametre i sættet *>
7 2964 if res=7 then
7 2965 begin
8 2966 if t(1)<>5 or (t(2)<>5 and t(2)<>7)
8 2967 or t(3)<>5 then
8 2968 res:= -27 <* parametertype *>
8 2969 else
8 2970 if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
8 2971 else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
8 2972 else if k<1 or k>99 then res:= -6 <* løb *>
8 2973 else
8 2974 begin <* ok *>
9 2975 parm(1):= i;
9 2976 if t(2)=5 then j:= j shift 5;
9 2977 parm(2):= j shift 7 +k;
9 2978 end;
8 2979 end
7 2980 else if res=8 then
7 2981 begin
8 2982 if t(2)<>1 or t(3)<>5 then res:= -27
8 2983 else if t(1)=5 and (i<1 or i>999) then res:= -5
8 2984 else if k<1 or k>99 then res:= -6
8 2985 else
8 2986 begin
9 2987 if t(1)=5 then i:= i shift 5;
9 2988 parm(1):= i;
9 2989 parm(2):= j;
9 2990 parm(3):= k;
9 2991 end;
8 2992 end;
7 2993 end <* nr=3 *>
6 2994 else res:=-24; <* syntaks *>
6 2995 \f
6 2995 message procedure læs_param_sæt side 9 - 810428/hko;
6 2996
6 2996 end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
5 2997 else if t(1)=8 <* gruppe_id *> then
5 2998 begin
6 2999 <* mere end 1 parameter , hvoraf den første
6 3000 er en gruppe_identifikation ved navn.
6 3001 lovlige parametre er alle internt repræsenteret i et ord *>
6 3002
6 3002 i:=par(1);
6 3003 j:=par(5);
6 3004 k:=par(9);
6 3005
6 3005 if nr=2 then
6 3006 <* 2 parametre *>
6 3007 begin
7 3008 res:=if s(1)=':' and t(2)=5 then 11
7 3009 else if s(1)<>':' then -26 <* skilletegn *>
7 3010 else -27; <*param.type *>
7 3011 if res=11 then
7 3012 begin
8 3013 if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
8 3014 else
8 3015 begin
9 3016 parm(1):=i;
9 3017 parm(2):=j;
9 3018 end;
8 3019 end;
7 3020 \f
7 3020 message procedure læs_param_sæt side 10 - 810428/hko;
7 3021
7 3021 <* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
7 3022
7 3022 end <*nr=2*>
6 3023 else if nr=3 then
6 3024 <* 3 parametre *>
6 3025 begin
7 3026 res:=if s(1)=':' and s(2)='/' then 11
7 3027 else -26; <* skilletegn *>
7 3028 if res=11 then
7 3029 begin
8 3030 if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
8 3031 else
8 3032 begin
9 3033 if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
9 3034 else
9 3035 begin
10 3036 parm(1):=i;
10 3037 if t(2)=5 then j:=j shift 5;
10 3038 parm(2):= 1 shift 22 +j shift 7 +k;
10 3039 end;
9 3040 end;
8 3041 end;
7 3042 end <* nr=3 *>
6 3043 else res:=-24; <* syntaks *>
6 3044 \f
6 3044 message procedure læs_param_sæt side 11 - 810501/hko;
6 3045
6 3045 end <* t(1)=8 *>
5 3046 else if t(1)=1 and par(1)= 'D' shift 16 then
5 3047 begin
6 3048 <* mere end 1 parameter i sættet og 1. parameter er et 'D'.
6 3049 lovlige parametre er alle internt repræsenteret i et ord. *>
6 3050 i:=par(1);
6 3051 j:=par(5);
6 3052 k:=par(9);
6 3053
6 3053 if nr=3 then
6 3054 begin
7 3055 res:=if s(1)='.' and s(2)='.' then 12
7 3056 else -26; <* skilletegn *>
7 3057 if res=12 then
7 3058 begin
8 3059 if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
8 3060 else
8 3061 begin
9 3062 integer år,md,dg,tt,mm,ss;
9 3063 real dato,tid;
9 3064 år:=j//10000;
9 3065 md:=(j//100) mod 100;
9 3066 dg:=j mod 100;
9 3067 cifre:= par(10);
9 3068 tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
9 3069 else k;
9 3070 mm:=if cifre>4 then (k//100) mod 100
9 3071 else if cifre>2 then k mod 100 else 0;
9 3072 ss:=if cifre>4 then k mod 100 else 0;
9 3073 \f
9 3073 message procedure læs_param_sæt side 12 - 810501/hko;
9 3074
9 3074 dato:=systime(5,0.0,tid);
9 3075 if j=0 then dg:=round dato mod 100;
9 3076 if år=0 and md=0 then md:=(round dato//100) mod 100;
9 3077 if år=0 then år:=round dato//10000;
9 3078 if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
9 3079 res:=-24 <* syntaks *>
9 3080 else if dg<1 or dg > (case md of (
9 3081 31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
9 3082 31,31,30, 31,30,31)) then res:=-24
9 3083 else
9 3084 begin
10 3085 parm(1):=år*10000+md*100+dg;
10 3086 parm(2):=tt*10000+mm*100+ss;
10 3087 end;
9 3088 end;
8 3089
8 3089 end; <* res=12 *>
7 3090 end <* nr=3 *>
6 3091 else res:=-24; <*syntaks*>
6 3092 end <* t(1)=1 and par(1)='D' shift 16 *>
5 3093
5 3093 else res:=-27;<*parametertype*>
5 3094 end; <* en eller flere parametre *>
4 3095
4 3095 læs_param_sæt:= res;
4 3096 term:= sep;
4 3097 if res>= 0 then pos:= apos;
4 3098 end;
3 3099 end læs_param_sæt;
2 3100 \f
2 3100 message procedure læs_kommando side 1 - 810428/hko;
2 3101
2 3101 integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
2 3102 value kilde;
2 3103 zone z;
2 3104 integer kilde, pos,indeks,sep,slut_tegn;
2 3105 integer array field op_ref;
2 3106
2 3106 <* proceduren indlæser er kommmando fra en terminal (telex,
2 3107 skærm eller skrivemaskine). ved indlæsning fra skærm eller
2 3108 skrivemaskine inviteres først ved udskrivning af '>'-tegn.
2 3109 for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
2 3110 23'ende linie inden invitation.
2 3111 *>
2 3112 \f
2 3112 message procedure læs_kommando side 2 - 810428/hko;
2 3113
2 3113 begin
3 3114 integer
3 3115 a_pos,
3 3116 a_res,res,
3 3117 i,j,k;
3 3118 boolean
3 3119 skip;
3 3120
3 3120 <*V*>setposition(z,0,0);
3 3121
3 3121 case kilde//100 of
3 3122 begin
4 3123 begin <* io *>
5 3124 write(z,"nl",1,">",1);
5 3125 end;
4 3126
4 3126 begin <* operatør *>
5 3127 cursor(z,24,1);
5 3128 write(z,"esc" add 128,1,<:ÆK:>);
5 3129 cursor(z,23,1);
5 3130 write(z,"esc" add 128,1,<:ÆK:>);
5 3131 outchar(z,'>');
5 3132 end;
4 3133
4 3133 begin <* garageterminal *> ;
5 3134 outchar(z,'nl');
5 3135 end
4 3136 end;
3 3137
3 3137 <*V*>setposition(z,0,0);
3 3138 \f
3 3138 message procedure læs_kommando side 3 - 810921/hko,cl;
3 3139
3 3139 res:=0;
3 3140 skip:= false;
3 3141 <*V*>
3 3142 k:=læs_store(z,i);
3 3143
3 3143 apos:= 1;
3 3144 while k<=6 <*klasse=bogstav*> do
3 3145 begin
4 3146 if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
4 3147 <*V*> k:= læs_store(z,i);
4 3148 end;
3 3149
3 3149 skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
3 3150
3 3150 if i=',' and a_pos>1 then
3 3151 begin
4 3152 skrivtegn(d.op_ref.data,a_pos,i);
4 3153 repeat
4 3154 <*V*> k:= læs_store(z,i);
4 3155 if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
4 3156 until k>=7;
4 3157 end;
3 3158
3 3158 pos:=a_pos;
3 3159 while k<8 do
3 3160 begin
4 3161 if a_pos< (att_op_længde//2*3-2) then
4 3162 skriv_tegn(d.op_ref.data,a_pos,i);
4 3163 skip:= skip or i='?';
4 3164 <*V*> k:= læs_store(z,i);
4 3165 pos:=pos+1;
4 3166 end;
3 3167
3 3167 skip:= skip or i='?' or i='esc';
3 3168 slut_tegn:= i;
3 3169 skrivtegn(d.op_ref.data,apos,'em');
3 3170 afslut_text(d.op_ref.data,apos);
3 3171 \f
3 3171 message procedure læs_kommando side 4 - 820301/hko/cl;
3 3172
3 3172 disable
3 3173 begin
4 3174 integer
4 3175 i1,
4 3176 nr,
4 3177 partype,
4 3178 cifre;
4 3179 integer array
4 3180 spec(1:1),
4 3181 værdi(1:4);
4 3182
4 3182 <*+2*>
4 3183 if testbit25 and overvåget then
4 3184 disable begin
5 3185 real array field raf;
5 3186 write(out,"nl",1,<:kommando læst::>);
5 3187 laf:=data;
5 3188 write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
5 3189 <: skip=:>,if skip then <:true:> else <:false:>);
5 3190 ud;
5 3191 end;
4 3192 <*-2*>
4 3193
4 3193 for i:=1 step 1 until 32 do ia(i):=0;
4 3194
4 3194 if skip then
4 3195 begin
5 3196 res:=53; <*annulleret*>
5 3197 pos:= -1;
5 3198 goto slut_læskommando;
5 3199 end;
4 3200 \f
4 3200 message procedure læs_kommando side 5 - 850820/cl;
4 3201
4 3201 i:= kilde//100; <* hovedmodul *>
4 3202 k:= kilde mod 100; <* løbenr *>
4 3203 <* if pos>79 then linieoverløb; *>
4 3204 pos:=a_pos:=0;
4 3205 spec(1):= ',' shift 16;
4 3206
4 3206 <*+4*>
4 3207 if k<1 or k>(case i of (1,max_antal_operatører,
4 3208 max_antal_garageterminaler)) then
4 3209 begin
5 3210 fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
5 3211 res:=31;
5 3212 end
4 3213 else
4 3214 <*-4*>
4 3215 if i>0 and i<4 then <* io, operatør eller garageterminal *>
4 3216 begin
5 3217 <* læs operationskode *>
5 3218 j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
5 3219
5 3219 res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
5 3220 else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
5 3221 else if j=2 then 4 <*ukendt kommando*>
5 3222 else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
5 3223 else if sep<>'sp' and sep<>','
5 3224 and sep<>'nl' and sep<>';'
5 3225 and sep<>'nul' and sep<>'em' then 26
5 3226 <*skilletegn*>
5 3227 else if -, læsbit_i(værdi(4),i-1) then 4
5 3228 <* logand(extend 0 add værdi(4)
5 3229 extend 1 shift (case i of (0,k,8+k)))=0 then 4
5 3230 *> <*ukendt kommando*>
5 3231 else 1;
5 3232 \f
5 3232 message procedure læs_kommando side 5a- 810409/hko;
5 3233
5 3233 <*+2*>if testbit25 and overvåget then
5 3234 begin
6 3235 write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
6 3236 << -dddd>,j,apos,cifre,sep,res,
6 3237 <: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
6 3238 "nl",0);
6 3239 if j<>0 then skriv_op(out,op_ref);
6 3240 ud;
6 3241 end;
5 3242 <*-2*>
5 3243
5 3243 if res=31 then fejlreaktion(18<*tabelfil*>,j,
5 3244 <:=res, filnr 1025, læskommando:>,0);
5 3245
5 3245 if res=1 then <* operationskode ok *>
5 3246 begin
6 3247 if sep<>'sp' then apos:=apos-1;
6 3248 d.op_ref.opkode:=værdi(1);
6 3249 indeks:=værdi(2);
6 3250 partype:= værdi(3);
6 3251 nr:= 0;
6 3252 pos:= apos;
6 3253 \f
6 3253 message procedure læs_kommando side 6 - 810409/hko;
6 3254
6 3254 while res=1 do
6 3255 begin
7 3256 læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
7 3257 værdi,sep,a_res);
7 3258 nr:= nr +1;
7 3259 i1:= værdi(1);
7 3260 <*+2*> if testbit25 and overvåget then
7 3261 begin
8 3262 write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
8 3263 apos,sep,ares,<: værdi(1-4)::>,
8 3264 værdi(1),værdi(2),værdi(3),værdi(4),
8 3265 "nl",0);
8 3266 ud;
8 3267 end;
7 3268 <*-2*>
7 3269 case par_type of
7 3270 begin
8 3271
8 3271 <*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
8 3272
8 3272 begin
9 3273 if nr=1 then
9 3274 begin
10 3275 if a_res=0 then res:=2 <*godkendt*>
10 3276 else if a_res=2 and (i1<1 or i1>9999)
10 3277 then res:=7 <*busnr ulovligt*>
10 3278 else if a_res=2 or a_res=6 then
10 3279 begin
11 3280 ia(1):= if a_res=2 then i1
11 3281 else 1 shift 22 +i1;
11 3282 end
10 3283 else res:= 27; <*parametertype*>
10 3284 if res<4 then pos:= apos;
10 3285 end <*nr=1*>
9 3286 else
9 3287 if nr=2 then
9 3288 begin
10 3289 if ares=0 then res:= 2 <*godkendt*>
10 3290 else if ares=1 then
10 3291 begin
11 3292 ia(2):= find_område(i1);
11 3293 if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
11 3294 end
10 3295 else res:= 27; <* syntaks, parametertype *>
10 3296 end
9 3297 else
9 3298 if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
9 3299 end;
8 3300 \f
8 3300 message procedure læs_kommando side 7 - 810226/hko;
8 3301
8 3301 <*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
8 3302
8 3302 begin
9 3303 if nr=1 then
9 3304 begin
10 3305 if a_res=0 then res:=25 <*parameter mangler*>
10 3306 else if a_res=2 and (i1<1 or i1>9999)
10 3307 then res:=7 <*busnr ulovligt*>
10 3308 else if a_res=2 or a_res=6 then
10 3309 begin
11 3310 ia(1):=if a_res=2 then i1
11 3311 else 1 shift 22 +i1;
11 3312 end
10 3313 else res:= 27; <*parametertype*>
10 3314 if res<4 then pos:=a_pos;
10 3315 end
9 3316 else
9 3317 if nr=2 then
9 3318 begin
10 3319 if ares=0 then res:= 2 <*godkendt*> else
10 3320 if ares=1 and ia(1) shift (-21) = 0 then
10 3321 begin
11 3322 ia(2):= findområde(i1);
11 3323 if ia(2)=0 then res:= 56; <*område ukendt*>
11 3324 end
10 3325 else res:= 27;
10 3326 if res<4 then pos:= apos;
10 3327 end
9 3328 else
9 3329 if ares=0 then res:= 2 else res:= 24<*syntaks*>;
9 3330 end;
8 3331 \f
8 3331 message procedure læs_kommando side 8 - 810223/hko;
8 3332
8 3332 <*3: (<linie>!G<nr>) *>
8 3333
8 3333 begin
9 3334 if nr=1 then
9 3335 begin
10 3336 if a_res=0 then res:=25 <*parameter mangler*>
10 3337 else if a_res=2 and (i1<1 or i1>999) then res:=5
10 3338 <*linienr ulovligt*>
10 3339 else if a_res=2 or a_res=4 or a_res=5 then
10 3340 begin
11 3341 ia(1):=
11 3342 if a_res=2 then 4 shift 21 +i1 shift 5
11 3343 else if a_res=4 then 4 shift 21 +i1
11 3344 else <* a_res=5 *> 5 shift 21 +i1;
11 3345 end
10 3346 else res:=27; <* parametertype *>
10 3347 if res<4 then pos:= a_pos;
10 3348 end
9 3349 else
9 3350 res:= if nr=2 and a_res<>0 then 24<*syntaks*>
9 3351 else 2;<*godkendt*>
9 3352 end;
8 3353
8 3353 <*4: <ingenting> *>
8 3354
8 3354 begin
9 3355 res:= if a_res<>0 then 24<*syntaks*>
9 3356 else 2;<*godkendt*>
9 3357 end;
8 3358 \f
8 3358 message procedure læs_kommando side 9 - 810226/hko;
8 3359
8 3359 <*5: (<kanalnr>) *>
8 3360
8 3360 begin
9 3361 long field lf;
9 3362
9 3362 if nr=1 then
9 3363 begin
10 3364 if a_res=0 then res:= 25
10 3365 else if a_res<>1 then res:=27<*parametertype*>
10 3366 else
10 3367 begin
11 3368 j:= 0; lf:= 4;
11 3369 for i:= 1 step 1 until max_antal_kanaler do
11 3370 if kanal_navn(i)=værdi.lf then j:= i;
11 3371 if j<>0 then
11 3372 begin
12 3373 ia(1):= 3 shift 22 + j;
12 3374 res:= 2;
12 3375 end
11 3376 else
11 3377 res:= 17; <* kanal ukendt *>
11 3378 end;
10 3379 if res<4 then pos:= a_pos;
10 3380 end
9 3381 else
9 3382 res:=if nr=2 and a_res<>0 then 24<*syntaks*>
9 3383 else 2;<*godkendt*>
9 3384 end;
8 3385 \f
8 3385 message procedure læs_kommando side 10 - 810415/hko;
8 3386
8 3386 <*6: <busnr>/<linie>/<løb> (<område>) *>
8 3387
8 3387 begin
9 3388 if nr=1 then
9 3389 begin
10 3390 if a_res=0 then res:=25<*parameter mangler*>
10 3391 else if a_res=7 then
10 3392 begin
11 3393 ia(1):= i1;
11 3394 ia(2):= 1 shift 22 + værdi(2);
11 3395 end
10 3396 else res:=27;<*parametertype*>
10 3397 if res<4 then pos:= apos;
10 3398 end
9 3399 else
9 3400 if nr=2 then
9 3401 begin
10 3402 if ares=0 then res:= 2 <*godkendt*> else
10 3403 if ares=1 then
10 3404 begin
11 3405 ia(3):= findområde(i1);
11 3406 if ia(3)=0 then res:= 56; <* område ukendt *>
11 3407 end
10 3408 else res:= 27; <*parametertype*>
10 3409 if res<4 then pos:= apos;
10 3410 end
9 3411 else
9 3412 if ares=0 then res:= 2 else res:= 24;
9 3413 end;
8 3414 \f
8 3414 message procedure læs_kommando side 11 - 810512/hko/cl;
8 3415
8 3415
8 3415 <* att_op_længde//2-2 *>
8 3416 <*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
8 3417 <* 1 *>
8 3418
8 3418 begin
9 3419 if nr=1 then
9 3420 begin
10 3421 if a_res=0 then res:=25 <*parameter mangler*>
10 3422 else if a_res=8 then
10 3423 begin
11 3424 ia(1):= 4 shift 21 + i1;
11 3425 ia(2):= værdi(2);
11 3426 ia(3):= værdi(3);
11 3427 indeks:= 3;
11 3428 end
10 3429 else res:=27;<*parametertype*>
10 3430 end
9 3431 else if nr<=att_op_længde//2-2 then
9 3432 begin
10 3433 if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
10 3434 else if a_res=0 then res:=25 <* parameter mangler *>
10 3435 else if a_res=10 then
10 3436 begin
11 3437 if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
11 3438 begin
12 3439 ia(nr+2):= i1 shift 12 + værdi(2);
12 3440 indeks:= nr +2;
12 3441 end
11 3442 else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
11 3443 else res:=6; <*løb-nr ulovligt*>
11 3444 end
10 3445 else res:=27;<*parametertype*>
10 3446 end
9 3447 else
9 3448 res:= if a_res=0 then 2 else 24;<* syntaks *>
9 3449 if res<4 then pos:=a_pos;
9 3450 end;
8 3451 \f
8 3451 message procedure læs_kommando side 12 - 810306/hko;
8 3452
8 3452 <*8: (<operatør>!<radiokanal>!<garageterminal>) *>
8 3453
8 3453 begin
9 3454 if nr=1 then
9 3455 begin
10 3456 if a_res=0 then res:=25 <* parameter mangler *>
10 3457 else if a_res=2 then
10 3458 begin
11 3459 j:=d.op_ref.opkode;
11 3460 ia(1):=i1;
11 3461 k:=(j+1)//2;
11 3462 if k<1 or k=3 or k>4 then
11 3463 fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
11 3464 else
11 3465 begin
12 3466 if k=4 then k:=3;
12 3467 if i1<1 or i1> (case k of
12 3468 (max_antal_operatører,max_antal_radiokanaler,
12 3469 max_antal_garageterminaler))
12 3470 then res:=case k of (28,29,17);
12 3471 end;
11 3472 end
10 3473 else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
10 3474 begin
11 3475 laf:= 0;
11 3476 ia(1):= find_bpl(værdi.laf(1));
11 3477 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3478 end
10 3479 else res:=27; <*parametertype*>
10 3480 end
9 3481 else
9 3482 if nr=2 and d.opref.opkode=1 then
9 3483 begin
10 3484 <* åbningstilstand for operatørplads *>
10 3485 if a_res=0 then res:= 2 <*godkendt*>
10 3486 else if a_res<>1 then res:= 27 <*parametertype*>
10 3487 else begin
11 3488 res:= 2<*godkendt*>;
11 3489 j:= værdi(1) shift (-16);
11 3490 if j='S' then ia(2):= 3 else
11 3491 if j<>'Å' then res:= 24; <*syntaks*>
11 3492 end;
10 3493 end
9 3494 else
9 3495 begin
10 3496 res:=if a_res=0 then 2 <* godkendt *>
10 3497 else 24;<* syntaks *>
10 3498 end;
9 3499 if res<4 then pos:=a_pos;
9 3500 end; <* partype 8 *>
8 3501 \f
8 3501 message procedure læs_kommando side 13 - 810306/hko;
8 3502
8 3502
8 3502 <* att_op_længde//2 *>
8 3503 <*9: <operatør>((+!-)<linienr>) *>
8 3504 <* 1 *>
8 3505
8 3505 begin
9 3506 if nr=1 then
9 3507 begin
10 3508 if a_res=0 then res:=25 <* parameter mangler *>
10 3509 else if a_res=2 then
10 3510 begin
11 3511 ia(1):=i1;
11 3512 if i1<1 or i1>max_antal_operatører then res:=28;
11 3513 end
10 3514 else if a_res=1 then
10 3515 begin
11 3516 laf:= 0;
11 3517 ia(1):= find_bpl(værdi.laf(1));
11 3518 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3519 end
10 3520 else res:=27; <* parametertype *>
10 3521 end
9 3522 else if nr<=att_op_længde//2 then
9 3523 begin <* nr>1 *>
10 3524 if a_res=0 then res:=(if nr>2 then 2 else 25)
10 3525 else if a_res=2 or a_res=3 then
10 3526 begin
11 3527 ia(nr):=i1; indeks:= nr;
11 3528 if i1=0 or abs(i1)>999 then res:=5;
11 3529 end
10 3530 else res:=27; <* parametertype *>
10 3531 if res<4 then pos:=a_pos;
10 3532 end
9 3533 else
9 3534 res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
9 3535 else 2;
9 3536 end; <* partype 9 *>
8 3537 \f
8 3537 message procedure læs_kommando side 14 - 810428/hko;
8 3538
8 3538 <* 2 *>
8 3539 <*10: (bus) *>
8 3540 <* 1 *>
8 3541
8 3541 begin
9 3542 if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
9 3543 else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
9 3544 else if a_res=0 then res:=2 <* godkendt *>
9 3545 else if a_res<>2 then res:=27 <* parametertype *>
9 3546 else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
9 3547 else
9 3548 ia(nr):=i1;
9 3549 end;
8 3550
8 3550 <* 5 *>
8 3551 <*11: (<linie>) *>
8 3552 <* 1 *>
8 3553
8 3553 begin
9 3554 if a_res=0 and nr=1 then res:=25
9 3555 else if a_res<>0 and nr>5 then res:=24
9 3556 else if a_res=0 then res:=2
9 3557 else if a_res<>2 and a_res<>4 then res:=27
9 3558 else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
9 3559 else
9 3560 ia(nr):=
9 3561 (if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
9 3562 end;
8 3563 \f
8 3563 message procedure læs_kommando side 15 - 810306/hko;
8 3564
8 3564 <*12: (<ingenting>!<navn>) *>
8 3565
8 3565 begin
9 3566 if nr=1 then
9 3567 begin
10 3568 if a_res=0 then res:=2 <*godkendt*>
10 3569 else if a_res=1 then
10 3570 tofrom(ia,værdi,8)
10 3571 else res:=27; <* parametertype *>
10 3572 end
9 3573 else
9 3574 res:=if a_res<>0 then 24 <* syntaks (for mange) *>
9 3575 else 2;
9 3576 end; <* partype 12 *>
8 3577 \f
8 3577 message procedure læs_kommando side 16 - 810512/hko/cl;
8 3578
8 3578 <* 15 *>
8 3579 <*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
8 3580 <* 1 *>
8 3581
8 3581 begin
9 3582 if nr=1 then
9 3583 begin
10 3584 if a_res=0 then res:=25 <* parameter mangler *>
10 3585 else
10 3586 if a_res=11 then
10 3587 begin
11 3588 ia(1):= 5 shift 21 + i1;
11 3589 ia(2):=værdi(2);
11 3590 indeks:= 2;
11 3591 end
10 3592 else res:=27; <* parametertype *>
10 3593 end
9 3594 else if nr<= att_op_længde//2-1 then
9 3595 begin
10 3596 if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
10 3597 else if a_res=0 then res:=25 <* parameter mangler *>
10 3598 else if ares=2 and (i1<1 or i1>9999) then
10 3599 res:= 7 <*busnr ulovligt*>
10 3600 else if a_res=2 or a_res=6 then
10 3601 begin
11 3602 ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
11 3603 indeks:= nr+1;
11 3604 end
10 3605 else res:=27; <* parametertype *>
10 3606 end
9 3607 else
9 3608 res:=if a_res=0 then 2 <*godkendt *>
9 3609 else 24;<* syntaks *>
9 3610 if res<4 then pos:=a_pos;
9 3611 end; <* partype 13 *>
8 3612 \f
8 3612 message procedure læs_kommando side 17 - 810311/hko;
8 3613
8 3613 <*14: <linie>.<indeks> *>
8 3614
8 3614 begin
9 3615 if nr=1 then
9 3616 begin
10 3617 if a_res=0 then res:=25 <* parameter mangler *>
10 3618 else if a_res=9 then
10 3619 begin
11 3620 ia(1):= 1 shift 23 +i1;
11 3621 ia(2):= værdi(2);
11 3622 end
10 3623 else res:=27; <* parametertype *>
10 3624 end
9 3625 else <* nr>1 *>
9 3626 res:= if a_res=0 then 2 <* godkendt *>
9 3627 else 24;<* syntaks *>
9 3628 end; <* partype 14 *>
8 3629 \f
8 3629 message procedure læs_kommando side 18 - 810313/hko;
8 3630
8 3630 <*15: <linie>.<indeks> <bus> *>
8 3631
8 3631 begin
9 3632 if nr=1 then
9 3633 begin
10 3634 if a_res=0 then res:= 25 <* parameter mangler *>
10 3635 else if a_res=9 then
10 3636 begin
11 3637 ia(1):= 1 shift 23 +i1;
11 3638 ia(2):= værdi(2);
11 3639 end
10 3640 else res:=27; <* parametertype *>
10 3641 end
9 3642 else if nr=2 then
9 3643 begin
10 3644 if a_res=0 then res:=25
10 3645 else if a_res=2 then
10 3646 begin
11 3647 if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
11 3648 else ia(3):= i1;
11 3649 end
10 3650 else res:=27; <*parametertype *>
10 3651 end
9 3652 else
9 3653 res:=if a_res=0 then 2 <* godkendt *>
9 3654 else 24;<* syntaks *>
9 3655 if res<4 then pos:=a_pos;
9 3656 end; <* partype 15 *>
8 3657 \f
8 3657 message procedure læs_kommando side 19 - 810311/hko;
8 3658
8 3658 <*16: (<ingenting>!D.<dato>.<klokkeslet> *>
8 3659
8 3659 begin
9 3660 if nr=1 then
9 3661 begin
10 3662 if a_res=0 then res:=2 <* godkendt *>
10 3663 else if a_res=12 then
10 3664 begin
11 3665 raf:=0;
11 3666 ia.raf(1):= systid(i1,værdi(2));
11 3667 end
10 3668 else res:=27; <* parametertype *>
10 3669 end
9 3670 else
9 3671 res:= if a_res=0 then 2 <* godkendt *>
9 3672 else 24;<* syntaks *>
9 3673 if res<4 then pos:=a_pos;
9 3674 end; <* partype 16 *>
8 3675 \f
8 3675 message procedure læs_kommando side 20 - 810511/hko;
8 3676
8 3676 <*17: G<grp.nr> *>
8 3677
8 3677 begin
9 3678 if nr=1 then
9 3679 begin
10 3680 if a_res=0 then res:=25 <*parameter mangler *>
10 3681 else if a_res=5 then
10 3682 begin
11 3683 ia(1):= 5 shift 21 +i1;
11 3684 end
10 3685 else res:=27; <* parametertype *>
10 3686 end
9 3687 else
9 3688 res:= if a_res=0 then 2 <* godkendt *>
9 3689 else 24;<* syntaks *>
9 3690 end; <* partype 17 *>
8 3691
8 3691 <* att_op_længde//2 *>
8 3692 <*18: (<heltal>) *>
8 3693 <* 1 *>
8 3694
8 3694 begin
9 3695 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3696 else
9 3697 if nr<=att_op_længde//2 then
9 3698 begin
10 3699 if a_res=2 or a_res=3 <* pos/neg heltal *> then
10 3700 begin
11 3701 ia(nr):= i1; indeks:= nr;
11 3702 end
10 3703 else if a_res=0 then res:= 2
10 3704 else res:= 27; <*parametertype*>
10 3705 end
9 3706 else
9 3707 res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
9 3708 end;
8 3709 \f
8 3709 message procedure læs_kommando side 21 - 820302/cl;
8 3710
8 3710 <*19: <linie>/<løb> <linie>/<løb> *>
8 3711
8 3711 begin
9 3712 if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3713 else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
9 3714 else if nr<3 then
9 3715 begin
10 3716 ia(nr):=i1 + 1 shift 22;
10 3717 end
9 3718 else
9 3719 res:= if a_res=0 then 2 <*godkendt*>
9 3720 else 24;<*syntaks (for mange)*>
9 3721 if res<4 then pos:= a_pos;
9 3722 end; <* partype 19 *>
8 3723
8 3723 <*20: <busnr> <kortnavn> *>
8 3724 begin
9 3725 if nr=1 then
9 3726 begin
10 3727 if ares=0 then res:= 25 else
10 3728 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3729 if ares<>2 then res:= 27 else ia(1):= i1;
10 3730 end
9 3731 else
9 3732 if nr=2 then
9 3733 begin
10 3734 if ares=1 and værdi(2) extract 8 = 0 then
10 3735 begin
11 3736 ia(2):= værdi(1); ia(3):= værdi(2);
11 3737 end
10 3738 else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
10 3739 end
9 3740 else
9 3741 if ares=0 then res:= 2 else res:= 24;
9 3742 end; <* partype 20 *>
8 3743 \f
8 3743 message procedure læs_kommando side 22 - 851001/cl;
8 3744
8 3744 <* 2 *>
8 3745 <*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
8 3746 <* 0 *>
8 3747
8 3747 begin
9 3748 laf:= 0;
9 3749 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3750 else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
9 3751 else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
9 3752 else if a_res=0 then res:= 2 <*godkendt*>
9 3753 else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
9 3754 else if (a_res=2 or a_res=4) and nr<=2 then
9 3755 begin
10 3756 if ia(3)<>0 then res:= 27 else
10 3757 ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
10 3758 end
9 3759 else
9 3760 if ares=1 then
9 3761 begin
10 3762 if nr=1 then
10 3763 begin
11 3764 ia(1):= (4 shift 21) + (1 shift 5);
11 3765 ia(2):= (4 shift 21) + (999 shift 5);
11 3766 end;
10 3767 if ia(3)=-2 then
10 3768 begin
11 3769 if i1=long<:ALL:> shift (-24) extract 24 then
11 3770 ia(3):= -1
11 3771 else
11 3772 begin
12 3773 ia(3):= findområde(i1);
12 3774 if ia(3)=0 then res:= 56 else
12 3775 ia(3):= 14 shift 20 + ia(3);
12 3776 end;
11 3777 end
10 3778 else
10 3779 if ia(3) = 0 then
10 3780 begin
11 3781 if i1 = long<:OMR:> shift (-24) extract (24) then
11 3782 ia(3):= -2
11 3783 else
11 3784 ia(3):= find_bpl(værdi.laf(1));
11 3785 if ia(3)=0 then res:= 55;
11 3786 end
10 3787 else res:= 24;
10 3788 end
9 3789 else res:= 27; <*parametertype*>
9 3790 if res<4 then pos:= apos;
9 3791 end;
8 3792
8 3792 <*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
8 3793
8 3793 begin
9 3794 if nr=1 then
9 3795 begin
10 3796 if ares=0 then res:= 25 <*parameter mangler*>
10 3797 else if ares=2 and (i1<1 or i1>9999)
10 3798 then res:= 7 <* busnr ulovligt *>
10 3799 else if ares=2 or ares=6 then
10 3800 begin
11 3801 ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
11 3802 end
10 3803 else res:= 27 <* parametertype *>
10 3804 end
9 3805 else
9 3806 if nr=2 then
9 3807 begin
10 3808 if ares=0 then res:= 2 <* godkendt *>
10 3809 else if ares=1 then
10 3810 begin
11 3811 ia(2):= findområde(i1);
11 3812 if ia(2)=0 then res:= 17 <*kanal ukendt*>
11 3813 end
10 3814 else
10 3815 res:= 27; <* parametertype *>
10 3816 end
9 3817 else if ares=0 then res:= 2 <*godkendt*>
9 3818 else res:= 24; <*syntaks*>
9 3819 if res < 4 then pos:= apos;
9 3820 end;
8 3821
8 3821 <*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
8 3822
8 3822 begin
9 3823 if nr=1 then
9 3824 begin
10 3825 if ares=0 then res:= 25 else
10 3826 if ares=2 and (i1<1 or i1>999) then res:= 5 else
10 3827 if ares=2 or ares=4 or ares=5 then
10 3828 begin
11 3829 ia(1):=
11 3830 if ares=2 then 4 shift 21 + i1 shift 5 else
11 3831 if ares=4 then 4 shift 21 + i1 else
11 3832 5 shift 21 + i1;
11 3833 end
10 3834 else res:= 27;
10 3835 if res < 4 then pos:= apos;
10 3836 end
9 3837 else
9 3838 if nr=2 then
9 3839 begin
10 3840 if ares=0 then res:= 2 else
10 3841 if ares=1 then
10 3842 begin
11 3843 ia(2):= findområde(i1);
11 3844 if ia(2)=0 then res:= 17;
11 3845 end
10 3846 else res:= 27;
10 3847 end
9 3848 else
9 3849 if ares=0 then res:= 2 else res:= 24;
9 3850 end;
8 3851
8 3851 <*24: ( <ingenting> ! <område> ! * ) *>
8 3852
8 3852 begin
9 3853 if nr=1 then
9 3854 begin
10 3855 if ares=0 then res:= 2 else
10 3856 if ares=1 then
10 3857 begin
11 3858 if i1=long<:ALL:> shift (-24) extract 24 then
11 3859 ia(1):= (-1) shift (-3) shift 3
11 3860 else
11 3861 begin
12 3862 k:= findområde(i1);
12 3863 if k=0 then res:= 17 else
12 3864 ia(1):= 14 shift 20 + k;
12 3865 end;
11 3866 end
10 3867 else res:= 27;
10 3868 end
9 3869 else
9 3870 if ares=0 then res:= 2 else res:= 24;
9 3871 if res < 4 then pos:= apos;
9 3872 end;
8 3873
8 3873 <*25: <område> *>
8 3874
8 3874 begin
9 3875 if nr=1 then
9 3876 begin
10 3877 if ares=0 then res:= 25 else
10 3878 if ares=1 then
10 3879 begin
11 3880 if i1 = '*' shift 16 then ia(1):= -1 else
11 3881 ia(1):= findområde(i1);
11 3882 if ia(1)=0 then res:= 17;
11 3883 end
10 3884 else res:= 27;
10 3885 end
9 3886 else
9 3887 if ares=0 then res:= 2 else res:= 24;
9 3888 if res < 4 then pos:= apos;
9 3889 end;
8 3890
8 3890 <*26: <busnr> *>
8 3891 begin
9 3892 if nr=1 then
9 3893 begin
10 3894 if ares=0 then res:= 25 else
10 3895 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3896 if ares<>2 then res:= 27 else ia(1):= i1;
10 3897 end
9 3898 else
9 3899 if ares=0 then res:= 2 else res:= 24;
9 3900 end;
8 3901
8 3901 <* 8 *>
8 3902 <*27: <operatørnr> (<område>) *>
8 3903 <* 1 *>
8 3904 begin
9 3905 if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3906 else if nr=1 then
9 3907 begin
10 3908 if a_res=2 then
10 3909 begin
11 3910 ia(1):= i1;
11 3911 if i1 < 0 or max_antal_operatører < i1 then res:= 28;
11 3912 end
10 3913 else if a_res=1 then
10 3914 begin
11 3915 laf:= 0;
11 3916 ia(1):= find_bpl(værdi.laf(1));
11 3917 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3918 end
10 3919 else res:= 27; <*parametertype*>
10 3920 end
9 3921 else
9 3922 begin
10 3923 if a_res=0 then res:= (if nr > 2 then 2 else 25)
10 3924 else if nr > 9 then res:= 24
10 3925 else if a_res=1 then
10 3926 begin
11 3927 ia(nr):= find_område(i1);
11 3928 indeks:= nr;
11 3929 if ia(nr)=0 then res:= 56;
11 3930 end
10 3931 else res:= 27;
10 3932 end;
9 3933 if res < 4 then pos:= a_pos;
9 3934 end <* partype 27 *>;
8 3935
8 3935 <*28: (<ingenting>!<kanalnr>) *>
8 3936 begin
9 3937 long field lf;
9 3938
9 3938 if nr=1 then
9 3939 begin
10 3940 if ares=0 then res:= 2 else
10 3941 if ares=1 then
10 3942 begin
11 3943 j:= 0; lf:= 4;
11 3944 for i:= 1 step 1 until max_antal_kanaler do
11 3945 if kanal_navn(i)=værdi.lf then j:= i;
11 3946 if j<>0 then
11 3947 begin
12 3948 ia(1):= 3 shift 22 + j;
12 3949 res:= 2;
12 3950 end
11 3951 else
11 3952 res:= 17; <*kanal ukendt*>
11 3953 end
10 3954 else
10 3955 res:= 27; <*parametertype*>
10 3956 if res < 4 then pos:= apos;
10 3957 end
9 3958 else
9 3959 res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
9 3960 end;
8 3961
8 3961 <* n *>
8 3962 <*29: <btj.pl.navn> ( <operatørnavn>) *>
8 3963 <* 0 *>
8 3964 begin
9 3965 laf:= 0;
9 3966 if nr=1 then
9 3967 begin
10 3968 if a_res=0 then res:= 25 <*parameter mangler*>
10 3969 else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
10 3970 else begin
11 3971 indeks:= 2;
11 3972 ia(1):= værdi(1); ia(2):= værdi(2);
11 3973 j:= find_bpl(værdi.laf(1));
11 3974 if 0<j and j<=max_antal_operatører then
11 3975 res:= 62; <*ulovligt navn*>
11 3976 end;
10 3977 end
9 3978 else
9 3979 begin
10 3980 if a_res=0 then res:= 2 <*godkendt*>
10 3981 else if a_res<>1 then res:= 27 <*parametertype*>
10 3982 else begin
11 3983 indeks:= indeks+1;
11 3984 ia(indeks):= find_bpl(værdi.laf(1));
11 3985 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3986 res:= 28; <*ukendt operatør*>
11 3987 end;
10 3988 end;
9 3989 if res<4 then pos:= a_pos;
9 3990 end;
8 3991
8 3991 <* 3 *>
8 3992 <*30: (<operatørnavn>) ( <btj.pl.navn>) *>
8 3993 <* io 0 *>
8 3994
8 3994 begin
9 3995 boolean io;
9 3996
9 3996 io:= (kilde//100 = 1);
9 3997 laf:= 0;
9 3998 if -,io and nr=1 then
9 3999 begin
10 4000 indeks:= 1;
10 4001 ia(1):= kilde mod 100; <*egen operatørplads*>
10 4002 end;
9 4003
9 4003 if io and nr=1 then
9 4004 begin
10 4005 if a_res=0 then res:= 25 <*parameter mangler*>
10 4006 else if a_res<>1 then res:= 27 <*parametertype*>
10 4007 else begin
11 4008 indeks:= nr;
11 4009 ia(indeks):= find_bpl(værdi.laf(1));
11 4010 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 4011 res:= 28; <*ukendt operatør*>
11 4012 end;
10 4013 end
9 4014 else
9 4015 begin
10 4016 if a_res=0 then res:= 2<*godkendt*>
10 4017 else if indeks=4 then res:= 24 <*syntaks, for mange*>
10 4018 else if a_res<>1 then res:= 27 <*parametertype*>
10 4019 else begin
11 4020 indeks:= indeks+1;
11 4021 ia(indeks):= find_bpl(værdi.laf(1));
11 4022 if ia(indeks)=0 then res:= 46 <*navn ukendt*>
11 4023 else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
11 4024 end;
10 4025 end;
9 4026 if res<4 then pos:= a_pos;
9 4027 end;
8 4028
8 4028 <* *>
8 4029 <*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
8 4030 <* *>
8 4031
8 4031 begin
9 4032 laf:= 0;
9 4033 if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
9 4034 else
9 4035 if nr=1 then
9 4036 begin
10 4037 if a_res=2 then
10 4038 begin
11 4039 ia(1):= i1;
11 4040 if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
11 4041 end else res:= 27; <*parametertype*>
10 4042 end
9 4043 else
9 4044 if nr=2 then
9 4045 begin
10 4046 if a_res=1 and værdi(2) extract 8 = 0 then
10 4047 begin
11 4048 ia(2):= værdi(1); ia(3):= værdi(2);
11 4049 j:= find_bpl(værdi.laf(1));
11 4050 if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
11 4051 end
10 4052 else res:= if a_res=0 then 2 <*godkendt*>
10 4053 else 27 <*parametertype*>;
10 4054 end
9 4055 else
9 4056 if nr=3 then
9 4057 begin
10 4058 if a_res=0 then res:=2 <*godkendt*>
10 4059 else if a_res<>1 then res:= 27 <*parametertype*>
10 4060 else begin
11 4061 j:= værdi(1) shift (-16);
11 4062 if j='Å' then ia(4):= 1 else
11 4063 if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
11 4064 end;
10 4065 end
9 4066 else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
9 4067 if res<4 then pos:= a_pos;
9 4068 end;
8 4069
8 4069 <* 1 *>
8 4070 <*32: (heltal) *>
8 4071 <* 0 *>
8 4072 begin
9 4073 if nr=1 then
9 4074 begin
10 4075 if ares=0 then
10 4076 begin
11 4077 indeks:= 0; res:= 2;
11 4078 end
10 4079 else
10 4080 if ares=2 or ares=3 then
10 4081 begin
11 4082 ia(nr):= i1; indeks:= nr;
11 4083 end
10 4084 else res:=27; <*parametertype*>
10 4085 end
9 4086 else
9 4087 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4088 if res < 4 then pos:= a_pos;
9 4089 end;
8 4090
8 4090 <*33 generel tekst*>
8 4091 begin
9 4092 integer p,p1,ch,lgd;
9 4093
9 4093 if nr=1 and a_res<>0 then
9 4094 begin
10 4095 p:=pos; p1:=1;
10 4096 lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
10 4097 if 95<lgd then lgd:=95;
10 4098 repeat læstegn(d.opref.data,p,ch) until ch<>' ';
10 4099 while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
10 4100 begin
11 4101 skrivtegn(ia,p1,ch);
11 4102 læstegn(d.opref.data,p,ch);
11 4103 end;
10 4104 if p1=1 then res:= 25 else res:= 2;
10 4105 repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
10 4106 end
9 4107 else
9 4108 if a_res=0 then res:= 25 else res:= 24;
9 4109 end;
8 4110
8 4110 <*34: (heltal) *>
8 4111 begin
9 4112 if nr=1 then
9 4113 begin
10 4114 if ares=0 then res:= 25 else
10 4115 if ares=2 or ares=3 then
10 4116 begin
11 4117 ia(nr):= i1; indeks:= nr;
11 4118 end
10 4119 else res:=27; <*parametertype*>
10 4120 end
9 4121 else
9 4122 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4123 if res < 4 then pos:= a_pos;
9 4124 end;
8 4125
8 4125 <*+4*> begin
9 4126 fejlreaktion(4<*systemfejl*>,partype,
9 4127 <:parametertype fejl i kommandofil:>,1);
9 4128 res:=31;
9 4129 end
8 4130 <*-4*>
8 4131 end;<*case partype*>
7 4132 end;<* while læs_param_sæt *>
6 4133 end; <* operationskode ok *>
5 4134 end
4 4135 else
4 4136 begin
5 4137 fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
5 4138 end;
4 4139
4 4139 if a_res<0 then res:= -a_res;
4 4140 slut_læskommando:
4 4141
4 4141 læs_kommando:=d.op_ref.resultat:= res;
4 4142 end;<* disable-blok*>
3 4143 end læs_kommando;
2 4144 \f
2 4144 message procedure skriv_kvittering side 1 - 820301/hko/cl;
2 4145
2 4145 procedure skriv_kvittering(z,ref,pos,res);
2 4146 value ref,pos,res;
2 4147 zone z;
2 4148 integer ref,pos,res;
2 4149 begin
3 4150 integer array field op;
3 4151 integer pos1,tegn;
3 4152 op:=ref;
3 4153 if res<1 or res>3 then write(z,<:*** :>);
3 4154 write(z,case res+1 of (
3 4155 <* 0*><:ubehandlet:>,
3 4156 <* 1*><:ok:>,
3 4157 <* 2*><:godkendt:>,
3 4158 <* 3*><:udført:>,
3 4159 <* 4*><:kommando ukendt:>,
3 4160
3 4160 <* 5*><:linie-nr ulovligt:>,
3 4161 <* 6*><:løb-nr ulovligt:>,
3 4162 <* 7*><:bus-nr ulovligt:>,
3 4163 <* 8*><:gruppe ukendt:>,
3 4164 <* 9*><:linie/løb ukendt:>,
3 4165
3 4165 <*10*><:bus-nr ukendt:>,
3 4166 <*11*><:bus allerede indsat på :>,
3 4167 <*12*><:linie/løb allerede besat af :>,
3 4168 <*13*><:bus ikke indsat:>,
3 4169 <*14*><:bus optaget:>,
3 4170
3 4170 <*15*><:gruppe optaget:>,
3 4171 <*16*><:skærm optaget:>,
3 4172 <*17*><:kanal ukendt:>,
3 4173 <*18*><:bus i kø:>,
3 4174 <*19*><:kø er tom:>,
3 4175
3 4175 <*20*><:ej forbindelse :>,
3 4176 <*21*><:ingen at gennemstille til:>,
3 4177 <*22*><:ingen samtale at nedlægge:>,
3 4178 <*23*><:ingen samtale at monitere:>,
3 4179 <*24*><:syntaks:>,
3 4180
3 4180 <*25*><:syntaks, parameter mangler:>,
3 4181 <*26*><:syntaks, skilletegn:>,
3 4182 <*27*><:syntaks, parametertype:>,
3 4183 <*28*><:operatør ukendt:>,
3 4184 <*29*><:garageterminal ukendt:>,
3 4185 \f
3 4185
3 4185 <*30*><:rapport kan ikke dannes:>,
3 4186 <*31*><:systemfejl:>,
3 4187 <*32*><:ingen fri plads:>,
3 4188 <*33*><:gruppe for stor:>,
3 4189 <*34*><:gruppe allerede defineret:>,
3 4190
3 4190 <*35*><:springsekvens for stor:>,
3 4191 <*36*><:spring allerede defineret:>,
3 4192 <*37*><:spring ukendt:>,
3 4193 <*38*><:spring allerede igangsat:>,
3 4194 <*39*><:bus ikke reserveret:>,
3 4195
3 4195 <*40*><:gruppe ikke reserveret:>,
3 4196 <*41*><:spring ikke igangsat:>,
3 4197 <*42*><:intet frit linie/løb:>,
3 4198 <*43*><:ændring af dato/tid ikke lovlig:>,
3 4199 <*44*><:interval-størrelse ulovlig:>,
3 4200
3 4200 <*45*><:ikke implementeret:>,
3 4201 <*46*><:navn ukendt:>,
3 4202 <*47*><:forkert indhold:>,
3 4203 <*48*><:i brug:>,
3 4204 <*49*><:ingen samtale igang:>,
3 4205
3 4205 <*50*><:kanal:>,
3 4206 <*51*><:afvist:>,
3 4207 <*52*><:kanal optaget :>,
3 4208 <*53*><:annulleret:>,
3 4209 <*54*><:ingen busser at kalde op:>,
3 4210
3 4210 <*55*><:garagenavn ukendt:>,
3 4211 <*56*><:område ukendt:>,
3 4212 <*57*><:område nødvendigt:>,
3 4213 <*58*><:ulovligt område for bus:>,
3 4214 <*59*><:radiofejl :>,
3 4215
3 4215 <*60*><:område kan ikke opdateres:>,
3 4216 <*61*><:ingen talevej:>,
3 4217 <*62*><:ulovligt navn:>,
3 4218 <*63*><:alarmlængde: :>,
3 4219 <*64*><:ulovligt tal:>,
3 4220
3 4220 <*99*><:- <'?'> -:>));
3 4221 \f
3 4221 message procedure skriv_kvittering side 3 - 820301/hko;
3 4222 if res=3 and op<>0 then
3 4223 begin
4 4224 if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
4 4225 begin
5 4226 i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
5 4227 if i<>0 then write(z,i,<: udtaget:>);
5 4228 end;
4 4229 end;
3 4230 if res = 11 or res = 12 then
3 4231 i:=ref;
3 4232 if res=11 then write(z,i shift(-12) extract 10,
3 4233 if i shift(-7) extract 5 =0 then false
3 4234 else "A" add (i shift(-7) extract 5 -1),1,
3 4235 <:/:>,<<d>,i extract 7) else
3 4236 if res=12 then write(z,i extract 14) else
3 4237 if res = 20 or res = 52 or res = 59 then
3 4238 begin
4 4239 i:= d.op.data(12);
4 4240 if i <> 0 then skriv_id(z,i,8);
4 4241 i:=d.op.data(2);
4 4242 if i=0 then i:=d.op.data(9);
4 4243 if i=0 then i:=d.op.data(8);
4 4244 skriv_id(z,i,8);
4 4245 end;
3 4246 if res=63 then
3 4247 begin
4 4248 i:= ref;
4 4249 if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
4 4250 end;
3 4251
3 4251 if pos>=0 then
3 4252 begin
4 4253 pos:=pos+1;
4 4254 outchar(z,':');
4 4255 tegn:=-1;
4 4256 while tegn<>10 and tegn<>0 do
4 4257 outchar(z,læs_tegn(d.op.data,pos,tegn));
4 4258 end;
3 4259 <*V*>setposition(z,0,0);
3 4260 end skriv_kvittering;
2 4261 \f
2 4261 message procedure cursor, side 1 - 810213/hko;
2 4262
2 4262 procedure cursor(z,linie,pos);
2 4263 value linie,pos;
2 4264 zone z;
2 4265 integer linie,pos;
2 4266 begin
3 4267 if linie>0 and linie<25
3 4268 and pos>0 and pos<81 then
3 4269 begin
4 4270 write(z,"esc" add 128,1,<:Æ:>,
4 4271 <<d>,linie,<:;:>,pos,<:H:>);
4 4272 end;
3 4273 end cursor;
2 4274 \f
2 4274 message procedure attention side 1 - 810529/hko;
2 4275
2 4275 procedure attention;
2 4276 begin
3 4277 integer i, j, k;
3 4278 integer array field op_ref,mess_ref;
3 4279 integer array att_message(1:9);
3 4280 long array field laf1, laf2;
3 4281 boolean optaget;
3 4282 procedure skriv_attention(zud,omfang);
3 4283 integer omfang;
3 4284 zone zud;
3 4285 begin
4 4286 write(zud,"nl",1,<:+++ attention :>);
4 4287 if omfang <> 0 then
4 4288 disable begin integer x;
5 4289 trap(slut);
5 4290 write(zud,"nl",1,
5 4291 <: i: :>,i,"nl",1,
5 4292 <: j: :>,j,"nl",1,
5 4293 <: k: :>,k,"nl",1,
5 4294 <: op-ref: :>,op_ref,"nl",1,
5 4295 <: mess-ref: :>,mess_ref,"nl",1,
5 4296 <: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
5 4297 <: laf2 :>,laf2,"nl",1,
5 4298 <: att-message::>,"nl",1,
5 4299 <::>);
5 4300 raf:= 0;
5 4301 skriv_hele(zud,att_message.raf,18,127);
5 4302 skriv_coru(zud,coru_no(010));
5 4303 slut:
5 4304 end;
4 4305 end skriv_attention;
3 4306
3 4306 integer procedure udtag_tal(tekst,pos);
3 4307 long array tekst;
3 4308 integer pos;
3 4309 begin
4 4310 integer i;
4 4311
4 4311 if getnumber(tekst,pos,i) >= 0 then
4 4312 udtag_tal:= i
4 4313 else
4 4314 udtag_tal:= 0;
4 4315 end;
3 4316
3 4316 for i:= 1 step 1 until att_maske_lgd//2 do
3 4317 att_signal(i):=att_flag(i):=0;
3 4318 trap(att_trap);
3 4319 stack_claim((if cm_test then 198 else 146)+50);
3 4320 <*+2*>
3 4321 if testbit26 and overvåget or testbit28 then
3 4322 skriv_attention(out,0);
3 4323 <*-2*>
3 4324 \f
3 4324 message procedure attention side 2 - 810406/hko;
3 4325
3 4325 repeat
3 4326
3 4326 wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
3 4327
3 4327 repeat
3 4328 <*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
3 4329 raf:= laf1:= 0;
3 4330 laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
3 4331
3 4331 <*+2*>if testbit7 and overvåget then
3 4332 disable begin
4 4333 laf2:= abs(laf);
4 4334 write(out,"nl",1,<:attention - :>);
4 4335 if laf<=0 then write(out,<:Regrettet :>);
4 4336 write(out,<:Message modtaget fra :>);
4 4337 if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
4 4338 skriv_hele(out,att_message.raf,16,127);
4 4339 ud;
4 4340 end;
3 4341 <*-2*>
3 4342 \f
3 4342 message procedure attention side 3 - 830310/cl;
3 4343
3 4343 if laf <= 0 then
3 4344 i:= -1
3 4345 else
3 4346 if core.laf(1)=konsol_navn.laf1(1)
3 4347 and core.laf(2)=konsol_navn.laf1(2) then
3 4348 i:= 101
3 4349 else
3 4350 begin
4 4351 i:= -1; j:= 1;
4 4352 while i=(-1) and (j <= max_antal_operatører) do
4 4353 begin
5 4354 laf2:= (j-1)*8;
5 4355 if core.laf(1) = terminal_navn.laf2(1)
5 4356 and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
5 4357 j:= j+1;
5 4358 end;
4 4359 j:= 1;
4 4360 while i=(-1) and (j<=max_antal_garageterminaler) do
4 4361 begin
5 4362 laf2:= (j-1)*8;
5 4363 if core.laf(1) = garage_terminal_navn.laf2(1)
5 4364 and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
5 4365 j:= j+1;
5 4366 end;
4 4367 end;
3 4368
3 4368 if i=101 or (201<=i and i<=200+max_antal_operatører)
3 4369 <* or (301<=i and i<=300+max_antal_garageterminaler) *>
3 4370 then
3 4371 begin
4 4372
4 4372 j:= if i=101 then 0
4 4373 else max_antal_operatører*(i//100-2)+i mod 100;
4 4374
4 4374 ref:=j*terminal_beskr_længde;
4 4375 att_message(9):=
4 4376 if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
4 4377 else 4 <*disconnected*>;
4 4378 optaget:=læsbit_ia(att_flag,j);
4 4379 if optaget and att_message(9)=1 then
4 4380 sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
4 4381 else optaget:=optaget or att_message(9)<>1;
4 4382 if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
4 4383 begin <* att fra ekskluderet operatør - inkluder *>
5 4384 start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
5 4385 d.op_ref.data(1):= i mod 100;
5 4386 signalch(cs_rad,op_ref,gen_optype);
5 4387 waitch(cs_att_pulje,op_ref,true,-1);
5 4388 end;
4 4389 end
3 4390 else
3 4391 begin
4 4392 optaget:= true;
4 4393 att_message(9):= 2 <*rejected*>;
4 4394 end;
3 4395
3 4395 monitor(22)send_answer:(zdummy,mess_ref,att_message);
3 4396
3 4396 until -,optaget;
3 4397 \f
3 4397 message procedure attention side 4 - 810424/hko;
3 4398
3 4398 sætbit_ia(att_flag,j,1);
3 4399
3 4399 start_operation(op_ref,i,cs_att_pulje,0);
3 4400
3 4400 signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
3 4401
3 4401 until false;
3 4402
3 4402 att_trap:
3 4403
3 4403 skriv_attention(zbillede,1);
3 4404
3 4404
3 4404 end attention;
2 4405
2 4405 \f
2 4405 message io_erklæringer side 1 - 810421/hko;
2 4406
2 4406 integer
2 4407 cs_io,
2 4408 cs_io_komm,
2 4409 cs_io_fil,
2 4410 cs_io_spool,
2 4411 cs_io_medd,
2 4412 ss_io_spool_tomme,
2 4413 ss_io_spool_fulde,
2 4414 bs_zio_adgang,
2 4415 io_spool_fil,
2 4416 io_spool_postantal,
2 4417 io_spool_postlængde;
2 4418
2 4418 integer array field
2 4419 io_spool_post;
2 4420
2 4420 zone z_io(32,1,io_fejl);
2 4421
2 4421 procedure io_fejl(z,s,b);
2 4422 integer s,b;
2 4423 zone z;
2 4424 begin
3 4425 disable begin
4 4426 integer array iz(1:20);
4 4427 integer i,j,k;
4 4428 integer array field iaf;
4 4429 real array field raf;
4 4430 if s<>(1 shift 21 + 2) then
4 4431 begin
5 4432 getzone6(z,iz);
5 4433 raf:=2;
5 4434 iaf:=0;
5 4435 k:=1;
5 4436
5 4436 j:= terminal_tab.iaf.terminal_tilstand;
5 4437 if j shift(-21)<>6 then
5 4438 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
5 4439 1 shift 12 <*binært*> +1 <*fortsæt*>);
5 4440 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
5 4441 + terminal_tab.iaf.terminal_tilstand extract 21;
5 4442 end;
4 4443 z(1):=real <:<'?'><'?'><'em'>:>;
4 4444 b:=2;
4 4445 end; <*disable*>
3 4446 end io_fejl;
2 4447 \f
2 4447 message procedure skriv_auto_spring_medd side 1 - 820301/hko;
2 4448
2 4448 procedure skriv_auto_spring_medd(z,medd,tid);
2 4449 value tid;
2 4450 zone z;
2 4451 real tid;
2 4452 integer array medd;
2 4453 begin
3 4454 disable begin
4 4455 real t;
4 4456 integer kode,bus,linie,bogst,løb,dato,kl;
4 4457 long array indeks(1:1);
4 4458 kode:= medd(1);
4 4459 indeks(1):= extend medd(5) shift 24;
4 4460 if kode > 0 and kode < 10 then
4 4461 begin
5 4462 write(z,"nl",0,<:-<'>'>:>,case kode of(
5 4463 <*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
5 4464 <*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
5 4465 <*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
5 4466 <*4*><:vogn optaget:>, <* - i - - / - *>
5 4467 <*5*><:spring annulleret:>, <*udløb af ventetid *>
5 4468 <*6*><::>, <* - af springliste *>
5 4469 <*7*><::>, <*start af springsekvens *>
5 4470 <*8*><::>, <*afvikling af springsekvens *>
5 4471 <*9*><:område kan ikke opdateres:>,<*vt-ændring*>
5 4472 <::>));
5 4473 <* if kode = 5 then
5 4474 begin
5 4475 bogst:= medd(4);
5 4476 linie:= bogst shift(-5) extract 10;
5 4477 bogst:= bogst extract 5;
5 4478 if bogst > 0 then bogst:= bogst +'A'-1;
5 4479 write(z,"sp",1,<<z>,linie,false add bogst,1,
5 4480 ".",1,indeks);
5 4481 end;
5 4482 *>
5 4483 outchar(z,'sp');
5 4484 bus:= medd(2) extract 14;
5 4485 if bus > 0 then
5 4486 write(z,<<z>,bus,"/",1);
5 4487 løb:= medd(3);
5 4488 <*+4*> if løb shift(-22) <> 1 and løb <> 0 then
5 4489 fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
5 4490 <*-4*>
5 4491 \f
5 4491 message procedure skriv_auto_spring_medd side 2 - 810507/hko;
5 4492
5 4492 linie:= løb shift(-12) extract 10;
5 4493 bogst:= løb shift(-7) extract 5;
5 4494 if bogst > 0 then bogst:= bogst +'A'-1;
5 4495 løb:= løb extract 7;
5 4496 if medd(3) <> 0 or kode <> 5 then
5 4497 begin
6 4498 write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
6 4499 if kode = 5 or kode = 6 then write(z,<:er frit :>);
6 4500 end;
5 4501 if kode = 7 or kode = 8 then
5 4502 write(z,<*indeks,"sp",1,*>
5 4503 if kode=7 then <:udtaget :> else <:indsat :>);
5 4504
5 4504 dato:= systime(4,tid,t);
5 4505 kl:= t/100.0;
5 4506 løb:= replace_char(1<*space in number*>,'.');
5 4507 write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
5 4508 replace_char(1,løb);
5 4509 end
4 4510 else <*kode < 1 or kode > 8*>
4 4511 fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
4 4512 end; <*disable*>
3 4513 end skriv_auto_spring_medd;
2 4514 \f
2 4514 message procedure h_io side 1 - 810507/hko;
2 4515
2 4515 <* hovedmodulkorutine for io *>
2 4516 procedure h_io;
2 4517 begin
3 4518 integer array field op_ref;
3 4519 integer k,dest_sem;
3 4520 procedure skriv_hio(zud,omfang);
3 4521 value omfang;
3 4522 zone zud;
3 4523 integer omfang;
3 4524 begin
4 4525
4 4525 write(zud,"nl",1,<:+++ hovedmodul io :>);
4 4526 if omfang>0 then
4 4527 disable begin integer x;
5 4528 trap(slut);
5 4529 write(zud,"nl",1,
5 4530 <: op_ref: :>,op_ref,"nl",1,
5 4531 <: k: :>,k,"nl",1,
5 4532 <: dest_sem: :>,dest_sem,"nl",1,
5 4533 <::>);
5 4534 skriv_coru(zud,coru_no(100));
5 4535 slut:
5 4536 end;
4 4537 end skriv_hio;
3 4538
3 4538 trap(hio_trap);
3 4539 stack_claim(if cm_test then 198 else 146);
3 4540
3 4540 <*+2*>
3 4541 if testbit0 and overvåget or testbit28 then
3 4542 skriv_hio(out,0);
3 4543 <*-2*>
3 4544 \f
3 4544 message procedure h_io side 2 - 810507/hko;
3 4545
3 4545 repeat
3 4546 wait_ch(cs_io,op_ref,true,-1);
3 4547 <*+4*>
3 4548 if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
3 4549 then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
3 4550 <*-4*>
3 4551
3 4551 k:=d.op_ref.opkode extract 12;
3 4552 dest_sem:=
3 4553 if k = 0 <*attention*> then cs_io_komm else
3 4554
3 4554 if k = 22 <*auto vt opdatering*>
3 4555 or k = 23 <*generel meddelelse*>
3 4556 or k = 36 <*spring meddelelse*>
3 4557 or k = 44 <*udeladt i gruppeopkald*>
3 4558 or k = 45 <*nødopkald modtaget*>
3 4559 or k = 46 <*nødopkald besvaret*> then cs_io_spool else
3 4560
3 4560 if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
3 4561 0;
3 4562 <*+4*>
3 4563 if dest_sem = 0 then
3 4564 begin
4 4565 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
4 4566 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 4567 end
3 4568 else
3 4569 <*-4*>
3 4570 begin
4 4571 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 4572 end;
3 4573 until false;
3 4574
3 4574 hio_trap:
3 4575 disable skriv_hio(zbillede,1);
3 4576 end h_io;
2 4577 \f
2 4577 message procedure io_komm side 1 - 810507/hko;
2 4578
2 4578 procedure io_komm;
2 4579 begin
3 4580 integer array field op_ref,ref,vt_op,iaf;
3 4581 integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
3 4582 pos,indeks,sep,sluttegn,operatør,i,j,k;
3 4583 long navn;
3 4584
3 4584 procedure skriv_io_komm(zud,omfang);
3 4585 value omfang;
3 4586 zone zud;
3 4587 integer omfang;
3 4588 begin
4 4589
4 4589 disable
4 4590
4 4590 write(zud,"nl",1,<:+++ io_komm :>);
4 4591 if omfang > 0 then
4 4592 disable begin integer x;
5 4593 trap(slut);
5 4594 write(zud,"nl",1,
5 4595 <: op-ref: :>,op_ref,"nl",1,
5 4596 <: kode: :>,kode,"nl",1,
5 4597 <: aktion: :>,aktion,"nl",1,
5 4598 <: ref: :>,ref,"nl",1,
5 4599 <: vt_op: :>,vt_op,"nl",1,
5 4600 <: status: :>,status,"nl",1,
5 4601 <: opgave: :>,opgave,"nl",1,
5 4602 <: dest-sem: :>,dest_sem,"nl",1,
5 4603 <: iaf: :>,iaf,"nl",1,
5 4604 <: i: :>,i,"nl",1,
5 4605 <: j: :>,j,"nl",1,
5 4606 <: k: :>,k,"nl",1,
5 4607 <: navn: :>,string navn,"nl",1,
5 4608 <: pos: :>,pos,"nl",1,
5 4609 <: indeks: :>,indeks,"nl",1,
5 4610 <: sep: :>,sep,"nl",1,
5 4611 <: sluttegn: :>,sluttegn,"nl",1,
5 4612 <: vogn: :>,vogn,"nl",1,
5 4613 <: ll: :>,ll,"nl",1,
5 4614 <: omr: :>,omr,"nl",1,
5 4615 <: operatør: :>,operatør,"nl",1,
5 4616 <::>);
5 4617 skriv_coru(zud,coru_no(101));
5 4618 slut:
5 4619 end;
4 4620 end skriv_io_komm;
3 4621 \f
3 4621 message procedure io_komm side 2 - 810424/hko;
3 4622
3 4622 trap(io_komm_trap);
3 4623 stack_claim((if cm_test then 200 else 146)+24+200);
3 4624
3 4624 ref:=0;
3 4625 navn:= long<::>;
3 4626
3 4626 <*+2*>
3 4627 if testbit0 and overvåget or testbit28 then
3 4628 skriv_io_komm(out,0);
3 4629 <*-2*>
3 4630
3 4630 repeat
3 4631
3 4631 <*V*> wait_ch(cs_io_komm,
3 4632 op_ref,
3 4633 true,
3 4634 -1<*timeout*>);
3 4635 <*+2*>
3 4636 if testbit1 and overvåget then
3 4637 disable begin
4 4638 skriv_io_komm(out,0);
4 4639 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
4 4640 <: til io :>);
4 4641 skriv_op(out,op_ref);
4 4642 end;
3 4643 <*-2*>
3 4644
3 4644 kode:= d.op_ref.op_kode;
3 4645 i:= terminal_tab.ref.terminal_tilstand;
3 4646 status:= i shift(-21);
3 4647 opgave:=
3 4648 if kode=0 then 1 <* indlæs kommando *> else
3 4649 0; <* afvises *>
3 4650
3 4650 aktion:= if opgave = 0 then 0 else
3 4651 (case status +1 of(
3 4652 <* status *>
3 4653 <* 0 klar *>(1),
3 4654 <* 1 - *>(-1),<* ulovlig tilstand *>
3 4655 <* 2 - *>(-1),<* ulovlig tilstand *>
3 4656 <* 3 stoppet *>(2),
3 4657 <* 4 noneksist *>(-1),<* ulovlig tilstand *>
3 4658 <* 5 - *>(-1),<* ulovlig tilstand *>
3 4659 <* 6 - *>(-1),<* ulovlig tilstand *>
3 4660 <* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
3 4661 -1));
3 4662 \f
3 4662 message procedure io_komm side 3 - 810428/hko;
3 4663
3 4663 case aktion+6 of
3 4664 begin
4 4665 begin
5 4666 <*-5: terminal optaget *>
5 4667
5 4667 d.op_ref.resultat:= 16;
5 4668 afslut_operation(op_ref,-1);
5 4669 end;
4 4670
4 4670 begin
5 4671 <*-4: operation uden virkning *>
5 4672
5 4672 afslut_operation(op_ref,-1);
5 4673 end;
4 4674
4 4674 begin
5 4675 <*-3: ulovlig operationskode *>
5 4676
5 4676 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 4677 afslut_operation(op_ref,-1);
5 4678 end;
4 4679
4 4679 begin
5 4680 <*-2: ulovlig aktion *>
5 4681
5 4681 fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
5 4682 afslut_operation(op_ref,-1);
5 4683 end;
4 4684
4 4684 begin
5 4685 <*-1: ulovlig io_tilstand *>
5 4686
5 4686 fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
5 4687 afslut_operation(op_ref,-1);
5 4688 end;
4 4689
4 4689 begin
5 4690 <* 0: ikke implementeret *>
5 4691
5 4691 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 4692 afslut_operation(op_ref,-1);
5 4693 end;
4 4694
4 4694 begin
5 4695 \f
5 4695 message procedure io_komm side 4 - 851001/cl;
5 4696
5 4696 <* 1: indlæs kommando *>
5 4697 <*V*> wait(bs_zio_adgang);
5 4698
5 4698 <*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
5 4699
5 4699 if d.op_ref.resultat > 3 then
5 4700 begin
6 4701 <*V*> setposition(z_io,0,0);
6 4702 if sluttegn<>'nl' then outchar(z_io,'nl');
6 4703 skriv_kvittering(z_io,op_ref,pos,
6 4704 d.op_ref.resultat);
6 4705 end
5 4706 else if d.op_ref.resultat>0 then
5 4707 begin <*godkendt*>
6 4708 kode:=d.op_ref.opkode;
6 4709 i:= kode extract 12;
6 4710 j:= if kode < 5 or
6 4711 kode=7 or kode=8 or
6 4712 kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
6 4713 if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
6 4714 if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
6 4715 if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
6 4716 kode=20 or kode=24 then 4<*VO,F/VO,R*>else
6 4717 if kode =21 then 5 <*AU*> else
6 4718 if kode =25 then 6 <*GR,D*> else
6 4719 if kode =26 then 5 <*GR,S*> else
6 4720 if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
6 4721 if kode =30 then 10 <*SP,D*> else
6 4722 if kode =31 then 5 <*SP*> else
6 4723 if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
6 4724 if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
6 4725 if kode=71 then 11 <*FO,V*> else
6 4726 if kode =75 then 12 <*TÆ,V *>else
6 4727 if kode =76 then 12 <*TÆ,N *>else
6 4728 if kode =65 then 13 <*BE,N *>else
6 4729 if kode =66 then 14 <*BE,G *>else
6 4730 if kode =67 then 15 <*BE,V *>else
6 4731 if kode =68 then 16 <*ST,D *>else
6 4732 if kode =69 then 17 <*ST,V *>else
6 4733 if kode =36 then 18 <*AL *>else
6 4734 if kode =37 then 19 <*CC *>else
6 4735 if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
6 4736 if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
6 4737 0;
6 4738 if j > 0 then
6 4739 begin
7 4740 case j of
7 4741 begin
8 4742 begin
9 4743 \f
9 4743 message procedure io_komm side 5 - 810424/hko;
9 4744
9 4744 <* 1: inkluder/ekskluder ydre enhed *>
9 4745
9 4745 d.op_ref.retur:= cs_io_komm;
9 4746 if kode=1 then d.opref.opkode:=
9 4747 ia(2) shift 12 + d.opref.opkode extract 12;
9 4748 d.op_ref.data(1):= ia(1);
9 4749 signal_ch(if kode < 5 or kode>=72 then cs_rad
9 4750 else cs_gar,
9 4751 op_ref,gen_optype or io_optype);
9 4752 indeks:= op_ref;
9 4753 wait_ch(cs_io_komm,
9 4754 op_ref,
9 4755 true,
9 4756 -1<*timeout*>);
9 4757 <*+4*> if op_ref <> indeks then
9 4758 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4759 <*-4*>
9 4760 <*V*> setposition(z_io,0,0);
9 4761 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4762 skriv_kvittering(z_io,op_ref,-1,
9 4763 d.op_ref.resultat);
9 4764 end;
8 4765
8 4765 begin
9 4766 \f
9 4766 message procedure io_komm side 6 - 810501/hko;
9 4767
9 4767 <* 2: tid/attention,ja/attention,nej
9 4768 slut/slut med billede *>
9 4769
9 4769 case d.op_ref.opkode -79 of
9 4770 begin
10 4771
10 4771 <* 80: TI *> begin
11 4772 setposition(z_io,0,0);
11 4773 if sluttegn<>'nl' then outchar(z_io,'nl');
11 4774 if ia(1) <> 0 or ia(2) <> 0 then
11 4775 begin real field rf;
12 4776 rf:= 4;
12 4777 trap(forbudt);
12 4778 <*V*> setposition(z_io,0,0);
12 4779 systime(3,ia.rf,0.0);
12 4780 if false then
12 4781 begin
13 4782 forbudt: skriv_kvittering(z_io,0,-1,
13 4783 43<*ændring af dato/tid ikke lovlig*>);
13 4784 end
12 4785 else
12 4786 skriv_kvittering(z_io,0,-1,3);
12 4787 end
11 4788 else
11 4789 begin
12 4790 setposition(z_io,0,0);
12 4791 write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
12 4792 end;
11 4793 end TI;
10 4794 \f
10 4794 message procedure io_komm side 7 - 810424/hko;
10 4795
10 4795 <*81: AT,J*> begin
11 4796 <*V*> setposition(z_io,0,0);
11 4797 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4798 monitor(10)release process:(z_io,0,ia);
11 4799 skriv_kvittering(z_io,0,-1,3);
11 4800 end;
10 4801
10 4801 <* 82: AT,N*> begin
11 4802 i:= monitor(8)reserve process:(z_io,0,ia);
11 4803 <*V*> setposition(z_io,0,0);
11 4804 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4805 skriv_kvittering(z_io,0,-1,
11 4806 if i = 0 then 3 else 0);
11 4807 end;
10 4808
10 4808 <* 83: SL *> begin
11 4809 errorbits:=0; <* warning.no ok.yes *>
11 4810 trapmode:= 1 shift 13;
11 4811 trap(-2);
11 4812 end;
10 4813
10 4813 <* 84: SL,B *>begin
11 4814 errorbits:=1; <* warning.no ok.no *>
11 4815 trap(-3);
11 4816 end;
10 4817 <* 85: SL,K *>begin
11 4818 errorbits:=1; <* warning.no ok.no *>
11 4819 disable sæt_bit_i(trapmode,15,0);
11 4820 trap(-3);
11 4821 end;
10 4822 \f
10 4822 message procedure io_komm side 7a - 810511/cl;
10 4823
10 4823 <* 86: TE,J *>begin
11 4824 setposition(z_io,0,0);
11 4825 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4826 for i:= 1 step 1 until indeks do
11 4827 if 0<=ia(i) and ia(i)<=47 then
11 4828 begin
12 4829 case (ia(i)+1) of
12 4830 begin
13 4831 testbit0 := true;testbit1 := true;testbit2 := true;
13 4832 testbit3 := true;testbit4 := true;testbit5 := true;
13 4833 testbit6 := true;testbit7 := true;testbit8 := true;
13 4834 testbit9 := true;testbit10:= true;testbit11:= true;
13 4835 testbit12:= true;testbit13:= true;testbit14:= true;
13 4836 testbit15:= true;testbit16:= true;testbit17:= true;
13 4837 testbit18:= true;testbit19:= true;testbit20:= true;
13 4838 testbit21:= true;testbit22:= true;testbit23:= true;
13 4839 testbit24:= true;testbit25:= true;testbit26:= true;
13 4840 testbit27:= true;testbit28:= true;testbit29:= true;
13 4841 testbit30:= true;testbit31:= true;testbit32:= true;
13 4842 testbit33:= true;testbit34:= true;testbit35:= true;
13 4843 testbit36:= true;testbit37:= true;testbit38:= true;
13 4844 testbit39:= true;testbit40:= true;testbit41:= true;
13 4845 testbit42:= true;testbit43:= true;testbit44:= true;
13 4846 testbit45:= true;testbit46:= true;testbit47:= true;
13 4847 end;
12 4848 end;
11 4849 skriv_kvittering(z_io,0,-1,3);
11 4850 end;
10 4851 \f
10 4851 message procedure io_komm side 7b - 810511/cl;
10 4852
10 4852 <* 87: TE,N *>begin
11 4853 setposition(z_io,0,0);
11 4854 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4855 for i:= 1 step 1 until indeks do
11 4856 if 0<=ia(i) and ia(i)<=47 then
11 4857 begin
12 4858 case (ia(i)+1) of
12 4859 begin
13 4860 testbit0 := false;testbit1 := false;testbit2 := false;
13 4861 testbit3 := false;testbit4 := false;testbit5 := false;
13 4862 testbit6 := false;testbit7 := false;testbit8 := false;
13 4863 testbit9 := false;testbit10:= false;testbit11:= false;
13 4864 testbit12:= false;testbit13:= false;testbit14:= false;
13 4865 testbit15:= false;testbit16:= false;testbit17:= false;
13 4866 testbit18:= false;testbit19:= false;testbit20:= false;
13 4867 testbit21:= false;testbit22:= false;testbit23:= false;
13 4868 testbit24:= false;testbit25:= false;testbit26:= false;
13 4869 testbit27:= false;testbit28:= false;testbit29:= false;
13 4870 testbit30:= false;testbit31:= false;testbit32:= false;
13 4871 testbit33:= false;testbit34:= false;testbit35:= false;
13 4872 testbit36:= false;testbit37:= false;testbit38:= false;
13 4873 testbit39:= false;testbit40:= false;testbit41:= false;
13 4874 testbit42:= false;testbit43:= false;testbit44:= false;
13 4875 testbit45:= false;testbit46:= false;testbit47:= false;
13 4876 end;
12 4877 end;
11 4878 skriv_kvittering(z_io,0,-1,3);
11 4879 end;
10 4880
10 4880 <* 88: O *> begin
11 4881 integer array odescr,zdescr(1:20);
11 4882 long array field laf;
11 4883 integer res, i, j;
11 4884
11 4884 i:= j:= 1;
11 4885 while læstegn(ia,i,res)<>0 do
11 4886 begin
12 4887 if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
12 4888 skrivtegn(ia,j,res);
12 4889 end;
11 4890
11 4890 laf:= 2;
11 4891 getzone6(out,odescr);
11 4892 getzone6(z_io,zdescr);
11 4893 close(out,zdescr.laf(1)<>odescr.laf(1) or
11 4894 zdescr.laf(2)<>odescr.laf(2));
11 4895 laf:= 0;
11 4896
11 4896 if ia(1)=0 then
11 4897 begin
12 4898 res:= 3;
12 4899 j:= 0;
12 4900 end
11 4901 else
11 4902 begin
12 4903 j:= res:= openbs(out,j,ia,0);
12 4904 if res<>0 then
12 4905 res:= 46;
12 4906 end;
11 4907 if res<>0 then
11 4908 begin
12 4909 open(out,8,konsol_navn,0);
12 4910 if j<>0 then
12 4911 begin
13 4912 i:= 1;
13 4913 fejlreaktion(4,j,string ia.laf(increase(i)),1);
13 4914 end;
12 4915 end
11 4916 else res:= 3;
11 4917 setposition(z_io,0,0);
11 4918 skriv_kvittering(z_io,0,-1,res);
11 4919 end;
10 4920 end;<*case d.op_ref.opkode -79*>
9 4921 end;<*case 2*>
8 4922 begin
9 4923 \f
9 4923 message procedure io_komm side 8 - 810424/hko;
9 4924
9 4924 <* 3: vogntabel,linienr/-,busnr*>
9 4925
9 4925 d.op_ref.retur:= cs_io_komm;
9 4926 tofrom(d.op_ref.data,ia,10);
9 4927 indeks:= op_ref;
9 4928 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 4929 wait_ch(cs_io_komm,
9 4930 op_ref,
9 4931 io_optype,
9 4932 -1<*timeout*>);
9 4933 <*+2*> if testbit2 and overvåget then
9 4934 disable begin
10 4935 skriv_io_komm(out,0);
10 4936 write(out,"nl",1,<:io operation retur fra vt:>);
10 4937 skriv_op(out,op_ref);
10 4938 end;
9 4939 <*-2*>
9 4940 <*+4*> if indeks <> op_ref then
9 4941 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4942 <*-4*>
9 4943
9 4943 i:=d.op_ref.resultat;
9 4944 if i<1 or i>3 then
9 4945 begin
10 4946 <*V*> setposition(z_io,0,0);
10 4947 if sluttegn<>'nl' then outchar(z_io,'nl');
10 4948 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 4949 end
9 4950 else
9 4951 begin
10 4952 \f
10 4952 message procedure io_komm side 9 - 820301/hko,cl;
10 4953
10 4953 integer antal,filref;
10 4954
10 4954 antal:= d.op_ref.data(6);
10 4955 fil_ref:= d.op_ref.data(7);
10 4956 pos:= 0;
10 4957 <*V*> setposition(zio,0,0);
10 4958 if sluttegn <> 'nl' then outchar(z_io,'nl');
10 4959 for pos:= pos +1 while pos <= antal do
10 4960 begin
11 4961 integer bogst,løb;
11 4962
11 4962 disable i:= læsfil(fil_ref,pos,j);
11 4963 if i <> 0 then
11 4964 fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
11 4965 vogn:= fil(j,1) shift (-24) extract 24;
11 4966 løb:= fil(j,1) extract 24;
11 4967 if d.op_ref.opkode=9 then
11 4968 begin i:=vogn; vogn:=løb; løb:=i; end;
11 4969 ll:= løb shift(-12) extract 10;
11 4970 bogst:= løb shift(-7) extract 5;
11 4971 if bogst > 0 then bogst:= bogst+'A'-1;
11 4972 løb:= løb extract 7;
11 4973 vogn:= vogn extract 14;
11 4974 i:= d.op_ref.opkode -8;
11 4975 for i:= i,i +1 do
11 4976 begin
12 4977 j:= (i+1) extract 1;
12 4978 case j+1 of
12 4979 begin
13 4980 write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 4981 false add bogst,1,"/",1,true,3,<<d>,løb);
13 4982 write(zio,<<dddd>,vogn,"sp",1);
13 4983 end;
12 4984 end;
11 4985 if pos mod 5 = 0 then
11 4986 begin
12 4987 outchar(zio,'nl');
12 4988 <*V*> setposition(zio,0,0);
12 4989 end
11 4990 else write(zio,"sp",3);
11 4991 end;
10 4992 write(zio,"*",1);
10 4993 \f
10 4993 message procedure io_komm side 9a - 810505/hko;
10 4994
10 4994 d.op_ref.opkode:=104;<*slet fil*>
10 4995 d.op_ref.data(4):=filref;
10 4996 indeks:=op_ref;
10 4997 signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
10 4998 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
10 4999
10 4999 <*+2*> if testbit2 and overvåget then
10 5000 disable begin
11 5001 skriv_io_komm(out,0);
11 5002 write(out,"nl",1,<:io operation retur fra sletfil:>);
11 5003 skriv_op(out,op_ref);
11 5004 end;
10 5005 <*-2*>
10 5006
10 5006 <*+4*> if op_ref<>indeks then
10 5007 fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
10 5008 <*-4*>
10 5009 if d.op_ref.data(9)<>0 then
10 5010 fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 5011 <:io-komm, sletfil:>,1);
10 5012 end;
9 5013 end;
8 5014
8 5014 begin
9 5015 \f
9 5015 message procedure io_komm side 10 - 820301/hko;
9 5016
9 5016 <* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
9 5017
9 5017 vogn:=ia(1);
9 5018 ll:=ia(2);
9 5019 omr:= if kode=11 or kode=19 then ia(3) else
9 5020 if kode=12 then ia(2) else 0;
9 5021 if kode=19 and omr<=0 then
9 5022 begin
10 5023 if omr=-1 then omr:= 0
10 5024 else omr:= 14 shift 20 + 3; <*OMR TCT*>
10 5025 end;
9 5026 <*V*> wait_ch(cs_vt_adgang,
9 5027 vt_op,
9 5028 gen_optype,
9 5029 -1<*timeout sek*>);
9 5030 start_operation(vtop,101,cs_io_komm,
9 5031 kode);
9 5032 d.vt_op.data(1):=vogn;
9 5033 d.vt_op.data(2):=ll;
9 5034 d.vt_op.data(if kode=19 then 3 else 4):= omr;
9 5035 indeks:= vt_op;
9 5036 signal_ch(cs_vt,
9 5037 vt_op,
9 5038 gen_optype or io_optype);
9 5039
9 5039 <*V*> wait_ch(cs_io_komm,
9 5040 vt_op,
9 5041 io_optype,
9 5042 -1<*timeout sek*>);
9 5043 <*+2*> if testbit2 and overvåget then
9 5044 disable begin
10 5045 skriv_io_komm(out,0);
10 5046 write(out,"nl",1,
10 5047 <:iooperation retur fra vt:>);
10 5048 skriv_op(out,vt_op);
10 5049 end;
9 5050 <*-2*>
9 5051 <*+4*> if vt_op<>indeks then
9 5052 fejl_reaktion(11<*fremmede op*>,op_ref,
9 5053 <:io-kommando:>,0);
9 5054 <*-4*>
9 5055 <*V*> setposition(z_io,0,0);
9 5056 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5057 skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
9 5058 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 5059 else vt_op,-1,d.vt_op.resultat);
9 5060 d.vt_op.optype:= genoptype or vt_optype;
9 5061 disable afslut_operation(vt_op,cs_vt_adgang);
9 5062 end;
8 5063
8 5063 begin
9 5064 \f
9 5064 message procedure io_komm side 11 - 810428/hko;
9 5065
9 5065 <* 5 autofil-skift
9 5066 gruppe,slet
9 5067 spring (igangsæt)
9 5068 spring,annuler
9 5069 spring,reserve *>
9 5070
9 5070 tofrom(d.op_ref.data,ia,8);
9 5071 d.op_ref.retur:=cs_io_komm;
9 5072 indeks:=op_ref;
9 5073 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5074 <*V*> wait_ch(cs_io_komm,
9 5075 op_ref,
9 5076 io_optype,
9 5077 -1<*timeout*>);
9 5078 <*+2*> if testbit2 and overvåget then
9 5079 disable begin
10 5080 skriv_io_komm(out,0);
10 5081 write(out,"nl",1,<:io operation retur fra vt:>);
10 5082 skriv_op(out,op_ref);
10 5083 end;
9 5084 <*-2*>
9 5085 <*+4*> if indeks<>op_ref then
9 5086 fejlreaktion(11<*fremmed post*>,op_ref,
9 5087 <:io-kommando(autofil):>,0);
9 5088 <*-4*>
9 5089
9 5089 <*V*> setposition(z_io,0,0);
9 5090 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5091 skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
9 5092 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 5093 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 5094 end;
8 5095
8 5095 begin
9 5096 \f
9 5096 message procedure io_komm side 12 - 820301/hko/cl;
9 5097
9 5097 <* 6 gruppedefinition *>
9 5098
9 5098 tofrom(d.op_ref.data,ia,indeks*2);
9 5099 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5100 start_operation(vt_op,101,cs_io_komm,
9 5101 101<*opret fil*>);
9 5102 d.vt_op.data(1):=256;<*postantal*>
9 5103 d.vt_op.data(2):=1; <*postlængde*>
9 5104 d.vt_op.data(3):=1; <*segmentantal*>
9 5105 d.vt_op.data(4):=
9 5106 2 shift 10; <*spool fil*>
9 5107 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5108 pos:=vt_op;<*variabel lånes*>
9 5109 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5110 <*+4*> if vt_op<>pos then
9 5111 fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
9 5112 if d.vt_op.data(9)<>0 then
9 5113 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5114 <:io-kommando(gruppedefinition):>,0);
9 5115 <*-4*>
9 5116 iaf:=0;
9 5117 for i:=1 step 1 until indeks-1 do
9 5118 begin
10 5119 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5120 if k<>0 then
10 5121 fejlreaktion(7<*modif-fil*>,k,
10 5122 <:io kommando(gruppe-def):>,0);
10 5123 fil(j).iaf(1):=d.op_ref.data(i+1);
10 5124 end;
9 5125 while sep = ',' do
9 5126 begin
10 5127 wait(bs_fortsæt_adgang);
10 5128 pos:= 1; j:= 0;
10 5129 while læs_store(z_io,i) < 8 do
10 5130 begin
11 5131 skrivtegn(fortsæt,pos,i);
11 5132 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5133 end;
10 5134 skrivtegn(fortsæt,pos,'em');
10 5135 afsluttext(fortsæt,pos);
10 5136 sluttegn:= i;
10 5137 if j<>0 then
10 5138 begin
11 5139 setposition(z_io,0,0);
11 5140 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5141 skriv_kvittering(zio,opref,-1,53);<*annulleret*>
11 5142 goto gr_ann;
11 5143 end;
10 5144 \f
10 5144 message procedure io_komm side 13 - 810512/hko/cl;
10 5145
10 5145 disable begin
11 5146 integer array værdi(1:4);
11 5147 integer a_pos,res;
11 5148 pos:= 0;
11 5149 repeat
11 5150 apos:= pos;
11 5151 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5152 if res >= 0 then
11 5153 begin
12 5154 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5155 else if res=0 then res:= -25 <*parameter mangler*>
12 5156 else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
12 5157 res:= -7 <*busnr ulovligt*>
12 5158 else if res=2 or res=6 then
12 5159 begin
13 5160 k:=modiffil(d.vt_op.data(4),indeks,j);
13 5161 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5162 <:io kommando(gruppe-def):>,0);
13 5163 iaf:= 0;
13 5164 fil(j).iaf(1):= værdi(1) +
13 5165 (if res=6 then 1 shift 22 else 0);
13 5166 indeks:= indeks+1;
13 5167 if sep = ',' then res:= 0;
13 5168 end
12 5169 else res:= -27; <*parametertype*>
12 5170 end;
11 5171 if res>0 then pos:= a_pos;
11 5172 until sep<>'sp' or res<=0;
11 5173
11 5173 if res<0 then
11 5174 begin
12 5175 d.op_ref.resultat:= -res;
12 5176 i:=1;
12 5177 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5178 afsluttext(d.op_ref.data,i);
12 5179 end;
11 5180 end;
10 5181 \f
10 5181 message procedure io_komm side 13a - 810512/hko/cl;
10 5182
10 5182 if d.op_ref.resultat > 3 then
10 5183 begin
11 5184 setposition(z_io,0,0);
11 5185 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5186 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5187 goto gr_ann;
11 5188 end;
10 5189 signalbin(bs_fortsæt_adgang);
10 5190 end while sep = ',';
9 5191 d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
9 5192 k:= sætfildim(d.vt_op.data);
9 5193 if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
9 5194 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5195 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5196 d.op_ref.retur:=cs_io_komm;
9 5197 pos:=op_ref;
9 5198 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5199 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5200 <*+4*> if pos<>op_ref then
9 5201 fejlreaktion(11<*fremmed post*>,op_ref,
9 5202 <:io kommando(gruppedef retur fra vt):>,0);
9 5203 <*-4*>
9 5204
9 5204 <*V*> setposition(z_io,0,0);
9 5205 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5206 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5207
9 5207 if false then
9 5208 begin
10 5209 gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5210 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5211 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5212 end;
9 5213
9 5213 end;
8 5214
8 5214 begin
9 5215 \f
9 5215 message procedure io_komm side 14 - 810525/hko/cl;
9 5216
9 5216 <* 7 gruppe(-oversigts-)rapport *>
9 5217
9 5217 d.op_ref.retur:=cs_io_komm;
9 5218 d.op_ref.data(1):=ia(1);
9 5219 indeks:=op_ref;
9 5220 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5221 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5222
9 5222 <*+4*> if op_ref<>indeks then
9 5223 fejlreaktion(11<*fremmed post*>,op_ref,
9 5224 <:io-kommando(gruppe-rapport):>,0);
9 5225 <*-4*>
9 5226
9 5226 <*V*> setposition(z_io,0,0);
9 5227 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5228 if d.op_ref.resultat<>3 then
9 5229 begin
10 5230 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5231 end
9 5232 else
9 5233 begin
10 5234 integer bogst,løb;
10 5235
10 5235 if kode = 27 then <* gruppe,vis *>
10 5236 begin
11 5237 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
11 5238 "G",1,<<z>,d.op_ref.data(1) extract 7,
11 5239 "sp",2,"-",5,"nl",1);
11 5240 \f
11 5240 message procedure io_komm side 15 - 820301/hko;
11 5241
11 5241 for pos:=1 step 1 until d.op_ref.data(2) do
11 5242 begin
12 5243 disable i:=læsfil(d.op_ref.data(3),pos,j);
12 5244 if i<>0 then
12 5245 fejlreaktion(5<*læsfil*>,i,
12 5246 <:io_kommando(gruppe,vis):>,0);
12 5247 iaf:=0;
12 5248 vogn:=fil(j).iaf(1);
12 5249 if vogn shift(-22) =0 then
12 5250 write(z_io,<<ddddddd>,vogn extract 14)
12 5251 else
12 5252 begin
13 5253 løb:=vogn extract 7;
13 5254 bogst:=vogn shift(-7) extract 5;
13 5255 if bogst>0 then bogst:=bogst+'A'-1;
13 5256 ll:=vogn shift(-12) extract 10;
13 5257 write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5258 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5259 end;
12 5260 if pos mod 8 =0 then outchar(z_io,'nl')
12 5261 else write(z_io,"sp",2);
12 5262 end;
11 5263 write(z_io,"*",1);
11 5264 \f
11 5264 message procedure io_komm side 16 - 810512/hko/cl;
11 5265
11 5265 end
10 5266 else if kode=28 then <* gruppe,oversigt *>
10 5267 begin
11 5268 write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
11 5269 "sp",2,"-",5,"nl",2);
11 5270 for pos:=1 step 1 until d.op_ref.data(1) do
11 5271 begin
12 5272 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5273 if i<>0 then
12 5274 fejlreaktion(5<*læsfil*>,i,
12 5275 <:io-kommando(gruppe-oversigt):>,0);
12 5276 iaf:=0;
12 5277 ll:=fil(j).iaf(1);
12 5278 write(z_io,"G",1,<<z>,true,3,ll extract 7);
12 5279 if pos mod 10 =0 then outchar(z_io,'nl')
12 5280 else write(z_io,"sp",3);
12 5281 end;
11 5282 write(z_io,"*",1);
11 5283 end;
10 5284 <* slet fil *>
10 5285 d.op_ref.opkode:= 104;
10 5286 d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
10 5287 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5288 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5289 end; <* resultat=3 *>
9 5290
9 5290 end;
8 5291
8 5291 begin
9 5292 \f
9 5292 message procedure io_komm side 17 - 810525/cl;
9 5293
9 5293 <* 8 spring(-oversigts-)rapport *>
9 5294
9 5294 d.op_ref.retur:=cs_io_komm;
9 5295 tofrom(d.op_ref.data,ia,4);
9 5296 indeks:=op_ref;
9 5297 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5298 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5299
9 5299 <*+4*> if op_ref<>indeks then
9 5300 fejlreaktion(11<*fremmed post*>,op_ref,
9 5301 <:io-kommando(spring-rapport):>,0);
9 5302 <*-4*>
9 5303
9 5303 <*V*> setposition(z_io,0,0);
9 5304 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5305 if d.op_ref.resultat<>3 then
9 5306 begin
10 5307 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5308 end
9 5309 else
9 5310 begin
10 5311 boolean p_skrevet;
10 5312 integer bogst,løb;
10 5313
10 5313 if kode = 32 then <* spring,vis *>
10 5314 begin
11 5315 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 5316 bogst:= d.op_ref.data(1) extract 5;
11 5317 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 5318 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
11 5319 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 5320 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 5321 raf:= data+8;
11 5322 if d.op_ref.raf(1)<>0.0 then
11 5323 write(z_io,<:, startet :>,<<zddddd>,round
11 5324 systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 5325 else
11 5326 write(z_io,<:, ikke startet:>);
11 5327 write(z_io,"sp",2,"-",5,"nl",1);
11 5328 \f
11 5328 message procedure io_komm side 18 - 810518/cl;
11 5329
11 5329 p_skrevet:= false;
11 5330 for pos:=1 step 1 until d.op_ref.data(3) do
11 5331 begin
12 5332 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 5333 if i<>0 then
12 5334 fejlreaktion(5<*læsfil*>,i,
12 5335 <:io_kommando(spring,vis):>,0);
12 5336 iaf:=0;
12 5337 i:= fil(j).iaf(1);
12 5338 if i < 0 and -, p_skrevet then
12 5339 begin
13 5340 outchar(z_io,'('); p_skrevet:= true;
13 5341 end;
12 5342 if i > 0 and p_skrevet then
12 5343 begin
13 5344 outchar(z_io,')'); p_skrevet:= false;
13 5345 end;
12 5346 if pos mod 2 = 0 then
12 5347 write(z_io,<< dd>,abs i,<:.:>)
12 5348 else
12 5349 write(z_io,true,3,<<d>,abs i);
12 5350 if pos mod 21 = 0 then outchar(z_io,'nl');
12 5351 end;
11 5352 write(z_io,"*",1);
11 5353 \f
11 5353 message procedure io_komm side 19 - 810525/cl;
11 5354
11 5354 end
10 5355 else if kode=33 then <* spring,oversigt *>
10 5356 begin
11 5357 write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
11 5358 "sp",2,"-",5,"nl",2);
11 5359 for pos:=1 step 1 until d.op_ref.data(1) do
11 5360 begin
12 5361 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5362 if i<>0 then
12 5363 fejlreaktion(5<*læsfil*>,i,
12 5364 <:io-kommando(spring-oversigt):>,0);
12 5365 iaf:=0;
12 5366 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 5367 bogst:=fil(j).iaf(1) extract 5;
12 5368 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 5369 write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 5370 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 5371 string (extend fil(j).iaf(2) shift 24));
12 5372 if fil(j,2)<>0.0 then
12 5373 write(z_io,<:startet :>,<<zddddd>,
12 5374 round systime(4,fil(j,2),r),<:.:>,round r);
12 5375 outchar(z_io,'nl');
12 5376 end;
11 5377 write(z_io,"*",1);
11 5378 end;
10 5379 <* slet fil *>
10 5380 d.op_ref.opkode:= 104;
10 5381 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 5382 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5383 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5384 end; <* resultat=3 *>
9 5385
9 5385 end;
8 5386
8 5386 begin
9 5387 \f
9 5387 message procedure io_komm side 20 - 820302/hko;
9 5388
9 5388 <* 9 fordeling af linier/områder på operatører *>
9 5389
9 5389 d.op_ref.retur:=cs_io_komm;
9 5390 disable
9 5391 if kode=5 then
9 5392 begin
10 5393 integer array io_linietabel(1:max_linienr//3+1);
10 5394
10 5394 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5395 begin
11 5396 i:= læs_fil(1035,ref//512+1,j);
11 5397 if i <> 0 then
11 5398 fejlreaktion(5,i,<:liniefordelingstabel:>,0);
11 5399 tofrom(io_linietabel.ref,fil(j),
11 5400 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
11 5401 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
11 5402 end;
10 5403 ref:=0;
10 5404 operatør:=ia(1);
10 5405 for j:=2 step 1 until indeks do
10 5406 begin
11 5407 ll:=ia(j);
11 5408 if ll<>0 then
11 5409 skrivtegn(io_linietabel,abs(ll)+1,
11 5410 if ll>0 then operatør else 0);
11 5411 end;
10 5412 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5413 begin
11 5414 i:= skriv_fil(1035,ref//512+1,j);
11 5415 if i <> 0 then
11 5416 fejlreaktion(6,i,<:liniefordelingstabel:>,0);
11 5417 tofrom(fil(j),io_linietabel.ref,
11 5418 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
11 5419 then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
11 5420 );
11 5421 end;
10 5422 ref:=0;
10 5423 end
9 5424 else
9 5425 begin
10 5426 modiffil(1034,1,i);
10 5427 ref:=0;
10 5428 operatør:=ia(1);
10 5429 for j:=2 step 1 until indeks do
10 5430 begin
11 5431 ll:=ia(j);
11 5432 fil(i).ref(ll):= if ll>0 then operatør else 0;
11 5433 end;
10 5434 end;
9 5435 indeks:=op_ref;
9 5436 signal_ch(cs_rad,op_ref,gen_optype or io_optype);
9 5437 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
9 5438
9 5438 <*+4*> if op_ref<>indeks then
9 5439 fejlreaktion(11<*fr.post*>,op_ref,
9 5440 <:io-komm,liniefordeling retur fra rad:>,0);
9 5441 <*-4*>
9 5442
9 5442 <*V*> setposition(z_io,0,0);
9 5443 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5444 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5445
9 5445 end;
8 5446
8 5446 begin
9 5447 \f
9 5447 message procedure io_komm side 21 - 820301/cl;
9 5448
9 5448 <* 10 springdefinition *>
9 5449
9 5449 tofrom(d.op_ref.data,ia,indeks*2);
9 5450 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5451 start_operation(vt_op,101,cs_io_komm,
9 5452 101<*opret fil*>);
9 5453 d.vt_op.data(1):=128;<*postantal*>
9 5454 d.vt_op.data(2):=2; <*postlængde*>
9 5455 d.vt_op.data(3):=1; <*segmentantal*>
9 5456 d.vt_op.data(4):=
9 5457 2 shift 10; <*spool fil*>
9 5458 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5459 pos:=vt_op;<*variabel lånes*>
9 5460 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5461 <*+4*> if vt_op<>pos then
9 5462 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 5463 if d.vt_op.data(9)<>0 then
9 5464 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5465 <:io-kommando(springdefinition):>,0);
9 5466 <*-4*>
9 5467 iaf:=0;
9 5468 for i:=1 step 1 until indeks-2 do
9 5469 begin
10 5470 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5471 if k<>0 then
10 5472 fejlreaktion(7<*modif-fil*>,k,
10 5473 <:io kommando(spring-def):>,0);
10 5474 fil(j).iaf(1):=d.op_ref.data(i+2);
10 5475 end;
9 5476 while sep = ',' do
9 5477 begin
10 5478 wait(bs_fortsæt_adgang);
10 5479 pos:= 1; j:= 0;
10 5480 while læs_store(z_io,i) < 8 do
10 5481 begin
11 5482 skrivtegn(fortsæt,pos,i);
11 5483 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5484 end;
10 5485 skrivtegn(fortsæt,pos,'em');
10 5486 afsluttext(fortsæt,pos);
10 5487 sluttegn:= i;
10 5488 if j<>0 then
10 5489 begin
11 5490 setposition(z_io,0,0);
11 5491 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5492 skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
11 5493 goto sp_ann;
11 5494 end;
10 5495 \f
10 5495 message procedure io_komm side 22 - 810519/cl;
10 5496
10 5496 disable begin
11 5497 integer array værdi(1:4);
11 5498 integer a_pos,res;
11 5499 pos:= 0;
11 5500 repeat
11 5501 apos:= pos;
11 5502 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5503 if res >= 0 then
11 5504 begin
12 5505 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5506 else if res=0 then res:= -25 <*parameter mangler*>
12 5507 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 5508 res:= -44 <*intervalstørrelse ulovlig*>
12 5509 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 5510 res:= -6 <*løbnr ulovligt*>
12 5511 else if res=10 then
12 5512 begin
13 5513 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 5514 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5515 <:io kommando(spring-def):>,0);
13 5516 iaf:= 0;
13 5517 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 5518 indeks:= indeks+1;
13 5519 if sep = ',' then res:= 0;
13 5520 end
12 5521 else res:= -27; <*parametertype*>
12 5522 end;
11 5523 if res>0 then pos:= a_pos;
11 5524 until sep<>'sp' or res<=0;
11 5525
11 5525 if res<0 then
11 5526 begin
12 5527 d.op_ref.resultat:= -res;
12 5528 i:=1;
12 5529 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5530 afsluttext(d.op_ref.data,i);
12 5531 end;
11 5532 end;
10 5533 \f
10 5533 message procedure io_komm side 23 - 810519/cl;
10 5534
10 5534 if d.op_ref.resultat > 3 then
10 5535 begin
11 5536 setposition(z_io,0,0);
11 5537 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5538 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5539 goto sp_ann;
11 5540 end;
10 5541 signalbin(bs_fortsæt_adgang);
10 5542 end while sep = ',';
9 5543 d.vt_op.data(1):= indeks-2;
9 5544 k:= sætfildim(d.vt_op.data);
9 5545 if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
9 5546 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5547 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5548 d.op_ref.retur:=cs_io_komm;
9 5549 pos:=op_ref;
9 5550 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5551 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5552 <*+4*> if pos<>op_ref then
9 5553 fejlreaktion(11<*fremmed post*>,op_ref,
9 5554 <:io kommando(springdef retur fra vt):>,0);
9 5555 <*-4*>
9 5556
9 5556 <*V*> setposition(z_io,0,0);
9 5557 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5558 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5559
9 5559 if false then
9 5560 begin
10 5561 sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5562 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5563 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5564 signalbin(bs_fortsæt_adgang);
10 5565 end;
9 5566
9 5566 end;
8 5567 begin
9 5568 integer i,j,k,opr,lin,max_lin;
9 5569 boolean o_ud, t_ud;
9 5570 \f
9 5570 message procedure io_komm side 23a - 820301/cl;
9 5571
9 5571 <* 11 fordelingsrapport *>
9 5572
9 5572 <*V*> setposition(z_io,0,0);
9 5573 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5574
9 5574 max_lin:= max_linienr;
9 5575 for opr:= 1 step 1 until max_antal_operatører, 0 do
9 5576 begin
10 5577 o_ud:= t_ud:= false;
10 5578 k:= 0;
10 5579
10 5579 if opr<>0 then
10 5580 begin
11 5581 j:= k:= 0;
11 5582 for lin:= 1 step 1 until max_lin do
11 5583 begin
12 5584 læs_tegn(radio_linietabel,lin+1,i);
12 5585 if i<>0 then j:= lin;
12 5586 if opr=i and opr<>0 then
12 5587 begin
13 5588 if -, o_ud then
13 5589 begin
14 5590 o_ud:= true;
14 5591 if opr<>0 then
14 5592 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
14 5593 "sp",2,string bpl_navn(opr))
14 5594 else
14 5595 write(z_io,"nl",1,<:ikke fordelte:>);
14 5596 end;
13 5597 if -, t_ud then
13 5598 begin
14 5599 write(z_io,<:<'nl'> linier: :>);
14 5600 t_ud:= true;
14 5601 end;
13 5602 k:=k+1;
13 5603 if k>1 and k mod 10 = 1 then
13 5604 write(z_io,"nl",1,"sp",13);
13 5605 write(z_io,<<ddd >,lin);
13 5606 end;
12 5607 if lin=max_lin then max_lin:= j;
12 5608 end;
11 5609 end;
10 5610
10 5610 k:= 0; t_ud:= false;
10 5611 for i:= 1 step 1 until max_antal_områder do
10 5612 begin
11 5613 if radio_områdetabel(i)= opr then
11 5614 begin
12 5615 if -, o_ud then
12 5616 begin
13 5617 o_ud:= true;
13 5618 if opr<>0 then
13 5619 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
13 5620 "sp",2,string bpl_navn(opr))
13 5621 else
13 5622 write(z_io,"nl",1,<:ikke fordelte:>);
13 5623 end;
12 5624 if -, t_ud then
12 5625 begin
13 5626 write(z_io,<:<'nl'> områder: :>);
13 5627 t_ud:= true;
13 5628 end;
12 5629 k:= k+1;
12 5630 if k>1 and k mod 10 = 1 then
12 5631 write(z_io,"nl",1,"sp",13);
12 5632 write(z_io,true,4,string område_navn(i));
12 5633 end;
11 5634 end;
10 5635 if o_ud then write(z_io,"nl",1);
10 5636 end;
9 5637 write(z_io,"*",1);
9 5638 end;
8 5639
8 5639 begin
9 5640 integer omr,typ,sum;
9 5641 integer array ialt(1:8);
9 5642 real r;
9 5643 \f
9 5643 message procedure io_komm side 24 - 810501/hko;
9 5644
9 5644 <* 12 vis/nulstil opkaldstællere *>
9 5645
9 5645 setposition(z_io,0,0);
9 5646 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5647
9 5647 if kode=76 and indeks=1 then
9 5648 begin <* TÆ,N <tid> *>
10 5649 if ia(1)<(-1) or 2400<ia(1) then
10 5650 skriv_kvittering(z_io,opref,-1,64)
10 5651 else
10 5652 begin
11 5653 if ia(1)=(-1) then nulstil_systællere:= -1
11 5654 else nulstil_systællere:= (ia(1) mod 2400)*100;
11 5655 opdater_tf_systællere;
11 5656 skriv_kvittering(z_io,opref,-1,3);
11 5657 end;
10 5658 end
9 5659 else
9 5660 begin
10 5661 for typ:= 1 step 1 until 8 do ialt(typ):= 0;
10 5662
10 5662 write(z_io,
10 5663 <:område udgående alm. ind nød ind:>,
10 5664 <: ind ialt total ej forb. optaget:>,"nl",1);
10 5665 for omr := 1 step 1 until max_antal_områder do
10 5666 begin
11 5667 sum:= 0;
11 5668 write(z_io,true,6,string område_navn(omr),":",1);
11 5669 for typ:= 1 step 1 until 3 do
11 5670 begin
12 5671 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*8+typ));
12 5672 sum:= sum + opkalds_tællere((omr-1)*8+typ);
12 5673 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*8+typ);
12 5674 end;
11 5675 write(z_io,<< ddddddd>,
11 5676 sum-opkalds_tællere((omr-1)*8+1),sum,"sp",2);
11 5677 for typ:= 4 step 1 until 5 do
11 5678 begin
12 5679 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*8+typ));
12 5680 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*8+typ);
12 5681 end;
11 5682 write(z_io,"nl",1);
11 5683 end;
10 5684 sum:= 0;
10 5685 write(z_io,"nl",1,<:ialt ::>);
10 5686 for typ:= 1 step 1 until 3 do
10 5687 begin
11 5688 write(z_io,<< ddddddd>,ialt(typ));
11 5689 sum:= sum+ialt(typ);
11 5690 end;
10 5691 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5692 ialt(4), ialt(5), "nl",3);
10 5693
10 5693 for typ:= 1 step 1 until 8 do ialt(typ):= 0;
10 5694 write(z_io,
10 5695 <:oper. udgående alm. ind nød ind:>,
10 5696 <: ind ialt total:>,"nl",1);
10 5697 for omr := 1 step 1 until max_antal_operatører do
10 5698 begin
11 5699 sum:= 0;
11 5700 if bpl_navn(omr)=long<::> then
11 5701 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
11 5702 else
11 5703 write(z_io,true,6,string bpl_navn(omr),":",1);
11 5704 for typ:= 1 step 1 until 3 do
11 5705 begin
12 5706 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
12 5707 sum:= sum + operatør_tællere((omr-1)*4+typ);
12 5708 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*4+typ);
12 5709 end;
11 5710 write(z_io,<< ddddddd>,
11 5711 sum-operatør_tællere((omr-1)*4+1),sum,"sp",2);
11 5712 write(z_io,"nl",1);
11 5713 end;
10 5714 sum:= 0;
10 5715 write(z_io,"nl",1,<:ialt ::>);
10 5716 for typ:= 1 step 1 until 3 do
10 5717 begin
11 5718 write(z_io,<< ddddddd>,ialt(typ));
11 5719 sum:= sum+ialt(typ);
11 5720 end;
10 5721 write(z_io,<< ddddddd>,sum-ialt(1),sum,"nl",2);
10 5722
10 5722 typ:= replacechar(1,':');
10 5723 write(z_io,<:tællere nulstilles :>);
10 5724 if nulstil_systællere=(-1) then
10 5725 write(z_io,<:ikke automatisk:>,"nl",1)
10 5726 else
10 5727 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
10 5728 nulstil_systællere,"nl",1);
10 5729 replacechar(1,'.');
10 5730 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
10 5731 systime(4,systællere_nulstillet,r));
10 5732 replacechar(1,':');
10 5733 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
10 5734 replacechar(1,typ);
10 5735 write(z_io,"*",1,"nl",1);
10 5736 setposition(z_io,0,0);
10 5737
10 5737 if kode = 76 <* nulstil tællere *> then
10 5738 disable begin
11 5739 for omr:= 1 step 1 until max_antal_områder*8 do
11 5740 opkalds_tællere(omr):= 0;
11 5741 for omr:= 1 step 1 until max_antal_operatører*4 do
11 5742 operatør_tællere(omr):= 0;
11 5743 systime(1,0.0,systællere_nulstillet);
11 5744 opdater_tf_systællere;
11 5745 typ:= replacechar(1,'.');
11 5746 write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
11 5747 systime(4,systællere_nulstillet,r));
11 5748 replacechar(1,':');
11 5749 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
11 5750 replacechar(1,typ);
11 5751 setposition(z_io,0,0);
11 5752 end;
10 5753 end;
9 5754 end;
8 5755
8 5755 begin
9 5756 \f
9 5756 message procedure io_komm side 25 - 940522/cl;
9 5757
9 5757 <* 13 navngiv betjeningsplads *>
9 5758 boolean incl;
9 5759 long field lf;
9 5760
9 5760 lf:=6;
9 5761 operatør:= ia(1);
9 5762 navn:= ia.lf;
9 5763 incl:= false add (ia(4) extract 8);
9 5764
9 5764 if navn=long<::> then
9 5765 begin
10 5766 <* nedlæg navn - check for i brug *>
10 5767 iaf:= operatør*terminal_beskr_længde;
10 5768 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5769 d.opref.resultat:= 48 <*i brug*>
10 5770 else
10 5771 begin
11 5772 for i:= 65 step 1 until top_bpl_gruppe do
11 5773 begin
12 5774 iaf:= i*op_maske_lgd;
12 5775 if læsbit_ia(bpl_def.iaf,operatør) then
12 5776 d.opref.resultat:= 48<*i brug*>;
12 5777 end;
11 5778 end;
10 5779 if d.opref.resultat <= 3 then
10 5780 begin
11 5781 for i:= 1 step 1 until sidste_bus do
11 5782 if bustabel(i) shift (-14) extract 8 = operatør then
11 5783 d.opref.resultat:= 48<*i brug*>;
11 5784 end;
10 5785 end
9 5786 else
9 5787 begin
10 5788 <* opret/omdøb *>
10 5789 i:= find_bpl(navn);
10 5790 if i<>0 and i<>operatør then
10 5791 d.opref.resultat:= 48 <*i brug*>;
10 5792 end;
9 5793 if d.opref.resultat<=3 then
9 5794 begin
10 5795 bpl_navn(operatør):= navn;
10 5796 operatør_auto_include(operatør):= incl;
10 5797 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5798 if k<>0 then
10 5799 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5800 lf:= 4;
10 5801 fil(ll).lf:= navn add (incl extract 8);
10 5802 setposition(fil(ll),0,0);
10 5803
10 5803 <* skriv bplnavne *>
10 5804 disable begin
11 5805 zone z(128,1,stderror);
11 5806 long array field laf;
11 5807 integer array ia(1:10);
11 5808
11 5808 open(z,4,<:bplnavne:>,0);
11 5809 laf:= 0;
11 5810 outrec6(z,512);
11 5811 for i:= 1 step 1 until 127 do
11 5812 z.laf(i):= bpl_navn(i);
11 5813 close(z,true);
11 5814 monitor(42,z,0,ia);
11 5815 ia(6):= systime(7,0,0.0);
11 5816 monitor(44,z,0,ia);
11 5817 end;
10 5818 d.opref.resultat:= 3;<*udført*>
10 5819 end;
9 5820
9 5820 setposition(z_io,0,0);
9 5821 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5822 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5823 end;
8 5824
8 5824 begin
9 5825 \f
9 5825 message procedure io_komm side 26 - 940522/cl;
9 5826
9 5826 <* 14 betjeningsplads - gruppe *>
9 5827 integer ant_i_gruppe;
9 5828 long field lf;
9 5829 integer array maske(1:op_maske_lgd//2);
9 5830
9 5830 lf:= 4; ant_i_gruppe:= 0;
9 5831 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5832 navn:= ia.lf;
9 5833 operatør:= find_bpl(navn);
9 5834 for i:= 3 step 1 until indeks do
9 5835 if sætbit_ia(maske,ia(i),1)=0 then
9 5836 ant_i_gruppe:= ant_i_gruppe+1;
9 5837 if ant_i_gruppe=0 then
9 5838 begin
10 5839 <* slet gruppe *>
10 5840 if operatør<=64 then
10 5841 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5842 else 62<*navn ulovligt*>)
10 5843 else
10 5844 begin
11 5845 for i:= 1 step 1 until max_antal_operatører do
11 5846 for j:= 1 step 1 until 3 do
11 5847 if operatør_stop(i,j)=operatør then
11 5848 d.opref.resultat:= 48<*i brug*>;
11 5849 end;
10 5850 navn:= long<::>;
10 5851 end
9 5852 else
9 5853 begin
10 5854 if 1<=operatør and operatør<=64 then
10 5855 d.opref.resultat:= 62<*navn ulovligt*>
10 5856 else
10 5857 if operatør=0 then
10 5858 begin
11 5859 i:=65;
11 5860 while i<=127 and operatør=0 do
11 5861 begin
12 5862 if bpl_navn(i)=long<::> then operatør:=i;
12 5863 i:= i+1;
12 5864 end;
11 5865 if operatør=0 then
11 5866 d.opref.resultat:= 32<*ikke plads*>
11 5867 else if operatør>top_bpl_gruppe then
11 5868 top_bpl_gruppe:= operatør;
11 5869 end;
10 5870 end;
9 5871 if d.opref.resultat<=3 then
9 5872 begin
10 5873 bpl_navn(operatør):= navn;
10 5874 iaf:= operatør*op_maske_lgd;
10 5875 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5876 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5877 for i:= 1 step 1 until max_antal_operatører do
10 5878 begin
11 5879 if læsbit_ia(maske,i) then
11 5880 begin
12 5881 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5882 if læsbit_ia(operatør_maske,i) then
12 5883 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5884 end;
11 5885 end;
10 5886 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5887 if k<>0 then
10 5888 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5889 lf:= 4;
10 5890 fil(ll).lf:= navn;
10 5891 setposition(fil(ll),0,0);
10 5892 iaf:= 0;
10 5893 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5894 if k<>0 then
10 5895 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5896 for i:= 1 step 1 until op_maske_lgd//2 do
10 5897 fil(ll).iaf(i):= maske(i);
10 5898 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5899 setposition(fil(ll),0,0);
10 5900 d.opref.resultat:= 3;
10 5901 end;
9 5902
9 5902 setposition(z_io,0,0);
9 5903 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5904 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5905 end;
8 5906
8 5906 begin
9 5907 \f
9 5907 message procedure io_komm side 27 - 940522/cl;
9 5908
9 5908 <* 15 vis betjeningspladsdefinitioner *>
9 5909
9 5909 setposition(z_io,0,0);
9 5910 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5911 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5912 for i:= 1 step 1 until max_antal_operatører do
9 5913 begin
10 5914 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5915 case operatør_auto_include(i) extract 2 + 1 of(
10 5916 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5917 if i mod 4 = 0 then write(z_io,"nl",1)
10 5918 else write(z_io,"sp",5);
10 5919 end;
9 5920 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5921 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5922 for i:= 65 step 1 until top_bpl_gruppe do
9 5923 begin
10 5924 ll:=0; iaf:= i*op_maske_lgd;
10 5925 if bpl_navn(i)<>long<::> then
10 5926 begin
11 5927 write(z_io,true,6,string bpl_navn(i),":",1);
11 5928 for j:= 1 step 1 until max_antal_operatører do
11 5929 begin
12 5930 if læsbit_ia(bpl_def.iaf,j) then
12 5931 begin
13 5932 if ll mod 8 = 0 and ll<>0 then
13 5933 write(z_io,"nl",1,"sp",7);
13 5934 write(z_io,"sp",2,string bpl_navn(j));
13 5935 ll:=ll+1;
13 5936 end;
12 5937 end;
11 5938 write(z_io,"nl",1);
11 5939 end;
10 5940 end;
9 5941 write(z_io,"*",1);
9 5942 end;
8 5943
8 5943 begin
9 5944 \f
9 5944 message procedure io_komm side 28 - 940522/cl;
9 5945
9 5945 <* 16 stopniveau,definer *>
9 5946
9 5946 operatør:= ia(1);
9 5947 iaf:= operatør*terminal_beskr_længde;
9 5948 for i:= 1 step 1 until 3 do
9 5949 operatør_stop(operatør,i):= ia(i+1);
9 5950 if -,læsbit_ia(operatørmaske,operatør) then
9 5951 begin
10 5952 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5953 signal_bin(bs_mobilopkald);
10 5954 end;
9 5955 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5956 if k<>0 then
9 5957 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 5958 iaf:= 0;
9 5959 for i:= 0 step 1 until 3 do
9 5960 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 5961 setposition(fil(ll),0,0);
9 5962 setposition(z_io,0,0);
9 5963 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5964 skriv_kvittering(z_io,0,-1,3);
9 5965 end;
8 5966
8 5966 begin
9 5967 \f
9 5967 message procedure io_komm side 29 - 940522/cl;
9 5968
9 5968 <* 17 stopniveauer,vis *>
9 5969
9 5969 setposition(z_io,0,0);
9 5970 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5971
9 5971 for operatør:= 1 step 1 until max_antal_operatører do
9 5972 begin
10 5973 iaf:=operatør*terminal_beskr_længde;
10 5974 ll:=0;
10 5975 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 5976 string bpl_navn(operatør),<:(:>,
10 5977 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 5978 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 5979 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 5980 for i:= 1 step 1 until 3 do
10 5981 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 5982 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 5983 else string bpl_navn(operatør_stop(operatør,i)));
10 5984 if operatør mod 2 = 1 then
10 5985 write(z_io,"sp",40-ll)
10 5986 else
10 5987 write(z_io,"nl",1);
10 5988 end;
9 5989 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 5990 write(z_io,"*",1);
9 5991 end;
8 5992
8 5992 begin
9 5993 \f
9 5993 message procedure io_komm side 30 - 941007/cl;
9 5994
9 5994 <* 18 alarmlængder *>
9 5995
9 5995 setposition(z_io,0,0);
9 5996 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5997
9 5997 for operatør:= 1 step 1 until max_antal_operatører do
9 5998 begin
10 5999 ll:=0;
10 6000 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6001 string bpl_navn(operatør));
10 6002 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 6003 if opk_alarm.iaf.alarm_lgd < 0 then
10 6004 ll:= ll+write(z_io,<:uendelig:>)
10 6005 else
10 6006 ll:= ll+write(z_io,<<ddddddd>,
10 6007 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 6008
10 6008 if operatør mod 2 = 1 then
10 6009 write(z_io,"sp",40-ll)
10 6010 else
10 6011 write(z_io,"nl",1);
10 6012 end;
9 6013 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6014 write(z_io,"*",1);
9 6015 end;
8 6016
8 6016 begin
9 6017 <* 19 CC *>
9 6018 integer i, c;
9 6019
9 6019 i:= 1;
9 6020 while læstegn(ia,i+0,c)<>0 and
9 6021 i<(op_spool_postlgd-op_spool_text)//2*3
9 6022 do skrivtegn(d.opref.data,i,c);
9 6023 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 6024
9 6024 d.opref.retur:= cs_io_komm;
9 6025 signalch(cs_op,opref,io_optype or gen_optype);
9 6026 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 6027
9 6027 setposition(z_io,0,0);
9 6028 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6029 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 6030 end;
8 6031
8 6031 begin
9 6032 <* 20: CQF,I CQF,U CQF,V *>
9 6033 integer kode, res, i, j;
9 6034 integer array field iaf, iaf1;
9 6035 long field navn;
9 6036
9 6036 kode:= d.opref.opkode extract 12;
9 6037 navn:= 6; res:= 0;
9 6038 if kode=90 <*CQF,I*> then
9 6039 begin
10 6040 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 6041 res:= 10 <*busnr ukendt*>
10 6042 else
10 6043 begin
11 6044 j:= -1;
11 6045 for i:= 1 step 1 until max_cqf do
11 6046 begin
12 6047 iaf:= (i-1)*cqf_lgd;
12 6048 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 6049 ia.navn = cqf_tabel.iaf.cqf_id
12 6050 then res:= 48; <*i brug*>
12 6051 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 6052 end;
11 6053 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 6054 if res=0 then
11 6055 begin
12 6056 iaf:= (j-1)*cqf_lgd;
12 6057 cqf_tabel.iaf.cqf_bus:= ia(1);
12 6058 cqf_tabel.iaf.cqf_fejl:= 0;
12 6059 cqf_tabel.iaf.cqf_id:= ia.navn;
12 6060 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 6061 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 6062 res:= 3;
12 6063 end;
11 6064 end;
10 6065 setposition(z_io,0,0);
10 6066 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6067 skriv_kvittering(z_io,opref,-1,res);
10 6068 end
9 6069 else
9 6070 if kode=91 <*CQF,U*> then
9 6071 begin
10 6072 j:= -1;
10 6073 for i:= 1 step 1 until max_cqf do
10 6074 begin
11 6075 iaf:= (i-1)*cqf_lgd;
11 6076 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 6077 end;
10 6078 if j>=0 then
10 6079 begin
11 6080 iaf:= (j-1)*cqf_lgd;
11 6081 for i:= 1 step 1 until cqf_lgd//2 do
11 6082 cqf_tabel.iaf(i):= 0;
11 6083 res:= 3;
11 6084 end
10 6085 else res:= 13; <*bus ikke indsat*>
10 6086 setposition(z_io,0,0);
10 6087 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6088 skriv_kvittering(z_io,opref,-1,res);
10 6089 end
9 6090 else
9 6091 begin
10 6092 setposition(z_io,0,0);
10 6093 skriv_cqf_tabel(z_io,false);
10 6094 outchar(z_io,'*');
10 6095 setposition(z_io,0,0);
10 6096 end;
9 6097
9 6097 if kode=90 or kode=91 then
9 6098 begin
10 6099 j:= skrivfil(1033,1,i);
10 6100 if j<>0 then
10 6101 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 6102 for k:= 1 step 1 until max_cqf do
10 6103 begin
11 6104 iaf1:= (k-1)*cqf_lgd;
11 6105 iaf := (k-1)*cqf_id;
11 6106 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 6107 end;
10 6108 op_cqf_tab_ændret:= true;
10 6109 end;
9 6110 end;<*CQF*>
8 6111
8 6111
8 6111 begin
9 6112 \f
9 6112 message procedure io_komm side xx - 940522/cl;
9 6113
9 6113
9 6113
9 6113 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 6114 <*-3*>
9 6115 end
8 6116 end;<*case j *>
7 6117 end <* j > 0 *>
6 6118 else
6 6119 begin
7 6120 <*V*> setposition(z_io,0,0);
7 6121 if sluttegn<>'nl' then outchar(z_io,'nl');
7 6122 skriv_kvittering(z_io,op_ref,-1,
7 6123 45 <* ikke implementeret *>);
7 6124 end;
6 6125 end;<* godkendt *>
5 6126
5 6126 <*V*> setposition(z_io,0,0);
5 6127 signal_bin(bs_zio_adgang);
5 6128 d.op_ref.retur:=cs_att_pulje;
5 6129 disable afslut_kommando(op_ref);
5 6130 end; <* indlæs kommando *>
4 6131
4 6131 begin
5 6132 \f
5 6132 message procedure io_komm side xx+1 - 810428/hko;
5 6133
5 6133 <* 2: aktiver efter stop *>
5 6134 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 6135 terminal_tab.ref.terminal_tilstand extract 21;
5 6136 afslut_operation(op_ref,-1);
5 6137 signal_bin(bs_zio_adgang);
5 6138 end;
4 6139
4 6139 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6140 <*-3*>
4 6141 end; <* case aktion+6 *>
3 6142
3 6142 until false;
3 6143 io_komm_trap:
3 6144 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6145 alarmcause extract 24 = (-13)) then
3 6146 disable skriv_io_komm(zbillede,1);
3 6147 end io_komm;
2 6148 \f
2 6148 message procedure io_spool side 1 - 810507/hko;
2 6149
2 6149 procedure io_spool;
2 6150 begin
3 6151 integer
3 6152 næste_tomme,nr;
3 6153 integer array field
3 6154 op_ref;
3 6155
3 6155 procedure skriv_io_spool(zud,omfang);
3 6156 value omfang;
3 6157 zone zud;
3 6158 integer omfang;
3 6159 begin
4 6160 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6161 if omfang > 0 then
4 6162 disable begin integer x;
5 6163 trap(slut);
5 6164 write(zud,"nl",1,
5 6165 <: opref: :>,op_ref,"nl",1,
5 6166 <: næstetomme::>,næste_tomme,"nl",1,
5 6167 <: nr :>,nr,"nl",1,
5 6168 <::>);
5 6169 skriv_coru(zud,coru_no(102));
5 6170 slut:
5 6171 end;<*disable*>
4 6172 end skriv_io_spool;
3 6173
3 6173 trap(io_spool_trap);
3 6174 næste_tomme:= 1;
3 6175 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6176 <*+2*>
3 6177 if testbit0 and overvåget or testbit28 then
3 6178 skriv_io_spool(out,0);
3 6179 <*-2*>
3 6180 \f
3 6180 message procedure io_spool side 2 - 810602/hko;
3 6181
3 6181 repeat
3 6182
3 6182 wait_ch(cs_io_spool,
3 6183 op_ref,
3 6184 true,
3 6185 -1<*timeout*>);
3 6186
3 6186 i:= d.op_ref.opkode;
3 6187 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6188 begin
4 6189 wait(ss_io_spool_tomme);
4 6190 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6191 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6192
4 6192 i:= d.op_ref.opsize;
4 6193 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6194 begin
5 6195 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6196 i:= io_spool_postlængde*2 -io_spool_post;
5 6197 end;
4 6198 <*-4*>
4 6199 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6200 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6201 signal(ss_io_spool_fulde);
4 6202 d.op_ref.resultat:= 1;
4 6203 end
3 6204 else
3 6205 begin
4 6206 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6207 <:io_spool_korutine:>,1);
4 6208 end;
3 6209
3 6209 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6210
3 6210 until false;
3 6211
3 6211 io_spool_trap:
3 6212
3 6212 disable skriv_io_spool(zbillede,1);
3 6213 end io_spool;
2 6214 \f
2 6214 message procedure io_spon side 1 - 810507/hko;
2 6215
2 6215 procedure io_spon;
2 6216 begin
3 6217 integer
3 6218 næste_fulde,nr,i,dato,kl;
3 6219 real t;
3 6220
3 6220 procedure skriv_io_spon(zud,omfang);
3 6221 value omfang;
3 6222 zone zud;
3 6223 integer omfang;
3 6224 begin
4 6225 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6226 if omfang > 0 then
4 6227 disable begin integer x;
5 6228 trap(slut);
5 6229 write(zud,"nl",1,
5 6230 <: næste-fulde::>,næste_fulde,"nl",1,
5 6231 <: nr :>,nr,"nl",1,
5 6232 <::>);
5 6233 skriv_coru(zud,coru_no(103));
5 6234 slut:
5 6235 end;<*disable*>
4 6236 end skriv_io_spon;
3 6237
3 6237 trap(io_spon_trap);
3 6238 næste_fulde:= 1;
3 6239 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6240 <*+2*>
3 6241 if testbit0 and overvåget or testbit28 then
3 6242 skriv_io_spon(out,0);
3 6243 <*-2*>
3 6244 \f
3 6244 message procedure io_spon side 2 - 810602/hko/cl;
3 6245
3 6245 repeat
3 6246
3 6246 <*V*> wait(ss_io_spool_fulde);
3 6247 <*V*> wait(bs_zio_adgang);
3 6248
3 6248 <*V*> setposition(zio,0,0);
3 6249
3 6249 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6250 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6251
3 6251 laf:=data;
3 6252 k:= fil(nr).io_spool_post.opkode;
3 6253 if k = 22 or k = 36 then
3 6254 disable begin
4 6255 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6256 if k=36 then
4 6257 begin
5 6258 i:= fil(nr).io_spool_post.data(4);
5 6259 j:= i extract 5;
5 6260 if j<>0 then j:=j+'A'-1;
5 6261 i:= i shift (-5) extract 10;
5 6262 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6263 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6264 end;
4 6265 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6266 fil(nr).io_spool_post.tid)
4 6267 end
3 6268 else if k = 23 then
3 6269 disable
3 6270 begin
4 6271 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6272 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6273 kl:= round t;
4 6274 i:= replace_char(1<*space in number*>,'.');
4 6275 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6276 replace_char(1,i);
4 6277 end
3 6278 else if k = 45 or k = 46 then
3 6279 disable begin
4 6280 integer vogn,linie,bogst,løb,t;
4 6281
4 6281 t:=fil(nr).io_spool_post.data(2);
4 6282 outchar(z_io,'nl');
4 6283 if k = 45 then
4 6284 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6285
4 6285 write(zio,<:nødopkald fra :>);
4 6286 vogn:= fil(nr).io_spool_post.data(1);
4 6287 i:= vogn shift (-22);
4 6288 if i < 2 then
4 6289 skrivid(zio,vogn,9)
4 6290 else
4 6291 begin
5 6292 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6293 write(zio,<:!!!:>,vogn);
5 6294 end;
4 6295 \f
4 6295 message procedure io_spon side 3 - 810507/hko;
4 6296
4 6296 if fil(nr).io_spool_post.data(3)<>0 then
4 6297 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6298
4 6298 if k = 46 then
4 6299 begin
5 6300 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6301 end;
4 6302 end <*disable*>
3 6303 else
3 6304 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6305
3 6305 fil(nr,1):= fil(nr,1) add 1;
3 6306
3 6306 <*V*> setposition(zio,0,0);
3 6307
3 6307 signal_bin(bs_zio_adgang);
3 6308
3 6308 signal(ss_io_spool_tomme);
3 6309
3 6309 until false;
3 6310
3 6310 io_spon_trap:
3 6311 skriv_io_spon(zbillede,1);
3 6312
3 6312 end io_spon;
2 6313 \f
2 6313 message procedure io_medd side 1;
2 6314
2 6314 procedure io_medd;
2 6315 begin
3 6316 integer array field opref;
3 6317 integer afs, kl, i;
3 6318 real dato, t;
3 6319
3 6319
3 6319 procedure skriv_io_medd(zud,omfang);
3 6320 value omfang;
3 6321 zone zud;
3 6322 integer omfang;
3 6323 begin
4 6324 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6325 if omfang > 0 then
4 6326 disable begin integer x;
5 6327 trap(slut);
5 6328 write(zud,"nl",1,
5 6329 <: opref: :>,opref,"nl",1,
5 6330 <: afs: :>,afs,"nl",1,
5 6331 <: kl: :>,kl,"nl",1,
5 6332 <: i: :>,i,"nl",1,
5 6333 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6334 <: t: :>,t,"nl",1,
5 6335 <::>);
5 6336 skriv_coru(zud,coru_no(104));
5 6337 slut:
5 6338 end;<*disable*>
4 6339 end skriv_io_medd;
3 6340
3 6340 trap(io_medd_trap);
3 6341 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6342 <*+2*>
3 6343 if testbit0 and overvåget or testbit28 then
3 6344 skriv_io_medd(out,0);
3 6345 <*-2*>
3 6346 \f
3 6346 message procedure io_medd side 2;
3 6347
3 6347 repeat
3 6348 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6349 <*V*> wait(bs_zio_adgang);
3 6350
3 6350 afs:= d.opref.data.op_spool_kilde;
3 6351 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6352 kl:= round t;
3 6353 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6354 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6355 i:= replacechar(1,'.');
3 6356 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6357 replacechar(1,i);
3 6358 write(z_io,d.opref.data.op_spool_text);
3 6359 setposition(z_io,0,0);
3 6360
3 6360 signalbin(bs_zio_adgang);
3 6361 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6362 until false;
3 6363
3 6363 io_medd_trap:
3 6364 skriv_io_medd(zbillede,1);
3 6365
3 6365 end io_medd;
2 6366 \f
2 6366 message operatør_erklæringer side 1 - 810602/hko;
2 6367 integer
2 6368 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6369 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6370 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6371 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6372 integer array
2 6373 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6374 operatørmaske(1:op_maske_lgd//2),
2 6375 op_talevej(0:max_antal_operatører),
2 6376 tv_operatør(0:max_antal_taleveje),
2 6377 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6378 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6379 ant_i_opkø,
2 6380 cs_operatør,
2 6381 cs_op_fil(1:max_antal_operatører);
2 6382 boolean
2 6383 op_cqf_tab_ændret;
2 6384 integer field
2 6385 op_spool_kilde;
2 6386 real field
2 6387 op_spool_tid;
2 6388 long array field
2 6389 op_spool_text;
2 6390 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6391 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6392 \f
2 6392 message procedure op_fejl side 1 - 830310/hko;
2 6393
2 6393 procedure op_fejl(z,s,b);
2 6394 integer s,b;
2 6395 zone z;
2 6396 begin
3 6397 disable begin
4 6398 integer array iz(1:20);
4 6399 integer i,j,k,n;
4 6400 integer array field iaf,iaf1,msk;
4 6401 boolean input;
4 6402 real array field laf,laf1;
4 6403
4 6403 getzone6(z,iz);
4 6404 iaf:=laf:=2;
4 6405 input:= iz(13) = 1;
4 6406 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6407 if iz.laf(1)=terminal_navn.laf1(1) and
4 6408 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6409
4 6409 <*+2*> if testbit31 then
4 6410 <**> begin
5 6411 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6412 <**> <:s=:>); outintbits(out,s);
5 6413 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6414 <**> else <:output:>,"nl",1);
5 6415 <**> setposition(out,0,0);
5 6416 <**> end;
4 6417 <*-2*>
4 6418 iaf:=j*terminal_beskr_længde;
4 6419 k:=1;
4 6420
4 6420 i:= terminal_tab.iaf.terminal_tilstand;
4 6421 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6422 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6423 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6424 if s <> (1 shift 21 +2) then
4 6425 begin
5 6426 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6427 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6428 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6429 sæt_bit_ia(opkaldsflag,j,0);
5 6430 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6431 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6432 begin
6 6433 msk:= k*op_maske_lgd;
6 6434 if læsbit_ia(bpl_def.msk,j) then
6 6435 <**> begin
7 6436 n:= 0;
7 6437 for i:= 1 step 1 until max_antal_operatører do
7 6438 if læsbit_ia(bpl_def.msk,i) then
7 6439 begin
8 6440 iaf1:= i*terminal_beskr_længde;
8 6441 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6442 n:= n+1;
8 6443 end;
7 6444 bpl_tilst(j,1):= n;
7 6445 end;
6 6446 <**> <*
6 6447 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6448 *> end;
5 6449 signal_bin(bs_mobil_opkald);
5 6450 end;
4 6451
4 6451 if input or -,input then
4 6452 begin
5 6453 z(1):=real <:<'?'><'?'><'em'>:>;
5 6454 b:=2;
5 6455 end;
4 6456 end; <*disable*>
3 6457 end op_fejl;
2 6458 \f
2 6458 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6459
2 6459 procedure tvswitch_fejl(z,s,b);
2 6460 integer s,b;
2 6461 zone z;
2 6462 begin
3 6463 disable begin
4 6464 integer array iz(1:20);
4 6465 integer i,j,k;
4 6466 integer array field iaf;
4 6467 boolean input;
4 6468 real array field raf;
4 6469
4 6469 getzone6(z,iz);
4 6470 iaf:=raf:=2;
4 6471 input:= iz(13) = 1;
4 6472 <*+2*> if testbit31 then
4 6473 <**> begin
5 6474 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6475 <**> <:s=:>); outintbits(out,s);
5 6476 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6477 <**> else <:output:>,"nl",1);
5 6478 <**> skrivhele(out,z,b,5);
5 6479 <**> setposition(out,0,0);
5 6480 <**> end;
4 6481 <*-2*>
4 6482 k:=1;
4 6483 if s <> (1 shift 21 +2) then
4 6484 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6485 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6486
4 6486 if input or -,input then
4 6487 begin
5 6488 z(1):=real <:<'em'>:>;
5 6489 b:=2;
5 6490 end;
4 6491 end; <*disable*>
3 6492 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6493 end tvswitch_fejl;
2 6494
2 6494 procedure skriv_talevejs_tab(z);
2 6495 zone z;
2 6496 begin
3 6497 write(z,"nl",2,<:talevejsswitch::>);
3 6498 write(z,"nl",1,<: operatører::>,"nl",1);
3 6499 for i:= 1 step 1 until max_antal_operatører do
3 6500 begin
4 6501 write(z,<< dd>,i,":",1,op_talevej(i));
4 6502 if i mod 8=0 then outchar(z,'nl');
4 6503 end;
3 6504 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6505 for i:= 1 step 1 until max_antal_taleveje do
3 6506 begin
4 6507 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6508 if i mod 8=0 then outchar(z,'nl');
4 6509 end;
3 6510 write(z,"nl",3);
3 6511 end;
2 6512 \f
2 6512 message procedure skriv_opk_alarm_tab side 1;
2 6513
2 6513 procedure skriv_opk_alarm_tab(z);
2 6514 zone z;
2 6515 begin
3 6516 integer nr;
3 6517 integer array field tab;
3 6518 real t;
3 6519
3 6519 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6520 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6521 for nr:=1 step 1 until max_antal_operatører do
3 6522 begin
4 6523 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6524 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6525 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6526 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6527 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6528 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6529 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6530 "nl",1);
4 6531 end;
3 6532 end;
2 6533 \f
2 6533 message procedure skriv_op_spool_buf side 1;
2 6534
2 6534 procedure skriv_op_spool_buf(z);
2 6535 zone z;
2 6536 begin
3 6537 integer array field ref;
3 6538 integer nr, kilde;
3 6539 real dato, kl;
3 6540
3 6540 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6541 for nr:= 1 step 1 until op_spool_postantal do
3 6542 begin
4 6543 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6544 ref:= (nr-1)*op_spool_postlgd;
4 6545 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6546 begin
5 6547 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6548 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6549 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6550 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6551 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6552 op_spool_buf.ref.op_spool_text);
5 6553 end;
4 6554 outchar(z,'nl');
4 6555 end;
3 6556 end;
2 6557
2 6557 procedure skriv_cqf_tabel(z,lang);
2 6558 value lang;
2 6559 zone z;
2 6560 boolean lang;
2 6561 begin
3 6562 integer array field ref;
3 6563 integer i,ant;
3 6564 real dato, kl;
3 6565
3 6565 ant:= 0;
3 6566 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6567 if -,lang then
3 6568 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6569 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6570 else
3 6571 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6572 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6573 for i:= 1 step 1 until max_cqf do
3 6574 begin
4 6575 ref:= (i-1)*cqf_lgd;
4 6576 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6577 begin
5 6578 ant:= ant+1;
5 6579 if lang then
5 6580 write(z,<<dd>,i,":",1);
5 6581 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6582 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6583 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6584 begin
6 6585 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6586 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6587 end
5 6588 else
5 6589 write(z,"sp",14,"?",1);
5 6590 if lang then
5 6591 begin
6 6592 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6593 begin
7 6594 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6595 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6596 end
6 6597 else
6 6598 write(z,"sp",14,"?",1);
6 6599 end
5 6600 else
5 6601 write(z,"sp",2);
5 6602 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6603 end;
4 6604 end;
3 6605 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6606 end;
2 6607
2 6607 procedure sorter_cqftab(l,u);
2 6608 value l,u;
2 6609 integer l,u;
2 6610 begin
3 6611 integer array field ii,jj;
3 6612 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6613
3 6613 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6614 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6615 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6616 repeat
3 6617 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6618 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6619 if ii <= jj then
3 6620 begin
4 6621 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6622 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6623 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6624 ii:= ii+cqf_lgd;
4 6625 jj:= jj-cqf_lgd;
4 6626 end;
3 6627 until ii>jj;
3 6628 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6629 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6630 end;
2 6631 \f
2 6631 message procedure ht_symbol side 1 - 851001/cl;
2 6632
2 6632 procedure ht_symbol(z);
2 6633 zone z;
2 6634 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6635
2 6635
2 6635
2 6635
2 6635 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6635 @@ @@ @@
2 6635 @@ @@ @@
2 6635 @@ @@ @@
2 6635 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6635 @@ @@
2 6635 @@ @@
2 6635 @@ @@
2 6635 @@ @@@@@@@@@@@@@ @@
2 6635 @@ @@ @@ @@
2 6635 @@ @@ @@ @@
2 6635 @@ @@ @@ @@
2 6635 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6635 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6636 \f
2 6636 message procedure definer_taster side 1 - 891214,cl;
2 6637
2 6637 procedure definer_taster(nr);
2 6638 value nr;
2 6639 integer nr;
2 6640 begin
3 6641
3 6641 setposition(z_op(nr),0,0);
3 6642 write(z_op(nr),
3 6643 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6644 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6645 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6646 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6647 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6648 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6649 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6650 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6651 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6652 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6653 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6654 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6655 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6656 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6657 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6658 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6659 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6660 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6661 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6662 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6663 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6664 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6665 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6666 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6667 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6668 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6669 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6670 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6671 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6672 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6673 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6674 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6675 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6676 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6677 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6678 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6679 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6680 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6681 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6682 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6683 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6684 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6685 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6686 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6687 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6688 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6689 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6690 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6691 <::>);
3 6692 end;
2 6693 \f
2 6693 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6694
2 6694 procedure skriv_terminal_tab(z);
2 6695 zone z;
2 6696 begin
3 6697 integer array field ref;
3 6698 integer t1,i,j,id,k;
3 6699
3 6699 write(z,"ff",1,<:
3 6700 ******* terminalbeskrivelser ********
3 6701
3 6701 # a k l p m m n o
3 6702 1 l a y a o o ø p
3 6703 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6704 <*
3 6705 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6706 *>
3 6707 for i:=1 step 1 until max_antal_operatører do
3 6708 begin
4 6709 ref:=i*terminal_beskr_længde;
4 6710 t1:=terminal_tab.ref(1);
4 6711 id:=terminal_tab.ref(2);
4 6712 k:=terminal_tab.ref(3);
4 6713 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6714 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6715 "sp",1);
4 6716 for j:=11 step -1 until 2 do
4 6717 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6718 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6719 "sp",1);
4 6720 skriv_id(z,id,9);
4 6721 skriv_id(z,k,9);
4 6722 end;
3 6723 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6724 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6725 write(z,"nl",1);
3 6726 end skriv_terminal_tab;
2 6727 \f
2 6727 message procedure h_operatør side 1 - 810520/hko;
2 6728
2 6728 <* hovedmodulkorutine for operatørterminaler *>
2 6729 procedure h_operatør;
2 6730 begin
3 6731 integer array field op_ref;
3 6732 integer k,nr,ant,ref,dest_sem;
3 6733 procedure skriv_hoperatør(zud,omfang);
3 6734 value omfang;
3 6735 zone zud;
3 6736 integer omfang;
3 6737 begin
4 6738
4 6738 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6739 if omfang>0 then
4 6740 disable begin integer x;
5 6741 trap(slut);
5 6742 write(zud,"nl",1,
5 6743 <: op_ref: :>,op_ref,"nl",1,
5 6744 <: nr: :>,nr,"nl",1,
5 6745 <: ant: :>,ant,"nl",1,
5 6746 <: ref: :>,ref,"nl",1,
5 6747 <: k: :>,k,"nl",1,
5 6748 <: dest_sem: :>,dest_sem,"nl",1,
5 6749 <::>);
5 6750 skriv_coru(zud,coru_no(200));
5 6751 slut:
5 6752 end;
4 6753 end skriv_hoperatør;
3 6754
3 6754 trap(hop_trap);
3 6755 stack_claim(if cm_test then 198 else 146);
3 6756
3 6756 <*+2*>
3 6757 if testbit8 and overvåget or testbit28 then
3 6758 skriv_hoperatør(out,0);
3 6759 <*-2*>
3 6760 \f
3 6760 message procedure h_operatør side 2 - 820304/hko;
3 6761
3 6761 repeat
3 6762 wait_ch(cs_op,op_ref,true,-1);
3 6763 <*+4*>
3 6764 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6765 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6766 <*-4*>
3 6767
3 6767 k:=d.op_ref.opkode extract 12;
3 6768 dest_sem:=
3 6769 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6770 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6771 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6772 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6773 if k=37 then cs_op_spool else
3 6774 if k=40 or k=38 then 0
3 6775 else -1;
3 6776 <*+4*>
3 6777 if dest_sem=-1 then
3 6778 begin
4 6779 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6780 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6781 end
3 6782 else
3 6783 <*-4*>
3 6784 if k=40 then
3 6785 begin
4 6786 dest_sem:= d.op_ref.retur;
4 6787 d.op_ref.retur:= cs_op_retur;
4 6788 for nr:= 1 step 1 until max_antal_operatører do
4 6789 begin
5 6790 inspect_ch(cs_operatør(nr),genoptype,ant);
5 6791 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 6792 or læsbit_ia(samtaleflag,nr))
5 6793 and læsbit_ia(operatørmaske,nr) then
5 6794 begin
6 6795 ref:= op_ref;
6 6796 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6797 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6798 <*+4*> if op_ref <> ref then
6 6799 fejlreaktion(11<*fr.post*>,op_ref,
6 6800 <:opdater opkaldskø,retur:>,0);
6 6801 <*-4*>
6 6802 end;
5 6803 end;
4 6804 d.op_ref.retur:= dest_sem;
4 6805 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6806 end
3 6807 else
3 6808 if k=38 then
3 6809 begin
4 6810 dest_sem:= d.opref.retur;
4 6811 d.op_ref.retur:= cs_op_retur;
4 6812 for nr:= 1 step 1 until max_antal_operatører do
4 6813 begin
5 6814 if d.opref.data.op_spool_kilde <> nr then
5 6815 begin
6 6816 ref:= op_ref;
6 6817 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6818 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6819 <*+4*> if op_ref <> ref then
6 6820 fejlreaktion(11<*fr.post*>,op_ref,
6 6821 <:opdater opkaldskø,retur:>,0);
6 6822 <*-4*>
6 6823 end;
5 6824 end;
4 6825 if d.opref.data.op_spool_kilde<>0 then
4 6826 begin
5 6827 ref:= op_ref;
5 6828 nr:= d.opref.data.op_spool_kilde;
5 6829 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 6830 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 6831 <*+4*> if op_ref <> ref then
5 6832 fejlreaktion(11<*fr.post*>,op_ref,
5 6833 <:operatørmedddelelse, retur:>,0);
5 6834 <*-4*>
5 6835 d.op_ref.retur:= dest_sem;
5 6836 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 6837 end
4 6838 else
4 6839 begin
5 6840 d.op_ref.retur:= dest_sem;
5 6841 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 6842 end;
4 6843 end
3 6844 else
3 6845 begin
4 6846 \f
4 6846 message procedure h_operatør side 3 - 810601/hko;
4 6847
4 6847 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 6848 begin
5 6849 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 6850 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 6851 +terminal_tab.iaf.terminal_tilstand extract 21;
5 6852 end;
4 6853 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6854 end;
3 6855 until false;
3 6856
3 6856 hop_trap:
3 6857 disable skriv_hoperatør(zbillede,1);
3 6858 end h_operatør;
2 6859 \f
2 6859 message procedure operatør side 1 - 820304/hko;
2 6860
2 6860 procedure operatør(nr);
2 6861 value nr;
2 6862 integer nr;
2 6863 begin
3 6864 integer array field op_ref,ref,vt_op,iaf,tab;
3 6865 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 6866 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 6867 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 6868 real kommstart,kommslut;
3 6869 \f
3 6869 message procedure operatør side 1a - 820301/hko;
3 6870
3 6870 procedure skriv_operatør(zud,omfang);
3 6871 value omfang;
3 6872 zone zud;
3 6873 integer omfang;
3 6874 begin integer i;
4 6875
4 6875 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 6876 write(zud,"sp",26-i);
4 6877 if omfang > 0 then
4 6878 disable begin
5 6879 integer x;
5 6880 trap(slut);
5 6881 write(zud,"nl",1,
5 6882 <: op-ref: :>,op_ref,"nl",1,
5 6883 <: kode: :>,kode,"nl",1,
5 6884 <: aktion: :>,aktion,"nl",1,
5 6885 <: ref: :>,ref,"nl",1,
5 6886 <: vt_op: :>,vt_op,"nl",1,
5 6887 <: iaf: :>,iaf,"nl",1,
5 6888 <: status: :>,status,"nl",1,
5 6889 <: tilstand: :>,tilstand,"nl",1,
5 6890 <: bv: :>,bv,"nl",1,
5 6891 <: bs: :>,bs,"nl",1,
5 6892 <: bs-tilst: :>,bs_tilst,"nl",1,
5 6893 <: kanal: :>,kanal,"nl",1,
5 6894 <: opgave: :>,opgave,"nl",1,
5 6895 <: pos: :>,pos,"nl",1,
5 6896 <: indeks: :>,indeks,"nl",1,
5 6897 <: sep: :>,sep,"nl",1,
5 6898 <: sluttegn: :>,sluttegn,"nl",1,
5 6899 <: vogn: :>,vogn,"nl",1,
5 6900 <: ll: :>,ll,"nl",1,
5 6901 <: garage: :>,garage,"nl",1,
5 6902 <: skærmmåde: :>,skærmmåde,"nl",1,
5 6903 <: res: :>,res,"nl",1,
5 6904 <: tab: :>,tab,"nl",1,
5 6905 <: rkom: :>,rkom,"nl",1,
5 6906 <: par1: :>,par1,"nl",1,
5 6907 <: par2: :>,par2,"nl",1,
5 6908 <::>);
5 6909 skriv_coru(zud,coru_no(200+nr));
5 6910 slut:
5 6911 end;
4 6912 end skriv_operatør;
3 6913 \f
3 6913 message procedure skærmstatus side 1 - 810518/hko;
3 6914
3 6914 integer
3 6915 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 6916 integer tilstand,b_v,b_s,b_s_tilst;
3 6917 begin
4 6918 integer i,j;
4 6919
4 6919 i:= terminal_tab.ref(1);
4 6920 b_s:= terminal_tab.ref(2);
4 6921 b_s_tilst:= i extract 12;
4 6922 j:= b_s_tilst extract 3;
4 6923 b_v:= i shift (-12) extract 4;
4 6924 tilstand:= i shift (-21);
4 6925
4 6925 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 6926 if b_v = 0 and j = 1<*opkald*> then 1 else
4 6927 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 6928 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 6929 end skærmstatus;
3 6930 \f
3 6930 message procedure skriv_skærm side 1 - 810522/hko;
3 6931
3 6931 procedure skriv_skærm(nr);
3 6932 value nr;
3 6933 integer nr;
3 6934 begin
4 6935 integer i;
4 6936
4 6936 disable definer_taster(nr);
4 6937
4 6937 skriv_skærm_maske(nr);
4 6938 skriv_skærm_opkaldskø(nr);
4 6939 skriv_skærm_b_v_s(nr);
4 6940 for i:= 1 step 1 until max_antal_kanaler do
4 6941 skriv_skærm_kanal(nr,i);
4 6942 cursor(z_op(nr),1,1);
4 6943 <*V*> setposition(z_op(nr),0,0);
4 6944 end skriv_skærm;
3 6945 \f
3 6945 message procedure skriv_skærm_id side 1 - 830310/hko;
3 6946
3 6946 procedure skriv_skærm_id(nr,id,nød);
3 6947 value nr,id,nød;
3 6948 integer nr,id;
3 6949 boolean nød;
3 6950 begin
4 6951 integer linie,løb,bogst,i,p;
4 6952
4 6952 i:= id shift (-22);
4 6953
4 6953 case i+1 of
4 6954 begin
5 6955 begin <* busnr *>
6 6956 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 6957 (id extract 14) mod 10000);
6 6958 if id shift (-14) extract 8 > 0 then
6 6959 p:= p+write(z_op(nr),".",1,
6 6960 string bpl_navn(id shift (-14) extract 8));
6 6961 write(z_op(nr),"sp",11-p);
6 6962 end;
5 6963
5 6963 begin <*linie/løb*>
6 6964 linie:= id shift (-12) extract 10;
6 6965 bogst:= id shift (-7) extract 5;
6 6966 if bogst > 0 then bogst:= bogst +'A'-1;
6 6967 løb:= id extract 7;
6 6968 write(z_op(nr),if nød then "*" else "sp",1,
6 6969 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 6970 false add bogst,1,"/",1,løb,
6 6971 "sp",if løb > 9 then 3 else 4);
6 6972 end;
5 6973
5 6973 begin <*gruppe*>
6 6974 write(z_op(nr),<:GRP :>);
6 6975 if id shift (-21) extract 1 = 1 then
6 6976 begin <*specialgruppe*>
7 6977 løb:= id extract 7;
7 6978 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 6979 <<d>,løb,"sp",2);
7 6980 end
6 6981 else
6 6982 begin
7 6983 linie:= id shift (-5) extract 10;
7 6984 bogst:= id extract 5;
7 6985 if bogst > 0 then bogst:= bogst +'A'-1;
7 6986 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 6987 false add bogst,1,"sp",2);
7 6988 end;
6 6989 end;
5 6990
5 6990 <* kanal eller område *>
5 6991 begin
6 6992 linie:= (id shift (-20) extract 2) + 1;
6 6993 case linie of
6 6994 begin
7 6995 write(z_op(nr),"sp",11-write(z_op(nr),
7 6996 string kanal_navn(id extract 20)));
7 6997 write(z_op(nr),<:K*:>,"sp",9);
7 6998 write(z_op(nr),"sp",11-write(z_op(nr),
7 6999 <:OMR :>,string område_navn(id extract 20)));
7 7000 write(z_op(nr),<:ALLE:>,"sp",7);
7 7001 end;
6 7002 end;
5 7003
5 7003 end <* case i *>
4 7004 end skriv_skærm_id;
3 7005 \f
3 7005 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 7006
3 7006 procedure skriv_skærm_kanal(nr,kanal);
3 7007 value nr,kanal;
3 7008 integer nr,kanal;
3 7009 begin
4 7010 integer i,j,k,t,omr;
4 7011 integer array field tref,kref;
4 7012 boolean nød;
4 7013
4 7013 tref:= nr*terminal_beskr_længde;
4 7014 kref:= (kanal-1)*kanal_beskr_længde;
4 7015 t:= kanaltab.kref.kanal_tilstand;
4 7016 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 7017 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 7018 cursor(z_op(nr),kanal+2,28);
4 7019 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 7020 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 7021 " ",1," ",1);
4 7022 write(z_op(nr),true,6,string kanal_navn(kanal));
4 7023 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 7024 pabx_id(kanal_id(kanal) extract 5)
4 7025 else
4 7026 radio_id(kanal_id(kanal) extract 5);
4 7027 for i:= -2 step 1 until 0 do
4 7028 begin
5 7029 write(z_op(nr),
5 7030 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 7031 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 7032 end;
4 7033 write(z_op(nr),<:: :>);
4 7034 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 7035 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 7036 begin
5 7037 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 7038 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 7039 end
4 7040 else
4 7041 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 7042 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 7043 else
4 7044 if i > 0 and
4 7045 ( true <* i <> nr *> <* OPT også ud på egen skærm 960527/CL *> or
4 7046 j = kanal <* kanal = kanalnr for ventepos *> or
4 7047 (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 7048 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 7049 begin
5 7050 write(z_op(nr),<:OPT :>);
5 7051 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 7052 else write(z_op(nr),string bpl_navn(i));
5 7053 end
4 7054 else
4 7055 if false then
4 7056 begin
5 7057 i:= kanaltab.kref.kanal_id1;
5 7058 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 7059 skriv_skærm_id(nr,i,nød);
5 7060 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 7061 i:= kanaltab.kref.kanal_id2;
5 7062 if i<>0 then skriv_skærm_id(nr,i,false);
5 7063 end;
4 7064 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7065 end skriv_skærm_kanal;
3 7066 \f
3 7066 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 7067
3 7067 procedure skriv_skærm_b_v_s(nr);
3 7068 value nr;
3 7069 integer nr;
3 7070 begin
4 7071 integer i,j,k,kv,ks,t;
4 7072 integer array field tref,kref;
4 7073
4 7073 tref:= nr*terminal_beskr_længde;
4 7074 i:= terminal_tab.tref.terminal_tilstand;
4 7075 kv:= i shift (-12) extract 4;
4 7076 ks:= terminaltab.tref(2) extract 20;
4 7077 <*V*> setposition(z_op(nr),0,0);
4 7078 cursor(z_op(nr),18,28);
4 7079 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7080 cursor(z_op(nr),20,28);
4 7081 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7082 cursor(z_op(nr),21,28);
4 7083 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7084 cursor(z_op(nr),20,28);
4 7085 if op_talevej(nr)<>0 then
4 7086 begin
5 7087 cursor(z_op(nr),18,28);
5 7088 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 7089 end;
4 7090 if kv <> 0 then
4 7091 begin
5 7092 kref:= (kv-1)*kanal_beskr_længde;
5 7093 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 7094 else kanaltab.kref.kanal_id2;
5 7095 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 7096 else kanaltab.kref.kanal_alt_id2;
5 7097 write(z_op(nr),true,6,string kanal_navn(kv));
5 7098 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 7099 skriv_skærm_id(nr,k,false);
5 7100 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 7101 end;
4 7102
4 7102 cursor(z_op(nr),21,28);
4 7103 j:= terminal_tab.tref(2);
4 7104 if i shift (-21) <> 0 <*ikke ledig*> then
4 7105 begin
5 7106 \f
5 7106 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 7107
5 7107 if i shift (-21) = 1 <*samtale*> then
5 7108 begin
6 7109 if j shift (-20) = 12 then
6 7110 begin
7 7111 write(z_op(nr),true,6,string kanal_navn(ks));
7 7112 end
6 7113 else
6 7114 begin
7 7115 write(z_op(nr),true,6,<:K*:>);
7 7116 k:= 0;
7 7117 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 7118 k:= k+1;
7 7119 ks:= k;
7 7120 end;
6 7121 kref:= (ks-1)*kanal_beskr_længde;
6 7122 t:= kanaltab.kref.kanaltilstand;
6 7123 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 7124 t shift (-3) extract 1 = 1);
6 7125 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 7126 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 7127 if t shift (-5) extract 1 = 1 then <:MON :> else
6 7128 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 7129 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 7130 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 7131 if t shift (-9) extract 1 = 1 then
6 7132 write(z_op(nr),<:ALLE :>);
6 7133 if t shift (-8) extract 1 = 1 then
6 7134 write(z_op(nr),<:KATASTROFE :>);
6 7135 k:= kanaltab.kref.kanal_spec;
6 7136 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7137 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7138 end
5 7139 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7140 begin
6 7141 write(z_op(nr),<:K-:>,"sp",3);
6 7142 if j <> 0 then
6 7143 skriv_skærm_id(nr,j,false)
6 7144 else
6 7145 begin
7 7146 j:=terminal_tab.tref(3);
7 7147 skriv_skærm_id(nr,j,
7 7148 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7149 else 0));
7 7150 end;
6 7151 write(z_op(nr),<:OPT:>);
6 7152 end;
5 7153 end;
4 7154 <*V*> setposition(z_op(nr),0,0);
4 7155 end skriv_skærm_b_v_s;
3 7156 \f
3 7156 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7157
3 7157 procedure skriv_skærm_maske(nr);
3 7158 value nr;
3 7159 integer nr;
3 7160 begin
4 7161 integer i;
4 7162 <*V*> setposition(z_op(nr),0,0);
4 7163 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7164 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7165 "sp",1,"*",5,"nl",1,"-",80);
4 7166
4 7166 for i:= 3 step 1 until 21 do
4 7167 begin
5 7168 cursor(z_op(nr),i,26);
5 7169 outchar(z_op(nr),'!');
5 7170 end;
4 7171 cursor(z_op(nr),22,1);
4 7172 write(z_op(nr),"-",80);
4 7173 cursor(z_op(nr),1,1);
4 7174 <*V*> setposition(z_op(nr),0,0);
4 7175 end skriv_skærm_maske;
3 7176 \f
3 7176 message procedure skal_udskrives side 1 - 940522/cl;
3 7177
3 7177 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7178 value fordelt_til,aktuel_skærm;
3 7179 integer fordelt_til,aktuel_skærm;
3 7180 begin
4 7181 boolean skal_ud;
4 7182 integer n;
4 7183 integer array field iaf;
4 7184
4 7184 skal_ud:= true;
4 7185 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7186 begin
5 7187 for n:= 0 step 1 until 3 do
5 7188 begin
6 7189 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7190 begin
7 7191 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7192 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7193 goto returner;
7 7194 end;
6 7195 end;
5 7196 end;
4 7197 returner:
4 7198 skal_udskrives:= skal_ud;
4 7199 end;
3 7200
3 7200 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7201
3 7201 procedure skriv_skærm_opkaldskø(nr);
3 7202 value nr;
3 7203 integer nr;
3 7204 begin
4 7205 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7206 integer array field ref,iaf,tab;
4 7207 boolean skal_ud;
4 7208
4 7208 <*V*> wait(bs_opkaldskø_adgang);
4 7209 setposition(z_op(nr),0,0);
4 7210 ant:= 0; kmdo:= 0;
4 7211 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7212 ref:= første_nødopkald;
4 7213 if ref=0 then ref:=første_opkald;
4 7214 while ref <> 0 do
4 7215 begin
5 7216 i:= opkaldskø.ref(4);
5 7217 operatør:= i extract 8;
5 7218 type:=i shift (-8) extract 4;
5 7219
5 7219 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7220 *>
5 7221 if operatør > 64 then
5 7222 begin
6 7223 <* fordelt til gruppe af betjeningspladser *>
6 7224 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7225 while skal_ud and i<max_antal_operatører do
6 7226 begin
7 7227 i:=i+1;
7 7228 if læsbit_ia(bpl_def.iaf,i) then
7 7229 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7230 end;
6 7231 end
5 7232 else
5 7233 skal_ud:= skal_udskrives(operatør,nr);
5 7234 if skal_ud then
5 7235 begin
6 7236 ant:= ant +1;
6 7237 if ant < 6 then
6 7238 begin
7 7239 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7240 ttmm:= i shift (-12);
7 7241 vogn:= opkaldskø.ref(3);
7 7242 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7243 skriv_skærm_id(nr,vogn,type=2);
7 7244 write(z_op(nr),true,4,
7 7245 string område_navn(opkaldskø.ref(5) extract 4),
7 7246 <<zd.dd>,ttmm/100.0);
7 7247 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7248 begin
8 7249 if opkaldskø.ref(5) extract 4 <= 2 or
8 7250 opk_alarm.tab.alarm_lgd = 0 then
8 7251 begin
9 7252 if type=2 then
9 7253 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7254 else
9 7255 write(z_op(nr),"bel",1);
9 7256 end
8 7257 else if type>kmdo then kmdo:= type;
8 7258 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7259 end;
7 7260 end;<* ant < 6 *>
6 7261 end;<* operatør ok *>
5 7262
5 7262 ref:= opkaldskø.ref(1) extract 12;
5 7263 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7264 end;
4 7265 \f
4 7265 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7266
4 7266 signal_bin(bs_opkaldskø_adgang);
4 7267 if kmdo > opk_alarm.tab.alarm_tilst and
4 7268 kmdo > opk_alarm.tab.alarm_kmdo then
4 7269 begin
5 7270 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7271 signal_bin(bs_opk_alarm);
5 7272 end;
4 7273 if ant > 5 then
4 7274 begin
5 7275 cursor(z_op(nr),13,9);
5 7276 write(z_op(nr),<<+ddd>,ant-5);
5 7277 end
4 7278 else
4 7279 begin
5 7280 for i:= ant +1 step 1 until 6 do
5 7281 begin
6 7282 cursor(z_op(nr),i*2+1,1);
6 7283 write(z_op(nr),"sp",25);
6 7284 end;
5 7285 end;
4 7286 ant_i_opkø(nr):= ant;
4 7287 cursor(z_op(nr),1,1);
4 7288 <*V*> setposition(z_op(nr),0,0);
4 7289 end skriv_skærm_opkaldskø;
3 7290 \f
3 7290 message procedure operatør side 2 - 810522/hko;
3 7291
3 7291 trap(op_trap);
3 7292 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7293
3 7293 ref:= nr*terminal_beskr_længde;
3 7294 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7295 skærmmåde:= 0; <*normal*>
3 7296
3 7296 if operatør_auto_include(nr) then
3 7297 begin
4 7298 waitch(cs_att_pulje,opref,true,-1);
4 7299 i:= operatør_auto_include(nr) extract 2;
4 7300 if i<>3 then i:= 0;
4 7301 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7302 d.opref.data(1):= nr;
4 7303 signalch(cs_rad,opref,gen_optype or io_optype);
4 7304 end;
3 7305
3 7305 <*+2*>
3 7306 if testbit8 and overvåget or testbit28 then
3 7307 skriv_operatør(out,0);
3 7308 <*-2*>
3 7309 \f
3 7309 message procedure operatør side 3 - 810602/hko;
3 7310
3 7310 repeat
3 7311
3 7311 <*V*> wait_ch(cs_operatør(nr),
3 7312 op_ref,
3 7313 true,
3 7314 -1<*timeout*>);
3 7315 <*+2*>
3 7316 if testbit9 and overvåget then
3 7317 disable begin
4 7318 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7319 <: til operatør :>,nr);
4 7320 skriv_op(out,op_ref);
4 7321 end;
3 7322 <*-2*>
3 7323 monitor(8)reserve process:(z_op(nr),0,ia);
3 7324 kode:= d.op_ref.op_kode extract 12;
3 7325 i:= terminal_tab.ref.terminal_tilstand;
3 7326 status:= i shift(-21);
3 7327 opgave:=
3 7328 if kode=0 then 1 <* indlæs kommando *> else
3 7329 if kode=1 then 2 <* inkluder *> else
3 7330 if kode=2 then 3 <* ekskluder *> else
3 7331 if kode=40 then 4 <* opdater skærm *> else
3 7332 if kode=43 then 5 <* opkald etableret *> else
3 7333 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7334 if kode=38 then 7 <* operatør meddelelse *> else
3 7335 0; <* afvises *>
3 7336
3 7336 aktion:= case status +1 of(
3 7337 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7338 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7339 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7340 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7341 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7342 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7343 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7344 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7345 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7346 -1);
3 7347 \f
3 7347 message procedure operatør side 4 - 810424/hko;
3 7348
3 7348 case aktion+6 of
3 7349 begin
4 7350 begin
5 7351 <*-5: terminal optaget *>
5 7352
5 7352 d.op_ref.resultat:= 16;
5 7353 afslut_operation(op_ref,-1);
5 7354 end;
4 7355
4 7355 begin
5 7356 <*-4: operation uden virkning *>
5 7357
5 7357 afslut_operation(op_ref,-1);
5 7358 end;
4 7359
4 7359 begin
5 7360 <*-3: ulovlig operationskode *>
5 7361
5 7361 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7362 afslut_operation(op_ref,-1);
5 7363 end;
4 7364
4 7364 begin
5 7365 <*-2: ulovligt operatørterminal_nr *>
5 7366
5 7366 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7367 afslut_operation(op_ref,-1);
5 7368 end;
4 7369
4 7369 begin
5 7370 <*-1: ulovlig operatørtilstand *>
5 7371
5 7371 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7372 afslut_operation(op_ref,-1);
5 7373 end;
4 7374
4 7374 begin
5 7375 <* 0: ikke implementeret *>
5 7376
5 7376 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7377 afslut_operation(op_ref,-1);
5 7378 end;
4 7379
4 7379 begin
5 7380 \f
5 7380 message procedure operatør side 5 - 851001/cl;
5 7381
5 7381 <* 1: indlæs kommando *>
5 7382
5 7382
5 7382 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7383 if opk_alarm.tab.alarm_tilst > 0 then
5 7384 begin
6 7385 opk_alarm.tab.alarm_kmdo:= 3;
6 7386 signal_bin(bs_opk_alarm);
6 7387 pass;
6 7388 end;
5 7389 if d.op_ref.resultat > 3 then
5 7390 begin
6 7391 <*V*> setposition(z_op(nr),0,0);
6 7392 cursor(z_op(nr),24,1);
6 7393 skriv_kvittering(z_op(nr),op_ref,pos,
6 7394 d.op_ref.resultat);
6 7395 end
5 7396 else if d.op_ref.resultat = -1 then
5 7397 begin
6 7398 skærmmåde:= 0;
6 7399 skrivskærm(nr);
6 7400 end
5 7401 else if d.op_ref.resultat>0 then
5 7402 begin <*godkendt*>
6 7403 kode:=d.op_ref.opkode;
6 7404 i:= kode extract 12;
6 7405 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7406 if kode = 19 then 1 <*VO,S *> else
6 7407 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7408 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7409 if kode = 6 then 4 <*STop*> else
6 7410 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7411 if kode = 30 then 5 <*SP,D*> else
6 7412 if kode = 31 then 6 <*SP*> else
6 7413 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7414 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7415 if kode = 83 then 8 <*SL*> else
6 7416 if kode = 68 then 9 <*ST,D*> else
6 7417 if kode = 69 then 10 <*ST,V*> else
6 7418 if kode = 36 then 11 <*AL*> else
6 7419 if kode = 37 then 12 <*CC*> else
6 7420 if kode = 2 then 13 <*EX*> else
6 7421 if kode = 92 then 14 <*CQF,V*> else
6 7422 if kode = 38 then 15 <*AL,T*> else
6 7423 0;
6 7424 if j > 0 then
6 7425 begin
7 7426 case j of
7 7427 begin
8 7428 begin
9 7429 \f
9 7429 message procedure operatør side 6 - 851001/cl;
9 7430
9 7430 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7431
9 7431 vogn:=ia(1);
9 7432 ll:=ia(2);
9 7433 kanal:= if kode=11 or kode=19 then ia(3) else
9 7434 if kode=12 then ia(2) else 0;
9 7435 <*V*> wait_ch(cs_vt_adgang,
9 7436 vt_op,
9 7437 gen_optype,
9 7438 -1<*timeout sek*>);
9 7439 start_operation(vtop,200+nr,cs_operatør(nr),
9 7440 kode);
9 7441 d.vt_op.data(1):=vogn;
9 7442 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7443 d.vt_op.data(2):=ll;
9 7444 if kode=19 then d.vt_op.data(3):= kanal else
9 7445 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7446 indeks:= vt_op;
9 7447 signal_ch(cs_vt,
9 7448 vt_op,
9 7449 gen_optype or op_optype);
9 7450
9 7450 <*V*> wait_ch(cs_operatør(nr),
9 7451 vt_op,
9 7452 op_optype,
9 7453 -1<*timeout sek*>);
9 7454 <*+2*> if testbit10 and overvåget then
9 7455 disable begin
10 7456 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7457 <:: operation retur fra vt:>);
10 7458 skriv_op(out,vt_op);
10 7459 end;
9 7460 <*-2*>
9 7461 <*+4*> if vt_op<>indeks then
9 7462 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7463 <:operatør-kommando:>,0);
9 7464 <*-4*>
9 7465 <*V*> setposition(z_op(nr),0,0);
9 7466 cursor(z_op(nr),24,1);
9 7467 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7468 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7469 else vt_op,-1,d.vt_op.resultat);
9 7470 d.vt_op.optype:= gen_optype or vt_optype;
9 7471 disable afslut_operation(vt_op,cs_vt_adgang);
9 7472 end;
8 7473 begin
9 7474 \f
9 7474 message procedure operatør side 7 - 810921/hko,cl;
9 7475
9 7475 <* 2 vogntabel,linienr/-,busnr *>
9 7476
9 7476 d.op_ref.retur:= cs_operatør(nr);
9 7477 tofrom(d.op_ref.data,ia,10);
9 7478 indeks:= op_ref;
9 7479 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7480 wait_ch(cs_operatør(nr),
9 7481 op_ref,
9 7482 op_optype,
9 7483 -1<*timeout*>);
9 7484 <*+2*> if testbit10 and overvåget then
9 7485 disable begin
10 7486 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7487 skriv_op(out,op_ref);
10 7488 end;
9 7489 <*-2*>
9 7490 <*+4*>
9 7491 if indeks <> op_ref then
9 7492 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7493 <*-4*>
9 7494 i:= d.op_ref.resultat;
9 7495 if i = 0 or i > 3 then
9 7496 begin
10 7497 <*V*> setposition(z_op(nr),0,0);
10 7498 cursor(z_op(nr),24,1);
10 7499 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7500 end
9 7501 else
9 7502 begin
10 7503 integer antal,fil_ref;
10 7504
10 7504 skærm_måde:= 1;
10 7505 antal:= d.op_ref.data(6);
10 7506 fil_ref:= d.op_ref.data(7);
10 7507 <*V*> setposition(z_op(nr),0,0);
10 7508 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7509 "sp",14,"*",10,"sp",6,
10 7510 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7511 <*V*> setposition(z_op(nr),0,0);
10 7512 \f
10 7512 message procedure operatør side 8 - 841213/cl;
10 7513
10 7513 pos:= 1;
10 7514 while pos <= antal do
10 7515 begin
11 7516 integer bogst,løb;
11 7517
11 7517 disable i:= læs_fil(fil_ref,pos,j);
11 7518 if i <> 0 then
11 7519 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7520 else
11 7521 begin
12 7522 vogn:= fil(j,1) shift (-24) extract 24;
12 7523 løb:= fil(j,1) extract 24;
12 7524 if d.op_ref.opkode=9 then
12 7525 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7526 ll:= løb shift (-12) extract 10;
12 7527 bogst:= løb shift (-7) extract 5;
12 7528 if bogst > 0 then bogst:= bogst +'A'-1;
12 7529 løb:= løb extract 7;
12 7530 vogn:= vogn extract 14;
12 7531 i:= d.op_ref.opkode-8;
12 7532 for i:= i,i+1 do
12 7533 begin
13 7534 j:= (i+1) extract 1;
13 7535 case j +1 of
13 7536 begin
14 7537 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7538 false add bogst,1,"/",1,<<d__>,løb);
14 7539 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7540 end;
13 7541 end;
12 7542 if pos mod 5 = 0 then
12 7543 begin
13 7544 outchar(z_op(nr),'nl');
13 7545 <*V*> setposition(z_op(nr),0,0);
13 7546 end
12 7547 else write(z_op(nr),"sp",3);
12 7548 end;
11 7549 pos:=pos+1;
11 7550 end;
10 7551 write(z_op(nr),"*",1,"nl",1);
10 7552 \f
10 7552 message procedure operatør side 8a- 810507/hko;
10 7553
10 7553 d.opref.opkode:=104; <*slet-fil*>
10 7554 d.op_ref.data(4):=filref;
10 7555 indeks:=op_ref;
10 7556 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7557 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7558
10 7558 <*+2*> if testbit10 and overvåget then
10 7559 disable begin
11 7560 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7561 skriv_op(out,op_ref);
11 7562 end;
10 7563 <*-2*>
10 7564
10 7564 <*+4*> if op_ref<>indeks then
10 7565 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7566 <*-4*>
10 7567 if d.op_ref.data(9)<>0 then
10 7568 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7569 <:operatør, slet_fil:>,1);
10 7570 end;
9 7571 end;
8 7572
8 7572 begin
9 7573 \f
9 7573 message procedure operatør side 9 - 830310/hko;
9 7574
9 7574 <* 3 radio_kommandoer *>
9 7575
9 7575 kode:= d.op_ref.opkode;
9 7576 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7577 disable if testbit14 then
9 7578 begin
10 7579 integer i; <*lav en trap-bar blok*>
10 7580
10 7580 trap(test14_trap);
10 7581 systime(1,0,kommstart);
10 7582 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7583 string bpl_navn(nr),<: start :>,case rkom of (
10 7584 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7585 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7586 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7587 <:GE,T:>),<: :>);
10 7588 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7589 rkom=16 or rkom=17 or rkom=19)
10 7590 then
10 7591 begin
11 7592 if par1<>0 then skriv_id(zrl,par1,0);
11 7593 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7594 write(zrl,"sp",1,string områdenavn(par2));
11 7595 end
10 7596 else
10 7597 if rkom=10 and par1<>0 then
10 7598 write(zrl,string kanalnavn(par1 extract 20))
10 7599 else
10 7600 if rkom=5 or rkom=6 then
10 7601 begin
11 7602 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7603 if par1 shift (-20)=14 then
11 7604 write(zrl,string områdenavn(par1 extract 20));
11 7605 end;
10 7606 test14_trap: outchar(zrl,'nl');
10 7607 end;
9 7608 d.op_ref.data(4):= nr; <*operatør*>
9 7609 opgave:=
9 7610 if kode = 45 <*OP *> then 1 else
9 7611 if kode = 46 <*ME *> then 2 else
9 7612 if kode = 47 <*OP,G*> then 3 else
9 7613 if kode = 48 <*ME,G*> then 4 else
9 7614 if kode = 49 <*OP,A*> then 5 else
9 7615 if kode = 50 <*ME,A*> then 6 else
9 7616 if kode = 51 <*KA,C*> then 7 else
9 7617 if kode = 52 <*KA,P*> then 8 else
9 7618 if kode = 53 <*OP,L*> then 9 else
9 7619 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7620 if kode = 55 <*VE *> then 14 else
9 7621 if kode = 56 <*NE *> then 12 else
9 7622 if kode = 57 <*OP,V*> then 1 else
9 7623 if kode = 58 <*OP,T*> then 1 else
9 7624 if kode = 59 <*R *> then 13 else
9 7625 if kode = 60 <*GE *> then 15 else
9 7626 if kode = 61 <*GE,G*> then 16 else
9 7627 if kode = 62 <*GE,V*> then 15 else
9 7628 if kode = 63 <*GE,T*> then 15 else
9 7629 -1;
9 7630 <*+4*> if opgave < 0 then
9 7631 fejlreaktion(2<*operationskode*>,kode,
9 7632 <:operatør, radio-kommando :>,0);
9 7633 <*-4*>
9 7634 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7635 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7636 if 5<=opgave and opgave<=8 then
9 7637 d.opref.data(2):= -1;
9 7638 if opgave=13 then d.opref.data(2):=
9 7639 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7640 then 0 else 1);
9 7641 if opgave = 14 then d.opref.data(2):= 1;
9 7642 if opgave=7 or opgave=8 then
9 7643 d.opref.data(3):= -1
9 7644 else
9 7645 if opgave=5 or opgave=6 then
9 7646 begin
10 7647 if ia(1) shift (-20) = 15 then
10 7648 begin
11 7649 d.opref.data(3):= 15 shift 20;
11 7650 for j:= 1 step 1 until max_antal_kanaler do
11 7651 begin
12 7652 iaf:= (j-1)*kanalbeskrlængde;
12 7653 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7654 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7655 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7656 end;
11 7657 end
10 7658 else
10 7659 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7660 else ia(1);
10 7661 end
9 7662 else
9 7663 if kode = 57 then d.opref.data(3):= 2 else
9 7664 if kode = 58 then d.opref.data(3):= 1 else
9 7665 if kode = 62 then d.opref.data(3):= 2 else
9 7666 if kode = 63 then d.opref.data(3):= 1 else
9 7667 d.opref.data(3):= ia(2);
9 7668
9 7668 <* !!! i første if-sætning nedenfor er 'status>1'
9 7669 rettet til 'status>0' for at forhindre
9 7670 at opkald nr. 2 kan udføres med et allerede
9 7671 etableret opkald i skærmens s-felt,
9 7672 jvf. ulykke d. 7/2-1995
9 7673 !!! *>
9 7674 res:=
9 7675 if (opgave=1 or opgave=3) and status>0
9 7676 then 16 <*skærm optaget*> else
9 7677 if (opgave=15 or opgave=16) and
9 7678 status>1 then 16 <*skærm optaget*> else
9 7679 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7680 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7681 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7682 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7683 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7684 then 52 else 1) else
9 7685 if opgave<11 and status>0 then 16 else
9 7686 if opgave=11 and status<2 then 21 else
9 7687 if opgave=12 and status=0 then 22 else
9 7688 if opgave=13 and status=0 then 49 else
9 7689 if opgave=14 and status<>3 then 21 else 1;
9 7690 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7691 begin <* specialbetingelser for TLF og VHF *>
10 7692 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7693 end;
9 7694 if skærmmåde<>0 then
9 7695 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7696 kode:= opgave;
9 7697 if opgave = 15 then opgave:= 1 else
9 7698 if opgave = 16 then opgave:= 3;
9 7699 \f
9 7699 message procedure operatør side 10 - 810616/hko;
9 7700
9 7700 <* tilknyt talevej (om nødvendigt) *>
9 7701 if res = 1 and op_talevej(nr)=0 then
9 7702 begin
10 7703 i:= sidste_tv_brugt;
10 7704 repeat
10 7705 i:= (i mod max_antal_taleveje)+1;
10 7706 if tv_operatør(i)=0 then
10 7707 begin
11 7708 tv_operatør(i):= nr;
11 7709 op_talevej(nr):= i;
11 7710 end;
10 7711 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7712 if op_talevej(nr)=0 then
10 7713 res:=61
10 7714 else
10 7715 begin
11 7716 sidste_tv_brugt:=
11 7717 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7718
11 7718 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7719 start_operation(iaf,200+nr,cs_operatør(nr),
11 7720 'A' shift 12 + 44);
11 7721 d.iaf.data(1):= op_talevej(nr);
11 7722 d.iaf.data(2):= nr+16;
11 7723 ll:= 0;
11 7724 repeat
11 7725 signalch(cs_talevejsswitch,iaf,op_optype);
11 7726 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7727 ll:= ll+1;
11 7728 until ll=3 or d.iaf.resultat=3;
11 7729 res:= if d.iaf.resultat=3 then 1 else 61;
11 7730 <* ********* *>
11 7731 delay(1);
11 7732 start_operation(iaf,200+nr,cs_operatør(nr),
11 7733 'R' shift 12 + 44);
11 7734 ll:= 0;
11 7735 repeat
11 7736 signalch(cs_talevejsswitch,iaf,op_optype);
11 7737 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7738 ll:= ll+1;
11 7739 until ll=3 or d.iaf.resultat=3;
11 7740 <* ********* *>
11 7741 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7742 if res<>1 then
11 7743 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7744 end;
10 7745 end;
9 7746 if op_talevej(nr)=0 then res:= 61;
9 7747 d.op_ref.data(1):= op_talevej(nr);
9 7748
9 7748 if res <= 1 then
9 7749 begin
10 7750 til_radio: <* send operation til radiomodul *>
10 7751 d.op_ref.opkode:= opgave shift 12 + 41;
10 7752 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7753 else 0;
10 7754 d.op_ref.data(6):= b_s;
10 7755 d.op_ref.resultat:=0;
10 7756 d.op_ref.retur:= cs_operatør(nr);
10 7757 indeks:= op_ref;
10 7758 <*+2*> if testbit11 and overvåget then
10 7759 disable begin
11 7760 skriv_operatør(out,0);
11 7761 write(out,<: operation til radio:>);
11 7762 skriv_op(out,op_ref); ud;
11 7763 end;
10 7764 <*-2*>
10 7765 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7766 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7767
10 7767 <*+2*> if testbit12 and overvåget then
10 7768 disable begin
11 7769 skriv_operatør(out,0);
11 7770 write(out,<: operation retur fra radio:>);
11 7771 skriv_op(out,op_ref); ud;
11 7772 end;
10 7773 <*-2*>
10 7774 <*+4*> if op_ref <> indeks then
10 7775 fejlreaktion(11<*fr.post*>,op_ref,
10 7776 <:operatør, retur fra radio:>,0);
10 7777 <*-4*>
10 7778 \f
10 7778 message procedure operatør side 11 - 810529/hko;
10 7779
10 7779 res:= d.op_ref.resultat;
10 7780 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7781 begin
11 7782 <*+4*> if res < 2 then
11 7783 fejlreaktion(3<*prg.fejl*>,res,
11 7784 <: operatør,radio_op,resultat:>,1);
11 7785 <*-4*>
11 7786 if res = 1 then res:= 0;
11 7787 end
10 7788 else
10 7789 begin <* res = 2 eller 3 *>
11 7790 s_kanal:= v_kanal:= 0;
11 7791 opgave:= d.opref.opkode shift (-12);
11 7792 bv:= d.op_ref.data(5) extract 4;
11 7793 bs:= d.op_ref.data(6);
11 7794 if opgave < 10 then
11 7795 begin
12 7796 j:= d.op_ref.data(7) <*type*>;
12 7797 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 7798 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 7799 terminal_tab.ref(1):= i
12 7800 +(if res=2 then 4 <*optaget*> else 0)
12 7801 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 7802 then 8 <*nød*> else 0)
12 7803 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 7804 then 16 else 0)
12 7805 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 7806 + (if opgave=9 then 128 else
12 7807 if opgave>=7 then 256 else
12 7808 if opgave>=5 then 512 else 0)
12 7809 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 7810 else if b_s = 0 then 0 <*tilstand = ledig *>
12 7811 else 1 shift 21 <*tilstand = samtale*>);
12 7812 if res=3 and 0<=j and j<3 then
12 7813 disable tæl_opkald_pr_operatør(nr,j+1);
12 7814 end
11 7815 else if opgave=10 <*monitering*> or
11 7816 opgave=14 <*ventepos *> then
11 7817 begin
12 7818 <*+4*> if res = 2 then
12 7819 fejlreaktion(3<*prg.fejl*>,res,
12 7820 <: operatør,moniter,res:>,1);
12 7821 <*-4*>
12 7822 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 7823 i:= if bs<0 then
12 7824 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 7825 terminal_tab.ref(1):= i +
12 7826 (if bs < 0 then (1 shift 21) else 0);
12 7827 if opgave=10 then
12 7828 begin
13 7829 s_kanal:= bs;
13 7830 v_kanal:= d.opref.data(5);
13 7831 end;
12 7832 \f
12 7832 message procedure operatør side 12 - 810603/hko;
12 7833 end
11 7834 else if opgave=11 or opgave=12 then
11 7835 begin
12 7836 <*+4*> if res = 2 then
12 7837 fejlreaktion(3<*prg.fejl*>,res,
12 7838 <: operatør,ge/ne,res:>,1);
12 7839 <*-4*>
12 7840 if opgave=11 <*GE*> and res<>49 then
12 7841 begin
13 7842 s_kanal:= terminal_tab.ref(2);
13 7843 v_kanal:= 12 shift 20 +
13 7844 (terminal_tab.ref(1) shift (-12) extract 4);
13 7845 end;
12 7846 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 7847 end
11 7848 else
11 7849 if opgave=13 then
11 7850 begin
12 7851 if res=2 then
12 7852 fejlreaktion(3<*prg.fejl*>,res,
12 7853 <:operatør,R,res:>,1);
12 7854 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 7855 d.opref.data(2));
12 7856 end
11 7857 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 7858 <*-4*>
11 7859 ;
11 7860 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 7861
11 7861 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 7862 terminal_tab.ref(2):= b_s;
11 7863 terminal_tab.ref(3):= d.op_ref.data(11);
11 7864 if (opgave<10 or opgave=14) and res=3 then
11 7865 <*så henviser b_s til radiokanal*>
11 7866 begin
12 7867 if bs shift (-20) = 12 then
12 7868 begin
13 7869 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 7870 kanaltab.iaf.kanal_tilstand:=
13 7871 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 7872 +terminal_tab.ref(1) extract 10;
13 7873 end
12 7874 else
12 7875 begin
13 7876 for i:= 1 step 1 until max_antal_kanaler do
13 7877 begin
14 7878 if læsbit_i(bs,i) then
14 7879 begin
15 7880 iaf:= (i-1)*kanal_beskr_længde;
15 7881 kanaltab.iaf.kanaltilstand:=
15 7882 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 7883 + terminal_tab.ref(1) extract 10;
15 7884 end;
14 7885 end;
13 7886 end;
12 7887 end;
11 7888 if kode=15 or kode=16 then
11 7889 begin
12 7890 if opgave<10 then
12 7891 begin
13 7892 opgave:= 11;
13 7893 kanal:= (12 shift 20) +
13 7894 d.opref.data(6) extract 20;
13 7895 goto til_radio;
13 7896 end
12 7897 else
12 7898 if opgave=11 then
12 7899 begin
13 7900 opgave:= 10;
13 7901 d.opref.data(2):= kanal;
13 7902 goto til_radio;
13 7903 end;
12 7904 end
11 7905 else
11 7906 if (kode=1 or kode=3) then
11 7907 begin
12 7908 if opgave<10 and bv<>0 then
12 7909 begin
13 7910 opgave:= 14;
13 7911 d.opref.data(2):= 2;
13 7912 goto til_radio;
13 7913 end;
12 7914 end;
11 7915 <*V*> skriv_skærm_b_v_s(nr);
11 7916 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 7917 skriv_skærm_opkaldskø(nr);
11 7918 for i:= s_kanal, v_kanal do
11 7919 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 7920 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 7921 signalbin(bs_mobilopkald);
11 7922 <*V*> setposition(z_op(nr),0,0);
11 7923 end; <* res = 2 eller 3 *>
10 7924 end; <* res <= 1 *>
9 7925 <* frigiv talevej (om nødvendigt) *>
9 7926 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 7927 and terminal_tab.ref(2)=0 <*b_s*>
9 7928 and op_talevej(nr)<>0
9 7929 then
9 7930 begin
10 7931 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 7932 start_operation(iaf,200+nr,cs_operatør(nr),
10 7933 'D' shift 12 + 44);
10 7934 d.iaf.data(1):= op_talevej(nr);
10 7935 d.iaf.data(2):= nr+16;
10 7936 ll:= 0;
10 7937 repeat
10 7938 signalch(cs_talevejsswitch,iaf,op_optype);
10 7939 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 7940 ll:= ll+1;
10 7941 until ll=3 or d.iaf.resultat=3;
10 7942 ll:= d.iaf.resultat;
10 7943 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 7944 if ll<>3 then
10 7945 fejlreaktion(21,op_talevej(nr)*100+nr,
10 7946 <:frigiv operatør fejlet:>,1)
10 7947 else
10 7948 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 7949 skriv_skærm_b_v_s(nr);
10 7950 end;
9 7951 disable if testbit14 then
9 7952 begin
10 7953 integer t; <*lav en trap-bar blok*>
10 7954
10 7954 trap(test14_trap);
10 7955 systime(1,0,kommslut);
10 7956 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7957 string bpl_navn(nr),<: slut :>,case rkom of (
10 7958 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7959 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7960 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7961 <:GE,T:>),<: :>);
10 7962 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7963 rkom=16 or rkom=17 or rkom=19)
10 7964 then
10 7965 begin
11 7966 if d.opref.data(7)=2 then outchar(zrl,'*');
11 7967 if d.opref.data(9)<>0 then
11 7968 begin
12 7969 skriv_id(zrl,d.opref.data(9),0);
12 7970 outchar(zrl,' ');
12 7971 end;
11 7972 if d.opref.data(8)<>0 then
11 7973 begin
12 7974 skriv_id(zrl,d.opref.data(8),0);
12 7975 outchar(zrl,' ');
12 7976 end;
11 7977 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 7978 d.opref.data(2)<>0 then
11 7979 begin
12 7980 skriv_id(zrl,d.opref.data(2),0);
12 7981 outchar(zrl,' ');
12 7982 end;
11 7983 if d.opref.data(12)<>0 then
11 7984 begin
12 7985 if d.opref.data(12) shift (-20) = 15 then
12 7986 write(zrl,<:OMR*:>)
12 7987 else
12 7988 if d.opref.data(12) shift (-20) = 14 then
12 7989 write(zrl,
12 7990 string områdenavn(d.opref.data(12) extract 20))
12 7991 else
12 7992 skriv_id(zrl,d.opref.data(12),0);
12 7993 outchar(zrl,' ');
12 7994 end;
11 7995 t:= terminal_tab.ref.terminaltilstand extract 10;
11 7996 if res=3 and rkom=1 and
11 7997 (t shift (-4) extract 1 = 1) and
11 7998 (t extract 2 <> 3)
11 7999 then
11 8000 begin
12 8001 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 8002 kanal_beskr_længde;
12 8003 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 8004 extract 12)/100," ",1);
12 8005 end;
11 8006 if d.opref.data(10)<>0 then
11 8007 begin
12 8008 skriv_id(zrl,d.opref.data(10),0);
12 8009 outchar(zrl,' ');
12 8010 end;
11 8011 end
10 8012 else
10 8013 if rkom=10 and par1<>0 then
10 8014 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 8015 else
10 8016 if rkom=5 or rkom=6 then
10 8017 begin
11 8018 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 8019 if par1 shift (-20)=14 then
11 8020 write(zrl,string områdenavn(par1 extract 20));
11 8021 outchar(zrl,' ');
11 8022 end;
10 8023 if op_talevej(nr) > 0 then
10 8024 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 8025 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 8026 <<dd.dd>,kommslut-kommstart);
10 8027 test14_trap: outchar(zrl,'nl');
10 8028 end;
9 8029
9 8029 <*V*> setposition(z_op(nr),0,0);
9 8030 cursor(z_op(nr),24,1);
9 8031 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 8032 end; <* radio-kommando *>
8 8033 begin
9 8034 \f
9 8034 message procedure operatør side 13 - 810518/hko;
9 8035
9 8035 <* 4 stop kommando *>
9 8036
9 8036 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 8037 if tilstand <> 0 then
9 8038 begin
10 8039 d.op_ref.resultat:= 16; <*skærm optaget*>
10 8040 end
9 8041 else
9 8042 begin
10 8043 d.op_ref.retur:= cs_operatør(nr);
10 8044 d.op_ref.resultat:= 0;
10 8045 d.op_ref.data(1):= nr;
10 8046 indeks:= op_ref;
10 8047 <*+2*> if testbit11 and overvåget then
10 8048 disable begin
11 8049 skriv_operatør(out,0);
11 8050 write(out,<: stop_operation til radio:>);
11 8051 skriv_op(out,op_ref); ud;
11 8052 end;
10 8053 <*-2*>
10 8054 if opk_alarm.tab.alarm_tilst > 0 then
10 8055 begin
11 8056 opk_alarm.tab.alarm_kmdo:= 3;
11 8057 signal_bin(bs_opk_alarm);
11 8058 end;
10 8059
10 8059 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 8060 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 8061 <*+2*> if testbit12 and overvåget then
10 8062 disable begin
11 8063 skriv_operatør(out,0);
11 8064 write(out,<: operation retur fra radio:>);
11 8065 skriv_op(out,op_ref); ud;
11 8066 end;
10 8067 <*-2*>
10 8068 <*+4*> if indeks <> op_ref then
10 8069 fejlreaktion(11<*fr.post*>,op_ref,
10 8070 <: operatør, retur fra radio:>,0);
10 8071 <*-4*>
10 8072 \f
10 8072 message procedure operatør side 14 - 810527/hko;
10 8073
10 8073 if d.op_ref.resultat = 3 then
10 8074 begin
11 8075 integer k,n;
11 8076 integer array field msk,iaf1;
11 8077
11 8077 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 8078 +terminal_tab.ref.terminal_tilstand extract 21;
11 8079 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 8080 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 8081 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 8082 begin
12 8083 msk:= k*op_maske_lgd;
12 8084 if læsbit_ia(bpl_def.msk,nr) then
12 8085 <**> begin
13 8086 n:= 0;
13 8087 for i:= 1 step 1 until max_antal_operatører do
13 8088 if læsbit_ia(bpl_def.msk,i) then
13 8089 begin
14 8090 iaf1:= i*terminal_beskr_længde;
14 8091 if terminal_tab.iaf1.terminal_tilstand
14 8092 shift (-21) < 3 then
14 8093 n:= n+1;
14 8094 end;
13 8095 bpl_tilst(k,1):= n;
13 8096 end;
12 8097 <**> <*
12 8098 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 8099 *> end;
11 8100 signal_bin(bs_mobil_opkald);
11 8101 <*V*> setposition(z_op(nr),0,0);
11 8102 ht_symbol(z_op(nr));
11 8103 end;
10 8104 end;
9 8105 <*V*> setposition(z_op(nr),0,0);
9 8106 cursor(z_op(nr),24,1);
9 8107 if d.op_ref.resultat<> 3 then
9 8108 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8109 end;
8 8110 begin
9 8111 boolean l22;
9 8112 \f
9 8112 message procedure operatør side 15 - 810521/cl;
9 8113
9 8113 <* 5 springdefinition *>
9 8114 l22:= false;
9 8115 if sep=',' then
9 8116 disable begin
10 8117 setposition(z_op(nr),0,0);
10 8118 cursor(z_op(nr),22,1);
10 8119 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 8120 l22:= true; pos:= 1;
10 8121 while læstegn(d.op_ref.data,pos,i)<>0 do
10 8122 outchar(z_op(nr),i);
10 8123 end;
9 8124
9 8124 tofrom(d.op_ref.data,ia,indeks*2);
9 8125 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 8126 start_operation(vt_op,200+nr,cs_operatør(nr),
9 8127 101<*opret fil*>);
9 8128 d.vt_op.data(1):=128;<*postantal*>
9 8129 d.vt_op.data(2):=2; <*postlængde*>
9 8130 d.vt_op.data(3):=1; <*segmentantal*>
9 8131 d.vt_op.data(4):=
9 8132 2 shift 10; <*spool fil*>
9 8133 signal_ch(cs_opret_fil,vt_op,op_optype);
9 8134 pos:=vt_op;<*variabel lånes*>
9 8135 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 8136 <*+4*> if vt_op<>pos then
9 8137 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 8138 if d.vt_op.data(9)<>0 then
9 8139 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8140 <:op kommando(springdefinition):>,0);
9 8141 <*-4*>
9 8142 iaf:=0;
9 8143 for i:=1 step 1 until indeks-2 do
9 8144 begin
10 8145 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8146 if k<>0 then
10 8147 fejlreaktion(7<*modif-fil*>,k,
10 8148 <:op kommando(spring-def):>,0);
10 8149 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8150 end;
9 8151 \f
9 8151 message procedure operatør side 15a - 820301/cl;
9 8152
9 8152 while sep = ',' do
9 8153 begin
10 8154 setposition(z_op(nr),0,0);
10 8155 cursor(z_op(nr),23,1);
10 8156 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8157 setposition(z_op(nr),0,0);
10 8158 wait(bs_fortsæt_adgang);
10 8159 pos:= 1; j:= 0;
10 8160 while læs_store(z_op(nr),i) < 8 do
10 8161 begin
11 8162 skrivtegn(fortsæt,pos,i);
11 8163 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8164 end;
10 8165 skrivtegn(fortsæt,pos,'em');
10 8166 afsluttext(fortsæt,pos);
10 8167 sluttegn:= i;
10 8168 if j<>0 then
10 8169 begin
11 8170 setposition(z_op(nr),0,0);
11 8171 cursor(z_op(nr),24,1);
11 8172 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8173 cursor(z_op(nr),1,1);
11 8174 goto sp_ann;
11 8175 end;
10 8176 \f
10 8176 message procedure operatør side 16 - 810521/cl;
10 8177
10 8177 disable begin
11 8178 integer array værdi(1:4);
11 8179 integer a_pos,res;
11 8180 pos:= 0;
11 8181 repeat
11 8182 apos:= pos;
11 8183 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8184 if res >= 0 then
11 8185 begin
12 8186 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8187 else if res=0 then res:= -25 <*parameter mangler*>
12 8188 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8189 res:= -44 <*intervalstørrelse ulovlig*>
12 8190 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8191 res:= -6 <*løbnr ulovligt*>
12 8192 else if res=10 then
12 8193 begin
13 8194 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8195 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8196 <:op kommando(spring-def):>,0);
13 8197 iaf:= 0;
13 8198 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8199 indeks:= indeks+1;
13 8200 if sep = ',' then res:= 0;
13 8201 end
12 8202 else res:= -27; <*parametertype*>
12 8203 end;
11 8204 if res>0 then pos:= a_pos;
11 8205 until sep<>'sp' or res<=0;
11 8206
11 8206 if res<0 then
11 8207 begin
12 8208 d.op_ref.resultat:= -res;
12 8209 i:=1; j:= 1;
12 8210 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8211 afsluttext(d.op_ref.data,i);
12 8212 end;
11 8213 end;
10 8214 \f
10 8214 message procedure operatør side 17 - 810521/cl;
10 8215
10 8215 if d.op_ref.resultat > 3 then
10 8216 begin
11 8217 setposition(z_op(nr),0,0);
11 8218 if l22 then
11 8219 begin
12 8220 cursor(z_op(nr),22,1); l22:= false;
12 8221 write(z_op(nr),"-",80);
12 8222 end;
11 8223 cursor(z_op(nr),24,1);
11 8224 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8225 goto sp_ann;
11 8226 end;
10 8227 if sep=',' then
10 8228 begin
11 8229 setposition(z_op(nr),0,0);
11 8230 cursor(z_op(nr),22,1);
11 8231 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8232 pos:= 1; l22:= true;
11 8233 while læstegn(fortsæt,pos,i)<>0 do
11 8234 outchar(z_op(nr),i);
11 8235 end;
10 8236 signalbin(bs_fortsæt_adgang);
10 8237 end while sep = ',';
9 8238 d.vt_op.data(1):= indeks-2;
9 8239 k:= sætfildim(d.vt_op.data);
9 8240 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8241 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8242 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8243 d.op_ref.retur:=cs_operatør(nr);
9 8244 pos:=op_ref;
9 8245 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8246 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8247 <*+4*> if pos<>op_ref then
9 8248 fejlreaktion(11<*fremmed post*>,op_ref,
9 8249 <:op kommando(springdef retur fra vt):>,0);
9 8250 <*-4*>
9 8251 \f
9 8251 message procedure operatør side 18 - 810521/cl;
9 8252
9 8252 <*V*> setposition(z_op(nr),0,0);
9 8253 if l22 then
9 8254 begin
10 8255 cursor(z_op(nr),22,1);
10 8256 write(z_op(nr),"-",80);
10 8257 end;
9 8258 cursor(z_op(nr),24,1);
9 8259 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8260
9 8260 if false then
9 8261 begin
10 8262 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8263 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8264 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8265 signalbin(bs_fortsæt_adgang);
10 8266 end;
9 8267
9 8267 end;
8 8268
8 8268 begin
9 8269 \f
9 8269 message procedure operatør side 19 - 810522/cl;
9 8270
9 8270 <* 6 spring (igangsæt)
9 8271 spring,annuler
9 8272 spring,reserve *>
9 8273
9 8273 tofrom(d.op_ref.data,ia,6);
9 8274 d.op_ref.retur:=cs_operatør(nr);
9 8275 indeks:=op_ref;
9 8276 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8277 <*V*> wait_ch(cs_operatør(nr),
9 8278 op_ref,
9 8279 op_optype,
9 8280 -1<*timeout*>);
9 8281 <*+2*> if testbit10 and overvåget then
9 8282 disable begin
10 8283 skriv_operatør(out,0);
10 8284 write(out,"nl",1,<:op operation retur fra vt:>);
10 8285 skriv_op(out,op_ref);
10 8286 end;
9 8287 <*-2*>
9 8288 <*+4*> if indeks<>op_ref then
9 8289 fejlreaktion(11<*fremmed post*>,op_ref,
9 8290 <:op kommando(spring):>,0);
9 8291 <*-4*>
9 8292
9 8292 <*V*> setposition(z_op(nr),0,0);
9 8293 cursor(z_op(nr),24,1);
9 8294 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8295 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8296 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8297 end;
8 8298
8 8298 begin
9 8299 \f
9 8299 message procedure operatør side 20 - 810525/cl;
9 8300
9 8300 <* 7 spring(-oversigts-)rapport *>
9 8301
9 8301 d.op_ref.retur:=cs_operatør(nr);
9 8302 tofrom(d.op_ref.data,ia,4);
9 8303 indeks:=op_ref;
9 8304 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8305 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8306 <*+2*> disable if testbit10 and overvåget then
9 8307 begin
10 8308 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8309 skriv_op(out,op_ref);
10 8310 end;
9 8311 <*-2*>
9 8312
9 8312 <*+4*> if op_ref<>indeks then
9 8313 fejlreaktion(11<*fremmed post*>,op_ref,
9 8314 <:op kommando(spring-rapport):>,0);
9 8315 <*-4*>
9 8316
9 8316 <*V*> setposition(z_op(nr),0,0);
9 8317 if d.op_ref.resultat<>3 then
9 8318 begin
10 8319 cursor(z_op(nr),24,1);
10 8320 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8321 end
9 8322 else
9 8323 begin
10 8324 boolean p_skrevet;
10 8325 integer bogst,løb;
10 8326
10 8326 skærmmåde:= 1;
10 8327
10 8327 if kode = 32 then <* spring,vis *>
10 8328 begin
11 8329 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8330 bogst:= d.op_ref.data(1) extract 5;
11 8331 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8332 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8333 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8334 <:spring: :>,
11 8335 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8336 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8337 raf:= data+8;
11 8338 if d.op_ref.raf(1)<>0.0 then
11 8339 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8340 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8341 else write(z_op(nr),<:, ikke startet:>);
11 8342 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8343 \f
11 8343 message procedure operatør side 21 - 810522/cl;
11 8344
11 8344 p_skrevet:= false;
11 8345 for pos:=1 step 1 until d.op_ref.data(3) do
11 8346 begin
12 8347 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8348 if i<>0 then
12 8349 fejlreaktion(5<*læsfil*>,i,
12 8350 <:op kommando(spring,vis):>,0);
12 8351 iaf:=0;
12 8352 i:= fil(j).iaf(1);
12 8353 if i < 0 and -, p_skrevet then
12 8354 begin
13 8355 outchar(z_op(nr),'('); p_skrevet:= true;
13 8356 end;
12 8357 if i > 0 and p_skrevet then
12 8358 begin
13 8359 outchar(z_op(nr),')'); p_skrevet:= false;
13 8360 end;
12 8361 if pos mod 2 = 0 then
12 8362 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8363 else
12 8364 write(z_op(nr),true,3,<<d>,abs i);
12 8365 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8366 end;
11 8367 write(z_op(nr),"*",1);
11 8368 \f
11 8368 message procedure operatør side 22 - 810522/cl;
11 8369
11 8369 end
10 8370 else if kode=33 then <* spring,oversigt *>
10 8371 begin
11 8372 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8373 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8374 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8375
11 8375 for pos:=1 step 1 until d.op_ref.data(1) do
11 8376 begin
12 8377 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8378 if i<>0 then
12 8379 fejlreaktion(5<*læsfil*>,i,
12 8380 <:op kommando(spring-oversigt):>,0);
12 8381 iaf:=0;
12 8382 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8383 bogst:=fil(j).iaf(1) extract 5;
12 8384 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8385 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8386 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8387 string (extend fil(j).iaf(2) shift 24));
12 8388 if fil(j,2)<>0.0 then
12 8389 write(z_op(nr),<:startet :>,<<zddddd>,
12 8390 round systime(4,fil(j,2),r),<:.:>,round r);
12 8391 outchar(z_op(nr),'nl');
12 8392 end;
11 8393 write(z_op(nr),"*",1);
11 8394 end;
10 8395 <* slet fil *>
10 8396 d.op_ref.opkode:= 104;
10 8397 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8398 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8399 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8400 end; <* resultat=3 *>
9 8401
9 8401 end;
8 8402
8 8402 begin
9 8403 \f
9 8403 message procedure operatør side 23 - 940522/cl;
9 8404
9 8404
9 8404 <* 8 SLUT *>
9 8405 trapmode:= 1 shift 13;
9 8406 trap(-2);
9 8407 end;
8 8408
8 8408 begin
9 8409 <* 9 stopniveauer,definer *>
9 8410 integer fno;
9 8411
9 8411 for i:= 1 step 1 until 3 do
9 8412 operatør_stop(nr,i):= ia(i+1);
9 8413 i:= modif_fil(tf_stoptabel,nr,fno);
9 8414 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8415 iaf:=0;
9 8416 for i:= 0,1,2,3 do
9 8417 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8418 setposition(fil(fno),0,0);
9 8419 setposition(z_op(nr),0,0);
9 8420 cursor(z_op(nr),24,1);
9 8421 skriv_kvittering(z_op(nr),0,-1,3);
9 8422 end;
8 8423
8 8423 begin
9 8424 \f
9 8424 message procedure operatør side 24 - 940522/cl;
9 8425
9 8425 <* 10 stopniveauer,vis *>
9 8426 integer bpl,j,k;
9 8427
9 8427 skærm_måde:= 1;
9 8428 setposition(z_op(nr),0,0);
9 8429 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8430 <:stopniveauer: :>);
9 8431 for i:= 0 step 1 until 3 do
9 8432 begin
10 8433 bpl:= operatør_stop(nr,i);
10 8434 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8435 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8436 end;
9 8437 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8438 j:=0;
9 8439 for bpl:= 1 step 1 until max_antal_operatører do
9 8440 if bpl_navn(bpl)<>long<::> then
9 8441 begin
10 8442 if j mod 8 = 0 and j > 0 then
10 8443 write(z_op(nr),"nl",1,"sp",18);
10 8444 iaf:= bpl*terminal_beskr_længde;
10 8445 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8446 true,6,string bpl_navn(bpl));
10 8447 j:=j+1;
10 8448 end;
9 8449 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8450 j:=0;
9 8451 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8452 if bpl_navn(bpl)<>long<::> then
9 8453 begin
10 8454 if j mod 8 = 0 and j > 0 then
10 8455 write(z_op(nr),"nl",1,"sp",19);
10 8456 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8457 j:=j+1;
10 8458 end;
9 8459 write(z_op(nr),"nl",1,"*",1);
9 8460 end;
8 8461
8 8461 begin
9 8462 <* 11 alarmlængde *>
9 8463 integer fno;
9 8464
9 8464 if indeks > 0 then
9 8465 begin
10 8466 opk_alarm.tab.alarm_lgd:= ia(1);
10 8467 i:= modiffil(tf_alarmlgd,nr,fno);
10 8468 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8469 iaf:= 0;
10 8470 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8471 setposition(fil(fno),0,0);
10 8472 end;
9 8473
9 8473 setposition(z_op(nr),0,0);
9 8474 cursor(z_op(nr),24,1);
9 8475 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8476 end;
8 8477
8 8477 begin
9 8478 <* 12 CC *>
9 8479 integer i, c;
9 8480
9 8480 i:= 1;
9 8481 while læstegn(ia,i+0,c)<>0 and
9 8482 i<(op_spool_postlgd-op_spool_text)//2*3
9 8483 do skrivtegn(d.opref.data,i,c);
9 8484 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8485
9 8485 d.opref.retur:= cs_operatør(nr);
9 8486 signalch(cs_op_spool,opref,op_optype);
9 8487 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8488
9 8488 setposition(z_op(nr),0,0);
9 8489 cursor(z_op(nr),24,1);
9 8490 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8491 end;
8 8492
8 8492 <* 13 EXkluder skærmen *>
8 8493 begin
9 8494 d.opref.resultat:= 2;
9 8495 setposition(z_op(nr),0,0);
9 8496 cursor(z_op(nr),24,1);
9 8497 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8498
9 8498 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8499 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8500 d.vt_op.data(1):= nr;
9 8501 signalch(cs_rad,vt_op,gen_optype);
9 8502 end;
8 8503
8 8503 begin
9 8504 <* 14 CQF-tabel,vis *>
9 8505
9 8505 skærm_måde:= 1;
9 8506 setposition(z_op(nr),0,0);
9 8507 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8508 "esc" add 128,1,<:ÆJ:>);
9 8509 skriv_cqf_tabel(z_op(nr),false);
9 8510 write(z_op(nr),"*",1);
9 8511 end;
8 8512
8 8512 begin
9 8513 <* 15 ALarmlyd,Test *>
9 8514 integer array field tab;
9 8515 integer res;
9 8516
9 8516 tab:= (nr-1)*opk_alarm_tab_lgd;
9 8517 setposition(z_op(nr),0,0);
9 8518 if ia(1)<1 or ia(1)>2 then
9 8519 res:= 64 <* ulovligt tal *>
9 8520 else if opk_alarm.tab.alarm_lgd = 0 then
9 8521 begin
10 8522 if ia(1)=2 then
10 8523 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
10 8524 else
10 8525 write(z_op(nr),"bel",1);
10 8526 res:= 3;
10 8527 end
9 8528 else if ia(1) > opk_alarm.tab.alarm_tilst and
9 8529 ia(1) > opk_alarm.tab.alarm_kmdo then
9 8530 begin
10 8531 opk_alarm.tab.alarm_kmdo:= ia(1);
10 8532 signal_bin(bs_opk_alarm);
10 8533 res:= 3;
10 8534 end
9 8535 else
9 8536 res:= 48; <* i brug *>
9 8537
9 8537 cursor(z_op(nr),24,1);
9 8538 skriv_kvittering(z_op(nr),opref,-1,res);
9 8539 end;
8 8540
8 8540 begin
9 8541 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8542 setposition(z_op(nr),0,0);
9 8543 cursor(z_op(nr),24,1);
9 8544 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8545 end;
8 8546 \f
8 8546 message procedure operatør side x - 810522/hko;
8 8547
8 8547 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8548 <*-4*>
8 8549 end;<*case j *>
7 8550 end <* j > 0 *>
6 8551 else
6 8552 begin
7 8553 <*V*> setposition(z_op(nr),0,0);
7 8554 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8555 skriv_kvittering(z_op(nr),op_ref,-1,
7 8556 45 <*ikke implementeret *>);
7 8557 end;
6 8558 end;<* godkendt *>
5 8559
5 8559 <*V*> setposition(z_op(nr),0,0);
5 8560 <*???*>
5 8561 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8562 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8563 skærmmåde = 0 do
5 8564 begin
6 8565 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8566 begin
7 8567 skriv_skærm_bvs(nr);
7 8568 <*940920 if op_talevej(nr)=0 then status:= 0
7 8569 else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8570 if status>0 then
7 8571 begin
7 8572 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8573 terminaltab.ref(ll):= 0;
7 8574 skriv_skærm_bvs(nr);
7 8575 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8576 end;
7 8577 for i:= 1 step 1 until max_antal_kanaler do
7 8578 begin
7 8579 iaf:= (i-1)*kanalbeskrlængde;
7 8580 inspect(ss_samtale_nedlagt(i),status);
7 8581 if status>0 and
7 8582 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8583 begin
7 8584 kanaltab.iaf.kanal_tilstand:=
7 8585 kanaltab.iaf(1) shift (-10) extract 6 shift 10;
7 8586 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8587 kanaltab.iaf(ll):= 0;
7 8588 skriv_skærm_kanal(nr,i);
7 8589 repeat
7 8590 wait(ss_samtale_nedlagt(i));
7 8591 inspect(ss_samtale_nedlagt(i),status);
7 8592 until status=0;
7 8593 end;
7 8594 end;
7 8595 940920*> cursor(z_op(nr),1,1);
7 8596 setposition(z_op(nr),0,0);
7 8597 end;
6 8598 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8599 and skærmmåde = 0
6 8600 and læsbit_ia(operatørmaske,nr) then
6 8601 begin
7 8602 if sætbit_ia(opkaldsflag,nr,0) = 1 then
7 8603 skriv_skærm_opkaldskø(nr);
7 8604 if sætbit_ia(kanalflag,nr,0) = 1 then
7 8605 begin
8 8606 for i:= 1 step 1 until max_antal_kanaler do
8 8607 skriv_skærm_kanal(nr,i);
8 8608 end;
7 8609 cursor(z_op(nr),1,1);
7 8610 <*V*> setposition(z_op(nr),0,0);
7 8611 end;
6 8612 end;
5 8613 d.op_ref.retur:=cs_att_pulje;
5 8614 disable afslut_kommando(op_ref);
5 8615 end; <* indlæs kommando *>
4 8616
4 8616 begin
5 8617 \f
5 8617 message procedure operatør side x+1 - 810617/hko;
5 8618
5 8618 <* 2: inkluder *>
5 8619 integer k,n;
5 8620 integer array field msk,iaf1;
5 8621
5 8621 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8622 if i=0 then
5 8623 begin
6 8624 fejlreaktion(3<*programfejl*>,nr,
6 8625 <:operatør(nr) eksisterer ikke:>,1);
6 8626 d.op_ref.resultat:=28;
6 8627 end
5 8628 else
5 8629 begin
6 8630 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8631 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8632 else if d.op_ref.opkode = 0 then 0
6 8633 else 3;<*udført*>
6 8634 if i > 0 then
6 8635 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8636 <:operatørskærm reservation:>,1)
6 8637 else
6 8638 begin
7 8639 i:=terminal_tab.ref.terminal_tilstand;
7 8640 <*940418/cl inkluderet sættes i stop - start *>
7 8641 kode:= d.opref.opkode extract 12;
7 8642 if kode <> 0 then
7 8643 terminal_tab.ref.terminal_tilstand:=
7 8644 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8645 else
7 8646 <*940418/cl inkluderet sættes i stop - slut *>
7 8647 terminal_tab.ref.terminal_tilstand:= i extract
7 8648 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8649 for i:= 1 step 1 until max_antal_kanaler do
7 8650 begin
8 8651 iaf:= (i-1)*kanalbeskrlængde;
8 8652 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8653 end;
7 8654 skærm_måde:= 0;
7 8655 sætbit_ia(operatørmaske,nr,
7 8656 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8657 then 0 else 1));
7 8658 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8659 begin
8 8660 msk:= k*op_maske_lgd;
8 8661 if læsbit_ia(bpl_def.msk,nr) then
8 8662 <**> begin
9 8663 n:= 0;
9 8664 for i:= 1 step 1 until max_antal_operatører do
9 8665 if læsbit_ia(bpl_def.msk,i) then
9 8666 begin
10 8667 iaf1:= i*terminal_beskr_længde;
10 8668 if terminal_tab.iaf1.terminal_tilstand
10 8669 shift (-21) < 3 then
10 8670 n:= n+1;
10 8671 end;
9 8672 bpl_tilst(k,1):= n;
9 8673 end;
8 8674 <**> <*
8 8675 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8676 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8677 *> end;
7 8678 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8679 sætbit_ia(opkaldsflag,nr,0);
7 8680 signal_bin(bs_mobil_opkald);
7 8681 <*940418/cl inkluderet sættes i stop - start *>
7 8682 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8683 <*V*> ht_symbol(z_op(nr))
7 8684 else
7 8685 <*940418/cl inkluderet sættes i stop - slut *>
7 8686 <*V*> skriv_skærm(nr);
7 8687 cursor(z_op(nr),24,1);
7 8688 <*V*> setposition(z_op(nr),0,0);
7 8689 end;
6 8690 end;
5 8691 if d.op_ref.opkode = 0 then
5 8692 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8693 else
5 8694 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8695 end;
4 8696
4 8696 begin
5 8697 \f
5 8697 message procedure operatør side x+2 - 820304/hko;
5 8698
5 8698 <* 3: ekskluder *>
5 8699 integer k,n;
5 8700 integer array field iaf1,msk;
5 8701
5 8701 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8702 <*V*> setposition(z_op(nr),0,0);
5 8703 monitor(10) release process:(z_op(nr),0,ia);
5 8704 d.op_ref.resultat:=3;
5 8705 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8706 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8707 terminal_tab.ref.terminal_tilstand extract 21;
5 8708 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8709 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8710 begin
6 8711 msk:= k*op_maske_lgd;
6 8712 if læsbit_ia(bpl_def.msk,nr) then
6 8713 <**> begin
7 8714 n:= 0;
7 8715 for i:= 1 step 1 until max_antal_operatører do
7 8716 if læsbit_ia(bpl_def.msk,i) then
7 8717 begin
8 8718 iaf1:= i*terminal_beskr_længde;
8 8719 if terminal_tab.iaf1.terminal_tilstand
8 8720 shift (-21) < 3 then
8 8721 n:= n+1;
8 8722 end;
7 8723 bpl_tilst(k,1):= n;
7 8724 end;
6 8725 <**> <*
6 8726 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8727 *> end;
5 8728 signal_bin(bs_mobil_opkald);
5 8729 if opk_alarm.tab.alarm_tilst > 0 then
5 8730 begin
6 8731 opk_alarm.tab.alarm_kmdo:= 3;
6 8732 signal_bin(bs_opk_alarm);
6 8733 end;
5 8734 end;
4 8735 begin
5 8736
5 8736 <* 4: opdater skærm *>
5 8737
5 8737 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8738 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8739 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8740 skærmmåde=0 do
5 8741 begin
6 8742
6 8742 <*+2*> if testbit13 and overvåget then
6 8743 disable begin
7 8744 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8745 <:) opkaldsflag::>,"nl",1);
7 8746 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8747 write(out,<: operatørmaske::>,"nl",1);
7 8748 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8749 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8750 ud;
7 8751 end;
6 8752 <*-2*>
6 8753 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8754 begin
7 8755 skriv_skærm_bvs(nr);
7 8756 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8757 if status>0 then
7 8758 begin
7 8759 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8760 terminaltab.ref(ll):= 0;
7 8761 skriv_skærm_bvs(nr);
7 8762 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8763 end;
7 8764 for i:= 1 step 1 until max_antal_kanaler do
7 8765 begin
7 8766 iaf:= (i-1)*kanalbeskrlængde;
7 8767 inspect(ss_samtale_nedlagt(i),status);
7 8768 if status>0 and
7 8769 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8770 begin
7 8771 kanaltab.iaf.kanal_tilstand:=
7 8772 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8773 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8774 kanaltab.iaf(ll):= 0;
7 8775 skriv_skærm_kanal(nr,i);
7 8776 repeat
7 8777 wait(ss_samtale_nedlagt(i));
7 8778 inspect(ss_samtale_nedlagt(i),status);
7 8779 until status=0;
7 8780 end;
7 8781 end;
7 8782 940920*> cursor(z_op(nr),1,1);
7 8783 setposition(z_op(nr),0,0);
7 8784 end;
6 8785 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8786 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8787 begin
7 8788 <*V*> setposition(z_op(nr),0,0);
7 8789 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 8790 skriv_skærm_opkaldskø(nr);
7 8791 if sætbit_ia(kanalflag,nr,0) =1 then
7 8792 begin
8 8793 for i:=1 step 1 until max_antal_kanaler do
8 8794 skriv_skærm_kanal(nr,i);
8 8795 end;
7 8796 cursor(z_op(nr),1,1);
7 8797 <*V*> setposition(z_op(nr),0,0);
7 8798 end;
6 8799 end;
5 8800 end;
4 8801 begin
5 8802 \f
5 8802 message procedure operatør side x+3 - 830310/hko;
5 8803
5 8803 <* 5: samtale etableret *>
5 8804
5 8804 res:= d.op_ref.resultat;
5 8805 b_v:= d.op_ref.data(3) extract 4;
5 8806 b_s:= d.op_ref.data(4);
5 8807 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8808 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 8809 begin
6 8810 sætbit_i(terminal_tab.ref(1),21,1);
6 8811 sætbit_i(terminal_tab.ref(1),22,0);
6 8812 sætbit_i(terminal_tab.ref(1),2,0);
6 8813 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 8814 terminal_tab.ref(2):= b_s;
6 8815 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 8816 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 8817 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 8818 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 8819
6 8819 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8820 begin
7 8821 <*V*> setposition(z_op(nr),0,0);
7 8822 skriv_skærm_b_v_s(nr);
7 8823 <*V*> setposition(z_op(nr),0,0);
7 8824 end;
6 8825 end
5 8826 else
5 8827 if terminal_tab.ref(1) shift(-21) = 2 then
5 8828 begin
6 8829 sætbit_i(terminal_tab.ref(1),22,0);
6 8830 sætbit_i(terminal_tab.ref(1),2,0);
6 8831 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 8832 terminal_tab.ref(2):= 0;
6 8833 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8834 begin
7 8835 <*V*> setposition(z_op(nr),0,0);
7 8836 cursor(z_op(nr),21,17);
7 8837 write(z_op(nr),<:EJ FORB:>);
7 8838 <*V*> setposition(z_op(nr),0,0);
7 8839 end;
6 8840 end
5 8841 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 8842 <:terminal tilstand:>,1);
5 8843 end;
4 8844
4 8844 begin
5 8845 \f
5 8845 message procedure operatør side x+4 - 810602/hko;
5 8846
5 8846 <* 6: radiokanal ekskluderet *>
5 8847
5 8847 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 8848 pos:= d.op_ref.data(1);
5 8849 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8850 indeks:= terminal_tab.ref(2);
5 8851 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 8852 then indeks extract 4 else 0;
5 8853 if b_v = pos then
5 8854 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 8855 if b_s = pos then
5 8856 begin
6 8857 terminal_tab.ref(2):= 0;
6 8858 sætbit_i(terminal_tab.ref(1),21,0);
6 8859 sætbit_i(terminal_tab.ref(1),22,0);
6 8860 sætbit_i(terminal_tab.ref(1),2,0);
6 8861 end;
5 8862 if skærmmåde=0 then
5 8863 begin
6 8864 if b_v = pos or b_s = pos then
6 8865 <*V*> skriv_skærm_b_v_s(nr);
6 8866 <*V*> skriv_skærm_kanal(nr,pos);
6 8867 cursor(z_op(nr),1,1);
6 8868 setposition(z_op(nr),0,0);
6 8869 end;
5 8870 end;
4 8871
4 8871 begin
5 8872 \f
5 8872 message procedure operatør side x+5 - 950118/cl;
5 8873
5 8873 <* 7: operatørmeddelelse *>
5 8874 integer afs, kl, i;
5 8875 real dato, t;
5 8876
5 8876 cursor(z_op(nr),24,1);
5 8877 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 8878 cursor(z_op(nr),23,1);
5 8879 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 8880
5 8880 afs:= d.opref.data.op_spool_kilde;
5 8881 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 8882 kl:= round t;
5 8883 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 8884 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 8885 i:= replacechar(1,'.');
5 8886 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 8887 replacechar(1,i);
5 8888 write(z_op(nr),d.opref.data.op_spool_text);
5 8889
5 8889 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 8890 begin
6 8891 if opk_alarm.tab.alarm_lgd > 0 and
6 8892 opk_alarm.tab.alarm_tilst < 1 and
6 8893 opk_alarm.tab.alarm_kmdo < 1
6 8894 then
6 8895 begin
7 8896 opk_alarm.tab.alarm_kmdo := 1;
7 8897 signalbin(bs_opk_alarm);
7 8898 end
6 8899 else
6 8900 if opk_alarm.tab.alarm_lgd = 0 then
6 8901 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 8902 end;
5 8903
5 8903 setposition(z_op(nr),0,0);
5 8904
5 8904 signalch(d.opref.retur,opref,d.opref.optype);
5 8905 end;
4 8906
4 8906 begin
5 8907
5 8907 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 8908 <*-4*>
5 8909 end
4 8910 end; <* case aktion+6 *>
3 8911
3 8911 until false;
3 8912 op_trap:
3 8913 skriv_operatør(zbillede,1);
3 8914 end operatør;
2 8915
2 8915 \f
2 8915 message procedure op_cqftest side 1;
2 8916
2 8916 procedure op_cqftest;
2 8917 begin
3 8918 integer array field opref, ref, ref1;
3 8919 integer i, j, tv, cqf, res, pausetid;
3 8920 real nu, næstetid, kommstart, kommslut;
3 8921
3 8921 procedure skriv_op_cqftest(zud,omfang);
3 8922 value omfang;
3 8923 zone zud;
3 8924 integer omfang;
3 8925 begin
4 8926 write(zud,"nl",1,<:+++ op-cqftest:>);
4 8927 if omfang > 0 then
4 8928 disable begin
5 8929 real t;
5 8930
5 8930 trap(slut);
5 8931 write(zud,"nl",1,
5 8932 <: opref: :>,opref,"nl",1,
5 8933 <: ref: :>,ref,"nl",1,
5 8934 <: i: :>,i,"nl",1,
5 8935 <: tv: :>,tv,"nl",1,
5 8936 <: cqf: :>,cqf,"nl",1,
5 8937 <: res: :>,res,"nl",1,
5 8938 <: pausetid: :>,pausetid,"nl",1,
5 8939 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 8940 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 8941 <::>);
5 8942 skriv_coru(zud,coru_no(292));
5 8943 slut:
5 8944 end;
4 8945 end skriv_op_cqftest;
3 8946
3 8946 trap(op_cqf_trap);
3 8947 stackclaim(1000);
3 8948
3 8948
3 8948 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 8949 skriv_op_cqftest(out,0);
3 8950 <*-4*>
3 8951
3 8951 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 8952 repeat
3 8953 i:= sidste_tv_brugt; tv:= 0;
3 8954 repeat
3 8955 i:= (i mod max_antal_taleveje) + 1;
3 8956 if tv_operatør(i) = 0 then tv:= i;
3 8957 until (tv<>0) or (i=sidste_tv_brugt);
3 8958
3 8958 if tv<>0 then
3 8959 begin
4 8960 tv_operatør(tv):= -1;
4 8961 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 8962 for cqf:= 1 step 1 until max_cqf do
4 8963 begin
5 8964 ref:= (cqf-1)*cqf_lgd;
5 8965 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 8966 begin
6 8967 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 8968 d.opref.data(1):= tv;
6 8969 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 8970 disable if testbit19 then
6 8971 begin
7 8972 integer i; <*lav en trap-bar blok*>
7 8973
7 8973 trap(test19_trap);
7 8974 systime(1,0,kommstart);
7 8975 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 8976 skriv_id(zrl,d.opref.data(2),0);
7 8977 test19_trap: outchar(zrl,'nl');
7 8978 end;
6 8979 signalch(cs_rad,opref,op_optype or gen_optype);
6 8980 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 8981 res:= d.opref.resultat;
6 8982 <*+2*>
6 8983 disable if testbit19 then
6 8984 begin
7 8985 integer i; <*lav en trap-bar blok*>
7 8986
7 8986 trap(test19_trap);
7 8987 systime(1,0,kommslut);
7 8988 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 8989 if d.opref.data(7)=2 then outchar(zrl,'*');
7 8990 if d.opref.data(9)<>0 then
7 8991 begin
8 8992 skriv_id(zrl,d.opref.data(9),0);
8 8993 outchar(zrl,' ');
8 8994 end;
7 8995 if d.opref.data(8)<>0 then
7 8996 begin
8 8997 skriv_id(zrl,d.opref.data(8),0);
8 8998 outchar(zrl,' ');
8 8999 end;
7 9000 if d.opref.data(12)<>0 then
7 9001 begin
8 9002 if d.opref.data(12) shift (-20) = 15 then
8 9003 write(zrl,<:OMR*:>)
8 9004 else
8 9005 if d.opref.data(12) shift (-20) = 14 then
8 9006 write(zrl,
8 9007 string områdenavn(d.opref.data(12) extract 20))
8 9008 else
8 9009 skriv_id(zrl,d.opref.data(12),0);
8 9010 outchar(zrl,' ');
8 9011 end;
7 9012 if d.opref.data(10)<>0 then
7 9013 begin
8 9014 skriv_id(zrl,d.opref.data(10),0);
8 9015 outchar(zrl,' ');
8 9016 end;
7 9017 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 9018 <<dd.dd>,kommslut-kommstart);
7 9019 test19_trap: outchar(zrl,'nl');
7 9020 end;
6 9021 <*-2*>
6 9022 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 9023 begin
7 9024 delay(3);
7 9025 d.opref.opkode:= 12 shift 12 + 41;
7 9026 d.opref.resultat:= 0;
7 9027 disable if testbit19 then
7 9028 begin
8 9029 integer i; <*lav en trap-bar blok*>
8 9030
8 9030 trap(test19_trap);
8 9031 systime(1,0,kommstart);
8 9032 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 9033 test19_trap: outchar(zrl,'nl');
8 9034 end;
7 9035 signalch(cs_rad,opref,op_optype or gen_optype);
7 9036 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 9037 <*+2*>
7 9038 disable if testbit19 then
7 9039 begin
8 9040 integer i; <*lav en trap-bar blok*>
8 9041
8 9041 trap(test19_trap);
8 9042 systime(1,0,kommslut);
8 9043 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 9044 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 9045 <<dd.dd>,kommslut-kommstart);
8 9046 test19_trap: outchar(zrl,'nl');
8 9047 end;
7 9048 <*-2*>
7 9049 if d.opref.resultat <> 3 then
7 9050 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 9051 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 9052 begin
8 9053 startoperation(opref,292,cs_cqf,23);
8 9054 i:= 1;
8 9055 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9056 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9057 skriv_tegn(d.opref.data,i,' ');
8 9058 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9059 hægtstring(d.opref.data,i,<: ok!:>);
8 9060 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9061 signalch(cs_io,opref,gen_optype);
8 9062 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9063 end;
7 9064 if cqf_tabel.ref.cqf_bus > 0 then
7 9065 begin
8 9066 cqf_tabel.ref.cqf_fejl:= 0;
8 9067 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 9068 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 9069 end;
7 9070 end <*res=3*>
6 9071 else
6 9072 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 9073 cqf_tabel.ref.cqf_bus > 0
6 9074 then
6 9075 begin
7 9076 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 9077 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 9078 if cqf_tabel.ref.cqf_fejl >= 2 then
7 9079 begin
8 9080 startoperation(opref,292,cs_cqf,23);
8 9081 i:= 1;
8 9082 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9083 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9084 skriv_tegn(d.opref.data,i,' ');
8 9085 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9086 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 9087 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9088 signalch(cs_io,opref,gen_optype);
8 9089 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9090 end;
7 9091 end;
6 9092 delay(10);
6 9093 end;
5 9094 if cqf_tabel.ref.cqf_bus > 0 and
5 9095 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 9096 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 9097 end; <*for cqf*>
4 9098
4 9098 tv_operatør(tv):= 0; tv:= 0;
4 9099 if op_cqf_tab_ændret then
4 9100 begin
5 9101 j:= skrivfil(1033,1,i);
5 9102 if j<>0 then
5 9103 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 9104 sorter_cqftab(1,max_cqf);
5 9105 for cqf:= 1 step 1 until max_cqf do
5 9106 begin
6 9107 ref:= (cqf-1)*cqf_lgd;
6 9108 ref1:= (cqf-1)*cqf_id;
6 9109 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 9110 end;
5 9111 op_cqf_tab_ændret:= false;
5 9112 end;
4 9113 end; <*tv*>
3 9114
3 9114 systime(1,0.0,nu);
3 9115 pausetid:= round(næste_tid - nu);
3 9116 if pausetid < 30 then pausetid:= 30;
3 9117
3 9117 <*V*> delay(pausetid);
3 9118
3 9118 until false;
3 9119
3 9119 op_cqf_trap:
3 9120 disable skriv_op_cqftest(zbillede,1);
3 9121 end op_cqftest;
2 9122 \f
2 9122 message procedure op_spool side 1;
2 9123
2 9123 procedure op_spool;
2 9124 begin
3 9125 integer array field opref, ref;
3 9126 integer næste_tomme, i;
3 9127
3 9127 procedure skriv_op_spool(zud,omfang);
3 9128 value omfang;
3 9129 zone zud;
3 9130 integer omfang;
3 9131 begin
4 9132 write(zud,"nl",1,<:+++ op-spool:>);
4 9133 if omfang > 0 then
4 9134 disable begin
5 9135 real t;
5 9136
5 9136 trap(slut);
5 9137 write(zud,"nl",1,
5 9138 <: opref: :>,opref,"nl",1,
5 9139 <: næste-tomme: :>,næste_tomme,"nl",1,
5 9140 <: ref: :>,ref,"nl",1,
5 9141 <: i: :>,i,"nl",1,
5 9142 <::>);
5 9143 skriv_coru(zud,coru_no(293));
5 9144 slut:
5 9145 end;
4 9146 end skriv_op_spool;
3 9147
3 9147 trap(op_spool_trap);
3 9148 stackclaim(400);
3 9149
3 9149 næste_tomme:= 0;
3 9150
3 9150 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9151 skriv_op_spool(out,0);
3 9152 <*-4*>
3 9153
3 9153 repeat
3 9154 <*V*> waitch(cs_op_spool,opref,true,-1);
3 9155 inspect(ss_op_spool_tomme,i);
3 9156
3 9156 if d.opref.opkode extract 12 <> 37 then
3 9157 begin
4 9158 d.opref.resultat:= 31;
4 9159 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 9160 end
3 9161 else
3 9162 if i<=0 then
3 9163 d.opref.resultat:= 32 <*ingen fri plads*>
3 9164 else
3 9165 begin
4 9166 <*V*> wait(ss_op_spool_tomme);
4 9167 ref:= næste_tomme*op_spool_postlgd;
4 9168 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9169 i:= d.opref.opsize - data;
4 9170 if i > (op_spool_postlgd - op_spool_text) then
4 9171 i:= (op_spool_postlgd - op_spool_text);
4 9172 op_spool_buf.ref.op_spool_kilde:=
4 9173 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9174 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9175 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9176 op_spool_buf.ref(op_spool_postlgd//2):=
4 9177 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9178 d.opref.resultat:= 3;
4 9179
4 9179 signal(ss_op_spool_fulde);
4 9180 end;
3 9181
3 9181 signalch(d.opref.retur,opref,d.opref.optype);
3 9182 until false;
3 9183
3 9183 op_spool_trap:
3 9184 disable skriv_op_spool(zbillede,1);
3 9185 end op_spool;
2 9186 \f
2 9186 message procedure op_medd side 1;
2 9187
2 9187 procedure op_medd;
2 9188 begin
3 9189 integer array field opref, ref;
3 9190 integer næste_fulde, i;
3 9191
3 9191 procedure skriv_op_medd(zud,omfang);
3 9192 value omfang;
3 9193 zone zud;
3 9194 integer omfang;
3 9195 begin
4 9196 write(zud,"nl",1,<:+++ op-medd:>);
4 9197 if omfang > 0 then
4 9198 disable begin
5 9199 real t;
5 9200
5 9200 trap(slut);
5 9201 write(zud,"nl",1,
5 9202 <: opref: :>,opref,"nl",1,
5 9203 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9204 <: ref: :>,ref,"nl",1,
5 9205 <: i: :>,i,"nl",1,
5 9206 <::>);
5 9207 skriv_coru(zud,coru_no(294));
5 9208 slut:
5 9209 end;
4 9210 end skriv_op_medd;
3 9211
3 9211 trap(op_medd_trap);
3 9212 næste_fulde:= 0;
3 9213 stackclaim(400);
3 9214
3 9214 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9215 skriv_op_medd(out,0);
3 9216 <*-4*>
3 9217
3 9217 repeat
3 9218 <*V*> wait(ss_op_spool_fulde);
3 9219 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9220
3 9220 ref:= næste_fulde*op_spool_postlgd;
3 9221 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9222
3 9222 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9223 d.opref.resultat:= 0;
3 9224 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9225 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9226 opref,gen_optype);
3 9227 signal(ss_op_spool_tomme);
3 9228 until false;
3 9229
3 9229 op_medd_trap:
3 9230 disable skriv_op_medd(zbillede,1);
3 9231 end op_medd;
2 9232 \f
2 9232 message procedure alarmur side 1;
2 9233
2 9233 procedure alarmur;
2 9234 begin
3 9235 integer ventetid, nr;
3 9236 integer array field opref, tab;
3 9237 real nu;
3 9238
3 9238 procedure skriv_alarmur(zud,omfang);
3 9239 value omfang;
3 9240 zone zud;
3 9241 integer omfang;
3 9242 begin
4 9243 write(zud,"nl",1,<:+++ alarmur:>);
4 9244 if omfang > 0 then
4 9245 disable begin
5 9246 real t;
5 9247
5 9247 trap(slut);
5 9248 write(zud,"nl",1,
5 9249 <: ventetid: :>,ventetid,"nl",1,
5 9250 <: nr: :>,nr,"nl",1,
5 9251 <: opref: :>,opref,"nl",1,
5 9252 <: tab: :>,tab,"nl",1,
5 9253 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9254 <::>);
5 9255 skriv_coru(zud,coru_no(295));
5 9256 slut:
5 9257 end;
4 9258 end skriv_alarmur;
3 9259
3 9259 trap(alarmur_trap);
3 9260 stackclaim(400);
3 9261
3 9261 systime(1,0.0,nu);
3 9262 ventetid:= -1;
3 9263 repeat
3 9264 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9265 if opref > 0 then
3 9266 signalch(d.opref.retur,opref,op_optype);
3 9267
3 9267 ventetid:= -1;
3 9268 systime(1,0.0,nu);
3 9269 for nr:= 1 step 1 until max_antal_operatører do
3 9270 begin
4 9271 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9272 if opk_alarm.tab.alarm_tilst > 0 and
4 9273 opk_alarm.tab.alarm_lgd >= 0 then
4 9274 begin
5 9275 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9276 begin
6 9277 opk_alarm.tab.alarm_kmdo:= 3;
6 9278 signalbin(bs_opk_alarm);
6 9279 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9280 end
5 9281 else
5 9282 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9283 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9284 end;
4 9285 end;
3 9286 if ventetid=0 then ventetid:= 1;
3 9287 until false;
3 9288
3 9288 alarmur_trap:
3 9289 disable skriv_alarmur(zbillede,1);
3 9290 end alarmur;
2 9291 \f
2 9291 message procedure opkaldsalarmer side 1;
2 9292
2 9292 procedure opkaldsalarmer;
2 9293 begin
3 9294 integer nr, ny_kommando, tilst, aktion, tt;
3 9295 integer array field tab, opref, alarmop;
3 9296
3 9296 procedure skriv_opkaldsalarmer(zud,omfang);
3 9297 value omfang;
3 9298 zone zud;
3 9299 integer omfang;
3 9300 begin
4 9301 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9302 if omfang>0 then
4 9303 disable begin
5 9304 real array field raf;
5 9305 trap(slut);
5 9306 raf:=0;
5 9307 write(zud,"nl",1,
5 9308 <: nr: :>,nr,"nl",1,
5 9309 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9310 <: tilst: :>,tilst,"nl",1,
5 9311 <: aktion: :>,aktion,"nl",1,
5 9312 <: tt: :>,false add tt,1,"nl",1,
5 9313 <: tab: :>,tab,"nl",1,
5 9314 <: opref: :>,opref,"nl",1,
5 9315 <: alarmop: :>,alarmop,"nl",1,
5 9316 <::>);
5 9317 skriv_coru(zud,coru_no(296));
5 9318 slut:
5 9319 end;
4 9320 end skriv_opkaldsalarmer;
3 9321
3 9321 trap(opk_alarm_trap);
3 9322 stackclaim(400);
3 9323
3 9323 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9324 skriv_opkaldsalarmer(out,0);
3 9325 <*-2*>
3 9326
3 9326 repeat
3 9327 wait(bs_opk_alarm);
3 9328 alarmop:= 0;
3 9329 for nr:= 1 step 1 until max_antal_operatører do
3 9330 begin
4 9331 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9332 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9333 tilst:= opk_alarm.tab.alarm_tilst;
4 9334 aktion:= case ny_kommando+1 of (
4 9335 <*ingenting*> case tilst+1 of (4,4,4),
4 9336 <*normal *> case tilst+1 of (1,4,4),
4 9337 <*nød *> case tilst+1 of (2,2,4),
4 9338 <*sluk *> case tilst+1 of (4,3,3));
4 9339 tt:= case aktion of ('B','C','F','-');
4 9340 if tt<>'-' then
4 9341 begin
5 9342 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9343 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9344 d.opref.data(1):= nr+16;
5 9345 signalch(cs_talevejsswitch,opref,op_optype);
5 9346 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9347 if d.opref.resultat = 3 then
5 9348 begin
6 9349 opk_alarm.tab.alarm_kmdo:= 0;
6 9350 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9351 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9352 if aktion < 3 then
6 9353 begin
7 9354 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9355 if alarmop = 0 then
7 9356 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9357 end;
6 9358 end;
5 9359 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9360 end;
4 9361 end;
3 9362 if alarmop<>0 then
3 9363 begin
4 9364 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9365 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9366 end;
3 9367 until false;
3 9368
3 9368 opk_alarm_trap:
3 9369 disable skriv_opkaldsalarmer(zbillede,1);
3 9370 end;
2 9371
2 9371 \f
2 9371 message procedure tvswitch_input side 1 - 940810/cl;
2 9372
2 9372 procedure tv_switch_input;
2 9373 begin
3 9374 integer array field opref;
3 9375 integer tt,ant;
3 9376 boolean ok;
3 9377 integer array ia(1:128);
3 9378
3 9378 procedure skriv_tvswitch_input(zud,omfang);
3 9379 value omfang;
3 9380 zone zud;
3 9381 integer omfang;
3 9382 begin
4 9383 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9384 if omfang>0 then
4 9385 disable begin
5 9386 real array field raf;
5 9387 trap(slut);
5 9388 raf:=0;
5 9389 write(zud,"nl",1,
5 9390 <: opref: :>,opref,"nl",1,
5 9391 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9392 <: ant: :>,ant,"nl",1,
5 9393 <: tt: :>,tt,"nl",1,
5 9394 <::>);
5 9395 write(zud,"nl",1,<:ia: :>);
5 9396 skrivhele(zud,ia.raf,256,2);
5 9397 skriv_coru(zud,coru_no(297));
5 9398 slut:
5 9399 end;
4 9400 end skriv_tvswitch_input;
3 9401 \f
3 9401 boolean procedure læs_tlgr;
3 9402 begin
4 9403 integer kl,ch,i,pos,p;
4 9404 long field lf;
4 9405 boolean ok;
4 9406
4 9406 integer procedure readch(z,c);
4 9407 zone z; integer c;
4 9408 begin
5 9409 readch:= readchar(z,c);
5 9410 <*+2*> if testbit15 and overvåget then
5 9411 disable begin
6 9412 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9413 else write(zrl,"<",1,<<d>,c,">",1);
6 9414 if c='em' then write(zrl,<: *timeout*:>);
6 9415 end;
5 9416 <*-2*>
5 9417 end;
4 9418
4 9418 ok:= false; tt:=' ';
4 9419 repeat
4 9420 readchar(z_tv_in,ch);
4 9421 until ch<>'em';
4 9422 repeatchar(z_tv_in);
4 9423
4 9423 <*+2*>if testbit15 and overvåget then
4 9424 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9425 <*-2*>
4 9426
4 9426 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9427 if ch='%' then
4 9428 begin
5 9429 ant:= 0; pos:= 1; lf:= 4;
5 9430 ok:= true;
5 9431 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9432
5 9432 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9433 skrivtegn(ia,pos,ch);
5 9434
5 9434 p:=pos;
5 9435 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9436
5 9436 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9437 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9438 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9439
5 9439 if ok and ch=' ' then
5 9440 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9441
5 9441 while kl = 2 do
5 9442 begin
6 9443 i:= ch - '0';
6 9444 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9445 if ant < 128 then
6 9446 begin
7 9447 ant:= ant+1;
7 9448 ia(ant):= i;
7 9449 end
6 9450 else
6 9451 ok:= false;
6 9452 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9453 end;
5 9454 if ch<>'nl' then ok:= false;
5 9455 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9456 <* !! setposition(z_tv_in,0,0); !! *>
5 9457 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9458 <*-2*>
5 9459
5 9459 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9460 ok:= ok
5 9461 else if tt='C' or tt='N' or
5 9462 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9463 ok:= ok and ant=1
5 9464 else if tt='X' or tt='Y' then
5 9465 ok:= ok and ant=2
5 9466 else if tt='T' or tt='W' then
5 9467 ok:= ok and ant=64
5 9468 else if tt='R' then
5 9469 ok:= ok and ant extract 1 = 0
5 9470 else
5 9471 begin
6 9472 ok:= false;
6 9473 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9474 end;
5 9475
5 9475 end; <* if ch='%' *>
4 9476 læs_tlgr:= ok;
4 9477 end læs_tlgr;
3 9478 \f
3 9478 trap(tvswitch_input_trap);
3 9479 stackclaim(400);
3 9480 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9481
3 9481 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9482 skriv_tvswitch_input(out,0);
3 9483 <*-2*>
3 9484
3 9484 repeat
3 9485 ok:= læs_tlgr;
3 9486 if ok then
3 9487 begin
4 9488 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9489 start_operation(opref,297,cs_tvswitch_input,0);
4 9490 d.opref.resultat:= tt shift 12 + ant;
4 9491 tofrom(d.opref.data,ia,ant*2);
4 9492 signalch(cs_talevejsswitch,opref,op_optype);
4 9493 end;
3 9494 until false;
3 9495
3 9495 tvswitch_input_trap:
3 9496
3 9496 disable skriv_tvswitch_input(zbillede,1);
3 9497
3 9497 end tvswitch_input;
2 9498 \f
2 9498 message procedure tv_switch_adm side 1 - 940502/cl;
2 9499
2 9499 procedure tv_switch_adm;
2 9500 begin
3 9501 integer array field opref;
3 9502 integer rc;
3 9503
3 9503 procedure skriv_tv_switch_adm(zud,omfang);
3 9504 value omfang;
3 9505 zone zud;
3 9506 integer omfang;
3 9507 begin
4 9508 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9509 if omfang>0 then
4 9510 disable begin
5 9511 trap(slut);
5 9512 write(zud,"nl",1,
5 9513 <: opref: :>,opref,"nl",1,
5 9514 <: rc: :>,rc,"nl",1,
5 9515 <::>);
5 9516 skriv_coru(zud,coru_no(298));
5 9517 slut:
5 9518 end;
4 9519 end skriv_tv_switch_adm;
3 9520
3 9520 trap(tv_switch_adm_trap);
3 9521 stackclaim(400);
3 9522
3 9522 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9523 disable skriv_tv_switch_adm(out,0);
3 9524 <*-2*>
3 9525
3 9525
3 9525
3 9525 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9526 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9527 *>
3 9528
3 9528 repeat
3 9529 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9530 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9531 rc:= 0;
3 9532 repeat
3 9533 signalch(cs_talevejsswitch,opref,op_optype);
3 9534 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9535 rc:= rc+1;
3 9536 until rc=3 or d.opref.resultat=3;
3 9537
3 9537 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9538
3 9538 <*V*> delay(15*60);
3 9539 until false;
3 9540 tv_switch_adm_trap:
3 9541 disable skriv_tv_switch_adm(zbillede,1);
3 9542 end;
2 9543 \f
2 9543 message procedure talevejsswitch side 1 -940426/cl;
2 9544
2 9544 procedure talevejsswitch;
2 9545 begin
3 9546 integer tt, ant, ventetid;
3 9547 integer array field opref, gemt_op, tab;
3 9548 boolean ok;
3 9549 integer array ia(1:128);
3 9550
3 9550 procedure skriv_talevejsswitch(zud,omfang);
3 9551 value omfang;
3 9552 zone zud;
3 9553 integer omfang;
3 9554 begin
4 9555 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9556 if omfang>0 then
4 9557 disable begin
5 9558 real array field raf;
5 9559 trap(slut);
5 9560 raf:= 0;
5 9561 write(zud,"nl",1,
5 9562 <: tt: :>,tt,"nl",1,
5 9563 <: ant: :>,ant,"nl",1,
5 9564 <: ventetid: :>,ventetid,"nl",1,
5 9565 <: opref: :>,opref,"nl",1,
5 9566 <: gemt-op: :>,gemt_op,"nl",1,
5 9567 <: tab: :>,tab,"nl",1,
5 9568 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9569 <::>);
5 9570 write(zud,"nl",1,<:ia: :>);
5 9571 skriv_hele(zud,ia.raf,256,2);
5 9572 skriv_coru(zud,coru_no(299));
5 9573 slut:
5 9574 end;
4 9575 end skriv_talevejsswitch;
3 9576 \f
3 9576 trap(tvswitch_trap);
3 9577 stackclaim(400);
3 9578 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9579
3 9579 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9580 skriv_talevejsswitch(out,0);
3 9581 <*-2*>
3 9582
3 9582 ventetid:= -1; ant:= 0; tt:= ' ';
3 9583 repeat
3 9584 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9585 if opref > 0 then
3 9586 begin
4 9587 if d.opref.opkode extract 12 = 0 then
4 9588 begin <*input fra talevejsswitchen *>
5 9589 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9590 tt:= d.opref.resultat shift (-12) extract 12;
5 9591 ant:= d.opref.resultat extract 12;
5 9592 tofrom(ia,d.opref.data,ant*2);
5 9593 signalch(d.opref.retur,opref,d.opref.optype);
5 9594
5 9594 if tt<>'+' and tt<>'-' then
5 9595 begin
6 9596 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9597 setposition(z_tv_out,0,0);
6 9598 <*+2*> if testbit15 and overvåget then
6 9599 disable begin
7 9600 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9601 outchar(zrl,'nl');
7 9602 end;
6 9603 <*-2*>
6 9604 end;
5 9605 if (tt='+' or tt='-') and gemt_op<>0 then
5 9606 begin
6 9607 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9608 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9609 gemt_op:= 0;
6 9610 ventetid:= -1;
6 9611 end
5 9612 else
5 9613 if tt='R' then
5 9614 begin
6 9615 for i:= 1 step 2 until ant do
6 9616 begin
7 9617 if ia(i) <= max_antal_taleveje and
7 9618 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9619 then
7 9620 begin
8 9621 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9622 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9623 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9624 op_talevej(tv_operatør(ia(i))):= 0;
8 9625 tv_operatør(ia(i)):= ia(i+1)-16;
8 9626 op_talevej(ia(i+1)-16):= ia(i);
8 9627 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9628 end
7 9629 else
7 9630 if ia(i+1) <= max_antal_taleveje and
7 9631 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9632 then
7 9633 begin
8 9634 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9635 tv_operatør(op_talevej(ia(i))):= 0;
8 9636 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9637 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9638 tv_operatør(ia(i+1)):= ia(i)-16;
8 9639 op_talevej(ia(i)-16):= ia(i+1);
8 9640 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9641 end;
7 9642 end;
6 9643 signal_bin(bs_mobil_opkald);
6 9644 <*+2*> if testbit15 and testbit16 and overvåget then
6 9645 disable begin
7 9646 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9647 end;
6 9648 <*-2*>
6 9649 end <* tt='R' and ant>0 *>
5 9650 else
5 9651 if tt='Y' then
5 9652 begin
6 9653 if ia(1) <= max_antal_taleveje and
6 9654 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9655 then
6 9656 begin
7 9657 if tv_operatør(ia(1))=ia(2)-16 and
7 9658 op_talevej(ia(2)-16)=ia(1)
7 9659 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9660 end
6 9661 else
6 9662 if ia(2) <= max_antal_taleveje and
6 9663 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9664 then
6 9665 begin
7 9666 if tv_operatør(ia(2))=ia(1)-16 and
7 9667 op_talevej(ia(1)-16)=ia(2)
7 9668 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9669 end;
6 9670 end
5 9671 else
5 9672 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9673 begin
6 9674 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9675 startoperation(opref,299,cs_op_iomedd,23);
6 9676 ant:= 1;
6 9677 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9678 anbringtal(d.opref.data,ant,ia(1),2);
6 9679 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9680 begin
7 9681 hægtstring(d.opref.data,ant,<: (:>);
7 9682 if bpl_navn(ia(1)-16)=long<::> then
7 9683 begin
8 9684 hægtstring(d.opref.data,ant,<:op:>);
8 9685 anbringtal(d.opref.data,ant,ia(1)-16,
8 9686 if ia(1)-16 > 9 then 2 else 1);
8 9687 end
7 9688 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9689 skrivtegn(d.opref.data,ant,')');
7 9690 end;
6 9691 hægtstring(d.opref.data,ant,
6 9692 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9693 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9694 if tt='P' then <: Tilgængelig:> else
6 9695 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9696 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9697 signalch(cs_io,opref,gen_optype);
6 9698 end
5 9699 else
5 9700 if tt='Z' then
5 9701 begin
6 9702 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9703 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9704 end
5 9705 else
5 9706 begin
6 9707 <* ikke implementeret *>
6 9708 end;
5 9709 end
4 9710 else
4 9711 if d.opref.opkode extract 12 = 44 then
4 9712 begin
5 9713 tt:= d.opref.opkode shift (-12);
5 9714 ok:= true;
5 9715 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9716 begin
6 9717 <*+2*> if testbit15 and overvåget then
6 9718 disable begin
7 9719 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9720 outchar(zrl,'nl');
7 9721 end;
6 9722 <*-2*>
6 9723 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9724 setposition(z_tv_out,0,0);
6 9725 end
5 9726 else
5 9727 if tt='B' or tt='C' or tt='F' then
5 9728 begin
6 9729 <*+2*> if testbit15 and overvåget then
6 9730 disable begin
7 9731 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9732 " ",1,<<d>,d.opref.data(1));
7 9733 outchar(zrl,'nl');
7 9734 end;
6 9735 <*-2*>
6 9736 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9737 d.opref.data(1),"cr",1);
6 9738 setposition(z_tv_out,0,0);
6 9739 end
5 9740 else
5 9741 if tt='A' or tt='D' or tt='T' then
5 9742 begin
6 9743 <*+2*> if testbit15 and overvåget then
6 9744 disable begin
7 9745 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9746 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9747 outchar(zrl,'nl');
7 9748 end;
6 9749 <*-2*>
6 9750 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9751 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9752 setposition(z_tv_out,0,0);
6 9753 end
5 9754 else
5 9755 ok:= false;
5 9756 if ok then
5 9757 begin
6 9758 gemt_op:= opref;
6 9759 ventetid:= 2;
6 9760 end
5 9761 else
5 9762 begin
6 9763 d.opref.resultat:= 4;
6 9764 signalch(d.opref.retur,opref,d.opref.optype);
6 9765 end;
5 9766 end;
4 9767 end
3 9768 else
3 9769 if gemt_op<>0 then
3 9770 begin <*timeout*>
4 9771 d.gemt_op.resultat:= 0;
4 9772 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9773 gemt_op:= 0;
4 9774 ventetid:= -1;
4 9775 <*+2*> if testbit15 and overvåget then
4 9776 disable begin
5 9777 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9778 outchar(zrl,'nl');
5 9779 end;
4 9780 <*-2*>
4 9781 end;
3 9782 until false;
3 9783 tvswitch_trap:
3 9784 disable skriv_talevejsswitch(zbillede,1);
3 9785 end talevejsswitch;
2 9786
2 9786 \f
2 9786 message garage_erklæringer side 1 - 810415/hko;
2 9787
2 9787 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 9788
2 9788 procedure gar_fejl(z,s,b);
2 9789 integer s,b;
2 9790 zone z;
2 9791 begin
3 9792 disable begin
4 9793 integer array iz(1:20);
4 9794 integer i,j,k;
4 9795 integer array field iaf;
4 9796 real array field raf;
4 9797
4 9797 getzone6(z,iz);
4 9798 iaf:=raf:=2;
4 9799 getnumber(iz.raf,7,j);
4 9800
4 9800 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 9801 k:=1;
4 9802
4 9802 j:= terminal_tab.iaf.terminal_tilstand;
4 9803 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 9804 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 9805 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 9806 if s <> (1 shift 21 +2) then
4 9807 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 9808 + terminal_tab.iaf.terminal_tilstand extract 21;
4 9809 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 9810 begin
5 9811 z(1):=real <:<'?'><'em'>:>;
5 9812 b:=2;
5 9813 end;
4 9814 end; <*disable*>
3 9815 end gar_fejl;
2 9816
2 9816 integer cs_gar;
2 9817 integer array cs_garage(1:max_antal_garageterminaler);
2 9818 \f
2 9818 message procedure h_garage side 1 - 810520/hko;
2 9819
2 9819 <* hovedmodulkorutine for garageterminaler *>
2 9820 procedure h_garage;
2 9821 begin
3 9822 integer array field op_ref;
3 9823 integer k,dest_sem;
3 9824 procedure skriv_hgarage(zud,omfang);
3 9825 value omfang;
3 9826 zone zud;
3 9827 integer omfang;
3 9828 begin integer i;
4 9829
4 9829 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 9830 write(zud,"sp",26-i);
4 9831 if omfang>0 then
4 9832 disable begin
5 9833 integer x;
5 9834 trap(slut);
5 9835 write(zud,"nl",1,
5 9836 <: op_ref: :>,op_ref,"nl",1,
5 9837 <: k: :>,k,"nl",1,
5 9838 <: dest_sem: :>,dest_sem,"nl",1,
5 9839 <::>);
5 9840 skriv_coru(zud,coru_no(300));
5 9841 slut:
5 9842 end;
4 9843 end skriv_hgarage;
3 9844
3 9844 trap(hgar_trap);
3 9845 stack_claim(if cm_test then 198 else 146);
3 9846
3 9846 <*+2*>
3 9847 if testbit16 and overvåget or testbit28 then
3 9848 skriv_hgarage(out,0);
3 9849 <*-2*>
3 9850 \f
3 9850 message procedure h_garage side 2 - 811105/hko;
3 9851
3 9851 repeat
3 9852 wait_ch(cs_gar,op_ref,true,-1);
3 9853 <*+4*>
3 9854 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 9855 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 9856 <*-4*>
3 9857
3 9857 k:=d.op_ref.opkode extract 12;
3 9858 dest_sem:=
3 9859 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 9860 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 9861 else -1;
3 9862 <*+4*>
3 9863 if dest_sem=-1 then
3 9864 begin
4 9865 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 9866 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 9867 end
3 9868 else
3 9869 <*-4*>
3 9870 if k=7<*inkluder*> then
3 9871 begin
4 9872 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 9873 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 9874 begin
5 9875 d.op_ref.resultat:=3;
5 9876 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9877 dest_sem:=-2;
5 9878 end;
4 9879 end
3 9880 else
3 9881 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 9882 begin
4 9883 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 9884 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 9885 +terminal_tab.iaf.terminal_tilstand extract 21;
4 9886 end;
3 9887 if dest_sem>0 then
3 9888 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 9889 until false;
3 9890
3 9890 hgar_trap:
3 9891 disable skriv_hgarage(zbillede,1);
3 9892 end h_garage;
2 9893 \f
2 9893 message procedure garage side 1 - 830310/cl;
2 9894
2 9894 procedure garage(nr);
2 9895 value nr;
2 9896 integer nr;
2 9897 begin
3 9898 integer array field op_ref,ref;
3 9899 integer i,kode,aktion,status,opgave,retur_sem,
3 9900 pos,indeks,sep,sluttegn,vogn,ll;
3 9901
3 9901 procedure skriv_garage(zud,omfang);
3 9902 value omfang;
3 9903 zone zud;
3 9904 integer omfang;
3 9905 begin integer i;
4 9906
4 9906 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 9907 write(zud,"sp",26-i);
4 9908 if omfang > 0 then
4 9909 disable begin integer x;
5 9910 trap(slut);
5 9911 write(zud,"nl",1,
5 9912 <: op-ref: :>,op_ref,"nl",1,
5 9913 <: kode: :>,kode,"nl",1,
5 9914 <: ref: :>,ref,"nl",1,
5 9915 <: i: :>,i,"nl",1,
5 9916 <: aktion: :>,aktion,"nl",1,
5 9917 <: retur-sem: :>,retur_sem,"nl",1,
5 9918 <: vogn: :>,vogn,"nl",1,
5 9919 <: ll: :>,ll,"nl",1,
5 9920 <: status: :>,status,"nl",1,
5 9921 <: opgave: :>,opgave,"nl",1,
5 9922 <: pos: :>,pos,"nl",1,
5 9923 <: indeks: :>,indeks,"nl",1,
5 9924 <: sep: :>,sep,"nl",1,
5 9925 <: sluttegn: :>,sluttegn,"nl",1,
5 9926 <::>);
5 9927 skriv_coru(zud,coru_no(300+nr));
5 9928 slut:
5 9929 end;
4 9930 end skriv_garage;
3 9931 \f
3 9931 message procedure garage side 2 - 830310/hko;
3 9932
3 9932 trap(gar_trap);
3 9933 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 9934
3 9934 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 9935
3 9935 <*+2*>
3 9936 if testbit16 and overvåget or testbit28 then
3 9937 skriv_garage(out,0);
3 9938 <*-2*>
3 9939
3 9939 <* attention simulering
3 9940 *>
3 9941 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 9942 begin
4 9943 wait_ch(cs_att_pulje,op_ref,true,-1);
4 9944 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 9945 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 9946 end;
3 9947 <*
3 9948 *>
3 9949 \f
3 9949 message procedure garage side 3 - 830310/hko;
3 9950
3 9950 repeat
3 9951
3 9951 <*V*> wait_ch(cs_garage(nr),
3 9952 op_ref,
3 9953 true,
3 9954 -1<*timeout*>);
3 9955 <*+2*>
3 9956 if testbit17 and overvåget then
3 9957 disable begin
4 9958 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 9959 <: til garage :>,nr);
4 9960 skriv_op(out,op_ref);
4 9961 end;
3 9962 <*-2*>
3 9963
3 9963 kode:= d.op_ref.op_kode;
3 9964 retur_sem:= d.op_ref.retur;
3 9965 i:= terminal_tab.ref.terminal_tilstand;
3 9966 status:= i shift(-21);
3 9967 opgave:=
3 9968 if kode=0 then 1 <* indlæs kommando *> else
3 9969 if kode=7 then 2 <* inkluder *> else
3 9970 if kode=8 then 3 <* ekskluder *> else
3 9971 0; <* afvises *>
3 9972
3 9972 aktion:= case status +1 of(
3 9973 <* status *> <* opgave: 0 1 2 3 *>
3 9974 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 9975 <* 1 - *>(-1),<* ulovlig tilstand *>
3 9976 <* 2 - *>(-1),<* ulovlig tilstand *>
3 9977 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 9978 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 9979 <* 5 - *>(-1),<* ulovlig tilstand *>
3 9980 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 9981 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 9982 -1);
3 9983 \f
3 9983 message procedure garage side 4 - 810424/hko;
3 9984
3 9984 case aktion+6 of
3 9985 begin
4 9986 begin
5 9987 <*-5: terminal optaget *>
5 9988
5 9988 d.op_ref.resultat:= 16;
5 9989 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 9990 end;
4 9991
4 9991 begin
5 9992 <*-4: operation uden virkning *>
5 9993
5 9993 afslut_operation(op_ref,-1);
5 9994 end;
4 9995
4 9995 begin
5 9996 <*-3: ulovlig operationskode *>
5 9997
5 9997 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 9998 afslut_operation(op_ref,-1);
5 9999 end;
4 10000
4 10000 begin
5 10001 <*-2: ulovligt garageterminal_nr *>
5 10002
5 10002 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 10003 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10004 end;
4 10005
4 10005 begin
5 10006 <*-1: ulovlig operatørtilstand *>
5 10007
5 10007 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 10008 afslut_operation(op_ref,-1);
5 10009 end;
4 10010
4 10010 begin
5 10011 <* 0: ikke implementeret *>
5 10012
5 10012 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 10013 afslut_operation(op_ref,-1);
5 10014 end;
4 10015
4 10015 begin
5 10016 \f
5 10016 message procedure garage side 5 - 851001/cl;
5 10017
5 10017 <* 1: indlæs kommando *>
5 10018
5 10018
5 10018 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 10019
5 10019 if d.op_ref.resultat > 3 then
5 10020 begin
6 10021 <*V*> setposition(z_gar(nr),0,0);
6 10022 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 10023 skriv_kvittering(z_gar(nr),op_ref,pos,
6 10024 d.op_ref.resultat);
6 10025 end
5 10026 else if d.op_ref.resultat>0 then
5 10027 begin <*godkendt*>
6 10028 kode:=d.op_ref.opkode;
6 10029 i:= kode extract 12;
6 10030 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 10031 else if kode=9 or kode=10 then 2
6 10032 else 0;
6 10033 if j > 0 then
6 10034 begin
7 10035 case j of
7 10036 begin
8 10037 begin
9 10038 \f
9 10038 message procedure garage side 6 - 851001/cl;
9 10039
9 10039 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 10040 integer vogn,ll;
9 10041 integer array field vtop;
9 10042
9 10042 vogn:=ia(1);
9 10043 ll:=ia(2);
9 10044 <*V*> wait_ch(cs_vt_adgang,
9 10045 vt_op,
9 10046 gen_optype,
9 10047 -1<*timeout sek*>);
9 10048 start_operation(vtop,300+nr,cs_garage(nr),
9 10049 kode);
9 10050 d.vt_op.data(1):=vogn;
9 10051 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 10052 indeks:= vt_op;
9 10053 signal_ch(cs_vt,
9 10054 vt_op,
9 10055 gen_optype or gar_optype);
9 10056
9 10056 <*V*> wait_ch(cs_garage(nr),
9 10057 vt_op,
9 10058 gar_optype,
9 10059 -1<*timeout sek*>);
9 10060 <*+2*> if testbit18 and overvåget then
9 10061 disable begin
10 10062 write(out,"nl",1,<:garage :>,<<d>,nr,
10 10063 <:: operation retur fra vt:>);
10 10064 skriv_op(out,vt_op);
10 10065 end;
9 10066 <*-2*>
9 10067 <*+4*> if vt_op<>indeks then
9 10068 fejl_reaktion(11<*fremmede op*>,op_ref,
9 10069 <:garage-kommando:>,0);
9 10070 <*-4*>
9 10071 <*V*> setposition(z_gar(nr),0,0);
9 10072 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 10073 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 10074 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 10075 else vt_op,-1,d.vt_op.resultat);
9 10076 d.vt_op.optype:=gen_optype or vtoptype;
9 10077 disable afslut_operation(vt_op,cs_vt_adgang);
9 10078 end;
8 10079
8 10079 begin
9 10080 \f
9 10080 message procedure garage side 6a - 830310/cl;
9 10081
9 10081 <* 2 vogntabel,linienr/-,busnr *>
9 10082
9 10082 d.op_ref.retur:= cs_garage(nr);
9 10083 tofrom(d.op_ref.data,ia,10);
9 10084 indeks:= op_ref;
9 10085 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 10086 wait_ch(cs_garage(nr),
9 10087 op_ref,
9 10088 gar_optype,
9 10089 -1<*timeout*>);
9 10090 <*+2*> if testbit18 and overvåget then
9 10091 disable begin
10 10092 write(out,"nl",1,<:garage operation retur fra vt:>);
10 10093 skriv_op(out,op_ref);
10 10094 end;
9 10095 <*-2*>
9 10096 <*+4*>
9 10097 if indeks <> op_ref then
9 10098 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 10099 <*-4*>
9 10100 i:= d.op_ref.resultat;
9 10101 if i = 0 or i > 3 then
9 10102 begin
10 10103 <*V*> setposition(z_gar(nr),0,0);
10 10104 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 10105 end
9 10106 else
9 10107 begin
10 10108 integer antal,fil_ref;
10 10109 antal:= d.op_ref.data(6);
10 10110 fil_ref:= d.op_ref.data(7);
10 10111 <*V*> setposition(z_gar(nr),0,0);
10 10112 write(z_gar(nr),"*",24,"sp",6,
10 10113 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 10114 <*V*> setposition(z_gar(nr),0,0);
10 10115 \f
10 10115 message procedure garage side 6c - 841213/cl;
10 10116
10 10116 pos:= 1;
10 10117 while pos <= antal do
10 10118 begin
11 10119 integer bogst,løb;
11 10120
11 10120 disable i:= læs_fil(fil_ref,pos,j);
11 10121 if i <> 0 then
11 10122 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 10123 else
11 10124 begin
12 10125 vogn:= fil(j,1) shift (-24) extract 24;
12 10126 løb:= fil(j,1) extract 24;
12 10127 if d.op_ref.opkode=9 then
12 10128 begin i:=vogn; vogn:=løb; løb:=i; end;
12 10129 ll:= løb shift (-12) extract 10;
12 10130 bogst:= løb shift (-7) extract 5;
12 10131 if bogst > 0 then bogst:= bogst +'A'-1;
12 10132 løb:= løb extract 7;
12 10133 vogn:= vogn extract 14;
12 10134 i:= d.op_ref.opkode-8;
12 10135 for i:= i,i+1 do
12 10136 begin
13 10137 j:= (i+1) extract 1;
13 10138 case j +1 of
13 10139 begin
14 10140 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 10141 false add bogst,1,"/",1,<<d__>,løb);
14 10142 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 10143 end;
13 10144 end;
12 10145 if pos mod 5 = 0 then
12 10146 begin
13 10147 write(z_gar(nr),"nl",1);
13 10148 <*V*> setposition(z_gar(nr),0,0);
13 10149 end
12 10150 else write(z_gar(nr),"sp",3);
12 10151 end;
11 10152 pos:=pos+1;
11 10153 end;
10 10154 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 10155 \f
10 10155 message procedure garage side 6d- 830310/cl;
10 10156
10 10156 d.opref.opkode:=104; <*slet-fil*>
10 10157 d.op_ref.data(4):=filref;
10 10158 indeks:=op_ref;
10 10159 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 10160 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 10161
10 10161 <*+2*> if testbit18 and overvåget then
10 10162 disable begin
11 10163 write(out,"nl",1,<:garage, slet-fil retur:>);
11 10164 skriv_op(out,op_ref);
11 10165 end;
10 10166 <*-2*>
10 10167
10 10167 <*+4*> if op_ref<>indeks then
10 10168 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10169 <*-4*>
10 10170 if d.op_ref.data(9)<>0 then
10 10171 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10172 <:garage, slet_fil:>,1);
10 10173 end;
9 10174 \f
9 10174 message procedure garage side 7 -810424/hko;
9 10175
9 10175 end;
8 10176
8 10176 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10177 <*-4*>
8 10178 end;<*case j *>
7 10179 end <* j > 0 *>
6 10180 else
6 10181 begin
7 10182 <*V*> setposition(z_gar(nr),0,0);
7 10183 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10184 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10185 4 <*kommando ukendt *>);
7 10186 end;
6 10187 end;<* godkendt *>
5 10188
5 10188 <*V*> setposition(z_gar(nr),0,0);
5 10189
5 10189 d.op_ref.opkode:=0; <*telex*>
5 10190
5 10190 disable afslut_operation(op_ref,cs_gar);
5 10191 end; <* indlæs kommando *>
4 10192
4 10192 begin
5 10193 \f
5 10193 message procedure garage side 8 - 841213/cl;
5 10194
5 10194 <* 2: inkluder *>
5 10195
5 10195 d.op_ref.resultat:=3;
5 10196 afslut_operation(op_ref,-1);
5 10197 monitor(8)reserve:(z_gar(nr),0,ia);
5 10198 terminal_tab.ref.terminal_tilstand:=
5 10199 terminal_tab.ref.terminal_tilstand extract 21;
5 10200 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10201 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10202 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10203 end;
4 10204
4 10204 begin
5 10205
5 10205 <* 3: ekskluder *>
5 10206 d.op_ref.resultat:= 3;
5 10207 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10208 terminal_tab.ref.terminal_tilstand extract 21;
5 10209 monitor(10)release:(z_gar(nr),0,ia);
5 10210 afslut_operation(op_ref,-1);
5 10211
5 10211 end;
4 10212
4 10212 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10213 <*-4*>
4 10214 end; <* case aktion+6 *>
3 10215
3 10215 until false;
3 10216 gar_trap:
3 10217 skriv_garage(zbillede,1);
3 10218 end garage;
2 10219
2 10219 \f
2 10219 message procedure radio_erklæringer side 1 - 820304/hko;
2 10220
2 10220 zone z_fr_in(14,1,rad_in_fejl),
2 10221 z_rf_in(14,1,rad_in_fejl),
2 10222 z_fr_out(14,1,rad_out_fejl),
2 10223 z_rf_out(14,1,rad_out_fejl);
2 10224
2 10224 integer array
2 10225 radiofejl,
2 10226 ss_samtale_nedlagt,
2 10227 ss_radio_aktiver(1:max_antal_kanaler),
2 10228 bs_talevej_udkoblet,
2 10229 cs_radio(1:max_antal_taleveje),
2 10230 radio_linietabel(1:max_linienr//3+1),
2 10231 radio_områdetabel(0:max_antal_områder),
2 10232 opkaldskø(opkaldskø_postlængde//2+1:
2 10233 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10234 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10235 hookoff_maske(1:(tv_maske_lgd//2)),
2 10236 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10237
2 10237 integer field
2 10238 kanal_tilstand,
2 10239 kanal_id1,
2 10240 kanal_id2,
2 10241 kanal_spec,
2 10242 kanal_alt_id1,
2 10243 kanal_alt_id2;
2 10244 integer array field
2 10245 kanal_mon_maske,
2 10246 kanal_alarm,
2 10247 opkald_meldt;
2 10248
2 10248 integer
2 10249 cs_rad,
2 10250 cs_radio_medd,
2 10251 cs_radio_adm,
2 10252 cs_radio_ind,
2 10253 cs_radio_ud,
2 10254 cs_radio_pulje,
2 10255 cs_radio_kø,
2 10256 bs_mobil_opkald,
2 10257 bs_opkaldskø_adgang,
2 10258 opkaldskø_ledige,
2 10259 nødopkald_brugt,
2 10260 første_frie_opkald,
2 10261 første_opkald,
2 10262 sidste_opkald,
2 10263 første_nødopkald,
2 10264 sidste_nødopkald,
2 10265 optaget_flag;
2 10266
2 10266 boolean
2 10267 mobil_opkald_aktiveret;
2 10268 \f
2 10268 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10269
2 10269 integer
2 10270 procedure læs_hex_ciffer(tabel,linie,op);
2 10271 value linie;
2 10272 integer array tabel;
2 10273 integer linie,op;
2 10274 begin
3 10275 integer i,j;
3 10276
3 10276 i:=(if linie>=0 then linie+6 else linie)//6;
3 10277 j:=((i-1)*6-linie)*4;
3 10278 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10279 end læs_hex_ciffer;
2 10280
2 10280 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10281
2 10281 integer
2 10282 procedure sæt_hex_ciffer(tabel,linie,op);
2 10283 value linie;
2 10284 integer array tabel;
2 10285 integer linie,op;
2 10286 begin
3 10287 integer i,j;
3 10288
3 10288 i:=(if linie>=0 then linie+6 else linie)//6;
3 10289 j:=(linie-(i-1)*6)*4;
3 10290 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10291 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10292 shift j add (tabel(i) extract j);
3 10293 end sæt_hex_ciffer;
2 10294
2 10294 message procedure hex_to_dec side 1 - 900108/cl;
2 10295
2 10295 integer procedure hex_to_dec(hex);
2 10296 value hex;
2 10297 integer hex;
2 10298 begin
3 10299 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10300 else (hex-'0');
3 10301 end;
2 10302
2 10302 message procedure dec_to_hex side 1 - 900108/cl;
2 10303
2 10303 integer procedure dec_to_hex(dec);
2 10304 value dec;
2 10305 integer dec;
2 10306 begin
3 10307 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10308 else ('A'+dec-10);
3 10309 end;
2 10310
2 10310 message procedure rad_out_fejl side 1 - 820304/hko;
2 10311
2 10311 procedure rad_out_fejl(z,s,b);
2 10312 value s;
2 10313 zone z;
2 10314 integer s,b;
2 10315 begin
3 10316 integer array field iaf;
3 10317 integer pos,tegn,max,i;
3 10318 integer array ia(1:20);
3 10319 long array field laf;
3 10320
3 10320 disable begin
4 10321 laf:= iaf:= 2;
4 10322 tegn:= 1;
4 10323 getzone6(z,ia);
4 10324 max:= ia(16)//2*3;
4 10325 if s = 1 shift 21 + 2 then
4 10326 begin
5 10327 z(1):= real<:<'em'>:>;
5 10328 b:= 2;
5 10329 end
4 10330 else
4 10331 begin
5 10332 pos:= 0;
5 10333 for i:= 1 step 1 until max_antal_kanaler do
5 10334 begin
6 10335 iaf:= (i-1)*kanalbeskr_længde;
6 10336 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10337 if pos>0 then
6 10338 begin
7 10339 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10340 signalbin(bs_mobilopkald);
7 10341 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10342 1 shift 12<*binært*> +1<*fortsæt*>);
7 10343 end;
6 10344 end;
5 10345 end;
4 10346 end;
3 10347 end;
2 10348 \f
2 10348 message procedure rad_in_fejl side 1 - 810601/hko;
2 10349
2 10349 procedure rad_in_fejl(z,s,b);
2 10350 value s;
2 10351 zone z;
2 10352 integer s,b;
2 10353 begin
3 10354 integer array field iaf;
3 10355 integer pos,tegn,max,i;
3 10356 integer array ia(1:20);
3 10357 long array field laf;
3 10358
3 10358 disable begin
4 10359 laf:= iaf:= 2;
4 10360 i:= 1;
4 10361 getzone6(z,ia);
4 10362 max:= ia(16)//2*3;
4 10363 if s shift (-21) extract 1 = 0
4 10364 and s shift(-19) extract 1 = 0 then
4 10365 begin
5 10366 if b = 0 then
5 10367 begin
6 10368 z(1):= real<:!:>;
6 10369 b:= 2;
6 10370 end;
5 10371 end;
4 10372 \f
4 10372 message procedure rad_in_fejl side 2 - 820304/hko;
4 10373
4 10373 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10374 begin
5 10375 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10376 1 shift 12<*binær*> +1<*fortsæt*>);
5 10377 end
4 10378 else
4 10379 if s shift (-19) extract 1 = 1 then
4 10380 begin
5 10381 z(1):= real<:!<'nl'>:>;
5 10382 b:= 2;
5 10383 end
4 10384 else
4 10385 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10386 begin
5 10387 <*
5 10388 if b = 0 then
5 10389 begin
5 10390 *>
5 10391 z(1):= real <:<'em'>:>;
5 10392 b:= 2;
5 10393 <*
5 10394 end
5 10395 else
5 10396 begin
5 10397 tegn:= -1;
5 10398 iaf:= 0;
5 10399 pos:= b//2*3-2;
5 10400 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10401 skriv_tegn(z.iaf,pos,'?');
5 10402 if pos<=max then
5 10403 afslut_text(z.iaf,pos);
5 10404 b:= (pos-1)//3*2;
5 10405 end;
5 10406 *>
5 10407 end;<* s=1 shift 21+2 *>
4 10408 end;
3 10409 if testbit22 and
3 10410 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10411 then
3 10412 delay(60);
3 10413 end rad_in_fejl;
2 10414 \f
2 10414 message procedure afvent_radioinput side 1 - 880901/cl;
2 10415
2 10415 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10416 value rf;
2 10417 zone z_in;
2 10418 integer array tlgr;
2 10419 boolean rf;
2 10420 begin
3 10421 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10422 long array field laf;
3 10423
3 10423 laf:= 0;
3 10424 pos:= 1;
3 10425 repeat
3 10426 i:=readchar(z_in,tegn);
3 10427 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10428 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10429 p:=pos;
3 10430 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10431 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10432 (rf and testbit39)) then
3 10433 disable begin
4 10434 write(zrl,<<zd dd dd.dd >,now,
4 10435 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10436 if tegn='em' then <:*timeout*:> else
4 10437 if pos>=80 then <:*for langt*:> else <::>);
4 10438 outchar(zrl,'nl');
4 10439 end;
3 10440 <*-2*>
3 10441 ac:= -1;
3 10442 if pos >= 80 then
3 10443 begin <* telegram for langt *>
4 10444 repeat readchar(z_in,tegn)
4 10445 until tegn='nl' or tegn='em';
4 10446 end
3 10447 else
3 10448 if pos>1 and tegn='nl' then
3 10449 begin
4 10450 lgd:= 1;
4 10451 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10452 lgd:= lgd-2;
4 10453 if lgd >= 5 then
4 10454 begin
5 10455 lgd:= lgd-2; <* se bort fra checksum *>
5 10456 i:= lgd + 1;
5 10457 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10458 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10459 i:= lgd + 1;
5 10460 skrivtegn(tlgr,i,0);
5 10461 skrivtegn(tlgr,i,0);
5 10462 i:= 1; sum:= 0;
5 10463 while i <= lgd do
5 10464 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10465 if csum >= 0 and csum <> sum then
5 10466 begin
6 10467 <*+2*> if overvåget and (testbit36 or
6 10468 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10469 disable begin
7 10470 write(zrl,<<zd dd dd.dd >,now,
7 10471 (if rf then <:rf:> else <:fr:>),
7 10472 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10473 end;
6 10474 <*-2*>
6 10475 ac:= 6 <* checksumfejl *>
6 10476 end
5 10477 else
5 10478 ac:= 0;
5 10479 end
4 10480 else ac:= 6; <* for kort telegram - retransmitter *>
4 10481 end;
3 10482 afvent_radioinput:= ac;
3 10483 end;
2 10484 \f
2 10484 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10485
2 10485 procedure skriv_kanal_tab(z);
2 10486 zone z;
2 10487 begin
3 10488 integer array field ref;
3 10489 integer i,j,t,op,id1,id2;
3 10490
3 10490 write(z,"ff",1,"nl",1,<:
3 10491 ******** kanal-beskrivelser *******
3 10492
3 10492 a k l p m b n
3 10493 l a y a o s ø
3 10494 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10495 <*
3 10496 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10497 *>
3 10498 "nl",1);
3 10499 for i:=1 step 1 until max_antal_kanaler do
3 10500 begin
4 10501 ref:=(i-1)*kanal_beskr_længde;
4 10502 t:=kanal_tab.ref.kanal_tilstand;
4 10503 id1:=kanal_tab.ref.kanal_id1;
4 10504 id2:=kanal_tab.ref.kanal_id2;
4 10505 write(z,"nl",1,"sp",4,
4 10506 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10507 for j:=11 step -1 until 2 do
4 10508 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10509 write(z,case t extract 2 +1 of
4 10510 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10511 "sp",1);
4 10512 skriv_id(z,id1,9);
4 10513 skriv_id(z,id2,9);
4 10514 t:=kanal_tab.ref.kanal_spec;
4 10515 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10516 write(z,"nl",1,"sp",14,<:mon: :>);
4 10517 for j:= max_antal_taleveje step -1 until 1 do
4 10518 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10519 else "."),1);
4 10520 write(z,"sp",25-max_antal_taleveje);
4 10521 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10522 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10523 end;
3 10524 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10525 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10526 write(z,"nl",2);
3 10527 end skriv_kanal_tab;
2 10528 \f
2 10528 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10529
2 10529 procedure skriv_opkaldskø(z);
2 10530 zone z;
2 10531 begin
3 10532 integer i,bogst,løb,j;
3 10533 integer array field ref;
3 10534 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10535 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10536 <: sig omr :>,"nl",1);
3 10537 for i:= 1 step 1 until max_antal_mobilopkald do
3 10538 begin
4 10539 ref:= i*opkaldskø_postlængde;
4 10540 j:= opkaldskø.ref(1);
4 10541 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10542 j:= opkaldskø.ref(2);
4 10543 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10544 skriv_id(z,j extract 23,9);
4 10545 j:= opkaldskø.ref(3);
4 10546 skriv_id(z,j,7);
4 10547 j:= opkaldskø.ref(4);
4 10548 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10549 << zd>,j extract 8);
4 10550 j:= j shift (-8) extract 4;
4 10551 if j = 1 or j = 2 then
4 10552 write(z,if j=1 then <: normal:> else <: nød :>)
4 10553 else write(z,<<dddd>,j,"sp",3);
4 10554 j:= opkaldskø.ref(5);
4 10555 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10556 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10557 string område_navn(j extract 8) else <:---:>);
4 10558 outchar(z,'nl');
4 10559 end;
3 10560
3 10560 write(z,"nl",1,<<z>,
3 10561 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10562 <:første_opkald=:>,første_opkald,"nl",1,
3 10563 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10564 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10565 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10566 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10567 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10568 "nl",1,<:opkaldsflag::>,"nl",1);
3 10569 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10570 write(z,"nl",2);
3 10571 end skriv_opkaldskø;
2 10572 \f
2 10572 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10573
2 10573 procedure skriv_radio_linie_tabel(z);
2 10574 zone z;
2 10575 begin
3 10576 integer i,j,k;
3 10577
3 10577 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10578 k:= 0;
3 10579 for i:= 1 step 1 until max_linienr do
3 10580 begin
4 10581 læstegn(radio_linietabel,i+1,j);
4 10582 if j > 0 then
4 10583 begin
5 10584 k:= k +1;
5 10585 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10586 "nl",if k mod 5=0 then 1 else 0);
5 10587 end;
4 10588 end;
3 10589 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10590 end skriv_radio_linietabel;
2 10591
2 10591 procedure skriv_radio_områdetabel(z);
2 10592 zone z;
2 10593 begin
3 10594 integer i;
3 10595
3 10595 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10596 for i:= 1 step 1 until max_antal_områder do
3 10597 begin
4 10598 laf:= (i-1)*4;
4 10599 if radio_områdetabel(i)<>0 then
4 10600 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10601 radio_områdetabel(i),"nl",1);
4 10602 end;
3 10603 end skriv_radio_områdetabel;
2 10604 \f
2 10604 message procedure h_radio side 1 - 810520/hko;
2 10605
2 10605 <* hovedmodulkorutine for radiokanaler *>
2 10606 procedure h_radio;
2 10607 begin
3 10608 integer array field op_ref;
3 10609 integer k,dest_sem;
3 10610 procedure skriv_hradio(z,omfang);
3 10611 value omfang;
3 10612 zone z;
3 10613 integer omfang;
3 10614 begin integer i;
4 10615 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10616 write(z,"sp",26-i);
4 10617 if omfang >0 then
4 10618 disable begin integer x;
5 10619 trap(slut);
5 10620 write(z,"nl",1,
5 10621 <: op_ref: :>,op_ref,"nl",1,
5 10622 <: k: :>,k,"nl",1,
5 10623 <: dest_sem: :>,dest_sem,"nl",1,
5 10624 <::>);
5 10625 skriv_coru(z,coru_no(400));
5 10626 slut:
5 10627 end;
4 10628 end skriv_hradio;
3 10629
3 10629 trap(hrad_trap);
3 10630 stack_claim(if cm_test then 198 else 146);
3 10631
3 10631 <*+2*> if testbit32 and overvåget or testbit28 then
3 10632 skriv_hradio(out,0);
3 10633 <*-2*>
3 10634 \f
3 10634 message procedure h_radio side 2 - 820304/hko;
3 10635
3 10635 repeat
3 10636 wait_ch(cs_rad,op_ref,true,-1);
3 10637 <*+2*>if testbit33 and overvåget then
3 10638 disable begin
4 10639 skriv_h_radio(out,0);
4 10640 write(out,<: operation modtaget:>);
4 10641 skriv_op(out,op_ref);
4 10642 end;
3 10643 <*-2*>
3 10644 <*+4*>
3 10645 if (d.op_ref.optype and
3 10646 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10647 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10648 <*-4*>
3 10649
3 10649 k:=d.op_ref.op_kode extract 12;
3 10650 dest_sem:=
3 10651 if k > 0 and k < 7
3 10652 or k=11 or k=12 or k=19
3 10653 or (72<=k and k<=74) or k = 77
3 10654 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10655 then cs_radio_adm
3 10656 else if k=41 <* radiokommando fra operatør *>
3 10657 then cs_radio(d.opref.data(1)) else -1;
3 10658 <*+4*>
3 10659 if dest_sem<1 then
3 10660 begin
4 10661 if dest_sem<0 then
4 10662 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10663 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10664 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10665 end
3 10666 else
3 10667 <*-4*>
3 10668 begin <* operationskode ok *>
4 10669 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10670 end;
3 10671 until false;
3 10672
3 10672 hrad_trap:
3 10673 disable skriv_hradio(zbillede,1);
3 10674 end h_radio;
2 10675 \f
2 10675 message procedure radio side 1 - 820301/hko;
2 10676
2 10676 procedure radio(talevej,op);
2 10677 value talevej,op;
2 10678 integer talevej,op;
2 10679 begin
3 10680 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10681 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10682 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10683 integer array felt,værdi(1:8);
3 10684 boolean byt,nød,frigiv_samtale;
3 10685 real kl;
3 10686 real field rf;
3 10687
3 10687 procedure skriv_radio(z,omfang);
3 10688 value omfang;
3 10689 zone z;
3 10690 integer omfang;
3 10691 begin integer i1;
4 10692 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10693 write(z,"sp",26-i1);
4 10694 if omfang > 0 then
4 10695 disable begin real x;
5 10696 trap(slut);
5 10697 \f
5 10697 message procedure radio side 1a- 820301/hko;
5 10698
5 10698 write(z,"nl",1,
5 10699 <: op_ref: :>,op_ref,"nl",1,
5 10700 <: opref1: :>,opref1,"nl",1,
5 10701 <: iaf: :>,iaf,"nl",1,
5 10702 <: iaf1: :>,iaf1,"nl",1,
5 10703 <: vt-op: :>,vt_op,"nl",1,
5 10704 <: rad-op: :>,rad_op,"nl",1,
5 10705 <: rf: :>,rf,"nl",1,
5 10706 <: nr: :>,nr,"nl",1,
5 10707 <: i: :>,i,"nl",1,
5 10708 <: j: :>,j,"nl",1,
5 10709 <: k: :>,k,"nl",1,
5 10710 <: operatør: :>,operatør,"nl",1,
5 10711 <: tilst: :>,tilst,"nl",1,
5 10712 <: res: :>,res,"nl",1,
5 10713 <: opgave: :>,opgave,"nl",1,
5 10714 <: type: :>,type,"nl",1,
5 10715 <: bus: :>,bus,"nl",1,
5 10716 <: ll: :>,ll,"nl",1,
5 10717 <: ttmm: :>,ttmm,"nl",1,
5 10718 <: vogn: :>,vogn,"nl",1,
5 10719 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10720 <: vtop2: :>,vtop2,"nl",1,
5 10721 <: vtop3: :>,vtop3,"nl",1,
5 10722 <: sig: :>,sig,"nl",1,
5 10723 <: omr: :>,omr,"nl",1,
5 10724 <: garage: :>,garage,"nl",1,
5 10725 <<-dddddd'-dd>,
5 10726 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10727 <:samtaleflag: :>,"nl",1);
5 10728 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10729 skriv_coru(z,coru_no(410+talevej));
5 10730 slut:
5 10731 end;<*disable*>
4 10732 end skriv_radio;
3 10733 \f
3 10733 message procedure udtag_opkald side 1 - 820301/hko;
3 10734
3 10734 integer
3 10735 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10736 value vogn, operatør;
3 10737 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10738 begin
4 10739 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10740 integer array field vt_op,ref,næste,forrige;
4 10741 integer array field iaf1;
4 10742 boolean skal_ud;
4 10743
4 10743 boolean procedure skal_udskrives(fordelt,aktuel);
4 10744 value fordelt,aktuel;
4 10745 integer fordelt,aktuel;
4 10746 begin
5 10747 boolean skal;
5 10748 integer n;
5 10749 integer array field iaf;
5 10750
5 10750 skal:= true;
5 10751 if fordelt > 0 and fordelt<>aktuel then
5 10752 begin
6 10753 for n:= 0 step 1 until 3 do
6 10754 begin
7 10755 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10756 begin
8 10757 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10758 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10759 goto returner;
8 10760 end;
7 10761 end;
6 10762 end;
5 10763 returner:
5 10764 skal_udskrives:= skal;
5 10765 end;
4 10766
4 10766 l:= b:= tm:= t:= 0;
4 10767 garage:= sig:= 0;
4 10768 res:= -1;
4 10769 <*V*> wait(bs_opkaldskø_adgang);
4 10770 ref:= første_nødopkald;
4 10771 if ref <> 0 then
4 10772 t:= 2
4 10773 else
4 10774 begin
5 10775 ref:= første_opkald;
5 10776 t:= if ref = 0 then 0 else 1;
5 10777 end;
4 10778 if t = 0 then res:= +19 <*kø er tom*> else
4 10779 if vogn=0 and omr=0 then
4 10780 begin
5 10781 while ref <> 0 and res = -1 do
5 10782 begin
6 10783 nr:= opkaldskø.ref(4) extract 8;
6 10784 if nr>64 then
6 10785 begin
7 10786 <*opk. primærfordelt til gruppe af btj.pl.*>
7 10787 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 10788 while skal_ud and i<max_antal_operatører do
7 10789 begin
8 10790 i:=i+1;
8 10791 if læsbit_ia(bpl_def.iaf1,i) then
8 10792 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 10793 end;
7 10794 end
6 10795 else
6 10796 skal_ud:= skal_udskrives(nr,operatør);
6 10797
6 10797 if skal_ud then
6 10798 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 10799 *>
6 10800 res:= 0
6 10801 else
6 10802 begin
7 10803 ref:= opkaldskø.ref(1) extract 12;
7 10804 if ref = 0 and t = 2 then
7 10805 begin
8 10806 ref:= første_opkald;
8 10807 t:= if ref = 0 then 0 else 1;
8 10808 end else if ref = 0 then t:= 0;
7 10809 end;
6 10810 end; <*while*>
5 10811 \f
5 10811 message procedure udtag_opkald side 2 - 820304/hko;
5 10812
5 10812 if ref <> 0 then
5 10813 begin
6 10814 b:= opkaldskø.ref(2);
6 10815 <*+4*> if b < 0 then
6 10816 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 10817 <:nødopkald(besvaret/ej meldt):>,1);
6 10818 <*-4*>
6 10819 garage:=b shift(-14) extract 8;
6 10820 b:= b extract 14;
6 10821 l:= opkaldskø.ref(3);
6 10822 tm:= opkaldskø.ref(4);
6 10823 o:= tm extract 8;
6 10824 tm:= tm shift(-12);
6 10825 omr:= opkaldskø.ref(5) extract 8;
6 10826 sig:= opkaldskø.ref(5) shift (-20);
6 10827 end
5 10828 else res:=19; <* kø er tom *>
5 10829 end <*vogn=0 and omr=0 *>
4 10830 else
4 10831 begin
5 10832 <* vogn<>0 or omr<>0 *>
5 10833 i:= 0; tilst:= -1;
5 10834 if vogn shift(-22) = 1 then
5 10835 begin
6 10836 i:= find_busnr(vogn,nr,garage,tilst);
6 10837 l:= vogn;
6 10838 end
5 10839 else
5 10840 if vogn<>0 and (omr=0 or omr>2) then
5 10841 begin
6 10842 o:= 0;
6 10843 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 10844 if i=(-2) then
6 10845 begin
7 10846 o:= omr;
7 10847 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 10848 end;
6 10849 nr:= vogn extract 14;
6 10850 end
5 10851 else nr:= vogn extract 14;
5 10852 if i<0 then ref:= 0;
5 10853 while ref <> 0 and res = -1 do
5 10854 begin
6 10855 i:= opkaldskø.ref(2) extract 14;
6 10856 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 10857 if nr = i and
6 10858 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 10859 else
6 10860 begin
7 10861 ref:= opkaldskø.ref(1) extract 12;
7 10862 if ref = 0 and t = 2 then
7 10863 begin
8 10864 ref:= første_opkald;
8 10865 t:= if ref = 0 then 0 else 1;
8 10866 end else if ref = 0 then t:= 0;
7 10867 end;
6 10868 end; <*while*>
5 10869 \f
5 10869 message procedure udtag_opkald side 3 - 810603/hko;
5 10870
5 10870 if ref <> 0 then
5 10871 begin
6 10872 b:= nr;
6 10873 tm:= opkaldskø.ref(4);
6 10874 o:= tm extract 8;
6 10875 tm:= tm shift(-12);
6 10876 omr:= opkaldskø.ref(5) extract 4;
6 10877 sig:= opkaldskø.ref(5) shift (-20);
6 10878
6 10878 <*+4*> if tilst <> -1 then
6 10879 fejlreaktion(3<*prg.fejl*>,tilst,
6 10880 <:vogntabel_tilstand for vogn i kø:>,1);
6 10881 <*-4*>
6 10882 end;
5 10883 end;
4 10884
4 10884 if ref <> 0 then
4 10885 begin
5 10886 næste:= opkaldskø.ref(1);
5 10887 forrige:= næste shift(-12);
5 10888 næste:= næste extract 12;
5 10889 if forrige <> 0 then
5 10890 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 10891 + næste
5 10892 else if t = 1 then første_opkald:= næste
5 10893 else <*if t = 2 then*> første_nødopkald:= næste;
5 10894
5 10894 if næste <> 0 then
5 10895 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 10896 + forrige shift 12
5 10897 else if t = 1 then sidste_opkald:= forrige
5 10898 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 10899
5 10899 opkaldskø.ref(1):=første_frie_opkald;
5 10900 første_frie_opkald:=ref;
5 10901
5 10901 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 10902 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 10903 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 10904 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 10905 else
5 10906 begin
6 10907 sætbit_ia(opkaldsflag,operatør,1);
6 10908 sætbit_ia(opkaldsflag,o,1);
6 10909 end;
5 10910 signal_bin(bs_mobil_opkald);
5 10911 end;
4 10912 \f
4 10912 message procedure udtag_opkald side 4 - 810531/hko;
4 10913
4 10913 signal_bin(bs_opkaldskø_adgang);
4 10914 bus:= b;
4 10915 type:= t;
4 10916 ll:= l;
4 10917 ttmm:= tm;
4 10918 udtag_opkald:= res;
4 10919 end udtag opkald;
3 10920 \f
3 10920 message procedure frigiv_kanal side 1 - 810603/hko;
3 10921
3 10921 procedure frigiv_kanal(nr);
3 10922 value nr;
3 10923 integer nr;
3 10924 begin
4 10925 integer id1, id2, omr, i;
4 10926 integer array field iaf, vt_op;
4 10927
4 10927 iaf:= (nr-1)*kanal_beskrlængde;
4 10928 id1:= kanal_tab.iaf.kanal_id1;
4 10929 id2:= kanal_tab.iaf.kanal_id2;
4 10930 omr:= kanal_til_omr(nr);
4 10931 if id1 <> 0 then
4 10932 wait(ss_samtale_nedlagt(nr));
4 10933 if id1 shift (-22) < 3 and omr > 2 then
4 10934 begin
5 10935 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 10936 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10937 if id1 shift (-22) = 2 then 18 else 17);
5 10938 d.vt_op.data(1):= id1;
5 10939 d.vt_op.data(4):= omr;
5 10940 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 10941 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 10942 signalch(cs_vt_adgang,vt_op,true);
5 10943 end;
4 10944
4 10944 if id2 <> 0 and id2 shift(-20) <> 12 then
4 10945 wait(ss_samtale_nedlagt(nr));
4 10946 if id2 shift (-22) < 3 and omr > 2 then
4 10947 begin
5 10948 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 10949 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10950 if id2 shift (-22) = 2 then 18 else 17);
5 10951 d.vt_op.data(1):= id2;
5 10952 d.vt_op.data(4):= omr;
5 10953 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 10954 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 10955 signalch(cs_vt_adgang,vt_op,true);
5 10956 end;
4 10957
4 10957 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 10958 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 10959 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 10960 shift (-10) extract 6 shift 10;
4 10961 <* repeat
4 10962 inspect(ss_samtale_nedlagt(nr),i);
4 10963 if i>0 then wait(ss_samtale_nedlagt(nr));
4 10964 until i<=0;
4 10965 *>
4 10966 end frigiv_kanal;
3 10967 \f
3 10967 message procedure hookoff side 1 - 880901/cl;
3 10968
3 10968 integer procedure hookoff(talevej,op,retursem,flash);
3 10969 value talevej,op,retursem,flash;
3 10970 integer talevej,op,retursem;
3 10971 boolean flash;
3 10972 begin
4 10973 integer array field opref;
4 10974
4 10974 opref:= op;
4 10975 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 10976 d.opref.data(1):= talevej;
4 10977 d.opref.data(2):= if flash then 2 else 1;
4 10978 signalch(cs_radio_ud,opref,rad_optype);
4 10979 <*V*> waitch(retursem,opref,rad_optype,-1);
4 10980 hookoff:= d.opref.resultat;
4 10981 end;
3 10982 \f
3 10982 message procedure hookon side 1 - 880901/cl;
3 10983
3 10983 integer procedure hookon(talevej,op,retursem);
3 10984 value talevej,op,retursem;
3 10985 integer talevej,op,retursem;
3 10986 begin
4 10987 integer i,res;
4 10988 integer array field opref;
4 10989
4 10989 if læsbit_ia(hookoff_maske,talevej) then
4 10990 begin
5 10991 inspect(bs_talevej_udkoblet(talevej),i);
5 10992 if i<=0 then
5 10993 begin
6 10994 opref:= op;
6 10995 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 10996 d.opref.data(1):= talevej;
6 10997 signalch(cs_radio_ud,opref,rad_optype);
6 10998 <*V*> waitch(retursem,opref,rad_optype,-1);
6 10999 res:= d.opref.resultat;
6 11000 end
5 11001 else
5 11002 res:= 0;
5 11003
5 11003 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 11004 end
4 11005 else
4 11006 res:= 0;
4 11007
4 11007 sætbit_ia(hookoff_maske,talevej,0);
4 11008 hookon:= res;
4 11009 end;
3 11010 \f
3 11010 message procedure radio side 2 - 820304/hko;
3 11011
3 11011 rad_op:= op;
3 11012
3 11012 trap(radio_trap);
3 11013 stack_claim((if cm_test then 200 else 150) +200);
3 11014
3 11014 <*+2*>if testbit32 and overvåget or testbit28 then
3 11015 skriv_radio(out,0);
3 11016 <*-2*>
3 11017 repeat
3 11018 waitch(cs_radio(talevej),opref,true,-1);
3 11019 <*+2*>
3 11020 if testbit33 and overvåget then
3 11021 disable begin
4 11022 skriv_radio(out,0);
4 11023 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 11024 skriv_op(out,opref);
4 11025 end;
3 11026 <*-2*>
3 11027
3 11027 k:= d.op_ref.opkode extract 12;
3 11028 opgave:= d.opref.opkode shift (-12);
3 11029 operatør:= d.op_ref.data(4);
3 11030
3 11030 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 11031 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 11032 <:radio:>,0);
3 11033 <*-4*>
3 11034 \f
3 11034 message procedure radio side 3 - 880930/cl;
3 11035 if k=41 <*radiokommando fra operatør*> then
3 11036 begin
4 11037 vogn:= d.opref.data(2);
4 11038 res:= -1;
4 11039 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 11040 sig:= 0; omr:= d.opref.data(3) extract 8;
4 11041 bus:= garage:= ll:= 0;
4 11042
4 11042 if opgave=1 or opgave=9 then
4 11043 begin <* opkald til enkelt vogn (CHF) *>
5 11044 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 11045 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 11046 <* ok at kø er tom når vogn er angivet eller VHF *>
5 11047
5 11047 d.opref.data(11):= if res=0 then
5 11048 (if ll<>0 then ll else bus) else vogn;
5 11049
5 11049 if type=2 <*nød*> then
5 11050 begin
6 11051 waitch(cs_radio_pulje,opref1,true,-1);
6 11052 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 11053 d.opref1.data(1):= if ll<>0 then ll else bus;
6 11054 systime(5,0,kl);
6 11055 d.opref1.data(2):= entier(kl/100.0);
6 11056 d.opref1.data(3):= omr;
6 11057 signalch(cs_io,opref1,gen_optype or rad_optype);
6 11058 end
5 11059 end; <* enkeltvogn (CHF) *>
4 11060
4 11060 <* check enkeltvogn for ledig *>
4 11061 if res<=0 and omr=2<*VHF*> and bus=0 and
4 11062 (opgave=1 or opgave=9) then
4 11063 begin
5 11064 for i:= 1 step 1 until max_antal_kanaler do
5 11065 if kanal_til_omr(i)=2 then nr:= i;
5 11066 iaf:= (nr-1)*kanalbeskrlængde;
5 11067 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 11068 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 11069 then res:= 52;
5 11070 end;
4 11071 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 11072 d.opref.data(3)=0 <*std. omr*>) and
4 11073 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 11074 then
4 11075 begin
5 11076 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 11077 if vogn shift (-22) = 1 then
5 11078 begin
6 11079 find_busnr(vogn,bus,garage,res);
6 11080 ll:= vogn;
6 11081 end
5 11082 else
5 11083 if vogn shift (-22) = 0 then
5 11084 begin
6 11085 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 11086 bus:= vogn;
6 11087 end
5 11088 else
5 11089 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 11090 res:= if res=(-1) then 18 <* i kø *> else
5 11091 (if res<>0 then 14 <*opt*> else 0);
5 11092 end
4 11093 else
4 11094 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 11095 opgave <= 2 then
4 11096 begin
5 11097 bus:= vogn; garage:= type:= ttmm:= 0;
5 11098 res:= 0; omr:= 0; sig:= 0;
5 11099 end
4 11100 else
4 11101 if opgave>1 and opgave<>9 then
4 11102 type:= ttmm:= res:= 0;
4 11103 \f
4 11103 message procedure radio side 4 - 880930/cl;
4 11104
4 11104 if res=0 and (opgave<=4 or opgave=9) and
4 11105 (omr<1 or 2<omr) and
4 11106 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 11107 begin <* reserver i vogntabel *>
5 11108 waitch(cs_vt_adgang,vt_op,true,-1);
5 11109 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11110 if opgave <=2 or opgave=9 then 15 else 16);
5 11111 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 11112 (if vogn=0 then garage shift 14 + bus else
5 11113 if ll<>0 then ll else garage shift 14 + bus)
5 11114 else vogn <*gruppeid*>;
5 11115 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 11116 d.opref.data(3) extract 8
5 11117 else omr extract 8;
5 11118 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 11119 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 11120
5 11120 res:= d.vt_op.resultat;
5 11121 if res=3 then res:= 0;
5 11122 vtop2:= d.vt_op.data(2);
5 11123 vtop3:= d.vt_op.data(3);
5 11124 tekn_inf:= d.vt_op.data(4);
5 11125 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 11126 end;
4 11127
4 11127 if res<>0 then
4 11128 begin
5 11129 d.opref.resultat:= res;
5 11130 signalch(d.opref.retur,opref,d.opref.optype);
5 11131 end
4 11132 else
4 11133
4 11133 if opgave <= 9 then
4 11134 begin <* opkald *>
5 11135 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 11136 opgave<>9 and d.opref.data(6)<>0);
5 11137
5 11137 if res<>0 then
5 11138 goto returner_op;
5 11139
5 11139 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 11140 begin
6 11141 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 11142 'H' shift 12 + 60);
6 11143 d.rad_op.data(1):= talevej;
6 11144 d.rad_op.data(2):= 'D';
6 11145 d.rad_op.data(3):= 6; <* rear *>
6 11146 d.rad_op.data(4):= 1; <* rear no *>
6 11147 d.rad_op.data(5):= 0; <* disconnect *>
6 11148 signalch(cs_radio_ud,rad_op,rad_optype);
6 11149 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 11150 if d.rad_op.resultat<>0 then
6 11151 begin
7 11152 res:= d.rad_op.resultat;
7 11153 goto returner_op;
7 11154 end;
6 11155 <*
6 11156 while optaget_flag shift (-1) <> 0 do
6 11157 delay(1);
6 11158 *>
6 11159 end;
5 11160 \f
5 11160 message procedure radio side 5 - 880930/cl;
5 11161
5 11161 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 11162 'B' shift 12 + 60);
5 11163 d.rad_op.data(1):= talevej;
5 11164 d.rad_op.data(2):= 'D';
5 11165 d.rad_op.data(3):= if opgave=9 then 3 else
5 11166 (2 - (opgave extract 1)); <* højttalerkode *>
5 11167
5 11167 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11168 begin
6 11169 j:= 0;
6 11170 for i:= 2 step 1 until max_antal_områder do
6 11171 begin
7 11172 if opgave > 6 or
7 11173 (d.opref.data(3) shift (-20) = 15 and
7 11174 læsbiti(d.opref.data(3),i)) or
7 11175 (d.opref.data(3) shift (-20) = 14 and
7 11176 d.opref.data(3) extract 20 = i)
7 11177 then
7 11178 begin
8 11179 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11180 begin
9 11181 j:= j+1;
9 11182 d.rad_op.data(10+(j-1)*2):=
9 11183 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11184 (if i=2<*VHF*> then 4 else k)
9 11185 shift 8 + <* signal type *>
9 11186 1; <* antal tno *>
9 11187 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11188 end;
8 11189 end;
7 11190 end;
6 11191 d.rad_op.data(4):= j;
6 11192 d.rad_op.data(5):= 0;
6 11193 end
5 11194 else
5 11195 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11196 begin
6 11197 d.rad_op.data(4):= vtop2;
6 11198 d.rad_op.data(5):= vtop3;
6 11199 end
5 11200 else
5 11201 begin <* enkeltvogn *>
6 11202 if omr=0 then
6 11203 begin
7 11204 sig:= tekn_inf shift (-23);
7 11205 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11206 else tekn_inf extract 8;
7 11207 end
6 11208 else
6 11209 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11210
6 11210 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11211 <* tvinges til alm. opkald *>
6 11212 if (opgave=9) and (type=2) and (omr<=3) then
6 11213 begin
7 11214 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11215 opgave:= 1;
7 11216 d.radop.data(3):= 1;
7 11217 end;
6 11218
6 11218 if omr=2 <*VHF*> then sig:= 4 else
6 11219 if omr=1 <*TLF*> then sig:= 7 else
6 11220 <*UHF*> sig:= sig+1;
6 11221 d.rad_op.data(4):= 1;
6 11222 d.rad_op.data(5):= 0;
6 11223 d.rad_op.data(10):=
6 11224 (område_id(omr,2) extract 12) shift 12 +
6 11225 sig shift 8 +
6 11226 1;
6 11227 d.rad_op.data(11):= bus;
6 11228 end;
5 11229 \f
5 11229 message procedure radio side 6 - 880930/cl;
5 11230
5 11230 signalch(cs_radio_ud,rad_op,rad_optype);
5 11231 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11232 res:= d.rad_op.resultat;
5 11233
5 11233 d.rad_op.data(6):= 0;
5 11234 for i:= 1 step 1 until max_antal_områder do
5 11235 if læsbiti(d.rad_op.data(7),i) then
5 11236 increase(d.rad_op.data(6));
5 11237 returner_op:
5 11238 if d.rad_op.data(6)=1 then
5 11239 begin
6 11240 for i:= 1 step 1 until max_antal_områder do
6 11241 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11242 d.opref.data(12):= 14 shift 20 + i;
6 11243 end
5 11244 else
5 11245 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11246 d.opref.data(7):= type;
5 11247 d.opref.data(8):= garage shift 14 + bus;
5 11248 d.opref.data(9):= ll;
5 11249 if res=0 then
5 11250 begin
6 11251 d.opref.resultat:= 3;
6 11252 d.opref.data(5):= d.opref.data(6);
6 11253 j:= 0;
6 11254 for i:= 1 step 1 until max_antal_kanaler do
6 11255 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11256 if j>1 then
6 11257 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11258 else
6 11259 begin
7 11260 j:= 0;
7 11261 for i:= 1 step 1 until max_antal_kanaler do
7 11262 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11263 d.opref.data(6):= 3 shift 22 + j;
7 11264 end;
6 11265 d.opref.data(7):= type;
6 11266 d.opref.data(8):= garage shift 14 + bus;
6 11267 d.opref.data(9):= ll;
6 11268 d.opref.data(10):= d.opref.data(6);
6 11269 for i:= 1 step 1 until max_antal_kanaler do
6 11270 begin
7 11271 if læsbiti(d.rad_op.data(9),i) then
7 11272 begin
8 11273 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11274 j:= pabx_id( kanal_id(i) extract 5 )
8 11275 else
8 11276 j:= radio_id( kanal_id(i) extract 5 );
8 11277 if j>0 and type=0 then tæl_opkald(j,1);
8 11278
8 11278 iaf:= (i-1)*kanalbeskrlængde;
8 11279 skrivtegn(kanal_tab.iaf,1,talevej);
8 11280 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11281 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11282 kanal_tab.iaf.kanal_id1:=
8 11283 if opgave<=2 or opgave=9 then
8 11284 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11285 else
8 11286 d.opref.data(2);
8 11287 kanal_tab.iaf.kanal_alt_id1:=
8 11288 if opgave<=2 or opgave=9 then
8 11289 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11290 else
8 11291 0;
8 11292 if kanal_tab.iaf.kanal_id1=0 then
8 11293 kanal_tab.iaf.kanal_id1:= 10000;
8 11294 kanal_tab.iaf.kanal_spec:=
8 11295 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11296 end;
7 11297 end;
6 11298 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11299 sætbit_ia(kanalflag,operatør,1);
6 11300 \f
6 11300 message procedure radio side 7 - 880930/cl;
6 11301
6 11301 end
5 11302 else
5 11303 begin
6 11304 d.opref.resultat:= res;
6 11305 if res=22 or res=52 then
6 11306 begin <* tæl ej.forb og opt.kanal *>
7 11307 for i:= 1 step 1 until max_antal_områder do
7 11308 if læsbiti(d.rad_op.data(7),i) then
7 11309 tæl_opkald(i,(if res=22 then 4 else 5));
7 11310 end;
6 11311 if d.opref.data(6)=0 then
6 11312 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11313 <* frigiv fra vogntabel hvis reserveret *>
6 11314 if (opgave<=4 or opgave=9) and
6 11315 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11316 begin
7 11317 waitch(cs_vt_adgang,vt_op,true,-1);
7 11318 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11319 if opgave<=2 or opgave=9 then 17 else 18);
7 11320 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11321 (if vogn=0 then garage shift 14 + bus else
7 11322 if ll<>0 then ll else garage shift 14 + bus)
7 11323 else vogn;
7 11324 d.vt_op.data(4):= omr;
7 11325 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11326 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11327 signalch(cs_vt_adgang,vt_op,true);
7 11328 end;
6 11329 end;
5 11330 signalch(d.opref.retur,opref,d.opref.optype);
5 11331 \f
5 11331 message procedure radio side 8 - 880930/cl;
5 11332
5 11332 end <* opkald *>
4 11333 else
4 11334 if opgave = 10 <* MONITER *> then
4 11335 begin
5 11336 nr:= d.opref.data(2);
5 11337 if nr shift (-20) <> 12 then
5 11338 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11339 nr:= nr extract 20;
5 11340 iaf:= (nr-1)*kanalbeskrlængde;
5 11341 inspect(ss_samtale_nedlagt(nr),i);
5 11342 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11343 kanal_tab.iaf.kanal_id2 extract 20
5 11344 else
5 11345 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11346 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11347 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11348 (i<>0 or j<>0) then
5 11349 begin
6 11350 res:= 0;
6 11351 d.opref.data(5):= 12 shift 20 + k;
6 11352 d.opref.data(6):= 12 shift 20 + nr;
6 11353 sætbit_ia(kanalflag,operatør,1);
6 11354 goto radio_nedlæg;
6 11355 end
5 11356 else
5 11357 if i<>0 or j<>0 then
5 11358 res:= 49
5 11359 else
5 11360 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11361 res:= 49 <* ingen samtale igang *>
5 11362 else
5 11363 begin
6 11364 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11365 if res=0 then
6 11366 begin
7 11367 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11368 'B' shift 12 + 60);
7 11369 d.rad_op.data(1):= talevej;
7 11370 d.rad_op.data(2):= 'V';
7 11371 d.rad_op.data(3):= 0;
7 11372 d.rad_op.data(4):= 1;
7 11373 d.rad_op.data(5):= 0;
7 11374 d.rad_op.data(10):=
7 11375 (kanal_id(nr) shift (-5) shift 18) +
7 11376 (kanal_id(nr) extract 5 shift 12) + 0;
7 11377 signalch(cs_radio_ud,rad_op,rad_optype);
7 11378 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11379 res:= d.rad_op.resultat;
7 11380 if res=0 then
7 11381 begin
8 11382 d.opref.data(5):= 0;
8 11383 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11384 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11385 res:= 3;
8 11386 end;
7 11387 end;
6 11388 end;
5 11389 \f
5 11389 message procedure radio side 9 - 880930/cl;
5 11390 if res=3 then
5 11391 begin
6 11392 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11393 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11394 else
6 11395 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11396 d.opref.data(6):= 12 shift 20 + nr;
6 11397 i:= kanal_tab.iaf.kanal_id2;
6 11398 if i<>0 then
6 11399 begin
7 11400 if i shift (-20) = 12 then
7 11401 begin <* ident2 henviser til anden kanal *>
8 11402 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11403 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11404 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11405 else
8 11406 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11407 d.opref.data(5):= 12 shift 20 + i;
8 11408 end
7 11409 else
7 11410 d.opref.data(5):= 12 shift 20 + nr;
7 11411 end
6 11412 else
6 11413 d.opref.data(5):= 0;
6 11414 end;
5 11415
5 11415 if res<>3 then
5 11416 begin
6 11417 res:= 0;
6 11418 sætbit_ia(kanalflag,operatør,1);
6 11419 goto radio_nedlæg;
6 11420 end;
5 11421 d.opref.resultat:= res;
5 11422 signalch(d.opref.retur,opref,d.opref.optype);
5 11423 \f
5 11423 message procedure radio side 10 - 880930/cl;
5 11424
5 11424 end <* MONITERING *>
4 11425 else
4 11426 if opgave = 11 then <* GENNEMSTILLING *>
4 11427 begin
5 11428 nr:= d.opref.data(6) extract 20;
5 11429 k:= if d.opref.data(5) shift (-20) = 12 then
5 11430 d.opref.data(5) extract 20
5 11431 else
5 11432 0;
5 11433 inspect(ss_samtale_nedlagt(nr),i);
5 11434 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11435 if i<>0 and j<>0 then
5 11436 begin
6 11437 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11438 goto radio_nedlæg;
6 11439 end;
5 11440
5 11440 iaf:= (nr-1)*kanal_beskr_længde;
5 11441 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11442 begin
6 11443 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11444 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11445 then
6 11446 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11447 else
6 11448 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11449 d.opref.data(5)<>0
6 11450 then
6 11451 res:= 0
6 11452 else
6 11453 res:= 21; <* ingen at gennemstille til *>
6 11454 end
5 11455 else
5 11456 res:= 50; <* kanalnr *>
5 11457
5 11457 if res=0 then
5 11458 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11459 if res=0 then
5 11460 begin
6 11461 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11462 kanal_tab.iaf.kanal_tilstand:=
6 11463 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11464 d.opref.data(6):= 0;
6 11465 if kanal_tab.iaf.kanal_id2=0 then
6 11466 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11467
6 11467 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11468 begin <* gennemstillet til anden kanal *>
7 11469 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11470 *kanalbeskrlængde;
7 11471 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11472 kanal_tab.iaf1.kanal_tilstand:=
7 11473 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11474 if kanal_tab.iaf1.kanal_id2=0 then
7 11475 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11476 end;
6 11477 d.opref.data(5):= 0;
6 11478
6 11478 res:= 3;
6 11479 end;
5 11480
5 11480 d.opref.resultat:= res;
5 11481 signalch(d.opref.retur,opref,d.opref.optype);
5 11482 \f
5 11482 message procedure radio side 11 - 880930/cl;
5 11483
5 11483 end
4 11484 else
4 11485 if opgave = 12 then <* NEDLÆG *>
4 11486 begin
5 11487 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11488 radio_nedlæg:
5 11489 if res=0 then
5 11490 begin
6 11491 for k:= 5, 6 do
6 11492 begin
7 11493 if d.opref.data(k) shift (-20) = 12 then
7 11494 begin
8 11495 i:= d.opref.data(k) extract 20;
8 11496 iaf:= (i-1)*kanalbeskrlængde;
8 11497 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11498 frigiv_kanal(d.opref.data(k) extract 20)
8 11499 else
8 11500 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11501 end
7 11502 else
7 11503 if d.opref.data(k) shift (-20) = 13 then
7 11504 begin
8 11505 for i:= 1 step 1 until max_antal_kanaler do
8 11506 if læsbiti(d.opref.data(k),i) then
8 11507 begin
9 11508 iaf:= (i-1)*kanalbeskrlængde;
9 11509 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11510 frigiv_kanal(i)
9 11511 else
9 11512 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11513 end;
8 11514 sætbit_ia(kanalflag,operatør,1);
8 11515 end;
7 11516 end;
6 11517 d.opref.data(5):= 0;
6 11518 d.opref.data(6):= 0;
6 11519 d.opref.data(9):= 0;
6 11520 res:= if opgave=12 then 3 else 49;
6 11521 end;
5 11522 d.opref.resultat:= res;
5 11523 signalch(d.opref.retur,opref,d.opref.optype);
5 11524 end
4 11525 else
4 11526 if opgave=13 then <* R *>
4 11527 begin
5 11528 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11529 'H' shift 12 + 60);
5 11530 d.rad_op.data(1):= talevej;
5 11531 d.rad_op.data(2):= 'M';
5 11532 d.rad_op.data(3):= 0; <*tkt*>
5 11533 d.rad_op.data(4):= 0; <*tkn*>
5 11534 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11535 signalch(cs_radio_ud,rad_op,rad_optype);
5 11536 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11537 res:= d.rad_op.resultat;
5 11538 d.opref.resultat:= if res=0 then 3 else res;
5 11539 signalch(d.opref.retur,opref,d.opref.optype);
5 11540 end
4 11541 else
4 11542 if opgave=14 <* VENTEPOS *> then
4 11543 begin
5 11544 res:= 0;
5 11545 while (res<=3 and d.opref.data(2)>0) do
5 11546 begin
6 11547 nr:= d.opref.data(6) extract 20;
6 11548 k:= if d.opref.data(5) shift (-20) = 12 then
6 11549 d.opref.data(5) extract 20
6 11550 else
6 11551 0;
6 11552 inspect(ss_samtale_nedlagt(nr),i);
6 11553 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11554 if i<>0 or j<>0 then
6 11555 begin
7 11556 res:= hookon(talevej,radop,cs_radio(talevej));
7 11557 goto radio_nedlæg;
7 11558 end;
6 11559
6 11559 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11560
6 11560 if res=0 then
6 11561 begin
7 11562 i:= d.opref.data(5);
7 11563 d.opref.data(5):= d.opref.data(6);
7 11564 d.opref.data(6):= i;
7 11565 res:= 3;
7 11566 end;
6 11567
6 11567 d.opref.data(2):= d.opref.data(2)-1;
6 11568 end;
5 11569 d.opref.resultat:= res;
5 11570 signalch(d.opref.retur,opref,d.opref.optype);
5 11571 end
4 11572 else
4 11573 begin
5 11574 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11575 d.opref.resultat:= 31;
5 11576 signalch(d.opref.retur,opref,d.opref.optype);
5 11577 end;
4 11578
4 11578 end <* radiokommando fra operatør *>
3 11579 else
3 11580 begin
4 11581
4 11581 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11582
4 11582 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11583
4 11583 end;
3 11584
3 11584 until false;
3 11585 radio_trap:
3 11586 disable skriv_radio(zbillede,1);
3 11587 end radio;
2 11588 \f
2 11588 message procedure radio_ind side 1 - 810521/hko;
2 11589
2 11589 procedure radio_ind(op);
2 11590 value op;
2 11591 integer op;
2 11592 begin
3 11593 integer array field op_ref,ref,io_opref;
3 11594 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11595 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11596 integer array typ, val(1:6), answ, tlgr(1:32);
3 11597 integer array field spec;
3 11598 real field rf;
3 11599 long array field laf;
3 11600
3 11600 procedure skriv_radio_ind(zud,omfang);
3 11601 value omfang;
3 11602 zone zud;
3 11603 integer omfang;
3 11604 begin integer ii;
4 11605 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11606 if omfang > 0 then
4 11607 disable begin integer x; long array field tx;
5 11608 tx:= 0;
5 11609 trap(slut);
5 11610 write(zud,"nl",1,
5 11611 <: op-ref: :>,op_ref,"nl",1,
5 11612 <: ref: :>,ref,"nl",1,
5 11613 <: io-opref: :>,io_opref,"nl",1,
5 11614 <: ac: :>,ac,"nl",1,
5 11615 <: lgd: :>,lgd,"nl",1,
5 11616 <: ttyp: :>,ttyp,"nl",1,
5 11617 <: ptyp: :>,ptyp,"nl",1,
5 11618 <: pnum: :>,pnum,"nl",1,
5 11619 <: pos: :>,pos,"nl",1,
5 11620 <: tegn: :>,tegn,"nl",1,
5 11621 <: bs: :>,bs,"nl",1,
5 11622 <: b-pt: :>,b_pt,"nl",1,
5 11623 <: b-pn: :>,b_pn,"nl",1,
5 11624 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11625 <: antal-spec: :>,antal_spec,"nl",1,
5 11626 <: sum: :>,sum,"nl",1,
5 11627 <: csum: :>,csum,"nl",1,
5 11628 <: i: :>,i,"nl",1,
5 11629 <: j: :>,j,"nl",1,
5 11630 <: k: :>,k,"nl",1,
5 11631 <: filref :>,filref,"nl",1,
5 11632 <: zno: :>,zno,"nl",1,
5 11633 <: answ: :>,answ.tx,"nl",1,
5 11634 <: tlgr: :>,tlgr.tx,"nl",1,
5 11635 <: spec: :>,spec,"nl",1);
5 11636 trap(slut);
5 11637 slut:
5 11638 end; <*disable*>
4 11639 end skriv_radio_ind;
3 11640 \f
3 11640 message procedure indsæt_opkald side 1 - 811105/hko;
3 11641
3 11641 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11642 value bus,type,omr,sig;
3 11643 integer bus,type,omr,sig;
3 11644 begin
4 11645 integer res,tilst,ll,operatør;
4 11646 integer array field vt_op,ref,næste,forrige;
4 11647 real r;
4 11648
4 11648 res:= -1;
4 11649 begin
5 11650 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11651 if vt_op <> 0 then
5 11652 begin
6 11653 wait(bs_opkaldskø_adgang);
6 11654 if omr>2 then
6 11655 begin
7 11656 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11657 d.vt_op.data(1):= bus;
7 11658 d.vt_op.data(4):= omr;
7 11659 tilst:= vt_op;
7 11660 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11661 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11662 <*+4*> if tilst <> vt_op then
7 11663 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11664 <*-4*>
7 11665 <*+2*> if testbit34 and overvåget then
7 11666 disable begin
8 11667 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11668 skriv_op(out,vt_op);
8 11669 ud;
8 11670 end;
7 11671 end
6 11672 else
6 11673 begin
7 11674 d.vt_op.data(1):= bus;
7 11675 d.vt_op.data(2):= 0;
7 11676 d.vt_op.data(3):= bus;
7 11677 d.vt_op.data(4):= omr;
7 11678 d.vt_op.resultat:= 0;
7 11679 ref:= første_nødopkald;
7 11680 if ref<>0 then tilst:= 2
7 11681 else
7 11682 begin
8 11683 ref:= første_opkald;
8 11684 tilst:= if ref=0 then 0 else 1;
8 11685 end;
7 11686 if tilst=0 then
7 11687 d.vt_op.resultat:= 3
7 11688 else
7 11689 begin
8 11690 while ref<>0 and d.vt_op.resultat=0 do
8 11691 begin
9 11692 if opkaldskø.ref(2) extract 14 = bus and
9 11693 opkaldskø.ref(5) extract 8 = omr
9 11694 then
9 11695 d.vt_op.resultat:= 18
9 11696 else
9 11697 begin
10 11698 ref:= opkaldskø.ref(1) extract 12;
10 11699 if ref=0 and tilst=2 then
10 11700 begin
11 11701 ref:= første_opkald;
11 11702 tilst:= if ref=0 then 0 else 1;
11 11703 end
10 11704 else
10 11705 if ref=0 then tilst:= 0;
10 11706 end;
9 11707 end;
8 11708 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11709 end;
7 11710 end;
6 11711 <*-2*>
6 11712 \f
6 11712 message procedure indsæt_opkald side 1a- 820301/hko;
6 11713
6 11713 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11714 begin
7 11715 ref:=første_opkald;
7 11716 tilst:=-1;
7 11717 while ref<>0 and tilst=-1 do
7 11718 begin
8 11719 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11720 begin <* udtag normalopkald *>
9 11721 næste:=opkaldskø.ref(1);
9 11722 forrige:=næste shift(-12);
9 11723 næste:=næste extract 12;
9 11724 if forrige<>0 then
9 11725 opkaldskø.forrige(1):=
9 11726 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11727 else
9 11728 første_opkald:=næste;
9 11729 if næste<>0 then
9 11730 opkaldskø.næste(1):=
9 11731 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11732 else
9 11733 sidste_opkald:=forrige;
9 11734 opkaldskø.ref(1):=første_frie_opkald;
9 11735 første_frie_opkald:=ref;
9 11736 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11737 tilst:=0;
9 11738 end
8 11739 else
8 11740 ref:=opkaldskø.ref(1) extract 12;
8 11741 end; <*while*>
7 11742 if tilst=0 then
7 11743 d.vt_op.resultat:=3;
7 11744 end; <*nødopkald bus i kø*>
6 11745 \f
6 11745 message procedure indsæt_opkald side 2 - 820304/hko;
6 11746
6 11746 if d.vt_op.resultat = 3 then
6 11747 begin
7 11748 ll:= d.vt_op.data(2);
7 11749 tilst:= d.vt_op.data(3);
7 11750 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11751 if operatør < 0 or max_antal_operatører < operatør then
7 11752 operatør:= 0;
7 11753 if operatør=0 then
7 11754 operatør:= (tilst shift (-14) extract 8);
7 11755 if operatør=0 then
7 11756 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11757 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11758 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11759 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11760 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11761 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11762 forrige:= (if type = 1 then sidste_opkald
7 11763 else sidste_nødopkald);
7 11764 opkaldskø.ref(1):= forrige shift 12;
7 11765 if type = 1 then
7 11766 begin
8 11767 if første_opkald = 0 then første_opkald:= ref;
8 11768 sidste_opkald:= ref;
8 11769 end
7 11770 else
7 11771 begin <*type = 2*>
8 11772 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11773 sidste_nødopkald:= ref;
8 11774 end;
7 11775 if forrige <> 0 then
7 11776 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11777 shift 12 +ref;
7 11778
7 11778 opkaldskø.ref(2):= tilst extract 22 add
7 11779 (if type=2 then 1 shift 23 else 0);
7 11780 opkaldskø.ref(3):= ll;
7 11781 systime(5,0.0,r);
7 11782 ll:= round r//100;<*ttmm*>
7 11783 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 11784 opkaldskø.ref(5):= sig shift 20 + omr;
7 11785 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 11786 res:= 0;
7 11787 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 11788 opkaldskø_ledige:= opkaldskø_ledige -1;
7 11789 <*meddel opkald til berørte operatører *>
7 11790 signal_bin(bs_mobil_opkald);
7 11791 tæl_opkald(omr,type+1);
7 11792 end <* resultat = 3 *>
6 11793 else
6 11794 begin
7 11795 \f
7 11795 message procedure indsæt_opkald side 3 - 810601/hko;
7 11796
7 11796 <* d.vt_op.resultat <> 3 *>
7 11797
7 11797 res:= d.vt_op.resultat;
7 11798 if res = 10 then
7 11799 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 11800 <:er ikke i bustabel:>,1)
7 11801 else
7 11802 <*+4*> if res <> 14 and res <> 18 then
7 11803 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 11804 <*-4*>
7 11805 ;
7 11806 end;
6 11807 signalbin(bs_opkaldskø_adgang);
6 11808 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 11809 end
5 11810 else
5 11811 res:= -2; <*timeout for cs_vt_adgang*>
5 11812 end;
4 11813 indsæt_opkald:= res;
4 11814 end indsæt_opkald;
3 11815 \f
3 11815 message procedure afvent_telegram side 1 - 880901/cl;
3 11816
3 11816 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 11817 integer array tlgr;
3 11818 integer lgd,ttyp,ptyp,pnum;
3 11819 begin
4 11820 integer i, pos, tegn, ac, sum, csum;
4 11821
4 11821 pos:= 1;
4 11822 lgd:= 0;
4 11823 ttyp:= 'Z';
4 11824 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 11825 if ac >= 0 then
4 11826 begin
5 11827 lgd:= 1;
5 11828 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 11829 lgd:= lgd-2;
5 11830 if lgd >= 3 then
5 11831 begin
6 11832 i:= 1;
6 11833 ttyp:= læstegn(tlgr,i,tegn);
6 11834 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 11835 pnum:= læstegn(tlgr,i,tegn) - '@';
6 11836 end
5 11837 else ac:= 6; <* for kort telegram - retransmitter *>
5 11838 end;
4 11839
4 11839 afvent_telegram:= ac;
4 11840 end;
3 11841 \f
3 11841 message procedure b_answ side 1 - 880901/cl;
3 11842
3 11842 procedure b_answ(answ,ht,spec,more,ac);
3 11843 value ht, more,ac;
3 11844 integer array answ, spec;
3 11845 boolean more;
3 11846 integer ht, ac;
3 11847 begin
4 11848 integer pos, i, sum, tegn;
4 11849
4 11849 pos:= 1;
4 11850 skrivtegn(answ,pos,'B');
4 11851 skrivtegn(answ,pos,if more then 'B' else ' ');
4 11852 skrivtegn(answ,pos,ac+'@');
4 11853 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 11854 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 11855 skrivtegn(answ,pos,'@');
4 11856 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 11857 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 11858 for i:= 1 step 1 until spec(1) extract 8 do
4 11859 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 11860 else
4 11861 begin
5 11862 skrivtegn(answ,pos,'D');
5 11863 anbringtal(answ,pos,spec(1+i),-4);
5 11864 end;
4 11865 for i:= 1 step 1 until 4 do
4 11866 skrivtegn(answ,pos,'@');
4 11867 skrivtegn(answ,pos,ht+'@');
4 11868 skrivtegn(answ,pos,'@');
4 11869
4 11869 i:= 1; sum:= 0;
4 11870 while i < pos do
4 11871 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 11872 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 11873 skrivtegn(answ,pos,sum extract 4 + '@');
4 11874 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 11875 end;
3 11876 \f
3 11876 message procedure ann_opkald side 1 - 881108/cl;
3 11877
3 11877 integer procedure ann_opkald(vogn,omr);
3 11878 value vogn,omr;
3 11879 integer vogn,omr;
3 11880 begin
4 11881 integer array field vt_op,ref,næste,forrige;
4 11882 integer res, t, i, o;
4 11883
4 11883 waitch(cs_vt_adgang,vt_op,true,-1);
4 11884 res:= -1;
4 11885 wait(bs_opkaldskø_adgang);
4 11886 ref:= første_nødopkald;
4 11887 if ref <> 0 then
4 11888 t:= 2
4 11889 else
4 11890 begin
5 11891 ref:= første_opkald;
5 11892 t:= if ref<>0 then 1 else 0;
5 11893 end;
4 11894
4 11894 if t=0 then
4 11895 res:= 19 <* kø tom *>
4 11896 else
4 11897 begin
5 11898 while ref<>0 and res=(-1) do
5 11899 begin
6 11900 if vogn=opkaldskø.ref(2) extract 14 and
6 11901 omr=opkaldskø.ref(5) extract 8
6 11902 then
6 11903 res:= 0
6 11904 else
6 11905 begin
7 11906 ref:= opkaldskø.ref(1) extract 12;
7 11907 if ref=0 and t=2 then
7 11908 begin
8 11909 ref:= første_opkald;
8 11910 t:= if ref=0 then 0 else 1;
8 11911 end;
7 11912 end;
6 11913 end; <*while*>
5 11914 \f
5 11914 message procedure ann_opkald side 2 - 881108/cl;
5 11915
5 11915 if ref<>0 then
5 11916 begin
6 11917 start_operation(vt_op,401,cs_radio_ind,17);
6 11918 d.vt_op.data(1):= vogn;
6 11919 d.vt_op.data(4):= omr;
6 11920 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 11921 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 11922
6 11922 o:= opkaldskø.ref(4) extract 8;
6 11923 næste:= opkaldskø.ref(1);
6 11924 forrige:= næste shift (-12);
6 11925 næste:= næste extract 12;
6 11926 if forrige<>0 then
6 11927 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 11928 + næste
6 11929 else
6 11930 if t=2 then første_nødopkald:= næste
6 11931 else første_opkald:= næste;
6 11932
6 11932 if næste<>0 then
6 11933 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 11934 + forrige shift 12
6 11935 else
6 11936 if t=2 then sidste_nødopkald:= forrige
6 11937 else sidste_opkald:= forrige;
6 11938
6 11938 opkaldskø.ref(1):= første_frie_opkald;
6 11939 første_frie_opkald:= ref;
6 11940 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 11941 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 11942
6 11942 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 11943 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 11944 else
6 11945 begin
7 11946 sætbit_ia(opkaldsflag,o,1);
7 11947 end;
6 11948 signalbin(bs_mobilopkald);
6 11949 end;
5 11950 end;
4 11951
4 11951 signalbin(bs_opkaldskø_adgang);
4 11952 signalch(cs_vt_adgang, vt_op, true);
4 11953 ann_opkald:= res;
4 11954 end;
3 11955 \f
3 11955 message procedure frigiv_id side 1 - 881114/cl;
3 11956
3 11956 integer procedure frigiv_id(id,omr);
3 11957 value id,omr;
3 11958 integer id,omr;
3 11959 begin
4 11960 integer array field vt_op;
4 11961
4 11961 if id shift (-22) < 3 and omr > 2 then
4 11962 begin
5 11963 waitch(cs_vt_adgang,vt_op,true,-1);
5 11964 start_operation(vt_op,401,cs_radio_ind,
5 11965 if id shift (-22) = 2 then 18 else 17);
5 11966 d.vt_op.data(1):= id;
5 11967 d.vt_op.data(4):= omr;
5 11968 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 11969 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 11970 frigiv_id:= d.vt_op.resultat;
5 11971 signalch(cs_vt_adgang,vt_op,true);
5 11972 end;
4 11973 end;
3 11974 \f
3 11974 message procedure radio_ind side 2 - 810524/hko;
3 11975 trap(radio_ind_trap);
3 11976 laf:= 0;
3 11977 stack_claim((if cm_test then 200 else 150) +135+75);
3 11978
3 11978 <*+2*>if testbit32 and overvåget or testbit28 then
3 11979 skriv_radio_ind(out,0);
3 11980 <*-2*>
3 11981 answ.laf(1):= long<:<'nl'>:>;
3 11982 io_opref:= op;
3 11983
3 11983 repeat
3 11984 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 11985 pos:= 4;
3 11986 if ac = 0 then
3 11987 begin
4 11988 \f
4 11988 message procedure radio_ind side 3 - 881107/cl;
4 11989 if ttyp = 'A' then
4 11990 begin
5 11991 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 11992 ac:= 1
5 11993 else
5 11994 begin
6 11995 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 11996 val(1):= ttyp;
6 11997 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 11998 val(2):= pnum;
6 11999 typ(3):= -1;
6 12000 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12001 if opref>0 then
6 12002 begin
7 12003 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 12004 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 12005 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 12006 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 12007 then
7 12008 begin
8 12009 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 12010 end
7 12011 else
7 12012 begin
8 12013 ac:= 0;
8 12014 d.opref.resultat:= 0;
8 12015 sætbit_ia(hookoff_maske,pnum,1);
8 12016 end;
7 12017 signalch(d.opref.retur,opref,d.opref.optype);
7 12018 end
6 12019 else
6 12020 ac:= 2;
6 12021 end;
5 12022 pos:= 1;
5 12023 skrivtegn(answ,pos,'A');
5 12024 skrivtegn(answ,pos,' ');
5 12025 skrivtegn(answ,pos,ac+'@');
5 12026 for i:= 1 step 1 until 5 do
5 12027 skrivtegn(answ,pos,'@');
5 12028 skrivtegn(answ,pos,'0');
5 12029 i:= 1; sum:= 0;
5 12030 while i < pos do
5 12031 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12032 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12033 skrivtegn(answ,pos,sum extract 4 + '@');
5 12034 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12035 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12036 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12037 disable begin
6 12038 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12039 outchar(zrl,'nl');
6 12040 end;
5 12041 <*-2*>
5 12042 disable setposition(z_fr_out,0,0);
5 12043 ac:= -1;
5 12044 \f
5 12044 message procedure radio_ind side 4 - 881107/cl;
5 12045 end <* ttyp=A *>
4 12046 else
4 12047 if ttyp = 'B' then
4 12048 begin
5 12049 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12050 ac:= 1
5 12051 else
5 12052 begin
6 12053 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 12054 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 12055 typ(3):= -1;
6 12056 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12057 if opref > 0 then
6 12058 begin
7 12059 <*+2*> if testbit37 and overvåget then
7 12060 disable begin
8 12061 skriv_radio_ind(out,0);
8 12062 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 12063 skriv_op(out,opref);
8 12064 end;
7 12065 <*-2*>
7 12066 læstegn(tlgr,pos,bs);
7 12067 if bs = 'V' then
7 12068 begin
8 12069 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 12070 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 12071 end;
7 12072 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 12073 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 12074 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 12075 then
7 12076 begin
8 12077 ac:= 1;
8 12078 d.opref.resultat:= 31; <* systemfejl *>
8 12079 signalch(d.opref.retur,opref,d.opref.optype);
8 12080 end
7 12081 else
7 12082 if bs='V' then
7 12083 begin
8 12084 ac:= 0;
8 12085 d.opref.resultat:= 1;
8 12086 d.opref.data(4):= 0;
8 12087 d.opref.data(7):=
8 12088 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 12089 radio_id(b_pn));
8 12090 systime(1,0.0,d.opref.tid);
8 12091 signalch(cs_radio_ind,opref,d.opref.optype);
8 12092 spec:= data+18;
8 12093 b_answ(answ,0,d.opref.spec,false,ac);
8 12094 <*+2*> if (testbit36 or testbit38) and overvåget then
8 12095 disable begin
9 12096 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 12097 outchar(zrl,'nl');
9 12098 end;
8 12099 <*-2*>
8 12100 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 12101 disable setposition(z_fr_out,0,0);
8 12102 ac:= -1;
8 12103 \f
8 12103 message procedure radio_ind side 5 - 881107/cl;
8 12104 end
7 12105 else
7 12106 begin
8 12107 integer sig_type;
8 12108
8 12108 ac:= 0;
8 12109 antal_spec:= d.opref.data(4);
8 12110 filref:= d.opref.data(5);
8 12111 spec:= d.opref.data(6);
8 12112 if antal_spec>0 then
8 12113 begin
9 12114 antal_spec:= antal_spec-1;
9 12115 if filref<>0 then
9 12116 begin
10 12117 læsfil(filref,1,zno);
10 12118 b_pt:= fil(zno).spec(1) shift (-12);
10 12119 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 12120 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 12121 antal_spec>0,ac);
10 12122 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 12123 end
9 12124 else
9 12125 begin
10 12126 b_pt:= d.opref.spec(1) shift (-12);
10 12127 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 12128 b_answ(answ,d.opref.data(3),d.opref.spec,
10 12129 antal_spec>0,ac);
10 12130 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 12131 end;
9 12132
9 12132 <* send answer *>
9 12133 <*+2*> if (testbit36 or testbit38) and overvåget then
9 12134 disable begin
10 12135 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 12136 outchar(zrl,'nl');
10 12137 end;
9 12138 <*-2*>
9 12139 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 12140 disable setposition(z_fr_out,0,0);
9 12141 if ac<>0 then
9 12142 begin
10 12143 antal_spec:= 0;
10 12144 ac:= -1;
10 12145 end
9 12146 else
9 12147 begin
10 12148 for i:= 1 step 1 until max_antal_områder do
10 12149 if område_id(i,2)=b_pt then
10 12150 begin
11 12151 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 12152 if sætbiti(d.opref.data(7),j,1)=0 then
11 12153 d.opref.resultat:= d.opref.resultat + 1;
11 12154 end;
10 12155 end;
9 12156 end;
8 12157 \f
8 12157 message procedure radio_ind side 6 - 881107/cl;
8 12158
8 12158 <* afvent nyt telegram *>
8 12159 d.opref.data(4):= antal_spec;
8 12160 d.opref.data(6):= spec;
8 12161 ac:= -1;
8 12162 systime(1,0.0,d.opref.tid);
8 12163 <*+2*> if testbit37 and overvåget then
8 12164 disable begin
9 12165 skriv_radio_ind(out,0);
9 12166 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 12167 ud;
9 12168 end;
8 12169 <*-2*>
8 12170 signalch(cs_radio_ind,opref,d.opref.optype);
8 12171 end;
7 12172 end
6 12173 else ac:= 2;
6 12174 end;
5 12175 if ac > 0 then
5 12176 begin
6 12177 for i:= 1 step 1 until 6 do val(i):= 0;
6 12178 b_answ(answ,0,val,false,ac);
6 12179 <*+2*>
6 12180 if (testbit36 or testbit38) and overvåget then
6 12181 disable begin
7 12182 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12183 outchar(zrl,'nl');
7 12184 end;
6 12185 <*-2*>
6 12186 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12187 disable setposition(z_fr_out,0,0);
6 12188 ac:= -1;
6 12189 end;
5 12190 \f
5 12190 message procedure radio_ind side 7 - 881107/cl;
5 12191 end <* ttyp = 'B' *>
4 12192 else
4 12193 if ttyp='C' or ttyp='J' then
4 12194 begin
5 12195 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12196 ac:= 1
5 12197 else
5 12198 begin
6 12199 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12200 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12201 typ(3):= -1;
6 12202 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12203 if opref > 0 then
6 12204 begin
7 12205 d.opref.resultat:= d.opref.resultat - 1;
7 12206 if ttyp = 'C' then
7 12207 begin
8 12208 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12209 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12210 j:= 0;
8 12211 for i:= 1 step 1 until max_antal_kanaler do
8 12212 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12213 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12214 d.opref.resultat:= d.opref.resultat-1;
8 12215 sætbiti(optaget_flag,j,1);
8 12216 sætbiti(d.opref.data(9),j,1);
8 12217 end
7 12218 else
7 12219 begin <* INGEN FORBINDELSE *>
8 12220 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12221 end;
7 12222 ac:= 0;
7 12223 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12224 begin
8 12225 systime(1,0,d.opref.tid);
8 12226 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12227 end
7 12228 else
7 12229 begin
8 12230 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12231 if læsbiti(d.opref.data(8),9) then 52 else
8 12232 if læsbiti(d.opref.data(8),10) then 20 else
8 12233 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12234 signalch(d.opref.retur, opref, d.opref.optype);
8 12235 end;
7 12236 end
6 12237 else
6 12238 ac:= 2;
6 12239 end;
5 12240 pos:= 1;
5 12241 skrivtegn(answ,pos,ttyp);
5 12242 skrivtegn(answ,pos,' ');
5 12243 skrivtegn(answ,pos,ac+'@');
5 12244 i:= 1; sum:= 0;
5 12245 while i < pos do
5 12246 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12247 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12248 skrivtegn(answ,pos,sum extract 4 + '@');
5 12249 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12250 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12251 disable begin
6 12252 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12253 outchar(zrl,'nl');
6 12254 end;
5 12255 <*-2*>
5 12256 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12257 disable setposition(z_fr_out,0,0);
5 12258 ac:= -1;
5 12259 \f
5 12259 message procedure radio_ind side 8 - 881107/cl;
5 12260 end <* ttyp = 'C' or 'J' *>
4 12261 else
4 12262 if ttyp = 'D' then
4 12263 begin
5 12264 if ptyp = 4 <* VDU *> then
5 12265 begin
6 12266 if pnum<1 or pnum>max_antal_taleveje then
6 12267 ac:= 1
6 12268 else
6 12269 begin
7 12270 inspect(bs_talevej_udkoblet(pnum),j);
7 12271 if j>=0 then
7 12272 begin
8 12273 sætbit_ia(samtaleflag,pnum,1);
8 12274 signal_bin(bs_mobil_opkald);
8 12275 end;
7 12276 if læsbit_ia(hookoff_maske,pnum) then
7 12277 signalbin(bs_talevej_udkoblet(pnum));
7 12278 ac:= 0;
7 12279 end
6 12280 end
5 12281 else
5 12282 if ptyp=3 or ptyp=2 then
5 12283 begin
6 12284 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12285 ptyp=2 and pnum<>2
6 12286 then
6 12287 ac:= 1
6 12288 else
6 12289 begin
7 12290 if læstegn(tlgr,5,tegn)='D' then
7 12291 begin <* teknisk nr i telegram *>
8 12292 b_pn:= 0;
8 12293 for i:= 1 step 1 until 4 do
8 12294 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12295 end
7 12296 else
7 12297 b_pn:= 0;
7 12298 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12299 i:= 0;
7 12300 for j:= 1 step 1 until max_antal_kanaler do
7 12301 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12302 if i<>0 then
7 12303 begin
8 12304 ref:= (i-1)*kanalbeskrlængde;
8 12305 inspect(ss_samtale_nedlagt(i),j);
8 12306 if j>=0 then
8 12307 begin
9 12308 sætbit_ia(samtaleflag,
9 12309 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12310 signalbin(bs_mobil_opkald);
9 12311 end;
8 12312 signal(ss_samtale_nedlagt(i));
8 12313 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12314 begin
9 12315 if kanal_tab.ref.kanal_id1<>0 and
9 12316 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12317 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12318 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12319 if kanal_tab.ref.kanal_id2<>0 and
9 12320 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12321 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12322 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12323 end;
8 12324 sætbiti(optaget_flag,i,0);
8 12325 end;
7 12326 ac:= 0;
7 12327 end;
6 12328 end
5 12329 else ac:= 1;
5 12330 if ac>=0 then
5 12331 begin
6 12332 pos:= i:= 1; sum:= 0;
6 12333 skrivtegn(answ,pos,'D');
6 12334 skrivtegn(answ,pos,' ');
6 12335 skrivtegn(answ,pos,ac+'@');
6 12336 skrivtegn(answ,pos,'@');
6 12337 while i<pos do
6 12338 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12339 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12340 skrivtegn(answ,pos, sum extract 4 + '@');
6 12341 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12342 <*+2*>
6 12343 if (testbit36 or testbit38) and overvåget then
6 12344 disable begin
7 12345 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12346 outchar(zrl,'nl');
7 12347 end;
6 12348 <*-2*>
6 12349 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12350 disable setposition(z_fr_out,0,0);
6 12351 ac:= -1;
6 12352 end;
5 12353 \f
5 12353 message procedure radio_ind side 9 - 881107/cl;
5 12354 end <* ttyp = D *>
4 12355 else
4 12356 if ttyp='H' then
4 12357 begin
5 12358 integer htyp;
5 12359
5 12359 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12360
5 12360 if htyp='A' then
5 12361 begin <*mobilopkald*>
6 12362 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12363 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12364 ac:= 1
6 12365 else
6 12366 begin
7 12367 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12368 if læstegn(tlgr,6,tegn)='D' then
7 12369 begin <*teknisk nr. i telegram*>
8 12370 b_pn:= 0;
8 12371 for i:= 1 step 1 until 4 do
8 12372 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12373 end
7 12374 else b_pn:= 0;
7 12375 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12376 <* opkaldstype *>
7 12377 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12378 if j>0 then
7 12379 begin
8 12380 if bs=10 then
8 12381 ann_opkald(b_pn,j)
8 12382 else
8 12383 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12384 ac:= 0;
8 12385 end else ac:= 1;
7 12386 end;
6 12387 \f
6 12387 message procedure radio_ind side 10 - 881107/cl;
6 12388 end
5 12389 else
5 12390 if htyp='E' then
5 12391 begin <* radiokanal status *>
6 12392 long onavn;
6 12393
6 12393 ac:= 0;
6 12394 j:= 0;
6 12395 for i:= 1 step 1 until max_antal_kanaler do
6 12396 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12397
6 12397 <* Alarmer for K12 = GLX ignoreres *>
6 12398 <* 94.06.14/CL *>
6 12399 <* Alarmer for K15 = HG ignoreres *>
6 12400 <* 95.07.31/CL *>
6 12401 <* Alarmer for K10 = FS ignoreres *>
6 12402 <* 96.05.27/CL *>
6 12403 if j>0 then
6 12404 begin
7 12405 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12406 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
7 12407 (onavn = long<:FS:>) then 0 else j);
7 12408 end;
6 12409
6 12409 læstegn(tlgr,9,tegn);
6 12410 if j<>0 and (tegn='A' or tegn='E') then
6 12411 begin
7 12412 ref:= (j-1)*kanalbeskrlængde;
7 12413 bs:= if tegn='E' then 0 else 15;
7 12414 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12415 begin
8 12416 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12417 signalbin(bs_mobil_opkald);
8 12418 end;
7 12419 end;
6 12420 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12421 begin
7 12422 waitch(cs_radio_pulje,opref,true,-1);
7 12423 startoperation(opref,401,cs_radio_pulje,23);
7 12424 i:= 1;
7 12425 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12426 if læstegn(tlgr,4,k)<>'@' then
7 12427 begin
8 12428 if k-'@' = 17 then
8 12429 hægtstring(d.opref.data,i,<: AMV:>)
8 12430 else
8 12431 if k-'@' = 18 then
8 12432 hægtstring(d.opref.data,i,<: BHV:>)
8 12433 else
8 12434 begin
9 12435 hægtstring(d.opref.data,i,<: BST:>);
9 12436 anbringtal(d.opref.data,i,k-'@',1);
9 12437 end;
8 12438 end;
7 12439 skrivtegn(d.opref.data,i,' ');
7 12440 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12441 skrivtegn(d.opref.data,i,' ');
7 12442 hægtstring(d.opref.data,i,
7 12443 string område_navn(kanal_til_omr(j)));
7 12444 if '@'<=tegn and tegn<='F' then
7 12445 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12446 <*@*> <:: ukendt fejl:>,
7 12447 <*A*> <:: compad-fejl:>,
7 12448 <*B*> <:: ladefejl:>,
7 12449 <*C*> <:: dør åben:>,
7 12450 <*D*> <:: senderfejl:>,
7 12451 <*E*> <:: compad ok:>,
7 12452 <*F*> <:: liniefejl:>,
7 12453 <::>))
7 12454 else
7 12455 begin
8 12456 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12457 skrivtegn(d.opref.data,i,tegn);
8 12458 end;
7 12459 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12460 signalch(cs_io,opref,gen_optype or rad_optype);
7 12461 ref:= (j-1)*kanalbeskrlængde;
7 12462 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12463 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12464 signalbin(bs_mobilopkald);
7 12465 end;
6 12466 \f
6 12466 message procedure radio_ind side 11 - 881107/cl;
6 12467 end
5 12468 else
5 12469 if htyp='G' then
5 12470 begin <* fjerninkludering/-ekskludering af område *>
6 12471 bs:= læstegn(tlgr,9,tegn)-'@';
6 12472 j:= 0;
6 12473 for i:= 1 step 1 until max_antal_kanaler do
6 12474 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12475 if j<>0 then
6 12476 begin
7 12477 ref:= (j-1)*kanalbeskrlængde;
7 12478 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12479 end;
6 12480 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12481 signalbin(bs_mobilopkald);
6 12482 ac:= 0;
6 12483 end
5 12484 else
5 12485 if htyp='L' then
5 12486 begin <* vogntabelændringer *>
6 12487 long field ll;
6 12488
6 12488 ll:= 10;
6 12489 ac:= 0;
6 12490 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12491 læstegn(tlgr,9,tegn);
6 12492 if (tegn='N') or (tegn='O') then
6 12493 begin
7 12494 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12495 typ(2):= -1;
7 12496 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12497 if opref>0 then
7 12498 begin
8 12499 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12500 signalch(d.opref.retur,opref,d.opref.optype);
8 12501 end;
7 12502 ac:= -1;
7 12503 end
6 12504 else
6 12505 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12506 ac:= -1
6 12507 else
6 12508 if tegn='G' then <*indkodning*>
6 12509 begin
7 12510 pos:= 10; i:= 0;
7 12511 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12512 i:= i*10 + (tegn-'0');
7 12513 i:= i mod 1000;
7 12514 b_pn:= (1 shift 22) + (i shift 12);
7 12515 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12516 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12517 pos:= 14; i:= 0;
7 12518 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12519 i:= i*10 + (tegn-'0');
7 12520 b_pn:= b_pn + i;
7 12521 pos:= 16; i:= 0;
7 12522 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12523 i:= i*10 + (tegn-'0');
7 12524 b_pt:= i;
7 12525 bs:= 11;
7 12526 \f
7 12526 message procedure radio_ind side 12 - 881107/cl;
7 12527 end
6 12528 else
6 12529 if tegn='H' then <*udkodning*>
6 12530 begin
7 12531 pos:= 10; i:= 0;
7 12532 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12533 i:= i*10 + (tegn-'0');
7 12534 b_pt:= i;
7 12535 b_pn:= 0;
7 12536 bs:= 12;
7 12537 end
6 12538 else
6 12539 if tegn='I' then <*slet tabel*>
6 12540 begin
7 12541 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12542 pos:= 10; i:= 0;
7 12543 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12544 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12545 zno:= i;
7 12546 end
6 12547 else ac:= 2;
6 12548 if ac<0 then
6 12549 ac:= 0
6 12550 else
6 12551
6 12551 if ac=0 then
6 12552 begin
7 12553 waitch(cs_vt_adgang,opref,true,-1);
7 12554 startoperation(opref,401,cs_vt_adgang,bs);
7 12555 d.opref.data(1):= b_pt;
7 12556 d.opref.data(2):= b_pn;
7 12557 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12558 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12559 end;
6 12560 end
5 12561 else
5 12562 ac:= 2;
5 12563
5 12563 pos:= 1;
5 12564 skrivtegn(answ,pos,'H');
5 12565 skrivtegn(answ,pos,' ');
5 12566 skrivtegn(answ,pos,ac+'@');
5 12567 i:= 1; sum:= 0;
5 12568 while i < pos do
5 12569 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12570 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12571 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12572 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12573 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12574 disable begin
6 12575 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12576 outchar(zrl,'nl');
6 12577 end;
5 12578 <*-2*>
5 12579 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12580 disable setposition(z_fr_out,0,0);
5 12581 ac:= -1;
5 12582 \f
5 12582 message procedure radio_ind side 13 - 881107/cl;
5 12583 end
4 12584 else
4 12585 if ttyp = 'I' then
4 12586 begin
5 12587 typ(1):= -1;
5 12588 repeat
5 12589 getch(cs_radio_ind,opref,true,typ,val);
5 12590 if opref<>0 then
5 12591 begin
6 12592 d.opref.resultat:= 31;
6 12593 signalch(d.opref.retur,opref,d.opref.op_type);
6 12594 end;
5 12595 until opref=0;
5 12596 for i:= 1 step 1 until max_antal_taleveje do
5 12597 if læsbit_ia(hookoff_maske,i) then
5 12598 begin
6 12599 signalbin(bs_talevej_udkoblet(i));
6 12600 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12601 end;
5 12602 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12603 signal_bin(bs_mobil_opkald);
5 12604 for i:= 1 step 1 until max_antal_kanaler do
5 12605 begin
6 12606 ref:= (i-1)*kanalbeskrlængde;
6 12607 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12608 begin
7 12609 if kanal_tab.ref.kanal_id2<>0 and
7 12610 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12611 then
7 12612 begin
8 12613 signal(ss_samtale_nedlagt(i));
8 12614 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12615 end;
7 12616 if kanal_tab.ref.kanal_id1<>0 then
7 12617 begin
8 12618 signal(ss_samtale_nedlagt(i));
8 12619 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12620 end;
7 12621 end;
6 12622 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12623 end;
5 12624 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12625 startoperation(opref,401,cs_radio_pulje,23);
5 12626 i:= 1;
5 12627 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12628 j:= 4;
5 12629 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12630 begin
6 12631 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12632 end;
5 12633 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12634 signalch(cs_io,opref,gen_optype or rad_optype);
5 12635 optaget_flag:= 0;
5 12636 pos:= i:= 1; sum:= 0;
5 12637 skrivtegn(answ,pos,'I');
5 12638 skrivtegn(answ,pos,' ');
5 12639 skrivtegn(answ,pos,'@');
5 12640 while i<pos do
5 12641 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12642 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12643 skrivtegn(answ,pos,sum extract 4 + '@');
5 12644 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12645 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12646 disable begin
6 12647 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12648 outchar(zrl,'nl');
6 12649 end;
5 12650 <*-2*>
5 12651 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12652 disable setposition(z_fr_out,0,0);
5 12653 ac:= -1;
5 12654 \f
5 12654 message procedure radio_ind side 14 - 881107/cl;
5 12655 end
4 12656 else
4 12657 if ttyp='L' then
4 12658 begin
5 12659 ac:= 0;
5 12660 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12661 if testbit21 then
5 12662 begin
6 12663 waitch(cs_radio_pulje,opref,true,-1);
6 12664 startoperation(opref,401,cs_radio_pulje,23);
6 12665 i:= 1;
6 12666 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12667 j:= 4;
6 12668 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12669 begin
7 12670 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12671 end;
6 12672 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12673 signalch(cs_io,opref,gen_optype or rad_optype);
6 12674 end; <*testbit21*>
5 12675 end
4 12676 else
4 12677 if ttyp='Z' then
4 12678 begin
5 12679 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12680 disable begin
6 12681 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12682 outchar(zrl,'nl');
6 12683 end;
5 12684 <*-2*>
5 12685 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12686 disable setposition(z_fr_out,0,0);
5 12687 ac:= -1;
5 12688 end
4 12689 else
4 12690 ac:= 1;
4 12691 end; <* telegram modtaget ok *>
3 12692 \f
3 12692 message procedure radio_ind side 15 - 881107/cl;
3 12693 if ac>=0 then
3 12694 begin
4 12695 pos:= i:= 1; sum:= 0;
4 12696 skrivtegn(answ,pos,ttyp);
4 12697 skrivtegn(answ,pos,' ');
4 12698 skrivtegn(answ,pos,ac+'@');
4 12699 while i<pos do
4 12700 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12701 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12702 skrivtegn(answ,pos, sum extract 4 + '@');
4 12703 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12704 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12705 disable begin
5 12706 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12707 outchar(zrl,'nl');
5 12708 end;
4 12709 <*-2*>
4 12710 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12711 disable setposition(z_fr_out,0,0);
4 12712 ac:= -1;
4 12713 end;
3 12714
3 12714 typ(1):= 0;
3 12715 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12716 rf:= 4;
3 12717 systime(1,0.0,val.rf);
3 12718 val.rf:= val.rf - 30.0;
3 12719 typ(3):= -1;
3 12720 repeat
3 12721 getch(cs_radio_ind,opref,true,typ,val);
3 12722 if opref>0 then
3 12723 begin
4 12724 d.opref.resultat:= 53; <*annuleret*>
4 12725 signalch(d.opref.retur,opref,d.opref.optype);
4 12726 end;
3 12727 until opref=0;
3 12728
3 12728 until false;
3 12729
3 12729 radio_ind_trap:
3 12730
3 12730 disable skriv_radio_ind(zbillede,1);
3 12731
3 12731 end radio_ind;
2 12732 \f
2 12732 message procedure radio_ud side 1 - 820301/hko;
2 12733
2 12733 procedure radio_ud(op);
2 12734 value op;
2 12735 integer op;
2 12736 begin
3 12737 integer array field opref,io_opref;
3 12738 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12739 integer array answ, tlgr(1:32);
3 12740 long array field laf;
3 12741
3 12741 procedure skriv_radio_ud(z,omfang);
3 12742 value omfang;
3 12743 zone z;
3 12744 integer omfang;
3 12745 begin integer i1;
4 12746 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12747 if omfang > 0 then
4 12748 disable begin real x; long array field tx;
5 12749 tx:= 0;
5 12750 trap(slut);
5 12751 write(z,"nl",1,
5 12752 <: opref: :>,opref,"nl",1,
5 12753 <: io-opref: :>,io_opref,"nl",1,
5 12754 <: opgave: :>,opgave,"nl",1,
5 12755 <: kode: :>,kode,"nl",1,
5 12756 <: pos: :>,pos,"nl",1,
5 12757 <: tegn: :>,tegn,"nl",1,
5 12758 <: i: :>,i,"nl",1,
5 12759 <: sum: :>,sum,"nl",1,
5 12760 <: rc: :>,rc,"nl",1,
5 12761 <: svar-status: :>,svar_status,"nl",1,
5 12762 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12763 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12764 <::>);
5 12765 skriv_coru(z,coru_no(402));
5 12766 slut:
5 12767 end; <*disable*>
4 12768 end skriv_radio_ud;
3 12769
3 12769 trap(radio_ud_trap);
3 12770 laf:= 0;
3 12771 stack_claim((if cm_test then 200 else 150) +35+100);
3 12772
3 12772 <*+2*>if testbit32 and overvåget or testbit28 then
3 12773 skriv_radio_ud(out,0);
3 12774 <*-2*>
3 12775
3 12775 io_opref:= op;
3 12776 \f
3 12776 message procedure radio_ud side 2 - 810529/hko;
3 12777
3 12777 repeat
3 12778
3 12778 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12779 kode:= d.op_ref.opkode;
3 12780 opgave:= kode shift(-12);
3 12781 kode:= kode extract 12;
3 12782 if opgave < 'A' or opgave > 'I' then
3 12783 begin
4 12784 d.opref.resultat:= 31;
4 12785 end
3 12786 else
3 12787 begin
4 12788 pos:= 1;
4 12789 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12790 begin
5 12791 skrivtegn(tlgr,pos,opgave);
5 12792 if d.opref.data(1) = 0 then
5 12793 begin
6 12794 skrivtegn(tlgr,pos,'G');
6 12795 skrivtegn(tlgr,pos,'A');
6 12796 end
5 12797 else
5 12798 begin
6 12799 skrivtegn(tlgr,pos,'D');
6 12800 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 12801 end;
5 12802 if opgave='A' then
5 12803 begin
6 12804 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 12805 end
5 12806 else
5 12807 if opgave='B' then
5 12808 begin
6 12809 skrivtegn(tlgr,pos,d.opref.data(2));
6 12810 if d.opref.data(2)='V' then
6 12811 begin
7 12812 skrivtegn(tlgr,pos,
7 12813 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 12814 skrivtegn(tlgr,pos,
7 12815 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 12816 end;
6 12817 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 12818 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 12819 end
5 12820 else
5 12821 if opgave='H' then
5 12822 begin
6 12823 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 12824 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 12825 hægtstring(tlgr,pos,<:@@@:>);
6 12826 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 12827 skrivtegn(tlgr,pos,'A');
6 12828 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 12829 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 12830 if d.opref.data(2)='L' then
6 12831 begin
7 12832 if d.opref.data(5)=7 then
7 12833 begin
8 12834 anbringtal(tlgr,pos,
8 12835 d.opref.data(8) shift (-12) extract 10,-4);
8 12836 anbringtal(tlgr,pos,
8 12837 d.opref.data(8) extract 7,-2);
8 12838 end
7 12839 else
7 12840 if d.opref.data(5)=8 then
7 12841 begin
8 12842 hægtstring(tlgr,pos,<:FFFFFF:>);
8 12843 end;
7 12844 if d.opref.data(5)<>9 then
7 12845 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 12846 skrivtegn(tlgr,pos,
7 12847 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 12848 skrivtegn(tlgr,pos,
7 12849 dec_to_hex(d.opref.data(6) extract 4));
7 12850 skrivtegn(tlgr,10,pos-11+'@');
7 12851 end;
6 12852 end;
5 12853 end
4 12854 else
4 12855 if opgave='I' then
4 12856 begin
5 12857 hægtstring(tlgr,pos,<:IGA:>);
5 12858 end
4 12859 else d.opref.resultat:= 31; <*systemfejl*>
4 12860 end;
3 12861 \f
3 12861 message procedure radio_ud side 3 - 881107/cl;
3 12862
3 12862 if d.opref.resultat=0 then
3 12863 begin
4 12864 if (opgave <= 'B')
4 12865 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 12866 begin
5 12867 systime(1,0,d.opref.tid);
5 12868 signalch(cs_radio_ind,opref,d.opref.optype);
5 12869 opref:= 0;
5 12870 end;
4 12871 <* beregn checksum og send *>
4 12872 i:= 1; sum:= 0;
4 12873 while i < pos do
4 12874 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 12875 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 12876 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 12877 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 12878 <**********************************************>
4 12879 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 12880
4 12880 if opgave='B' then delay(1);
4 12881
4 12881 <* 94.04.19/cl *>
4 12882 <**********************************************>
4 12883
4 12883 <*+2*> if (testbit36 or testbit39) and overvåget then
4 12884 disable begin
5 12885 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 12886 outchar(zrl,'nl');
5 12887 end;
4 12888 <*-2*>
4 12889 setposition(z_rf_in,0,0);
4 12890 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 12891 disable setposition(z_rf_out,0,0);
4 12892 rc:= 0;
4 12893
4 12893 <* afvent svar*>
4 12894 repeat
4 12895 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 12896 if svar_status=6 then
4 12897 begin
5 12898 svar_status:= -3;
5 12899 goto radio_ud_check;
5 12900 end;
4 12901 pos:= 1;
4 12902 while læstegn(answ,pos,i)<>0 do ;
4 12903 pos:= pos-2;
4 12904 if pos > 0 then
4 12905 begin
5 12906 if pos<3 then
5 12907 svar_status:= -2 <*format error*>
5 12908 else
5 12909 begin
6 12910 if læstegn(answ,3,tegn)<>'@' then
6 12911 svar_status:= tegn - '@'
6 12912 else
6 12913 begin
7 12914 pos:= 1;
7 12915 læstegn(answ,pos,tegn);
7 12916 if tegn<>opgave then
7 12917 svar_status:= -4 <*gal type*>
7 12918 else
7 12919 if læstegn(answ,pos,tegn)<>' ' then
7 12920 svar_status:= -tegn <*fejl*>
7 12921 else
7 12922 svar_status:= læstegn(answ,pos,tegn)-'@';
7 12923 end;
6 12924 end;
5 12925 end
4 12926 else
4 12927 svar_status:= -1;
4 12928 \f
4 12928 message procedure radio_ud side 5 - 881107/cl;
4 12929
4 12929 radio_ud_check:
4 12930 rc:= rc+1;
4 12931 if -3<=svar_status and svar_status< -1 then
4 12932 disable begin
5 12933 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 12934 setposition(z_rf_out,0,0);
5 12935 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12936 begin
6 12937 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 12938 outchar(zrl,'nl');
6 12939 end;
5 12940 <*-2*>
5 12941 end
4 12942 else
4 12943 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 12944 disable begin
5 12945 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 12946 setposition(z_rf_out,0,0);
5 12947 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12948 begin
6 12949 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 12950 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 12951 end;
5 12952 <*-2*>
5 12953 end
4 12954 else
4 12955 if svar_status=0 and opref<>0 then
4 12956 d.opref.resultat:= 0
4 12957 else
4 12958 if opref<>0 then
4 12959 d.opref.resultat:= 31;
4 12960 until svar_status=0 or rc>3;
4 12961 end;
3 12962 if opref<>0 then
3 12963 begin
4 12964 if svar_status<>0 and rc>3 then
4 12965 d.opref.resultat:= 53; <* annulleret *>
4 12966 signalch(d.opref.retur,opref,d.opref.optype);
4 12967 opref:= 0;
4 12968 end;
3 12969 until false;
3 12970
3 12970 radio_ud_trap:
3 12971
3 12971 disable skriv_radio_ud(zbillede,1);
3 12972
3 12972 end radio_ud;
2 12973 \f
2 12973 message procedure radio_medd_opkald side 1 - 810610/hko;
2 12974
2 12974 procedure radio_medd_opkald;
2 12975 begin
3 12976 integer array field ref,op_ref;
3 12977 integer i;
3 12978
3 12978 procedure skriv_radio_medd_opkald(z,omfang);
3 12979 value omfang;
3 12980 zone z;
3 12981 integer omfang;
3 12982 begin integer x;
4 12983 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 12984 write(z,"sp",26-x);
4 12985 if omfang > 0 then
4 12986 disable begin
5 12987 trap(slut);
5 12988 write(z,"nl",1,
5 12989 <: ref: :>,ref,"nl",1,
5 12990 <: opref: :>,op_ref,"nl",1,
5 12991 <: i: :>,i,"nl",1,
5 12992 <::>);
5 12993 skriv_coru(z,abs curr_coruno);
5 12994 slut:
5 12995 end;<*disable*>
4 12996 end skriv_radio_medd_opkald;
3 12997
3 12997 trap(radio_medd_opkald_trap);
3 12998
3 12998 stack_claim((if cm_test then 200 else 150) +1);
3 12999
3 12999 <*+2*>if testbit32 and overvåget or testbit28 then
3 13000 disable skriv_radio_medd_opkald(out,0);
3 13001 <*-2*>
3 13002 \f
3 13002 message procedure radio_medd_opkald side 2 - 820301/hko;
3 13003
3 13003 repeat
3 13004
3 13004 <*V*> wait(bs_mobil_opkald);
3 13005 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 13006 <*V*> wait(bs_opkaldskø_adgang);
3 13007
3 13007 ref:= første_nød_opkald;
3 13008 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 13009 begin
4 13010 i:= opkaldskø.ref(2);
4 13011 if i < 0 then
4 13012 begin
5 13013 <* nødopkald ikke meldt *>
5 13014
5 13014 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 13015 d.op_ref.data(1):= <* vogn_id *>
5 13016 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 13017 opkaldskø.ref(2):= i extract 22;
5 13018 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 13019 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 13020 i:= op_ref;
5 13021 <*+2*> if testbit35 and overvåget then
5 13022 disable begin
6 13023 write(out,"nl",1,<:radio nød-medd:>);
6 13024 skriv_op(out,op_ref);
6 13025 ud;
6 13026 end;
5 13027 <*-2*>
5 13028 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 13029 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 13030 <*+4*> if i <> op_ref then
5 13031 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 13032 <*-4*>
5 13033 end;<*nødopkald ikke meldt*>
4 13034
4 13034 ref:= opkaldskø.ref(1) extract 12;
4 13035 end; <* melding til io *>
3 13036 \f
3 13036 message procedure radio_medd_opkald side 3 - 820304/hko;
3 13037
3 13037 start_operation(op_ref,403,cs_radio_medd,
3 13038 40<*opdater opkaldskøbill*>);
3 13039 signal_bin(bs_opkaldskø_adgang);
3 13040 <*+2*> if testbit35 and overvåget then
3 13041 disable begin
4 13042 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 13043 skriv_op(out,op_ref);
4 13044 write(out, <:opkaldsflag: :>,"nl",1);
4 13045 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 13046 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 13047 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 13048 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 13049 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 13050 ud;
4 13051 end;
3 13052 <*-2*>
3 13053 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 13054
3 13054 until false;
3 13055
3 13055 radio_medd_opkald_trap:
3 13056
3 13056 disable skriv_radio_medd_opkald(zbillede,1);
3 13057
3 13057 end radio_medd_opkald;
2 13058 \f
2 13058 message procedure radio_adm side 1 - 820301/hko;
2 13059
2 13059 procedure radio_adm(op);
2 13060 value op;
2 13061 integer op;
2 13062 begin
3 13063 integer array field opref, rad_op, iaf;
3 13064 integer nr,i,j,k,res,opgave,tilst,operatør;
3 13065
3 13065 procedure skriv_radio_adm(z,omfang);
3 13066 value omfang;
3 13067 zone z;
3 13068 integer omfang;
3 13069 begin integer i1;
4 13070 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 13071 write(z,"sp",26-i1);
4 13072 if omfang > 0 then
4 13073 disable begin real x;
5 13074 trap(slut);
5 13075 \f
5 13075 message procedure radio_adm side 2- 820301/hko;
5 13076
5 13076 write(z,"nl",1,
5 13077 <: op_ref: :>,op_ref,"nl",1,
5 13078 <: iaf: :>,iaf,"nl",1,
5 13079 <: rad-op: :>,rad_op,"nl",1,
5 13080 <: nr: :>,nr,"nl",1,
5 13081 <: i: :>,i,"nl",1,
5 13082 <: j: :>,j,"nl",1,
5 13083 <: k: :>,k,"nl",1,
5 13084 <: tilst: :>,tilst,"nl",1,
5 13085 <: res: :>,res,"nl",1,
5 13086 <: opgave: :>,opgave,"nl",1,
5 13087 <: operatør: :>,operatør,"nl",1);
5 13088 skriv_coru(z,coru_no(404));
5 13089 slut:
5 13090 end;<*disable*>
4 13091 end skriv_radio_adm;
3 13092 \f
3 13092 message procedure radio_adm side 3 - 820304/hko;
3 13093
3 13093 rad_op:= op;
3 13094
3 13094 trap(radio_adm_trap);
3 13095 stack_claim((if cm_test then 200 else 150) +50);
3 13096
3 13096 <*+2*>if testbit32 and overvåget or testbit28 then
3 13097 skriv_radio_adm(out,0);
3 13098 <*-2*>
3 13099
3 13099 pass;
3 13100 if -,testbit22 then
3 13101 begin
4 13102 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13103 signalch(cs_radio_ud,rad_op,rad_optype);
4 13104 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13105 end;
3 13106 repeat
3 13107 waitch(cs_radio_adm,opref,true,-1);
3 13108 <*+2*>
3 13109 if testbit33 and overvåget then
3 13110 disable begin
4 13111 skriv_radio_adm(out,0);
4 13112 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 13113 skriv_op(out,opref);
4 13114 end;
3 13115 <*-2*>
3 13116
3 13116 k:= d.op_ref.opkode extract 12;
3 13117 opgave:= d.opref.opkode shift (-12);
3 13118 nr:=operatør:=d.op_ref.data(1);
3 13119
3 13119 <*+4*> if (d.op_ref.optype and
3 13120 (gen_optype or io_optype or op_optype or vt_optype))
3 13121 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 13122 <:radio_adm:>,0);
3 13123 <*-4*>
3 13124 if k = 74 <* RA,I *> then
3 13125 begin
4 13126 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13127 signalch(cs_radio_ud,rad_op,rad_optype);
4 13128 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13129 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 13130 else d.rad_op.resultat;
4 13131 signalch(d.opref.retur,opref,d.opref.optype);
4 13132 \f
4 13132 message procedure radio_adm side 4 - 820301/hko;
4 13133 end
3 13134 else
3 13135
3 13135 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 13136 k = 5<*FO,L*> or k = 6<*ST *> then
3 13137 begin
4 13138 if k = 5 or k=77 then
4 13139 begin
5 13140
5 13140 <*V*> wait(bs_opkaldskø_adgang);
5 13141 if k=5 then
5 13142 begin
6 13143 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 13144 begin
7 13145 i:= læs_fil(1035,iaf//512+1,nr);
7 13146 if i <> 0 then
7 13147 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 13148 tofrom(radio_linietabel.iaf,fil(nr),
7 13149 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 13150 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 13151 end;
6 13152
6 13152 for i:= 1 step 1 until max_antal_mobilopkald do
6 13153 begin
7 13154 iaf:= i*opkaldskø_postlængde;
7 13155 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 13156 if nr>0 then
7 13157 begin
8 13158 læs_tegn(radio_linietabel,nr+1,operatør);
8 13159 if operatør>max_antal_operatører then operatør:= 0;
8 13160 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 13161 operatør;
8 13162 end;
7 13163 end;
6 13164 end
5 13165 else
5 13166 if k=77 then
5 13167 begin
6 13168 disable i:= læsfil(1034,1,nr);
6 13169 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 13170 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 13171 for i:= 1 step 1 until max_antal_mobilopkald do
6 13172 begin
7 13173 iaf:= i*opkaldskø_postlængde;
7 13174 nr:= opkaldskø.iaf(5) extract 4;
7 13175 operatør:= radio_områdetabel(nr);
7 13176 if operatør < 0 or max_antal_operatører < operatør then
7 13177 operatør:= 0;
7 13178 if opkaldskø.iaf(4) extract 8=0 and
7 13179 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13180 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13181 operatør;
7 13182 end;
6 13183 end;
5 13184
5 13184 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13185 signal_bin(bs_opkaldskø_adgang);
5 13186
5 13186 signal_bin(bs_mobil_opkald);
5 13187
5 13187 d.op_ref.resultat:= res:= 3;
5 13188 \f
5 13188 message procedure radio_adm side 5 - 820304/hko;
5 13189
5 13189 end <*k = 5 / k = 77*>
4 13190 else
4 13191 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13192 res:= 3;
5 13193 for nr:= 1 step 1 until max_antal_kanaler do
5 13194 begin
6 13195 iaf:= (nr-1)*kanal_beskr_længde;
6 13196 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13197 op_talevej(operatør) then
6 13198 begin
7 13199 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13200 if tilst <> 0 then
7 13201 res:= 16; <*skærm optaget*>
7 13202 end; <* kanal_tab(operatør) = operatør*>
6 13203 end;
5 13204 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13205 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13206 signal_bin(bs_mobil_opkald);
5 13207 d.op_ref.resultat:= res;
5 13208 end;<*k=1,2 eller 6 *>
4 13209
4 13209 <*+2*> if testbit35 and overvåget then
4 13210 disable begin
5 13211 skriv_radio_adm(out,0);
5 13212 write(out,<: sender til :>,
5 13213 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13214 else cs_op);
5 13215 skriv_op(out,op_ref);
5 13216 end;
4 13217 <*-2*>
4 13218
4 13218 if k=5 or k=6 or k=77 or res > 3 then
4 13219 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13220 else
4 13221 begin <*k = (1 eller 2) og res = 3 *>
5 13222 d.op_ref.resultat:=0;
5 13223 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13224 end;
4 13225 \f
4 13225 message procedure radio_adm side 6 - 816610/hko;
4 13226
4 13226 end <*k=1,2,5 eller 6*>
3 13227 else
3 13228 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13229 begin
4 13230 nr:= d.op_ref.data(1);
4 13231 res:= 3;
4 13232
4 13232 if nr<=3 then
4 13233 res:= 51 <* afvist *>
4 13234 else
4 13235 begin
5 13236
5 13236 <* gennemstilling af område *>
5 13237 j:= 1;
5 13238 for i:= 1 step 1 until max_antal_kanaler do
5 13239 begin
6 13240 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13241 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13242 end;
5 13243 nr:= j;
5 13244 iaf:= (nr-1)*kanalbeskrlængde;
5 13245 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13246 begin
6 13247 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13248 d.rad_op.data(1):= 0;
6 13249 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13250 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13251 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13252 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13253 signalch(cs_radio_ud,rad_op,rad_optype);
6 13254 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13255 res:= d.rad_op.resultat;
6 13256 if res=0 then res:= 3;
6 13257 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13258 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13259 end;
5 13260 end;
4 13261 d.op_ref.resultat:=res;
4 13262 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13263 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13264 signal_bin(bs_mobil_opkald);
4 13265 \f
4 13265 message procedure radio_adm side 7 - 880930/cl;
4 13266
4 13266
4 13266 end <* k=3 eller 4 *>
3 13267 else
3 13268 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13269 begin
4 13270 nr:= d.opref.data(1) extract 22;
4 13271 res:= 3;
4 13272 iaf:= (nr-1)*kanalbeskrlængde;
4 13273 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13274 d.rad_op.data(1):= 0;
4 13275 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13276 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13277 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13278 d.rad_op.data(5):= k extract 1;
4 13279 signalch(cs_radio_ud,radop,rad_optype);
4 13280 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13281 res:= d.radop.resultat;
4 13282 if res=0 then res:= 3;
4 13283 j:= if k=72 then 15 else 0;
4 13284 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13285 begin
5 13286 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13287 signalbin(bs_mobilopkald);
5 13288 end;
4 13289 d.opref.resultat:= res;
4 13290 signalch(d.opref.retur,opref,d.opref.optype);
4 13291 end
3 13292 else
3 13293 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13294 begin
4 13295 nr:= d.opref.data(1) extract 8;
4 13296 opgave:= if k=19 then 9 else (k-4);
4 13297 if nr<=3 then
4 13298 res:= 51 <*afvist*>
4 13299 else
4 13300 begin
5 13301 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13302 d.radop.data(1):= 0;
5 13303 d.radop.data(2):= 'L';
5 13304 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13305 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13306 d.radop.data(5):= opgave;
5 13307 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13308 d.radop.data(7):= d.opref.data(2);
5 13309 d.radop.data(8):= d.opref.data(3);
5 13310 signalch(cs_radio_ud,radop,rad_optype);
5 13311 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13312 res:= d.radop.resultat;
5 13313 if res=0 then res:= 3;
5 13314 end;
4 13315 d.opref.resultat:= res;
4 13316 signalch(d.opref.retur,opref,d.opref.optype);
4 13317 end
3 13318 else
3 13319
3 13319 begin
4 13320
4 13320 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13321
4 13321 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13322
4 13322 end;
3 13323
3 13323 until false;
3 13324 radio_adm_trap:
3 13325 disable skriv_radio_adm(zbillede,1);
3 13326 end radio_adm;
2 13327
2 13327 \f
2 13327 message vogntabel erklæringer side 1 - 820301/cl;
2 13328
2 13328 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13329 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13330 cs_vt_log;
2 13331 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13332 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13333 vt_log_slicelgd;
2 13334 integer array bustabel,bustabel1(0:max_antal_busser),
2 13335 linie_løb_tabel(0:max_antal_linie_løb),
2 13336 springtabel(1:max_antal_spring,1:3),
2 13337 gruppetabel(1:max_antal_grupper),
2 13338 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13339 vt_logop(1:2),
2 13340 vt_logdisc(1:4),
2 13341 vt_log_tail(1:10);
2 13342 boolean array busindeks(-1:max_antal_linie_løb),
2 13343 bustilstand(-1:max_antal_busser),
2 13344 linie_løb_indeks(-1:max_antal_busser);
2 13345 real array springtid,springstart(1:max_antal_spring);
2 13346 real vt_logstart;
2 13347 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13348 integer array field v_tekst;
2 13349 real field v_tid;
2 13350
2 13350 zone zvtlog(128,1,stderror);
2 13351
2 13351 \f
2 13351 message vogntabel erklæringer side 2 - 851001/cl;
2 13352
2 13352 procedure skriv_vt_variable(zud);
2 13353 zone zud;
2 13354 begin integer i; long array field laf;
3 13355 laf:= 0;
3 13356 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13357 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13358 <:cs-vt :>,cs_vt,"nl",1,
3 13359 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13360 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13361 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13362 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13363 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13364 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13365 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13366 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13367 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13368 <:vt-op :>,vt_op,"nl",1,
3 13369 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13370 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13371 <:sidste-bus :>,sidste_bus,"nl",1,
3 13372 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13373 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13374 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13375 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13376 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13377 <:tf-springdef :>,tf_springdef,"nl",1,
3 13378 <:vt-logskift :>,vt_logskift,"nl",1,
3 13379 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13380 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13381 <:vt-log-aktiv :>,
3 13382 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13383 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13384 <::>);
3 13385 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13386 laf:= 2;
3 13387 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13388 for i:= 6 step 1 until 10 do
3 13389 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13390 write(zud,"nl",1);
3 13391 end;
2 13392 \f
2 13392 message procedure p_vogntabel side 1 - 820301/cl;
2 13393
2 13393 procedure p_vogntabel(z);
2 13394 zone z;
2 13395 begin
3 13396 integer i,b,s,o,t,li,lb,lø,g;
3 13397 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13398 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13399 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13400 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13401
3 13401 for i:= 1 step 1 until sidste_bus do
3 13402 begin
4 13403 b:= bustabel(i) extract 14;
4 13404 g:= bustabel(i) shift (-14);
4 13405 s:= bustabel1(i) shift (-23);
4 13406 o:= bustabel1(i) extract 8;
4 13407 t:= intg(bustilstand(i));
4 13408 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13409 lø:= li extract 7;
4 13410 lb:= li shift (-7) extract 5;
4 13411 lb:= if lb=0 then 32 else lb+64;
4 13412 li:= li shift (-12) extract 10;
4 13413 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13414 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13415 if g > 0 then string bpl_navn(g) else <: :>,
4 13416 ";",1,true,4,string område_navn(o),
4 13417 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13418 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13419 end;
3 13420 end p_vogntabel;
2 13421 \f
2 13421 message procedure p_gruppetabel side 1 - 810531/cl;
2 13422
2 13422 procedure p_gruppetabel(z);
2 13423 zone z;
2 13424 begin
3 13425 integer i,nr,bogst;
3 13426 boolean spc_gr;
3 13427 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13428 <:max-antal-grupper =:>,max_antal_grupper,
3 13429 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13430 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13431 <:gruppetabel::>);
3 13432 for i:= 1 step 1 until max_antal_grupper do
3 13433 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13434 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13435 gruppetabel(i) extract 7);
3 13436 write(z,"nl",2,<:gruppeopkald::>);
3 13437 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13438 begin
4 13439 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13440 if gruppeopkald(i,1) = 0 then
4 13441 write(z,"sp",11)
4 13442 else
4 13443 begin
5 13444 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13445 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13446 else
5 13447 begin
6 13448 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13449 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13450 if bogst = '@' then bogst:= 'sp';
6 13451 end;
5 13452 if spc_gr then
5 13453 write(z,<:(G:>,<<d>,true,3,nr)
5 13454 else
5 13455 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13456 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13457 end;
4 13458 end;
3 13459 end p_gruppetabel;
2 13460 \f
2 13460 message procedure p_springtabel side 1 - 810519/cl;
2 13461
2 13461 procedure p_springtabel(z);
2 13462 zone z;
2 13463 begin
3 13464 integer li,bo,max,st,nr;
3 13465 long indeks;
3 13466 real t;
3 13467
3 13467 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13468 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13469 <:nr spring-id max status næste-tid:>,"nl",1);
3 13470 for nr:= 1 step 1 until max_antal_spring do
3 13471 begin
4 13472 write(z,<<dd>,nr);
4 13473 <* if springtabel(nr,1)<>0 then *>
4 13474 begin
5 13475 li:= springtabel(nr,1) shift (-5) extract 10;
5 13476 bo:= springtabel(nr,1) extract 5;
5 13477 if bo<>0 then bo:= bo + 'A' - 1;
5 13478 indeks:= extend springtabel(nr,2) shift 24;
5 13479 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13480 max:= springtabel(nr,3) extract 12;
5 13481 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13482 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13483 if springtid(nr)<>0.0 then
5 13484 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13485 else
5 13486 write(z,<< d.d >,0.0);
5 13487 if springstart(nr)<>0.0 then
5 13488 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13489 else
5 13490 write(z,<< d.d >,0.0);
5 13491 end
4 13492 <* else
4 13493 write(z,<: --------:>)*>;
4 13494 write(z,"nl",1);
4 13495 end;
3 13496 end p_springtabel;
2 13497 \f
2 13497 message procedure find_busnr side 1 - 820301/cl;
2 13498
2 13498 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13499 value ll_id;
2 13500 integer ll_id, busnr, garage, tilst;
2 13501 begin
3 13502 integer i,j;
3 13503
3 13503 j:= binærsøg(sidste_linie_løb,
3 13504 (linie_løb_tabel(i) - ll_id), i);
3 13505 if j<>0 then <* linie/løb findes ikke *>
3 13506 begin
4 13507 find_busnr:= -1;
4 13508 busnr:= 0;
4 13509 garage:= 0;
4 13510 tilst:= 0;
4 13511 end
3 13512 else
3 13513 begin
4 13514 busnr:= bustabel(busindeks(i) extract 12);
4 13515 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13516 garage:= busnr shift (-14);
4 13517 busnr:= busnr extract 14;
4 13518 find_busnr:= busindeks(i) extract 12;
4 13519 end;
3 13520 end find_busnr;
2 13521 \f
2 13521 message procedure søg_omr_bus side 1 - 881027/cl;
2 13522
2 13522
2 13522 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13523 value bus;
2 13524 integer bus,ll,gar,omr,sig,tilst;
2 13525 begin
3 13526 integer i,j,nr,bu,bi,bl;
3 13527
3 13527 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13528 nr:= -1;
3 13529 if j=0 then
3 13530 begin
4 13531 bl:= bu:= bi;
4 13532 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13533 while bu<sidste_bus and
4 13534 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13535
4 13535 if bl<>bu then
4 13536 begin
5 13537 <* flere busser med samme tekniske nr. omr skal passe *>
5 13538 nr:= -2;
5 13539 for bi:= bl step 1 until bu do
5 13540 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13541 end
4 13542 else
4 13543 nr:= bi;
4 13544 end;
3 13545
3 13545 if nr<0 then
3 13546 begin
4 13547 <* bus findes ikke *>
4 13548 ll:= gar:= tilst:= sig:= 0;
4 13549 end
3 13550 else
3 13551 begin
4 13552 tilst:= intg(bustilstand(nr));
4 13553 gar:= bustabel(nr) shift (-14);
4 13554 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13555 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13556 sig:= bustabel1(nr) shift (-23);
4 13557 end;
3 13558 søg_omr_bus:= nr;
3 13559 end;
2 13560 \f
2 13560 message procedure find_linie_løb side 1 - 820301/cl;
2 13561
2 13561 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13562 value busnr;
2 13563 integer busnr, linie_løb, garage, tilst;
2 13564 begin
3 13565 integer i,j;
3 13566
3 13566 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13567
3 13567 if j<>0 then <* bus findes ikke *>
3 13568 begin
4 13569 find_linie_løb:= -1;
4 13570 linie_løb:= 0;
4 13571 garage:= 0;
4 13572 tilst:= 0;
4 13573 end
3 13574 else
3 13575 begin
4 13576 tilst:= intg(bustilstand(i));
4 13577 garage:= bustabel(i) shift (-14);
4 13578 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13579 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13580 end;
3 13581 end find_linie_løb;
2 13582 \f
2 13582 message procedure h_vogntabel side 1 - 810413/cl;
2 13583
2 13583 <* hovedmodulcorutine for vogntabelmodul *>
2 13584
2 13584 procedure h_vogntabel;
2 13585 begin
3 13586 integer array field op;
3 13587 integer dest_sem,k;
3 13588
3 13588 procedure skriv_h_vogntabel(zud,omfang);
3 13589 value omfang;
3 13590 zone zud;
3 13591 integer omfang;
3 13592 begin
4 13593 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13594 if omfang<>0 then
4 13595 disable
4 13596 begin
5 13597 skriv_coru(zud,abs curr_coruno);
5 13598 write(zud,"nl",1,<<d>,
5 13599 <:cs-vt :>,cs_vt,"nl",1,
5 13600 <:op :>,op,"nl",1,
5 13601 <:dest-sem :>,dest_sem,"nl",1,
5 13602 <:k :>,k,"nl",1,
5 13603 <::>);
5 13604 end;
4 13605 end;
3 13606 \f
3 13606 message procedure h_vogntabel side 2 - 820301/cl;
3 13607
3 13607 stackclaim(if cm_test then 198 else 146);
3 13608 trap(h_vt_trap);
3 13609
3 13609 <*+2*>
3 13610 <**> disable if testbit47 and overvåget or testbit28 then
3 13611 <**> skriv_h_vogntabel(out,0);
3 13612 <*-2*>
3 13613
3 13613 repeat
3 13614 waitch(cs_vt,op,true,-1);
3 13615 <*+4*>
3 13616 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13617 (d.op.optype and vt_optype) extract 12 = 0 then
3 13618 fejlreaktion(12,op,<:vogntabel:>,0);
3 13619 <*-4*>
3 13620 disable
3 13621 begin
4 13622
4 13622 k:= d.op.opkode extract 12;
4 13623 dest_sem:=
4 13624 if k = 9 then cs_vt_rap else
4 13625 if k = 10 then cs_vt_rap else
4 13626 if k = 11 then cs_vt_opd else
4 13627 if k = 12 then cs_vt_opd else
4 13628 if k = 13 then cs_vt_opd else
4 13629 if k = 14 then cs_vt_tilst else
4 13630 if k = 15 then cs_vt_tilst else
4 13631 if k = 16 then cs_vt_tilst else
4 13632 if k = 17 then cs_vt_tilst else
4 13633 if k = 18 then cs_vt_tilst else
4 13634 if k = 19 then cs_vt_opd else
4 13635 if k = 20 then cs_vt_opd else
4 13636 if k = 21 then cs_vt_auto else
4 13637 if k = 24 then cs_vt_opd else
4 13638 if k = 25 then cs_vt_grp else
4 13639 if k = 26 then cs_vt_grp else
4 13640 if k = 27 then cs_vt_grp else
4 13641 if k = 28 then cs_vt_grp else
4 13642 if k = 30 then cs_vt_spring else
4 13643 if k = 31 then cs_vt_spring else
4 13644 if k = 32 then cs_vt_spring else
4 13645 if k = 33 then cs_vt_spring else
4 13646 if k = 34 then cs_vt_spring else
4 13647 if k = 35 then cs_vt_spring else
4 13648 -1;
4 13649 \f
4 13649 message procedure h_vogntabel side 3 - 810422/cl;
4 13650
4 13650 <*+2*>
4 13651 <**> if testbit41 and overvåget then
4 13652 <**> begin
5 13653 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13654 <**> skriv_op(out,op);
5 13655 <**> end;
4 13656 <*-2*>
4 13657 end;
3 13658
3 13658 if dest_sem = -1 then
3 13659 fejlreaktion(2,k,<:vogntabel:>,0);
3 13660 disable signalch(dest_sem,op,d.op.optype);
3 13661 until false;
3 13662 h_vt_trap:
3 13663 disable skriv_h_vogntabel(zbillede,1);
3 13664 end h_vogntabel;
2 13665 \f
2 13665 message procedure vt_opdater side 1 - 810317/cl;
2 13666
2 13666 procedure vt_opdater(op1);
2 13667 value op1;
2 13668 integer op1;
2 13669 begin
3 13670 integer array field op,radop;
3 13671 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13672 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13673 flin,slin,finx,sinx;
3 13674 integer field bn,ll;
3 13675
3 13675 procedure skriv_vt_opd(zud,omfang);
3 13676 value omfang; integer omfang;
3 13677 zone zud;
3 13678 begin
4 13679 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13680 if omfang <> 0 then
4 13681 disable
4 13682 begin
5 13683 skriv_coru(zud,abs curr_coruno);
5 13684 write(zud,"nl",1,
5 13685 <: op: :>,op,"nl",1,
5 13686 <: radop::>,radop,"nl",1,
5 13687 <: funk: :>,funk,"nl",1,
5 13688 <: res: :>,res,"nl",1,
5 13689 <::>);
5 13690 end;
4 13691 end skriv_vt_opd;
3 13692
3 13692 integer procedure opd_omr(fnk,omr,bus,ll);
3 13693 value fnk,omr,bus,ll;
3 13694 integer fnk,omr,bus,ll;
3 13695 begin
4 13696 opd_omr:= 3;
4 13697 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13698 ændringer skal ikke længere meldes til yderområder *>
4 13699 goto dummy_retur;
4 13700
4 13700 if omr extract 8 > 3 then
4 13701 begin
5 13702 startoperation(radop,501,cs_vt_opd,fnk);
5 13703 d.radop.data(1):= omr;
5 13704 d.radop.data(2):= bus;
5 13705 d.radop.data(3):= ll;
5 13706 signalch(cs_rad,radop,vt_optype);
5 13707 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13708 opd_omr:= d.radop.resultat;
5 13709 end
4 13710 else
4 13711 opd_omr:= 0;
4 13712 dummy_retur:
4 13713 end;
3 13714 message procedure vt_opdater side 1a - 920517/cl;
3 13715
3 13715 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13716 value kilde,kode,bus,ll1,ll2;
3 13717 integer kilde,kode,bus,ll1,ll2;
3 13718 begin
4 13719 integer array field op;
4 13720
4 13720 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13721
4 13721 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13722 systime(1,0.0,d.op.data.v_tid);
4 13723 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13724 d.op.data.v_bus:= bus;
4 13725 d.op.data.v_ll1:= ll1;
4 13726 d.op.data.v_ll2:= ll2;
4 13727 signalch(cs_vt_log,op,vt_optype);
4 13728 end;
3 13729
3 13729 stackclaim((if cm_test then 198 else 146)+125);
3 13730
3 13730 bn:= 4; ll:= 2;
3 13731 radop:= op1;
3 13732 trap(vt_opd_trap);
3 13733
3 13733 <*+2*>
3 13734 <**> disable if testbit47 and overvåget or testbit28 then
3 13735 <**> skriv_vt_opd(out,0);
3 13736 <*-2*>
3 13737 \f
3 13737 message procedure vt_opdater side 2 - 851001/cl;
3 13738
3 13738 vent_op:
3 13739 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13740
3 13740 <*+2*>
3 13741 <**> disable
3 13742 <**> if testbit41 and overvåget then
3 13743 <**> begin
4 13744 <**> skriv_vt_opd(out,0);
4 13745 <**> write(out,<: modtaget operation:>);
4 13746 <**> skriv_op(out,op);
4 13747 <**> end;
3 13748 <*-2*>
3 13749
3 13749 <*+4*>
3 13750 <**>if op<>vt_op then
3 13751 <**>begin
4 13752 <**> disable begin
5 13753 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13754 <**> d.op.resultat:= 31; <*systemfejl*>
5 13755 <**> signalch(d.op.retur,op,d.op.optype);
5 13756 <**> end;
4 13757 <**> goto vent_op;
4 13758 <**>end;
3 13759 <*-4*>
3 13760 disable
3 13761 begin integer opk;
4 13762
4 13762 opk:= d.op.opkode extract 12;
4 13763 funk:= if opk=11 then 1 else
4 13764 if opk=12 then 2 else
4 13765 if opk=13 then 3 else
4 13766 if opk=19 then 4 else
4 13767 if opk=20 then 5 else
4 13768 if opk=24 then 6 else
4 13769 0;
4 13770 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13771 end;
3 13772 res:= 0;
3 13773 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13774 \f
3 13774 message procedure vt_opdater side 3 - 820301/cl;
3 13775
3 13775 indsæt:
3 13776 begin
4 13777 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13778 <*+4*>
4 13779 <**> if d.op.data(1) shift (-22) <> 0 then
4 13780 <**> begin
5 13781 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13782 <**> goto slut_indsæt;
5 13783 <**> end;
4 13784 <*-4*>
4 13785 busnr:= d.op.data(1) extract 14;
4 13786 <*+4*>
4 13787 <**> if d.op.data(2) shift (-22) <> 1 then
4 13788 <**> begin
5 13789 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13790 <**> goto slut_indsæt;
5 13791 <**> end;
4 13792 <*-4*>
4 13793 ll_id:= d.op.data(2);
4 13794 s:= omr:= d.op.data(4) extract 8;
4 13795 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13796 if bi<0 then
4 13797 begin
5 13798 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13799 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13800 end
4 13801 else
4 13802 if s<>0 and s<>omr then
4 13803 res:= 58 <* ulovligt område for bus *>
4 13804 else
4 13805 if intg(bustilstand(bi)) <> 0 then
4 13806 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 13807 else 14 <* optaget *>)
4 13808 else
4 13809 begin
5 13810 if linie_løb_indeks(bi) extract 12 <> 0 then
5 13811 begin <* linie/løb allerede indsat *>
6 13812 res:= 11;
6 13813 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 13814 end
5 13815 else
5 13816 begin
6 13817 \f
6 13817 message procedure vt_opdater side 3a - 900108/cl;
6 13818
6 13818 if d.op.kilde//100 <> 4 then
6 13819 res:= opd_omr(11,gar shift 8 +
6 13820 bustabel1(bi) extract 8,busnr,ll_id);
6 13821 if res>3 then goto slut_indsæt;
6 13822 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 13823 if s=0 then <* linie/løb findes allerede *>
6 13824 begin
7 13825 sig:= busindeks(li) extract 12;
7 13826 d.op.data(3):= bustabel(sig);
7 13827 linie_løb_indeks(sig):= false;
7 13828 disable modiffil(tf_vogntabel,sig,zi);
7 13829 fil(zi).ll:= 0;
7 13830 fil(zi).bn:= bustabel(sig) extract 14 add
7 13831 (bustabel1(sig) extract 8 shift 14);
7 13832 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 13833
7 13833 linie_løb_indeks(bi):= false add li;
7 13834 busindeks(li):= false add bi;
7 13835 disable modiffil(tf_vogntabel,bi,zi);
7 13836 fil(zi).ll:= ll_id;
7 13837 fil(zi).bn:= bustabel(bi) extract 14 add
7 13838 (bustabel1(bi) extract 8 shift 14);
7 13839 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 13840 res:= 3;
7 13841 end
6 13842 else
6 13843 begin
7 13844 \f
7 13844 message procedure vt_opdater side 4 - 810527/cl;
7 13845
7 13845 if s<0 then li:= li +1;
7 13846 if sidste_linie_løb=max_antal_linie_løb then
7 13847 begin
8 13848 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 13849 res:= 31;
8 13850 end
7 13851 else
7 13852 begin
8 13853 for i:= sidste_linie_løb step -1 until li do
8 13854 begin
9 13855 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 13856 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 13857 bus_indeks(i+1):=bus_indeks(i);
9 13858 end;
8 13859 sidste_linie_løb:= sidste_linie_løb +1;
8 13860 linie_løb_tabel(li):= ll_id;
8 13861 linie_løb_indeks(bi):= false add li;
8 13862 busindeks(li):= false add bi;
8 13863 disable s:= modiffil(tf_vogntabel,bi,zi);
8 13864 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 13865 fil(zi).bn:= busnr extract 14 add
8 13866 (bustabel1(bi) extract 8 shift 14);
8 13867 fil(zi).ll:= ll_id;
8 13868 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 13869 res:= 3; <* ok *>
8 13870 end;
7 13871 end;
6 13872 end;
5 13873 end;
4 13874 slut_indsæt:
4 13875 d.op.resultat:= res;
4 13876 end;
3 13877 goto returner;
3 13878 \f
3 13878 message procedure vt_opdater side 5 - 820301/cl;
3 13879
3 13879 udtag:
3 13880 begin
4 13881 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 13882
4 13882 busnr:= ll_id:= 0;
4 13883 omr:= s:= d.op.data(2) extract 8;
4 13884 format:= d.op.data(1) shift (-22);
4 13885 if format=0 then <*busnr*>
4 13886 begin
5 13887 busnr:= d.op.data(1) extract 14;
5 13888 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 13889 if bi<0 then
5 13890 begin
6 13891 if bi=-1 then res:= 10 else
6 13892 if s<>0 then res:= 58 else res:= 57;
6 13893 goto slut_udtag;
6 13894 end;
5 13895 if bi>0 and s<>0 and s<>omr then
5 13896 begin
6 13897 res:= 58; goto slut_udtag;
6 13898 end;
5 13899 li:= linie_løb_indeks(bi) extract 12;
5 13900 busnr:= bustabel(bi);
5 13901 if li=0 or linie_løb_tabel(li)=0 then
5 13902 begin <* bus ej indsat *>
6 13903 res:= 13;
6 13904 goto slut_udtag;
6 13905 end;
5 13906 ll_id:= linie_løb_tabel(li);
5 13907 end
4 13908 else
4 13909 if format=1 then <* linie_løb *>
4 13910 begin
5 13911 ll_id:= d.op.data(1);
5 13912 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 13913 if s<>0 then
5 13914 begin <* linie/løb findes ikke *>
6 13915 res:= 9;
6 13916 goto slut_udtag;
6 13917 end;
5 13918 bi:= busindeks(li) extract 12;
5 13919 busnr:= bustabel(bi);
5 13920 end
4 13921 else <* ulovlig identifikation *>
4 13922 begin
5 13923 res:= 31;
5 13924 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 13925 goto slut_udtag;
5 13926 end;
4 13927 \f
4 13927 message procedure vt_opdater side 6 - 820301/cl;
4 13928
4 13928 tilst:= intg(bustilstand(bi));
4 13929 if tilst<>0 then
4 13930 begin
5 13931 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 13932 goto slut_udtag;
5 13933 end;
4 13934 if d.op.kilde//100 <> 4 then
4 13935 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 13936 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 13937 if res>3 then goto slut_udtag;
4 13938 linie_løb_indeks(bi):= false;
4 13939 for i:= li step 1 until sidste_linie_løb -1 do
4 13940 begin
5 13941 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 13942 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 13943 bus_indeks(i):= bus_indeks(i+1);
5 13944 end;
4 13945 linie_løb_tabel(sidste_linie_løb):= 0;
4 13946 bus_indeks(sidste_linie_løb):= false;
4 13947 sidste_linie_løb:= sidste_linie_løb -1;
4 13948 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 13949 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 13950 fil(zi).ll:= 0;
4 13951 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 13952 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 13953 res:= 3; <* ok *>
4 13954 slut_udtag:
4 13955 d.op.resultat:= res;
4 13956 d.op.data(2):= ll_id;
4 13957 d.op.data(3):= busnr;
4 13958 end;
3 13959 goto returner;
3 13960 \f
3 13960 message procedure vt_opdater side 7 - 851001/cl;
3 13961
3 13961 omkod:
3 13962 flyt:
3 13963 roker:
3 13964 begin
4 13965 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 13966
4 13966 inf1:= inf2:= 0;
4 13967 ll_id1:= d.op.data(1);
4 13968 ll_id2:= d.op.data(2);
4 13969 if ll_id1=ll_id2 then
4 13970 begin
5 13971 res:= 24; inf1:= ll_id2;
5 13972 goto slut_flyt;
5 13973 end;
4 13974 <*+4*>
4 13975 <**> for i:= 1,2 do
4 13976 <**> if d.op.data(i) shift (-22) <> 1 then
4 13977 <**> begin
5 13978 <**> res:= 31;
5 13979 <**> fejlreaktion(10,d.op.data(i),case i of (
5 13980 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 13981 <**> goto slut_flyt;
5 13982 <**> end;
4 13983 <*-4*>
4 13984
4 13984 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 13985 if s<>0 and funk=6 <* roker *> then
4 13986 begin
5 13987 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 13988 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 13989 end;
4 13990 if s<>0 then
4 13991 begin
5 13992 res:= 9; <* ukendt linie/løb *>
5 13993 goto slut_flyt;
5 13994 end;
4 13995 bi1:= busindeks(li1) extract 12;
4 13996 inf1:= bustabel(bi1);
4 13997 tilst:= intg(bustilstand(bi1));
4 13998 if tilst<>0 then <* bus ikke fri *>
4 13999 begin
5 14000 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 14001 goto slut_flyt;
5 14002 end;
4 14003 \f
4 14003 message procedure vt_opdater side 7a- 851001/cl;
4 14004 if d.op.kilde//100 <> 4 then
4 14005
4 14005 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 14006 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 14007 if res>3 then goto slut_flyt;
4 14008
4 14008 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 14009 if s=0 then
4 14010 begin <* ll_id2 er indkodet *>
5 14011 bi2:= busindeks(li2) extract 12;
5 14012 inf2:= bustabel(bi2);
5 14013 tilst:= intg(bustilstand(bi2));
5 14014 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 14015 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 14016 if res>3 then
5 14017 begin
6 14018 inf1:= inf2; inf2:= 0;
6 14019 goto slut_flyt;
6 14020 end;
5 14021
5 14021 if d.op.kilde//100 <> 4 then
5 14022 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 14023 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 14024 if res>3 then goto slut_flyt;
5 14025
5 14025 <* flyt bus *>
5 14026 if funk=6 then
5 14027 linie_løb_indeks(bi2):= false add li1
5 14028 else
5 14029 linie_løb_indeks(bi2):= false;
5 14030 linie_løb_indeks(bi1):= false add li2;
5 14031 if funk=6 then
5 14032 busindeks(li1):= false add bi2
5 14033 else
5 14034 busindeks(li1):= false;
5 14035 busindeks(li2):= false add bi1;
5 14036
5 14036 if funk<>6 then
5 14037 begin
6 14038 <* fjern ll_id1 *>
6 14039 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 14040 begin
7 14041 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 14042 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 14043 busindeks(i):= busindeks(i+1);
7 14044 end;
6 14045 linie_løb_tabel(sidste_linie_løb):= 0;
6 14046 bus_indeks(sidste_linie_løb):= false;
6 14047 sidste_linie_løb:= sidste_linie_løb-1;
6 14048 end;
5 14049
5 14049 <* opdater vogntabelfil *>
5 14050 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 14051 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14052 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 14053 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 14054 if funk=6 then
5 14055 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 14056 else
5 14057 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 14058 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14059 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14060 fil(zi).ll:= ll_id2;
5 14061 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14062 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14063 \f
5 14063 message procedure vt_opdater side 8 - 820301/cl;
5 14064
5 14064 end <* ll_id2 indkodet *>
4 14065 else
4 14066 begin
5 14067 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 14068 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 14069 pm1:= sgn(li2-li1);
5 14070 for i:= li1 step pm1 until li2-pm1 do
5 14071 begin
6 14072 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 14073 busindeks(i):= busindeks(i+pm1);
6 14074 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 14075 end;
5 14076 linie_løb_tabel(li2):= ll_id2;
5 14077 busindeks(li2):= false add bi1;
5 14078 linie_løb_indeks(bi1):= false add li2;
5 14079 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14080 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14081 fil(zi).ll:= ll_id2;
5 14082 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14083 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14084 end;
4 14085 res:= 3; <*udført*>
4 14086 slut_flyt:
4 14087 d.op.resultat:= res;
4 14088 d.op.data(3):= inf1;
4 14089 if funk=5 then d.op.data(4):= inf2;
4 14090 end;
3 14091 goto returner;
3 14092 \f
3 14092 message procedure vt_opdater side 9 - 851001/cl;
3 14093
3 14093 slet:
3 14094 begin
4 14095 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 14096 boolean test24;
4 14097
4 14097 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 14098 omr:= d.op.data(3);
4 14099
4 14099 if d.op.data(1) > d.op.data(2) then
4 14100 begin
5 14101 res:= 44; <* intervalstørrelse ulovlig *>
5 14102 goto slut_slet;
5 14103 end;
4 14104
4 14104 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 14105 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 14106
4 14106 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 14107 if s<0 then finx:= finx+1;
4 14108 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 14109 if s>0 then sinx:= sinx-1;
4 14110
4 14110 for li:= finx step 1 until sinx do
4 14111 begin
5 14112 bi:= busindeks(li) extract 12;
5 14113 gar:= bustabel(bi) shift (-14) extract 8;
5 14114 if intg(bustilstand(bi))=0 and
5 14115 (omr = 0 or (omr > 0 and omr = gar) or
5 14116 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 14117 begin
6 14118 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 14119 linie_løb_indeks(bi):= busindeks(li):= false;
6 14120 linie_løb_tabel(li):= 0;
6 14121 end;
5 14122 end;
4 14123 \f
4 14123 message procedure vt_opdater side 10 - 850820/cl;
4 14124
4 14124 sinx:= finx-1;
4 14125 for li:= finx step 1 until sidste_linie_løb do
4 14126 begin
5 14127 if linie_løb_tabel(li)<>0 then
5 14128 begin
6 14129 sinx:= sinx+1;
6 14130 if sinx<>li then
6 14131 begin
7 14132 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 14133 busindeks(sinx):= busindeks(li);
7 14134 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 14135 linie_løb_tabel(li):= 0;
7 14136 busindeks(li):= false;
7 14137 end;
6 14138 end;
5 14139 end;
4 14140 sidste_linie_løb:= sinx;
4 14141
4 14141 test24:= testbit24; testbit24:= false;
4 14142 for bi:= 1 step 1 until sidste_bus do
4 14143 disable
4 14144 begin
5 14145 s:= modiffil(tf_vogntabel,bi,finx);
5 14146 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 14147 fil(finx).bn:= bustabel(bi) extract 14 add
5 14148 (bustabel1(bi) extract 8 shift 14);
5 14149 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 14150 end;
4 14151 testbit24:= test24;
4 14152 res:= 3;
4 14153
4 14153 slut_slet:
4 14154 d.op.resultat:= res;
4 14155 end;
3 14156 goto returner;
3 14157 \f
3 14157 message procedure vt_opdater side 11 - 810409/cl;
3 14158
3 14158 returner:
3 14159 disable
3 14160 begin
4 14161
4 14161 <*+2*>
4 14162 <**> if testbit40 and overvåget then
4 14163 <**> begin
5 14164 <**> skriv_vt_opd(out,0);
5 14165 <**> write(out,<: vogntabel efter ændring:>);
5 14166 <**> p_vogntabel(out);
5 14167 <**> end;
4 14168 <**> if testbit41 and overvåget then
4 14169 <**> begin
5 14170 <**> skriv_vt_opd(out,0);
5 14171 <**> write(out,<: returner operation:>);
5 14172 <**> skriv_op(out,op);
5 14173 <**> end;
4 14174 <*-2*>
4 14175
4 14175 signalch(d.op.retur,op,d.op.optype);
4 14176 end;
3 14177 goto vent_op;
3 14178
3 14178 vt_opd_trap:
3 14179 disable skriv_vt_opd(zbillede,1);
3 14180
3 14180 end vt_opdater;
2 14181 \f
2 14181 message procedure vt_tilstand side 1 - 810424/cl;
2 14182
2 14182 procedure vt_tilstand(cs_fil,fil_opref);
2 14183 value cs_fil,fil_opref;
2 14184 integer cs_fil,fil_opref;
2 14185 begin
3 14186 integer array field op,filop;
3 14187 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14188 g_type,gr,antal,ej_res,zi,li,filref;
3 14189 integer array identer(1:max_antal_i_gruppe);
3 14190
3 14190 procedure skriv_vt_tilst(zud,omfang);
3 14191 value omfang;
3 14192 zone zud;
3 14193 integer omfang;
3 14194 begin
4 14195 real array field raf;
4 14196 raf:= 0;
4 14197 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14198 if omfang <> 0 then
4 14199 begin
5 14200 skriv_coru(zud,abs curr_coruno);
5 14201 write(zud,"nl",1,<<d>,
5 14202 <:cs-fil :>,cs_fil,"nl",1,
5 14203 <:filop :>,filop,"nl",1,
5 14204 <:op :>,op,"nl",1,
5 14205 <:funk :>,funk,"nl",1,
5 14206 <:format :>,format,"nl",1,
5 14207 <:busid :>,busid,"nl",1,
5 14208 <:res :>,res,"nl",1,
5 14209 <:bi :>,bi,"nl",1,
5 14210 <:tilst :>,tilst,"nl",1,
5 14211 <:opk :>,opk,"nl",1,
5 14212 <:opk-indeks :>,opk_indeks,"nl",1,
5 14213 <:g-type :>,g_type,"nl",1,
5 14214 <:gr :>,gr,"nl",1,
5 14215 <:antal :>,antal,"nl",1,
5 14216 <:ej-res :>,ej_res,"nl",1,
5 14217 <:zi :>,zi,"nl",1,
5 14218 <:li :>,li,"nl",1,
5 14219 <::>);
5 14220 write(zud,"nl",1,<:identer:>);
5 14221 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14222 end;
4 14223 end;
3 14224
3 14224 procedure sorter_gruppe(tab,l,u);
3 14225 value l,u;
3 14226 integer array tab;
3 14227 integer l,u;
3 14228 begin
4 14229 integer array field ii,jj;
4 14230 integer array ww, xx(1:2);
4 14231
4 14231 integer procedure sml(a,b);
4 14232 integer array a,b;
4 14233 begin
5 14234 integer res;
5 14235
5 14235 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14236 if res = 0 then
5 14237 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14238 if res = 0 then
5 14239 res:=
5 14240 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14241 if res = 0 then
5 14242 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14243 sml:= res;
5 14244 end;
4 14245
4 14245 ii:= ((l+u)//2 - 1)*4;
4 14246 tofrom(xx,tab.ii,4);
4 14247 ii:= (l-1)*4; jj:= (u-1)*4;
4 14248 repeat
4 14249 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14250 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14251 if ii <= jj then
4 14252 begin
5 14253 tofrom(ww,tab.ii,4);
5 14254 tofrom(tab.ii,tab.jj,4);
5 14255 tofrom(tab.jj,ww,4);
5 14256 ii:= ii+4;
5 14257 jj:= jj-4;
5 14258 end;
4 14259 until ii>jj;
4 14260 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14261 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14262 end;
3 14263 \f
3 14263 message procedure vt_tilstand side 2 - 820301/cl;
3 14264
3 14264 filop:= filopref;
3 14265 stackclaim(if cm_test then 550 else 500);
3 14266 trap(vt_tilst_trap);
3 14267
3 14267 <*+2*>
3 14268 <**> disable if testbit47 and overvåget or testbit28 then
3 14269 <**> skriv_vt_tilst(out,0);
3 14270 <*-2*>
3 14271
3 14271 vent_op:
3 14272 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14273 <*+2*>disable
3 14274 <**> if (testbit41 and overvåget) or
3 14275 (testbit46 and overvåget and
3 14276 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14277 then
3 14278 <**> begin
4 14279 <**> skriv_vt_tilst(out,0);
4 14280 <**> write(out,<: modtaget operation:>);
4 14281 <**> skriv_op(out,op);
4 14282 <**> end;
3 14283 <*-2*>
3 14284
3 14284 <*+4*>
3 14285 <**> if op <> vt_op then
3 14286 <**> begin
4 14287 <**> disable begin
5 14288 <**> d.op.resultat:= 31;
5 14289 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14290 <**> end;
4 14291 <**> goto returner;
4 14292 <**> end;
3 14293 <*-4*>
3 14294
3 14294 opk:= d.op.opkode extract 12;
3 14295 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14296 if opk = 15 <*bus res *> then 2 else
3 14297 if opk = 16 <*grp res *> then 4 else
3 14298 if opk = 17 <*bus fri *> then 3 else
3 14299 if opk = 18 <*grp fri *> then 5 else
3 14300 0;
3 14301 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14302 res:= 0;
3 14303 format:= d.op.data(1) shift (-22);
3 14304
3 14304 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14305 \f
3 14305 message procedure vt_tilstand side 3 - 820301/cl;
3 14306
3 14306 enkelt_bus:
3 14307 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14308 disable
3 14309 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14310 <*+4*>
4 14311 <**>if format <> 0 and format <> 1 then
4 14312 <**>begin
5 14313 <**> res:= 31;
5 14314 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14315 <**> goto slut_enkelt_bus;
5 14316 <**>end;
4 14317 <*-4*>
4 14318 <* find busnr og tilstand *>
4 14319 case format+1 of
4 14320 begin
5 14321 <* 0: budident *>
5 14322 begin
6 14323 busnr:= d.op.data(1) extract 14;
6 14324 s:= omr:= d.op.data(4) extract 8;
6 14325 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14326 if bi<0 then
6 14327 begin
7 14328 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14329 goto slut_enkelt_bus;
7 14330 end
6 14331 else
6 14332 begin
7 14333 tilst:= intg(bustilstand(bi));
7 14334 end;
6 14335 end;
5 14336
5 14336 <* 1: linie_løb_ident *>
5 14337 begin
6 14338 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14339 if bi < 0 then <* ukendt linie_løb *>
6 14340 begin
7 14341 res:= 9;
7 14342 goto slut_enkelt_bus;
7 14343 end;
6 14344 end;
5 14345 end case;
4 14346 \f
4 14346 message procedure vt_tilstand side 4 - 830310/cl;
4 14347
4 14347 if funk < 3 then
4 14348 begin
5 14349 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14350 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14351 else 0;
5 14352 d.op.data(3):= bustabel(bi);
5 14353 d.op.data(4):= bustabel1(bi);
5 14354 end;
4 14355
4 14355 <* check tilstand *>
4 14356 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14357 res:= 39 <* bus ikke reserveret *>
4 14358 else
4 14359 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14360 res:= 14 <* bus optaget *>
4 14361 else
4 14362 if funk = 1 <* i kø *> and tilst = (-1) then
4 14363 res:= 18 <* i kø *>
4 14364 else
4 14365 res:= 3; <*udført*>
4 14366
4 14366 if res = 3 then
4 14367 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14368
4 14368 slut_enkelt_bus:
4 14369 d.op.resultat:= res;
4 14370 end <*disable*>;
3 14371 goto returner;
3 14372 \f
3 14372 message procedure vt_tilstand side 5 - 810424/cl;
3 14373
3 14373 grp_res: <* reserver gruppe *>
3 14374 disable
3 14375 begin
4 14376
4 14376 <*+4*>
4 14377 <**> if format <> 2 then
4 14378 <**> begin
5 14379 <**> res:= 31;
5 14380 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14381 <**> goto slut_grp_res_1;
5 14382 <**> end;
4 14383 <*-4*>
4 14384
4 14384 <* find frit indeks i opkaldstabel *>
4 14385 opk_indeks:= 0;
4 14386 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14387 begin
5 14388 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14389 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14390 end;
4 14391 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14392 if res <> 0 then goto slut_grp_res_1;
4 14393 g_type:= d.op.data(1) shift (-21) extract 1;
4 14394 if g_type = 1 <*special gruppe*> then
4 14395 begin <*check eksistens*>
5 14396 gr:= 0;
5 14397 for i:= 1 step 1 until max_antal_grupper do
5 14398 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14399 if gr = 0 then <*gruppe ukendt*>
5 14400 begin
6 14401 res:= 8;
6 14402 goto slut_grp_res_1;
6 14403 end;
5 14404 end;
4 14405
4 14405 <* reserver i opkaldstabel *>
4 14406 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14407 \f
4 14407 message procedure vt_tilstand side 6 - 810428/cl;
4 14408
4 14408 <* tilknyt fil *>
4 14409 start_operation(filop,curr_coruid,cs_fil,101);
4 14410 d.filop.data(1):= 0; <*postantal*>
4 14411 d.filop.data(2):= 256; <*postlængde*>
4 14412 d.filop.data(3):= 1; <*segmentantal*>
4 14413 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14414 signalch(cs_opret_fil,filop,vt_optype);
4 14415
4 14415 slut_grp_res_1:
4 14416 if res <> 0 then d.op.resultat:= res;
4 14417 end;
3 14418 if res <> 0 then goto returner;
3 14419
3 14419 waitch(cs_fil,filop,vt_optype,-1);
3 14420
3 14420 <* check filsys-resultat *>
3 14421 if d.filop.data(9) <> 0 then
3 14422 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14423 filref:= d.filop.data(4);
3 14424 \f
3 14424 message procedure vt_tilstand side 7 - 820301/cl;
3 14425 disable if g_type = 0 <*linie-gruppe*> then
3 14426 begin
4 14427 integer s,i,ll_id;
4 14428 integer array field iaf1;
4 14429
4 14429 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14430 iaf1:= 2;
4 14431 s:= binærsøg(sidste_linie_løb,
4 14432 linie_løb_tabel(i) - ll_id, i);
4 14433 if s < 0 then i:= i +1;
4 14434 antal:= ej_res:= 0;
4 14435 skrivfil(filref,1,zi);
4 14436 if i <= sidste_linie_løb then
4 14437 begin
5 14438 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14439 begin
6 14440 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14441 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14442 ej_res:= ej_res+1
6 14443 else
6 14444 begin
7 14445 antal:= antal+1;
7 14446 bi:= busindeks(i) extract 12;
7 14447 fil(zi).iaf1(1):=
7 14448 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14449 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14450 fil(zi).iaf1(2):= bustabel(bi);
7 14451 iaf1:= iaf1+4;
7 14452 bustilstand(bi):= false add opk_indeks;
7 14453 end;
6 14454 i:= i +1;
6 14455 if i > sidste_linie_løb then goto slut_l_grp;
6 14456 end;
5 14457 end;
4 14458 \f
4 14458 message procedure vt_tilstand side 8 - 820301/cl;
4 14459
4 14459 slut_l_grp:
4 14460 end
3 14461 else
3 14462 begin <*special gruppe*>
4 14463 integer i,s,li,omr,gar,tilst;
4 14464 integer array field iaf1;
4 14465
4 14465 iaf1:= 2;
4 14466 antal:= ej_res:= 0;
4 14467 s:= læsfil(tf_gruppedef,gr,zi);
4 14468 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14469 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14470 s:= skrivfil(filref,1,zi);
4 14471 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14472 i:= 1;
4 14473 while identer(i) <> 0 do
4 14474 begin
5 14475 if identer(i) shift (-22) = 0 then
5 14476 begin <*busident*>
6 14477 omr:= 0;
6 14478 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14479 if bi<0 then goto næste_ident;
6 14480 li:= linie_løb_indeks(bi) extract 12;
6 14481 end
5 14482 else
5 14483 begin <*linie/løb ident*>
6 14484 s:= binærsøg(sidste_linie_løb,
6 14485 linie_løb_tabel(li) - identer(i), li);
6 14486 if s <> 0 then goto næste_ident;
6 14487 bi:= busindeks(li) extract 12;
6 14488 end;
5 14489 if (intg(bustilstand(bi))<>0) or
5 14490 (bustabel1(bi) extract 8 <> 3) then
5 14491 ej_res:= ej_res+1
5 14492 else
5 14493 begin
6 14494 antal:= antal +1;
6 14495 fil(zi).iaf1(1):=
6 14496 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14497 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14498 fil(zi).iaf1(2):= bustabel(bi);
6 14499 iaf1:= iaf1+4;
6 14500 bustilstand(bi):= false add opk_indeks;
6 14501 end;
5 14502 næste_ident:
5 14503 i:= i +1;
5 14504 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14505 end;
4 14506 slut_s_grp:
4 14507 end;
3 14508 \f
3 14508 message procedure vt_tilstand side 9 - 820301/cl;
3 14509
3 14509 if antal > 0 then <*ok*>
3 14510 disable begin
4 14511 integer array field spec,akt;
4 14512 integer a;
4 14513 integer field antal_spec;
4 14514
4 14514 antal_spec:= 2; a:= 0;
4 14515 spec:= 2; akt:= 2;
4 14516 sorter_gruppe(fil(zi).spec,1,antal);
4 14517 fil(zi).antal_spec:= 0;
4 14518 while akt//4 < antal do
4 14519 begin
5 14520 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14521 a:= 0;
5 14522 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14523 and a<15 do
5 14524 begin
6 14525 a:= a+1;
6 14526 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14527 akt:= akt+4;
6 14528 end;
5 14529 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14530 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14531 spec:= spec + 2*a + 2;
5 14532 end;
4 14533 antal:= fil(zi).antal_spec;
4 14534 gruppeopkald(opk_indeks,2):= filref;
4 14535 d.op.resultat:= 3;
4 14536 d.op.data(2):= antal;
4 14537 d.op.data(3):= filref;
4 14538 d.op.data(4):= ej_res;
4 14539 end
3 14540 else
3 14541 begin
4 14542 disable begin
5 14543 d.filop.opkode:= 104; <*slet fil*>
5 14544 signalch(cs_slet_fil,filop,vt_optype);
5 14545 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14546 d.op.resultat:= 54;
5 14547 d.op.data(2):= antal;
5 14548 d.op.data(3):= 0;
5 14549 d.op.data(4):= ej_res;
5 14550 end;
4 14551 waitch(cs_fil,filop,vt_optype,-1);
4 14552 if d.filop.data(9) <> 0 then
4 14553 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14554 end;
3 14555 goto returner;
3 14556 \f
3 14556 message procedure vt_tilstand side 10 - 820301/cl;
3 14557
3 14557 grp_fri: <* frigiv gruppe *>
3 14558 disable
3 14559 begin integer i,j,s,ll,gar,omr,tilst;
4 14560 integer array field spec;
4 14561
4 14561 <*+4*>
4 14562 <**> if format <> 2 then
4 14563 <**> begin
5 14564 <**> res:= 31;
5 14565 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14566 <**> goto slut_grp_fri;
5 14567 <**> end;
4 14568 <*-4*>
4 14569
4 14569 <* find indeks i opkaldstabel *>
4 14570 opk_indeks:= 0;
4 14571 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14572 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14573 if opk_indeks = 0 <*ikke fundet*> then
4 14574 begin
5 14575 res:= 40; <*gruppe ej reserveret*>
5 14576 goto slut_grp_fri;
5 14577 end;
4 14578 filref:= gruppeopkald(opk_indeks,2);
4 14579 start_operation(filop,curr_coruid,cs_fil,104);
4 14580 d.filop.data(4):= filref;
4 14581 hentfildim(d.filop.data);
4 14582 læsfil(filref,1,zi);
4 14583 spec:= 0;
4 14584 antal:= fil(zi).spec(1);
4 14585 spec:= spec+2;
4 14586 for i:= 1 step 1 until antal do
4 14587 begin
5 14588 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14589 begin
6 14590 busid:= fil(zi).spec(1+j) extract 14;
6 14591 omr:= 0;
6 14592 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14593 if bi>=0 then bustilstand(bi):= false;
6 14594 end;
5 14595 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14596 end;
4 14597
4 14597 slut_grp_fri:
4 14598 d.op.resultat:= res;
4 14599 end;
3 14600 if res <> 0 then goto returner;
3 14601 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14602 signalch(cs_slet_fil,filop,vt_optype);
3 14603 \f
3 14603 message procedure vt_tilstand side 11 - 810424/cl;
3 14604
3 14604 waitch(cs_fil,filop,vt_optype,-1);
3 14605
3 14605 if d.filop.data(9) <> 0 then
3 14606 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14607 d.op.resultat:= 3;
3 14608
3 14608 returner:
3 14609 disable
3 14610 begin
4 14611 <*+2*>
4 14612 <**> if testbit40 and overvåget then
4 14613 <**> begin
5 14614 <**> skriv_vt_tilst(out,0);
5 14615 <**> write(out,<: vogntabel efter ændring:>);
5 14616 <**> p_vogntabel(out);
5 14617 <**> end;
4 14618 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14619 <**> begin
5 14620 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14621 <**> p_gruppetabel(out);
5 14622 <**> end;
4 14623 <**> if (testbit41 and overvåget) or
4 14624 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14625 <**> begin
5 14626 <**> skriv_vt_tilst(out,0);
5 14627 <**> write(out,<: returner operation:>);
5 14628 <**> skriv_op(out,op);
5 14629 <**> end;
4 14630 <*-2*>
4 14631 signalch(d.op.retur,op,d.op.optype);
4 14632 end;
3 14633 goto vent_op;
3 14634
3 14634 vt_tilst_trap:
3 14635 disable skriv_vt_tilst(zbillede,1);
3 14636
3 14636 end vt_tilstand;
2 14637 \f
2 14637 message procedure vt_rapport side 1 - 810428/cl;
2 14638
2 14638 procedure vt_rapport(cs_fil,fil_opref);
2 14639 value cs_fil,fil_opref;
2 14640 integer cs_fil,fil_opref;
2 14641 begin
3 14642 integer array field op,filop;
3 14643 integer funk,filref,antal,id_ant,res;
3 14644 integer field i1,i2;
3 14645
3 14645 procedure skriv_vt_rap(z,omfang);
3 14646 value omfang;
3 14647 zone z;
3 14648 integer omfang;
3 14649 begin
4 14650 write(z,"nl",1,<:+++ vt_rapport :>);
4 14651 if omfang <> 0 then
4 14652 begin
5 14653 skriv_coru(z,abs curr_coruno);
5 14654 write(z,"nl",1,<<d>,
5 14655 <: cs_fil :>,cs_fil,"nl",1,
5 14656 <: filop :>,filop,"nl",1,
5 14657 <: op :>,op,"nl",1,
5 14658 <: funk :>,funk,"nl",1,
5 14659 <: filref :>,filref,"nl",1,
5 14660 <: antal :>,antal,"nl",1,
5 14661 <: id-ant :>,id_ant,"nl",1,
5 14662 <: res :>,res,"nl",1,
5 14663 <::>);
5 14664
5 14664 end;
4 14665 end skriv_vt_rap;
3 14666
3 14666 stackclaim(if cm_test then 198 else 146);
3 14667 filop:= fil_opref;
3 14668 i1:= 2; i2:= 4;
3 14669 trap(vt_rap_trap);
3 14670
3 14670 <*+2*>
3 14671 <**> disable if testbit47 and overvåget or testbit28 then
3 14672 <**> skriv_vt_rap(out,0);
3 14673 <*-2*>
3 14674 \f
3 14674 message procedure vt_rapport side 2 - 810505/cl;
3 14675
3 14675 vent_op:
3 14676 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14677
3 14677 <*+2*>
3 14678 <**> disable begin
4 14679 <**> if testbit41 and overvåget then
4 14680 <**> begin
5 14681 <**> skriv_vt_rap(out,0);
5 14682 <**> write(out,<: modtaget operation:>);
5 14683 <**> skriv_op(out,op);
5 14684 <**> ud;
5 14685 <**> end;
4 14686 <**> end;<*disable*>
3 14687 <*-2*>
3 14688
3 14688 disable
3 14689 begin
4 14690 integer opk;
4 14691
4 14691 opk:= d.op.opkode extract 12;
4 14692 funk:= if opk = 9 then 1 else
4 14693 if opk =10 then 2 else
4 14694 0;
4 14695 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14696
4 14696 <* opret og tilknyt fil *>
4 14697 start_operation(filop,curr_coruid,cs_fil,101);
4 14698 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14699 d.filop.data(2):= 2; <*postlængde*>
4 14700 d.filop.data(3):=10; <*segmenter*>
4 14701 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14702 signalch(cs_opretfil,filop,vt_optype);
4 14703 end;
3 14704
3 14704 waitch(cs_fil,filop,vt_optype,-1);
3 14705
3 14705 <* check resultat *>
3 14706 if d.filop.data(9) <> 0 then
3 14707 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14708 filref:= d.filop.data(4);
3 14709 antal:= 0;
3 14710 goto case funk of (l_rapport,b_rapport);
3 14711 \f
3 14711 message procedure vt_rapport side 3 - 850820/cl;
3 14712
3 14712 l_rapport:
3 14713 disable
3 14714 begin
4 14715 integer i,j,s,ll,zi;
4 14716 idant:= 0;
4 14717 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14718 <*+4*>
4 14719 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14720 <**> begin
5 14721 <**> res:= 31;
5 14722 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14723 <**> goto l_rap_slut;
5 14724 <**> end;
4 14725 <*-4*>
4 14726 ;
4 14727
4 14727 for i:= 1 step 1 until id_ant do
4 14728 begin
5 14729 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14730 s:= binærsøg(sidste_linie_løb,
5 14731 linie_løb_tabel(j) - ll, j);
5 14732 if s < 0 then j:= j +1;
5 14733
5 14733 if j<= sidste_linie_løb then
5 14734 begin <* skriv identer *>
6 14735 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14736 begin
7 14737 antal:= antal +1;
7 14738 s:= skrivfil(filref,antal,zi);
7 14739 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14740 fil(zi).i1:= linie_løb_tabel(j);
7 14741 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14742 j:= j +1;
7 14743 if j > sidste_bus then goto linie_slut;
7 14744 end;
6 14745 end;
5 14746 linie_slut:
5 14747 end;
4 14748 res:= 3;
4 14749 l_rap_slut:
4 14750 end <*disable*>;
3 14751 goto returner;
3 14752 \f
3 14752 message procedure vt_rapport side 4 - 820301/cl;
3 14753
3 14753 b_rapport:
3 14754 disable
3 14755 begin
4 14756 integer i,j,s,zi,busnr1,busnr2;
4 14757 <*+4*>
4 14758 <**> for i:= 1,2 do
4 14759 <**> if d.op.data(i) shift (-14) <> 0 then
4 14760 <**> begin
5 14761 <**> res:= 31;
5 14762 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14763 <**> goto bus_slut;
5 14764 <**> end;
4 14765 <*-4*>
4 14766
4 14766 busnr1:= d.op.data(1) extract 14;
4 14767 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14768 if busnr1 = 0 or busnr2 < busnr1 then
4 14769 begin
5 14770 res:= 7; <* fejl i busnr *>
5 14771 goto bus_slut;
5 14772 end;
4 14773
4 14773 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14774 - busnr1,j);
4 14775 if s < 0 then j:= j +1;
4 14776 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14777 if j <= sidste_bus then
4 14778 begin <* skriv identer *>
5 14779 while bustabel(j) extract 14 <= busnr2 do
5 14780 begin
6 14781 i:= linie_løb_indeks(j) extract 12;
6 14782 if i<>0 then
6 14783 begin
7 14784 antal:= antal +1;
7 14785 s:= skriv_fil(filref,antal,zi);
7 14786 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14787 fil(zi).i1:= bustabel(j);
7 14788 fil(zi).i2:= linie_løb_tabel(i);
7 14789 end;
6 14790 j:= j +1;
6 14791 if j > sidste_bus then goto bus_slut;
6 14792 end;
5 14793 end;
4 14794 bus_slut:
4 14795 end <*disable*>;
3 14796 res:= 3; <*ok*>
3 14797 \f
3 14797 message procedure vt_rapport side 5 - 810409/cl;
3 14798
3 14798 returner:
3 14799 disable
3 14800 begin
4 14801 d.op.resultat:= res;
4 14802 d.op.data(6):= antal;
4 14803 d.op.data(7):= filref;
4 14804 d.filop.data(1):= antal;
4 14805 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 14806 i:= sæt_fil_dim(d.filop.data);
4 14807 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 14808 <*+2*>
4 14809 <**> if testbit41 and overvåget then
4 14810 <**> begin
5 14811 <**> skriv_vt_rap(out,0);
5 14812 <**> write(out,<: returner operation:>);
5 14813 <**> skriv_op(out,op);
5 14814 <**> end;
4 14815 <*-2*>
4 14816 signalch(d.op.retur,op,d.op.optype);
4 14817 end;
3 14818 goto vent_op;
3 14819
3 14819 vt_rap_trap:
3 14820 disable skriv_vt_rap(zbillede,1);
3 14821
3 14821 end vt_rapport;
2 14822 \f
2 14822 message procedure vt_gruppe side 1 - 810428/cl;
2 14823
2 14823 procedure vt_gruppe(cs_fil,fil_opref);
2 14824
2 14824 value cs_fil,fil_opref;
2 14825 integer cs_fil,fil_opref;
2 14826 begin
3 14827 integer array field op, fil_op, iaf;
3 14828 integer funk, res, filref, gr, i, antal, zi, s;
3 14829 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 14830 max_antal_grupper else max_antal_i_gruppe));
3 14831
3 14831 procedure skriv_vt_gruppe(zud,omfang);
3 14832 value omfang;
3 14833 integer omfang;
3 14834 zone zud;
3 14835 begin
4 14836 integer øg;
4 14837
4 14837 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 14838 if omfang <> 0 then
4 14839 disable
4 14840 begin
5 14841 skriv_coru(zud,abs curr_coruno);
5 14842 write(zud,"nl",1,<<d>,
5 14843 <: cs_fil :>,cs_fil,"nl",1,
5 14844 <: op :>,op,"nl",1,
5 14845 <: filop :>,filop,"nl",1,
5 14846 <: funk :>,funk,"nl",1,
5 14847 <: res :>,res,"nl",1,
5 14848 <: filref :>,filref,"nl",1,
5 14849 <: gr :>,gr,"nl",1,
5 14850 <: i :>,i,"nl",1,
5 14851 <: antal :>,antal,"nl",1,
5 14852 <: zi :>,zi,"nl",1,
5 14853 <: s :>,s,"nl",1,
5 14854 <::>);
5 14855 raf:= 0;
5 14856 system(3,øg,identer);
5 14857 write(zud,"nl",1,<:identer::>);
5 14858 skriv_hele(zud,identer.raf,øg*2,2);
5 14859 end;
4 14860 end;
3 14861
3 14861 stackclaim(if cm_test then 198 else 146);
3 14862 filop:= fil_opref;
3 14863 trap(vt_grp_trap);
3 14864 iaf:= 0;
3 14865 \f
3 14865 message procedure vt_gruppe side 2 - 810409/cl;
3 14866
3 14866 <*+2*>
3 14867 <**> disable if testbit47 and overvåget or testbit28 then
3 14868 <**> skriv_vt_gruppe(out,0);
3 14869 <*-2*>
3 14870
3 14870 vent_op:
3 14871 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 14872 <*+2*>
3 14873 <**>disable
3 14874 <**>begin
4 14875 <**> if testbit41 and overvåget then
4 14876 <**> begin
5 14877 <**> skriv_vt_gruppe(out,0);
5 14878 <**> write(out,<: modtaget operation:>);
5 14879 <**> skriv_op(out,op);
5 14880 <**> ud;
5 14881 <**> end;
4 14882 <**>end;
3 14883 <*-2*>
3 14884
3 14884 disable
3 14885 begin
4 14886 integer opk;
4 14887
4 14887 opk:= d.op.opkode extract 12;
4 14888 funk:= if opk=25 then 1 else
4 14889 if opk=26 then 2 else
4 14890 if opk=27 then 3 else
4 14891 if opk=28 then 4 else
4 14892 0;
4 14893 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14894 end;
3 14895 <*+4*>
3 14896 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 14897 <**> begin
4 14898 <**> disable begin
5 14899 <**> d.op.resultat:= 31;
5 14900 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 14901 <**> end;
4 14902 <**> goto returner;
4 14903 <**> end;
3 14904 <*-4*>
3 14905
3 14905 goto case funk of(definer,slet,vis,oversigt);
3 14906 \f
3 14906 message procedure vt_gruppe side 3 - 810505/cl;
3 14907
3 14907 definer:
3 14908 disable
3 14909 begin
4 14910 gr:= 0; res:= 0;
4 14911 for i:= max_antal_grupper step -1 until 1 do
4 14912 begin
5 14913 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 14914 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 14915 end;
4 14916 if gr=0 then res:= 32; <*ingen plads*>
4 14917 end;
3 14918 if res<>0 then goto slut_definer;
3 14919 disable
3 14920 begin <*fri plads fundet*>
4 14921 antal:= d.op.data(2);
4 14922 if antal <=0 or max_antal_i_gruppe<antal then
4 14923 res:= 33 <*fejl i gruppestørrelse*>
4 14924 else
4 14925 begin
5 14926 for i:= 1 step 1 until antal do
5 14927 begin
6 14928 s:= læsfil(d.op.data(3),i,zi);
6 14929 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 14930 identer(i):= fil(zi).iaf(1);
6 14931 end;
5 14932 s:= modif_fil(tf_gruppedef,gr,zi);
5 14933 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14934 tofrom(fil(zi).iaf,identer,antal*2);
5 14935 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 14936 fil(zi).iaf(i):= 0;
5 14937 gruppetabel(gr):= d.op.data(1);
5 14938 s:= modiffil(tf_gruppeidenter,gr,zi);
5 14939 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14940 fil(zi).iaf(1):= gruppetabel(gr);
5 14941 res:= 3;
5 14942 end;
4 14943 end;
3 14944 slut_definer:
3 14945 <*slet fil*>
3 14946 start_operation(fil_op,curr_coruid,cs_fil,104);
3 14947 d.filop.data(4):= d.op.data(3);
3 14948 signalch(cs_slet_fil,filop,vt_optype);
3 14949 waitch(cs_fil,filop,vt_optype,-1);
3 14950 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 14951 d.op.resultat:= res;
3 14952 goto returner;
3 14953 \f
3 14953 message procedure vt_gruppe side 4 - 810409/cl;
3 14954
3 14954 slet:
3 14955 disable
3 14956 begin
4 14957 gr:= 0; res:= 0;
4 14958 for i:= 1 step 1 until max_antal_grupper do
4 14959 begin
5 14960 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 14961 end;
4 14962 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 14963 else
4 14964 begin
5 14965 for i:= 1 step 1 until max_antal_gruppeopkald do
5 14966 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 14967 if res = 0 then
5 14968 begin
6 14969 gruppetabel(gr):= 0;
6 14970 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 14971 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 14972 fil(zi).iaf(1):= gruppetabel(gr);
6 14973 res:= 3;
6 14974 end;
5 14975 end;
4 14976 d.op.resultat:= res;
4 14977 end;
3 14978 goto returner;
3 14979 \f
3 14979 message procedure vt_gruppe side 5 - 810505/cl;
3 14980
3 14980 vis:
3 14981 disable
3 14982 begin
4 14983 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 14984 for i:= 1 step 1 until max_antal_grupper do
4 14985 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 14986 if gr = 0 then res:= 8
4 14987 else
4 14988 begin
5 14989 s:= læsfil(tf_gruppedef,gr,zi);
5 14990 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 14991 for i:= 1 step 1 until max_antal_i_gruppe do
5 14992 begin
6 14993 identer(i):= fil(zi).iaf(i);
6 14994 if identer(i) <> 0 then antal:= antal +1;
6 14995 end;
5 14996 start_operation(filop,curr_coruid,cs_fil,101);
5 14997 d.filop.data(1):= antal; <*postantal*>
5 14998 d.filop.data(2):= 1; <*postlængde*>
5 14999 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 15000 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 15001 d.filop.data(5):= d.filop.data(6):=
5 15002 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 15003 signalch(cs_opret_fil,filop,vt_optype);
5 15004 end;
4 15005 end;
3 15006 if res <> 0 then goto slut_vis;
3 15007 waitch(cs_fil,filop,vt_optype,-1);
3 15008 disable
3 15009 begin
4 15010 if d.filop.data(9) <> 0 then
4 15011 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 15012 filref:= d.filop.data(4);
4 15013 for i:= 1 step 1 until antal do
4 15014 begin
5 15015 s:= skrivfil(filref,i,zi);
5 15016 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 15017 fil(zi).iaf(1):= identer(i);
5 15018 end;
4 15019 res:= 3;
4 15020 end;
3 15021 slut_vis:
3 15022 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 15023 goto returner;
3 15024 \f
3 15024 message procedure vt_gruppe side 6 - 810508/cl;
3 15025
3 15025 oversigt:
3 15026 disable
3 15027 begin
4 15028 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 15029 for i:= 1 step 1 until max_antal_grupper do
4 15030 begin
5 15031 if gruppetabel(i) <> 0 then
5 15032 begin
6 15033 antal:= antal +1;
6 15034 identer(antal):= gruppetabel(i);
6 15035 end;
5 15036 end;
4 15037 start_operation(filop,curr_coruid,cs_fil,101);
4 15038 d.filop.data(1):= antal; <*postantal*>
4 15039 d.filop.data(2):= 1; <*postlængde*>
4 15040 d.filop.data(3):= if antal = 0 then 1 else
4 15041 (antal-1)//256 +1; <*segm.antal*>
4 15042 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 15043 d.filop.data(5):= d.filop.data(6):=
4 15044 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 15045 signalch(cs_opretfil,filop,vt_optype);
4 15046 end;
3 15047 waitch(cs_fil,filop,vt_optype,-1);
3 15048 disable
3 15049 begin
4 15050 if d.filop.data(9) <> 0 then
4 15051 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 15052 filref:= d.filop.data(4);
4 15053 for i:= 1 step 1 until antal do
4 15054 begin
5 15055 s:= skriv_fil(filref,i,zi);
5 15056 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 15057 fil(zi).iaf(1):= identer(i);
5 15058 end;
4 15059 d.op.resultat:= 3; <*ok*>
4 15060 d.op.data(1):= antal;
4 15061 d.op.data(2):= filref;
4 15062 end;
3 15063 \f
3 15063 message procedure vt_gruppe side 7 - 810505/cl;
3 15064
3 15064 returner:
3 15065 disable
3 15066 begin
4 15067 <*+2*>
4 15068 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 15069 <**> begin
5 15070 <**> skriv_vt_gruppe(out,0);
5 15071 <**> write(out,<: gruppetabel efter ændring:>);
5 15072 <**> p_gruppetabel(out);
5 15073 <**> end;
4 15074 <**> if testbit41 and overvåget then
4 15075 <**> begin
5 15076 <**> skriv_vt_gruppe(out,0);
5 15077 <**> write(out,<: returner operation:>);
5 15078 <**> skriv_op(out,op);
5 15079 <**> end;
4 15080 <*-2*>
4 15081 signalch(d.op.retur,op,d.op.optype);
4 15082 end;
3 15083 goto vent_op;
3 15084
3 15084 vt_grp_trap:
3 15085 disable skriv_vt_gruppe(zbillede,1);
3 15086
3 15086 end vt_gruppe;
2 15087 \f
2 15087 message procedure vt_spring side 1 - 810506/cl;
2 15088
2 15088 procedure vt_spring(cs_spring_retur,spr_opref);
2 15089 value cs_spring_retur,spr_opref;
2 15090 integer cs_spring_retur,spr_opref;
2 15091 begin
3 15092 integer array field komm_op,spr_op,iaf;
3 15093 real nu;
3 15094 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 15095
3 15095 procedure skriv_vt_spring(zud,omfang);
3 15096 value omfang;
3 15097 zone zud;
3 15098 integer omfang;
3 15099 begin
4 15100 write(zud,"nl",1,<:+++ vt_spring :>);
4 15101 if omfang <> 0 then
4 15102 begin
5 15103 skriv_coru(zud,abs curr_coruno);
5 15104 write(zud,"nl",1,<<d>,
5 15105 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 15106 <:spr-op :>,spr_op,"nl",1,
5 15107 <:komm-op :>,komm_op,"nl",1,
5 15108 <:funk :>,funk,"nl",1,
5 15109 <:interval :>,interval,"nl",1,
5 15110 <:nr :>,nr,"nl",1,
5 15111 <:i :>,i,"nl",1,
5 15112 <:s :>,s,"nl",1,
5 15113 <:id1 :>,id1,"nl",1,
5 15114 <:id2 :>,id2,"nl",1,
5 15115 <:res :>,res,"nl",1,
5 15116 <:res-inf :>,res_inf,"nl",1,
5 15117 <:medd-kode :>,medd_kode,"nl",1,
5 15118 <:zi :>,zi,"nl",1,
5 15119 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 15120 <::>);
5 15121 end;
4 15122 end;
3 15123 \f
3 15123 message procedure vt_spring side 2 - 810506/cl;
3 15124
3 15124 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 15125 value aktion,id1,id2;
3 15126 integer aktion,id1,id2,res,res_inf;
3 15127 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 15128 integer array field akt_op;
4 15129
4 15129 <* vent på adgang til vogntabel *>
4 15130 waitch(cs_vt_adgang,akt_op,true,-1);
4 15131
4 15131 <* start operation *>
4 15132 disable
4 15133 begin
5 15134 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 15135 d.akt_op.data(1):= id1;
5 15136 d.akt_op.data(2):= id2;
5 15137 signalch(cs_vt_opd,akt_op,vt_optype);
5 15138 end;
4 15139
4 15139 <* afvent svar *>
4 15140 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 15141 res:= d.akt_op.resultat;
4 15142 res_inf:= d.akt_op.data(3);
4 15143 <*+2*>
4 15144 <**> disable
4 15145 <**> if testbit45 and overvåget then
4 15146 <**> begin
5 15147 <**> real t;
5 15148 <**> skriv_vt_spring(out,0);
5 15149 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 15150 <**> skriv_id(out,springtabel(nr,1),0);
5 15151 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 15152 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 15153 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 15154 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 15155 <**> d.akt_op.resultat,"sp",2);
5 15156 <**> skriv_id(out,d.akt_op.data(1),8);
5 15157 <**> skriv_id(out,d.akt_op.data(2),8);
5 15158 <**> skriv_id(out,d.akt_op.data(3),8);
5 15159 <**> systime(4,springtid(nr),t);
5 15160 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 15161 <**> end;
4 15162 <*-2*>
4 15163
4 15163 <* åbn adgang til vogntabel *>
4 15164 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 15165 end vt_operation;
3 15166 \f
3 15166 message procedure vt_spring side 2a - 810506/cl;
3 15167
3 15167 procedure io_meddelelse(medd_no,bus,linie,springno);
3 15168 value medd_no,bus,linie,springno;
3 15169 integer medd_no,bus,linie,springno;
3 15170 begin
4 15171 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 15172 d.spr_op.data(1):= medd_no;
4 15173 d.spr_op.data(2):= bus;
4 15174 d.spr_op.data(3):= linie;
4 15175 d.spr_op.data(4):= springtabel(springno,1);
4 15176 d.spr_op.data(5):= springtabel(springno,2);
4 15177 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15178 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15179 end;
3 15180
3 15180 procedure returner_op(op,res);
3 15181 value res;
3 15182 integer array field op;
3 15183 integer res;
3 15184 begin
4 15185 <*+2*>
4 15186 <**> disable
4 15187 <**> if testbit41 and overvåget then
4 15188 <**> begin
5 15189 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15190 <**> skriv_op(out,op);
5 15191 <**> end;
4 15192 <*-2*>
4 15193 d.op.resultat:= res;
4 15194 signalch(d.op.retur,op,d.op.optype);
4 15195 end;
3 15196 \f
3 15196 message procedure vt_spring side 3 - 810603/cl;
3 15197
3 15197 iaf:= 0;
3 15198 spr_op:= spr_opref;
3 15199 stack_claim((if cm_test then 198 else 146) + 24);
3 15200
3 15200 trap(vt_spring_trap);
3 15201
3 15201 for i:= 1 step 1 until max_antal_spring do
3 15202 begin
4 15203 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15204 springtid(i):= springstart(i):= 0.0;
4 15205 end;
3 15206
3 15206 <*+2*>
3 15207 <**> disable
3 15208 <**> if testbit44 and overvåget then
3 15209 <**> begin
4 15210 <**> skriv_vt_spring(out,0);
4 15211 <**> write(out,<: springtabel efter initialisering:>);
4 15212 <**> p_springtabel(out); ud;
4 15213 <**> end;
3 15214 <*-2*>
3 15215
3 15215 <*+2*>
3 15216 <**> disable if testbit47 and overvåget or testbit28 then
3 15217 <**> skriv_vt_spring(out,0);
3 15218 <*-2*>
3 15219 \f
3 15219 message procedure vt_spring side 4 - 810609/cl;
3 15220
3 15220 næste_tid: <* find næste tid *>
3 15221 disable
3 15222 begin
4 15223 interval:= -1; <*vent uendeligt*>
4 15224 systime(1,0.0,nu);
4 15225 for i:= 1 step 1 until max_antal_spring do
4 15226 if springtabel(i,3) < 0 then
4 15227 interval:= 5
4 15228 else
4 15229 if springtid(i) <> 0.0 and
4 15230 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15231 interval:= (if springtid(i) <= nu then 0 else
4 15232 round(springtid(i) -nu));
4 15233 if interval=0 then interval:= 1;
4 15234 end;
3 15235 \f
3 15235 message procedure vt_spring side 4a - 810525/cl;
3 15236
3 15236 <* afvent operation eller timeout *>
3 15237 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15238 if komm_op <> 0 then goto afkod_operation;
3 15239
3 15239 <* timeout *>
3 15240 systime(1,0.0,nu);
3 15241 nr:= 1;
3 15242 næste_sekv:
3 15243 if nr > max_antal_spring then goto næste_tid;
3 15244 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15245 begin
4 15246 nr:= nr +1;
4 15247 goto næste_sekv;
4 15248 end;
3 15249 disable s:= modif_fil(tf_springdef,nr,zi);
3 15250 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15251 if springtabel(nr,3) < 0 then
3 15252 begin <* hængende spring *>
4 15253 if springtid(nr) <= nu then
4 15254 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15255 <* find frit løb *>
5 15256 disable
5 15257 begin
6 15258 id2:= 0;
6 15259 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15260 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15261 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15262 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15263 end;
5 15264 <* send meddelelse til io *>
5 15265 io_meddelelse(5,0,id2,nr);
5 15266
5 15266 <* annuler spring*>
5 15267 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15268 springtid(nr):= springstart(nr):= 0.0;
5 15269 end
4 15270 else
4 15271 begin <* forsøg igen *>
5 15272 \f
5 15272 message procedure vt_spring side 5 - 810525/cl;
5 15273
5 15273 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15274 if i = 2 <* første spring ej udført *> then
5 15275 begin
6 15276 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15277 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15278 id2:= id1;
6 15279 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15280 end
5 15281 else
5 15282 begin
6 15283 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15284 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15285 id2:= id1 shift (-7) shift 7
6 15286 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15287 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15288 end;
5 15289
5 15289 <* check resultat *>
5 15290 medd_kode:= if res = 3 and i = 2 then 7 else
5 15291 if res = 3 and i > 2 then 8 else
5 15292 <* if res = 9 then 1 else
5 15293 if res =12 then 2 else
5 15294 if res =14 then 4 else
5 15295 if res =18 then 3 else *>
5 15296 0;
5 15297 if medd_kode > 0 then
5 15298 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15299 id2 else id1,nr);
5 15300 if res = 3 then
5 15301 begin <* spring udført *>
6 15302 disable s:= modiffil(tf_springdef,nr,zi);
6 15303 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15304 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15305 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15306 if i > 2 then fil(zi).iaf(2+i-2):=
6 15307 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15308 end;
5 15309 end;
4 15310 end <* hængende spring *>
3 15311 else
3 15312 begin
4 15313 i:= spring_tabel(nr,3) shift (-12);
4 15314 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15315 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15316 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15317 + id1 shift (-7) shift 7;
4 15318 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15319 \f
4 15319 message procedure vt_spring side 6 - 820304/cl;
4 15320
4 15320 <* check resultat *>
4 15321 medd_kode:= if res = 3 then 8 else
4 15322 if res = 9 then 1 else
4 15323 if res =12 then 2 else
4 15324 if res =14 then 4 else
4 15325 if res =18 then 3 else
4 15326 if res =60 then 9 else 0;
4 15327 if medd_kode > 0 then
4 15328 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15329
4 15329 <* opdater springtabel *>
4 15330 disable s:= modiffil(tf_springdef,nr,zi);
4 15331 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15332 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15333 begin
5 15334 io_meddelelse(if res=3 then 6 else 5,0,
5 15335 if res=3 then id1 else id2,nr);
5 15336 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15337 springtid(nr):= springstart(nr):= 0.0;
5 15338 end
4 15339 else
4 15340 begin
5 15341 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15342 if res = 3 then
5 15343 begin
6 15344 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15345 (fil(zi).iaf(2+i-1) extract 22);
6 15346 fil(zi).iaf(2+i) := (1 shift 22) add
6 15347 (fil(zi).iaf(2+i) extract 22);
6 15348 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15349 end
5 15350 else
5 15351 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15352 end;
4 15353 end;
3 15354 <*+2*>
3 15355 <**> disable
3 15356 <**> if testbit44 and overvåget then
3 15357 <**> begin
4 15358 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15359 <**> p_springtabel(out); ud;
4 15360 <**> end;
3 15361 <*-2*>
3 15362
3 15362 nr:= nr +1;
3 15363 goto næste_sekv;
3 15364 \f
3 15364 message procedure vt_spring side 7 - 810506/cl;
3 15365
3 15365 afkod_operation:
3 15366 <*+2*>
3 15367 <**> disable
3 15368 <**> if testbit41 and overvåget then
3 15369 <**> begin
4 15370 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15371 <**> skriv_op(out,komm_op);
4 15372 <**> end;
3 15373 <*-2*>
3 15374
3 15374 disable
3 15375 begin integer opk;
4 15376
4 15376 opk:= d.komm_op.opkode extract 12;
4 15377 funk:= if opk = 30 <*sp,d*> then 5 else
4 15378 if opk = 31 <*sp. *> then 1 else
4 15379 if opk = 32 <*sp,v*> then 4 else
4 15380 if opk = 33 <*sp,o*> then 6 else
4 15381 if opk = 34 <*sp,r*> then 2 else
4 15382 if opk = 35 <*sp,a*> then 3 else
4 15383 0;
4 15384 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15385
4 15385 if funk <> 6 <*sp,o*> then
4 15386 begin <* find nr i springtabel *>
5 15387 nr:= 0;
5 15388 for i:= 1 step 1 until max_antal_spring do
5 15389 if springtabel(i,1) = d.komm_op.data(1) and
5 15390 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15391 end;
4 15392 end;
3 15393 if funk = 6 then goto oversigt;
3 15394 if funk = 5 then goto definer;
3 15395
3 15395 if nr = 0 then
3 15396 begin
4 15397 returner_op(komm_op,37<*spring ukendt*>);
4 15398 goto næste_tid;
4 15399 end;
3 15400
3 15400 goto case funk of(start,indsæt,annuler,vis);
3 15401 \f
3 15401 message procedure vt_spring side 8 - 810525/cl;
3 15402
3 15402 start:
3 15403 if springtabel(nr,3) shift (-12) <> 0 then
3 15404 begin returner_op(komm_op,38); goto næste_tid; end;
3 15405 disable
3 15406 begin <* find linie_løb_og_udtag *>
4 15407 s:= modif_fil(tf_springdef,nr,zi);
4 15408 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15409 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15410 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15411 id2:= 0;
4 15412 end;
3 15413 vt_operation(12,id1,id2,res,res_inf);
3 15414
3 15414 disable <* check resultat *>
3 15415 medd_kode:= if res = 3 <*ok*> then 7 else
3 15416 if res = 9 <*linie/løb ukendt*> then 1 else
3 15417 if res =14 <*optaget*> then 4 else
3 15418 if res =18 <*i kø*> then 3 else 0;
3 15419 returner_op(komm_op,3);
3 15420 if medd_kode = 0 then goto næste_tid;
3 15421
3 15421 <* send spring-meddelelse til io *>
3 15422 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15423
3 15423 <* opdater springtabel *>
3 15424 disable
3 15425 begin
4 15426 s:= modif_fil(tf_springdef,nr,zi);
4 15427 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15428 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15429 add (springtabel(nr,3) extract 12);
4 15430 systime(1,0.0,nu);
4 15431 springstart(nr):= nu;
4 15432 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15433 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15434 end;
3 15435 <*+2*>
3 15436 <**> disable
3 15437 <**> if testbit44 and overvåget then
3 15438 <**> begin
4 15439 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15440 <**> p_springtabel(out); ud;
4 15441 <**> end;
3 15442 <*-2*>
3 15443
3 15443 goto næste_tid;
3 15444 \f
3 15444 message procedure vt_spring side 9 - 810506/cl;
3 15445
3 15445 indsæt:
3 15446 if springtabel(nr,3) shift (-12) = 0 then
3 15447 begin <* ikke igangsat *>
4 15448 returner_op(komm_op,41);
4 15449 goto næste_tid;
4 15450 end;
3 15451 <* find frie linie/løb *>
3 15452 disable
3 15453 begin
4 15454 s:= læs_fil(tf_springdef,nr,zi);
4 15455 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15456 id2:= 0;
4 15457 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15458 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15459 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15460 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15461 id1:= d.komm_op.data(3);
4 15462 end;
3 15463
3 15463 if id2<>0 then
3 15464 vt_operation(11,id1,id2,res,res_inf)
3 15465 else
3 15466 res:= 42;
3 15467
3 15467 disable <* check resultat *>
3 15468 medd_kode:= if res = 3 <*ok*> then 8 else
3 15469 if res =10 <*bus ukendt*> then 0 else
3 15470 if res =11 <*bus allerede indsat*> then 0 else
3 15471 if res =12 <*linie/løb allerede besat*> then 2 else
3 15472 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15473 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15474 returner_op(komm_op,res);
3 15475 if medd_kode = 0 then goto næste_tid;
3 15476
3 15476 <* send springmeddelelse til io *>
3 15477 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15478 io_meddelelse(5,0,0,nr);
3 15479 \f
3 15479 message procedure vt_spring side 9a - 810525/cl;
3 15480
3 15480 <* annuler springtabel *>
3 15481 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15482 springtid(nr):= springstart(nr):= 0.0;
3 15483 <*+2*>
3 15484 <**> disable
3 15485 <**> if testbit44 and overvåget then
3 15486 <**> begin
4 15487 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15488 <**> p_springtabel(out); ud;
4 15489 <**> end;
3 15490 <*-2*>
3 15491
3 15491 goto næste_tid;
3 15492 \f
3 15492 message procedure vt_spring side 10 - 810525/cl;
3 15493
3 15493 annuler:
3 15494 disable
3 15495 begin <* find evt. frit linie/løb *>
4 15496 s:= læs_fil(tf_springdef,nr,zi);
4 15497 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15498 id1:= id2:= 0;
4 15499 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15500 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15501 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15502 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15503 returner_op(komm_op,3);
4 15504 end;
3 15505
3 15505 <* send springmeddelelse til io *>
3 15506 io_meddelelse(5,id1,id2,nr);
3 15507
3 15507 <* annuler springtabel *>
3 15508 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15509 springtid(nr):= springstart(nr):= 0.0;
3 15510 <*+2*>
3 15511 <**> disable
3 15512 <**> if testbit44 and overvåget then
3 15513 <**> begin
4 15514 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15515 <**> p_springtabel(out); ud;
4 15516 <**> end;
3 15517 <*-2*>
3 15518
3 15518 goto næste_tid;
3 15519
3 15519 definer:
3 15520 if nr <> 0 then <* allerede defineret *>
3 15521 begin
4 15522 res:= 36;
4 15523 goto slut_definer;
4 15524 end;
3 15525
3 15525 <* find frit nr *>
3 15526 i:= 0;
3 15527 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15528 if springtabel(i,1) = 0 then nr:= i;
3 15529 if nr = 0 then
3 15530 begin
4 15531 res:= 32; <* ingen fri plads *>
4 15532 goto slut_definer;
4 15533 end;
3 15534 \f
3 15534 message procedure vt_spring side 11 - 810525/cl;
3 15535
3 15535 disable
3 15536 begin integer array fdim(1:8),ia(1:32);
4 15537 <* læs sekvens *>
4 15538 fdim(4):= d.komm_op.data(3);
4 15539 s:= hent_fil_dim(fdim);
4 15540 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15541 if fdim(1) > 30 then
4 15542 res:= 35 <* springsekvens for stor *>
4 15543 else
4 15544 begin
5 15545 for i:= 1 step 1 until fdim(1) do
5 15546 begin
6 15547 s:= læs_fil(fdim(4),i,zi);
6 15548 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15549 ia(i):= fil(zi).iaf(1) shift 12;
6 15550 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15551 end;
5 15552 s:= modif_fil(tf_springdef,nr,zi);
5 15553 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15554 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15555 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15556 iaf:= 4;
5 15557 tofrom(fil(zi).iaf,ia,60);
5 15558 iaf:= 0;
5 15559 springtabel(nr,3):= fdim(1);
5 15560 springtid(nr):= springstart(nr):= 0.0;
5 15561 res:= 3;
5 15562 end;
4 15563 end;
3 15564 \f
3 15564 message procedure vt_spring side 11a - 81-525/cl;
3 15565
3 15565 slut_definer:
3 15566
3 15566 <* slet fil *>
3 15567 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15568 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15569 signalch(cs_slet_fil,spr_op,vt_optype);
3 15570 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15571 if d.spr_op.data(9) <> 0 then
3 15572 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15573 returner_op(komm_op,res);
3 15574 <*+2*>
3 15575 <**> disable
3 15576 <**> if testbit44 and overvåget then
3 15577 <**> begin
4 15578 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15579 <**> p_springtabel(out); ud;
4 15580 <**> end;
3 15581 <*-2*>
3 15582 goto næste_tid;
3 15583 \f
3 15583 message procedure vt_spring side 12 - 810525/cl;
3 15584
3 15584 vis:
3 15585 disable
3 15586 begin
4 15587 <* tilknyt fil *>
4 15588 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15589 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15590 d.spr_op.data(2):= 1;
4 15591 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15592 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15593 signalch(cs_opret_fil,spr_op,vt_optype);
4 15594 end;
3 15595
3 15595 <* afvent svar *>
3 15596 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15597 if d.spr_op.data(9) <> 0 then
3 15598 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15599 disable
3 15600 begin integer array ia(1:30);
4 15601 s:= læs_fil(tf_springdef,nr,zi);
4 15602 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15603 iaf:= 4;
4 15604 tofrom(ia,fil(zi).iaf,60);
4 15605 iaf:= 0;
4 15606 for i:= 1 step 1 until d.spr_op.data(1) do
4 15607 begin
5 15608 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15609 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15610 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15611 ia(i) shift (-12) extract 7
5 15612 else -(ia(i) shift (-12) extract 7);
5 15613 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15614 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15615 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15616 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15617 else ia(i) extract 12)
5 15618 else 0;
5 15619 end;
4 15620 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15621 sæt_fil_dim(d.spr_op.data);
4 15622 d.komm_op.data(3):= d.spr_op.data(1);
4 15623 d.komm_op.data(4):= d.spr_op.data(4);
4 15624 raf:= data+8;
4 15625 d.komm_op.raf(1):= springstart(nr);
4 15626 returner_op(komm_op,3);
4 15627 end;
3 15628 goto næste_tid;
3 15629 \f
3 15629 message procedure vt_spring side 13 - 810525/cl;
3 15630
3 15630 oversigt:
3 15631 disable
3 15632 begin
4 15633 <* opret fil *>
4 15634 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15635 d.spr_op.data(1):= max_antal_spring;
4 15636 d.spr_op.data(2):= 4;
4 15637 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15638 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15639 signalch(cs_opret_fil,spr_op,vt_optype);
4 15640 end;
3 15641
3 15641 <* afvent svar *>
3 15642 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15643 if d.spr_op.data(9) <> 0 then
3 15644 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15645 disable
3 15646 begin
4 15647 nr:= 0;
4 15648 for i:= 1 step 1 until max_antal_spring do
4 15649 begin
5 15650 if springtabel(i,1) <> 0 then
5 15651 begin
6 15652 nr:= nr +1;
6 15653 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15654 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15655 fil(zi).iaf(1):= springtabel(i,1);
6 15656 fil(zi).iaf(2):= springtabel(i,2);
6 15657 fil(zi,2):= springstart(i);
6 15658 end;
5 15659 end;
4 15660 d.spr_op.data(1):= nr;
4 15661 s:= sæt_fil_dim(d.spr_op.data);
4 15662 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15663 d.komm_op.data(1):= nr;
4 15664 d.komm_op.data(2):= d.spr_op.data(4);
4 15665 returner_op(komm_op,3);
4 15666 end;
3 15667 goto næste_tid;
3 15668
3 15668 vt_spring_trap:
3 15669 disable skriv_vt_spring(zbillede,1);
3 15670
3 15670 end vt_spring;
2 15671 \f
2 15671 message procedure vt_auto side 1 - 810505/cl;
2 15672
2 15672 procedure vt_auto(cs_auto_retur,auto_opref);
2 15673 value cs_auto_retur,auto_opref;
2 15674 integer cs_auto_retur,auto_opref;
2 15675 begin
3 15676 integer array field op,auto_op,iaf;
3 15677 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15678 res_inf,i,s,zi,kl,døgnstart;
3 15679 real t,nu,næste_tid;
3 15680 boolean optaget;
3 15681 integer array filnavn,nytnavn(1:4);
3 15682
3 15682 procedure skriv_vt_auto(zud,omfang);
3 15683 value omfang;
3 15684 zone zud;
3 15685 integer omfang;
3 15686 begin
4 15687 long array field laf;
4 15688
4 15688 laf:= 0;
4 15689 write(zud,"nl",1,<:+++ vt_auto :>);
4 15690 if omfang<>0 then
4 15691 begin
5 15692 skriv_coru(zud,abs curr_coruno);
5 15693 write(zud,"nl",1,<<d>,
5 15694 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15695 <:op :>,op,"nl",1,
5 15696 <:auto-op :>,auto_op,"nl",1,
5 15697 <:filref :>,filref,"nl",1,
5 15698 <:id1 :>,id1,"nl",1,
5 15699 <:id2 :>,id2,"nl",1,
5 15700 <:aktion :>,aktion,"nl",1,
5 15701 <:postnr :>,postnr,"nl",1,
5 15702 <:sidste-post :>,sidste_post,"nl",1,
5 15703 <:interval :>,interval,"nl",1,
5 15704 <:res :>,res,"nl",1,
5 15705 <:res-inf :>,res_inf,"nl",1,
5 15706 <:i :>,i,"nl",1,
5 15707 <:s :>,s,"nl",1,
5 15708 <:zi :>,zi,"nl",1,
5 15709 <:kl :>,kl,"nl",1,
5 15710 <:døgnstart :>,døgnstart,"nl",1,
5 15711 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15712 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15713 <:nu :>,nu,"nl",1,
5 15714 <:næste-tid :>,næste_tid,"nl",1,
5 15715 <:filnavn :>,filnavn.laf,"nl",1,
5 15716 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15717 <::>);
5 15718 end;
4 15719 end skriv_vt_auto;
3 15720 \f
3 15720 message procedure vt_auto side 2 - 810507/cl;
3 15721
3 15721 iaf:= 0;
3 15722 auto_op:= auto_opref;
3 15723 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15724 optaget:= false;
3 15725 næste_tid:= 0.0;
3 15726 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15727 stack_claim(if cm_test then 298 else 246);
3 15728 trap(vt_auto_trap);
3 15729
3 15729 <*+2*>
3 15730 <**> disable if testbit47 and overvåget or testbit28 then
3 15731 <**> skriv_vt_auto(out,0);
3 15732 <*-2*>
3 15733
3 15733 vent:
3 15734
3 15734 systime(1,0.0,nu);
3 15735 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15736 if næste_tid > nu then round(næste_tid-nu) else
3 15737 if optaget then 5 else 0;
3 15738 if interval=0 then interval:= 1;
3 15739
3 15739 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15740
3 15740 if op<>0 then goto filskift;
3 15741
3 15741 <* vent på adgang til vogntabel *>
3 15742 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15743
3 15743 <* afsend relevant operation til opdatering af vogntabel *>
3 15744 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15745 d.op.data(1):= id1;
3 15746 d.op.data(2):= id2;
3 15747 signalch(cs_vt_opd,op,vt_optype);
3 15748 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15749 res:= d.op.resultat;
3 15750 id2:= d.op.data(2);
3 15751 res_inf:= d.op.data(3);
3 15752
3 15752 <* åbn for vogntabel *>
3 15753 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15754 \f
3 15754 message procedure vt_auto side 3 - 810507/cl;
3 15755
3 15755 <* behandl svar fra opdatering *>
3 15756 <*+2*>
3 15757 <**> disable
3 15758 <**> if testbit45 and overvåget then
3 15759 <**> begin
4 15760 <**> integer li,lø,bo;
4 15761 <**> skriv_vt_auto(out,0);
4 15762 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15763 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15764 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15765 <**> for i:= 1,2 do
4 15766 <**> begin
5 15767 <**> li:= d.op.data(i);
5 15768 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15769 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15770 <**> li:= li shift (-12) extract 10;
5 15771 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15772 <**> end;
4 15773 <**> systime(4,næste_tid,t);
4 15774 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15775 <**> << zd.dd>,t/10000,"nl",1);
4 15776 <**> end;
3 15777 <*-2*>
3 15778 if res=31 then
3 15779 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15780 else
3 15781 if res<>3 then
3 15782 begin
4 15783 if -, optaget then
4 15784 begin
5 15785 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15786 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15787 if res=18 then 3 else if res=60 then 9 else 4;
5 15788 d.auto_op.data(2):= res_inf;
5 15789 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15790 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15791 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15792 end;
4 15793 if res=14 or res=18 then <* i kø eller optaget *>
4 15794 begin
5 15795 optaget:= true;
5 15796 goto vent;
5 15797 end;
4 15798 end;
3 15799 optaget:= false;
3 15800 \f
3 15800 message procedure vt_auto side 4 - 810507/cl;
3 15801
3 15801 <* find næste post *>
3 15802 disable
3 15803 begin
4 15804 if postnr=sidste_post then
4 15805 begin <* døgnskift *>
5 15806 postnr:= 1;
5 15807 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15808 end
4 15809 else postnr:= postnr+1;
4 15810 s:= læsfil(filref,postnr,zi);
4 15811 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 15812 aktion:= fil(zi).iaf(1);
4 15813 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 15814 id1:= fil(zi).iaf(3);
4 15815 id2:= fil(zi).iaf(4);
4 15816 end;
3 15817 goto vent;
3 15818 \f
3 15818 message procedure vt_auto side 5 - 810507/cl;
3 15819
3 15819 filskift:
3 15820
3 15820 <*+2*>
3 15821 <**> disable
3 15822 <**> if testbit41 and overvåget then
3 15823 <**> begin
4 15824 <**> skriv_vt_auto(out,0);
4 15825 <**> write(out,<: modtaget operation::>);
4 15826 <**> skriv_op(out,op);
4 15827 <**> end;
3 15828 <*-2*>
3 15829 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 15830 res:= 46;
3 15831 if d.op.opkode extract 12 <> 21 then
3 15832 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 15833 if filref = 0 then goto knyt;
3 15834
3 15834 <* gem filnavn til io-meddelelse *>
3 15835 disable begin
4 15836 integer array fdim(1:8);
4 15837 integer array field navn;
4 15838 fdim(4):= filref;
4 15839 hentfildim(fdim);
4 15840 navn:= 8;
4 15841 tofrom(filnavn,fdim.navn,8);
4 15842 end;
3 15843
3 15843 <* frivgiv tilknyttet autofil *>
3 15844 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 15845 d.auto_op.data(4):= filref;
3 15846 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 15847 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 15848 if d.auto_op.data(9) <> 0 then
3 15849 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 15850 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 15851 optaget:= false;
3 15852 næste_tid:= 0.0;
3 15853 res:= 3;
3 15854 \f
3 15854 message procedure vt_auto side 6 - 810507/cl;
3 15855
3 15855 <* tilknyt evt. ny autofil *>
3 15856 knyt:
3 15857 if d.op.data(1)<>0 then
3 15858 begin
4 15859 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 15860 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 15861 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 15862 disable
4 15863 begin integer pos1,pos2;
5 15864 pos1:= pos2:= 13;
5 15865 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 15866 begin
6 15867 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 15868 skrivtegn(d.auto_op.data,pos2,i);
6 15869 end;
5 15870 end;
4 15871 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 15872 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 15873 s:= d.auto_op.data(9);
4 15874 if s=0 then res:= 3 <* ok *> else
4 15875 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 15876 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 15877 if s=6 then res:= 48 <* i brug *> else
4 15878 fejlreaktion(14,2,<:auto,filskift:>,0);
4 15879 if res<>3 then goto returner;
4 15880
4 15880 tofrom(nytnavn,d.op.data,8);
4 15881
4 15881 <* find første post *>
4 15882 disable
4 15883 begin
5 15884 døgnstart:= systime(5,0.0,t);
5 15885 kl:= round t;
5 15886 filref:= d.auto_op.data(4);
5 15887 sidste_post:= d.auto_op.data(1);
5 15888 postnr:= 0;
5 15889 for postnr:= postnr+1 while postnr <= sidste_post do
5 15890 begin
6 15891 s:= læsfil(filref,postnr,zi);
6 15892 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 15893 if fil(zi).iaf(2) > kl then goto post_fundet;
6 15894 end;
5 15895 postnr:= 1;
5 15896 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15897 \f
5 15897 message procedure vt_auto side 7 - 810507/cl;
5 15898
5 15898 post_fundet:
5 15899 s:= læsfil(filref,postnr,zi);
5 15900 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 15901 aktion:= fil(zi).iaf(1);
5 15902 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 15903 id1:= fil(zi).iaf(3);
5 15904 id2:= fil(zi).iaf(4);
5 15905 res:= 3;
5 15906 end;
4 15907 end ny fil;
3 15908
3 15908 returner:
3 15909 d.op.resultat:= res;
3 15910 <*+2*>
3 15911 <**> disable
3 15912 <**> if testbit41 and overvåget then
3 15913 <**> begin
4 15914 <**> skriv_vt_auto(out,0);
4 15915 <**> write(out,<: returner operation::>);
4 15916 <**> skriv_op(out,op);
4 15917 <**> end;
3 15918 <*-2*>
3 15919 signalch(d.op.retur,op,d.op.optype);
3 15920
3 15920 if vt_log_aktiv then
3 15921 begin
4 15922 waitch(cs_vt_logpool,op,vt_optype,-1);
4 15923 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 15924 if nytnavn(1)=0 then
4 15925 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 15926 else
4 15927 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 15928 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 15929 systime(1,0.0,d.op.data.v_tid);
4 15930 signalch(cs_vt_log,op,vt_optype);
4 15931 end;
3 15932
3 15932 if filnavn(1)<>0 then
3 15933 begin <* meddelelse til io om annulering *>
4 15934 disable begin
5 15935 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 15936 i:= 1;
5 15937 hægtstring(d.auto_op.data,i,<:auto :>);
5 15938 skriv_text(d.auto_op.data,i,filnavn);
5 15939 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 15940 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 15941 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15942 end;
4 15943 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 15944 end;
3 15945 goto vent;
3 15946
3 15946 vt_auto_trap:
3 15947 disable skriv_vt_auto(zbillede,1);
3 15948
3 15948 end vt_auto;
2 15949 message procedure vt_log side 1 - 920517/cl;
2 15950
2 15950 procedure vt_log;
2 15951 begin
3 15952 integer i,j,ventetid;
3 15953 real dg,t,nu,skiftetid;
3 15954 boolean fil_åben;
3 15955 integer array ia(1:10),dp,dp1(1:8);
3 15956 integer array field op, iaf;
3 15957
3 15957 procedure skriv_vt_log(zud,omfang);
3 15958 value omfang;
3 15959 zone zud;
3 15960 integer omfang;
3 15961 begin
4 15962 write(zud,"nl",1,<:+++ vt-log :>);
4 15963 if omfang<>0 then
4 15964 begin
5 15965 skriv_coru(zud, abs curr_coruno);
5 15966 write(zud,"nl",1,<<d>,
5 15967 <:i :>,i,"nl",1,
5 15968 <:j :>,j,"nl",1,
5 15969 <:ventetid :>,ventetid,"nl",1,
5 15970 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 15971 <:t :>,t,"nl",1,
5 15972 <:nu :>,nu,"nl",1,
5 15973 <:skiftetid :>,skiftetid,"nl",1,
5 15974 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 15975 <:op :>,<<d>,op,"nl",1,
5 15976 <::>);
5 15977 raf:= 0;
5 15978 write(zud,"nl",1,<:ia::>);
5 15979 skrivhele(zud,ia.raf,20,2);
5 15980 write(zud,"nl",2,<:dp::>);
5 15981 skrivhele(zud,dp.raf,16,2);
5 15982 write(zud,"nl",2,<:dp1::>);
5 15983 skrivhele(zud,dp1.raf,16,2);
5 15984 end;
4 15985 end;
3 15986
3 15986 message procedure vt_log side 2 - 920517/cl;
3 15987
3 15987 procedure slet_fil;
3 15988 begin
4 15989 integer segm,res;
4 15990 integer array tail(1:10);
4 15991
4 15991 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 15992 if res=0 then
4 15993 begin
5 15994 segm:= tail(10);
5 15995 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 15996 if res=0 then
5 15997 begin
6 15998 close(zvtlog,true);
6 15999 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 16000 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16001 if res=0 then
6 16002 begin
7 16003 tail(1):= tail(1)+segm;
7 16004 monitor(44)change_entry:(zvtlog,0,tail);
7 16005 end;
6 16006 end;
5 16007 end;
4 16008 end;
3 16009
3 16009 boolean procedure udvid_fil;
3 16010 begin
4 16011 integer res,spos;
4 16012 integer array tail(1:10);
4 16013 zone z(1,1,stderror);
4 16014
4 16014 udvid_fil:= false;
4 16015 open(z,0,<:vtlogpool:>,0); close(z,true);
4 16016 res:= monitor(42)lookup_entry:(z,0,tail);
4 16017 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 16018 begin
5 16019 tail(1):=tail(1) - vt_log_slicelgd;
5 16020 res:=monitor(44)change_entry:(z,0,tail);
5 16021 if res=0 then
5 16022 begin
6 16023 spos:= vt_logtail(1);
6 16024 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 16025 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 16026 if res<>0 then
6 16027 begin
7 16028 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 16029 tail(1):= tail(1) + vt_log_slicelgd;
7 16030 monitor(44)change_entry:(z,0,tail);
7 16031 end
6 16032 else
6 16033 begin
7 16034 setposition(zvtlog,0,spos);
7 16035 udvid_fil:= true;
7 16036 end;
6 16037 end;
5 16038 end;
4 16039 end;
3 16040
3 16040 message procedure vt_log side 3 - 920517/cl;
3 16041
3 16041 boolean procedure ny_fil;
3 16042 begin
4 16043 integer res,i,j;
4 16044 integer array nyt(1:4), ia,tail(1:10);
4 16045 long array field navn;
4 16046 real t;
4 16047
4 16047 navn:=0;
4 16048 if fil_åben then
4 16049 begin
5 16050 close(zvtlog,true);
5 16051 fil_åben:= false;
5 16052 nyt.navn(1):= long<:vtlo:>;
5 16053 nyt.navn(2):= long<::>;
5 16054 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 16055 j:= 'a' - 1;
5 16056 repeat
5 16057 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 16058 if res=3 then
5 16059 begin
6 16060 j:= j+1;
6 16061 if j <= 'å' then skrivtegn(nyt,11,j);
6 16062 end;
5 16063 until (res<>3) or (j > 'å');
5 16064
5 16064 if res=0 then
5 16065 begin
6 16066 open(zvtlog,4,<:vtlogklar:>,0);
6 16067 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16068 if res=0 then
6 16069 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 16070 if res=0 then
6 16071 begin
7 16072 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 16073 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 16074 end;
6 16075
6 16075 if res=0 then
6 16076 begin
7 16077 setposition(zvtlog,0,tail(10)//64);
7 16078 navn:= (tail(10) mod 64)*8;
7 16079 if (tail(1) <= tail(10)//64) then
7 16080 outrec6(zvtlog,512)
7 16081 else
7 16082 swoprec6(zvtlog,512);
7 16083 tofrom(zvtlog.navn,nyt,8);
7 16084 tail(10):= tail(10)+1;
7 16085 setposition(zvtlog,0,tail(10)//64);
7 16086 monitor(44)change_entry:(zvtlog,0,tail);
7 16087 close(zvtlog,true);
7 16088 end
6 16089 else
6 16090 begin
7 16091 navn:= 0;
7 16092 close(zvtlog,true);
7 16093 open(zvtlog,4,<:vtlog:>,0);
7 16094 slet_fil;
7 16095 end;
6 16096 end
5 16097 else
5 16098 slet_fil;
5 16099 end;
4 16100
4 16100 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 16101 <* eller den er blevet slettet. *>
4 16102
4 16102 open(zvtlog,4,<:vtlog:>,0);
4 16103 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 16104 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 16105 vt_logtail(6):= systime(7,0,t);
4 16106
4 16106 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 16107 if res=0 then
4 16108 begin
5 16109 monitor(50)permanent_entry:(zvtlog,3,ia);
5 16110 if res<>0 then
5 16111 monitor(48)remove_entry:(zvtlog,0,ia);
5 16112 end;
4 16113
4 16113 if res=0 then fil_åben:= true;
4 16114
4 16114 ny_fil:= fil_åben;
4 16115 end ny_fil;
3 16116
3 16116 message procedure vt_log side 4 - 920517/cl;
3 16117
3 16117 procedure skriv_post(logpost);
3 16118 integer array logpost;
3 16119 begin
4 16120 integer array field post;
4 16121 real t;
4 16122
4 16122 if vt_logtail(10)//32 < vt_logtail(1) then
4 16123 begin
5 16124 outrec6(zvtlog,512);
5 16125 post:= (vt_logtail(10) mod 32)*16;
5 16126 tofrom(zvtlog.post,logpost,16);
5 16127 vt_logtail(10):= vt_logtail(10)+1;
5 16128 setposition(zvtlog,0,vt_logtail(10)//32);
5 16129 vt_logtail(6):= systime(7,0,t);
5 16130 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 16131 end;
4 16132 end;
3 16133
3 16133 procedure sletsendte;
3 16134 begin
4 16135 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 16136 integer array pooltail,tail,ia(1:10);
4 16137 integer i,res;
4 16138
4 16138 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 16139 res:=monitor(42,zpool,0,pooltail);
4 16140
4 16140 open(z,4,<:vtlogslet:>,0);
4 16141 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 16142 begin
5 16143 if monitor(52,z,0,tail)=0 then
5 16144 begin
6 16145 if monitor(8,z,0,tail)=0 then
6 16146 begin
7 16147 for i:=1 step 1 until tail(10) do
7 16148 begin
8 16149 inrec6(z,8);
8 16150 open(zlog,0,z,0); close(zlog,true);
8 16151 if monitor(42,zlog,0,ia)=0 then
8 16152 begin
9 16153 if monitor(48,zlog,0,ia)=0 then
9 16154 begin
10 16155 pooltail(1):=pooltail(1)+ia(1);
10 16156 end;
9 16157 end;
8 16158 end;
7 16159 tail(10):=0;
7 16160 monitor(44,z,0,tail);
7 16161 end
6 16162 else
6 16163 monitor(64,z,0,tail);
6 16164 end;
5 16165 if res=0 then monitor(44,zpool,0,pooltail);
5 16166 end;
4 16167 close(z,true);
4 16168 end;
3 16169
3 16169 message procedure vt_log side 5 - 920517/cl;
3 16170
3 16170 trap(vt_log_trap);
3 16171 stack_claim(200);
3 16172
3 16172 fil_åben:= false;
3 16173 if -, vt_log_aktiv then goto init_slut;
3 16174 open(zvtlog,4,<:vtlog:>,0);
3 16175 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16176 if i=0 then
3 16177 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16178 if i=0 then
3 16179 begin
4 16180 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16181 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16182 end;
3 16183
3 16183 if (i=0) and (vt_logtail(1)=0) then
3 16184 begin
4 16185 close(zvtlog,true);
4 16186 monitor(48)remove_entry:(zvtlog,0,ia);
4 16187 i:= 1;
4 16188 end;
3 16189
3 16189 disable
3 16190 if i=0 then
3 16191 begin
4 16192 fil_åben:= true;
4 16193 inrec6(zvtlog,512);
4 16194 vt_logstart:= zvtlog.v_tid;
4 16195 systime(1,0.0,nu);
4 16196 if (nu - vt_logstart) < 24*60*60.0 then
4 16197 begin
5 16198 setposition(zvtlog,0,vt_logtail(10)//32);
5 16199 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16200 begin
6 16201 inrec6(zvtlog,512);
6 16202 setposition(zvtlog,0,vt_logtail(10)//32);
6 16203 end;
5 16204 end
4 16205 else
4 16206 begin
5 16207 if ny_fil then
5 16208 begin
6 16209 if udvid_fil then
6 16210 begin
7 16211 systime(1,0.0,dp.v_tid);
7 16212 vt_logstart:= dp.v_tid;
7 16213 dp.v_kode:=0;
7 16214 skriv_post(dp);
7 16215 end
6 16216 else
6 16217 begin
7 16218 close(zvtlog,true);
7 16219 monitor(48)remove_entry:(zvtlog,0,ia);
7 16220 fil_åben:= false;
7 16221 end;
6 16222 end;
5 16223 end;
4 16224 end
3 16225 else
3 16226 begin
4 16227 close(zvtlog,true);
4 16228 if ny_fil then
4 16229 begin
5 16230 if udvid_fil then
5 16231 begin
6 16232 systime(1,0.0,dp.v_tid);
6 16233 vt_logstart:= dp.v_tid;
6 16234 dp.v_kode:=0;
6 16235 skriv_post(dp);
6 16236 end
5 16237 else
5 16238 begin
6 16239 close(zvtlog,true);
6 16240 monitor(48)remove_entry:(zvtlog,0,ia);
6 16241 fil_åben:= false;
6 16242 end;
5 16243 end;
4 16244 end;
3 16245
3 16245 init_slut:
3 16246
3 16246 dg:= systime(5,0,t);
3 16247 if t < vt_logskift then
3 16248 skiftetid:= systid(dg,vt_logskift)
3 16249 else
3 16250 skiftetid:= systid(dg+1,vt_logskift);
3 16251
3 16251 message procedure vt_log side 6 - 920517/cl;
3 16252
3 16252 vent:
3 16253
3 16253 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16254 ventetid:= round(skiftetid - nu);
3 16255 if ventetid < 1 then ventetid:= 1;
3 16256
3 16256 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16257
3 16257 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16258 if op <> 0 then
3 16259 begin
4 16260 tofrom(dp,d.op.data,16);
4 16261 signalch(cs_vt_logpool,op,vt_optype);
4 16262 end;
3 16263
3 16263 if -, vt_log_aktiv then goto vent;
3 16264
3 16264 disable if (op=0) or (nu > skiftetid) then
3 16265 begin
4 16266 if fil_åben then
4 16267 begin
5 16268 dp1.v_tid:= systid(dg,vt_logskift);
5 16269 dp1.v_kode:= 1;
5 16270 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16271 begin
6 16272 if udvid_fil then
6 16273 skriv_post(dp1);
6 16274 end
5 16275 else
5 16276 skriv_post(dp1);
5 16277 end;
4 16278
4 16278 if (op=0) or (nu > skiftetid) then
4 16279 skiftetid:= skiftetid + 24*60*60.0;
4 16280
4 16280 sletsendte;
4 16281
4 16281 if ny_fil then
4 16282 begin
5 16283 if udvid_fil then
5 16284 begin
6 16285 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16286 dp1.v_kode:= 0;
6 16287 skriv_post(dp1);
6 16288 end
5 16289 else
5 16290 begin
6 16291 close(zvtlog,true);
6 16292 monitor(48)remove_entry:(zvtlog,0,ia);
6 16293 fil_åben:= false;
6 16294 end;
5 16295 end;
4 16296 end;
3 16297
3 16297 disable if op<>0 and fil_åben then
3 16298 begin
4 16299 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16300 begin
5 16301 if -, udvid_fil then
5 16302 begin
6 16303 if ny_fil then
6 16304 begin
7 16305 if udvid_fil then
7 16306 begin
8 16307 systime(1,0.0,dp1.v_tid);
8 16308 vt_logstart:= dp1.v_tid;
8 16309 dp1.v_kode:= 0;
8 16310 skriv_post(dp1);
8 16311 end
7 16312 else
7 16313 begin
8 16314 close(zvtlog,true);
8 16315 monitor(48)remove_entry:(zvtlog,0,ia);
8 16316 fil_åben:= false;
8 16317 end;
7 16318 end;
6 16319 end;
5 16320 end;
4 16321
4 16321 if fil_åben then skriv_post(dp);
4 16322 end;
3 16323
3 16323 goto vent;
3 16324
3 16324 vt_log_trap:
3 16325 disable skriv_vt_log(zbillede,1);
3 16326 end vt_log;
2 16327 \f
2 16327
2 16327 algol list.off;
2 16328 message coroutinemonitor - 11 ;
2 16329
2 16329
2 16329 <*************** coroutine monitor procedures ***************>
2 16330
2 16330
2 16330 <***** delay *****
2 16331
2 16331 this procedure links the calling coroutine into the timerqueue and sets
2 16332 the timeout value to 'timeout'. *>
2 16333
2 16333
2 16333 procedure delay (timeout);
2 16334 value timeout;
2 16335 integer timeout;
2 16336 begin
3 16337 link(current, idlequeue);
3 16338 link(current + corutimerchain, timerqueue);
3 16339 d.current.corutimer:= timeout;
3 16340
3 16340
3 16340 passivate;
3 16341 d.current.corutimer:= 0;
3 16342 end;
2 16343 \f
2 16343
2 16343 message coroutinemonitor - 12 ;
2 16344
2 16344
2 16344 <***** pass *****
2 16345
2 16345 this procedure moves the calling coroutine from the head of the ready
2 16346 queue down below all coroutines of lower or equal priority. *>
2 16347
2 16347
2 16347 procedure pass;
2 16348 begin
3 16349 linkprio(current, readyqueue);
3 16350
3 16350
3 16350 passivate;
3 16351 end;
2 16352
2 16352
2 16352 <***** signal ****
2 16353
2 16353 this procedure increases the value af 'semaphore' by 1.
2 16354 in case some coroutine is already waiting, it is linked into the ready
2 16355 queue for activation. the calling coroutine continues execution. *>
2 16356
2 16356
2 16356 procedure signal (semaphore);
2 16357 value semaphore;
2 16358 integer semaphore;
2 16359 begin
3 16360 integer array field sem;
3 16361 sem:= semaphore;
3 16362 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16363 d.sem.simvalue:= d.sem.simvalue + 1;
3 16364
3 16364
3 16364 end;
2 16365 \f
2 16365
2 16365 message coroutinemonitor - 13 ;
2 16366
2 16366
2 16366 <***** wait *****
2 16367
2 16367 this procedure decreases the value of 'semaphore' by 1.
2 16368 in case the value of the semaphore is negative after the decrease, the
2 16369 calling coroutine is linked into the semaphore queue waiting for a
2 16370 coroutine to signal this semaphore. *>
2 16371
2 16371
2 16371 procedure wait (semaphore);
2 16372 value semaphore;
2 16373 integer semaphore;
2 16374 begin
3 16375 integer array field sem;
3 16376 sem:= semaphore;
3 16377 d.sem.simvalue:= d.sem.simvalue - 1;
3 16378
3 16378
3 16378 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16379 passivate;
3 16380 end;
2 16381 \f
2 16381
2 16381 message coroutinemonitor - 14 ;
2 16382
2 16382
2 16382 <***** inspect *****
2 16383
2 16383 this procedure inspects the value of the semaphore and returns it in
2 16384 'elements'.
2 16385 the semaphore is left unchanged. *>
2 16386
2 16386
2 16386 procedure inspect (semaphore, elements);
2 16387 value semaphore;
2 16388 integer semaphore, elements;
2 16389 begin
3 16390 integer array field sem;
3 16391 sem:= semaphore;
3 16392 elements:= d.sem.simvalue;
3 16393
3 16393
3 16393 end;
2 16394 \f
2 16394
2 16394 message coroutinemonitor - 15 ;
2 16395
2 16395
2 16395 <***** signalch *****
2 16396
2 16396 this procedure delivers an operation at 'semaphore'.
2 16397 in case another coroutine is already waiting for an operation of the
2 16398 kind 'operationtype' this coroutine will get the operation and it will
2 16399 be put into the ready queue for activation.
2 16400 in case no coroutine is waiting for the actial kind of operation it is
2 16401 linked into the semaphore queue, at the end of the queue
2 16402 if operation is positive and at the beginning if operation is negative.
2 16403 the calling coroutine continues execution. *>
2 16404
2 16404
2 16404 procedure signalch (semaphore, operation, operationtype);
2 16405 value semaphore, operation, operationtype;
2 16406 integer semaphore, operation;
2 16407 boolean operationtype;
2 16408 begin
3 16409 integer array field firstcoru, currcoru, op,currop;
3 16410 op:= abs operation;
3 16411 d.op.optype:= operationtype;
3 16412 firstcoru:= semaphore + semcoru;
3 16413 currcoru:= d.firstcoru.next;
3 16414 while currcoru <> firstcoru do
3 16415 begin
4 16416 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16417 begin
5 16418 link(operation, 0);
5 16419 d.currcoru.coruop:= operation;
5 16420 linkprio(currcoru, readyqueue);
5 16421 link(currcoru + corutimerchain, idlequeue);
5 16422 goto exit;
5 16423 end else currcoru:= d.currcoru.next;
4 16424 end;
3 16425 currop:=semaphore + semop;
3 16426 if operation < 0 then currop:=d.currop.next;
3 16427 link(op, currop);
3 16428 exit:
3 16429
3 16429
3 16429 end;
2 16430 \f
2 16430
2 16430 message coroutinemonitor - 16 ;
2 16431
2 16431
2 16431 <***** waitch *****
2 16432
2 16432 this procedure fetches an operation from a semaphore.
2 16433 in case an operation matching 'operationtypeset' is already waiting at
2 16434 'semaphore' it is handed over to the calling coroutine.
2 16435 in case no matching operation is waiting, the calling coroutine is
2 16436 linked to the semaphore.
2 16437 in any case the calling coroutine will be stopped and all corouti-
2 16438 nes are rescheduled. *>
2 16439
2 16439
2 16439 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16440 value semaphore, operationtypeset, timeout;
2 16441 integer semaphore, operation, timeout;
2 16442 boolean operationtypeset;
2 16443 begin
3 16444 integer array field firstop, currop;
3 16445 firstop:= semaphore + semop;
3 16446 currop:= d.firstop.next;
3 16447
3 16447
3 16447 while currop <> firstop do
3 16448 begin
4 16449 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16450 begin
5 16451 link(currop, 0);
5 16452 d.current.coruop:= currop;
5 16453 operation:= currop;
5 16454 \f
5 16454
5 16454 message coroutinemonitor - 17 ;
5 16455
5 16455 linkprio(current, readyqueue);
5 16456 passivate;
5 16457 goto exit;
5 16458 end else currop:= d.currop.next;
4 16459 end;
3 16460 linkprio(current, semaphore + semcoru);
3 16461 if timeout > 0 then
3 16462 begin
4 16463 link(current + corutimerchain, timerqueue);
4 16464 d.current.corutimer:= timeout;
4 16465 end else d.current.corutimer:= 0;
3 16466 d.current.corutypeset:= operationtypeset;
3 16467 passivate;
3 16468 if d.current.corutimer < 0 then operation:= 0
3 16469 else operation:= d.current.coruop;
3 16470 d.current.corutimer:= 0;
3 16471 currop:= operation;
3 16472 d.current.coruop:= currop;
3 16473 link(current+corutimerchain, idlequeue);
3 16474 exit:
3 16475
3 16475
3 16475 end;
2 16476 \f
2 16476
2 16476 message coroutinemonitor - 18 ;
2 16477
2 16477
2 16477 <***** inspectch *****
2 16478
2 16478 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16479 the number of matching operations are counted and delivered in 'elements'.
2 16480 if no operations are found the number of coroutines waiting
2 16481 for operations of the typeset are counted and delivered as
2 16482 negative value in 'elements'.
2 16483 the semaphore is left unchanged. *>
2 16484
2 16484
2 16484 procedure inspectch (semaphore, operationtypeset, elements);
2 16485 value semaphore, operationtypeset;
2 16486 integer semaphore, elements;
2 16487 boolean operationtypeset;
2 16488 begin
3 16489 integer array field firstop, currop,firstcoru,currcoru;
3 16490 integer counter;
3 16491 counter:= 0;
3 16492 firstop:= semaphore + semop;
3 16493 currop:= d.firstop.next;
3 16494 while currop <> firstop do
3 16495 begin
4 16496 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16497 counter:= counter + 1;
4 16498 currop:= d.currop.next;
4 16499 end;
3 16500 if counter=0 then
3 16501 begin
4 16502 firstcoru:=semaphore + sem_coru;
4 16503 curr_coru:=d.firstcoru.next;
4 16504 while curr_coru<>first_coru do
4 16505 begin
5 16506 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16507 counter:=counter - 1;
5 16508 curr_coru:=d.curr_coru.next;
5 16509 end;
4 16510 end;
3 16511 elements:= counter;
3 16512
3 16512
3 16512 end;
2 16513 \f
2 16513
2 16513 message coroutinemonitor - 19 ;
2 16514
2 16514
2 16514 <***** csendmessage *****
2 16515
2 16515 this procedure sends the message in 'mess' to the process defined by the name
2 16516 in 'receiver', and returns an identification of the message extension used
2 16517 for sending the message (this identification is to be used for calling 'cwait-
2 16518 answer' or 'cregretmessage'. *>
2 16519
2 16519
2 16519 procedure csendmessage (receiver, mess, messextension);
2 16520 real array receiver;
2 16521 integer array mess;
2 16522 integer messextension;
2 16523 begin
3 16524 integer bufref, messext;
3 16525 messref(maxmessext):= 0;
3 16526 messext:= 1;
3 16527 while messref(messext) <> 0 do messext:= messext + 1;
3 16528 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16529 begin
4 16530 messcode(messext):= 1 shift 12 add 2;
4 16531 mon(16) send message :(0, mess, 0, receiver);
4 16532 messref(messext):= monw2;
4 16533 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16534 end;
3 16535
3 16535
3 16535 end;
2 16536 \f
2 16536
2 16536 message coroutinemonitor - 20 ;
2 16537
2 16537
2 16537 <***** cwaitanswer *****
2 16538
2 16538 this procedure asks the coroutine monitor to get an answer to the message
2 16539 corresponding to 'messextension'. in case the answer has already arrived
2 16540 it stays in the eventqueue until 'cwaitanswer' is called.
2 16541 in case 'timeout' is positive, the coroutine is linked into the timer
2 16542 queue, and in case the answer does not arrive within 'timout' seconds the
2 16543 coroutine is restarted with result = 0. *>
2 16544
2 16544
2 16544 procedure cwaitanswer (messextension, answer, result, timeout);
2 16545 value messextension, timeout;
2 16546 integer messextension, result, timeout;
2 16547 integer array answer;
2 16548 begin
3 16549 integer messext;
3 16550 messext:= messextension;
3 16551 messcode(messext):= messcode(messext) extract 12;
3 16552 link(current, idlequeue);
3 16553 messop(messext):= current;
3 16554 if timeout > 0 then
3 16555 begin
4 16556 link(current + corutimerchain, timerqueue);
4 16557 d.current.corutimer:= timeout;
4 16558 end else d.current.corutimer:= 0;
3 16559
3 16559
3 16559 passivate;
3 16560 if d.current.corutimer < 0 then result:= 0 else
3 16561 begin
4 16562 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16563 result:= monw0;
4 16564 baseevent:= 0;
4 16565 messref(messextension):= 0;
4 16566 end;
3 16567 d.current.corutimer:= 0;
3 16568 link(current+corutimerchain, idlequeue);
3 16569 end;
2 16570 \f
2 16570
2 16570 message coroutinemonitor - 21 ;
2 16571
2 16571
2 16571 <***** cwaitmessage *****
2 16572
2 16572 this procedure asks the coroutine monitor to give it a message, when some-
2 16573 one arrives. in case a message has arrived already it stays at the event queue
2 16574 until 'cwaitmessage' is called.
2 16575 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16576 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16577 with messbufferref = 0. *>
2 16578
2 16578
2 16578 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16579 value timeout, processextension;
2 16580 integer processextension, messbufferref, timeout;
2 16581 integer array mess;
2 16582 begin
3 16583 integer i;
3 16584 integer array field messbuf;
3 16585 proccode(processextension):= 2;
3 16586 procop(processextension):= current;
3 16587 link(current, idlequeue);
3 16588 if timeout > 0 then
3 16589 begin
4 16590 link(current + corutimerchain, timerqueue);
4 16591 d.current.corutimer:= timeout;
4 16592 end else d.current.corutimer:= 0;
3 16593
3 16593
3 16593 passivate;
3 16594 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16595 begin
4 16596 messbuf:= procop(processextension);
4 16597 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16598 proccode(procext):= 1 shift 12;
4 16599 messbufferref:= messbuf;
4 16600 baseevent:= 0;
4 16601 end;
3 16602 d.current.corutimer:= 0;
3 16603 link(current+corutimerchain, idlequeue);
3 16604 end;
2 16605 \f
2 16605
2 16605 message coroutinemonitor - 22 ;
2 16606
2 16606
2 16606 <***** cregretmessage *****
2 16607
2 16607 this procedure regrets the message corresponding to messageexten-
2 16608 sion, to release message buffer and message extension.
2 16609 i/o messages are not regretable. *>
2 16610
2 16610
2 16610
2 16610 procedure cregretmessage (messageextension);
2 16611 value messageextension;
2 16612 integer messageextension;
2 16613 begin
3 16614 integer array field messbuf;
3 16615 messbuf:= messref(messageextension);
3 16616 mon(82) regret message :(0, 0, messbuf, 0);
3 16617 messref(messageextension):= 0;
3 16618
3 16618
3 16618 end;
2 16619 \f
2 16619
2 16619 message coroutinemonitor - 23 ;
2 16620
2 16620
2 16620 <***** semsendmessage *****
2 16621
2 16621 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16622 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16623 by the monitor, when the answer arrives.
2 16624 in case there are too few resources to send the message, the operation is
2 16625 returned immediately with the result field set to zero. *>
2 16626
2 16626
2 16626 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16627 value semaphore, operation, operationtype;
2 16628 real array receiver;
2 16629 integer array mess;
2 16630 integer semaphore, operation;
2 16631 boolean operationtype;
2 16632 begin
3 16633 integer array field op;
3 16634 integer messext;
3 16635 op:= operation;
3 16636 messref(maxmessext):= 0;
3 16637 messext:= 1;
3 16638 while messref(messext) <> 0 do messext:= messext + 1;
3 16639 if messext < maxmessext then
3 16640 begin
4 16641 messop(messext):= op;
4 16642 messcode(messext):=1;
4 16643 d.op(1):= semaphore;
4 16644 d.op.optype:= operationtype;
4 16645 mon(16) send message :(0, mess, 0, receiver);
4 16646 messref(messext):= monw2;
4 16647 end;
3 16648
3 16648
3 16648 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16649 begin <* return the operation immediately with result = 0 *>
4 16650 d.op(9):= 0;
4 16651 signalch(semaphore, op, operationtype);
4 16652 end;
3 16653 end;
2 16654 \f
2 16654
2 16654 message coroutinemonitor - 24 ;
2 16655
2 16655
2 16655 <***** semwaitmessage *****
2 16656
2 16656 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16657 be performed by the coroutine monitor when a message arrives to the process
2 16658 corresponding to 'processextension'. *>
2 16659
2 16659
2 16659 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16660 value processextension, semaphore, operation, operationtype;
2 16661 integer processextension, semaphore, operation;
2 16662 boolean operationtype;
2 16663 begin
3 16664 integer array field op;
3 16665 op:= operation;
3 16666 procop(processextension):= operation;
3 16667 d.op(1):= semaphore;
3 16668 d.op.optype:= operationtype;
3 16669 proccode(processextension):= 1;
3 16670
3 16670
3 16670 end;
2 16671 \f
2 16671
2 16671 message coroutinemonitor - 25 ;
2 16672
2 16672
2 16672 <***** semregretmessage *****
2 16673
2 16673 this procedure regrets a message sent by semsendmessage.
2 16674 the message is identified by the operation in which the answer should be
2 16675 returned.
2 16676 the procedure sets the result field of the operation to zero, and then
2 16677 returns it by performing a signalch. *>
2 16678
2 16678
2 16678 procedure semregretmessage (operation);
2 16679 value operation;
2 16680 integer operation;
2 16681 begin
3 16682 integer i, j;
3 16683 integer array field op, sem;
3 16684 op:= operation;
3 16685 i:= 1;
3 16686 while i < maxmessext do
3 16687 begin
4 16688 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16689 begin
5 16690 mon(82) regret message :(0, 0, messref(i), 0);
5 16691 messref(i):= 0;
5 16692 sem:= d.op(1);
5 16693 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16694 signalch(sem, op, d.op.optype);
5 16695 i:= maxmessext;
5 16696 end;
4 16697 i:= i + 1;
4 16698 end;
3 16699
3 16699
3 16699 end;
2 16700 \f
2 16700
2 16700 message coroutinemonitor - 26 ;
2 16701
2 16701
2 16701 <***** link *****
2 16702
2 16702 this procedure links an object (allocated in the descriptor array 'd') into
2 16703 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16704 are all double chained, and the chainhead is of the same format as the chain
2 16705 fields of the objects.
2 16706 the procedure links the object immediately after the head. *>
2 16707
2 16707
2 16707 procedure link (object, chainhead);
2 16708 value object, chainhead;
2 16709 integer object, chainhead;
2 16710 begin
3 16711 integer array field prevelement, nextelement, chead, obj;
3 16712 obj:= object;
3 16713 chead:= chainhead;
3 16714 prevelement:= d.obj.prev;
3 16715 nextelement:= d.obj.next;
3 16716 d.prevelement.next:= nextelement;
3 16717 d.nextelement.prev:= prevelement;
3 16718 if chead > 0 then <* link into queue *>
3 16719 begin
4 16720 prevelement:= d.chead.prev;
4 16721 d.obj.prev:= prevelement;
4 16722 d.prevelement.next:= obj;
4 16723 d.obj.next:= chead;
4 16724 d.chead.prev:= obj;
4 16725 end else
3 16726 begin <* link onto itself *>
4 16727 d.obj.prev:= obj;
4 16728 d.obj.next:= obj;
4 16729 end;
3 16730 end;
2 16731 \f
2 16731
2 16731 message coroutinemonitor - 27 ;
2 16732
2 16732
2 16732 <***** linkprio *****
2 16733
2 16733 this procedure is used to link coroutines into queues corresponding to
2 16734 the priorities of the actual coroutine and the queue elements.
2 16735 the object is linked immediately before the first coroutine of lower prio-
2 16736 rity. *>
2 16737
2 16737
2 16737 procedure linkprio (object, chainhead);
2 16738 value object, chainhead;
2 16739 integer object, chainhead;
2 16740 begin
3 16741 integer array field currelement, chead, obj;
3 16742 obj:= object;
3 16743 chead:= chainhead;
3 16744 currelement:= d.chead.next;
3 16745 while currelement <> chead
3 16746 and d.currelement.corupriority <= d.obj.corupriority
3 16747 do currelement:= d.currelement.next;
3 16748 link(obj, currelement);
3 16749 end;
2 16750 \f
2 16750
2 16750 message coroutinemonitor - 28 ;
2 16751
2 16751 \f
2 16751
2 16751 message coroutinemonitor - 30a ;
2 16752
2 16752
2 16752 <*************** extention to coroutine monitor procedures **********>
2 16753
2 16753 <***** signalbin *****
2 16754
2 16754 this procedure simulates a binary semaphore on a simple semaphore
2 16755 by testing the value of the semaphore before signaling the
2 16756 semaphore. if the value of the semaphore is one (=open) nothing is
2 16757 done, otherwise a normal signal is carried out. *>
2 16758
2 16758
2 16758 procedure signalbin(semaphore);
2 16759 value semaphore;
2 16760 integer semaphore;
2 16761 begin
3 16762 integer array field sem;
3 16763 integer val;
3 16764 sem:= semaphore;
3 16765 inspect(sem,val);
3 16766 if val<1 then signal(sem);
3 16767 end;
2 16768 \f
2 16768
2 16768 message coroutinemonitor - 30b ;
2 16769
2 16769 <***** coruno *****
2 16770
2 16770 delivers the coroutinenumber for a give coroutine id.
2 16771 if the coroutine does not exists the value 0 is delivered *>
2 16772
2 16772 integer procedure coru_no(coru_id);
2 16773 value coru_id;
2 16774 integer coru_id;
2 16775 begin
3 16776 integer array field cor;
3 16777
3 16777 coru_no:= 0;
3 16778 for cor:= firstcoru step corusize until (coruref-1) do
3 16779 if d.cor.coruident//1000 = coru_id then
3 16780 coru_no:= d.cor.coruident mod 1000;
3 16781 end;
2 16782 \f
2 16782
2 16782 message coroutinemonitor - 30c ;
2 16783
2 16783 <***** coroutine *****
2 16784
2 16784 delivers the referencebyte for the coroutinedescriptor for
2 16785 a coroutine identified by coroutinenumber *>
2 16786
2 16786 integer procedure coroutine(cor_no);
2 16787 value cor_no;
2 16788 integer cor_no;
2 16789 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16790 firstcoru + (cor_no-1)*corusize;
2 16791 \f
2 16791
2 16791 message coroutinemonitor - 30d ;
2 16792
2 16792 <***** curr_coruno *****
2 16793
2 16793 delivers number of calling coroutine
2 16794 curr_coruno:
2 16795 < 0 = -current_coroutine_number in disabled mode
2 16796 = 0 = procedure not called from coroutine
2 16797 > 0 = current_coroutine_number in enabled mode *>
2 16798
2 16798 integer procedure curr_coruno;
2 16799 begin
3 16800 integer i;
3 16801 integer array ia(1:12);
3 16802
3 16802 i:= system(12,0,ia);
3 16803 if i > 0 then
3 16804 begin
4 16805 i:= system(12,1,ia);
4 16806 curr_coruno:= ia(3);
4 16807 end else curr_coruno:= 0;
3 16808 end curr_coruno;
2 16809 \f
2 16809
2 16809 message coroutinemonitor - 30e ;
2 16810
2 16810 <***** curr_coruid *****
2 16811
2 16811 delivers coruident of calling coroutine :
2 16812
2 16812 curr_coruid:
2 16813 > 0 = coruident of calling coroutine
2 16814 = 0 = procedure not called from coroutine *>
2 16815
2 16815 integer procedure curr_coruid;
2 16816 begin
3 16817 integer cor_no;
3 16818 integer array field cor;
3 16819
3 16819 cor_no:= abs curr_coruno;
3 16820 if cor_no <> 0 then
3 16821 begin
4 16822 cor:= coroutine(cor_no);
4 16823 curr_coruid:= d.cor.coruident // 1000;
4 16824 end
3 16825 else curr_coruid:= 0;
3 16826 end curr_coruid;
2 16827 \f
2 16827 message coroutinemonitor - 30f.1 ;
2 16828
2 16828 <**** getch *****
2 16829
2 16829 this procedure searches the queue of operations waiting at 'semaphore'
2 16830 to find an operation that matches the operationstypeset and a set of
2 16831 select-values. each select value is specified by type and fieldvalue
2 16832 in integer array 'type' and by the value in integer array 'val'.
2 16833
2 16833 0: eq 0: not used
2 16834 1: lt 1: boolean
2 16835 2: le 2: integer
2 16836 3: gt 3: long
2 16837 4: ge 4: real
2 16838 5: ne
2 16839 *>
2 16840
2 16840 procedure getch(semaphore,operation,operationtypeset,type,val);
2 16841 value semaphore,operationtypeset;
2 16842 integer semaphore,operation;
2 16843 boolean operationtypeset;
2 16844 integer array type,val;
2 16845 begin
3 16846 integer array field firstop,currop;
3 16847 integer ø,n,i,f,t,rel,i1,i2;
3 16848 boolean field bf,bfval;
3 16849 integer field intf;
3 16850 long field lf,lfval; long l1,l2;
3 16851 real field rf,rfval; real r1,r2;
3 16852
3 16852 boolean match;
3 16853
3 16853 operation:= 0;
3 16854 n:= system(3,ø,type);
3 16855 match:= false;
3 16856 firstop:= semaphore + semop;
3 16857 currop:= d.firstop.next;
3 16858 while currop <> firstop and -,match do
3 16859 begin
4 16860 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16861 begin
5 16862 i:= n;
5 16863 match:= true;
5 16864 \f
5 16864 message coroutinemonitor - 30f.2 ;
5 16865
5 16865 while match and (if i <= ø then type(i) >= 0 else false) do
5 16866 begin
6 16867 rel:= type(i) shift(-18);
6 16868 t:= type(i) shift(-12) extract 6;
6 16869 f:= type(i) extract 12;
6 16870 if f > 2047 then f:= f -4096;
6 16871 case t+1 of
6 16872 begin
7 16873 ; <* not used *>
7 16874
7 16874 begin <*boolean or signed short integer*>
8 16875 bf:= f;
8 16876 bfval:= 2*i;
8 16877 i1:= d.currop.bf extract 12;
8 16878 if i1 > 2047 then i1:= i1-4096;
8 16879 i2:= val.bfval extract 12;
8 16880 if i2 > 2047 then i2:= i2-4096;
8 16881 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16882 end;
7 16883
7 16883 begin <*integer*>
8 16884 intf:= f;
8 16885 i1:= d.currop.intf;
8 16886 i2:= val(i);
8 16887 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16888 end;
7 16889
7 16889 begin <*long*>
8 16890 lf:= f;
8 16891 lfval:= i*2;
8 16892 l1:= d.currop.lf;
8 16893 l2:= val.lfval;
8 16894 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 16895 end;
7 16896
7 16896 begin <*real*>
8 16897 rf:= f;
8 16898 rfval:= i*2;
8 16899 r1:= d.currop.rf;
8 16900 r2:= val.rfval;
8 16901 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 16902 end;
7 16903
7 16903 end;<*case t+1*>
6 16904
6 16904 i:= i+1;
6 16905 end; <*while match and i<=ø and t>=0 *>
5 16906 \f
5 16906 message coroutinemonitor - 30f.3 ;
5 16907
5 16907 end; <* if operationtypeset and ---*>
4 16908 if -,match then currop:= d.currop.next;
4 16909 end; <*while currop <> firstop and -,match*>
3 16910
3 16910 if match then
3 16911 begin
4 16912 link(currop,0);
4 16913 d.current.coruop:= currop;
4 16914 operation:= currop;
4 16915 end;
3 16916 end getch;
2 16917 \f
2 16917
2 16917 message coroutinemonitor - 31 ;
2 16918
2 16918 activity(maxcoru);
2 16919
2 16919 goto initialization;
2 16920
2 16920
2 16920
2 16920 <*************** event handling ***************>
2 16921
2 16921
2 16921
2 16921 takeexternal:
2 16922 currevent:= baseevent;
2 16923 eventqueueempty:= false;
2 16924 repeat
2 16925 current:= 0;
2 16926 prevevent:= currevent;
2 16927 mon(66) test event :(0, 0, currevent, 0);
2 16928 currevent:= monw2;
2 16929 if monw0 < 0 <* no event *> then goto takeinternal;
2 16930 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 16931 cmi:= monw1
2 16932 else
2 16933 cmi:= - monw0;
2 16934
2 16934 if cmi > 0 then
2 16935 begin <* answer to activity zone *>
3 16936 current:= firstcoru + (cmi - 1) * corusize;
3 16937 linkprio(current, readyqueue);
3 16938 baseevent:= 0;
3 16939 end else
2 16940
2 16940 if cmi = 0 then
2 16941 begin <* message arrived *>
3 16942 \f
3 16942
3 16942 message coroutinemonitor - 32 ;
3 16943
3 16943 receiver:= core.currevent(3);
3 16944 if receiver < 0 then receiver:= - receiver;
3 16945 procref(maxprocext):= receiver;
3 16946 procext:= 1;
3 16947 while procref(procext) <> receiver do procext:= procext + 1;
3 16948 if procext = maxprocext then
3 16949 begin <* receiver unknown *>
4 16950 <* leave the message unchanged *>
4 16951 end else
3 16952 if proccode(procext) shift (-12) = 0 then
3 16953 begin <* the receiver is ready for accepting messages *>
4 16954 mon(26) get event :(0, 0, currevent, 0);
4 16955 case proccode(procext) of
4 16956 begin
5 16957 begin <* message received by semwaitmessage *>
6 16958 op:= procop(procext);
6 16959 sem:= d.op(1);
6 16960 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 16961 d.op(9):= currevent;
6 16962 signalch(sem, op, d.op.optype);
6 16963 proccode(procext):= 1 shift 12;
6 16964 end;
5 16965 begin <* message received by cwaitmessage *>
6 16966 current:= procop(procext);
6 16967 procop(procext):= currevent;
6 16968 linkprio(current, readyqueue);
6 16969 link(current + corutimerchain, idlequeue);
6 16970
6 16970
6 16970 end;
5 16971 end; <* case *>
4 16972 currevent:= baseevent;
4 16973 proccode(procext):= 1 shift 12;
4 16974 end;
3 16975 end <* message *> else
2 16976
2 16976 if cmi = -1 then
2 16977 begin <* answer arrived *>
3 16978 \f
3 16978
3 16978 message coroutinemonitor - 33 ;
3 16979
3 16979 if currevent = timermessage then
3 16980 begin
4 16981 mon(26) get event :(0, 0, currevent, 0);
4 16982 coru:= d.timerqueue.next;
4 16983 while coru <> timerqueue do
4 16984 begin
5 16985 current:= coru - corutimerchain;
5 16986 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 16987 coru:= d.coru.next;
5 16988 if d.current.corutimer <= 0 then
5 16989 begin <* timer perion expired *>
6 16990 d.current.corutimer:= -1;
6 16991 linkprio(current, readyqueue);
6 16992 link(current + corutimerchain, idlequeue);
6 16993 end;
5 16994 end;
4 16995 mon(16) send message :(0, clockmess, 0, clock);
4 16996 timermessage:= monw2;
4 16997 currevent:= baseevent;
4 16998 end <* timer answer *> else
3 16999 begin
4 17000 messref(maxmessext):= currevent;
4 17001 messext:= 1;
4 17002 while messref(messext) <> currevent do messext:= messext + 1;
4 17003 if messext = maxmessext then
4 17004 begin <* the answer is unknown *>
5 17005 <* leave the answer unchanged - it may belong to an activity *>
5 17006 end else
4 17007 if messcode(messext) shift (-12) = 0 then
4 17008 begin
5 17009 case messcode(messext) extract 12 of
5 17010 begin
6 17011 \f
6 17011
6 17011 message coroutinemonitor - 34 ;
6 17012 begin <* answer arrived after semsendmessage *>
7 17013 op:= messop(messext);
7 17014 sem:= d.op(1);
7 17015 mon(18) wait answer :(0, d.op, currevent, 0);
7 17016 d.op(9):= monw0;
7 17017 signalch(sem, op, d.op.optype);
7 17018 messref(messext):= 0;
7 17019 baseevent:= 0;
7 17020 end;
6 17021 begin <* answer arrived after csendmessage *>
7 17022 current:= messop(messext);
7 17023 linkprio(current, readyqueue);
7 17024 link(current + corutimerchain, idlequeue);
7 17025
7 17025
7 17025 end;
6 17026 end;
5 17027 end else baseevent:= currevent;
4 17028 end;
3 17029 end;
2 17030 until eventqueueempty;
2 17031 \f
2 17031
2 17031 message coroutinemonitor - 35 ;
2 17032
2 17032
2 17032
2 17032 <*************** coroutine activation ***************>
2 17033
2 17033 takeinternal:
2 17034
2 17034 current:= d.readyqueue.next;
2 17035 if current = readyqueue then
2 17036 begin
3 17037 mon(24) wait event :(0, 0, prevevent, 0);
3 17038 goto takeexternal;
3 17039 end;
2 17040
2 17040 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17041 <**> begin
3 17042 <**> systime(5,0,r);
3 17043 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17044 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17045 <**> d.current.coruident//1000,<: aktiveres:>);
3 17046 <**> end;
2 17047 <*-2*>
2 17048
2 17048 corustate:= activate(d.current.coruident mod 1000);
2 17049 cmi:= corustate extract 24;
2 17050 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17051 <**> begin
3 17052 <**> systime(5,0,r);
3 17053 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17054 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17055 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 17056 <**> end;
2 17057 <*-2*>
2 17058
2 17058 if cmi = 1 then
2 17059 begin <* programmed passivate *>
3 17060 goto takeexternal;
3 17061 end;
2 17062
2 17062 if cmi = 2 then
2 17063 begin <* implicit passivate in activity *>
3 17064
3 17064
3 17064 link(current, idlequeue);
3 17065 goto takeexternal;
3 17066 end;
2 17067 \f
2 17067
2 17067 message coroutinemonitor - 36 ;
2 17068
2 17068 <* coroutine termination (normal or abnormal) *>
2 17069
2 17069 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 17070 coru_term:
2 17071
2 17071 begin
3 17072 if false and alarmcause extract 24 = (-9) <* break *> and
3 17073 alarmcause shift (-24) extract 24 = 0 then
3 17074 begin
4 17075 endaction:= 2;
4 17076 goto program_slut;
4 17077 end;
3 17078 if alarmcause extract 24 = (-9) <* break *> and
3 17079 alarmcause shift (-24) = 8 <* parent *>
3 17080 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 17081 if alarmcause shift (-24) extract 24 <> -2 or
3 17082 alarmcause extract 24 <> -13 then
3 17083 begin
4 17084 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 17085 alarmcause shift (-24),<:,:>,
4 17086 alarmcause extract 24);
4 17087 for i:=1 step 1 until max_coru do
4 17088 j:=activate(-i); <* kill *>
4 17089 <* skriv billede *>
4 17090 end
3 17091 else
3 17092 begin
4 17093 errorbits:= 0; <* ok.yes warning.no *>
4 17094 goto finale;
4 17095 end;
3 17096 end;
2 17097
2 17097 goto dump;
2 17098
2 17098 link(current, idlequeue);
2 17099 goto takeexternal;
2 17100 \f
2 17100
2 17100 message coroutinemonitor - 37 ;
2 17101
2 17101
2 17101
2 17101 initialization:
2 17102
2 17102
2 17102 <*************** initialization ***************>
2 17103
2 17103 <* chain head *>
2 17104
2 17104 prev:= -2; <* -2 prev *>
2 17105 next:= 0; <* +0 next *>
2 17106
2 17106 <* corutine descriptor *>
2 17107
2 17107 <* -2 prev *>
2 17108 <* +0 next *>
2 17109 <* +2 (link field) *>
2 17110 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 17111 <* +6 (link field) *>
2 17112 coruop:= corutimerchain + 4; <* +8 coruop *>
2 17113 corutimer:= coruop + 2; <*+10 corutimer *>
2 17114 coruident:= corutimer + 2; <*+12 coruident *>
2 17115 corupriority:= coruident + 2; <*+14 corupriority *>
2 17116 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 17117 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 17118
2 17118 <* simple semaphore *>
2 17119
2 17119 <* -2 (link field) *>
2 17120 simcoru:= next; <* +0 simcoru *>
2 17121 simvalue:= simcoru + 2; <* +2 simvalue *>
2 17122
2 17122 <* chained semaphore *>
2 17123
2 17123 <* -2 (link field) *>
2 17124 semcoru:= next; <* +0 semcoru *>
2 17125 <* +2 (link field) *>
2 17126 semop:= semcoru + 4; <* +4 semop *>
2 17127 \f
2 17127
2 17127 message coroutinemonitor - 38 ;
2 17128
2 17128 <* operation *>
2 17129
2 17129 opsize:= next - 6; <* -6 opsize *>
2 17130 optype:= opsize + 1; <* -5 optype *>
2 17131 <* -2 prev *>
2 17132 <* +0 next *>
2 17133 <* +2 operation(1) *>
2 17134 <* +4 operation(2) *>
2 17135 <* +6 - *>
2 17136 <* . - *>
2 17137 <* . - *>
2 17138
2 17138 \f
2 17138
2 17138 message coroutinemonitor - 39 ;
2 17139
2 17139 trap(dump);
2 17140 systime(1, 0, starttime);
2 17141 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 17142 clockmess(1):= 0;
2 17143 clockmess(2):= timeinterval;
2 17144 clock(1):= real <:clock:>;
2 17145 clock(2):= real <::>;
2 17146 mon(16) send message :(0, clockmess, 0, clock);
2 17147 timermessage:= monw2;
2 17148 readyqueue:= 4;
2 17149 initchain(readyqueue);
2 17150 idlequeue:= readyqueue + 4;
2 17151 initchain(idlequeue);
2 17152 timerqueue:= idlequeue + 4;
2 17153 initchain(timerqueue);
2 17154 current:= 0;
2 17155 corucount:= 0;
2 17156 proccount:= 0;
2 17157 baseevent:= 0;
2 17158 coruref:= timerqueue + 4;
2 17159 firstcoru:= coruref;
2 17160 simref:= coruref + maxcoru * corusize;
2 17161 firstsim:= simref;
2 17162 semref:= simref + maxsem * simsize;
2 17163 firstsem:= semref;
2 17164 opref:= semref + maxsemch * semsize + 4;
2 17165 firstop:= opref;
2 17166 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 17167 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 17168 reflectcore(core);
2 17169
2 17169 algol list.on;
2 17170
2 17170 \f
2 17170 message sys_initialisering side 1 - 810601/hko;
2 17171
2 17171 trapmode:= 1 shift 15;
2 17172 errorbits:= 1; <* warning.no ok.no *>
2 17173 trap(coru_term);
2 17174
2 17174 open(zbillede,4,<:billede:>,0);
2 17175 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17176 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17177 system(2,0,ia);
2 17178 open(zdummy,4,ia,0); close(zdummy,false);
2 17179 monitor(42,zdummy,0,ia);
2 17180 laf:= 0;
2 17181 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17182 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17183 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17184
2 17184 open(zrl,4,<:radiolog:>,0);
2 17185 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17186 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17187 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17188 begin
3 17189 ia(1):=1; ia(2):= 3;
3 17190 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17191 monitor(40)create_area:(zrl,0,ia);
3 17192 end;
2 17193
2 17193 for i:=1 step 1 until max_antal_fejltekster do
2 17194 fejltekst(i):= real (case i of (
2 17195 <* 1*><:filsystem:>,
2 17196 <* 2*><:operationskode:>,
2 17197 <* 3*><:programfejl:>,
2 17198 <* 4*><:monitor<'_'>resultat=:>,
2 17199 <* 5*><:læs<'_'>fil:>,
2 17200 <* 6*><:skriv<'_'>fil:>,
2 17201 <* 7*><:modif<'_'>fil:>,
2 17202 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17203 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17204 <*10*><:vogntabel:>,
2 17205 <*11*><:fremmed operation:>,
2 17206 <*12*><:operationstype:>,
2 17207 <*13*><:opret<'_'>fil:>,
2 17208 <*14*><:tilknyt<'_'>fil:>,
2 17209 <*15*><:frigiv<'_'>fil:>,
2 17210 <*16*><:slet<'_'>fil:>,
2 17211 <*17*><:ydre enhed, status=:>,
2 17212 <*18*><:tabelfil:>,
2 17213 <*19*><:radio:>,
2 17214 <*20*><:mobilopkald, bus:>,
2 17215 <*21*><:talevejsswitch:>,
2 17216 <*99*><:ftslut:>));
2 17217
2 17217 for i:= 1 step 1 until max_antal_områder do
2 17218 begin
3 17219 område_navn(i):= long (case i of
3 17220 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17221 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17222 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17223 område_id(i,2):=
3 17224 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17225 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17226 end;
2 17227
2 17227 pabx_id(1):= -1;
2 17228 pabx_id(2):= 1;
2 17229
2 17229 for i:= 1 step 1 until max_antal_radiokanaler do
2 17230 begin
3 17231 radio_id(i):=
3 17232 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17233 end;
2 17234
2 17234 for i:=1 step 1 until max_antal_kanaler do
2 17235 begin
3 17236 kanal_navn(i):= long (case i of (
3 17237 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17238 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17239 kanal_id(i):=
3 17240 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17241 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17242 end;
2 17243
2 17243 for i:= 1 step 1 until op_maske_lgd//2 do
2 17244 ingen_operatører(i):= alle_operatører(i):= 0;
2 17245 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17246 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17247
2 17247 begin
3 17248 long array navn(1:2);
3 17249 long array field doc, ref;
3 17250
3 17250 doc:= 2; iaf:= 0;
3 17251 movestring(navn,1,<:terminal0:>);
3 17252 for i:= 1 step 1 until max_antal_operatører do
3 17253 begin
4 17254 ref:=(i-1)*8; k:=9;
4 17255 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17256 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17257 open(zdummy,8,navn,0); close(zdummy,true);
4 17258 k:= monitor(42,zdummy,0,ia);
4 17259 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17260 else tofrom(terminal_navn.ref,navn,8);
4 17261 operatør_auto_include(i):= false;
4 17262 sætbit_ia(alle_operatører,i,1);
4 17263 end;
3 17264
3 17264 movestring(navn,1,<:garage0:>);
3 17265 for i:= 1 step 1 until max_antal_garageterminaler do
3 17266 begin
4 17267 ref:=(i-1)*8; k:=7;
4 17268 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17269 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17270 open(zdummy,8,navn,0); close(zdummy,true);
4 17271 k:= monitor(42,zdummy,0,ia);
4 17272 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17273 else tofrom(garage_terminal_navn.ref,navn,8);
4 17274 garage_auto_include(i):= false;
4 17275 end;
3 17276 end;
2 17277
2 17277 for i:= 1 step 1 until max_antal_taleveje do
2 17278 sætbit_ia(alle_taleveje,i,1);
2 17279 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17280 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17281 operatør_auto_include(ia(i)):= true;
2 17282 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17283 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17284 garage_auto_include(ia(i)):= true;
2 17285
2 17285
2 17285 \f
2 17285 message fil_init side 1 - 801030/jg;
2 17286
2 17286 begin integer i,antz,tz,s;
3 17287 real array field raf;
3 17288
3 17288 filskrevet:=fillæst:=0; <*fil*>
3 17289 dbsegmax:= 2**18-1;
3 17290
3 17290 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17291 for i:=1 step 1 until dbantez do
3 17292 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17293 for i:=dbantez+1 step 1 until tz do
3 17294 open(fil(i),4,dbsnavn,0);
3 17295 for i:=tz+1 step 1 until antz do
3 17296 open(fil(i),4,dbtnavn,0);
3 17297
3 17297 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17298 dbkatz(i,1):=dbkatz(i,2):=0;
3 17299 for i:=dbantez+1 step 1 until tz do
3 17300 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17301 for i:=tz+1 step 1 until antz do
3 17302 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17303 dbkatz(antz,2):=tz+1;
3 17304 dbsidstetz:=antz;
3 17305 dbsidstesz:=tz;
3 17306
3 17306 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17307 begin integer j;
4 17308 for j:=1,3 step 1 until 6 do
4 17309 dbkate(i,j):=0;
4 17310 dbkate(i,2):=i+1;
4 17311 end;
3 17312 dbkate(dbmaxef,2):=0;
3 17313 dbkatefri:=1;
3 17314 dbantef:=0;
3 17315 \f
3 17315 message fil_init side 2 - 801030/jg;
3 17316
3 17316
3 17316 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17317 begin
4 17318 dbkats(i,1):=0;
4 17319 dbkats(i,2):=i+1;
4 17320 end;
3 17321 dbkats(dbmaxsf,2):=0;
3 17322 dbkatsfri:=1;
3 17323 dbantsf:=0;
3 17324
3 17324 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17325 dbkatb(i):=false add (i+1);
3 17326 dbkatb(dbmaxb):=false;
3 17327 dbkatbfri:=1;
3 17328 dbantb:=0;
3 17329 raf:=4;
3 17330 for i:=1 step 1 until dbmaxtf do
3 17331 begin
4 17332 inrec6(fil(antz),4);
4 17333 dbkatt.raf(i):=fil(antz,1);
4 17334 end;
3 17335 inrec6(fil(antz),4);
3 17336 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17337 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17338 setposition(fil(antz),0,0);
3 17339
3 17339 end filsystem;
2 17340 \f
2 17340 message fil_init side 3 - 810209/cl;
2 17341
2 17341 bs_kats_fri:= nextsem;
2 17342 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17343 <*-3*>
2 17344 bs_kate_fri:= nextsem;
2 17345 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17346 <*-3*>
2 17347 cs_opret_fil:= nextsemch;
2 17348 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17349 <*-3*>
2 17350 cs_tilknyt_fil:= nextsemch;
2 17351 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17352 <*-3*>
2 17353 cs_frigiv_fil:= nextsemch;
2 17354 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17355 <*-3*>
2 17356 cs_slet_fil:= nextsemch;
2 17357 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17358 <*-3*>
2 17359 cs_opret_spoolfil:= nextsemch;
2 17360 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17361 <*-3*>
2 17362 cs_opret_eksternfil:= nextsemch;
2 17363 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17364 <*-3*>
2 17365 \f
2 17365 message fil_init side 4 810209/cl;
2 17366
2 17366
2 17366 <* initialisering af filsystemcoroutiner *>
2 17367
2 17367 i:= nextcoru(001,10,true);
2 17368 j:= newactivity(i,0,opretfil);
2 17369 <*+3*> skriv_newactivity(out,i,j);
2 17370 <*-3*>
2 17371
2 17371 i:= nextcoru(002,10,true);
2 17372 j:= newactivity(i,0,tilknytfil);
2 17373 <*+3*> skriv_newactivity(out,i,j);
2 17374 <*-3*>
2 17375
2 17375 i:= nextcoru(003,10,true);
2 17376 j:= newactivity(i,0,frigivfil);
2 17377 <*+3*> skriv_newactivity(out,i,j);
2 17378 <*-3*>
2 17379
2 17379 i:= nextcoru(004,10,true);
2 17380 j:= newactivity(i,0,sletfil);
2 17381 <*+3*> skriv_newactivity(out,i,j);
2 17382 <*-3*>
2 17383
2 17383 i:= nextcoru(005,10,true);
2 17384 j:= newactivity(i,0,opretspoolfil);
2 17385 <*+3*> skriv_newactivity(out,i,j);
2 17386 <*-3*>
2 17387
2 17387 i:= nextcoru(006,10,true);
2 17388 j:= newactivity(i,0,opreteksternfil);
2 17389 <*+3*> skriv_newactivity(out,i,j);
2 17390 <*-3*>
2 17391 \f
2 17391 message attention_initialisering side 1 - 850820/cl;
2 17392
2 17392 tf_kommandotabel:= 1 shift 10 + 1;
2 17393
2 17393 begin
3 17394 integer i, s, zno;
3 17395 zone z(128,1,stderror);
3 17396 integer array fdim(1:8);
3 17397
3 17397 fdim(4):= tf_kommandotabel;
3 17398 hentfildim(fdim);
3 17399
3 17399 open(z,4,<:htkommando:>,0);
3 17400 for i:= 1 step 1 until fdim(3) do
3 17401 begin
4 17402 inrec6(z,512);
4 17403 s:= skrivfil(tf_kommandotabel,i,zno);
4 17404 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17405 tofrom(fil(zno),z,512);
4 17406 end;
3 17407 close(z,true);
3 17408 end;
2 17409 \f
2 17409 message attention_initialisering side 1a - 810428/hko;
2 17410
2 17410 for j:= system(3,i,terminal_tab) step 1 until i do
2 17411 terminal_tab(j):= 0;
2 17412
2 17412 cs_att_pulje:=next_semch;
2 17413 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17414 <*-3*>
2 17415
2 17415 bs_fortsæt_adgang:= nextsem;
2 17416 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17417 <*-3*>
2 17418 signalbin(bs_fortsæt_adgang);
2 17419
2 17419 for i:= 1,
2 17420 1 step 1 until max_antal_operatører,
2 17421 1 step 1 until max_antal_garageterminaler do
2 17422
2 17422 <* initialisering af pulje med attention_operationer *>
2 17423
2 17423 signalch(cs_att_pulje, <* pulje_semafor *>
2 17424 nextop(data+att_op_længde), <* næste_operation *>
2 17425 gen_optype);
2 17426
2 17426 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17427
2 17427 i:=next_coru(010,<*ident*>
2 17428 2,<*prioritet*>
2 17429 true<*test_maske*>);
2 17430 j:=newactivity( i, <*activityno *>
2 17431 0, <*ikke virtual *>
2 17432 attention);<*ingen parametre*>
2 17433
2 17433 <*+3*>skriv_newactivity(out,i,j);
2 17434 <*-3*>
2 17435 \f
2 17435 message io_initialisering side 1 - 810507/hko;
2 17436
2 17436 io_spoolfil:= 1028;
2 17437 begin
3 17438 integer array fdim(1:8);
3 17439 fdim(4):= io_spoolfil;
3 17440 hent_fildim(fdim);
3 17441 io_spool_postantal:= fdim(1);
3 17442 io_spool_postlængde:= fdim(2);
3 17443 end;
2 17444
2 17444 io_spool_post:= 4;
2 17445
2 17445 cs_io:= next_semch;
2 17446 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17447 <*-3*>
2 17448
2 17448 i:= next_coru(100,<*ident *>
2 17449 5,<*prioritet *>
2 17450 true<*test_maske*>);
2 17451
2 17451 j:= new_activity( i,
2 17452 0,
2 17453 h_io);
2 17454
2 17454 <*+3*>skriv_newactivity(out,i,j);
2 17455 <*-3*>
2 17456 cs_io_komm:= next_semch;
2 17457 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17458 <*-3*>
2 17459
2 17459 i:= next_coru(101,<*ident*>
2 17460 10,<*prioritet*>
2 17461 true <*testmaske*>);
2 17462 j:= new_activity( i,
2 17463 0,
2 17464 io_komm);<*ingen parametre*>
2 17465
2 17465 <*+3*>skriv_newactivity(out,i,j);
2 17466 <*-3*>
2 17467 \f
2 17467 message io_initialisering side 2 - 810520/hko/cl;
2 17468
2 17468 bs_zio_adgang:= next_sem;
2 17469 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17470 <*-3*>
2 17471 signal_bin(bs_zio_adgang);
2 17472
2 17472 cs_io_spool:= next_semch;
2 17473 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17474 <*-3*>
2 17475
2 17475 cs_io_fil:=next_semch;
2 17476 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17477 <*-3*>
2 17478 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17479
2 17479 ss_io_spool_fulde:= next_sem;
2 17480 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17481 <*-3*>
2 17482
2 17482 ss_io_spool_tomme:= next_sem;
2 17483 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17484 <*-3*>
2 17485 for i:= 1 step 1 until io_spool_postantal do
2 17486 signal(ss_io_spool_tomme);
2 17487 \f
2 17487 message io_initialisering side 3 - 880901/cl;
2 17488
2 17488 i:= next_coru(102,
2 17489 5,
2 17490 true);
2 17491 j:= new_activity(i,0,io_spool);
2 17492
2 17492 <*+3*>skriv_newactivity(out,i,j);
2 17493 <*-3*>
2 17494
2 17494 i:= next_coru(103,
2 17495 10,
2 17496 true);
2 17497 j:= new_activity(i,0,io_spon);
2 17498
2 17498 <*+3*>skriv_newactivity(out,i,j);
2 17499 <*-3*>
2 17500
2 17500 cs_io_medd:= next_semch;
2 17501 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17502 <*-3*>
2 17503
2 17503 i:= next_coru(104,<*ident *>
2 17504 10,<*prioritet *>
2 17505 true<*test_maske*>);
2 17506
2 17506 j:= new_activity( i,
2 17507 0,
2 17508 io_medd);
2 17509
2 17509 <*+3*>skriv_newactivity(out,i,j);
2 17510 <*-3*>
2 17511
2 17511 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17512 i:= monitor(8)reserve process:(z_io,0,ia);
2 17513 if i <> 0 then
2 17514 begin
3 17515 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17516 end
2 17517 else
2 17518 begin
3 17519 ref:= 0;
3 17520 terminal_tab.ref.terminal_tilstand:= 0;
3 17521 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17522 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17523 "sp",1,"*",15,"nl",1);
3 17524 setposition(z_io,0,0);
3 17525 end;
2 17526 \f
2 17526 message operatør_initialisering side 1 - 810520/hko;
2 17527
2 17527 top_bpl_gruppe:= 64;
2 17528
2 17528 bpl_navn(0):= long<::>;
2 17529 for i:= 1 step 1 until 127 do
2 17530 begin
3 17531 k:= læsfil(tf_bpl_navne,i,j);
3 17532 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17533 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17534 if i<=max_antal_operatører then
3 17535 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17536 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17537 top_bpl_gruppe:= i;
3 17538 end;
2 17539
2 17539 for i:= 0 step 1 until 64 do
2 17540 begin
3 17541 iaf:= i*op_maske_lgd;
3 17542 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17543 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17544 if 1<=i and i<= max_antal_operatører then
3 17545 begin
4 17546 bpl_tilst(i,2):= 1;
4 17547 sætbit_ia(bpl_def.iaf,i,1);
4 17548 end;
3 17549 end;
2 17550 for i:= 65 step 1 until 127 do
2 17551 begin
3 17552 k:= læsfil(tf_bpl_def,i-64,j);
3 17553 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17554 iaf:= i*op_maske_lgd;
3 17555 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17556 bpl_tilst(i,1):= 0;
3 17557 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17558 end;
2 17559
2 17559 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17560 iaf:= 0;
2 17561 for i:= 1 step 1 until max_antal_operatører do
2 17562 begin
3 17563 k:= læsfil(tf_stoptabel,i,j);
3 17564 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17565 operatør_stop(i,0):= i;
3 17566 for k:= 1,2,3 do
3 17567 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17568 ant_i_opkø(i):= 0;
3 17569 end;
2 17570
2 17570 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17571 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17572 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17573 sidste_tv_brugt:= max_antal_taleveje;
2 17574
2 17574 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17575 opk_alarm(i):= 0;
2 17576 for i:= 1 step 1 until max_antal_operatører do
2 17577 begin
3 17578 integer array field tab;
3 17579
3 17579 k:= læsfil(tf_alarmlgd,i,j);
3 17580 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17581 tab:= (i-1)*opk_alarm_tab_lgd;
3 17582 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17583 opk_alarm.tab.alarm_start:= 0.0;
3 17584 end;
2 17585
2 17585 op_spool_kilde:= 2;
2 17586 op_spool_tid := 6;
2 17587 op_spool_text := 6;
2 17588 begin
3 17589 long array field laf1, laf2;
3 17590 laf2:= 4; laf1:= 0;
3 17591 op_spool_buf.laf1(1):= long<::>;
3 17592 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17593 op_spool_postantal*op_spool_postlgd-4);
3 17594 end;
2 17595
2 17595 k:=læsfil(1033,1,j);
2 17596 systime(1,0.0,r);
2 17597 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17598 for i:= 1 step 1 until max_cqf do
2 17599 begin
3 17600 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17601 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17602 cqf_tabel.ref.cqf_næste_tid:=
3 17603 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17604 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17605 end;
2 17606 op_cqf_tab_ændret:= true;
2 17607
2 17607 laf:= raf:= 0;
2 17608 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17609 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17610 j:= 1;
2 17611 if i<>0 then
2 17612 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17613 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17614 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17615 j:= 1;
2 17616 if i<>0 then
2 17617 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17618
2 17618 ia(1):= 3; <*canonical*>
2 17619 ia(2):= 0; <*no echo*>
2 17620 ia(3):= 0; <*prompt*>
2 17621 ia(4):= 2; <*timeout*>
2 17622 setcspterm(taleswitch_in_navn.laf,ia);
2 17623 setcspterm(taleswitch_out_navn.laf,ia);
2 17624
2 17624 cs_op:= next_semch;
2 17625
2 17625 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17626 <*-3*>
2 17627
2 17627 cs_op_retur:= next_semch;
2 17628
2 17628 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17629 <*-3*>
2 17630
2 17630 i:= nextcoru(200,<*ident*>
2 17631 10,<*prioitet*>
2 17632 true<*test_maske*>);
2 17633
2 17633 j:= new_activity( i,
2 17634 0,
2 17635 h_operatør);
2 17636
2 17636 <*+3*>skriv_newactivity(out,i,j);
2 17637 <*-3*>
2 17638 \f
2 17638 message operatør_initialisering side 2 - 810520/hko;
2 17639
2 17639 for k:= 1 step 1 until max_antal_operatører do
2 17640 begin
3 17641 ref:= (k-1)*8;
3 17642 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17643 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17644 ref:=k*terminal_beskr_længde;
3 17645 if i = 0 then
3 17646 begin
4 17647 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17648 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17649 end
3 17650 else
3 17651 begin
4 17652 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17653 end;
3 17654
3 17654 cs_operatør(k):= next_semch;
3 17655 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17656 <*-3*>
3 17657
3 17657 cs_op_fil(k):= nextsemch;
3 17658 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17659 <*-3*>
3 17660 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17661
3 17661 i:= next_coru(200+k,<*ident*>
3 17662 10,<*prioitet*>
3 17663 true<*testmaske*>);
3 17664 j:= new_activity( i,
3 17665 0,
3 17666 operatør,k);
3 17667
3 17667 <*+3*>skriv_newactivity(out,i,j);
3 17668 <*-3*>
3 17669 end;
2 17670
2 17670 cs_cqf:= next_semch;
2 17671 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17672 <*-3*>
2 17673
2 17673 signalch(cs_cqf,nextop(60),true);
2 17674
2 17674 i:= next_coru(292, <*ident*>
2 17675 10, <*prioritet*>
2 17676 true <*testmaske*>);
2 17677 j:= new_activity( i,
2 17678 0,
2 17679 op_cqftest);
2 17680 <*+3*>skriv_new_activity(out,i,j);
2 17681 <*-3*>
2 17682
2 17682 cs_op_spool:= next_semch;
2 17683 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17684 <*-3*>
2 17685
2 17685 cs_op_medd:= next_semch;
2 17686 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17687 <*-3*>
2 17688
2 17688 ss_op_spool_tomme:= next_sem;
2 17689 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17690 <*-3*>
2 17691 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17692
2 17692 ss_op_spool_fulde:= next_sem;
2 17693 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17694 <*-3*>
2 17695
2 17695 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17696
2 17696 i:= next_coru(293, <*ident*>
2 17697 10, <*prioritet*>
2 17698 true <*testmaske*>);
2 17699 j:= new_activity( i,
2 17700 0,
2 17701 op_spool);
2 17702 <*+3*>skriv_new_activity(out,i,j);
2 17703 <*-3*>
2 17704
2 17704 i:= next_coru(294, <*ident*>
2 17705 10, <*prioritet*>
2 17706 true <*testmaske*>);
2 17707 j:= new_activity( i,
2 17708 0,
2 17709 op_medd);
2 17710 <*+3*>skriv_new_activity(out,i,j);
2 17711 <*-3*>
2 17712
2 17712 cs_op_iomedd:= next_semch;
2 17713 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17714 <*-3*>
2 17715
2 17715 bs_opk_alarm:= next_sem;
2 17716 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17717 <*-3*>
2 17718
2 17718 cs_opk_alarm:= next_semch;
2 17719 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17720 <*-3*>
2 17721
2 17721 cs_opk_alarm_ur:= next_semch;
2 17722 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17723 <*-3*>
2 17724
2 17724 cs_opk_alarm_ur_ret:= next_semch;
2 17725 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17726 <*-3*>
2 17727
2 17727 cs_tvswitch_adgang:= next_semch;
2 17728 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17729 <*-3*>
2 17730
2 17730 cs_tv_switch_input:= next_semch;
2 17731 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17732 <*-3*>
2 17733
2 17733 cs_tv_switch_adm:= next_semch;
2 17734 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17735 <*-3*>
2 17736
2 17736 cs_talevejsswitch:= next_semch;
2 17737 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17738 <*-3*>
2 17739
2 17739 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17740
2 17740 iaf:= nextop(data+128);
2 17741 if testbit22 then
2 17742 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17743 else
2 17744 begin
3 17745 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17746 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17747 end;
2 17748
2 17748 i:= next_coru(295, <*ident*>
2 17749 8, <*prioritet*>
2 17750 true <*testmaske*>);
2 17751 j:= new_activity( i,
2 17752 0,
2 17753 alarmur);
2 17754 <*+3*>skriv_new_activity(out,i,j);
2 17755 <*-3*>
2 17756
2 17756 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17757
2 17757 i:= next_coru(296, <*ident*>
2 17758 8, <*prioritet*>
2 17759 true <*testmaske*>);
2 17760 j:= new_activity( i,
2 17761 0,
2 17762 opkaldsalarmer);
2 17763 <*+3*>skriv_new_activity(out,i,j);
2 17764 <*-3*>
2 17765
2 17765 i:= next_coru(297, <*ident*>
2 17766 3, <*prioritet*>
2 17767 true <*testmaske*>);
2 17768 j:= new_activity( i,
2 17769 0,
2 17770 tv_switch_input);
2 17771 <*+3*>skriv_new_activity(out,i,j);
2 17772 <*-3*>
2 17773
2 17773 for i:= 1,2 do
2 17774 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17775
2 17775 i:= next_coru(298, <*ident*>
2 17776 20, <*prioritet*>
2 17777 true <*testmaske*>);
2 17778 j:= new_activity( i,
2 17779 0,
2 17780 tv_switch_adm);
2 17781 <*+3*>skriv_new_activity(out,i,j);
2 17782 <*-3*>
2 17783
2 17783 i:= next_coru(299, <*ident*>
2 17784 3, <*prioritet*>
2 17785 true <*testmaske*>);
2 17786 j:= new_activity( i,
2 17787 0,
2 17788 talevejsswitch);
2 17789 <*+3*>skriv_new_activity(out,i,j);
2 17790 <*-3*>
2 17791 \f
2 17791 message garage_initialisering side 1 - 810521/hko;
2 17792
2 17792 cs_gar:= next_semch;
2 17793 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 17794 <*-3*>
2 17795
2 17795 i:= next_coru(300,<*ident*>
2 17796 10,<*prioritet*>
2 17797 true<*test_maske*>);
2 17798
2 17798 j:= new_activity( i,
2 17799 0,
2 17800 h_garage);
2 17801
2 17801 <*+3*>skriv_newactivity(out,i,j);
2 17802 <*-3*>
2 17803
2 17803 for k:= 1 step 1 until max_antal_garageterminaler do
2 17804 begin
3 17805 ref:= (k-1)*8;
3 17806 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 17807 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 17808 i:=monitor(4)process address:(z_gar(k),0,ia);
3 17809 if i = 0 then
3 17810 begin
4 17811 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 17812 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17813 end
3 17814 else
3 17815 begin
4 17816 terminal_tab.ref.terminal_tilstand:=
4 17817 if garage_auto_include(k) then 0 else 7 shift 21;
4 17818 if garage_auto_include(k) then
4 17819 monitor(8)reserve:(z_gar(k),0,ia);
4 17820 end;
3 17821 cs_garage(k):= next_semch;
3 17822 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 17823 <*-3*>
3 17824 i:= next_coru(300+k,<*ident*>
3 17825 10,<*prioritet*>
3 17826 true <*testmaske*>);
3 17827 j:= new_activity( i,
3 17828 0,
3 17829 garage,k);
3 17830
3 17830 <*+3*>skriv_newactivity(out,i,j);
3 17831 <*-3*>
3 17832
3 17832 end;
2 17833 \f
2 17833 message radio_initialisering side 1 - 820301/hko;
2 17834
2 17834 cs_rad:= next_semch;
2 17835 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 17836 <*-3*>
2 17837
2 17837 i:= next_coru(400,<*ident*>
2 17838 10,<*prioritet*>
2 17839 true<*test_maske*>);
2 17840 j:= new_activity( i,
2 17841 0,
2 17842 h_radio);
2 17843 <*+3*>skriv_newactivity(out,i,j);
2 17844 <*-3*>
2 17845
2 17845 opkalds_kø_ledige:= max_antal_mobilopkald;
2 17846 nødopkald_brugt:= 0;
2 17847 læsfil(1034,1,i);
2 17848 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 17849
2 17849 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 17850 for i:= system(3,j,opkaldskø) step 1 until j do
2 17851 opkaldskø(i):= 0;
2 17852 første_frie_opkald:=opkaldskø_postlængde;
2 17853 første_opkald:=sidste_opkald:=
2 17854 første_nødopkald:=sidste_nødopkald:=j:=0;
2 17855
2 17855 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 17856 begin
3 17857 ref:=i*opkaldskø_postlængde;
3 17858 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 17859 end;
2 17860 ref:=ref+opkaldskø_postlængde;
2 17861 opkaldskø.ref(1):=j shift 12;
2 17862
2 17862 for ref:= 0 step 512 until (max_linienr//768*512) do
2 17863 begin
3 17864 i:= læs_fil(1035,ref//512+1,j);
3 17865 if i <> 0 then
3 17866 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 17867 tofrom(radio_linietabel.ref,fil(j),
3 17868 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 17869 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 17870 end;
2 17871
2 17871 for i:= system(3,j,kanal_tab) step 1 until j do
2 17872 kanal_tab(i):= 0;
2 17873 kanal_tilstand:= 2;
2 17874 kanal_id1:= 4;
2 17875 kanal_id2:= 6;
2 17876 kanal_spec:= 8;
2 17877 kanal_alt_id1:= 10;
2 17878 kanal_alt_id2:= 12;
2 17879 kanal_mon_maske:= 12;
2 17880 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 17881
2 17881 for i:= 1 step 1 until max_antal_kanaler do
2 17882 begin
3 17883 ref:= (i-1)*kanalbeskrlængde;
3 17884 sæthexciffer(kanal_tab.ref,3,15);
3 17885 if kanal_id(i) shift (-5) extract 3 = 2 or
3 17886 kanal_id(i) shift (-5) extract 3 = 3 and
3 17887 radio_id(kanal_id(i) extract 5)<=3
3 17888 then
3 17889 begin
4 17890 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 17891 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 17892 end;
3 17893 end;
2 17894 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 17895 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 17896 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 17897 optaget_flag:= 0;
2 17898 \f
2 17898 message radio_initialisering side 2 - 810524/hko;
2 17899
2 17899 bs_mobil_opkald:= next_sem;
2 17900
2 17900 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 17901 <*-3*>
2 17902
2 17902 bs_opkaldskø_adgang:= next_sem;
2 17903 signal_bin(bs_opkaldskø_adgang);
2 17904
2 17904 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 17905 <*-3*>
2 17906
2 17906 cs_radio_medd:=next_semch;
2 17907 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 17908
2 17908 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 17909 <*-3*>
2 17910
2 17910 i:= next_coru(403,
2 17911 5,<*prioritet*>
2 17912 true<*testmaske*>);
2 17913
2 17913 j:= new_activity( i,
2 17914 0,
2 17915 radio_medd_opkald);
2 17916
2 17916 <*+3*>skriv_newactivity(out,i,j);
2 17917 <*-3*>
2 17918
2 17918 cs_radio_adm:= nextsemch;
2 17919 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 17920 <*-3*>
2 17921
2 17921 i:= next_coru(404,
2 17922 10,
2 17923 true);
2 17924 j:= new_activity(i,
2 17925 0,
2 17926 radio_adm,next_op(data+radio_op_længde));
2 17927 <*+3*>skriv_new_activity(out,i,j);
2 17928 <*-3*>
2 17929 \f
2 17929 message radio_initialisering side 3 - 810526/hko;
2 17930 for k:= 1 step 1 until max_antal_taleveje do
2 17931 begin
3 17932
3 17932 cs_radio(k):=next_semch;
3 17933
3 17933 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 17934 <*-3*>
3 17935
3 17935 bs_talevej_udkoblet(k):= nextsem;
3 17936 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 17937 <*-3*>
3 17938
3 17938 i:=next_coru(410+k,
3 17939 10,
3 17940 true);
3 17941
3 17941 j:=new_activity( i,
3 17942 0,
3 17943 radio,k,next_op(data + radio_op_længde));
3 17944
3 17944 <*+3*>skriv_newactivity(out,i,j);
3 17945 <*-3*>
3 17946 end;
2 17947
2 17947 cs_radio_pulje:=next_semch;
2 17948
2 17948 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 17949 <*-3*>
2 17950
2 17950 for i:= 1 step 1 until radiopulje_størrelse do
2 17951 signal_ch(cs_radio_pulje,
2 17952 next_op(60),
2 17953 gen_optype or rad_optype);
2 17954
2 17954 cs_radio_kø:= next_semch;
2 17955
2 17955 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 17956 <*-3*>
2 17957
2 17957 mobil_opkald_aktiveret:= true;
2 17958 \f
2 17958 message radio_initialisering side 4 - 810522/hko;
2 17959
2 17959 laf:=raf:=0;
2 17960
2 17960 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 17961 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 17962 j:=1;
2 17963 if i <> 0 then
2 17964 fejlreaktion(4<*monitor resultat*>,i,
2 17965 string radio_fr_navn.raf(increase(j)),1);
2 17966 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 17967 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 17968 j:=1;
2 17969 if i <> 0 then
2 17970 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 17971 ia(1):= 3 <*canonical*>;
2 17972 ia(2):= 0 <*no echo*>;
2 17973 ia(3):= 0 <*prompt*>;
2 17974 ia(4):= 5 <*timeout*>;
2 17975 setcspterm(radio_fr_navn.laf,ia);
2 17976
2 17976 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 17977 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 17978 j:= 1;
2 17979 if i <> 0 then
2 17980 fejlreaktion(4<*monitor resultat*>,i,
2 17981 string radio_rf_navn.raf(increase(j)),1);
2 17982 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 17983 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 17984 j:= 1;
2 17985 if i <> 0 then
2 17986 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 17987 ia(1):= 3 <*canonical*>;
2 17988 ia(2):= 0 <*no echo*>;
2 17989 ia(3):= 0 <*prompt*>;
2 17990 ia(4):= 5 <*timeout*>;
2 17991 setcspterm(radio_rf_navn.laf,ia);
2 17992 \f
2 17992 message radio_initialisering side 5 - 810521/hko;
2 17993 for k:= 1 step 1 until max_antal_kanaler do
2 17994 begin
3 17995
3 17995 ss_radio_aktiver(k):=next_sem;
3 17996 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 17997 <*-3*>
3 17998
3 17998 ss_samtale_nedlagt(k):=next_sem;
3 17999 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 18000 <*-3*>
3 18001 end;
2 18002
2 18002 cs_radio_ind:= next_semch;
2 18003 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 18004 <*-3*>
2 18005
2 18005 i:= next_coru(401,<*ident radio_ind*>
2 18006 3, <*prioritet*>
2 18007 true <*testmaske*>);
2 18008 j:= new_activity( i,
2 18009 0,
2 18010 radio_ind,next_op(data + 64));
2 18011
2 18011 <*+3*>skriv_newactivity(out,i,j);
2 18012 <*-3*>
2 18013
2 18013 cs_radio_ud:=next_semch;
2 18014 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 18015 <*-3*>
2 18016
2 18016 i:= next_coru(402,<*ident radio_out*>
2 18017 10,<*prioritet*>
2 18018 true <*testmaske*>);
2 18019 j:= new_activity( i,
2 18020 0,
2 18021 radio_ud,next_op(data + 64));
2 18022
2 18022 <*+3*>skriv_newactivity(out,i,j);
2 18023 <*-3*>
2 18024 \f
2 18024 message vogntabel initialisering side 1 - 820301;
2 18025
2 18025 sidste_bus:= sidste_linie_løb:= 0;
2 18026
2 18026 tf_vogntabel:= 1 shift 10 + 2;
2 18027 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 18028 tf_gruppeidenter:= 1 shift 10 +6;
2 18029 tf_springdef:= 1 shift 10 +7;
2 18030 hent_fil_dim(ia);
2 18031 max_antal_i_gruppe:= ia(2);
2 18032 if ia(1) < max_antal_grupper then
2 18033 max_antal_grupper:= ia(1);
2 18034
2 18034 <* initialisering af interne vogntabeller *>
2 18035 begin
3 18036 long array field laf1,laf2;
3 18037 integer array fdim(1:8);
3 18038 zone z(128,1,stderror);
3 18039 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 18040 long omr,garageid;
3 18041 integer field ll, bn;
3 18042 boolean binær, test24;
3 18043
3 18043 ll:= 2; bn:= 4;
3 18044
3 18044 <* nulstil tabellerne *>
3 18045 laf1:= -2;
3 18046 laf2:= 2;
3 18047 bustabel1.laf2(0):=
3 18048 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 18049 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 18050 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 18051 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 18052 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 18053 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 18054 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 18055 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 18056 \f
3 18056 message vogntabel initialisering side 1a - 810505/cl;
3 18057
3 18057
3 18057 <* initialisering af intern busnummertabel *>
3 18058 open(z,4,<:busnumre:>,0);
3 18059 busnr:= -1;
3 18060 read(z,busnr);
3 18061 while busnr > 0 do
3 18062 begin
4 18063 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 18064 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 18065 sidste_bus:= sidste_bus+1;
4 18066 if sidste_bus > max_antal_busser then
4 18067 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 18068 repeatchar(z); readchar(z,tegn);
4 18069 garageid:= extend 0; binær:= false; omr:= extend 0;
4 18070 g_nr:= o_nr:= 0;
4 18071 if tegn='!' then
4 18072 begin
5 18073 binær:= true;
5 18074 readchar(z,tegn);
5 18075 end;
4 18076 if tegn='/' then <*garageid*>
4 18077 begin
5 18078 readchar(z,tegn); repeatchar(z);
5 18079 if '0'<=tegn and tegn<='9' then
5 18080 begin
6 18081 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 18082 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 18083 if g_nr<>0 and garageid=long<::> then
6 18084 begin
7 18085 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 18086 g_nr:= 0;
7 18087 end;
6 18088 end
5 18089 else
5 18090 begin
6 18091 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 18092 begin
7 18093 garageid:= garageid shift 8 + tegn;
7 18094 readchar(z,tegn);
7 18095 end;
6 18096 while garageid shift (-40) extract 8 = 0 do
6 18097 garageid:= garageid shift 8;
6 18098 g_nr:= find_bpl(garageid);
6 18099 if g_nr=0 then
6 18100 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 18101 end;
5 18102 repeatchar(z); readchar(z,tegn);
5 18103 end;
4 18104 if tegn=';' then
4 18105 begin
5 18106 readchar(z,tegn); repeatchar(z);
5 18107 if '0'<=tegn and tegn<='9' then
5 18108 begin
6 18109 read(z,o_nr);
6 18110 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 18111 if o_nr<>0 then omr:= område_navn(o_nr);
6 18112 if o_nr<>0 and omr=long<::> then
6 18113 begin
7 18114 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 18115 o_nr:= 0;
7 18116 end;
6 18117 end
5 18118 else
5 18119 begin
6 18120 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 18121 begin
7 18122 omr:= omr shift 8 + tegn;
7 18123 readchar(z,tegn);
7 18124 end;
6 18125 while omr shift (-40) extract 8 = 0 do
6 18126 omr:= omr shift 8;
6 18127 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 18128 i:= 1;
6 18129 while i<=max_antal_områder and o_nr=0 do
6 18130 begin
7 18131 if omr=område_navn(i) then o_nr:= i;
7 18132 i:= i+1;
7 18133 end;
6 18134 if o_nr=0 then
6 18135 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 18136 end;
5 18137 repeatchar(z); readchar(z,tegn);
5 18138 end;
4 18139 if o_nr=0 then o_nr:= 3;
4 18140 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 18141 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 18142
4 18142 busnr:= -1;
4 18143 read(z,busnr);
4 18144 end;
3 18145 close(z,true);
3 18146 \f
3 18146 message vogntabel initialisering side 2 - 820301/cl;
3 18147
3 18147 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 18148 test24:= testbit24;
3 18149 testbit24:= false;
3 18150 i:= 1;
3 18151 s:= læsfil(tf_vogntabel,i,zi);
3 18152 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 18153 while fil(zi).bn<>0 do
3 18154 begin
4 18155 if fil(zi).ll <> 0 then
4 18156 begin <* indsæt linie/løb *>
5 18157 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 18158 fil(zi).ll,j);
5 18159 if res < 0 then j:= j+1;
5 18160 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 18161 <:dobbeltregistrering i vogntabel:>,1)
5 18162 else
5 18163 begin
6 18164 o_nr:= fil(zi).bn shift (-14) extract 8;
6 18165 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 18166 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 18167 <:ukendt bus i vogntabel:>,1)
6 18168 else
6 18169 begin
7 18170 if sidste_linie_løb >= max_antal_linie_løb then
7 18171 fejlreaktion(10,fil(zi).bn extract 14,
7 18172 <:for mange linie/løb i vogntabel:>,0);
7 18173 for ll_nr:= sidste_linie_løb step (-1) until j do
7 18174 begin
8 18175 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18176 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18177 end;
7 18178 linie_løb_tabel(j):= fil(zi).ll;
7 18179 bus_indeks(j):= false add b_nr;
7 18180 sidste_linie_løb:= sidste_linie_løb + 1;
7 18181 end;
6 18182 end;
5 18183 end;
4 18184 i:= i+1;
4 18185 s:= læsfil(tf_vogntabel,i,zi);
4 18186 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18187 end;
3 18188 \f
3 18188 message vogntabel initialisering side 3 - 810428/cl;
3 18189
3 18189 <* initialisering af intern linie/løb-indekstabel *>
3 18190 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18191 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18192
3 18192 <* gem ny vogntabel i tabelfil *>
3 18193 for i:= 1 step 1 until sidste_bus do
3 18194 begin
4 18195 s:= skriv_fil(tf_vogntabel,i,zi);
4 18196 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18197 fil(zi).bn:= bustabel(i) extract 14 add
4 18198 (bustabel1(i) extract 8 shift 14);
4 18199 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18200 end;
3 18201 fdim(4):= tf_vogntabel;
3 18202 hent_fil_dim(fdim);
3 18203 pant:= fdim(3) * (256//fdim(2));
3 18204 for i:= sidste_bus+1 step 1 until pant do
3 18205 begin
4 18206 s:= skriv_fil(tf_vogntabel,i,zi);
4 18207 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18208 fil(zi).ll:= fil(zi).bn:= 0;
4 18209 end;
3 18210
3 18210 <* initialisering/nulstilling af gruppetabeller *>
3 18211 for i:= 1 step 1 until max_antal_grupper do
3 18212 begin
4 18213 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18214 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18215 gruppetabel(i):= fil(zi).ll;
4 18216 end;
3 18217 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18218 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18219 testbit24:= test24;
3 18220 end;
2 18221
2 18221
2 18221 <*+2*>
2 18222 <**> if testbit40 then p_vogntabel(out);
2 18223 <**> if testbit43 then p_gruppetabel(out);
2 18224 <*-2*>
2 18225
2 18225 message vogntabel initialisering side 3a -920517/cl;
2 18226
2 18226 <* initialisering for vt_log *>
2 18227
2 18227 v_tid:= 4;
2 18228 v_kode:= 6;
2 18229 v_bus:= 8;
2 18230 v_ll1:= 10;
2 18231 v_ll2:= 12;
2 18232 v_tekst:= 6;
2 18233 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18234 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18235 if vt_log_aktiv then
2 18236 begin
3 18237 integer i;
3 18238 real t;
3 18239 integer array field iaf;
3 18240 integer array
3 18241 tail(1:10),ia(1:10),chead(1:20);
3 18242
3 18242 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18243 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18244 if i=0 then
3 18245 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18246 if i=0 then
3 18247 begin
4 18248 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18249 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18250 end;
3 18251
3 18251 if i=0 then
3 18252 begin
4 18253 iaf:= 2;
4 18254 tofrom(vt_logdisc,tail.iaf,8);
4 18255 i:=slices(vt_logdisc,0,tail,chead);
4 18256 if i > (-2048) then
4 18257 begin
5 18258 vt_log_slicelgd:= chead(15);
5 18259 i:= 0;
5 18260 end;
4 18261 end;
3 18262
3 18262 if i=0 then
3 18263 begin
4 18264 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18265 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18266 if i=0 then
4 18267 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18268 if i=0 then
4 18269 begin
5 18270 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18271 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18272 end;
4 18273
4 18273 if i<>0 then
4 18274 begin
5 18275 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18276 tail(1):= 1;
5 18277 iaf:= 2;
5 18278 tofrom(tail.iaf,vt_logdisc,8);
5 18279 tail(6):=systime(7,0,t);
5 18280 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18281 if i=0 then
5 18282 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18283 end;
4 18284 end;
3 18285
3 18285 if i<>0 then vt_log_aktiv:= false;
3 18286 end;
2 18287
2 18287
2 18287 \f
2 18287 message vogntabel initialisering side 4 - 810520/cl;
2 18288
2 18288 cs_vt:= nextsemch;
2 18289 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18290 <*-3*>
2 18291
2 18291 cs_vt_adgang:= nextsemch;
2 18292 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18293 <*-3*>
2 18294
2 18294 cs_vt_opd:= nextsemch;
2 18295 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18296 <*-3*>
2 18297
2 18297 cs_vt_rap:= nextsemch;
2 18298 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18299 <*-3*>
2 18300
2 18300 cs_vt_tilst:= nextsemch;
2 18301 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18302 <*-3*>
2 18303
2 18303 cs_vt_auto:= nextsemch;
2 18304 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18305 <*-3*>
2 18306
2 18306 cs_vt_grp:= nextsemch;
2 18307 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18308 <*-3*>
2 18309
2 18309 cs_vt_spring:= nextsemch;
2 18310 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18311 <*-3*>
2 18312
2 18312 cs_vt_log:= nextsemch;
2 18313 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18314 <*-3*>
2 18315
2 18315 cs_vt_logpool:= nextsemch;
2 18316 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18317 <*-3*>
2 18318
2 18318 vt_op:= nextop(vt_op_længde);
2 18319 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18320
2 18320 vt_logop(1):= nextop(vt_op_længde);
2 18321 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18322 vt_logop(2):= nextop(vt_op_længde);
2 18323 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18324
2 18324 \f
2 18324 message vogntabel initialisering side 5 - 81-520/cl;
2 18325
2 18325 i:= nextcoru(500, <*ident*>
2 18326 10, <*prioitet*>
2 18327 true <*testmaske*>);
2 18328 j:= new_activity( i,
2 18329 0,
2 18330 h_vogntabel);
2 18331 <*+3*> skriv_newactivity(out,i,j);
2 18332 <*-3*>
2 18333
2 18333 i:= nextcoru(501, <*ident*>
2 18334 10, <*prioritet*>
2 18335 true <*testmaske*>);
2 18336 iaf:= nextop(filop_længde);
2 18337 j:= new_activity(i,
2 18338 0,
2 18339 vt_opdater,iaf);
2 18340 <*+3*> skriv_newactivity(out,i,j);
2 18341 <*-3*>
2 18342
2 18342 i:= nextcoru(502, <*ident*>
2 18343 10, <*prioritet*>
2 18344 true <*testmaske*>);
2 18345 k:= nextsemch;
2 18346 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18347 <*-3*>
2 18348 iaf:= nextop(fil_op_længde);
2 18349 j:= newactivity(i,
2 18350 0,
2 18351 vt_tilstand,
2 18352 k,
2 18353 iaf);
2 18354 <*+3*> skriv_newactivity(out,i,j);
2 18355 <*-3*>
2 18356 \f
2 18356 message vogntabel initialisering side 6 - 810520/cl;
2 18357
2 18357 i:= nextcoru(503, <*ident*>
2 18358 10, <*prioritet*>
2 18359 true <*testmaske*>);
2 18360 k:= nextsemch;
2 18361 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18362 <*-3*>
2 18363 iaf:= nextop(fil_op_længde);
2 18364 j:= newactivity(i,
2 18365 0,
2 18366 vt_rapport,
2 18367 k,
2 18368 iaf);
2 18369 <*+3*> skriv_newactivity(out,i,j);
2 18370 <*-3*>
2 18371
2 18371 i:= nextcoru(504, <*ident*>
2 18372 10, <*prioritet*>
2 18373 true <*testmaske*>);
2 18374 k:= nextsemch;
2 18375 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18376 <*-3*>
2 18377 iaf:= nextop(fil_op_længde);
2 18378 j:= new_activity(i,
2 18379 0,
2 18380 vt_gruppe,
2 18381 k,
2 18382 iaf);
2 18383 <*+3*> skriv_newactivity(out,i,j);
2 18384 <*-3*>
2 18385 \f
2 18385 message vogntabel initialisering side 7 - 810520/cl;
2 18386
2 18386 i:= nextcoru(505, <*ident*>
2 18387 10, <*prioritet*>
2 18388 true <*testmaske*>);
2 18389 k:= nextsemch;
2 18390 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18391 <*-3*>
2 18392 iaf:= nextop(fil_op_længde);
2 18393 j:= newactivity(i,
2 18394 0,
2 18395 vt_spring,
2 18396 k,
2 18397 iaf);
2 18398 <*+3*> skriv_newactivity(out,i,j);
2 18399 <*-3*>
2 18400
2 18400 i:= nextcoru(506, <*ident*>
2 18401 10,
2 18402 true <*testmaske*>);
2 18403 k:= nextsemch;
2 18404 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18405 <*-3*>
2 18406 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18407 j:= newactivity(i,
2 18408 0,
2 18409 vt_auto,
2 18410 k,
2 18411 iaf);
2 18412 <*+3*> skriv_newactivity(out,i,j);
2 18413 <*-3*>
2 18414
2 18414 i:=nextcoru(507, <*ident*>
2 18415 10, <*prioritet*>
2 18416 true <*testmaske*>);
2 18417 j:=newactivity(i,
2 18418 0,
2 18419 vt_log);
2 18420 <*+3*> skriv_newactivity(out,i,j);
2 18421 <*-3*>
2 18422
2 18422 <*+2*>
2 18423 <**> if testbit42 then skriv_vt_variable(out);
2 18424 <*-2*>
2 18425 \f
2 18425 message sysslut initialisering side 1 - 810406/cl;
2 18426 begin
3 18427 zone z(128,1,stderror);
3 18428 integer i,coruid,j,k;
3 18429 integer array field cor;
3 18430
3 18430 open(z,4,<:overvågede:>,0);
3 18431 for i:= read(z,coruid) while i > 0 do
3 18432 begin
4 18433 if coruid = 0 then
4 18434 begin
5 18435 for coruid:= 1 step 1 until maxcoru do
5 18436 begin
6 18437 cor:= coroutine(coruid);
6 18438 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18439 end
5 18440 end
4 18441 else
4 18442 begin
5 18443 cor:= coroutine(coru_no(abs coruid));
5 18444 if cor > 0 then
5 18445 begin
6 18446 d.cor.corutestmask:=
6 18447 (d.cor.corutestmask shift 1 shift (-1)) add
6 18448 ((coruid > 0) extract 1 shift 11);
6 18449 end;
5 18450 end;
4 18451 end;
3 18452 close(z,true);
3 18453
3 18453 læsfil(tf_systællere,1,k);
3 18454 rf:=iaf:= 4;
3 18455 systællere_nulstillet:= fil(k).rf;
3 18456 nulstil_systællere:= fil(k).iaf(1);
3 18457 if systællere_nulstillet=real<::> then
3 18458 begin
4 18459 systællere_nulstillet:= 0.0;
4 18460 nulstil_systællere:= -1;
4 18461 end;
3 18462 iaf:= 16;
3 18463 tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*16);
3 18464 iaf:= 256;
3 18465 tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*8);
3 18466
3 18466 end;
2 18467 \f
2 18467 message sysslut initialisering side 2 - 810603/cl;
2 18468
2 18468
2 18468 if låsning > 0 then
2 18469 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18470
2 18470 if låsning > 1 then
2 18471 <* låsning 2 : *> lock(readchar,1,write,2);
2 18472
2 18472 if låsning > 2 then
2 18473 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18474
2 18474
2 18474
2 18474
2 18474 if låsning > 0 then
2 18475 begin
3 18476 i:= locked(ia);
3 18477 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18478 end;
2 18479 \f
2 18479 message sysslut initialisering side 3 - 810406/cl;
2 18480
2 18480 write(z_io,"nl",2,<:initialisering slut:>);
2 18481 system(2)free core:(i,ra);
2 18482 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18483 setposition(z_io,0,0);
2 18484 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18485 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18486 "nl",1);
2 18487 errorbits:= 3; <* ok.no warning.yes *>
2 18488 \f
2 18488
2 18488 algol list.off;
2 18489 message coroutinemonitor - 40 ;
2 18490
2 18490 if simref <> firstsem then initerror(1, false);
2 18491 if semref <> firstop - 4 then initerror(2, false);
2 18492 if coruref <> firstsim then initerror(3, false);
2 18493 if opref <> optop + 6 then initerror(4, false);
2 18494 if proccount <> maxprocext -1 then initerror(5, false);
2 18495 goto takeexternal;
2 18496
2 18496 dump:
2 18497 op:= op;
2 18498 \f
2 18498 message sys trapaktion side 1 - 810521/hko/cl;
2 18499 trap(finale);
2 18500 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18501 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18502 begin
3 18503 k:= 0;
3 18504 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18505 <:timerqueue->:>));
3 18506 iaf:= i;
3 18507 for iaf:= d.iaf.next while iaf<>i do
3 18508 begin
4 18509 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18510 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18511 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18512 end;
3 18513 end;
2 18514 outchar(zbillede,'nl');
2 18515
2 18515 skriv_opkaldstællere(zbillede);
2 18516
2 18516
2 18516 pfilsystem(zbillede);
2 18517
2 18517 \f
2 18517 message operatør trapaktion1 side 1 - 810521/hko;
2 18518 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18519
2 18519 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18520 for i:= 1 step 1 until max_antal_operatører do
2 18521 begin
3 18522 laf:= (i-1)*8;
3 18523 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18524 case operatør_auto_include(i) extract 2 + 1 of (
3 18525 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18526 terminal_navn.laf,"nl",1);
3 18527 end;
2 18528 write(zbillede,"nl",1);
2 18529
2 18529 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18530 <:betjeningspladsgrupper::>,"nl",1);
2 18531 for i:= 1 step 1 until 127 do
2 18532 if bpl_navn(i)<>long<::> then
2 18533 begin
3 18534 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18535 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18536 write(zbillede,"sp",16-k,<:= :>);
3 18537 iaf:= i*op_maske_lgd; j:=0;
3 18538 for k:= 1 step 1 until max_antal_operatører do
3 18539 begin
4 18540 if læsbit_ia(bpl_def.iaf,k) then
4 18541 begin
5 18542 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18543 write(zbillede,true,6,string bpl_navn(k));
5 18544 j:= j+1;
5 18545 end;
4 18546 end;
3 18547 write(zbillede,"nl",1);
3 18548 end;
2 18549
2 18549 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18550 for i:= 1 step 1 until max_antal_operatører do
2 18551 begin
3 18552 write(zbillede,<<dd >,i);
3 18553 for j:= 0 step 1 until 3 do
3 18554 begin
4 18555 k:= operatør_stop(i,j);
4 18556 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18557 else string bpl_navn(k));
4 18558 end;
3 18559 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18560 end;
2 18561
2 18561 skriv_terminal_tab(zbillede);
2 18562 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18563 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18564 skriv_opk_alarm_tab(zbillede);
2 18565 skriv_talevejs_tab(zbillede);
2 18566 skriv_op_spool_buf(zbillede);
2 18567 skriv_cqf_tabel(zbillede,true);
2 18568 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18569
2 18569 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18570 for i:= 1 step 1 until max_antal_garageterminaler do
2 18571 begin
3 18572 laf:= (i-1)*8;
3 18573 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18574 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18575 end;
2 18576 \f
2 18576 message radio trapaktion side 1 - 820301/hko;
2 18577 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18578 skriv_kanal_tab(zbillede);
2 18579 skriv_opkaldskø(zbillede);
2 18580 skriv_radio_linietabel(zbillede);
2 18581 skriv_radio_områdetabel(zbillede);
2 18582
2 18582 \f
2 18582 message vogntabel trapaktion side 1 - 810520/cl;
2 18583 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18584 skriv_vt_variable(zbillede);
2 18585 p_vogntabel(zbillede);
2 18586 p_gruppetabel(zbillede);
2 18587 p_springtabel(zbillede);
2 18588 \f
2 18588 message sysslut trapaktion side 1 - 810519/cl;
2 18589 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18590 corutable(zbillede);
2 18591 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18592 <: ref værdi prev next:>,"nl",1);
2 18593 iaf:= firstsim;
2 18594 repeat
2 18595 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18596 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18597 iaf:= iaf + simsize;
2 18598 until iaf>=simref;
2 18599 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18600 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18601 iaf:= firstsem;
2 18602 repeat
2 18603 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18604 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18605 iaf:= iaf+semsize;
2 18606 until iaf>=semref;
2 18607 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18608 iaf:= firstop;
2 18609 repeat
2 18610 skriv_op(zbillede,iaf);
2 18611 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18612 until iaf>=optop;
2 18613 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18614 <: messref messcode messop:>,"nl",1);
2 18615 for i:= 1 step 1 until maxmessext do
2 18616 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18617 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18618 <: procref proccode procop:>,"nl",1);
2 18619 for i:= 1 step 1 until maxprocext do
2 18620 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18621
2 18621
2 18621 \f
2 18621 message sys_finale side 1 - 810428/hko;
2 18622
2 18622 finale:
2 18623 trap(slut_finale);
2 18624 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18625 endaction:=0;
2 18626 \f
2 18626 message filsystem finale side 1 - 810428/cl;
2 18627
2 18627 <* lukning af zoner *>
2 18628 write(out,<:lukker filsystem:>); ud;
2 18629 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18630 close(fil(i),true);
2 18631 \f
2 18631 message operatør_finale side 1 - 810428/hko;
2 18632
2 18632 goto op_trap2_slut;
2 18633
2 18633 write(out,<:lukker operatører:>); ud;
2 18634 for k:= 1 step 1 until max_antal_operatører do
2 18635 begin
3 18636 close(z_op(k),true);
3 18637 end;
2 18638 op_trap2_slut:
2 18639 k:=k;
2 18640
2 18640 \f
2 18640 message garage_finale side 1 - 810428/hko;
2 18641
2 18641 write(out,<:lukker garager:>); ud;
2 18642 for k:= 1 step 1 until max_antal_garageterminaler do
2 18643 begin
3 18644 close(z_gar(k),true);
3 18645 end;
2 18646 \f
2 18646 message radio_finale side 1 - 810525/hko;
2 18647 write(out,<:lukker radio:>); ud;
2 18648 close(z_fr_in,true);
2 18649 close(z_fr_out,true);
2 18650 close(z_rf_in,true);
2 18651 close(z_rf_out,true);
2 18652 \f
2 18652 message sysslut finale side 1 - 810530/cl;
2 18653
2 18653 slut_finale:
2 18654
2 18654 trap(exit_finale);
2 18655
2 18655 outchar(zrl,'em');
2 18656 close(zrl,true);
2 18657
2 18657 write(zbillede,
2 18658 "nl",2,<:blocksread=:>,blocksread,
2 18659 "nl",1,<:blocksout= :>,blocksout,
2 18660 "nl",1,<:fillæst= :>,fillæst,
2 18661 "nl",1,<:filskrevet=:>,filskrevet,
2 18662 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18663 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18664 close(zbillede,true);
2 18665 monitor(42,zbillede,0,ia);
2 18666 ia(6):= systime(7,0,0.0);
2 18667 monitor(44,zbillede,0,ia);
2 18668 setposition(z_io,0,0);
2 18669 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18670 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18671 close(z_io,true);
2 18672 exit_finale: trapmode:= 1 shift 10;
2 18673
2 18673 end;
1 18674
1 18674
1 18674 algol list.on;
1 18675 message programslut;
1 18676 program_slut:
1 18677 end
\f
1. 6162842 13281213 601 0 0
2. 11787693 2650874 345 0 0
3. 14985977 10765565 412 365 0
4. 1925184 4262291 422 1636 742
5. 3144304 2927057 574 29537 601
6. 16353703 10095601 575 0 0
7. 11904308 394012 623 0 0
8. 18667 18661 18648 18630 18617 18609 18599 18591 18580 18569
18562 18549 18535 18526 18518 18504 18492 18483 18473 18459
18431 18406 18388 18364 18344 18323 18310 18295 18279 18264
18243 18217 18203 18186 18166 18157 18135 18110 18085 18067
18054 18050 18022 18007 17991 17980 17967 17952 17936 17923
17907 17891 17869 17851 17835 17817 17800 17777 17758 17739
17727 17713 17693 17679 17660 17647 17628 17617 17604 17594
17577 17564 17553 17535 17522 17509 17491 17476 17457 17433
17416 17403 17387 17375 17360 17345 17333 17306 17293 17280
17271 17262 17256 17241 17222 17197 17186 17181 17175 17146
17085 17054 17043 17017 16991 16962 16934 16901 16880 16845
16780 16730 16690 16648 16613 16582 16551 16497 16460 16420
16377 16337 16301 16272 16256 16233 16202 16185 16167 16150
16138 16126 16105 16085 16073 16054 16028 16013 15991 15979
15970 15955 15939 15928 15916 15900 15884 15868 15859 15841
15825 15807 15780 15769 15759 15739 15719 15711 15703 15695
15670 15656 15642 15622 15613 15602 15591 15572 15557 15550
15538 15508 15491 15474 15455 15432 15414 15397 15371 15348
15332 15315 15300 15276 15251 15231 15210 15189 15173 15159
15152 15145 15122 15112 15104 15081 15059 15045 15022 15007
14990 14967 14947 14934 14918 14893 14867 14852 14844 14820
14806 14784 14762 14733 14710 14697 14676 14658 14649 14623
14606 14590 14572 14547 14529 14514 14485 14468 14441 14422
14406 14370 14338 14304 14280 14262 14250 14240 14220 14211
14203 14179 14162 14134 14114 14097 14079 14062 14055 14042
14015 13996 13975 13949 13934 13899 13866 13848 13832 13819
13789 13770 13745 13726 13707 13686 13663 13640 13613 13598
13572 13540 13515 13488 13481 13467 13442 13433 13418 13407
13390 13382 13374 13368 13360 13344 13316 13304 13284 13268
13253 13231 13212 13184 13161 13145 13127 13109 13091 13081
13071 13048 13042 13024 13005 12990 12971 12949 12934 12895
12883 12867 12844 12827 12815 12794 12769 12760 12752 12727
12710 12701 12682 12670 12651 12642 12631 12622 12602 12583
12572 12558 12539 12512 12492 12471 12456 12442 12435 12423
12406 12375 12350 12341 12322 12305 12276 12252 12243 12226
12214 12195 12178 12162 12139 12128 12110 12094 12079 12061
12038 12031 12009 11985 11968 11943 11917 11874 11862 11852
11824 11790 11759 11732 11690 11663 11644 11631 11623 11615
11605 11575 11556 11538 11523 11500 11480 11458 11434 11406
11383 11365 11341 11324 11309 11286 11271 11252 11233 11209
11174 11148 11130 11111 11090 11062 11045 11023 11009 10986
10958 10945 10932 10903 10865 10834 10791 10757 10726 10719
10711 10703 10692 10663 10640 10625 10615 10595 10577 10564
10555 10543 10534 10519 10511 10499 10470 10448 10430 10376
10341 10307 10274 10215 10199 10182 10163 10150 10137 10116
10104 10086 10073 10060 10033 10014 9997 9960 9944 9925
9917 9907 9876 9857 9840 9829 9799 9776 9751 9738
9729 9715 9691 9684 9674 9657 9638 9624 9605 9593
9577 9566 9555 9530 9513 9491 9473 9455 9435 9422
9402 9391 9365 9346 9327 9313 9303 9275 9257 9249
9225 9213 9201 9177 9159 9143 9132 9104 9087 9083
9066 9057 9050 9039 9025 9009 8992 8980 8968 8949
8939 8931 8904 8888 8881 8868 8854 8837 8829 8813
8804 8785 8748 8739 8714 8702 8688 8664 8644 8624
8602 8562 8544 8529 8517 8499 8490 8483 8471 8456
8445 8434 8420 8411 8390 8385 8374 8363 8347 8339
8329 8308 8296 8284 8264 8255 8241 8231 8217 8196
8181 8164 8154 8138 8125 8118 8101 8079 8060 8039
8025 8008 7990 7974 7957 7946 7932 7917 7871 7852
7815 7792 7769 7755 7733 7719 7689 7675 7654 7634
7604 7588 7576 7558 7545 7528 7510 7499 7484 7468
7456 7438 7408 7387 7366 7343 7320 7303 7287 7264
7247 7229 7192 7169 7162 7137 7125 7102 7088 7079
7060 7048 7031 7019 6998 6986 6968 6950 6928 6906
6898 6890 6883 6857 6830 6812 6792 6774 6758 6746
6726 6717 6700 6683 6672 6661 6650 6640 6635 6623
6613 6594 6581 6554 6543 6527 6519 6501 6485 6474
6438 6422 6408 6376 6356 6348 6333 6324 6300 6286
6275 6263 6251 6233 6213 6200 6175 6163 6136 6108
6093 6066 6040 6025 6013 6000 5981 5964 5952 5930
5918 5909 5896 5883 5860 5831 5814 5799 5775 5749
5736 5727 5715 5703 5691 5676 5663 5645 5622 5599
5575 5556 5544 5529 5509 5490 5470 5455 5440 5418
5404 5391 5374 5366 5355 5336 5324 5316 5297 5280
5270 5258 5241 5227 5209 5195 5184 5161 5141 5123
5109 5093 5079 5058 5041 5011 4998 4981 4964 4947
4930 4909 4885 4862 4853 4829 4820 4799 4782 4763
4747 4721 4701 4681 4641 4622 4610 4602 4595 4566
4545 4530 4508 4498 4463 4439 4399 4380 4356 4337
4325 4301 4293 4271 4249 4234 4213 4192 4172 4154
4137 4102 4077 4039 4009 3975 3940 3899 3855 3808
3769 3736 3695 3628 3575 3531 3490 3463 3433 3382
3336 3289 3264 3248 3235 3218 3189 3170 3154 3134
3097 3074 3043 3008 2971 2941 2914 2883 2861 2826
2802 2769 2637 2616 2582 2556 2524 2475 2446 2432
2416 2396 2379 2359 2350 2328 2313 2283 2267 2246
2230 2209 2196 2167 2135 2119 2096 2078 2069 2045
2023 2014 1992 1979 1958 1937 1913 1890 1881 1872
1846 1821 1800 1792 1769 1757 1748 1737 1721 1707
1693 1683 1676 1649 1624 1601 1561 1533 1498 1471
1447 1416 1386 1371 1342 1315 1298 1265 1257 1242
1237 1228 1198 1190 1185 1165 1151 1145 1137 1118
1100 1073 1046 1020 989 954 920 895 885 867
835 828 819 806 784 766 733 697 660 630
590 463 349 328 311 284 269 215 201 187
173 41 1 1 1 1
11904308 394012 956 506071 31002
9. 16 374 16 4 960604 004210 buskom1
7 3 1995 306 algftnrts
0 1 0 2 *version
969 400 969 4 flushout
969 44 969 4 911004 101112 sendmessage
970 106 970 12 910308 134214 copyout
971 244 971 12 890821 163833 getzone6
0 410 0 0 out
972 178 972 12 940411 220029 testbit
975 414 975 18 940411 222629 findfpparam
978 46 978 18 890821 163814 system
981 238 981 18 movestring
981 56 981 18 890821 163907 outdate
982 124 982 18 isotable
983 176 982 18 890821 163656 write
988 310 988 152 intable
989 34 988 152 890821 163503 read
993 24 993 340 890821 163714 tofrom
980 420 978 18 stderror
995 80 995 340 890821 163740 open
999 112 999 340 890821 163754 monitor
996 344 995 340 close
997 22 995 340 setposition
980 378 978 18 increase
987 50 982 18 outchar
982 26 982 18 replacechar
1002 98 1002 340 951214 094619 systime
0 1700 0 0 trapmode
1003 302 1003 340 trap
1003 112 1003 340 890821 163915 initzones
1004 268 1004 340 940411 222959 læsbitia
1005 22 1005 340 sign
1005 28 1005 340 890821 163648 ln
1006 432 1006 340 810409 111908 skrivhele
971 320 971 12 setzone6
1014 52 1014 340 inrec6
1014 28 1014 340 890821 163732 changerec6
1015 228 1015 340 940411 222949 sætbitia
989 36 988 152 readchar
1016 348 1016 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1017 278 1017 340 940411 222636 skrivtegn
1018 384 1018 340 940411 222639 afsluttext
1019 394 1019 340 940411 222952 læsbiti
1020 498 1020 340 940411 222816 systid
1022 28 1022 340 getnumber
1022 18 1022 340 900925 171358 putnumber
1 656 0 0 errorbits
1029 60 1029 342 940411 222943 sætbiti
1030 354 1030 342 940411 222801 openbs
1032 228 1032 342 940411 222742 hægttekst
1014 54 1014 340 outrec6
0 1704 0 0 alarmcause
1033 332 1033 342 940411 222745 hægtstring
1034 254 1034 342 940411 222749 anbringtal
988 288 988 152 repeatchar
1035 444 1035 342 940411 223002 intg
1036 350 1036 342 940411 222739 binærsøg
1005 20 1005 340 sgn
1037 380 1037 342 940411 222646 skrivtext
1014 56 1014 340 swoprec6
1041 56 1038 342 passivate
1038 40 1038 342 890821 163947 activity
1043 78 1043 350 260479 150000 mon
1 1043 1043 350 monw2
1 1039 1043 350 monw0
1 1041 1043 350 monw1
1040 56 1038 342 activate
0 1588 0 0 endaction
1043 320 1043 350 reflectcore
1039 50 1038 342 newactivity
1044 372 1044 358 940327 154135 setcspterm
1046 428 1046 358 941030 233200 slices
1050 52 1050 358 890821 163933 lock
1050 258 1050 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1051 162 1051 358 940411 222622 fpparam
1 1049 1052 358 nl
1 1047 1052 358 220978 131500 bel
1053 330 1053 446 940411 222722 ud
1054 252 1054 446 940411 222656 taltekst
1 1045 1043 350 monw3
971 296 971 12 getshare6
971 398 971 12 setshare6
70 476 1057 446 0
algol end 1057
*if ok.no
*if warning.yes
*o c
▶EOF◀