|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 992256 (0xf2400)
Types: TextFile
Names: »buskomudx04 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »buskomudx04 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.1424949.0155
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; <* hvis > 32 skal tf_systællere udvides *>
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; <* hvis > 16 skal tf_systællere udvides *>
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 <* io tællernulstilling *>
1 410 ;
1 411
1 411 max_semch:= max_semch
1 412 + 1 <* cs_io *>
1 413 + 1 <* cs_io_komm *>
1 414 + 1 <* cs_io_fil *>
1 415 + 1 <* cs_io_medd *>
1 416 + 1 <* cs_io_spool *>
1 417 + 1 <* cs_io_nulstil *>
1 418 ;
1 419
1 419 max_sem:= max_sem
1 420 + 1 <* ss_io_spool_fulde *>
1 421 + 1 <* ss_io_spool_tomme *>
1 422 + 1; <* bs_zio_adgang *>
1 423
1 423 max_op:=max_op
1 424 + 1; <* fil-operation *>
1 425
1 425 max_nettoop:=max_nettoop
1 426 + (data+18); <* fil-operation *>
1 427
1 427 \f
1 427 message operatør_claiming side 1 - 810520/hko;
1 428
1 428 max_coru:= max_coru +1 <* h_op *>
1 429 +1 <* alarmur *>
1 430 +1 <* opkaldsalarmer *>
1 431 +1 <* talevejsswitch *>
1 432 +1 <* tv_switch_adm *>
1 433 +1 <* tv_switch_input *>
1 434 +1 <* op_spool *>
1 435 +1 <* op_medd *>
1 436 +1 <* op_cqftest *>
1 437 +max_antal_operatører;
1 438
1 438 max_sem:= 1 <* bs_opk_alarm *>
1 439 +1 <* ss_op_spool_tomme *>
1 440 +1 <* ss_op_spool_fulde *>
1 441 +max_sem;
1 442
1 442 max_semch:= max_semch +1 <* cs_op *>
1 443 +1 <* cs_op_retur *>
1 444 +1 <* cs_opk_alarm_ur *>
1 445 +1 <* cs_opk_alarm_ur_ret *>
1 446 +1 <* cs_opk_alarm *>
1 447 +1 <* cs_talevejsswitch *>
1 448 +1 <* cs_tv_switch_adm *>
1 449 +1 <* cs_tvswitch_adgang *>
1 450 +1 <* cs_tvswitch_input *>
1 451 +1 <* cs_op_iomedd *>
1 452 +1 <* cs_op_spool *>
1 453 +1 <* cs_op_medd *>
1 454 +1 <* cs_cqf *>
1 455 +max_antal_operatører<* cs_operatør *>
1 456 +max_antal_operatører<* cs_op_fil *>;
1 457
1 457 max_op:= max_op + 1 <* talevejsoperation *>
1 458 + 2 <* tv_switch_input *>
1 459 + 1 <* op_iomedd *>
1 460 + 1 <* opk_alarm_ur *>
1 461 + 1 <* op_spool_medd *>
1 462 + 1 <* op_cqftest *>
1 463 + max_antal_operatører;
1 464
1 464 max_netto_op:= filoplængde*max_antal_operatører
1 465 + data+128 <* talevejsoperation *>
1 466 + 2*(data+256) <* tv_switch_input *>
1 467 + 60 <* op_iomedd *>
1 468 + data <* opk_alarm_ur *>
1 469 + data+op_spool_postlgd <* op_spool_med *>
1 470 + 60 <* op_cqftest *>
1 471 + max_netto_op;
1 472
1 472 \f
1 472 message garage_claiming side 1 -810226/hko;
1 473
1 473 max_coru:= max_coru +1
1 474 +max_antal_garageterminaler;
1 475
1 475 max_semch:= max_semch +1
1 476 +max_antal_garageterminaler;
1 477
1 477 \f
1 477 message procedure radio_claiming side 1 - 810526/hko;
1 478
1 478 max_coru:= max_coru
1 479 +1 <* hovedmodul radio *>
1 480 +1 <* opkaldskø_meddelelse *>
1 481 +1 <* radio_adm *>
1 482 +max_antal_taleveje <* radio *>
1 483 +2; <* radio ind/-ud*>
1 484
1 484 max_semch:= max_semch
1 485 +1 <* cs_rad *>
1 486 +max_antal_taleveje <* cs_radio *>
1 487 +1 <* cs_radio_pulje *>
1 488 +1 <* cs_radio_kø *>
1 489 +1 <* cs_radio_medd *>
1 490 +1 <* cs_radio_adm *>
1 491 +2 ; <* cs_radio_ind/-ud *>
1 492
1 492 max_sem:=
1 493 +1 <* bs_mobil_opkald *>
1 494 +1 <* bs_opkaldskø_adgang *>
1 495 +max_antal_kanaler <* ss_radio_aktiver *>
1 496 +max_antal_kanaler <* ss_samtale_nedlagt *>
1 497 +max_antal_taleveje <* bs_talevej_udkoblet *>
1 498 +max_sem;
1 499
1 499 max_op:=
1 500 + radio_pulje_størrelse <* radio_pulje_operationer *>
1 501 + 1 <* radio_medd *>
1 502 + 1 <* radio_adm *>
1 503 + max_antal_taleveje <* operationer for radio *>
1 504 + 2 <* operationer for radio_ind/-ud *>
1 505 + max_op;
1 506
1 506 max_netto_op:=
1 507 + radio_pulje_størrelse * 60 <* radio_pulje_operationer *>
1 508 + data + 6 <* radio_medd *>
1 509 + max_antal_taleveje <* operationer for radio *>
1 510 * (data + radio_op_længde)
1 511 + data + radio_op_længde <* operation for radio_adm *>
1 512 + 2*(data + 64) <* operationer for radio_ind/-ud *>
1 513 + max_netto_op;
1 514 \f
1 514 message vogntabel_claiming side 1 - 810413/cl;
1 515
1 515 maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
1 516 + 1 <* coroutine vt_opdater *>
1 517 + 1 <* coroutine vt_tilstand *>
1 518 + 1 <* coroutine vt_rapport *>
1 519 + 1 <* coroutine vt_gruppe *>
1 520 + 1 <* coroutine vt_spring *>
1 521 + 1 <* coroutine vt_auto *>
1 522 + 1 <* coroutine vt_log *>
1 523 + maxcoru;
1 524
1 524 maxsemch:= 1 <* cs_vt *>
1 525 + 1 <* cs_vt_adgang *>
1 526 + 1 <* cs_vt_logpool *>
1 527 + 1 <* cs_vt_opd *>
1 528 + 1 <* cs_vt_rap *>
1 529 + 1 <* cs_vt_tilst *>
1 530 + 1 <* cs_vtt_auto *>
1 531 + 1 <* cs_vt_grp *>
1 532 + 1 <* cs_vt_spring *>
1 533 + 1 <* cs_vt_log *>
1 534 + 5 <* cs_vt_filretur(coru) *>
1 535 + maxsemch;
1 536
1 536 maxop:= 1 <* vt_op *>
1 537 + 2 <* vt_log_op *>
1 538 + 6 <* vt_fil_op + radop *>
1 539 + maxop;
1 540
1 540 maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
1 541 + 5*fil_op_længde
1 542 + (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
1 543 + maxnettoop;
1 544
1 544 \f
1 544
1 544 algol list.off;
1 545 message coroutinemonitor - 3 ;
1 546
1 546 begin
2 547
2 547 <* work variables - primarily used during initialization *>
2 548 integer array field simref, semref, coruref, opref;
2 549 integer proccount, corucount, messcount, cmi, cmj;
2 550 integer array zoneia(1:20);
2 551
2 551 <* field variables describing the format of basic entities *>
2 552 integer field
2 553 <* chain head *>
2 554 next, prev,
2 555 <* simple semaphore *>
2 556 simvalue, simcoru,
2 557 <* chained semaphore *>
2 558 semop, semcoru,
2 559 <* coroutine *>
2 560 coruop, corutimerchain, corutimer, corupriority, coruident,
2 561 <* operation head *>
2 562 opnext, opsize;
2 563
2 563 \f
2 563
2 563 message coroutinemonitor - 4 ;
2 564
2 564 boolean field
2 565 corutypeset, corutestmask, optype;
2 566 real starttime;
2 567 long corustate;
2 568
2 568 <* field variables used as queue identifiers (addresses) *>
2 569 integer array field current, readyqueue, idlequeue, timerqueue;
2 570
2 570 <* extensions (message- and process- extensions) *>
2 571 integer array messref, messcode, messop (1:maxmessext);
2 572 integer array procref, proccode, procop (1:maxprocext);
2 573
2 573 <* core array used for accessing the core using addresses as field
2 574 variables (as delivered by the monitor functions)
2 575 - descriptor array 'd' in which all basic entities are allocated
2 576 (except for extensions) *>
2 577 integer array core (1:1), d (1:(4 <* readyqueue *> +
2 578 4 <* idlequeue *> +
2 579 4 <* timerqueue *> +
2 580 maxcoru * corusize +
2 581 maxsem * simsize +
2 582 maxsemch * semsize +
2 583 maxop * opheadsize +
2 584 maxnettoop)/2);
2 585 \f
2 585
2 585 message coroutinemonitor - 5 ;
2 586
2 586
2 586
2 586 <*************** initialization procedures ***************>
2 587
2 587
2 587
2 587 procedure initchain (chainref);
2 588 value chainref;
2 589 integer array field chainref;
2 590 begin
3 591 integer array field cref;
3 592 cref:= chainref;
3 593 d.cref.next:= d.cref.prev:= cref;
3 594 end;
2 595 \f
2 595
2 595 message coroutinemonitor - 6 ;
2 596
2 596
2 596 <***** nextsem *****
2 597
2 597 this procedure allocates and initializes the next simple semaphore in the
2 598 pool of claimed semaphores.
2 599 the procedure returns the identification (the address) of the semaphore to
2 600 be used when calling 'signal', 'wait' and 'inspect'. *>
2 601
2 601 integer procedure nextsem;
2 602 begin
3 603 nextsem:= simref;
3 604 if simref >= firstsem then initerror(1, true);
3 605 initchain(simref + simcoru);
3 606 d.simref.simvalue:= 0;
3 607 simref:= simref + simsize;
3 608 end;
2 609
2 609
2 609 <***** nextsemch *****
2 610
2 610 this procedure allocates and initializes the next simple semaphore in the
2 611 pool of claimed semaphores.
2 612 the procedure returns the identification (the address) of the semaphore to
2 613 be used when calling 'signalch', 'waitch' and 'inspectch'. *>
2 614
2 614 integer procedure nextsemch;
2 615 begin
3 616 nextsemch:= semref;
3 617 if semref >= firstop-4 then initerror(2, true);
3 618 initchain(semref + semcoru);
3 619 initchain(semref + semop);
3 620 semref:= semref + semsize;
3 621 end;
2 622 \f
2 622
2 622 message coroutinemonitor - 7 ;
2 623
2 623
2 623 <***** nextcoru *****
2 624
2 624 this procedure initializes the next coroutine description in the pool of
2 625 claimed coroutine descriptions.
2 626 at initialization is defined the priority (an integer value), an identi-
2 627 fication (an integer value 0..8000) and a test pattern (a boolean). *>
2 628
2 628 integer procedure nextcoru(ident, priority, testmask);
2 629 value ident, priority, testmask;
2 630 integer ident, priority;
2 631 boolean testmask;
2 632 begin
3 633 corucount:= corucount + 1;
3 634 if corucount > maxcoru then initerror(3, true);
3 635 nextcoru:= corucount;
3 636 initchain(coruref + next);
3 637 initchain(coruref + corutimerchain);
3 638 initchain(coruref + coruop);
3 639 d.coruref.corupriority:= priority;
3 640 d.coruref.coruident:= ident * 1000 + corucount;
3 641 d.coruref.corutypeset:= false;
3 642 d.coruref.corutimer:= 0;
3 643 d.coruref.corutestmask:= testmask;
3 644 linkprio(coruref, readyqueue);
3 645 current:= coruref;
3 646 coruref:= coruref + corusize;
3 647 end;
2 648 \f
2 648
2 648 message coroutinemonitor - 8 ;
2 649
2 649
2 649 <***** nextop *****
2 650
2 650 this procedure initializes the next operation in the pool of claimed ope-
2 651 rations (heads and buffers).
2 652 the head is allocated and immediately following the head is allocated 'size'
2 653 halfwords forming the operation buffer.
2 654 the procedure returns an identification of the operation (an address) and
2 655 in case this address is held in a field variable 'op', the buffer area may
2 656 be accessed as: d.op(1), d.op(2), d.op(3) ... *>
2 657
2 657 integer procedure nextop (size);
2 658 value size;
2 659 integer size;
2 660 begin
3 661 nextop:= opref;
3 662 if opref >= optop then initerror(4, true);
3 663 initchain(opref + next);
3 664 d.opref.opsize:= size;
3 665 opref:= opref + size + opheadsize;
3 666 end;
2 667 \f
2 667
2 667 message coroutinemonitor - 9 ;
2 668
2 668
2 668 <***** nextprocext *****
2 669
2 669 this procedure initializes the next process extension in the series of
2 670 claimed process extensions.
2 671 the process description address is put into the process extension and the
2 672 state of the extension is initialized to be closed. *>
2 673
2 673 integer procedure nextprocext (processref);
2 674 value processref;
2 675 integer processref;
2 676 begin
3 677 proccount:= proccount + 1;
3 678 if proccount >= maxprocext then initerror(5, true);
3 679 nextprocext:= proccount;
3 680 procref(proccount):= processref;
3 681 proccode(proccount):= 1 shift 12;
3 682 end;
2 683 \f
2 683
2 683 message coroutinemonitor - 10 ;
2 684
2 684
2 684 <***** initerror *****
2 685
2 685 this procedure is activated in case the initialized set of resources does
2 686 not match the claimed set.
2 687 in case more resources are claimed than used, a warning is written,
2 688 in case too few resources are claimed, an error message is written and
2 689 the execution is terminated. *>
2 690
2 690 procedure initerror (resource, exceeded);
2 691 value resource, exceeded;
2 692 integer resource; boolean exceeded;
2 693 begin
3 694 write(out, false add 10, 1,
3 695 if exceeded then <:more :> else <:less :>,
3 696 case resource of (
3 697 <:simple semaphores:>,
3 698 <:chained semaphores:>,
3 699 <:coroutines:>,
3 700 <:operations:>,
3 701 <:process extensions:>),
3 702 <: initialized than claimed:>,
3 703 false add 10, 1);
3 704 if exceeded then goto dump;
3 705 end;
2 706
2 706
2 706 <***** stackclaim *****
2 707
2 707 this procedure is used by a coroutine from its first activation to it
2 708 arrives its first waiting point. the procedure is used to claim an addi-
2 709 tional amount of stack space. this must be done because the maximum
2 710 stack space for a coroutine is set to be the max amount used during its
2 711 very first activation. *>
2 712
2 712
2 712 procedure stackclaim (size);
2 713 value size; integer size;
2 714 begin
3 715 boolean array stackspace (1:size);
3 716 end;
2 717 algol list.on;
2 718
2 718 \f
2 718 message sys_erklæringer side 1 - 810406/cl,hko;
2 719
2 719 zone
2 720 zdummy(1,1,stderror),
2 721 zrl(128,1,stderror),
2 722 zbillede(128,1,stderror);
2 723
2 723 real array
2 724 fejltekst(1:max_antal_fejltekster);
2 725
2 725 real
2 726 systællere_nulstillet;
2 727
2 727 integer
2 728 nulstil_systællere,
2 729 top_bpl_gruppe;
2 730
2 730 integer array
2 731 ingen_operatører, alle_operatører(1:(op_maske_lgd//2)),
2 732 ingen_taleveje, alle_taleveje(1:(tv_maske_lgd//2)),
2 733 bpl_def(1:(128*(op_maske_lgd//2))),
2 734 bpl_tilst(0:127,1:2),
2 735 operatør_stop(0:max_antal_operatører,0:3),
2 736 område_id(1:max_antal_områder,1:2),
2 737 pabx_id(1:max_antal_pabx),
2 738 radio_id(1:max_antal_radiokanaler),
2 739 kanal_id(1:max_antal_kanaler),
2 740 opkalds_tællere(1:(max_antal_områder*5)), <* maxantal <= 16 *>
2 741 operatør_tællere(1:(max_antal_operatører*5)); <* maxantal <= 32 *>
2 742
2 742 boolean array
2 743 operatør_auto_include(1:max_antal_operatører),
2 744 garage_auto_include(1:max_antal_garageterminaler);
2 745
2 745 long array
2 746 terminal_navn(1:(2*max_antal_operatører)),
2 747 garage_terminal_navn(1:(2*max_antal_garageterminaler)),
2 748 bpl_navn(0:127),
2 749 område_navn(1:max_antal_områder),
2 750 kanal_navn(1:max_antal_kanaler);
2 751 \f
2 751 message procedure findområde side 1 - 880901/cl;
2 752
2 752 integer procedure find_bpl(navn);
2 753 value navn;
2 754 long navn;
2 755 begin
3 756 integer i;
3 757
3 757 find_bpl:= 0;
3 758 for i:= 0 step 1 until 127 do
3 759 if navn = bpl_navn(i) then find_bpl:= i;
3 760 end;
2 761
2 761 integer procedure findområde(omr);
2 762 value omr;
2 763 integer omr;
2 764 begin
3 765 integer i;
3 766
3 766 if omr = '*' shift 16 then findområde:= -1 else
3 767 begin
4 768 findområde:= 0;
4 769 for i:= 1 step 1 until max_antal_områder do
4 770 if (extend omr) shift 24=område_navn(i) then findområde:= i;
4 771 end;
3 772 end;
2 773 \f
2 773 message procedure tæl_opkald side 1 - 880926/cl;
2 774
2 774 procedure opdater_tf_systællere;
2 775 begin
3 776 integer zi;
3 777 integer array field iaf;
3 778 real field rf;
3 779
3 779 disable begin
4 780 skrivfil(tf_systællere,1,zi);
4 781 rf:= iaf:= 4;
4 782 fil(zi).rf:= systællere_nulstillet;
4 783 fil(zi).iaf(1):= nulstil_systællere;
4 784 iaf:= 32;
4 785 tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*10);
4 786 iaf:= 192;
4 787 tofrom(fil(zi).iaf,operatør_tællere,max_antal_operatører*10);
4 788 setposition(fil(zi),0,0);
4 789 end;
3 790 end;
2 791
2 791 procedure tæl_opkald(område,type);
2 792 value område,type;
2 793 integer område,type;
2 794 begin
3 795 increase(opkalds_tællere((område-1)*5+type));
3 796 disable opdater_tf_systællere;
3 797 end;
2 798
2 798 procedure tæl_opkald_pr_operatør(operatør,type);
2 799 value operatør,type;
2 800 integer operatør,type;
2 801 begin
3 802 increase(operatør_tællere((operatør-1)*5+type));
3 803 disable opdater_tf_systællere;
3 804 end;
2 805
2 805 procedure skriv_opkaldstællere(z);
2 806 zone z;
2 807 begin
3 808 integer omr,typ,rpc;
3 809 real r;
3 810
3 810 write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
3 811 <:omr ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 812 for omr:= 1 step 1 until max_antal_områder do
3 813 begin
4 814 write(z,true,6,string område_navn(omr),":",1);
4 815 for typ:= 1 step 1 until 5 do
4 816 write(z,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
4 817 outchar(z,'nl');
4 818 end;
3 819
3 819 write(z,"nl",1,
3 820 <:oper. ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 821 for omr:= 1 step 1 until max_antal_operatører do
3 822 begin
4 823 if bpl_navn(omr)=long<::> then
4 824 write(z,"sp",6-write(z,<:op:>,<<d>,omr),":",1)
4 825 else
4 826 write(z,true,6,string bpl_navn(omr),":",1);
4 827 for typ:= 1 step 1 until 5 do
4 828 write(z,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
4 829 outchar(z,'nl');
4 830 end;
3 831
3 831 rpc:= replace_char(1,':');
3 832 write(z,"nl",1,<:nulstilles :>);
3 833 if nulstil_systællere = (-1) then write(z,<:ikke automatisk:>,"nl",1)
3 834 else write(z,<:automatisk kl. :>,<<zd dd dd>,nulstil_systællere,"nl",1);
3 835 replace_char(1,'.');
3 836 write(z,<:nulstillet d. :>,<<zd dd dd>,
3 837 systime(4,systællere_nulstillet,r)," ",1);
3 838 replace_char(1,':');
3 839 write(z,<<zd dd dd>,r,"nl",1);
3 840 replace_char(1,rpc);
3 841 end;
2 842 \f
2 842 message procedure start_operation side 1 - 810521/hko;
2 843
2 843 procedure start_operation(op_ref,kor,ret_sem,kode);
2 844 value kor,ret_sem,kode;
2 845 integer array field op_ref;
2 846 integer kor,ret_sem,kode;
2 847 <*
2 848 op_ref: kald, reference til operation
2 849
2 849 kor: kald, kilde= hovedmodulnr*100 +løbenr
2 850 = korutineident.
2 851 ret_sem: kald, retursemafor
2 852
2 852 kode: kald, suppl shift 12 + operationskode
2 853
2 853 proceduren initialiserer en operations hoved med
2 854 parameterværdierne samt tidfeltet med aktueltid.
2 855 resultatfelt og datafelter nulstilles.
2 856
2 856 *>
2 857 begin
3 858 integer i;
3 859 d.op_ref.kilde:= kor;
3 860 systime(1,0,d.op_ref.tid);
3 861 d.op_ref.retur:=ret_sem;
3 862 d.op_ref.op_kode:=kode;
3 863 d.op_ref.resultat:=0;
3 864 for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
3 865 d.op_ref.data(i):=0;
3 866 end start_operation;
2 867 \f
2 867 message procedure afslut_operation side 1 - 810331/hko;
2 868
2 868 procedure afslut_operation(op_ref,sem);
2 869 value op_ref,sem;
2 870 integer op_ref,sem;
2 871 begin
3 872 integer array field op;
3 873 op:=op_ref;
3 874 if sem>0 then signal_ch(sem,op,d.op.optype) else
3 875 if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
3 876 ;
3 877 end afslut_operation;
2 878 \f
2 878 message procedure fejlreaktion - side 1 - 810424/cl,hko;
2 879
2 879 procedure fejlreaktion(nr,værdi,str,måde);
2 880 value nr,værdi,måde;
2 881 integer nr,værdi,måde;
2 882 string str;
2 883 begin
3 884 disable begin
4 885 write(out,<:<10>!!! :>);
4 886 if nr>0 and nr <=max_antal_fejltekster then
4 887 write(out,string fejltekst(nr))
4 888 else write(out,<:fejl nr.:>,nr);
4 889 outchar(out,'sp');
4 890 if måde shift (-12) extract 2=1 then
4 891 outintbits(out,værdi)
4 892 else
4 893 if måde shift (-12) extract 2=2 then
4 894 write(out,<:":>,false add værdi,1,<:":>)
4 895 else
4 896 write(out,værdi);
4 897 write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
4 898 <: korutine nr=:>,<<d>, abs curr_coruno,
4 899 <: ident=:>,curr_coruid,"nl",0);
4 900 if testbit27 and måde extract 12=1 then
4 901 trace(1);
4 902 ud;
4 903 end;<*disable*>
3 904 if måde extract 12 =2 then trapmode:=1 shift 13;
3 905 if måde extract 12= 0 then trap(-1)
3 906 else if måde extract 12 = 2 then trap(-2);
3 907 end fejlreaktion;
2 908
2 908 procedure trace(n);
2 909 value n;
2 910 integer n;
2 911 begin
3 912 trap(finis);
3 913 trap(n);
3 914 finis:
3 915 end trace;
2 916 \f
2 916 message procedure overvåget side 1 - 810413/cl;
2 917
2 917 boolean procedure overvåget;
2 918 begin
3 919 disable begin
4 920 integer i,måde;
4 921 integer array field cor;
4 922 integer array ia(1:12);
4 923
4 923 i:= system(12,0,ia);
4 924 if i > 0 then
4 925 begin
5 926 i:= system(12,1,ia);
5 927 måde:= ia(3);
5 928 end
4 929 else måde:= 0;
4 930
4 930 if måde<>0 then
4 931 begin
5 932 cor:= coroutine(abs ia(3));
5 933 overvåget:= d.cor.corutestmask shift (-11);
5 934 end
4 935 else overvåget:= cl_overvåget;
4 936 end;
3 937 end;
2 938 \f
2 938 message procedure antal_bits_ia side 1 - 940424/cl;
2 939
2 939 integer procedure antal_bits_ia(ia,n,ø);
2 940 value n,ø;
2 941 integer array ia;
2 942 integer n,ø;
2 943 begin
3 944 integer i, ant;
3 945
3 945 ant:= 0;
3 946 for i:= n step 1 until ø do
3 947 if læsbit_ia(ia,i) then ant:= ant+1;
3 948 end;
2 949
2 949 message procedure trunk_til_omr side 1 - 881006/cl;
2 950
2 950 integer procedure trunk_til_omr(trunk);
2 951 value trunk; integer trunk;
2 952 begin
3 953 integer i,j;
3 954
3 954 j:=0;
3 955 for i:= 1 step 1 until max_antal_områder do
3 956 if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
3 957 trunk_til_omr:=j;
3 958 end;
2 959
2 959 integer procedure omr_til_trunk(omr);
2 960 value omr; integer omr;
2 961 begin
3 962 omr_til_trunk:= område_id(omr,2) extract 12;
3 963 end;
2 964
2 964 integer procedure port_til_omr(port);
2 965 value port; integer port;
2 966 begin
3 967 if port shift (-6) extract 6 = 2 then
3 968 port_til_omr:= pabx_id(port extract 6)
3 969 else
3 970 if port shift (-6) extract 6 = 3 then
3 971 port_til_omr:= radio_id(port extract 6)
3 972 else
3 973 port_til_omr:= 0;
3 974 end;
2 975
2 975 integer procedure kanal_til_port(kanal);
2 976 value kanal; integer kanal;
2 977 begin
3 978 kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
3 979 kanal_id(kanal) extract 5;
3 980 end;
2 981
2 981 integer procedure port_til_kanal(port);
2 982 value port; integer port;
2 983 begin
3 984 integer i,j;
3 985
3 985 j:=0;
3 986 for i:= 1 step 1 until max_antal_kanaler do
3 987 if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
3 988 port_til_kanal:= j;
3 989 end;
2 990
2 990 integer procedure kanal_til_omr(kanal);
2 991 value kanal; integer kanal;
2 992 begin
3 993 kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
3 994 end;
2 995
2 995 \f
2 995 message procedure out_xxx_bits side 1 - 810406/cl;
2 996
2 996 procedure outboolbits(zud,b);
2 997 value b;
2 998 zone zud;
2 999 boolean b;
2 1000 begin
3 1001 integer i;
3 1002
3 1002 for i:= -11 step 1 until 0 do
3 1003 outchar(zud,if b shift i then '1' else '.');
3 1004 end;
2 1005
2 1005 procedure outintbits(zud,j);
2 1006 value j;
2 1007 zone zud;
2 1008 integer j;
2 1009 begin
3 1010 integer i;
3 1011
3 1011 for i:= -23 step 1 until 0 do
3 1012 begin
4 1013 outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
4 1014 if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
4 1015 end;
3 1016 end;
2 1017
2 1017 procedure outintbits_ia(zud,ia,n,ø);
2 1018 value n,ø;
2 1019 zone zud;
2 1020 integer array ia;
2 1021 integer n,ø;
2 1022 begin
3 1023 integer i;
3 1024
3 1024 for i:= n step 1 until ø do
3 1025 begin
4 1026 outintbits(zud,ia(i));
4 1027 outchar(zud,'nl');
4 1028 end;
3 1029 end;
2 1030
2 1030 real procedure now;
2 1031 begin
3 1032 real f,r,r1; long l;
3 1033
3 1033 systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
3 1034 systime(4,r,r1);
3 1035 now:= r1+f;
3 1036 end;
2 1037 \f
2 1037 message procedure skriv_id side 1 - 820301/cl;
2 1038
2 1038 procedure skriv_id(z,id,lgd);
2 1039 value id,lgd;
2 1040 integer id,lgd;
2 1041 zone z;
2 1042 begin
3 1043 integer type,p,li,lø,bo;
3 1044
3 1044 type:= id shift (-22);
3 1045 case type+1 of
3 1046 begin
4 1047 <* 1: bus *>
4 1048 begin
5 1049 p:= write(z,<<d>,id extract 14);
5 1050 if id shift (-14) <> 0 then
5 1051 p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
5 1052 end;
4 1053
4 1053 <* 2: linie/løb *>
4 1054 begin
5 1055 li:= id shift (-12) extract 10;
5 1056 bo:= id shift (-7) extract 5;
5 1057 if bo<>0 then bo:= bo + 'A' - 1;
5 1058 lø:= id extract 7;
5 1059 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
5 1060 end;
4 1061
4 1061 <* 3: gruppe *>
4 1062 begin
5 1063 if id shift (-21) = 4 <* linie-gruppe *> then
5 1064 begin
6 1065 li:= id shift (-5) extract 10;
6 1066 bo:= id extract 5;
6 1067 if bo<>0 then bo:= bo + 'A' - 1;
6 1068 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
6 1069 end
5 1070 else <* special-gruppe *>
5 1071 p:= write(z,"G",1,<<d>,id extract 7);
5 1072 end;
4 1073
4 1073 <* 4: telefon *>
4 1074 begin
5 1075 bo:= id shift (-20) extract 2;
5 1076 li:= id extract 20;
5 1077 case bo+1 of
5 1078 begin
6 1079 p:= write(z,string kanalnavn(li));
6 1080 p:= write(z,<:K*:>);
6 1081 p:= write(z,<:OMR :>,string områdenavn(li));
6 1082 p:= write(z,<:OMR*:>);
6 1083 end;
5 1084 end;
4 1085 end case;
3 1086 write(z,"sp",lgd-p);
3 1087 end skriv_id;
2 1088 <*+3*>
2 1089 \f
2 1089 message skriv_new_sem side 1 - 810520/cl;
2 1090
2 1090 procedure skriv_new_sem(z,type,ref,navn);
2 1091 value type,ref;
2 1092 zone z;
2 1093 integer type,ref;
2 1094 string navn;
2 1095 <* skriver en identifikation af en semafor 'ref' i zonen z.
2 1096
2 1096 type: 1=binær sem
2 1097 2=simpel sem
2 1098 3=kædet sem
2 1099
2 1099 ref: semaforreference
2 1100
2 1100 navn: semafornavn, max 18 tegn
2 1101 *>
2 1102 begin
3 1103 disable if testbit29 then
3 1104 write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
3 1105 true,5,<<zddd>,ref,true,19,navn);
3 1106 end;
2 1107 \f
2 1107 message procedure skriv_newactivity side 1 - 810520/hko/cl;
2 1108
2 1108 <**> procedure skriv_newactivity(zud,actno,cause);
2 1109 <**> value actno,cause;
2 1110 <**> zone zud;
2 1111 <**> integer actno,cause;
2 1112 <**> begin
3 1113 <*+2*>
3 1114 <**> if testbit28 then
3 1115 <**> begin integer array field cor;
4 1116 <**> cor:= coroutine(actno);
4 1117 <**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
4 1118 <**> << zdd>,d.cor.coruident//1000);
4 1119 <**> end;
3 1120 <**> if -, testbit23 then goto skriv_newact_slut;
3 1121 <*-2*>
3 1122 <**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
3 1123 <**> <:) cause=:>,<<-d>,cause);
3 1124 <**> if cause<1 then write(zud,<: !!!:>);
3 1125 <**> skriv_coru(zud,actno);
3 1126 <**> skriv_newact_slut:
3 1127 <**> end skriv_newactivity;
2 1128 <*-3*>
2 1129 <*+99*>
2 1130 \f
2 1130 message procedure skriv_activity side 1 - 810313/hko;
2 1131
2 1131 <**> procedure skriv_activity(zud,actno);
2 1132 <**> value actno;
2 1133 <**> zone zud;
2 1134 <**> integer actno;
2 1135 <**> begin
3 1136 <**> integer i;
3 1137 <**> integer array iact(1:12);
3 1138 <**>
3 1139 <**> i:=system(12,actno,iact);
3 1140 <**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
3 1141 <**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
3 1142 <**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
3 1143 <**> if i>0 and actno>0 and actno<=i then
3 1144 <**> begin
4 1145 <**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
4 1146 <**> (<:tom:>,<:passivate:>,
4 1147 <**> <:implicit passivate:>,<:activate:>));
4 1148 <**> if iact(1)<>0 then
4 1149 <**> write(zud,<: ventende på message:>,iact(1));
4 1150 <**> if iact(7)>0 then
4 1151 <**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
4 1152 <**> <:hovedlager stak benyttes af activity(:>,<<d>,
4 1153 <**> iact(2));
4 1154 <**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
4 1155 <**> iact(4),iact(5),iact(6),iact(10),iact(11));
4 1156 <**> if iact(9)<> 1 shift 22 then
4 1157 <**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
4 1158 <**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
4 1159 <**> end;
3 1160 <**> end skriv_activity
2 1161 <*-99*>
2 1162 <*+98*>
2 1163 \f
2 1163 message procedure identificer side 1 - 810520/cl;
2 1164
2 1164 procedure identificer(z);
2 1165 zone z;
2 1166 begin
3 1167 disable write(z,<:coroutine::>,<< dd>,curr_coruno,
3 1168 <: ident::>,<< zdd >,curr_coruid);
3 1169 end;
2 1170 \f
2 1170 message procedure skriv_coru side 1 - 810317/cl;
2 1171
2 1171 <**> procedure skriv_coru(zud,cor_no);
2 1172 <**> value cor_no;
2 1173 <**> zone zud;
2 1174 <**> integer cor_no;
2 1175 <**> begin
3 1176 <**> integer i;
3 1177 <**> integer array field cor;
3 1178 <**>
3 1179 <**>
3 1180 <**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
3 1181 <**>
3 1182 <**> cor:= coroutine(cor_no);
3 1183 <**> if cor = -1 then
3 1184 <**> write(zud,<: eksisterer ikke !!!:>)
3 1185 <**> else
3 1186 <**> begin
4 1187 <**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
4 1188 <**> <: refbyte: :>,<<d>,cor,"nl",1,
4 1189 <**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
4 1190 <**> <: next: :>,d.cor.next,"nl",1,
4 1191 <**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
4 1192 <**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
4 1193 <**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
4 1194 <**> <: opchain.next: :>,d.cor.coruop,"nl",1,
4 1195 <**> <: timer: :>,d.cor.corutimer,"nl",1,
4 1196 <**> <: priority: :>,d.cor.corupriority,"nl",1,
4 1197 <**> <: typeset: :>);
4 1198 <**> for i:= -11 step 1 until 0 do
4 1199 <**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
4 1200 <**> write(zud,"nl",1,<: testmask: :>);
4 1201 <**> for i:= -11 step 1 until 0 do
4 1202 <**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
4 1203 <*+99*>
4 1204 <**> skriv_activity(zud,cor_no);
4 1205 <*-99*>
4 1206 <**> end;
3 1207 <**> end skriv_coru;
2 1208 <*-98*>
2 1209 <*+98*>
2 1210 \f
2 1210 message procedure skriv_op side 1 - 810409/cl;
2 1211
2 1211 <**> procedure skriv_op(zud,opref);
2 1212 <**> value opref;
2 1213 <**> integer opref;
2 1214 <**> zone zud;
2 1215 <**> begin
3 1216 <**> integer array field op;
3 1217 <**> real array field raf;
3 1218 <**> integer lgd,i;
3 1219 <**> real t;
3 1220 <**>
3 1221 <**> raf:= data;
3 1222 <**> op:= opref;
3 1223 <**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
3 1224 <**> if opref<first_op ! optop<=opref then
3 1225 <**> begin
4 1226 <**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
4 1227 <**> goto slut_skriv_op;
4 1228 <**> end;
3 1229 <**>
3 1230 <**> lgd:= d.op.opsize;
3 1231 <**> write(zud,"nl",1,<<d>,
3 1232 <**> <: opsize :>,d.op.opsize,"nl",1,
3 1233 <**> <: optype :>);
3 1234 <**> for i:= -11 step 1 until 0 do
3 1235 <**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
3 1236 <**> write(zud,"nl",1,<<d>,
3 1237 <**> <: prev :>,d.op.prev,"nl",1,
3 1238 <**> <: next :>,d.op.next);
3 1239 <**> if lgd=0 then goto slut_skriv_op;
3 1240 <**> write(zud,"nl",1,<<d>,
3 1241 <**> <: kilde :>,d.op.kilde extract 10,"nl",1,
3 1242 <**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
3 1243 <**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
3 1244 d.op.retur,"nl",1,
3 1245 <**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
3 1246 <**> d.op.opkode extract 12,"nl",1,
3 1247 <**> <: resultat :>,d.op.resultat,"nl",2,
3 1248 <**> <:data::>);
3 1249 <**> skriv_hele(zud,d.op.raf,lgd-data,1278);
3 1250 <**>slut_skriv_op:
3 1251 <**> end skriv_op;
2 1252 <*-98*>
2 1253 \f
2 1253 message procedure corutable side 1 - 810406/cl;
2 1254
2 1254 procedure corutable(zud);
2 1255 zone zud;
2 1256 begin
3 1257 integer i;
3 1258 integer array field cor;
3 1259
3 1259 write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
3 1260 <:no id ref chain timerch opchain timer pr:>,
3 1261 <: typeset testmask:>,"nl",2);
3 1262 for i:= 1 step 1 until maxcoru do
3 1263 begin
4 1264 cor:= coroutine(i);
4 1265 write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
4 1266 d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
4 1267 d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
4 1268 d.cor.corutimer,<< dd>,d.cor.corupriority);
4 1269 outchar(zud,'sp');
4 1270 outboolbits(zud,d.cor.corutypeset);
4 1271 outchar(zud,'sp');
4 1272 outboolbits(zud,d.cor.corutestmask);
4 1273 outchar(zud,'nl');
4 1274 end;
3 1275 end;
2 1276 \f
2 1276 message filglobal side 1 - 790302/jg;
2 1277
2 1277 integer
2 1278 dbantsf,dbkatsfri,
2 1279 dbantb,dbkatbfri,
2 1280 dbantef,dbkatefri,
2 1281 dbsidstesz,dbsidstetz,
2 1282 dbsegmax,
2 1283 filskrevet,fillæst;
2 1284 integer
2 1285 bs_kats_fri, bs_kate_fri,
2 1286 cs_opret_fil, cs_tilknyt_fil,
2 1287 cs_frigiv_fil, cs_slet_fil,
2 1288 cs_opret_spoolfil, cs_opret_eksternfil;
2 1289 integer array
2 1290 dbkatt(1:dbmaxtf,1:2),
2 1291 dbkats(1:dbmaxsf,1:2),
2 1292 dbkate(1:dbmaxef,1:6),
2 1293 dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
2 1294 boolean array
2 1295 dbkatb(1:dbmaxb);
2 1296 zone array
2 1297 fil(dbantez+dbantsz+dbanttz,128,1,stderror);
2 1298 \f
2 1298 message hentfildim side 1 - 781120/jg;
2 1299
2 1299
2 1299 integer procedure hentfildim(fdim);
2 1300 integer array fdim;
2 1301 <*inddata filref i fdim(4),uddata fdim(1:8)*>
2 1302
2 1302 begin integer ftype,fno,katf,i,s;
3 1303 ftype:=fdim(4) shift (-10);
3 1304 fno:=fdim(4) extract 10;
3 1305 if ftype>3 or ftype=0 or fno=0 then
3 1306 begin s:=1; goto udgang; end;
3 1307 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
3 1308 begin s:=1; goto udgang end; <*paramfejl*>
3 1309 katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
3 1310 if katf extract 9 = 0 then
3 1311 begin s:=2; goto udgang end; <*tom indgang*>
3 1312
3 1312 fdim(1):=katf shift (-9); <*post antal*>
3 1313 fdim(2):=katf extract 9; <*post længde*>
3 1314 fdim(3):=case ftype of( <*seg antal*>
3 1315 dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
3 1316 extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
3 1317 dbkate(fno,2) extract 18);
3 1318 for i:=5 step 1 until 8 do <*externt filnavn*>
3 1319 fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
3 1320 s:=0;
3 1321 udgang:
3 1322 hentfildim:=s;
3 1323 <*+2*>
3 1324 <*tz*> if testbit24 and overvåget then <*zt*>
3 1325 <*tz*> begin <*zt*>
4 1326 <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
4 1327 <*tz*> pfdim(fdim); <*zt*>
4 1328 <*tz*> ud; <*zt*>
4 1329 <*tz*> end; <*zt*>
3 1330 <*-2*>
3 1331 end hentfildim;
2 1332 \f
2 1332 message sætfildim side 1 - 780916/jg;
2 1333
2 1333 integer procedure sætfildim(fdim);
2 1334 integer array fdim;
2 1335 <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
2 1336
2 1336 begin
3 1337 integer ftype,fno,katf,s,pl;
3 1338 integer array gdim(1:8);
3 1339 gdim(4):=fdim(4);
3 1340 s:=hentfildim(gdim);
3 1341 if s>0 then
3 1342 goto udgang;
3 1343 fno:=fdim(4) extract 10;
3 1344 ftype:=fdim(4) shift (-10);
3 1345 pl:= fdim(2) extract 12;
3 1346 if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
3 1347 begin
4 1348 s:=1; <*parameter fejl*>
4 1349 goto udgang
4 1350 end;
3 1351 if fdim(1)>256//pl*fdim(3) then
3 1352 begin
4 1353 s:=1;
4 1354 goto udgang;
4 1355 end;
3 1356
3 1356 <*segant*>
3 1357 if ftype=3 then
3 1358 begin integer segant;
4 1359 segant:= fdim(3);
4 1360 if segant > dbsegmax then
4 1361 begin
5 1362 s:=4; <*ingen plads*>
5 1363 goto udgang
5 1364 end;
4 1365 \f
4 1365 message sætfildim side 2 - 780916/jg;
4 1366
4 1366
4 1366 if segant<>gdim(3) then
4 1367 begin integer i,z,s; array field enavn; integer array tail(1:10);
5 1368 z:=dbkate(fno,2) shift (-19); if z>0 then begin
6 1369 if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
6 1370 begin integer array zd(1:20);
7 1371 getzone6(fil(z),zd);
7 1372 if zd(13)>5 and zd(9)>=segant then
7 1373 begin <*dødt segment skal ikke udskrives*>
8 1374 zd(13):=5;
8 1375 setzone6(fil(z),zd)
8 1376 end
7 1377 end end;
5 1378 \f
5 1378 message sætfildim side 3 - 801031/jg;
5 1379
5 1379
5 1379 enavn:=8; <*ændr fil størrelse*>
5 1380 i:=1;
5 1381 open(zdummy,0,string gdim.enavn(increase(i)),0);
5 1382 s:=monitor(42,zdummy,0,tail); <*lookup*>
5 1383 if s>0 then
5 1384 fejlreaktion(1,s,<:lookup entry:>,0);
5 1385 tail(1):=segant;
5 1386 s:=monitor(44,zdummy,0,tail); <*change entry*>
5 1387 close(zdummy,false);
5 1388 if s<>0 then
5 1389 begin
6 1390 if s=6 then
6 1391 begin <*ingen plads*>
7 1392 s:=4; goto udgang
7 1393 end
6 1394 else fejlreaktion(1,s,<:change entry:>,0);
6 1395 end;
5 1396 dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
5 1397 add segant;
5 1398 \f
5 1398 message sætfildim side 4 - 801013/jg;
5 1399
5 1399
5 1399 end;
4 1400 fdim(3):=segant
4 1401 end
3 1402 else
3 1403 if fdim(3)>gdim(3) then
3 1404 begin
4 1405 s:=4; <*altid ingen plads*>
4 1406 goto udgang
4 1407 end
3 1408 else fdim(3):=gdim(3); <*samme længde*>
3 1409 <*postantal,postlængde*>
3 1410 katf:=fdim(1) shift 9 add pl;
3 1411 case ftype of begin
4 1412 dbkatt(fno,1):=katf;
4 1413 dbkats(fno,1):=katf;
4 1414 dbkate(fno,1):=katf end;
3 1415 udgang:
3 1416 sætfildim:=s;
3 1417 <*+2*>
3 1418 <*tz*> if testbit24 and overvåget then <*zt*>
3 1419 <*tz*> begin integer i; <*zt*>
4 1420 <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
4 1421 <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
4 1422 <*tz*> pfdim(gdim); <*zt*>
4 1423 <*tz*> ud; <*zt*>
4 1424 <*tz*> end; <*zt*>
3 1425 <*-2*>
3 1426 end sætfildim;
2 1427 \f
2 1427 message findfilenavn side 1 - 780916/jg;
2 1428
2 1428 integer procedure findfilenavn(navn);
2 1429 real array navn;
2 1430
2 1430 begin
3 1431 integer fno; array field enavn;
3 1432 for fno:=1 step 1 until dbmaxef do
3 1433 if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
3 1434 begin
4 1435 enavn:=fno*12+4;
4 1436 if navn(1)=dbkate.enavn(1) and
4 1437 navn(2)=dbkate.enavn(2) then
4 1438 begin
5 1439 findfilenavn:=fno;
5 1440 goto udgang
5 1441 end
4 1442 end;
3 1443 findfilenavn:=0;
3 1444 udgang:
3 1445 end findfilenavn;
2 1446 \f
2 1446 message læsfil side 1 - 781120/jg;
2 1447
2 1447 integer procedure læsfil(filref,postindex,zoneno);
2 1448 value filref,postindex;
2 1449 integer filref,postindex,zoneno;
2 1450 <*+2*>
2 1451 <*tz*> begin integer i,o,s; <*zt*>
3 1452 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1453 <*-2*>
3 1454
3 1454 læsfil:=tilgangfil(filref,postindex,zoneno,5);
3 1455
3 1455 <*+2*>
3 1456 <*tz*> if testbit24 and overvåget then <*zt*>
3 1457 <*tz*> begin <*zt*>
4 1458 <*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*>
4 1459 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1460 <*tz*> end; <*zt*>
3 1461 <*tz*> end procedure; <*zt*>
2 1462 <*-2*>
2 1463 \f
2 1463 message skrivfil side 1 - 781120/jg;
2 1464
2 1464 integer procedure skrivfil(filref,postindex,zoneno);
2 1465 value filref,postindex;
2 1466 integer filref,postindex,zoneno;
2 1467 <*+2*>
2 1468 <*tz*> begin integer i,o,s; <*zt*>
3 1469 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1470 <*-2*>
3 1471
3 1471 skrivfil:=tilgangfil(filref,postindex,zoneno,6);
3 1472
3 1472 <*+2*>
3 1473 <*tz*> if testbit24 and overvåget then <*zt*>
3 1474 <*tz*> begin <*zt*>
4 1475 <*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
4 1476 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1477 <*tz*> end; <*zt*>
3 1478 <*tz*> end procedure; <*zt*>
2 1479 <*-2*>
2 1480 \f
2 1480 message modiffil side 1 - 781120/jg;
2 1481
2 1481 integer procedure modiffil(filref,postindex,zoneno);
2 1482 value filref,postindex;
2 1483 integer filref,postindex,zoneno;
2 1484 <*+2*>
2 1485 <*tz*> begin integer i,o,s; <*zt*>
3 1486 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1487 <*-2*>
3 1488
3 1488 modiffil:=tilgangfil(filref,postindex,zoneno,7);
3 1489
3 1489 <*+2*>
3 1490 <*tz*> if testbit24 and overvåget then <*zt*>
3 1491 <*tz*> begin <*zt*>
4 1492 <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
4 1493 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1494 <*tz*> end; <*zt*>
3 1495 <*tz*> end procedure; <*zt*>
2 1496 <*-2*>
2 1497 \f
2 1497 message tilgangfil side 1 - 781003/jg;
2 1498
2 1498 integer procedure tilgangfil(filref,postindex,zoneno,operation);
2 1499 value filref,postindex,operation;
2 1500 integer filref,postindex,zoneno,operation;
2 1501 <*proceduren kaldes fra læsfil,skrivfil og modiffil*>
2 1502
2 1502 begin
3 1503 integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
3 1504 integer array zd(1:20),fdim(1:8);
3 1505
3 1505
3 1505
3 1505 <*hent katalog*>
3 1506
3 1506 fdim(4):=filref;
3 1507 st:=hentfildim(fdim);
3 1508 if st<>0 then
3 1509 goto udgang; <*parameter fejl eller fil findes ikke*>
3 1510 fno:=filref extract 10;
3 1511 ftype:=filref shift (-10);
3 1512 pl:=fdim(2);
3 1513 katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
3 1514 \f
3 1514 message tilgangfil side 2 - 781003/jg;
3 1515
3 1515
3 1515
3 1515 <*find segment adr og check postindex*>
3 1516
3 1516 pps:=256//pl; <*poster pr segment*>
3 1517 seg:=(postindex-1)//pps; <*relativt segment*>
3 1518 pr:=(postindex-1) mod pps; <*post relativ til seg*>
3 1519 if postindex <1 then
3 1520 begin <*parameter fejl*>
4 1521 st:=1;
4 1522 goto udgang
4 1523 end;
3 1524 if seg>=fdim(3) then
3 1525 begin <*post findes ikke*>
4 1526 st:=3;
4 1527 goto udgang
4 1528 end;
3 1529 case ftype of
3 1530 begin <*find absolut segment*>
4 1531
4 1531 <*tabelfil*>
4 1532 seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
4 1533
4 1533 begin <*spoolfil*>
5 1534 integer i,bidno;
5 1535 bidno:=katf extract 12;
5 1536 for i:=seg//dbbidlængde step -1 until 1 do
5 1537 bidno:=dbkatb(bidno) extract 12;
5 1538 seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
5 1539 end;
4 1540
4 1540 <*extern fil,seg ok*>
4 1541
4 1541 end case find abs seg;
3 1542 \f
3 1542 message tilgangfil side 3 - 801030/jg;
3 1543
3 1543 <*alloker zone*>
3 1544
3 1544 zno:=katf shift(-19);
3 1545 case ftype of begin
4 1546
4 1546 begin <*tabelfil*>
5 1547 integer førstetz;
5 1548 førstetz:=dbkatz(dbsidstetz,2);
5 1549 if zno=0 then
5 1550 zno:=førstetz
5 1551 else if dbkatz(zno,1)<>filref then
5 1552 zno:=førstetz
5 1553 else if zno <> førstetz and zno <> dbsidstetz then
5 1554 begin integer z;
6 1555 for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
6 1556 dbkatz(z,2):=dbkatz(zno,2);
6 1557 dbkatz(zno,2):=førstetz;
6 1558 dbkatz(dbsidstetz,2):=zno;
6 1559 end;
5 1560 dbsidstetz:=zno
5 1561 end;
4 1562 \f
4 1562 message tilgangfil side 4 - 801030/jg;
4 1563
4 1563
4 1563 begin <*spoolfil*>
5 1564 integer p,zslut,z;
5 1565 if zno>0 then begin if dbkatz(zno,1) =filref then
6 1566 goto udgangs end; <*strategi 1*>
5 1567 p:=0;
5 1568 zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
5 1569 zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
5 1570 for z:=dbantez+dbantsz step -1 until zslut do
5 1571 begin integer zfref;
6 1572 zfref:=dbkatz(z,1);
6 1573 if zfref extract 10=0 then <*fri zone*>
6 1574 begin <*strategi 2*>
7 1575 zno:=z;
7 1576 goto udgangs
7 1577 end
6 1578 else
6 1579 if zfref shift (-10)=2 then
6 1580 begin <*zone tilknyttet spoolfil*>
7 1581 integer q;
7 1582 q:=dbkatz(z,2); <*prioritet*>
7 1583 if q>p then
7 1584 begin <*strategi 3*>
8 1585 p:=q;
8 1586 zno:=z
8 1587 end
7 1588 end;
6 1589 end z;
5 1590 udgangs:
5 1591 if zno> dbantez then dbsidstesz:=zno;
5 1592 end;
4 1593 \f
4 1593 message tilgangfil side 5 - 780916/jg;
4 1594
4 1594 begin <*extern fil*>
5 1595 integer z;
5 1596 if zno=0 then
5 1597 zno:=1
5 1598 else if dbkatz(zno,1) = filref then
5 1599 goto udgange; <*strategi 1*>
5 1600 for z:=1 step 1 until dbantez do
5 1601 begin integer zfref;
6 1602 zfref:=dbkatz(z,1);
6 1603 if zfref=0 then <*zone fri*>
6 1604 begin zno:=z; goto udgange end <*strategi 2*>
6 1605 else if zfref shift (-10) =2 then <*spoolfil*>
6 1606 zno:=z; <*strategi 3*> <*else strategi 4-5*>
6 1607 end z;
5 1608 udgange:
5 1609 end
4 1610 end case alloker zone;
3 1611
3 1611
3 1611
3 1611 <*åbn zone*>
3 1612
3 1612 if zno<=dbantez then
3 1613 begin <*extern zone;spool og tabel zoner altid åbne*>
4 1614 integer zfref;
4 1615 zfref:=dbkatz(zno,1);
4 1616 if zfref<>0 and zfref<>filref and ftype=3 then
4 1617 begin <*luk hvis ny extern fil*>
5 1618 getzone6(fil(zno),zd);
5 1619 if zd(13)>5 then filskrevet:=filskrevet+1;
5 1620 zfref:=0;
5 1621 close(fil(zno),false);
5 1622 end;
4 1623 if zfref=0 then
4 1624 begin <*åbn zone*>
5 1625 array field enavn; integer i;
5 1626 enavn:=4*2; i:=1;
5 1627 open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
5 1628 string fdim.enavn(increase(i))),0)
5 1629 end
4 1630 end;
3 1631 \f
3 1631 message tilgangfil side 6 - 780916/jg;
3 1632
3 1632
3 1632
3 1632 <*hent segment og sæt zone descriptor*>
3 1633
3 1633 getzone6(fil(zno),zd);
3 1634 zstate:=zd(13);
3 1635 if zstate=0 or zd(9)<>seg then
3 1636 begin <*positioner*>
4 1637 if zstate>5 then
4 1638 filskrevet:=filskrevet+1;
4 1639 setposition(fil(zno),0,seg);
4 1640 if -,(operation=6 and pr=0) then
4 1641 begin <*læs seg medmindre op er skriv første post*>
5 1642 inrec6(fil(zno),512);
5 1643 fillæst:=fillæst+1
5 1644 end;
4 1645 zstate:=operation
4 1646 end
3 1647 else <*zstate:=max(operation,zone state)*>
3 1648 if operation>zstate then
3 1649 zstate:=operation;
3 1650 zd(9):=seg;
3 1651 zd(13):=zstate;
3 1652 zd(16):=pl shift 1;
3 1653 zd(14):=zd(19)+pr*zd(16);
3 1654 setzone6(fil(zno),zd);
3 1655 \f
3 1655 message tilgangfil side 7 - 780916/jg;
3 1656
3 1656
3 1656
3 1656 <*opdater kataloger*>
3 1657
3 1657 katf:=zno shift 19 add (katf extract 19);
3 1658 case ftype of
3 1659 begin
4 1660 dbkatt(fno,2):=katf;
4 1661 dbkats(fno,2):=katf;
4 1662 dbkate(fno,2):=katf
4 1663 end;
3 1664 dbkatz(zno,1):= filref;
3 1665 if ftype=3 then dbkatz(zno,2):=0 else
3 1666 <*if ftype=1 then allerede opd under zoneallokering*>
3 1667 if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
3 1668 if zstate=5 then (if pr=pps-1 then 2 else 1)
3 1669 else if zstate=6 and pr=pps-1 then 3 else 0;
3 1670
3 1670
3 1670
3 1670 <*udgang*>
3 1671
3 1671 udgang:
3 1672 if st=0 then
3 1673 zoneno:=zno
3 1674 else zoneno:=0; <*fejl*>
3 1675 tilgangfil:=st;
3 1676 end tilgangfil;
2 1677 \f
2 1677
2 1677 message pfilsystem side 1 - 781003/jg;
2 1678
2 1678 procedure pfilparm(z);
2 1679 zone z;
2 1680 write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
2 1681 dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
2 1682 <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
2 1683 dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
2 1684
2 1684 procedure pfilglobal(z);
2 1685 zone z;
2 1686 write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
2 1687 <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
2 1688 <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
2 1689 <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
2 1690 <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
2 1691 <:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
2 1692
2 1692
2 1692 procedure pdbkate(z,i);
2 1693 value i; integer i;
2 1694 zone z;
2 1695 begin integer j; array field navn;
3 1696 navn:=i*12+4; j:=1;
3 1697 write(z,<:<10>dbkate(:>,i,<:)=:>,
3 1698 dbkate(i,1) shift (-9),
3 1699 dbkate(i,1) extract 9,
3 1700 dbkate(i,2) shift (-19),
3 1701 dbkate(i,2) shift (-18) extract 1,
3 1702 dbkate(i,2) extract 18,
3 1703 <: :>,string dbkate.navn(increase(j)));
3 1704 end;
2 1705 \f
2 1705 message pfilsystem side 2 - 781003/jg;
2 1706
2 1706
2 1706
2 1706 procedure pdbkats(z,i);
2 1707 value i; integer i;
2 1708 zone z;
2 1709 write(z,<:<10>dbkats(:>,i,<:)=:>,
2 1710 dbkats(i,1) shift (-9),
2 1711 dbkats(i,1) extract 9,
2 1712 dbkats(i,2) shift (-19),
2 1713 dbkats(i,2) shift (-18) extract 1,
2 1714 dbkats(i,2) shift (-12) extract 6,
2 1715 dbkats(i,2) extract 12);
2 1716
2 1716 procedure pdbkatb(z,i);
2 1717 value i;integer i;
2 1718 zone z;
2 1719 write(z,<:<10>dbkatb(:>,i,<:)=:>,
2 1720 dbkatb(i) extract 12);
2 1721
2 1721 procedure pdbkatt(z,i);
2 1722 value i; integer i;
2 1723 zone z;
2 1724 write(z,<:<10>dbkatt(:>,i,<:)=:>,
2 1725 dbkatt(i,1) shift (-9),
2 1726 dbkatt(i,1) extract 9,
2 1727 dbkatt(i,2) shift (-19),
2 1728 dbkatt(i,2) shift (-18) extract 1,
2 1729 dbkatt(i,2) extract 18);
2 1730
2 1730 procedure pdbkatz(z,i);
2 1731 value i; integer i;
2 1732 zone z;
2 1733 write(z,<:<10>dbkatz(:>,i,<:)=:>,
2 1734 dbkatz(i,1),dbkatz(i,2));
2 1735 \f
2 1735 message pfilsystem side 3 - 781003/jg;
2 1736
2 1736
2 1736
2 1736 procedure pfil(z,i);
2 1737 value i; integer i;
2 1738 zone z;
2 1739 begin integer j,k; array field navn; integer array zd(1:20);
3 1740 navn:=2; k:=1;
3 1741 getzone6(fil(i),zd);
3 1742 write(z,<:<10>fil(:>,i,<:)=:>,
3 1743 zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
3 1744 string zd.navn(increase(k)));
3 1745 for j:=6 step 1 until 10 do write(z,zd(j));
3 1746 write(z,<:<10>:>);
3 1747 for j:=11 step 1 until 20 do write(z,zd(j));
3 1748 end;
2 1749
2 1749 procedure pfilsystem(z);
2 1750 zone z;
2 1751 begin integer i;
3 1752
3 1752 write(z,<:<12>udskrift af variable i filsystem:>);
3 1753 write(z,<:<10><10>filparm::>);
3 1754 pfilparm(z);
3 1755 write(z,<:<10><10>filglobal::>);
3 1756 pfilglobal(z);
3 1757 write(z,<:<10><10>fil: zone descriptor:>);
3 1758 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
3 1759 write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
3 1760 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
3 1761 write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
3 1762 for i :=1 step 1 until dbmaxef do pdbkate(z,i);
3 1763 write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
3 1764 for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
3 1765 write(z,<:<10><10>dbkatb: katbref:>);
3 1766 for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
3 1767 write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
3 1768 for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
3 1769 end pfilsystem;
2 1770 \f
2 1770 message pfilsystem side 4 - 781003/jg;
2 1771
2 1771
2 1771
2 1771 procedure pfdim(fdim);
2 1772 integer array fdim;
2 1773 begin
3 1774 integer i;
3 1775 array field navn;
3 1776 i:=1;navn:=8;
3 1777 write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
3 1778 string fdim.navn(increase(i)));
3 1779 end pfdim;
2 1780 \f
2 1780 message opretfil side 0 - 810529/cl;
2 1781
2 1781 procedure opretfil;
2 1782 <* checker parametre og vidresender operation
2 1783 til opret_spoolfil eller opret_eksternfil *>
2 1784
2 1784 begin
3 1785 integer array field op;
3 1786 integer status,pant,pl,segant,p_nøgle,fno,ftype;
3 1787
3 1787 procedure skriv_opret_fil(z,omfang);
3 1788 value omfang;
3 1789 zone z;
3 1790 integer omfang;
3 1791 begin
4 1792 write(z,"nl",1,<:+++ opret fil :>);
4 1793 if omfang > 0 then
4 1794 disable
4 1795 begin
5 1796 skriv_coru(z,abs curr_coruno);
5 1797 write(z,"nl",1,<<d>,
5 1798 <:op :>,op,"nl",1,
5 1799 <:status :>,status,"nl",1,
5 1800 <:pant :>,pant,"nl",1,
5 1801 <:pl :>,pl,"nl",1,
5 1802 <:segant :>,segant,"nl",1,
5 1803 <:p-nøgle:>,p_nøgle,"nl",1,
5 1804 <:fno :>,fno,"nl",1,
5 1805 <:ftype :>,ftype,"nl",1,
5 1806 <::>);
5 1807 end;
4 1808 end skriv_opret_fil;
3 1809 \f
3 1809 message opretfil side 1 - 810526/cl;
3 1810
3 1810 trap(opretfil_trap);
3 1811 <*+2*>
3 1812 <**> disable if testbit28 then
3 1813 <**> skriv_opret_fil(out,0);
3 1814 <*-2*>
3 1815
3 1815 stack_claim(if cm_test then 200 else 150);
3 1816
3 1816 <*+2*>
3 1817 <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
3 1818 <*-2*>
3 1819
3 1819 trin1:
3 1820 waitch(cs_opret_fil,op,true,-1);
3 1821
3 1821 trin2: <* check parametre *>
3 1822 disable begin
4 1823
4 1823 ftype:= d.op.data(4) shift (-10);
4 1824 fno:= d.op.data(4) extract 10;
4 1825 if ftype<2 or ftype>3 or fno<>0 then
4 1826 begin
5 1827 status:= 1; <*parameterfejl*>
5 1828 goto returner;
5 1829 end;
4 1830
4 1830 pant:= d.op.data(1);
4 1831 pl:= d.op.data(2);
4 1832 segant:= d.op.data(3);
4 1833 p_nøgle:= d.op.opkode shift (-12);
4 1834 if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
4 1835 or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
4 1836 status:= 1 <*parameterfejl *>
4 1837 else
4 1838 if pant>256//pl*segant then status:= 1 else
4 1839 if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
4 1840 status:= 4 <*ingen plads*>
4 1841 else
4 1842 status:=0;
4 1843 \f
4 1843 message opretfil side 2 - 810526/cl;
4 1844
4 1844
4 1844 returner:
4 1845
4 1845 d.op.data(9):= status;
4 1846
4 1846 <*+2*>
4 1847 <*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
4 1848 <*tz*> begin <*zt*>
5 1849 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 1850 <*tz*> pfdim(d.op.data); <*zt*>
5 1851 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1852 <*tz*> end; <*zt*>
4 1853 <*-2*>
4 1854
4 1854 <*returner eller vidresend operation*>
4 1855 signalch(if status>0 then d.op.retur else
4 1856 case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
4 1857 op,d.op.optype);
4 1858 end;
3 1859 goto trin1;
3 1860 opretfil_trap:
3 1861 disable skriv_opret_fil(zbillede,1);
3 1862
3 1862 end opretfil;
2 1863 \f
2 1863 message tilknytfil side 0 - 810526/cl;
2 1864
2 1864 procedure tilknytfil;
2 1865 <* tilknytter ekstern fil og returnerer intern filid *>
2 1866
2 1866 begin
3 1867 integer array field op;
3 1868 integer status,i,fno,segant,pa,pl,sliceant,s;
3 1869 array field enavn;
3 1870 integer array tail(1:10);
3 1871
3 1871 procedure skriv_tilknyt_fil(z,omfang);
3 1872 value omfang;
3 1873 zone z;
3 1874 integer omfang;
3 1875 begin
4 1876 write(z,"nl",1,<:+++ tilknyt fil :>);
4 1877 if omfang > 0 then
4 1878 disable
4 1879 begin real array field raf;
5 1880 skriv_coru(z,abs curr_coruno);
5 1881 write(z,"nl",1,<<d>,
5 1882 <:op :>,op,"nl",1,
5 1883 <:status :>,status,"nl",1,
5 1884 <:i :>,i,"nl",1,
5 1885 <:fno :>,fno,"nl",1,
5 1886 <:segant :>,segant,"nl",1,
5 1887 <:pa :>,pa,"nl",1,
5 1888 <:pl :>,pl,"nl",1,
5 1889 <:sliceant:>,sliceant,"nl",1,
5 1890 <:s :>,s,"nl",1,
5 1891 <::>);
5 1892 raf:= 0;
5 1893 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 1894 write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
5 1895 end;
4 1896 end skriv_tilknyt_fil;
3 1897 \f
3 1897 message tilknytfil side 1 - 810529/cl;
3 1898
3 1898 stack_claim(if cm_test then 200 else 150);
3 1899 trap(tilknytfil_trap);
3 1900
3 1900 <*+2*>
3 1901 <**> if testbit28 then
3 1902 <**> skriv_tilknyt_fil(out,0);
3 1903 <*-2*>
3 1904
3 1904 trin1:
3 1905 waitch(cs_tilknyt_fil,op,true,-1);
3 1906
3 1906 trin2:
3 1907 wait(bs_kate_fri);
3 1908
3 1908 trin3:
3 1909 disable begin
4 1910
4 1910 <* find ekstern rapportfil *>
4 1911 enavn:= 8;
4 1912 if find_fil_enavn(d.op.data.enavn)>0 then
4 1913 begin
5 1914 status:= 6; <* fil i brug *>
5 1915 goto returner;
5 1916 end;
4 1917 open(zdummy,0,d.op.data.enavn,0);
4 1918 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 1919 if s<>0 then
4 1920 begin
5 1921 if s=3 then status:= 2 <* fil findes ikke *>
5 1922 else if s=6 then status:= 1 <* parameterfejl, navn *>
5 1923 else fejlreaktion(1,s,<:lookup entry:>,0);
5 1924 goto returner;
5 1925 end;
4 1926 if tail(9)<>d.op.data(4) <* contentskey,subno *> then
4 1927 begin
5 1928 status:= 5; <* forkert indhold *> goto returner;
5 1929 end;
4 1930 segant:= tail(1);
4 1931 if segant>db_seg_max then
4 1932 segant:= db_seg_max;
4 1933 pa:= tail(10);
4 1934 pl:= tail(7) extract 12;
4 1935 if pl < 1 or pl > 256 then
4 1936 begin status:= 7; goto returner; end;
4 1937 \f
4 1937 message tilknytfil side 2 - 810529/cl;
4 1938 if pa>256//pl*segant then
4 1939 begin status:= 7; goto returner; end;
4 1940
4 1940 <* reserver *>
4 1941 s:= monitor(52)create area:(zdummy,0,ia);
4 1942 if s<>0 then
4 1943 begin
5 1944 if s=3 then status:= 2 <* fil findes ikke *>
5 1945 else if s=1 <* areaclaims exeeded *> then
5 1946 begin
6 1947 status:= 4;
6 1948 fejlreaktion(1,s,<:create area:>,1);
6 1949 end
5 1950 else fejlreaktion(1,s,<:create area:>,0);
5 1951 goto returner;
5 1952 end;
4 1953
4 1953 s:= monitor(8)reserve:(zdummy,0,ia);
4 1954 if s<>0 then
4 1955 begin
5 1956 if s<3 then status:= 6 <* i brug *>
5 1957 else fejlreaktion(1,s,<:reserve:>,0);
5 1958 monitor(64)remove area:(zdummy,0,ia);
5 1959 goto returner;
5 1960 end;
4 1961
4 1961 tail(7):= 1 shift 12 +pl; <* tilknyttet *>
4 1962 s:= monitor(44)change entry:(zdummy,0,tail);
4 1963 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 1964
4 1964 <* opdater katalog *>
4 1965 dbantef:= dbantef+1;
4 1966 fno:= dbkatefri;
4 1967 dbkatefri:= dbkate(fno,2);
4 1968 dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
4 1969 dbkate(fno,2):= segant;
4 1970 for i:= 5 step 1 until 8 do
4 1971 dbkate(fno,i-2):= d.op.data(i);
4 1972
4 1972 <* returparametre *>
4 1973 d.op.data(1):= pa;
4 1974 d.op.data(2):= pl;
4 1975 d.op.data(3):= segant;
4 1976 d.op.data(4):= 3 shift 10 +fno;
4 1977 status:= 0;
4 1978 \f
4 1978 message tilknytfil side 3 - 810526/cl;
4 1979
4 1979
4 1979 returner:
4 1980 close(zdummy,false);
4 1981 d.op.data(9):= status;
4 1982
4 1982
4 1982 <*+2*>
4 1983 <*tz*> if testbit24 and overvåget then <*zt*>
4 1984 <*tz*> begin <*zt*>
5 1985 <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
5 1986 <*tz*> pfdim(d.op.data); <*zt*>
5 1987 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1988 <*tz*> end; <*zt*>
4 1989 <*-2*>
4 1990
4 1990 signalch(d.op.retur,op,d.op.optype);
4 1991 if dbantef < dbmaxef then
4 1992 signalbin(bs_kate_fri);
4 1993 end;
3 1994 goto trin1;
3 1995 tilknytfil_trap:
3 1996 disable skriv_tilknyt_fil(zbillede,1);
3 1997 end tilknyt_fil;
2 1998 \f
2 1998 message frigivfil side 0 - 810529/cl;
2 1999
2 1999 procedure frigivfil;
2 2000 <* frigiver en tilknyttet ekstern fil *>
2 2001
2 2001 begin
3 2002 integer array field op;
3 2003 integer status,fref,ftype,fno,s,i,z;
3 2004 array field enavn;
3 2005 integer array tail(1:10);
3 2006
3 2006 procedure skriv_frigiv_fil(zud,omfang);
3 2007 value omfang;
3 2008 zone zud;
3 2009 integer omfang;
3 2010 begin
4 2011 write(zud,"nl",1,<:+++ frigiv fil :>);
4 2012 if omfang > 0 then
4 2013 disable
4 2014 begin real array field raf;
5 2015 skriv_coru(zud,abs curr_coruno);
5 2016 write(zud,"nl",1,<<d>,
5 2017 <:op :>,op,"nl",1,
5 2018 <:status:>,status,"nl",1,
5 2019 <:fref :>,fref,"nl",1,
5 2020 <:ftype :>,ftype,"nl",1,
5 2021 <:fno :>,fno,"nl",1,
5 2022 <:s :>,s,"nl",1,
5 2023 <:i :>,i,"nl",1,
5 2024 <:z :>,z,"nl",1,
5 2025 <::>);
5 2026 raf:= 0;
5 2027 write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
5 2028 end;
4 2029 end skriv_frigiv_fil;
3 2030 \f
3 2030 message frigivfil side 1 - 810526/cl;
3 2031
3 2031
3 2031 stack_claim(if cm_test then 200 else 150);
3 2032 trap(frigivfil_trap);
3 2033
3 2033 <*+2*>
3 2034 <**> disable if testbit28 then
3 2035 <**> skriv_frigiv_fil(out,0);
3 2036 <*-2*>
3 2037
3 2037 trin1:
3 2038 waitch(cs_frigiv_fil,op,true,-1);
3 2039
3 2039 trin2:
3 2040 disable begin
4 2041
4 2041 <* find fil *>
4 2042 fref:= d.op.data(4);
4 2043 ftype:= fref shift (-10);
4 2044 fno:= fref extract 10;
4 2045 if ftype=0 or ftype>3 or fno=0 then
4 2046 begin status:= 1; goto returner; end;
4 2047 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2048 begin status:= 1; goto returner; end;
4 2049 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2050 extract 9 = 0 then
4 2051 begin
5 2052 status:= 2; <* fil findes ikke *>
5 2053 goto returner;
5 2054 end;
4 2055 if ftype <> 3 then
4 2056 begin status:= 5; goto returner; end;
4 2057
4 2057 <* frigiv evt. tilknyttet zone og areaprocess *>
4 2058 z:= dbkate(fno,2) shift (-19);
4 2059 if z > 0 then
4 2060 begin
5 2061 if dbkatz(z,1)=fref then
5 2062 begin integer array zd(1:20);
6 2063 getzone6(fil(z),zd);
6 2064 if zd(13)>5 then filskrevet:= filskrevet +1;
6 2065 close(fil(z),true);
6 2066 dbkatz(z,1):= 0;
6 2067 end;
5 2068 end;
4 2069 \f
4 2069 message frigivfil side 2 - 810526/cl;
4 2070
4 2070 <* opdater tail *>
4 2071 enavn:= fno*12+4;
4 2072 open(zdummy,0,dbkate.enavn,0);
4 2073 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 2074 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
4 2075 tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
4 2076 tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
4 2077 s:= monitor(44)change entry:(zdummy,0,tail);
4 2078 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 2079 monitor(64)remove process:(zdummy,0,tail);
4 2080 close(zdummy,true);
4 2081
4 2081 <* frigiv indgang *>
4 2082 for i:= 1, 3 step 1 until 6 do
4 2083 dbkate(fno,1):= 0;
4 2084 dbkate(fno,2):= dbkatefri;
4 2085 dbkatefri:= fno;
4 2086 dbantef:= dbantef -1;
4 2087 signalbin(bs_kate_fri);
4 2088 d.op.data(4):= 0; <* filref null *>
4 2089 status:= 0;
4 2090
4 2090 returner:
4 2091 d.op.data(9):= status;
4 2092 <*+2*>
4 2093 <*tz*> if testbit24 and overvåget then <*zt*>
4 2094 <*tz*> begin <*zt*>
5 2095 <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
5 2096 <*tz*> pfdim(d.op.data); <*zt*>
5 2097 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2098 <*tz*> end; <*zt*>
4 2099 <*-2*>
4 2100
4 2100 signalch(d.op.retur,op,d.op.optype);
4 2101 end;
3 2102 goto trin1;
3 2103 frigiv_fil_trap:
3 2104 disable skriv_frigiv_fil(zbillede,1);
3 2105 end frigivfil;
2 2106 \f
2 2106 message sletfil side 0 - 810526/cl;
2 2107
2 2107 procedure sletfil;
2 2108 <* sletter en spool- eller ekstern fil *>
2 2109
2 2109 begin
3 2110 integer array field op;
3 2111 integer fref,fno,ftype,status;
3 2112
3 2112 procedure skriv_slet_fil(z,omfang);
3 2113 value omfang;
3 2114 zone z;
3 2115 integer omfang;
3 2116 begin
4 2117 write(z,"nl",1,<:+++ slet fil :>);
4 2118 if omfang > 0 then
4 2119 disable
4 2120 begin
5 2121 skriv_coru(z,abs curr_coruno);
5 2122 write(z,"nl",1,<<d>,
5 2123 <:op :>,op,"nl",1,
5 2124 <:fref :>,fref,"nl",1,
5 2125 <:fno :>,fno,"nl",1,
5 2126 <:ftype :>,ftype,"nl",1,
5 2127 <:status:>,status,"nl",1,
5 2128 <::>);
5 2129 end;
4 2130 end skriv_slet_fil;
3 2131 \f
3 2131 message sletfil side 1 - 810526/cl;
3 2132
3 2132 stack_claim(if cm_test then 200 else 150);
3 2133
3 2133 trap(sletfil_trap);
3 2134 <*+2*>
3 2135 <**> disable if testbit28 then
3 2136 <**> skriv_slet_fil(out,0);
3 2137 <*-2*>
3 2138
3 2138 trin1:
3 2139 waitch(cs_slet_fil,op,true,-1);
3 2140
3 2140 trin2:
3 2141 disable begin
4 2142
4 2142 <* find fil *>
4 2143 fref:= d.op.data(4);
4 2144 ftype:= fref shift (-10);
4 2145 fno:= fref extract 10;
4 2146 if ftype=0 or ftype>3 or fno=0 then
4 2147 begin status:= 1; goto returner; end;
4 2148 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2149 begin status:= 1; goto returner; end;
4 2150 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2151 extract 9 = 0 then
4 2152 begin
5 2153 status:= 2; <* fil findes ikke *>
5 2154 goto returner;
5 2155 end;
4 2156
4 2156
4 2156 <* slet spool- eller ekstern fil *>
4 2157 case ftype of
4 2158 begin
5 2159
5 2159 <* tabelfil - ingen aktion *>
5 2160 ;
5 2161 \f
5 2161 message sletfil side 2 - 810203/cl;
5 2162
5 2162 <* spoolfil *>
5 2163 begin
6 2164 integer z,bidno,bf,bidant,i;
6 2165
6 2165 <* hvis tilknyttet så frigiv *>
6 2166 z:= dbkats(fno,2) shift (-19);
6 2167 if z>0 then
6 2168 begin
7 2169 if dbkatz(z,1)=fref then
7 2170 begin integer array zd(1:20);
8 2171 dbkatz(z,1):= 2 shift 10;
8 2172 getzone6(fil(z),zd); <*annuler evt. udskrivning*>
8 2173 if zd(13)>5 then
8 2174 begin zd(13):= 0; setzone6(fil(z),zd); end;
8 2175 end;
7 2176 end;
6 2177
6 2177 <* frigiv bidder *>
6 2178 bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
6 2179 bidant:= dbkats(fno,2) shift (-12) extract 6;
6 2180 for i:= bidant -1 step -1 until 1 do
6 2181 bidno:= dbkatb(bidno) extract 12;
6 2182 dbkatb(bidno):= false add dbkatbfri;
6 2183 dbkatbfri:= bf;
6 2184 dbantb:= dbantb-bidant;
6 2185
6 2185 <* frigiv indgang *>
6 2186 dbkats(fno,1):= 0;
6 2187 dbkats(fno,2):= dbkatsfri;
6 2188 dbkatsfri:= fno;
6 2189 dbantsf:= dbantsf -1;
6 2190 signalbin(bs_kats_fri);
6 2191 end spoolfil;
5 2192 \f
5 2192 message sletfil side 3 - 810203/cl;
5 2193
5 2193 <* extern fil *>
5 2194 begin
6 2195 integer i,s,z;
6 2196 real array field enavn;
6 2197 integer array tail(1:10);
6 2198
6 2198 <* find head and tail *>
6 2199 enavn:= fno*12+4;
6 2200 open(zdummy,0,dbkate.enavn,0);
6 2201 s:= monitor(42)lookup entry:(zdummy,0,tail);
6 2202 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
6 2203
6 2203 <*frigiv evt. tilknyttet zone og areaprocess*>
6 2204 z:=dbkate(fno,2) shift (-19);
6 2205 if z>0 then
6 2206 begin
7 2207 if dbkatz(z,1)=fref then
7 2208 begin integer array zd(1:20);
8 2209 getzone6(fil(z),zd);
8 2210 if zd(13)>5 then <* udskrivning *>
8 2211 begin <*annuler*>
9 2212 zd(13):= 0;
9 2213 setzone6(fil(z),zd);
9 2214 end;
8 2215 close(fil(z),true);
8 2216 dbkatz(z,1):= 0;
8 2217 end;
7 2218 end;
6 2219
6 2219 <* fjern entry *>
6 2220 s:= monitor(48)remove entry:(zdummy,0,tail);
6 2221 if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
6 2222 close(zdummy,true);
6 2223
6 2223 <* frigiv indgang *>
6 2224 for i:=1, 3 step 1 until 6 do
6 2225 dbkate(fno,i):= 0;
6 2226 dbkate(fno,2):= dbkatefri;
6 2227 dbkatefri:= fno;
6 2228 dbantef:= dbantef -1;
6 2229 signalbin(bs_kate_fri);
6 2230 end eksternfil;
5 2231
5 2231 end ftype;
4 2232 \f
4 2232 message sletfil side 4 - 810526/cl;
4 2233
4 2233
4 2233 status:= 0;
4 2234 if ftype > 1 then
4 2235 d.op.data(4):= 0; <*filref null*>
4 2236
4 2236 returner:
4 2237 d.op.data(9):= status;
4 2238
4 2238 <*+2*>
4 2239 <*tz*> if testbit24 and overvåget then <*zt*>
4 2240 <*tz*> begin <*zt*>
5 2241 <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
5 2242 <*tz*> pfdim(d.op.data); <*zt*>
5 2243 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2244 <*tz*> end; <*zt*>
4 2245 <*-2*>
4 2246
4 2246 signalch(d.op.retur,op,d.op.optype);
4 2247 end;
3 2248 goto trin1;
3 2249 sletfil_trap:
3 2250 disable skriv_slet_fil(zbillede,1);
3 2251 end sletfil;
2 2252 \f
2 2252 message opretspoolfil side 0 - 810526/cl;
2 2253
2 2253 procedure opretspoolfil;
2 2254 <* opretter en spoolfil og returnerer intern filid *>
2 2255
2 2255 begin
3 2256 integer array field op;
3 2257 integer bidantal,fno,i,bs,bidstart;
3 2258
3 2258 procedure skriv_opret_spoolfil(z,omfang);
3 2259 value omfang;
3 2260 zone z;
3 2261 integer omfang;
3 2262 begin
4 2263 write(z,"nl",1,<:+++ opret spoolfil :>);
4 2264 if omfang > 0 then
4 2265 disable
4 2266 begin
5 2267 skriv_coru(z,abs curr_coruno);
5 2268 write(z,"nl",1,<<d>,
5 2269 <:op :>,op,"nl",1,
5 2270 <:bidantal:>,bidantal,"nl",1,
5 2271 <:fno :>,fno,"nl",1,
5 2272 <:i :>,i,"nl",1,
5 2273 <:bs :>,bs,"nl",1,
5 2274 <:bidstart:>,bidstart,"nl",1,
5 2275 <::>);
5 2276 end;
4 2277 end skriv_opret_spoolfil;
3 2278 \f
3 2278 message opretspoolfil side 1 - 810526/cl;
3 2279
3 2279 stack_claim(if cm_test then 200 else 150);
3 2280
3 2280 signalbin(bs_kats_fri); <*initialiseres til åben*>
3 2281
3 2281 trap(opretspool_trap);
3 2282 <*+2*>
3 2283 <**> disable if testbit28 then
3 2284 <**> skriv_opret_spoolfil(out,0);
3 2285 <*-2*>
3 2286 trin1:
3 2287 waitch(cs_opret_spoolfil,op,true,-1);
3 2288
3 2288 trin2:
3 2289 bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
3 2290 wait(bs_kats_fri);
3 2291
3 2291 trin3:
3 2292 if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
3 2293 begin
4 2294 wait(bs_kats_fri);
4 2295 goto trin3;
4 2296 end;
3 2297 disable begin
4 2298
4 2298 <*alloker bidder*>
4 2299 bs:= bidstart:= dbkatbfri;
4 2300 for i:= bidantal-1 step -1 until 1 do
4 2301 bs:= dbkatb(bs) extract 12;
4 2302 dbkatbfri:= dbkatb(bs) extract 12;
4 2303 dbkatb(bs):= false; <*sidste ref null*>
4 2304 dbantb:= dbantb+bidantal;
4 2305
4 2305 <*alloker indgang*>
4 2306 fno:= dbkatsfri;
4 2307 dbkatsfri:= dbkats(fno,2);
4 2308 dbantsf:= dbantsf +1;
4 2309 dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
4 2310 d.op.data(2) extract 9; <*postlængde*>
4 2311 dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
4 2312 \f
4 2312 message opretspoolfil side 2 - 810526/cl;
4 2313
4 2313 <*returner*>
4 2314 d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
4 2315 d.op.data(4):= 2 shift 10 add fno; <*filref*>
4 2316 for i:= 5 step 1 until 8 do <*filnavn null*>
4 2317 d.op.data(i):= 0;
4 2318 d.op.data(9):= 0; <*status ok*>
4 2319
4 2319 <*+2*>
4 2320 <*tz*> if testbit24 and overvåget then <*zt*>
4 2321 <*tz*> begin <*zt*>
5 2322 <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
5 2323 <*tz*> pfdim(d.op.data); <*zt*>
5 2324 <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
5 2325 <*tz*> end; <*zt*>
4 2326 <*-2*>
4 2327
4 2327 signalch(d.op.retur,op,d.op.optype);
4 2328 if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
4 2329 end;
3 2330 goto trin1;
3 2331
3 2331 opretspool_trap:
3 2332 disable skriv_opret_spoolfil(zbillede,1);
3 2333
3 2333 end opretspoolfil;
2 2334 \f
2 2334 message opreteksternfil side 0 - 810526/cl;
2 2335
2 2335 procedure opreteksternfil;
2 2336 <* opretter og knytter en ekstern fil *>
2 2337
2 2337 begin
3 2338 integer array field op;
3 2339 integer status,s,i,fno,p_nøgle;
3 2340 integer array tail(1:10),zd(1:20);
3 2341 real r;
3 2342 real array field enavn;
3 2343
3 2343 procedure skriv_opret_ekstfil(z,omfang);
3 2344 value omfang;
3 2345 zone z;
3 2346 integer omfang;
3 2347 begin
4 2348 write(z,"nl",1,<:+++ opret ekstern fil :>);
4 2349 if omfang > 0 then
4 2350 disable
4 2351 begin real array field raf;
5 2352 skriv_coru(z,abs curr_coruno);
5 2353 write(z,"nl",1,<<d>,
5 2354 <:op :>,op,"nl",1,
5 2355 <:status :>,status,"nl",1,
5 2356 <:s :>,s,"nl",1,
5 2357 <:i :>,i,"nl",1,
5 2358 <:fno :>,fno,"nl",1,
5 2359 <:p-nøgle:>,p_nøgle,"nl",1,
5 2360 <::>);
5 2361 raf:= 0;
5 2362 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 2363 write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
5 2364 end;
4 2365 end skriv_opret_ekstfil;
3 2366 \f
3 2366 message opreteksternfil side 1 - 810526/cl;
3 2367
3 2367 stack_claim(if cm_test then 200 else 150);
3 2368
3 2368 signalbin(bs_kate_fri); <*initialiseres til åben*>
3 2369
3 2369 trap(opretekst_trap);
3 2370 <*+2*>
3 2371 <**> disable if testbit28 then
3 2372 <**> skriv_opret_ekstfil(out,0);
3 2373 <*-2*>
3 2374 trin1:
3 2375 waitch(cs_opret_eksternfil,op,true,-1);
3 2376
3 2376 trin2:
3 2377 wait(bs_kate_fri);
3 2378
3 2378 trin3:
3 2379 <*opret temporær fil og tilknyt den*>
3 2380 disable begin
4 2381
4 2381 enavn:= 8;
4 2382 <*opret*>
4 2383 open(zdummy,0,d.op.data.enavn,0);
4 2384 tail(1):= d.op.data(3); <*segant*>
4 2385 tail(2):= 1;
4 2386 tail(6):= systime(7,0,r); <*shortclock*>
4 2387 tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
4 2388 tail(8):= 0;
4 2389 tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
4 2390 tail(10):= d.op.data(1); <*postantal*>
4 2391 s:= monitor(40)create entry:(zdummy,0,tail);
4 2392 if s<>0 then
4 2393 begin
5 2394 if s=4 <*claims exeeded*> then
5 2395 begin
6 2396 status:= 4;
6 2397 fejlreaktion(1,s,<:create entry:>,1);
6 2398 goto returner;
6 2399 end;
5 2400 if s=3 <*navn ikke unikt*> then
5 2401 begin status:= 6; goto returner; end;
5 2402 fejlreaktion(1,s,<:create entry:>,0);
5 2403 end;
4 2404 \f
4 2404 message opreteksternfil side 2 - 810203/cl;
4 2405
4 2405 p_nøgle:= d.op.opkode shift (-12);
4 2406 s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
4 2407 if s<>0 then
4 2408 begin
5 2409 if s=6 then
5 2410 begin <*claims exeeded*>
6 2411 status:= 4;
6 2412 fejlreaktion(1,s,<:permanent entry:>,1);
6 2413 monitor(48)remove entry:(zdummy,0,tail);
6 2414 goto returner;
6 2415 end
5 2416 else fejlreaktion(1,s,<:permanent entry:>,0);
5 2417 end;
4 2418
4 2418 <*reserver*>
4 2419 s:= monitor(52)create areaprocess:(zdummy,0,zd);
4 2420 if s<>0 then
4 2421 begin
5 2422 fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
5 2423 status:= 4;
5 2424 monitor(48)remove entry:(zdummy,0,zd);
5 2425 goto returner;
5 2426 end;
4 2427
4 2427 s:= monitor(8)reserve:(zdummy,0,zd);
4 2428 if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
4 2429
4 2429 <*tilknyt*>
4 2430 dbantef:= dbantef +1;
4 2431 fno:= dbkatefri;
4 2432 dbkatefri:= dbkate(fno,2);
4 2433 dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
4 2434 dbkate(fno,2):= tail(1);
4 2435 getzone6(zdummy,zd);
4 2436 for i:= 2 step 1 until 5 do
4 2437 dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
4 2438 d.op.data(3):= tail(1);
4 2439 d.op.data(4):= 3 shift 10 +fno;
4 2440 status:= 0;
4 2441 \f
4 2441 message opreteksternfil side 3 - 810526/cl;
4 2442
4 2442 returner:
4 2443
4 2443 close(zdummy,false);
4 2444 d.op.data(9):= status;
4 2445
4 2445 <*+2*>
4 2446 <*tz*> if testbit24 and overvåget then <*zt*>
4 2447 <*tz*> begin <*zt*>
5 2448 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 2449 <*tz*> pfdim(d.op.data); <*zt*>
5 2450 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2451 <*tz*> end; <*zt*>
4 2452 <*-2*>
4 2453
4 2453 signalch(d.op.retur,op,d.op.optype);
4 2454 if dbantef<dbmaxef then signalbin(bs_kate_fri);
4 2455 end;
3 2456 goto trin1;
3 2457
3 2457 opretekst_trap:
3 2458 disable skriv_opret_ekstfil(zbillede,1);
3 2459
3 2459 end opreteksternfil;
2 2460
2 2460 \f
2 2460 message attention_erklæringer side 1 - 850820/cl;
2 2461
2 2461 integer
2 2462 tf_kommandotabel,
2 2463 cs_att_pulje,
2 2464 bs_fortsæt_adgang,
2 2465 att_proc_ref;
2 2466
2 2466 integer array
2 2467 att_flag,
2 2468 att_signal(1:att_maske_lgd//2);
2 2469
2 2469 integer array
2 2470 terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
2 2471 max_antal_operatører+max_antal_garageterminaler)),
2 2472 fortsæt(1:32);
2 2473 \f
2 2473 message procedure afslut_kommando side 1 - 810507/hko;
2 2474
2 2474 procedure afslut_kommando(op_ref);
2 2475 integer array field op_ref;
2 2476 begin integer nr,i,sem;
3 2477 i:= d.op_ref.kilde;
3 2478 nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
3 2479 else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
3 2480 sætbit_ia(att_flag,nr,0);
3 2481 d.op_ref.optype:=gen_optype;
3 2482 <* "husket" attention disabled ****************
3 2483 if sætbit_ia(att_signal,nr,0)=1 then
3 2484 begin
3 2485 sem:=if i=299 then cs_talevejsswitch else
3 2486 case i//100 of (cs_io_komm,cs_operatør(i mod 100),
3 2487 cs_garage(i mod 100));
3 2488 afslut_operation(op_ref,0);
3 2489 start_operation(op_ref,i,cs_att_pulje,0);
3 2490 signal_ch(sem,op_ref,gen_optype);
3 2491 end
3 2492 else
3 2493 ********************* disable "husket" attention *>
3 2494 afslut_operation(op_ref,cs_att_pulje);
3 2495 end;
2 2496 \f
2 2496 message procedure læs_store side 1 - 880919/cl;
2 2497
2 2497 integer procedure læs_store(z,c);
2 2498 zone z;
2 2499 integer c;
2 2500 begin
3 2501 læs_store:= readchar(z,c);
3 2502 if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
3 2503 end;
2 2504 \f
2 2504 message procedure param side 1 - 810226/cl;
2 2505
2 2505
2 2505
2 2505 integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
2 2506 value tabel_id;
2 2507 integer pos, tabel_id, type, sep;
2 2508 integer array txt, spec, værdi;
2 2509
2 2509
2 2509
2 2509 <*************************************>
2 2510 <* *>
2 2511 <* CLAUS LARSEN: 15.07.77 *>
2 2512 <* *>
2 2513 <*************************************>
2 2514
2 2514
2 2514
2 2514
2 2514 <* param syntax-analyserer en parameterliste, og *>
2 2515 <* bestemmer næste parameter og den separator der *>
2 2516 <* afslutter parameteren *>
2 2517
2 2517
2 2517
2 2517 begin
3 2518 integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
3 2519 real array indgang(1:2);
3 2520 integer i, j, tegn, tegn_pos, tal, hashnøgle,
3 2521 zone_nr, top, max_segm, start_segm, lpos;
3 2522 boolean minus, separator;
3 2523 lpos := pos;
3 2524 type:=-1;
3 2525 for i:=1 step 1 until 4 do værdi(i):=0;
3 2526 \f
3 2526 message procedure param side 2 - 810428/cl,hko;
3 2527
3 2527
3 2527
3 2527 <* grænsecheck for pos *>
3 2528 begin
4 2529 integer nedre, øvre;
4 2530
4 2530 nedre := system(3,øvre,txt);
4 2531 nedre := nedre * 3 - 2;
4 2532 øvre := øvre * 3;
4 2533 if lpos < (nedre - 1) or øvre < lpos then
4 2534 begin
5 2535 sep:= -1;
5 2536 param:= 5;
5 2537 goto slut;
5 2538 end;
4 2539
4 2539 <* er parameterlisten slut *>
4 2540 lpos:= lpos+1;
4 2541 læs_tegn(txt,lpos,tegn);
4 2542 if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
4 2543 begin
5 2544 lpos := lpos - 2;
5 2545 sep := tegn;
5 2546 param := 5;
5 2547
5 2547 goto slut;
5 2548 end else lpos:= lpos-1;
4 2549 end;
3 2550 \f
3 2550 message procedure param side 3 - 810428/cl;
3 2551
3 2551
3 2551 <* initialisering *>
3 2552 for i := 1 step 1 until 4 do
3 2553 aktuel_param(i) := 0;
3 2554 minus := separator := false;
3 2555
3 2555 <* initialiser klassetabel *>
3 2556 for i := 65 step 1 until 93,
3 2557 97 step 1 until 125 do klasse(i) := 1;
3 2558 for i := 48 step 1 until 57 do klasse(i) := 2;
3 2559 for i := 0 step 1 until 47, 58 step 1 until 64,
3 2560 94, 95, 96, 126, 127 do klasse(i) := 4;
3 2561
3 2561
3 2561 <* sæt specialtegn *>
3 2562 i := 1;
3 2563 læs_tegn(spec,i,tegn);
3 2564 while tegn <> 0 do
3 2565 begin
4 2566 if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
4 2567 klasse(tegn) := 3;
4 2568 læs_tegn(spec,i,tegn);
4 2569 end;
3 2570 \f
3 2570 message procedure param side 4 - 810226/cl;
3 2571
3 2571
3 2571 <* læs første tegn i ny parameter og bestem typen *>
3 2572 læs_tegn(txt,lpos,tegn);
3 2573
3 2573 case klasse(tegn) of
3 2574 begin
4 2575
4 2575 <* case 1 - bogstav *>
4 2576 begin
5 2577 type := 0;
5 2578 param := 0;
5 2579 tegn_pos := 1;
5 2580 hashnøgle := 0;
5 2581
5 2581 <* læs parameter *>
5 2582 while tegn_pos < 12 and klasse(tegn) <> 4 do
5 2583 begin
6 2584 hashnøgle := hashnøgle + tegn;
6 2585 skriv_tegn(aktuel_param,tegn_pos,tegn);
6 2586 læs_tegn(txt,lpos,tegn);
6 2587 end;
5 2588
5 2588 <* find separator *>
5 2589 while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
5 2590 sep := tegn;
5 2591 \f
5 2591 message procedure param side 5 - 810226/cl;
5 2592
5 2592 <* tabelopslag *>
5 2593 if tabel_id <> 0 then
5 2594 begin
6 2595 <* hent max_segm *>
6 2596
6 2596 fdim(4) := tabel_id;
6 2597 j := hent_fil_dim(fdim);
6 2598 if j > 0 then
6 2599 begin
7 2600 param := 4;
7 2601 for i := 1 step 1 until 4 do
7 2602 værdi(i) := aktuel_param(i);
7 2603 goto slut;
7 2604 end;
6 2605 max_segm := fdim(3);
6 2606
6 2606 <* forbered opslag *>
6 2607 start_segm := (hashnøgle mod max_segm) + 1;
6 2608 indgang(1) := 0.0 shift 48 add aktuel_param(1)
6 2609 shift 24 add aktuel_param(2);
6 2610 indgang(2) := 0.0 shift 48 add aktuel_param(3)
6 2611 shift 24 add aktuel_param(4);
6 2612 hashnøgle := start_segm;
6 2613 \f
6 2613 message procedure param side 6 - 810226/cl;
6 2614
6 2614 <* søg navn *>
6 2615 repeat
6 2616 <* læs segment *>
6 2617 læs_fil(tabel_id,hashnøgle,zone_nr);
6 2618
6 2618 <* beregn sidste element *>
6 2619 top := fil(zone_nr,1) extract 24;
6 2620 top := (top - 1) * 4 + 2;
6 2621
6 2621 <* søg *>
6 2622 for i := 2 step 4 until top do
6 2623 if fil(zone_nr,i) = indgang(1) and
6 2624 fil(zone_nr,i+1) = indgang(2) then
6 2625 begin
7 2626 <* fundet *>
7 2627 værdi(1) := fil(zone_nr,i+2) shift (-24)
7 2628 extract 24;
7 2629 værdi(2) := fil(zone_nr,i+2) extract 24;
7 2630 værdi(3) := fil(zone_nr,i+3) shift (-24)
7 2631 extract 24;
7 2632 værdi(4) := fil(zone_nr,i+3) extract 24;
7 2633 goto fundet;
7 2634 end;
6 2635
6 2635 if top = 122 then <*overløb *>
6 2636 hashnøgle := (hashnøgle mod max_segm) + 1;
6 2637 until top < 122 or hashnøgle = start_segm;
6 2638
6 2638 <* navn findes ikke *>
6 2639 param := 2;
6 2640 for j := 1 step 1 until 4 do
6 2641 værdi(j) := aktuel_param(j);
6 2642 fundet: ;
6 2643 end <*tabel_id <> 0 *>
5 2644 else
5 2645 for i := 1 step 1 until 4 do
5 2646 værdi(i) := aktuel_param(i);
5 2647 end <* case 1 *>;
4 2648 \f
4 2648 message procedure param side 7 - 810310/cl,hko;
4 2649
4 2649 <* case 2 - ciffer *>
4 2650 cif: begin
5 2651 type:=tal := 0;
5 2652 while klasse(tegn) = 2 do
5 2653 begin
6 2654 type:=type+1;
6 2655 tal := tal * 10 + (tegn - 48);
6 2656 læs_tegn(txt,lpos,tegn);
6 2657 end;
5 2658 if minus then tal := -tal;
5 2659 værdi(1) := tal;
5 2660 sep := tegn;
5 2661 param := 0;
5 2662 end <* case 2 *>;
4 2663 \f
4 2663 message procedure param side 8 - 810428/cl;
4 2664
4 2664 <* case 3 - specialtegn *>
4 2665 spc: begin
5 2666 if tegn = '-' then
5 2667 begin
6 2668 læs_tegn(txt,lpos,tegn);
6 2669 if klasse(tegn) = 2 then
6 2670 begin
7 2671 minus := true;
7 2672 goto cif;
7 2673 end
6 2674 else
6 2675 begin
7 2676 tegn := '-';
7 2677 lpos := lpos - 1;
7 2678 end;
6 2679 end;
5 2680 <* syntaxfejl *>
5 2681 param := if separator then 1 else 3;
5 2682 sep := tegn;
5 2683 end <* case 3 *>;
4 2684
4 2684 <* case 4 - separator *>
4 2685 begin
5 2686 separator := true;
5 2687 goto spc;
5 2688 end <* case 4 *>;
4 2689
4 2689 end <* case *>;
3 2690
3 2690 lpos := lpos - 1;
3 2691 slut:
3 2692 pos := lpos;
3 2693 end;
2 2694 \f
2 2694 message procedure læs_param_sæt side 1 - 830310/cl;
2 2695
2 2695 integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
2 2696 integer array tekst, parm;
2 2697 integer pos,ant, term,res;
2 2698
2 2698 <* proceduren læser et sammenhørende sæt parametre
2 2699 afsluttet med (sp),(nl),(;),(,) eller (nul)
2 2700
2 2700 læs_param_sæt returstatus eller 'typen' af det læste parametersæt
2 2701 (retur,int)
2 2702 type ant parm indeholder:
2 2703 <0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
2 2704 0: 0 (ingenting) 'rest kommando er tom'
2 2705 1: 1 (tekst) 'indtil 11 tegn'
2 2706 2: 1 (pos.tal)
2 2707 3: 1 (neg.tal)
2 2708 4: 1 (pos.tal<1000)(bogstav) 'linienummer'
2 2709 5: 1 G(pos.tal<100) 'gruppe_ident'
2 2710 6: 2 (linie)/(løb) 'vogn_ident'
2 2711 7: 3 (bus)/(linie)/(løb)
2 2712 8: 3 (linie).(indeks):(løb)
2 2713 9: 2 (linie).(indeks)
2 2714 10: 2 (pos.tal).(pos.tal)
2 2715 11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
2 2716 12: 3 D.(dato).(tid)
2 2717
2 2717 tekst indeholder teksten hvori parametersættet
2 2718 (kald,int.arr.) skal søges.
2 2719
2 2719 pos
2 2720 (kald/retur,int.) position efter hvilken søgningen starter, og
2 2721 ved retur positionen for afsluttende tegn.
2 2722 (ikke ændret ved fejl)
2 2723
2 2723 ant hvis kaldeværdien er >0 skal parametersættet
2 2724 (kald/retur,int) indeholde det angivne antal enkeltparametre,
2 2725 i modsat fald returneres med fejltype -26
2 2726 (skilletegn) eller -25 (parameter mangler).
2 2727 ellers læses op til 3 enkeltparametre. retur-
2 2728 værdien afhænger af det læste parametersæts
2 2729 type, se ovenfor under læs_param_sæt.
2 2730 \f
2 2730 message procedure læs_param_sæt side 2 - 810428/hko;
2 2731
2 2731 parm skal omfatte elementerne 1 til 4.
2 2732 (retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
2 2733 terne værdien 0.
2 2734
2 2734 type (element,indhold)
2 2735 1: 1-4,teksten
2 2736 2-3: 1, talværdien
2 2737 4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
2 2738 5: 1, talværdi (uden G)
2 2739 6: 1, (som'4') shift 7 + løb
2 2740 7: 1, bus
2 2741 2, linie/løb som '6'
2 2742 8: 1, tal shift 5 eller som '4'
2 2743 2, tekst (1-3 bogstaver)
2 2744 3, løb
2 2745 9: 1 og 2, som '8'
2 2746 10: 1, talværdi
2 2747 2, talværdi
2 2748 11: 1, som '5'
2 2749 2, vogn (bus eller linie/løb)
2 2750 12: 1, dato
2 2751 2, tid
2 2752
2 2752 term iso-tegnværdien for tegnet der afslutter
2 2753 (retur,int) parameter_sættet.
2 2754
2 2754 res som læs_param_sæt.
2 2755 (retur,int)
2 2756
2 2756 *>
2 2757 \f
2 2757 message procedure læs_param_sæt side 3 - 810310/hko;
2 2758
2 2758 begin
3 2759 integer max_ant;
3 2760
3 2760 max_ant:= 3;
3 2761
3 2761 begin
4 2762 integer
4 2763 i,j,k, <* hjælpe variable *>
4 2764 nr, <* nummer på parameter i sættet *>
4 2765 apos, <* aktuel tegnposition *>
4 2766 cifre, <* parametertype (param: 0=tekst, >1=tal) *>
4 2767 sep; <* afsluttende skilletegn ved param *>
4 2768
4 2768 integer array field
4 2769 iaf; <* hjælpe variabel *>
4 2770
4 2770 integer array
4 2771 par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
4 2772 s, <* 1 element med separator for hver parameter *>
4 2773 t(1:max_ant), <* 1 element med typen for hver parameter *>
4 2774 værdi(1:4), <* værdi af aktuel parameter jvf. param *>
4 2775 spec(1:1); <* specialtegn i navne jvf. param *>
4 2776
4 2776 <* de interne typer af enkeltparametre er
4 2777
4 2777 type parameter
4 2778
4 2778 1: 1-3 tegn tekst (1 ord)
4 2779 2: 4-6 tegn (2 ord)
4 2780 3: 7-9 tegn (3 ord)
4 2781 4:10-11 tegn (4 ord)
4 2782 5: positivt heltal
4 2783 6: negativt heltal
4 2784 7: positivt heltal<1000 efterfulgt af stort bogstav
4 2785 8: G efterfulgt af positivt heltal<100
4 2786
4 2786 *>
4 2787 \f
4 2787 message procedure læs_param_sæt side 4 - 810408/hko;
4 2788
4 2788 nr:= 0;
4 2789 res:= -1;
4 2790 spec(1):= 0; <* ingen specialtegn *>
4 2791 apos:= pos;
4 2792 for i:= 1 step 1 until 4 do parm(i):= 0;
4 2793 for i:= 1 step 1 until max_ant do
4 2794 begin
5 2795 s(i):= t(i):= 0;
5 2796 for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
5 2797 end;
4 2798 repeat
4 2799 <* skip foranstillede sp-tegn *>
4 2800 for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
4 2801 while i=1 and sep='sp' do;
4 2802 <*+2*>
4 2803 begin
5 2804 if testbit25 and testbit26 then
5 2805 disable begin
6 2806 write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
6 2807 i,apos,cifre,sep);
6 2808 laf:=0;
6 2809 if cifre<>0 then
6 2810 write(out,<: værdi(1-4)::>,
6 2811 << -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
6 2812 else write(out,<: værdi::>,værdi.laf);
6 2813 ud;
6 2814 end;
5 2815 end;
4 2816 <*-2*>
4 2817 ;
4 2818 if i<>0 then <* ikke ok *>
4 2819 begin
5 2820 if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
5 2821 begin
6 2822 apos:= apos -1;
6 2823 res:= 0;
6 2824 end
5 2825 else if i=1 then res:=-26 <* skilletegn *>
5 2826 else <* i=5 *> res:= -25 <* parameter mangler *>
5 2827 end
4 2828 else <* i=0 *>
4 2829 begin
5 2830 if sep=',' or sep=';' then apos:=apos-1;
5 2831 iaf:= nr*8;
5 2832 nr:= nr +1;
5 2833 \f
5 2833 message procedure læs_param_sæt side 5 - 810520/hko/cl;
5 2834
5 2834 if cifre=0 <* navne_parameter *> then
5 2835 begin
6 2836 if værdi(2)=0
6 2837 and læstegn(værdi,1,i)='G'
6 2838 and læstegn(værdi,2,j)>'0' and j<='9'
6 2839 and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
6 2840 then
6 2841 begin <* gruppenavn, repræsenteres som tal *>
7 2842 t(nr):= 8;
7 2843 j:= j -'0';
7 2844 par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
7 2845 s(nr):= sep;
7 2846 end
6 2847 else
6 2848 begin <* generel tekst *>
7 2849 i:= 0;
7 2850 for i:= i +1 while i<=4 do
7 2851 begin
8 2852 if værdi(i)<>0 then
8 2853 begin
9 2854 t(nr):= i;
9 2855 par.iaf(i):= værdi(i);
9 2856 end
8 2857 else i:= 4;
8 2858 end;
7 2859 s(nr):= sep;
7 2860 end <* generel tekst *>
6 2861 end <* navne_parameter *>
5 2862 else
5 2863 begin <* talparameter *>
6 2864 i:= if værdi(1)<0 then 6 <* neg.tal *>
6 2865 else if værdi(1)>0 and værdi(1)<1000
6 2866 and sep>='A' and sep<='Å' then 7
6 2867 else 5 <* positivt tal *>;
6 2868 t(nr):= i;
6 2869 par.iaf(1):= if i<>7 then værdi(1)
6 2870 else værdi(1) shift 5 +(sep+1-'A');
6 2871 par.iaf(2):= cifre;
6 2872 apos:= apos+1;
6 2873 s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
6 2874 apos:= apos-1;
6 2875 end;
5 2876 end;<* i=0 *>
4 2877 until (ant>0 and nr=ant)
4 2878 or nr=max_ant
4 2879 or res<> -1
4 2880 or sep='sp' or sep=';' or sep='em'
4 2881 or sep=',' or sep='nl' or sep='nul';
4 2882 \f
4 2882 message procedure læs_param_sæt side 6 - 810508/hko;
4 2883
4 2883 if ant>nr then res:= -25 <*parameter mangler*>
4 2884 else
4 2885 if nr=0 or t(1)=0 then
4 2886 begin <* ingen parameter før skilletegn *>
5 2887 if res=-25 then res:= 0;
5 2888 end
4 2889 else if sep<>'sp' and sep<>'nl' and sep <> 'em'
4 2890 and sep<>';' and sep<>',' then
4 2891 begin <* ulovligt afsluttende skilletegn *>
5 2892 res:= -26;
5 2893 end
4 2894 else
4 2895 begin <* en eller flere lovligt afsluttede parametre *>
5 2896 if t(1)<5 and nr=1 then
5 2897
5 2897 <* 1 navne_parameter *>
5 2898
5 2898 begin
6 2899 res:= 1;
6 2900 tofrom(parm,par,8);
6 2901 end
5 2902 else if <*t(1)<9 and *> nr=1 then
5 2903
5 2903 <* 1 parameter af anden type *>
5 2904
5 2904 begin <*tal,linie eller gruppe *>
6 2905 res:= t(1) -3;
6 2906 parm(1):= par(1);
6 2907 end
5 2908 else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
5 2909
5 2909 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
5 2910
5 2910 begin
6 2911 i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
6 2912 j:= par(5); <* internt *>
6 2913 k:= par(9); <* *>
6 2914 if nr=2 then
6 2915 <* 2 parametre i sættet *>
6 2916 begin
7 2917 res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
7 2918 else if s(1)='.' and t(2)=1 then 9
7 2919 else if s(1)='-' and t(1)=5 and t(2)=5 then 10
7 2920 else if s(1)<>'/' and s(1)<>'.'
7 2921 and s(1)<>'-' then -26 <* skilletegn *>
7 2922 else -27;<* parametertype*>
7 2923 \f
7 2923 message procedure læs_param_sæt side 7 - 810501/hko;
7 2924
7 2924 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2925
7 2925 <* 2 parametre i sættet *>
7 2926 if res=6 then
7 2927 begin
8 2928 if (i<1 or i>999) and t(1)=5 then
8 2929 res:= -5 <* ulovligt linienr *>
8 2930 else if (j<1 or j>99) then
8 2931 res:= -6 <* ulovligt løbsnr *>
8 2932 else
8 2933 begin
9 2934 if t(1)=5 then i:= i shift 5;
9 2935 parm(1):= i shift 7 +j;
9 2936 end;
8 2937 end <* res=6 *>
7 2938 else if res=9 then
7 2939 begin
8 2940 if t(1)=5 and (i<1 or 999<i) then
8 2941 res:= -5 <*ulovligt linienr*>
8 2942 else
8 2943 begin
9 2944 if t(1)=5 then i:=i shift 5;
9 2945 parm(1):= i;
9 2946 parm(2):= j;
9 2947 end;
8 2948 end <* res=9 *>
7 2949 else if res=10 then
7 2950 begin
8 2951 begin
9 2952 parm(1):= i;
9 2953 parm(2):= j;
9 2954 end;
8 2955 end; <* res=10 *>
7 2956 end <* nr=2 *>
6 2957 else
6 2958 if nr=3 then
6 2959 <* 3 paramtre i sættet *>
6 2960 begin
7 2961 res:= if (s(1)='/' or s(1)='.') and
7 2962 (s(2)='/' or s(2)='.') then 7
7 2963 else if s(1)='.' and s(2)=':' then 8
7 2964 else -26; <* skilletegn *>
7 2965 \f
7 2965 message procedure læs_param_sæt side 8 - 810501/hko;
7 2966
7 2966 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2967 <* 3 parametre i sættet *>
7 2968 if res=7 then
7 2969 begin
8 2970 if t(1)<>5 or (t(2)<>5 and t(2)<>7)
8 2971 or t(3)<>5 then
8 2972 res:= -27 <* parametertype *>
8 2973 else
8 2974 if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
8 2975 else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
8 2976 else if k<1 or k>99 then res:= -6 <* løb *>
8 2977 else
8 2978 begin <* ok *>
9 2979 parm(1):= i;
9 2980 if t(2)=5 then j:= j shift 5;
9 2981 parm(2):= j shift 7 +k;
9 2982 end;
8 2983 end
7 2984 else if res=8 then
7 2985 begin
8 2986 if t(2)<>1 or t(3)<>5 then res:= -27
8 2987 else if t(1)=5 and (i<1 or i>999) then res:= -5
8 2988 else if k<1 or k>99 then res:= -6
8 2989 else
8 2990 begin
9 2991 if t(1)=5 then i:= i shift 5;
9 2992 parm(1):= i;
9 2993 parm(2):= j;
9 2994 parm(3):= k;
9 2995 end;
8 2996 end;
7 2997 end <* nr=3 *>
6 2998 else res:=-24; <* syntaks *>
6 2999 \f
6 2999 message procedure læs_param_sæt side 9 - 810428/hko;
6 3000
6 3000 end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
5 3001 else if t(1)=8 <* gruppe_id *> then
5 3002 begin
6 3003 <* mere end 1 parameter , hvoraf den første
6 3004 er en gruppe_identifikation ved navn.
6 3005 lovlige parametre er alle internt repræsenteret i et ord *>
6 3006
6 3006 i:=par(1);
6 3007 j:=par(5);
6 3008 k:=par(9);
6 3009
6 3009 if nr=2 then
6 3010 <* 2 parametre *>
6 3011 begin
7 3012 res:=if s(1)=':' and t(2)=5 then 11
7 3013 else if s(1)<>':' then -26 <* skilletegn *>
7 3014 else -27; <*param.type *>
7 3015 if res=11 then
7 3016 begin
8 3017 if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
8 3018 else
8 3019 begin
9 3020 parm(1):=i;
9 3021 parm(2):=j;
9 3022 end;
8 3023 end;
7 3024 \f
7 3024 message procedure læs_param_sæt side 10 - 810428/hko;
7 3025
7 3025 <* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
7 3026
7 3026 end <*nr=2*>
6 3027 else if nr=3 then
6 3028 <* 3 parametre *>
6 3029 begin
7 3030 res:=if s(1)=':' and s(2)='/' then 11
7 3031 else -26; <* skilletegn *>
7 3032 if res=11 then
7 3033 begin
8 3034 if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
8 3035 else
8 3036 begin
9 3037 if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
9 3038 else
9 3039 begin
10 3040 parm(1):=i;
10 3041 if t(2)=5 then j:=j shift 5;
10 3042 parm(2):= 1 shift 22 +j shift 7 +k;
10 3043 end;
9 3044 end;
8 3045 end;
7 3046 end <* nr=3 *>
6 3047 else res:=-24; <* syntaks *>
6 3048 \f
6 3048 message procedure læs_param_sæt side 11 - 810501/hko;
6 3049
6 3049 end <* t(1)=8 *>
5 3050 else if t(1)=1 and par(1)= 'D' shift 16 then
5 3051 begin
6 3052 <* mere end 1 parameter i sættet og 1. parameter er et 'D'.
6 3053 lovlige parametre er alle internt repræsenteret i et ord. *>
6 3054 i:=par(1);
6 3055 j:=par(5);
6 3056 k:=par(9);
6 3057
6 3057 if nr=3 then
6 3058 begin
7 3059 res:=if s(1)='.' and s(2)='.' then 12
7 3060 else -26; <* skilletegn *>
7 3061 if res=12 then
7 3062 begin
8 3063 if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
8 3064 else
8 3065 begin
9 3066 integer år,md,dg,tt,mm,ss;
9 3067 real dato,tid;
9 3068 år:=j//10000;
9 3069 md:=(j//100) mod 100;
9 3070 dg:=j mod 100;
9 3071 cifre:= par(10);
9 3072 tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
9 3073 else k;
9 3074 mm:=if cifre>4 then (k//100) mod 100
9 3075 else if cifre>2 then k mod 100 else 0;
9 3076 ss:=if cifre>4 then k mod 100 else 0;
9 3077 \f
9 3077 message procedure læs_param_sæt side 12 - 810501/hko;
9 3078
9 3078 dato:=systime(5,0.0,tid);
9 3079 if j=0 then dg:=round dato mod 100;
9 3080 if år=0 and md=0 then md:=(round dato//100) mod 100;
9 3081 if år=0 then år:=round dato//10000;
9 3082 if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
9 3083 res:=-24 <* syntaks *>
9 3084 else if dg<1 or dg > (case md of (
9 3085 31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
9 3086 31,31,30, 31,30,31)) then res:=-24
9 3087 else
9 3088 begin
10 3089 parm(1):=år*10000+md*100+dg;
10 3090 parm(2):=tt*10000+mm*100+ss;
10 3091 end;
9 3092 end;
8 3093
8 3093 end; <* res=12 *>
7 3094 end <* nr=3 *>
6 3095 else res:=-24; <*syntaks*>
6 3096 end <* t(1)=1 and par(1)='D' shift 16 *>
5 3097
5 3097 else res:=-27;<*parametertype*>
5 3098 end; <* en eller flere parametre *>
4 3099
4 3099 læs_param_sæt:= res;
4 3100 term:= sep;
4 3101 if res>= 0 then pos:= apos;
4 3102 end;
3 3103 end læs_param_sæt;
2 3104 \f
2 3104 message procedure læs_kommando side 1 - 810428/hko;
2 3105
2 3105 integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
2 3106 value kilde;
2 3107 zone z;
2 3108 integer kilde, pos,indeks,sep,slut_tegn;
2 3109 integer array field op_ref;
2 3110
2 3110 <* proceduren indlæser er kommmando fra en terminal (telex,
2 3111 skærm eller skrivemaskine). ved indlæsning fra skærm eller
2 3112 skrivemaskine inviteres først ved udskrivning af '>'-tegn.
2 3113 for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
2 3114 23'ende linie inden invitation.
2 3115 *>
2 3116 \f
2 3116 message procedure læs_kommando side 2 - 810428/hko;
2 3117
2 3117 begin
3 3118 integer
3 3119 a_pos,
3 3120 a_res,res,
3 3121 i,j,k;
3 3122 boolean
3 3123 skip;
3 3124
3 3124 <*V*>setposition(z,0,0);
3 3125
3 3125 case kilde//100 of
3 3126 begin
4 3127 begin <* io *>
5 3128 write(z,"nl",1,">",1);
5 3129 end;
4 3130
4 3130 begin <* operatør *>
5 3131 cursor(z,24,1);
5 3132 write(z,"esc" add 128,1,<:ÆK:>);
5 3133 cursor(z,23,1);
5 3134 write(z,"esc" add 128,1,<:ÆK:>);
5 3135 outchar(z,'>');
5 3136 end;
4 3137
4 3137 begin <* garageterminal *> ;
5 3138 outchar(z,'nl');
5 3139 end
4 3140 end;
3 3141
3 3141 <*V*>setposition(z,0,0);
3 3142 \f
3 3142 message procedure læs_kommando side 3 - 810921/hko,cl;
3 3143
3 3143 res:=0;
3 3144 skip:= false;
3 3145 <*V*>
3 3146 k:=læs_store(z,i);
3 3147
3 3147 apos:= 1;
3 3148 while k<=6 <*klasse=bogstav*> do
3 3149 begin
4 3150 if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
4 3151 <*V*> k:= læs_store(z,i);
4 3152 end;
3 3153
3 3153 skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
3 3154
3 3154 if i=',' and a_pos>1 then
3 3155 begin
4 3156 skrivtegn(d.op_ref.data,a_pos,i);
4 3157 repeat
4 3158 <*V*> k:= læs_store(z,i);
4 3159 if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
4 3160 until k>=7;
4 3161 end;
3 3162
3 3162 pos:=a_pos;
3 3163 while k<8 do
3 3164 begin
4 3165 if a_pos< (att_op_længde//2*3-2) then
4 3166 skriv_tegn(d.op_ref.data,a_pos,i);
4 3167 skip:= skip or i='?';
4 3168 <*V*> k:= læs_store(z,i);
4 3169 pos:=pos+1;
4 3170 end;
3 3171
3 3171 skip:= skip or i='?' or i='esc';
3 3172 slut_tegn:= i;
3 3173 skrivtegn(d.op_ref.data,apos,'em');
3 3174 afslut_text(d.op_ref.data,apos);
3 3175 \f
3 3175 message procedure læs_kommando side 4 - 820301/hko/cl;
3 3176
3 3176 disable
3 3177 begin
4 3178 integer
4 3179 i1,
4 3180 nr,
4 3181 partype,
4 3182 cifre;
4 3183 integer array
4 3184 spec(1:1),
4 3185 værdi(1:4);
4 3186
4 3186 <*+2*>
4 3187 if testbit25 and overvåget then
4 3188 disable begin
5 3189 real array field raf;
5 3190 write(out,"nl",1,<:kommando læst::>);
5 3191 laf:=data;
5 3192 write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
5 3193 <: skip=:>,if skip then <:true:> else <:false:>);
5 3194 ud;
5 3195 end;
4 3196 <*-2*>
4 3197
4 3197 for i:=1 step 1 until 32 do ia(i):=0;
4 3198
4 3198 if skip then
4 3199 begin
5 3200 res:=53; <*annulleret*>
5 3201 pos:= -1;
5 3202 goto slut_læskommando;
5 3203 end;
4 3204 \f
4 3204 message procedure læs_kommando side 5 - 850820/cl;
4 3205
4 3205 i:= kilde//100; <* hovedmodul *>
4 3206 k:= kilde mod 100; <* løbenr *>
4 3207 <* if pos>79 then linieoverløb; *>
4 3208 pos:=a_pos:=0;
4 3209 spec(1):= ',' shift 16;
4 3210
4 3210 <*+4*>
4 3211 if k<1 or k>(case i of (1,max_antal_operatører,
4 3212 max_antal_garageterminaler)) then
4 3213 begin
5 3214 fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
5 3215 res:=31;
5 3216 end
4 3217 else
4 3218 <*-4*>
4 3219 if i>0 and i<4 then <* io, operatør eller garageterminal *>
4 3220 begin
5 3221 <* læs operationskode *>
5 3222 j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
5 3223
5 3223 res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
5 3224 else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
5 3225 else if j=2 then 4 <*ukendt kommando*>
5 3226 else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
5 3227 else if sep<>'sp' and sep<>','
5 3228 and sep<>'nl' and sep<>';'
5 3229 and sep<>'nul' and sep<>'em' then 26
5 3230 <*skilletegn*>
5 3231 else if -, læsbit_i(værdi(4),i-1) then 4
5 3232 <* logand(extend 0 add værdi(4)
5 3233 extend 1 shift (case i of (0,k,8+k)))=0 then 4
5 3234 *> <*ukendt kommando*>
5 3235 else 1;
5 3236 \f
5 3236 message procedure læs_kommando side 5a- 810409/hko;
5 3237
5 3237 <*+2*>if testbit25 and overvåget then
5 3238 begin
6 3239 write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
6 3240 << -dddd>,j,apos,cifre,sep,res,
6 3241 <: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
6 3242 "nl",0);
6 3243 if j<>0 then skriv_op(out,op_ref);
6 3244 ud;
6 3245 end;
5 3246 <*-2*>
5 3247
5 3247 if res=31 then fejlreaktion(18<*tabelfil*>,j,
5 3248 <:=res, filnr 1025, læskommando:>,0);
5 3249
5 3249 if res=1 then <* operationskode ok *>
5 3250 begin
6 3251 if sep<>'sp' then apos:=apos-1;
6 3252 d.op_ref.opkode:=værdi(1);
6 3253 indeks:=værdi(2);
6 3254 partype:= værdi(3);
6 3255 nr:= 0;
6 3256 pos:= apos;
6 3257 \f
6 3257 message procedure læs_kommando side 6 - 810409/hko;
6 3258
6 3258 while res=1 do
6 3259 begin
7 3260 læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
7 3261 værdi,sep,a_res);
7 3262 nr:= nr +1;
7 3263 i1:= værdi(1);
7 3264 <*+2*> if testbit25 and overvåget then
7 3265 begin
8 3266 write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
8 3267 apos,sep,ares,<: værdi(1-4)::>,
8 3268 værdi(1),værdi(2),værdi(3),værdi(4),
8 3269 "nl",0);
8 3270 ud;
8 3271 end;
7 3272 <*-2*>
7 3273 case par_type of
7 3274 begin
8 3275
8 3275 <*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
8 3276
8 3276 begin
9 3277 if nr=1 then
9 3278 begin
10 3279 if a_res=0 then res:=2 <*godkendt*>
10 3280 else if a_res=2 and (i1<1 or i1>9999)
10 3281 then res:=7 <*busnr ulovligt*>
10 3282 else if a_res=2 or a_res=6 then
10 3283 begin
11 3284 ia(1):= if a_res=2 then i1
11 3285 else 1 shift 22 +i1;
11 3286 end
10 3287 else res:= 27; <*parametertype*>
10 3288 if res<4 then pos:= apos;
10 3289 end <*nr=1*>
9 3290 else
9 3291 if nr=2 then
9 3292 begin
10 3293 if ares=0 then res:= 2 <*godkendt*>
10 3294 else if ares=1 then
10 3295 begin
11 3296 ia(2):= find_område(i1);
11 3297 if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
11 3298 end
10 3299 else res:= 27; <* syntaks, parametertype *>
10 3300 end
9 3301 else
9 3302 if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
9 3303 end;
8 3304 \f
8 3304 message procedure læs_kommando side 7 - 810226/hko;
8 3305
8 3305 <*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
8 3306
8 3306 begin
9 3307 if nr=1 then
9 3308 begin
10 3309 if a_res=0 then res:=25 <*parameter mangler*>
10 3310 else if a_res=2 and (i1<1 or i1>9999)
10 3311 then res:=7 <*busnr ulovligt*>
10 3312 else if a_res=2 or a_res=6 then
10 3313 begin
11 3314 ia(1):=if a_res=2 then i1
11 3315 else 1 shift 22 +i1;
11 3316 end
10 3317 else res:= 27; <*parametertype*>
10 3318 if res<4 then pos:=a_pos;
10 3319 end
9 3320 else
9 3321 if nr=2 then
9 3322 begin
10 3323 if ares=0 then res:= 2 <*godkendt*> else
10 3324 if ares=1 and ia(1) shift (-21) = 0 then
10 3325 begin
11 3326 ia(2):= findområde(i1);
11 3327 if ia(2)=0 then res:= 56; <*område ukendt*>
11 3328 end
10 3329 else res:= 27;
10 3330 if res<4 then pos:= apos;
10 3331 end
9 3332 else
9 3333 if ares=0 then res:= 2 else res:= 24<*syntaks*>;
9 3334 end;
8 3335 \f
8 3335 message procedure læs_kommando side 8 - 810223/hko;
8 3336
8 3336 <*3: (<linie>!G<nr>) *>
8 3337
8 3337 begin
9 3338 if nr=1 then
9 3339 begin
10 3340 if a_res=0 then res:=25 <*parameter mangler*>
10 3341 else if a_res=2 and (i1<1 or i1>999) then res:=5
10 3342 <*linienr ulovligt*>
10 3343 else if a_res=2 or a_res=4 or a_res=5 then
10 3344 begin
11 3345 ia(1):=
11 3346 if a_res=2 then 4 shift 21 +i1 shift 5
11 3347 else if a_res=4 then 4 shift 21 +i1
11 3348 else <* a_res=5 *> 5 shift 21 +i1;
11 3349 end
10 3350 else res:=27; <* parametertype *>
10 3351 if res<4 then pos:= a_pos;
10 3352 end
9 3353 else
9 3354 res:= if nr=2 and a_res<>0 then 24<*syntaks*>
9 3355 else 2;<*godkendt*>
9 3356 end;
8 3357
8 3357 <*4: <ingenting> *>
8 3358
8 3358 begin
9 3359 res:= if a_res<>0 then 24<*syntaks*>
9 3360 else 2;<*godkendt*>
9 3361 end;
8 3362 \f
8 3362 message procedure læs_kommando side 9 - 810226/hko;
8 3363
8 3363 <*5: (<kanalnr>) *>
8 3364
8 3364 begin
9 3365 long field lf;
9 3366
9 3366 if nr=1 then
9 3367 begin
10 3368 if a_res=0 then res:= 25
10 3369 else if a_res<>1 then res:=27<*parametertype*>
10 3370 else
10 3371 begin
11 3372 j:= 0; lf:= 4;
11 3373 for i:= 1 step 1 until max_antal_kanaler do
11 3374 if kanal_navn(i)=værdi.lf then j:= i;
11 3375 if j<>0 then
11 3376 begin
12 3377 ia(1):= 3 shift 22 + j;
12 3378 res:= 2;
12 3379 end
11 3380 else
11 3381 res:= 17; <* kanal ukendt *>
11 3382 end;
10 3383 if res<4 then pos:= a_pos;
10 3384 end
9 3385 else
9 3386 res:=if nr=2 and a_res<>0 then 24<*syntaks*>
9 3387 else 2;<*godkendt*>
9 3388 end;
8 3389 \f
8 3389 message procedure læs_kommando side 10 - 810415/hko;
8 3390
8 3390 <*6: <busnr>/<linie>/<løb> (<område>) *>
8 3391
8 3391 begin
9 3392 if nr=1 then
9 3393 begin
10 3394 if a_res=0 then res:=25<*parameter mangler*>
10 3395 else if a_res=7 then
10 3396 begin
11 3397 ia(1):= i1;
11 3398 ia(2):= 1 shift 22 + værdi(2);
11 3399 end
10 3400 else res:=27;<*parametertype*>
10 3401 if res<4 then pos:= apos;
10 3402 end
9 3403 else
9 3404 if nr=2 then
9 3405 begin
10 3406 if ares=0 then res:= 2 <*godkendt*> else
10 3407 if ares=1 then
10 3408 begin
11 3409 ia(3):= findområde(i1);
11 3410 if ia(3)=0 then res:= 56; <* område ukendt *>
11 3411 end
10 3412 else res:= 27; <*parametertype*>
10 3413 if res<4 then pos:= apos;
10 3414 end
9 3415 else
9 3416 if ares=0 then res:= 2 else res:= 24;
9 3417 end;
8 3418 \f
8 3418 message procedure læs_kommando side 11 - 810512/hko/cl;
8 3419
8 3419
8 3419 <* att_op_længde//2-2 *>
8 3420 <*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
8 3421 <* 1 *>
8 3422
8 3422 begin
9 3423 if nr=1 then
9 3424 begin
10 3425 if a_res=0 then res:=25 <*parameter mangler*>
10 3426 else if a_res=8 then
10 3427 begin
11 3428 ia(1):= 4 shift 21 + i1;
11 3429 ia(2):= værdi(2);
11 3430 ia(3):= værdi(3);
11 3431 indeks:= 3;
11 3432 end
10 3433 else res:=27;<*parametertype*>
10 3434 end
9 3435 else if nr<=att_op_længde//2-2 then
9 3436 begin
10 3437 if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
10 3438 else if a_res=0 then res:=25 <* parameter mangler *>
10 3439 else if a_res=10 then
10 3440 begin
11 3441 if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
11 3442 begin
12 3443 ia(nr+2):= i1 shift 12 + værdi(2);
12 3444 indeks:= nr +2;
12 3445 end
11 3446 else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
11 3447 else res:=6; <*løb-nr ulovligt*>
11 3448 end
10 3449 else res:=27;<*parametertype*>
10 3450 end
9 3451 else
9 3452 res:= if a_res=0 then 2 else 24;<* syntaks *>
9 3453 if res<4 then pos:=a_pos;
9 3454 end;
8 3455 \f
8 3455 message procedure læs_kommando side 12 - 810306/hko;
8 3456
8 3456 <*8: (<operatør>!<radiokanal>!<garageterminal>) *>
8 3457
8 3457 begin
9 3458 if nr=1 then
9 3459 begin
10 3460 if a_res=0 then res:=25 <* parameter mangler *>
10 3461 else if a_res=2 then
10 3462 begin
11 3463 j:=d.op_ref.opkode;
11 3464 ia(1):=i1;
11 3465 k:=(j+1)//2;
11 3466 if k<1 or k=3 or k>4 then
11 3467 fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
11 3468 else
11 3469 begin
12 3470 if k=4 then k:=3;
12 3471 if i1<1 or i1> (case k of
12 3472 (max_antal_operatører,max_antal_radiokanaler,
12 3473 max_antal_garageterminaler))
12 3474 then res:=case k of (28,29,17);
12 3475 end;
11 3476 end
10 3477 else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
10 3478 begin
11 3479 laf:= 0;
11 3480 ia(1):= find_bpl(værdi.laf(1));
11 3481 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3482 end
10 3483 else res:=27; <*parametertype*>
10 3484 end
9 3485 else
9 3486 if nr=2 and d.opref.opkode=1 then
9 3487 begin
10 3488 <* åbningstilstand for operatørplads *>
10 3489 if a_res=0 then res:= 2 <*godkendt*>
10 3490 else if a_res<>1 then res:= 27 <*parametertype*>
10 3491 else begin
11 3492 res:= 2<*godkendt*>;
11 3493 j:= værdi(1) shift (-16);
11 3494 if j='S' then ia(2):= 3 else
11 3495 if j<>'Å' then res:= 24; <*syntaks*>
11 3496 end;
10 3497 end
9 3498 else
9 3499 begin
10 3500 res:=if a_res=0 then 2 <* godkendt *>
10 3501 else 24;<* syntaks *>
10 3502 end;
9 3503 if res<4 then pos:=a_pos;
9 3504 end; <* partype 8 *>
8 3505 \f
8 3505 message procedure læs_kommando side 13 - 810306/hko;
8 3506
8 3506
8 3506 <* att_op_længde//2 *>
8 3507 <*9: <operatør>((+!-)<linienr>) *>
8 3508 <* 1 *>
8 3509
8 3509 begin
9 3510 if nr=1 then
9 3511 begin
10 3512 if a_res=0 then res:=25 <* parameter mangler *>
10 3513 else if a_res=2 then
10 3514 begin
11 3515 ia(1):=i1;
11 3516 if i1<1 or i1>max_antal_operatører then res:=28;
11 3517 end
10 3518 else if a_res=1 then
10 3519 begin
11 3520 laf:= 0;
11 3521 ia(1):= find_bpl(værdi.laf(1));
11 3522 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3523 end
10 3524 else res:=27; <* parametertype *>
10 3525 end
9 3526 else if nr<=att_op_længde//2 then
9 3527 begin <* nr>1 *>
10 3528 if a_res=0 then res:=(if nr>2 then 2 else 25)
10 3529 else if a_res=2 or a_res=3 then
10 3530 begin
11 3531 ia(nr):=i1; indeks:= nr;
11 3532 if i1=0 or abs(i1)>999 then res:=5;
11 3533 end
10 3534 else res:=27; <* parametertype *>
10 3535 if res<4 then pos:=a_pos;
10 3536 end
9 3537 else
9 3538 res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
9 3539 else 2;
9 3540 end; <* partype 9 *>
8 3541 \f
8 3541 message procedure læs_kommando side 14 - 810428/hko;
8 3542
8 3542 <* 2 *>
8 3543 <*10: (bus) *>
8 3544 <* 1 *>
8 3545
8 3545 begin
9 3546 if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
9 3547 else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
9 3548 else if a_res=0 then res:=2 <* godkendt *>
9 3549 else if a_res<>2 then res:=27 <* parametertype *>
9 3550 else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
9 3551 else
9 3552 ia(nr):=i1;
9 3553 end;
8 3554
8 3554 <* 5 *>
8 3555 <*11: (<linie>) *>
8 3556 <* 1 *>
8 3557
8 3557 begin
9 3558 if a_res=0 and nr=1 then res:=25
9 3559 else if a_res<>0 and nr>5 then res:=24
9 3560 else if a_res=0 then res:=2
9 3561 else if a_res<>2 and a_res<>4 then res:=27
9 3562 else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
9 3563 else
9 3564 ia(nr):=
9 3565 (if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
9 3566 end;
8 3567 \f
8 3567 message procedure læs_kommando side 15 - 810306/hko;
8 3568
8 3568 <*12: (<ingenting>!<navn>) *>
8 3569
8 3569 begin
9 3570 if nr=1 then
9 3571 begin
10 3572 if a_res=0 then res:=2 <*godkendt*>
10 3573 else if a_res=1 then
10 3574 tofrom(ia,værdi,8)
10 3575 else res:=27; <* parametertype *>
10 3576 end
9 3577 else
9 3578 res:=if a_res<>0 then 24 <* syntaks (for mange) *>
9 3579 else 2;
9 3580 end; <* partype 12 *>
8 3581 \f
8 3581 message procedure læs_kommando side 16 - 810512/hko/cl;
8 3582
8 3582 <* 15 *>
8 3583 <*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
8 3584 <* 1 *>
8 3585
8 3585 begin
9 3586 if nr=1 then
9 3587 begin
10 3588 if a_res=0 then res:=25 <* parameter mangler *>
10 3589 else
10 3590 if a_res=11 then
10 3591 begin
11 3592 ia(1):= 5 shift 21 + i1;
11 3593 ia(2):=værdi(2);
11 3594 indeks:= 2;
11 3595 end
10 3596 else res:=27; <* parametertype *>
10 3597 end
9 3598 else if nr<= att_op_længde//2-1 then
9 3599 begin
10 3600 if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
10 3601 else if a_res=0 then res:=25 <* parameter mangler *>
10 3602 else if ares=2 and (i1<1 or i1>9999) then
10 3603 res:= 7 <*busnr ulovligt*>
10 3604 else if a_res=2 or a_res=6 then
10 3605 begin
11 3606 ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
11 3607 indeks:= nr+1;
11 3608 end
10 3609 else res:=27; <* parametertype *>
10 3610 end
9 3611 else
9 3612 res:=if a_res=0 then 2 <*godkendt *>
9 3613 else 24;<* syntaks *>
9 3614 if res<4 then pos:=a_pos;
9 3615 end; <* partype 13 *>
8 3616 \f
8 3616 message procedure læs_kommando side 17 - 810311/hko;
8 3617
8 3617 <*14: <linie>.<indeks> *>
8 3618
8 3618 begin
9 3619 if nr=1 then
9 3620 begin
10 3621 if a_res=0 then res:=25 <* parameter mangler *>
10 3622 else if a_res=9 then
10 3623 begin
11 3624 ia(1):= 1 shift 23 +i1;
11 3625 ia(2):= værdi(2);
11 3626 end
10 3627 else res:=27; <* parametertype *>
10 3628 end
9 3629 else <* nr>1 *>
9 3630 res:= if a_res=0 then 2 <* godkendt *>
9 3631 else 24;<* syntaks *>
9 3632 end; <* partype 14 *>
8 3633 \f
8 3633 message procedure læs_kommando side 18 - 810313/hko;
8 3634
8 3634 <*15: <linie>.<indeks> <bus> *>
8 3635
8 3635 begin
9 3636 if nr=1 then
9 3637 begin
10 3638 if a_res=0 then res:= 25 <* parameter mangler *>
10 3639 else if a_res=9 then
10 3640 begin
11 3641 ia(1):= 1 shift 23 +i1;
11 3642 ia(2):= værdi(2);
11 3643 end
10 3644 else res:=27; <* parametertype *>
10 3645 end
9 3646 else if nr=2 then
9 3647 begin
10 3648 if a_res=0 then res:=25
10 3649 else if a_res=2 then
10 3650 begin
11 3651 if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
11 3652 else ia(3):= i1;
11 3653 end
10 3654 else res:=27; <*parametertype *>
10 3655 end
9 3656 else
9 3657 res:=if a_res=0 then 2 <* godkendt *>
9 3658 else 24;<* syntaks *>
9 3659 if res<4 then pos:=a_pos;
9 3660 end; <* partype 15 *>
8 3661 \f
8 3661 message procedure læs_kommando side 19 - 810311/hko;
8 3662
8 3662 <*16: (<ingenting>!D.<dato>.<klokkeslet> *>
8 3663
8 3663 begin
9 3664 if nr=1 then
9 3665 begin
10 3666 if a_res=0 then res:=2 <* godkendt *>
10 3667 else if a_res=12 then
10 3668 begin
11 3669 raf:=0;
11 3670 ia.raf(1):= systid(i1,værdi(2));
11 3671 end
10 3672 else res:=27; <* parametertype *>
10 3673 end
9 3674 else
9 3675 res:= if a_res=0 then 2 <* godkendt *>
9 3676 else 24;<* syntaks *>
9 3677 if res<4 then pos:=a_pos;
9 3678 end; <* partype 16 *>
8 3679 \f
8 3679 message procedure læs_kommando side 20 - 810511/hko;
8 3680
8 3680 <*17: G<grp.nr> *>
8 3681
8 3681 begin
9 3682 if nr=1 then
9 3683 begin
10 3684 if a_res=0 then res:=25 <*parameter mangler *>
10 3685 else if a_res=5 then
10 3686 begin
11 3687 ia(1):= 5 shift 21 +i1;
11 3688 end
10 3689 else res:=27; <* parametertype *>
10 3690 end
9 3691 else
9 3692 res:= if a_res=0 then 2 <* godkendt *>
9 3693 else 24;<* syntaks *>
9 3694 end; <* partype 17 *>
8 3695
8 3695 <* att_op_længde//2 *>
8 3696 <*18: (<heltal>) *>
8 3697 <* 1 *>
8 3698
8 3698 begin
9 3699 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3700 else
9 3701 if nr<=att_op_længde//2 then
9 3702 begin
10 3703 if a_res=2 or a_res=3 <* pos/neg heltal *> then
10 3704 begin
11 3705 ia(nr):= i1; indeks:= nr;
11 3706 end
10 3707 else if a_res=0 then res:= 2
10 3708 else res:= 27; <*parametertype*>
10 3709 end
9 3710 else
9 3711 res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
9 3712 end;
8 3713 \f
8 3713 message procedure læs_kommando side 21 - 820302/cl;
8 3714
8 3714 <*19: <linie>/<løb> <linie>/<løb> *>
8 3715
8 3715 begin
9 3716 if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3717 else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
9 3718 else if nr<3 then
9 3719 begin
10 3720 ia(nr):=i1 + 1 shift 22;
10 3721 end
9 3722 else
9 3723 res:= if a_res=0 then 2 <*godkendt*>
9 3724 else 24;<*syntaks (for mange)*>
9 3725 if res<4 then pos:= a_pos;
9 3726 end; <* partype 19 *>
8 3727
8 3727 <*20: <busnr> <kortnavn> *>
8 3728 begin
9 3729 if nr=1 then
9 3730 begin
10 3731 if ares=0 then res:= 25 else
10 3732 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3733 if ares<>2 then res:= 27 else ia(1):= i1;
10 3734 end
9 3735 else
9 3736 if nr=2 then
9 3737 begin
10 3738 if ares=1 and værdi(2) extract 8 = 0 then
10 3739 begin
11 3740 ia(2):= værdi(1); ia(3):= værdi(2);
11 3741 end
10 3742 else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
10 3743 end
9 3744 else
9 3745 if ares=0 then res:= 2 else res:= 24;
9 3746 end; <* partype 20 *>
8 3747 \f
8 3747 message procedure læs_kommando side 22 - 851001/cl;
8 3748
8 3748 <* 2 *>
8 3749 <*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
8 3750 <* 0 *>
8 3751
8 3751 begin
9 3752 laf:= 0;
9 3753 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3754 else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
9 3755 else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
9 3756 else if a_res=0 then res:= 2 <*godkendt*>
9 3757 else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
9 3758 else if (a_res=2 or a_res=4) and nr<=2 then
9 3759 begin
10 3760 if ia(3)<>0 then res:= 27 else
10 3761 ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
10 3762 end
9 3763 else
9 3764 if ares=1 then
9 3765 begin
10 3766 if nr=1 then
10 3767 begin
11 3768 ia(1):= (4 shift 21) + (1 shift 5);
11 3769 ia(2):= (4 shift 21) + (999 shift 5);
11 3770 end;
10 3771 if ia(3)=-2 then
10 3772 begin
11 3773 if i1=long<:ALL:> shift (-24) extract 24 then
11 3774 ia(3):= -1
11 3775 else
11 3776 begin
12 3777 ia(3):= findområde(i1);
12 3778 if ia(3)=0 then res:= 56 else
12 3779 ia(3):= 14 shift 20 + ia(3);
12 3780 end;
11 3781 end
10 3782 else
10 3783 if ia(3) = 0 then
10 3784 begin
11 3785 if i1 = long<:OMR:> shift (-24) extract (24) then
11 3786 ia(3):= -2
11 3787 else
11 3788 ia(3):= find_bpl(værdi.laf(1));
11 3789 if ia(3)=0 then res:= 55;
11 3790 end
10 3791 else res:= 24;
10 3792 end
9 3793 else res:= 27; <*parametertype*>
9 3794 if res<4 then pos:= apos;
9 3795 end;
8 3796
8 3796 <*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
8 3797
8 3797 begin
9 3798 if nr=1 then
9 3799 begin
10 3800 if ares=0 then res:= 25 <*parameter mangler*>
10 3801 else if ares=2 and (i1<1 or i1>9999)
10 3802 then res:= 7 <* busnr ulovligt *>
10 3803 else if ares=2 or ares=6 then
10 3804 begin
11 3805 ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
11 3806 end
10 3807 else res:= 27 <* parametertype *>
10 3808 end
9 3809 else
9 3810 if nr=2 then
9 3811 begin
10 3812 if ares=0 then res:= 2 <* godkendt *>
10 3813 else if ares=1 then
10 3814 begin
11 3815 ia(2):= findområde(i1);
11 3816 if ia(2)=0 then res:= 17 <*kanal ukendt*>
11 3817 end
10 3818 else
10 3819 res:= 27; <* parametertype *>
10 3820 end
9 3821 else if ares=0 then res:= 2 <*godkendt*>
9 3822 else res:= 24; <*syntaks*>
9 3823 if res < 4 then pos:= apos;
9 3824 end;
8 3825
8 3825 <*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
8 3826
8 3826 begin
9 3827 if nr=1 then
9 3828 begin
10 3829 if ares=0 then res:= 25 else
10 3830 if ares=2 and (i1<1 or i1>999) then res:= 5 else
10 3831 if ares=2 or ares=4 or ares=5 then
10 3832 begin
11 3833 ia(1):=
11 3834 if ares=2 then 4 shift 21 + i1 shift 5 else
11 3835 if ares=4 then 4 shift 21 + i1 else
11 3836 5 shift 21 + i1;
11 3837 end
10 3838 else res:= 27;
10 3839 if res < 4 then pos:= apos;
10 3840 end
9 3841 else
9 3842 if nr=2 then
9 3843 begin
10 3844 if ares=0 then res:= 2 else
10 3845 if ares=1 then
10 3846 begin
11 3847 ia(2):= findområde(i1);
11 3848 if ia(2)=0 then res:= 17;
11 3849 end
10 3850 else res:= 27;
10 3851 end
9 3852 else
9 3853 if ares=0 then res:= 2 else res:= 24;
9 3854 end;
8 3855
8 3855 <*24: ( <ingenting> ! <område> ! * ) *>
8 3856
8 3856 begin
9 3857 if nr=1 then
9 3858 begin
10 3859 if ares=0 then res:= 2 else
10 3860 if ares=1 then
10 3861 begin
11 3862 if i1=long<:ALL:> shift (-24) extract 24 then
11 3863 ia(1):= (-1) shift (-3) shift 3
11 3864 else
11 3865 begin
12 3866 k:= findområde(i1);
12 3867 if k=0 then res:= 17 else
12 3868 ia(1):= 14 shift 20 + k;
12 3869 end;
11 3870 end
10 3871 else res:= 27;
10 3872 end
9 3873 else
9 3874 if ares=0 then res:= 2 else res:= 24;
9 3875 if res < 4 then pos:= apos;
9 3876 end;
8 3877
8 3877 <*25: <område> *>
8 3878
8 3878 begin
9 3879 if nr=1 then
9 3880 begin
10 3881 if ares=0 then res:= 25 else
10 3882 if ares=1 then
10 3883 begin
11 3884 if i1 = '*' shift 16 then ia(1):= -1 else
11 3885 ia(1):= findområde(i1);
11 3886 if ia(1)=0 then res:= 17;
11 3887 end
10 3888 else res:= 27;
10 3889 end
9 3890 else
9 3891 if ares=0 then res:= 2 else res:= 24;
9 3892 if res < 4 then pos:= apos;
9 3893 end;
8 3894
8 3894 <*26: <busnr> *>
8 3895 begin
9 3896 if nr=1 then
9 3897 begin
10 3898 if ares=0 then res:= 25 else
10 3899 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3900 if ares<>2 then res:= 27 else ia(1):= i1;
10 3901 end
9 3902 else
9 3903 if ares=0 then res:= 2 else res:= 24;
9 3904 end;
8 3905
8 3905 <* 8 *>
8 3906 <*27: <operatørnr> (<område>) *>
8 3907 <* 1 *>
8 3908 begin
9 3909 if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3910 else if nr=1 then
9 3911 begin
10 3912 if a_res=2 then
10 3913 begin
11 3914 ia(1):= i1;
11 3915 if i1 < 0 or max_antal_operatører < i1 then res:= 28;
11 3916 end
10 3917 else if a_res=1 then
10 3918 begin
11 3919 laf:= 0;
11 3920 ia(1):= find_bpl(værdi.laf(1));
11 3921 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3922 end
10 3923 else res:= 27; <*parametertype*>
10 3924 end
9 3925 else
9 3926 begin
10 3927 if a_res=0 then res:= (if nr > 2 then 2 else 25)
10 3928 else if nr > 9 then res:= 24
10 3929 else if a_res=1 then
10 3930 begin
11 3931 ia(nr):= find_område(i1);
11 3932 indeks:= nr;
11 3933 if ia(nr)=0 then res:= 56;
11 3934 end
10 3935 else res:= 27;
10 3936 end;
9 3937 if res < 4 then pos:= a_pos;
9 3938 end <* partype 27 *>;
8 3939
8 3939 <*28: (<ingenting>!<kanalnr>) *>
8 3940 begin
9 3941 long field lf;
9 3942
9 3942 if nr=1 then
9 3943 begin
10 3944 if ares=0 then res:= 2 else
10 3945 if ares=1 then
10 3946 begin
11 3947 j:= 0; lf:= 4;
11 3948 for i:= 1 step 1 until max_antal_kanaler do
11 3949 if kanal_navn(i)=værdi.lf then j:= i;
11 3950 if j<>0 then
11 3951 begin
12 3952 ia(1):= 3 shift 22 + j;
12 3953 res:= 2;
12 3954 end
11 3955 else
11 3956 res:= 17; <*kanal ukendt*>
11 3957 end
10 3958 else
10 3959 res:= 27; <*parametertype*>
10 3960 if res < 4 then pos:= apos;
10 3961 end
9 3962 else
9 3963 res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
9 3964 end;
8 3965
8 3965 <* n *>
8 3966 <*29: <btj.pl.navn> ( <operatørnavn>) *>
8 3967 <* 0 *>
8 3968 begin
9 3969 laf:= 0;
9 3970 if nr=1 then
9 3971 begin
10 3972 if a_res=0 then res:= 25 <*parameter mangler*>
10 3973 else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
10 3974 else begin
11 3975 indeks:= 2;
11 3976 ia(1):= værdi(1); ia(2):= værdi(2);
11 3977 j:= find_bpl(værdi.laf(1));
11 3978 if 0<j and j<=max_antal_operatører then
11 3979 res:= 62; <*ulovligt navn*>
11 3980 end;
10 3981 end
9 3982 else
9 3983 begin
10 3984 if a_res=0 then res:= 2 <*godkendt*>
10 3985 else if a_res<>1 then res:= 27 <*parametertype*>
10 3986 else begin
11 3987 indeks:= indeks+1;
11 3988 ia(indeks):= find_bpl(værdi.laf(1));
11 3989 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3990 res:= 28; <*ukendt operatør*>
11 3991 end;
10 3992 end;
9 3993 if res<4 then pos:= a_pos;
9 3994 end;
8 3995
8 3995 <* 3 *>
8 3996 <*30: (<operatørnavn>) ( <btj.pl.navn>) *>
8 3997 <* io 0 *>
8 3998
8 3998 begin
9 3999 boolean io;
9 4000
9 4000 io:= (kilde//100 = 1);
9 4001 laf:= 0;
9 4002 if -,io and nr=1 then
9 4003 begin
10 4004 indeks:= 1;
10 4005 ia(1):= kilde mod 100; <*egen operatørplads*>
10 4006 end;
9 4007
9 4007 if io and nr=1 then
9 4008 begin
10 4009 if a_res=0 then res:= 25 <*parameter mangler*>
10 4010 else if a_res<>1 then res:= 27 <*parametertype*>
10 4011 else begin
11 4012 indeks:= nr;
11 4013 ia(indeks):= find_bpl(værdi.laf(1));
11 4014 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 4015 res:= 28; <*ukendt operatør*>
11 4016 end;
10 4017 end
9 4018 else
9 4019 begin
10 4020 if a_res=0 then res:= 2<*godkendt*>
10 4021 else if indeks=4 then res:= 24 <*syntaks, for mange*>
10 4022 else if a_res<>1 then res:= 27 <*parametertype*>
10 4023 else begin
11 4024 indeks:= indeks+1;
11 4025 ia(indeks):= find_bpl(værdi.laf(1));
11 4026 if ia(indeks)=0 then res:= 46 <*navn ukendt*>
11 4027 else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
11 4028 end;
10 4029 end;
9 4030 if res<4 then pos:= a_pos;
9 4031 end;
8 4032
8 4032 <* *>
8 4033 <*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
8 4034 <* *>
8 4035
8 4035 begin
9 4036 laf:= 0;
9 4037 if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
9 4038 else
9 4039 if nr=1 then
9 4040 begin
10 4041 if a_res=2 then
10 4042 begin
11 4043 ia(1):= i1;
11 4044 if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
11 4045 end else res:= 27; <*parametertype*>
10 4046 end
9 4047 else
9 4048 if nr=2 then
9 4049 begin
10 4050 if a_res=1 and værdi(2) extract 8 = 0 then
10 4051 begin
11 4052 ia(2):= værdi(1); ia(3):= værdi(2);
11 4053 j:= find_bpl(værdi.laf(1));
11 4054 if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
11 4055 end
10 4056 else res:= if a_res=0 then 2 <*godkendt*>
10 4057 else 27 <*parametertype*>;
10 4058 end
9 4059 else
9 4060 if nr=3 then
9 4061 begin
10 4062 if a_res=0 then res:=2 <*godkendt*>
10 4063 else if a_res<>1 then res:= 27 <*parametertype*>
10 4064 else begin
11 4065 j:= værdi(1) shift (-16);
11 4066 if j='Å' then ia(4):= 1 else
11 4067 if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
11 4068 end;
10 4069 end
9 4070 else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
9 4071 if res<4 then pos:= a_pos;
9 4072 end;
8 4073
8 4073 <* 1 *>
8 4074 <*32: (heltal) *>
8 4075 <* 0 *>
8 4076 begin
9 4077 if nr=1 then
9 4078 begin
10 4079 if ares=0 then
10 4080 begin
11 4081 indeks:= 0; res:= 2;
11 4082 end
10 4083 else
10 4084 if ares=2 or ares=3 then
10 4085 begin
11 4086 ia(nr):= i1; indeks:= nr;
11 4087 end
10 4088 else res:=27; <*parametertype*>
10 4089 end
9 4090 else
9 4091 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4092 if res < 4 then pos:= a_pos;
9 4093 end;
8 4094
8 4094 <*33 generel tekst*>
8 4095 begin
9 4096 integer p,p1,ch,lgd;
9 4097
9 4097 if nr=1 and a_res<>0 then
9 4098 begin
10 4099 p:=pos; p1:=1;
10 4100 lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
10 4101 if 95<lgd then lgd:=95;
10 4102 repeat læstegn(d.opref.data,p,ch) until ch<>' ';
10 4103 while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
10 4104 begin
11 4105 skrivtegn(ia,p1,ch);
11 4106 læstegn(d.opref.data,p,ch);
11 4107 end;
10 4108 if p1=1 then res:= 25 else res:= 2;
10 4109 repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
10 4110 end
9 4111 else
9 4112 if a_res=0 then res:= 25 else res:= 24;
9 4113 end;
8 4114
8 4114 <*34: (heltal) *>
8 4115 begin
9 4116 if nr=1 then
9 4117 begin
10 4118 if ares=0 then res:= 25 else
10 4119 if ares=2 or ares=3 then
10 4120 begin
11 4121 ia(nr):= i1; indeks:= nr;
11 4122 end
10 4123 else res:=27; <*parametertype*>
10 4124 end
9 4125 else
9 4126 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4127 if res < 4 then pos:= a_pos;
9 4128 end;
8 4129
8 4129 <*+4*> begin
9 4130 fejlreaktion(4<*systemfejl*>,partype,
9 4131 <:parametertype fejl i kommandofil:>,1);
9 4132 res:=31;
9 4133 end
8 4134 <*-4*>
8 4135 end;<*case partype*>
7 4136 end;<* while læs_param_sæt *>
6 4137 end; <* operationskode ok *>
5 4138 end
4 4139 else
4 4140 begin
5 4141 fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
5 4142 end;
4 4143
4 4143 if a_res<0 then res:= -a_res;
4 4144 slut_læskommando:
4 4145
4 4145 læs_kommando:=d.op_ref.resultat:= res;
4 4146 end;<* disable-blok*>
3 4147 end læs_kommando;
2 4148 \f
2 4148 message procedure skriv_kvittering side 1 - 820301/hko/cl;
2 4149
2 4149 procedure skriv_kvittering(z,ref,pos,res);
2 4150 value ref,pos,res;
2 4151 zone z;
2 4152 integer ref,pos,res;
2 4153 begin
3 4154 integer array field op;
3 4155 integer pos1,tegn;
3 4156 op:=ref;
3 4157 if res<1 or res>3 then write(z,<:*** :>);
3 4158 write(z,case res+1 of (
3 4159 <* 0*><:ubehandlet:>,
3 4160 <* 1*><:ok:>,
3 4161 <* 2*><:godkendt:>,
3 4162 <* 3*><:udført:>,
3 4163 <* 4*><:kommando ukendt:>,
3 4164
3 4164 <* 5*><:linie-nr ulovligt:>,
3 4165 <* 6*><:løb-nr ulovligt:>,
3 4166 <* 7*><:bus-nr ulovligt:>,
3 4167 <* 8*><:gruppe ukendt:>,
3 4168 <* 9*><:linie/løb ukendt:>,
3 4169
3 4169 <*10*><:bus-nr ukendt:>,
3 4170 <*11*><:bus allerede indsat på :>,
3 4171 <*12*><:linie/løb allerede besat af :>,
3 4172 <*13*><:bus ikke indsat:>,
3 4173 <*14*><:bus optaget:>,
3 4174
3 4174 <*15*><:gruppe optaget:>,
3 4175 <*16*><:skærm optaget:>,
3 4176 <*17*><:kanal ukendt:>,
3 4177 <*18*><:bus i kø:>,
3 4178 <*19*><:kø er tom:>,
3 4179
3 4179 <*20*><:ej forbindelse :>,
3 4180 <*21*><:ingen at gennemstille til:>,
3 4181 <*22*><:ingen samtale at nedlægge:>,
3 4182 <*23*><:ingen samtale at monitere:>,
3 4183 <*24*><:syntaks:>,
3 4184
3 4184 <*25*><:syntaks, parameter mangler:>,
3 4185 <*26*><:syntaks, skilletegn:>,
3 4186 <*27*><:syntaks, parametertype:>,
3 4187 <*28*><:operatør ukendt:>,
3 4188 <*29*><:garageterminal ukendt:>,
3 4189 \f
3 4189
3 4189 <*30*><:rapport kan ikke dannes:>,
3 4190 <*31*><:systemfejl:>,
3 4191 <*32*><:ingen fri plads:>,
3 4192 <*33*><:gruppe for stor:>,
3 4193 <*34*><:gruppe allerede defineret:>,
3 4194
3 4194 <*35*><:springsekvens for stor:>,
3 4195 <*36*><:spring allerede defineret:>,
3 4196 <*37*><:spring ukendt:>,
3 4197 <*38*><:spring allerede igangsat:>,
3 4198 <*39*><:bus ikke reserveret:>,
3 4199
3 4199 <*40*><:gruppe ikke reserveret:>,
3 4200 <*41*><:spring ikke igangsat:>,
3 4201 <*42*><:intet frit linie/løb:>,
3 4202 <*43*><:ændring af dato/tid ikke lovlig:>,
3 4203 <*44*><:interval-størrelse ulovlig:>,
3 4204
3 4204 <*45*><:ikke implementeret:>,
3 4205 <*46*><:navn ukendt:>,
3 4206 <*47*><:forkert indhold:>,
3 4207 <*48*><:i brug:>,
3 4208 <*49*><:ingen samtale igang:>,
3 4209
3 4209 <*50*><:kanal:>,
3 4210 <*51*><:afvist:>,
3 4211 <*52*><:kanal optaget :>,
3 4212 <*53*><:annulleret:>,
3 4213 <*54*><:ingen busser at kalde op:>,
3 4214
3 4214 <*55*><:garagenavn ukendt:>,
3 4215 <*56*><:område ukendt:>,
3 4216 <*57*><:område nødvendigt:>,
3 4217 <*58*><:ulovligt område for bus:>,
3 4218 <*59*><:radiofejl :>,
3 4219
3 4219 <*60*><:område kan ikke opdateres:>,
3 4220 <*61*><:ingen talevej:>,
3 4221 <*62*><:ulovligt navn:>,
3 4222 <*63*><:alarmlængde: :>,
3 4223 <*64*><:ulovligt tal:>,
3 4224
3 4224 <*99*><:- <'?'> -:>));
3 4225 \f
3 4225 message procedure skriv_kvittering side 3 - 820301/hko;
3 4226 if res=3 and op<>0 then
3 4227 begin
4 4228 if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
4 4229 begin
5 4230 i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
5 4231 if i<>0 then write(z,i,<: udtaget:>);
5 4232 end;
4 4233 end;
3 4234 if res = 11 or res = 12 then
3 4235 i:=ref;
3 4236 if res=11 then write(z,i shift(-12) extract 10,
3 4237 if i shift(-7) extract 5 =0 then false
3 4238 else "A" add (i shift(-7) extract 5 -1),1,
3 4239 <:/:>,<<d>,i extract 7) else
3 4240 if res=12 then write(z,i extract 14) else
3 4241 if res = 20 or res = 52 or res = 59 then
3 4242 begin
4 4243 i:= d.op.data(12);
4 4244 if i <> 0 then skriv_id(z,i,8);
4 4245 i:=d.op.data(2);
4 4246 if i=0 then i:=d.op.data(9);
4 4247 if i=0 then i:=d.op.data(8);
4 4248 skriv_id(z,i,8);
4 4249 end;
3 4250 if res=63 then
3 4251 begin
4 4252 i:= ref;
4 4253 if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
4 4254 end;
3 4255
3 4255 if pos>=0 then
3 4256 begin
4 4257 pos:=pos+1;
4 4258 outchar(z,':');
4 4259 tegn:=-1;
4 4260 while tegn<>10 and tegn<>0 do
4 4261 outchar(z,læs_tegn(d.op.data,pos,tegn));
4 4262 end;
3 4263 <*V*>setposition(z,0,0);
3 4264 end skriv_kvittering;
2 4265 \f
2 4265 message procedure cursor, side 1 - 810213/hko;
2 4266
2 4266 procedure cursor(z,linie,pos);
2 4267 value linie,pos;
2 4268 zone z;
2 4269 integer linie,pos;
2 4270 begin
3 4271 if linie>0 and linie<25
3 4272 and pos>0 and pos<81 then
3 4273 begin
4 4274 write(z,"esc" add 128,1,<:Æ:>,
4 4275 <<d>,linie,<:;:>,pos,<:H:>);
4 4276 end;
3 4277 end cursor;
2 4278 \f
2 4278 message procedure attention side 1 - 810529/hko;
2 4279
2 4279 procedure attention;
2 4280 begin
3 4281 integer i, j, k;
3 4282 integer array field op_ref,mess_ref;
3 4283 integer array att_message(1:9);
3 4284 long array field laf1, laf2;
3 4285 boolean optaget;
3 4286 procedure skriv_attention(zud,omfang);
3 4287 integer omfang;
3 4288 zone zud;
3 4289 begin
4 4290 write(zud,"nl",1,<:+++ attention :>);
4 4291 if omfang <> 0 then
4 4292 disable begin integer x;
5 4293 trap(slut);
5 4294 write(zud,"nl",1,
5 4295 <: i: :>,i,"nl",1,
5 4296 <: j: :>,j,"nl",1,
5 4297 <: k: :>,k,"nl",1,
5 4298 <: op-ref: :>,op_ref,"nl",1,
5 4299 <: mess-ref: :>,mess_ref,"nl",1,
5 4300 <: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
5 4301 <: laf2 :>,laf2,"nl",1,
5 4302 <: att-message::>,"nl",1,
5 4303 <::>);
5 4304 raf:= 0;
5 4305 skriv_hele(zud,att_message.raf,18,127);
5 4306 skriv_coru(zud,coru_no(010));
5 4307 slut:
5 4308 end;
4 4309 end skriv_attention;
3 4310
3 4310 integer procedure udtag_tal(tekst,pos);
3 4311 long array tekst;
3 4312 integer pos;
3 4313 begin
4 4314 integer i;
4 4315
4 4315 if getnumber(tekst,pos,i) >= 0 then
4 4316 udtag_tal:= i
4 4317 else
4 4318 udtag_tal:= 0;
4 4319 end;
3 4320
3 4320 for i:= 1 step 1 until att_maske_lgd//2 do
3 4321 att_signal(i):=att_flag(i):=0;
3 4322 trap(att_trap);
3 4323 stack_claim((if cm_test then 198 else 146)+50);
3 4324 <*+2*>
3 4325 if testbit26 and overvåget or testbit28 then
3 4326 skriv_attention(out,0);
3 4327 <*-2*>
3 4328 \f
3 4328 message procedure attention side 2 - 810406/hko;
3 4329
3 4329 repeat
3 4330
3 4330 wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
3 4331
3 4331 repeat
3 4332 <*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
3 4333 raf:= laf1:= 0;
3 4334 laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
3 4335
3 4335 <*+2*>if testbit7 and overvåget then
3 4336 disable begin
4 4337 laf2:= abs(laf);
4 4338 write(out,"nl",1,<:attention - :>);
4 4339 if laf<=0 then write(out,<:Regrettet :>);
4 4340 write(out,<:Message modtaget fra :>);
4 4341 if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
4 4342 skriv_hele(out,att_message.raf,16,127);
4 4343 ud;
4 4344 end;
3 4345 <*-2*>
3 4346 \f
3 4346 message procedure attention side 3 - 830310/cl;
3 4347
3 4347 if laf <= 0 then
3 4348 i:= -1
3 4349 else
3 4350 if core.laf(1)=konsol_navn.laf1(1)
3 4351 and core.laf(2)=konsol_navn.laf1(2) then
3 4352 i:= 101
3 4353 else
3 4354 begin
4 4355 i:= -1; j:= 1;
4 4356 while i=(-1) and (j <= max_antal_operatører) do
4 4357 begin
5 4358 laf2:= (j-1)*8;
5 4359 if core.laf(1) = terminal_navn.laf2(1)
5 4360 and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
5 4361 j:= j+1;
5 4362 end;
4 4363 j:= 1;
4 4364 while i=(-1) and (j<=max_antal_garageterminaler) do
4 4365 begin
5 4366 laf2:= (j-1)*8;
5 4367 if core.laf(1) = garage_terminal_navn.laf2(1)
5 4368 and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
5 4369 j:= j+1;
5 4370 end;
4 4371 end;
3 4372
3 4372 if i=101 or (201<=i and i<=200+max_antal_operatører)
3 4373 <* or (301<=i and i<=300+max_antal_garageterminaler) *>
3 4374 then
3 4375 begin
4 4376
4 4376 j:= if i=101 then 0
4 4377 else max_antal_operatører*(i//100-2)+i mod 100;
4 4378
4 4378 ref:=j*terminal_beskr_længde;
4 4379 att_message(9):=
4 4380 if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
4 4381 else 4 <*disconnected*>;
4 4382 optaget:=læsbit_ia(att_flag,j);
4 4383 if optaget and att_message(9)=1 then
4 4384 sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
4 4385 else optaget:=optaget or att_message(9)<>1;
4 4386 if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
4 4387 begin <* att fra ekskluderet operatør - inkluder *>
5 4388 start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
5 4389 d.op_ref.data(1):= i mod 100;
5 4390 signalch(cs_rad,op_ref,gen_optype);
5 4391 waitch(cs_att_pulje,op_ref,true,-1);
5 4392 end;
4 4393 end
3 4394 else
3 4395 begin
4 4396 optaget:= true;
4 4397 att_message(9):= 2 <*rejected*>;
4 4398 end;
3 4399
3 4399 monitor(22)send_answer:(zdummy,mess_ref,att_message);
3 4400
3 4400 until -,optaget;
3 4401 \f
3 4401 message procedure attention side 4 - 810424/hko;
3 4402
3 4402 sætbit_ia(att_flag,j,1);
3 4403
3 4403 start_operation(op_ref,i,cs_att_pulje,0);
3 4404
3 4404 signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
3 4405
3 4405 until false;
3 4406
3 4406 att_trap:
3 4407
3 4407 skriv_attention(zbillede,1);
3 4408
3 4408
3 4408 end attention;
2 4409
2 4409 \f
2 4409 message io_erklæringer side 1 - 810421/hko;
2 4410
2 4410 integer
2 4411 cs_io,
2 4412 cs_io_komm,
2 4413 cs_io_fil,
2 4414 cs_io_spool,
2 4415 cs_io_medd,
2 4416 cs_io_nulstil,
2 4417 ss_io_spool_tomme,
2 4418 ss_io_spool_fulde,
2 4419 bs_zio_adgang,
2 4420 io_spool_fil,
2 4421 io_spool_postantal,
2 4422 io_spool_postlængde;
2 4423
2 4423 integer array field
2 4424 io_spool_post;
2 4425
2 4425 zone z_io(32,1,io_fejl);
2 4426
2 4426 procedure io_fejl(z,s,b);
2 4427 integer s,b;
2 4428 zone z;
2 4429 begin
3 4430 disable begin
4 4431 integer array iz(1:20);
4 4432 integer i,j,k;
4 4433 integer array field iaf;
4 4434 real array field raf;
4 4435 if s<>(1 shift 21 + 2) then
4 4436 begin
5 4437 getzone6(z,iz);
5 4438 raf:=2;
5 4439 iaf:=0;
5 4440 k:=1;
5 4441
5 4441 j:= terminal_tab.iaf.terminal_tilstand;
5 4442 if j shift(-21)<>6 then
5 4443 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
5 4444 1 shift 12 <*binært*> +1 <*fortsæt*>);
5 4445 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
5 4446 + terminal_tab.iaf.terminal_tilstand extract 21;
5 4447 end;
4 4448 z(1):=real <:<'?'><'?'><'em'>:>;
4 4449 b:=2;
4 4450 end; <*disable*>
3 4451 end io_fejl;
2 4452 \f
2 4452 message procedure skriv_auto_spring_medd side 1 - 820301/hko;
2 4453
2 4453 procedure skriv_auto_spring_medd(z,medd,tid);
2 4454 value tid;
2 4455 zone z;
2 4456 real tid;
2 4457 integer array medd;
2 4458 begin
3 4459 disable begin
4 4460 real t;
4 4461 integer kode,bus,linie,bogst,løb,dato,kl;
4 4462 long array indeks(1:1);
4 4463 kode:= medd(1);
4 4464 indeks(1):= extend medd(5) shift 24;
4 4465 if kode > 0 and kode < 10 then
4 4466 begin
5 4467 write(z,"nl",0,<:-<'>'>:>,case kode of(
5 4468 <*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
5 4469 <*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
5 4470 <*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
5 4471 <*4*><:vogn optaget:>, <* - i - - / - *>
5 4472 <*5*><:spring annulleret:>, <*udløb af ventetid *>
5 4473 <*6*><::>, <* - af springliste *>
5 4474 <*7*><::>, <*start af springsekvens *>
5 4475 <*8*><::>, <*afvikling af springsekvens *>
5 4476 <*9*><:område kan ikke opdateres:>,<*vt-ændring*>
5 4477 <::>));
5 4478 <* if kode = 5 then
5 4479 begin
5 4480 bogst:= medd(4);
5 4481 linie:= bogst shift(-5) extract 10;
5 4482 bogst:= bogst extract 5;
5 4483 if bogst > 0 then bogst:= bogst +'A'-1;
5 4484 write(z,"sp",1,<<z>,linie,false add bogst,1,
5 4485 ".",1,indeks);
5 4486 end;
5 4487 *>
5 4488 outchar(z,'sp');
5 4489 bus:= medd(2) extract 14;
5 4490 if bus > 0 then
5 4491 write(z,<<z>,bus,"/",1);
5 4492 løb:= medd(3);
5 4493 <*+4*> if løb shift(-22) <> 1 and løb <> 0 then
5 4494 fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
5 4495 <*-4*>
5 4496 \f
5 4496 message procedure skriv_auto_spring_medd side 2 - 810507/hko;
5 4497
5 4497 linie:= løb shift(-12) extract 10;
5 4498 bogst:= løb shift(-7) extract 5;
5 4499 if bogst > 0 then bogst:= bogst +'A'-1;
5 4500 løb:= løb extract 7;
5 4501 if medd(3) <> 0 or kode <> 5 then
5 4502 begin
6 4503 write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
6 4504 if kode = 5 or kode = 6 then write(z,<:er frit :>);
6 4505 end;
5 4506 if kode = 7 or kode = 8 then
5 4507 write(z,<*indeks,"sp",1,*>
5 4508 if kode=7 then <:udtaget :> else <:indsat :>);
5 4509
5 4509 dato:= systime(4,tid,t);
5 4510 kl:= t/100.0;
5 4511 løb:= replace_char(1<*space in number*>,'.');
5 4512 write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
5 4513 replace_char(1,løb);
5 4514 end
4 4515 else <*kode < 1 or kode > 8*>
4 4516 fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
4 4517 end; <*disable*>
3 4518 end skriv_auto_spring_medd;
2 4519 \f
2 4519 message procedure h_io side 1 - 810507/hko;
2 4520
2 4520 <* hovedmodulkorutine for io *>
2 4521 procedure h_io;
2 4522 begin
3 4523 integer array field op_ref;
3 4524 integer k,dest_sem;
3 4525 procedure skriv_hio(zud,omfang);
3 4526 value omfang;
3 4527 zone zud;
3 4528 integer omfang;
3 4529 begin
4 4530
4 4530 write(zud,"nl",1,<:+++ hovedmodul io :>);
4 4531 if omfang>0 then
4 4532 disable begin integer x;
5 4533 trap(slut);
5 4534 write(zud,"nl",1,
5 4535 <: op_ref: :>,op_ref,"nl",1,
5 4536 <: k: :>,k,"nl",1,
5 4537 <: dest_sem: :>,dest_sem,"nl",1,
5 4538 <::>);
5 4539 skriv_coru(zud,coru_no(100));
5 4540 slut:
5 4541 end;
4 4542 end skriv_hio;
3 4543
3 4543 trap(hio_trap);
3 4544 stack_claim(if cm_test then 198 else 146);
3 4545
3 4545 <*+2*>
3 4546 if testbit0 and overvåget or testbit28 then
3 4547 skriv_hio(out,0);
3 4548 <*-2*>
3 4549 \f
3 4549 message procedure h_io side 2 - 810507/hko;
3 4550
3 4550 repeat
3 4551 wait_ch(cs_io,op_ref,true,-1);
3 4552 <*+4*>
3 4553 if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
3 4554 then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
3 4555 <*-4*>
3 4556
3 4556 k:=d.op_ref.opkode extract 12;
3 4557 dest_sem:=
3 4558 if k = 0 <*attention*> then cs_io_komm else
3 4559
3 4559 if k = 22 <*auto vt opdatering*>
3 4560 or k = 23 <*generel meddelelse*>
3 4561 or k = 36 <*spring meddelelse*>
3 4562 or k = 44 <*udeladt i gruppeopkald*>
3 4563 or k = 45 <*nødopkald modtaget*>
3 4564 or k = 46 <*nødopkald besvaret*> then cs_io_spool else
3 4565
3 4565 if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
3 4566 0;
3 4567 <*+4*>
3 4568 if dest_sem = 0 then
3 4569 begin
4 4570 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
4 4571 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 4572 end
3 4573 else
3 4574 <*-4*>
3 4575 begin
4 4576 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 4577 end;
3 4578 until false;
3 4579
3 4579 hio_trap:
3 4580 disable skriv_hio(zbillede,1);
3 4581 end h_io;
2 4582 \f
2 4582 message procedure io_komm side 1 - 810507/hko;
2 4583
2 4583 procedure io_komm;
2 4584 begin
3 4585 integer array field op_ref,ref,vt_op,iaf;
3 4586 integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
3 4587 pos,indeks,sep,sluttegn,operatør,i,j,k;
3 4588 long navn;
3 4589
3 4589 procedure skriv_io_komm(zud,omfang);
3 4590 value omfang;
3 4591 zone zud;
3 4592 integer omfang;
3 4593 begin
4 4594
4 4594 disable
4 4595
4 4595 write(zud,"nl",1,<:+++ io_komm :>);
4 4596 if omfang > 0 then
4 4597 disable begin integer x;
5 4598 trap(slut);
5 4599 write(zud,"nl",1,
5 4600 <: op-ref: :>,op_ref,"nl",1,
5 4601 <: kode: :>,kode,"nl",1,
5 4602 <: aktion: :>,aktion,"nl",1,
5 4603 <: ref: :>,ref,"nl",1,
5 4604 <: vt_op: :>,vt_op,"nl",1,
5 4605 <: status: :>,status,"nl",1,
5 4606 <: opgave: :>,opgave,"nl",1,
5 4607 <: dest-sem: :>,dest_sem,"nl",1,
5 4608 <: iaf: :>,iaf,"nl",1,
5 4609 <: i: :>,i,"nl",1,
5 4610 <: j: :>,j,"nl",1,
5 4611 <: k: :>,k,"nl",1,
5 4612 <: navn: :>,string navn,"nl",1,
5 4613 <: pos: :>,pos,"nl",1,
5 4614 <: indeks: :>,indeks,"nl",1,
5 4615 <: sep: :>,sep,"nl",1,
5 4616 <: sluttegn: :>,sluttegn,"nl",1,
5 4617 <: vogn: :>,vogn,"nl",1,
5 4618 <: ll: :>,ll,"nl",1,
5 4619 <: omr: :>,omr,"nl",1,
5 4620 <: operatør: :>,operatør,"nl",1,
5 4621 <::>);
5 4622 skriv_coru(zud,coru_no(101));
5 4623 slut:
5 4624 end;
4 4625 end skriv_io_komm;
3 4626 \f
3 4626 message procedure io_komm side 2 - 810424/hko;
3 4627
3 4627 trap(io_komm_trap);
3 4628 stack_claim((if cm_test then 200 else 146)+24+200);
3 4629
3 4629 ref:=0;
3 4630 navn:= long<::>;
3 4631
3 4631 <*+2*>
3 4632 if testbit0 and overvåget or testbit28 then
3 4633 skriv_io_komm(out,0);
3 4634 <*-2*>
3 4635
3 4635 repeat
3 4636
3 4636 <*V*> wait_ch(cs_io_komm,
3 4637 op_ref,
3 4638 true,
3 4639 -1<*timeout*>);
3 4640 <*+2*>
3 4641 if testbit1 and overvåget then
3 4642 disable begin
4 4643 skriv_io_komm(out,0);
4 4644 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
4 4645 <: til io :>);
4 4646 skriv_op(out,op_ref);
4 4647 end;
3 4648 <*-2*>
3 4649
3 4649 kode:= d.op_ref.op_kode;
3 4650 i:= terminal_tab.ref.terminal_tilstand;
3 4651 status:= i shift(-21);
3 4652 opgave:=
3 4653 if kode=0 then 1 <* indlæs kommando *> else
3 4654 0; <* afvises *>
3 4655
3 4655 aktion:= if opgave = 0 then 0 else
3 4656 (case status +1 of(
3 4657 <* status *>
3 4658 <* 0 klar *>(1),
3 4659 <* 1 - *>(-1),<* ulovlig tilstand *>
3 4660 <* 2 - *>(-1),<* ulovlig tilstand *>
3 4661 <* 3 stoppet *>(2),
3 4662 <* 4 noneksist *>(-1),<* ulovlig tilstand *>
3 4663 <* 5 - *>(-1),<* ulovlig tilstand *>
3 4664 <* 6 - *>(-1),<* ulovlig tilstand *>
3 4665 <* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
3 4666 -1));
3 4667 \f
3 4667 message procedure io_komm side 3 - 810428/hko;
3 4668
3 4668 case aktion+6 of
3 4669 begin
4 4670 begin
5 4671 <*-5: terminal optaget *>
5 4672
5 4672 d.op_ref.resultat:= 16;
5 4673 afslut_operation(op_ref,-1);
5 4674 end;
4 4675
4 4675 begin
5 4676 <*-4: operation uden virkning *>
5 4677
5 4677 afslut_operation(op_ref,-1);
5 4678 end;
4 4679
4 4679 begin
5 4680 <*-3: ulovlig operationskode *>
5 4681
5 4681 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 4682 afslut_operation(op_ref,-1);
5 4683 end;
4 4684
4 4684 begin
5 4685 <*-2: ulovlig aktion *>
5 4686
5 4686 fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
5 4687 afslut_operation(op_ref,-1);
5 4688 end;
4 4689
4 4689 begin
5 4690 <*-1: ulovlig io_tilstand *>
5 4691
5 4691 fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
5 4692 afslut_operation(op_ref,-1);
5 4693 end;
4 4694
4 4694 begin
5 4695 <* 0: ikke implementeret *>
5 4696
5 4696 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 4697 afslut_operation(op_ref,-1);
5 4698 end;
4 4699
4 4699 begin
5 4700 \f
5 4700 message procedure io_komm side 4 - 851001/cl;
5 4701
5 4701 <* 1: indlæs kommando *>
5 4702 <*V*> wait(bs_zio_adgang);
5 4703
5 4703 <*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
5 4704
5 4704 if d.op_ref.resultat > 3 then
5 4705 begin
6 4706 <*V*> setposition(z_io,0,0);
6 4707 if sluttegn<>'nl' then outchar(z_io,'nl');
6 4708 skriv_kvittering(z_io,op_ref,pos,
6 4709 d.op_ref.resultat);
6 4710 end
5 4711 else if d.op_ref.resultat>0 then
5 4712 begin <*godkendt*>
6 4713 kode:=d.op_ref.opkode;
6 4714 i:= kode extract 12;
6 4715 j:= if kode < 5 or
6 4716 kode=7 or kode=8 or
6 4717 kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
6 4718 if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
6 4719 if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
6 4720 if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
6 4721 kode=20 or kode=24 then 4<*VO,F/VO,R*>else
6 4722 if kode =21 then 5 <*AU*> else
6 4723 if kode =25 then 6 <*GR,D*> else
6 4724 if kode =26 then 5 <*GR,S*> else
6 4725 if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
6 4726 if kode =30 then 10 <*SP,D*> else
6 4727 if kode =31 then 5 <*SP*> else
6 4728 if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
6 4729 if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
6 4730 if kode=71 then 11 <*FO,V*> else
6 4731 if kode =75 then 12 <*TÆ,V *>else
6 4732 if kode =76 then 12 <*TÆ,N *>else
6 4733 if kode =65 then 13 <*BE,N *>else
6 4734 if kode =66 then 14 <*BE,G *>else
6 4735 if kode =67 then 15 <*BE,V *>else
6 4736 if kode =68 then 16 <*ST,D *>else
6 4737 if kode =69 then 17 <*ST,V *>else
6 4738 if kode =36 then 18 <*AL *>else
6 4739 if kode =37 then 19 <*CC *>else
6 4740 if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
6 4741 if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
6 4742 0;
6 4743 if j > 0 then
6 4744 begin
7 4745 case j of
7 4746 begin
8 4747 begin
9 4748 \f
9 4748 message procedure io_komm side 5 - 810424/hko;
9 4749
9 4749 <* 1: inkluder/ekskluder ydre enhed *>
9 4750
9 4750 d.op_ref.retur:= cs_io_komm;
9 4751 if kode=1 then d.opref.opkode:=
9 4752 ia(2) shift 12 + d.opref.opkode extract 12;
9 4753 d.op_ref.data(1):= ia(1);
9 4754 signal_ch(if kode < 5 or kode>=72 then cs_rad
9 4755 else cs_gar,
9 4756 op_ref,gen_optype or io_optype);
9 4757 indeks:= op_ref;
9 4758 wait_ch(cs_io_komm,
9 4759 op_ref,
9 4760 true,
9 4761 -1<*timeout*>);
9 4762 <*+4*> if op_ref <> indeks then
9 4763 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4764 <*-4*>
9 4765 <*V*> setposition(z_io,0,0);
9 4766 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4767 skriv_kvittering(z_io,op_ref,-1,
9 4768 d.op_ref.resultat);
9 4769 end;
8 4770
8 4770 begin
9 4771 \f
9 4771 message procedure io_komm side 6 - 810501/hko;
9 4772
9 4772 <* 2: tid/attention,ja/attention,nej
9 4773 slut/slut med billede *>
9 4774
9 4774 case d.op_ref.opkode -79 of
9 4775 begin
10 4776
10 4776 <* 80: TI *> begin
11 4777 setposition(z_io,0,0);
11 4778 if sluttegn<>'nl' then outchar(z_io,'nl');
11 4779 if ia(1) <> 0 or ia(2) <> 0 then
11 4780 begin real field rf;
12 4781 rf:= 4;
12 4782 trap(forbudt);
12 4783 <*V*> setposition(z_io,0,0);
12 4784 systime(3,ia.rf,0.0);
12 4785 if false then
12 4786 begin
13 4787 forbudt: skriv_kvittering(z_io,0,-1,
13 4788 43<*ændring af dato/tid ikke lovlig*>);
13 4789 end
12 4790 else
12 4791 skriv_kvittering(z_io,0,-1,3);
12 4792 end
11 4793 else
11 4794 begin
12 4795 setposition(z_io,0,0);
12 4796 write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
12 4797 end;
11 4798 end TI;
10 4799 \f
10 4799 message procedure io_komm side 7 - 810424/hko;
10 4800
10 4800 <*81: AT,J*> begin
11 4801 <*V*> setposition(z_io,0,0);
11 4802 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4803 monitor(10)release process:(z_io,0,ia);
11 4804 skriv_kvittering(z_io,0,-1,3);
11 4805 end;
10 4806
10 4806 <* 82: AT,N*> begin
11 4807 i:= monitor(8)reserve process:(z_io,0,ia);
11 4808 <*V*> setposition(z_io,0,0);
11 4809 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4810 skriv_kvittering(z_io,0,-1,
11 4811 if i = 0 then 3 else 0);
11 4812 end;
10 4813
10 4813 <* 83: SL *> begin
11 4814 errorbits:=0; <* warning.no ok.yes *>
11 4815 trapmode:= 1 shift 13;
11 4816 trap(-2);
11 4817 end;
10 4818
10 4818 <* 84: SL,B *>begin
11 4819 errorbits:=1; <* warning.no ok.no *>
11 4820 trap(-3);
11 4821 end;
10 4822 <* 85: SL,K *>begin
11 4823 errorbits:=1; <* warning.no ok.no *>
11 4824 disable sæt_bit_i(trapmode,15,0);
11 4825 trap(-3);
11 4826 end;
10 4827 \f
10 4827 message procedure io_komm side 7a - 810511/cl;
10 4828
10 4828 <* 86: TE,J *>begin
11 4829 setposition(z_io,0,0);
11 4830 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4831 for i:= 1 step 1 until indeks do
11 4832 if 0<=ia(i) and ia(i)<=47 then
11 4833 begin
12 4834 case (ia(i)+1) of
12 4835 begin
13 4836 testbit0 := true;testbit1 := true;testbit2 := true;
13 4837 testbit3 := true;testbit4 := true;testbit5 := true;
13 4838 testbit6 := true;testbit7 := true;testbit8 := true;
13 4839 testbit9 := true;testbit10:= true;testbit11:= true;
13 4840 testbit12:= true;testbit13:= true;testbit14:= true;
13 4841 testbit15:= true;testbit16:= true;testbit17:= true;
13 4842 testbit18:= true;testbit19:= true;testbit20:= true;
13 4843 testbit21:= true;testbit22:= true;testbit23:= true;
13 4844 testbit24:= true;testbit25:= true;testbit26:= true;
13 4845 testbit27:= true;testbit28:= true;testbit29:= true;
13 4846 testbit30:= true;testbit31:= true;testbit32:= true;
13 4847 testbit33:= true;testbit34:= true;testbit35:= true;
13 4848 testbit36:= true;testbit37:= true;testbit38:= true;
13 4849 testbit39:= true;testbit40:= true;testbit41:= true;
13 4850 testbit42:= true;testbit43:= true;testbit44:= true;
13 4851 testbit45:= true;testbit46:= true;testbit47:= true;
13 4852 end;
12 4853 end;
11 4854 skriv_kvittering(z_io,0,-1,3);
11 4855 end;
10 4856 \f
10 4856 message procedure io_komm side 7b - 810511/cl;
10 4857
10 4857 <* 87: TE,N *>begin
11 4858 setposition(z_io,0,0);
11 4859 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4860 for i:= 1 step 1 until indeks do
11 4861 if 0<=ia(i) and ia(i)<=47 then
11 4862 begin
12 4863 case (ia(i)+1) of
12 4864 begin
13 4865 testbit0 := false;testbit1 := false;testbit2 := false;
13 4866 testbit3 := false;testbit4 := false;testbit5 := false;
13 4867 testbit6 := false;testbit7 := false;testbit8 := false;
13 4868 testbit9 := false;testbit10:= false;testbit11:= false;
13 4869 testbit12:= false;testbit13:= false;testbit14:= false;
13 4870 testbit15:= false;testbit16:= false;testbit17:= false;
13 4871 testbit18:= false;testbit19:= false;testbit20:= false;
13 4872 testbit21:= false;testbit22:= false;testbit23:= false;
13 4873 testbit24:= false;testbit25:= false;testbit26:= false;
13 4874 testbit27:= false;testbit28:= false;testbit29:= false;
13 4875 testbit30:= false;testbit31:= false;testbit32:= false;
13 4876 testbit33:= false;testbit34:= false;testbit35:= false;
13 4877 testbit36:= false;testbit37:= false;testbit38:= false;
13 4878 testbit39:= false;testbit40:= false;testbit41:= false;
13 4879 testbit42:= false;testbit43:= false;testbit44:= false;
13 4880 testbit45:= false;testbit46:= false;testbit47:= false;
13 4881 end;
12 4882 end;
11 4883 skriv_kvittering(z_io,0,-1,3);
11 4884 end;
10 4885
10 4885 <* 88: O *> begin
11 4886 integer array odescr,zdescr(1:20);
11 4887 long array field laf;
11 4888 integer res, i, j;
11 4889
11 4889 i:= j:= 1;
11 4890 while læstegn(ia,i,res)<>0 do
11 4891 begin
12 4892 if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
12 4893 skrivtegn(ia,j,res);
12 4894 end;
11 4895
11 4895 laf:= 2;
11 4896 getzone6(out,odescr);
11 4897 getzone6(z_io,zdescr);
11 4898 close(out,zdescr.laf(1)<>odescr.laf(1) or
11 4899 zdescr.laf(2)<>odescr.laf(2));
11 4900 laf:= 0;
11 4901
11 4901 if ia(1)=0 then
11 4902 begin
12 4903 res:= 3;
12 4904 j:= 0;
12 4905 end
11 4906 else
11 4907 begin
12 4908 j:= res:= openbs(out,j,ia,0);
12 4909 if res<>0 then
12 4910 res:= 46;
12 4911 end;
11 4912 if res<>0 then
11 4913 begin
12 4914 open(out,8,konsol_navn,0);
12 4915 if j<>0 then
12 4916 begin
13 4917 i:= 1;
13 4918 fejlreaktion(4,j,string ia.laf(increase(i)),1);
13 4919 end;
12 4920 end
11 4921 else res:= 3;
11 4922 setposition(z_io,0,0);
11 4923 skriv_kvittering(z_io,0,-1,res);
11 4924 end;
10 4925 end;<*case d.op_ref.opkode -79*>
9 4926 end;<*case 2*>
8 4927 begin
9 4928 \f
9 4928 message procedure io_komm side 8 - 810424/hko;
9 4929
9 4929 <* 3: vogntabel,linienr/-,busnr*>
9 4930
9 4930 d.op_ref.retur:= cs_io_komm;
9 4931 tofrom(d.op_ref.data,ia,10);
9 4932 indeks:= op_ref;
9 4933 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 4934 wait_ch(cs_io_komm,
9 4935 op_ref,
9 4936 io_optype,
9 4937 -1<*timeout*>);
9 4938 <*+2*> if testbit2 and overvåget then
9 4939 disable begin
10 4940 skriv_io_komm(out,0);
10 4941 write(out,"nl",1,<:io operation retur fra vt:>);
10 4942 skriv_op(out,op_ref);
10 4943 end;
9 4944 <*-2*>
9 4945 <*+4*> if indeks <> op_ref then
9 4946 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4947 <*-4*>
9 4948
9 4948 i:=d.op_ref.resultat;
9 4949 if i<1 or i>3 then
9 4950 begin
10 4951 <*V*> setposition(z_io,0,0);
10 4952 if sluttegn<>'nl' then outchar(z_io,'nl');
10 4953 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 4954 end
9 4955 else
9 4956 begin
10 4957 \f
10 4957 message procedure io_komm side 9 - 820301/hko,cl;
10 4958
10 4958 integer antal,filref;
10 4959
10 4959 antal:= d.op_ref.data(6);
10 4960 fil_ref:= d.op_ref.data(7);
10 4961 pos:= 0;
10 4962 <*V*> setposition(zio,0,0);
10 4963 if sluttegn <> 'nl' then outchar(z_io,'nl');
10 4964 for pos:= pos +1 while pos <= antal do
10 4965 begin
11 4966 integer bogst,løb;
11 4967
11 4967 disable i:= læsfil(fil_ref,pos,j);
11 4968 if i <> 0 then
11 4969 fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
11 4970 vogn:= fil(j,1) shift (-24) extract 24;
11 4971 løb:= fil(j,1) extract 24;
11 4972 if d.op_ref.opkode=9 then
11 4973 begin i:=vogn; vogn:=løb; løb:=i; end;
11 4974 ll:= løb shift(-12) extract 10;
11 4975 bogst:= løb shift(-7) extract 5;
11 4976 if bogst > 0 then bogst:= bogst+'A'-1;
11 4977 løb:= løb extract 7;
11 4978 vogn:= vogn extract 14;
11 4979 i:= d.op_ref.opkode -8;
11 4980 for i:= i,i +1 do
11 4981 begin
12 4982 j:= (i+1) extract 1;
12 4983 case j+1 of
12 4984 begin
13 4985 write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 4986 false add bogst,1,"/",1,true,3,<<d>,løb);
13 4987 write(zio,<<dddd>,vogn,"sp",1);
13 4988 end;
12 4989 end;
11 4990 if pos mod 5 = 0 then
11 4991 begin
12 4992 outchar(zio,'nl');
12 4993 <*V*> setposition(zio,0,0);
12 4994 end
11 4995 else write(zio,"sp",3);
11 4996 end;
10 4997 write(zio,"*",1);
10 4998 \f
10 4998 message procedure io_komm side 9a - 810505/hko;
10 4999
10 4999 d.op_ref.opkode:=104;<*slet fil*>
10 5000 d.op_ref.data(4):=filref;
10 5001 indeks:=op_ref;
10 5002 signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
10 5003 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
10 5004
10 5004 <*+2*> if testbit2 and overvåget then
10 5005 disable begin
11 5006 skriv_io_komm(out,0);
11 5007 write(out,"nl",1,<:io operation retur fra sletfil:>);
11 5008 skriv_op(out,op_ref);
11 5009 end;
10 5010 <*-2*>
10 5011
10 5011 <*+4*> if op_ref<>indeks then
10 5012 fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
10 5013 <*-4*>
10 5014 if d.op_ref.data(9)<>0 then
10 5015 fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 5016 <:io-komm, sletfil:>,1);
10 5017 end;
9 5018 end;
8 5019
8 5019 begin
9 5020 \f
9 5020 message procedure io_komm side 10 - 820301/hko;
9 5021
9 5021 <* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
9 5022
9 5022 vogn:=ia(1);
9 5023 ll:=ia(2);
9 5024 omr:= if kode=11 or kode=19 then ia(3) else
9 5025 if kode=12 then ia(2) else 0;
9 5026 if kode=19 and omr<=0 then
9 5027 begin
10 5028 if omr=-1 then omr:= 0
10 5029 else omr:= 14 shift 20 + 3; <*OMR TCT*>
10 5030 end;
9 5031 <*V*> wait_ch(cs_vt_adgang,
9 5032 vt_op,
9 5033 gen_optype,
9 5034 -1<*timeout sek*>);
9 5035 start_operation(vtop,101,cs_io_komm,
9 5036 kode);
9 5037 d.vt_op.data(1):=vogn;
9 5038 d.vt_op.data(2):=ll;
9 5039 d.vt_op.data(if kode=19 then 3 else 4):= omr;
9 5040 indeks:= vt_op;
9 5041 signal_ch(cs_vt,
9 5042 vt_op,
9 5043 gen_optype or io_optype);
9 5044
9 5044 <*V*> wait_ch(cs_io_komm,
9 5045 vt_op,
9 5046 io_optype,
9 5047 -1<*timeout sek*>);
9 5048 <*+2*> if testbit2 and overvåget then
9 5049 disable begin
10 5050 skriv_io_komm(out,0);
10 5051 write(out,"nl",1,
10 5052 <:iooperation retur fra vt:>);
10 5053 skriv_op(out,vt_op);
10 5054 end;
9 5055 <*-2*>
9 5056 <*+4*> if vt_op<>indeks then
9 5057 fejl_reaktion(11<*fremmede op*>,op_ref,
9 5058 <:io-kommando:>,0);
9 5059 <*-4*>
9 5060 <*V*> setposition(z_io,0,0);
9 5061 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5062 skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
9 5063 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 5064 else vt_op,-1,d.vt_op.resultat);
9 5065 d.vt_op.optype:= genoptype or vt_optype;
9 5066 disable afslut_operation(vt_op,cs_vt_adgang);
9 5067 end;
8 5068
8 5068 begin
9 5069 \f
9 5069 message procedure io_komm side 11 - 810428/hko;
9 5070
9 5070 <* 5 autofil-skift
9 5071 gruppe,slet
9 5072 spring (igangsæt)
9 5073 spring,annuler
9 5074 spring,reserve *>
9 5075
9 5075 tofrom(d.op_ref.data,ia,8);
9 5076 d.op_ref.retur:=cs_io_komm;
9 5077 indeks:=op_ref;
9 5078 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5079 <*V*> wait_ch(cs_io_komm,
9 5080 op_ref,
9 5081 io_optype,
9 5082 -1<*timeout*>);
9 5083 <*+2*> if testbit2 and overvåget then
9 5084 disable begin
10 5085 skriv_io_komm(out,0);
10 5086 write(out,"nl",1,<:io operation retur fra vt:>);
10 5087 skriv_op(out,op_ref);
10 5088 end;
9 5089 <*-2*>
9 5090 <*+4*> if indeks<>op_ref then
9 5091 fejlreaktion(11<*fremmed post*>,op_ref,
9 5092 <:io-kommando(autofil):>,0);
9 5093 <*-4*>
9 5094
9 5094 <*V*> setposition(z_io,0,0);
9 5095 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5096 skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
9 5097 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 5098 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 5099 end;
8 5100
8 5100 begin
9 5101 \f
9 5101 message procedure io_komm side 12 - 820301/hko/cl;
9 5102
9 5102 <* 6 gruppedefinition *>
9 5103
9 5103 tofrom(d.op_ref.data,ia,indeks*2);
9 5104 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5105 start_operation(vt_op,101,cs_io_komm,
9 5106 101<*opret fil*>);
9 5107 d.vt_op.data(1):=256;<*postantal*>
9 5108 d.vt_op.data(2):=1; <*postlængde*>
9 5109 d.vt_op.data(3):=1; <*segmentantal*>
9 5110 d.vt_op.data(4):=
9 5111 2 shift 10; <*spool fil*>
9 5112 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5113 pos:=vt_op;<*variabel lånes*>
9 5114 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5115 <*+4*> if vt_op<>pos then
9 5116 fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
9 5117 if d.vt_op.data(9)<>0 then
9 5118 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5119 <:io-kommando(gruppedefinition):>,0);
9 5120 <*-4*>
9 5121 iaf:=0;
9 5122 for i:=1 step 1 until indeks-1 do
9 5123 begin
10 5124 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5125 if k<>0 then
10 5126 fejlreaktion(7<*modif-fil*>,k,
10 5127 <:io kommando(gruppe-def):>,0);
10 5128 fil(j).iaf(1):=d.op_ref.data(i+1);
10 5129 end;
9 5130 while sep = ',' do
9 5131 begin
10 5132 wait(bs_fortsæt_adgang);
10 5133 pos:= 1; j:= 0;
10 5134 while læs_store(z_io,i) < 8 do
10 5135 begin
11 5136 skrivtegn(fortsæt,pos,i);
11 5137 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5138 end;
10 5139 skrivtegn(fortsæt,pos,'em');
10 5140 afsluttext(fortsæt,pos);
10 5141 sluttegn:= i;
10 5142 if j<>0 then
10 5143 begin
11 5144 setposition(z_io,0,0);
11 5145 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5146 skriv_kvittering(zio,opref,-1,53);<*annulleret*>
11 5147 goto gr_ann;
11 5148 end;
10 5149 \f
10 5149 message procedure io_komm side 13 - 810512/hko/cl;
10 5150
10 5150 disable begin
11 5151 integer array værdi(1:4);
11 5152 integer a_pos,res;
11 5153 pos:= 0;
11 5154 repeat
11 5155 apos:= pos;
11 5156 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5157 if res >= 0 then
11 5158 begin
12 5159 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5160 else if res=0 then res:= -25 <*parameter mangler*>
12 5161 else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
12 5162 res:= -7 <*busnr ulovligt*>
12 5163 else if res=2 or res=6 then
12 5164 begin
13 5165 k:=modiffil(d.vt_op.data(4),indeks,j);
13 5166 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5167 <:io kommando(gruppe-def):>,0);
13 5168 iaf:= 0;
13 5169 fil(j).iaf(1):= værdi(1) +
13 5170 (if res=6 then 1 shift 22 else 0);
13 5171 indeks:= indeks+1;
13 5172 if sep = ',' then res:= 0;
13 5173 end
12 5174 else res:= -27; <*parametertype*>
12 5175 end;
11 5176 if res>0 then pos:= a_pos;
11 5177 until sep<>'sp' or res<=0;
11 5178
11 5178 if res<0 then
11 5179 begin
12 5180 d.op_ref.resultat:= -res;
12 5181 i:=1;
12 5182 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5183 afsluttext(d.op_ref.data,i);
12 5184 end;
11 5185 end;
10 5186 \f
10 5186 message procedure io_komm side 13a - 810512/hko/cl;
10 5187
10 5187 if d.op_ref.resultat > 3 then
10 5188 begin
11 5189 setposition(z_io,0,0);
11 5190 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5191 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5192 goto gr_ann;
11 5193 end;
10 5194 signalbin(bs_fortsæt_adgang);
10 5195 end while sep = ',';
9 5196 d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
9 5197 k:= sætfildim(d.vt_op.data);
9 5198 if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
9 5199 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5200 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5201 d.op_ref.retur:=cs_io_komm;
9 5202 pos:=op_ref;
9 5203 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5204 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5205 <*+4*> if pos<>op_ref then
9 5206 fejlreaktion(11<*fremmed post*>,op_ref,
9 5207 <:io kommando(gruppedef retur fra vt):>,0);
9 5208 <*-4*>
9 5209
9 5209 <*V*> setposition(z_io,0,0);
9 5210 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5211 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5212
9 5212 if false then
9 5213 begin
10 5214 gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5215 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5216 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5217 end;
9 5218
9 5218 end;
8 5219
8 5219 begin
9 5220 \f
9 5220 message procedure io_komm side 14 - 810525/hko/cl;
9 5221
9 5221 <* 7 gruppe(-oversigts-)rapport *>
9 5222
9 5222 d.op_ref.retur:=cs_io_komm;
9 5223 d.op_ref.data(1):=ia(1);
9 5224 indeks:=op_ref;
9 5225 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5226 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5227
9 5227 <*+4*> if op_ref<>indeks then
9 5228 fejlreaktion(11<*fremmed post*>,op_ref,
9 5229 <:io-kommando(gruppe-rapport):>,0);
9 5230 <*-4*>
9 5231
9 5231 <*V*> setposition(z_io,0,0);
9 5232 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5233 if d.op_ref.resultat<>3 then
9 5234 begin
10 5235 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5236 end
9 5237 else
9 5238 begin
10 5239 integer bogst,løb;
10 5240
10 5240 if kode = 27 then <* gruppe,vis *>
10 5241 begin
11 5242 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
11 5243 "G",1,<<z>,d.op_ref.data(1) extract 7,
11 5244 "sp",2,"-",5,"nl",1);
11 5245 \f
11 5245 message procedure io_komm side 15 - 820301/hko;
11 5246
11 5246 for pos:=1 step 1 until d.op_ref.data(2) do
11 5247 begin
12 5248 disable i:=læsfil(d.op_ref.data(3),pos,j);
12 5249 if i<>0 then
12 5250 fejlreaktion(5<*læsfil*>,i,
12 5251 <:io_kommando(gruppe,vis):>,0);
12 5252 iaf:=0;
12 5253 vogn:=fil(j).iaf(1);
12 5254 if vogn shift(-22) =0 then
12 5255 write(z_io,<<ddddddd>,vogn extract 14)
12 5256 else
12 5257 begin
13 5258 løb:=vogn extract 7;
13 5259 bogst:=vogn shift(-7) extract 5;
13 5260 if bogst>0 then bogst:=bogst+'A'-1;
13 5261 ll:=vogn shift(-12) extract 10;
13 5262 write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5263 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5264 end;
12 5265 if pos mod 8 =0 then outchar(z_io,'nl')
12 5266 else write(z_io,"sp",2);
12 5267 end;
11 5268 write(z_io,"*",1);
11 5269 \f
11 5269 message procedure io_komm side 16 - 810512/hko/cl;
11 5270
11 5270 end
10 5271 else if kode=28 then <* gruppe,oversigt *>
10 5272 begin
11 5273 write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
11 5274 "sp",2,"-",5,"nl",2);
11 5275 for pos:=1 step 1 until d.op_ref.data(1) do
11 5276 begin
12 5277 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5278 if i<>0 then
12 5279 fejlreaktion(5<*læsfil*>,i,
12 5280 <:io-kommando(gruppe-oversigt):>,0);
12 5281 iaf:=0;
12 5282 ll:=fil(j).iaf(1);
12 5283 write(z_io,"G",1,<<z>,true,3,ll extract 7);
12 5284 if pos mod 10 =0 then outchar(z_io,'nl')
12 5285 else write(z_io,"sp",3);
12 5286 end;
11 5287 write(z_io,"*",1);
11 5288 end;
10 5289 <* slet fil *>
10 5290 d.op_ref.opkode:= 104;
10 5291 d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
10 5292 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5293 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5294 end; <* resultat=3 *>
9 5295
9 5295 end;
8 5296
8 5296 begin
9 5297 \f
9 5297 message procedure io_komm side 17 - 810525/cl;
9 5298
9 5298 <* 8 spring(-oversigts-)rapport *>
9 5299
9 5299 d.op_ref.retur:=cs_io_komm;
9 5300 tofrom(d.op_ref.data,ia,4);
9 5301 indeks:=op_ref;
9 5302 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5303 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5304
9 5304 <*+4*> if op_ref<>indeks then
9 5305 fejlreaktion(11<*fremmed post*>,op_ref,
9 5306 <:io-kommando(spring-rapport):>,0);
9 5307 <*-4*>
9 5308
9 5308 <*V*> setposition(z_io,0,0);
9 5309 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5310 if d.op_ref.resultat<>3 then
9 5311 begin
10 5312 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5313 end
9 5314 else
9 5315 begin
10 5316 boolean p_skrevet;
10 5317 integer bogst,løb;
10 5318
10 5318 if kode = 32 then <* spring,vis *>
10 5319 begin
11 5320 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 5321 bogst:= d.op_ref.data(1) extract 5;
11 5322 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 5323 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
11 5324 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 5325 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 5326 raf:= data+8;
11 5327 if d.op_ref.raf(1)<>0.0 then
11 5328 write(z_io,<:, startet :>,<<zddddd>,round
11 5329 systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 5330 else
11 5331 write(z_io,<:, ikke startet:>);
11 5332 write(z_io,"sp",2,"-",5,"nl",1);
11 5333 \f
11 5333 message procedure io_komm side 18 - 810518/cl;
11 5334
11 5334 p_skrevet:= false;
11 5335 for pos:=1 step 1 until d.op_ref.data(3) do
11 5336 begin
12 5337 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 5338 if i<>0 then
12 5339 fejlreaktion(5<*læsfil*>,i,
12 5340 <:io_kommando(spring,vis):>,0);
12 5341 iaf:=0;
12 5342 i:= fil(j).iaf(1);
12 5343 if i < 0 and -, p_skrevet then
12 5344 begin
13 5345 outchar(z_io,'('); p_skrevet:= true;
13 5346 end;
12 5347 if i > 0 and p_skrevet then
12 5348 begin
13 5349 outchar(z_io,')'); p_skrevet:= false;
13 5350 end;
12 5351 if pos mod 2 = 0 then
12 5352 write(z_io,<< dd>,abs i,<:.:>)
12 5353 else
12 5354 write(z_io,true,3,<<d>,abs i);
12 5355 if pos mod 21 = 0 then outchar(z_io,'nl');
12 5356 end;
11 5357 write(z_io,"*",1);
11 5358 \f
11 5358 message procedure io_komm side 19 - 810525/cl;
11 5359
11 5359 end
10 5360 else if kode=33 then <* spring,oversigt *>
10 5361 begin
11 5362 write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
11 5363 "sp",2,"-",5,"nl",2);
11 5364 for pos:=1 step 1 until d.op_ref.data(1) do
11 5365 begin
12 5366 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5367 if i<>0 then
12 5368 fejlreaktion(5<*læsfil*>,i,
12 5369 <:io-kommando(spring-oversigt):>,0);
12 5370 iaf:=0;
12 5371 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 5372 bogst:=fil(j).iaf(1) extract 5;
12 5373 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 5374 write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 5375 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 5376 string (extend fil(j).iaf(2) shift 24));
12 5377 if fil(j,2)<>0.0 then
12 5378 write(z_io,<:startet :>,<<zddddd>,
12 5379 round systime(4,fil(j,2),r),<:.:>,round r);
12 5380 outchar(z_io,'nl');
12 5381 end;
11 5382 write(z_io,"*",1);
11 5383 end;
10 5384 <* slet fil *>
10 5385 d.op_ref.opkode:= 104;
10 5386 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 5387 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5388 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5389 end; <* resultat=3 *>
9 5390
9 5390 end;
8 5391
8 5391 begin
9 5392 \f
9 5392 message procedure io_komm side 20 - 820302/hko;
9 5393
9 5393 <* 9 fordeling af linier/områder på operatører *>
9 5394
9 5394 d.op_ref.retur:=cs_io_komm;
9 5395 disable
9 5396 if kode=5 then
9 5397 begin
10 5398 integer array io_linietabel(1:max_linienr//3+1);
10 5399
10 5399 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5400 begin
11 5401 i:= læs_fil(1035,ref//512+1,j);
11 5402 if i <> 0 then
11 5403 fejlreaktion(5,i,<:liniefordelingstabel:>,0);
11 5404 tofrom(io_linietabel.ref,fil(j),
11 5405 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
11 5406 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
11 5407 end;
10 5408 ref:=0;
10 5409 operatør:=ia(1);
10 5410 for j:=2 step 1 until indeks do
10 5411 begin
11 5412 ll:=ia(j);
11 5413 if ll<>0 then
11 5414 skrivtegn(io_linietabel,abs(ll)+1,
11 5415 if ll>0 then operatør else 0);
11 5416 end;
10 5417 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5418 begin
11 5419 i:= skriv_fil(1035,ref//512+1,j);
11 5420 if i <> 0 then
11 5421 fejlreaktion(6,i,<:liniefordelingstabel:>,0);
11 5422 tofrom(fil(j),io_linietabel.ref,
11 5423 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
11 5424 then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
11 5425 );
11 5426 end;
10 5427 ref:=0;
10 5428 end
9 5429 else
9 5430 begin
10 5431 modiffil(1034,1,i);
10 5432 ref:=0;
10 5433 operatør:=ia(1);
10 5434 for j:=2 step 1 until indeks do
10 5435 begin
11 5436 ll:=ia(j);
11 5437 fil(i).ref(ll):= if ll>0 then operatør else 0;
11 5438 end;
10 5439 end;
9 5440 indeks:=op_ref;
9 5441 signal_ch(cs_rad,op_ref,gen_optype or io_optype);
9 5442 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
9 5443
9 5443 <*+4*> if op_ref<>indeks then
9 5444 fejlreaktion(11<*fr.post*>,op_ref,
9 5445 <:io-komm,liniefordeling retur fra rad:>,0);
9 5446 <*-4*>
9 5447
9 5447 <*V*> setposition(z_io,0,0);
9 5448 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5449 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5450
9 5450 end;
8 5451
8 5451 begin
9 5452 \f
9 5452 message procedure io_komm side 21 - 820301/cl;
9 5453
9 5453 <* 10 springdefinition *>
9 5454
9 5454 tofrom(d.op_ref.data,ia,indeks*2);
9 5455 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5456 start_operation(vt_op,101,cs_io_komm,
9 5457 101<*opret fil*>);
9 5458 d.vt_op.data(1):=128;<*postantal*>
9 5459 d.vt_op.data(2):=2; <*postlængde*>
9 5460 d.vt_op.data(3):=1; <*segmentantal*>
9 5461 d.vt_op.data(4):=
9 5462 2 shift 10; <*spool fil*>
9 5463 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5464 pos:=vt_op;<*variabel lånes*>
9 5465 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5466 <*+4*> if vt_op<>pos then
9 5467 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 5468 if d.vt_op.data(9)<>0 then
9 5469 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5470 <:io-kommando(springdefinition):>,0);
9 5471 <*-4*>
9 5472 iaf:=0;
9 5473 for i:=1 step 1 until indeks-2 do
9 5474 begin
10 5475 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5476 if k<>0 then
10 5477 fejlreaktion(7<*modif-fil*>,k,
10 5478 <:io kommando(spring-def):>,0);
10 5479 fil(j).iaf(1):=d.op_ref.data(i+2);
10 5480 end;
9 5481 while sep = ',' do
9 5482 begin
10 5483 wait(bs_fortsæt_adgang);
10 5484 pos:= 1; j:= 0;
10 5485 while læs_store(z_io,i) < 8 do
10 5486 begin
11 5487 skrivtegn(fortsæt,pos,i);
11 5488 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5489 end;
10 5490 skrivtegn(fortsæt,pos,'em');
10 5491 afsluttext(fortsæt,pos);
10 5492 sluttegn:= i;
10 5493 if j<>0 then
10 5494 begin
11 5495 setposition(z_io,0,0);
11 5496 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5497 skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
11 5498 goto sp_ann;
11 5499 end;
10 5500 \f
10 5500 message procedure io_komm side 22 - 810519/cl;
10 5501
10 5501 disable begin
11 5502 integer array værdi(1:4);
11 5503 integer a_pos,res;
11 5504 pos:= 0;
11 5505 repeat
11 5506 apos:= pos;
11 5507 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5508 if res >= 0 then
11 5509 begin
12 5510 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5511 else if res=0 then res:= -25 <*parameter mangler*>
12 5512 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 5513 res:= -44 <*intervalstørrelse ulovlig*>
12 5514 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 5515 res:= -6 <*løbnr ulovligt*>
12 5516 else if res=10 then
12 5517 begin
13 5518 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 5519 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5520 <:io kommando(spring-def):>,0);
13 5521 iaf:= 0;
13 5522 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 5523 indeks:= indeks+1;
13 5524 if sep = ',' then res:= 0;
13 5525 end
12 5526 else res:= -27; <*parametertype*>
12 5527 end;
11 5528 if res>0 then pos:= a_pos;
11 5529 until sep<>'sp' or res<=0;
11 5530
11 5530 if res<0 then
11 5531 begin
12 5532 d.op_ref.resultat:= -res;
12 5533 i:=1;
12 5534 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5535 afsluttext(d.op_ref.data,i);
12 5536 end;
11 5537 end;
10 5538 \f
10 5538 message procedure io_komm side 23 - 810519/cl;
10 5539
10 5539 if d.op_ref.resultat > 3 then
10 5540 begin
11 5541 setposition(z_io,0,0);
11 5542 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5543 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5544 goto sp_ann;
11 5545 end;
10 5546 signalbin(bs_fortsæt_adgang);
10 5547 end while sep = ',';
9 5548 d.vt_op.data(1):= indeks-2;
9 5549 k:= sætfildim(d.vt_op.data);
9 5550 if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
9 5551 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5552 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5553 d.op_ref.retur:=cs_io_komm;
9 5554 pos:=op_ref;
9 5555 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5556 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5557 <*+4*> if pos<>op_ref then
9 5558 fejlreaktion(11<*fremmed post*>,op_ref,
9 5559 <:io kommando(springdef retur fra vt):>,0);
9 5560 <*-4*>
9 5561
9 5561 <*V*> setposition(z_io,0,0);
9 5562 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5563 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5564
9 5564 if false then
9 5565 begin
10 5566 sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5567 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5568 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5569 signalbin(bs_fortsæt_adgang);
10 5570 end;
9 5571
9 5571 end;
8 5572 begin
9 5573 integer i,j,k,opr,lin,max_lin;
9 5574 boolean o_ud, t_ud;
9 5575 \f
9 5575 message procedure io_komm side 23a - 820301/cl;
9 5576
9 5576 <* 11 fordelingsrapport *>
9 5577
9 5577 <*V*> setposition(z_io,0,0);
9 5578 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5579
9 5579 max_lin:= max_linienr;
9 5580 for opr:= 1 step 1 until max_antal_operatører, 0 do
9 5581 begin
10 5582 o_ud:= t_ud:= false;
10 5583 k:= 0;
10 5584
10 5584 if opr<>0 then
10 5585 begin
11 5586 j:= k:= 0;
11 5587 for lin:= 1 step 1 until max_lin do
11 5588 begin
12 5589 læs_tegn(radio_linietabel,lin+1,i);
12 5590 if i<>0 then j:= lin;
12 5591 if opr=i and opr<>0 then
12 5592 begin
13 5593 if -, o_ud then
13 5594 begin
14 5595 o_ud:= true;
14 5596 if opr<>0 then
14 5597 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
14 5598 "sp",2,string bpl_navn(opr))
14 5599 else
14 5600 write(z_io,"nl",1,<:ikke fordelte:>);
14 5601 end;
13 5602 if -, t_ud then
13 5603 begin
14 5604 write(z_io,<:<'nl'> linier: :>);
14 5605 t_ud:= true;
14 5606 end;
13 5607 k:=k+1;
13 5608 if k>1 and k mod 10 = 1 then
13 5609 write(z_io,"nl",1,"sp",13);
13 5610 write(z_io,<<ddd >,lin);
13 5611 end;
12 5612 if lin=max_lin then max_lin:= j;
12 5613 end;
11 5614 end;
10 5615
10 5615 k:= 0; t_ud:= false;
10 5616 for i:= 1 step 1 until max_antal_områder do
10 5617 begin
11 5618 if radio_områdetabel(i)= opr then
11 5619 begin
12 5620 if -, o_ud then
12 5621 begin
13 5622 o_ud:= true;
13 5623 if opr<>0 then
13 5624 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
13 5625 "sp",2,string bpl_navn(opr))
13 5626 else
13 5627 write(z_io,"nl",1,<:ikke fordelte:>);
13 5628 end;
12 5629 if -, t_ud then
12 5630 begin
13 5631 write(z_io,<:<'nl'> områder: :>);
13 5632 t_ud:= true;
13 5633 end;
12 5634 k:= k+1;
12 5635 if k>1 and k mod 10 = 1 then
12 5636 write(z_io,"nl",1,"sp",13);
12 5637 write(z_io,true,4,string område_navn(i));
12 5638 end;
11 5639 end;
10 5640 if o_ud then write(z_io,"nl",1);
10 5641 end;
9 5642 write(z_io,"*",1);
9 5643 end;
8 5644
8 5644 begin
9 5645 integer omr,typ,sum;
9 5646 integer array ialt(1:5);
9 5647 real r;
9 5648 \f
9 5648 message procedure io_komm side 24 - 810501/hko;
9 5649
9 5649 <* 12 vis/nulstil opkaldstællere *>
9 5650
9 5650 setposition(z_io,0,0);
9 5651 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5652
9 5652 if kode=76 and indeks=1 then
9 5653 begin <* TÆ,N <tid> *>
10 5654 if ia(1)<(-1) or 2400<ia(1) then
10 5655 skriv_kvittering(z_io,opref,-1,64)
10 5656 else
10 5657 begin
11 5658 if ia(1)=(-1) then nulstil_systællere:= -1
11 5659 else nulstil_systællere:= (ia(1) mod 2400)*100;
11 5660 opdater_tf_systællere;
11 5661 typ:= opref; <* typ lånes til gemmevariabel *>
11 5662 d.opref.retur:= cs_io_komm;
11 5663 signal_ch(cs_io_nulstil,opref,io_optype);
11 5664 <*V*> wait_ch(cs_io_komm,opref,io_optype,-1);
11 5665 <*+4*> if opref <> typ then
11 5666 fejlreaktion(11<*fremmed post*>,opref,
11 5667 <:io_kommando:>,0);
11 5668 <*-4*>
11 5669 skriv_kvittering(z_io,opref,-1,3);
11 5670 end;
10 5671 end
9 5672 else
9 5673 begin
10 5674 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5675
10 5675 write(z_io,
10 5676 <:område udgående alm. ind nød ind:>,
10 5677 <: ind ialt total ej forb. optaget:>,"nl",1);
10 5678 for omr := 1 step 1 until max_antal_områder do
10 5679 begin
11 5680 sum:= 0;
11 5681 write(z_io,true,6,string område_navn(omr),":",1);
11 5682 for typ:= 1 step 1 until 3 do
11 5683 begin
12 5684 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5685 sum:= sum + opkalds_tællere((omr-1)*5+typ);
12 5686 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5687 end;
11 5688 write(z_io,<< ddddddd>,
11 5689 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
11 5690 for typ:= 4 step 1 until 5 do
11 5691 begin
12 5692 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5693 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5694 end;
11 5695 write(z_io,"nl",1);
11 5696 end;
10 5697 sum:= 0;
10 5698 write(z_io,"nl",1,<:ialt ::>);
10 5699 for typ:= 1 step 1 until 3 do
10 5700 begin
11 5701 write(z_io,<< ddddddd>,ialt(typ));
11 5702 sum:= sum+ialt(typ);
11 5703 end;
10 5704 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5705 ialt(4), ialt(5), "nl",3);
10 5706
10 5706 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5707 write(z_io,
10 5708 <:oper. udgående alm. ind nød ind:>,
10 5709 <: ind ialt total ej forb. optaget:>,"nl",1);
10 5710 for omr := 1 step 1 until max_antal_operatører do
10 5711 begin
11 5712 sum:= 0;
11 5713 if bpl_navn(omr)=long<::> then
11 5714 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
11 5715 else
11 5716 write(z_io,true,6,string bpl_navn(omr),":",1);
11 5717 for typ:= 1 step 1 until 3 do
11 5718 begin
12 5719 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
12 5720 sum:= sum + operatør_tællere((omr-1)*5+typ);
12 5721 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5722 end;
11 5723 write(z_io,<< ddddddd>,
11 5724 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
11 5725 for typ:= 4 step 1 until 5 do
11 5726 begin
12 5727 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
12 5728 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5729 end;
11 5730 write(z_io,"nl",1);
11 5731 end;
10 5732 sum:= 0;
10 5733 write(z_io,"nl",1,<:ialt ::>);
10 5734 for typ:= 1 step 1 until 3 do
10 5735 begin
11 5736 write(z_io,<< ddddddd>,ialt(typ));
11 5737 sum:= sum+ialt(typ);
11 5738 end;
10 5739 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5740 ialt(4),ialt(5),"nl",2);
10 5741
10 5741 typ:= replacechar(1,':');
10 5742 write(z_io,<:tællere nulstilles :>);
10 5743 if nulstil_systællere=(-1) then
10 5744 write(z_io,<:ikke automatisk:>,"nl",1)
10 5745 else
10 5746 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
10 5747 nulstil_systællere,"nl",1);
10 5748 replacechar(1,'.');
10 5749 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
10 5750 systime(4,systællere_nulstillet,r));
10 5751 replacechar(1,':');
10 5752 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
10 5753 replacechar(1,typ);
10 5754 write(z_io,"*",1,"nl",1);
10 5755 setposition(z_io,0,0);
10 5756
10 5756 if kode = 76 <* nulstil tællere *> then
10 5757 disable begin
11 5758 for omr:= 1 step 1 until max_antal_områder*5 do
11 5759 opkalds_tællere(omr):= 0;
11 5760 for omr:= 1 step 1 until max_antal_operatører*5 do
11 5761 operatør_tællere(omr):= 0;
11 5762 systime(1,0.0,systællere_nulstillet);
11 5763 opdater_tf_systællere;
11 5764 typ:= replacechar(1,'.');
11 5765 write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
11 5766 systime(4,systællere_nulstillet,r));
11 5767 replacechar(1,':');
11 5768 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
11 5769 replacechar(1,typ);
11 5770 setposition(z_io,0,0);
11 5771 end;
10 5772 end;
9 5773 end;
8 5774
8 5774 begin
9 5775 \f
9 5775 message procedure io_komm side 25 - 940522/cl;
9 5776
9 5776 <* 13 navngiv betjeningsplads *>
9 5777 boolean incl;
9 5778 long field lf;
9 5779
9 5779 lf:=6;
9 5780 operatør:= ia(1);
9 5781 navn:= ia.lf;
9 5782 incl:= false add (ia(4) extract 8);
9 5783
9 5783 if navn=long<::> then
9 5784 begin
10 5785 <* nedlæg navn - check for i brug *>
10 5786 iaf:= operatør*terminal_beskr_længde;
10 5787 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5788 d.opref.resultat:= 48 <*i brug*>
10 5789 else
10 5790 begin
11 5791 for i:= 65 step 1 until top_bpl_gruppe do
11 5792 begin
12 5793 iaf:= i*op_maske_lgd;
12 5794 if læsbit_ia(bpl_def.iaf,operatør) then
12 5795 d.opref.resultat:= 48<*i brug*>;
12 5796 end;
11 5797 end;
10 5798 if d.opref.resultat <= 3 then
10 5799 begin
11 5800 for i:= 1 step 1 until sidste_bus do
11 5801 if bustabel(i) shift (-14) extract 8 = operatør then
11 5802 d.opref.resultat:= 48<*i brug*>;
11 5803 end;
10 5804 end
9 5805 else
9 5806 begin
10 5807 <* opret/omdøb *>
10 5808 i:= find_bpl(navn);
10 5809 if i<>0 and i<>operatør then
10 5810 d.opref.resultat:= 48 <*i brug*>;
10 5811 end;
9 5812 if d.opref.resultat<=3 then
9 5813 begin
10 5814 bpl_navn(operatør):= navn;
10 5815 operatør_auto_include(operatør):= incl;
10 5816 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5817 if k<>0 then
10 5818 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5819 lf:= 4;
10 5820 fil(ll).lf:= navn add (incl extract 8);
10 5821 setposition(fil(ll),0,0);
10 5822
10 5822 <* skriv bplnavne *>
10 5823 disable begin
11 5824 zone z(128,1,stderror);
11 5825 long array field laf;
11 5826 integer array ia(1:10);
11 5827
11 5827 open(z,4,<:bplnavne:>,0);
11 5828 laf:= 0;
11 5829 outrec6(z,512);
11 5830 for i:= 1 step 1 until 127 do
11 5831 z.laf(i):= bpl_navn(i);
11 5832 close(z,true);
11 5833 monitor(42,z,0,ia);
11 5834 ia(6):= systime(7,0,0.0);
11 5835 monitor(44,z,0,ia);
11 5836 end;
10 5837 d.opref.resultat:= 3;<*udført*>
10 5838 end;
9 5839
9 5839 setposition(z_io,0,0);
9 5840 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5841 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5842 end;
8 5843
8 5843 begin
9 5844 \f
9 5844 message procedure io_komm side 26 - 940522/cl;
9 5845
9 5845 <* 14 betjeningsplads - gruppe *>
9 5846 integer ant_i_gruppe;
9 5847 long field lf;
9 5848 integer array maske(1:op_maske_lgd//2);
9 5849
9 5849 lf:= 4; ant_i_gruppe:= 0;
9 5850 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5851 navn:= ia.lf;
9 5852 operatør:= find_bpl(navn);
9 5853 for i:= 3 step 1 until indeks do
9 5854 if sætbit_ia(maske,ia(i),1)=0 then
9 5855 ant_i_gruppe:= ant_i_gruppe+1;
9 5856 if ant_i_gruppe=0 then
9 5857 begin
10 5858 <* slet gruppe *>
10 5859 if operatør<=64 then
10 5860 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5861 else 62<*navn ulovligt*>)
10 5862 else
10 5863 begin
11 5864 for i:= 1 step 1 until max_antal_operatører do
11 5865 for j:= 1 step 1 until 3 do
11 5866 if operatør_stop(i,j)=operatør then
11 5867 d.opref.resultat:= 48<*i brug*>;
11 5868 end;
10 5869 navn:= long<::>;
10 5870 end
9 5871 else
9 5872 begin
10 5873 if 1<=operatør and operatør<=64 then
10 5874 d.opref.resultat:= 62<*navn ulovligt*>
10 5875 else
10 5876 if operatør=0 then
10 5877 begin
11 5878 i:=65;
11 5879 while i<=127 and operatør=0 do
11 5880 begin
12 5881 if bpl_navn(i)=long<::> then operatør:=i;
12 5882 i:= i+1;
12 5883 end;
11 5884 if operatør=0 then
11 5885 d.opref.resultat:= 32<*ikke plads*>
11 5886 else if operatør>top_bpl_gruppe then
11 5887 top_bpl_gruppe:= operatør;
11 5888 end;
10 5889 end;
9 5890 if d.opref.resultat<=3 then
9 5891 begin
10 5892 bpl_navn(operatør):= navn;
10 5893 iaf:= operatør*op_maske_lgd;
10 5894 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5895 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5896 for i:= 1 step 1 until max_antal_operatører do
10 5897 begin
11 5898 if læsbit_ia(maske,i) then
11 5899 begin
12 5900 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5901 if læsbit_ia(operatør_maske,i) then
12 5902 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5903 end;
11 5904 end;
10 5905 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5906 if k<>0 then
10 5907 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5908 lf:= 4;
10 5909 fil(ll).lf:= navn;
10 5910 setposition(fil(ll),0,0);
10 5911 iaf:= 0;
10 5912 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5913 if k<>0 then
10 5914 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5915 for i:= 1 step 1 until op_maske_lgd//2 do
10 5916 fil(ll).iaf(i):= maske(i);
10 5917 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5918 setposition(fil(ll),0,0);
10 5919 d.opref.resultat:= 3;
10 5920 end;
9 5921
9 5921 setposition(z_io,0,0);
9 5922 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5923 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5924 end;
8 5925
8 5925 begin
9 5926 \f
9 5926 message procedure io_komm side 27 - 940522/cl;
9 5927
9 5927 <* 15 vis betjeningspladsdefinitioner *>
9 5928
9 5928 setposition(z_io,0,0);
9 5929 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5930 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5931 for i:= 1 step 1 until max_antal_operatører do
9 5932 begin
10 5933 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5934 case operatør_auto_include(i) extract 2 + 1 of(
10 5935 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5936 if i mod 4 = 0 then write(z_io,"nl",1)
10 5937 else write(z_io,"sp",5);
10 5938 end;
9 5939 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5940 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5941 for i:= 65 step 1 until top_bpl_gruppe do
9 5942 begin
10 5943 ll:=0; iaf:= i*op_maske_lgd;
10 5944 if bpl_navn(i)<>long<::> then
10 5945 begin
11 5946 write(z_io,true,6,string bpl_navn(i),":",1);
11 5947 for j:= 1 step 1 until max_antal_operatører do
11 5948 begin
12 5949 if læsbit_ia(bpl_def.iaf,j) then
12 5950 begin
13 5951 if ll mod 8 = 0 and ll<>0 then
13 5952 write(z_io,"nl",1,"sp",7);
13 5953 write(z_io,"sp",2,string bpl_navn(j));
13 5954 ll:=ll+1;
13 5955 end;
12 5956 end;
11 5957 write(z_io,"nl",1);
11 5958 end;
10 5959 end;
9 5960 write(z_io,"*",1);
9 5961 end;
8 5962
8 5962 begin
9 5963 \f
9 5963 message procedure io_komm side 28 - 940522/cl;
9 5964
9 5964 <* 16 stopniveau,definer *>
9 5965
9 5965 operatør:= ia(1);
9 5966 iaf:= operatør*terminal_beskr_længde;
9 5967 for i:= 1 step 1 until 3 do
9 5968 operatør_stop(operatør,i):= ia(i+1);
9 5969 if -,læsbit_ia(operatørmaske,operatør) then
9 5970 begin
10 5971 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5972 signal_bin(bs_mobilopkald);
10 5973 end;
9 5974 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5975 if k<>0 then
9 5976 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 5977 iaf:= 0;
9 5978 for i:= 0 step 1 until 3 do
9 5979 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 5980 setposition(fil(ll),0,0);
9 5981 setposition(z_io,0,0);
9 5982 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5983 skriv_kvittering(z_io,0,-1,3);
9 5984 end;
8 5985
8 5985 begin
9 5986 \f
9 5986 message procedure io_komm side 29 - 940522/cl;
9 5987
9 5987 <* 17 stopniveauer,vis *>
9 5988
9 5988 setposition(z_io,0,0);
9 5989 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5990
9 5990 for operatør:= 1 step 1 until max_antal_operatører do
9 5991 begin
10 5992 iaf:=operatør*terminal_beskr_længde;
10 5993 ll:=0;
10 5994 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 5995 string bpl_navn(operatør),<:(:>,
10 5996 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 5997 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 5998 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 5999 for i:= 1 step 1 until 3 do
10 6000 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 6001 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 6002 else string bpl_navn(operatør_stop(operatør,i)));
10 6003 if operatør mod 2 = 1 then
10 6004 write(z_io,"sp",40-ll)
10 6005 else
10 6006 write(z_io,"nl",1);
10 6007 end;
9 6008 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6009 write(z_io,"*",1);
9 6010 end;
8 6011
8 6011 begin
9 6012 \f
9 6012 message procedure io_komm side 30 - 941007/cl;
9 6013
9 6013 <* 18 alarmlængder *>
9 6014
9 6014 setposition(z_io,0,0);
9 6015 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6016
9 6016 for operatør:= 1 step 1 until max_antal_operatører do
9 6017 begin
10 6018 ll:=0;
10 6019 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6020 string bpl_navn(operatør));
10 6021 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 6022 if opk_alarm.iaf.alarm_lgd < 0 then
10 6023 ll:= ll+write(z_io,<:uendelig:>)
10 6024 else
10 6025 ll:= ll+write(z_io,<<ddddddd>,
10 6026 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 6027
10 6027 if operatør mod 2 = 1 then
10 6028 write(z_io,"sp",40-ll)
10 6029 else
10 6030 write(z_io,"nl",1);
10 6031 end;
9 6032 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6033 write(z_io,"*",1);
9 6034 end;
8 6035
8 6035 begin
9 6036 <* 19 CC *>
9 6037 integer i, c;
9 6038
9 6038 i:= 1;
9 6039 while læstegn(ia,i+0,c)<>0 and
9 6040 i<(op_spool_postlgd-op_spool_text)//2*3
9 6041 do skrivtegn(d.opref.data,i,c);
9 6042 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 6043
9 6043 d.opref.retur:= cs_io_komm;
9 6044 signalch(cs_op,opref,io_optype or gen_optype);
9 6045 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 6046
9 6046 setposition(z_io,0,0);
9 6047 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6048 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 6049 end;
8 6050
8 6050 begin
9 6051 <* 20: CQF,I CQF,U CQF,V *>
9 6052 integer kode, res, i, j;
9 6053 integer array field iaf, iaf1;
9 6054 long field navn;
9 6055
9 6055 kode:= d.opref.opkode extract 12;
9 6056 navn:= 6; res:= 0;
9 6057 if kode=90 <*CQF,I*> then
9 6058 begin
10 6059 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 6060 res:= 10 <*busnr ukendt*>
10 6061 else
10 6062 begin
11 6063 j:= -1;
11 6064 for i:= 1 step 1 until max_cqf do
11 6065 begin
12 6066 iaf:= (i-1)*cqf_lgd;
12 6067 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 6068 ia.navn = cqf_tabel.iaf.cqf_id
12 6069 then res:= 48; <*i brug*>
12 6070 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 6071 end;
11 6072 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 6073 if res=0 then
11 6074 begin
12 6075 iaf:= (j-1)*cqf_lgd;
12 6076 cqf_tabel.iaf.cqf_bus:= ia(1);
12 6077 cqf_tabel.iaf.cqf_fejl:= 0;
12 6078 cqf_tabel.iaf.cqf_id:= ia.navn;
12 6079 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 6080 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 6081 res:= 3;
12 6082 end;
11 6083 end;
10 6084 setposition(z_io,0,0);
10 6085 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6086 skriv_kvittering(z_io,opref,-1,res);
10 6087 end
9 6088 else
9 6089 if kode=91 <*CQF,U*> then
9 6090 begin
10 6091 j:= -1;
10 6092 for i:= 1 step 1 until max_cqf do
10 6093 begin
11 6094 iaf:= (i-1)*cqf_lgd;
11 6095 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 6096 end;
10 6097 if j>=0 then
10 6098 begin
11 6099 iaf:= (j-1)*cqf_lgd;
11 6100 for i:= 1 step 1 until cqf_lgd//2 do
11 6101 cqf_tabel.iaf(i):= 0;
11 6102 res:= 3;
11 6103 end
10 6104 else res:= 13; <*bus ikke indsat*>
10 6105 setposition(z_io,0,0);
10 6106 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6107 skriv_kvittering(z_io,opref,-1,res);
10 6108 end
9 6109 else
9 6110 begin
10 6111 setposition(z_io,0,0);
10 6112 skriv_cqf_tabel(z_io,false);
10 6113 outchar(z_io,'*');
10 6114 setposition(z_io,0,0);
10 6115 end;
9 6116
9 6116 if kode=90 or kode=91 then
9 6117 begin
10 6118 j:= skrivfil(1033,1,i);
10 6119 if j<>0 then
10 6120 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 6121 for k:= 1 step 1 until max_cqf do
10 6122 begin
11 6123 iaf1:= (k-1)*cqf_lgd;
11 6124 iaf := (k-1)*cqf_id;
11 6125 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 6126 end;
10 6127 op_cqf_tab_ændret:= true;
10 6128 end;
9 6129 end;<*CQF*>
8 6130
8 6130
8 6130 begin
9 6131 \f
9 6131 message procedure io_komm side xx - 940522/cl;
9 6132
9 6132
9 6132
9 6132 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 6133 <*-3*>
9 6134 end
8 6135 end;<*case j *>
7 6136 end <* j > 0 *>
6 6137 else
6 6138 begin
7 6139 <*V*> setposition(z_io,0,0);
7 6140 if sluttegn<>'nl' then outchar(z_io,'nl');
7 6141 skriv_kvittering(z_io,op_ref,-1,
7 6142 45 <* ikke implementeret *>);
7 6143 end;
6 6144 end;<* godkendt *>
5 6145
5 6145 <*V*> setposition(z_io,0,0);
5 6146 signal_bin(bs_zio_adgang);
5 6147 d.op_ref.retur:=cs_att_pulje;
5 6148 disable afslut_kommando(op_ref);
5 6149 end; <* indlæs kommando *>
4 6150
4 6150 begin
5 6151 \f
5 6151 message procedure io_komm side xx+1 - 810428/hko;
5 6152
5 6152 <* 2: aktiver efter stop *>
5 6153 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 6154 terminal_tab.ref.terminal_tilstand extract 21;
5 6155 afslut_operation(op_ref,-1);
5 6156 signal_bin(bs_zio_adgang);
5 6157 end;
4 6158
4 6158 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6159 <*-3*>
4 6160 end; <* case aktion+6 *>
3 6161
3 6161 until false;
3 6162 io_komm_trap:
3 6163 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6164 alarmcause extract 24 = (-13)) then
3 6165 disable skriv_io_komm(zbillede,1);
3 6166 end io_komm;
2 6167 \f
2 6167 message procedure io_spool side 1 - 810507/hko;
2 6168
2 6168 procedure io_spool;
2 6169 begin
3 6170 integer
3 6171 næste_tomme,nr;
3 6172 integer array field
3 6173 op_ref;
3 6174
3 6174 procedure skriv_io_spool(zud,omfang);
3 6175 value omfang;
3 6176 zone zud;
3 6177 integer omfang;
3 6178 begin
4 6179 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6180 if omfang > 0 then
4 6181 disable begin integer x;
5 6182 trap(slut);
5 6183 write(zud,"nl",1,
5 6184 <: opref: :>,op_ref,"nl",1,
5 6185 <: næstetomme::>,næste_tomme,"nl",1,
5 6186 <: nr :>,nr,"nl",1,
5 6187 <::>);
5 6188 skriv_coru(zud,coru_no(102));
5 6189 slut:
5 6190 end;<*disable*>
4 6191 end skriv_io_spool;
3 6192
3 6192 trap(io_spool_trap);
3 6193 næste_tomme:= 1;
3 6194 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6195 <*+2*>
3 6196 if testbit0 and overvåget or testbit28 then
3 6197 skriv_io_spool(out,0);
3 6198 <*-2*>
3 6199 \f
3 6199 message procedure io_spool side 2 - 810602/hko;
3 6200
3 6200 repeat
3 6201
3 6201 wait_ch(cs_io_spool,
3 6202 op_ref,
3 6203 true,
3 6204 -1<*timeout*>);
3 6205
3 6205 i:= d.op_ref.opkode;
3 6206 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6207 begin
4 6208 wait(ss_io_spool_tomme);
4 6209 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6210 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6211
4 6211 i:= d.op_ref.opsize;
4 6212 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6213 begin
5 6214 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6215 i:= io_spool_postlængde*2 -io_spool_post;
5 6216 end;
4 6217 <*-4*>
4 6218 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6219 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6220 signal(ss_io_spool_fulde);
4 6221 d.op_ref.resultat:= 1;
4 6222 end
3 6223 else
3 6224 begin
4 6225 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6226 <:io_spool_korutine:>,1);
4 6227 end;
3 6228
3 6228 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6229
3 6229 until false;
3 6230
3 6230 io_spool_trap:
3 6231
3 6231 disable skriv_io_spool(zbillede,1);
3 6232 end io_spool;
2 6233 \f
2 6233 message procedure io_spon side 1 - 810507/hko;
2 6234
2 6234 procedure io_spon;
2 6235 begin
3 6236 integer
3 6237 næste_fulde,nr,i,dato,kl;
3 6238 real t;
3 6239
3 6239 procedure skriv_io_spon(zud,omfang);
3 6240 value omfang;
3 6241 zone zud;
3 6242 integer omfang;
3 6243 begin
4 6244 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6245 if omfang > 0 then
4 6246 disable begin integer x;
5 6247 trap(slut);
5 6248 write(zud,"nl",1,
5 6249 <: næste-fulde::>,næste_fulde,"nl",1,
5 6250 <: nr :>,nr,"nl",1,
5 6251 <::>);
5 6252 skriv_coru(zud,coru_no(103));
5 6253 slut:
5 6254 end;<*disable*>
4 6255 end skriv_io_spon;
3 6256
3 6256 trap(io_spon_trap);
3 6257 næste_fulde:= 1;
3 6258 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6259 <*+2*>
3 6260 if testbit0 and overvåget or testbit28 then
3 6261 skriv_io_spon(out,0);
3 6262 <*-2*>
3 6263 \f
3 6263 message procedure io_spon side 2 - 810602/hko/cl;
3 6264
3 6264 repeat
3 6265
3 6265 <*V*> wait(ss_io_spool_fulde);
3 6266 <*V*> wait(bs_zio_adgang);
3 6267
3 6267 <*V*> setposition(zio,0,0);
3 6268
3 6268 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6269 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6270
3 6270 laf:=data;
3 6271 k:= fil(nr).io_spool_post.opkode;
3 6272 if k = 22 or k = 36 then
3 6273 disable begin
4 6274 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6275 if k=36 then
4 6276 begin
5 6277 i:= fil(nr).io_spool_post.data(4);
5 6278 j:= i extract 5;
5 6279 if j<>0 then j:=j+'A'-1;
5 6280 i:= i shift (-5) extract 10;
5 6281 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6282 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6283 end;
4 6284 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6285 fil(nr).io_spool_post.tid)
4 6286 end
3 6287 else if k = 23 then
3 6288 disable
3 6289 begin
4 6290 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6291 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6292 kl:= round t;
4 6293 i:= replace_char(1<*space in number*>,'.');
4 6294 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6295 replace_char(1,i);
4 6296 end
3 6297 else if k = 45 or k = 46 then
3 6298 disable begin
4 6299 integer vogn,linie,bogst,løb,t;
4 6300
4 6300 t:=fil(nr).io_spool_post.data(2);
4 6301 outchar(z_io,'nl');
4 6302 if k = 45 then
4 6303 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6304
4 6304 write(zio,<:nødopkald fra :>);
4 6305 vogn:= fil(nr).io_spool_post.data(1);
4 6306 i:= vogn shift (-22);
4 6307 if i < 2 then
4 6308 skrivid(zio,vogn,9)
4 6309 else
4 6310 begin
5 6311 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6312 write(zio,<:!!!:>,vogn);
5 6313 end;
4 6314 \f
4 6314 message procedure io_spon side 3 - 810507/hko;
4 6315
4 6315 if fil(nr).io_spool_post.data(3)<>0 then
4 6316 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6317
4 6317 if k = 46 then
4 6318 begin
5 6319 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6320 end;
4 6321 end <*disable*>
3 6322 else
3 6323 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6324
3 6324 fil(nr,1):= fil(nr,1) add 1;
3 6325
3 6325 <*V*> setposition(zio,0,0);
3 6326
3 6326 signal_bin(bs_zio_adgang);
3 6327
3 6327 signal(ss_io_spool_tomme);
3 6328
3 6328 until false;
3 6329
3 6329 io_spon_trap:
3 6330 skriv_io_spon(zbillede,1);
3 6331
3 6331 end io_spon;
2 6332 \f
2 6332 message procedure io_medd side 1;
2 6333
2 6333 procedure io_medd;
2 6334 begin
3 6335 integer array field opref;
3 6336 integer afs, kl, i;
3 6337 real dato, t;
3 6338
3 6338
3 6338 procedure skriv_io_medd(zud,omfang);
3 6339 value omfang;
3 6340 zone zud;
3 6341 integer omfang;
3 6342 begin
4 6343 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6344 if omfang > 0 then
4 6345 disable begin integer x;
5 6346 trap(slut);
5 6347 write(zud,"nl",1,
5 6348 <: opref: :>,opref,"nl",1,
5 6349 <: afs: :>,afs,"nl",1,
5 6350 <: kl: :>,kl,"nl",1,
5 6351 <: i: :>,i,"nl",1,
5 6352 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6353 <: t: :>,t,"nl",1,
5 6354 <::>);
5 6355 skriv_coru(zud,coru_no(104));
5 6356 slut:
5 6357 end;<*disable*>
4 6358 end skriv_io_medd;
3 6359
3 6359 trap(io_medd_trap);
3 6360 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6361 <*+2*>
3 6362 if testbit0 and overvåget or testbit28 then
3 6363 skriv_io_medd(out,0);
3 6364 <*-2*>
3 6365 \f
3 6365 message procedure io_medd side 2;
3 6366
3 6366 repeat
3 6367 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6368 <*V*> wait(bs_zio_adgang);
3 6369
3 6369 afs:= d.opref.data.op_spool_kilde;
3 6370 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6371 kl:= round t;
3 6372 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6373 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6374 i:= replacechar(1,'.');
3 6375 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6376 replacechar(1,i);
3 6377 write(z_io,d.opref.data.op_spool_text);
3 6378 setposition(z_io,0,0);
3 6379
3 6379 signalbin(bs_zio_adgang);
3 6380 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6381 until false;
3 6382
3 6382 io_medd_trap:
3 6383 skriv_io_medd(zbillede,1);
3 6384
3 6384 end io_medd;
2 6385
2 6385 procedure io_nulstil_tællere;
2 6386 begin
3 6387 real nu, dato, kl, forr, næste, et_døgn, r;
3 6388 integer array field opref;
3 6389 integer ventetid, omr, typ, sum;
3 6390 integer array ialt(1:5);
3 6391
3 6391 procedure skriv_io_null(zud,omfang);
3 6392 value omfang;
3 6393 zone zud;
3 6394 integer omfang;
3 6395 begin
4 6396 disable write(zud,"nl",1,<:+++ io_nulstil_tællere :>);
4 6397 if omfang > 0 then
4 6398 disable begin real t; real array field raf;
5 6399 raf:=0;
5 6400 trap(slut);
5 6401 write(zud,"nl",1,
5 6402 <: opref: :>,opref,"nl",1,
5 6403 <: ventetid: :>,ventetid,"nl",1,
5 6404 <: omr: :>,omr,"nl",1,
5 6405 <: typ: :>,typ,"nl",1,
5 6406 <: sum: :>,sum,"nl",1,
5 6407 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 6408 <: forr: :>,systime(4,forr,t),t,"nl",1,
5 6409 <: næste: :>,systime(4,næste,t),t,"nl",1,
5 6410 <: r: :>,systime(4,r,t),t,"nl",1,
5 6411 <: dato: :>,dato,"nl",1,
5 6412 <: kl: :>,kl,"nl",1,
5 6413 <: et-døgn: :>,<< dddddd>,et_døgn,"nl",1,
5 6414 <::>);
5 6415 write(zud,"nl",1,<:ialt: :>);
5 6416 skriv_hele(zud,ialt.raf,10,2);
5 6417 skriv_coru(zud,coru_no(105));
5 6418 slut:
5 6419 end;<*disable*>
4 6420 end skriv_io_null;
3 6421
3 6421 trap(io_null_trap);
3 6422 et_døgn:= 24*60*60.0;
3 6423 stack_claim(500);
3 6424 <*+2*>
3 6425 if testbit0 and overvåget or testbit28 then
3 6426 skriv_io_null(out,0);
3 6427 <*-2*>
3 6428 pass;
3 6429
3 6429 systime(1,0.0,nu);
3 6430 dato:= systime(4,nu,kl);
3 6431 if nulstil_systællere >= 0 then
3 6432 begin
4 6433 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6434 + et_døgn
4 6435 else næste:= systid(dato,nulstil_systællere);
4 6436 forr:= næste - et_døgn;
4 6437 if (forr - systællere_nulstillet) > et_døgn then
4 6438 næste:= nu;
4 6439 end;
3 6440
3 6440 repeat
3 6441 ventetid:= (if nulstil_systællere < 0 then (-1) else (næste - nu));
3 6442 <*V*> waitch(cs_io_nulstil,opref,io_optype,ventetid);
3 6443
3 6443 if opref <= 0 then
3 6444 begin
4 6445 <* nulstil opkaldstællere *>
4 6446 wait(bs_zio_adgang);
4 6447 setposition(z_io,0,0);
4 6448
4 6448 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6449
4 6449 write(z_io,"nl",1,<:!TÆ,N (automatisk):>,"nl",2,
4 6450 <:område udgående alm. ind nød ind:>,
4 6451 <: ind ialt total ej forb. optaget:>,"nl",1);
4 6452 for omr := 1 step 1 until max_antal_områder do
4 6453 begin
5 6454 sum:= 0;
5 6455 write(z_io,true,6,string område_navn(omr),":",1);
5 6456 for typ:= 1 step 1 until 3 do
5 6457 begin
6 6458 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6459 sum:= sum + opkalds_tællere((omr-1)*5+typ);
6 6460 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6461 end;
5 6462 write(z_io,<< ddddddd>,
5 6463 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
5 6464 for typ:= 4 step 1 until 5 do
5 6465 begin
6 6466 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6467 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6468 end;
5 6469 write(z_io,"nl",1);
5 6470 end;
4 6471 sum:= 0;
4 6472 write(z_io,"nl",1,<:ialt ::>);
4 6473 for typ:= 1 step 1 until 3 do
4 6474 begin
5 6475 write(z_io,<< ddddddd>,ialt(typ));
5 6476 sum:= sum+ialt(typ);
5 6477 end;
4 6478 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6479 ialt(4), ialt(5), "nl",3);
4 6480
4 6480 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6481 write(z_io,<:oper. udgående alm. ind nød ind:>,
4 6482 <: ind ialt total ej forb. optaget:>,"nl",1);
4 6483 for omr := 1 step 1 until max_antal_operatører do
4 6484 begin
5 6485 sum:= 0;
5 6486 if bpl_navn(omr)=long<::> then
5 6487 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
5 6488 else
5 6489 write(z_io,true,6,string bpl_navn(omr),":",1);
5 6490 for typ:= 1 step 1 until 3 do
5 6491 begin
6 6492 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
6 6493 sum:= sum + operatør_tællere((omr-1)*5+typ);
6 6494 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6495 end;
5 6496 write(z_io,<< ddddddd>,
5 6497 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
5 6498 for typ:= 4 step 1 until 5 do
5 6499 begin
6 6500 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
6 6501 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6502 end;
5 6503 write(z_io,"nl",1);
5 6504 end;
4 6505 sum:= 0;
4 6506 write(z_io,"nl",1,<:ialt ::>);
4 6507 for typ:= 1 step 1 until 3 do
4 6508 begin
5 6509 write(z_io,<< ddddddd>,ialt(typ));
5 6510 sum:= sum+ialt(typ);
5 6511 end;
4 6512 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6513 ialt(4),ialt(5),"nl",2);
4 6514
4 6514 typ:= replacechar(1,':');
4 6515 write(z_io,<:tællere nulstilles :>);
4 6516 if nulstil_systællere=(-1) then
4 6517 write(z_io,<:ikke automatisk:>,"nl",1)
4 6518 else
4 6519 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
4 6520 nulstil_systællere,"nl",1);
4 6521 replacechar(1,'.');
4 6522 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
4 6523 systime(4,systællere_nulstillet,r));
4 6524 replacechar(1,':');
4 6525 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
4 6526 replacechar(1,typ);
4 6527 write(z_io,"*",1,"nl",1);
4 6528 setposition(z_io,0,0);
4 6529 signal_bin(bs_zio_adgang);
4 6530
4 6530 for omr:= 1 step 1 until max_antal_områder*5 do
4 6531 opkalds_tællere(omr):= 0;
4 6532 for omr:= 1 step 1 until max_antal_operatører*5 do
4 6533 operatør_tællere(omr):= 0;
4 6534 systællere_nulstillet:= næste;
4 6535 opdater_tf_systællere;
4 6536 end
3 6537 else
3 6538 signalch(d.opref.retur,opref,d.opref.optype);
3 6539
3 6539 systime(1,0.0,nu);
3 6540 dato:= systime(4,nu,kl);
3 6541 if nulstil_systællere >= 0 then
3 6542 begin
4 6543 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6544 + et_døgn
4 6545 else næste:= systid(dato,nulstil_systællere);
4 6546 forr:= næste - et_døgn;
4 6547 end;
3 6548 until false;
3 6549
3 6549 io_null_trap:
3 6550 skriv_io_null(zbillede,1);
3 6551 end io_nulstil_tællere;
2 6552
2 6552 \f
2 6552 message operatør_erklæringer side 1 - 810602/hko;
2 6553 integer
2 6554 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6555 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6556 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6557 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6558 integer array
2 6559 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6560 operatørmaske(1:op_maske_lgd//2),
2 6561 op_talevej(0:max_antal_operatører),
2 6562 tv_operatør(0:max_antal_taleveje),
2 6563 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6564 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6565 ant_i_opkø,
2 6566 cs_operatør,
2 6567 cs_op_fil(1:max_antal_operatører);
2 6568 boolean
2 6569 op_cqf_tab_ændret;
2 6570 integer field
2 6571 op_spool_kilde;
2 6572 real field
2 6573 op_spool_tid;
2 6574 long array field
2 6575 op_spool_text;
2 6576 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6577 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6578 \f
2 6578 message procedure op_fejl side 1 - 830310/hko;
2 6579
2 6579 procedure op_fejl(z,s,b);
2 6580 integer s,b;
2 6581 zone z;
2 6582 begin
3 6583 disable begin
4 6584 integer array iz(1:20);
4 6585 integer i,j,k,n;
4 6586 integer array field iaf,iaf1,msk;
4 6587 boolean input;
4 6588 real array field laf,laf1;
4 6589
4 6589 getzone6(z,iz);
4 6590 iaf:=laf:=2;
4 6591 input:= iz(13) = 1;
4 6592 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6593 if iz.laf(1)=terminal_navn.laf1(1) and
4 6594 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6595
4 6595 <*+2*> if testbit31 then
4 6596 <**> begin
5 6597 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6598 <**> <:s=:>); outintbits(out,s);
5 6599 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6600 <**> else <:output:>,"nl",1);
5 6601 <**> setposition(out,0,0);
5 6602 <**> end;
4 6603 <*-2*>
4 6604 iaf:=j*terminal_beskr_længde;
4 6605 k:=1;
4 6606
4 6606 i:= terminal_tab.iaf.terminal_tilstand;
4 6607 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6608 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6609 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6610 if s <> (1 shift 21 +2) then
4 6611 begin
5 6612 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6613 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6614 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6615 sæt_bit_ia(opkaldsflag,j,0);
5 6616 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6617 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6618 begin
6 6619 msk:= k*op_maske_lgd;
6 6620 if læsbit_ia(bpl_def.msk,j) then
6 6621 <**> begin
7 6622 n:= 0;
7 6623 for i:= 1 step 1 until max_antal_operatører do
7 6624 if læsbit_ia(bpl_def.msk,i) then
7 6625 begin
8 6626 iaf1:= i*terminal_beskr_længde;
8 6627 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6628 n:= n+1;
8 6629 end;
7 6630 bpl_tilst(j,1):= n;
7 6631 end;
6 6632 <**> <*
6 6633 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6634 *> end;
5 6635 signal_bin(bs_mobil_opkald);
5 6636 end;
4 6637
4 6637 if input or -,input then
4 6638 begin
5 6639 z(1):=real <:<'?'><'?'><'em'>:>;
5 6640 b:=2;
5 6641 end;
4 6642 end; <*disable*>
3 6643 end op_fejl;
2 6644 \f
2 6644 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6645
2 6645 procedure tvswitch_fejl(z,s,b);
2 6646 integer s,b;
2 6647 zone z;
2 6648 begin
3 6649 disable begin
4 6650 integer array iz(1:20);
4 6651 integer i,j,k;
4 6652 integer array field iaf;
4 6653 boolean input;
4 6654 real array field raf;
4 6655
4 6655 getzone6(z,iz);
4 6656 iaf:=raf:=2;
4 6657 input:= iz(13) = 1;
4 6658 <*+2*> if testbit31 then
4 6659 <**> begin
5 6660 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6661 <**> <:s=:>); outintbits(out,s);
5 6662 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6663 <**> else <:output:>,"nl",1);
5 6664 <**> skrivhele(out,z,b,5);
5 6665 <**> setposition(out,0,0);
5 6666 <**> end;
4 6667 <*-2*>
4 6668 k:=1;
4 6669 if s <> (1 shift 21 +2) then
4 6670 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6671 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6672
4 6672 if input or -,input then
4 6673 begin
5 6674 z(1):=real <:<'em'>:>;
5 6675 b:=2;
5 6676 end;
4 6677 end; <*disable*>
3 6678 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6679 end tvswitch_fejl;
2 6680
2 6680 procedure skriv_talevejs_tab(z);
2 6681 zone z;
2 6682 begin
3 6683 write(z,"nl",2,<:talevejsswitch::>);
3 6684 write(z,"nl",1,<: operatører::>,"nl",1);
3 6685 for i:= 1 step 1 until max_antal_operatører do
3 6686 begin
4 6687 write(z,<< dd>,i,":",1,op_talevej(i));
4 6688 if i mod 8=0 then outchar(z,'nl');
4 6689 end;
3 6690 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6691 for i:= 1 step 1 until max_antal_taleveje do
3 6692 begin
4 6693 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6694 if i mod 8=0 then outchar(z,'nl');
4 6695 end;
3 6696 write(z,"nl",3);
3 6697 end;
2 6698 \f
2 6698 message procedure skriv_opk_alarm_tab side 1;
2 6699
2 6699 procedure skriv_opk_alarm_tab(z);
2 6700 zone z;
2 6701 begin
3 6702 integer nr;
3 6703 integer array field tab;
3 6704 real t;
3 6705
3 6705 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6706 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6707 for nr:=1 step 1 until max_antal_operatører do
3 6708 begin
4 6709 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6710 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6711 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6712 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6713 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6714 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6715 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6716 "nl",1);
4 6717 end;
3 6718 end;
2 6719 \f
2 6719 message procedure skriv_op_spool_buf side 1;
2 6720
2 6720 procedure skriv_op_spool_buf(z);
2 6721 zone z;
2 6722 begin
3 6723 integer array field ref;
3 6724 integer nr, kilde;
3 6725 real dato, kl;
3 6726
3 6726 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6727 for nr:= 1 step 1 until op_spool_postantal do
3 6728 begin
4 6729 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6730 ref:= (nr-1)*op_spool_postlgd;
4 6731 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6732 begin
5 6733 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6734 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6735 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6736 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6737 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6738 op_spool_buf.ref.op_spool_text);
5 6739 end;
4 6740 outchar(z,'nl');
4 6741 end;
3 6742 end;
2 6743
2 6743 procedure skriv_cqf_tabel(z,lang);
2 6744 value lang;
2 6745 zone z;
2 6746 boolean lang;
2 6747 begin
3 6748 integer array field ref;
3 6749 integer i,ant;
3 6750 real dato, kl;
3 6751
3 6751 ant:= 0;
3 6752 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6753 if -,lang then
3 6754 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6755 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6756 else
3 6757 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6758 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6759 for i:= 1 step 1 until max_cqf do
3 6760 begin
4 6761 ref:= (i-1)*cqf_lgd;
4 6762 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6763 begin
5 6764 ant:= ant+1;
5 6765 if lang then
5 6766 write(z,<<dd>,i,":",1);
5 6767 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6768 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6769 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6770 begin
6 6771 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6772 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6773 end
5 6774 else
5 6775 write(z,"sp",14,"?",1);
5 6776 if lang then
5 6777 begin
6 6778 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6779 begin
7 6780 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6781 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6782 end
6 6783 else
6 6784 write(z,"sp",14,"?",1);
6 6785 end
5 6786 else
5 6787 write(z,"sp",2);
5 6788 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6789 end;
4 6790 end;
3 6791 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6792 end;
2 6793
2 6793 procedure sorter_cqftab(l,u);
2 6794 value l,u;
2 6795 integer l,u;
2 6796 begin
3 6797 integer array field ii,jj;
3 6798 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6799
3 6799 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6800 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6801 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6802 repeat
3 6803 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6804 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6805 if ii <= jj then
3 6806 begin
4 6807 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6808 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6809 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6810 ii:= ii+cqf_lgd;
4 6811 jj:= jj-cqf_lgd;
4 6812 end;
3 6813 until ii>jj;
3 6814 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6815 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6816 end;
2 6817 \f
2 6817 message procedure ht_symbol side 1 - 851001/cl;
2 6818
2 6818 procedure ht_symbol(z);
2 6819 zone z;
2 6820 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6821
2 6821
2 6821
2 6821
2 6821 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6821 @@ @@ @@
2 6821 @@ @@ @@
2 6821 @@ @@ @@
2 6821 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6821 @@ @@
2 6821 @@ @@
2 6821 @@ @@
2 6821 @@ @@@@@@@@@@@@@ @@
2 6821 @@ @@ @@ @@
2 6821 @@ @@ @@ @@
2 6821 @@ @@ @@ @@
2 6821 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6821 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6822 \f
2 6822 message procedure definer_taster side 1 - 891214,cl;
2 6823
2 6823 procedure definer_taster(nr);
2 6824 value nr;
2 6825 integer nr;
2 6826 begin
3 6827
3 6827 setposition(z_op(nr),0,0);
3 6828 write(z_op(nr),
3 6829 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6830 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6831 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6832 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6833 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6834 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6835 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6836 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6837 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6838 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6839 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6840 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6841 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6842 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6843 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6844 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6845 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6846 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6847 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6848 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6849 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6850 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6851 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6852 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6853 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6854 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6855 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6856 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6857 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6858 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6859 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6860 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6861 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6862 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6863 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6864 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6865 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6866 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6867 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6868 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6869 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6870 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6871 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6872 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6873 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6874 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6875 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6876 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6877 <::>);
3 6878 end;
2 6879 \f
2 6879 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6880
2 6880 procedure skriv_terminal_tab(z);
2 6881 zone z;
2 6882 begin
3 6883 integer array field ref;
3 6884 integer t1,i,j,id,k;
3 6885
3 6885 write(z,"ff",1,<:
3 6886 ******* terminalbeskrivelser ********
3 6887
3 6887 # a k l p m m n o
3 6888 1 l a y a o o ø p
3 6889 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6890 <*
3 6891 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6892 *>
3 6893 for i:=1 step 1 until max_antal_operatører do
3 6894 begin
4 6895 ref:=i*terminal_beskr_længde;
4 6896 t1:=terminal_tab.ref(1);
4 6897 id:=terminal_tab.ref(2);
4 6898 k:=terminal_tab.ref(3);
4 6899 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6900 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6901 "sp",1);
4 6902 for j:=11 step -1 until 2 do
4 6903 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6904 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6905 "sp",1);
4 6906 skriv_id(z,id,9);
4 6907 skriv_id(z,k,9);
4 6908 end;
3 6909 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6910 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6911 write(z,"nl",1);
3 6912 end skriv_terminal_tab;
2 6913 \f
2 6913 message procedure h_operatør side 1 - 810520/hko;
2 6914
2 6914 <* hovedmodulkorutine for operatørterminaler *>
2 6915 procedure h_operatør;
2 6916 begin
3 6917 integer array field op_ref;
3 6918 integer k,nr,ant,ref,dest_sem;
3 6919 procedure skriv_hoperatør(zud,omfang);
3 6920 value omfang;
3 6921 zone zud;
3 6922 integer omfang;
3 6923 begin
4 6924
4 6924 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6925 if omfang>0 then
4 6926 disable begin integer x;
5 6927 trap(slut);
5 6928 write(zud,"nl",1,
5 6929 <: op_ref: :>,op_ref,"nl",1,
5 6930 <: nr: :>,nr,"nl",1,
5 6931 <: ant: :>,ant,"nl",1,
5 6932 <: ref: :>,ref,"nl",1,
5 6933 <: k: :>,k,"nl",1,
5 6934 <: dest_sem: :>,dest_sem,"nl",1,
5 6935 <::>);
5 6936 skriv_coru(zud,coru_no(200));
5 6937 slut:
5 6938 end;
4 6939 end skriv_hoperatør;
3 6940
3 6940 trap(hop_trap);
3 6941 stack_claim(if cm_test then 198 else 146);
3 6942
3 6942 <*+2*>
3 6943 if testbit8 and overvåget or testbit28 then
3 6944 skriv_hoperatør(out,0);
3 6945 <*-2*>
3 6946 \f
3 6946 message procedure h_operatør side 2 - 820304/hko;
3 6947
3 6947 repeat
3 6948 wait_ch(cs_op,op_ref,true,-1);
3 6949 <*+4*>
3 6950 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6951 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6952 <*-4*>
3 6953
3 6953 k:=d.op_ref.opkode extract 12;
3 6954 dest_sem:=
3 6955 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6956 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6957 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6958 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6959 if k=37 then cs_op_spool else
3 6960 if k=40 or k=38 then 0
3 6961 else -1;
3 6962 <*+4*>
3 6963 if dest_sem=-1 then
3 6964 begin
4 6965 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6966 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6967 end
3 6968 else
3 6969 <*-4*>
3 6970 if k=40 then
3 6971 begin
4 6972 dest_sem:= d.op_ref.retur;
4 6973 d.op_ref.retur:= cs_op_retur;
4 6974 for nr:= 1 step 1 until max_antal_operatører do
4 6975 begin
5 6976 inspect_ch(cs_operatør(nr),genoptype,ant);
5 6977 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 6978 or læsbit_ia(samtaleflag,nr))
5 6979 and læsbit_ia(operatørmaske,nr) then
5 6980 begin
6 6981 ref:= op_ref;
6 6982 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6983 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6984 <*+4*> if op_ref <> ref then
6 6985 fejlreaktion(11<*fr.post*>,op_ref,
6 6986 <:opdater opkaldskø,retur:>,0);
6 6987 <*-4*>
6 6988 end;
5 6989 end;
4 6990 d.op_ref.retur:= dest_sem;
4 6991 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6992 end
3 6993 else
3 6994 if k=38 then
3 6995 begin
4 6996 dest_sem:= d.opref.retur;
4 6997 d.op_ref.retur:= cs_op_retur;
4 6998 for nr:= 1 step 1 until max_antal_operatører do
4 6999 begin
5 7000 if d.opref.data.op_spool_kilde <> nr then
5 7001 begin
6 7002 ref:= op_ref;
6 7003 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 7004 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 7005 <*+4*> if op_ref <> ref then
6 7006 fejlreaktion(11<*fr.post*>,op_ref,
6 7007 <:opdater opkaldskø,retur:>,0);
6 7008 <*-4*>
6 7009 end;
5 7010 end;
4 7011 if d.opref.data.op_spool_kilde<>0 then
4 7012 begin
5 7013 ref:= op_ref;
5 7014 nr:= d.opref.data.op_spool_kilde;
5 7015 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 7016 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 7017 <*+4*> if op_ref <> ref then
5 7018 fejlreaktion(11<*fr.post*>,op_ref,
5 7019 <:operatørmedddelelse, retur:>,0);
5 7020 <*-4*>
5 7021 d.op_ref.retur:= dest_sem;
5 7022 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 7023 end
4 7024 else
4 7025 begin
5 7026 d.op_ref.retur:= dest_sem;
5 7027 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 7028 end;
4 7029 end
3 7030 else
3 7031 begin
4 7032 \f
4 7032 message procedure h_operatør side 3 - 810601/hko;
4 7033
4 7033 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 7034 begin
5 7035 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 7036 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 7037 +terminal_tab.iaf.terminal_tilstand extract 21;
5 7038 end;
4 7039 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7040 end;
3 7041 until false;
3 7042
3 7042 hop_trap:
3 7043 disable skriv_hoperatør(zbillede,1);
3 7044 end h_operatør;
2 7045 \f
2 7045 message procedure operatør side 1 - 820304/hko;
2 7046
2 7046 procedure operatør(nr);
2 7047 value nr;
2 7048 integer nr;
2 7049 begin
3 7050 integer array field op_ref,ref,vt_op,iaf,tab;
3 7051 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 7052 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 7053 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 7054 real kommstart,kommslut;
3 7055 \f
3 7055 message procedure operatør side 1a - 820301/hko;
3 7056
3 7056 procedure skriv_operatør(zud,omfang);
3 7057 value omfang;
3 7058 zone zud;
3 7059 integer omfang;
3 7060 begin integer i;
4 7061
4 7061 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 7062 write(zud,"sp",26-i);
4 7063 if omfang > 0 then
4 7064 disable begin
5 7065 integer x;
5 7066 trap(slut);
5 7067 write(zud,"nl",1,
5 7068 <: op-ref: :>,op_ref,"nl",1,
5 7069 <: kode: :>,kode,"nl",1,
5 7070 <: aktion: :>,aktion,"nl",1,
5 7071 <: ref: :>,ref,"nl",1,
5 7072 <: vt_op: :>,vt_op,"nl",1,
5 7073 <: iaf: :>,iaf,"nl",1,
5 7074 <: status: :>,status,"nl",1,
5 7075 <: tilstand: :>,tilstand,"nl",1,
5 7076 <: bv: :>,bv,"nl",1,
5 7077 <: bs: :>,bs,"nl",1,
5 7078 <: bs-tilst: :>,bs_tilst,"nl",1,
5 7079 <: kanal: :>,kanal,"nl",1,
5 7080 <: opgave: :>,opgave,"nl",1,
5 7081 <: pos: :>,pos,"nl",1,
5 7082 <: indeks: :>,indeks,"nl",1,
5 7083 <: sep: :>,sep,"nl",1,
5 7084 <: sluttegn: :>,sluttegn,"nl",1,
5 7085 <: vogn: :>,vogn,"nl",1,
5 7086 <: ll: :>,ll,"nl",1,
5 7087 <: garage: :>,garage,"nl",1,
5 7088 <: skærmmåde: :>,skærmmåde,"nl",1,
5 7089 <: res: :>,res,"nl",1,
5 7090 <: tab: :>,tab,"nl",1,
5 7091 <: rkom: :>,rkom,"nl",1,
5 7092 <: par1: :>,par1,"nl",1,
5 7093 <: par2: :>,par2,"nl",1,
5 7094 <::>);
5 7095 skriv_coru(zud,coru_no(200+nr));
5 7096 slut:
5 7097 end;
4 7098 end skriv_operatør;
3 7099 \f
3 7099 message procedure skærmstatus side 1 - 810518/hko;
3 7100
3 7100 integer
3 7101 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 7102 integer tilstand,b_v,b_s,b_s_tilst;
3 7103 begin
4 7104 integer i,j;
4 7105
4 7105 i:= terminal_tab.ref(1);
4 7106 b_s:= terminal_tab.ref(2);
4 7107 b_s_tilst:= i extract 12;
4 7108 j:= b_s_tilst extract 3;
4 7109 b_v:= i shift (-12) extract 4;
4 7110 tilstand:= i shift (-21);
4 7111
4 7111 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 7112 if b_v = 0 and j = 1<*opkald*> then 1 else
4 7113 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 7114 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 7115 end skærmstatus;
3 7116 \f
3 7116 message procedure skriv_skærm side 1 - 810522/hko;
3 7117
3 7117 procedure skriv_skærm(nr);
3 7118 value nr;
3 7119 integer nr;
3 7120 begin
4 7121 integer i;
4 7122
4 7122 disable definer_taster(nr);
4 7123
4 7123 skriv_skærm_maske(nr);
4 7124 skriv_skærm_opkaldskø(nr);
4 7125 skriv_skærm_b_v_s(nr);
4 7126 for i:= 1 step 1 until max_antal_kanaler do
4 7127 skriv_skærm_kanal(nr,i);
4 7128 cursor(z_op(nr),1,1);
4 7129 <*V*> setposition(z_op(nr),0,0);
4 7130 end skriv_skærm;
3 7131 \f
3 7131 message procedure skriv_skærm_id side 1 - 830310/hko;
3 7132
3 7132 procedure skriv_skærm_id(nr,id,nød);
3 7133 value nr,id,nød;
3 7134 integer nr,id;
3 7135 boolean nød;
3 7136 begin
4 7137 integer linie,løb,bogst,i,p;
4 7138
4 7138 i:= id shift (-22);
4 7139
4 7139 case i+1 of
4 7140 begin
5 7141 begin <* busnr *>
6 7142 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 7143 (id extract 14) mod 10000);
6 7144 if id shift (-14) extract 8 > 0 then
6 7145 p:= p+write(z_op(nr),".",1,
6 7146 string bpl_navn(id shift (-14) extract 8));
6 7147 write(z_op(nr),"sp",11-p);
6 7148 end;
5 7149
5 7149 begin <*linie/løb*>
6 7150 linie:= id shift (-12) extract 10;
6 7151 bogst:= id shift (-7) extract 5;
6 7152 if bogst > 0 then bogst:= bogst +'A'-1;
6 7153 løb:= id extract 7;
6 7154 write(z_op(nr),if nød then "*" else "sp",1,
6 7155 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 7156 false add bogst,1,"/",1,løb,
6 7157 "sp",if løb > 9 then 3 else 4);
6 7158 end;
5 7159
5 7159 begin <*gruppe*>
6 7160 write(z_op(nr),<:GRP :>);
6 7161 if id shift (-21) extract 1 = 1 then
6 7162 begin <*specialgruppe*>
7 7163 løb:= id extract 7;
7 7164 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 7165 <<d>,løb,"sp",2);
7 7166 end
6 7167 else
6 7168 begin
7 7169 linie:= id shift (-5) extract 10;
7 7170 bogst:= id extract 5;
7 7171 if bogst > 0 then bogst:= bogst +'A'-1;
7 7172 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 7173 false add bogst,1,"sp",2);
7 7174 end;
6 7175 end;
5 7176
5 7176 <* kanal eller område *>
5 7177 begin
6 7178 linie:= (id shift (-20) extract 2) + 1;
6 7179 case linie of
6 7180 begin
7 7181 write(z_op(nr),"sp",11-write(z_op(nr),
7 7182 string kanal_navn(id extract 20)));
7 7183 write(z_op(nr),<:K*:>,"sp",9);
7 7184 write(z_op(nr),"sp",11-write(z_op(nr),
7 7185 <:OMR :>,string område_navn(id extract 20)));
7 7186 write(z_op(nr),<:ALLE:>,"sp",7);
7 7187 end;
6 7188 end;
5 7189
5 7189 end <* case i *>
4 7190 end skriv_skærm_id;
3 7191 \f
3 7191 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 7192
3 7192 procedure skriv_skærm_kanal(nr,kanal);
3 7193 value nr,kanal;
3 7194 integer nr,kanal;
3 7195 begin
4 7196 integer i,j,k,t,omr;
4 7197 integer array field tref,kref;
4 7198 boolean nød;
4 7199
4 7199 tref:= nr*terminal_beskr_længde;
4 7200 kref:= (kanal-1)*kanal_beskr_længde;
4 7201 t:= kanaltab.kref.kanal_tilstand;
4 7202 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 7203 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 7204 cursor(z_op(nr),kanal+2,28);
4 7205 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 7206 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 7207 " ",1," ",1);
4 7208 write(z_op(nr),true,6,string kanal_navn(kanal));
4 7209 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 7210 pabx_id(kanal_id(kanal) extract 5)
4 7211 else
4 7212 radio_id(kanal_id(kanal) extract 5);
4 7213 for i:= -2 step 1 until 0 do
4 7214 begin
5 7215 write(z_op(nr),
5 7216 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 7217 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 7218 end;
4 7219 write(z_op(nr),<:: :>);
4 7220 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 7221 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 7222 begin
5 7223 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 7224 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 7225 end
4 7226 else
4 7227 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 7228 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 7229 else
4 7230 if i > 0 and
4 7231 ( true <* i <> nr *> <* OPT også ud på egen skærm 960527/CL *> or
4 7232 j = kanal <* kanal = kanalnr for ventepos *> or
4 7233 (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 7234 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 7235 begin
5 7236 write(z_op(nr),<:OPT :>);
5 7237 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 7238 else write(z_op(nr),string bpl_navn(i));
5 7239 end
4 7240 else
4 7241 if false then
4 7242 begin
5 7243 i:= kanaltab.kref.kanal_id1;
5 7244 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 7245 skriv_skærm_id(nr,i,nød);
5 7246 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 7247 i:= kanaltab.kref.kanal_id2;
5 7248 if i<>0 then skriv_skærm_id(nr,i,false);
5 7249 end;
4 7250 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7251 end skriv_skærm_kanal;
3 7252 \f
3 7252 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 7253
3 7253 procedure skriv_skærm_b_v_s(nr);
3 7254 value nr;
3 7255 integer nr;
3 7256 begin
4 7257 integer i,j,k,kv,ks,t;
4 7258 integer array field tref,kref;
4 7259
4 7259 tref:= nr*terminal_beskr_længde;
4 7260 i:= terminal_tab.tref.terminal_tilstand;
4 7261 kv:= i shift (-12) extract 4;
4 7262 ks:= terminaltab.tref(2) extract 20;
4 7263 <*V*> setposition(z_op(nr),0,0);
4 7264 cursor(z_op(nr),18,28);
4 7265 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7266 cursor(z_op(nr),20,28);
4 7267 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7268 cursor(z_op(nr),21,28);
4 7269 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7270 cursor(z_op(nr),20,28);
4 7271 if op_talevej(nr)<>0 then
4 7272 begin
5 7273 cursor(z_op(nr),18,28);
5 7274 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 7275 end;
4 7276 if kv <> 0 then
4 7277 begin
5 7278 kref:= (kv-1)*kanal_beskr_længde;
5 7279 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 7280 else kanaltab.kref.kanal_id2;
5 7281 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 7282 else kanaltab.kref.kanal_alt_id2;
5 7283 write(z_op(nr),true,6,string kanal_navn(kv));
5 7284 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 7285 skriv_skærm_id(nr,k,false);
5 7286 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 7287 end;
4 7288
4 7288 cursor(z_op(nr),21,28);
4 7289 j:= terminal_tab.tref(2);
4 7290 if i shift (-21) <> 0 <*ikke ledig*> then
4 7291 begin
5 7292 \f
5 7292 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 7293
5 7293 if i shift (-21) = 1 <*samtale*> then
5 7294 begin
6 7295 if j shift (-20) = 12 then
6 7296 begin
7 7297 write(z_op(nr),true,6,string kanal_navn(ks));
7 7298 end
6 7299 else
6 7300 begin
7 7301 write(z_op(nr),true,6,<:K*:>);
7 7302 k:= 0;
7 7303 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 7304 k:= k+1;
7 7305 ks:= k;
7 7306 end;
6 7307 kref:= (ks-1)*kanal_beskr_længde;
6 7308 t:= kanaltab.kref.kanaltilstand;
6 7309 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 7310 t shift (-3) extract 1 = 1);
6 7311 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 7312 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 7313 if t shift (-5) extract 1 = 1 then <:MON :> else
6 7314 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 7315 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 7316 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 7317 if t shift (-9) extract 1 = 1 then
6 7318 write(z_op(nr),<:ALLE :>);
6 7319 if t shift (-8) extract 1 = 1 then
6 7320 write(z_op(nr),<:KATASTROFE :>);
6 7321 k:= kanaltab.kref.kanal_spec;
6 7322 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7323 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7324 end
5 7325 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7326 begin
6 7327 write(z_op(nr),<:K-:>,"sp",3);
6 7328 if j <> 0 then
6 7329 skriv_skærm_id(nr,j,false)
6 7330 else
6 7331 begin
7 7332 j:=terminal_tab.tref(3);
7 7333 skriv_skærm_id(nr,j,
7 7334 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7335 else 0));
7 7336 end;
6 7337 write(z_op(nr),<:OPT:>);
6 7338 end;
5 7339 end;
4 7340 <*V*> setposition(z_op(nr),0,0);
4 7341 end skriv_skærm_b_v_s;
3 7342 \f
3 7342 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7343
3 7343 procedure skriv_skærm_maske(nr);
3 7344 value nr;
3 7345 integer nr;
3 7346 begin
4 7347 integer i;
4 7348 <*V*> setposition(z_op(nr),0,0);
4 7349 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7350 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7351 "sp",1,"*",5,"nl",1,"-",80);
4 7352
4 7352 for i:= 3 step 1 until 21 do
4 7353 begin
5 7354 cursor(z_op(nr),i,26);
5 7355 outchar(z_op(nr),'!');
5 7356 end;
4 7357 cursor(z_op(nr),22,1);
4 7358 write(z_op(nr),"-",80);
4 7359 cursor(z_op(nr),1,1);
4 7360 <*V*> setposition(z_op(nr),0,0);
4 7361 end skriv_skærm_maske;
3 7362 \f
3 7362 message procedure skal_udskrives side 1 - 940522/cl;
3 7363
3 7363 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7364 value fordelt_til,aktuel_skærm;
3 7365 integer fordelt_til,aktuel_skærm;
3 7366 begin
4 7367 boolean skal_ud;
4 7368 integer n;
4 7369 integer array field iaf;
4 7370
4 7370 skal_ud:= true;
4 7371 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7372 begin
5 7373 for n:= 0 step 1 until 3 do
5 7374 begin
6 7375 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7376 begin
7 7377 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7378 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7379 goto returner;
7 7380 end;
6 7381 end;
5 7382 end;
4 7383 returner:
4 7384 skal_udskrives:= skal_ud;
4 7385 end;
3 7386
3 7386 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7387
3 7387 procedure skriv_skærm_opkaldskø(nr);
3 7388 value nr;
3 7389 integer nr;
3 7390 begin
4 7391 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7392 integer array field ref,iaf,tab;
4 7393 boolean skal_ud;
4 7394
4 7394 <*V*> wait(bs_opkaldskø_adgang);
4 7395 setposition(z_op(nr),0,0);
4 7396 ant:= 0; kmdo:= 0;
4 7397 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7398 ref:= første_nødopkald;
4 7399 if ref=0 then ref:=første_opkald;
4 7400 while ref <> 0 do
4 7401 begin
5 7402 i:= opkaldskø.ref(4);
5 7403 operatør:= i extract 8;
5 7404 type:=i shift (-8) extract 4;
5 7405
5 7405 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7406 *>
5 7407 if operatør > 64 then
5 7408 begin
6 7409 <* fordelt til gruppe af betjeningspladser *>
6 7410 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7411 while skal_ud and i<max_antal_operatører do
6 7412 begin
7 7413 i:=i+1;
7 7414 if læsbit_ia(bpl_def.iaf,i) then
7 7415 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7416 end;
6 7417 end
5 7418 else
5 7419 skal_ud:= skal_udskrives(operatør,nr);
5 7420 if skal_ud then
5 7421 begin
6 7422 ant:= ant +1;
6 7423 if ant < 6 then
6 7424 begin
7 7425 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7426 ttmm:= i shift (-12);
7 7427 vogn:= opkaldskø.ref(3);
7 7428 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7429 skriv_skærm_id(nr,vogn,type=2);
7 7430 write(z_op(nr),true,4,
7 7431 string område_navn(opkaldskø.ref(5) extract 4),
7 7432 <<zd.dd>,ttmm/100.0);
7 7433 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7434 begin
8 7435 if opkaldskø.ref(5) extract 4 <= 2 or
8 7436 opk_alarm.tab.alarm_lgd = 0 then
8 7437 begin
9 7438 if type=2 then
9 7439 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7440 else
9 7441 write(z_op(nr),"bel",1);
9 7442 end
8 7443 else if type>kmdo then kmdo:= type;
8 7444 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7445 end;
7 7446 end;<* ant < 6 *>
6 7447 end;<* operatør ok *>
5 7448
5 7448 ref:= opkaldskø.ref(1) extract 12;
5 7449 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7450 end;
4 7451 \f
4 7451 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7452
4 7452 signal_bin(bs_opkaldskø_adgang);
4 7453 if kmdo > opk_alarm.tab.alarm_tilst and
4 7454 kmdo > opk_alarm.tab.alarm_kmdo then
4 7455 begin
5 7456 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7457 signal_bin(bs_opk_alarm);
5 7458 end;
4 7459 if ant > 5 then
4 7460 begin
5 7461 cursor(z_op(nr),13,9);
5 7462 write(z_op(nr),<<+ddd>,ant-5);
5 7463 end
4 7464 else
4 7465 begin
5 7466 for i:= ant +1 step 1 until 6 do
5 7467 begin
6 7468 cursor(z_op(nr),i*2+1,1);
6 7469 write(z_op(nr),"sp",25);
6 7470 end;
5 7471 end;
4 7472 ant_i_opkø(nr):= ant;
4 7473 cursor(z_op(nr),1,1);
4 7474 <*V*> setposition(z_op(nr),0,0);
4 7475 end skriv_skærm_opkaldskø;
3 7476 \f
3 7476 message procedure operatør side 2 - 810522/hko;
3 7477
3 7477 trap(op_trap);
3 7478 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7479
3 7479 ref:= nr*terminal_beskr_længde;
3 7480 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7481 skærmmåde:= 0; <*normal*>
3 7482
3 7482 if operatør_auto_include(nr) then
3 7483 begin
4 7484 waitch(cs_att_pulje,opref,true,-1);
4 7485 i:= operatør_auto_include(nr) extract 2;
4 7486 if i<>3 then i:= 0;
4 7487 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7488 d.opref.data(1):= nr;
4 7489 signalch(cs_rad,opref,gen_optype or io_optype);
4 7490 end;
3 7491
3 7491 <*+2*>
3 7492 if testbit8 and overvåget or testbit28 then
3 7493 skriv_operatør(out,0);
3 7494 <*-2*>
3 7495 \f
3 7495 message procedure operatør side 3 - 810602/hko;
3 7496
3 7496 repeat
3 7497
3 7497 <*V*> wait_ch(cs_operatør(nr),
3 7498 op_ref,
3 7499 true,
3 7500 -1<*timeout*>);
3 7501 <*+2*>
3 7502 if testbit9 and overvåget then
3 7503 disable begin
4 7504 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7505 <: til operatør :>,nr);
4 7506 skriv_op(out,op_ref);
4 7507 end;
3 7508 <*-2*>
3 7509 monitor(8)reserve process:(z_op(nr),0,ia);
3 7510 kode:= d.op_ref.op_kode extract 12;
3 7511 i:= terminal_tab.ref.terminal_tilstand;
3 7512 status:= i shift(-21);
3 7513 opgave:=
3 7514 if kode=0 then 1 <* indlæs kommando *> else
3 7515 if kode=1 then 2 <* inkluder *> else
3 7516 if kode=2 then 3 <* ekskluder *> else
3 7517 if kode=40 then 4 <* opdater skærm *> else
3 7518 if kode=43 then 5 <* opkald etableret *> else
3 7519 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7520 if kode=38 then 7 <* operatør meddelelse *> else
3 7521 0; <* afvises *>
3 7522
3 7522 aktion:= case status +1 of(
3 7523 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7524 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7525 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7526 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7527 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7528 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7529 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7530 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7531 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7532 -1);
3 7533 \f
3 7533 message procedure operatør side 4 - 810424/hko;
3 7534
3 7534 case aktion+6 of
3 7535 begin
4 7536 begin
5 7537 <*-5: terminal optaget *>
5 7538
5 7538 d.op_ref.resultat:= 16;
5 7539 afslut_operation(op_ref,-1);
5 7540 end;
4 7541
4 7541 begin
5 7542 <*-4: operation uden virkning *>
5 7543
5 7543 afslut_operation(op_ref,-1);
5 7544 end;
4 7545
4 7545 begin
5 7546 <*-3: ulovlig operationskode *>
5 7547
5 7547 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7548 afslut_operation(op_ref,-1);
5 7549 end;
4 7550
4 7550 begin
5 7551 <*-2: ulovligt operatørterminal_nr *>
5 7552
5 7552 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7553 afslut_operation(op_ref,-1);
5 7554 end;
4 7555
4 7555 begin
5 7556 <*-1: ulovlig operatørtilstand *>
5 7557
5 7557 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7558 afslut_operation(op_ref,-1);
5 7559 end;
4 7560
4 7560 begin
5 7561 <* 0: ikke implementeret *>
5 7562
5 7562 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7563 afslut_operation(op_ref,-1);
5 7564 end;
4 7565
4 7565 begin
5 7566 \f
5 7566 message procedure operatør side 5 - 851001/cl;
5 7567
5 7567 <* 1: indlæs kommando *>
5 7568
5 7568
5 7568 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7569 if opk_alarm.tab.alarm_tilst > 0 then
5 7570 begin
6 7571 opk_alarm.tab.alarm_kmdo:= 3;
6 7572 signal_bin(bs_opk_alarm);
6 7573 pass;
6 7574 end;
5 7575 if d.op_ref.resultat > 3 then
5 7576 begin
6 7577 <*V*> setposition(z_op(nr),0,0);
6 7578 cursor(z_op(nr),24,1);
6 7579 skriv_kvittering(z_op(nr),op_ref,pos,
6 7580 d.op_ref.resultat);
6 7581 end
5 7582 else if d.op_ref.resultat = -1 then
5 7583 begin
6 7584 skærmmåde:= 0;
6 7585 skrivskærm(nr);
6 7586 end
5 7587 else if d.op_ref.resultat>0 then
5 7588 begin <*godkendt*>
6 7589 kode:=d.op_ref.opkode;
6 7590 i:= kode extract 12;
6 7591 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7592 if kode = 19 then 1 <*VO,S *> else
6 7593 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7594 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7595 if kode = 6 then 4 <*STop*> else
6 7596 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7597 if kode = 30 then 5 <*SP,D*> else
6 7598 if kode = 31 then 6 <*SP*> else
6 7599 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7600 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7601 if kode = 83 then 8 <*SL*> else
6 7602 if kode = 68 then 9 <*ST,D*> else
6 7603 if kode = 69 then 10 <*ST,V*> else
6 7604 if kode = 36 then 11 <*AL*> else
6 7605 if kode = 37 then 12 <*CC*> else
6 7606 if kode = 2 then 13 <*EX*> else
6 7607 if kode = 92 then 14 <*CQF,V*> else
6 7608 if kode = 38 then 15 <*AL,T*> else
6 7609 0;
6 7610 if j > 0 then
6 7611 begin
7 7612 case j of
7 7613 begin
8 7614 begin
9 7615 \f
9 7615 message procedure operatør side 6 - 851001/cl;
9 7616
9 7616 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7617
9 7617 vogn:=ia(1);
9 7618 ll:=ia(2);
9 7619 kanal:= if kode=11 or kode=19 then ia(3) else
9 7620 if kode=12 then ia(2) else 0;
9 7621 <*V*> wait_ch(cs_vt_adgang,
9 7622 vt_op,
9 7623 gen_optype,
9 7624 -1<*timeout sek*>);
9 7625 start_operation(vtop,200+nr,cs_operatør(nr),
9 7626 kode);
9 7627 d.vt_op.data(1):=vogn;
9 7628 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7629 d.vt_op.data(2):=ll;
9 7630 if kode=19 then d.vt_op.data(3):= kanal else
9 7631 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7632 indeks:= vt_op;
9 7633 signal_ch(cs_vt,
9 7634 vt_op,
9 7635 gen_optype or op_optype);
9 7636
9 7636 <*V*> wait_ch(cs_operatør(nr),
9 7637 vt_op,
9 7638 op_optype,
9 7639 -1<*timeout sek*>);
9 7640 <*+2*> if testbit10 and overvåget then
9 7641 disable begin
10 7642 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7643 <:: operation retur fra vt:>);
10 7644 skriv_op(out,vt_op);
10 7645 end;
9 7646 <*-2*>
9 7647 <*+4*> if vt_op<>indeks then
9 7648 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7649 <:operatør-kommando:>,0);
9 7650 <*-4*>
9 7651 <*V*> setposition(z_op(nr),0,0);
9 7652 cursor(z_op(nr),24,1);
9 7653 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7654 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7655 else vt_op,-1,d.vt_op.resultat);
9 7656 d.vt_op.optype:= gen_optype or vt_optype;
9 7657 disable afslut_operation(vt_op,cs_vt_adgang);
9 7658 end;
8 7659 begin
9 7660 \f
9 7660 message procedure operatør side 7 - 810921/hko,cl;
9 7661
9 7661 <* 2 vogntabel,linienr/-,busnr *>
9 7662
9 7662 d.op_ref.retur:= cs_operatør(nr);
9 7663 tofrom(d.op_ref.data,ia,10);
9 7664 indeks:= op_ref;
9 7665 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7666 wait_ch(cs_operatør(nr),
9 7667 op_ref,
9 7668 op_optype,
9 7669 -1<*timeout*>);
9 7670 <*+2*> if testbit10 and overvåget then
9 7671 disable begin
10 7672 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7673 skriv_op(out,op_ref);
10 7674 end;
9 7675 <*-2*>
9 7676 <*+4*>
9 7677 if indeks <> op_ref then
9 7678 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7679 <*-4*>
9 7680 i:= d.op_ref.resultat;
9 7681 if i = 0 or i > 3 then
9 7682 begin
10 7683 <*V*> setposition(z_op(nr),0,0);
10 7684 cursor(z_op(nr),24,1);
10 7685 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7686 end
9 7687 else
9 7688 begin
10 7689 integer antal,fil_ref;
10 7690
10 7690 skærm_måde:= 1;
10 7691 antal:= d.op_ref.data(6);
10 7692 fil_ref:= d.op_ref.data(7);
10 7693 <*V*> setposition(z_op(nr),0,0);
10 7694 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7695 "sp",14,"*",10,"sp",6,
10 7696 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7697 <*V*> setposition(z_op(nr),0,0);
10 7698 \f
10 7698 message procedure operatør side 8 - 841213/cl;
10 7699
10 7699 pos:= 1;
10 7700 while pos <= antal do
10 7701 begin
11 7702 integer bogst,løb;
11 7703
11 7703 disable i:= læs_fil(fil_ref,pos,j);
11 7704 if i <> 0 then
11 7705 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7706 else
11 7707 begin
12 7708 vogn:= fil(j,1) shift (-24) extract 24;
12 7709 løb:= fil(j,1) extract 24;
12 7710 if d.op_ref.opkode=9 then
12 7711 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7712 ll:= løb shift (-12) extract 10;
12 7713 bogst:= løb shift (-7) extract 5;
12 7714 if bogst > 0 then bogst:= bogst +'A'-1;
12 7715 løb:= løb extract 7;
12 7716 vogn:= vogn extract 14;
12 7717 i:= d.op_ref.opkode-8;
12 7718 for i:= i,i+1 do
12 7719 begin
13 7720 j:= (i+1) extract 1;
13 7721 case j +1 of
13 7722 begin
14 7723 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7724 false add bogst,1,"/",1,<<d__>,løb);
14 7725 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7726 end;
13 7727 end;
12 7728 if pos mod 5 = 0 then
12 7729 begin
13 7730 outchar(z_op(nr),'nl');
13 7731 <*V*> setposition(z_op(nr),0,0);
13 7732 end
12 7733 else write(z_op(nr),"sp",3);
12 7734 end;
11 7735 pos:=pos+1;
11 7736 end;
10 7737 write(z_op(nr),"*",1,"nl",1);
10 7738 \f
10 7738 message procedure operatør side 8a- 810507/hko;
10 7739
10 7739 d.opref.opkode:=104; <*slet-fil*>
10 7740 d.op_ref.data(4):=filref;
10 7741 indeks:=op_ref;
10 7742 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7743 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7744
10 7744 <*+2*> if testbit10 and overvåget then
10 7745 disable begin
11 7746 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7747 skriv_op(out,op_ref);
11 7748 end;
10 7749 <*-2*>
10 7750
10 7750 <*+4*> if op_ref<>indeks then
10 7751 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7752 <*-4*>
10 7753 if d.op_ref.data(9)<>0 then
10 7754 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7755 <:operatør, slet_fil:>,1);
10 7756 end;
9 7757 end;
8 7758
8 7758 begin
9 7759 \f
9 7759 message procedure operatør side 9 - 830310/hko;
9 7760
9 7760 <* 3 radio_kommandoer *>
9 7761
9 7761 kode:= d.op_ref.opkode;
9 7762 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7763 disable if testbit14 then
9 7764 begin
10 7765 integer i; <*lav en trap-bar blok*>
10 7766
10 7766 trap(test14_trap);
10 7767 systime(1,0,kommstart);
10 7768 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7769 string bpl_navn(nr),<: start :>,case rkom of (
10 7770 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7771 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7772 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7773 <:GE,T:>),<: :>);
10 7774 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7775 rkom=16 or rkom=17 or rkom=19)
10 7776 then
10 7777 begin
11 7778 if par1<>0 then skriv_id(zrl,par1,0);
11 7779 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7780 write(zrl,"sp",1,string områdenavn(par2));
11 7781 end
10 7782 else
10 7783 if rkom=10 and par1<>0 then
10 7784 write(zrl,string kanalnavn(par1 extract 20))
10 7785 else
10 7786 if rkom=5 or rkom=6 then
10 7787 begin
11 7788 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7789 if par1 shift (-20)=14 then
11 7790 write(zrl,string områdenavn(par1 extract 20));
11 7791 end;
10 7792 test14_trap: outchar(zrl,'nl');
10 7793 end;
9 7794 d.op_ref.data(4):= nr; <*operatør*>
9 7795 opgave:=
9 7796 if kode = 45 <*OP *> then 1 else
9 7797 if kode = 46 <*ME *> then 2 else
9 7798 if kode = 47 <*OP,G*> then 3 else
9 7799 if kode = 48 <*ME,G*> then 4 else
9 7800 if kode = 49 <*OP,A*> then 5 else
9 7801 if kode = 50 <*ME,A*> then 6 else
9 7802 if kode = 51 <*KA,C*> then 7 else
9 7803 if kode = 52 <*KA,P*> then 8 else
9 7804 if kode = 53 <*OP,L*> then 9 else
9 7805 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7806 if kode = 55 <*VE *> then 14 else
9 7807 if kode = 56 <*NE *> then 12 else
9 7808 if kode = 57 <*OP,V*> then 1 else
9 7809 if kode = 58 <*OP,T*> then 1 else
9 7810 if kode = 59 <*R *> then 13 else
9 7811 if kode = 60 <*GE *> then 15 else
9 7812 if kode = 61 <*GE,G*> then 16 else
9 7813 if kode = 62 <*GE,V*> then 15 else
9 7814 if kode = 63 <*GE,T*> then 15 else
9 7815 -1;
9 7816 <*+4*> if opgave < 0 then
9 7817 fejlreaktion(2<*operationskode*>,kode,
9 7818 <:operatør, radio-kommando :>,0);
9 7819 <*-4*>
9 7820 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7821 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7822 if 5<=opgave and opgave<=8 then
9 7823 d.opref.data(2):= -1;
9 7824 if opgave=13 then d.opref.data(2):=
9 7825 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7826 then 0 else 1);
9 7827 if opgave = 14 then d.opref.data(2):= 1;
9 7828 if opgave=7 or opgave=8 then
9 7829 d.opref.data(3):= -1
9 7830 else
9 7831 if opgave=5 or opgave=6 then
9 7832 begin
10 7833 if ia(1) shift (-20) = 15 then
10 7834 begin
11 7835 d.opref.data(3):= 15 shift 20;
11 7836 for j:= 1 step 1 until max_antal_kanaler do
11 7837 begin
12 7838 iaf:= (j-1)*kanalbeskrlængde;
12 7839 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7840 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7841 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7842 end;
11 7843 end
10 7844 else
10 7845 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7846 else ia(1);
10 7847 end
9 7848 else
9 7849 if kode = 57 then d.opref.data(3):= 2 else
9 7850 if kode = 58 then d.opref.data(3):= 1 else
9 7851 if kode = 62 then d.opref.data(3):= 2 else
9 7852 if kode = 63 then d.opref.data(3):= 1 else
9 7853 d.opref.data(3):= ia(2);
9 7854
9 7854 <* !!! i første if-sætning nedenfor er 'status>1'
9 7855 rettet til 'status>0' for at forhindre
9 7856 at opkald nr. 2 kan udføres med et allerede
9 7857 etableret opkald i skærmens s-felt,
9 7858 jvf. ulykke d. 7/2-1995
9 7859 !!! *>
9 7860 res:=
9 7861 if (opgave=1 or opgave=3) and status>0
9 7862 then 16 <*skærm optaget*> else
9 7863 if (opgave=15 or opgave=16) and
9 7864 status>1 then 16 <*skærm optaget*> else
9 7865 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7866 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7867 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7868 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7869 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7870 then 52 else 1) else
9 7871 if opgave<11 and status>0 then 16 else
9 7872 if opgave=11 and status<2 then 21 else
9 7873 if opgave=12 and status=0 then 22 else
9 7874 if opgave=13 and status=0 then 49 else
9 7875 if opgave=14 and status<>3 then 21 else 1;
9 7876 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7877 begin <* specialbetingelser for TLF og VHF *>
10 7878 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7879 end;
9 7880 if skærmmåde<>0 then
9 7881 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7882 kode:= opgave;
9 7883 if opgave = 15 then opgave:= 1 else
9 7884 if opgave = 16 then opgave:= 3;
9 7885 \f
9 7885 message procedure operatør side 10 - 810616/hko;
9 7886
9 7886 <* tilknyt talevej (om nødvendigt) *>
9 7887 if res = 1 and op_talevej(nr)=0 then
9 7888 begin
10 7889 i:= sidste_tv_brugt;
10 7890 repeat
10 7891 i:= (i mod max_antal_taleveje)+1;
10 7892 if tv_operatør(i)=0 then
10 7893 begin
11 7894 tv_operatør(i):= nr;
11 7895 op_talevej(nr):= i;
11 7896 end;
10 7897 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7898 if op_talevej(nr)=0 then
10 7899 res:=61
10 7900 else
10 7901 begin
11 7902 sidste_tv_brugt:=
11 7903 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7904
11 7904 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7905 start_operation(iaf,200+nr,cs_operatør(nr),
11 7906 'A' shift 12 + 44);
11 7907 d.iaf.data(1):= op_talevej(nr);
11 7908 d.iaf.data(2):= nr+16;
11 7909 ll:= 0;
11 7910 repeat
11 7911 signalch(cs_talevejsswitch,iaf,op_optype);
11 7912 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7913 ll:= ll+1;
11 7914 until ll=3 or d.iaf.resultat=3;
11 7915 res:= if d.iaf.resultat=3 then 1 else 61;
11 7916 <* ********* *>
11 7917 delay(1);
11 7918 start_operation(iaf,200+nr,cs_operatør(nr),
11 7919 'R' shift 12 + 44);
11 7920 ll:= 0;
11 7921 repeat
11 7922 signalch(cs_talevejsswitch,iaf,op_optype);
11 7923 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7924 ll:= ll+1;
11 7925 until ll=3 or d.iaf.resultat=3;
11 7926 <* ********* *>
11 7927 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7928 if res<>1 then
11 7929 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7930 end;
10 7931 end;
9 7932 if op_talevej(nr)=0 then res:= 61;
9 7933 d.op_ref.data(1):= op_talevej(nr);
9 7934
9 7934 if res <= 1 then
9 7935 begin
10 7936 til_radio: <* send operation til radiomodul *>
10 7937 d.op_ref.opkode:= opgave shift 12 + 41;
10 7938 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7939 else 0;
10 7940 d.op_ref.data(6):= b_s;
10 7941 d.op_ref.resultat:=0;
10 7942 d.op_ref.retur:= cs_operatør(nr);
10 7943 indeks:= op_ref;
10 7944 <*+2*> if testbit11 and overvåget then
10 7945 disable begin
11 7946 skriv_operatør(out,0);
11 7947 write(out,<: operation til radio:>);
11 7948 skriv_op(out,op_ref); ud;
11 7949 end;
10 7950 <*-2*>
10 7951 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7952 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7953
10 7953 <*+2*> if testbit12 and overvåget then
10 7954 disable begin
11 7955 skriv_operatør(out,0);
11 7956 write(out,<: operation retur fra radio:>);
11 7957 skriv_op(out,op_ref); ud;
11 7958 end;
10 7959 <*-2*>
10 7960 <*+4*> if op_ref <> indeks then
10 7961 fejlreaktion(11<*fr.post*>,op_ref,
10 7962 <:operatør, retur fra radio:>,0);
10 7963 <*-4*>
10 7964 \f
10 7964 message procedure operatør side 11 - 810529/hko;
10 7965
10 7965 res:= d.op_ref.resultat;
10 7966 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7967 begin
11 7968 <*+4*> if res < 2 then
11 7969 fejlreaktion(3<*prg.fejl*>,res,
11 7970 <: operatør,radio_op,resultat:>,1);
11 7971 <*-4*>
11 7972 if res = 1 then res:= 0;
11 7973 end
10 7974 else
10 7975 begin <* res = 2 eller 3 *>
11 7976 s_kanal:= v_kanal:= 0;
11 7977 opgave:= d.opref.opkode shift (-12);
11 7978 bv:= d.op_ref.data(5) extract 4;
11 7979 bs:= d.op_ref.data(6);
11 7980 if opgave < 10 then
11 7981 begin
12 7982 j:= d.op_ref.data(7) <*type*>;
12 7983 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 7984 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 7985 terminal_tab.ref(1):= i
12 7986 +(if res=2 then 4 <*optaget*> else 0)
12 7987 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 7988 then 8 <*nød*> else 0)
12 7989 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 7990 then 16 else 0)
12 7991 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 7992 + (if opgave=9 then 128 else
12 7993 if opgave>=7 then 256 else
12 7994 if opgave>=5 then 512 else 0)
12 7995 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 7996 else if b_s = 0 then 0 <*tilstand = ledig *>
12 7997 else 1 shift 21 <*tilstand = samtale*>);
12 7998 if (res=3 or res=20 or res=52) and 0<=j and j<3 then
12 7999 disable tæl_opkald_pr_operatør(nr,
12 8000 (if res=20 then 4 else if res=52 then 5 else j+1));
12 8001 end
11 8002 else if opgave=10 <*monitering*> or
11 8003 opgave=14 <*ventepos *> then
11 8004 begin
12 8005 <*+4*> if res = 2 then
12 8006 fejlreaktion(3<*prg.fejl*>,res,
12 8007 <: operatør,moniter,res:>,1);
12 8008 <*-4*>
12 8009 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 8010 i:= if bs<0 then
12 8011 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 8012 terminal_tab.ref(1):= i +
12 8013 (if bs < 0 then (1 shift 21) else 0);
12 8014 if opgave=10 then
12 8015 begin
13 8016 s_kanal:= bs;
13 8017 v_kanal:= d.opref.data(5);
13 8018 end;
12 8019 \f
12 8019 message procedure operatør side 12 - 810603/hko;
12 8020 end
11 8021 else if opgave=11 or opgave=12 then
11 8022 begin
12 8023 <*+4*> if res = 2 then
12 8024 fejlreaktion(3<*prg.fejl*>,res,
12 8025 <: operatør,ge/ne,res:>,1);
12 8026 <*-4*>
12 8027 if opgave=11 <*GE*> and res<>49 then
12 8028 begin
13 8029 s_kanal:= terminal_tab.ref(2);
13 8030 v_kanal:= 12 shift 20 +
13 8031 (terminal_tab.ref(1) shift (-12) extract 4);
13 8032 end;
12 8033 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 8034 end
11 8035 else
11 8036 if opgave=13 then
11 8037 begin
12 8038 if res=2 then
12 8039 fejlreaktion(3<*prg.fejl*>,res,
12 8040 <:operatør,R,res:>,1);
12 8041 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 8042 d.opref.data(2));
12 8043 end
11 8044 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 8045 <*-4*>
11 8046 ;
11 8047 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 8048
11 8048 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 8049 terminal_tab.ref(2):= b_s;
11 8050 terminal_tab.ref(3):= d.op_ref.data(11);
11 8051 if (opgave<10 or opgave=14) and res=3 then
11 8052 <*så henviser b_s til radiokanal*>
11 8053 begin
12 8054 if bs shift (-20) = 12 then
12 8055 begin
13 8056 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 8057 kanaltab.iaf.kanal_tilstand:=
13 8058 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 8059 +terminal_tab.ref(1) extract 10;
13 8060 end
12 8061 else
12 8062 begin
13 8063 for i:= 1 step 1 until max_antal_kanaler do
13 8064 begin
14 8065 if læsbit_i(bs,i) then
14 8066 begin
15 8067 iaf:= (i-1)*kanal_beskr_længde;
15 8068 kanaltab.iaf.kanaltilstand:=
15 8069 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 8070 + terminal_tab.ref(1) extract 10;
15 8071 end;
14 8072 end;
13 8073 end;
12 8074 end;
11 8075 if kode=15 or kode=16 then
11 8076 begin
12 8077 if opgave<10 then
12 8078 begin
13 8079 opgave:= 11;
13 8080 kanal:= (12 shift 20) +
13 8081 d.opref.data(6) extract 20;
13 8082 goto til_radio;
13 8083 end
12 8084 else
12 8085 if opgave=11 then
12 8086 begin
13 8087 opgave:= 10;
13 8088 d.opref.data(2):= kanal;
13 8089 goto til_radio;
13 8090 end;
12 8091 end
11 8092 else
11 8093 if (kode=1 or kode=3) then
11 8094 begin
12 8095 if opgave<10 and bv<>0 then
12 8096 begin
13 8097 opgave:= 14;
13 8098 d.opref.data(2):= 2;
13 8099 goto til_radio;
13 8100 end;
12 8101 end;
11 8102 <*V*> skriv_skærm_b_v_s(nr);
11 8103 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 8104 skriv_skærm_opkaldskø(nr);
11 8105 for i:= s_kanal, v_kanal do
11 8106 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 8107 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 8108 signalbin(bs_mobilopkald);
11 8109 <*V*> setposition(z_op(nr),0,0);
11 8110 end; <* res = 2 eller 3 *>
10 8111 end; <* res <= 1 *>
9 8112 <* frigiv talevej (om nødvendigt) *>
9 8113 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 8114 and terminal_tab.ref(2)=0 <*b_s*>
9 8115 and op_talevej(nr)<>0
9 8116 then
9 8117 begin
10 8118 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 8119 start_operation(iaf,200+nr,cs_operatør(nr),
10 8120 'D' shift 12 + 44);
10 8121 d.iaf.data(1):= op_talevej(nr);
10 8122 d.iaf.data(2):= nr+16;
10 8123 ll:= 0;
10 8124 repeat
10 8125 signalch(cs_talevejsswitch,iaf,op_optype);
10 8126 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 8127 ll:= ll+1;
10 8128 until ll=3 or d.iaf.resultat=3;
10 8129 ll:= d.iaf.resultat;
10 8130 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 8131 if ll<>3 then
10 8132 fejlreaktion(21,op_talevej(nr)*100+nr,
10 8133 <:frigiv operatør fejlet:>,1)
10 8134 else
10 8135 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 8136 skriv_skærm_b_v_s(nr);
10 8137 end;
9 8138 disable if testbit14 then
9 8139 begin
10 8140 integer t; <*lav en trap-bar blok*>
10 8141
10 8141 trap(test14_trap);
10 8142 systime(1,0,kommslut);
10 8143 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 8144 string bpl_navn(nr),<: slut :>,case rkom of (
10 8145 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 8146 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 8147 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 8148 <:GE,T:>),<: :>);
10 8149 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 8150 rkom=16 or rkom=17 or rkom=19)
10 8151 then
10 8152 begin
11 8153 if d.opref.data(7)=2 then outchar(zrl,'*');
11 8154 if d.opref.data(9)<>0 then
11 8155 begin
12 8156 skriv_id(zrl,d.opref.data(9),0);
12 8157 outchar(zrl,' ');
12 8158 end;
11 8159 if d.opref.data(8)<>0 then
11 8160 begin
12 8161 skriv_id(zrl,d.opref.data(8),0);
12 8162 outchar(zrl,' ');
12 8163 end;
11 8164 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 8165 d.opref.data(2)<>0 then
11 8166 begin
12 8167 skriv_id(zrl,d.opref.data(2),0);
12 8168 outchar(zrl,' ');
12 8169 end;
11 8170 if d.opref.data(12)<>0 then
11 8171 begin
12 8172 if d.opref.data(12) shift (-20) = 15 then
12 8173 write(zrl,<:OMR*:>)
12 8174 else
12 8175 if d.opref.data(12) shift (-20) = 14 then
12 8176 write(zrl,
12 8177 string områdenavn(d.opref.data(12) extract 20))
12 8178 else
12 8179 skriv_id(zrl,d.opref.data(12),0);
12 8180 outchar(zrl,' ');
12 8181 end;
11 8182 t:= terminal_tab.ref.terminaltilstand extract 10;
11 8183 if res=3 and rkom=1 and
11 8184 (t shift (-4) extract 1 = 1) and
11 8185 (t extract 2 <> 3)
11 8186 then
11 8187 begin
12 8188 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 8189 kanal_beskr_længde;
12 8190 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 8191 extract 12)/100," ",1);
12 8192 end;
11 8193 if d.opref.data(10)<>0 then
11 8194 begin
12 8195 skriv_id(zrl,d.opref.data(10),0);
12 8196 outchar(zrl,' ');
12 8197 end;
11 8198 end
10 8199 else
10 8200 if rkom=10 and par1<>0 then
10 8201 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 8202 else
10 8203 if rkom=5 or rkom=6 then
10 8204 begin
11 8205 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 8206 if par1 shift (-20)=14 then
11 8207 write(zrl,string områdenavn(par1 extract 20));
11 8208 outchar(zrl,' ');
11 8209 end;
10 8210 if op_talevej(nr) > 0 then
10 8211 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 8212 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 8213 <<dd.dd>,kommslut-kommstart);
10 8214 test14_trap: outchar(zrl,'nl');
10 8215 end;
9 8216
9 8216 <*V*> setposition(z_op(nr),0,0);
9 8217 cursor(z_op(nr),24,1);
9 8218 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 8219 end; <* radio-kommando *>
8 8220 begin
9 8221 \f
9 8221 message procedure operatør side 13 - 810518/hko;
9 8222
9 8222 <* 4 stop kommando *>
9 8223
9 8223 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 8224 if tilstand <> 0 then
9 8225 begin
10 8226 d.op_ref.resultat:= 16; <*skærm optaget*>
10 8227 end
9 8228 else
9 8229 begin
10 8230 d.op_ref.retur:= cs_operatør(nr);
10 8231 d.op_ref.resultat:= 0;
10 8232 d.op_ref.data(1):= nr;
10 8233 indeks:= op_ref;
10 8234 <*+2*> if testbit11 and overvåget then
10 8235 disable begin
11 8236 skriv_operatør(out,0);
11 8237 write(out,<: stop_operation til radio:>);
11 8238 skriv_op(out,op_ref); ud;
11 8239 end;
10 8240 <*-2*>
10 8241 if opk_alarm.tab.alarm_tilst > 0 then
10 8242 begin
11 8243 opk_alarm.tab.alarm_kmdo:= 3;
11 8244 signal_bin(bs_opk_alarm);
11 8245 end;
10 8246
10 8246 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 8247 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 8248 <*+2*> if testbit12 and overvåget then
10 8249 disable begin
11 8250 skriv_operatør(out,0);
11 8251 write(out,<: operation retur fra radio:>);
11 8252 skriv_op(out,op_ref); ud;
11 8253 end;
10 8254 <*-2*>
10 8255 <*+4*> if indeks <> op_ref then
10 8256 fejlreaktion(11<*fr.post*>,op_ref,
10 8257 <: operatør, retur fra radio:>,0);
10 8258 <*-4*>
10 8259 \f
10 8259 message procedure operatør side 14 - 810527/hko;
10 8260
10 8260 if d.op_ref.resultat = 3 then
10 8261 begin
11 8262 integer k,n;
11 8263 integer array field msk,iaf1;
11 8264
11 8264 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 8265 +terminal_tab.ref.terminal_tilstand extract 21;
11 8266 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 8267 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 8268 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 8269 begin
12 8270 msk:= k*op_maske_lgd;
12 8271 if læsbit_ia(bpl_def.msk,nr) then
12 8272 <**> begin
13 8273 n:= 0;
13 8274 for i:= 1 step 1 until max_antal_operatører do
13 8275 if læsbit_ia(bpl_def.msk,i) then
13 8276 begin
14 8277 iaf1:= i*terminal_beskr_længde;
14 8278 if terminal_tab.iaf1.terminal_tilstand
14 8279 shift (-21) < 3 then
14 8280 n:= n+1;
14 8281 end;
13 8282 bpl_tilst(k,1):= n;
13 8283 end;
12 8284 <**> <*
12 8285 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 8286 *> end;
11 8287 signal_bin(bs_mobil_opkald);
11 8288 <*V*> setposition(z_op(nr),0,0);
11 8289 ht_symbol(z_op(nr));
11 8290 end;
10 8291 end;
9 8292 <*V*> setposition(z_op(nr),0,0);
9 8293 cursor(z_op(nr),24,1);
9 8294 if d.op_ref.resultat<> 3 then
9 8295 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8296 end;
8 8297 begin
9 8298 boolean l22;
9 8299 \f
9 8299 message procedure operatør side 15 - 810521/cl;
9 8300
9 8300 <* 5 springdefinition *>
9 8301 l22:= false;
9 8302 if sep=',' then
9 8303 disable begin
10 8304 setposition(z_op(nr),0,0);
10 8305 cursor(z_op(nr),22,1);
10 8306 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 8307 l22:= true; pos:= 1;
10 8308 while læstegn(d.op_ref.data,pos,i)<>0 do
10 8309 outchar(z_op(nr),i);
10 8310 end;
9 8311
9 8311 tofrom(d.op_ref.data,ia,indeks*2);
9 8312 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 8313 start_operation(vt_op,200+nr,cs_operatør(nr),
9 8314 101<*opret fil*>);
9 8315 d.vt_op.data(1):=128;<*postantal*>
9 8316 d.vt_op.data(2):=2; <*postlængde*>
9 8317 d.vt_op.data(3):=1; <*segmentantal*>
9 8318 d.vt_op.data(4):=
9 8319 2 shift 10; <*spool fil*>
9 8320 signal_ch(cs_opret_fil,vt_op,op_optype);
9 8321 pos:=vt_op;<*variabel lånes*>
9 8322 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 8323 <*+4*> if vt_op<>pos then
9 8324 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 8325 if d.vt_op.data(9)<>0 then
9 8326 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8327 <:op kommando(springdefinition):>,0);
9 8328 <*-4*>
9 8329 iaf:=0;
9 8330 for i:=1 step 1 until indeks-2 do
9 8331 begin
10 8332 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8333 if k<>0 then
10 8334 fejlreaktion(7<*modif-fil*>,k,
10 8335 <:op kommando(spring-def):>,0);
10 8336 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8337 end;
9 8338 \f
9 8338 message procedure operatør side 15a - 820301/cl;
9 8339
9 8339 while sep = ',' do
9 8340 begin
10 8341 setposition(z_op(nr),0,0);
10 8342 cursor(z_op(nr),23,1);
10 8343 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8344 setposition(z_op(nr),0,0);
10 8345 wait(bs_fortsæt_adgang);
10 8346 pos:= 1; j:= 0;
10 8347 while læs_store(z_op(nr),i) < 8 do
10 8348 begin
11 8349 skrivtegn(fortsæt,pos,i);
11 8350 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8351 end;
10 8352 skrivtegn(fortsæt,pos,'em');
10 8353 afsluttext(fortsæt,pos);
10 8354 sluttegn:= i;
10 8355 if j<>0 then
10 8356 begin
11 8357 setposition(z_op(nr),0,0);
11 8358 cursor(z_op(nr),24,1);
11 8359 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8360 cursor(z_op(nr),1,1);
11 8361 goto sp_ann;
11 8362 end;
10 8363 \f
10 8363 message procedure operatør side 16 - 810521/cl;
10 8364
10 8364 disable begin
11 8365 integer array værdi(1:4);
11 8366 integer a_pos,res;
11 8367 pos:= 0;
11 8368 repeat
11 8369 apos:= pos;
11 8370 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8371 if res >= 0 then
11 8372 begin
12 8373 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8374 else if res=0 then res:= -25 <*parameter mangler*>
12 8375 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8376 res:= -44 <*intervalstørrelse ulovlig*>
12 8377 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8378 res:= -6 <*løbnr ulovligt*>
12 8379 else if res=10 then
12 8380 begin
13 8381 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8382 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8383 <:op kommando(spring-def):>,0);
13 8384 iaf:= 0;
13 8385 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8386 indeks:= indeks+1;
13 8387 if sep = ',' then res:= 0;
13 8388 end
12 8389 else res:= -27; <*parametertype*>
12 8390 end;
11 8391 if res>0 then pos:= a_pos;
11 8392 until sep<>'sp' or res<=0;
11 8393
11 8393 if res<0 then
11 8394 begin
12 8395 d.op_ref.resultat:= -res;
12 8396 i:=1; j:= 1;
12 8397 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8398 afsluttext(d.op_ref.data,i);
12 8399 end;
11 8400 end;
10 8401 \f
10 8401 message procedure operatør side 17 - 810521/cl;
10 8402
10 8402 if d.op_ref.resultat > 3 then
10 8403 begin
11 8404 setposition(z_op(nr),0,0);
11 8405 if l22 then
11 8406 begin
12 8407 cursor(z_op(nr),22,1); l22:= false;
12 8408 write(z_op(nr),"-",80);
12 8409 end;
11 8410 cursor(z_op(nr),24,1);
11 8411 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8412 goto sp_ann;
11 8413 end;
10 8414 if sep=',' then
10 8415 begin
11 8416 setposition(z_op(nr),0,0);
11 8417 cursor(z_op(nr),22,1);
11 8418 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8419 pos:= 1; l22:= true;
11 8420 while læstegn(fortsæt,pos,i)<>0 do
11 8421 outchar(z_op(nr),i);
11 8422 end;
10 8423 signalbin(bs_fortsæt_adgang);
10 8424 end while sep = ',';
9 8425 d.vt_op.data(1):= indeks-2;
9 8426 k:= sætfildim(d.vt_op.data);
9 8427 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8428 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8429 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8430 d.op_ref.retur:=cs_operatør(nr);
9 8431 pos:=op_ref;
9 8432 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8433 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8434 <*+4*> if pos<>op_ref then
9 8435 fejlreaktion(11<*fremmed post*>,op_ref,
9 8436 <:op kommando(springdef retur fra vt):>,0);
9 8437 <*-4*>
9 8438 \f
9 8438 message procedure operatør side 18 - 810521/cl;
9 8439
9 8439 <*V*> setposition(z_op(nr),0,0);
9 8440 if l22 then
9 8441 begin
10 8442 cursor(z_op(nr),22,1);
10 8443 write(z_op(nr),"-",80);
10 8444 end;
9 8445 cursor(z_op(nr),24,1);
9 8446 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8447
9 8447 if false then
9 8448 begin
10 8449 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8450 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8451 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8452 signalbin(bs_fortsæt_adgang);
10 8453 end;
9 8454
9 8454 end;
8 8455
8 8455 begin
9 8456 \f
9 8456 message procedure operatør side 19 - 810522/cl;
9 8457
9 8457 <* 6 spring (igangsæt)
9 8458 spring,annuler
9 8459 spring,reserve *>
9 8460
9 8460 tofrom(d.op_ref.data,ia,6);
9 8461 d.op_ref.retur:=cs_operatør(nr);
9 8462 indeks:=op_ref;
9 8463 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8464 <*V*> wait_ch(cs_operatør(nr),
9 8465 op_ref,
9 8466 op_optype,
9 8467 -1<*timeout*>);
9 8468 <*+2*> if testbit10 and overvåget then
9 8469 disable begin
10 8470 skriv_operatør(out,0);
10 8471 write(out,"nl",1,<:op operation retur fra vt:>);
10 8472 skriv_op(out,op_ref);
10 8473 end;
9 8474 <*-2*>
9 8475 <*+4*> if indeks<>op_ref then
9 8476 fejlreaktion(11<*fremmed post*>,op_ref,
9 8477 <:op kommando(spring):>,0);
9 8478 <*-4*>
9 8479
9 8479 <*V*> setposition(z_op(nr),0,0);
9 8480 cursor(z_op(nr),24,1);
9 8481 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8482 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8483 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8484 end;
8 8485
8 8485 begin
9 8486 \f
9 8486 message procedure operatør side 20 - 810525/cl;
9 8487
9 8487 <* 7 spring(-oversigts-)rapport *>
9 8488
9 8488 d.op_ref.retur:=cs_operatør(nr);
9 8489 tofrom(d.op_ref.data,ia,4);
9 8490 indeks:=op_ref;
9 8491 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8492 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8493 <*+2*> disable if testbit10 and overvåget then
9 8494 begin
10 8495 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8496 skriv_op(out,op_ref);
10 8497 end;
9 8498 <*-2*>
9 8499
9 8499 <*+4*> if op_ref<>indeks then
9 8500 fejlreaktion(11<*fremmed post*>,op_ref,
9 8501 <:op kommando(spring-rapport):>,0);
9 8502 <*-4*>
9 8503
9 8503 <*V*> setposition(z_op(nr),0,0);
9 8504 if d.op_ref.resultat<>3 then
9 8505 begin
10 8506 cursor(z_op(nr),24,1);
10 8507 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8508 end
9 8509 else
9 8510 begin
10 8511 boolean p_skrevet;
10 8512 integer bogst,løb;
10 8513
10 8513 skærmmåde:= 1;
10 8514
10 8514 if kode = 32 then <* spring,vis *>
10 8515 begin
11 8516 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8517 bogst:= d.op_ref.data(1) extract 5;
11 8518 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8519 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8520 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8521 <:spring: :>,
11 8522 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8523 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8524 raf:= data+8;
11 8525 if d.op_ref.raf(1)<>0.0 then
11 8526 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8527 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8528 else write(z_op(nr),<:, ikke startet:>);
11 8529 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8530 \f
11 8530 message procedure operatør side 21 - 810522/cl;
11 8531
11 8531 p_skrevet:= false;
11 8532 for pos:=1 step 1 until d.op_ref.data(3) do
11 8533 begin
12 8534 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8535 if i<>0 then
12 8536 fejlreaktion(5<*læsfil*>,i,
12 8537 <:op kommando(spring,vis):>,0);
12 8538 iaf:=0;
12 8539 i:= fil(j).iaf(1);
12 8540 if i < 0 and -, p_skrevet then
12 8541 begin
13 8542 outchar(z_op(nr),'('); p_skrevet:= true;
13 8543 end;
12 8544 if i > 0 and p_skrevet then
12 8545 begin
13 8546 outchar(z_op(nr),')'); p_skrevet:= false;
13 8547 end;
12 8548 if pos mod 2 = 0 then
12 8549 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8550 else
12 8551 write(z_op(nr),true,3,<<d>,abs i);
12 8552 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8553 end;
11 8554 write(z_op(nr),"*",1);
11 8555 \f
11 8555 message procedure operatør side 22 - 810522/cl;
11 8556
11 8556 end
10 8557 else if kode=33 then <* spring,oversigt *>
10 8558 begin
11 8559 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8560 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8561 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8562
11 8562 for pos:=1 step 1 until d.op_ref.data(1) do
11 8563 begin
12 8564 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8565 if i<>0 then
12 8566 fejlreaktion(5<*læsfil*>,i,
12 8567 <:op kommando(spring-oversigt):>,0);
12 8568 iaf:=0;
12 8569 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8570 bogst:=fil(j).iaf(1) extract 5;
12 8571 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8572 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8573 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8574 string (extend fil(j).iaf(2) shift 24));
12 8575 if fil(j,2)<>0.0 then
12 8576 write(z_op(nr),<:startet :>,<<zddddd>,
12 8577 round systime(4,fil(j,2),r),<:.:>,round r);
12 8578 outchar(z_op(nr),'nl');
12 8579 end;
11 8580 write(z_op(nr),"*",1);
11 8581 end;
10 8582 <* slet fil *>
10 8583 d.op_ref.opkode:= 104;
10 8584 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8585 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8586 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8587 end; <* resultat=3 *>
9 8588
9 8588 end;
8 8589
8 8589 begin
9 8590 \f
9 8590 message procedure operatør side 23 - 940522/cl;
9 8591
9 8591
9 8591 <* 8 SLUT *>
9 8592 trapmode:= 1 shift 13;
9 8593 trap(-2);
9 8594 end;
8 8595
8 8595 begin
9 8596 <* 9 stopniveauer,definer *>
9 8597 integer fno;
9 8598
9 8598 for i:= 1 step 1 until 3 do
9 8599 operatør_stop(nr,i):= ia(i+1);
9 8600 i:= modif_fil(tf_stoptabel,nr,fno);
9 8601 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8602 iaf:=0;
9 8603 for i:= 0,1,2,3 do
9 8604 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8605 setposition(fil(fno),0,0);
9 8606 setposition(z_op(nr),0,0);
9 8607 cursor(z_op(nr),24,1);
9 8608 skriv_kvittering(z_op(nr),0,-1,3);
9 8609 end;
8 8610
8 8610 begin
9 8611 \f
9 8611 message procedure operatør side 24 - 940522/cl;
9 8612
9 8612 <* 10 stopniveauer,vis *>
9 8613 integer bpl,j,k;
9 8614
9 8614 skærm_måde:= 1;
9 8615 setposition(z_op(nr),0,0);
9 8616 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8617 <:stopniveauer: :>);
9 8618 for i:= 0 step 1 until 3 do
9 8619 begin
10 8620 bpl:= operatør_stop(nr,i);
10 8621 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8622 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8623 end;
9 8624 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8625 j:=0;
9 8626 for bpl:= 1 step 1 until max_antal_operatører do
9 8627 if bpl_navn(bpl)<>long<::> then
9 8628 begin
10 8629 if j mod 8 = 0 and j > 0 then
10 8630 write(z_op(nr),"nl",1,"sp",18);
10 8631 iaf:= bpl*terminal_beskr_længde;
10 8632 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8633 true,6,string bpl_navn(bpl));
10 8634 j:=j+1;
10 8635 end;
9 8636 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8637 j:=0;
9 8638 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8639 if bpl_navn(bpl)<>long<::> then
9 8640 begin
10 8641 if j mod 8 = 0 and j > 0 then
10 8642 write(z_op(nr),"nl",1,"sp",19);
10 8643 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8644 j:=j+1;
10 8645 end;
9 8646 write(z_op(nr),"nl",1,"*",1);
9 8647 end;
8 8648
8 8648 begin
9 8649 <* 11 alarmlængde *>
9 8650 integer fno;
9 8651
9 8651 if indeks > 0 then
9 8652 begin
10 8653 opk_alarm.tab.alarm_lgd:= ia(1);
10 8654 i:= modiffil(tf_alarmlgd,nr,fno);
10 8655 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8656 iaf:= 0;
10 8657 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8658 setposition(fil(fno),0,0);
10 8659 end;
9 8660
9 8660 setposition(z_op(nr),0,0);
9 8661 cursor(z_op(nr),24,1);
9 8662 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8663 end;
8 8664
8 8664 begin
9 8665 <* 12 CC *>
9 8666 integer i, c;
9 8667
9 8667 i:= 1;
9 8668 while læstegn(ia,i+0,c)<>0 and
9 8669 i<(op_spool_postlgd-op_spool_text)//2*3
9 8670 do skrivtegn(d.opref.data,i,c);
9 8671 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8672
9 8672 d.opref.retur:= cs_operatør(nr);
9 8673 signalch(cs_op_spool,opref,op_optype);
9 8674 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8675
9 8675 setposition(z_op(nr),0,0);
9 8676 cursor(z_op(nr),24,1);
9 8677 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8678 end;
8 8679
8 8679 <* 13 EXkluder skærmen *>
8 8680 begin
9 8681 d.opref.resultat:= 2;
9 8682 setposition(z_op(nr),0,0);
9 8683 cursor(z_op(nr),24,1);
9 8684 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8685
9 8685 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8686 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8687 d.vt_op.data(1):= nr;
9 8688 signalch(cs_rad,vt_op,gen_optype);
9 8689 end;
8 8690
8 8690 begin
9 8691 <* 14 CQF-tabel,vis *>
9 8692
9 8692 skærm_måde:= 1;
9 8693 setposition(z_op(nr),0,0);
9 8694 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8695 "esc" add 128,1,<:ÆJ:>);
9 8696 skriv_cqf_tabel(z_op(nr),false);
9 8697 write(z_op(nr),"*",1);
9 8698 end;
8 8699
8 8699 begin
9 8700 <* 15 ALarmlyd,Test *>
9 8701 integer array field tab;
9 8702 integer res;
9 8703
9 8703 tab:= (nr-1)*opk_alarm_tab_lgd;
9 8704 setposition(z_op(nr),0,0);
9 8705 if ia(1)<1 or ia(1)>2 then
9 8706 res:= 64 <* ulovligt tal *>
9 8707 else if opk_alarm.tab.alarm_lgd = 0 then
9 8708 begin
10 8709 if ia(1)=2 then
10 8710 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
10 8711 else
10 8712 write(z_op(nr),"bel",1);
10 8713 res:= 3;
10 8714 end
9 8715 else if ia(1) > opk_alarm.tab.alarm_tilst and
9 8716 ia(1) > opk_alarm.tab.alarm_kmdo then
9 8717 begin
10 8718 opk_alarm.tab.alarm_kmdo:= ia(1);
10 8719 signal_bin(bs_opk_alarm);
10 8720 res:= 3;
10 8721 end
9 8722 else
9 8723 res:= 48; <* i brug *>
9 8724
9 8724 cursor(z_op(nr),24,1);
9 8725 skriv_kvittering(z_op(nr),opref,-1,res);
9 8726 end;
8 8727
8 8727 begin
9 8728 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8729 setposition(z_op(nr),0,0);
9 8730 cursor(z_op(nr),24,1);
9 8731 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8732 end;
8 8733 \f
8 8733 message procedure operatør side x - 810522/hko;
8 8734
8 8734 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8735 <*-4*>
8 8736 end;<*case j *>
7 8737 end <* j > 0 *>
6 8738 else
6 8739 begin
7 8740 <*V*> setposition(z_op(nr),0,0);
7 8741 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8742 skriv_kvittering(z_op(nr),op_ref,-1,
7 8743 45 <*ikke implementeret *>);
7 8744 end;
6 8745 end;<* godkendt *>
5 8746
5 8746 <*V*> setposition(z_op(nr),0,0);
5 8747 <*???*>
5 8748 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8749 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8750 skærmmåde = 0 do
5 8751 begin
6 8752 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8753 begin
7 8754 skriv_skærm_bvs(nr);
7 8755 <*940920 if op_talevej(nr)=0 then status:= 0
7 8756 else 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(1) 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 skærmmåde = 0
6 8787 and læsbit_ia(operatørmaske,nr) then
6 8788 begin
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 d.op_ref.retur:=cs_att_pulje;
5 8801 disable afslut_kommando(op_ref);
5 8802 end; <* indlæs kommando *>
4 8803
4 8803 begin
5 8804 \f
5 8804 message procedure operatør side x+1 - 810617/hko;
5 8805
5 8805 <* 2: inkluder *>
5 8806 integer k,n;
5 8807 integer array field msk,iaf1;
5 8808
5 8808 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8809 if i=0 then
5 8810 begin
6 8811 fejlreaktion(3<*programfejl*>,nr,
6 8812 <:operatør(nr) eksisterer ikke:>,1);
6 8813 d.op_ref.resultat:=28;
6 8814 end
5 8815 else
5 8816 begin
6 8817 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8818 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8819 else if d.op_ref.opkode = 0 then 0
6 8820 else 3;<*udført*>
6 8821 if i > 0 then
6 8822 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8823 <:operatørskærm reservation:>,1)
6 8824 else
6 8825 begin
7 8826 i:=terminal_tab.ref.terminal_tilstand;
7 8827 <*940418/cl inkluderet sættes i stop - start *>
7 8828 kode:= d.opref.opkode extract 12;
7 8829 if kode <> 0 then
7 8830 terminal_tab.ref.terminal_tilstand:=
7 8831 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8832 else
7 8833 <*940418/cl inkluderet sættes i stop - slut *>
7 8834 terminal_tab.ref.terminal_tilstand:= i extract
7 8835 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8836 for i:= 1 step 1 until max_antal_kanaler do
7 8837 begin
8 8838 iaf:= (i-1)*kanalbeskrlængde;
8 8839 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8840 end;
7 8841 skærm_måde:= 0;
7 8842 sætbit_ia(operatørmaske,nr,
7 8843 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8844 then 0 else 1));
7 8845 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8846 begin
8 8847 msk:= k*op_maske_lgd;
8 8848 if læsbit_ia(bpl_def.msk,nr) then
8 8849 <**> begin
9 8850 n:= 0;
9 8851 for i:= 1 step 1 until max_antal_operatører do
9 8852 if læsbit_ia(bpl_def.msk,i) then
9 8853 begin
10 8854 iaf1:= i*terminal_beskr_længde;
10 8855 if terminal_tab.iaf1.terminal_tilstand
10 8856 shift (-21) < 3 then
10 8857 n:= n+1;
10 8858 end;
9 8859 bpl_tilst(k,1):= n;
9 8860 end;
8 8861 <**> <*
8 8862 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8863 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8864 *> end;
7 8865 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8866 sætbit_ia(opkaldsflag,nr,0);
7 8867 signal_bin(bs_mobil_opkald);
7 8868 <*940418/cl inkluderet sættes i stop - start *>
7 8869 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8870 <*V*> ht_symbol(z_op(nr))
7 8871 else
7 8872 <*940418/cl inkluderet sættes i stop - slut *>
7 8873 <*V*> skriv_skærm(nr);
7 8874 cursor(z_op(nr),24,1);
7 8875 <*V*> setposition(z_op(nr),0,0);
7 8876 end;
6 8877 end;
5 8878 if d.op_ref.opkode = 0 then
5 8879 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8880 else
5 8881 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8882 end;
4 8883
4 8883 begin
5 8884 \f
5 8884 message procedure operatør side x+2 - 820304/hko;
5 8885
5 8885 <* 3: ekskluder *>
5 8886 integer k,n;
5 8887 integer array field iaf1,msk;
5 8888
5 8888 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8889 <*V*> setposition(z_op(nr),0,0);
5 8890 monitor(10) release process:(z_op(nr),0,ia);
5 8891 d.op_ref.resultat:=3;
5 8892 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8893 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8894 terminal_tab.ref.terminal_tilstand extract 21;
5 8895 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8896 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8897 begin
6 8898 msk:= k*op_maske_lgd;
6 8899 if læsbit_ia(bpl_def.msk,nr) then
6 8900 <**> begin
7 8901 n:= 0;
7 8902 for i:= 1 step 1 until max_antal_operatører do
7 8903 if læsbit_ia(bpl_def.msk,i) then
7 8904 begin
8 8905 iaf1:= i*terminal_beskr_længde;
8 8906 if terminal_tab.iaf1.terminal_tilstand
8 8907 shift (-21) < 3 then
8 8908 n:= n+1;
8 8909 end;
7 8910 bpl_tilst(k,1):= n;
7 8911 end;
6 8912 <**> <*
6 8913 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8914 *> end;
5 8915 signal_bin(bs_mobil_opkald);
5 8916 if opk_alarm.tab.alarm_tilst > 0 then
5 8917 begin
6 8918 opk_alarm.tab.alarm_kmdo:= 3;
6 8919 signal_bin(bs_opk_alarm);
6 8920 end;
5 8921 end;
4 8922 begin
5 8923
5 8923 <* 4: opdater skærm *>
5 8924
5 8924 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8925 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8926 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8927 skærmmåde=0 do
5 8928 begin
6 8929
6 8929 <*+2*> if testbit13 and overvåget then
6 8930 disable begin
7 8931 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8932 <:) opkaldsflag::>,"nl",1);
7 8933 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8934 write(out,<: operatørmaske::>,"nl",1);
7 8935 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8936 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8937 ud;
7 8938 end;
6 8939 <*-2*>
6 8940 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8941 begin
7 8942 skriv_skærm_bvs(nr);
7 8943 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8944 if status>0 then
7 8945 begin
7 8946 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8947 terminaltab.ref(ll):= 0;
7 8948 skriv_skærm_bvs(nr);
7 8949 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8950 end;
7 8951 for i:= 1 step 1 until max_antal_kanaler do
7 8952 begin
7 8953 iaf:= (i-1)*kanalbeskrlængde;
7 8954 inspect(ss_samtale_nedlagt(i),status);
7 8955 if status>0 and
7 8956 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8957 begin
7 8958 kanaltab.iaf.kanal_tilstand:=
7 8959 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8960 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8961 kanaltab.iaf(ll):= 0;
7 8962 skriv_skærm_kanal(nr,i);
7 8963 repeat
7 8964 wait(ss_samtale_nedlagt(i));
7 8965 inspect(ss_samtale_nedlagt(i),status);
7 8966 until status=0;
7 8967 end;
7 8968 end;
7 8969 940920*> cursor(z_op(nr),1,1);
7 8970 setposition(z_op(nr),0,0);
7 8971 end;
6 8972 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8973 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8974 begin
7 8975 <*V*> setposition(z_op(nr),0,0);
7 8976 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 8977 skriv_skærm_opkaldskø(nr);
7 8978 if sætbit_ia(kanalflag,nr,0) =1 then
7 8979 begin
8 8980 for i:=1 step 1 until max_antal_kanaler do
8 8981 skriv_skærm_kanal(nr,i);
8 8982 end;
7 8983 cursor(z_op(nr),1,1);
7 8984 <*V*> setposition(z_op(nr),0,0);
7 8985 end;
6 8986 end;
5 8987 end;
4 8988 begin
5 8989 \f
5 8989 message procedure operatør side x+3 - 830310/hko;
5 8990
5 8990 <* 5: samtale etableret *>
5 8991
5 8991 res:= d.op_ref.resultat;
5 8992 b_v:= d.op_ref.data(3) extract 4;
5 8993 b_s:= d.op_ref.data(4);
5 8994 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8995 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 8996 begin
6 8997 sætbit_i(terminal_tab.ref(1),21,1);
6 8998 sætbit_i(terminal_tab.ref(1),22,0);
6 8999 sætbit_i(terminal_tab.ref(1),2,0);
6 9000 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9001 terminal_tab.ref(2):= b_s;
6 9002 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 9003 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 9004 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 9005 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 9006
6 9006 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9007 begin
7 9008 <*V*> setposition(z_op(nr),0,0);
7 9009 skriv_skærm_b_v_s(nr);
7 9010 <*V*> setposition(z_op(nr),0,0);
7 9011 end;
6 9012 end
5 9013 else
5 9014 if terminal_tab.ref(1) shift(-21) = 2 then
5 9015 begin
6 9016 sætbit_i(terminal_tab.ref(1),22,0);
6 9017 sætbit_i(terminal_tab.ref(1),2,0);
6 9018 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9019 terminal_tab.ref(2):= 0;
6 9020 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9021 begin
7 9022 <*V*> setposition(z_op(nr),0,0);
7 9023 cursor(z_op(nr),21,17);
7 9024 write(z_op(nr),<:EJ FORB:>);
7 9025 <*V*> setposition(z_op(nr),0,0);
7 9026 end;
6 9027 end
5 9028 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 9029 <:terminal tilstand:>,1);
5 9030 end;
4 9031
4 9031 begin
5 9032 \f
5 9032 message procedure operatør side x+4 - 810602/hko;
5 9033
5 9033 <* 6: radiokanal ekskluderet *>
5 9034
5 9034 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 9035 pos:= d.op_ref.data(1);
5 9036 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9037 indeks:= terminal_tab.ref(2);
5 9038 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 9039 then indeks extract 4 else 0;
5 9040 if b_v = pos then
5 9041 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 9042 if b_s = pos then
5 9043 begin
6 9044 terminal_tab.ref(2):= 0;
6 9045 sætbit_i(terminal_tab.ref(1),21,0);
6 9046 sætbit_i(terminal_tab.ref(1),22,0);
6 9047 sætbit_i(terminal_tab.ref(1),2,0);
6 9048 end;
5 9049 if skærmmåde=0 then
5 9050 begin
6 9051 if b_v = pos or b_s = pos then
6 9052 <*V*> skriv_skærm_b_v_s(nr);
6 9053 <*V*> skriv_skærm_kanal(nr,pos);
6 9054 cursor(z_op(nr),1,1);
6 9055 setposition(z_op(nr),0,0);
6 9056 end;
5 9057 end;
4 9058
4 9058 begin
5 9059 \f
5 9059 message procedure operatør side x+5 - 950118/cl;
5 9060
5 9060 <* 7: operatørmeddelelse *>
5 9061 integer afs, kl, i;
5 9062 real dato, t;
5 9063
5 9063 cursor(z_op(nr),24,1);
5 9064 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9065 cursor(z_op(nr),23,1);
5 9066 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9067
5 9067 afs:= d.opref.data.op_spool_kilde;
5 9068 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 9069 kl:= round t;
5 9070 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 9071 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 9072 i:= replacechar(1,'.');
5 9073 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 9074 replacechar(1,i);
5 9075 write(z_op(nr),d.opref.data.op_spool_text);
5 9076
5 9076 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 9077 begin
6 9078 if opk_alarm.tab.alarm_lgd > 0 and
6 9079 opk_alarm.tab.alarm_tilst < 1 and
6 9080 opk_alarm.tab.alarm_kmdo < 1
6 9081 then
6 9082 begin
7 9083 opk_alarm.tab.alarm_kmdo := 1;
7 9084 signalbin(bs_opk_alarm);
7 9085 end
6 9086 else
6 9087 if opk_alarm.tab.alarm_lgd = 0 then
6 9088 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 9089 end;
5 9090
5 9090 setposition(z_op(nr),0,0);
5 9091
5 9091 signalch(d.opref.retur,opref,d.opref.optype);
5 9092 end;
4 9093
4 9093 begin
5 9094
5 9094 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 9095 <*-4*>
5 9096 end
4 9097 end; <* case aktion+6 *>
3 9098
3 9098 until false;
3 9099 op_trap:
3 9100 skriv_operatør(zbillede,1);
3 9101 end operatør;
2 9102
2 9102 \f
2 9102 message procedure op_cqftest side 1;
2 9103
2 9103 procedure op_cqftest;
2 9104 begin
3 9105 integer array field opref, ref, ref1;
3 9106 integer i, j, tv, cqf, res, pausetid;
3 9107 real nu, næstetid, kommstart, kommslut;
3 9108
3 9108 procedure skriv_op_cqftest(zud,omfang);
3 9109 value omfang;
3 9110 zone zud;
3 9111 integer omfang;
3 9112 begin
4 9113 write(zud,"nl",1,<:+++ op-cqftest:>);
4 9114 if omfang > 0 then
4 9115 disable begin
5 9116 real t;
5 9117
5 9117 trap(slut);
5 9118 write(zud,"nl",1,
5 9119 <: opref: :>,opref,"nl",1,
5 9120 <: ref: :>,ref,"nl",1,
5 9121 <: i: :>,i,"nl",1,
5 9122 <: tv: :>,tv,"nl",1,
5 9123 <: cqf: :>,cqf,"nl",1,
5 9124 <: res: :>,res,"nl",1,
5 9125 <: pausetid: :>,pausetid,"nl",1,
5 9126 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 9127 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 9128 <::>);
5 9129 skriv_coru(zud,coru_no(292));
5 9130 slut:
5 9131 end;
4 9132 end skriv_op_cqftest;
3 9133
3 9133 trap(op_cqf_trap);
3 9134 stackclaim(1000);
3 9135
3 9135
3 9135 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9136 skriv_op_cqftest(out,0);
3 9137 <*-4*>
3 9138
3 9138 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 9139 repeat
3 9140 i:= sidste_tv_brugt; tv:= 0;
3 9141 repeat
3 9142 i:= (i mod max_antal_taleveje) + 1;
3 9143 if tv_operatør(i) = 0 then tv:= i;
3 9144 until (tv<>0) or (i=sidste_tv_brugt);
3 9145
3 9145 if tv<>0 then
3 9146 begin
4 9147 tv_operatør(tv):= -1;
4 9148 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 9149 for cqf:= 1 step 1 until max_cqf do
4 9150 begin
5 9151 ref:= (cqf-1)*cqf_lgd;
5 9152 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 9153 begin
6 9154 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 9155 d.opref.data(1):= tv;
6 9156 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 9157 disable if testbit19 then
6 9158 begin
7 9159 integer i; <*lav en trap-bar blok*>
7 9160
7 9160 trap(test19_trap);
7 9161 systime(1,0,kommstart);
7 9162 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 9163 skriv_id(zrl,d.opref.data(2),0);
7 9164 test19_trap: outchar(zrl,'nl');
7 9165 end;
6 9166 signalch(cs_rad,opref,op_optype or gen_optype);
6 9167 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 9168 res:= d.opref.resultat;
6 9169 <*+2*>
6 9170 disable if testbit19 then
6 9171 begin
7 9172 integer i; <*lav en trap-bar blok*>
7 9173
7 9173 trap(test19_trap);
7 9174 systime(1,0,kommslut);
7 9175 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 9176 if d.opref.data(7)=2 then outchar(zrl,'*');
7 9177 if d.opref.data(9)<>0 then
7 9178 begin
8 9179 skriv_id(zrl,d.opref.data(9),0);
8 9180 outchar(zrl,' ');
8 9181 end;
7 9182 if d.opref.data(8)<>0 then
7 9183 begin
8 9184 skriv_id(zrl,d.opref.data(8),0);
8 9185 outchar(zrl,' ');
8 9186 end;
7 9187 if d.opref.data(12)<>0 then
7 9188 begin
8 9189 if d.opref.data(12) shift (-20) = 15 then
8 9190 write(zrl,<:OMR*:>)
8 9191 else
8 9192 if d.opref.data(12) shift (-20) = 14 then
8 9193 write(zrl,
8 9194 string områdenavn(d.opref.data(12) extract 20))
8 9195 else
8 9196 skriv_id(zrl,d.opref.data(12),0);
8 9197 outchar(zrl,' ');
8 9198 end;
7 9199 if d.opref.data(10)<>0 then
7 9200 begin
8 9201 skriv_id(zrl,d.opref.data(10),0);
8 9202 outchar(zrl,' ');
8 9203 end;
7 9204 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 9205 <<dd.dd>,kommslut-kommstart);
7 9206 test19_trap: outchar(zrl,'nl');
7 9207 end;
6 9208 <*-2*>
6 9209 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 9210 begin
7 9211 delay(3);
7 9212 d.opref.opkode:= 12 shift 12 + 41;
7 9213 d.opref.resultat:= 0;
7 9214 disable if testbit19 then
7 9215 begin
8 9216 integer i; <*lav en trap-bar blok*>
8 9217
8 9217 trap(test19_trap);
8 9218 systime(1,0,kommstart);
8 9219 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 9220 test19_trap: outchar(zrl,'nl');
8 9221 end;
7 9222 signalch(cs_rad,opref,op_optype or gen_optype);
7 9223 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 9224 <*+2*>
7 9225 disable if testbit19 then
7 9226 begin
8 9227 integer i; <*lav en trap-bar blok*>
8 9228
8 9228 trap(test19_trap);
8 9229 systime(1,0,kommslut);
8 9230 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 9231 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 9232 <<dd.dd>,kommslut-kommstart);
8 9233 test19_trap: outchar(zrl,'nl');
8 9234 end;
7 9235 <*-2*>
7 9236 if d.opref.resultat <> 3 then
7 9237 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 9238 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 9239 begin
8 9240 startoperation(opref,292,cs_cqf,23);
8 9241 i:= 1;
8 9242 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9243 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9244 skriv_tegn(d.opref.data,i,' ');
8 9245 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9246 hægtstring(d.opref.data,i,<: ok!:>);
8 9247 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9248 signalch(cs_io,opref,gen_optype);
8 9249 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9250 end;
7 9251 if cqf_tabel.ref.cqf_bus > 0 then
7 9252 begin
8 9253 cqf_tabel.ref.cqf_fejl:= 0;
8 9254 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 9255 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 9256 end;
7 9257 end <*res=3*>
6 9258 else
6 9259 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 9260 cqf_tabel.ref.cqf_bus > 0
6 9261 then
6 9262 begin
7 9263 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 9264 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 9265 if cqf_tabel.ref.cqf_fejl >= 2 then
7 9266 begin
8 9267 startoperation(opref,292,cs_cqf,23);
8 9268 i:= 1;
8 9269 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9270 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9271 skriv_tegn(d.opref.data,i,' ');
8 9272 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9273 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 9274 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9275 signalch(cs_io,opref,gen_optype);
8 9276 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9277 end;
7 9278 end;
6 9279 delay(10);
6 9280 end;
5 9281 if cqf_tabel.ref.cqf_bus > 0 and
5 9282 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 9283 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 9284 end; <*for cqf*>
4 9285
4 9285 tv_operatør(tv):= 0; tv:= 0;
4 9286 if op_cqf_tab_ændret then
4 9287 begin
5 9288 j:= skrivfil(1033,1,i);
5 9289 if j<>0 then
5 9290 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 9291 sorter_cqftab(1,max_cqf);
5 9292 for cqf:= 1 step 1 until max_cqf do
5 9293 begin
6 9294 ref:= (cqf-1)*cqf_lgd;
6 9295 ref1:= (cqf-1)*cqf_id;
6 9296 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 9297 end;
5 9298 op_cqf_tab_ændret:= false;
5 9299 end;
4 9300 end; <*tv*>
3 9301
3 9301 systime(1,0.0,nu);
3 9302 pausetid:= round(næste_tid - nu);
3 9303 if pausetid < 30 then pausetid:= 30;
3 9304
3 9304 <*V*> delay(pausetid);
3 9305
3 9305 until false;
3 9306
3 9306 op_cqf_trap:
3 9307 disable skriv_op_cqftest(zbillede,1);
3 9308 end op_cqftest;
2 9309 \f
2 9309 message procedure op_spool side 1;
2 9310
2 9310 procedure op_spool;
2 9311 begin
3 9312 integer array field opref, ref;
3 9313 integer næste_tomme, i;
3 9314
3 9314 procedure skriv_op_spool(zud,omfang);
3 9315 value omfang;
3 9316 zone zud;
3 9317 integer omfang;
3 9318 begin
4 9319 write(zud,"nl",1,<:+++ op-spool:>);
4 9320 if omfang > 0 then
4 9321 disable begin
5 9322 real t;
5 9323
5 9323 trap(slut);
5 9324 write(zud,"nl",1,
5 9325 <: opref: :>,opref,"nl",1,
5 9326 <: næste-tomme: :>,næste_tomme,"nl",1,
5 9327 <: ref: :>,ref,"nl",1,
5 9328 <: i: :>,i,"nl",1,
5 9329 <::>);
5 9330 skriv_coru(zud,coru_no(293));
5 9331 slut:
5 9332 end;
4 9333 end skriv_op_spool;
3 9334
3 9334 trap(op_spool_trap);
3 9335 stackclaim(400);
3 9336
3 9336 næste_tomme:= 0;
3 9337
3 9337 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9338 skriv_op_spool(out,0);
3 9339 <*-4*>
3 9340
3 9340 repeat
3 9341 <*V*> waitch(cs_op_spool,opref,true,-1);
3 9342 inspect(ss_op_spool_tomme,i);
3 9343
3 9343 if d.opref.opkode extract 12 <> 37 then
3 9344 begin
4 9345 d.opref.resultat:= 31;
4 9346 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 9347 end
3 9348 else
3 9349 if i<=0 then
3 9350 d.opref.resultat:= 32 <*ingen fri plads*>
3 9351 else
3 9352 begin
4 9353 <*V*> wait(ss_op_spool_tomme);
4 9354 ref:= næste_tomme*op_spool_postlgd;
4 9355 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9356 i:= d.opref.opsize - data;
4 9357 if i > (op_spool_postlgd - op_spool_text) then
4 9358 i:= (op_spool_postlgd - op_spool_text);
4 9359 op_spool_buf.ref.op_spool_kilde:=
4 9360 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9361 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9362 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9363 op_spool_buf.ref(op_spool_postlgd//2):=
4 9364 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9365 d.opref.resultat:= 3;
4 9366
4 9366 signal(ss_op_spool_fulde);
4 9367 end;
3 9368
3 9368 signalch(d.opref.retur,opref,d.opref.optype);
3 9369 until false;
3 9370
3 9370 op_spool_trap:
3 9371 disable skriv_op_spool(zbillede,1);
3 9372 end op_spool;
2 9373 \f
2 9373 message procedure op_medd side 1;
2 9374
2 9374 procedure op_medd;
2 9375 begin
3 9376 integer array field opref, ref;
3 9377 integer næste_fulde, i;
3 9378
3 9378 procedure skriv_op_medd(zud,omfang);
3 9379 value omfang;
3 9380 zone zud;
3 9381 integer omfang;
3 9382 begin
4 9383 write(zud,"nl",1,<:+++ op-medd:>);
4 9384 if omfang > 0 then
4 9385 disable begin
5 9386 real t;
5 9387
5 9387 trap(slut);
5 9388 write(zud,"nl",1,
5 9389 <: opref: :>,opref,"nl",1,
5 9390 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9391 <: ref: :>,ref,"nl",1,
5 9392 <: i: :>,i,"nl",1,
5 9393 <::>);
5 9394 skriv_coru(zud,coru_no(294));
5 9395 slut:
5 9396 end;
4 9397 end skriv_op_medd;
3 9398
3 9398 trap(op_medd_trap);
3 9399 næste_fulde:= 0;
3 9400 stackclaim(400);
3 9401
3 9401 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9402 skriv_op_medd(out,0);
3 9403 <*-4*>
3 9404
3 9404 repeat
3 9405 <*V*> wait(ss_op_spool_fulde);
3 9406 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9407
3 9407 ref:= næste_fulde*op_spool_postlgd;
3 9408 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9409
3 9409 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9410 d.opref.resultat:= 0;
3 9411 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9412 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9413 opref,gen_optype);
3 9414 signal(ss_op_spool_tomme);
3 9415 until false;
3 9416
3 9416 op_medd_trap:
3 9417 disable skriv_op_medd(zbillede,1);
3 9418 end op_medd;
2 9419 \f
2 9419 message procedure alarmur side 1;
2 9420
2 9420 procedure alarmur;
2 9421 begin
3 9422 integer ventetid, nr;
3 9423 integer array field opref, tab;
3 9424 real nu;
3 9425
3 9425 procedure skriv_alarmur(zud,omfang);
3 9426 value omfang;
3 9427 zone zud;
3 9428 integer omfang;
3 9429 begin
4 9430 write(zud,"nl",1,<:+++ alarmur:>);
4 9431 if omfang > 0 then
4 9432 disable begin
5 9433 real t;
5 9434
5 9434 trap(slut);
5 9435 write(zud,"nl",1,
5 9436 <: ventetid: :>,ventetid,"nl",1,
5 9437 <: nr: :>,nr,"nl",1,
5 9438 <: opref: :>,opref,"nl",1,
5 9439 <: tab: :>,tab,"nl",1,
5 9440 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9441 <::>);
5 9442 skriv_coru(zud,coru_no(295));
5 9443 slut:
5 9444 end;
4 9445 end skriv_alarmur;
3 9446
3 9446 trap(alarmur_trap);
3 9447 stackclaim(400);
3 9448
3 9448 systime(1,0.0,nu);
3 9449 ventetid:= -1;
3 9450 repeat
3 9451 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9452 if opref > 0 then
3 9453 signalch(d.opref.retur,opref,op_optype);
3 9454
3 9454 ventetid:= -1;
3 9455 systime(1,0.0,nu);
3 9456 for nr:= 1 step 1 until max_antal_operatører do
3 9457 begin
4 9458 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9459 if opk_alarm.tab.alarm_tilst > 0 and
4 9460 opk_alarm.tab.alarm_lgd >= 0 then
4 9461 begin
5 9462 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9463 begin
6 9464 opk_alarm.tab.alarm_kmdo:= 3;
6 9465 signalbin(bs_opk_alarm);
6 9466 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9467 end
5 9468 else
5 9469 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9470 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9471 end;
4 9472 end;
3 9473 if ventetid=0 then ventetid:= 1;
3 9474 until false;
3 9475
3 9475 alarmur_trap:
3 9476 disable skriv_alarmur(zbillede,1);
3 9477 end alarmur;
2 9478 \f
2 9478 message procedure opkaldsalarmer side 1;
2 9479
2 9479 procedure opkaldsalarmer;
2 9480 begin
3 9481 integer nr, ny_kommando, tilst, aktion, tt;
3 9482 integer array field tab, opref, alarmop;
3 9483
3 9483 procedure skriv_opkaldsalarmer(zud,omfang);
3 9484 value omfang;
3 9485 zone zud;
3 9486 integer omfang;
3 9487 begin
4 9488 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9489 if omfang>0 then
4 9490 disable begin
5 9491 real array field raf;
5 9492 trap(slut);
5 9493 raf:=0;
5 9494 write(zud,"nl",1,
5 9495 <: nr: :>,nr,"nl",1,
5 9496 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9497 <: tilst: :>,tilst,"nl",1,
5 9498 <: aktion: :>,aktion,"nl",1,
5 9499 <: tt: :>,false add tt,1,"nl",1,
5 9500 <: tab: :>,tab,"nl",1,
5 9501 <: opref: :>,opref,"nl",1,
5 9502 <: alarmop: :>,alarmop,"nl",1,
5 9503 <::>);
5 9504 skriv_coru(zud,coru_no(296));
5 9505 slut:
5 9506 end;
4 9507 end skriv_opkaldsalarmer;
3 9508
3 9508 trap(opk_alarm_trap);
3 9509 stackclaim(400);
3 9510
3 9510 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9511 skriv_opkaldsalarmer(out,0);
3 9512 <*-2*>
3 9513
3 9513 repeat
3 9514 wait(bs_opk_alarm);
3 9515 alarmop:= 0;
3 9516 for nr:= 1 step 1 until max_antal_operatører do
3 9517 begin
4 9518 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9519 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9520 tilst:= opk_alarm.tab.alarm_tilst;
4 9521 aktion:= case ny_kommando+1 of (
4 9522 <*ingenting*> case tilst+1 of (4,4,4),
4 9523 <*normal *> case tilst+1 of (1,4,4),
4 9524 <*nød *> case tilst+1 of (2,2,4),
4 9525 <*sluk *> case tilst+1 of (4,3,3));
4 9526 tt:= case aktion of ('B','C','F','-');
4 9527 if tt<>'-' then
4 9528 begin
5 9529 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9530 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9531 d.opref.data(1):= nr+16;
5 9532 signalch(cs_talevejsswitch,opref,op_optype);
5 9533 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9534 if d.opref.resultat = 3 then
5 9535 begin
6 9536 opk_alarm.tab.alarm_kmdo:= 0;
6 9537 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9538 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9539 if aktion < 3 then
6 9540 begin
7 9541 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9542 if alarmop = 0 then
7 9543 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9544 end;
6 9545 end;
5 9546 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9547 end;
4 9548 end;
3 9549 if alarmop<>0 then
3 9550 begin
4 9551 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9552 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9553 end;
3 9554 until false;
3 9555
3 9555 opk_alarm_trap:
3 9556 disable skriv_opkaldsalarmer(zbillede,1);
3 9557 end;
2 9558
2 9558 \f
2 9558 message procedure tvswitch_input side 1 - 940810/cl;
2 9559
2 9559 procedure tv_switch_input;
2 9560 begin
3 9561 integer array field opref;
3 9562 integer tt,ant;
3 9563 boolean ok;
3 9564 integer array ia(1:128);
3 9565
3 9565 procedure skriv_tvswitch_input(zud,omfang);
3 9566 value omfang;
3 9567 zone zud;
3 9568 integer omfang;
3 9569 begin
4 9570 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9571 if omfang>0 then
4 9572 disable begin
5 9573 real array field raf;
5 9574 trap(slut);
5 9575 raf:=0;
5 9576 write(zud,"nl",1,
5 9577 <: opref: :>,opref,"nl",1,
5 9578 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9579 <: ant: :>,ant,"nl",1,
5 9580 <: tt: :>,tt,"nl",1,
5 9581 <::>);
5 9582 write(zud,"nl",1,<:ia: :>);
5 9583 skrivhele(zud,ia.raf,256,2);
5 9584 skriv_coru(zud,coru_no(297));
5 9585 slut:
5 9586 end;
4 9587 end skriv_tvswitch_input;
3 9588 \f
3 9588 boolean procedure læs_tlgr;
3 9589 begin
4 9590 integer kl,ch,i,pos,p;
4 9591 long field lf;
4 9592 boolean ok;
4 9593
4 9593 integer procedure readch(z,c);
4 9594 zone z; integer c;
4 9595 begin
5 9596 readch:= readchar(z,c);
5 9597 <*+2*> if testbit15 and overvåget then
5 9598 disable begin
6 9599 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9600 else write(zrl,"<",1,<<d>,c,">",1);
6 9601 if c='em' then write(zrl,<: *timeout*:>);
6 9602 end;
5 9603 <*-2*>
5 9604 end;
4 9605
4 9605 ok:= false; tt:=' ';
4 9606 repeat
4 9607 readchar(z_tv_in,ch);
4 9608 until ch<>'em';
4 9609 repeatchar(z_tv_in);
4 9610
4 9610 <*+2*>if testbit15 and overvåget then
4 9611 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9612 <*-2*>
4 9613
4 9613 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9614 if ch='%' then
4 9615 begin
5 9616 ant:= 0; pos:= 1; lf:= 4;
5 9617 ok:= true;
5 9618 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9619
5 9619 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9620 skrivtegn(ia,pos,ch);
5 9621
5 9621 p:=pos;
5 9622 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9623
5 9623 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9624 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9625 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9626
5 9626 if ok and ch=' ' then
5 9627 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9628
5 9628 while kl = 2 do
5 9629 begin
6 9630 i:= ch - '0';
6 9631 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9632 if ant < 128 then
6 9633 begin
7 9634 ant:= ant+1;
7 9635 ia(ant):= i;
7 9636 end
6 9637 else
6 9638 ok:= false;
6 9639 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9640 end;
5 9641 if ch<>'nl' then ok:= false;
5 9642 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9643 <* !! setposition(z_tv_in,0,0); !! *>
5 9644 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9645 <*-2*>
5 9646
5 9646 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9647 ok:= ok
5 9648 else if tt='C' or tt='N' or
5 9649 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9650 ok:= ok and ant=1
5 9651 else if tt='X' or tt='Y' then
5 9652 ok:= ok and ant=2
5 9653 else if tt='T' or tt='W' then
5 9654 ok:= ok and ant=64
5 9655 else if tt='R' then
5 9656 ok:= ok and ant extract 1 = 0
5 9657 else
5 9658 begin
6 9659 ok:= false;
6 9660 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9661 end;
5 9662
5 9662 end; <* if ch='%' *>
4 9663 læs_tlgr:= ok;
4 9664 end læs_tlgr;
3 9665 \f
3 9665 trap(tvswitch_input_trap);
3 9666 stackclaim(400);
3 9667 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9668
3 9668 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9669 skriv_tvswitch_input(out,0);
3 9670 <*-2*>
3 9671
3 9671 repeat
3 9672 ok:= læs_tlgr;
3 9673 if ok then
3 9674 begin
4 9675 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9676 start_operation(opref,297,cs_tvswitch_input,0);
4 9677 d.opref.resultat:= tt shift 12 + ant;
4 9678 tofrom(d.opref.data,ia,ant*2);
4 9679 signalch(cs_talevejsswitch,opref,op_optype);
4 9680 end;
3 9681 until false;
3 9682
3 9682 tvswitch_input_trap:
3 9683
3 9683 disable skriv_tvswitch_input(zbillede,1);
3 9684
3 9684 end tvswitch_input;
2 9685 \f
2 9685 message procedure tv_switch_adm side 1 - 940502/cl;
2 9686
2 9686 procedure tv_switch_adm;
2 9687 begin
3 9688 integer array field opref;
3 9689 integer rc;
3 9690
3 9690 procedure skriv_tv_switch_adm(zud,omfang);
3 9691 value omfang;
3 9692 zone zud;
3 9693 integer omfang;
3 9694 begin
4 9695 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9696 if omfang>0 then
4 9697 disable begin
5 9698 trap(slut);
5 9699 write(zud,"nl",1,
5 9700 <: opref: :>,opref,"nl",1,
5 9701 <: rc: :>,rc,"nl",1,
5 9702 <::>);
5 9703 skriv_coru(zud,coru_no(298));
5 9704 slut:
5 9705 end;
4 9706 end skriv_tv_switch_adm;
3 9707
3 9707 trap(tv_switch_adm_trap);
3 9708 stackclaim(400);
3 9709
3 9709 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9710 disable skriv_tv_switch_adm(out,0);
3 9711 <*-2*>
3 9712
3 9712
3 9712
3 9712 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9713 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9714 *>
3 9715
3 9715 repeat
3 9716 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9717 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9718 rc:= 0;
3 9719 repeat
3 9720 signalch(cs_talevejsswitch,opref,op_optype);
3 9721 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9722 rc:= rc+1;
3 9723 until rc=3 or d.opref.resultat=3;
3 9724
3 9724 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9725
3 9725 <*V*> delay(15*60);
3 9726 until false;
3 9727 tv_switch_adm_trap:
3 9728 disable skriv_tv_switch_adm(zbillede,1);
3 9729 end;
2 9730 \f
2 9730 message procedure talevejsswitch side 1 -940426/cl;
2 9731
2 9731 procedure talevejsswitch;
2 9732 begin
3 9733 integer tt, ant, ventetid;
3 9734 integer array field opref, gemt_op, tab;
3 9735 boolean ok;
3 9736 integer array ia(1:128);
3 9737
3 9737 procedure skriv_talevejsswitch(zud,omfang);
3 9738 value omfang;
3 9739 zone zud;
3 9740 integer omfang;
3 9741 begin
4 9742 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9743 if omfang>0 then
4 9744 disable begin
5 9745 real array field raf;
5 9746 trap(slut);
5 9747 raf:= 0;
5 9748 write(zud,"nl",1,
5 9749 <: tt: :>,tt,"nl",1,
5 9750 <: ant: :>,ant,"nl",1,
5 9751 <: ventetid: :>,ventetid,"nl",1,
5 9752 <: opref: :>,opref,"nl",1,
5 9753 <: gemt-op: :>,gemt_op,"nl",1,
5 9754 <: tab: :>,tab,"nl",1,
5 9755 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9756 <::>);
5 9757 write(zud,"nl",1,<:ia: :>);
5 9758 skriv_hele(zud,ia.raf,256,2);
5 9759 skriv_coru(zud,coru_no(299));
5 9760 slut:
5 9761 end;
4 9762 end skriv_talevejsswitch;
3 9763 \f
3 9763 trap(tvswitch_trap);
3 9764 stackclaim(400);
3 9765 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9766
3 9766 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9767 skriv_talevejsswitch(out,0);
3 9768 <*-2*>
3 9769
3 9769 ventetid:= -1; ant:= 0; tt:= ' ';
3 9770 repeat
3 9771 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9772 if opref > 0 then
3 9773 begin
4 9774 if d.opref.opkode extract 12 = 0 then
4 9775 begin <*input fra talevejsswitchen *>
5 9776 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9777 tt:= d.opref.resultat shift (-12) extract 12;
5 9778 ant:= d.opref.resultat extract 12;
5 9779 tofrom(ia,d.opref.data,ant*2);
5 9780 signalch(d.opref.retur,opref,d.opref.optype);
5 9781
5 9781 if tt<>'+' and tt<>'-' then
5 9782 begin
6 9783 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9784 setposition(z_tv_out,0,0);
6 9785 <*+2*> if testbit15 and overvåget then
6 9786 disable begin
7 9787 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9788 outchar(zrl,'nl');
7 9789 end;
6 9790 <*-2*>
6 9791 end;
5 9792 if (tt='+' or tt='-') and gemt_op<>0 then
5 9793 begin
6 9794 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9795 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9796 gemt_op:= 0;
6 9797 ventetid:= -1;
6 9798 end
5 9799 else
5 9800 if tt='R' then
5 9801 begin
6 9802 for i:= 1 step 2 until ant do
6 9803 begin
7 9804 if ia(i) <= max_antal_taleveje and
7 9805 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9806 then
7 9807 begin
8 9808 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9809 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9810 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9811 op_talevej(tv_operatør(ia(i))):= 0;
8 9812 tv_operatør(ia(i)):= ia(i+1)-16;
8 9813 op_talevej(ia(i+1)-16):= ia(i);
8 9814 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9815 end
7 9816 else
7 9817 if ia(i+1) <= max_antal_taleveje and
7 9818 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9819 then
7 9820 begin
8 9821 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9822 tv_operatør(op_talevej(ia(i))):= 0;
8 9823 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9824 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9825 tv_operatør(ia(i+1)):= ia(i)-16;
8 9826 op_talevej(ia(i)-16):= ia(i+1);
8 9827 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9828 end;
7 9829 end;
6 9830 signal_bin(bs_mobil_opkald);
6 9831 <*+2*> if testbit15 and testbit16 and overvåget then
6 9832 disable begin
7 9833 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9834 end;
6 9835 <*-2*>
6 9836 end <* tt='R' and ant>0 *>
5 9837 else
5 9838 if tt='Y' then
5 9839 begin
6 9840 if ia(1) <= max_antal_taleveje and
6 9841 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9842 then
6 9843 begin
7 9844 if tv_operatør(ia(1))=ia(2)-16 and
7 9845 op_talevej(ia(2)-16)=ia(1)
7 9846 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9847 end
6 9848 else
6 9849 if ia(2) <= max_antal_taleveje and
6 9850 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9851 then
6 9852 begin
7 9853 if tv_operatør(ia(2))=ia(1)-16 and
7 9854 op_talevej(ia(1)-16)=ia(2)
7 9855 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9856 end;
6 9857 end
5 9858 else
5 9859 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9860 begin
6 9861 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9862 startoperation(opref,299,cs_op_iomedd,23);
6 9863 ant:= 1;
6 9864 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9865 anbringtal(d.opref.data,ant,ia(1),2);
6 9866 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9867 begin
7 9868 hægtstring(d.opref.data,ant,<: (:>);
7 9869 if bpl_navn(ia(1)-16)=long<::> then
7 9870 begin
8 9871 hægtstring(d.opref.data,ant,<:op:>);
8 9872 anbringtal(d.opref.data,ant,ia(1)-16,
8 9873 if ia(1)-16 > 9 then 2 else 1);
8 9874 end
7 9875 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9876 skrivtegn(d.opref.data,ant,')');
7 9877 end;
6 9878 hægtstring(d.opref.data,ant,
6 9879 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9880 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9881 if tt='P' then <: Tilgængelig:> else
6 9882 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9883 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9884 signalch(cs_io,opref,gen_optype);
6 9885 end
5 9886 else
5 9887 if tt='Z' then
5 9888 begin
6 9889 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9890 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9891 end
5 9892 else
5 9893 begin
6 9894 <* ikke implementeret *>
6 9895 end;
5 9896 end
4 9897 else
4 9898 if d.opref.opkode extract 12 = 44 then
4 9899 begin
5 9900 tt:= d.opref.opkode shift (-12);
5 9901 ok:= true;
5 9902 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9903 begin
6 9904 <*+2*> if testbit15 and overvåget then
6 9905 disable begin
7 9906 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9907 outchar(zrl,'nl');
7 9908 end;
6 9909 <*-2*>
6 9910 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9911 setposition(z_tv_out,0,0);
6 9912 end
5 9913 else
5 9914 if tt='B' or tt='C' or tt='F' then
5 9915 begin
6 9916 <*+2*> if testbit15 and overvåget then
6 9917 disable begin
7 9918 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9919 " ",1,<<d>,d.opref.data(1));
7 9920 outchar(zrl,'nl');
7 9921 end;
6 9922 <*-2*>
6 9923 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9924 d.opref.data(1),"cr",1);
6 9925 setposition(z_tv_out,0,0);
6 9926 end
5 9927 else
5 9928 if tt='A' or tt='D' or tt='T' then
5 9929 begin
6 9930 <*+2*> if testbit15 and overvåget then
6 9931 disable begin
7 9932 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9933 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9934 outchar(zrl,'nl');
7 9935 end;
6 9936 <*-2*>
6 9937 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9938 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9939 setposition(z_tv_out,0,0);
6 9940 end
5 9941 else
5 9942 ok:= false;
5 9943 if ok then
5 9944 begin
6 9945 gemt_op:= opref;
6 9946 ventetid:= 2;
6 9947 end
5 9948 else
5 9949 begin
6 9950 d.opref.resultat:= 4;
6 9951 signalch(d.opref.retur,opref,d.opref.optype);
6 9952 end;
5 9953 end;
4 9954 end
3 9955 else
3 9956 if gemt_op<>0 then
3 9957 begin <*timeout*>
4 9958 d.gemt_op.resultat:= 0;
4 9959 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9960 gemt_op:= 0;
4 9961 ventetid:= -1;
4 9962 <*+2*> if testbit15 and overvåget then
4 9963 disable begin
5 9964 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9965 outchar(zrl,'nl');
5 9966 end;
4 9967 <*-2*>
4 9968 end;
3 9969 until false;
3 9970 tvswitch_trap:
3 9971 disable skriv_talevejsswitch(zbillede,1);
3 9972 end talevejsswitch;
2 9973
2 9973 \f
2 9973 message garage_erklæringer side 1 - 810415/hko;
2 9974
2 9974 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 9975
2 9975 procedure gar_fejl(z,s,b);
2 9976 integer s,b;
2 9977 zone z;
2 9978 begin
3 9979 disable begin
4 9980 integer array iz(1:20);
4 9981 integer i,j,k;
4 9982 integer array field iaf;
4 9983 real array field raf;
4 9984
4 9984 getzone6(z,iz);
4 9985 iaf:=raf:=2;
4 9986 getnumber(iz.raf,7,j);
4 9987
4 9987 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 9988 k:=1;
4 9989
4 9989 j:= terminal_tab.iaf.terminal_tilstand;
4 9990 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 9991 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 9992 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 9993 if s <> (1 shift 21 +2) then
4 9994 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 9995 + terminal_tab.iaf.terminal_tilstand extract 21;
4 9996 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 9997 begin
5 9998 z(1):=real <:<'?'><'em'>:>;
5 9999 b:=2;
5 10000 end;
4 10001 end; <*disable*>
3 10002 end gar_fejl;
2 10003
2 10003 integer cs_gar;
2 10004 integer array cs_garage(1:max_antal_garageterminaler);
2 10005 \f
2 10005 message procedure h_garage side 1 - 810520/hko;
2 10006
2 10006 <* hovedmodulkorutine for garageterminaler *>
2 10007 procedure h_garage;
2 10008 begin
3 10009 integer array field op_ref;
3 10010 integer k,dest_sem;
3 10011 procedure skriv_hgarage(zud,omfang);
3 10012 value omfang;
3 10013 zone zud;
3 10014 integer omfang;
3 10015 begin integer i;
4 10016
4 10016 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 10017 write(zud,"sp",26-i);
4 10018 if omfang>0 then
4 10019 disable begin
5 10020 integer x;
5 10021 trap(slut);
5 10022 write(zud,"nl",1,
5 10023 <: op_ref: :>,op_ref,"nl",1,
5 10024 <: k: :>,k,"nl",1,
5 10025 <: dest_sem: :>,dest_sem,"nl",1,
5 10026 <::>);
5 10027 skriv_coru(zud,coru_no(300));
5 10028 slut:
5 10029 end;
4 10030 end skriv_hgarage;
3 10031
3 10031 trap(hgar_trap);
3 10032 stack_claim(if cm_test then 198 else 146);
3 10033
3 10033 <*+2*>
3 10034 if testbit16 and overvåget or testbit28 then
3 10035 skriv_hgarage(out,0);
3 10036 <*-2*>
3 10037 \f
3 10037 message procedure h_garage side 2 - 811105/hko;
3 10038
3 10038 repeat
3 10039 wait_ch(cs_gar,op_ref,true,-1);
3 10040 <*+4*>
3 10041 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 10042 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 10043 <*-4*>
3 10044
3 10044 k:=d.op_ref.opkode extract 12;
3 10045 dest_sem:=
3 10046 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 10047 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 10048 else -1;
3 10049 <*+4*>
3 10050 if dest_sem=-1 then
3 10051 begin
4 10052 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 10053 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10054 end
3 10055 else
3 10056 <*-4*>
3 10057 if k=7<*inkluder*> then
3 10058 begin
4 10059 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 10060 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 10061 begin
5 10062 d.op_ref.resultat:=3;
5 10063 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 10064 dest_sem:=-2;
5 10065 end;
4 10066 end
3 10067 else
3 10068 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 10069 begin
4 10070 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 10071 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 10072 +terminal_tab.iaf.terminal_tilstand extract 21;
4 10073 end;
3 10074 if dest_sem>0 then
3 10075 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 10076 until false;
3 10077
3 10077 hgar_trap:
3 10078 disable skriv_hgarage(zbillede,1);
3 10079 end h_garage;
2 10080 \f
2 10080 message procedure garage side 1 - 830310/cl;
2 10081
2 10081 procedure garage(nr);
2 10082 value nr;
2 10083 integer nr;
2 10084 begin
3 10085 integer array field op_ref,ref;
3 10086 integer i,kode,aktion,status,opgave,retur_sem,
3 10087 pos,indeks,sep,sluttegn,vogn,ll;
3 10088
3 10088 procedure skriv_garage(zud,omfang);
3 10089 value omfang;
3 10090 zone zud;
3 10091 integer omfang;
3 10092 begin integer i;
4 10093
4 10093 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 10094 write(zud,"sp",26-i);
4 10095 if omfang > 0 then
4 10096 disable begin integer x;
5 10097 trap(slut);
5 10098 write(zud,"nl",1,
5 10099 <: op-ref: :>,op_ref,"nl",1,
5 10100 <: kode: :>,kode,"nl",1,
5 10101 <: ref: :>,ref,"nl",1,
5 10102 <: i: :>,i,"nl",1,
5 10103 <: aktion: :>,aktion,"nl",1,
5 10104 <: retur-sem: :>,retur_sem,"nl",1,
5 10105 <: vogn: :>,vogn,"nl",1,
5 10106 <: ll: :>,ll,"nl",1,
5 10107 <: status: :>,status,"nl",1,
5 10108 <: opgave: :>,opgave,"nl",1,
5 10109 <: pos: :>,pos,"nl",1,
5 10110 <: indeks: :>,indeks,"nl",1,
5 10111 <: sep: :>,sep,"nl",1,
5 10112 <: sluttegn: :>,sluttegn,"nl",1,
5 10113 <::>);
5 10114 skriv_coru(zud,coru_no(300+nr));
5 10115 slut:
5 10116 end;
4 10117 end skriv_garage;
3 10118 \f
3 10118 message procedure garage side 2 - 830310/hko;
3 10119
3 10119 trap(gar_trap);
3 10120 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 10121
3 10121 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 10122
3 10122 <*+2*>
3 10123 if testbit16 and overvåget or testbit28 then
3 10124 skriv_garage(out,0);
3 10125 <*-2*>
3 10126
3 10126 <* attention simulering
3 10127 *>
3 10128 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 10129 begin
4 10130 wait_ch(cs_att_pulje,op_ref,true,-1);
4 10131 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 10132 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 10133 end;
3 10134 <*
3 10135 *>
3 10136 \f
3 10136 message procedure garage side 3 - 830310/hko;
3 10137
3 10137 repeat
3 10138
3 10138 <*V*> wait_ch(cs_garage(nr),
3 10139 op_ref,
3 10140 true,
3 10141 -1<*timeout*>);
3 10142 <*+2*>
3 10143 if testbit17 and overvåget then
3 10144 disable begin
4 10145 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 10146 <: til garage :>,nr);
4 10147 skriv_op(out,op_ref);
4 10148 end;
3 10149 <*-2*>
3 10150
3 10150 kode:= d.op_ref.op_kode;
3 10151 retur_sem:= d.op_ref.retur;
3 10152 i:= terminal_tab.ref.terminal_tilstand;
3 10153 status:= i shift(-21);
3 10154 opgave:=
3 10155 if kode=0 then 1 <* indlæs kommando *> else
3 10156 if kode=7 then 2 <* inkluder *> else
3 10157 if kode=8 then 3 <* ekskluder *> else
3 10158 0; <* afvises *>
3 10159
3 10159 aktion:= case status +1 of(
3 10160 <* status *> <* opgave: 0 1 2 3 *>
3 10161 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 10162 <* 1 - *>(-1),<* ulovlig tilstand *>
3 10163 <* 2 - *>(-1),<* ulovlig tilstand *>
3 10164 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 10165 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 10166 <* 5 - *>(-1),<* ulovlig tilstand *>
3 10167 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 10168 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 10169 -1);
3 10170 \f
3 10170 message procedure garage side 4 - 810424/hko;
3 10171
3 10171 case aktion+6 of
3 10172 begin
4 10173 begin
5 10174 <*-5: terminal optaget *>
5 10175
5 10175 d.op_ref.resultat:= 16;
5 10176 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10177 end;
4 10178
4 10178 begin
5 10179 <*-4: operation uden virkning *>
5 10180
5 10180 afslut_operation(op_ref,-1);
5 10181 end;
4 10182
4 10182 begin
5 10183 <*-3: ulovlig operationskode *>
5 10184
5 10184 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 10185 afslut_operation(op_ref,-1);
5 10186 end;
4 10187
4 10187 begin
5 10188 <*-2: ulovligt garageterminal_nr *>
5 10189
5 10189 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 10190 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10191 end;
4 10192
4 10192 begin
5 10193 <*-1: ulovlig operatørtilstand *>
5 10194
5 10194 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 10195 afslut_operation(op_ref,-1);
5 10196 end;
4 10197
4 10197 begin
5 10198 <* 0: ikke implementeret *>
5 10199
5 10199 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 10200 afslut_operation(op_ref,-1);
5 10201 end;
4 10202
4 10202 begin
5 10203 \f
5 10203 message procedure garage side 5 - 851001/cl;
5 10204
5 10204 <* 1: indlæs kommando *>
5 10205
5 10205
5 10205 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 10206
5 10206 if d.op_ref.resultat > 3 then
5 10207 begin
6 10208 <*V*> setposition(z_gar(nr),0,0);
6 10209 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 10210 skriv_kvittering(z_gar(nr),op_ref,pos,
6 10211 d.op_ref.resultat);
6 10212 end
5 10213 else if d.op_ref.resultat>0 then
5 10214 begin <*godkendt*>
6 10215 kode:=d.op_ref.opkode;
6 10216 i:= kode extract 12;
6 10217 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 10218 else if kode=9 or kode=10 then 2
6 10219 else 0;
6 10220 if j > 0 then
6 10221 begin
7 10222 case j of
7 10223 begin
8 10224 begin
9 10225 \f
9 10225 message procedure garage side 6 - 851001/cl;
9 10226
9 10226 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 10227 integer vogn,ll;
9 10228 integer array field vtop;
9 10229
9 10229 vogn:=ia(1);
9 10230 ll:=ia(2);
9 10231 <*V*> wait_ch(cs_vt_adgang,
9 10232 vt_op,
9 10233 gen_optype,
9 10234 -1<*timeout sek*>);
9 10235 start_operation(vtop,300+nr,cs_garage(nr),
9 10236 kode);
9 10237 d.vt_op.data(1):=vogn;
9 10238 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 10239 indeks:= vt_op;
9 10240 signal_ch(cs_vt,
9 10241 vt_op,
9 10242 gen_optype or gar_optype);
9 10243
9 10243 <*V*> wait_ch(cs_garage(nr),
9 10244 vt_op,
9 10245 gar_optype,
9 10246 -1<*timeout sek*>);
9 10247 <*+2*> if testbit18 and overvåget then
9 10248 disable begin
10 10249 write(out,"nl",1,<:garage :>,<<d>,nr,
10 10250 <:: operation retur fra vt:>);
10 10251 skriv_op(out,vt_op);
10 10252 end;
9 10253 <*-2*>
9 10254 <*+4*> if vt_op<>indeks then
9 10255 fejl_reaktion(11<*fremmede op*>,op_ref,
9 10256 <:garage-kommando:>,0);
9 10257 <*-4*>
9 10258 <*V*> setposition(z_gar(nr),0,0);
9 10259 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 10260 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 10261 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 10262 else vt_op,-1,d.vt_op.resultat);
9 10263 d.vt_op.optype:=gen_optype or vtoptype;
9 10264 disable afslut_operation(vt_op,cs_vt_adgang);
9 10265 end;
8 10266
8 10266 begin
9 10267 \f
9 10267 message procedure garage side 6a - 830310/cl;
9 10268
9 10268 <* 2 vogntabel,linienr/-,busnr *>
9 10269
9 10269 d.op_ref.retur:= cs_garage(nr);
9 10270 tofrom(d.op_ref.data,ia,10);
9 10271 indeks:= op_ref;
9 10272 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 10273 wait_ch(cs_garage(nr),
9 10274 op_ref,
9 10275 gar_optype,
9 10276 -1<*timeout*>);
9 10277 <*+2*> if testbit18 and overvåget then
9 10278 disable begin
10 10279 write(out,"nl",1,<:garage operation retur fra vt:>);
10 10280 skriv_op(out,op_ref);
10 10281 end;
9 10282 <*-2*>
9 10283 <*+4*>
9 10284 if indeks <> op_ref then
9 10285 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 10286 <*-4*>
9 10287 i:= d.op_ref.resultat;
9 10288 if i = 0 or i > 3 then
9 10289 begin
10 10290 <*V*> setposition(z_gar(nr),0,0);
10 10291 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 10292 end
9 10293 else
9 10294 begin
10 10295 integer antal,fil_ref;
10 10296 antal:= d.op_ref.data(6);
10 10297 fil_ref:= d.op_ref.data(7);
10 10298 <*V*> setposition(z_gar(nr),0,0);
10 10299 write(z_gar(nr),"*",24,"sp",6,
10 10300 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 10301 <*V*> setposition(z_gar(nr),0,0);
10 10302 \f
10 10302 message procedure garage side 6c - 841213/cl;
10 10303
10 10303 pos:= 1;
10 10304 while pos <= antal do
10 10305 begin
11 10306 integer bogst,løb;
11 10307
11 10307 disable i:= læs_fil(fil_ref,pos,j);
11 10308 if i <> 0 then
11 10309 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 10310 else
11 10311 begin
12 10312 vogn:= fil(j,1) shift (-24) extract 24;
12 10313 løb:= fil(j,1) extract 24;
12 10314 if d.op_ref.opkode=9 then
12 10315 begin i:=vogn; vogn:=løb; løb:=i; end;
12 10316 ll:= løb shift (-12) extract 10;
12 10317 bogst:= løb shift (-7) extract 5;
12 10318 if bogst > 0 then bogst:= bogst +'A'-1;
12 10319 løb:= løb extract 7;
12 10320 vogn:= vogn extract 14;
12 10321 i:= d.op_ref.opkode-8;
12 10322 for i:= i,i+1 do
12 10323 begin
13 10324 j:= (i+1) extract 1;
13 10325 case j +1 of
13 10326 begin
14 10327 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 10328 false add bogst,1,"/",1,<<d__>,løb);
14 10329 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 10330 end;
13 10331 end;
12 10332 if pos mod 5 = 0 then
12 10333 begin
13 10334 write(z_gar(nr),"nl",1);
13 10335 <*V*> setposition(z_gar(nr),0,0);
13 10336 end
12 10337 else write(z_gar(nr),"sp",3);
12 10338 end;
11 10339 pos:=pos+1;
11 10340 end;
10 10341 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 10342 \f
10 10342 message procedure garage side 6d- 830310/cl;
10 10343
10 10343 d.opref.opkode:=104; <*slet-fil*>
10 10344 d.op_ref.data(4):=filref;
10 10345 indeks:=op_ref;
10 10346 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 10347 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 10348
10 10348 <*+2*> if testbit18 and overvåget then
10 10349 disable begin
11 10350 write(out,"nl",1,<:garage, slet-fil retur:>);
11 10351 skriv_op(out,op_ref);
11 10352 end;
10 10353 <*-2*>
10 10354
10 10354 <*+4*> if op_ref<>indeks then
10 10355 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10356 <*-4*>
10 10357 if d.op_ref.data(9)<>0 then
10 10358 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10359 <:garage, slet_fil:>,1);
10 10360 end;
9 10361 \f
9 10361 message procedure garage side 7 -810424/hko;
9 10362
9 10362 end;
8 10363
8 10363 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10364 <*-4*>
8 10365 end;<*case j *>
7 10366 end <* j > 0 *>
6 10367 else
6 10368 begin
7 10369 <*V*> setposition(z_gar(nr),0,0);
7 10370 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10371 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10372 4 <*kommando ukendt *>);
7 10373 end;
6 10374 end;<* godkendt *>
5 10375
5 10375 <*V*> setposition(z_gar(nr),0,0);
5 10376
5 10376 d.op_ref.opkode:=0; <*telex*>
5 10377
5 10377 disable afslut_operation(op_ref,cs_gar);
5 10378 end; <* indlæs kommando *>
4 10379
4 10379 begin
5 10380 \f
5 10380 message procedure garage side 8 - 841213/cl;
5 10381
5 10381 <* 2: inkluder *>
5 10382
5 10382 d.op_ref.resultat:=3;
5 10383 afslut_operation(op_ref,-1);
5 10384 monitor(8)reserve:(z_gar(nr),0,ia);
5 10385 terminal_tab.ref.terminal_tilstand:=
5 10386 terminal_tab.ref.terminal_tilstand extract 21;
5 10387 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10388 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10389 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10390 end;
4 10391
4 10391 begin
5 10392
5 10392 <* 3: ekskluder *>
5 10393 d.op_ref.resultat:= 3;
5 10394 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10395 terminal_tab.ref.terminal_tilstand extract 21;
5 10396 monitor(10)release:(z_gar(nr),0,ia);
5 10397 afslut_operation(op_ref,-1);
5 10398
5 10398 end;
4 10399
4 10399 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10400 <*-4*>
4 10401 end; <* case aktion+6 *>
3 10402
3 10402 until false;
3 10403 gar_trap:
3 10404 skriv_garage(zbillede,1);
3 10405 end garage;
2 10406
2 10406 \f
2 10406 message procedure radio_erklæringer side 1 - 820304/hko;
2 10407
2 10407 zone z_fr_in(14,1,rad_in_fejl),
2 10408 z_rf_in(14,1,rad_in_fejl),
2 10409 z_fr_out(14,1,rad_out_fejl),
2 10410 z_rf_out(14,1,rad_out_fejl);
2 10411
2 10411 integer array
2 10412 radiofejl,
2 10413 ss_samtale_nedlagt,
2 10414 ss_radio_aktiver(1:max_antal_kanaler),
2 10415 bs_talevej_udkoblet,
2 10416 cs_radio(1:max_antal_taleveje),
2 10417 radio_linietabel(1:max_linienr//3+1),
2 10418 radio_områdetabel(0:max_antal_områder),
2 10419 opkaldskø(opkaldskø_postlængde//2+1:
2 10420 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10421 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10422 hookoff_maske(1:(tv_maske_lgd//2)),
2 10423 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10424
2 10424 integer field
2 10425 kanal_tilstand,
2 10426 kanal_id1,
2 10427 kanal_id2,
2 10428 kanal_spec,
2 10429 kanal_alt_id1,
2 10430 kanal_alt_id2;
2 10431 integer array field
2 10432 kanal_mon_maske,
2 10433 kanal_alarm,
2 10434 opkald_meldt;
2 10435
2 10435 integer
2 10436 cs_rad,
2 10437 cs_radio_medd,
2 10438 cs_radio_adm,
2 10439 cs_radio_ind,
2 10440 cs_radio_ud,
2 10441 cs_radio_pulje,
2 10442 cs_radio_kø,
2 10443 bs_mobil_opkald,
2 10444 bs_opkaldskø_adgang,
2 10445 opkaldskø_ledige,
2 10446 nødopkald_brugt,
2 10447 første_frie_opkald,
2 10448 første_opkald,
2 10449 sidste_opkald,
2 10450 første_nødopkald,
2 10451 sidste_nødopkald,
2 10452 optaget_flag;
2 10453
2 10453 boolean
2 10454 mobil_opkald_aktiveret;
2 10455 \f
2 10455 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10456
2 10456 integer
2 10457 procedure læs_hex_ciffer(tabel,linie,op);
2 10458 value linie;
2 10459 integer array tabel;
2 10460 integer linie,op;
2 10461 begin
3 10462 integer i,j;
3 10463
3 10463 i:=(if linie>=0 then linie+6 else linie)//6;
3 10464 j:=((i-1)*6-linie)*4;
3 10465 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10466 end læs_hex_ciffer;
2 10467
2 10467 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10468
2 10468 integer
2 10469 procedure sæt_hex_ciffer(tabel,linie,op);
2 10470 value linie;
2 10471 integer array tabel;
2 10472 integer linie,op;
2 10473 begin
3 10474 integer i,j;
3 10475
3 10475 i:=(if linie>=0 then linie+6 else linie)//6;
3 10476 j:=(linie-(i-1)*6)*4;
3 10477 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10478 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10479 shift j add (tabel(i) extract j);
3 10480 end sæt_hex_ciffer;
2 10481
2 10481 message procedure hex_to_dec side 1 - 900108/cl;
2 10482
2 10482 integer procedure hex_to_dec(hex);
2 10483 value hex;
2 10484 integer hex;
2 10485 begin
3 10486 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10487 else (hex-'0');
3 10488 end;
2 10489
2 10489 message procedure dec_to_hex side 1 - 900108/cl;
2 10490
2 10490 integer procedure dec_to_hex(dec);
2 10491 value dec;
2 10492 integer dec;
2 10493 begin
3 10494 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10495 else ('A'+dec-10);
3 10496 end;
2 10497
2 10497 message procedure rad_out_fejl side 1 - 820304/hko;
2 10498
2 10498 procedure rad_out_fejl(z,s,b);
2 10499 value s;
2 10500 zone z;
2 10501 integer s,b;
2 10502 begin
3 10503 integer array field iaf;
3 10504 integer pos,tegn,max,i;
3 10505 integer array ia(1:20);
3 10506 long array field laf;
3 10507
3 10507 disable begin
4 10508 laf:= iaf:= 2;
4 10509 tegn:= 1;
4 10510 getzone6(z,ia);
4 10511 max:= ia(16)//2*3;
4 10512 if s = 1 shift 21 + 2 then
4 10513 begin
5 10514 z(1):= real<:<'em'>:>;
5 10515 b:= 2;
5 10516 end
4 10517 else
4 10518 begin
5 10519 pos:= 0;
5 10520 for i:= 1 step 1 until max_antal_kanaler do
5 10521 begin
6 10522 iaf:= (i-1)*kanalbeskr_længde;
6 10523 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10524 if pos>0 then
6 10525 begin
7 10526 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10527 signalbin(bs_mobilopkald);
7 10528 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10529 1 shift 12<*binært*> +1<*fortsæt*>);
7 10530 end;
6 10531 end;
5 10532 end;
4 10533 end;
3 10534 end;
2 10535 \f
2 10535 message procedure rad_in_fejl side 1 - 810601/hko;
2 10536
2 10536 procedure rad_in_fejl(z,s,b);
2 10537 value s;
2 10538 zone z;
2 10539 integer s,b;
2 10540 begin
3 10541 integer array field iaf;
3 10542 integer pos,tegn,max,i;
3 10543 integer array ia(1:20);
3 10544 long array field laf;
3 10545
3 10545 disable begin
4 10546 laf:= iaf:= 2;
4 10547 i:= 1;
4 10548 getzone6(z,ia);
4 10549 max:= ia(16)//2*3;
4 10550 if s shift (-21) extract 1 = 0
4 10551 and s shift(-19) extract 1 = 0 then
4 10552 begin
5 10553 if b = 0 then
5 10554 begin
6 10555 z(1):= real<:!:>;
6 10556 b:= 2;
6 10557 end;
5 10558 end;
4 10559 \f
4 10559 message procedure rad_in_fejl side 2 - 820304/hko;
4 10560
4 10560 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10561 begin
5 10562 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10563 1 shift 12<*binær*> +1<*fortsæt*>);
5 10564 end
4 10565 else
4 10566 if s shift (-19) extract 1 = 1 then
4 10567 begin
5 10568 z(1):= real<:!<'nl'>:>;
5 10569 b:= 2;
5 10570 end
4 10571 else
4 10572 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10573 begin
5 10574 <*
5 10575 if b = 0 then
5 10576 begin
5 10577 *>
5 10578 z(1):= real <:<'em'>:>;
5 10579 b:= 2;
5 10580 <*
5 10581 end
5 10582 else
5 10583 begin
5 10584 tegn:= -1;
5 10585 iaf:= 0;
5 10586 pos:= b//2*3-2;
5 10587 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10588 skriv_tegn(z.iaf,pos,'?');
5 10589 if pos<=max then
5 10590 afslut_text(z.iaf,pos);
5 10591 b:= (pos-1)//3*2;
5 10592 end;
5 10593 *>
5 10594 end;<* s=1 shift 21+2 *>
4 10595 end;
3 10596 if testbit22 and
3 10597 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10598 then
3 10599 delay(60);
3 10600 end rad_in_fejl;
2 10601 \f
2 10601 message procedure afvent_radioinput side 1 - 880901/cl;
2 10602
2 10602 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10603 value rf;
2 10604 zone z_in;
2 10605 integer array tlgr;
2 10606 boolean rf;
2 10607 begin
3 10608 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10609 long array field laf;
3 10610
3 10610 laf:= 0;
3 10611 pos:= 1;
3 10612 repeat
3 10613 i:=readchar(z_in,tegn);
3 10614 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10615 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10616 p:=pos;
3 10617 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10618 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10619 (rf and testbit39)) then
3 10620 disable begin
4 10621 write(zrl,<<zd dd dd.dd >,now,
4 10622 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10623 if tegn='em' then <:*timeout*:> else
4 10624 if pos>=80 then <:*for langt*:> else <::>);
4 10625 outchar(zrl,'nl');
4 10626 end;
3 10627 <*-2*>
3 10628 ac:= -1;
3 10629 if pos >= 80 then
3 10630 begin <* telegram for langt *>
4 10631 repeat readchar(z_in,tegn)
4 10632 until tegn='nl' or tegn='em';
4 10633 end
3 10634 else
3 10635 if pos>1 and tegn='nl' then
3 10636 begin
4 10637 lgd:= 1;
4 10638 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10639 lgd:= lgd-2;
4 10640 if lgd >= 5 then
4 10641 begin
5 10642 lgd:= lgd-2; <* se bort fra checksum *>
5 10643 i:= lgd + 1;
5 10644 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10645 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10646 i:= lgd + 1;
5 10647 skrivtegn(tlgr,i,0);
5 10648 skrivtegn(tlgr,i,0);
5 10649 i:= 1; sum:= 0;
5 10650 while i <= lgd do
5 10651 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10652 if csum >= 0 and csum <> sum then
5 10653 begin
6 10654 <*+2*> if overvåget and (testbit36 or
6 10655 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10656 disable begin
7 10657 write(zrl,<<zd dd dd.dd >,now,
7 10658 (if rf then <:rf:> else <:fr:>),
7 10659 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10660 end;
6 10661 <*-2*>
6 10662 ac:= 6 <* checksumfejl *>
6 10663 end
5 10664 else
5 10665 ac:= 0;
5 10666 end
4 10667 else ac:= 6; <* for kort telegram - retransmitter *>
4 10668 end;
3 10669 afvent_radioinput:= ac;
3 10670 end;
2 10671 \f
2 10671 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10672
2 10672 procedure skriv_kanal_tab(z);
2 10673 zone z;
2 10674 begin
3 10675 integer array field ref;
3 10676 integer i,j,t,op,id1,id2;
3 10677
3 10677 write(z,"ff",1,"nl",1,<:
3 10678 ******** kanal-beskrivelser *******
3 10679
3 10679 a k l p m b n
3 10680 l a y a o s ø
3 10681 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10682 <*
3 10683 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10684 *>
3 10685 "nl",1);
3 10686 for i:=1 step 1 until max_antal_kanaler do
3 10687 begin
4 10688 ref:=(i-1)*kanal_beskr_længde;
4 10689 t:=kanal_tab.ref.kanal_tilstand;
4 10690 id1:=kanal_tab.ref.kanal_id1;
4 10691 id2:=kanal_tab.ref.kanal_id2;
4 10692 write(z,"nl",1,"sp",4,
4 10693 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10694 for j:=11 step -1 until 2 do
4 10695 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10696 write(z,case t extract 2 +1 of
4 10697 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10698 "sp",1);
4 10699 skriv_id(z,id1,9);
4 10700 skriv_id(z,id2,9);
4 10701 t:=kanal_tab.ref.kanal_spec;
4 10702 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10703 write(z,"nl",1,"sp",14,<:mon: :>);
4 10704 for j:= max_antal_taleveje step -1 until 1 do
4 10705 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10706 else "."),1);
4 10707 write(z,"sp",25-max_antal_taleveje);
4 10708 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10709 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10710 end;
3 10711 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10712 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10713 write(z,"nl",2);
3 10714 end skriv_kanal_tab;
2 10715 \f
2 10715 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10716
2 10716 procedure skriv_opkaldskø(z);
2 10717 zone z;
2 10718 begin
3 10719 integer i,bogst,løb,j;
3 10720 integer array field ref;
3 10721 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10722 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10723 <: sig omr :>,"nl",1);
3 10724 for i:= 1 step 1 until max_antal_mobilopkald do
3 10725 begin
4 10726 ref:= i*opkaldskø_postlængde;
4 10727 j:= opkaldskø.ref(1);
4 10728 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10729 j:= opkaldskø.ref(2);
4 10730 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10731 skriv_id(z,j extract 23,9);
4 10732 j:= opkaldskø.ref(3);
4 10733 skriv_id(z,j,7);
4 10734 j:= opkaldskø.ref(4);
4 10735 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10736 << zd>,j extract 8);
4 10737 j:= j shift (-8) extract 4;
4 10738 if j = 1 or j = 2 then
4 10739 write(z,if j=1 then <: normal:> else <: nød :>)
4 10740 else write(z,<<dddd>,j,"sp",3);
4 10741 j:= opkaldskø.ref(5);
4 10742 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10743 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10744 string område_navn(j extract 8) else <:---:>);
4 10745 outchar(z,'nl');
4 10746 end;
3 10747
3 10747 write(z,"nl",1,<<z>,
3 10748 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10749 <:første_opkald=:>,første_opkald,"nl",1,
3 10750 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10751 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10752 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10753 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10754 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10755 "nl",1,<:opkaldsflag::>,"nl",1);
3 10756 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10757 write(z,"nl",2);
3 10758 end skriv_opkaldskø;
2 10759 \f
2 10759 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10760
2 10760 procedure skriv_radio_linie_tabel(z);
2 10761 zone z;
2 10762 begin
3 10763 integer i,j,k;
3 10764
3 10764 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10765 k:= 0;
3 10766 for i:= 1 step 1 until max_linienr do
3 10767 begin
4 10768 læstegn(radio_linietabel,i+1,j);
4 10769 if j > 0 then
4 10770 begin
5 10771 k:= k +1;
5 10772 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10773 "nl",if k mod 5=0 then 1 else 0);
5 10774 end;
4 10775 end;
3 10776 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10777 end skriv_radio_linietabel;
2 10778
2 10778 procedure skriv_radio_områdetabel(z);
2 10779 zone z;
2 10780 begin
3 10781 integer i;
3 10782
3 10782 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10783 for i:= 1 step 1 until max_antal_områder do
3 10784 begin
4 10785 laf:= (i-1)*4;
4 10786 if radio_områdetabel(i)<>0 then
4 10787 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10788 radio_områdetabel(i),"nl",1);
4 10789 end;
3 10790 end skriv_radio_områdetabel;
2 10791 \f
2 10791 message procedure h_radio side 1 - 810520/hko;
2 10792
2 10792 <* hovedmodulkorutine for radiokanaler *>
2 10793 procedure h_radio;
2 10794 begin
3 10795 integer array field op_ref;
3 10796 integer k,dest_sem;
3 10797 procedure skriv_hradio(z,omfang);
3 10798 value omfang;
3 10799 zone z;
3 10800 integer omfang;
3 10801 begin integer i;
4 10802 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10803 write(z,"sp",26-i);
4 10804 if omfang >0 then
4 10805 disable begin integer x;
5 10806 trap(slut);
5 10807 write(z,"nl",1,
5 10808 <: op_ref: :>,op_ref,"nl",1,
5 10809 <: k: :>,k,"nl",1,
5 10810 <: dest_sem: :>,dest_sem,"nl",1,
5 10811 <::>);
5 10812 skriv_coru(z,coru_no(400));
5 10813 slut:
5 10814 end;
4 10815 end skriv_hradio;
3 10816
3 10816 trap(hrad_trap);
3 10817 stack_claim(if cm_test then 198 else 146);
3 10818
3 10818 <*+2*> if testbit32 and overvåget or testbit28 then
3 10819 skriv_hradio(out,0);
3 10820 <*-2*>
3 10821 \f
3 10821 message procedure h_radio side 2 - 820304/hko;
3 10822
3 10822 repeat
3 10823 wait_ch(cs_rad,op_ref,true,-1);
3 10824 <*+2*>if testbit33 and overvåget then
3 10825 disable begin
4 10826 skriv_h_radio(out,0);
4 10827 write(out,<: operation modtaget:>);
4 10828 skriv_op(out,op_ref);
4 10829 end;
3 10830 <*-2*>
3 10831 <*+4*>
3 10832 if (d.op_ref.optype and
3 10833 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10834 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10835 <*-4*>
3 10836
3 10836 k:=d.op_ref.op_kode extract 12;
3 10837 dest_sem:=
3 10838 if k > 0 and k < 7
3 10839 or k=11 or k=12 or k=19
3 10840 or (72<=k and k<=74) or k = 77
3 10841 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10842 then cs_radio_adm
3 10843 else if k=41 <* radiokommando fra operatør *>
3 10844 then cs_radio(d.opref.data(1)) else -1;
3 10845 <*+4*>
3 10846 if dest_sem<1 then
3 10847 begin
4 10848 if dest_sem<0 then
4 10849 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10850 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10851 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10852 end
3 10853 else
3 10854 <*-4*>
3 10855 begin <* operationskode ok *>
4 10856 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10857 end;
3 10858 until false;
3 10859
3 10859 hrad_trap:
3 10860 disable skriv_hradio(zbillede,1);
3 10861 end h_radio;
2 10862 \f
2 10862 message procedure radio side 1 - 820301/hko;
2 10863
2 10863 procedure radio(talevej,op);
2 10864 value talevej,op;
2 10865 integer talevej,op;
2 10866 begin
3 10867 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10868 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10869 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10870 integer array felt,værdi(1:8);
3 10871 boolean byt,nød,frigiv_samtale;
3 10872 real kl;
3 10873 real field rf;
3 10874
3 10874 procedure skriv_radio(z,omfang);
3 10875 value omfang;
3 10876 zone z;
3 10877 integer omfang;
3 10878 begin integer i1;
4 10879 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10880 write(z,"sp",26-i1);
4 10881 if omfang > 0 then
4 10882 disable begin real x;
5 10883 trap(slut);
5 10884 \f
5 10884 message procedure radio side 1a- 820301/hko;
5 10885
5 10885 write(z,"nl",1,
5 10886 <: op_ref: :>,op_ref,"nl",1,
5 10887 <: opref1: :>,opref1,"nl",1,
5 10888 <: iaf: :>,iaf,"nl",1,
5 10889 <: iaf1: :>,iaf1,"nl",1,
5 10890 <: vt-op: :>,vt_op,"nl",1,
5 10891 <: rad-op: :>,rad_op,"nl",1,
5 10892 <: rf: :>,rf,"nl",1,
5 10893 <: nr: :>,nr,"nl",1,
5 10894 <: i: :>,i,"nl",1,
5 10895 <: j: :>,j,"nl",1,
5 10896 <: k: :>,k,"nl",1,
5 10897 <: operatør: :>,operatør,"nl",1,
5 10898 <: tilst: :>,tilst,"nl",1,
5 10899 <: res: :>,res,"nl",1,
5 10900 <: opgave: :>,opgave,"nl",1,
5 10901 <: type: :>,type,"nl",1,
5 10902 <: bus: :>,bus,"nl",1,
5 10903 <: ll: :>,ll,"nl",1,
5 10904 <: ttmm: :>,ttmm,"nl",1,
5 10905 <: vogn: :>,vogn,"nl",1,
5 10906 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10907 <: vtop2: :>,vtop2,"nl",1,
5 10908 <: vtop3: :>,vtop3,"nl",1,
5 10909 <: sig: :>,sig,"nl",1,
5 10910 <: omr: :>,omr,"nl",1,
5 10911 <: garage: :>,garage,"nl",1,
5 10912 <<-dddddd'-dd>,
5 10913 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10914 <:samtaleflag: :>,"nl",1);
5 10915 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10916 skriv_coru(z,coru_no(410+talevej));
5 10917 slut:
5 10918 end;<*disable*>
4 10919 end skriv_radio;
3 10920 \f
3 10920 message procedure udtag_opkald side 1 - 820301/hko;
3 10921
3 10921 integer
3 10922 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10923 value vogn, operatør;
3 10924 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10925 begin
4 10926 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10927 integer array field vt_op,ref,næste,forrige;
4 10928 integer array field iaf1;
4 10929 boolean skal_ud;
4 10930
4 10930 boolean procedure skal_udskrives(fordelt,aktuel);
4 10931 value fordelt,aktuel;
4 10932 integer fordelt,aktuel;
4 10933 begin
5 10934 boolean skal;
5 10935 integer n;
5 10936 integer array field iaf;
5 10937
5 10937 skal:= true;
5 10938 if fordelt > 0 and fordelt<>aktuel then
5 10939 begin
6 10940 for n:= 0 step 1 until 3 do
6 10941 begin
7 10942 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10943 begin
8 10944 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10945 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10946 goto returner;
8 10947 end;
7 10948 end;
6 10949 end;
5 10950 returner:
5 10951 skal_udskrives:= skal;
5 10952 end;
4 10953
4 10953 l:= b:= tm:= t:= 0;
4 10954 garage:= sig:= 0;
4 10955 res:= -1;
4 10956 <*V*> wait(bs_opkaldskø_adgang);
4 10957 ref:= første_nødopkald;
4 10958 if ref <> 0 then
4 10959 t:= 2
4 10960 else
4 10961 begin
5 10962 ref:= første_opkald;
5 10963 t:= if ref = 0 then 0 else 1;
5 10964 end;
4 10965 if t = 0 then res:= +19 <*kø er tom*> else
4 10966 if vogn=0 and omr=0 then
4 10967 begin
5 10968 while ref <> 0 and res = -1 do
5 10969 begin
6 10970 nr:= opkaldskø.ref(4) extract 8;
6 10971 if nr>64 then
6 10972 begin
7 10973 <*opk. primærfordelt til gruppe af btj.pl.*>
7 10974 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 10975 while skal_ud and i<max_antal_operatører do
7 10976 begin
8 10977 i:=i+1;
8 10978 if læsbit_ia(bpl_def.iaf1,i) then
8 10979 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 10980 end;
7 10981 end
6 10982 else
6 10983 skal_ud:= skal_udskrives(nr,operatør);
6 10984
6 10984 if skal_ud then
6 10985 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 10986 *>
6 10987 res:= 0
6 10988 else
6 10989 begin
7 10990 ref:= opkaldskø.ref(1) extract 12;
7 10991 if ref = 0 and t = 2 then
7 10992 begin
8 10993 ref:= første_opkald;
8 10994 t:= if ref = 0 then 0 else 1;
8 10995 end else if ref = 0 then t:= 0;
7 10996 end;
6 10997 end; <*while*>
5 10998 \f
5 10998 message procedure udtag_opkald side 2 - 820304/hko;
5 10999
5 10999 if ref <> 0 then
5 11000 begin
6 11001 b:= opkaldskø.ref(2);
6 11002 <*+4*> if b < 0 then
6 11003 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 11004 <:nødopkald(besvaret/ej meldt):>,1);
6 11005 <*-4*>
6 11006 garage:=b shift(-14) extract 8;
6 11007 b:= b extract 14;
6 11008 l:= opkaldskø.ref(3);
6 11009 tm:= opkaldskø.ref(4);
6 11010 o:= tm extract 8;
6 11011 tm:= tm shift(-12);
6 11012 omr:= opkaldskø.ref(5) extract 8;
6 11013 sig:= opkaldskø.ref(5) shift (-20);
6 11014 end
5 11015 else res:=19; <* kø er tom *>
5 11016 end <*vogn=0 and omr=0 *>
4 11017 else
4 11018 begin
5 11019 <* vogn<>0 or omr<>0 *>
5 11020 i:= 0; tilst:= -1;
5 11021 if vogn shift(-22) = 1 then
5 11022 begin
6 11023 i:= find_busnr(vogn,nr,garage,tilst);
6 11024 l:= vogn;
6 11025 end
5 11026 else
5 11027 if vogn<>0 and (omr=0 or omr>2) then
5 11028 begin
6 11029 o:= 0;
6 11030 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 11031 if i=(-2) then
6 11032 begin
7 11033 o:= omr;
7 11034 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 11035 end;
6 11036 nr:= vogn extract 14;
6 11037 end
5 11038 else nr:= vogn extract 14;
5 11039 if i<0 then ref:= 0;
5 11040 while ref <> 0 and res = -1 do
5 11041 begin
6 11042 i:= opkaldskø.ref(2) extract 14;
6 11043 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 11044 if nr = i and
6 11045 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 11046 else
6 11047 begin
7 11048 ref:= opkaldskø.ref(1) extract 12;
7 11049 if ref = 0 and t = 2 then
7 11050 begin
8 11051 ref:= første_opkald;
8 11052 t:= if ref = 0 then 0 else 1;
8 11053 end else if ref = 0 then t:= 0;
7 11054 end;
6 11055 end; <*while*>
5 11056 \f
5 11056 message procedure udtag_opkald side 3 - 810603/hko;
5 11057
5 11057 if ref <> 0 then
5 11058 begin
6 11059 b:= nr;
6 11060 tm:= opkaldskø.ref(4);
6 11061 o:= tm extract 8;
6 11062 tm:= tm shift(-12);
6 11063 omr:= opkaldskø.ref(5) extract 4;
6 11064 sig:= opkaldskø.ref(5) shift (-20);
6 11065
6 11065 <*+4*> if tilst <> -1 then
6 11066 fejlreaktion(3<*prg.fejl*>,tilst,
6 11067 <:vogntabel_tilstand for vogn i kø:>,1);
6 11068 <*-4*>
6 11069 end;
5 11070 end;
4 11071
4 11071 if ref <> 0 then
4 11072 begin
5 11073 næste:= opkaldskø.ref(1);
5 11074 forrige:= næste shift(-12);
5 11075 næste:= næste extract 12;
5 11076 if forrige <> 0 then
5 11077 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 11078 + næste
5 11079 else if t = 1 then første_opkald:= næste
5 11080 else <*if t = 2 then*> første_nødopkald:= næste;
5 11081
5 11081 if næste <> 0 then
5 11082 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 11083 + forrige shift 12
5 11084 else if t = 1 then sidste_opkald:= forrige
5 11085 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 11086
5 11086 opkaldskø.ref(1):=første_frie_opkald;
5 11087 første_frie_opkald:=ref;
5 11088
5 11088 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 11089 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 11090 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 11091 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 11092 else
5 11093 begin
6 11094 sætbit_ia(opkaldsflag,operatør,1);
6 11095 sætbit_ia(opkaldsflag,o,1);
6 11096 end;
5 11097 signal_bin(bs_mobil_opkald);
5 11098 end;
4 11099 \f
4 11099 message procedure udtag_opkald side 4 - 810531/hko;
4 11100
4 11100 signal_bin(bs_opkaldskø_adgang);
4 11101 bus:= b;
4 11102 type:= t;
4 11103 ll:= l;
4 11104 ttmm:= tm;
4 11105 udtag_opkald:= res;
4 11106 end udtag opkald;
3 11107 \f
3 11107 message procedure frigiv_kanal side 1 - 810603/hko;
3 11108
3 11108 procedure frigiv_kanal(nr);
3 11109 value nr;
3 11110 integer nr;
3 11111 begin
4 11112 integer id1, id2, omr, i;
4 11113 integer array field iaf, vt_op;
4 11114
4 11114 iaf:= (nr-1)*kanal_beskrlængde;
4 11115 id1:= kanal_tab.iaf.kanal_id1;
4 11116 id2:= kanal_tab.iaf.kanal_id2;
4 11117 omr:= kanal_til_omr(nr);
4 11118 if id1 <> 0 then
4 11119 wait(ss_samtale_nedlagt(nr));
4 11120 if id1 shift (-22) < 3 and omr > 2 then
4 11121 begin
5 11122 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11123 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11124 if id1 shift (-22) = 2 then 18 else 17);
5 11125 d.vt_op.data(1):= id1;
5 11126 d.vt_op.data(4):= omr;
5 11127 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11128 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11129 signalch(cs_vt_adgang,vt_op,true);
5 11130 end;
4 11131
4 11131 if id2 <> 0 and id2 shift(-20) <> 12 then
4 11132 wait(ss_samtale_nedlagt(nr));
4 11133 if id2 shift (-22) < 3 and omr > 2 then
4 11134 begin
5 11135 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11136 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11137 if id2 shift (-22) = 2 then 18 else 17);
5 11138 d.vt_op.data(1):= id2;
5 11139 d.vt_op.data(4):= omr;
5 11140 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11141 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11142 signalch(cs_vt_adgang,vt_op,true);
5 11143 end;
4 11144
4 11144 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 11145 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 11146 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 11147 shift (-10) extract 6 shift 10;
4 11148 <* repeat
4 11149 inspect(ss_samtale_nedlagt(nr),i);
4 11150 if i>0 then wait(ss_samtale_nedlagt(nr));
4 11151 until i<=0;
4 11152 *>
4 11153 end frigiv_kanal;
3 11154 \f
3 11154 message procedure hookoff side 1 - 880901/cl;
3 11155
3 11155 integer procedure hookoff(talevej,op,retursem,flash);
3 11156 value talevej,op,retursem,flash;
3 11157 integer talevej,op,retursem;
3 11158 boolean flash;
3 11159 begin
4 11160 integer array field opref;
4 11161
4 11161 opref:= op;
4 11162 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 11163 d.opref.data(1):= talevej;
4 11164 d.opref.data(2):= if flash then 2 else 1;
4 11165 signalch(cs_radio_ud,opref,rad_optype);
4 11166 <*V*> waitch(retursem,opref,rad_optype,-1);
4 11167 hookoff:= d.opref.resultat;
4 11168 end;
3 11169 \f
3 11169 message procedure hookon side 1 - 880901/cl;
3 11170
3 11170 integer procedure hookon(talevej,op,retursem);
3 11171 value talevej,op,retursem;
3 11172 integer talevej,op,retursem;
3 11173 begin
4 11174 integer i,res;
4 11175 integer array field opref;
4 11176
4 11176 if læsbit_ia(hookoff_maske,talevej) then
4 11177 begin
5 11178 inspect(bs_talevej_udkoblet(talevej),i);
5 11179 if i<=0 then
5 11180 begin
6 11181 opref:= op;
6 11182 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 11183 d.opref.data(1):= talevej;
6 11184 signalch(cs_radio_ud,opref,rad_optype);
6 11185 <*V*> waitch(retursem,opref,rad_optype,-1);
6 11186 res:= d.opref.resultat;
6 11187 end
5 11188 else
5 11189 res:= 0;
5 11190
5 11190 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 11191 end
4 11192 else
4 11193 res:= 0;
4 11194
4 11194 sætbit_ia(hookoff_maske,talevej,0);
4 11195 hookon:= res;
4 11196 end;
3 11197 \f
3 11197 message procedure radio side 2 - 820304/hko;
3 11198
3 11198 rad_op:= op;
3 11199
3 11199 trap(radio_trap);
3 11200 stack_claim((if cm_test then 200 else 150) +200);
3 11201
3 11201 <*+2*>if testbit32 and overvåget or testbit28 then
3 11202 skriv_radio(out,0);
3 11203 <*-2*>
3 11204 repeat
3 11205 waitch(cs_radio(talevej),opref,true,-1);
3 11206 <*+2*>
3 11207 if testbit33 and overvåget then
3 11208 disable begin
4 11209 skriv_radio(out,0);
4 11210 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 11211 skriv_op(out,opref);
4 11212 end;
3 11213 <*-2*>
3 11214
3 11214 k:= d.op_ref.opkode extract 12;
3 11215 opgave:= d.opref.opkode shift (-12);
3 11216 operatør:= d.op_ref.data(4);
3 11217
3 11217 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 11218 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 11219 <:radio:>,0);
3 11220 <*-4*>
3 11221 \f
3 11221 message procedure radio side 3 - 880930/cl;
3 11222 if k=41 <*radiokommando fra operatør*> then
3 11223 begin
4 11224 vogn:= d.opref.data(2);
4 11225 res:= -1;
4 11226 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 11227 sig:= 0; omr:= d.opref.data(3) extract 8;
4 11228 bus:= garage:= ll:= 0;
4 11229
4 11229 if opgave=1 or opgave=9 then
4 11230 begin <* opkald til enkelt vogn (CHF) *>
5 11231 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 11232 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 11233 <* ok at kø er tom når vogn er angivet eller VHF *>
5 11234
5 11234 d.opref.data(11):= if res=0 then
5 11235 (if ll<>0 then ll else bus) else vogn;
5 11236
5 11236 if type=2 <*nød*> then
5 11237 begin
6 11238 waitch(cs_radio_pulje,opref1,true,-1);
6 11239 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 11240 d.opref1.data(1):= if ll<>0 then ll else bus;
6 11241 systime(5,0,kl);
6 11242 d.opref1.data(2):= entier(kl/100.0);
6 11243 d.opref1.data(3):= omr;
6 11244 signalch(cs_io,opref1,gen_optype or rad_optype);
6 11245 end
5 11246 end; <* enkeltvogn (CHF) *>
4 11247
4 11247 <* check enkeltvogn for ledig *>
4 11248 if res<=0 and omr=2<*VHF*> and bus=0 and
4 11249 (opgave=1 or opgave=9) then
4 11250 begin
5 11251 for i:= 1 step 1 until max_antal_kanaler do
5 11252 if kanal_til_omr(i)=2 then nr:= i;
5 11253 iaf:= (nr-1)*kanalbeskrlængde;
5 11254 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 11255 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 11256 then res:= 52;
5 11257 end;
4 11258 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 11259 d.opref.data(3)=0 <*std. omr*>) and
4 11260 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 11261 then
4 11262 begin
5 11263 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 11264 if vogn shift (-22) = 1 then
5 11265 begin
6 11266 find_busnr(vogn,bus,garage,res);
6 11267 ll:= vogn;
6 11268 end
5 11269 else
5 11270 if vogn shift (-22) = 0 then
5 11271 begin
6 11272 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 11273 bus:= vogn;
6 11274 end
5 11275 else
5 11276 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 11277 res:= if res=(-1) then 18 <* i kø *> else
5 11278 (if res<>0 then 14 <*opt*> else 0);
5 11279 end
4 11280 else
4 11281 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 11282 opgave <= 2 then
4 11283 begin
5 11284 bus:= vogn; garage:= type:= ttmm:= 0;
5 11285 res:= 0; omr:= 0; sig:= 0;
5 11286 end
4 11287 else
4 11288 if opgave>1 and opgave<>9 then
4 11289 type:= ttmm:= res:= 0;
4 11290 \f
4 11290 message procedure radio side 4 - 880930/cl;
4 11291
4 11291 if res=0 and (opgave<=4 or opgave=9) and
4 11292 (omr<1 or 2<omr) and
4 11293 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 11294 begin <* reserver i vogntabel *>
5 11295 waitch(cs_vt_adgang,vt_op,true,-1);
5 11296 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11297 if opgave <=2 or opgave=9 then 15 else 16);
5 11298 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 11299 (if vogn=0 then garage shift 14 + bus else
5 11300 if ll<>0 then ll else garage shift 14 + bus)
5 11301 else vogn <*gruppeid*>;
5 11302 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 11303 d.opref.data(3) extract 8
5 11304 else omr extract 8;
5 11305 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 11306 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 11307
5 11307 res:= d.vt_op.resultat;
5 11308 if res=3 then res:= 0;
5 11309 vtop2:= d.vt_op.data(2);
5 11310 vtop3:= d.vt_op.data(3);
5 11311 tekn_inf:= d.vt_op.data(4);
5 11312 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 11313 end;
4 11314
4 11314 if res<>0 then
4 11315 begin
5 11316 d.opref.resultat:= res;
5 11317 signalch(d.opref.retur,opref,d.opref.optype);
5 11318 end
4 11319 else
4 11320
4 11320 if opgave <= 9 then
4 11321 begin <* opkald *>
5 11322 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 11323 opgave<>9 and d.opref.data(6)<>0);
5 11324
5 11324 if res<>0 then
5 11325 goto returner_op;
5 11326
5 11326 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 11327 begin
6 11328 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 11329 'H' shift 12 + 60);
6 11330 d.rad_op.data(1):= talevej;
6 11331 d.rad_op.data(2):= 'D';
6 11332 d.rad_op.data(3):= 6; <* rear *>
6 11333 d.rad_op.data(4):= 1; <* rear no *>
6 11334 d.rad_op.data(5):= 0; <* disconnect *>
6 11335 signalch(cs_radio_ud,rad_op,rad_optype);
6 11336 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 11337 if d.rad_op.resultat<>0 then
6 11338 begin
7 11339 res:= d.rad_op.resultat;
7 11340 goto returner_op;
7 11341 end;
6 11342 <*
6 11343 while optaget_flag shift (-1) <> 0 do
6 11344 delay(1);
6 11345 *>
6 11346 end;
5 11347 \f
5 11347 message procedure radio side 5 - 880930/cl;
5 11348
5 11348 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 11349 'B' shift 12 + 60);
5 11350 d.rad_op.data(1):= talevej;
5 11351 d.rad_op.data(2):= 'D';
5 11352 d.rad_op.data(3):= if opgave=9 then 3 else
5 11353 (2 - (opgave extract 1)); <* højttalerkode *>
5 11354
5 11354 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11355 begin
6 11356 j:= 0;
6 11357 for i:= 2 step 1 until max_antal_områder do
6 11358 begin
7 11359 if opgave > 6 or
7 11360 (d.opref.data(3) shift (-20) = 15 and
7 11361 læsbiti(d.opref.data(3),i)) or
7 11362 (d.opref.data(3) shift (-20) = 14 and
7 11363 d.opref.data(3) extract 20 = i)
7 11364 then
7 11365 begin
8 11366 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11367 begin
9 11368 j:= j+1;
9 11369 d.rad_op.data(10+(j-1)*2):=
9 11370 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11371 (if i=2<*VHF*> then 4 else k)
9 11372 shift 8 + <* signal type *>
9 11373 1; <* antal tno *>
9 11374 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11375 end;
8 11376 end;
7 11377 end;
6 11378 d.rad_op.data(4):= j;
6 11379 d.rad_op.data(5):= 0;
6 11380 end
5 11381 else
5 11382 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11383 begin
6 11384 d.rad_op.data(4):= vtop2;
6 11385 d.rad_op.data(5):= vtop3;
6 11386 end
5 11387 else
5 11388 begin <* enkeltvogn *>
6 11389 if omr=0 then
6 11390 begin
7 11391 sig:= tekn_inf shift (-23);
7 11392 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11393 else tekn_inf extract 8;
7 11394 end
6 11395 else
6 11396 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11397
6 11397 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11398 <* tvinges til alm. opkald *>
6 11399 if (opgave=9) and (type=2) and (omr<=3) then
6 11400 begin
7 11401 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11402 opgave:= 1;
7 11403 d.radop.data(3):= 1;
7 11404 end;
6 11405
6 11405 if omr=2 <*VHF*> then sig:= 4 else
6 11406 if omr=1 <*TLF*> then sig:= 7 else
6 11407 <*UHF*> sig:= sig+1;
6 11408 d.rad_op.data(4):= 1;
6 11409 d.rad_op.data(5):= 0;
6 11410 d.rad_op.data(10):=
6 11411 (område_id(omr,2) extract 12) shift 12 +
6 11412 sig shift 8 +
6 11413 1;
6 11414 d.rad_op.data(11):= bus;
6 11415 end;
5 11416 \f
5 11416 message procedure radio side 6 - 880930/cl;
5 11417
5 11417 signalch(cs_radio_ud,rad_op,rad_optype);
5 11418 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11419 res:= d.rad_op.resultat;
5 11420
5 11420 d.rad_op.data(6):= 0;
5 11421 for i:= 1 step 1 until max_antal_områder do
5 11422 if læsbiti(d.rad_op.data(7),i) then
5 11423 increase(d.rad_op.data(6));
5 11424 returner_op:
5 11425 if d.rad_op.data(6)=1 then
5 11426 begin
6 11427 for i:= 1 step 1 until max_antal_områder do
6 11428 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11429 d.opref.data(12):= 14 shift 20 + i;
6 11430 end
5 11431 else
5 11432 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11433 d.opref.data(7):= type;
5 11434 d.opref.data(8):= garage shift 14 + bus;
5 11435 d.opref.data(9):= ll;
5 11436 if res=0 then
5 11437 begin
6 11438 d.opref.resultat:= 3;
6 11439 d.opref.data(5):= d.opref.data(6);
6 11440 j:= 0;
6 11441 for i:= 1 step 1 until max_antal_kanaler do
6 11442 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11443 if j>1 then
6 11444 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11445 else
6 11446 begin
7 11447 j:= 0;
7 11448 for i:= 1 step 1 until max_antal_kanaler do
7 11449 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11450 d.opref.data(6):= 3 shift 22 + j;
7 11451 end;
6 11452 d.opref.data(7):= type;
6 11453 d.opref.data(8):= garage shift 14 + bus;
6 11454 d.opref.data(9):= ll;
6 11455 d.opref.data(10):= d.opref.data(6);
6 11456 for i:= 1 step 1 until max_antal_kanaler do
6 11457 begin
7 11458 if læsbiti(d.rad_op.data(9),i) then
7 11459 begin
8 11460 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11461 j:= pabx_id( kanal_id(i) extract 5 )
8 11462 else
8 11463 j:= radio_id( kanal_id(i) extract 5 );
8 11464 if j>0 and type=0 and operatør>0 then tæl_opkald(j,1);
8 11465
8 11465 iaf:= (i-1)*kanalbeskrlængde;
8 11466 skrivtegn(kanal_tab.iaf,1,talevej);
8 11467 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11468 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11469 kanal_tab.iaf.kanal_id1:=
8 11470 if opgave<=2 or opgave=9 then
8 11471 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11472 else
8 11473 d.opref.data(2);
8 11474 kanal_tab.iaf.kanal_alt_id1:=
8 11475 if opgave<=2 or opgave=9 then
8 11476 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11477 else
8 11478 0;
8 11479 if kanal_tab.iaf.kanal_id1=0 then
8 11480 kanal_tab.iaf.kanal_id1:= 10000;
8 11481 kanal_tab.iaf.kanal_spec:=
8 11482 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11483 end;
7 11484 end;
6 11485 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11486 sætbit_ia(kanalflag,operatør,1);
6 11487 \f
6 11487 message procedure radio side 7 - 880930/cl;
6 11488
6 11488 end
5 11489 else
5 11490 begin
6 11491 d.opref.resultat:= res;
6 11492 if res=20 or res=52 then
6 11493 begin <* tæl ej.forb og opt.kanal *>
7 11494 for i:= 1 step 1 until max_antal_områder do
7 11495 if læsbiti(d.rad_op.data(7),i) then
7 11496 tæl_opkald(i,(if res=20 then 4 else 5));
7 11497 end;
6 11498 if d.opref.data(6)=0 then
6 11499 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11500 <* frigiv fra vogntabel hvis reserveret *>
6 11501 if (opgave<=4 or opgave=9) and
6 11502 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11503 begin
7 11504 waitch(cs_vt_adgang,vt_op,true,-1);
7 11505 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11506 if opgave<=2 or opgave=9 then 17 else 18);
7 11507 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11508 (if vogn=0 then garage shift 14 + bus else
7 11509 if ll<>0 then ll else garage shift 14 + bus)
7 11510 else vogn;
7 11511 d.vt_op.data(4):= omr;
7 11512 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11513 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11514 signalch(cs_vt_adgang,vt_op,true);
7 11515 end;
6 11516 end;
5 11517 signalch(d.opref.retur,opref,d.opref.optype);
5 11518 \f
5 11518 message procedure radio side 8 - 880930/cl;
5 11519
5 11519 end <* opkald *>
4 11520 else
4 11521 if opgave = 10 <* MONITER *> then
4 11522 begin
5 11523 nr:= d.opref.data(2);
5 11524 if nr shift (-20) <> 12 then
5 11525 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11526 nr:= nr extract 20;
5 11527 iaf:= (nr-1)*kanalbeskrlængde;
5 11528 inspect(ss_samtale_nedlagt(nr),i);
5 11529 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11530 kanal_tab.iaf.kanal_id2 extract 20
5 11531 else
5 11532 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11533 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11534 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11535 (i<>0 or j<>0) then
5 11536 begin
6 11537 res:= 0;
6 11538 d.opref.data(5):= 12 shift 20 + k;
6 11539 d.opref.data(6):= 12 shift 20 + nr;
6 11540 sætbit_ia(kanalflag,operatør,1);
6 11541 goto radio_nedlæg;
6 11542 end
5 11543 else
5 11544 if i<>0 or j<>0 then
5 11545 res:= 49
5 11546 else
5 11547 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11548 res:= 49 <* ingen samtale igang *>
5 11549 else
5 11550 begin
6 11551 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11552 if res=0 then
6 11553 begin
7 11554 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11555 'B' shift 12 + 60);
7 11556 d.rad_op.data(1):= talevej;
7 11557 d.rad_op.data(2):= 'V';
7 11558 d.rad_op.data(3):= 0;
7 11559 d.rad_op.data(4):= 1;
7 11560 d.rad_op.data(5):= 0;
7 11561 d.rad_op.data(10):=
7 11562 (kanal_id(nr) shift (-5) shift 18) +
7 11563 (kanal_id(nr) extract 5 shift 12) + 0;
7 11564 signalch(cs_radio_ud,rad_op,rad_optype);
7 11565 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11566 res:= d.rad_op.resultat;
7 11567 if res=0 then
7 11568 begin
8 11569 d.opref.data(5):= 0;
8 11570 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11571 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11572 res:= 3;
8 11573 end;
7 11574 end;
6 11575 end;
5 11576 \f
5 11576 message procedure radio side 9 - 880930/cl;
5 11577 if res=3 then
5 11578 begin
6 11579 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11580 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11581 else
6 11582 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11583 d.opref.data(6):= 12 shift 20 + nr;
6 11584 i:= kanal_tab.iaf.kanal_id2;
6 11585 if i<>0 then
6 11586 begin
7 11587 if i shift (-20) = 12 then
7 11588 begin <* ident2 henviser til anden kanal *>
8 11589 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11590 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11591 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11592 else
8 11593 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11594 d.opref.data(5):= 12 shift 20 + i;
8 11595 end
7 11596 else
7 11597 d.opref.data(5):= 12 shift 20 + nr;
7 11598 end
6 11599 else
6 11600 d.opref.data(5):= 0;
6 11601 end;
5 11602
5 11602 if res<>3 then
5 11603 begin
6 11604 res:= 0;
6 11605 sætbit_ia(kanalflag,operatør,1);
6 11606 goto radio_nedlæg;
6 11607 end;
5 11608 d.opref.resultat:= res;
5 11609 signalch(d.opref.retur,opref,d.opref.optype);
5 11610 \f
5 11610 message procedure radio side 10 - 880930/cl;
5 11611
5 11611 end <* MONITERING *>
4 11612 else
4 11613 if opgave = 11 then <* GENNEMSTILLING *>
4 11614 begin
5 11615 nr:= d.opref.data(6) extract 20;
5 11616 k:= if d.opref.data(5) shift (-20) = 12 then
5 11617 d.opref.data(5) extract 20
5 11618 else
5 11619 0;
5 11620 inspect(ss_samtale_nedlagt(nr),i);
5 11621 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11622 if i<>0 and j<>0 then
5 11623 begin
6 11624 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11625 goto radio_nedlæg;
6 11626 end;
5 11627
5 11627 iaf:= (nr-1)*kanal_beskr_længde;
5 11628 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11629 begin
6 11630 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11631 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11632 then
6 11633 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11634 else
6 11635 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11636 d.opref.data(5)<>0
6 11637 then
6 11638 res:= 0
6 11639 else
6 11640 res:= 21; <* ingen at gennemstille til *>
6 11641 end
5 11642 else
5 11643 res:= 50; <* kanalnr *>
5 11644
5 11644 if res=0 then
5 11645 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11646 if res=0 then
5 11647 begin
6 11648 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11649 kanal_tab.iaf.kanal_tilstand:=
6 11650 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11651 d.opref.data(6):= 0;
6 11652 if kanal_tab.iaf.kanal_id2=0 then
6 11653 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11654
6 11654 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11655 begin <* gennemstillet til anden kanal *>
7 11656 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11657 *kanalbeskrlængde;
7 11658 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11659 kanal_tab.iaf1.kanal_tilstand:=
7 11660 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11661 if kanal_tab.iaf1.kanal_id2=0 then
7 11662 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11663 end;
6 11664 d.opref.data(5):= 0;
6 11665
6 11665 res:= 3;
6 11666 end;
5 11667
5 11667 d.opref.resultat:= res;
5 11668 signalch(d.opref.retur,opref,d.opref.optype);
5 11669 \f
5 11669 message procedure radio side 11 - 880930/cl;
5 11670
5 11670 end
4 11671 else
4 11672 if opgave = 12 then <* NEDLÆG *>
4 11673 begin
5 11674 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11675 radio_nedlæg:
5 11676 if res=0 then
5 11677 begin
6 11678 for k:= 5, 6 do
6 11679 begin
7 11680 if d.opref.data(k) shift (-20) = 12 then
7 11681 begin
8 11682 i:= d.opref.data(k) extract 20;
8 11683 iaf:= (i-1)*kanalbeskrlængde;
8 11684 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11685 frigiv_kanal(d.opref.data(k) extract 20)
8 11686 else
8 11687 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11688 end
7 11689 else
7 11690 if d.opref.data(k) shift (-20) = 13 then
7 11691 begin
8 11692 for i:= 1 step 1 until max_antal_kanaler do
8 11693 if læsbiti(d.opref.data(k),i) then
8 11694 begin
9 11695 iaf:= (i-1)*kanalbeskrlængde;
9 11696 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11697 frigiv_kanal(i)
9 11698 else
9 11699 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11700 end;
8 11701 sætbit_ia(kanalflag,operatør,1);
8 11702 end;
7 11703 end;
6 11704 d.opref.data(5):= 0;
6 11705 d.opref.data(6):= 0;
6 11706 d.opref.data(9):= 0;
6 11707 res:= if opgave=12 then 3 else 49;
6 11708 end;
5 11709 d.opref.resultat:= res;
5 11710 signalch(d.opref.retur,opref,d.opref.optype);
5 11711 end
4 11712 else
4 11713 if opgave=13 then <* R *>
4 11714 begin
5 11715 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11716 'H' shift 12 + 60);
5 11717 d.rad_op.data(1):= talevej;
5 11718 d.rad_op.data(2):= 'M';
5 11719 d.rad_op.data(3):= 0; <*tkt*>
5 11720 d.rad_op.data(4):= 0; <*tkn*>
5 11721 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11722 signalch(cs_radio_ud,rad_op,rad_optype);
5 11723 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11724 res:= d.rad_op.resultat;
5 11725 d.opref.resultat:= if res=0 then 3 else res;
5 11726 signalch(d.opref.retur,opref,d.opref.optype);
5 11727 end
4 11728 else
4 11729 if opgave=14 <* VENTEPOS *> then
4 11730 begin
5 11731 res:= 0;
5 11732 while (res<=3 and d.opref.data(2)>0) do
5 11733 begin
6 11734 nr:= d.opref.data(6) extract 20;
6 11735 k:= if d.opref.data(5) shift (-20) = 12 then
6 11736 d.opref.data(5) extract 20
6 11737 else
6 11738 0;
6 11739 inspect(ss_samtale_nedlagt(nr),i);
6 11740 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11741 if i<>0 or j<>0 then
6 11742 begin
7 11743 res:= hookon(talevej,radop,cs_radio(talevej));
7 11744 goto radio_nedlæg;
7 11745 end;
6 11746
6 11746 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11747
6 11747 if res=0 then
6 11748 begin
7 11749 i:= d.opref.data(5);
7 11750 d.opref.data(5):= d.opref.data(6);
7 11751 d.opref.data(6):= i;
7 11752 res:= 3;
7 11753 end;
6 11754
6 11754 d.opref.data(2):= d.opref.data(2)-1;
6 11755 end;
5 11756 d.opref.resultat:= res;
5 11757 signalch(d.opref.retur,opref,d.opref.optype);
5 11758 end
4 11759 else
4 11760 begin
5 11761 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11762 d.opref.resultat:= 31;
5 11763 signalch(d.opref.retur,opref,d.opref.optype);
5 11764 end;
4 11765
4 11765 end <* radiokommando fra operatør *>
3 11766 else
3 11767 begin
4 11768
4 11768 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11769
4 11769 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11770
4 11770 end;
3 11771
3 11771 until false;
3 11772 radio_trap:
3 11773 disable skriv_radio(zbillede,1);
3 11774 end radio;
2 11775 \f
2 11775 message procedure radio_ind side 1 - 810521/hko;
2 11776
2 11776 procedure radio_ind(op);
2 11777 value op;
2 11778 integer op;
2 11779 begin
3 11780 integer array field op_ref,ref,io_opref;
3 11781 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11782 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11783 integer array typ, val(1:6), answ, tlgr(1:32);
3 11784 integer array field spec;
3 11785 real field rf;
3 11786 long array field laf;
3 11787
3 11787 procedure skriv_radio_ind(zud,omfang);
3 11788 value omfang;
3 11789 zone zud;
3 11790 integer omfang;
3 11791 begin integer ii;
4 11792 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11793 if omfang > 0 then
4 11794 disable begin integer x; long array field tx;
5 11795 tx:= 0;
5 11796 trap(slut);
5 11797 write(zud,"nl",1,
5 11798 <: op-ref: :>,op_ref,"nl",1,
5 11799 <: ref: :>,ref,"nl",1,
5 11800 <: io-opref: :>,io_opref,"nl",1,
5 11801 <: ac: :>,ac,"nl",1,
5 11802 <: lgd: :>,lgd,"nl",1,
5 11803 <: ttyp: :>,ttyp,"nl",1,
5 11804 <: ptyp: :>,ptyp,"nl",1,
5 11805 <: pnum: :>,pnum,"nl",1,
5 11806 <: pos: :>,pos,"nl",1,
5 11807 <: tegn: :>,tegn,"nl",1,
5 11808 <: bs: :>,bs,"nl",1,
5 11809 <: b-pt: :>,b_pt,"nl",1,
5 11810 <: b-pn: :>,b_pn,"nl",1,
5 11811 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11812 <: antal-spec: :>,antal_spec,"nl",1,
5 11813 <: sum: :>,sum,"nl",1,
5 11814 <: csum: :>,csum,"nl",1,
5 11815 <: i: :>,i,"nl",1,
5 11816 <: j: :>,j,"nl",1,
5 11817 <: k: :>,k,"nl",1,
5 11818 <: filref :>,filref,"nl",1,
5 11819 <: zno: :>,zno,"nl",1,
5 11820 <: answ: :>,answ.tx,"nl",1,
5 11821 <: tlgr: :>,tlgr.tx,"nl",1,
5 11822 <: spec: :>,spec,"nl",1);
5 11823 trap(slut);
5 11824 slut:
5 11825 end; <*disable*>
4 11826 end skriv_radio_ind;
3 11827 \f
3 11827 message procedure indsæt_opkald side 1 - 811105/hko;
3 11828
3 11828 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11829 value bus,type,omr,sig;
3 11830 integer bus,type,omr,sig;
3 11831 begin
4 11832 integer res,tilst,ll,operatør;
4 11833 integer array field vt_op,ref,næste,forrige;
4 11834 real r;
4 11835
4 11835 res:= -1;
4 11836 begin
5 11837 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11838 if vt_op <> 0 then
5 11839 begin
6 11840 wait(bs_opkaldskø_adgang);
6 11841 if omr>2 then
6 11842 begin
7 11843 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11844 d.vt_op.data(1):= bus;
7 11845 d.vt_op.data(4):= omr;
7 11846 tilst:= vt_op;
7 11847 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11848 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11849 <*+4*> if tilst <> vt_op then
7 11850 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11851 <*-4*>
7 11852 <*+2*> if testbit34 and overvåget then
7 11853 disable begin
8 11854 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11855 skriv_op(out,vt_op);
8 11856 ud;
8 11857 end;
7 11858 end
6 11859 else
6 11860 begin
7 11861 d.vt_op.data(1):= bus;
7 11862 d.vt_op.data(2):= 0;
7 11863 d.vt_op.data(3):= bus;
7 11864 d.vt_op.data(4):= omr;
7 11865 d.vt_op.resultat:= 0;
7 11866 ref:= første_nødopkald;
7 11867 if ref<>0 then tilst:= 2
7 11868 else
7 11869 begin
8 11870 ref:= første_opkald;
8 11871 tilst:= if ref=0 then 0 else 1;
8 11872 end;
7 11873 if tilst=0 then
7 11874 d.vt_op.resultat:= 3
7 11875 else
7 11876 begin
8 11877 while ref<>0 and d.vt_op.resultat=0 do
8 11878 begin
9 11879 if opkaldskø.ref(2) extract 14 = bus and
9 11880 opkaldskø.ref(5) extract 8 = omr
9 11881 then
9 11882 d.vt_op.resultat:= 18
9 11883 else
9 11884 begin
10 11885 ref:= opkaldskø.ref(1) extract 12;
10 11886 if ref=0 and tilst=2 then
10 11887 begin
11 11888 ref:= første_opkald;
11 11889 tilst:= if ref=0 then 0 else 1;
11 11890 end
10 11891 else
10 11892 if ref=0 then tilst:= 0;
10 11893 end;
9 11894 end;
8 11895 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11896 end;
7 11897 end;
6 11898 <*-2*>
6 11899 \f
6 11899 message procedure indsæt_opkald side 1a- 820301/hko;
6 11900
6 11900 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11901 begin
7 11902 ref:=første_opkald;
7 11903 tilst:=-1;
7 11904 while ref<>0 and tilst=-1 do
7 11905 begin
8 11906 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11907 begin <* udtag normalopkald *>
9 11908 næste:=opkaldskø.ref(1);
9 11909 forrige:=næste shift(-12);
9 11910 næste:=næste extract 12;
9 11911 if forrige<>0 then
9 11912 opkaldskø.forrige(1):=
9 11913 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11914 else
9 11915 første_opkald:=næste;
9 11916 if næste<>0 then
9 11917 opkaldskø.næste(1):=
9 11918 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11919 else
9 11920 sidste_opkald:=forrige;
9 11921 opkaldskø.ref(1):=første_frie_opkald;
9 11922 første_frie_opkald:=ref;
9 11923 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11924 tilst:=0;
9 11925 end
8 11926 else
8 11927 ref:=opkaldskø.ref(1) extract 12;
8 11928 end; <*while*>
7 11929 if tilst=0 then
7 11930 d.vt_op.resultat:=3;
7 11931 end; <*nødopkald bus i kø*>
6 11932 \f
6 11932 message procedure indsæt_opkald side 2 - 820304/hko;
6 11933
6 11933 if d.vt_op.resultat = 3 then
6 11934 begin
7 11935 ll:= d.vt_op.data(2);
7 11936 tilst:= d.vt_op.data(3);
7 11937 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11938 if operatør < 0 or max_antal_operatører < operatør then
7 11939 operatør:= 0;
7 11940 if operatør=0 then
7 11941 operatør:= (tilst shift (-14) extract 8);
7 11942 if operatør=0 then
7 11943 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11944 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11945 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11946 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11947 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11948 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11949 forrige:= (if type = 1 then sidste_opkald
7 11950 else sidste_nødopkald);
7 11951 opkaldskø.ref(1):= forrige shift 12;
7 11952 if type = 1 then
7 11953 begin
8 11954 if første_opkald = 0 then første_opkald:= ref;
8 11955 sidste_opkald:= ref;
8 11956 end
7 11957 else
7 11958 begin <*type = 2*>
8 11959 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11960 sidste_nødopkald:= ref;
8 11961 end;
7 11962 if forrige <> 0 then
7 11963 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11964 shift 12 +ref;
7 11965
7 11965 opkaldskø.ref(2):= tilst extract 22 add
7 11966 (if type=2 then 1 shift 23 else 0);
7 11967 opkaldskø.ref(3):= ll;
7 11968 systime(5,0.0,r);
7 11969 ll:= round r//100;<*ttmm*>
7 11970 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 11971 opkaldskø.ref(5):= sig shift 20 + omr;
7 11972 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 11973 res:= 0;
7 11974 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 11975 opkaldskø_ledige:= opkaldskø_ledige -1;
7 11976 <*meddel opkald til berørte operatører *>
7 11977 signal_bin(bs_mobil_opkald);
7 11978 tæl_opkald(omr,type+1);
7 11979 end <* resultat = 3 *>
6 11980 else
6 11981 begin
7 11982 \f
7 11982 message procedure indsæt_opkald side 3 - 810601/hko;
7 11983
7 11983 <* d.vt_op.resultat <> 3 *>
7 11984
7 11984 res:= d.vt_op.resultat;
7 11985 if res = 10 then
7 11986 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 11987 <:er ikke i bustabel:>,1)
7 11988 else
7 11989 <*+4*> if res <> 14 and res <> 18 then
7 11990 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 11991 <*-4*>
7 11992 ;
7 11993 end;
6 11994 signalbin(bs_opkaldskø_adgang);
6 11995 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 11996 end
5 11997 else
5 11998 res:= -2; <*timeout for cs_vt_adgang*>
5 11999 end;
4 12000 indsæt_opkald:= res;
4 12001 end indsæt_opkald;
3 12002 \f
3 12002 message procedure afvent_telegram side 1 - 880901/cl;
3 12003
3 12003 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12004 integer array tlgr;
3 12005 integer lgd,ttyp,ptyp,pnum;
3 12006 begin
4 12007 integer i, pos, tegn, ac, sum, csum;
4 12008
4 12008 pos:= 1;
4 12009 lgd:= 0;
4 12010 ttyp:= 'Z';
4 12011 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 12012 if ac >= 0 then
4 12013 begin
5 12014 lgd:= 1;
5 12015 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 12016 lgd:= lgd-2;
5 12017 if lgd >= 3 then
5 12018 begin
6 12019 i:= 1;
6 12020 ttyp:= læstegn(tlgr,i,tegn);
6 12021 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 12022 pnum:= læstegn(tlgr,i,tegn) - '@';
6 12023 end
5 12024 else ac:= 6; <* for kort telegram - retransmitter *>
5 12025 end;
4 12026
4 12026 afvent_telegram:= ac;
4 12027 end;
3 12028 \f
3 12028 message procedure b_answ side 1 - 880901/cl;
3 12029
3 12029 procedure b_answ(answ,ht,spec,more,ac);
3 12030 value ht, more,ac;
3 12031 integer array answ, spec;
3 12032 boolean more;
3 12033 integer ht, ac;
3 12034 begin
4 12035 integer pos, i, sum, tegn;
4 12036
4 12036 pos:= 1;
4 12037 skrivtegn(answ,pos,'B');
4 12038 skrivtegn(answ,pos,if more then 'B' else ' ');
4 12039 skrivtegn(answ,pos,ac+'@');
4 12040 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 12041 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 12042 skrivtegn(answ,pos,'@');
4 12043 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 12044 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 12045 for i:= 1 step 1 until spec(1) extract 8 do
4 12046 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 12047 else
4 12048 begin
5 12049 skrivtegn(answ,pos,'D');
5 12050 anbringtal(answ,pos,spec(1+i),-4);
5 12051 end;
4 12052 for i:= 1 step 1 until 4 do
4 12053 skrivtegn(answ,pos,'@');
4 12054 skrivtegn(answ,pos,ht+'@');
4 12055 skrivtegn(answ,pos,'@');
4 12056
4 12056 i:= 1; sum:= 0;
4 12057 while i < pos do
4 12058 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 12059 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 12060 skrivtegn(answ,pos,sum extract 4 + '@');
4 12061 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 12062 end;
3 12063 \f
3 12063 message procedure ann_opkald side 1 - 881108/cl;
3 12064
3 12064 integer procedure ann_opkald(vogn,omr);
3 12065 value vogn,omr;
3 12066 integer vogn,omr;
3 12067 begin
4 12068 integer array field vt_op,ref,næste,forrige;
4 12069 integer res, t, i, o;
4 12070
4 12070 waitch(cs_vt_adgang,vt_op,true,-1);
4 12071 res:= -1;
4 12072 wait(bs_opkaldskø_adgang);
4 12073 ref:= første_nødopkald;
4 12074 if ref <> 0 then
4 12075 t:= 2
4 12076 else
4 12077 begin
5 12078 ref:= første_opkald;
5 12079 t:= if ref<>0 then 1 else 0;
5 12080 end;
4 12081
4 12081 if t=0 then
4 12082 res:= 19 <* kø tom *>
4 12083 else
4 12084 begin
5 12085 while ref<>0 and res=(-1) do
5 12086 begin
6 12087 if vogn=opkaldskø.ref(2) extract 14 and
6 12088 omr=opkaldskø.ref(5) extract 8
6 12089 then
6 12090 res:= 0
6 12091 else
6 12092 begin
7 12093 ref:= opkaldskø.ref(1) extract 12;
7 12094 if ref=0 and t=2 then
7 12095 begin
8 12096 ref:= første_opkald;
8 12097 t:= if ref=0 then 0 else 1;
8 12098 end;
7 12099 end;
6 12100 end; <*while*>
5 12101 \f
5 12101 message procedure ann_opkald side 2 - 881108/cl;
5 12102
5 12102 if ref<>0 then
5 12103 begin
6 12104 start_operation(vt_op,401,cs_radio_ind,17);
6 12105 d.vt_op.data(1):= vogn;
6 12106 d.vt_op.data(4):= omr;
6 12107 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 12108 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 12109
6 12109 o:= opkaldskø.ref(4) extract 8;
6 12110 næste:= opkaldskø.ref(1);
6 12111 forrige:= næste shift (-12);
6 12112 næste:= næste extract 12;
6 12113 if forrige<>0 then
6 12114 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 12115 + næste
6 12116 else
6 12117 if t=2 then første_nødopkald:= næste
6 12118 else første_opkald:= næste;
6 12119
6 12119 if næste<>0 then
6 12120 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 12121 + forrige shift 12
6 12122 else
6 12123 if t=2 then sidste_nødopkald:= forrige
6 12124 else sidste_opkald:= forrige;
6 12125
6 12125 opkaldskø.ref(1):= første_frie_opkald;
6 12126 første_frie_opkald:= ref;
6 12127 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 12128 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 12129
6 12129 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 12130 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 12131 else
6 12132 begin
7 12133 sætbit_ia(opkaldsflag,o,1);
7 12134 end;
6 12135 signalbin(bs_mobilopkald);
6 12136 end;
5 12137 end;
4 12138
4 12138 signalbin(bs_opkaldskø_adgang);
4 12139 signalch(cs_vt_adgang, vt_op, true);
4 12140 ann_opkald:= res;
4 12141 end;
3 12142 \f
3 12142 message procedure frigiv_id side 1 - 881114/cl;
3 12143
3 12143 integer procedure frigiv_id(id,omr);
3 12144 value id,omr;
3 12145 integer id,omr;
3 12146 begin
4 12147 integer array field vt_op;
4 12148
4 12148 if id shift (-22) < 3 and omr > 2 then
4 12149 begin
5 12150 waitch(cs_vt_adgang,vt_op,true,-1);
5 12151 start_operation(vt_op,401,cs_radio_ind,
5 12152 if id shift (-22) = 2 then 18 else 17);
5 12153 d.vt_op.data(1):= id;
5 12154 d.vt_op.data(4):= omr;
5 12155 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 12156 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 12157 frigiv_id:= d.vt_op.resultat;
5 12158 signalch(cs_vt_adgang,vt_op,true);
5 12159 end;
4 12160 end;
3 12161 \f
3 12161 message procedure radio_ind side 2 - 810524/hko;
3 12162 trap(radio_ind_trap);
3 12163 laf:= 0;
3 12164 stack_claim((if cm_test then 200 else 150) +135+75);
3 12165
3 12165 <*+2*>if testbit32 and overvåget or testbit28 then
3 12166 skriv_radio_ind(out,0);
3 12167 <*-2*>
3 12168 answ.laf(1):= long<:<'nl'>:>;
3 12169 io_opref:= op;
3 12170
3 12170 repeat
3 12171 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12172 pos:= 4;
3 12173 if ac = 0 then
3 12174 begin
4 12175 \f
4 12175 message procedure radio_ind side 3 - 881107/cl;
4 12176 if ttyp = 'A' then
4 12177 begin
5 12178 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12179 ac:= 1
5 12180 else
5 12181 begin
6 12182 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 12183 val(1):= ttyp;
6 12184 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 12185 val(2):= pnum;
6 12186 typ(3):= -1;
6 12187 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12188 if opref>0 then
6 12189 begin
7 12190 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 12191 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 12192 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 12193 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 12194 then
7 12195 begin
8 12196 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 12197 end
7 12198 else
7 12199 begin
8 12200 ac:= 0;
8 12201 d.opref.resultat:= 0;
8 12202 sætbit_ia(hookoff_maske,pnum,1);
8 12203 end;
7 12204 signalch(d.opref.retur,opref,d.opref.optype);
7 12205 end
6 12206 else
6 12207 ac:= 2;
6 12208 end;
5 12209 pos:= 1;
5 12210 skrivtegn(answ,pos,'A');
5 12211 skrivtegn(answ,pos,' ');
5 12212 skrivtegn(answ,pos,ac+'@');
5 12213 for i:= 1 step 1 until 5 do
5 12214 skrivtegn(answ,pos,'@');
5 12215 skrivtegn(answ,pos,'0');
5 12216 i:= 1; sum:= 0;
5 12217 while i < pos do
5 12218 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12219 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12220 skrivtegn(answ,pos,sum extract 4 + '@');
5 12221 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12222 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12223 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12224 disable begin
6 12225 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12226 outchar(zrl,'nl');
6 12227 end;
5 12228 <*-2*>
5 12229 disable setposition(z_fr_out,0,0);
5 12230 ac:= -1;
5 12231 \f
5 12231 message procedure radio_ind side 4 - 881107/cl;
5 12232 end <* ttyp=A *>
4 12233 else
4 12234 if ttyp = 'B' then
4 12235 begin
5 12236 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12237 ac:= 1
5 12238 else
5 12239 begin
6 12240 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 12241 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 12242 typ(3):= -1;
6 12243 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12244 if opref > 0 then
6 12245 begin
7 12246 <*+2*> if testbit37 and overvåget then
7 12247 disable begin
8 12248 skriv_radio_ind(out,0);
8 12249 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 12250 skriv_op(out,opref);
8 12251 end;
7 12252 <*-2*>
7 12253 læstegn(tlgr,pos,bs);
7 12254 if bs = 'V' then
7 12255 begin
8 12256 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 12257 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 12258 end;
7 12259 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 12260 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 12261 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 12262 then
7 12263 begin
8 12264 ac:= 1;
8 12265 d.opref.resultat:= 31; <* systemfejl *>
8 12266 signalch(d.opref.retur,opref,d.opref.optype);
8 12267 end
7 12268 else
7 12269 if bs='V' then
7 12270 begin
8 12271 ac:= 0;
8 12272 d.opref.resultat:= 1;
8 12273 d.opref.data(4):= 0;
8 12274 d.opref.data(7):=
8 12275 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 12276 radio_id(b_pn));
8 12277 systime(1,0.0,d.opref.tid);
8 12278 signalch(cs_radio_ind,opref,d.opref.optype);
8 12279 spec:= data+18;
8 12280 b_answ(answ,0,d.opref.spec,false,ac);
8 12281 <*+2*> if (testbit36 or testbit38) and overvåget then
8 12282 disable begin
9 12283 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 12284 outchar(zrl,'nl');
9 12285 end;
8 12286 <*-2*>
8 12287 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 12288 disable setposition(z_fr_out,0,0);
8 12289 ac:= -1;
8 12290 \f
8 12290 message procedure radio_ind side 5 - 881107/cl;
8 12291 end
7 12292 else
7 12293 begin
8 12294 integer sig_type;
8 12295
8 12295 ac:= 0;
8 12296 antal_spec:= d.opref.data(4);
8 12297 filref:= d.opref.data(5);
8 12298 spec:= d.opref.data(6);
8 12299 if antal_spec>0 then
8 12300 begin
9 12301 antal_spec:= antal_spec-1;
9 12302 if filref<>0 then
9 12303 begin
10 12304 læsfil(filref,1,zno);
10 12305 b_pt:= fil(zno).spec(1) shift (-12);
10 12306 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 12307 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 12308 antal_spec>0,ac);
10 12309 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 12310 end
9 12311 else
9 12312 begin
10 12313 b_pt:= d.opref.spec(1) shift (-12);
10 12314 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 12315 b_answ(answ,d.opref.data(3),d.opref.spec,
10 12316 antal_spec>0,ac);
10 12317 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 12318 end;
9 12319
9 12319 <* send answer *>
9 12320 <*+2*> if (testbit36 or testbit38) and overvåget then
9 12321 disable begin
10 12322 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 12323 outchar(zrl,'nl');
10 12324 end;
9 12325 <*-2*>
9 12326 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 12327 disable setposition(z_fr_out,0,0);
9 12328 if ac<>0 then
9 12329 begin
10 12330 antal_spec:= 0;
10 12331 ac:= -1;
10 12332 end
9 12333 else
9 12334 begin
10 12335 for i:= 1 step 1 until max_antal_områder do
10 12336 if område_id(i,2)=b_pt then
10 12337 begin
11 12338 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 12339 if sætbiti(d.opref.data(7),j,1)=0 then
11 12340 d.opref.resultat:= d.opref.resultat + 1;
11 12341 end;
10 12342 end;
9 12343 end;
8 12344 \f
8 12344 message procedure radio_ind side 6 - 881107/cl;
8 12345
8 12345 <* afvent nyt telegram *>
8 12346 d.opref.data(4):= antal_spec;
8 12347 d.opref.data(6):= spec;
8 12348 ac:= -1;
8 12349 systime(1,0.0,d.opref.tid);
8 12350 <*+2*> if testbit37 and overvåget then
8 12351 disable begin
9 12352 skriv_radio_ind(out,0);
9 12353 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 12354 ud;
9 12355 end;
8 12356 <*-2*>
8 12357 signalch(cs_radio_ind,opref,d.opref.optype);
8 12358 end;
7 12359 end
6 12360 else ac:= 2;
6 12361 end;
5 12362 if ac > 0 then
5 12363 begin
6 12364 for i:= 1 step 1 until 6 do val(i):= 0;
6 12365 b_answ(answ,0,val,false,ac);
6 12366 <*+2*>
6 12367 if (testbit36 or testbit38) and overvåget then
6 12368 disable begin
7 12369 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12370 outchar(zrl,'nl');
7 12371 end;
6 12372 <*-2*>
6 12373 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12374 disable setposition(z_fr_out,0,0);
6 12375 ac:= -1;
6 12376 end;
5 12377 \f
5 12377 message procedure radio_ind side 7 - 881107/cl;
5 12378 end <* ttyp = 'B' *>
4 12379 else
4 12380 if ttyp='C' or ttyp='J' then
4 12381 begin
5 12382 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12383 ac:= 1
5 12384 else
5 12385 begin
6 12386 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12387 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12388 typ(3):= -1;
6 12389 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12390 if opref > 0 then
6 12391 begin
7 12392 d.opref.resultat:= d.opref.resultat - 1;
7 12393 if ttyp = 'C' then
7 12394 begin
8 12395 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12396 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12397 j:= 0;
8 12398 for i:= 1 step 1 until max_antal_kanaler do
8 12399 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12400 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12401 d.opref.resultat:= d.opref.resultat-1;
8 12402 sætbiti(optaget_flag,j,1);
8 12403 sætbiti(d.opref.data(9),j,1);
8 12404 end
7 12405 else
7 12406 begin <* INGEN FORBINDELSE *>
8 12407 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12408 end;
7 12409 ac:= 0;
7 12410 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12411 begin
8 12412 systime(1,0,d.opref.tid);
8 12413 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12414 end
7 12415 else
7 12416 begin
8 12417 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12418 if læsbiti(d.opref.data(8),9) then 52 else
8 12419 if læsbiti(d.opref.data(8),10) then 20 else
8 12420 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12421 signalch(d.opref.retur, opref, d.opref.optype);
8 12422 end;
7 12423 end
6 12424 else
6 12425 ac:= 2;
6 12426 end;
5 12427 pos:= 1;
5 12428 skrivtegn(answ,pos,ttyp);
5 12429 skrivtegn(answ,pos,' ');
5 12430 skrivtegn(answ,pos,ac+'@');
5 12431 i:= 1; sum:= 0;
5 12432 while i < pos do
5 12433 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12434 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12435 skrivtegn(answ,pos,sum extract 4 + '@');
5 12436 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12437 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12438 disable begin
6 12439 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12440 outchar(zrl,'nl');
6 12441 end;
5 12442 <*-2*>
5 12443 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12444 disable setposition(z_fr_out,0,0);
5 12445 ac:= -1;
5 12446 \f
5 12446 message procedure radio_ind side 8 - 881107/cl;
5 12447 end <* ttyp = 'C' or 'J' *>
4 12448 else
4 12449 if ttyp = 'D' then
4 12450 begin
5 12451 if ptyp = 4 <* VDU *> then
5 12452 begin
6 12453 if pnum<1 or pnum>max_antal_taleveje then
6 12454 ac:= 1
6 12455 else
6 12456 begin
7 12457 inspect(bs_talevej_udkoblet(pnum),j);
7 12458 if j>=0 then
7 12459 begin
8 12460 sætbit_ia(samtaleflag,pnum,1);
8 12461 signal_bin(bs_mobil_opkald);
8 12462 end;
7 12463 if læsbit_ia(hookoff_maske,pnum) then
7 12464 signalbin(bs_talevej_udkoblet(pnum));
7 12465 ac:= 0;
7 12466 end
6 12467 end
5 12468 else
5 12469 if ptyp=3 or ptyp=2 then
5 12470 begin
6 12471 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12472 ptyp=2 and pnum<>2
6 12473 then
6 12474 ac:= 1
6 12475 else
6 12476 begin
7 12477 if læstegn(tlgr,5,tegn)='D' then
7 12478 begin <* teknisk nr i telegram *>
8 12479 b_pn:= 0;
8 12480 for i:= 1 step 1 until 4 do
8 12481 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12482 end
7 12483 else
7 12484 b_pn:= 0;
7 12485 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12486 i:= 0;
7 12487 for j:= 1 step 1 until max_antal_kanaler do
7 12488 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12489 if i<>0 then
7 12490 begin
8 12491 ref:= (i-1)*kanalbeskrlængde;
8 12492 inspect(ss_samtale_nedlagt(i),j);
8 12493 if j>=0 then
8 12494 begin
9 12495 sætbit_ia(samtaleflag,
9 12496 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12497 signalbin(bs_mobil_opkald);
9 12498 end;
8 12499 signal(ss_samtale_nedlagt(i));
8 12500 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12501 begin
9 12502 if kanal_tab.ref.kanal_id1<>0 and
9 12503 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12504 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12505 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12506 if kanal_tab.ref.kanal_id2<>0 and
9 12507 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12508 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12509 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12510 end;
8 12511 sætbiti(optaget_flag,i,0);
8 12512 end;
7 12513 ac:= 0;
7 12514 end;
6 12515 end
5 12516 else ac:= 1;
5 12517 if ac>=0 then
5 12518 begin
6 12519 pos:= i:= 1; sum:= 0;
6 12520 skrivtegn(answ,pos,'D');
6 12521 skrivtegn(answ,pos,' ');
6 12522 skrivtegn(answ,pos,ac+'@');
6 12523 skrivtegn(answ,pos,'@');
6 12524 while i<pos do
6 12525 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12526 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12527 skrivtegn(answ,pos, sum extract 4 + '@');
6 12528 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12529 <*+2*>
6 12530 if (testbit36 or testbit38) and overvåget then
6 12531 disable begin
7 12532 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12533 outchar(zrl,'nl');
7 12534 end;
6 12535 <*-2*>
6 12536 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12537 disable setposition(z_fr_out,0,0);
6 12538 ac:= -1;
6 12539 end;
5 12540 \f
5 12540 message procedure radio_ind side 9 - 881107/cl;
5 12541 end <* ttyp = D *>
4 12542 else
4 12543 if ttyp='H' then
4 12544 begin
5 12545 integer htyp;
5 12546
5 12546 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12547
5 12547 if htyp='A' then
5 12548 begin <*mobilopkald*>
6 12549 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12550 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12551 ac:= 1
6 12552 else
6 12553 begin
7 12554 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12555 if læstegn(tlgr,6,tegn)='D' then
7 12556 begin <*teknisk nr. i telegram*>
8 12557 b_pn:= 0;
8 12558 for i:= 1 step 1 until 4 do
8 12559 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12560 end
7 12561 else b_pn:= 0;
7 12562 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12563 <* opkaldstype *>
7 12564 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12565 if j>0 then
7 12566 begin
8 12567 if bs=10 then
8 12568 ann_opkald(b_pn,j)
8 12569 else
8 12570 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12571 ac:= 0;
8 12572 end else ac:= 1;
7 12573 end;
6 12574 \f
6 12574 message procedure radio_ind side 10 - 881107/cl;
6 12575 end
5 12576 else
5 12577 if htyp='E' then
5 12578 begin <* radiokanal status *>
6 12579 long onavn;
6 12580
6 12580 ac:= 0;
6 12581 j:= 0;
6 12582 for i:= 1 step 1 until max_antal_kanaler do
6 12583 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12584
6 12584 <* Alarmer for K12 = GLX ignoreres *>
6 12585 <* 94.06.14/CL *>
6 12586 <* Alarmer for K15 = HG ignoreres *>
6 12587 <* 95.07.31/CL *>
6 12588 <* Alarmer for K10 = FS ignoreres *>
6 12589 <* 96.05.27/CL *>
6 12590 if j>0 then
6 12591 begin
7 12592 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12593 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
7 12594 (onavn = long<:FS:>) then 0 else j);
7 12595 end;
6 12596
6 12596 læstegn(tlgr,9,tegn);
6 12597 if j<>0 and (tegn='A' or tegn='E') then
6 12598 begin
7 12599 ref:= (j-1)*kanalbeskrlængde;
7 12600 bs:= if tegn='E' then 0 else 15;
7 12601 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12602 begin
8 12603 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12604 signalbin(bs_mobil_opkald);
8 12605 end;
7 12606 end;
6 12607 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12608 begin
7 12609 waitch(cs_radio_pulje,opref,true,-1);
7 12610 startoperation(opref,401,cs_radio_pulje,23);
7 12611 i:= 1;
7 12612 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12613 if læstegn(tlgr,4,k)<>'@' then
7 12614 begin
8 12615 if k-'@' = 17 then
8 12616 hægtstring(d.opref.data,i,<: AMV:>)
8 12617 else
8 12618 if k-'@' = 18 then
8 12619 hægtstring(d.opref.data,i,<: BHV:>)
8 12620 else
8 12621 begin
9 12622 hægtstring(d.opref.data,i,<: BST:>);
9 12623 anbringtal(d.opref.data,i,k-'@',1);
9 12624 end;
8 12625 end;
7 12626 skrivtegn(d.opref.data,i,' ');
7 12627 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12628 skrivtegn(d.opref.data,i,' ');
7 12629 hægtstring(d.opref.data,i,
7 12630 string område_navn(kanal_til_omr(j)));
7 12631 if '@'<=tegn and tegn<='F' then
7 12632 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12633 <*@*> <:: ukendt fejl:>,
7 12634 <*A*> <:: compad-fejl:>,
7 12635 <*B*> <:: ladefejl:>,
7 12636 <*C*> <:: dør åben:>,
7 12637 <*D*> <:: senderfejl:>,
7 12638 <*E*> <:: compad ok:>,
7 12639 <*F*> <:: liniefejl:>,
7 12640 <::>))
7 12641 else
7 12642 begin
8 12643 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12644 skrivtegn(d.opref.data,i,tegn);
8 12645 end;
7 12646 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12647 signalch(cs_io,opref,gen_optype or rad_optype);
7 12648 ref:= (j-1)*kanalbeskrlængde;
7 12649 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12650 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12651 signalbin(bs_mobilopkald);
7 12652 end;
6 12653 \f
6 12653 message procedure radio_ind side 11 - 881107/cl;
6 12654 end
5 12655 else
5 12656 if htyp='G' then
5 12657 begin <* fjerninkludering/-ekskludering af område *>
6 12658 bs:= læstegn(tlgr,9,tegn)-'@';
6 12659 j:= 0;
6 12660 for i:= 1 step 1 until max_antal_kanaler do
6 12661 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12662 if j<>0 then
6 12663 begin
7 12664 ref:= (j-1)*kanalbeskrlængde;
7 12665 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12666 end;
6 12667 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12668 signalbin(bs_mobilopkald);
6 12669 ac:= 0;
6 12670 end
5 12671 else
5 12672 if htyp='L' then
5 12673 begin <* vogntabelændringer *>
6 12674 long field ll;
6 12675
6 12675 ll:= 10;
6 12676 ac:= 0;
6 12677 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12678 læstegn(tlgr,9,tegn);
6 12679 if (tegn='N') or (tegn='O') then
6 12680 begin
7 12681 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12682 typ(2):= -1;
7 12683 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12684 if opref>0 then
7 12685 begin
8 12686 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12687 signalch(d.opref.retur,opref,d.opref.optype);
8 12688 end;
7 12689 ac:= -1;
7 12690 end
6 12691 else
6 12692 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12693 ac:= -1
6 12694 else
6 12695 if tegn='G' then <*indkodning*>
6 12696 begin
7 12697 pos:= 10; i:= 0;
7 12698 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12699 i:= i*10 + (tegn-'0');
7 12700 i:= i mod 1000;
7 12701 b_pn:= (1 shift 22) + (i shift 12);
7 12702 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12703 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12704 pos:= 14; i:= 0;
7 12705 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12706 i:= i*10 + (tegn-'0');
7 12707 b_pn:= b_pn + i;
7 12708 pos:= 16; i:= 0;
7 12709 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12710 i:= i*10 + (tegn-'0');
7 12711 b_pt:= i;
7 12712 bs:= 11;
7 12713 \f
7 12713 message procedure radio_ind side 12 - 881107/cl;
7 12714 end
6 12715 else
6 12716 if tegn='H' then <*udkodning*>
6 12717 begin
7 12718 pos:= 10; i:= 0;
7 12719 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12720 i:= i*10 + (tegn-'0');
7 12721 b_pt:= i;
7 12722 b_pn:= 0;
7 12723 bs:= 12;
7 12724 end
6 12725 else
6 12726 if tegn='I' then <*slet tabel*>
6 12727 begin
7 12728 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12729 pos:= 10; i:= 0;
7 12730 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12731 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12732 zno:= i;
7 12733 end
6 12734 else ac:= 2;
6 12735 if ac<0 then
6 12736 ac:= 0
6 12737 else
6 12738
6 12738 if ac=0 then
6 12739 begin
7 12740 waitch(cs_vt_adgang,opref,true,-1);
7 12741 startoperation(opref,401,cs_vt_adgang,bs);
7 12742 d.opref.data(1):= b_pt;
7 12743 d.opref.data(2):= b_pn;
7 12744 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12745 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12746 end;
6 12747 end
5 12748 else
5 12749 ac:= 2;
5 12750
5 12750 pos:= 1;
5 12751 skrivtegn(answ,pos,'H');
5 12752 skrivtegn(answ,pos,' ');
5 12753 skrivtegn(answ,pos,ac+'@');
5 12754 i:= 1; sum:= 0;
5 12755 while i < pos do
5 12756 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12757 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12758 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12759 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12760 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12761 disable begin
6 12762 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12763 outchar(zrl,'nl');
6 12764 end;
5 12765 <*-2*>
5 12766 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12767 disable setposition(z_fr_out,0,0);
5 12768 ac:= -1;
5 12769 \f
5 12769 message procedure radio_ind side 13 - 881107/cl;
5 12770 end
4 12771 else
4 12772 if ttyp = 'I' then
4 12773 begin
5 12774 typ(1):= -1;
5 12775 repeat
5 12776 getch(cs_radio_ind,opref,true,typ,val);
5 12777 if opref<>0 then
5 12778 begin
6 12779 d.opref.resultat:= 31;
6 12780 signalch(d.opref.retur,opref,d.opref.op_type);
6 12781 end;
5 12782 until opref=0;
5 12783 for i:= 1 step 1 until max_antal_taleveje do
5 12784 if læsbit_ia(hookoff_maske,i) then
5 12785 begin
6 12786 signalbin(bs_talevej_udkoblet(i));
6 12787 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12788 end;
5 12789 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12790 signal_bin(bs_mobil_opkald);
5 12791 for i:= 1 step 1 until max_antal_kanaler do
5 12792 begin
6 12793 ref:= (i-1)*kanalbeskrlængde;
6 12794 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12795 begin
7 12796 if kanal_tab.ref.kanal_id2<>0 and
7 12797 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12798 then
7 12799 begin
8 12800 signal(ss_samtale_nedlagt(i));
8 12801 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12802 end;
7 12803 if kanal_tab.ref.kanal_id1<>0 then
7 12804 begin
8 12805 signal(ss_samtale_nedlagt(i));
8 12806 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12807 end;
7 12808 end;
6 12809 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12810 end;
5 12811 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12812 startoperation(opref,401,cs_radio_pulje,23);
5 12813 i:= 1;
5 12814 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12815 j:= 4;
5 12816 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12817 begin
6 12818 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12819 end;
5 12820 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12821 signalch(cs_io,opref,gen_optype or rad_optype);
5 12822 optaget_flag:= 0;
5 12823 pos:= i:= 1; sum:= 0;
5 12824 skrivtegn(answ,pos,'I');
5 12825 skrivtegn(answ,pos,' ');
5 12826 skrivtegn(answ,pos,'@');
5 12827 while i<pos do
5 12828 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12829 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12830 skrivtegn(answ,pos,sum extract 4 + '@');
5 12831 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12832 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12833 disable begin
6 12834 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12835 outchar(zrl,'nl');
6 12836 end;
5 12837 <*-2*>
5 12838 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12839 disable setposition(z_fr_out,0,0);
5 12840 ac:= -1;
5 12841 \f
5 12841 message procedure radio_ind side 14 - 881107/cl;
5 12842 end
4 12843 else
4 12844 if ttyp='L' then
4 12845 begin
5 12846 ac:= 0;
5 12847 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12848 if testbit21 then
5 12849 begin
6 12850 waitch(cs_radio_pulje,opref,true,-1);
6 12851 startoperation(opref,401,cs_radio_pulje,23);
6 12852 i:= 1;
6 12853 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12854 j:= 4;
6 12855 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12856 begin
7 12857 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12858 end;
6 12859 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12860 signalch(cs_io,opref,gen_optype or rad_optype);
6 12861 end; <*testbit21*>
5 12862 end
4 12863 else
4 12864 if ttyp='Z' then
4 12865 begin
5 12866 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12867 disable begin
6 12868 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12869 outchar(zrl,'nl');
6 12870 end;
5 12871 <*-2*>
5 12872 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12873 disable setposition(z_fr_out,0,0);
5 12874 ac:= -1;
5 12875 end
4 12876 else
4 12877 ac:= 1;
4 12878 end; <* telegram modtaget ok *>
3 12879 \f
3 12879 message procedure radio_ind side 15 - 881107/cl;
3 12880 if ac>=0 then
3 12881 begin
4 12882 pos:= i:= 1; sum:= 0;
4 12883 skrivtegn(answ,pos,ttyp);
4 12884 skrivtegn(answ,pos,' ');
4 12885 skrivtegn(answ,pos,ac+'@');
4 12886 while i<pos do
4 12887 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12888 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12889 skrivtegn(answ,pos, sum extract 4 + '@');
4 12890 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12891 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12892 disable begin
5 12893 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12894 outchar(zrl,'nl');
5 12895 end;
4 12896 <*-2*>
4 12897 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12898 disable setposition(z_fr_out,0,0);
4 12899 ac:= -1;
4 12900 end;
3 12901
3 12901 typ(1):= 0;
3 12902 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12903 rf:= 4;
3 12904 systime(1,0.0,val.rf);
3 12905 val.rf:= val.rf - 30.0;
3 12906 typ(3):= -1;
3 12907 repeat
3 12908 getch(cs_radio_ind,opref,true,typ,val);
3 12909 if opref>0 then
3 12910 begin
4 12911 d.opref.resultat:= 53; <*annuleret*>
4 12912 signalch(d.opref.retur,opref,d.opref.optype);
4 12913 end;
3 12914 until opref=0;
3 12915
3 12915 until false;
3 12916
3 12916 radio_ind_trap:
3 12917
3 12917 disable skriv_radio_ind(zbillede,1);
3 12918
3 12918 end radio_ind;
2 12919 \f
2 12919 message procedure radio_ud side 1 - 820301/hko;
2 12920
2 12920 procedure radio_ud(op);
2 12921 value op;
2 12922 integer op;
2 12923 begin
3 12924 integer array field opref,io_opref;
3 12925 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12926 integer array answ, tlgr(1:32);
3 12927 long array field laf;
3 12928
3 12928 procedure skriv_radio_ud(z,omfang);
3 12929 value omfang;
3 12930 zone z;
3 12931 integer omfang;
3 12932 begin integer i1;
4 12933 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12934 if omfang > 0 then
4 12935 disable begin real x; long array field tx;
5 12936 tx:= 0;
5 12937 trap(slut);
5 12938 write(z,"nl",1,
5 12939 <: opref: :>,opref,"nl",1,
5 12940 <: io-opref: :>,io_opref,"nl",1,
5 12941 <: opgave: :>,opgave,"nl",1,
5 12942 <: kode: :>,kode,"nl",1,
5 12943 <: pos: :>,pos,"nl",1,
5 12944 <: tegn: :>,tegn,"nl",1,
5 12945 <: i: :>,i,"nl",1,
5 12946 <: sum: :>,sum,"nl",1,
5 12947 <: rc: :>,rc,"nl",1,
5 12948 <: svar-status: :>,svar_status,"nl",1,
5 12949 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12950 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12951 <::>);
5 12952 skriv_coru(z,coru_no(402));
5 12953 slut:
5 12954 end; <*disable*>
4 12955 end skriv_radio_ud;
3 12956
3 12956 trap(radio_ud_trap);
3 12957 laf:= 0;
3 12958 stack_claim((if cm_test then 200 else 150) +35+100);
3 12959
3 12959 <*+2*>if testbit32 and overvåget or testbit28 then
3 12960 skriv_radio_ud(out,0);
3 12961 <*-2*>
3 12962
3 12962 io_opref:= op;
3 12963 \f
3 12963 message procedure radio_ud side 2 - 810529/hko;
3 12964
3 12964 repeat
3 12965
3 12965 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12966 kode:= d.op_ref.opkode;
3 12967 opgave:= kode shift(-12);
3 12968 kode:= kode extract 12;
3 12969 if opgave < 'A' or opgave > 'I' then
3 12970 begin
4 12971 d.opref.resultat:= 31;
4 12972 end
3 12973 else
3 12974 begin
4 12975 pos:= 1;
4 12976 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12977 begin
5 12978 skrivtegn(tlgr,pos,opgave);
5 12979 if d.opref.data(1) = 0 then
5 12980 begin
6 12981 skrivtegn(tlgr,pos,'G');
6 12982 skrivtegn(tlgr,pos,'A');
6 12983 end
5 12984 else
5 12985 begin
6 12986 skrivtegn(tlgr,pos,'D');
6 12987 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 12988 end;
5 12989 if opgave='A' then
5 12990 begin
6 12991 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 12992 end
5 12993 else
5 12994 if opgave='B' then
5 12995 begin
6 12996 skrivtegn(tlgr,pos,d.opref.data(2));
6 12997 if d.opref.data(2)='V' then
6 12998 begin
7 12999 skrivtegn(tlgr,pos,
7 13000 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 13001 skrivtegn(tlgr,pos,
7 13002 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 13003 end;
6 13004 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 13005 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 13006 end
5 13007 else
5 13008 if opgave='H' then
5 13009 begin
6 13010 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 13011 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 13012 hægtstring(tlgr,pos,<:@@@:>);
6 13013 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 13014 skrivtegn(tlgr,pos,'A');
6 13015 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 13016 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 13017 if d.opref.data(2)='L' then
6 13018 begin
7 13019 if d.opref.data(5)=7 then
7 13020 begin
8 13021 anbringtal(tlgr,pos,
8 13022 d.opref.data(8) shift (-12) extract 10,-4);
8 13023 anbringtal(tlgr,pos,
8 13024 d.opref.data(8) extract 7,-2);
8 13025 end
7 13026 else
7 13027 if d.opref.data(5)=8 then
7 13028 begin
8 13029 hægtstring(tlgr,pos,<:FFFFFF:>);
8 13030 end;
7 13031 if d.opref.data(5)<>9 then
7 13032 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 13033 skrivtegn(tlgr,pos,
7 13034 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 13035 skrivtegn(tlgr,pos,
7 13036 dec_to_hex(d.opref.data(6) extract 4));
7 13037 skrivtegn(tlgr,10,pos-11+'@');
7 13038 end;
6 13039 end;
5 13040 end
4 13041 else
4 13042 if opgave='I' then
4 13043 begin
5 13044 hægtstring(tlgr,pos,<:IGA:>);
5 13045 end
4 13046 else d.opref.resultat:= 31; <*systemfejl*>
4 13047 end;
3 13048 \f
3 13048 message procedure radio_ud side 3 - 881107/cl;
3 13049
3 13049 if d.opref.resultat=0 then
3 13050 begin
4 13051 if (opgave <= 'B')
4 13052 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 13053 begin
5 13054 systime(1,0,d.opref.tid);
5 13055 signalch(cs_radio_ind,opref,d.opref.optype);
5 13056 opref:= 0;
5 13057 end;
4 13058 <* beregn checksum og send *>
4 13059 i:= 1; sum:= 0;
4 13060 while i < pos do
4 13061 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 13062 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 13063 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 13064 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 13065 <**********************************************>
4 13066 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 13067
4 13067 if opgave='B' then delay(1);
4 13068
4 13068 <* 94.04.19/cl *>
4 13069 <**********************************************>
4 13070
4 13070 <*+2*> if (testbit36 or testbit39) and overvåget then
4 13071 disable begin
5 13072 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 13073 outchar(zrl,'nl');
5 13074 end;
4 13075 <*-2*>
4 13076 setposition(z_rf_in,0,0);
4 13077 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 13078 disable setposition(z_rf_out,0,0);
4 13079 rc:= 0;
4 13080
4 13080 <* afvent svar*>
4 13081 repeat
4 13082 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 13083 if svar_status=6 then
4 13084 begin
5 13085 svar_status:= -3;
5 13086 goto radio_ud_check;
5 13087 end;
4 13088 pos:= 1;
4 13089 while læstegn(answ,pos,i)<>0 do ;
4 13090 pos:= pos-2;
4 13091 if pos > 0 then
4 13092 begin
5 13093 if pos<3 then
5 13094 svar_status:= -2 <*format error*>
5 13095 else
5 13096 begin
6 13097 if læstegn(answ,3,tegn)<>'@' then
6 13098 svar_status:= tegn - '@'
6 13099 else
6 13100 begin
7 13101 pos:= 1;
7 13102 læstegn(answ,pos,tegn);
7 13103 if tegn<>opgave then
7 13104 svar_status:= -4 <*gal type*>
7 13105 else
7 13106 if læstegn(answ,pos,tegn)<>' ' then
7 13107 svar_status:= -tegn <*fejl*>
7 13108 else
7 13109 svar_status:= læstegn(answ,pos,tegn)-'@';
7 13110 end;
6 13111 end;
5 13112 end
4 13113 else
4 13114 svar_status:= -1;
4 13115 \f
4 13115 message procedure radio_ud side 5 - 881107/cl;
4 13116
4 13116 radio_ud_check:
4 13117 rc:= rc+1;
4 13118 if -3<=svar_status and svar_status< -1 then
4 13119 disable begin
5 13120 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 13121 setposition(z_rf_out,0,0);
5 13122 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13123 begin
6 13124 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 13125 outchar(zrl,'nl');
6 13126 end;
5 13127 <*-2*>
5 13128 end
4 13129 else
4 13130 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 13131 disable begin
5 13132 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 13133 setposition(z_rf_out,0,0);
5 13134 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13135 begin
6 13136 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 13137 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 13138 end;
5 13139 <*-2*>
5 13140 end
4 13141 else
4 13142 if svar_status=0 and opref<>0 then
4 13143 d.opref.resultat:= 0
4 13144 else
4 13145 if opref<>0 then
4 13146 d.opref.resultat:= 31;
4 13147 until svar_status=0 or rc>3;
4 13148 end;
3 13149 if opref<>0 then
3 13150 begin
4 13151 if svar_status<>0 and rc>3 then
4 13152 d.opref.resultat:= 53; <* annulleret *>
4 13153 signalch(d.opref.retur,opref,d.opref.optype);
4 13154 opref:= 0;
4 13155 end;
3 13156 until false;
3 13157
3 13157 radio_ud_trap:
3 13158
3 13158 disable skriv_radio_ud(zbillede,1);
3 13159
3 13159 end radio_ud;
2 13160 \f
2 13160 message procedure radio_medd_opkald side 1 - 810610/hko;
2 13161
2 13161 procedure radio_medd_opkald;
2 13162 begin
3 13163 integer array field ref,op_ref;
3 13164 integer i;
3 13165
3 13165 procedure skriv_radio_medd_opkald(z,omfang);
3 13166 value omfang;
3 13167 zone z;
3 13168 integer omfang;
3 13169 begin integer x;
4 13170 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 13171 write(z,"sp",26-x);
4 13172 if omfang > 0 then
4 13173 disable begin
5 13174 trap(slut);
5 13175 write(z,"nl",1,
5 13176 <: ref: :>,ref,"nl",1,
5 13177 <: opref: :>,op_ref,"nl",1,
5 13178 <: i: :>,i,"nl",1,
5 13179 <::>);
5 13180 skriv_coru(z,abs curr_coruno);
5 13181 slut:
5 13182 end;<*disable*>
4 13183 end skriv_radio_medd_opkald;
3 13184
3 13184 trap(radio_medd_opkald_trap);
3 13185
3 13185 stack_claim((if cm_test then 200 else 150) +1);
3 13186
3 13186 <*+2*>if testbit32 and overvåget or testbit28 then
3 13187 disable skriv_radio_medd_opkald(out,0);
3 13188 <*-2*>
3 13189 \f
3 13189 message procedure radio_medd_opkald side 2 - 820301/hko;
3 13190
3 13190 repeat
3 13191
3 13191 <*V*> wait(bs_mobil_opkald);
3 13192 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 13193 <*V*> wait(bs_opkaldskø_adgang);
3 13194
3 13194 ref:= første_nød_opkald;
3 13195 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 13196 begin
4 13197 i:= opkaldskø.ref(2);
4 13198 if i < 0 then
4 13199 begin
5 13200 <* nødopkald ikke meldt *>
5 13201
5 13201 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 13202 d.op_ref.data(1):= <* vogn_id *>
5 13203 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 13204 opkaldskø.ref(2):= i extract 22;
5 13205 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 13206 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 13207 i:= op_ref;
5 13208 <*+2*> if testbit35 and overvåget then
5 13209 disable begin
6 13210 write(out,"nl",1,<:radio nød-medd:>);
6 13211 skriv_op(out,op_ref);
6 13212 ud;
6 13213 end;
5 13214 <*-2*>
5 13215 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 13216 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 13217 <*+4*> if i <> op_ref then
5 13218 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 13219 <*-4*>
5 13220 end;<*nødopkald ikke meldt*>
4 13221
4 13221 ref:= opkaldskø.ref(1) extract 12;
4 13222 end; <* melding til io *>
3 13223 \f
3 13223 message procedure radio_medd_opkald side 3 - 820304/hko;
3 13224
3 13224 start_operation(op_ref,403,cs_radio_medd,
3 13225 40<*opdater opkaldskøbill*>);
3 13226 signal_bin(bs_opkaldskø_adgang);
3 13227 <*+2*> if testbit35 and overvåget then
3 13228 disable begin
4 13229 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 13230 skriv_op(out,op_ref);
4 13231 write(out, <:opkaldsflag: :>,"nl",1);
4 13232 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 13233 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 13234 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 13235 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 13236 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 13237 ud;
4 13238 end;
3 13239 <*-2*>
3 13240 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 13241
3 13241 until false;
3 13242
3 13242 radio_medd_opkald_trap:
3 13243
3 13243 disable skriv_radio_medd_opkald(zbillede,1);
3 13244
3 13244 end radio_medd_opkald;
2 13245 \f
2 13245 message procedure radio_adm side 1 - 820301/hko;
2 13246
2 13246 procedure radio_adm(op);
2 13247 value op;
2 13248 integer op;
2 13249 begin
3 13250 integer array field opref, rad_op, iaf;
3 13251 integer nr,i,j,k,res,opgave,tilst,operatør;
3 13252
3 13252 procedure skriv_radio_adm(z,omfang);
3 13253 value omfang;
3 13254 zone z;
3 13255 integer omfang;
3 13256 begin integer i1;
4 13257 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 13258 write(z,"sp",26-i1);
4 13259 if omfang > 0 then
4 13260 disable begin real x;
5 13261 trap(slut);
5 13262 \f
5 13262 message procedure radio_adm side 2- 820301/hko;
5 13263
5 13263 write(z,"nl",1,
5 13264 <: op_ref: :>,op_ref,"nl",1,
5 13265 <: iaf: :>,iaf,"nl",1,
5 13266 <: rad-op: :>,rad_op,"nl",1,
5 13267 <: nr: :>,nr,"nl",1,
5 13268 <: i: :>,i,"nl",1,
5 13269 <: j: :>,j,"nl",1,
5 13270 <: k: :>,k,"nl",1,
5 13271 <: tilst: :>,tilst,"nl",1,
5 13272 <: res: :>,res,"nl",1,
5 13273 <: opgave: :>,opgave,"nl",1,
5 13274 <: operatør: :>,operatør,"nl",1);
5 13275 skriv_coru(z,coru_no(404));
5 13276 slut:
5 13277 end;<*disable*>
4 13278 end skriv_radio_adm;
3 13279 \f
3 13279 message procedure radio_adm side 3 - 820304/hko;
3 13280
3 13280 rad_op:= op;
3 13281
3 13281 trap(radio_adm_trap);
3 13282 stack_claim((if cm_test then 200 else 150) +50);
3 13283
3 13283 <*+2*>if testbit32 and overvåget or testbit28 then
3 13284 skriv_radio_adm(out,0);
3 13285 <*-2*>
3 13286
3 13286 pass;
3 13287 if -,testbit22 then
3 13288 begin
4 13289 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13290 signalch(cs_radio_ud,rad_op,rad_optype);
4 13291 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13292 end;
3 13293 repeat
3 13294 waitch(cs_radio_adm,opref,true,-1);
3 13295 <*+2*>
3 13296 if testbit33 and overvåget then
3 13297 disable begin
4 13298 skriv_radio_adm(out,0);
4 13299 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 13300 skriv_op(out,opref);
4 13301 end;
3 13302 <*-2*>
3 13303
3 13303 k:= d.op_ref.opkode extract 12;
3 13304 opgave:= d.opref.opkode shift (-12);
3 13305 nr:=operatør:=d.op_ref.data(1);
3 13306
3 13306 <*+4*> if (d.op_ref.optype and
3 13307 (gen_optype or io_optype or op_optype or vt_optype))
3 13308 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 13309 <:radio_adm:>,0);
3 13310 <*-4*>
3 13311 if k = 74 <* RA,I *> then
3 13312 begin
4 13313 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13314 signalch(cs_radio_ud,rad_op,rad_optype);
4 13315 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13316 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 13317 else d.rad_op.resultat;
4 13318 signalch(d.opref.retur,opref,d.opref.optype);
4 13319 \f
4 13319 message procedure radio_adm side 4 - 820301/hko;
4 13320 end
3 13321 else
3 13322
3 13322 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 13323 k = 5<*FO,L*> or k = 6<*ST *> then
3 13324 begin
4 13325 if k = 5 or k=77 then
4 13326 begin
5 13327
5 13327 <*V*> wait(bs_opkaldskø_adgang);
5 13328 if k=5 then
5 13329 begin
6 13330 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 13331 begin
7 13332 i:= læs_fil(1035,iaf//512+1,nr);
7 13333 if i <> 0 then
7 13334 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 13335 tofrom(radio_linietabel.iaf,fil(nr),
7 13336 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 13337 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 13338 end;
6 13339
6 13339 for i:= 1 step 1 until max_antal_mobilopkald do
6 13340 begin
7 13341 iaf:= i*opkaldskø_postlængde;
7 13342 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 13343 if nr>0 then
7 13344 begin
8 13345 læs_tegn(radio_linietabel,nr+1,operatør);
8 13346 if operatør>max_antal_operatører then operatør:= 0;
8 13347 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 13348 operatør;
8 13349 end;
7 13350 end;
6 13351 end
5 13352 else
5 13353 if k=77 then
5 13354 begin
6 13355 disable i:= læsfil(1034,1,nr);
6 13356 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 13357 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 13358 for i:= 1 step 1 until max_antal_mobilopkald do
6 13359 begin
7 13360 iaf:= i*opkaldskø_postlængde;
7 13361 nr:= opkaldskø.iaf(5) extract 4;
7 13362 operatør:= radio_områdetabel(nr);
7 13363 if operatør < 0 or max_antal_operatører < operatør then
7 13364 operatør:= 0;
7 13365 if opkaldskø.iaf(4) extract 8=0 and
7 13366 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13367 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13368 operatør;
7 13369 end;
6 13370 end;
5 13371
5 13371 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13372 signal_bin(bs_opkaldskø_adgang);
5 13373
5 13373 signal_bin(bs_mobil_opkald);
5 13374
5 13374 d.op_ref.resultat:= res:= 3;
5 13375 \f
5 13375 message procedure radio_adm side 5 - 820304/hko;
5 13376
5 13376 end <*k = 5 / k = 77*>
4 13377 else
4 13378 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13379 res:= 3;
5 13380 for nr:= 1 step 1 until max_antal_kanaler do
5 13381 begin
6 13382 iaf:= (nr-1)*kanal_beskr_længde;
6 13383 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13384 op_talevej(operatør) then
6 13385 begin
7 13386 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13387 if tilst <> 0 then
7 13388 res:= 16; <*skærm optaget*>
7 13389 end; <* kanal_tab(operatør) = operatør*>
6 13390 end;
5 13391 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13392 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13393 signal_bin(bs_mobil_opkald);
5 13394 d.op_ref.resultat:= res;
5 13395 end;<*k=1,2 eller 6 *>
4 13396
4 13396 <*+2*> if testbit35 and overvåget then
4 13397 disable begin
5 13398 skriv_radio_adm(out,0);
5 13399 write(out,<: sender til :>,
5 13400 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13401 else cs_op);
5 13402 skriv_op(out,op_ref);
5 13403 end;
4 13404 <*-2*>
4 13405
4 13405 if k=5 or k=6 or k=77 or res > 3 then
4 13406 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13407 else
4 13408 begin <*k = (1 eller 2) og res = 3 *>
5 13409 d.op_ref.resultat:=0;
5 13410 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13411 end;
4 13412 \f
4 13412 message procedure radio_adm side 6 - 816610/hko;
4 13413
4 13413 end <*k=1,2,5 eller 6*>
3 13414 else
3 13415 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13416 begin
4 13417 nr:= d.op_ref.data(1);
4 13418 res:= 3;
4 13419
4 13419 if nr<=3 then
4 13420 res:= 51 <* afvist *>
4 13421 else
4 13422 begin
5 13423
5 13423 <* gennemstilling af område *>
5 13424 j:= 1;
5 13425 for i:= 1 step 1 until max_antal_kanaler do
5 13426 begin
6 13427 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13428 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13429 end;
5 13430 nr:= j;
5 13431 iaf:= (nr-1)*kanalbeskrlængde;
5 13432 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13433 begin
6 13434 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13435 d.rad_op.data(1):= 0;
6 13436 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13437 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13438 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13439 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13440 signalch(cs_radio_ud,rad_op,rad_optype);
6 13441 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13442 res:= d.rad_op.resultat;
6 13443 if res=0 then res:= 3;
6 13444 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13445 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13446 end;
5 13447 end;
4 13448 d.op_ref.resultat:=res;
4 13449 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13450 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13451 signal_bin(bs_mobil_opkald);
4 13452 \f
4 13452 message procedure radio_adm side 7 - 880930/cl;
4 13453
4 13453
4 13453 end <* k=3 eller 4 *>
3 13454 else
3 13455 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13456 begin
4 13457 nr:= d.opref.data(1) extract 22;
4 13458 res:= 3;
4 13459 iaf:= (nr-1)*kanalbeskrlængde;
4 13460 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13461 d.rad_op.data(1):= 0;
4 13462 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13463 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13464 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13465 d.rad_op.data(5):= k extract 1;
4 13466 signalch(cs_radio_ud,radop,rad_optype);
4 13467 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13468 res:= d.radop.resultat;
4 13469 if res=0 then res:= 3;
4 13470 j:= if k=72 then 15 else 0;
4 13471 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13472 begin
5 13473 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13474 signalbin(bs_mobilopkald);
5 13475 end;
4 13476 d.opref.resultat:= res;
4 13477 signalch(d.opref.retur,opref,d.opref.optype);
4 13478 end
3 13479 else
3 13480 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13481 begin
4 13482 nr:= d.opref.data(1) extract 8;
4 13483 opgave:= if k=19 then 9 else (k-4);
4 13484 if nr<=3 then
4 13485 res:= 51 <*afvist*>
4 13486 else
4 13487 begin
5 13488 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13489 d.radop.data(1):= 0;
5 13490 d.radop.data(2):= 'L';
5 13491 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13492 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13493 d.radop.data(5):= opgave;
5 13494 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13495 d.radop.data(7):= d.opref.data(2);
5 13496 d.radop.data(8):= d.opref.data(3);
5 13497 signalch(cs_radio_ud,radop,rad_optype);
5 13498 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13499 res:= d.radop.resultat;
5 13500 if res=0 then res:= 3;
5 13501 end;
4 13502 d.opref.resultat:= res;
4 13503 signalch(d.opref.retur,opref,d.opref.optype);
4 13504 end
3 13505 else
3 13506
3 13506 begin
4 13507
4 13507 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13508
4 13508 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13509
4 13509 end;
3 13510
3 13510 until false;
3 13511 radio_adm_trap:
3 13512 disable skriv_radio_adm(zbillede,1);
3 13513 end radio_adm;
2 13514
2 13514 \f
2 13514 message vogntabel erklæringer side 1 - 820301/cl;
2 13515
2 13515 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13516 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13517 cs_vt_log;
2 13518 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13519 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13520 vt_log_slicelgd;
2 13521 integer array bustabel,bustabel1(0:max_antal_busser),
2 13522 linie_løb_tabel(0:max_antal_linie_løb),
2 13523 springtabel(1:max_antal_spring,1:3),
2 13524 gruppetabel(1:max_antal_grupper),
2 13525 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13526 vt_logop(1:2),
2 13527 vt_logdisc(1:4),
2 13528 vt_log_tail(1:10);
2 13529 boolean array busindeks(-1:max_antal_linie_løb),
2 13530 bustilstand(-1:max_antal_busser),
2 13531 linie_løb_indeks(-1:max_antal_busser);
2 13532 real array springtid,springstart(1:max_antal_spring);
2 13533 real vt_logstart;
2 13534 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13535 integer array field v_tekst;
2 13536 real field v_tid;
2 13537
2 13537 zone zvtlog(128,1,stderror);
2 13538
2 13538 \f
2 13538 message vogntabel erklæringer side 2 - 851001/cl;
2 13539
2 13539 procedure skriv_vt_variable(zud);
2 13540 zone zud;
2 13541 begin integer i; long array field laf;
3 13542 laf:= 0;
3 13543 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13544 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13545 <:cs-vt :>,cs_vt,"nl",1,
3 13546 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13547 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13548 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13549 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13550 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13551 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13552 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13553 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13554 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13555 <:vt-op :>,vt_op,"nl",1,
3 13556 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13557 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13558 <:sidste-bus :>,sidste_bus,"nl",1,
3 13559 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13560 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13561 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13562 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13563 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13564 <:tf-springdef :>,tf_springdef,"nl",1,
3 13565 <:vt-logskift :>,vt_logskift,"nl",1,
3 13566 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13567 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13568 <:vt-log-aktiv :>,
3 13569 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13570 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13571 <::>);
3 13572 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13573 laf:= 2;
3 13574 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13575 for i:= 6 step 1 until 10 do
3 13576 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13577 write(zud,"nl",1);
3 13578 end;
2 13579 \f
2 13579 message procedure p_vogntabel side 1 - 820301/cl;
2 13580
2 13580 procedure p_vogntabel(z);
2 13581 zone z;
2 13582 begin
3 13583 integer i,b,s,o,t,li,lb,lø,g;
3 13584 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13585 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13586 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13587 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13588
3 13588 for i:= 1 step 1 until sidste_bus do
3 13589 begin
4 13590 b:= bustabel(i) extract 14;
4 13591 g:= bustabel(i) shift (-14);
4 13592 s:= bustabel1(i) shift (-23);
4 13593 o:= bustabel1(i) extract 8;
4 13594 t:= intg(bustilstand(i));
4 13595 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13596 lø:= li extract 7;
4 13597 lb:= li shift (-7) extract 5;
4 13598 lb:= if lb=0 then 32 else lb+64;
4 13599 li:= li shift (-12) extract 10;
4 13600 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13601 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13602 if g > 0 then string bpl_navn(g) else <: :>,
4 13603 ";",1,true,4,string område_navn(o),
4 13604 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13605 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13606 end;
3 13607 end p_vogntabel;
2 13608 \f
2 13608 message procedure p_gruppetabel side 1 - 810531/cl;
2 13609
2 13609 procedure p_gruppetabel(z);
2 13610 zone z;
2 13611 begin
3 13612 integer i,nr,bogst;
3 13613 boolean spc_gr;
3 13614 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13615 <:max-antal-grupper =:>,max_antal_grupper,
3 13616 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13617 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13618 <:gruppetabel::>);
3 13619 for i:= 1 step 1 until max_antal_grupper do
3 13620 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13621 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13622 gruppetabel(i) extract 7);
3 13623 write(z,"nl",2,<:gruppeopkald::>);
3 13624 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13625 begin
4 13626 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13627 if gruppeopkald(i,1) = 0 then
4 13628 write(z,"sp",11)
4 13629 else
4 13630 begin
5 13631 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13632 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13633 else
5 13634 begin
6 13635 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13636 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13637 if bogst = '@' then bogst:= 'sp';
6 13638 end;
5 13639 if spc_gr then
5 13640 write(z,<:(G:>,<<d>,true,3,nr)
5 13641 else
5 13642 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13643 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13644 end;
4 13645 end;
3 13646 end p_gruppetabel;
2 13647 \f
2 13647 message procedure p_springtabel side 1 - 810519/cl;
2 13648
2 13648 procedure p_springtabel(z);
2 13649 zone z;
2 13650 begin
3 13651 integer li,bo,max,st,nr;
3 13652 long indeks;
3 13653 real t;
3 13654
3 13654 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13655 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13656 <:nr spring-id max status næste-tid:>,"nl",1);
3 13657 for nr:= 1 step 1 until max_antal_spring do
3 13658 begin
4 13659 write(z,<<dd>,nr);
4 13660 <* if springtabel(nr,1)<>0 then *>
4 13661 begin
5 13662 li:= springtabel(nr,1) shift (-5) extract 10;
5 13663 bo:= springtabel(nr,1) extract 5;
5 13664 if bo<>0 then bo:= bo + 'A' - 1;
5 13665 indeks:= extend springtabel(nr,2) shift 24;
5 13666 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13667 max:= springtabel(nr,3) extract 12;
5 13668 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13669 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13670 if springtid(nr)<>0.0 then
5 13671 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13672 else
5 13673 write(z,<< d.d >,0.0);
5 13674 if springstart(nr)<>0.0 then
5 13675 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13676 else
5 13677 write(z,<< d.d >,0.0);
5 13678 end
4 13679 <* else
4 13680 write(z,<: --------:>)*>;
4 13681 write(z,"nl",1);
4 13682 end;
3 13683 end p_springtabel;
2 13684 \f
2 13684 message procedure find_busnr side 1 - 820301/cl;
2 13685
2 13685 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13686 value ll_id;
2 13687 integer ll_id, busnr, garage, tilst;
2 13688 begin
3 13689 integer i,j;
3 13690
3 13690 j:= binærsøg(sidste_linie_løb,
3 13691 (linie_løb_tabel(i) - ll_id), i);
3 13692 if j<>0 then <* linie/løb findes ikke *>
3 13693 begin
4 13694 find_busnr:= -1;
4 13695 busnr:= 0;
4 13696 garage:= 0;
4 13697 tilst:= 0;
4 13698 end
3 13699 else
3 13700 begin
4 13701 busnr:= bustabel(busindeks(i) extract 12);
4 13702 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13703 garage:= busnr shift (-14);
4 13704 busnr:= busnr extract 14;
4 13705 find_busnr:= busindeks(i) extract 12;
4 13706 end;
3 13707 end find_busnr;
2 13708 \f
2 13708 message procedure søg_omr_bus side 1 - 881027/cl;
2 13709
2 13709
2 13709 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13710 value bus;
2 13711 integer bus,ll,gar,omr,sig,tilst;
2 13712 begin
3 13713 integer i,j,nr,bu,bi,bl;
3 13714
3 13714 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13715 nr:= -1;
3 13716 if j=0 then
3 13717 begin
4 13718 bl:= bu:= bi;
4 13719 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13720 while bu<sidste_bus and
4 13721 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13722
4 13722 if bl<>bu then
4 13723 begin
5 13724 <* flere busser med samme tekniske nr. omr skal passe *>
5 13725 nr:= -2;
5 13726 for bi:= bl step 1 until bu do
5 13727 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13728 end
4 13729 else
4 13730 nr:= bi;
4 13731 end;
3 13732
3 13732 if nr<0 then
3 13733 begin
4 13734 <* bus findes ikke *>
4 13735 ll:= gar:= tilst:= sig:= 0;
4 13736 end
3 13737 else
3 13738 begin
4 13739 tilst:= intg(bustilstand(nr));
4 13740 gar:= bustabel(nr) shift (-14);
4 13741 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13742 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13743 sig:= bustabel1(nr) shift (-23);
4 13744 end;
3 13745 søg_omr_bus:= nr;
3 13746 end;
2 13747 \f
2 13747 message procedure find_linie_løb side 1 - 820301/cl;
2 13748
2 13748 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13749 value busnr;
2 13750 integer busnr, linie_løb, garage, tilst;
2 13751 begin
3 13752 integer i,j;
3 13753
3 13753 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13754
3 13754 if j<>0 then <* bus findes ikke *>
3 13755 begin
4 13756 find_linie_løb:= -1;
4 13757 linie_løb:= 0;
4 13758 garage:= 0;
4 13759 tilst:= 0;
4 13760 end
3 13761 else
3 13762 begin
4 13763 tilst:= intg(bustilstand(i));
4 13764 garage:= bustabel(i) shift (-14);
4 13765 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13766 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13767 end;
3 13768 end find_linie_løb;
2 13769 \f
2 13769 message procedure h_vogntabel side 1 - 810413/cl;
2 13770
2 13770 <* hovedmodulcorutine for vogntabelmodul *>
2 13771
2 13771 procedure h_vogntabel;
2 13772 begin
3 13773 integer array field op;
3 13774 integer dest_sem,k;
3 13775
3 13775 procedure skriv_h_vogntabel(zud,omfang);
3 13776 value omfang;
3 13777 zone zud;
3 13778 integer omfang;
3 13779 begin
4 13780 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13781 if omfang<>0 then
4 13782 disable
4 13783 begin
5 13784 skriv_coru(zud,abs curr_coruno);
5 13785 write(zud,"nl",1,<<d>,
5 13786 <:cs-vt :>,cs_vt,"nl",1,
5 13787 <:op :>,op,"nl",1,
5 13788 <:dest-sem :>,dest_sem,"nl",1,
5 13789 <:k :>,k,"nl",1,
5 13790 <::>);
5 13791 end;
4 13792 end;
3 13793 \f
3 13793 message procedure h_vogntabel side 2 - 820301/cl;
3 13794
3 13794 stackclaim(if cm_test then 198 else 146);
3 13795 trap(h_vt_trap);
3 13796
3 13796 <*+2*>
3 13797 <**> disable if testbit47 and overvåget or testbit28 then
3 13798 <**> skriv_h_vogntabel(out,0);
3 13799 <*-2*>
3 13800
3 13800 repeat
3 13801 waitch(cs_vt,op,true,-1);
3 13802 <*+4*>
3 13803 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13804 (d.op.optype and vt_optype) extract 12 = 0 then
3 13805 fejlreaktion(12,op,<:vogntabel:>,0);
3 13806 <*-4*>
3 13807 disable
3 13808 begin
4 13809
4 13809 k:= d.op.opkode extract 12;
4 13810 dest_sem:=
4 13811 if k = 9 then cs_vt_rap else
4 13812 if k = 10 then cs_vt_rap else
4 13813 if k = 11 then cs_vt_opd else
4 13814 if k = 12 then cs_vt_opd else
4 13815 if k = 13 then cs_vt_opd else
4 13816 if k = 14 then cs_vt_tilst else
4 13817 if k = 15 then cs_vt_tilst else
4 13818 if k = 16 then cs_vt_tilst else
4 13819 if k = 17 then cs_vt_tilst else
4 13820 if k = 18 then cs_vt_tilst else
4 13821 if k = 19 then cs_vt_opd else
4 13822 if k = 20 then cs_vt_opd else
4 13823 if k = 21 then cs_vt_auto else
4 13824 if k = 24 then cs_vt_opd else
4 13825 if k = 25 then cs_vt_grp else
4 13826 if k = 26 then cs_vt_grp else
4 13827 if k = 27 then cs_vt_grp else
4 13828 if k = 28 then cs_vt_grp else
4 13829 if k = 30 then cs_vt_spring else
4 13830 if k = 31 then cs_vt_spring else
4 13831 if k = 32 then cs_vt_spring else
4 13832 if k = 33 then cs_vt_spring else
4 13833 if k = 34 then cs_vt_spring else
4 13834 if k = 35 then cs_vt_spring else
4 13835 -1;
4 13836 \f
4 13836 message procedure h_vogntabel side 3 - 810422/cl;
4 13837
4 13837 <*+2*>
4 13838 <**> if testbit41 and overvåget then
4 13839 <**> begin
5 13840 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13841 <**> skriv_op(out,op);
5 13842 <**> end;
4 13843 <*-2*>
4 13844 end;
3 13845
3 13845 if dest_sem = -1 then
3 13846 fejlreaktion(2,k,<:vogntabel:>,0);
3 13847 disable signalch(dest_sem,op,d.op.optype);
3 13848 until false;
3 13849 h_vt_trap:
3 13850 disable skriv_h_vogntabel(zbillede,1);
3 13851 end h_vogntabel;
2 13852 \f
2 13852 message procedure vt_opdater side 1 - 810317/cl;
2 13853
2 13853 procedure vt_opdater(op1);
2 13854 value op1;
2 13855 integer op1;
2 13856 begin
3 13857 integer array field op,radop;
3 13858 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13859 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13860 flin,slin,finx,sinx;
3 13861 integer field bn,ll;
3 13862
3 13862 procedure skriv_vt_opd(zud,omfang);
3 13863 value omfang; integer omfang;
3 13864 zone zud;
3 13865 begin
4 13866 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13867 if omfang <> 0 then
4 13868 disable
4 13869 begin
5 13870 skriv_coru(zud,abs curr_coruno);
5 13871 write(zud,"nl",1,
5 13872 <: op: :>,op,"nl",1,
5 13873 <: radop::>,radop,"nl",1,
5 13874 <: funk: :>,funk,"nl",1,
5 13875 <: res: :>,res,"nl",1,
5 13876 <::>);
5 13877 end;
4 13878 end skriv_vt_opd;
3 13879
3 13879 integer procedure opd_omr(fnk,omr,bus,ll);
3 13880 value fnk,omr,bus,ll;
3 13881 integer fnk,omr,bus,ll;
3 13882 begin
4 13883 opd_omr:= 3;
4 13884 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13885 ændringer skal ikke længere meldes til yderområder *>
4 13886 goto dummy_retur;
4 13887
4 13887 if omr extract 8 > 3 then
4 13888 begin
5 13889 startoperation(radop,501,cs_vt_opd,fnk);
5 13890 d.radop.data(1):= omr;
5 13891 d.radop.data(2):= bus;
5 13892 d.radop.data(3):= ll;
5 13893 signalch(cs_rad,radop,vt_optype);
5 13894 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13895 opd_omr:= d.radop.resultat;
5 13896 end
4 13897 else
4 13898 opd_omr:= 0;
4 13899 dummy_retur:
4 13900 end;
3 13901 message procedure vt_opdater side 1a - 920517/cl;
3 13902
3 13902 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13903 value kilde,kode,bus,ll1,ll2;
3 13904 integer kilde,kode,bus,ll1,ll2;
3 13905 begin
4 13906 integer array field op;
4 13907
4 13907 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13908
4 13908 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13909 systime(1,0.0,d.op.data.v_tid);
4 13910 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13911 d.op.data.v_bus:= bus;
4 13912 d.op.data.v_ll1:= ll1;
4 13913 d.op.data.v_ll2:= ll2;
4 13914 signalch(cs_vt_log,op,vt_optype);
4 13915 end;
3 13916
3 13916 stackclaim((if cm_test then 198 else 146)+125);
3 13917
3 13917 bn:= 4; ll:= 2;
3 13918 radop:= op1;
3 13919 trap(vt_opd_trap);
3 13920
3 13920 <*+2*>
3 13921 <**> disable if testbit47 and overvåget or testbit28 then
3 13922 <**> skriv_vt_opd(out,0);
3 13923 <*-2*>
3 13924 \f
3 13924 message procedure vt_opdater side 2 - 851001/cl;
3 13925
3 13925 vent_op:
3 13926 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13927
3 13927 <*+2*>
3 13928 <**> disable
3 13929 <**> if testbit41 and overvåget then
3 13930 <**> begin
4 13931 <**> skriv_vt_opd(out,0);
4 13932 <**> write(out,<: modtaget operation:>);
4 13933 <**> skriv_op(out,op);
4 13934 <**> end;
3 13935 <*-2*>
3 13936
3 13936 <*+4*>
3 13937 <**>if op<>vt_op then
3 13938 <**>begin
4 13939 <**> disable begin
5 13940 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13941 <**> d.op.resultat:= 31; <*systemfejl*>
5 13942 <**> signalch(d.op.retur,op,d.op.optype);
5 13943 <**> end;
4 13944 <**> goto vent_op;
4 13945 <**>end;
3 13946 <*-4*>
3 13947 disable
3 13948 begin integer opk;
4 13949
4 13949 opk:= d.op.opkode extract 12;
4 13950 funk:= if opk=11 then 1 else
4 13951 if opk=12 then 2 else
4 13952 if opk=13 then 3 else
4 13953 if opk=19 then 4 else
4 13954 if opk=20 then 5 else
4 13955 if opk=24 then 6 else
4 13956 0;
4 13957 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13958 end;
3 13959 res:= 0;
3 13960 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13961 \f
3 13961 message procedure vt_opdater side 3 - 820301/cl;
3 13962
3 13962 indsæt:
3 13963 begin
4 13964 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13965 <*+4*>
4 13966 <**> if d.op.data(1) shift (-22) <> 0 then
4 13967 <**> begin
5 13968 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13969 <**> goto slut_indsæt;
5 13970 <**> end;
4 13971 <*-4*>
4 13972 busnr:= d.op.data(1) extract 14;
4 13973 <*+4*>
4 13974 <**> if d.op.data(2) shift (-22) <> 1 then
4 13975 <**> begin
5 13976 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13977 <**> goto slut_indsæt;
5 13978 <**> end;
4 13979 <*-4*>
4 13980 ll_id:= d.op.data(2);
4 13981 s:= omr:= d.op.data(4) extract 8;
4 13982 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13983 if bi<0 then
4 13984 begin
5 13985 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13986 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13987 end
4 13988 else
4 13989 if s<>0 and s<>omr then
4 13990 res:= 58 <* ulovligt område for bus *>
4 13991 else
4 13992 if intg(bustilstand(bi)) <> 0 then
4 13993 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 13994 else 14 <* optaget *>)
4 13995 else
4 13996 begin
5 13997 if linie_løb_indeks(bi) extract 12 <> 0 then
5 13998 begin <* linie/løb allerede indsat *>
6 13999 res:= 11;
6 14000 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 14001 end
5 14002 else
5 14003 begin
6 14004 \f
6 14004 message procedure vt_opdater side 3a - 900108/cl;
6 14005
6 14005 if d.op.kilde//100 <> 4 then
6 14006 res:= opd_omr(11,gar shift 8 +
6 14007 bustabel1(bi) extract 8,busnr,ll_id);
6 14008 if res>3 then goto slut_indsæt;
6 14009 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 14010 if s=0 then <* linie/løb findes allerede *>
6 14011 begin
7 14012 sig:= busindeks(li) extract 12;
7 14013 d.op.data(3):= bustabel(sig);
7 14014 linie_løb_indeks(sig):= false;
7 14015 disable modiffil(tf_vogntabel,sig,zi);
7 14016 fil(zi).ll:= 0;
7 14017 fil(zi).bn:= bustabel(sig) extract 14 add
7 14018 (bustabel1(sig) extract 8 shift 14);
7 14019 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 14020
7 14020 linie_løb_indeks(bi):= false add li;
7 14021 busindeks(li):= false add bi;
7 14022 disable modiffil(tf_vogntabel,bi,zi);
7 14023 fil(zi).ll:= ll_id;
7 14024 fil(zi).bn:= bustabel(bi) extract 14 add
7 14025 (bustabel1(bi) extract 8 shift 14);
7 14026 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 14027 res:= 3;
7 14028 end
6 14029 else
6 14030 begin
7 14031 \f
7 14031 message procedure vt_opdater side 4 - 810527/cl;
7 14032
7 14032 if s<0 then li:= li +1;
7 14033 if sidste_linie_løb=max_antal_linie_løb then
7 14034 begin
8 14035 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 14036 res:= 31;
8 14037 end
7 14038 else
7 14039 begin
8 14040 for i:= sidste_linie_løb step -1 until li do
8 14041 begin
9 14042 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 14043 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 14044 bus_indeks(i+1):=bus_indeks(i);
9 14045 end;
8 14046 sidste_linie_løb:= sidste_linie_løb +1;
8 14047 linie_løb_tabel(li):= ll_id;
8 14048 linie_løb_indeks(bi):= false add li;
8 14049 busindeks(li):= false add bi;
8 14050 disable s:= modiffil(tf_vogntabel,bi,zi);
8 14051 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 14052 fil(zi).bn:= busnr extract 14 add
8 14053 (bustabel1(bi) extract 8 shift 14);
8 14054 fil(zi).ll:= ll_id;
8 14055 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 14056 res:= 3; <* ok *>
8 14057 end;
7 14058 end;
6 14059 end;
5 14060 end;
4 14061 slut_indsæt:
4 14062 d.op.resultat:= res;
4 14063 end;
3 14064 goto returner;
3 14065 \f
3 14065 message procedure vt_opdater side 5 - 820301/cl;
3 14066
3 14066 udtag:
3 14067 begin
4 14068 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 14069
4 14069 busnr:= ll_id:= 0;
4 14070 omr:= s:= d.op.data(2) extract 8;
4 14071 format:= d.op.data(1) shift (-22);
4 14072 if format=0 then <*busnr*>
4 14073 begin
5 14074 busnr:= d.op.data(1) extract 14;
5 14075 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 14076 if bi<0 then
5 14077 begin
6 14078 if bi=-1 then res:= 10 else
6 14079 if s<>0 then res:= 58 else res:= 57;
6 14080 goto slut_udtag;
6 14081 end;
5 14082 if bi>0 and s<>0 and s<>omr then
5 14083 begin
6 14084 res:= 58; goto slut_udtag;
6 14085 end;
5 14086 li:= linie_løb_indeks(bi) extract 12;
5 14087 busnr:= bustabel(bi);
5 14088 if li=0 or linie_løb_tabel(li)=0 then
5 14089 begin <* bus ej indsat *>
6 14090 res:= 13;
6 14091 goto slut_udtag;
6 14092 end;
5 14093 ll_id:= linie_løb_tabel(li);
5 14094 end
4 14095 else
4 14096 if format=1 then <* linie_løb *>
4 14097 begin
5 14098 ll_id:= d.op.data(1);
5 14099 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 14100 if s<>0 then
5 14101 begin <* linie/løb findes ikke *>
6 14102 res:= 9;
6 14103 goto slut_udtag;
6 14104 end;
5 14105 bi:= busindeks(li) extract 12;
5 14106 busnr:= bustabel(bi);
5 14107 end
4 14108 else <* ulovlig identifikation *>
4 14109 begin
5 14110 res:= 31;
5 14111 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 14112 goto slut_udtag;
5 14113 end;
4 14114 \f
4 14114 message procedure vt_opdater side 6 - 820301/cl;
4 14115
4 14115 tilst:= intg(bustilstand(bi));
4 14116 if tilst<>0 then
4 14117 begin
5 14118 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 14119 goto slut_udtag;
5 14120 end;
4 14121 if d.op.kilde//100 <> 4 then
4 14122 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 14123 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 14124 if res>3 then goto slut_udtag;
4 14125 linie_løb_indeks(bi):= false;
4 14126 for i:= li step 1 until sidste_linie_løb -1 do
4 14127 begin
5 14128 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 14129 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 14130 bus_indeks(i):= bus_indeks(i+1);
5 14131 end;
4 14132 linie_løb_tabel(sidste_linie_løb):= 0;
4 14133 bus_indeks(sidste_linie_løb):= false;
4 14134 sidste_linie_løb:= sidste_linie_løb -1;
4 14135 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 14136 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 14137 fil(zi).ll:= 0;
4 14138 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 14139 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 14140 res:= 3; <* ok *>
4 14141 slut_udtag:
4 14142 d.op.resultat:= res;
4 14143 d.op.data(2):= ll_id;
4 14144 d.op.data(3):= busnr;
4 14145 end;
3 14146 goto returner;
3 14147 \f
3 14147 message procedure vt_opdater side 7 - 851001/cl;
3 14148
3 14148 omkod:
3 14149 flyt:
3 14150 roker:
3 14151 begin
4 14152 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 14153
4 14153 inf1:= inf2:= 0;
4 14154 ll_id1:= d.op.data(1);
4 14155 ll_id2:= d.op.data(2);
4 14156 if ll_id1=ll_id2 then
4 14157 begin
5 14158 res:= 24; inf1:= ll_id2;
5 14159 goto slut_flyt;
5 14160 end;
4 14161 <*+4*>
4 14162 <**> for i:= 1,2 do
4 14163 <**> if d.op.data(i) shift (-22) <> 1 then
4 14164 <**> begin
5 14165 <**> res:= 31;
5 14166 <**> fejlreaktion(10,d.op.data(i),case i of (
5 14167 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 14168 <**> goto slut_flyt;
5 14169 <**> end;
4 14170 <*-4*>
4 14171
4 14171 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 14172 if s<>0 and funk=6 <* roker *> then
4 14173 begin
5 14174 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 14175 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 14176 end;
4 14177 if s<>0 then
4 14178 begin
5 14179 res:= 9; <* ukendt linie/løb *>
5 14180 goto slut_flyt;
5 14181 end;
4 14182 bi1:= busindeks(li1) extract 12;
4 14183 inf1:= bustabel(bi1);
4 14184 tilst:= intg(bustilstand(bi1));
4 14185 if tilst<>0 then <* bus ikke fri *>
4 14186 begin
5 14187 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 14188 goto slut_flyt;
5 14189 end;
4 14190 \f
4 14190 message procedure vt_opdater side 7a- 851001/cl;
4 14191 if d.op.kilde//100 <> 4 then
4 14192
4 14192 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 14193 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 14194 if res>3 then goto slut_flyt;
4 14195
4 14195 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 14196 if s=0 then
4 14197 begin <* ll_id2 er indkodet *>
5 14198 bi2:= busindeks(li2) extract 12;
5 14199 inf2:= bustabel(bi2);
5 14200 tilst:= intg(bustilstand(bi2));
5 14201 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 14202 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 14203 if res>3 then
5 14204 begin
6 14205 inf1:= inf2; inf2:= 0;
6 14206 goto slut_flyt;
6 14207 end;
5 14208
5 14208 if d.op.kilde//100 <> 4 then
5 14209 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 14210 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 14211 if res>3 then goto slut_flyt;
5 14212
5 14212 <* flyt bus *>
5 14213 if funk=6 then
5 14214 linie_løb_indeks(bi2):= false add li1
5 14215 else
5 14216 linie_løb_indeks(bi2):= false;
5 14217 linie_løb_indeks(bi1):= false add li2;
5 14218 if funk=6 then
5 14219 busindeks(li1):= false add bi2
5 14220 else
5 14221 busindeks(li1):= false;
5 14222 busindeks(li2):= false add bi1;
5 14223
5 14223 if funk<>6 then
5 14224 begin
6 14225 <* fjern ll_id1 *>
6 14226 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 14227 begin
7 14228 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 14229 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 14230 busindeks(i):= busindeks(i+1);
7 14231 end;
6 14232 linie_løb_tabel(sidste_linie_løb):= 0;
6 14233 bus_indeks(sidste_linie_løb):= false;
6 14234 sidste_linie_løb:= sidste_linie_løb-1;
6 14235 end;
5 14236
5 14236 <* opdater vogntabelfil *>
5 14237 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 14238 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14239 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 14240 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 14241 if funk=6 then
5 14242 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 14243 else
5 14244 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 14245 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14246 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14247 fil(zi).ll:= ll_id2;
5 14248 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14249 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14250 \f
5 14250 message procedure vt_opdater side 8 - 820301/cl;
5 14251
5 14251 end <* ll_id2 indkodet *>
4 14252 else
4 14253 begin
5 14254 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 14255 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 14256 pm1:= sgn(li2-li1);
5 14257 for i:= li1 step pm1 until li2-pm1 do
5 14258 begin
6 14259 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 14260 busindeks(i):= busindeks(i+pm1);
6 14261 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 14262 end;
5 14263 linie_løb_tabel(li2):= ll_id2;
5 14264 busindeks(li2):= false add bi1;
5 14265 linie_løb_indeks(bi1):= false add li2;
5 14266 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14267 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14268 fil(zi).ll:= ll_id2;
5 14269 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14270 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14271 end;
4 14272 res:= 3; <*udført*>
4 14273 slut_flyt:
4 14274 d.op.resultat:= res;
4 14275 d.op.data(3):= inf1;
4 14276 if funk=5 then d.op.data(4):= inf2;
4 14277 end;
3 14278 goto returner;
3 14279 \f
3 14279 message procedure vt_opdater side 9 - 851001/cl;
3 14280
3 14280 slet:
3 14281 begin
4 14282 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 14283 boolean test24;
4 14284
4 14284 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 14285 omr:= d.op.data(3);
4 14286
4 14286 if d.op.data(1) > d.op.data(2) then
4 14287 begin
5 14288 res:= 44; <* intervalstørrelse ulovlig *>
5 14289 goto slut_slet;
5 14290 end;
4 14291
4 14291 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 14292 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 14293
4 14293 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 14294 if s<0 then finx:= finx+1;
4 14295 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 14296 if s>0 then sinx:= sinx-1;
4 14297
4 14297 for li:= finx step 1 until sinx do
4 14298 begin
5 14299 bi:= busindeks(li) extract 12;
5 14300 gar:= bustabel(bi) shift (-14) extract 8;
5 14301 if intg(bustilstand(bi))=0 and
5 14302 (omr = 0 or (omr > 0 and omr = gar) or
5 14303 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 14304 begin
6 14305 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 14306 linie_løb_indeks(bi):= busindeks(li):= false;
6 14307 linie_løb_tabel(li):= 0;
6 14308 end;
5 14309 end;
4 14310 \f
4 14310 message procedure vt_opdater side 10 - 850820/cl;
4 14311
4 14311 sinx:= finx-1;
4 14312 for li:= finx step 1 until sidste_linie_løb do
4 14313 begin
5 14314 if linie_løb_tabel(li)<>0 then
5 14315 begin
6 14316 sinx:= sinx+1;
6 14317 if sinx<>li then
6 14318 begin
7 14319 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 14320 busindeks(sinx):= busindeks(li);
7 14321 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 14322 linie_løb_tabel(li):= 0;
7 14323 busindeks(li):= false;
7 14324 end;
6 14325 end;
5 14326 end;
4 14327 sidste_linie_løb:= sinx;
4 14328
4 14328 test24:= testbit24; testbit24:= false;
4 14329 for bi:= 1 step 1 until sidste_bus do
4 14330 disable
4 14331 begin
5 14332 s:= modiffil(tf_vogntabel,bi,finx);
5 14333 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 14334 fil(finx).bn:= bustabel(bi) extract 14 add
5 14335 (bustabel1(bi) extract 8 shift 14);
5 14336 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 14337 end;
4 14338 testbit24:= test24;
4 14339 res:= 3;
4 14340
4 14340 slut_slet:
4 14341 d.op.resultat:= res;
4 14342 end;
3 14343 goto returner;
3 14344 \f
3 14344 message procedure vt_opdater side 11 - 810409/cl;
3 14345
3 14345 returner:
3 14346 disable
3 14347 begin
4 14348
4 14348 <*+2*>
4 14349 <**> if testbit40 and overvåget then
4 14350 <**> begin
5 14351 <**> skriv_vt_opd(out,0);
5 14352 <**> write(out,<: vogntabel efter ændring:>);
5 14353 <**> p_vogntabel(out);
5 14354 <**> end;
4 14355 <**> if testbit41 and overvåget then
4 14356 <**> begin
5 14357 <**> skriv_vt_opd(out,0);
5 14358 <**> write(out,<: returner operation:>);
5 14359 <**> skriv_op(out,op);
5 14360 <**> end;
4 14361 <*-2*>
4 14362
4 14362 signalch(d.op.retur,op,d.op.optype);
4 14363 end;
3 14364 goto vent_op;
3 14365
3 14365 vt_opd_trap:
3 14366 disable skriv_vt_opd(zbillede,1);
3 14367
3 14367 end vt_opdater;
2 14368 \f
2 14368 message procedure vt_tilstand side 1 - 810424/cl;
2 14369
2 14369 procedure vt_tilstand(cs_fil,fil_opref);
2 14370 value cs_fil,fil_opref;
2 14371 integer cs_fil,fil_opref;
2 14372 begin
3 14373 integer array field op,filop;
3 14374 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14375 g_type,gr,antal,ej_res,zi,li,filref;
3 14376 integer array identer(1:max_antal_i_gruppe);
3 14377
3 14377 procedure skriv_vt_tilst(zud,omfang);
3 14378 value omfang;
3 14379 zone zud;
3 14380 integer omfang;
3 14381 begin
4 14382 real array field raf;
4 14383 raf:= 0;
4 14384 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14385 if omfang <> 0 then
4 14386 begin
5 14387 skriv_coru(zud,abs curr_coruno);
5 14388 write(zud,"nl",1,<<d>,
5 14389 <:cs-fil :>,cs_fil,"nl",1,
5 14390 <:filop :>,filop,"nl",1,
5 14391 <:op :>,op,"nl",1,
5 14392 <:funk :>,funk,"nl",1,
5 14393 <:format :>,format,"nl",1,
5 14394 <:busid :>,busid,"nl",1,
5 14395 <:res :>,res,"nl",1,
5 14396 <:bi :>,bi,"nl",1,
5 14397 <:tilst :>,tilst,"nl",1,
5 14398 <:opk :>,opk,"nl",1,
5 14399 <:opk-indeks :>,opk_indeks,"nl",1,
5 14400 <:g-type :>,g_type,"nl",1,
5 14401 <:gr :>,gr,"nl",1,
5 14402 <:antal :>,antal,"nl",1,
5 14403 <:ej-res :>,ej_res,"nl",1,
5 14404 <:zi :>,zi,"nl",1,
5 14405 <:li :>,li,"nl",1,
5 14406 <::>);
5 14407 write(zud,"nl",1,<:identer:>);
5 14408 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14409 end;
4 14410 end;
3 14411
3 14411 procedure sorter_gruppe(tab,l,u);
3 14412 value l,u;
3 14413 integer array tab;
3 14414 integer l,u;
3 14415 begin
4 14416 integer array field ii,jj;
4 14417 integer array ww, xx(1:2);
4 14418
4 14418 integer procedure sml(a,b);
4 14419 integer array a,b;
4 14420 begin
5 14421 integer res;
5 14422
5 14422 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14423 if res = 0 then
5 14424 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14425 if res = 0 then
5 14426 res:=
5 14427 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14428 if res = 0 then
5 14429 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14430 sml:= res;
5 14431 end;
4 14432
4 14432 ii:= ((l+u)//2 - 1)*4;
4 14433 tofrom(xx,tab.ii,4);
4 14434 ii:= (l-1)*4; jj:= (u-1)*4;
4 14435 repeat
4 14436 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14437 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14438 if ii <= jj then
4 14439 begin
5 14440 tofrom(ww,tab.ii,4);
5 14441 tofrom(tab.ii,tab.jj,4);
5 14442 tofrom(tab.jj,ww,4);
5 14443 ii:= ii+4;
5 14444 jj:= jj-4;
5 14445 end;
4 14446 until ii>jj;
4 14447 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14448 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14449 end;
3 14450 \f
3 14450 message procedure vt_tilstand side 2 - 820301/cl;
3 14451
3 14451 filop:= filopref;
3 14452 stackclaim(if cm_test then 550 else 500);
3 14453 trap(vt_tilst_trap);
3 14454
3 14454 <*+2*>
3 14455 <**> disable if testbit47 and overvåget or testbit28 then
3 14456 <**> skriv_vt_tilst(out,0);
3 14457 <*-2*>
3 14458
3 14458 vent_op:
3 14459 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14460 <*+2*>disable
3 14461 <**> if (testbit41 and overvåget) or
3 14462 (testbit46 and overvåget and
3 14463 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14464 then
3 14465 <**> begin
4 14466 <**> skriv_vt_tilst(out,0);
4 14467 <**> write(out,<: modtaget operation:>);
4 14468 <**> skriv_op(out,op);
4 14469 <**> end;
3 14470 <*-2*>
3 14471
3 14471 <*+4*>
3 14472 <**> if op <> vt_op then
3 14473 <**> begin
4 14474 <**> disable begin
5 14475 <**> d.op.resultat:= 31;
5 14476 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14477 <**> end;
4 14478 <**> goto returner;
4 14479 <**> end;
3 14480 <*-4*>
3 14481
3 14481 opk:= d.op.opkode extract 12;
3 14482 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14483 if opk = 15 <*bus res *> then 2 else
3 14484 if opk = 16 <*grp res *> then 4 else
3 14485 if opk = 17 <*bus fri *> then 3 else
3 14486 if opk = 18 <*grp fri *> then 5 else
3 14487 0;
3 14488 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14489 res:= 0;
3 14490 format:= d.op.data(1) shift (-22);
3 14491
3 14491 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14492 \f
3 14492 message procedure vt_tilstand side 3 - 820301/cl;
3 14493
3 14493 enkelt_bus:
3 14494 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14495 disable
3 14496 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14497 <*+4*>
4 14498 <**>if format <> 0 and format <> 1 then
4 14499 <**>begin
5 14500 <**> res:= 31;
5 14501 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14502 <**> goto slut_enkelt_bus;
5 14503 <**>end;
4 14504 <*-4*>
4 14505 <* find busnr og tilstand *>
4 14506 case format+1 of
4 14507 begin
5 14508 <* 0: budident *>
5 14509 begin
6 14510 busnr:= d.op.data(1) extract 14;
6 14511 s:= omr:= d.op.data(4) extract 8;
6 14512 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14513 if bi<0 then
6 14514 begin
7 14515 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14516 goto slut_enkelt_bus;
7 14517 end
6 14518 else
6 14519 begin
7 14520 tilst:= intg(bustilstand(bi));
7 14521 end;
6 14522 end;
5 14523
5 14523 <* 1: linie_løb_ident *>
5 14524 begin
6 14525 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14526 if bi < 0 then <* ukendt linie_løb *>
6 14527 begin
7 14528 res:= 9;
7 14529 goto slut_enkelt_bus;
7 14530 end;
6 14531 end;
5 14532 end case;
4 14533 \f
4 14533 message procedure vt_tilstand side 4 - 830310/cl;
4 14534
4 14534 if funk < 3 then
4 14535 begin
5 14536 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14537 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14538 else 0;
5 14539 d.op.data(3):= bustabel(bi);
5 14540 d.op.data(4):= bustabel1(bi);
5 14541 end;
4 14542
4 14542 <* check tilstand *>
4 14543 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14544 res:= 39 <* bus ikke reserveret *>
4 14545 else
4 14546 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14547 res:= 14 <* bus optaget *>
4 14548 else
4 14549 if funk = 1 <* i kø *> and tilst = (-1) then
4 14550 res:= 18 <* i kø *>
4 14551 else
4 14552 res:= 3; <*udført*>
4 14553
4 14553 if res = 3 then
4 14554 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14555
4 14555 slut_enkelt_bus:
4 14556 d.op.resultat:= res;
4 14557 end <*disable*>;
3 14558 goto returner;
3 14559 \f
3 14559 message procedure vt_tilstand side 5 - 810424/cl;
3 14560
3 14560 grp_res: <* reserver gruppe *>
3 14561 disable
3 14562 begin
4 14563
4 14563 <*+4*>
4 14564 <**> if format <> 2 then
4 14565 <**> begin
5 14566 <**> res:= 31;
5 14567 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14568 <**> goto slut_grp_res_1;
5 14569 <**> end;
4 14570 <*-4*>
4 14571
4 14571 <* find frit indeks i opkaldstabel *>
4 14572 opk_indeks:= 0;
4 14573 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14574 begin
5 14575 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14576 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14577 end;
4 14578 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14579 if res <> 0 then goto slut_grp_res_1;
4 14580 g_type:= d.op.data(1) shift (-21) extract 1;
4 14581 if g_type = 1 <*special gruppe*> then
4 14582 begin <*check eksistens*>
5 14583 gr:= 0;
5 14584 for i:= 1 step 1 until max_antal_grupper do
5 14585 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14586 if gr = 0 then <*gruppe ukendt*>
5 14587 begin
6 14588 res:= 8;
6 14589 goto slut_grp_res_1;
6 14590 end;
5 14591 end;
4 14592
4 14592 <* reserver i opkaldstabel *>
4 14593 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14594 \f
4 14594 message procedure vt_tilstand side 6 - 810428/cl;
4 14595
4 14595 <* tilknyt fil *>
4 14596 start_operation(filop,curr_coruid,cs_fil,101);
4 14597 d.filop.data(1):= 0; <*postantal*>
4 14598 d.filop.data(2):= 256; <*postlængde*>
4 14599 d.filop.data(3):= 1; <*segmentantal*>
4 14600 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14601 signalch(cs_opret_fil,filop,vt_optype);
4 14602
4 14602 slut_grp_res_1:
4 14603 if res <> 0 then d.op.resultat:= res;
4 14604 end;
3 14605 if res <> 0 then goto returner;
3 14606
3 14606 waitch(cs_fil,filop,vt_optype,-1);
3 14607
3 14607 <* check filsys-resultat *>
3 14608 if d.filop.data(9) <> 0 then
3 14609 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14610 filref:= d.filop.data(4);
3 14611 \f
3 14611 message procedure vt_tilstand side 7 - 820301/cl;
3 14612 disable if g_type = 0 <*linie-gruppe*> then
3 14613 begin
4 14614 integer s,i,ll_id;
4 14615 integer array field iaf1;
4 14616
4 14616 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14617 iaf1:= 2;
4 14618 s:= binærsøg(sidste_linie_løb,
4 14619 linie_løb_tabel(i) - ll_id, i);
4 14620 if s < 0 then i:= i +1;
4 14621 antal:= ej_res:= 0;
4 14622 skrivfil(filref,1,zi);
4 14623 if i <= sidste_linie_løb then
4 14624 begin
5 14625 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14626 begin
6 14627 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14628 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14629 ej_res:= ej_res+1
6 14630 else
6 14631 begin
7 14632 antal:= antal+1;
7 14633 bi:= busindeks(i) extract 12;
7 14634 fil(zi).iaf1(1):=
7 14635 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14636 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14637 fil(zi).iaf1(2):= bustabel(bi);
7 14638 iaf1:= iaf1+4;
7 14639 bustilstand(bi):= false add opk_indeks;
7 14640 end;
6 14641 i:= i +1;
6 14642 if i > sidste_linie_løb then goto slut_l_grp;
6 14643 end;
5 14644 end;
4 14645 \f
4 14645 message procedure vt_tilstand side 8 - 820301/cl;
4 14646
4 14646 slut_l_grp:
4 14647 end
3 14648 else
3 14649 begin <*special gruppe*>
4 14650 integer i,s,li,omr,gar,tilst;
4 14651 integer array field iaf1;
4 14652
4 14652 iaf1:= 2;
4 14653 antal:= ej_res:= 0;
4 14654 s:= læsfil(tf_gruppedef,gr,zi);
4 14655 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14656 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14657 s:= skrivfil(filref,1,zi);
4 14658 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14659 i:= 1;
4 14660 while identer(i) <> 0 do
4 14661 begin
5 14662 if identer(i) shift (-22) = 0 then
5 14663 begin <*busident*>
6 14664 omr:= 0;
6 14665 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14666 if bi<0 then goto næste_ident;
6 14667 li:= linie_løb_indeks(bi) extract 12;
6 14668 end
5 14669 else
5 14670 begin <*linie/løb ident*>
6 14671 s:= binærsøg(sidste_linie_løb,
6 14672 linie_løb_tabel(li) - identer(i), li);
6 14673 if s <> 0 then goto næste_ident;
6 14674 bi:= busindeks(li) extract 12;
6 14675 end;
5 14676 if (intg(bustilstand(bi))<>0) or
5 14677 (bustabel1(bi) extract 8 <> 3) then
5 14678 ej_res:= ej_res+1
5 14679 else
5 14680 begin
6 14681 antal:= antal +1;
6 14682 fil(zi).iaf1(1):=
6 14683 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14684 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14685 fil(zi).iaf1(2):= bustabel(bi);
6 14686 iaf1:= iaf1+4;
6 14687 bustilstand(bi):= false add opk_indeks;
6 14688 end;
5 14689 næste_ident:
5 14690 i:= i +1;
5 14691 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14692 end;
4 14693 slut_s_grp:
4 14694 end;
3 14695 \f
3 14695 message procedure vt_tilstand side 9 - 820301/cl;
3 14696
3 14696 if antal > 0 then <*ok*>
3 14697 disable begin
4 14698 integer array field spec,akt;
4 14699 integer a;
4 14700 integer field antal_spec;
4 14701
4 14701 antal_spec:= 2; a:= 0;
4 14702 spec:= 2; akt:= 2;
4 14703 sorter_gruppe(fil(zi).spec,1,antal);
4 14704 fil(zi).antal_spec:= 0;
4 14705 while akt//4 < antal do
4 14706 begin
5 14707 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14708 a:= 0;
5 14709 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14710 and a<15 do
5 14711 begin
6 14712 a:= a+1;
6 14713 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14714 akt:= akt+4;
6 14715 end;
5 14716 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14717 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14718 spec:= spec + 2*a + 2;
5 14719 end;
4 14720 antal:= fil(zi).antal_spec;
4 14721 gruppeopkald(opk_indeks,2):= filref;
4 14722 d.op.resultat:= 3;
4 14723 d.op.data(2):= antal;
4 14724 d.op.data(3):= filref;
4 14725 d.op.data(4):= ej_res;
4 14726 end
3 14727 else
3 14728 begin
4 14729 disable begin
5 14730 d.filop.opkode:= 104; <*slet fil*>
5 14731 signalch(cs_slet_fil,filop,vt_optype);
5 14732 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14733 d.op.resultat:= 54;
5 14734 d.op.data(2):= antal;
5 14735 d.op.data(3):= 0;
5 14736 d.op.data(4):= ej_res;
5 14737 end;
4 14738 waitch(cs_fil,filop,vt_optype,-1);
4 14739 if d.filop.data(9) <> 0 then
4 14740 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14741 end;
3 14742 goto returner;
3 14743 \f
3 14743 message procedure vt_tilstand side 10 - 820301/cl;
3 14744
3 14744 grp_fri: <* frigiv gruppe *>
3 14745 disable
3 14746 begin integer i,j,s,ll,gar,omr,tilst;
4 14747 integer array field spec;
4 14748
4 14748 <*+4*>
4 14749 <**> if format <> 2 then
4 14750 <**> begin
5 14751 <**> res:= 31;
5 14752 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14753 <**> goto slut_grp_fri;
5 14754 <**> end;
4 14755 <*-4*>
4 14756
4 14756 <* find indeks i opkaldstabel *>
4 14757 opk_indeks:= 0;
4 14758 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14759 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14760 if opk_indeks = 0 <*ikke fundet*> then
4 14761 begin
5 14762 res:= 40; <*gruppe ej reserveret*>
5 14763 goto slut_grp_fri;
5 14764 end;
4 14765 filref:= gruppeopkald(opk_indeks,2);
4 14766 start_operation(filop,curr_coruid,cs_fil,104);
4 14767 d.filop.data(4):= filref;
4 14768 hentfildim(d.filop.data);
4 14769 læsfil(filref,1,zi);
4 14770 spec:= 0;
4 14771 antal:= fil(zi).spec(1);
4 14772 spec:= spec+2;
4 14773 for i:= 1 step 1 until antal do
4 14774 begin
5 14775 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14776 begin
6 14777 busid:= fil(zi).spec(1+j) extract 14;
6 14778 omr:= 0;
6 14779 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14780 if bi>=0 then bustilstand(bi):= false;
6 14781 end;
5 14782 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14783 end;
4 14784
4 14784 slut_grp_fri:
4 14785 d.op.resultat:= res;
4 14786 end;
3 14787 if res <> 0 then goto returner;
3 14788 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14789 signalch(cs_slet_fil,filop,vt_optype);
3 14790 \f
3 14790 message procedure vt_tilstand side 11 - 810424/cl;
3 14791
3 14791 waitch(cs_fil,filop,vt_optype,-1);
3 14792
3 14792 if d.filop.data(9) <> 0 then
3 14793 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14794 d.op.resultat:= 3;
3 14795
3 14795 returner:
3 14796 disable
3 14797 begin
4 14798 <*+2*>
4 14799 <**> if testbit40 and overvåget then
4 14800 <**> begin
5 14801 <**> skriv_vt_tilst(out,0);
5 14802 <**> write(out,<: vogntabel efter ændring:>);
5 14803 <**> p_vogntabel(out);
5 14804 <**> end;
4 14805 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14806 <**> begin
5 14807 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14808 <**> p_gruppetabel(out);
5 14809 <**> end;
4 14810 <**> if (testbit41 and overvåget) or
4 14811 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14812 <**> begin
5 14813 <**> skriv_vt_tilst(out,0);
5 14814 <**> write(out,<: returner operation:>);
5 14815 <**> skriv_op(out,op);
5 14816 <**> end;
4 14817 <*-2*>
4 14818 signalch(d.op.retur,op,d.op.optype);
4 14819 end;
3 14820 goto vent_op;
3 14821
3 14821 vt_tilst_trap:
3 14822 disable skriv_vt_tilst(zbillede,1);
3 14823
3 14823 end vt_tilstand;
2 14824 \f
2 14824 message procedure vt_rapport side 1 - 810428/cl;
2 14825
2 14825 procedure vt_rapport(cs_fil,fil_opref);
2 14826 value cs_fil,fil_opref;
2 14827 integer cs_fil,fil_opref;
2 14828 begin
3 14829 integer array field op,filop;
3 14830 integer funk,filref,antal,id_ant,res;
3 14831 integer field i1,i2;
3 14832
3 14832 procedure skriv_vt_rap(z,omfang);
3 14833 value omfang;
3 14834 zone z;
3 14835 integer omfang;
3 14836 begin
4 14837 write(z,"nl",1,<:+++ vt_rapport :>);
4 14838 if omfang <> 0 then
4 14839 begin
5 14840 skriv_coru(z,abs curr_coruno);
5 14841 write(z,"nl",1,<<d>,
5 14842 <: cs_fil :>,cs_fil,"nl",1,
5 14843 <: filop :>,filop,"nl",1,
5 14844 <: op :>,op,"nl",1,
5 14845 <: funk :>,funk,"nl",1,
5 14846 <: filref :>,filref,"nl",1,
5 14847 <: antal :>,antal,"nl",1,
5 14848 <: id-ant :>,id_ant,"nl",1,
5 14849 <: res :>,res,"nl",1,
5 14850 <::>);
5 14851
5 14851 end;
4 14852 end skriv_vt_rap;
3 14853
3 14853 stackclaim(if cm_test then 198 else 146);
3 14854 filop:= fil_opref;
3 14855 i1:= 2; i2:= 4;
3 14856 trap(vt_rap_trap);
3 14857
3 14857 <*+2*>
3 14858 <**> disable if testbit47 and overvåget or testbit28 then
3 14859 <**> skriv_vt_rap(out,0);
3 14860 <*-2*>
3 14861 \f
3 14861 message procedure vt_rapport side 2 - 810505/cl;
3 14862
3 14862 vent_op:
3 14863 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14864
3 14864 <*+2*>
3 14865 <**> disable begin
4 14866 <**> if testbit41 and overvåget then
4 14867 <**> begin
5 14868 <**> skriv_vt_rap(out,0);
5 14869 <**> write(out,<: modtaget operation:>);
5 14870 <**> skriv_op(out,op);
5 14871 <**> ud;
5 14872 <**> end;
4 14873 <**> end;<*disable*>
3 14874 <*-2*>
3 14875
3 14875 disable
3 14876 begin
4 14877 integer opk;
4 14878
4 14878 opk:= d.op.opkode extract 12;
4 14879 funk:= if opk = 9 then 1 else
4 14880 if opk =10 then 2 else
4 14881 0;
4 14882 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14883
4 14883 <* opret og tilknyt fil *>
4 14884 start_operation(filop,curr_coruid,cs_fil,101);
4 14885 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14886 d.filop.data(2):= 2; <*postlængde*>
4 14887 d.filop.data(3):=10; <*segmenter*>
4 14888 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14889 signalch(cs_opretfil,filop,vt_optype);
4 14890 end;
3 14891
3 14891 waitch(cs_fil,filop,vt_optype,-1);
3 14892
3 14892 <* check resultat *>
3 14893 if d.filop.data(9) <> 0 then
3 14894 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14895 filref:= d.filop.data(4);
3 14896 antal:= 0;
3 14897 goto case funk of (l_rapport,b_rapport);
3 14898 \f
3 14898 message procedure vt_rapport side 3 - 850820/cl;
3 14899
3 14899 l_rapport:
3 14900 disable
3 14901 begin
4 14902 integer i,j,s,ll,zi;
4 14903 idant:= 0;
4 14904 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14905 <*+4*>
4 14906 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14907 <**> begin
5 14908 <**> res:= 31;
5 14909 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14910 <**> goto l_rap_slut;
5 14911 <**> end;
4 14912 <*-4*>
4 14913 ;
4 14914
4 14914 for i:= 1 step 1 until id_ant do
4 14915 begin
5 14916 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14917 s:= binærsøg(sidste_linie_løb,
5 14918 linie_løb_tabel(j) - ll, j);
5 14919 if s < 0 then j:= j +1;
5 14920
5 14920 if j<= sidste_linie_løb then
5 14921 begin <* skriv identer *>
6 14922 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14923 begin
7 14924 antal:= antal +1;
7 14925 s:= skrivfil(filref,antal,zi);
7 14926 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14927 fil(zi).i1:= linie_løb_tabel(j);
7 14928 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14929 j:= j +1;
7 14930 if j > sidste_bus then goto linie_slut;
7 14931 end;
6 14932 end;
5 14933 linie_slut:
5 14934 end;
4 14935 res:= 3;
4 14936 l_rap_slut:
4 14937 end <*disable*>;
3 14938 goto returner;
3 14939 \f
3 14939 message procedure vt_rapport side 4 - 820301/cl;
3 14940
3 14940 b_rapport:
3 14941 disable
3 14942 begin
4 14943 integer i,j,s,zi,busnr1,busnr2;
4 14944 <*+4*>
4 14945 <**> for i:= 1,2 do
4 14946 <**> if d.op.data(i) shift (-14) <> 0 then
4 14947 <**> begin
5 14948 <**> res:= 31;
5 14949 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14950 <**> goto bus_slut;
5 14951 <**> end;
4 14952 <*-4*>
4 14953
4 14953 busnr1:= d.op.data(1) extract 14;
4 14954 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14955 if busnr1 = 0 or busnr2 < busnr1 then
4 14956 begin
5 14957 res:= 7; <* fejl i busnr *>
5 14958 goto bus_slut;
5 14959 end;
4 14960
4 14960 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14961 - busnr1,j);
4 14962 if s < 0 then j:= j +1;
4 14963 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14964 if j <= sidste_bus then
4 14965 begin <* skriv identer *>
5 14966 while bustabel(j) extract 14 <= busnr2 do
5 14967 begin
6 14968 i:= linie_løb_indeks(j) extract 12;
6 14969 if i<>0 then
6 14970 begin
7 14971 antal:= antal +1;
7 14972 s:= skriv_fil(filref,antal,zi);
7 14973 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14974 fil(zi).i1:= bustabel(j);
7 14975 fil(zi).i2:= linie_løb_tabel(i);
7 14976 end;
6 14977 j:= j +1;
6 14978 if j > sidste_bus then goto bus_slut;
6 14979 end;
5 14980 end;
4 14981 bus_slut:
4 14982 end <*disable*>;
3 14983 res:= 3; <*ok*>
3 14984 \f
3 14984 message procedure vt_rapport side 5 - 810409/cl;
3 14985
3 14985 returner:
3 14986 disable
3 14987 begin
4 14988 d.op.resultat:= res;
4 14989 d.op.data(6):= antal;
4 14990 d.op.data(7):= filref;
4 14991 d.filop.data(1):= antal;
4 14992 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 14993 i:= sæt_fil_dim(d.filop.data);
4 14994 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 14995 <*+2*>
4 14996 <**> if testbit41 and overvåget then
4 14997 <**> begin
5 14998 <**> skriv_vt_rap(out,0);
5 14999 <**> write(out,<: returner operation:>);
5 15000 <**> skriv_op(out,op);
5 15001 <**> end;
4 15002 <*-2*>
4 15003 signalch(d.op.retur,op,d.op.optype);
4 15004 end;
3 15005 goto vent_op;
3 15006
3 15006 vt_rap_trap:
3 15007 disable skriv_vt_rap(zbillede,1);
3 15008
3 15008 end vt_rapport;
2 15009 \f
2 15009 message procedure vt_gruppe side 1 - 810428/cl;
2 15010
2 15010 procedure vt_gruppe(cs_fil,fil_opref);
2 15011
2 15011 value cs_fil,fil_opref;
2 15012 integer cs_fil,fil_opref;
2 15013 begin
3 15014 integer array field op, fil_op, iaf;
3 15015 integer funk, res, filref, gr, i, antal, zi, s;
3 15016 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 15017 max_antal_grupper else max_antal_i_gruppe));
3 15018
3 15018 procedure skriv_vt_gruppe(zud,omfang);
3 15019 value omfang;
3 15020 integer omfang;
3 15021 zone zud;
3 15022 begin
4 15023 integer øg;
4 15024
4 15024 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 15025 if omfang <> 0 then
4 15026 disable
4 15027 begin
5 15028 skriv_coru(zud,abs curr_coruno);
5 15029 write(zud,"nl",1,<<d>,
5 15030 <: cs_fil :>,cs_fil,"nl",1,
5 15031 <: op :>,op,"nl",1,
5 15032 <: filop :>,filop,"nl",1,
5 15033 <: funk :>,funk,"nl",1,
5 15034 <: res :>,res,"nl",1,
5 15035 <: filref :>,filref,"nl",1,
5 15036 <: gr :>,gr,"nl",1,
5 15037 <: i :>,i,"nl",1,
5 15038 <: antal :>,antal,"nl",1,
5 15039 <: zi :>,zi,"nl",1,
5 15040 <: s :>,s,"nl",1,
5 15041 <::>);
5 15042 raf:= 0;
5 15043 system(3,øg,identer);
5 15044 write(zud,"nl",1,<:identer::>);
5 15045 skriv_hele(zud,identer.raf,øg*2,2);
5 15046 end;
4 15047 end;
3 15048
3 15048 stackclaim(if cm_test then 198 else 146);
3 15049 filop:= fil_opref;
3 15050 trap(vt_grp_trap);
3 15051 iaf:= 0;
3 15052 \f
3 15052 message procedure vt_gruppe side 2 - 810409/cl;
3 15053
3 15053 <*+2*>
3 15054 <**> disable if testbit47 and overvåget or testbit28 then
3 15055 <**> skriv_vt_gruppe(out,0);
3 15056 <*-2*>
3 15057
3 15057 vent_op:
3 15058 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 15059 <*+2*>
3 15060 <**>disable
3 15061 <**>begin
4 15062 <**> if testbit41 and overvåget then
4 15063 <**> begin
5 15064 <**> skriv_vt_gruppe(out,0);
5 15065 <**> write(out,<: modtaget operation:>);
5 15066 <**> skriv_op(out,op);
5 15067 <**> ud;
5 15068 <**> end;
4 15069 <**>end;
3 15070 <*-2*>
3 15071
3 15071 disable
3 15072 begin
4 15073 integer opk;
4 15074
4 15074 opk:= d.op.opkode extract 12;
4 15075 funk:= if opk=25 then 1 else
4 15076 if opk=26 then 2 else
4 15077 if opk=27 then 3 else
4 15078 if opk=28 then 4 else
4 15079 0;
4 15080 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 15081 end;
3 15082 <*+4*>
3 15083 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 15084 <**> begin
4 15085 <**> disable begin
5 15086 <**> d.op.resultat:= 31;
5 15087 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 15088 <**> end;
4 15089 <**> goto returner;
4 15090 <**> end;
3 15091 <*-4*>
3 15092
3 15092 goto case funk of(definer,slet,vis,oversigt);
3 15093 \f
3 15093 message procedure vt_gruppe side 3 - 810505/cl;
3 15094
3 15094 definer:
3 15095 disable
3 15096 begin
4 15097 gr:= 0; res:= 0;
4 15098 for i:= max_antal_grupper step -1 until 1 do
4 15099 begin
5 15100 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 15101 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 15102 end;
4 15103 if gr=0 then res:= 32; <*ingen plads*>
4 15104 end;
3 15105 if res<>0 then goto slut_definer;
3 15106 disable
3 15107 begin <*fri plads fundet*>
4 15108 antal:= d.op.data(2);
4 15109 if antal <=0 or max_antal_i_gruppe<antal then
4 15110 res:= 33 <*fejl i gruppestørrelse*>
4 15111 else
4 15112 begin
5 15113 for i:= 1 step 1 until antal do
5 15114 begin
6 15115 s:= læsfil(d.op.data(3),i,zi);
6 15116 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 15117 identer(i):= fil(zi).iaf(1);
6 15118 end;
5 15119 s:= modif_fil(tf_gruppedef,gr,zi);
5 15120 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15121 tofrom(fil(zi).iaf,identer,antal*2);
5 15122 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 15123 fil(zi).iaf(i):= 0;
5 15124 gruppetabel(gr):= d.op.data(1);
5 15125 s:= modiffil(tf_gruppeidenter,gr,zi);
5 15126 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15127 fil(zi).iaf(1):= gruppetabel(gr);
5 15128 res:= 3;
5 15129 end;
4 15130 end;
3 15131 slut_definer:
3 15132 <*slet fil*>
3 15133 start_operation(fil_op,curr_coruid,cs_fil,104);
3 15134 d.filop.data(4):= d.op.data(3);
3 15135 signalch(cs_slet_fil,filop,vt_optype);
3 15136 waitch(cs_fil,filop,vt_optype,-1);
3 15137 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 15138 d.op.resultat:= res;
3 15139 goto returner;
3 15140 \f
3 15140 message procedure vt_gruppe side 4 - 810409/cl;
3 15141
3 15141 slet:
3 15142 disable
3 15143 begin
4 15144 gr:= 0; res:= 0;
4 15145 for i:= 1 step 1 until max_antal_grupper do
4 15146 begin
5 15147 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 15148 end;
4 15149 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 15150 else
4 15151 begin
5 15152 for i:= 1 step 1 until max_antal_gruppeopkald do
5 15153 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 15154 if res = 0 then
5 15155 begin
6 15156 gruppetabel(gr):= 0;
6 15157 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 15158 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 15159 fil(zi).iaf(1):= gruppetabel(gr);
6 15160 res:= 3;
6 15161 end;
5 15162 end;
4 15163 d.op.resultat:= res;
4 15164 end;
3 15165 goto returner;
3 15166 \f
3 15166 message procedure vt_gruppe side 5 - 810505/cl;
3 15167
3 15167 vis:
3 15168 disable
3 15169 begin
4 15170 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 15171 for i:= 1 step 1 until max_antal_grupper do
4 15172 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 15173 if gr = 0 then res:= 8
4 15174 else
4 15175 begin
5 15176 s:= læsfil(tf_gruppedef,gr,zi);
5 15177 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 15178 for i:= 1 step 1 until max_antal_i_gruppe do
5 15179 begin
6 15180 identer(i):= fil(zi).iaf(i);
6 15181 if identer(i) <> 0 then antal:= antal +1;
6 15182 end;
5 15183 start_operation(filop,curr_coruid,cs_fil,101);
5 15184 d.filop.data(1):= antal; <*postantal*>
5 15185 d.filop.data(2):= 1; <*postlængde*>
5 15186 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 15187 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 15188 d.filop.data(5):= d.filop.data(6):=
5 15189 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 15190 signalch(cs_opret_fil,filop,vt_optype);
5 15191 end;
4 15192 end;
3 15193 if res <> 0 then goto slut_vis;
3 15194 waitch(cs_fil,filop,vt_optype,-1);
3 15195 disable
3 15196 begin
4 15197 if d.filop.data(9) <> 0 then
4 15198 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 15199 filref:= d.filop.data(4);
4 15200 for i:= 1 step 1 until antal do
4 15201 begin
5 15202 s:= skrivfil(filref,i,zi);
5 15203 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 15204 fil(zi).iaf(1):= identer(i);
5 15205 end;
4 15206 res:= 3;
4 15207 end;
3 15208 slut_vis:
3 15209 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 15210 goto returner;
3 15211 \f
3 15211 message procedure vt_gruppe side 6 - 810508/cl;
3 15212
3 15212 oversigt:
3 15213 disable
3 15214 begin
4 15215 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 15216 for i:= 1 step 1 until max_antal_grupper do
4 15217 begin
5 15218 if gruppetabel(i) <> 0 then
5 15219 begin
6 15220 antal:= antal +1;
6 15221 identer(antal):= gruppetabel(i);
6 15222 end;
5 15223 end;
4 15224 start_operation(filop,curr_coruid,cs_fil,101);
4 15225 d.filop.data(1):= antal; <*postantal*>
4 15226 d.filop.data(2):= 1; <*postlængde*>
4 15227 d.filop.data(3):= if antal = 0 then 1 else
4 15228 (antal-1)//256 +1; <*segm.antal*>
4 15229 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 15230 d.filop.data(5):= d.filop.data(6):=
4 15231 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 15232 signalch(cs_opretfil,filop,vt_optype);
4 15233 end;
3 15234 waitch(cs_fil,filop,vt_optype,-1);
3 15235 disable
3 15236 begin
4 15237 if d.filop.data(9) <> 0 then
4 15238 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 15239 filref:= d.filop.data(4);
4 15240 for i:= 1 step 1 until antal do
4 15241 begin
5 15242 s:= skriv_fil(filref,i,zi);
5 15243 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 15244 fil(zi).iaf(1):= identer(i);
5 15245 end;
4 15246 d.op.resultat:= 3; <*ok*>
4 15247 d.op.data(1):= antal;
4 15248 d.op.data(2):= filref;
4 15249 end;
3 15250 \f
3 15250 message procedure vt_gruppe side 7 - 810505/cl;
3 15251
3 15251 returner:
3 15252 disable
3 15253 begin
4 15254 <*+2*>
4 15255 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 15256 <**> begin
5 15257 <**> skriv_vt_gruppe(out,0);
5 15258 <**> write(out,<: gruppetabel efter ændring:>);
5 15259 <**> p_gruppetabel(out);
5 15260 <**> end;
4 15261 <**> if testbit41 and overvåget then
4 15262 <**> begin
5 15263 <**> skriv_vt_gruppe(out,0);
5 15264 <**> write(out,<: returner operation:>);
5 15265 <**> skriv_op(out,op);
5 15266 <**> end;
4 15267 <*-2*>
4 15268 signalch(d.op.retur,op,d.op.optype);
4 15269 end;
3 15270 goto vent_op;
3 15271
3 15271 vt_grp_trap:
3 15272 disable skriv_vt_gruppe(zbillede,1);
3 15273
3 15273 end vt_gruppe;
2 15274 \f
2 15274 message procedure vt_spring side 1 - 810506/cl;
2 15275
2 15275 procedure vt_spring(cs_spring_retur,spr_opref);
2 15276 value cs_spring_retur,spr_opref;
2 15277 integer cs_spring_retur,spr_opref;
2 15278 begin
3 15279 integer array field komm_op,spr_op,iaf;
3 15280 real nu;
3 15281 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 15282
3 15282 procedure skriv_vt_spring(zud,omfang);
3 15283 value omfang;
3 15284 zone zud;
3 15285 integer omfang;
3 15286 begin
4 15287 write(zud,"nl",1,<:+++ vt_spring :>);
4 15288 if omfang <> 0 then
4 15289 begin
5 15290 skriv_coru(zud,abs curr_coruno);
5 15291 write(zud,"nl",1,<<d>,
5 15292 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 15293 <:spr-op :>,spr_op,"nl",1,
5 15294 <:komm-op :>,komm_op,"nl",1,
5 15295 <:funk :>,funk,"nl",1,
5 15296 <:interval :>,interval,"nl",1,
5 15297 <:nr :>,nr,"nl",1,
5 15298 <:i :>,i,"nl",1,
5 15299 <:s :>,s,"nl",1,
5 15300 <:id1 :>,id1,"nl",1,
5 15301 <:id2 :>,id2,"nl",1,
5 15302 <:res :>,res,"nl",1,
5 15303 <:res-inf :>,res_inf,"nl",1,
5 15304 <:medd-kode :>,medd_kode,"nl",1,
5 15305 <:zi :>,zi,"nl",1,
5 15306 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 15307 <::>);
5 15308 end;
4 15309 end;
3 15310 \f
3 15310 message procedure vt_spring side 2 - 810506/cl;
3 15311
3 15311 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 15312 value aktion,id1,id2;
3 15313 integer aktion,id1,id2,res,res_inf;
3 15314 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 15315 integer array field akt_op;
4 15316
4 15316 <* vent på adgang til vogntabel *>
4 15317 waitch(cs_vt_adgang,akt_op,true,-1);
4 15318
4 15318 <* start operation *>
4 15319 disable
4 15320 begin
5 15321 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 15322 d.akt_op.data(1):= id1;
5 15323 d.akt_op.data(2):= id2;
5 15324 signalch(cs_vt_opd,akt_op,vt_optype);
5 15325 end;
4 15326
4 15326 <* afvent svar *>
4 15327 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 15328 res:= d.akt_op.resultat;
4 15329 res_inf:= d.akt_op.data(3);
4 15330 <*+2*>
4 15331 <**> disable
4 15332 <**> if testbit45 and overvåget then
4 15333 <**> begin
5 15334 <**> real t;
5 15335 <**> skriv_vt_spring(out,0);
5 15336 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 15337 <**> skriv_id(out,springtabel(nr,1),0);
5 15338 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 15339 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 15340 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 15341 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 15342 <**> d.akt_op.resultat,"sp",2);
5 15343 <**> skriv_id(out,d.akt_op.data(1),8);
5 15344 <**> skriv_id(out,d.akt_op.data(2),8);
5 15345 <**> skriv_id(out,d.akt_op.data(3),8);
5 15346 <**> systime(4,springtid(nr),t);
5 15347 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 15348 <**> end;
4 15349 <*-2*>
4 15350
4 15350 <* åbn adgang til vogntabel *>
4 15351 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 15352 end vt_operation;
3 15353 \f
3 15353 message procedure vt_spring side 2a - 810506/cl;
3 15354
3 15354 procedure io_meddelelse(medd_no,bus,linie,springno);
3 15355 value medd_no,bus,linie,springno;
3 15356 integer medd_no,bus,linie,springno;
3 15357 begin
4 15358 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 15359 d.spr_op.data(1):= medd_no;
4 15360 d.spr_op.data(2):= bus;
4 15361 d.spr_op.data(3):= linie;
4 15362 d.spr_op.data(4):= springtabel(springno,1);
4 15363 d.spr_op.data(5):= springtabel(springno,2);
4 15364 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15365 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15366 end;
3 15367
3 15367 procedure returner_op(op,res);
3 15368 value res;
3 15369 integer array field op;
3 15370 integer res;
3 15371 begin
4 15372 <*+2*>
4 15373 <**> disable
4 15374 <**> if testbit41 and overvåget then
4 15375 <**> begin
5 15376 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15377 <**> skriv_op(out,op);
5 15378 <**> end;
4 15379 <*-2*>
4 15380 d.op.resultat:= res;
4 15381 signalch(d.op.retur,op,d.op.optype);
4 15382 end;
3 15383 \f
3 15383 message procedure vt_spring side 3 - 810603/cl;
3 15384
3 15384 iaf:= 0;
3 15385 spr_op:= spr_opref;
3 15386 stack_claim((if cm_test then 198 else 146) + 24);
3 15387
3 15387 trap(vt_spring_trap);
3 15388
3 15388 for i:= 1 step 1 until max_antal_spring do
3 15389 begin
4 15390 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15391 springtid(i):= springstart(i):= 0.0;
4 15392 end;
3 15393
3 15393 <*+2*>
3 15394 <**> disable
3 15395 <**> if testbit44 and overvåget then
3 15396 <**> begin
4 15397 <**> skriv_vt_spring(out,0);
4 15398 <**> write(out,<: springtabel efter initialisering:>);
4 15399 <**> p_springtabel(out); ud;
4 15400 <**> end;
3 15401 <*-2*>
3 15402
3 15402 <*+2*>
3 15403 <**> disable if testbit47 and overvåget or testbit28 then
3 15404 <**> skriv_vt_spring(out,0);
3 15405 <*-2*>
3 15406 \f
3 15406 message procedure vt_spring side 4 - 810609/cl;
3 15407
3 15407 næste_tid: <* find næste tid *>
3 15408 disable
3 15409 begin
4 15410 interval:= -1; <*vent uendeligt*>
4 15411 systime(1,0.0,nu);
4 15412 for i:= 1 step 1 until max_antal_spring do
4 15413 if springtabel(i,3) < 0 then
4 15414 interval:= 5
4 15415 else
4 15416 if springtid(i) <> 0.0 and
4 15417 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15418 interval:= (if springtid(i) <= nu then 0 else
4 15419 round(springtid(i) -nu));
4 15420 if interval=0 then interval:= 1;
4 15421 end;
3 15422 \f
3 15422 message procedure vt_spring side 4a - 810525/cl;
3 15423
3 15423 <* afvent operation eller timeout *>
3 15424 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15425 if komm_op <> 0 then goto afkod_operation;
3 15426
3 15426 <* timeout *>
3 15427 systime(1,0.0,nu);
3 15428 nr:= 1;
3 15429 næste_sekv:
3 15430 if nr > max_antal_spring then goto næste_tid;
3 15431 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15432 begin
4 15433 nr:= nr +1;
4 15434 goto næste_sekv;
4 15435 end;
3 15436 disable s:= modif_fil(tf_springdef,nr,zi);
3 15437 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15438 if springtabel(nr,3) < 0 then
3 15439 begin <* hængende spring *>
4 15440 if springtid(nr) <= nu then
4 15441 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15442 <* find frit løb *>
5 15443 disable
5 15444 begin
6 15445 id2:= 0;
6 15446 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15447 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15448 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15449 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15450 end;
5 15451 <* send meddelelse til io *>
5 15452 io_meddelelse(5,0,id2,nr);
5 15453
5 15453 <* annuler spring*>
5 15454 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15455 springtid(nr):= springstart(nr):= 0.0;
5 15456 end
4 15457 else
4 15458 begin <* forsøg igen *>
5 15459 \f
5 15459 message procedure vt_spring side 5 - 810525/cl;
5 15460
5 15460 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15461 if i = 2 <* første spring ej udført *> then
5 15462 begin
6 15463 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15464 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15465 id2:= id1;
6 15466 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15467 end
5 15468 else
5 15469 begin
6 15470 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15471 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15472 id2:= id1 shift (-7) shift 7
6 15473 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15474 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15475 end;
5 15476
5 15476 <* check resultat *>
5 15477 medd_kode:= if res = 3 and i = 2 then 7 else
5 15478 if res = 3 and i > 2 then 8 else
5 15479 <* if res = 9 then 1 else
5 15480 if res =12 then 2 else
5 15481 if res =14 then 4 else
5 15482 if res =18 then 3 else *>
5 15483 0;
5 15484 if medd_kode > 0 then
5 15485 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15486 id2 else id1,nr);
5 15487 if res = 3 then
5 15488 begin <* spring udført *>
6 15489 disable s:= modiffil(tf_springdef,nr,zi);
6 15490 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15491 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15492 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15493 if i > 2 then fil(zi).iaf(2+i-2):=
6 15494 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15495 end;
5 15496 end;
4 15497 end <* hængende spring *>
3 15498 else
3 15499 begin
4 15500 i:= spring_tabel(nr,3) shift (-12);
4 15501 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15502 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15503 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15504 + id1 shift (-7) shift 7;
4 15505 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15506 \f
4 15506 message procedure vt_spring side 6 - 820304/cl;
4 15507
4 15507 <* check resultat *>
4 15508 medd_kode:= if res = 3 then 8 else
4 15509 if res = 9 then 1 else
4 15510 if res =12 then 2 else
4 15511 if res =14 then 4 else
4 15512 if res =18 then 3 else
4 15513 if res =60 then 9 else 0;
4 15514 if medd_kode > 0 then
4 15515 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15516
4 15516 <* opdater springtabel *>
4 15517 disable s:= modiffil(tf_springdef,nr,zi);
4 15518 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15519 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15520 begin
5 15521 io_meddelelse(if res=3 then 6 else 5,0,
5 15522 if res=3 then id1 else id2,nr);
5 15523 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15524 springtid(nr):= springstart(nr):= 0.0;
5 15525 end
4 15526 else
4 15527 begin
5 15528 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15529 if res = 3 then
5 15530 begin
6 15531 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15532 (fil(zi).iaf(2+i-1) extract 22);
6 15533 fil(zi).iaf(2+i) := (1 shift 22) add
6 15534 (fil(zi).iaf(2+i) extract 22);
6 15535 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15536 end
5 15537 else
5 15538 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15539 end;
4 15540 end;
3 15541 <*+2*>
3 15542 <**> disable
3 15543 <**> if testbit44 and overvåget then
3 15544 <**> begin
4 15545 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15546 <**> p_springtabel(out); ud;
4 15547 <**> end;
3 15548 <*-2*>
3 15549
3 15549 nr:= nr +1;
3 15550 goto næste_sekv;
3 15551 \f
3 15551 message procedure vt_spring side 7 - 810506/cl;
3 15552
3 15552 afkod_operation:
3 15553 <*+2*>
3 15554 <**> disable
3 15555 <**> if testbit41 and overvåget then
3 15556 <**> begin
4 15557 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15558 <**> skriv_op(out,komm_op);
4 15559 <**> end;
3 15560 <*-2*>
3 15561
3 15561 disable
3 15562 begin integer opk;
4 15563
4 15563 opk:= d.komm_op.opkode extract 12;
4 15564 funk:= if opk = 30 <*sp,d*> then 5 else
4 15565 if opk = 31 <*sp. *> then 1 else
4 15566 if opk = 32 <*sp,v*> then 4 else
4 15567 if opk = 33 <*sp,o*> then 6 else
4 15568 if opk = 34 <*sp,r*> then 2 else
4 15569 if opk = 35 <*sp,a*> then 3 else
4 15570 0;
4 15571 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15572
4 15572 if funk <> 6 <*sp,o*> then
4 15573 begin <* find nr i springtabel *>
5 15574 nr:= 0;
5 15575 for i:= 1 step 1 until max_antal_spring do
5 15576 if springtabel(i,1) = d.komm_op.data(1) and
5 15577 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15578 end;
4 15579 end;
3 15580 if funk = 6 then goto oversigt;
3 15581 if funk = 5 then goto definer;
3 15582
3 15582 if nr = 0 then
3 15583 begin
4 15584 returner_op(komm_op,37<*spring ukendt*>);
4 15585 goto næste_tid;
4 15586 end;
3 15587
3 15587 goto case funk of(start,indsæt,annuler,vis);
3 15588 \f
3 15588 message procedure vt_spring side 8 - 810525/cl;
3 15589
3 15589 start:
3 15590 if springtabel(nr,3) shift (-12) <> 0 then
3 15591 begin returner_op(komm_op,38); goto næste_tid; end;
3 15592 disable
3 15593 begin <* find linie_løb_og_udtag *>
4 15594 s:= modif_fil(tf_springdef,nr,zi);
4 15595 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15596 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15597 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15598 id2:= 0;
4 15599 end;
3 15600 vt_operation(12,id1,id2,res,res_inf);
3 15601
3 15601 disable <* check resultat *>
3 15602 medd_kode:= if res = 3 <*ok*> then 7 else
3 15603 if res = 9 <*linie/løb ukendt*> then 1 else
3 15604 if res =14 <*optaget*> then 4 else
3 15605 if res =18 <*i kø*> then 3 else 0;
3 15606 returner_op(komm_op,3);
3 15607 if medd_kode = 0 then goto næste_tid;
3 15608
3 15608 <* send spring-meddelelse til io *>
3 15609 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15610
3 15610 <* opdater springtabel *>
3 15611 disable
3 15612 begin
4 15613 s:= modif_fil(tf_springdef,nr,zi);
4 15614 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15615 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15616 add (springtabel(nr,3) extract 12);
4 15617 systime(1,0.0,nu);
4 15618 springstart(nr):= nu;
4 15619 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15620 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15621 end;
3 15622 <*+2*>
3 15623 <**> disable
3 15624 <**> if testbit44 and overvåget then
3 15625 <**> begin
4 15626 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15627 <**> p_springtabel(out); ud;
4 15628 <**> end;
3 15629 <*-2*>
3 15630
3 15630 goto næste_tid;
3 15631 \f
3 15631 message procedure vt_spring side 9 - 810506/cl;
3 15632
3 15632 indsæt:
3 15633 if springtabel(nr,3) shift (-12) = 0 then
3 15634 begin <* ikke igangsat *>
4 15635 returner_op(komm_op,41);
4 15636 goto næste_tid;
4 15637 end;
3 15638 <* find frie linie/løb *>
3 15639 disable
3 15640 begin
4 15641 s:= læs_fil(tf_springdef,nr,zi);
4 15642 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15643 id2:= 0;
4 15644 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15645 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15646 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15647 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15648 id1:= d.komm_op.data(3);
4 15649 end;
3 15650
3 15650 if id2<>0 then
3 15651 vt_operation(11,id1,id2,res,res_inf)
3 15652 else
3 15653 res:= 42;
3 15654
3 15654 disable <* check resultat *>
3 15655 medd_kode:= if res = 3 <*ok*> then 8 else
3 15656 if res =10 <*bus ukendt*> then 0 else
3 15657 if res =11 <*bus allerede indsat*> then 0 else
3 15658 if res =12 <*linie/løb allerede besat*> then 2 else
3 15659 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15660 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15661 returner_op(komm_op,res);
3 15662 if medd_kode = 0 then goto næste_tid;
3 15663
3 15663 <* send springmeddelelse til io *>
3 15664 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15665 io_meddelelse(5,0,0,nr);
3 15666 \f
3 15666 message procedure vt_spring side 9a - 810525/cl;
3 15667
3 15667 <* annuler springtabel *>
3 15668 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15669 springtid(nr):= springstart(nr):= 0.0;
3 15670 <*+2*>
3 15671 <**> disable
3 15672 <**> if testbit44 and overvåget then
3 15673 <**> begin
4 15674 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15675 <**> p_springtabel(out); ud;
4 15676 <**> end;
3 15677 <*-2*>
3 15678
3 15678 goto næste_tid;
3 15679 \f
3 15679 message procedure vt_spring side 10 - 810525/cl;
3 15680
3 15680 annuler:
3 15681 disable
3 15682 begin <* find evt. frit linie/løb *>
4 15683 s:= læs_fil(tf_springdef,nr,zi);
4 15684 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15685 id1:= id2:= 0;
4 15686 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15687 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15688 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15689 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15690 returner_op(komm_op,3);
4 15691 end;
3 15692
3 15692 <* send springmeddelelse til io *>
3 15693 io_meddelelse(5,id1,id2,nr);
3 15694
3 15694 <* annuler springtabel *>
3 15695 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15696 springtid(nr):= springstart(nr):= 0.0;
3 15697 <*+2*>
3 15698 <**> disable
3 15699 <**> if testbit44 and overvåget then
3 15700 <**> begin
4 15701 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15702 <**> p_springtabel(out); ud;
4 15703 <**> end;
3 15704 <*-2*>
3 15705
3 15705 goto næste_tid;
3 15706
3 15706 definer:
3 15707 if nr <> 0 then <* allerede defineret *>
3 15708 begin
4 15709 res:= 36;
4 15710 goto slut_definer;
4 15711 end;
3 15712
3 15712 <* find frit nr *>
3 15713 i:= 0;
3 15714 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15715 if springtabel(i,1) = 0 then nr:= i;
3 15716 if nr = 0 then
3 15717 begin
4 15718 res:= 32; <* ingen fri plads *>
4 15719 goto slut_definer;
4 15720 end;
3 15721 \f
3 15721 message procedure vt_spring side 11 - 810525/cl;
3 15722
3 15722 disable
3 15723 begin integer array fdim(1:8),ia(1:32);
4 15724 <* læs sekvens *>
4 15725 fdim(4):= d.komm_op.data(3);
4 15726 s:= hent_fil_dim(fdim);
4 15727 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15728 if fdim(1) > 30 then
4 15729 res:= 35 <* springsekvens for stor *>
4 15730 else
4 15731 begin
5 15732 for i:= 1 step 1 until fdim(1) do
5 15733 begin
6 15734 s:= læs_fil(fdim(4),i,zi);
6 15735 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15736 ia(i):= fil(zi).iaf(1) shift 12;
6 15737 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15738 end;
5 15739 s:= modif_fil(tf_springdef,nr,zi);
5 15740 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15741 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15742 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15743 iaf:= 4;
5 15744 tofrom(fil(zi).iaf,ia,60);
5 15745 iaf:= 0;
5 15746 springtabel(nr,3):= fdim(1);
5 15747 springtid(nr):= springstart(nr):= 0.0;
5 15748 res:= 3;
5 15749 end;
4 15750 end;
3 15751 \f
3 15751 message procedure vt_spring side 11a - 81-525/cl;
3 15752
3 15752 slut_definer:
3 15753
3 15753 <* slet fil *>
3 15754 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15755 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15756 signalch(cs_slet_fil,spr_op,vt_optype);
3 15757 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15758 if d.spr_op.data(9) <> 0 then
3 15759 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15760 returner_op(komm_op,res);
3 15761 <*+2*>
3 15762 <**> disable
3 15763 <**> if testbit44 and overvåget then
3 15764 <**> begin
4 15765 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15766 <**> p_springtabel(out); ud;
4 15767 <**> end;
3 15768 <*-2*>
3 15769 goto næste_tid;
3 15770 \f
3 15770 message procedure vt_spring side 12 - 810525/cl;
3 15771
3 15771 vis:
3 15772 disable
3 15773 begin
4 15774 <* tilknyt fil *>
4 15775 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15776 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15777 d.spr_op.data(2):= 1;
4 15778 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15779 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15780 signalch(cs_opret_fil,spr_op,vt_optype);
4 15781 end;
3 15782
3 15782 <* afvent svar *>
3 15783 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15784 if d.spr_op.data(9) <> 0 then
3 15785 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15786 disable
3 15787 begin integer array ia(1:30);
4 15788 s:= læs_fil(tf_springdef,nr,zi);
4 15789 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15790 iaf:= 4;
4 15791 tofrom(ia,fil(zi).iaf,60);
4 15792 iaf:= 0;
4 15793 for i:= 1 step 1 until d.spr_op.data(1) do
4 15794 begin
5 15795 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15796 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15797 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15798 ia(i) shift (-12) extract 7
5 15799 else -(ia(i) shift (-12) extract 7);
5 15800 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15801 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15802 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15803 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15804 else ia(i) extract 12)
5 15805 else 0;
5 15806 end;
4 15807 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15808 sæt_fil_dim(d.spr_op.data);
4 15809 d.komm_op.data(3):= d.spr_op.data(1);
4 15810 d.komm_op.data(4):= d.spr_op.data(4);
4 15811 raf:= data+8;
4 15812 d.komm_op.raf(1):= springstart(nr);
4 15813 returner_op(komm_op,3);
4 15814 end;
3 15815 goto næste_tid;
3 15816 \f
3 15816 message procedure vt_spring side 13 - 810525/cl;
3 15817
3 15817 oversigt:
3 15818 disable
3 15819 begin
4 15820 <* opret fil *>
4 15821 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15822 d.spr_op.data(1):= max_antal_spring;
4 15823 d.spr_op.data(2):= 4;
4 15824 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15825 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15826 signalch(cs_opret_fil,spr_op,vt_optype);
4 15827 end;
3 15828
3 15828 <* afvent svar *>
3 15829 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15830 if d.spr_op.data(9) <> 0 then
3 15831 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15832 disable
3 15833 begin
4 15834 nr:= 0;
4 15835 for i:= 1 step 1 until max_antal_spring do
4 15836 begin
5 15837 if springtabel(i,1) <> 0 then
5 15838 begin
6 15839 nr:= nr +1;
6 15840 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15841 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15842 fil(zi).iaf(1):= springtabel(i,1);
6 15843 fil(zi).iaf(2):= springtabel(i,2);
6 15844 fil(zi,2):= springstart(i);
6 15845 end;
5 15846 end;
4 15847 d.spr_op.data(1):= nr;
4 15848 s:= sæt_fil_dim(d.spr_op.data);
4 15849 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15850 d.komm_op.data(1):= nr;
4 15851 d.komm_op.data(2):= d.spr_op.data(4);
4 15852 returner_op(komm_op,3);
4 15853 end;
3 15854 goto næste_tid;
3 15855
3 15855 vt_spring_trap:
3 15856 disable skriv_vt_spring(zbillede,1);
3 15857
3 15857 end vt_spring;
2 15858 \f
2 15858 message procedure vt_auto side 1 - 810505/cl;
2 15859
2 15859 procedure vt_auto(cs_auto_retur,auto_opref);
2 15860 value cs_auto_retur,auto_opref;
2 15861 integer cs_auto_retur,auto_opref;
2 15862 begin
3 15863 integer array field op,auto_op,iaf;
3 15864 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15865 res_inf,i,s,zi,kl,døgnstart;
3 15866 real t,nu,næste_tid;
3 15867 boolean optaget;
3 15868 integer array filnavn,nytnavn(1:4);
3 15869
3 15869 procedure skriv_vt_auto(zud,omfang);
3 15870 value omfang;
3 15871 zone zud;
3 15872 integer omfang;
3 15873 begin
4 15874 long array field laf;
4 15875
4 15875 laf:= 0;
4 15876 write(zud,"nl",1,<:+++ vt_auto :>);
4 15877 if omfang<>0 then
4 15878 begin
5 15879 skriv_coru(zud,abs curr_coruno);
5 15880 write(zud,"nl",1,<<d>,
5 15881 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15882 <:op :>,op,"nl",1,
5 15883 <:auto-op :>,auto_op,"nl",1,
5 15884 <:filref :>,filref,"nl",1,
5 15885 <:id1 :>,id1,"nl",1,
5 15886 <:id2 :>,id2,"nl",1,
5 15887 <:aktion :>,aktion,"nl",1,
5 15888 <:postnr :>,postnr,"nl",1,
5 15889 <:sidste-post :>,sidste_post,"nl",1,
5 15890 <:interval :>,interval,"nl",1,
5 15891 <:res :>,res,"nl",1,
5 15892 <:res-inf :>,res_inf,"nl",1,
5 15893 <:i :>,i,"nl",1,
5 15894 <:s :>,s,"nl",1,
5 15895 <:zi :>,zi,"nl",1,
5 15896 <:kl :>,kl,"nl",1,
5 15897 <:døgnstart :>,døgnstart,"nl",1,
5 15898 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15899 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15900 <:nu :>,nu,"nl",1,
5 15901 <:næste-tid :>,næste_tid,"nl",1,
5 15902 <:filnavn :>,filnavn.laf,"nl",1,
5 15903 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15904 <::>);
5 15905 end;
4 15906 end skriv_vt_auto;
3 15907 \f
3 15907 message procedure vt_auto side 2 - 810507/cl;
3 15908
3 15908 iaf:= 0;
3 15909 auto_op:= auto_opref;
3 15910 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15911 optaget:= false;
3 15912 næste_tid:= 0.0;
3 15913 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15914 stack_claim(if cm_test then 298 else 246);
3 15915 trap(vt_auto_trap);
3 15916
3 15916 <*+2*>
3 15917 <**> disable if testbit47 and overvåget or testbit28 then
3 15918 <**> skriv_vt_auto(out,0);
3 15919 <*-2*>
3 15920
3 15920 vent:
3 15921
3 15921 systime(1,0.0,nu);
3 15922 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15923 if næste_tid > nu then round(næste_tid-nu) else
3 15924 if optaget then 5 else 0;
3 15925 if interval=0 then interval:= 1;
3 15926
3 15926 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15927
3 15927 if op<>0 then goto filskift;
3 15928
3 15928 <* vent på adgang til vogntabel *>
3 15929 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15930
3 15930 <* afsend relevant operation til opdatering af vogntabel *>
3 15931 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15932 d.op.data(1):= id1;
3 15933 d.op.data(2):= id2;
3 15934 signalch(cs_vt_opd,op,vt_optype);
3 15935 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15936 res:= d.op.resultat;
3 15937 id2:= d.op.data(2);
3 15938 res_inf:= d.op.data(3);
3 15939
3 15939 <* åbn for vogntabel *>
3 15940 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15941 \f
3 15941 message procedure vt_auto side 3 - 810507/cl;
3 15942
3 15942 <* behandl svar fra opdatering *>
3 15943 <*+2*>
3 15944 <**> disable
3 15945 <**> if testbit45 and overvåget then
3 15946 <**> begin
4 15947 <**> integer li,lø,bo;
4 15948 <**> skriv_vt_auto(out,0);
4 15949 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15950 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15951 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15952 <**> for i:= 1,2 do
4 15953 <**> begin
5 15954 <**> li:= d.op.data(i);
5 15955 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15956 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15957 <**> li:= li shift (-12) extract 10;
5 15958 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15959 <**> end;
4 15960 <**> systime(4,næste_tid,t);
4 15961 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15962 <**> << zd.dd>,t/10000,"nl",1);
4 15963 <**> end;
3 15964 <*-2*>
3 15965 if res=31 then
3 15966 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15967 else
3 15968 if res<>3 then
3 15969 begin
4 15970 if -, optaget then
4 15971 begin
5 15972 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15973 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15974 if res=18 then 3 else if res=60 then 9 else 4;
5 15975 d.auto_op.data(2):= res_inf;
5 15976 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15977 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15978 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15979 end;
4 15980 if res=14 or res=18 then <* i kø eller optaget *>
4 15981 begin
5 15982 optaget:= true;
5 15983 goto vent;
5 15984 end;
4 15985 end;
3 15986 optaget:= false;
3 15987 \f
3 15987 message procedure vt_auto side 4 - 810507/cl;
3 15988
3 15988 <* find næste post *>
3 15989 disable
3 15990 begin
4 15991 if postnr=sidste_post then
4 15992 begin <* døgnskift *>
5 15993 postnr:= 1;
5 15994 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15995 end
4 15996 else postnr:= postnr+1;
4 15997 s:= læsfil(filref,postnr,zi);
4 15998 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 15999 aktion:= fil(zi).iaf(1);
4 16000 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 16001 id1:= fil(zi).iaf(3);
4 16002 id2:= fil(zi).iaf(4);
4 16003 end;
3 16004 goto vent;
3 16005 \f
3 16005 message procedure vt_auto side 5 - 810507/cl;
3 16006
3 16006 filskift:
3 16007
3 16007 <*+2*>
3 16008 <**> disable
3 16009 <**> if testbit41 and overvåget then
3 16010 <**> begin
4 16011 <**> skriv_vt_auto(out,0);
4 16012 <**> write(out,<: modtaget operation::>);
4 16013 <**> skriv_op(out,op);
4 16014 <**> end;
3 16015 <*-2*>
3 16016 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 16017 res:= 46;
3 16018 if d.op.opkode extract 12 <> 21 then
3 16019 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 16020 if filref = 0 then goto knyt;
3 16021
3 16021 <* gem filnavn til io-meddelelse *>
3 16022 disable begin
4 16023 integer array fdim(1:8);
4 16024 integer array field navn;
4 16025 fdim(4):= filref;
4 16026 hentfildim(fdim);
4 16027 navn:= 8;
4 16028 tofrom(filnavn,fdim.navn,8);
4 16029 end;
3 16030
3 16030 <* frivgiv tilknyttet autofil *>
3 16031 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 16032 d.auto_op.data(4):= filref;
3 16033 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 16034 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 16035 if d.auto_op.data(9) <> 0 then
3 16036 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 16037 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 16038 optaget:= false;
3 16039 næste_tid:= 0.0;
3 16040 res:= 3;
3 16041 \f
3 16041 message procedure vt_auto side 6 - 810507/cl;
3 16042
3 16042 <* tilknyt evt. ny autofil *>
3 16043 knyt:
3 16044 if d.op.data(1)<>0 then
3 16045 begin
4 16046 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 16047 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 16048 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 16049 disable
4 16050 begin integer pos1,pos2;
5 16051 pos1:= pos2:= 13;
5 16052 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 16053 begin
6 16054 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 16055 skrivtegn(d.auto_op.data,pos2,i);
6 16056 end;
5 16057 end;
4 16058 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 16059 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 16060 s:= d.auto_op.data(9);
4 16061 if s=0 then res:= 3 <* ok *> else
4 16062 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 16063 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 16064 if s=6 then res:= 48 <* i brug *> else
4 16065 fejlreaktion(14,2,<:auto,filskift:>,0);
4 16066 if res<>3 then goto returner;
4 16067
4 16067 tofrom(nytnavn,d.op.data,8);
4 16068
4 16068 <* find første post *>
4 16069 disable
4 16070 begin
5 16071 døgnstart:= systime(5,0.0,t);
5 16072 kl:= round t;
5 16073 filref:= d.auto_op.data(4);
5 16074 sidste_post:= d.auto_op.data(1);
5 16075 postnr:= 0;
5 16076 for postnr:= postnr+1 while postnr <= sidste_post do
5 16077 begin
6 16078 s:= læsfil(filref,postnr,zi);
6 16079 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 16080 if fil(zi).iaf(2) > kl then goto post_fundet;
6 16081 end;
5 16082 postnr:= 1;
5 16083 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16084 \f
5 16084 message procedure vt_auto side 7 - 810507/cl;
5 16085
5 16085 post_fundet:
5 16086 s:= læsfil(filref,postnr,zi);
5 16087 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 16088 aktion:= fil(zi).iaf(1);
5 16089 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 16090 id1:= fil(zi).iaf(3);
5 16091 id2:= fil(zi).iaf(4);
5 16092 res:= 3;
5 16093 end;
4 16094 end ny fil;
3 16095
3 16095 returner:
3 16096 d.op.resultat:= res;
3 16097 <*+2*>
3 16098 <**> disable
3 16099 <**> if testbit41 and overvåget then
3 16100 <**> begin
4 16101 <**> skriv_vt_auto(out,0);
4 16102 <**> write(out,<: returner operation::>);
4 16103 <**> skriv_op(out,op);
4 16104 <**> end;
3 16105 <*-2*>
3 16106 signalch(d.op.retur,op,d.op.optype);
3 16107
3 16107 if vt_log_aktiv then
3 16108 begin
4 16109 waitch(cs_vt_logpool,op,vt_optype,-1);
4 16110 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 16111 if nytnavn(1)=0 then
4 16112 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 16113 else
4 16114 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 16115 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 16116 systime(1,0.0,d.op.data.v_tid);
4 16117 signalch(cs_vt_log,op,vt_optype);
4 16118 end;
3 16119
3 16119 if filnavn(1)<>0 then
3 16120 begin <* meddelelse til io om annulering *>
4 16121 disable begin
5 16122 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 16123 i:= 1;
5 16124 hægtstring(d.auto_op.data,i,<:auto :>);
5 16125 skriv_text(d.auto_op.data,i,filnavn);
5 16126 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 16127 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 16128 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16129 end;
4 16130 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 16131 end;
3 16132 goto vent;
3 16133
3 16133 vt_auto_trap:
3 16134 disable skriv_vt_auto(zbillede,1);
3 16135
3 16135 end vt_auto;
2 16136 message procedure vt_log side 1 - 920517/cl;
2 16137
2 16137 procedure vt_log;
2 16138 begin
3 16139 integer i,j,ventetid;
3 16140 real dg,t,nu,skiftetid;
3 16141 boolean fil_åben;
3 16142 integer array ia(1:10),dp,dp1(1:8);
3 16143 integer array field op, iaf;
3 16144
3 16144 procedure skriv_vt_log(zud,omfang);
3 16145 value omfang;
3 16146 zone zud;
3 16147 integer omfang;
3 16148 begin
4 16149 write(zud,"nl",1,<:+++ vt-log :>);
4 16150 if omfang<>0 then
4 16151 begin
5 16152 skriv_coru(zud, abs curr_coruno);
5 16153 write(zud,"nl",1,<<d>,
5 16154 <:i :>,i,"nl",1,
5 16155 <:j :>,j,"nl",1,
5 16156 <:ventetid :>,ventetid,"nl",1,
5 16157 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 16158 <:t :>,t,"nl",1,
5 16159 <:nu :>,nu,"nl",1,
5 16160 <:skiftetid :>,skiftetid,"nl",1,
5 16161 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 16162 <:op :>,<<d>,op,"nl",1,
5 16163 <::>);
5 16164 raf:= 0;
5 16165 write(zud,"nl",1,<:ia::>);
5 16166 skrivhele(zud,ia.raf,20,2);
5 16167 write(zud,"nl",2,<:dp::>);
5 16168 skrivhele(zud,dp.raf,16,2);
5 16169 write(zud,"nl",2,<:dp1::>);
5 16170 skrivhele(zud,dp1.raf,16,2);
5 16171 end;
4 16172 end;
3 16173
3 16173 message procedure vt_log side 2 - 920517/cl;
3 16174
3 16174 procedure slet_fil;
3 16175 begin
4 16176 integer segm,res;
4 16177 integer array tail(1:10);
4 16178
4 16178 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 16179 if res=0 then
4 16180 begin
5 16181 segm:= tail(10);
5 16182 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 16183 if res=0 then
5 16184 begin
6 16185 close(zvtlog,true);
6 16186 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 16187 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16188 if res=0 then
6 16189 begin
7 16190 tail(1):= tail(1)+segm;
7 16191 monitor(44)change_entry:(zvtlog,0,tail);
7 16192 end;
6 16193 end;
5 16194 end;
4 16195 end;
3 16196
3 16196 boolean procedure udvid_fil;
3 16197 begin
4 16198 integer res,spos;
4 16199 integer array tail(1:10);
4 16200 zone z(1,1,stderror);
4 16201
4 16201 udvid_fil:= false;
4 16202 open(z,0,<:vtlogpool:>,0); close(z,true);
4 16203 res:= monitor(42)lookup_entry:(z,0,tail);
4 16204 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 16205 begin
5 16206 tail(1):=tail(1) - vt_log_slicelgd;
5 16207 res:=monitor(44)change_entry:(z,0,tail);
5 16208 if res=0 then
5 16209 begin
6 16210 spos:= vt_logtail(1);
6 16211 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 16212 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 16213 if res<>0 then
6 16214 begin
7 16215 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 16216 tail(1):= tail(1) + vt_log_slicelgd;
7 16217 monitor(44)change_entry:(z,0,tail);
7 16218 end
6 16219 else
6 16220 begin
7 16221 setposition(zvtlog,0,spos);
7 16222 udvid_fil:= true;
7 16223 end;
6 16224 end;
5 16225 end;
4 16226 end;
3 16227
3 16227 message procedure vt_log side 3 - 920517/cl;
3 16228
3 16228 boolean procedure ny_fil;
3 16229 begin
4 16230 integer res,i,j;
4 16231 integer array nyt(1:4), ia,tail(1:10);
4 16232 long array field navn;
4 16233 real t;
4 16234
4 16234 navn:=0;
4 16235 if fil_åben then
4 16236 begin
5 16237 close(zvtlog,true);
5 16238 fil_åben:= false;
5 16239 nyt.navn(1):= long<:vtlo:>;
5 16240 nyt.navn(2):= long<::>;
5 16241 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 16242 j:= 'a' - 1;
5 16243 repeat
5 16244 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 16245 if res=3 then
5 16246 begin
6 16247 j:= j+1;
6 16248 if j <= 'å' then skrivtegn(nyt,11,j);
6 16249 end;
5 16250 until (res<>3) or (j > 'å');
5 16251
5 16251 if res=0 then
5 16252 begin
6 16253 open(zvtlog,4,<:vtlogklar:>,0);
6 16254 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16255 if res=0 then
6 16256 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 16257 if res=0 then
6 16258 begin
7 16259 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 16260 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 16261 end;
6 16262
6 16262 if res=0 then
6 16263 begin
7 16264 setposition(zvtlog,0,tail(10)//64);
7 16265 navn:= (tail(10) mod 64)*8;
7 16266 if (tail(1) <= tail(10)//64) then
7 16267 outrec6(zvtlog,512)
7 16268 else
7 16269 swoprec6(zvtlog,512);
7 16270 tofrom(zvtlog.navn,nyt,8);
7 16271 tail(10):= tail(10)+1;
7 16272 setposition(zvtlog,0,tail(10)//64);
7 16273 monitor(44)change_entry:(zvtlog,0,tail);
7 16274 close(zvtlog,true);
7 16275 end
6 16276 else
6 16277 begin
7 16278 navn:= 0;
7 16279 close(zvtlog,true);
7 16280 open(zvtlog,4,<:vtlog:>,0);
7 16281 slet_fil;
7 16282 end;
6 16283 end
5 16284 else
5 16285 slet_fil;
5 16286 end;
4 16287
4 16287 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 16288 <* eller den er blevet slettet. *>
4 16289
4 16289 open(zvtlog,4,<:vtlog:>,0);
4 16290 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 16291 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 16292 vt_logtail(6):= systime(7,0,t);
4 16293
4 16293 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 16294 if res=0 then
4 16295 begin
5 16296 monitor(50)permanent_entry:(zvtlog,3,ia);
5 16297 if res<>0 then
5 16298 monitor(48)remove_entry:(zvtlog,0,ia);
5 16299 end;
4 16300
4 16300 if res=0 then fil_åben:= true;
4 16301
4 16301 ny_fil:= fil_åben;
4 16302 end ny_fil;
3 16303
3 16303 message procedure vt_log side 4 - 920517/cl;
3 16304
3 16304 procedure skriv_post(logpost);
3 16305 integer array logpost;
3 16306 begin
4 16307 integer array field post;
4 16308 real t;
4 16309
4 16309 if vt_logtail(10)//32 < vt_logtail(1) then
4 16310 begin
5 16311 outrec6(zvtlog,512);
5 16312 post:= (vt_logtail(10) mod 32)*16;
5 16313 tofrom(zvtlog.post,logpost,16);
5 16314 vt_logtail(10):= vt_logtail(10)+1;
5 16315 setposition(zvtlog,0,vt_logtail(10)//32);
5 16316 vt_logtail(6):= systime(7,0,t);
5 16317 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 16318 end;
4 16319 end;
3 16320
3 16320 procedure sletsendte;
3 16321 begin
4 16322 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 16323 integer array pooltail,tail,ia(1:10);
4 16324 integer i,res;
4 16325
4 16325 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 16326 res:=monitor(42,zpool,0,pooltail);
4 16327
4 16327 open(z,4,<:vtlogslet:>,0);
4 16328 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 16329 begin
5 16330 if monitor(52,z,0,tail)=0 then
5 16331 begin
6 16332 if monitor(8,z,0,tail)=0 then
6 16333 begin
7 16334 for i:=1 step 1 until tail(10) do
7 16335 begin
8 16336 inrec6(z,8);
8 16337 open(zlog,0,z,0); close(zlog,true);
8 16338 if monitor(42,zlog,0,ia)=0 then
8 16339 begin
9 16340 if monitor(48,zlog,0,ia)=0 then
9 16341 begin
10 16342 pooltail(1):=pooltail(1)+ia(1);
10 16343 end;
9 16344 end;
8 16345 end;
7 16346 tail(10):=0;
7 16347 monitor(44,z,0,tail);
7 16348 end
6 16349 else
6 16350 monitor(64,z,0,tail);
6 16351 end;
5 16352 if res=0 then monitor(44,zpool,0,pooltail);
5 16353 end;
4 16354 close(z,true);
4 16355 end;
3 16356
3 16356 message procedure vt_log side 5 - 920517/cl;
3 16357
3 16357 trap(vt_log_trap);
3 16358 stack_claim(200);
3 16359
3 16359 fil_åben:= false;
3 16360 if -, vt_log_aktiv then goto init_slut;
3 16361 open(zvtlog,4,<:vtlog:>,0);
3 16362 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16363 if i=0 then
3 16364 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16365 if i=0 then
3 16366 begin
4 16367 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16368 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16369 end;
3 16370
3 16370 if (i=0) and (vt_logtail(1)=0) then
3 16371 begin
4 16372 close(zvtlog,true);
4 16373 monitor(48)remove_entry:(zvtlog,0,ia);
4 16374 i:= 1;
4 16375 end;
3 16376
3 16376 disable
3 16377 if i=0 then
3 16378 begin
4 16379 fil_åben:= true;
4 16380 inrec6(zvtlog,512);
4 16381 vt_logstart:= zvtlog.v_tid;
4 16382 systime(1,0.0,nu);
4 16383 if (nu - vt_logstart) < 24*60*60.0 then
4 16384 begin
5 16385 setposition(zvtlog,0,vt_logtail(10)//32);
5 16386 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16387 begin
6 16388 inrec6(zvtlog,512);
6 16389 setposition(zvtlog,0,vt_logtail(10)//32);
6 16390 end;
5 16391 end
4 16392 else
4 16393 begin
5 16394 if ny_fil then
5 16395 begin
6 16396 if udvid_fil then
6 16397 begin
7 16398 systime(1,0.0,dp.v_tid);
7 16399 vt_logstart:= dp.v_tid;
7 16400 dp.v_kode:=0;
7 16401 skriv_post(dp);
7 16402 end
6 16403 else
6 16404 begin
7 16405 close(zvtlog,true);
7 16406 monitor(48)remove_entry:(zvtlog,0,ia);
7 16407 fil_åben:= false;
7 16408 end;
6 16409 end;
5 16410 end;
4 16411 end
3 16412 else
3 16413 begin
4 16414 close(zvtlog,true);
4 16415 if ny_fil then
4 16416 begin
5 16417 if udvid_fil then
5 16418 begin
6 16419 systime(1,0.0,dp.v_tid);
6 16420 vt_logstart:= dp.v_tid;
6 16421 dp.v_kode:=0;
6 16422 skriv_post(dp);
6 16423 end
5 16424 else
5 16425 begin
6 16426 close(zvtlog,true);
6 16427 monitor(48)remove_entry:(zvtlog,0,ia);
6 16428 fil_åben:= false;
6 16429 end;
5 16430 end;
4 16431 end;
3 16432
3 16432 init_slut:
3 16433
3 16433 dg:= systime(5,0,t);
3 16434 if t < vt_logskift then
3 16435 skiftetid:= systid(dg,vt_logskift)
3 16436 else
3 16437 skiftetid:= systid(dg+1,vt_logskift);
3 16438
3 16438 message procedure vt_log side 6 - 920517/cl;
3 16439
3 16439 vent:
3 16440
3 16440 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16441 ventetid:= round(skiftetid - nu);
3 16442 if ventetid < 1 then ventetid:= 1;
3 16443
3 16443 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16444
3 16444 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16445 if op <> 0 then
3 16446 begin
4 16447 tofrom(dp,d.op.data,16);
4 16448 signalch(cs_vt_logpool,op,vt_optype);
4 16449 end;
3 16450
3 16450 if -, vt_log_aktiv then goto vent;
3 16451
3 16451 disable if (op=0) or (nu > skiftetid) then
3 16452 begin
4 16453 if fil_åben then
4 16454 begin
5 16455 dp1.v_tid:= systid(dg,vt_logskift);
5 16456 dp1.v_kode:= 1;
5 16457 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16458 begin
6 16459 if udvid_fil then
6 16460 skriv_post(dp1);
6 16461 end
5 16462 else
5 16463 skriv_post(dp1);
5 16464 end;
4 16465
4 16465 if (op=0) or (nu > skiftetid) then
4 16466 skiftetid:= skiftetid + 24*60*60.0;
4 16467
4 16467 sletsendte;
4 16468
4 16468 if ny_fil then
4 16469 begin
5 16470 if udvid_fil then
5 16471 begin
6 16472 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16473 dp1.v_kode:= 0;
6 16474 skriv_post(dp1);
6 16475 end
5 16476 else
5 16477 begin
6 16478 close(zvtlog,true);
6 16479 monitor(48)remove_entry:(zvtlog,0,ia);
6 16480 fil_åben:= false;
6 16481 end;
5 16482 end;
4 16483 end;
3 16484
3 16484 disable if op<>0 and fil_åben then
3 16485 begin
4 16486 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16487 begin
5 16488 if -, udvid_fil then
5 16489 begin
6 16490 if ny_fil then
6 16491 begin
7 16492 if udvid_fil then
7 16493 begin
8 16494 systime(1,0.0,dp1.v_tid);
8 16495 vt_logstart:= dp1.v_tid;
8 16496 dp1.v_kode:= 0;
8 16497 skriv_post(dp1);
8 16498 end
7 16499 else
7 16500 begin
8 16501 close(zvtlog,true);
8 16502 monitor(48)remove_entry:(zvtlog,0,ia);
8 16503 fil_åben:= false;
8 16504 end;
7 16505 end;
6 16506 end;
5 16507 end;
4 16508
4 16508 if fil_åben then skriv_post(dp);
4 16509 end;
3 16510
3 16510 goto vent;
3 16511
3 16511 vt_log_trap:
3 16512 disable skriv_vt_log(zbillede,1);
3 16513 end vt_log;
2 16514 \f
2 16514
2 16514 algol list.off;
2 16515 message coroutinemonitor - 11 ;
2 16516
2 16516
2 16516 <*************** coroutine monitor procedures ***************>
2 16517
2 16517
2 16517 <***** delay *****
2 16518
2 16518 this procedure links the calling coroutine into the timerqueue and sets
2 16519 the timeout value to 'timeout'. *>
2 16520
2 16520
2 16520 procedure delay (timeout);
2 16521 value timeout;
2 16522 integer timeout;
2 16523 begin
3 16524 link(current, idlequeue);
3 16525 link(current + corutimerchain, timerqueue);
3 16526 d.current.corutimer:= timeout;
3 16527
3 16527
3 16527 passivate;
3 16528 d.current.corutimer:= 0;
3 16529 end;
2 16530 \f
2 16530
2 16530 message coroutinemonitor - 12 ;
2 16531
2 16531
2 16531 <***** pass *****
2 16532
2 16532 this procedure moves the calling coroutine from the head of the ready
2 16533 queue down below all coroutines of lower or equal priority. *>
2 16534
2 16534
2 16534 procedure pass;
2 16535 begin
3 16536 linkprio(current, readyqueue);
3 16537
3 16537
3 16537 passivate;
3 16538 end;
2 16539
2 16539
2 16539 <***** signal ****
2 16540
2 16540 this procedure increases the value af 'semaphore' by 1.
2 16541 in case some coroutine is already waiting, it is linked into the ready
2 16542 queue for activation. the calling coroutine continues execution. *>
2 16543
2 16543
2 16543 procedure signal (semaphore);
2 16544 value semaphore;
2 16545 integer semaphore;
2 16546 begin
3 16547 integer array field sem;
3 16548 sem:= semaphore;
3 16549 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16550 d.sem.simvalue:= d.sem.simvalue + 1;
3 16551
3 16551
3 16551 end;
2 16552 \f
2 16552
2 16552 message coroutinemonitor - 13 ;
2 16553
2 16553
2 16553 <***** wait *****
2 16554
2 16554 this procedure decreases the value of 'semaphore' by 1.
2 16555 in case the value of the semaphore is negative after the decrease, the
2 16556 calling coroutine is linked into the semaphore queue waiting for a
2 16557 coroutine to signal this semaphore. *>
2 16558
2 16558
2 16558 procedure wait (semaphore);
2 16559 value semaphore;
2 16560 integer semaphore;
2 16561 begin
3 16562 integer array field sem;
3 16563 sem:= semaphore;
3 16564 d.sem.simvalue:= d.sem.simvalue - 1;
3 16565
3 16565
3 16565 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16566 passivate;
3 16567 end;
2 16568 \f
2 16568
2 16568 message coroutinemonitor - 14 ;
2 16569
2 16569
2 16569 <***** inspect *****
2 16570
2 16570 this procedure inspects the value of the semaphore and returns it in
2 16571 'elements'.
2 16572 the semaphore is left unchanged. *>
2 16573
2 16573
2 16573 procedure inspect (semaphore, elements);
2 16574 value semaphore;
2 16575 integer semaphore, elements;
2 16576 begin
3 16577 integer array field sem;
3 16578 sem:= semaphore;
3 16579 elements:= d.sem.simvalue;
3 16580
3 16580
3 16580 end;
2 16581 \f
2 16581
2 16581 message coroutinemonitor - 15 ;
2 16582
2 16582
2 16582 <***** signalch *****
2 16583
2 16583 this procedure delivers an operation at 'semaphore'.
2 16584 in case another coroutine is already waiting for an operation of the
2 16585 kind 'operationtype' this coroutine will get the operation and it will
2 16586 be put into the ready queue for activation.
2 16587 in case no coroutine is waiting for the actial kind of operation it is
2 16588 linked into the semaphore queue, at the end of the queue
2 16589 if operation is positive and at the beginning if operation is negative.
2 16590 the calling coroutine continues execution. *>
2 16591
2 16591
2 16591 procedure signalch (semaphore, operation, operationtype);
2 16592 value semaphore, operation, operationtype;
2 16593 integer semaphore, operation;
2 16594 boolean operationtype;
2 16595 begin
3 16596 integer array field firstcoru, currcoru, op,currop;
3 16597 op:= abs operation;
3 16598 d.op.optype:= operationtype;
3 16599 firstcoru:= semaphore + semcoru;
3 16600 currcoru:= d.firstcoru.next;
3 16601 while currcoru <> firstcoru do
3 16602 begin
4 16603 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16604 begin
5 16605 link(operation, 0);
5 16606 d.currcoru.coruop:= operation;
5 16607 linkprio(currcoru, readyqueue);
5 16608 link(currcoru + corutimerchain, idlequeue);
5 16609 goto exit;
5 16610 end else currcoru:= d.currcoru.next;
4 16611 end;
3 16612 currop:=semaphore + semop;
3 16613 if operation < 0 then currop:=d.currop.next;
3 16614 link(op, currop);
3 16615 exit:
3 16616
3 16616
3 16616 end;
2 16617 \f
2 16617
2 16617 message coroutinemonitor - 16 ;
2 16618
2 16618
2 16618 <***** waitch *****
2 16619
2 16619 this procedure fetches an operation from a semaphore.
2 16620 in case an operation matching 'operationtypeset' is already waiting at
2 16621 'semaphore' it is handed over to the calling coroutine.
2 16622 in case no matching operation is waiting, the calling coroutine is
2 16623 linked to the semaphore.
2 16624 in any case the calling coroutine will be stopped and all corouti-
2 16625 nes are rescheduled. *>
2 16626
2 16626
2 16626 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16627 value semaphore, operationtypeset, timeout;
2 16628 integer semaphore, operation, timeout;
2 16629 boolean operationtypeset;
2 16630 begin
3 16631 integer array field firstop, currop;
3 16632 firstop:= semaphore + semop;
3 16633 currop:= d.firstop.next;
3 16634
3 16634
3 16634 while currop <> firstop do
3 16635 begin
4 16636 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16637 begin
5 16638 link(currop, 0);
5 16639 d.current.coruop:= currop;
5 16640 operation:= currop;
5 16641 \f
5 16641
5 16641 message coroutinemonitor - 17 ;
5 16642
5 16642 linkprio(current, readyqueue);
5 16643 passivate;
5 16644 goto exit;
5 16645 end else currop:= d.currop.next;
4 16646 end;
3 16647 linkprio(current, semaphore + semcoru);
3 16648 if timeout > 0 then
3 16649 begin
4 16650 link(current + corutimerchain, timerqueue);
4 16651 d.current.corutimer:= timeout;
4 16652 end else d.current.corutimer:= 0;
3 16653 d.current.corutypeset:= operationtypeset;
3 16654 passivate;
3 16655 if d.current.corutimer < 0 then operation:= 0
3 16656 else operation:= d.current.coruop;
3 16657 d.current.corutimer:= 0;
3 16658 currop:= operation;
3 16659 d.current.coruop:= currop;
3 16660 link(current+corutimerchain, idlequeue);
3 16661 exit:
3 16662
3 16662
3 16662 end;
2 16663 \f
2 16663
2 16663 message coroutinemonitor - 18 ;
2 16664
2 16664
2 16664 <***** inspectch *****
2 16665
2 16665 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16666 the number of matching operations are counted and delivered in 'elements'.
2 16667 if no operations are found the number of coroutines waiting
2 16668 for operations of the typeset are counted and delivered as
2 16669 negative value in 'elements'.
2 16670 the semaphore is left unchanged. *>
2 16671
2 16671
2 16671 procedure inspectch (semaphore, operationtypeset, elements);
2 16672 value semaphore, operationtypeset;
2 16673 integer semaphore, elements;
2 16674 boolean operationtypeset;
2 16675 begin
3 16676 integer array field firstop, currop,firstcoru,currcoru;
3 16677 integer counter;
3 16678 counter:= 0;
3 16679 firstop:= semaphore + semop;
3 16680 currop:= d.firstop.next;
3 16681 while currop <> firstop do
3 16682 begin
4 16683 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16684 counter:= counter + 1;
4 16685 currop:= d.currop.next;
4 16686 end;
3 16687 if counter=0 then
3 16688 begin
4 16689 firstcoru:=semaphore + sem_coru;
4 16690 curr_coru:=d.firstcoru.next;
4 16691 while curr_coru<>first_coru do
4 16692 begin
5 16693 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16694 counter:=counter - 1;
5 16695 curr_coru:=d.curr_coru.next;
5 16696 end;
4 16697 end;
3 16698 elements:= counter;
3 16699
3 16699
3 16699 end;
2 16700 \f
2 16700
2 16700 message coroutinemonitor - 19 ;
2 16701
2 16701
2 16701 <***** csendmessage *****
2 16702
2 16702 this procedure sends the message in 'mess' to the process defined by the name
2 16703 in 'receiver', and returns an identification of the message extension used
2 16704 for sending the message (this identification is to be used for calling 'cwait-
2 16705 answer' or 'cregretmessage'. *>
2 16706
2 16706
2 16706 procedure csendmessage (receiver, mess, messextension);
2 16707 real array receiver;
2 16708 integer array mess;
2 16709 integer messextension;
2 16710 begin
3 16711 integer bufref, messext;
3 16712 messref(maxmessext):= 0;
3 16713 messext:= 1;
3 16714 while messref(messext) <> 0 do messext:= messext + 1;
3 16715 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16716 begin
4 16717 messcode(messext):= 1 shift 12 add 2;
4 16718 mon(16) send message :(0, mess, 0, receiver);
4 16719 messref(messext):= monw2;
4 16720 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16721 end;
3 16722
3 16722
3 16722 end;
2 16723 \f
2 16723
2 16723 message coroutinemonitor - 20 ;
2 16724
2 16724
2 16724 <***** cwaitanswer *****
2 16725
2 16725 this procedure asks the coroutine monitor to get an answer to the message
2 16726 corresponding to 'messextension'. in case the answer has already arrived
2 16727 it stays in the eventqueue until 'cwaitanswer' is called.
2 16728 in case 'timeout' is positive, the coroutine is linked into the timer
2 16729 queue, and in case the answer does not arrive within 'timout' seconds the
2 16730 coroutine is restarted with result = 0. *>
2 16731
2 16731
2 16731 procedure cwaitanswer (messextension, answer, result, timeout);
2 16732 value messextension, timeout;
2 16733 integer messextension, result, timeout;
2 16734 integer array answer;
2 16735 begin
3 16736 integer messext;
3 16737 messext:= messextension;
3 16738 messcode(messext):= messcode(messext) extract 12;
3 16739 link(current, idlequeue);
3 16740 messop(messext):= current;
3 16741 if timeout > 0 then
3 16742 begin
4 16743 link(current + corutimerchain, timerqueue);
4 16744 d.current.corutimer:= timeout;
4 16745 end else d.current.corutimer:= 0;
3 16746
3 16746
3 16746 passivate;
3 16747 if d.current.corutimer < 0 then result:= 0 else
3 16748 begin
4 16749 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16750 result:= monw0;
4 16751 baseevent:= 0;
4 16752 messref(messextension):= 0;
4 16753 end;
3 16754 d.current.corutimer:= 0;
3 16755 link(current+corutimerchain, idlequeue);
3 16756 end;
2 16757 \f
2 16757
2 16757 message coroutinemonitor - 21 ;
2 16758
2 16758
2 16758 <***** cwaitmessage *****
2 16759
2 16759 this procedure asks the coroutine monitor to give it a message, when some-
2 16760 one arrives. in case a message has arrived already it stays at the event queue
2 16761 until 'cwaitmessage' is called.
2 16762 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16763 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16764 with messbufferref = 0. *>
2 16765
2 16765
2 16765 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16766 value timeout, processextension;
2 16767 integer processextension, messbufferref, timeout;
2 16768 integer array mess;
2 16769 begin
3 16770 integer i;
3 16771 integer array field messbuf;
3 16772 proccode(processextension):= 2;
3 16773 procop(processextension):= current;
3 16774 link(current, idlequeue);
3 16775 if timeout > 0 then
3 16776 begin
4 16777 link(current + corutimerchain, timerqueue);
4 16778 d.current.corutimer:= timeout;
4 16779 end else d.current.corutimer:= 0;
3 16780
3 16780
3 16780 passivate;
3 16781 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16782 begin
4 16783 messbuf:= procop(processextension);
4 16784 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16785 proccode(procext):= 1 shift 12;
4 16786 messbufferref:= messbuf;
4 16787 baseevent:= 0;
4 16788 end;
3 16789 d.current.corutimer:= 0;
3 16790 link(current+corutimerchain, idlequeue);
3 16791 end;
2 16792 \f
2 16792
2 16792 message coroutinemonitor - 22 ;
2 16793
2 16793
2 16793 <***** cregretmessage *****
2 16794
2 16794 this procedure regrets the message corresponding to messageexten-
2 16795 sion, to release message buffer and message extension.
2 16796 i/o messages are not regretable. *>
2 16797
2 16797
2 16797
2 16797 procedure cregretmessage (messageextension);
2 16798 value messageextension;
2 16799 integer messageextension;
2 16800 begin
3 16801 integer array field messbuf;
3 16802 messbuf:= messref(messageextension);
3 16803 mon(82) regret message :(0, 0, messbuf, 0);
3 16804 messref(messageextension):= 0;
3 16805
3 16805
3 16805 end;
2 16806 \f
2 16806
2 16806 message coroutinemonitor - 23 ;
2 16807
2 16807
2 16807 <***** semsendmessage *****
2 16808
2 16808 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16809 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16810 by the monitor, when the answer arrives.
2 16811 in case there are too few resources to send the message, the operation is
2 16812 returned immediately with the result field set to zero. *>
2 16813
2 16813
2 16813 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16814 value semaphore, operation, operationtype;
2 16815 real array receiver;
2 16816 integer array mess;
2 16817 integer semaphore, operation;
2 16818 boolean operationtype;
2 16819 begin
3 16820 integer array field op;
3 16821 integer messext;
3 16822 op:= operation;
3 16823 messref(maxmessext):= 0;
3 16824 messext:= 1;
3 16825 while messref(messext) <> 0 do messext:= messext + 1;
3 16826 if messext < maxmessext then
3 16827 begin
4 16828 messop(messext):= op;
4 16829 messcode(messext):=1;
4 16830 d.op(1):= semaphore;
4 16831 d.op.optype:= operationtype;
4 16832 mon(16) send message :(0, mess, 0, receiver);
4 16833 messref(messext):= monw2;
4 16834 end;
3 16835
3 16835
3 16835 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16836 begin <* return the operation immediately with result = 0 *>
4 16837 d.op(9):= 0;
4 16838 signalch(semaphore, op, operationtype);
4 16839 end;
3 16840 end;
2 16841 \f
2 16841
2 16841 message coroutinemonitor - 24 ;
2 16842
2 16842
2 16842 <***** semwaitmessage *****
2 16843
2 16843 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16844 be performed by the coroutine monitor when a message arrives to the process
2 16845 corresponding to 'processextension'. *>
2 16846
2 16846
2 16846 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16847 value processextension, semaphore, operation, operationtype;
2 16848 integer processextension, semaphore, operation;
2 16849 boolean operationtype;
2 16850 begin
3 16851 integer array field op;
3 16852 op:= operation;
3 16853 procop(processextension):= operation;
3 16854 d.op(1):= semaphore;
3 16855 d.op.optype:= operationtype;
3 16856 proccode(processextension):= 1;
3 16857
3 16857
3 16857 end;
2 16858 \f
2 16858
2 16858 message coroutinemonitor - 25 ;
2 16859
2 16859
2 16859 <***** semregretmessage *****
2 16860
2 16860 this procedure regrets a message sent by semsendmessage.
2 16861 the message is identified by the operation in which the answer should be
2 16862 returned.
2 16863 the procedure sets the result field of the operation to zero, and then
2 16864 returns it by performing a signalch. *>
2 16865
2 16865
2 16865 procedure semregretmessage (operation);
2 16866 value operation;
2 16867 integer operation;
2 16868 begin
3 16869 integer i, j;
3 16870 integer array field op, sem;
3 16871 op:= operation;
3 16872 i:= 1;
3 16873 while i < maxmessext do
3 16874 begin
4 16875 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16876 begin
5 16877 mon(82) regret message :(0, 0, messref(i), 0);
5 16878 messref(i):= 0;
5 16879 sem:= d.op(1);
5 16880 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16881 signalch(sem, op, d.op.optype);
5 16882 i:= maxmessext;
5 16883 end;
4 16884 i:= i + 1;
4 16885 end;
3 16886
3 16886
3 16886 end;
2 16887 \f
2 16887
2 16887 message coroutinemonitor - 26 ;
2 16888
2 16888
2 16888 <***** link *****
2 16889
2 16889 this procedure links an object (allocated in the descriptor array 'd') into
2 16890 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16891 are all double chained, and the chainhead is of the same format as the chain
2 16892 fields of the objects.
2 16893 the procedure links the object immediately after the head. *>
2 16894
2 16894
2 16894 procedure link (object, chainhead);
2 16895 value object, chainhead;
2 16896 integer object, chainhead;
2 16897 begin
3 16898 integer array field prevelement, nextelement, chead, obj;
3 16899 obj:= object;
3 16900 chead:= chainhead;
3 16901 prevelement:= d.obj.prev;
3 16902 nextelement:= d.obj.next;
3 16903 d.prevelement.next:= nextelement;
3 16904 d.nextelement.prev:= prevelement;
3 16905 if chead > 0 then <* link into queue *>
3 16906 begin
4 16907 prevelement:= d.chead.prev;
4 16908 d.obj.prev:= prevelement;
4 16909 d.prevelement.next:= obj;
4 16910 d.obj.next:= chead;
4 16911 d.chead.prev:= obj;
4 16912 end else
3 16913 begin <* link onto itself *>
4 16914 d.obj.prev:= obj;
4 16915 d.obj.next:= obj;
4 16916 end;
3 16917 end;
2 16918 \f
2 16918
2 16918 message coroutinemonitor - 27 ;
2 16919
2 16919
2 16919 <***** linkprio *****
2 16920
2 16920 this procedure is used to link coroutines into queues corresponding to
2 16921 the priorities of the actual coroutine and the queue elements.
2 16922 the object is linked immediately before the first coroutine of lower prio-
2 16923 rity. *>
2 16924
2 16924
2 16924 procedure linkprio (object, chainhead);
2 16925 value object, chainhead;
2 16926 integer object, chainhead;
2 16927 begin
3 16928 integer array field currelement, chead, obj;
3 16929 obj:= object;
3 16930 chead:= chainhead;
3 16931 currelement:= d.chead.next;
3 16932 while currelement <> chead
3 16933 and d.currelement.corupriority <= d.obj.corupriority
3 16934 do currelement:= d.currelement.next;
3 16935 link(obj, currelement);
3 16936 end;
2 16937 \f
2 16937
2 16937 message coroutinemonitor - 28 ;
2 16938
2 16938 \f
2 16938
2 16938 message coroutinemonitor - 30a ;
2 16939
2 16939
2 16939 <*************** extention to coroutine monitor procedures **********>
2 16940
2 16940 <***** signalbin *****
2 16941
2 16941 this procedure simulates a binary semaphore on a simple semaphore
2 16942 by testing the value of the semaphore before signaling the
2 16943 semaphore. if the value of the semaphore is one (=open) nothing is
2 16944 done, otherwise a normal signal is carried out. *>
2 16945
2 16945
2 16945 procedure signalbin(semaphore);
2 16946 value semaphore;
2 16947 integer semaphore;
2 16948 begin
3 16949 integer array field sem;
3 16950 integer val;
3 16951 sem:= semaphore;
3 16952 inspect(sem,val);
3 16953 if val<1 then signal(sem);
3 16954 end;
2 16955 \f
2 16955
2 16955 message coroutinemonitor - 30b ;
2 16956
2 16956 <***** coruno *****
2 16957
2 16957 delivers the coroutinenumber for a give coroutine id.
2 16958 if the coroutine does not exists the value 0 is delivered *>
2 16959
2 16959 integer procedure coru_no(coru_id);
2 16960 value coru_id;
2 16961 integer coru_id;
2 16962 begin
3 16963 integer array field cor;
3 16964
3 16964 coru_no:= 0;
3 16965 for cor:= firstcoru step corusize until (coruref-1) do
3 16966 if d.cor.coruident//1000 = coru_id then
3 16967 coru_no:= d.cor.coruident mod 1000;
3 16968 end;
2 16969 \f
2 16969
2 16969 message coroutinemonitor - 30c ;
2 16970
2 16970 <***** coroutine *****
2 16971
2 16971 delivers the referencebyte for the coroutinedescriptor for
2 16972 a coroutine identified by coroutinenumber *>
2 16973
2 16973 integer procedure coroutine(cor_no);
2 16974 value cor_no;
2 16975 integer cor_no;
2 16976 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16977 firstcoru + (cor_no-1)*corusize;
2 16978 \f
2 16978
2 16978 message coroutinemonitor - 30d ;
2 16979
2 16979 <***** curr_coruno *****
2 16980
2 16980 delivers number of calling coroutine
2 16981 curr_coruno:
2 16982 < 0 = -current_coroutine_number in disabled mode
2 16983 = 0 = procedure not called from coroutine
2 16984 > 0 = current_coroutine_number in enabled mode *>
2 16985
2 16985 integer procedure curr_coruno;
2 16986 begin
3 16987 integer i;
3 16988 integer array ia(1:12);
3 16989
3 16989 i:= system(12,0,ia);
3 16990 if i > 0 then
3 16991 begin
4 16992 i:= system(12,1,ia);
4 16993 curr_coruno:= ia(3);
4 16994 end else curr_coruno:= 0;
3 16995 end curr_coruno;
2 16996 \f
2 16996
2 16996 message coroutinemonitor - 30e ;
2 16997
2 16997 <***** curr_coruid *****
2 16998
2 16998 delivers coruident of calling coroutine :
2 16999
2 16999 curr_coruid:
2 17000 > 0 = coruident of calling coroutine
2 17001 = 0 = procedure not called from coroutine *>
2 17002
2 17002 integer procedure curr_coruid;
2 17003 begin
3 17004 integer cor_no;
3 17005 integer array field cor;
3 17006
3 17006 cor_no:= abs curr_coruno;
3 17007 if cor_no <> 0 then
3 17008 begin
4 17009 cor:= coroutine(cor_no);
4 17010 curr_coruid:= d.cor.coruident // 1000;
4 17011 end
3 17012 else curr_coruid:= 0;
3 17013 end curr_coruid;
2 17014 \f
2 17014 message coroutinemonitor - 30f.1 ;
2 17015
2 17015 <**** getch *****
2 17016
2 17016 this procedure searches the queue of operations waiting at 'semaphore'
2 17017 to find an operation that matches the operationstypeset and a set of
2 17018 select-values. each select value is specified by type and fieldvalue
2 17019 in integer array 'type' and by the value in integer array 'val'.
2 17020
2 17020 0: eq 0: not used
2 17021 1: lt 1: boolean
2 17022 2: le 2: integer
2 17023 3: gt 3: long
2 17024 4: ge 4: real
2 17025 5: ne
2 17026 *>
2 17027
2 17027 procedure getch(semaphore,operation,operationtypeset,type,val);
2 17028 value semaphore,operationtypeset;
2 17029 integer semaphore,operation;
2 17030 boolean operationtypeset;
2 17031 integer array type,val;
2 17032 begin
3 17033 integer array field firstop,currop;
3 17034 integer ø,n,i,f,t,rel,i1,i2;
3 17035 boolean field bf,bfval;
3 17036 integer field intf;
3 17037 long field lf,lfval; long l1,l2;
3 17038 real field rf,rfval; real r1,r2;
3 17039
3 17039 boolean match;
3 17040
3 17040 operation:= 0;
3 17041 n:= system(3,ø,type);
3 17042 match:= false;
3 17043 firstop:= semaphore + semop;
3 17044 currop:= d.firstop.next;
3 17045 while currop <> firstop and -,match do
3 17046 begin
4 17047 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 17048 begin
5 17049 i:= n;
5 17050 match:= true;
5 17051 \f
5 17051 message coroutinemonitor - 30f.2 ;
5 17052
5 17052 while match and (if i <= ø then type(i) >= 0 else false) do
5 17053 begin
6 17054 rel:= type(i) shift(-18);
6 17055 t:= type(i) shift(-12) extract 6;
6 17056 f:= type(i) extract 12;
6 17057 if f > 2047 then f:= f -4096;
6 17058 case t+1 of
6 17059 begin
7 17060 ; <* not used *>
7 17061
7 17061 begin <*boolean or signed short integer*>
8 17062 bf:= f;
8 17063 bfval:= 2*i;
8 17064 i1:= d.currop.bf extract 12;
8 17065 if i1 > 2047 then i1:= i1-4096;
8 17066 i2:= val.bfval extract 12;
8 17067 if i2 > 2047 then i2:= i2-4096;
8 17068 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17069 end;
7 17070
7 17070 begin <*integer*>
8 17071 intf:= f;
8 17072 i1:= d.currop.intf;
8 17073 i2:= val(i);
8 17074 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17075 end;
7 17076
7 17076 begin <*long*>
8 17077 lf:= f;
8 17078 lfval:= i*2;
8 17079 l1:= d.currop.lf;
8 17080 l2:= val.lfval;
8 17081 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 17082 end;
7 17083
7 17083 begin <*real*>
8 17084 rf:= f;
8 17085 rfval:= i*2;
8 17086 r1:= d.currop.rf;
8 17087 r2:= val.rfval;
8 17088 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 17089 end;
7 17090
7 17090 end;<*case t+1*>
6 17091
6 17091 i:= i+1;
6 17092 end; <*while match and i<=ø and t>=0 *>
5 17093 \f
5 17093 message coroutinemonitor - 30f.3 ;
5 17094
5 17094 end; <* if operationtypeset and ---*>
4 17095 if -,match then currop:= d.currop.next;
4 17096 end; <*while currop <> firstop and -,match*>
3 17097
3 17097 if match then
3 17098 begin
4 17099 link(currop,0);
4 17100 d.current.coruop:= currop;
4 17101 operation:= currop;
4 17102 end;
3 17103 end getch;
2 17104 \f
2 17104
2 17104 message coroutinemonitor - 31 ;
2 17105
2 17105 activity(maxcoru);
2 17106
2 17106 goto initialization;
2 17107
2 17107
2 17107
2 17107 <*************** event handling ***************>
2 17108
2 17108
2 17108
2 17108 takeexternal:
2 17109 currevent:= baseevent;
2 17110 eventqueueempty:= false;
2 17111 repeat
2 17112 current:= 0;
2 17113 prevevent:= currevent;
2 17114 mon(66) test event :(0, 0, currevent, 0);
2 17115 currevent:= monw2;
2 17116 if monw0 < 0 <* no event *> then goto takeinternal;
2 17117 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 17118 cmi:= monw1
2 17119 else
2 17120 cmi:= - monw0;
2 17121
2 17121 if cmi > 0 then
2 17122 begin <* answer to activity zone *>
3 17123 current:= firstcoru + (cmi - 1) * corusize;
3 17124 linkprio(current, readyqueue);
3 17125 baseevent:= 0;
3 17126 end else
2 17127
2 17127 if cmi = 0 then
2 17128 begin <* message arrived *>
3 17129 \f
3 17129
3 17129 message coroutinemonitor - 32 ;
3 17130
3 17130 receiver:= core.currevent(3);
3 17131 if receiver < 0 then receiver:= - receiver;
3 17132 procref(maxprocext):= receiver;
3 17133 procext:= 1;
3 17134 while procref(procext) <> receiver do procext:= procext + 1;
3 17135 if procext = maxprocext then
3 17136 begin <* receiver unknown *>
4 17137 <* leave the message unchanged *>
4 17138 end else
3 17139 if proccode(procext) shift (-12) = 0 then
3 17140 begin <* the receiver is ready for accepting messages *>
4 17141 mon(26) get event :(0, 0, currevent, 0);
4 17142 case proccode(procext) of
4 17143 begin
5 17144 begin <* message received by semwaitmessage *>
6 17145 op:= procop(procext);
6 17146 sem:= d.op(1);
6 17147 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 17148 d.op(9):= currevent;
6 17149 signalch(sem, op, d.op.optype);
6 17150 proccode(procext):= 1 shift 12;
6 17151 end;
5 17152 begin <* message received by cwaitmessage *>
6 17153 current:= procop(procext);
6 17154 procop(procext):= currevent;
6 17155 linkprio(current, readyqueue);
6 17156 link(current + corutimerchain, idlequeue);
6 17157
6 17157
6 17157 end;
5 17158 end; <* case *>
4 17159 currevent:= baseevent;
4 17160 proccode(procext):= 1 shift 12;
4 17161 end;
3 17162 end <* message *> else
2 17163
2 17163 if cmi = -1 then
2 17164 begin <* answer arrived *>
3 17165 \f
3 17165
3 17165 message coroutinemonitor - 33 ;
3 17166
3 17166 if currevent = timermessage then
3 17167 begin
4 17168 mon(26) get event :(0, 0, currevent, 0);
4 17169 coru:= d.timerqueue.next;
4 17170 while coru <> timerqueue do
4 17171 begin
5 17172 current:= coru - corutimerchain;
5 17173 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 17174 coru:= d.coru.next;
5 17175 if d.current.corutimer <= 0 then
5 17176 begin <* timer perion expired *>
6 17177 d.current.corutimer:= -1;
6 17178 linkprio(current, readyqueue);
6 17179 link(current + corutimerchain, idlequeue);
6 17180 end;
5 17181 end;
4 17182 mon(16) send message :(0, clockmess, 0, clock);
4 17183 timermessage:= monw2;
4 17184 currevent:= baseevent;
4 17185 end <* timer answer *> else
3 17186 begin
4 17187 messref(maxmessext):= currevent;
4 17188 messext:= 1;
4 17189 while messref(messext) <> currevent do messext:= messext + 1;
4 17190 if messext = maxmessext then
4 17191 begin <* the answer is unknown *>
5 17192 <* leave the answer unchanged - it may belong to an activity *>
5 17193 end else
4 17194 if messcode(messext) shift (-12) = 0 then
4 17195 begin
5 17196 case messcode(messext) extract 12 of
5 17197 begin
6 17198 \f
6 17198
6 17198 message coroutinemonitor - 34 ;
6 17199 begin <* answer arrived after semsendmessage *>
7 17200 op:= messop(messext);
7 17201 sem:= d.op(1);
7 17202 mon(18) wait answer :(0, d.op, currevent, 0);
7 17203 d.op(9):= monw0;
7 17204 signalch(sem, op, d.op.optype);
7 17205 messref(messext):= 0;
7 17206 baseevent:= 0;
7 17207 end;
6 17208 begin <* answer arrived after csendmessage *>
7 17209 current:= messop(messext);
7 17210 linkprio(current, readyqueue);
7 17211 link(current + corutimerchain, idlequeue);
7 17212
7 17212
7 17212 end;
6 17213 end;
5 17214 end else baseevent:= currevent;
4 17215 end;
3 17216 end;
2 17217 until eventqueueempty;
2 17218 \f
2 17218
2 17218 message coroutinemonitor - 35 ;
2 17219
2 17219
2 17219
2 17219 <*************** coroutine activation ***************>
2 17220
2 17220 takeinternal:
2 17221
2 17221 current:= d.readyqueue.next;
2 17222 if current = readyqueue then
2 17223 begin
3 17224 mon(24) wait event :(0, 0, prevevent, 0);
3 17225 goto takeexternal;
3 17226 end;
2 17227
2 17227 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17228 <**> begin
3 17229 <**> systime(5,0,r);
3 17230 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17231 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17232 <**> d.current.coruident//1000,<: aktiveres:>);
3 17233 <**> end;
2 17234 <*-2*>
2 17235
2 17235 corustate:= activate(d.current.coruident mod 1000);
2 17236 cmi:= corustate extract 24;
2 17237 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17238 <**> begin
3 17239 <**> systime(5,0,r);
3 17240 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17241 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17242 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 17243 <**> end;
2 17244 <*-2*>
2 17245
2 17245 if cmi = 1 then
2 17246 begin <* programmed passivate *>
3 17247 goto takeexternal;
3 17248 end;
2 17249
2 17249 if cmi = 2 then
2 17250 begin <* implicit passivate in activity *>
3 17251
3 17251
3 17251 link(current, idlequeue);
3 17252 goto takeexternal;
3 17253 end;
2 17254 \f
2 17254
2 17254 message coroutinemonitor - 36 ;
2 17255
2 17255 <* coroutine termination (normal or abnormal) *>
2 17256
2 17256 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 17257 coru_term:
2 17258
2 17258 begin
3 17259 if false and alarmcause extract 24 = (-9) <* break *> and
3 17260 alarmcause shift (-24) extract 24 = 0 then
3 17261 begin
4 17262 endaction:= 2;
4 17263 goto program_slut;
4 17264 end;
3 17265 if alarmcause extract 24 = (-9) <* break *> and
3 17266 alarmcause shift (-24) = 8 <* parent *>
3 17267 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 17268 if alarmcause shift (-24) extract 24 <> -2 or
3 17269 alarmcause extract 24 <> -13 then
3 17270 begin
4 17271 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 17272 alarmcause shift (-24),<:,:>,
4 17273 alarmcause extract 24);
4 17274 for i:=1 step 1 until max_coru do
4 17275 j:=activate(-i); <* kill *>
4 17276 <* skriv billede *>
4 17277 end
3 17278 else
3 17279 begin
4 17280 errorbits:= 0; <* ok.yes warning.no *>
4 17281 goto finale;
4 17282 end;
3 17283 end;
2 17284
2 17284 goto dump;
2 17285
2 17285 link(current, idlequeue);
2 17286 goto takeexternal;
2 17287 \f
2 17287
2 17287 message coroutinemonitor - 37 ;
2 17288
2 17288
2 17288
2 17288 initialization:
2 17289
2 17289
2 17289 <*************** initialization ***************>
2 17290
2 17290 <* chain head *>
2 17291
2 17291 prev:= -2; <* -2 prev *>
2 17292 next:= 0; <* +0 next *>
2 17293
2 17293 <* corutine descriptor *>
2 17294
2 17294 <* -2 prev *>
2 17295 <* +0 next *>
2 17296 <* +2 (link field) *>
2 17297 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 17298 <* +6 (link field) *>
2 17299 coruop:= corutimerchain + 4; <* +8 coruop *>
2 17300 corutimer:= coruop + 2; <*+10 corutimer *>
2 17301 coruident:= corutimer + 2; <*+12 coruident *>
2 17302 corupriority:= coruident + 2; <*+14 corupriority *>
2 17303 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 17304 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 17305
2 17305 <* simple semaphore *>
2 17306
2 17306 <* -2 (link field) *>
2 17307 simcoru:= next; <* +0 simcoru *>
2 17308 simvalue:= simcoru + 2; <* +2 simvalue *>
2 17309
2 17309 <* chained semaphore *>
2 17310
2 17310 <* -2 (link field) *>
2 17311 semcoru:= next; <* +0 semcoru *>
2 17312 <* +2 (link field) *>
2 17313 semop:= semcoru + 4; <* +4 semop *>
2 17314 \f
2 17314
2 17314 message coroutinemonitor - 38 ;
2 17315
2 17315 <* operation *>
2 17316
2 17316 opsize:= next - 6; <* -6 opsize *>
2 17317 optype:= opsize + 1; <* -5 optype *>
2 17318 <* -2 prev *>
2 17319 <* +0 next *>
2 17320 <* +2 operation(1) *>
2 17321 <* +4 operation(2) *>
2 17322 <* +6 - *>
2 17323 <* . - *>
2 17324 <* . - *>
2 17325
2 17325 \f
2 17325
2 17325 message coroutinemonitor - 39 ;
2 17326
2 17326 trap(dump);
2 17327 systime(1, 0, starttime);
2 17328 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 17329 clockmess(1):= 0;
2 17330 clockmess(2):= timeinterval;
2 17331 clock(1):= real <:clock:>;
2 17332 clock(2):= real <::>;
2 17333 mon(16) send message :(0, clockmess, 0, clock);
2 17334 timermessage:= monw2;
2 17335 readyqueue:= 4;
2 17336 initchain(readyqueue);
2 17337 idlequeue:= readyqueue + 4;
2 17338 initchain(idlequeue);
2 17339 timerqueue:= idlequeue + 4;
2 17340 initchain(timerqueue);
2 17341 current:= 0;
2 17342 corucount:= 0;
2 17343 proccount:= 0;
2 17344 baseevent:= 0;
2 17345 coruref:= timerqueue + 4;
2 17346 firstcoru:= coruref;
2 17347 simref:= coruref + maxcoru * corusize;
2 17348 firstsim:= simref;
2 17349 semref:= simref + maxsem * simsize;
2 17350 firstsem:= semref;
2 17351 opref:= semref + maxsemch * semsize + 4;
2 17352 firstop:= opref;
2 17353 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 17354 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 17355 reflectcore(core);
2 17356
2 17356 algol list.on;
2 17357
2 17357 \f
2 17357 message sys_initialisering side 1 - 810601/hko;
2 17358
2 17358 trapmode:= 1 shift 15;
2 17359 errorbits:= 1; <* warning.no ok.no *>
2 17360 trap(coru_term);
2 17361
2 17361 open(zbillede,4,<:billede:>,0);
2 17362 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17363 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17364 system(2,0,ia);
2 17365 open(zdummy,4,ia,0); close(zdummy,false);
2 17366 monitor(42,zdummy,0,ia);
2 17367 laf:= 0;
2 17368 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17369 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17370 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17371
2 17371 open(zrl,4,<:radiolog:>,0);
2 17372 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17373 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17374 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17375 begin
3 17376 ia(1):=1; ia(2):= 3;
3 17377 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17378 monitor(40)create_area:(zrl,0,ia);
3 17379 end;
2 17380
2 17380 for i:=1 step 1 until max_antal_fejltekster do
2 17381 fejltekst(i):= real (case i of (
2 17382 <* 1*><:filsystem:>,
2 17383 <* 2*><:operationskode:>,
2 17384 <* 3*><:programfejl:>,
2 17385 <* 4*><:monitor<'_'>resultat=:>,
2 17386 <* 5*><:læs<'_'>fil:>,
2 17387 <* 6*><:skriv<'_'>fil:>,
2 17388 <* 7*><:modif<'_'>fil:>,
2 17389 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17390 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17391 <*10*><:vogntabel:>,
2 17392 <*11*><:fremmed operation:>,
2 17393 <*12*><:operationstype:>,
2 17394 <*13*><:opret<'_'>fil:>,
2 17395 <*14*><:tilknyt<'_'>fil:>,
2 17396 <*15*><:frigiv<'_'>fil:>,
2 17397 <*16*><:slet<'_'>fil:>,
2 17398 <*17*><:ydre enhed, status=:>,
2 17399 <*18*><:tabelfil:>,
2 17400 <*19*><:radio:>,
2 17401 <*20*><:mobilopkald, bus:>,
2 17402 <*21*><:talevejsswitch:>,
2 17403 <*99*><:ftslut:>));
2 17404
2 17404 for i:= 1 step 1 until max_antal_områder do
2 17405 begin
3 17406 område_navn(i):= long (case i of
3 17407 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17408 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17409 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17410 område_id(i,2):=
3 17411 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17412 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17413 end;
2 17414
2 17414 pabx_id(1):= -1;
2 17415 pabx_id(2):= 1;
2 17416
2 17416 for i:= 1 step 1 until max_antal_radiokanaler do
2 17417 begin
3 17418 radio_id(i):=
3 17419 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17420 end;
2 17421
2 17421 for i:=1 step 1 until max_antal_kanaler do
2 17422 begin
3 17423 kanal_navn(i):= long (case i of (
3 17424 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17425 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17426 kanal_id(i):=
3 17427 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17428 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17429 end;
2 17430
2 17430 for i:= 1 step 1 until op_maske_lgd//2 do
2 17431 ingen_operatører(i):= alle_operatører(i):= 0;
2 17432 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17433 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17434
2 17434 begin
3 17435 long array navn(1:2);
3 17436 long array field doc, ref;
3 17437
3 17437 doc:= 2; iaf:= 0;
3 17438 movestring(navn,1,<:terminal0:>);
3 17439 for i:= 1 step 1 until max_antal_operatører do
3 17440 begin
4 17441 ref:=(i-1)*8; k:=9;
4 17442 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17443 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17444 open(zdummy,8,navn,0); close(zdummy,true);
4 17445 k:= monitor(42,zdummy,0,ia);
4 17446 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17447 else tofrom(terminal_navn.ref,navn,8);
4 17448 operatør_auto_include(i):= false;
4 17449 sætbit_ia(alle_operatører,i,1);
4 17450 end;
3 17451
3 17451 movestring(navn,1,<:garage0:>);
3 17452 for i:= 1 step 1 until max_antal_garageterminaler do
3 17453 begin
4 17454 ref:=(i-1)*8; k:=7;
4 17455 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17456 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17457 open(zdummy,8,navn,0); close(zdummy,true);
4 17458 k:= monitor(42,zdummy,0,ia);
4 17459 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17460 else tofrom(garage_terminal_navn.ref,navn,8);
4 17461 garage_auto_include(i):= false;
4 17462 end;
3 17463 end;
2 17464
2 17464 for i:= 1 step 1 until max_antal_taleveje do
2 17465 sætbit_ia(alle_taleveje,i,1);
2 17466 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17467 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17468 operatør_auto_include(ia(i)):= true;
2 17469 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17470 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17471 garage_auto_include(ia(i)):= true;
2 17472
2 17472
2 17472 \f
2 17472 message fil_init side 1 - 801030/jg;
2 17473
2 17473 begin integer i,antz,tz,s;
3 17474 real array field raf;
3 17475
3 17475 filskrevet:=fillæst:=0; <*fil*>
3 17476 dbsegmax:= 2**18-1;
3 17477
3 17477 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17478 for i:=1 step 1 until dbantez do
3 17479 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17480 for i:=dbantez+1 step 1 until tz do
3 17481 open(fil(i),4,dbsnavn,0);
3 17482 for i:=tz+1 step 1 until antz do
3 17483 open(fil(i),4,dbtnavn,0);
3 17484
3 17484 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17485 dbkatz(i,1):=dbkatz(i,2):=0;
3 17486 for i:=dbantez+1 step 1 until tz do
3 17487 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17488 for i:=tz+1 step 1 until antz do
3 17489 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17490 dbkatz(antz,2):=tz+1;
3 17491 dbsidstetz:=antz;
3 17492 dbsidstesz:=tz;
3 17493
3 17493 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17494 begin integer j;
4 17495 for j:=1,3 step 1 until 6 do
4 17496 dbkate(i,j):=0;
4 17497 dbkate(i,2):=i+1;
4 17498 end;
3 17499 dbkate(dbmaxef,2):=0;
3 17500 dbkatefri:=1;
3 17501 dbantef:=0;
3 17502 \f
3 17502 message fil_init side 2 - 801030/jg;
3 17503
3 17503
3 17503 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17504 begin
4 17505 dbkats(i,1):=0;
4 17506 dbkats(i,2):=i+1;
4 17507 end;
3 17508 dbkats(dbmaxsf,2):=0;
3 17509 dbkatsfri:=1;
3 17510 dbantsf:=0;
3 17511
3 17511 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17512 dbkatb(i):=false add (i+1);
3 17513 dbkatb(dbmaxb):=false;
3 17514 dbkatbfri:=1;
3 17515 dbantb:=0;
3 17516 raf:=4;
3 17517 for i:=1 step 1 until dbmaxtf do
3 17518 begin
4 17519 inrec6(fil(antz),4);
4 17520 dbkatt.raf(i):=fil(antz,1);
4 17521 end;
3 17522 inrec6(fil(antz),4);
3 17523 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17524 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17525 setposition(fil(antz),0,0);
3 17526
3 17526 end filsystem;
2 17527 \f
2 17527 message fil_init side 3 - 810209/cl;
2 17528
2 17528 bs_kats_fri:= nextsem;
2 17529 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17530 <*-3*>
2 17531 bs_kate_fri:= nextsem;
2 17532 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17533 <*-3*>
2 17534 cs_opret_fil:= nextsemch;
2 17535 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17536 <*-3*>
2 17537 cs_tilknyt_fil:= nextsemch;
2 17538 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17539 <*-3*>
2 17540 cs_frigiv_fil:= nextsemch;
2 17541 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17542 <*-3*>
2 17543 cs_slet_fil:= nextsemch;
2 17544 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17545 <*-3*>
2 17546 cs_opret_spoolfil:= nextsemch;
2 17547 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17548 <*-3*>
2 17549 cs_opret_eksternfil:= nextsemch;
2 17550 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17551 <*-3*>
2 17552 \f
2 17552 message fil_init side 4 810209/cl;
2 17553
2 17553
2 17553 <* initialisering af filsystemcoroutiner *>
2 17554
2 17554 i:= nextcoru(001,10,true);
2 17555 j:= newactivity(i,0,opretfil);
2 17556 <*+3*> skriv_newactivity(out,i,j);
2 17557 <*-3*>
2 17558
2 17558 i:= nextcoru(002,10,true);
2 17559 j:= newactivity(i,0,tilknytfil);
2 17560 <*+3*> skriv_newactivity(out,i,j);
2 17561 <*-3*>
2 17562
2 17562 i:= nextcoru(003,10,true);
2 17563 j:= newactivity(i,0,frigivfil);
2 17564 <*+3*> skriv_newactivity(out,i,j);
2 17565 <*-3*>
2 17566
2 17566 i:= nextcoru(004,10,true);
2 17567 j:= newactivity(i,0,sletfil);
2 17568 <*+3*> skriv_newactivity(out,i,j);
2 17569 <*-3*>
2 17570
2 17570 i:= nextcoru(005,10,true);
2 17571 j:= newactivity(i,0,opretspoolfil);
2 17572 <*+3*> skriv_newactivity(out,i,j);
2 17573 <*-3*>
2 17574
2 17574 i:= nextcoru(006,10,true);
2 17575 j:= newactivity(i,0,opreteksternfil);
2 17576 <*+3*> skriv_newactivity(out,i,j);
2 17577 <*-3*>
2 17578 \f
2 17578 message attention_initialisering side 1 - 850820/cl;
2 17579
2 17579 tf_kommandotabel:= 1 shift 10 + 1;
2 17580
2 17580 begin
3 17581 integer i, s, zno;
3 17582 zone z(128,1,stderror);
3 17583 integer array fdim(1:8);
3 17584
3 17584 fdim(4):= tf_kommandotabel;
3 17585 hentfildim(fdim);
3 17586
3 17586 open(z,4,<:htkommando:>,0);
3 17587 for i:= 1 step 1 until fdim(3) do
3 17588 begin
4 17589 inrec6(z,512);
4 17590 s:= skrivfil(tf_kommandotabel,i,zno);
4 17591 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17592 tofrom(fil(zno),z,512);
4 17593 end;
3 17594 close(z,true);
3 17595 end;
2 17596 \f
2 17596 message attention_initialisering side 1a - 810428/hko;
2 17597
2 17597 for j:= system(3,i,terminal_tab) step 1 until i do
2 17598 terminal_tab(j):= 0;
2 17599
2 17599 cs_att_pulje:=next_semch;
2 17600 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17601 <*-3*>
2 17602
2 17602 bs_fortsæt_adgang:= nextsem;
2 17603 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17604 <*-3*>
2 17605 signalbin(bs_fortsæt_adgang);
2 17606
2 17606 for i:= 1,
2 17607 1 step 1 until max_antal_operatører,
2 17608 1 step 1 until max_antal_garageterminaler do
2 17609
2 17609 <* initialisering af pulje med attention_operationer *>
2 17610
2 17610 signalch(cs_att_pulje, <* pulje_semafor *>
2 17611 nextop(data+att_op_længde), <* næste_operation *>
2 17612 gen_optype);
2 17613
2 17613 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17614
2 17614 i:=next_coru(010,<*ident*>
2 17615 2,<*prioritet*>
2 17616 true<*test_maske*>);
2 17617 j:=newactivity( i, <*activityno *>
2 17618 0, <*ikke virtual *>
2 17619 attention);<*ingen parametre*>
2 17620
2 17620 <*+3*>skriv_newactivity(out,i,j);
2 17621 <*-3*>
2 17622 \f
2 17622 message io_initialisering side 1 - 810507/hko;
2 17623
2 17623 io_spoolfil:= 1028;
2 17624 begin
3 17625 integer array fdim(1:8);
3 17626 fdim(4):= io_spoolfil;
3 17627 hent_fildim(fdim);
3 17628 io_spool_postantal:= fdim(1);
3 17629 io_spool_postlængde:= fdim(2);
3 17630 end;
2 17631
2 17631 io_spool_post:= 4;
2 17632
2 17632 cs_io:= next_semch;
2 17633 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17634 <*-3*>
2 17635
2 17635 i:= next_coru(100,<*ident *>
2 17636 5,<*prioritet *>
2 17637 true<*test_maske*>);
2 17638
2 17638 j:= new_activity( i,
2 17639 0,
2 17640 h_io);
2 17641
2 17641 <*+3*>skriv_newactivity(out,i,j);
2 17642 <*-3*>
2 17643 cs_io_komm:= next_semch;
2 17644 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17645 <*-3*>
2 17646
2 17646 i:= next_coru(101,<*ident*>
2 17647 10,<*prioritet*>
2 17648 true <*testmaske*>);
2 17649 j:= new_activity( i,
2 17650 0,
2 17651 io_komm);<*ingen parametre*>
2 17652
2 17652 <*+3*>skriv_newactivity(out,i,j);
2 17653 <*-3*>
2 17654 \f
2 17654 message io_initialisering side 2 - 810520/hko/cl;
2 17655
2 17655 bs_zio_adgang:= next_sem;
2 17656 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17657 <*-3*>
2 17658 signal_bin(bs_zio_adgang);
2 17659
2 17659 cs_io_spool:= next_semch;
2 17660 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17661 <*-3*>
2 17662
2 17662 cs_io_fil:=next_semch;
2 17663 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17664 <*-3*>
2 17665 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17666
2 17666 ss_io_spool_fulde:= next_sem;
2 17667 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17668 <*-3*>
2 17669
2 17669 ss_io_spool_tomme:= next_sem;
2 17670 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17671 <*-3*>
2 17672 for i:= 1 step 1 until io_spool_postantal do
2 17673 signal(ss_io_spool_tomme);
2 17674 \f
2 17674 message io_initialisering side 3 - 880901/cl;
2 17675
2 17675 i:= next_coru(102,
2 17676 5,
2 17677 true);
2 17678 j:= new_activity(i,0,io_spool);
2 17679
2 17679 <*+3*>skriv_newactivity(out,i,j);
2 17680 <*-3*>
2 17681
2 17681 i:= next_coru(103,
2 17682 10,
2 17683 true);
2 17684 j:= new_activity(i,0,io_spon);
2 17685
2 17685 <*+3*>skriv_newactivity(out,i,j);
2 17686 <*-3*>
2 17687
2 17687 cs_io_medd:= next_semch;
2 17688 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17689 <*-3*>
2 17690
2 17690 i:= next_coru(104,<*ident *>
2 17691 10,<*prioritet *>
2 17692 true<*test_maske*>);
2 17693
2 17693 j:= new_activity( i,
2 17694 0,
2 17695 io_medd);
2 17696
2 17696 <*+3*>skriv_newactivity(out,i,j);
2 17697 <*-3*>
2 17698
2 17698 cs_io_nulstil:= next_semch;
2 17699 <*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
2 17700 <*-3*>
2 17701
2 17701 i:= next_coru(105,<*ident *>
2 17702 10,<*prioritet *>
2 17703 true<*test_maske*>);
2 17704
2 17704 j:= new_activity( i,
2 17705 0,
2 17706 io_nulstil_tællere);
2 17707
2 17707 <*+3*>skriv_newactivity(out,i,j);
2 17708 <*-3*>
2 17709
2 17709 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17710 i:= monitor(8)reserve process:(z_io,0,ia);
2 17711 if i <> 0 then
2 17712 begin
3 17713 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17714 end
2 17715 else
2 17716 begin
3 17717 ref:= 0;
3 17718 terminal_tab.ref.terminal_tilstand:= 0;
3 17719 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17720 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17721 "sp",1,"*",15,"nl",1);
3 17722 setposition(z_io,0,0);
3 17723 end;
2 17724 \f
2 17724 message operatør_initialisering side 1 - 810520/hko;
2 17725
2 17725 top_bpl_gruppe:= 64;
2 17726
2 17726 bpl_navn(0):= long<::>;
2 17727 for i:= 1 step 1 until 127 do
2 17728 begin
3 17729 k:= læsfil(tf_bpl_navne,i,j);
3 17730 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17731 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17732 if i<=max_antal_operatører then
3 17733 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17734 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17735 top_bpl_gruppe:= i;
3 17736 end;
2 17737
2 17737 for i:= 0 step 1 until 64 do
2 17738 begin
3 17739 iaf:= i*op_maske_lgd;
3 17740 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17741 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17742 if 1<=i and i<= max_antal_operatører then
3 17743 begin
4 17744 bpl_tilst(i,2):= 1;
4 17745 sætbit_ia(bpl_def.iaf,i,1);
4 17746 end;
3 17747 end;
2 17748 for i:= 65 step 1 until 127 do
2 17749 begin
3 17750 k:= læsfil(tf_bpl_def,i-64,j);
3 17751 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17752 iaf:= i*op_maske_lgd;
3 17753 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17754 bpl_tilst(i,1):= 0;
3 17755 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17756 end;
2 17757
2 17757 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17758 iaf:= 0;
2 17759 for i:= 1 step 1 until max_antal_operatører do
2 17760 begin
3 17761 k:= læsfil(tf_stoptabel,i,j);
3 17762 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17763 operatør_stop(i,0):= i;
3 17764 for k:= 1,2,3 do
3 17765 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17766 ant_i_opkø(i):= 0;
3 17767 end;
2 17768
2 17768 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17769 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17770 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17771 sidste_tv_brugt:= max_antal_taleveje;
2 17772
2 17772 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17773 opk_alarm(i):= 0;
2 17774 for i:= 1 step 1 until max_antal_operatører do
2 17775 begin
3 17776 integer array field tab;
3 17777
3 17777 k:= læsfil(tf_alarmlgd,i,j);
3 17778 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17779 tab:= (i-1)*opk_alarm_tab_lgd;
3 17780 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17781 opk_alarm.tab.alarm_start:= 0.0;
3 17782 end;
2 17783
2 17783 op_spool_kilde:= 2;
2 17784 op_spool_tid := 6;
2 17785 op_spool_text := 6;
2 17786 begin
3 17787 long array field laf1, laf2;
3 17788 laf2:= 4; laf1:= 0;
3 17789 op_spool_buf.laf1(1):= long<::>;
3 17790 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17791 op_spool_postantal*op_spool_postlgd-4);
3 17792 end;
2 17793
2 17793 k:=læsfil(1033,1,j);
2 17794 systime(1,0.0,r);
2 17795 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17796 for i:= 1 step 1 until max_cqf do
2 17797 begin
3 17798 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17799 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17800 cqf_tabel.ref.cqf_næste_tid:=
3 17801 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17802 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17803 end;
2 17804 op_cqf_tab_ændret:= true;
2 17805
2 17805 laf:= raf:= 0;
2 17806 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17807 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17808 j:= 1;
2 17809 if i<>0 then
2 17810 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17811 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17812 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17813 j:= 1;
2 17814 if i<>0 then
2 17815 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17816
2 17816 ia(1):= 3; <*canonical*>
2 17817 ia(2):= 0; <*no echo*>
2 17818 ia(3):= 0; <*prompt*>
2 17819 ia(4):= 2; <*timeout*>
2 17820 setcspterm(taleswitch_in_navn.laf,ia);
2 17821 setcspterm(taleswitch_out_navn.laf,ia);
2 17822
2 17822 cs_op:= next_semch;
2 17823
2 17823 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17824 <*-3*>
2 17825
2 17825 cs_op_retur:= next_semch;
2 17826
2 17826 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17827 <*-3*>
2 17828
2 17828 i:= nextcoru(200,<*ident*>
2 17829 10,<*prioitet*>
2 17830 true<*test_maske*>);
2 17831
2 17831 j:= new_activity( i,
2 17832 0,
2 17833 h_operatør);
2 17834
2 17834 <*+3*>skriv_newactivity(out,i,j);
2 17835 <*-3*>
2 17836 \f
2 17836 message operatør_initialisering side 2 - 810520/hko;
2 17837
2 17837 for k:= 1 step 1 until max_antal_operatører do
2 17838 begin
3 17839 ref:= (k-1)*8;
3 17840 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17841 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17842 ref:=k*terminal_beskr_længde;
3 17843 if i = 0 then
3 17844 begin
4 17845 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17846 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17847 end
3 17848 else
3 17849 begin
4 17850 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17851 end;
3 17852
3 17852 cs_operatør(k):= next_semch;
3 17853 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17854 <*-3*>
3 17855
3 17855 cs_op_fil(k):= nextsemch;
3 17856 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17857 <*-3*>
3 17858 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17859
3 17859 i:= next_coru(200+k,<*ident*>
3 17860 10,<*prioitet*>
3 17861 true<*testmaske*>);
3 17862 j:= new_activity( i,
3 17863 0,
3 17864 operatør,k);
3 17865
3 17865 <*+3*>skriv_newactivity(out,i,j);
3 17866 <*-3*>
3 17867 end;
2 17868
2 17868 cs_cqf:= next_semch;
2 17869 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17870 <*-3*>
2 17871
2 17871 signalch(cs_cqf,nextop(60),true);
2 17872
2 17872 i:= next_coru(292, <*ident*>
2 17873 10, <*prioritet*>
2 17874 true <*testmaske*>);
2 17875 j:= new_activity( i,
2 17876 0,
2 17877 op_cqftest);
2 17878 <*+3*>skriv_new_activity(out,i,j);
2 17879 <*-3*>
2 17880
2 17880 cs_op_spool:= next_semch;
2 17881 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17882 <*-3*>
2 17883
2 17883 cs_op_medd:= next_semch;
2 17884 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17885 <*-3*>
2 17886
2 17886 ss_op_spool_tomme:= next_sem;
2 17887 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17888 <*-3*>
2 17889 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17890
2 17890 ss_op_spool_fulde:= next_sem;
2 17891 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17892 <*-3*>
2 17893
2 17893 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17894
2 17894 i:= next_coru(293, <*ident*>
2 17895 10, <*prioritet*>
2 17896 true <*testmaske*>);
2 17897 j:= new_activity( i,
2 17898 0,
2 17899 op_spool);
2 17900 <*+3*>skriv_new_activity(out,i,j);
2 17901 <*-3*>
2 17902
2 17902 i:= next_coru(294, <*ident*>
2 17903 10, <*prioritet*>
2 17904 true <*testmaske*>);
2 17905 j:= new_activity( i,
2 17906 0,
2 17907 op_medd);
2 17908 <*+3*>skriv_new_activity(out,i,j);
2 17909 <*-3*>
2 17910
2 17910 cs_op_iomedd:= next_semch;
2 17911 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17912 <*-3*>
2 17913
2 17913 bs_opk_alarm:= next_sem;
2 17914 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17915 <*-3*>
2 17916
2 17916 cs_opk_alarm:= next_semch;
2 17917 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17918 <*-3*>
2 17919
2 17919 cs_opk_alarm_ur:= next_semch;
2 17920 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17921 <*-3*>
2 17922
2 17922 cs_opk_alarm_ur_ret:= next_semch;
2 17923 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17924 <*-3*>
2 17925
2 17925 cs_tvswitch_adgang:= next_semch;
2 17926 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17927 <*-3*>
2 17928
2 17928 cs_tv_switch_input:= next_semch;
2 17929 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17930 <*-3*>
2 17931
2 17931 cs_tv_switch_adm:= next_semch;
2 17932 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17933 <*-3*>
2 17934
2 17934 cs_talevejsswitch:= next_semch;
2 17935 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17936 <*-3*>
2 17937
2 17937 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17938
2 17938 iaf:= nextop(data+128);
2 17939 if testbit22 then
2 17940 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17941 else
2 17942 begin
3 17943 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17944 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17945 end;
2 17946
2 17946 i:= next_coru(295, <*ident*>
2 17947 8, <*prioritet*>
2 17948 true <*testmaske*>);
2 17949 j:= new_activity( i,
2 17950 0,
2 17951 alarmur);
2 17952 <*+3*>skriv_new_activity(out,i,j);
2 17953 <*-3*>
2 17954
2 17954 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17955
2 17955 i:= next_coru(296, <*ident*>
2 17956 8, <*prioritet*>
2 17957 true <*testmaske*>);
2 17958 j:= new_activity( i,
2 17959 0,
2 17960 opkaldsalarmer);
2 17961 <*+3*>skriv_new_activity(out,i,j);
2 17962 <*-3*>
2 17963
2 17963 i:= next_coru(297, <*ident*>
2 17964 3, <*prioritet*>
2 17965 true <*testmaske*>);
2 17966 j:= new_activity( i,
2 17967 0,
2 17968 tv_switch_input);
2 17969 <*+3*>skriv_new_activity(out,i,j);
2 17970 <*-3*>
2 17971
2 17971 for i:= 1,2 do
2 17972 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17973
2 17973 i:= next_coru(298, <*ident*>
2 17974 20, <*prioritet*>
2 17975 true <*testmaske*>);
2 17976 j:= new_activity( i,
2 17977 0,
2 17978 tv_switch_adm);
2 17979 <*+3*>skriv_new_activity(out,i,j);
2 17980 <*-3*>
2 17981
2 17981 i:= next_coru(299, <*ident*>
2 17982 3, <*prioritet*>
2 17983 true <*testmaske*>);
2 17984 j:= new_activity( i,
2 17985 0,
2 17986 talevejsswitch);
2 17987 <*+3*>skriv_new_activity(out,i,j);
2 17988 <*-3*>
2 17989 \f
2 17989 message garage_initialisering side 1 - 810521/hko;
2 17990
2 17990 cs_gar:= next_semch;
2 17991 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 17992 <*-3*>
2 17993
2 17993 i:= next_coru(300,<*ident*>
2 17994 10,<*prioritet*>
2 17995 true<*test_maske*>);
2 17996
2 17996 j:= new_activity( i,
2 17997 0,
2 17998 h_garage);
2 17999
2 17999 <*+3*>skriv_newactivity(out,i,j);
2 18000 <*-3*>
2 18001
2 18001 for k:= 1 step 1 until max_antal_garageterminaler do
2 18002 begin
3 18003 ref:= (k-1)*8;
3 18004 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 18005 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 18006 i:=monitor(4)process address:(z_gar(k),0,ia);
3 18007 if i = 0 then
3 18008 begin
4 18009 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 18010 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 18011 end
3 18012 else
3 18013 begin
4 18014 terminal_tab.ref.terminal_tilstand:=
4 18015 if garage_auto_include(k) then 0 else 7 shift 21;
4 18016 if garage_auto_include(k) then
4 18017 monitor(8)reserve:(z_gar(k),0,ia);
4 18018 end;
3 18019 cs_garage(k):= next_semch;
3 18020 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 18021 <*-3*>
3 18022 i:= next_coru(300+k,<*ident*>
3 18023 10,<*prioritet*>
3 18024 true <*testmaske*>);
3 18025 j:= new_activity( i,
3 18026 0,
3 18027 garage,k);
3 18028
3 18028 <*+3*>skriv_newactivity(out,i,j);
3 18029 <*-3*>
3 18030
3 18030 end;
2 18031 \f
2 18031 message radio_initialisering side 1 - 820301/hko;
2 18032
2 18032 cs_rad:= next_semch;
2 18033 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 18034 <*-3*>
2 18035
2 18035 i:= next_coru(400,<*ident*>
2 18036 10,<*prioritet*>
2 18037 true<*test_maske*>);
2 18038 j:= new_activity( i,
2 18039 0,
2 18040 h_radio);
2 18041 <*+3*>skriv_newactivity(out,i,j);
2 18042 <*-3*>
2 18043
2 18043 opkalds_kø_ledige:= max_antal_mobilopkald;
2 18044 nødopkald_brugt:= 0;
2 18045 læsfil(1034,1,i);
2 18046 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 18047
2 18047 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 18048 for i:= system(3,j,opkaldskø) step 1 until j do
2 18049 opkaldskø(i):= 0;
2 18050 første_frie_opkald:=opkaldskø_postlængde;
2 18051 første_opkald:=sidste_opkald:=
2 18052 første_nødopkald:=sidste_nødopkald:=j:=0;
2 18053
2 18053 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 18054 begin
3 18055 ref:=i*opkaldskø_postlængde;
3 18056 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 18057 end;
2 18058 ref:=ref+opkaldskø_postlængde;
2 18059 opkaldskø.ref(1):=j shift 12;
2 18060
2 18060 for ref:= 0 step 512 until (max_linienr//768*512) do
2 18061 begin
3 18062 i:= læs_fil(1035,ref//512+1,j);
3 18063 if i <> 0 then
3 18064 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 18065 tofrom(radio_linietabel.ref,fil(j),
3 18066 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 18067 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 18068 end;
2 18069
2 18069 for i:= system(3,j,kanal_tab) step 1 until j do
2 18070 kanal_tab(i):= 0;
2 18071 kanal_tilstand:= 2;
2 18072 kanal_id1:= 4;
2 18073 kanal_id2:= 6;
2 18074 kanal_spec:= 8;
2 18075 kanal_alt_id1:= 10;
2 18076 kanal_alt_id2:= 12;
2 18077 kanal_mon_maske:= 12;
2 18078 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 18079
2 18079 for i:= 1 step 1 until max_antal_kanaler do
2 18080 begin
3 18081 ref:= (i-1)*kanalbeskrlængde;
3 18082 sæthexciffer(kanal_tab.ref,3,15);
3 18083 if kanal_id(i) shift (-5) extract 3 = 2 or
3 18084 kanal_id(i) shift (-5) extract 3 = 3 and
3 18085 radio_id(kanal_id(i) extract 5)<=3
3 18086 then
3 18087 begin
4 18088 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 18089 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 18090 end;
3 18091 end;
2 18092 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 18093 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 18094 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 18095 optaget_flag:= 0;
2 18096 \f
2 18096 message radio_initialisering side 2 - 810524/hko;
2 18097
2 18097 bs_mobil_opkald:= next_sem;
2 18098
2 18098 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 18099 <*-3*>
2 18100
2 18100 bs_opkaldskø_adgang:= next_sem;
2 18101 signal_bin(bs_opkaldskø_adgang);
2 18102
2 18102 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 18103 <*-3*>
2 18104
2 18104 cs_radio_medd:=next_semch;
2 18105 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 18106
2 18106 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 18107 <*-3*>
2 18108
2 18108 i:= next_coru(403,
2 18109 5,<*prioritet*>
2 18110 true<*testmaske*>);
2 18111
2 18111 j:= new_activity( i,
2 18112 0,
2 18113 radio_medd_opkald);
2 18114
2 18114 <*+3*>skriv_newactivity(out,i,j);
2 18115 <*-3*>
2 18116
2 18116 cs_radio_adm:= nextsemch;
2 18117 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 18118 <*-3*>
2 18119
2 18119 i:= next_coru(404,
2 18120 10,
2 18121 true);
2 18122 j:= new_activity(i,
2 18123 0,
2 18124 radio_adm,next_op(data+radio_op_længde));
2 18125 <*+3*>skriv_new_activity(out,i,j);
2 18126 <*-3*>
2 18127 \f
2 18127 message radio_initialisering side 3 - 810526/hko;
2 18128 for k:= 1 step 1 until max_antal_taleveje do
2 18129 begin
3 18130
3 18130 cs_radio(k):=next_semch;
3 18131
3 18131 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 18132 <*-3*>
3 18133
3 18133 bs_talevej_udkoblet(k):= nextsem;
3 18134 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 18135 <*-3*>
3 18136
3 18136 i:=next_coru(410+k,
3 18137 10,
3 18138 true);
3 18139
3 18139 j:=new_activity( i,
3 18140 0,
3 18141 radio,k,next_op(data + radio_op_længde));
3 18142
3 18142 <*+3*>skriv_newactivity(out,i,j);
3 18143 <*-3*>
3 18144 end;
2 18145
2 18145 cs_radio_pulje:=next_semch;
2 18146
2 18146 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 18147 <*-3*>
2 18148
2 18148 for i:= 1 step 1 until radiopulje_størrelse do
2 18149 signal_ch(cs_radio_pulje,
2 18150 next_op(60),
2 18151 gen_optype or rad_optype);
2 18152
2 18152 cs_radio_kø:= next_semch;
2 18153
2 18153 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 18154 <*-3*>
2 18155
2 18155 mobil_opkald_aktiveret:= true;
2 18156 \f
2 18156 message radio_initialisering side 4 - 810522/hko;
2 18157
2 18157 laf:=raf:=0;
2 18158
2 18158 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 18159 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 18160 j:=1;
2 18161 if i <> 0 then
2 18162 fejlreaktion(4<*monitor resultat*>,i,
2 18163 string radio_fr_navn.raf(increase(j)),1);
2 18164 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 18165 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 18166 j:=1;
2 18167 if i <> 0 then
2 18168 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 18169 ia(1):= 3 <*canonical*>;
2 18170 ia(2):= 0 <*no echo*>;
2 18171 ia(3):= 0 <*prompt*>;
2 18172 ia(4):= 5 <*timeout*>;
2 18173 setcspterm(radio_fr_navn.laf,ia);
2 18174
2 18174 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 18175 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 18176 j:= 1;
2 18177 if i <> 0 then
2 18178 fejlreaktion(4<*monitor resultat*>,i,
2 18179 string radio_rf_navn.raf(increase(j)),1);
2 18180 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 18181 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 18182 j:= 1;
2 18183 if i <> 0 then
2 18184 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 18185 ia(1):= 3 <*canonical*>;
2 18186 ia(2):= 0 <*no echo*>;
2 18187 ia(3):= 0 <*prompt*>;
2 18188 ia(4):= 5 <*timeout*>;
2 18189 setcspterm(radio_rf_navn.laf,ia);
2 18190 \f
2 18190 message radio_initialisering side 5 - 810521/hko;
2 18191 for k:= 1 step 1 until max_antal_kanaler do
2 18192 begin
3 18193
3 18193 ss_radio_aktiver(k):=next_sem;
3 18194 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 18195 <*-3*>
3 18196
3 18196 ss_samtale_nedlagt(k):=next_sem;
3 18197 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 18198 <*-3*>
3 18199 end;
2 18200
2 18200 cs_radio_ind:= next_semch;
2 18201 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 18202 <*-3*>
2 18203
2 18203 i:= next_coru(401,<*ident radio_ind*>
2 18204 3, <*prioritet*>
2 18205 true <*testmaske*>);
2 18206 j:= new_activity( i,
2 18207 0,
2 18208 radio_ind,next_op(data + 64));
2 18209
2 18209 <*+3*>skriv_newactivity(out,i,j);
2 18210 <*-3*>
2 18211
2 18211 cs_radio_ud:=next_semch;
2 18212 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 18213 <*-3*>
2 18214
2 18214 i:= next_coru(402,<*ident radio_out*>
2 18215 10,<*prioritet*>
2 18216 true <*testmaske*>);
2 18217 j:= new_activity( i,
2 18218 0,
2 18219 radio_ud,next_op(data + 64));
2 18220
2 18220 <*+3*>skriv_newactivity(out,i,j);
2 18221 <*-3*>
2 18222 \f
2 18222 message vogntabel initialisering side 1 - 820301;
2 18223
2 18223 sidste_bus:= sidste_linie_løb:= 0;
2 18224
2 18224 tf_vogntabel:= 1 shift 10 + 2;
2 18225 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 18226 tf_gruppeidenter:= 1 shift 10 +6;
2 18227 tf_springdef:= 1 shift 10 +7;
2 18228 hent_fil_dim(ia);
2 18229 max_antal_i_gruppe:= ia(2);
2 18230 if ia(1) < max_antal_grupper then
2 18231 max_antal_grupper:= ia(1);
2 18232
2 18232 <* initialisering af interne vogntabeller *>
2 18233 begin
3 18234 long array field laf1,laf2;
3 18235 integer array fdim(1:8);
3 18236 zone z(128,1,stderror);
3 18237 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 18238 long omr,garageid;
3 18239 integer field ll, bn;
3 18240 boolean binær, test24;
3 18241
3 18241 ll:= 2; bn:= 4;
3 18242
3 18242 <* nulstil tabellerne *>
3 18243 laf1:= -2;
3 18244 laf2:= 2;
3 18245 bustabel1.laf2(0):=
3 18246 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 18247 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 18248 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 18249 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 18250 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 18251 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 18252 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 18253 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 18254 \f
3 18254 message vogntabel initialisering side 1a - 810505/cl;
3 18255
3 18255
3 18255 <* initialisering af intern busnummertabel *>
3 18256 open(z,4,<:busnumre:>,0);
3 18257 busnr:= -1;
3 18258 read(z,busnr);
3 18259 while busnr > 0 do
3 18260 begin
4 18261 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 18262 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 18263 sidste_bus:= sidste_bus+1;
4 18264 if sidste_bus > max_antal_busser then
4 18265 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 18266 repeatchar(z); readchar(z,tegn);
4 18267 garageid:= extend 0; binær:= false; omr:= extend 0;
4 18268 g_nr:= o_nr:= 0;
4 18269 if tegn='!' then
4 18270 begin
5 18271 binær:= true;
5 18272 readchar(z,tegn);
5 18273 end;
4 18274 if tegn='/' then <*garageid*>
4 18275 begin
5 18276 readchar(z,tegn); repeatchar(z);
5 18277 if '0'<=tegn and tegn<='9' then
5 18278 begin
6 18279 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 18280 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 18281 if g_nr<>0 and garageid=long<::> then
6 18282 begin
7 18283 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 18284 g_nr:= 0;
7 18285 end;
6 18286 end
5 18287 else
5 18288 begin
6 18289 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 18290 begin
7 18291 garageid:= garageid shift 8 + tegn;
7 18292 readchar(z,tegn);
7 18293 end;
6 18294 while garageid shift (-40) extract 8 = 0 do
6 18295 garageid:= garageid shift 8;
6 18296 g_nr:= find_bpl(garageid);
6 18297 if g_nr=0 then
6 18298 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 18299 end;
5 18300 repeatchar(z); readchar(z,tegn);
5 18301 end;
4 18302 if tegn=';' then
4 18303 begin
5 18304 readchar(z,tegn); repeatchar(z);
5 18305 if '0'<=tegn and tegn<='9' then
5 18306 begin
6 18307 read(z,o_nr);
6 18308 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 18309 if o_nr<>0 then omr:= område_navn(o_nr);
6 18310 if o_nr<>0 and omr=long<::> then
6 18311 begin
7 18312 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 18313 o_nr:= 0;
7 18314 end;
6 18315 end
5 18316 else
5 18317 begin
6 18318 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 18319 begin
7 18320 omr:= omr shift 8 + tegn;
7 18321 readchar(z,tegn);
7 18322 end;
6 18323 while omr shift (-40) extract 8 = 0 do
6 18324 omr:= omr shift 8;
6 18325 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 18326 i:= 1;
6 18327 while i<=max_antal_områder and o_nr=0 do
6 18328 begin
7 18329 if omr=område_navn(i) then o_nr:= i;
7 18330 i:= i+1;
7 18331 end;
6 18332 if o_nr=0 then
6 18333 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 18334 end;
5 18335 repeatchar(z); readchar(z,tegn);
5 18336 end;
4 18337 if o_nr=0 then o_nr:= 3;
4 18338 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 18339 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 18340
4 18340 busnr:= -1;
4 18341 read(z,busnr);
4 18342 end;
3 18343 close(z,true);
3 18344 \f
3 18344 message vogntabel initialisering side 2 - 820301/cl;
3 18345
3 18345 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 18346 test24:= testbit24;
3 18347 testbit24:= false;
3 18348 i:= 1;
3 18349 s:= læsfil(tf_vogntabel,i,zi);
3 18350 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 18351 while fil(zi).bn<>0 do
3 18352 begin
4 18353 if fil(zi).ll <> 0 then
4 18354 begin <* indsæt linie/løb *>
5 18355 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 18356 fil(zi).ll,j);
5 18357 if res < 0 then j:= j+1;
5 18358 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 18359 <:dobbeltregistrering i vogntabel:>,1)
5 18360 else
5 18361 begin
6 18362 o_nr:= fil(zi).bn shift (-14) extract 8;
6 18363 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 18364 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 18365 <:ukendt bus i vogntabel:>,1)
6 18366 else
6 18367 begin
7 18368 if sidste_linie_løb >= max_antal_linie_løb then
7 18369 fejlreaktion(10,fil(zi).bn extract 14,
7 18370 <:for mange linie/løb i vogntabel:>,0);
7 18371 for ll_nr:= sidste_linie_løb step (-1) until j do
7 18372 begin
8 18373 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18374 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18375 end;
7 18376 linie_løb_tabel(j):= fil(zi).ll;
7 18377 bus_indeks(j):= false add b_nr;
7 18378 sidste_linie_løb:= sidste_linie_løb + 1;
7 18379 end;
6 18380 end;
5 18381 end;
4 18382 i:= i+1;
4 18383 s:= læsfil(tf_vogntabel,i,zi);
4 18384 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18385 end;
3 18386 \f
3 18386 message vogntabel initialisering side 3 - 810428/cl;
3 18387
3 18387 <* initialisering af intern linie/løb-indekstabel *>
3 18388 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18389 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18390
3 18390 <* gem ny vogntabel i tabelfil *>
3 18391 for i:= 1 step 1 until sidste_bus do
3 18392 begin
4 18393 s:= skriv_fil(tf_vogntabel,i,zi);
4 18394 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18395 fil(zi).bn:= bustabel(i) extract 14 add
4 18396 (bustabel1(i) extract 8 shift 14);
4 18397 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18398 end;
3 18399 fdim(4):= tf_vogntabel;
3 18400 hent_fil_dim(fdim);
3 18401 pant:= fdim(3) * (256//fdim(2));
3 18402 for i:= sidste_bus+1 step 1 until pant do
3 18403 begin
4 18404 s:= skriv_fil(tf_vogntabel,i,zi);
4 18405 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18406 fil(zi).ll:= fil(zi).bn:= 0;
4 18407 end;
3 18408
3 18408 <* initialisering/nulstilling af gruppetabeller *>
3 18409 for i:= 1 step 1 until max_antal_grupper do
3 18410 begin
4 18411 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18412 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18413 gruppetabel(i):= fil(zi).ll;
4 18414 end;
3 18415 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18416 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18417 testbit24:= test24;
3 18418 end;
2 18419
2 18419
2 18419 <*+2*>
2 18420 <**> if testbit40 then p_vogntabel(out);
2 18421 <**> if testbit43 then p_gruppetabel(out);
2 18422 <*-2*>
2 18423
2 18423 message vogntabel initialisering side 3a -920517/cl;
2 18424
2 18424 <* initialisering for vt_log *>
2 18425
2 18425 v_tid:= 4;
2 18426 v_kode:= 6;
2 18427 v_bus:= 8;
2 18428 v_ll1:= 10;
2 18429 v_ll2:= 12;
2 18430 v_tekst:= 6;
2 18431 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18432 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18433 if vt_log_aktiv then
2 18434 begin
3 18435 integer i;
3 18436 real t;
3 18437 integer array field iaf;
3 18438 integer array
3 18439 tail(1:10),ia(1:10),chead(1:20);
3 18440
3 18440 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18441 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18442 if i=0 then
3 18443 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18444 if i=0 then
3 18445 begin
4 18446 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18447 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18448 end;
3 18449
3 18449 if i=0 then
3 18450 begin
4 18451 iaf:= 2;
4 18452 tofrom(vt_logdisc,tail.iaf,8);
4 18453 i:=slices(vt_logdisc,0,tail,chead);
4 18454 if i > (-2048) then
4 18455 begin
5 18456 vt_log_slicelgd:= chead(15);
5 18457 i:= 0;
5 18458 end;
4 18459 end;
3 18460
3 18460 if i=0 then
3 18461 begin
4 18462 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18463 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18464 if i=0 then
4 18465 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18466 if i=0 then
4 18467 begin
5 18468 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18469 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18470 end;
4 18471
4 18471 if i<>0 then
4 18472 begin
5 18473 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18474 tail(1):= 1;
5 18475 iaf:= 2;
5 18476 tofrom(tail.iaf,vt_logdisc,8);
5 18477 tail(6):=systime(7,0,t);
5 18478 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18479 if i=0 then
5 18480 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18481 end;
4 18482 end;
3 18483
3 18483 if i<>0 then vt_log_aktiv:= false;
3 18484 end;
2 18485
2 18485
2 18485 \f
2 18485 message vogntabel initialisering side 4 - 810520/cl;
2 18486
2 18486 cs_vt:= nextsemch;
2 18487 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18488 <*-3*>
2 18489
2 18489 cs_vt_adgang:= nextsemch;
2 18490 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18491 <*-3*>
2 18492
2 18492 cs_vt_opd:= nextsemch;
2 18493 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18494 <*-3*>
2 18495
2 18495 cs_vt_rap:= nextsemch;
2 18496 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18497 <*-3*>
2 18498
2 18498 cs_vt_tilst:= nextsemch;
2 18499 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18500 <*-3*>
2 18501
2 18501 cs_vt_auto:= nextsemch;
2 18502 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18503 <*-3*>
2 18504
2 18504 cs_vt_grp:= nextsemch;
2 18505 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18506 <*-3*>
2 18507
2 18507 cs_vt_spring:= nextsemch;
2 18508 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18509 <*-3*>
2 18510
2 18510 cs_vt_log:= nextsemch;
2 18511 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18512 <*-3*>
2 18513
2 18513 cs_vt_logpool:= nextsemch;
2 18514 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18515 <*-3*>
2 18516
2 18516 vt_op:= nextop(vt_op_længde);
2 18517 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18518
2 18518 vt_logop(1):= nextop(vt_op_længde);
2 18519 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18520 vt_logop(2):= nextop(vt_op_længde);
2 18521 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18522
2 18522 \f
2 18522 message vogntabel initialisering side 5 - 81-520/cl;
2 18523
2 18523 i:= nextcoru(500, <*ident*>
2 18524 10, <*prioitet*>
2 18525 true <*testmaske*>);
2 18526 j:= new_activity( i,
2 18527 0,
2 18528 h_vogntabel);
2 18529 <*+3*> skriv_newactivity(out,i,j);
2 18530 <*-3*>
2 18531
2 18531 i:= nextcoru(501, <*ident*>
2 18532 10, <*prioritet*>
2 18533 true <*testmaske*>);
2 18534 iaf:= nextop(filop_længde);
2 18535 j:= new_activity(i,
2 18536 0,
2 18537 vt_opdater,iaf);
2 18538 <*+3*> skriv_newactivity(out,i,j);
2 18539 <*-3*>
2 18540
2 18540 i:= nextcoru(502, <*ident*>
2 18541 10, <*prioritet*>
2 18542 true <*testmaske*>);
2 18543 k:= nextsemch;
2 18544 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18545 <*-3*>
2 18546 iaf:= nextop(fil_op_længde);
2 18547 j:= newactivity(i,
2 18548 0,
2 18549 vt_tilstand,
2 18550 k,
2 18551 iaf);
2 18552 <*+3*> skriv_newactivity(out,i,j);
2 18553 <*-3*>
2 18554 \f
2 18554 message vogntabel initialisering side 6 - 810520/cl;
2 18555
2 18555 i:= nextcoru(503, <*ident*>
2 18556 10, <*prioritet*>
2 18557 true <*testmaske*>);
2 18558 k:= nextsemch;
2 18559 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18560 <*-3*>
2 18561 iaf:= nextop(fil_op_længde);
2 18562 j:= newactivity(i,
2 18563 0,
2 18564 vt_rapport,
2 18565 k,
2 18566 iaf);
2 18567 <*+3*> skriv_newactivity(out,i,j);
2 18568 <*-3*>
2 18569
2 18569 i:= nextcoru(504, <*ident*>
2 18570 10, <*prioritet*>
2 18571 true <*testmaske*>);
2 18572 k:= nextsemch;
2 18573 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18574 <*-3*>
2 18575 iaf:= nextop(fil_op_længde);
2 18576 j:= new_activity(i,
2 18577 0,
2 18578 vt_gruppe,
2 18579 k,
2 18580 iaf);
2 18581 <*+3*> skriv_newactivity(out,i,j);
2 18582 <*-3*>
2 18583 \f
2 18583 message vogntabel initialisering side 7 - 810520/cl;
2 18584
2 18584 i:= nextcoru(505, <*ident*>
2 18585 10, <*prioritet*>
2 18586 true <*testmaske*>);
2 18587 k:= nextsemch;
2 18588 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18589 <*-3*>
2 18590 iaf:= nextop(fil_op_længde);
2 18591 j:= newactivity(i,
2 18592 0,
2 18593 vt_spring,
2 18594 k,
2 18595 iaf);
2 18596 <*+3*> skriv_newactivity(out,i,j);
2 18597 <*-3*>
2 18598
2 18598 i:= nextcoru(506, <*ident*>
2 18599 10,
2 18600 true <*testmaske*>);
2 18601 k:= nextsemch;
2 18602 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18603 <*-3*>
2 18604 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18605 j:= newactivity(i,
2 18606 0,
2 18607 vt_auto,
2 18608 k,
2 18609 iaf);
2 18610 <*+3*> skriv_newactivity(out,i,j);
2 18611 <*-3*>
2 18612
2 18612 i:=nextcoru(507, <*ident*>
2 18613 10, <*prioritet*>
2 18614 true <*testmaske*>);
2 18615 j:=newactivity(i,
2 18616 0,
2 18617 vt_log);
2 18618 <*+3*> skriv_newactivity(out,i,j);
2 18619 <*-3*>
2 18620
2 18620 <*+2*>
2 18621 <**> if testbit42 then skriv_vt_variable(out);
2 18622 <*-2*>
2 18623 \f
2 18623 message sysslut initialisering side 1 - 810406/cl;
2 18624 begin
3 18625 zone z(128,1,stderror);
3 18626 integer i,coruid,j,k;
3 18627 integer array field cor;
3 18628
3 18628 open(z,4,<:overvågede:>,0);
3 18629 for i:= read(z,coruid) while i > 0 do
3 18630 begin
4 18631 if coruid = 0 then
4 18632 begin
5 18633 for coruid:= 1 step 1 until maxcoru do
5 18634 begin
6 18635 cor:= coroutine(coruid);
6 18636 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18637 end
5 18638 end
4 18639 else
4 18640 begin
5 18641 cor:= coroutine(coru_no(abs coruid));
5 18642 if cor > 0 then
5 18643 begin
6 18644 d.cor.corutestmask:=
6 18645 (d.cor.corutestmask shift 1 shift (-1)) add
6 18646 ((coruid > 0) extract 1 shift 11);
6 18647 end;
5 18648 end;
4 18649 end;
3 18650 close(z,true);
3 18651
3 18651 læsfil(tf_systællere,1,k);
3 18652 rf:=iaf:= 4;
3 18653 systællere_nulstillet:= fil(k).rf;
3 18654 nulstil_systællere:= fil(k).iaf(1);
3 18655 if systællere_nulstillet=real<::> then
3 18656 begin
4 18657 systællere_nulstillet:= 0.0;
4 18658 nulstil_systællere:= -1;
4 18659 end;
3 18660 iaf:= 32;
3 18661 tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*10);
3 18662 iaf:= 192;
3 18663 tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*10);
3 18664
3 18664 end;
2 18665 \f
2 18665 message sysslut initialisering side 2 - 810603/cl;
2 18666
2 18666
2 18666 if låsning > 0 then
2 18667 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18668
2 18668 if låsning > 1 then
2 18669 <* låsning 2 : *> lock(readchar,1,write,2);
2 18670
2 18670 if låsning > 2 then
2 18671 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18672
2 18672
2 18672
2 18672
2 18672 if låsning > 0 then
2 18673 begin
3 18674 i:= locked(ia);
3 18675 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18676 end;
2 18677 \f
2 18677 message sysslut initialisering side 3 - 810406/cl;
2 18678
2 18678 write(z_io,"nl",2,<:initialisering slut:>);
2 18679 system(2)free core:(i,ra);
2 18680 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18681 setposition(z_io,0,0);
2 18682 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18683 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18684 "nl",1);
2 18685 errorbits:= 3; <* ok.no warning.yes *>
2 18686 \f
2 18686
2 18686 algol list.off;
2 18687 message coroutinemonitor - 40 ;
2 18688
2 18688 if simref <> firstsem then initerror(1, false);
2 18689 if semref <> firstop - 4 then initerror(2, false);
2 18690 if coruref <> firstsim then initerror(3, false);
2 18691 if opref <> optop + 6 then initerror(4, false);
2 18692 if proccount <> maxprocext -1 then initerror(5, false);
2 18693 goto takeexternal;
2 18694
2 18694 dump:
2 18695 op:= op;
2 18696 \f
2 18696 message sys trapaktion side 1 - 810521/hko/cl;
2 18697 trap(finale);
2 18698 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18699 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18700 begin
3 18701 k:= 0;
3 18702 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18703 <:timerqueue->:>));
3 18704 iaf:= i;
3 18705 for iaf:= d.iaf.next while iaf<>i do
3 18706 begin
4 18707 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18708 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18709 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18710 end;
3 18711 end;
2 18712 outchar(zbillede,'nl');
2 18713
2 18713 skriv_opkaldstællere(zbillede);
2 18714
2 18714
2 18714 pfilsystem(zbillede);
2 18715
2 18715 \f
2 18715 message operatør trapaktion1 side 1 - 810521/hko;
2 18716 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18717
2 18717 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18718 for i:= 1 step 1 until max_antal_operatører do
2 18719 begin
3 18720 laf:= (i-1)*8;
3 18721 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18722 case operatør_auto_include(i) extract 2 + 1 of (
3 18723 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18724 terminal_navn.laf,"nl",1);
3 18725 end;
2 18726 write(zbillede,"nl",1);
2 18727
2 18727 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18728 <:betjeningspladsgrupper::>,"nl",1);
2 18729 for i:= 1 step 1 until 127 do
2 18730 if bpl_navn(i)<>long<::> then
2 18731 begin
3 18732 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18733 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18734 write(zbillede,"sp",16-k,<:= :>);
3 18735 iaf:= i*op_maske_lgd; j:=0;
3 18736 for k:= 1 step 1 until max_antal_operatører do
3 18737 begin
4 18738 if læsbit_ia(bpl_def.iaf,k) then
4 18739 begin
5 18740 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18741 write(zbillede,true,6,string bpl_navn(k));
5 18742 j:= j+1;
5 18743 end;
4 18744 end;
3 18745 write(zbillede,"nl",1);
3 18746 end;
2 18747
2 18747 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18748 for i:= 1 step 1 until max_antal_operatører do
2 18749 begin
3 18750 write(zbillede,<<dd >,i);
3 18751 for j:= 0 step 1 until 3 do
3 18752 begin
4 18753 k:= operatør_stop(i,j);
4 18754 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18755 else string bpl_navn(k));
4 18756 end;
3 18757 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18758 end;
2 18759
2 18759 skriv_terminal_tab(zbillede);
2 18760 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18761 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18762 skriv_opk_alarm_tab(zbillede);
2 18763 skriv_talevejs_tab(zbillede);
2 18764 skriv_op_spool_buf(zbillede);
2 18765 skriv_cqf_tabel(zbillede,true);
2 18766 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18767
2 18767 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18768 for i:= 1 step 1 until max_antal_garageterminaler do
2 18769 begin
3 18770 laf:= (i-1)*8;
3 18771 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18772 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18773 end;
2 18774 \f
2 18774 message radio trapaktion side 1 - 820301/hko;
2 18775 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18776 skriv_kanal_tab(zbillede);
2 18777 skriv_opkaldskø(zbillede);
2 18778 skriv_radio_linietabel(zbillede);
2 18779 skriv_radio_områdetabel(zbillede);
2 18780
2 18780 \f
2 18780 message vogntabel trapaktion side 1 - 810520/cl;
2 18781 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18782 skriv_vt_variable(zbillede);
2 18783 p_vogntabel(zbillede);
2 18784 p_gruppetabel(zbillede);
2 18785 p_springtabel(zbillede);
2 18786 \f
2 18786 message sysslut trapaktion side 1 - 810519/cl;
2 18787 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18788 corutable(zbillede);
2 18789 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18790 <: ref værdi prev next:>,"nl",1);
2 18791 iaf:= firstsim;
2 18792 repeat
2 18793 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18794 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18795 iaf:= iaf + simsize;
2 18796 until iaf>=simref;
2 18797 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18798 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18799 iaf:= firstsem;
2 18800 repeat
2 18801 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18802 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18803 iaf:= iaf+semsize;
2 18804 until iaf>=semref;
2 18805 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18806 iaf:= firstop;
2 18807 repeat
2 18808 skriv_op(zbillede,iaf);
2 18809 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18810 until iaf>=optop;
2 18811 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18812 <: messref messcode messop:>,"nl",1);
2 18813 for i:= 1 step 1 until maxmessext do
2 18814 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18815 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18816 <: procref proccode procop:>,"nl",1);
2 18817 for i:= 1 step 1 until maxprocext do
2 18818 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18819
2 18819
2 18819 \f
2 18819 message sys_finale side 1 - 810428/hko;
2 18820
2 18820 finale:
2 18821 trap(slut_finale);
2 18822 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18823 endaction:=0;
2 18824 \f
2 18824 message filsystem finale side 1 - 810428/cl;
2 18825
2 18825 <* lukning af zoner *>
2 18826 write(out,<:lukker filsystem:>); ud;
2 18827 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18828 close(fil(i),true);
2 18829 \f
2 18829 message operatør_finale side 1 - 810428/hko;
2 18830
2 18830 goto op_trap2_slut;
2 18831
2 18831 write(out,<:lukker operatører:>); ud;
2 18832 for k:= 1 step 1 until max_antal_operatører do
2 18833 begin
3 18834 close(z_op(k),true);
3 18835 end;
2 18836 op_trap2_slut:
2 18837 k:=k;
2 18838
2 18838 \f
2 18838 message garage_finale side 1 - 810428/hko;
2 18839
2 18839 write(out,<:lukker garager:>); ud;
2 18840 for k:= 1 step 1 until max_antal_garageterminaler do
2 18841 begin
3 18842 close(z_gar(k),true);
3 18843 end;
2 18844 \f
2 18844 message radio_finale side 1 - 810525/hko;
2 18845 write(out,<:lukker radio:>); ud;
2 18846 close(z_fr_in,true);
2 18847 close(z_fr_out,true);
2 18848 close(z_rf_in,true);
2 18849 close(z_rf_out,true);
2 18850 \f
2 18850 message sysslut finale side 1 - 810530/cl;
2 18851
2 18851 slut_finale:
2 18852
2 18852 trap(exit_finale);
2 18853
2 18853 outchar(zrl,'em');
2 18854 close(zrl,true);
2 18855
2 18855 write(zbillede,
2 18856 "nl",2,<:blocksread=:>,blocksread,
2 18857 "nl",1,<:blocksout= :>,blocksout,
2 18858 "nl",1,<:fillæst= :>,fillæst,
2 18859 "nl",1,<:filskrevet=:>,filskrevet,
2 18860 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18861 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18862 close(zbillede,true);
2 18863 monitor(42,zbillede,0,ia);
2 18864 ia(6):= systime(7,0,0.0);
2 18865 monitor(44,zbillede,0,ia);
2 18866 setposition(z_io,0,0);
2 18867 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18868 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18869 close(z_io,true);
2 18870 exit_finale: trapmode:= 1 shift 10;
2 18871
2 18871 end;
1 18872
1 18872
1 18872 algol list.on;
1 18873 message programslut;
1 18874 program_slut:
1 18875 end
\f
1. 7053191 13236373 610 0 0
2. 13975084 1883462 350 0 0
3. 1659907 8864126 418 368 0
4. 6862480 8909483 428 1653 742
5. 12248314 3624577 582 29903 605
6. 12253497 9665780 583 0 0
7. 12557109 12895971 632 0 0
8. 18865 18859 18846 18828 18815 18807 18797 18789 18778 18767
18760 18747 18733 18724 18716 18702 18690 18681 18671 18657
18629 18604 18586 18562 18542 18521 18508 18493 18477 18462
18441 18415 18401 18384 18364 18355 18333 18308 18283 18265
18252 18248 18220 18205 18189 18178 18165 18150 18134 18121
18105 18089 18067 18049 18033 18015 17998 17975 17956 17937
17925 17911 17891 17877 17858 17845 17826 17815 17802 17792
17775 17762 17751 17733 17720 17707 17687 17669 17656 17633
17613 17597 17584 17567 17555 17540 17525 17506 17485 17471
17461 17456 17446 17438 17419 17398 17378 17370 17363 17353
17308 17263 17235 17222 17189 17162 17139 17099 17074 17045
16989 16934 16881 16852 16819 16777 16745 16710 16654 16616
16576 16528 16495 16470 16447 16427 16399 16380 16361 16338
16327 16316 16296 16279 16264 16248 16221 16202 16186 16168
16159 16152 16127 16119 16109 16089 16078 16059 16048 16031
16016 15998 15973 15960 15949 15932 15914 15900 15893 15885
15876 15848 15831 15814 15801 15793 15784 15765 15754 15740
15728 15701 15686 15668 15646 15626 15613 15594 15571 15545
15524 15513 15491 15471 15449 15431 15403 15382 15364 15351
15343 15336 15321 15302 15295 15278 15258 15238 15224 15199
15184 15163 15137 15125 15116 15087 15065 15045 15035 15024
14999 14978 14958 14928 14909 14890 14870 14849 14841 14815
14802 14785 14766 14740 14721 14704 14677 14657 14635 14618
14598 14567 14536 14501 14474 14453 14440 14429 14408 14400
14391 14372 14352 14329 14302 14285 14267 14254 14244 14233
14209 14185 14166 14136 14123 14090 14055 14040 14019 14007
13981 13960 13940 13916 13905 13875 13856 13833 13803 13787
13764 13737 13702 13675 13668 13654 13633 13621 13607 13599
13584 13570 13563 13556 13549 13541 13508 13493 13473 13460
13442 13428 13400 13373 13355 13334 13316 13299 13282 13270
13260 13236 13230 13215 13195 13179 13162 13137 13124 13089
13072 13055 13032 13016 13004 12986 12959 12948 12940 12917
12898 12889 12872 12857 12839 12830 12818 12809 12791 12775
12760 12749 12730 12702 12681 12660 12644 12630 12623 12611
12594 12562 12544 12528 12511 12495 12464 12440 12430 12417
12402 12386 12368 12350 12326 12315 12299 12282 12266 12249
12225 12218 12200 12173 12155 12130 12105 12061 12050 12039
12011 11978 11948 11921 11879 11852 11831 11818 11810 11802
11792 11763 11746 11725 11710 11690 11667 11645 11621 11593
11571 11554 11529 11512 11496 11473 11458 11439 11420 11396
11361 11335 11317 11298 11277 11249 11232 11210 11196 11173
11145 11132 11119 11090 11052 11021 10978 10944 10913 10906
10898 10890 10879 10850 10827 10812 10802 10782 10764 10751
10742 10730 10721 10706 10698 10686 10657 10635 10617 10563
10528 10494 10461 10402 10386 10369 10350 10337 10324 10303
10291 10273 10260 10247 10220 10201 10184 10147 10131 10112
10104 10094 10063 10044 10027 10016 9986 9963 9938 9925
9916 9902 9878 9871 9861 9844 9825 9811 9792 9780
9764 9753 9742 9717 9700 9678 9660 9642 9622 9609
9589 9578 9552 9533 9514 9500 9490 9462 9444 9436
9412 9400 9388 9364 9346 9330 9319 9291 9274 9270
9253 9244 9237 9226 9212 9196 9179 9167 9155 9136
9126 9118 9091 9075 9068 9055 9041 9024 9016 9000
8991 8972 8935 8926 8901 8889 8875 8851 8831 8811
8789 8749 8731 8716 8704 8686 8677 8670 8658 8643
8632 8621 8607 8598 8577 8572 8561 8550 8534 8526
8516 8495 8483 8471 8451 8442 8428 8418 8404 8383
8368 8351 8341 8325 8312 8305 8288 8266 8247 8226
8212 8195 8177 8161 8144 8133 8119 8104 8058 8039
8002 7979 7956 7942 7921 7905 7876 7862 7840 7821
7790 7775 7763 7744 7731 7715 7696 7685 7670 7654
7642 7624 7594 7573 7552 7529 7506 7489 7473 7450
7433 7415 7378 7355 7348 7323 7311 7288 7274 7265
7246 7234 7217 7205 7184 7172 7154 7136 7114 7092
7084 7076 7069 7043 7016 6998 6978 6960 6944 6932
6912 6903 6886 6869 6858 6847 6836 6826 6821 6809
6799 6780 6767 6740 6729 6713 6705 6687 6671 6660
6624 6608 6594 6562 6535 6523 6513 6500 6487 6478
6463 6449 6430 6415 6409 6403 6383 6373 6360 6349
6328 6316 6303 6290 6281 6265 6249 6228 6209 6188
6179 6146 6124 6106 6079 6055 6042 6028 6014 5997
5981 5968 5946 5934 5923 5912 5898 5867 5841 5831
5816 5788 5766 5752 5744 5732 5716 5706 5693 5681
5663 5642 5625 5600 5577 5559 5548 5532 5512 5490
5473 5456 5442 5422 5405 5388 5378 5368 5355 5339
5329 5315 5300 5284 5274 5262 5244 5231 5211 5198
5185 5165 5145 5126 5112 5097 5082 5062 5043 5015
5002 4986 4969 4951 4933 4910 4886 4865 4854 4834
4815 4796 4782 4763 4745 4717 4696 4677 4642 4620
4612 4604 4595 4564 4543 4530 4508 4493 4463 4430
4391 4372 4347 4335 4319 4300 4291 4261 4244 4230
4203 4184 4163 4157 4116 4100 4053 4025 3989 3963
3920 3882 3830 3788 3755 3717 3659 3602 3559 3521
3477 3446 3409 3354 3312 3273 3263 3242 3228 3211
3190 3166 3151 3131 3084 3065 3034 2988 2970 2930
2906 2877 2842 2812 2798 2669 2630 2609 2572 2549
2503 2468 2446 2428 2412 2389 2369 2358 2348 2324
2307 2277 2267 2243 2221 2204 2180 2150 2128 2117
2095 2077 2065 2038 2023 2015 1987 1971 1953 1923
1902 1890 1881 1857 1838 1817 1801 1784 1765 1758
1745 1733 1719 1703 1690 1683 1668 1639 1621 1589
1555 1516 1490 1461 1433 1410 1384 1369 1338 1314
1291 1266 1256 1243 1237 1226 1199 1192 1187 1163
1154 1145 1139 1117 1086 1066 1034 1013 978 943
911 897 883 861 836 828 817 803 785 755
731 694 644 618 572 390 338 322 308 281
234 209 196 181 168 1 1 1 1 1
12557109 12895971 970 506071 31003
9. 16 120 16 4 960612 223004 buskom1
7 3 1995 306 algftnrts
0 1 0 2 *version
982 400 982 4 flushout
982 44 982 4 911004 101112 sendmessage
983 106 983 12 910308 134214 copyout
984 244 984 12 890821 163833 getzone6
0 410 0 0 out
985 178 985 12 940411 220029 testbit
988 414 988 18 940411 222629 findfpparam
991 46 991 18 890821 163814 system
994 238 994 18 movestring
994 56 994 18 890821 163907 outdate
995 124 995 18 isotable
996 176 995 18 890821 163656 write
1001 310 1001 152 intable
1002 34 1001 152 890821 163503 read
1006 24 1006 340 890821 163714 tofrom
993 420 991 18 stderror
1008 80 1008 340 890821 163740 open
1012 112 1012 340 890821 163754 monitor
1009 344 1008 340 close
1010 22 1008 340 setposition
993 378 991 18 increase
1000 50 995 18 outchar
995 26 995 18 replacechar
1015 98 1015 340 951214 094619 systime
0 1700 0 0 trapmode
1016 302 1016 340 trap
1016 112 1016 340 890821 163915 initzones
1017 268 1017 340 940411 222959 læsbitia
1018 22 1018 340 sign
1018 28 1018 340 890821 163648 ln
1019 432 1019 340 810409 111908 skrivhele
984 320 984 12 setzone6
1027 52 1027 340 inrec6
1027 28 1027 340 890821 163732 changerec6
1028 228 1028 340 940411 222949 sætbitia
1002 36 1001 152 readchar
1029 348 1029 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1030 278 1030 340 940411 222636 skrivtegn
1031 384 1031 340 940411 222639 afsluttext
1032 394 1032 340 940411 222952 læsbiti
1033 498 1033 340 960610 222201 systid
1035 28 1035 340 getnumber
1035 18 1035 340 900925 171358 putnumber
1 656 0 0 errorbits
1042 60 1042 342 940411 222943 sætbiti
1043 354 1043 342 940411 222801 openbs
1045 228 1045 342 940411 222742 hægttekst
1027 54 1027 340 outrec6
0 1704 0 0 alarmcause
1046 332 1046 342 940411 222745 hægtstring
1047 254 1047 342 940411 222749 anbringtal
1001 288 1001 152 repeatchar
1048 444 1048 342 940411 223002 intg
1049 350 1049 342 940411 222739 binærsøg
1018 20 1018 340 sgn
1050 380 1050 342 940411 222646 skrivtext
1027 56 1027 340 swoprec6
1054 56 1051 342 passivate
1051 40 1051 342 890821 163947 activity
1056 78 1056 350 260479 150000 mon
1 1043 1056 350 monw2
1 1039 1056 350 monw0
1 1041 1056 350 monw1
1053 56 1051 342 activate
0 1588 0 0 endaction
1056 320 1056 350 reflectcore
1052 50 1051 342 newactivity
1057 372 1057 358 940327 154135 setcspterm
1059 428 1059 358 941030 233200 slices
1063 52 1063 358 890821 163933 lock
1063 258 1063 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1064 162 1064 358 940411 222622 fpparam
1 1049 1065 358 nl
1 1047 1065 358 220978 131500 bel
1066 330 1066 446 940411 222722 ud
1067 252 1067 446 940411 222656 taltekst
1 1045 1056 350 monw3
984 296 984 12 getshare6
984 398 984 12 setshare6
70 480 1070 446 0
algol end 1070
*if ok.no
*if warning.yes
*o c
▶EOF◀