|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 993792 (0xf2a00)
Types: TextFile
Names: »buskomudx01 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomudx01 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.5471361.1150
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
9 5650 if kode=76 and indeks=1 then
9 5651 begin <* TÆ,N <tid> *>
10 5652 if ia(1)<(-1) or 2400<ia(1) then
10 5653 begin
11 5654 setposition(z_io,0,0);
11 5655 if sluttegn<>'nl' then outchar(z_io,'nl');
11 5656 skriv_kvittering(z_io,opref,-1,64);
11 5657 end
10 5658 else
10 5659 begin
11 5660 if ia(1)=(-1) then nulstil_systællere:= -1
11 5661 else nulstil_systællere:= (ia(1) mod 2400)*100;
11 5662 opdater_tf_systællere;
11 5663 typ:= opref; <* typ lånes til gemmevariabel *>
11 5664 d.opref.retur:= cs_io_komm;
11 5665 signal_ch(cs_io_nulstil,opref,io_optype);
11 5666 <*V*> wait_ch(cs_io_komm,opref,io_optype,-1);
11 5667 <*+4*> if opref <> typ then
11 5668 fejlreaktion(11<*fremmed post*>,opref,
11 5669 <:io_kommando:>,0);
11 5670 <*-4*>
11 5671 setposition(z_io,0,0);
11 5672 if sluttegn<>'nl' then outchar(z_io,'nl');
11 5673 skriv_kvittering(z_io,opref,-1,3);
11 5674 end;
10 5675 end
9 5676 else
9 5677 begin
10 5678 setposition(z_io,0,0);
10 5679 if sluttegn<>'nl' then outchar(z_io,'nl');
10 5680 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5681
10 5681 write(z_io,
10 5682 <:område udgående alm.ind nød ind:>,
10 5683 <: ind-ialt total ej forb. optaget:>,"nl",1);
10 5684 for omr := 1 step 1 until max_antal_områder do
10 5685 begin
11 5686 sum:= 0;
11 5687 write(z_io,true,6,string område_navn(omr),":",1);
11 5688 for typ:= 1 step 1 until 3 do
11 5689 begin
12 5690 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5691 sum:= sum + opkalds_tællere((omr-1)*5+typ);
12 5692 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5693 end;
11 5694 write(z_io,<< ddddddd>,
11 5695 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
11 5696 for typ:= 4 step 1 until 5 do
11 5697 begin
12 5698 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5699 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5700 end;
11 5701 write(z_io,"nl",1);
11 5702 end;
10 5703 sum:= 0;
10 5704 write(z_io,"nl",1,<:ialt ::>);
10 5705 for typ:= 1 step 1 until 3 do
10 5706 begin
11 5707 write(z_io,<< ddddddd>,ialt(typ));
11 5708 sum:= sum+ialt(typ);
11 5709 end;
10 5710 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5711 ialt(4), ialt(5), "nl",3);
10 5712
10 5712 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5713 write(z_io,
10 5714 <:oper. udgående alm.ind nød ind:>,
10 5715 <: ind-ialt total ej forb. optaget:>,"nl",1);
10 5716 for omr := 1 step 1 until max_antal_operatører do
10 5717 begin
11 5718 sum:= 0;
11 5719 if bpl_navn(omr)=long<::> then
11 5720 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
11 5721 else
11 5722 write(z_io,true,6,string bpl_navn(omr),":",1);
11 5723 for typ:= 1 step 1 until 3 do
11 5724 begin
12 5725 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
12 5726 sum:= sum + operatør_tællere((omr-1)*5+typ);
12 5727 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5728 end;
11 5729 write(z_io,<< ddddddd>,
11 5730 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
11 5731 for typ:= 4 step 1 until 5 do
11 5732 begin
12 5733 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
12 5734 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5735 end;
11 5736 write(z_io,"nl",1);
11 5737 end;
10 5738 sum:= 0;
10 5739 write(z_io,"nl",1,<:ialt ::>);
10 5740 for typ:= 1 step 1 until 3 do
10 5741 begin
11 5742 write(z_io,<< ddddddd>,ialt(typ));
11 5743 sum:= sum+ialt(typ);
11 5744 end;
10 5745 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5746 ialt(4),ialt(5),"nl",2);
10 5747
10 5747 typ:= replacechar(1,':');
10 5748 write(z_io,<:tællere nulstilles :>);
10 5749 if nulstil_systællere=(-1) then
10 5750 write(z_io,<:ikke automatisk:>,"nl",1)
10 5751 else
10 5752 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
10 5753 nulstil_systællere,"nl",1);
10 5754 replacechar(1,'.');
10 5755 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
10 5756 systime(4,systællere_nulstillet,r));
10 5757 replacechar(1,':');
10 5758 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
10 5759 replacechar(1,typ);
10 5760 write(z_io,"*",1,"nl",1);
10 5761 setposition(z_io,0,0);
10 5762
10 5762 if kode = 76 <* nulstil tællere *> then
10 5763 disable begin
11 5764 for omr:= 1 step 1 until max_antal_områder*5 do
11 5765 opkalds_tællere(omr):= 0;
11 5766 for omr:= 1 step 1 until max_antal_operatører*5 do
11 5767 operatør_tællere(omr):= 0;
11 5768 systime(1,0.0,systællere_nulstillet);
11 5769 opdater_tf_systællere;
11 5770 typ:= replacechar(1,'.');
11 5771 write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
11 5772 systime(4,systællere_nulstillet,r));
11 5773 replacechar(1,':');
11 5774 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
11 5775 replacechar(1,typ);
11 5776 setposition(z_io,0,0);
11 5777 end;
10 5778 end;
9 5779 end;
8 5780
8 5780 begin
9 5781 \f
9 5781 message procedure io_komm side 25 - 940522/cl;
9 5782
9 5782 <* 13 navngiv betjeningsplads *>
9 5783 boolean incl;
9 5784 long field lf;
9 5785
9 5785 lf:=6;
9 5786 operatør:= ia(1);
9 5787 navn:= ia.lf;
9 5788 incl:= false add (ia(4) extract 8);
9 5789
9 5789 if navn=long<::> then
9 5790 begin
10 5791 <* nedlæg navn - check for i brug *>
10 5792 iaf:= operatør*terminal_beskr_længde;
10 5793 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5794 d.opref.resultat:= 48 <*i brug*>
10 5795 else
10 5796 begin
11 5797 for i:= 65 step 1 until top_bpl_gruppe do
11 5798 begin
12 5799 iaf:= i*op_maske_lgd;
12 5800 if læsbit_ia(bpl_def.iaf,operatør) then
12 5801 d.opref.resultat:= 48<*i brug*>;
12 5802 end;
11 5803 end;
10 5804 if d.opref.resultat <= 3 then
10 5805 begin
11 5806 for i:= 1 step 1 until sidste_bus do
11 5807 if bustabel(i) shift (-14) extract 8 = operatør then
11 5808 d.opref.resultat:= 48<*i brug*>;
11 5809 end;
10 5810 end
9 5811 else
9 5812 begin
10 5813 <* opret/omdøb *>
10 5814 i:= find_bpl(navn);
10 5815 if i<>0 and i<>operatør then
10 5816 d.opref.resultat:= 48 <*i brug*>;
10 5817 end;
9 5818 if d.opref.resultat<=3 then
9 5819 begin
10 5820 bpl_navn(operatør):= navn;
10 5821 operatør_auto_include(operatør):= incl;
10 5822 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5823 if k<>0 then
10 5824 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5825 lf:= 4;
10 5826 fil(ll).lf:= navn add (incl extract 8);
10 5827 setposition(fil(ll),0,0);
10 5828
10 5828 <* skriv bplnavne *>
10 5829 disable begin
11 5830 zone z(128,1,stderror);
11 5831 long array field laf;
11 5832 integer array ia(1:10);
11 5833
11 5833 open(z,4,<:bplnavne:>,0);
11 5834 laf:= 0;
11 5835 outrec6(z,512);
11 5836 for i:= 1 step 1 until 127 do
11 5837 z.laf(i):= bpl_navn(i);
11 5838 close(z,true);
11 5839 monitor(42,z,0,ia);
11 5840 ia(6):= systime(7,0,0.0);
11 5841 monitor(44,z,0,ia);
11 5842 end;
10 5843 d.opref.resultat:= 3;<*udført*>
10 5844 end;
9 5845
9 5845 setposition(z_io,0,0);
9 5846 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5847 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5848 end;
8 5849
8 5849 begin
9 5850 \f
9 5850 message procedure io_komm side 26 - 940522/cl;
9 5851
9 5851 <* 14 betjeningsplads - gruppe *>
9 5852 integer ant_i_gruppe;
9 5853 long field lf;
9 5854 integer array maske(1:op_maske_lgd//2);
9 5855
9 5855 lf:= 4; ant_i_gruppe:= 0;
9 5856 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5857 navn:= ia.lf;
9 5858 operatør:= find_bpl(navn);
9 5859 for i:= 3 step 1 until indeks do
9 5860 if sætbit_ia(maske,ia(i),1)=0 then
9 5861 ant_i_gruppe:= ant_i_gruppe+1;
9 5862 if ant_i_gruppe=0 then
9 5863 begin
10 5864 <* slet gruppe *>
10 5865 if operatør<=64 then
10 5866 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5867 else 62<*navn ulovligt*>)
10 5868 else
10 5869 begin
11 5870 for i:= 1 step 1 until max_antal_operatører do
11 5871 for j:= 1 step 1 until 3 do
11 5872 if operatør_stop(i,j)=operatør then
11 5873 d.opref.resultat:= 48<*i brug*>;
11 5874 end;
10 5875 navn:= long<::>;
10 5876 end
9 5877 else
9 5878 begin
10 5879 if 1<=operatør and operatør<=64 then
10 5880 d.opref.resultat:= 62<*navn ulovligt*>
10 5881 else
10 5882 if operatør=0 then
10 5883 begin
11 5884 i:=65;
11 5885 while i<=127 and operatør=0 do
11 5886 begin
12 5887 if bpl_navn(i)=long<::> then operatør:=i;
12 5888 i:= i+1;
12 5889 end;
11 5890 if operatør=0 then
11 5891 d.opref.resultat:= 32<*ikke plads*>
11 5892 else if operatør>top_bpl_gruppe then
11 5893 top_bpl_gruppe:= operatør;
11 5894 end;
10 5895 end;
9 5896 if d.opref.resultat<=3 then
9 5897 begin
10 5898 bpl_navn(operatør):= navn;
10 5899 iaf:= operatør*op_maske_lgd;
10 5900 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5901 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5902 for i:= 1 step 1 until max_antal_operatører do
10 5903 begin
11 5904 if læsbit_ia(maske,i) then
11 5905 begin
12 5906 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5907 if læsbit_ia(operatør_maske,i) then
12 5908 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5909 end;
11 5910 end;
10 5911 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5912 if k<>0 then
10 5913 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5914 lf:= 4;
10 5915 fil(ll).lf:= navn;
10 5916 setposition(fil(ll),0,0);
10 5917 iaf:= 0;
10 5918 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5919 if k<>0 then
10 5920 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5921 for i:= 1 step 1 until op_maske_lgd//2 do
10 5922 fil(ll).iaf(i):= maske(i);
10 5923 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5924 setposition(fil(ll),0,0);
10 5925 d.opref.resultat:= 3;
10 5926 end;
9 5927
9 5927 setposition(z_io,0,0);
9 5928 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5929 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5930 end;
8 5931
8 5931 begin
9 5932 \f
9 5932 message procedure io_komm side 27 - 940522/cl;
9 5933
9 5933 <* 15 vis betjeningspladsdefinitioner *>
9 5934
9 5934 setposition(z_io,0,0);
9 5935 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5936 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5937 for i:= 1 step 1 until max_antal_operatører do
9 5938 begin
10 5939 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5940 case operatør_auto_include(i) extract 2 + 1 of(
10 5941 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5942 if i mod 4 = 0 then write(z_io,"nl",1)
10 5943 else write(z_io,"sp",5);
10 5944 end;
9 5945 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5946 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5947 for i:= 65 step 1 until top_bpl_gruppe do
9 5948 begin
10 5949 ll:=0; iaf:= i*op_maske_lgd;
10 5950 if bpl_navn(i)<>long<::> then
10 5951 begin
11 5952 write(z_io,true,6,string bpl_navn(i),":",1);
11 5953 for j:= 1 step 1 until max_antal_operatører do
11 5954 begin
12 5955 if læsbit_ia(bpl_def.iaf,j) then
12 5956 begin
13 5957 if ll mod 8 = 0 and ll<>0 then
13 5958 write(z_io,"nl",1,"sp",7);
13 5959 write(z_io,"sp",2,string bpl_navn(j));
13 5960 ll:=ll+1;
13 5961 end;
12 5962 end;
11 5963 write(z_io,"nl",1);
11 5964 end;
10 5965 end;
9 5966 write(z_io,"*",1);
9 5967 end;
8 5968
8 5968 begin
9 5969 \f
9 5969 message procedure io_komm side 28 - 940522/cl;
9 5970
9 5970 <* 16 stopniveau,definer *>
9 5971
9 5971 operatør:= ia(1);
9 5972 iaf:= operatør*terminal_beskr_længde;
9 5973 for i:= 1 step 1 until 3 do
9 5974 operatør_stop(operatør,i):= ia(i+1);
9 5975 if -,læsbit_ia(operatørmaske,operatør) then
9 5976 begin
10 5977 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5978 signal_bin(bs_mobilopkald);
10 5979 end;
9 5980 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5981 if k<>0 then
9 5982 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 5983 iaf:= 0;
9 5984 for i:= 0 step 1 until 3 do
9 5985 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 5986 setposition(fil(ll),0,0);
9 5987 setposition(z_io,0,0);
9 5988 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5989 skriv_kvittering(z_io,0,-1,3);
9 5990 end;
8 5991
8 5991 begin
9 5992 \f
9 5992 message procedure io_komm side 29 - 940522/cl;
9 5993
9 5993 <* 17 stopniveauer,vis *>
9 5994
9 5994 setposition(z_io,0,0);
9 5995 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5996
9 5996 for operatør:= 1 step 1 until max_antal_operatører do
9 5997 begin
10 5998 iaf:=operatør*terminal_beskr_længde;
10 5999 ll:=0;
10 6000 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6001 string bpl_navn(operatør),<:(:>,
10 6002 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 6003 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 6004 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 6005 for i:= 1 step 1 until 3 do
10 6006 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 6007 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 6008 else string bpl_navn(operatør_stop(operatør,i)));
10 6009 if operatør mod 2 = 1 then
10 6010 write(z_io,"sp",40-ll)
10 6011 else
10 6012 write(z_io,"nl",1);
10 6013 end;
9 6014 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6015 write(z_io,"*",1);
9 6016 end;
8 6017
8 6017 begin
9 6018 \f
9 6018 message procedure io_komm side 30 - 941007/cl;
9 6019
9 6019 <* 18 alarmlængder *>
9 6020
9 6020 setposition(z_io,0,0);
9 6021 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6022
9 6022 for operatør:= 1 step 1 until max_antal_operatører do
9 6023 begin
10 6024 ll:=0;
10 6025 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6026 string bpl_navn(operatør));
10 6027 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 6028 if opk_alarm.iaf.alarm_lgd < 0 then
10 6029 ll:= ll+write(z_io,<:uendelig:>)
10 6030 else
10 6031 ll:= ll+write(z_io,<<ddddddd>,
10 6032 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 6033
10 6033 if operatør mod 2 = 1 then
10 6034 write(z_io,"sp",40-ll)
10 6035 else
10 6036 write(z_io,"nl",1);
10 6037 end;
9 6038 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6039 write(z_io,"*",1);
9 6040 end;
8 6041
8 6041 begin
9 6042 <* 19 CC *>
9 6043 integer i, c;
9 6044
9 6044 i:= 1;
9 6045 while læstegn(ia,i+0,c)<>0 and
9 6046 i<(op_spool_postlgd-op_spool_text)//2*3
9 6047 do skrivtegn(d.opref.data,i,c);
9 6048 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 6049
9 6049 d.opref.retur:= cs_io_komm;
9 6050 signalch(cs_op,opref,io_optype or gen_optype);
9 6051 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 6052
9 6052 setposition(z_io,0,0);
9 6053 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6054 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 6055 end;
8 6056
8 6056 begin
9 6057 <* 20: CQF,I CQF,U CQF,V *>
9 6058 integer kode, res, i, j;
9 6059 integer array field iaf, iaf1;
9 6060 long field navn;
9 6061
9 6061 kode:= d.opref.opkode extract 12;
9 6062 navn:= 6; res:= 0;
9 6063 if kode=90 <*CQF,I*> then
9 6064 begin
10 6065 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 6066 res:= 10 <*busnr ukendt*>
10 6067 else
10 6068 begin
11 6069 j:= -1;
11 6070 for i:= 1 step 1 until max_cqf do
11 6071 begin
12 6072 iaf:= (i-1)*cqf_lgd;
12 6073 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 6074 ia.navn = cqf_tabel.iaf.cqf_id
12 6075 then res:= 48; <*i brug*>
12 6076 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 6077 end;
11 6078 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 6079 if res=0 then
11 6080 begin
12 6081 iaf:= (j-1)*cqf_lgd;
12 6082 cqf_tabel.iaf.cqf_bus:= ia(1);
12 6083 cqf_tabel.iaf.cqf_fejl:= 0;
12 6084 cqf_tabel.iaf.cqf_id:= ia.navn;
12 6085 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 6086 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 6087 res:= 3;
12 6088 end;
11 6089 end;
10 6090 setposition(z_io,0,0);
10 6091 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6092 skriv_kvittering(z_io,opref,-1,res);
10 6093 end
9 6094 else
9 6095 if kode=91 <*CQF,U*> then
9 6096 begin
10 6097 j:= -1;
10 6098 for i:= 1 step 1 until max_cqf do
10 6099 begin
11 6100 iaf:= (i-1)*cqf_lgd;
11 6101 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 6102 end;
10 6103 if j>=0 then
10 6104 begin
11 6105 iaf:= (j-1)*cqf_lgd;
11 6106 for i:= 1 step 1 until cqf_lgd//2 do
11 6107 cqf_tabel.iaf(i):= 0;
11 6108 res:= 3;
11 6109 end
10 6110 else res:= 13; <*bus ikke indsat*>
10 6111 setposition(z_io,0,0);
10 6112 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6113 skriv_kvittering(z_io,opref,-1,res);
10 6114 end
9 6115 else
9 6116 begin
10 6117 setposition(z_io,0,0);
10 6118 skriv_cqf_tabel(z_io,false);
10 6119 outchar(z_io,'*');
10 6120 setposition(z_io,0,0);
10 6121 end;
9 6122
9 6122 if kode=90 or kode=91 then
9 6123 begin
10 6124 j:= skrivfil(1033,1,i);
10 6125 if j<>0 then
10 6126 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 6127 for k:= 1 step 1 until max_cqf do
10 6128 begin
11 6129 iaf1:= (k-1)*cqf_lgd;
11 6130 iaf := (k-1)*cqf_id;
11 6131 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 6132 end;
10 6133 op_cqf_tab_ændret:= true;
10 6134 end;
9 6135 end;<*CQF*>
8 6136
8 6136
8 6136 begin
9 6137 \f
9 6137 message procedure io_komm side xx - 940522/cl;
9 6138
9 6138
9 6138
9 6138 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 6139 <*-3*>
9 6140 end
8 6141 end;<*case j *>
7 6142 end <* j > 0 *>
6 6143 else
6 6144 begin
7 6145 <*V*> setposition(z_io,0,0);
7 6146 if sluttegn<>'nl' then outchar(z_io,'nl');
7 6147 skriv_kvittering(z_io,op_ref,-1,
7 6148 45 <* ikke implementeret *>);
7 6149 end;
6 6150 end;<* godkendt *>
5 6151
5 6151 <*V*> setposition(z_io,0,0);
5 6152 signal_bin(bs_zio_adgang);
5 6153 d.op_ref.retur:=cs_att_pulje;
5 6154 disable afslut_kommando(op_ref);
5 6155 end; <* indlæs kommando *>
4 6156
4 6156 begin
5 6157 \f
5 6157 message procedure io_komm side xx+1 - 810428/hko;
5 6158
5 6158 <* 2: aktiver efter stop *>
5 6159 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 6160 terminal_tab.ref.terminal_tilstand extract 21;
5 6161 afslut_operation(op_ref,-1);
5 6162 signal_bin(bs_zio_adgang);
5 6163 end;
4 6164
4 6164 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6165 <*-3*>
4 6166 end; <* case aktion+6 *>
3 6167
3 6167 until false;
3 6168 io_komm_trap:
3 6169 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6170 alarmcause extract 24 = (-13)) then
3 6171 disable skriv_io_komm(zbillede,1);
3 6172 end io_komm;
2 6173 \f
2 6173 message procedure io_spool side 1 - 810507/hko;
2 6174
2 6174 procedure io_spool;
2 6175 begin
3 6176 integer
3 6177 næste_tomme,nr;
3 6178 integer array field
3 6179 op_ref;
3 6180
3 6180 procedure skriv_io_spool(zud,omfang);
3 6181 value omfang;
3 6182 zone zud;
3 6183 integer omfang;
3 6184 begin
4 6185 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6186 if omfang > 0 then
4 6187 disable begin integer x;
5 6188 trap(slut);
5 6189 write(zud,"nl",1,
5 6190 <: opref: :>,op_ref,"nl",1,
5 6191 <: næstetomme::>,næste_tomme,"nl",1,
5 6192 <: nr :>,nr,"nl",1,
5 6193 <::>);
5 6194 skriv_coru(zud,coru_no(102));
5 6195 slut:
5 6196 end;<*disable*>
4 6197 end skriv_io_spool;
3 6198
3 6198 trap(io_spool_trap);
3 6199 næste_tomme:= 1;
3 6200 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6201 <*+2*>
3 6202 if testbit0 and overvåget or testbit28 then
3 6203 skriv_io_spool(out,0);
3 6204 <*-2*>
3 6205 \f
3 6205 message procedure io_spool side 2 - 810602/hko;
3 6206
3 6206 repeat
3 6207
3 6207 wait_ch(cs_io_spool,
3 6208 op_ref,
3 6209 true,
3 6210 -1<*timeout*>);
3 6211
3 6211 i:= d.op_ref.opkode;
3 6212 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6213 begin
4 6214 wait(ss_io_spool_tomme);
4 6215 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6216 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6217
4 6217 i:= d.op_ref.opsize;
4 6218 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6219 begin
5 6220 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6221 i:= io_spool_postlængde*2 -io_spool_post;
5 6222 end;
4 6223 <*-4*>
4 6224 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6225 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6226 signal(ss_io_spool_fulde);
4 6227 d.op_ref.resultat:= 1;
4 6228 end
3 6229 else
3 6230 begin
4 6231 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6232 <:io_spool_korutine:>,1);
4 6233 end;
3 6234
3 6234 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6235
3 6235 until false;
3 6236
3 6236 io_spool_trap:
3 6237
3 6237 disable skriv_io_spool(zbillede,1);
3 6238 end io_spool;
2 6239 \f
2 6239 message procedure io_spon side 1 - 810507/hko;
2 6240
2 6240 procedure io_spon;
2 6241 begin
3 6242 integer
3 6243 næste_fulde,nr,i,dato,kl;
3 6244 real t;
3 6245
3 6245 procedure skriv_io_spon(zud,omfang);
3 6246 value omfang;
3 6247 zone zud;
3 6248 integer omfang;
3 6249 begin
4 6250 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6251 if omfang > 0 then
4 6252 disable begin integer x;
5 6253 trap(slut);
5 6254 write(zud,"nl",1,
5 6255 <: næste-fulde::>,næste_fulde,"nl",1,
5 6256 <: nr :>,nr,"nl",1,
5 6257 <::>);
5 6258 skriv_coru(zud,coru_no(103));
5 6259 slut:
5 6260 end;<*disable*>
4 6261 end skriv_io_spon;
3 6262
3 6262 trap(io_spon_trap);
3 6263 næste_fulde:= 1;
3 6264 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6265 <*+2*>
3 6266 if testbit0 and overvåget or testbit28 then
3 6267 skriv_io_spon(out,0);
3 6268 <*-2*>
3 6269 \f
3 6269 message procedure io_spon side 2 - 810602/hko/cl;
3 6270
3 6270 repeat
3 6271
3 6271 <*V*> wait(ss_io_spool_fulde);
3 6272 <*V*> wait(bs_zio_adgang);
3 6273
3 6273 <*V*> setposition(zio,0,0);
3 6274
3 6274 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6275 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6276
3 6276 laf:=data;
3 6277 k:= fil(nr).io_spool_post.opkode;
3 6278 if k = 22 or k = 36 then
3 6279 disable begin
4 6280 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6281 if k=36 then
4 6282 begin
5 6283 i:= fil(nr).io_spool_post.data(4);
5 6284 j:= i extract 5;
5 6285 if j<>0 then j:=j+'A'-1;
5 6286 i:= i shift (-5) extract 10;
5 6287 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6288 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6289 end;
4 6290 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6291 fil(nr).io_spool_post.tid)
4 6292 end
3 6293 else if k = 23 then
3 6294 disable
3 6295 begin
4 6296 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6297 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6298 kl:= round t;
4 6299 i:= replace_char(1<*space in number*>,'.');
4 6300 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6301 replace_char(1,i);
4 6302 end
3 6303 else if k = 45 or k = 46 then
3 6304 disable begin
4 6305 integer vogn,linie,bogst,løb,t;
4 6306
4 6306 t:=fil(nr).io_spool_post.data(2);
4 6307 outchar(z_io,'nl');
4 6308 if k = 45 then
4 6309 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6310
4 6310 write(zio,<:nødopkald fra :>);
4 6311 vogn:= fil(nr).io_spool_post.data(1);
4 6312 i:= vogn shift (-22);
4 6313 if i < 2 then
4 6314 skrivid(zio,vogn,9)
4 6315 else
4 6316 begin
5 6317 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6318 write(zio,<:!!!:>,vogn);
5 6319 end;
4 6320 \f
4 6320 message procedure io_spon side 3 - 810507/hko;
4 6321
4 6321 if fil(nr).io_spool_post.data(3)<>0 then
4 6322 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6323
4 6323 if k = 46 then
4 6324 begin
5 6325 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6326 end;
4 6327 end <*disable*>
3 6328 else
3 6329 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6330
3 6330 fil(nr,1):= fil(nr,1) add 1;
3 6331
3 6331 <*V*> setposition(zio,0,0);
3 6332
3 6332 signal_bin(bs_zio_adgang);
3 6333
3 6333 signal(ss_io_spool_tomme);
3 6334
3 6334 until false;
3 6335
3 6335 io_spon_trap:
3 6336 skriv_io_spon(zbillede,1);
3 6337
3 6337 end io_spon;
2 6338 \f
2 6338 message procedure io_medd side 1;
2 6339
2 6339 procedure io_medd;
2 6340 begin
3 6341 integer array field opref;
3 6342 integer afs, kl, i;
3 6343 real dato, t;
3 6344
3 6344
3 6344 procedure skriv_io_medd(zud,omfang);
3 6345 value omfang;
3 6346 zone zud;
3 6347 integer omfang;
3 6348 begin
4 6349 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6350 if omfang > 0 then
4 6351 disable begin integer x;
5 6352 trap(slut);
5 6353 write(zud,"nl",1,
5 6354 <: opref: :>,opref,"nl",1,
5 6355 <: afs: :>,afs,"nl",1,
5 6356 <: kl: :>,kl,"nl",1,
5 6357 <: i: :>,i,"nl",1,
5 6358 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6359 <: t: :>,t,"nl",1,
5 6360 <::>);
5 6361 skriv_coru(zud,coru_no(104));
5 6362 slut:
5 6363 end;<*disable*>
4 6364 end skriv_io_medd;
3 6365
3 6365 trap(io_medd_trap);
3 6366 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6367 <*+2*>
3 6368 if testbit0 and overvåget or testbit28 then
3 6369 skriv_io_medd(out,0);
3 6370 <*-2*>
3 6371 \f
3 6371 message procedure io_medd side 2;
3 6372
3 6372 repeat
3 6373 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6374 <*V*> wait(bs_zio_adgang);
3 6375
3 6375 afs:= d.opref.data.op_spool_kilde;
3 6376 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6377 kl:= round t;
3 6378 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6379 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6380 i:= replacechar(1,'.');
3 6381 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6382 replacechar(1,i);
3 6383 write(z_io,d.opref.data.op_spool_text);
3 6384 setposition(z_io,0,0);
3 6385
3 6385 signalbin(bs_zio_adgang);
3 6386 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6387 until false;
3 6388
3 6388 io_medd_trap:
3 6389 skriv_io_medd(zbillede,1);
3 6390
3 6390 end io_medd;
2 6391
2 6391 procedure io_nulstil_tællere;
2 6392 begin
3 6393 real nu, dato, kl, forr, næste, et_døgn, r;
3 6394 integer array field opref;
3 6395 integer ventetid, omr, typ, sum;
3 6396 integer array ialt(1:5);
3 6397
3 6397 procedure skriv_io_null(zud,omfang);
3 6398 value omfang;
3 6399 zone zud;
3 6400 integer omfang;
3 6401 begin
4 6402 disable write(zud,"nl",1,<:+++ io_nulstil_tællere :>);
4 6403 if omfang > 0 then
4 6404 disable begin real t; real array field raf;
5 6405 raf:=0;
5 6406 trap(slut);
5 6407 write(zud,"nl",1,
5 6408 <: opref: :>,opref,"nl",1,
5 6409 <: ventetid: :>,ventetid,"nl",1,
5 6410 <: omr: :>,omr,"nl",1,
5 6411 <: typ: :>,typ,"nl",1,
5 6412 <: sum: :>,sum,"nl",1);
5 6413 write(zud,
5 6414 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1);
5 6415 write(zud,
5 6416 <: forr: :>,<< zddddd>,systime(4,forr,t),t,"nl",1);
5 6417 write(zud,
5 6418 <: næste: :>,<< zddddd>,systime(4,næste,t),t,"nl",1);
5 6419 write(zud,
5 6420 <: r: :>,<< zddddd>,systime(4,r,t),t,"nl",1,
5 6421 <: dato: :>,dato,"nl",1,
5 6422 <: kl: :>,kl,"nl",1,
5 6423 <: et-døgn: :>,<< dddddd>,et_døgn,"nl",1,
5 6424 <::>);
5 6425 write(zud,"nl",1,<:ialt: :>);
5 6426 skriv_hele(zud,ialt.raf,10,2);
5 6427 skriv_coru(zud,coru_no(105));
5 6428 slut:
5 6429 end;<*disable*>
4 6430 end skriv_io_null;
3 6431
3 6431 trap(io_null_trap);
3 6432 et_døgn:= 24*60*60.0;
3 6433 stack_claim(500);
3 6434 <*+2*>
3 6435 if testbit0 and overvåget or testbit28 then
3 6436 skriv_io_null(out,0);
3 6437 <*-2*>
3 6438 pass;
3 6439
3 6439 systime(1,0.0,nu);
3 6440 dato:= systime(4,nu,kl);
3 6441 if nulstil_systællere >= 0 then
3 6442 begin
4 6443 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6444 + et_døgn
4 6445 else næste:= systid(dato,nulstil_systællere);
4 6446 forr:= næste - et_døgn;
4 6447 if (forr - systællere_nulstillet) > et_døgn then
4 6448 næste:= nu;
4 6449 end;
3 6450
3 6450 repeat
3 6451 ventetid:= (if nulstil_systællere < 0 then (-1) else (næste - nu));
3 6452 <*V*> waitch(cs_io_nulstil,opref,io_optype,ventetid);
3 6453
3 6453 if opref <= 0 then
3 6454 begin
4 6455 <* nulstil opkaldstællere *>
4 6456 wait(bs_zio_adgang);
4 6457 setposition(z_io,0,0);
4 6458
4 6458 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6459
4 6459 write(z_io,"nl",1,<:!TÆ,N (automatisk):>,"nl",2,
4 6460 <:område udgående alm.ind nød ind:>,
4 6461 <: ind-ialt total ej forb. optaget:>,"nl",1);
4 6462 for omr := 1 step 1 until max_antal_områder do
4 6463 begin
5 6464 sum:= 0;
5 6465 write(z_io,true,6,string område_navn(omr),":",1);
5 6466 for typ:= 1 step 1 until 3 do
5 6467 begin
6 6468 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6469 sum:= sum + opkalds_tællere((omr-1)*5+typ);
6 6470 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6471 end;
5 6472 write(z_io,<< ddddddd>,
5 6473 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
5 6474 for typ:= 4 step 1 until 5 do
5 6475 begin
6 6476 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6477 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6478 end;
5 6479 write(z_io,"nl",1);
5 6480 end;
4 6481 sum:= 0;
4 6482 write(z_io,"nl",1,<:ialt ::>);
4 6483 for typ:= 1 step 1 until 3 do
4 6484 begin
5 6485 write(z_io,<< ddddddd>,ialt(typ));
5 6486 sum:= sum+ialt(typ);
5 6487 end;
4 6488 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6489 ialt(4), ialt(5), "nl",3);
4 6490
4 6490 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6491 write(z_io,<:oper. udgående alm.ind nød ind:>,
4 6492 <: ind-ialt total ej forb. optaget:>,"nl",1);
4 6493 for omr := 1 step 1 until max_antal_operatører do
4 6494 begin
5 6495 sum:= 0;
5 6496 if bpl_navn(omr)=long<::> then
5 6497 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
5 6498 else
5 6499 write(z_io,true,6,string bpl_navn(omr),":",1);
5 6500 for typ:= 1 step 1 until 3 do
5 6501 begin
6 6502 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
6 6503 sum:= sum + operatør_tællere((omr-1)*5+typ);
6 6504 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6505 end;
5 6506 write(z_io,<< ddddddd>,
5 6507 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
5 6508 for typ:= 4 step 1 until 5 do
5 6509 begin
6 6510 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
6 6511 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6512 end;
5 6513 write(z_io,"nl",1);
5 6514 end;
4 6515 sum:= 0;
4 6516 write(z_io,"nl",1,<:ialt ::>);
4 6517 for typ:= 1 step 1 until 3 do
4 6518 begin
5 6519 write(z_io,<< ddddddd>,ialt(typ));
5 6520 sum:= sum+ialt(typ);
5 6521 end;
4 6522 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6523 ialt(4),ialt(5),"nl",2);
4 6524
4 6524 typ:= replacechar(1,':');
4 6525 write(z_io,<:tællere nulstilles :>);
4 6526 if nulstil_systællere=(-1) then
4 6527 write(z_io,<:ikke automatisk:>,"nl",1)
4 6528 else
4 6529 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
4 6530 nulstil_systællere,"nl",1);
4 6531 replacechar(1,'.');
4 6532 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
4 6533 systime(4,systællere_nulstillet,r));
4 6534 replacechar(1,':');
4 6535 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
4 6536 replacechar(1,typ);
4 6537 write(z_io,"*",1,"nl",1);
4 6538 setposition(z_io,0,0);
4 6539 signal_bin(bs_zio_adgang);
4 6540
4 6540 for omr:= 1 step 1 until max_antal_områder*5 do
4 6541 opkalds_tællere(omr):= 0;
4 6542 for omr:= 1 step 1 until max_antal_operatører*5 do
4 6543 operatør_tællere(omr):= 0;
4 6544 systællere_nulstillet:= næste;
4 6545 opdater_tf_systællere;
4 6546 end
3 6547 else
3 6548 signalch(d.opref.retur,opref,d.opref.optype);
3 6549
3 6549 systime(1,0.0,nu);
3 6550 dato:= systime(4,nu,kl);
3 6551 if nulstil_systællere >= 0 then
3 6552 begin
4 6553 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6554 + et_døgn
4 6555 else næste:= systid(dato,nulstil_systællere);
4 6556 forr:= næste - et_døgn;
4 6557 end;
3 6558 until false;
3 6559
3 6559 io_null_trap:
3 6560 skriv_io_null(zbillede,1);
3 6561 end io_nulstil_tællere;
2 6562
2 6562 \f
2 6562 message operatør_erklæringer side 1 - 810602/hko;
2 6563 integer
2 6564 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6565 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6566 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6567 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6568 integer array
2 6569 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6570 operatørmaske(1:op_maske_lgd//2),
2 6571 op_talevej(0:max_antal_operatører),
2 6572 tv_operatør(0:max_antal_taleveje),
2 6573 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6574 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6575 ant_i_opkø,
2 6576 cs_operatør,
2 6577 cs_op_fil(1:max_antal_operatører);
2 6578 boolean
2 6579 op_cqf_tab_ændret;
2 6580 integer field
2 6581 op_spool_kilde;
2 6582 real field
2 6583 op_spool_tid;
2 6584 long array field
2 6585 op_spool_text;
2 6586 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6587 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6588 \f
2 6588 message procedure op_fejl side 1 - 830310/hko;
2 6589
2 6589 procedure op_fejl(z,s,b);
2 6590 integer s,b;
2 6591 zone z;
2 6592 begin
3 6593 disable begin
4 6594 integer array iz(1:20);
4 6595 integer i,j,k,n;
4 6596 integer array field iaf,iaf1,msk;
4 6597 boolean input;
4 6598 real array field laf,laf1;
4 6599
4 6599 getzone6(z,iz);
4 6600 iaf:=laf:=2;
4 6601 input:= iz(13) = 1;
4 6602 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6603 if iz.laf(1)=terminal_navn.laf1(1) and
4 6604 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6605
4 6605 <*+2*> if testbit31 then
4 6606 <**> begin
5 6607 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6608 <**> <:s=:>); outintbits(out,s);
5 6609 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6610 <**> else <:output:>,"nl",1);
5 6611 <**> setposition(out,0,0);
5 6612 <**> end;
4 6613 <*-2*>
4 6614 iaf:=j*terminal_beskr_længde;
4 6615 k:=1;
4 6616
4 6616 i:= terminal_tab.iaf.terminal_tilstand;
4 6617 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6618 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6619 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6620 if s <> (1 shift 21 +2) then
4 6621 begin
5 6622 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6623 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6624 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6625 sæt_bit_ia(opkaldsflag,j,0);
5 6626 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6627 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6628 begin
6 6629 msk:= k*op_maske_lgd;
6 6630 if læsbit_ia(bpl_def.msk,j) then
6 6631 <**> begin
7 6632 n:= 0;
7 6633 for i:= 1 step 1 until max_antal_operatører do
7 6634 if læsbit_ia(bpl_def.msk,i) then
7 6635 begin
8 6636 iaf1:= i*terminal_beskr_længde;
8 6637 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6638 n:= n+1;
8 6639 end;
7 6640 bpl_tilst(j,1):= n;
7 6641 end;
6 6642 <**> <*
6 6643 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6644 *> end;
5 6645 signal_bin(bs_mobil_opkald);
5 6646 end;
4 6647
4 6647 if input or -,input then
4 6648 begin
5 6649 z(1):=real <:<'?'><'?'><'em'>:>;
5 6650 b:=2;
5 6651 end;
4 6652 end; <*disable*>
3 6653 end op_fejl;
2 6654 \f
2 6654 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6655
2 6655 procedure tvswitch_fejl(z,s,b);
2 6656 integer s,b;
2 6657 zone z;
2 6658 begin
3 6659 disable begin
4 6660 integer array iz(1:20);
4 6661 integer i,j,k;
4 6662 integer array field iaf;
4 6663 boolean input;
4 6664 real array field raf;
4 6665
4 6665 getzone6(z,iz);
4 6666 iaf:=raf:=2;
4 6667 input:= iz(13) = 1;
4 6668 <*+2*> if testbit31 then
4 6669 <**> begin
5 6670 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6671 <**> <:s=:>); outintbits(out,s);
5 6672 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6673 <**> else <:output:>,"nl",1);
5 6674 <**> skrivhele(out,z,b,5);
5 6675 <**> setposition(out,0,0);
5 6676 <**> end;
4 6677 <*-2*>
4 6678 k:=1;
4 6679 if s <> (1 shift 21 +2) then
4 6680 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6681 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6682
4 6682 if input or -,input then
4 6683 begin
5 6684 z(1):=real <:<'em'>:>;
5 6685 b:=2;
5 6686 end;
4 6687 end; <*disable*>
3 6688 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6689 end tvswitch_fejl;
2 6690
2 6690 procedure skriv_talevejs_tab(z);
2 6691 zone z;
2 6692 begin
3 6693 write(z,"nl",2,<:talevejsswitch::>);
3 6694 write(z,"nl",1,<: operatører::>,"nl",1);
3 6695 for i:= 1 step 1 until max_antal_operatører do
3 6696 begin
4 6697 write(z,<< dd>,i,":",1,op_talevej(i));
4 6698 if i mod 8=0 then outchar(z,'nl');
4 6699 end;
3 6700 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6701 for i:= 1 step 1 until max_antal_taleveje do
3 6702 begin
4 6703 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6704 if i mod 8=0 then outchar(z,'nl');
4 6705 end;
3 6706 write(z,"nl",3);
3 6707 end;
2 6708 \f
2 6708 message procedure skriv_opk_alarm_tab side 1;
2 6709
2 6709 procedure skriv_opk_alarm_tab(z);
2 6710 zone z;
2 6711 begin
3 6712 integer nr;
3 6713 integer array field tab;
3 6714 real t;
3 6715
3 6715 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6716 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6717 for nr:=1 step 1 until max_antal_operatører do
3 6718 begin
4 6719 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6720 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6721 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6722 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6723 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6724 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6725 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6726 "nl",1);
4 6727 end;
3 6728 end;
2 6729 \f
2 6729 message procedure skriv_op_spool_buf side 1;
2 6730
2 6730 procedure skriv_op_spool_buf(z);
2 6731 zone z;
2 6732 begin
3 6733 integer array field ref;
3 6734 integer nr, kilde;
3 6735 real dato, kl;
3 6736
3 6736 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6737 for nr:= 1 step 1 until op_spool_postantal do
3 6738 begin
4 6739 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6740 ref:= (nr-1)*op_spool_postlgd;
4 6741 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6742 begin
5 6743 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6744 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6745 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6746 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6747 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6748 op_spool_buf.ref.op_spool_text);
5 6749 end;
4 6750 outchar(z,'nl');
4 6751 end;
3 6752 end;
2 6753
2 6753 procedure skriv_cqf_tabel(z,lang);
2 6754 value lang;
2 6755 zone z;
2 6756 boolean lang;
2 6757 begin
3 6758 integer array field ref;
3 6759 integer i,ant;
3 6760 real dato, kl;
3 6761
3 6761 ant:= 0;
3 6762 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6763 if -,lang then
3 6764 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6765 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6766 else
3 6767 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6768 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6769 for i:= 1 step 1 until max_cqf do
3 6770 begin
4 6771 ref:= (i-1)*cqf_lgd;
4 6772 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6773 begin
5 6774 ant:= ant+1;
5 6775 if lang then
5 6776 write(z,<<dd>,i,":",1);
5 6777 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6778 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6779 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6780 begin
6 6781 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6782 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6783 end
5 6784 else
5 6785 write(z,"sp",14,"?",1);
5 6786 if lang then
5 6787 begin
6 6788 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6789 begin
7 6790 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6791 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6792 end
6 6793 else
6 6794 write(z,"sp",14,"?",1);
6 6795 end
5 6796 else
5 6797 write(z,"sp",2);
5 6798 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6799 end;
4 6800 end;
3 6801 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6802 end;
2 6803
2 6803 procedure sorter_cqftab(l,u);
2 6804 value l,u;
2 6805 integer l,u;
2 6806 begin
3 6807 integer array field ii,jj;
3 6808 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6809
3 6809 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6810 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6811 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6812 repeat
3 6813 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6814 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6815 if ii <= jj then
3 6816 begin
4 6817 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6818 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6819 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6820 ii:= ii+cqf_lgd;
4 6821 jj:= jj-cqf_lgd;
4 6822 end;
3 6823 until ii>jj;
3 6824 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6825 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6826 end;
2 6827 \f
2 6827 message procedure ht_symbol side 1 - 851001/cl;
2 6828
2 6828 procedure ht_symbol(z);
2 6829 zone z;
2 6830 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6831
2 6831
2 6831
2 6831
2 6831 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6831 @@ @@ @@
2 6831 @@ @@ @@
2 6831 @@ @@ @@
2 6831 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6831 @@ @@
2 6831 @@ @@
2 6831 @@ @@
2 6831 @@ @@@@@@@@@@@@@ @@
2 6831 @@ @@ @@ @@
2 6831 @@ @@ @@ @@
2 6831 @@ @@ @@ @@
2 6831 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6831 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6832 \f
2 6832 message procedure definer_taster side 1 - 891214,cl;
2 6833
2 6833 procedure definer_taster(nr);
2 6834 value nr;
2 6835 integer nr;
2 6836 begin
3 6837
3 6837 setposition(z_op(nr),0,0);
3 6838 write(z_op(nr),
3 6839 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6840 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6841 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6842 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6843 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6844 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6845 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6846 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6847 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6848 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6849 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6850 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6851 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6852 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6853 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6854 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6855 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6856 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6857 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6858 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6859 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6860 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6861 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6862 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6863 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6864 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6865 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6866 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6867 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6868 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6869 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6870 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6871 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6872 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6873 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6874 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6875 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6876 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6877 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6878 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6879 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6880 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6881 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6882 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6883 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6884 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6885 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6886 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6887 <::>);
3 6888 end;
2 6889 \f
2 6889 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6890
2 6890 procedure skriv_terminal_tab(z);
2 6891 zone z;
2 6892 begin
3 6893 integer array field ref;
3 6894 integer t1,i,j,id,k;
3 6895
3 6895 write(z,"ff",1,<:
3 6896 ******* terminalbeskrivelser ********
3 6897
3 6897 # a k l p m m n o
3 6898 1 l a y a o o ø p
3 6899 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6900 <*
3 6901 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6902 *>
3 6903 for i:=1 step 1 until max_antal_operatører do
3 6904 begin
4 6905 ref:=i*terminal_beskr_længde;
4 6906 t1:=terminal_tab.ref(1);
4 6907 id:=terminal_tab.ref(2);
4 6908 k:=terminal_tab.ref(3);
4 6909 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6910 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6911 "sp",1);
4 6912 for j:=11 step -1 until 2 do
4 6913 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6914 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6915 "sp",1);
4 6916 skriv_id(z,id,9);
4 6917 skriv_id(z,k,9);
4 6918 end;
3 6919 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6920 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6921 write(z,"nl",1);
3 6922 end skriv_terminal_tab;
2 6923 \f
2 6923 message procedure h_operatør side 1 - 810520/hko;
2 6924
2 6924 <* hovedmodulkorutine for operatørterminaler *>
2 6925 procedure h_operatør;
2 6926 begin
3 6927 integer array field op_ref;
3 6928 integer k,nr,ant,ref,dest_sem;
3 6929 procedure skriv_hoperatør(zud,omfang);
3 6930 value omfang;
3 6931 zone zud;
3 6932 integer omfang;
3 6933 begin
4 6934
4 6934 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6935 if omfang>0 then
4 6936 disable begin integer x;
5 6937 trap(slut);
5 6938 write(zud,"nl",1,
5 6939 <: op_ref: :>,op_ref,"nl",1,
5 6940 <: nr: :>,nr,"nl",1,
5 6941 <: ant: :>,ant,"nl",1,
5 6942 <: ref: :>,ref,"nl",1,
5 6943 <: k: :>,k,"nl",1,
5 6944 <: dest_sem: :>,dest_sem,"nl",1,
5 6945 <::>);
5 6946 skriv_coru(zud,coru_no(200));
5 6947 slut:
5 6948 end;
4 6949 end skriv_hoperatør;
3 6950
3 6950 trap(hop_trap);
3 6951 stack_claim(if cm_test then 198 else 146);
3 6952
3 6952 <*+2*>
3 6953 if testbit8 and overvåget or testbit28 then
3 6954 skriv_hoperatør(out,0);
3 6955 <*-2*>
3 6956 \f
3 6956 message procedure h_operatør side 2 - 820304/hko;
3 6957
3 6957 repeat
3 6958 wait_ch(cs_op,op_ref,true,-1);
3 6959 <*+4*>
3 6960 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6961 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6962 <*-4*>
3 6963
3 6963 k:=d.op_ref.opkode extract 12;
3 6964 dest_sem:=
3 6965 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6966 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6967 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6968 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6969 if k=37 then cs_op_spool else
3 6970 if k=40 or k=38 then 0
3 6971 else -1;
3 6972 <*+4*>
3 6973 if dest_sem=-1 then
3 6974 begin
4 6975 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6976 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6977 end
3 6978 else
3 6979 <*-4*>
3 6980 if k=40 then
3 6981 begin
4 6982 dest_sem:= d.op_ref.retur;
4 6983 d.op_ref.retur:= cs_op_retur;
4 6984 for nr:= 1 step 1 until max_antal_operatører do
4 6985 begin
5 6986 inspect_ch(cs_operatør(nr),genoptype,ant);
5 6987 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 6988 or læsbit_ia(samtaleflag,nr))
5 6989 and læsbit_ia(operatørmaske,nr) then
5 6990 begin
6 6991 ref:= op_ref;
6 6992 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6993 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6994 <*+4*> if op_ref <> ref then
6 6995 fejlreaktion(11<*fr.post*>,op_ref,
6 6996 <:opdater opkaldskø,retur:>,0);
6 6997 <*-4*>
6 6998 end;
5 6999 end;
4 7000 d.op_ref.retur:= dest_sem;
4 7001 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7002 end
3 7003 else
3 7004 if k=38 then
3 7005 begin
4 7006 dest_sem:= d.opref.retur;
4 7007 d.op_ref.retur:= cs_op_retur;
4 7008 for nr:= 1 step 1 until max_antal_operatører do
4 7009 begin
5 7010 if d.opref.data.op_spool_kilde <> nr then
5 7011 begin
6 7012 ref:= op_ref;
6 7013 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 7014 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 7015 <*+4*> if op_ref <> ref then
6 7016 fejlreaktion(11<*fr.post*>,op_ref,
6 7017 <:opdater opkaldskø,retur:>,0);
6 7018 <*-4*>
6 7019 end;
5 7020 end;
4 7021 if d.opref.data.op_spool_kilde<>0 then
4 7022 begin
5 7023 ref:= op_ref;
5 7024 nr:= d.opref.data.op_spool_kilde;
5 7025 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 7026 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 7027 <*+4*> if op_ref <> ref then
5 7028 fejlreaktion(11<*fr.post*>,op_ref,
5 7029 <:operatørmedddelelse, retur:>,0);
5 7030 <*-4*>
5 7031 d.op_ref.retur:= dest_sem;
5 7032 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 7033 end
4 7034 else
4 7035 begin
5 7036 d.op_ref.retur:= dest_sem;
5 7037 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 7038 end;
4 7039 end
3 7040 else
3 7041 begin
4 7042 \f
4 7042 message procedure h_operatør side 3 - 810601/hko;
4 7043
4 7043 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 7044 begin
5 7045 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 7046 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 7047 +terminal_tab.iaf.terminal_tilstand extract 21;
5 7048 end;
4 7049 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7050 end;
3 7051 until false;
3 7052
3 7052 hop_trap:
3 7053 disable skriv_hoperatør(zbillede,1);
3 7054 end h_operatør;
2 7055 \f
2 7055 message procedure operatør side 1 - 820304/hko;
2 7056
2 7056 procedure operatør(nr);
2 7057 value nr;
2 7058 integer nr;
2 7059 begin
3 7060 integer array field op_ref,ref,vt_op,iaf,tab;
3 7061 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 7062 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 7063 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 7064 real kommstart,kommslut;
3 7065 \f
3 7065 message procedure operatør side 1a - 820301/hko;
3 7066
3 7066 procedure skriv_operatør(zud,omfang);
3 7067 value omfang;
3 7068 zone zud;
3 7069 integer omfang;
3 7070 begin integer i;
4 7071
4 7071 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 7072 write(zud,"sp",26-i);
4 7073 if omfang > 0 then
4 7074 disable begin
5 7075 integer x;
5 7076 trap(slut);
5 7077 write(zud,"nl",1,
5 7078 <: op-ref: :>,op_ref,"nl",1,
5 7079 <: kode: :>,kode,"nl",1,
5 7080 <: aktion: :>,aktion,"nl",1,
5 7081 <: ref: :>,ref,"nl",1,
5 7082 <: vt_op: :>,vt_op,"nl",1,
5 7083 <: iaf: :>,iaf,"nl",1,
5 7084 <: status: :>,status,"nl",1,
5 7085 <: tilstand: :>,tilstand,"nl",1,
5 7086 <: bv: :>,bv,"nl",1,
5 7087 <: bs: :>,bs,"nl",1,
5 7088 <: bs-tilst: :>,bs_tilst,"nl",1,
5 7089 <: kanal: :>,kanal,"nl",1,
5 7090 <: opgave: :>,opgave,"nl",1,
5 7091 <: pos: :>,pos,"nl",1,
5 7092 <: indeks: :>,indeks,"nl",1,
5 7093 <: sep: :>,sep,"nl",1,
5 7094 <: sluttegn: :>,sluttegn,"nl",1,
5 7095 <: vogn: :>,vogn,"nl",1,
5 7096 <: ll: :>,ll,"nl",1,
5 7097 <: garage: :>,garage,"nl",1,
5 7098 <: skærmmåde: :>,skærmmåde,"nl",1,
5 7099 <: res: :>,res,"nl",1,
5 7100 <: tab: :>,tab,"nl",1,
5 7101 <: rkom: :>,rkom,"nl",1,
5 7102 <: par1: :>,par1,"nl",1,
5 7103 <: par2: :>,par2,"nl",1,
5 7104 <::>);
5 7105 skriv_coru(zud,coru_no(200+nr));
5 7106 slut:
5 7107 end;
4 7108 end skriv_operatør;
3 7109 \f
3 7109 message procedure skærmstatus side 1 - 810518/hko;
3 7110
3 7110 integer
3 7111 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 7112 integer tilstand,b_v,b_s,b_s_tilst;
3 7113 begin
4 7114 integer i,j;
4 7115
4 7115 i:= terminal_tab.ref(1);
4 7116 b_s:= terminal_tab.ref(2);
4 7117 b_s_tilst:= i extract 12;
4 7118 j:= b_s_tilst extract 3;
4 7119 b_v:= i shift (-12) extract 4;
4 7120 tilstand:= i shift (-21);
4 7121
4 7121 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 7122 if b_v = 0 and j = 1<*opkald*> then 1 else
4 7123 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 7124 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 7125 end skærmstatus;
3 7126 \f
3 7126 message procedure skriv_skærm side 1 - 810522/hko;
3 7127
3 7127 procedure skriv_skærm(nr);
3 7128 value nr;
3 7129 integer nr;
3 7130 begin
4 7131 integer i;
4 7132
4 7132 disable definer_taster(nr);
4 7133
4 7133 skriv_skærm_maske(nr);
4 7134 skriv_skærm_opkaldskø(nr);
4 7135 skriv_skærm_b_v_s(nr);
4 7136 for i:= 1 step 1 until max_antal_kanaler do
4 7137 skriv_skærm_kanal(nr,i);
4 7138 cursor(z_op(nr),1,1);
4 7139 <*V*> setposition(z_op(nr),0,0);
4 7140 end skriv_skærm;
3 7141 \f
3 7141 message procedure skriv_skærm_id side 1 - 830310/hko;
3 7142
3 7142 procedure skriv_skærm_id(nr,id,nød);
3 7143 value nr,id,nød;
3 7144 integer nr,id;
3 7145 boolean nød;
3 7146 begin
4 7147 integer linie,løb,bogst,i,p;
4 7148
4 7148 i:= id shift (-22);
4 7149
4 7149 case i+1 of
4 7150 begin
5 7151 begin <* busnr *>
6 7152 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 7153 (id extract 14) mod 10000);
6 7154 if id shift (-14) extract 8 > 0 then
6 7155 p:= p+write(z_op(nr),".",1,
6 7156 string bpl_navn(id shift (-14) extract 8));
6 7157 write(z_op(nr),"sp",11-p);
6 7158 end;
5 7159
5 7159 begin <*linie/løb*>
6 7160 linie:= id shift (-12) extract 10;
6 7161 bogst:= id shift (-7) extract 5;
6 7162 if bogst > 0 then bogst:= bogst +'A'-1;
6 7163 løb:= id extract 7;
6 7164 write(z_op(nr),if nød then "*" else "sp",1,
6 7165 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 7166 false add bogst,1,"/",1,løb,
6 7167 "sp",if løb > 9 then 3 else 4);
6 7168 end;
5 7169
5 7169 begin <*gruppe*>
6 7170 write(z_op(nr),<:GRP :>);
6 7171 if id shift (-21) extract 1 = 1 then
6 7172 begin <*specialgruppe*>
7 7173 løb:= id extract 7;
7 7174 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 7175 <<d>,løb,"sp",2);
7 7176 end
6 7177 else
6 7178 begin
7 7179 linie:= id shift (-5) extract 10;
7 7180 bogst:= id extract 5;
7 7181 if bogst > 0 then bogst:= bogst +'A'-1;
7 7182 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 7183 false add bogst,1,"sp",2);
7 7184 end;
6 7185 end;
5 7186
5 7186 <* kanal eller område *>
5 7187 begin
6 7188 linie:= (id shift (-20) extract 2) + 1;
6 7189 case linie of
6 7190 begin
7 7191 write(z_op(nr),"sp",11-write(z_op(nr),
7 7192 string kanal_navn(id extract 20)));
7 7193 write(z_op(nr),<:K*:>,"sp",9);
7 7194 write(z_op(nr),"sp",11-write(z_op(nr),
7 7195 <:OMR :>,string område_navn(id extract 20)));
7 7196 write(z_op(nr),<:ALLE:>,"sp",7);
7 7197 end;
6 7198 end;
5 7199
5 7199 end <* case i *>
4 7200 end skriv_skærm_id;
3 7201 \f
3 7201 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 7202
3 7202 procedure skriv_skærm_kanal(nr,kanal);
3 7203 value nr,kanal;
3 7204 integer nr,kanal;
3 7205 begin
4 7206 integer i,j,k,t,omr;
4 7207 integer array field tref,kref;
4 7208 boolean nød;
4 7209
4 7209 tref:= nr*terminal_beskr_længde;
4 7210 kref:= (kanal-1)*kanal_beskr_længde;
4 7211 t:= kanaltab.kref.kanal_tilstand;
4 7212 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 7213 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 7214 cursor(z_op(nr),kanal+2,28);
4 7215 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 7216 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 7217 " ",1," ",1);
4 7218 write(z_op(nr),true,6,string kanal_navn(kanal));
4 7219 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 7220 pabx_id(kanal_id(kanal) extract 5)
4 7221 else
4 7222 radio_id(kanal_id(kanal) extract 5);
4 7223 for i:= -2 step 1 until 0 do
4 7224 begin
5 7225 write(z_op(nr),
5 7226 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 7227 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 7228 end;
4 7229 write(z_op(nr),<:: :>);
4 7230 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 7231 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 7232 begin
5 7233 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 7234 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 7235 end
4 7236 else
4 7237 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 7238 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 7239 else
4 7240 if i > 0 and
4 7241 ( true <* i <> nr *> <* OPT også ud på egen skærm 960527/CL *> or
4 7242 j = kanal <* kanal = kanalnr for ventepos *> or
4 7243 (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 7244 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 7245 begin
5 7246 write(z_op(nr),<:OPT :>);
5 7247 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 7248 else write(z_op(nr),string bpl_navn(i));
5 7249 end
4 7250 else
4 7251 if false then
4 7252 begin
5 7253 i:= kanaltab.kref.kanal_id1;
5 7254 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 7255 skriv_skærm_id(nr,i,nød);
5 7256 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 7257 i:= kanaltab.kref.kanal_id2;
5 7258 if i<>0 then skriv_skærm_id(nr,i,false);
5 7259 end;
4 7260 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7261 end skriv_skærm_kanal;
3 7262 \f
3 7262 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 7263
3 7263 procedure skriv_skærm_b_v_s(nr);
3 7264 value nr;
3 7265 integer nr;
3 7266 begin
4 7267 integer i,j,k,kv,ks,t;
4 7268 integer array field tref,kref;
4 7269
4 7269 tref:= nr*terminal_beskr_længde;
4 7270 i:= terminal_tab.tref.terminal_tilstand;
4 7271 kv:= i shift (-12) extract 4;
4 7272 ks:= terminaltab.tref(2) extract 20;
4 7273 <*V*> setposition(z_op(nr),0,0);
4 7274 cursor(z_op(nr),18,28);
4 7275 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7276 cursor(z_op(nr),20,28);
4 7277 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7278 cursor(z_op(nr),21,28);
4 7279 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7280 cursor(z_op(nr),20,28);
4 7281 if op_talevej(nr)<>0 then
4 7282 begin
5 7283 cursor(z_op(nr),18,28);
5 7284 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 7285 end;
4 7286 if kv <> 0 then
4 7287 begin
5 7288 kref:= (kv-1)*kanal_beskr_længde;
5 7289 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 7290 else kanaltab.kref.kanal_id2;
5 7291 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 7292 else kanaltab.kref.kanal_alt_id2;
5 7293 write(z_op(nr),true,6,string kanal_navn(kv));
5 7294 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 7295 skriv_skærm_id(nr,k,false);
5 7296 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 7297 end;
4 7298
4 7298 cursor(z_op(nr),21,28);
4 7299 j:= terminal_tab.tref(2);
4 7300 if i shift (-21) <> 0 <*ikke ledig*> then
4 7301 begin
5 7302 \f
5 7302 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 7303
5 7303 if i shift (-21) = 1 <*samtale*> then
5 7304 begin
6 7305 if j shift (-20) = 12 then
6 7306 begin
7 7307 write(z_op(nr),true,6,string kanal_navn(ks));
7 7308 end
6 7309 else
6 7310 begin
7 7311 write(z_op(nr),true,6,<:K*:>);
7 7312 k:= 0;
7 7313 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 7314 k:= k+1;
7 7315 ks:= k;
7 7316 end;
6 7317 kref:= (ks-1)*kanal_beskr_længde;
6 7318 t:= kanaltab.kref.kanaltilstand;
6 7319 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 7320 t shift (-3) extract 1 = 1);
6 7321 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 7322 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 7323 if t shift (-5) extract 1 = 1 then <:MON :> else
6 7324 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 7325 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 7326 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 7327 if t shift (-9) extract 1 = 1 then
6 7328 write(z_op(nr),<:ALLE :>);
6 7329 if t shift (-8) extract 1 = 1 then
6 7330 write(z_op(nr),<:KATASTROFE :>);
6 7331 k:= kanaltab.kref.kanal_spec;
6 7332 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7333 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7334 end
5 7335 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7336 begin
6 7337 write(z_op(nr),<:K-:>,"sp",3);
6 7338 if j <> 0 then
6 7339 skriv_skærm_id(nr,j,false)
6 7340 else
6 7341 begin
7 7342 j:=terminal_tab.tref(3);
7 7343 skriv_skærm_id(nr,j,
7 7344 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7345 else 0));
7 7346 end;
6 7347 write(z_op(nr),<:OPT:>);
6 7348 end;
5 7349 end;
4 7350 <*V*> setposition(z_op(nr),0,0);
4 7351 end skriv_skærm_b_v_s;
3 7352 \f
3 7352 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7353
3 7353 procedure skriv_skærm_maske(nr);
3 7354 value nr;
3 7355 integer nr;
3 7356 begin
4 7357 integer i;
4 7358 <*V*> setposition(z_op(nr),0,0);
4 7359 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7360 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7361 "sp",1,"*",5,"nl",1,"-",80);
4 7362
4 7362 for i:= 3 step 1 until 21 do
4 7363 begin
5 7364 cursor(z_op(nr),i,26);
5 7365 outchar(z_op(nr),'!');
5 7366 end;
4 7367 cursor(z_op(nr),22,1);
4 7368 write(z_op(nr),"-",80);
4 7369 cursor(z_op(nr),1,1);
4 7370 <*V*> setposition(z_op(nr),0,0);
4 7371 end skriv_skærm_maske;
3 7372 \f
3 7372 message procedure skal_udskrives side 1 - 940522/cl;
3 7373
3 7373 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7374 value fordelt_til,aktuel_skærm;
3 7375 integer fordelt_til,aktuel_skærm;
3 7376 begin
4 7377 boolean skal_ud;
4 7378 integer n;
4 7379 integer array field iaf;
4 7380
4 7380 skal_ud:= true;
4 7381 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7382 begin
5 7383 for n:= 0 step 1 until 3 do
5 7384 begin
6 7385 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7386 begin
7 7387 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7388 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7389 goto returner;
7 7390 end;
6 7391 end;
5 7392 end;
4 7393 returner:
4 7394 skal_udskrives:= skal_ud;
4 7395 end;
3 7396
3 7396 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7397
3 7397 procedure skriv_skærm_opkaldskø(nr);
3 7398 value nr;
3 7399 integer nr;
3 7400 begin
4 7401 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7402 integer array field ref,iaf,tab;
4 7403 boolean skal_ud;
4 7404
4 7404 <*V*> wait(bs_opkaldskø_adgang);
4 7405 setposition(z_op(nr),0,0);
4 7406 ant:= 0; kmdo:= 0;
4 7407 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7408 ref:= første_nødopkald;
4 7409 if ref=0 then ref:=første_opkald;
4 7410 while ref <> 0 do
4 7411 begin
5 7412 i:= opkaldskø.ref(4);
5 7413 operatør:= i extract 8;
5 7414 type:=i shift (-8) extract 4;
5 7415
5 7415 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7416 *>
5 7417 if operatør > 64 then
5 7418 begin
6 7419 <* fordelt til gruppe af betjeningspladser *>
6 7420 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7421 while skal_ud and i<max_antal_operatører do
6 7422 begin
7 7423 i:=i+1;
7 7424 if læsbit_ia(bpl_def.iaf,i) then
7 7425 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7426 end;
6 7427 end
5 7428 else
5 7429 skal_ud:= skal_udskrives(operatør,nr);
5 7430 if skal_ud then
5 7431 begin
6 7432 ant:= ant +1;
6 7433 if ant < 6 then
6 7434 begin
7 7435 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7436 ttmm:= i shift (-12);
7 7437 vogn:= opkaldskø.ref(3);
7 7438 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7439 skriv_skærm_id(nr,vogn,type=2);
7 7440 write(z_op(nr),true,4,
7 7441 string område_navn(opkaldskø.ref(5) extract 4),
7 7442 <<zd.dd>,ttmm/100.0);
7 7443 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7444 begin
8 7445 if opkaldskø.ref(5) extract 4 <= 2 or
8 7446 opk_alarm.tab.alarm_lgd = 0 then
8 7447 begin
9 7448 if type=2 then
9 7449 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7450 else
9 7451 write(z_op(nr),"bel",1);
9 7452 end
8 7453 else if type>kmdo then kmdo:= type;
8 7454 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7455 end;
7 7456 end;<* ant < 6 *>
6 7457 end;<* operatør ok *>
5 7458
5 7458 ref:= opkaldskø.ref(1) extract 12;
5 7459 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7460 end;
4 7461 \f
4 7461 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7462
4 7462 signal_bin(bs_opkaldskø_adgang);
4 7463 if kmdo > opk_alarm.tab.alarm_tilst and
4 7464 kmdo > opk_alarm.tab.alarm_kmdo then
4 7465 begin
5 7466 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7467 signal_bin(bs_opk_alarm);
5 7468 end;
4 7469 if ant > 5 then
4 7470 begin
5 7471 cursor(z_op(nr),13,9);
5 7472 write(z_op(nr),<<+ddd>,ant-5);
5 7473 end
4 7474 else
4 7475 begin
5 7476 for i:= ant +1 step 1 until 6 do
5 7477 begin
6 7478 cursor(z_op(nr),i*2+1,1);
6 7479 write(z_op(nr),"sp",25);
6 7480 end;
5 7481 end;
4 7482 ant_i_opkø(nr):= ant;
4 7483 cursor(z_op(nr),1,1);
4 7484 <*V*> setposition(z_op(nr),0,0);
4 7485 end skriv_skærm_opkaldskø;
3 7486 \f
3 7486 message procedure operatør side 2 - 810522/hko;
3 7487
3 7487 trap(op_trap);
3 7488 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7489
3 7489 ref:= nr*terminal_beskr_længde;
3 7490 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7491 skærmmåde:= 0; <*normal*>
3 7492
3 7492 if operatør_auto_include(nr) then
3 7493 begin
4 7494 waitch(cs_att_pulje,opref,true,-1);
4 7495 i:= operatør_auto_include(nr) extract 2;
4 7496 if i<>3 then i:= 0;
4 7497 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7498 d.opref.data(1):= nr;
4 7499 signalch(cs_rad,opref,gen_optype or io_optype);
4 7500 end;
3 7501
3 7501 <*+2*>
3 7502 if testbit8 and overvåget or testbit28 then
3 7503 skriv_operatør(out,0);
3 7504 <*-2*>
3 7505 \f
3 7505 message procedure operatør side 3 - 810602/hko;
3 7506
3 7506 repeat
3 7507
3 7507 <*V*> wait_ch(cs_operatør(nr),
3 7508 op_ref,
3 7509 true,
3 7510 -1<*timeout*>);
3 7511 <*+2*>
3 7512 if testbit9 and overvåget then
3 7513 disable begin
4 7514 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7515 <: til operatør :>,nr);
4 7516 skriv_op(out,op_ref);
4 7517 end;
3 7518 <*-2*>
3 7519 monitor(8)reserve process:(z_op(nr),0,ia);
3 7520 kode:= d.op_ref.op_kode extract 12;
3 7521 i:= terminal_tab.ref.terminal_tilstand;
3 7522 status:= i shift(-21);
3 7523 opgave:=
3 7524 if kode=0 then 1 <* indlæs kommando *> else
3 7525 if kode=1 then 2 <* inkluder *> else
3 7526 if kode=2 then 3 <* ekskluder *> else
3 7527 if kode=40 then 4 <* opdater skærm *> else
3 7528 if kode=43 then 5 <* opkald etableret *> else
3 7529 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7530 if kode=38 then 7 <* operatør meddelelse *> else
3 7531 0; <* afvises *>
3 7532
3 7532 aktion:= case status +1 of(
3 7533 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7534 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7535 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7536 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7537 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7538 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7539 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7540 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7541 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7542 -1);
3 7543 \f
3 7543 message procedure operatør side 4 - 810424/hko;
3 7544
3 7544 case aktion+6 of
3 7545 begin
4 7546 begin
5 7547 <*-5: terminal optaget *>
5 7548
5 7548 d.op_ref.resultat:= 16;
5 7549 afslut_operation(op_ref,-1);
5 7550 end;
4 7551
4 7551 begin
5 7552 <*-4: operation uden virkning *>
5 7553
5 7553 afslut_operation(op_ref,-1);
5 7554 end;
4 7555
4 7555 begin
5 7556 <*-3: ulovlig operationskode *>
5 7557
5 7557 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7558 afslut_operation(op_ref,-1);
5 7559 end;
4 7560
4 7560 begin
5 7561 <*-2: ulovligt operatørterminal_nr *>
5 7562
5 7562 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7563 afslut_operation(op_ref,-1);
5 7564 end;
4 7565
4 7565 begin
5 7566 <*-1: ulovlig operatørtilstand *>
5 7567
5 7567 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7568 afslut_operation(op_ref,-1);
5 7569 end;
4 7570
4 7570 begin
5 7571 <* 0: ikke implementeret *>
5 7572
5 7572 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7573 afslut_operation(op_ref,-1);
5 7574 end;
4 7575
4 7575 begin
5 7576 \f
5 7576 message procedure operatør side 5 - 851001/cl;
5 7577
5 7577 <* 1: indlæs kommando *>
5 7578
5 7578
5 7578 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7579 if opk_alarm.tab.alarm_tilst > 0 then
5 7580 begin
6 7581 opk_alarm.tab.alarm_kmdo:= 3;
6 7582 signal_bin(bs_opk_alarm);
6 7583 pass;
6 7584 end;
5 7585 if d.op_ref.resultat > 3 then
5 7586 begin
6 7587 <*V*> setposition(z_op(nr),0,0);
6 7588 cursor(z_op(nr),24,1);
6 7589 skriv_kvittering(z_op(nr),op_ref,pos,
6 7590 d.op_ref.resultat);
6 7591 end
5 7592 else if d.op_ref.resultat = -1 then
5 7593 begin
6 7594 skærmmåde:= 0;
6 7595 skrivskærm(nr);
6 7596 end
5 7597 else if d.op_ref.resultat>0 then
5 7598 begin <*godkendt*>
6 7599 kode:=d.op_ref.opkode;
6 7600 i:= kode extract 12;
6 7601 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7602 if kode = 19 then 1 <*VO,S *> else
6 7603 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7604 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7605 if kode = 6 then 4 <*STop*> else
6 7606 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7607 if kode = 30 then 5 <*SP,D*> else
6 7608 if kode = 31 then 6 <*SP*> else
6 7609 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7610 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7611 if kode = 83 then 8 <*SL*> else
6 7612 if kode = 68 then 9 <*ST,D*> else
6 7613 if kode = 69 then 10 <*ST,V*> else
6 7614 if kode = 36 then 11 <*AL*> else
6 7615 if kode = 37 then 12 <*CC*> else
6 7616 if kode = 2 then 13 <*EX*> else
6 7617 if kode = 92 then 14 <*CQF,V*> else
6 7618 if kode = 38 then 15 <*AL,T*> else
6 7619 0;
6 7620 if j > 0 then
6 7621 begin
7 7622 case j of
7 7623 begin
8 7624 begin
9 7625 \f
9 7625 message procedure operatør side 6 - 851001/cl;
9 7626
9 7626 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7627
9 7627 vogn:=ia(1);
9 7628 ll:=ia(2);
9 7629 kanal:= if kode=11 or kode=19 then ia(3) else
9 7630 if kode=12 then ia(2) else 0;
9 7631 <*V*> wait_ch(cs_vt_adgang,
9 7632 vt_op,
9 7633 gen_optype,
9 7634 -1<*timeout sek*>);
9 7635 start_operation(vtop,200+nr,cs_operatør(nr),
9 7636 kode);
9 7637 d.vt_op.data(1):=vogn;
9 7638 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7639 d.vt_op.data(2):=ll;
9 7640 if kode=19 then d.vt_op.data(3):= kanal else
9 7641 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7642 indeks:= vt_op;
9 7643 signal_ch(cs_vt,
9 7644 vt_op,
9 7645 gen_optype or op_optype);
9 7646
9 7646 <*V*> wait_ch(cs_operatør(nr),
9 7647 vt_op,
9 7648 op_optype,
9 7649 -1<*timeout sek*>);
9 7650 <*+2*> if testbit10 and overvåget then
9 7651 disable begin
10 7652 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7653 <:: operation retur fra vt:>);
10 7654 skriv_op(out,vt_op);
10 7655 end;
9 7656 <*-2*>
9 7657 <*+4*> if vt_op<>indeks then
9 7658 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7659 <:operatør-kommando:>,0);
9 7660 <*-4*>
9 7661 <*V*> setposition(z_op(nr),0,0);
9 7662 cursor(z_op(nr),24,1);
9 7663 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7664 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7665 else vt_op,-1,d.vt_op.resultat);
9 7666 d.vt_op.optype:= gen_optype or vt_optype;
9 7667 disable afslut_operation(vt_op,cs_vt_adgang);
9 7668 end;
8 7669 begin
9 7670 \f
9 7670 message procedure operatør side 7 - 810921/hko,cl;
9 7671
9 7671 <* 2 vogntabel,linienr/-,busnr *>
9 7672
9 7672 d.op_ref.retur:= cs_operatør(nr);
9 7673 tofrom(d.op_ref.data,ia,10);
9 7674 indeks:= op_ref;
9 7675 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7676 wait_ch(cs_operatør(nr),
9 7677 op_ref,
9 7678 op_optype,
9 7679 -1<*timeout*>);
9 7680 <*+2*> if testbit10 and overvåget then
9 7681 disable begin
10 7682 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7683 skriv_op(out,op_ref);
10 7684 end;
9 7685 <*-2*>
9 7686 <*+4*>
9 7687 if indeks <> op_ref then
9 7688 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7689 <*-4*>
9 7690 i:= d.op_ref.resultat;
9 7691 if i = 0 or i > 3 then
9 7692 begin
10 7693 <*V*> setposition(z_op(nr),0,0);
10 7694 cursor(z_op(nr),24,1);
10 7695 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7696 end
9 7697 else
9 7698 begin
10 7699 integer antal,fil_ref;
10 7700
10 7700 skærm_måde:= 1;
10 7701 antal:= d.op_ref.data(6);
10 7702 fil_ref:= d.op_ref.data(7);
10 7703 <*V*> setposition(z_op(nr),0,0);
10 7704 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7705 "sp",14,"*",10,"sp",6,
10 7706 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7707 <*V*> setposition(z_op(nr),0,0);
10 7708 \f
10 7708 message procedure operatør side 8 - 841213/cl;
10 7709
10 7709 pos:= 1;
10 7710 while pos <= antal do
10 7711 begin
11 7712 integer bogst,løb;
11 7713
11 7713 disable i:= læs_fil(fil_ref,pos,j);
11 7714 if i <> 0 then
11 7715 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7716 else
11 7717 begin
12 7718 vogn:= fil(j,1) shift (-24) extract 24;
12 7719 løb:= fil(j,1) extract 24;
12 7720 if d.op_ref.opkode=9 then
12 7721 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7722 ll:= løb shift (-12) extract 10;
12 7723 bogst:= løb shift (-7) extract 5;
12 7724 if bogst > 0 then bogst:= bogst +'A'-1;
12 7725 løb:= løb extract 7;
12 7726 vogn:= vogn extract 14;
12 7727 i:= d.op_ref.opkode-8;
12 7728 for i:= i,i+1 do
12 7729 begin
13 7730 j:= (i+1) extract 1;
13 7731 case j +1 of
13 7732 begin
14 7733 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7734 false add bogst,1,"/",1,<<d__>,løb);
14 7735 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7736 end;
13 7737 end;
12 7738 if pos mod 5 = 0 then
12 7739 begin
13 7740 outchar(z_op(nr),'nl');
13 7741 <*V*> setposition(z_op(nr),0,0);
13 7742 end
12 7743 else write(z_op(nr),"sp",3);
12 7744 end;
11 7745 pos:=pos+1;
11 7746 end;
10 7747 write(z_op(nr),"*",1,"nl",1);
10 7748 \f
10 7748 message procedure operatør side 8a- 810507/hko;
10 7749
10 7749 d.opref.opkode:=104; <*slet-fil*>
10 7750 d.op_ref.data(4):=filref;
10 7751 indeks:=op_ref;
10 7752 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7753 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7754
10 7754 <*+2*> if testbit10 and overvåget then
10 7755 disable begin
11 7756 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7757 skriv_op(out,op_ref);
11 7758 end;
10 7759 <*-2*>
10 7760
10 7760 <*+4*> if op_ref<>indeks then
10 7761 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7762 <*-4*>
10 7763 if d.op_ref.data(9)<>0 then
10 7764 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7765 <:operatør, slet_fil:>,1);
10 7766 end;
9 7767 end;
8 7768
8 7768 begin
9 7769 \f
9 7769 message procedure operatør side 9 - 830310/hko;
9 7770
9 7770 <* 3 radio_kommandoer *>
9 7771
9 7771 kode:= d.op_ref.opkode;
9 7772 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7773 disable if testbit14 then
9 7774 begin
10 7775 integer i; <*lav en trap-bar blok*>
10 7776
10 7776 trap(test14_trap);
10 7777 systime(1,0,kommstart);
10 7778 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7779 string bpl_navn(nr),<: start :>,case rkom of (
10 7780 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7781 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7782 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7783 <:GE,T:>),<: :>);
10 7784 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7785 rkom=16 or rkom=17 or rkom=19)
10 7786 then
10 7787 begin
11 7788 if par1<>0 then skriv_id(zrl,par1,0);
11 7789 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7790 write(zrl,"sp",1,string områdenavn(par2));
11 7791 end
10 7792 else
10 7793 if rkom=10 and par1<>0 then
10 7794 write(zrl,string kanalnavn(par1 extract 20))
10 7795 else
10 7796 if rkom=5 or rkom=6 then
10 7797 begin
11 7798 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7799 if par1 shift (-20)=14 then
11 7800 write(zrl,string områdenavn(par1 extract 20));
11 7801 end;
10 7802 test14_trap: outchar(zrl,'nl');
10 7803 end;
9 7804 d.op_ref.data(4):= nr; <*operatør*>
9 7805 opgave:=
9 7806 if kode = 45 <*OP *> then 1 else
9 7807 if kode = 46 <*ME *> then 2 else
9 7808 if kode = 47 <*OP,G*> then 3 else
9 7809 if kode = 48 <*ME,G*> then 4 else
9 7810 if kode = 49 <*OP,A*> then 5 else
9 7811 if kode = 50 <*ME,A*> then 6 else
9 7812 if kode = 51 <*KA,C*> then 7 else
9 7813 if kode = 52 <*KA,P*> then 8 else
9 7814 if kode = 53 <*OP,L*> then 9 else
9 7815 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7816 if kode = 55 <*VE *> then 14 else
9 7817 if kode = 56 <*NE *> then 12 else
9 7818 if kode = 57 <*OP,V*> then 1 else
9 7819 if kode = 58 <*OP,T*> then 1 else
9 7820 if kode = 59 <*R *> then 13 else
9 7821 if kode = 60 <*GE *> then 15 else
9 7822 if kode = 61 <*GE,G*> then 16 else
9 7823 if kode = 62 <*GE,V*> then 15 else
9 7824 if kode = 63 <*GE,T*> then 15 else
9 7825 -1;
9 7826 <*+4*> if opgave < 0 then
9 7827 fejlreaktion(2<*operationskode*>,kode,
9 7828 <:operatør, radio-kommando :>,0);
9 7829 <*-4*>
9 7830 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7831 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7832 if 5<=opgave and opgave<=8 then
9 7833 d.opref.data(2):= -1;
9 7834 if opgave=13 then d.opref.data(2):=
9 7835 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7836 then 0 else 1);
9 7837 if opgave = 14 then d.opref.data(2):= 1;
9 7838 if opgave=7 or opgave=8 then
9 7839 d.opref.data(3):= -1
9 7840 else
9 7841 if opgave=5 or opgave=6 then
9 7842 begin
10 7843 if ia(1) shift (-20) = 15 then
10 7844 begin
11 7845 d.opref.data(3):= 15 shift 20;
11 7846 for j:= 1 step 1 until max_antal_kanaler do
11 7847 begin
12 7848 iaf:= (j-1)*kanalbeskrlængde;
12 7849 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7850 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7851 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7852 end;
11 7853 end
10 7854 else
10 7855 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7856 else ia(1);
10 7857 end
9 7858 else
9 7859 if kode = 57 then d.opref.data(3):= 2 else
9 7860 if kode = 58 then d.opref.data(3):= 1 else
9 7861 if kode = 62 then d.opref.data(3):= 2 else
9 7862 if kode = 63 then d.opref.data(3):= 1 else
9 7863 d.opref.data(3):= ia(2);
9 7864
9 7864 <* !!! i første if-sætning nedenfor er 'status>1'
9 7865 rettet til 'status>0' for at forhindre
9 7866 at opkald nr. 2 kan udføres med et allerede
9 7867 etableret opkald i skærmens s-felt,
9 7868 jvf. ulykke d. 7/2-1995
9 7869 !!! *>
9 7870 res:=
9 7871 if (opgave=1 or opgave=3) and status>0
9 7872 then 16 <*skærm optaget*> else
9 7873 if (opgave=15 or opgave=16) and
9 7874 status>1 then 16 <*skærm optaget*> else
9 7875 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7876 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7877 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7878 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7879 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7880 then 52 else 1) else
9 7881 if opgave<11 and status>0 then 16 else
9 7882 if opgave=11 and status<2 then 21 else
9 7883 if opgave=12 and status=0 then 22 else
9 7884 if opgave=13 and status=0 then 49 else
9 7885 if opgave=14 and status<>3 then 21 else 1;
9 7886 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7887 begin <* specialbetingelser for TLF og VHF *>
10 7888 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7889 end;
9 7890 if skærmmåde<>0 then
9 7891 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7892 kode:= opgave;
9 7893 if opgave = 15 then opgave:= 1 else
9 7894 if opgave = 16 then opgave:= 3;
9 7895 \f
9 7895 message procedure operatør side 10 - 810616/hko;
9 7896
9 7896 <* tilknyt talevej (om nødvendigt) *>
9 7897 if res = 1 and op_talevej(nr)=0 then
9 7898 begin
10 7899 i:= sidste_tv_brugt;
10 7900 repeat
10 7901 i:= (i mod max_antal_taleveje)+1;
10 7902 if tv_operatør(i)=0 then
10 7903 begin
11 7904 tv_operatør(i):= nr;
11 7905 op_talevej(nr):= i;
11 7906 end;
10 7907 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7908 if op_talevej(nr)=0 then
10 7909 res:=61
10 7910 else
10 7911 begin
11 7912 sidste_tv_brugt:=
11 7913 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7914
11 7914 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7915 start_operation(iaf,200+nr,cs_operatør(nr),
11 7916 'A' shift 12 + 44);
11 7917 d.iaf.data(1):= op_talevej(nr);
11 7918 d.iaf.data(2):= nr+16;
11 7919 ll:= 0;
11 7920 repeat
11 7921 signalch(cs_talevejsswitch,iaf,op_optype);
11 7922 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7923 ll:= ll+1;
11 7924 until ll=3 or d.iaf.resultat=3;
11 7925 res:= if d.iaf.resultat=3 then 1 else 61;
11 7926 <* ********* *>
11 7927 delay(1);
11 7928 start_operation(iaf,200+nr,cs_operatør(nr),
11 7929 'R' shift 12 + 44);
11 7930 ll:= 0;
11 7931 repeat
11 7932 signalch(cs_talevejsswitch,iaf,op_optype);
11 7933 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7934 ll:= ll+1;
11 7935 until ll=3 or d.iaf.resultat=3;
11 7936 <* ********* *>
11 7937 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7938 if res<>1 then
11 7939 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7940 end;
10 7941 end;
9 7942 if op_talevej(nr)=0 then res:= 61;
9 7943 d.op_ref.data(1):= op_talevej(nr);
9 7944
9 7944 if res <= 1 then
9 7945 begin
10 7946 til_radio: <* send operation til radiomodul *>
10 7947 d.op_ref.opkode:= opgave shift 12 + 41;
10 7948 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7949 else 0;
10 7950 d.op_ref.data(6):= b_s;
10 7951 d.op_ref.resultat:=0;
10 7952 d.op_ref.retur:= cs_operatør(nr);
10 7953 indeks:= op_ref;
10 7954 <*+2*> if testbit11 and overvåget then
10 7955 disable begin
11 7956 skriv_operatør(out,0);
11 7957 write(out,<: operation til radio:>);
11 7958 skriv_op(out,op_ref); ud;
11 7959 end;
10 7960 <*-2*>
10 7961 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7962 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7963
10 7963 <*+2*> if testbit12 and overvåget then
10 7964 disable begin
11 7965 skriv_operatør(out,0);
11 7966 write(out,<: operation retur fra radio:>);
11 7967 skriv_op(out,op_ref); ud;
11 7968 end;
10 7969 <*-2*>
10 7970 <*+4*> if op_ref <> indeks then
10 7971 fejlreaktion(11<*fr.post*>,op_ref,
10 7972 <:operatør, retur fra radio:>,0);
10 7973 <*-4*>
10 7974 \f
10 7974 message procedure operatør side 11 - 810529/hko;
10 7975
10 7975 res:= d.op_ref.resultat;
10 7976 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7977 begin
11 7978 <*+4*> if res < 2 then
11 7979 fejlreaktion(3<*prg.fejl*>,res,
11 7980 <: operatør,radio_op,resultat:>,1);
11 7981 <*-4*>
11 7982 if res = 1 then res:= 0;
11 7983 if (opgave < 10) and (res=20 or res=52) then
11 7984 disable tæl_opkald_pr_operatør(nr,
11 7985 (if res=20 then 4 else 5));
11 7986 end
10 7987 else
10 7988 begin <* res = 2 eller 3 *>
11 7989 s_kanal:= v_kanal:= 0;
11 7990 opgave:= d.opref.opkode shift (-12);
11 7991 bv:= d.op_ref.data(5) extract 4;
11 7992 bs:= d.op_ref.data(6);
11 7993 if opgave < 10 then
11 7994 begin
12 7995 j:= d.op_ref.data(7) <*type*>;
12 7996 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 7997 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 7998 terminal_tab.ref(1):= i
12 7999 +(if res=2 then 4 <*optaget*> else 0)
12 8000 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 8001 then 8 <*nød*> else 0)
12 8002 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 8003 then 16 else 0)
12 8004 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 8005 + (if opgave=9 then 128 else
12 8006 if opgave>=7 then 256 else
12 8007 if opgave>=5 then 512 else 0)
12 8008 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 8009 else if b_s = 0 then 0 <*tilstand = ledig *>
12 8010 else 1 shift 21 <*tilstand = samtale*>);
12 8011 if (res=3 and 0<=j and j<3) then
12 8012 disable tæl_opkald_pr_operatør(nr,j+1);
12 8013 end
11 8014 else if opgave=10 <*monitering*> or
11 8015 opgave=14 <*ventepos *> then
11 8016 begin
12 8017 <*+4*> if res = 2 then
12 8018 fejlreaktion(3<*prg.fejl*>,res,
12 8019 <: operatør,moniter,res:>,1);
12 8020 <*-4*>
12 8021 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 8022 i:= if bs<0 then
12 8023 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 8024 terminal_tab.ref(1):= i +
12 8025 (if bs < 0 then (1 shift 21) else 0);
12 8026 if opgave=10 then
12 8027 begin
13 8028 s_kanal:= bs;
13 8029 v_kanal:= d.opref.data(5);
13 8030 end;
12 8031 \f
12 8031 message procedure operatør side 12 - 810603/hko;
12 8032 end
11 8033 else if opgave=11 or opgave=12 then
11 8034 begin
12 8035 <*+4*> if res = 2 then
12 8036 fejlreaktion(3<*prg.fejl*>,res,
12 8037 <: operatør,ge/ne,res:>,1);
12 8038 <*-4*>
12 8039 if opgave=11 <*GE*> and res<>49 then
12 8040 begin
13 8041 s_kanal:= terminal_tab.ref(2);
13 8042 v_kanal:= 12 shift 20 +
13 8043 (terminal_tab.ref(1) shift (-12) extract 4);
13 8044 end;
12 8045 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 8046 end
11 8047 else
11 8048 if opgave=13 then
11 8049 begin
12 8050 if res=2 then
12 8051 fejlreaktion(3<*prg.fejl*>,res,
12 8052 <:operatør,R,res:>,1);
12 8053 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 8054 d.opref.data(2));
12 8055 end
11 8056 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 8057 <*-4*>
11 8058 ;
11 8059 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 8060
11 8060 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 8061 terminal_tab.ref(2):= b_s;
11 8062 terminal_tab.ref(3):= d.op_ref.data(11);
11 8063 if (opgave<10 or opgave=14) and res=3 then
11 8064 <*så henviser b_s til radiokanal*>
11 8065 begin
12 8066 if bs shift (-20) = 12 then
12 8067 begin
13 8068 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 8069 kanaltab.iaf.kanal_tilstand:=
13 8070 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 8071 +terminal_tab.ref(1) extract 10;
13 8072 end
12 8073 else
12 8074 begin
13 8075 for i:= 1 step 1 until max_antal_kanaler do
13 8076 begin
14 8077 if læsbit_i(bs,i) then
14 8078 begin
15 8079 iaf:= (i-1)*kanal_beskr_længde;
15 8080 kanaltab.iaf.kanaltilstand:=
15 8081 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 8082 + terminal_tab.ref(1) extract 10;
15 8083 end;
14 8084 end;
13 8085 end;
12 8086 end;
11 8087 if kode=15 or kode=16 then
11 8088 begin
12 8089 if opgave<10 then
12 8090 begin
13 8091 opgave:= 11;
13 8092 kanal:= (12 shift 20) +
13 8093 d.opref.data(6) extract 20;
13 8094 goto til_radio;
13 8095 end
12 8096 else
12 8097 if opgave=11 then
12 8098 begin
13 8099 opgave:= 10;
13 8100 d.opref.data(2):= kanal;
13 8101 goto til_radio;
13 8102 end;
12 8103 end
11 8104 else
11 8105 if (kode=1 or kode=3) then
11 8106 begin
12 8107 if opgave<10 and bv<>0 then
12 8108 begin
13 8109 opgave:= 14;
13 8110 d.opref.data(2):= 2;
13 8111 goto til_radio;
13 8112 end;
12 8113 end;
11 8114 <*V*> skriv_skærm_b_v_s(nr);
11 8115 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 8116 skriv_skærm_opkaldskø(nr);
11 8117 for i:= s_kanal, v_kanal do
11 8118 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 8119 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 8120 signalbin(bs_mobilopkald);
11 8121 <*V*> setposition(z_op(nr),0,0);
11 8122 end; <* res = 2 eller 3 *>
10 8123 end; <* res <= 1 *>
9 8124 <* frigiv talevej (om nødvendigt) *>
9 8125 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 8126 and terminal_tab.ref(2)=0 <*b_s*>
9 8127 and op_talevej(nr)<>0
9 8128 then
9 8129 begin
10 8130 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 8131 start_operation(iaf,200+nr,cs_operatør(nr),
10 8132 'D' shift 12 + 44);
10 8133 d.iaf.data(1):= op_talevej(nr);
10 8134 d.iaf.data(2):= nr+16;
10 8135 ll:= 0;
10 8136 repeat
10 8137 signalch(cs_talevejsswitch,iaf,op_optype);
10 8138 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 8139 ll:= ll+1;
10 8140 until ll=3 or d.iaf.resultat=3;
10 8141 ll:= d.iaf.resultat;
10 8142 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 8143 if ll<>3 then
10 8144 fejlreaktion(21,op_talevej(nr)*100+nr,
10 8145 <:frigiv operatør fejlet:>,1)
10 8146 else
10 8147 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 8148 skriv_skærm_b_v_s(nr);
10 8149 end;
9 8150 disable if testbit14 then
9 8151 begin
10 8152 integer t; <*lav en trap-bar blok*>
10 8153
10 8153 trap(test14_trap);
10 8154 systime(1,0,kommslut);
10 8155 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 8156 string bpl_navn(nr),<: slut :>,case rkom of (
10 8157 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 8158 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 8159 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 8160 <:GE,T:>),<: :>);
10 8161 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 8162 rkom=16 or rkom=17 or rkom=19)
10 8163 then
10 8164 begin
11 8165 if d.opref.data(7)=2 then outchar(zrl,'*');
11 8166 if d.opref.data(9)<>0 then
11 8167 begin
12 8168 skriv_id(zrl,d.opref.data(9),0);
12 8169 outchar(zrl,' ');
12 8170 end;
11 8171 if d.opref.data(8)<>0 then
11 8172 begin
12 8173 skriv_id(zrl,d.opref.data(8),0);
12 8174 outchar(zrl,' ');
12 8175 end;
11 8176 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 8177 d.opref.data(2)<>0 then
11 8178 begin
12 8179 skriv_id(zrl,d.opref.data(2),0);
12 8180 outchar(zrl,' ');
12 8181 end;
11 8182 if d.opref.data(12)<>0 then
11 8183 begin
12 8184 if d.opref.data(12) shift (-20) = 15 then
12 8185 write(zrl,<:OMR*:>)
12 8186 else
12 8187 if d.opref.data(12) shift (-20) = 14 then
12 8188 write(zrl,
12 8189 string områdenavn(d.opref.data(12) extract 20))
12 8190 else
12 8191 skriv_id(zrl,d.opref.data(12),0);
12 8192 outchar(zrl,' ');
12 8193 end;
11 8194 t:= terminal_tab.ref.terminaltilstand extract 10;
11 8195 if res=3 and rkom=1 and
11 8196 (t shift (-4) extract 1 = 1) and
11 8197 (t extract 2 <> 3)
11 8198 then
11 8199 begin
12 8200 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 8201 kanal_beskr_længde;
12 8202 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 8203 extract 12)/100," ",1);
12 8204 end;
11 8205 if d.opref.data(10)<>0 then
11 8206 begin
12 8207 skriv_id(zrl,d.opref.data(10),0);
12 8208 outchar(zrl,' ');
12 8209 end;
11 8210 end
10 8211 else
10 8212 if rkom=10 and par1<>0 then
10 8213 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 8214 else
10 8215 if rkom=5 or rkom=6 then
10 8216 begin
11 8217 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 8218 if par1 shift (-20)=14 then
11 8219 write(zrl,string områdenavn(par1 extract 20));
11 8220 outchar(zrl,' ');
11 8221 end;
10 8222 if op_talevej(nr) > 0 then
10 8223 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 8224 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 8225 <<dd.dd>,kommslut-kommstart);
10 8226 test14_trap: outchar(zrl,'nl');
10 8227 end;
9 8228
9 8228 <*V*> setposition(z_op(nr),0,0);
9 8229 cursor(z_op(nr),24,1);
9 8230 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 8231 end; <* radio-kommando *>
8 8232 begin
9 8233 \f
9 8233 message procedure operatør side 13 - 810518/hko;
9 8234
9 8234 <* 4 stop kommando *>
9 8235
9 8235 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 8236 if tilstand <> 0 then
9 8237 begin
10 8238 d.op_ref.resultat:= 16; <*skærm optaget*>
10 8239 end
9 8240 else
9 8241 begin
10 8242 d.op_ref.retur:= cs_operatør(nr);
10 8243 d.op_ref.resultat:= 0;
10 8244 d.op_ref.data(1):= nr;
10 8245 indeks:= op_ref;
10 8246 <*+2*> if testbit11 and overvåget then
10 8247 disable begin
11 8248 skriv_operatør(out,0);
11 8249 write(out,<: stop_operation til radio:>);
11 8250 skriv_op(out,op_ref); ud;
11 8251 end;
10 8252 <*-2*>
10 8253 if opk_alarm.tab.alarm_tilst > 0 then
10 8254 begin
11 8255 opk_alarm.tab.alarm_kmdo:= 3;
11 8256 signal_bin(bs_opk_alarm);
11 8257 end;
10 8258
10 8258 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 8259 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 8260 <*+2*> if testbit12 and overvåget then
10 8261 disable begin
11 8262 skriv_operatør(out,0);
11 8263 write(out,<: operation retur fra radio:>);
11 8264 skriv_op(out,op_ref); ud;
11 8265 end;
10 8266 <*-2*>
10 8267 <*+4*> if indeks <> op_ref then
10 8268 fejlreaktion(11<*fr.post*>,op_ref,
10 8269 <: operatør, retur fra radio:>,0);
10 8270 <*-4*>
10 8271 \f
10 8271 message procedure operatør side 14 - 810527/hko;
10 8272
10 8272 if d.op_ref.resultat = 3 then
10 8273 begin
11 8274 integer k,n;
11 8275 integer array field msk,iaf1;
11 8276
11 8276 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 8277 +terminal_tab.ref.terminal_tilstand extract 21;
11 8278 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 8279 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 8280 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 8281 begin
12 8282 msk:= k*op_maske_lgd;
12 8283 if læsbit_ia(bpl_def.msk,nr) then
12 8284 <**> begin
13 8285 n:= 0;
13 8286 for i:= 1 step 1 until max_antal_operatører do
13 8287 if læsbit_ia(bpl_def.msk,i) then
13 8288 begin
14 8289 iaf1:= i*terminal_beskr_længde;
14 8290 if terminal_tab.iaf1.terminal_tilstand
14 8291 shift (-21) < 3 then
14 8292 n:= n+1;
14 8293 end;
13 8294 bpl_tilst(k,1):= n;
13 8295 end;
12 8296 <**> <*
12 8297 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 8298 *> end;
11 8299 signal_bin(bs_mobil_opkald);
11 8300 <*V*> setposition(z_op(nr),0,0);
11 8301 ht_symbol(z_op(nr));
11 8302 end;
10 8303 end;
9 8304 <*V*> setposition(z_op(nr),0,0);
9 8305 cursor(z_op(nr),24,1);
9 8306 if d.op_ref.resultat<> 3 then
9 8307 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8308 end;
8 8309 begin
9 8310 boolean l22;
9 8311 \f
9 8311 message procedure operatør side 15 - 810521/cl;
9 8312
9 8312 <* 5 springdefinition *>
9 8313 l22:= false;
9 8314 if sep=',' then
9 8315 disable begin
10 8316 setposition(z_op(nr),0,0);
10 8317 cursor(z_op(nr),22,1);
10 8318 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 8319 l22:= true; pos:= 1;
10 8320 while læstegn(d.op_ref.data,pos,i)<>0 do
10 8321 outchar(z_op(nr),i);
10 8322 end;
9 8323
9 8323 tofrom(d.op_ref.data,ia,indeks*2);
9 8324 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 8325 start_operation(vt_op,200+nr,cs_operatør(nr),
9 8326 101<*opret fil*>);
9 8327 d.vt_op.data(1):=128;<*postantal*>
9 8328 d.vt_op.data(2):=2; <*postlængde*>
9 8329 d.vt_op.data(3):=1; <*segmentantal*>
9 8330 d.vt_op.data(4):=
9 8331 2 shift 10; <*spool fil*>
9 8332 signal_ch(cs_opret_fil,vt_op,op_optype);
9 8333 pos:=vt_op;<*variabel lånes*>
9 8334 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 8335 <*+4*> if vt_op<>pos then
9 8336 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 8337 if d.vt_op.data(9)<>0 then
9 8338 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8339 <:op kommando(springdefinition):>,0);
9 8340 <*-4*>
9 8341 iaf:=0;
9 8342 for i:=1 step 1 until indeks-2 do
9 8343 begin
10 8344 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8345 if k<>0 then
10 8346 fejlreaktion(7<*modif-fil*>,k,
10 8347 <:op kommando(spring-def):>,0);
10 8348 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8349 end;
9 8350 \f
9 8350 message procedure operatør side 15a - 820301/cl;
9 8351
9 8351 while sep = ',' do
9 8352 begin
10 8353 setposition(z_op(nr),0,0);
10 8354 cursor(z_op(nr),23,1);
10 8355 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8356 setposition(z_op(nr),0,0);
10 8357 wait(bs_fortsæt_adgang);
10 8358 pos:= 1; j:= 0;
10 8359 while læs_store(z_op(nr),i) < 8 do
10 8360 begin
11 8361 skrivtegn(fortsæt,pos,i);
11 8362 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8363 end;
10 8364 skrivtegn(fortsæt,pos,'em');
10 8365 afsluttext(fortsæt,pos);
10 8366 sluttegn:= i;
10 8367 if j<>0 then
10 8368 begin
11 8369 setposition(z_op(nr),0,0);
11 8370 cursor(z_op(nr),24,1);
11 8371 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8372 cursor(z_op(nr),1,1);
11 8373 goto sp_ann;
11 8374 end;
10 8375 \f
10 8375 message procedure operatør side 16 - 810521/cl;
10 8376
10 8376 disable begin
11 8377 integer array værdi(1:4);
11 8378 integer a_pos,res;
11 8379 pos:= 0;
11 8380 repeat
11 8381 apos:= pos;
11 8382 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8383 if res >= 0 then
11 8384 begin
12 8385 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8386 else if res=0 then res:= -25 <*parameter mangler*>
12 8387 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8388 res:= -44 <*intervalstørrelse ulovlig*>
12 8389 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8390 res:= -6 <*løbnr ulovligt*>
12 8391 else if res=10 then
12 8392 begin
13 8393 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8394 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8395 <:op kommando(spring-def):>,0);
13 8396 iaf:= 0;
13 8397 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8398 indeks:= indeks+1;
13 8399 if sep = ',' then res:= 0;
13 8400 end
12 8401 else res:= -27; <*parametertype*>
12 8402 end;
11 8403 if res>0 then pos:= a_pos;
11 8404 until sep<>'sp' or res<=0;
11 8405
11 8405 if res<0 then
11 8406 begin
12 8407 d.op_ref.resultat:= -res;
12 8408 i:=1; j:= 1;
12 8409 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8410 afsluttext(d.op_ref.data,i);
12 8411 end;
11 8412 end;
10 8413 \f
10 8413 message procedure operatør side 17 - 810521/cl;
10 8414
10 8414 if d.op_ref.resultat > 3 then
10 8415 begin
11 8416 setposition(z_op(nr),0,0);
11 8417 if l22 then
11 8418 begin
12 8419 cursor(z_op(nr),22,1); l22:= false;
12 8420 write(z_op(nr),"-",80);
12 8421 end;
11 8422 cursor(z_op(nr),24,1);
11 8423 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8424 goto sp_ann;
11 8425 end;
10 8426 if sep=',' then
10 8427 begin
11 8428 setposition(z_op(nr),0,0);
11 8429 cursor(z_op(nr),22,1);
11 8430 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8431 pos:= 1; l22:= true;
11 8432 while læstegn(fortsæt,pos,i)<>0 do
11 8433 outchar(z_op(nr),i);
11 8434 end;
10 8435 signalbin(bs_fortsæt_adgang);
10 8436 end while sep = ',';
9 8437 d.vt_op.data(1):= indeks-2;
9 8438 k:= sætfildim(d.vt_op.data);
9 8439 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8440 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8441 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8442 d.op_ref.retur:=cs_operatør(nr);
9 8443 pos:=op_ref;
9 8444 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8445 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8446 <*+4*> if pos<>op_ref then
9 8447 fejlreaktion(11<*fremmed post*>,op_ref,
9 8448 <:op kommando(springdef retur fra vt):>,0);
9 8449 <*-4*>
9 8450 \f
9 8450 message procedure operatør side 18 - 810521/cl;
9 8451
9 8451 <*V*> setposition(z_op(nr),0,0);
9 8452 if l22 then
9 8453 begin
10 8454 cursor(z_op(nr),22,1);
10 8455 write(z_op(nr),"-",80);
10 8456 end;
9 8457 cursor(z_op(nr),24,1);
9 8458 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8459
9 8459 if false then
9 8460 begin
10 8461 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8462 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8463 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8464 signalbin(bs_fortsæt_adgang);
10 8465 end;
9 8466
9 8466 end;
8 8467
8 8467 begin
9 8468 \f
9 8468 message procedure operatør side 19 - 810522/cl;
9 8469
9 8469 <* 6 spring (igangsæt)
9 8470 spring,annuler
9 8471 spring,reserve *>
9 8472
9 8472 tofrom(d.op_ref.data,ia,6);
9 8473 d.op_ref.retur:=cs_operatør(nr);
9 8474 indeks:=op_ref;
9 8475 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8476 <*V*> wait_ch(cs_operatør(nr),
9 8477 op_ref,
9 8478 op_optype,
9 8479 -1<*timeout*>);
9 8480 <*+2*> if testbit10 and overvåget then
9 8481 disable begin
10 8482 skriv_operatør(out,0);
10 8483 write(out,"nl",1,<:op operation retur fra vt:>);
10 8484 skriv_op(out,op_ref);
10 8485 end;
9 8486 <*-2*>
9 8487 <*+4*> if indeks<>op_ref then
9 8488 fejlreaktion(11<*fremmed post*>,op_ref,
9 8489 <:op kommando(spring):>,0);
9 8490 <*-4*>
9 8491
9 8491 <*V*> setposition(z_op(nr),0,0);
9 8492 cursor(z_op(nr),24,1);
9 8493 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8494 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8495 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8496 end;
8 8497
8 8497 begin
9 8498 \f
9 8498 message procedure operatør side 20 - 810525/cl;
9 8499
9 8499 <* 7 spring(-oversigts-)rapport *>
9 8500
9 8500 d.op_ref.retur:=cs_operatør(nr);
9 8501 tofrom(d.op_ref.data,ia,4);
9 8502 indeks:=op_ref;
9 8503 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8504 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8505 <*+2*> disable if testbit10 and overvåget then
9 8506 begin
10 8507 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8508 skriv_op(out,op_ref);
10 8509 end;
9 8510 <*-2*>
9 8511
9 8511 <*+4*> if op_ref<>indeks then
9 8512 fejlreaktion(11<*fremmed post*>,op_ref,
9 8513 <:op kommando(spring-rapport):>,0);
9 8514 <*-4*>
9 8515
9 8515 <*V*> setposition(z_op(nr),0,0);
9 8516 if d.op_ref.resultat<>3 then
9 8517 begin
10 8518 cursor(z_op(nr),24,1);
10 8519 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8520 end
9 8521 else
9 8522 begin
10 8523 boolean p_skrevet;
10 8524 integer bogst,løb;
10 8525
10 8525 skærmmåde:= 1;
10 8526
10 8526 if kode = 32 then <* spring,vis *>
10 8527 begin
11 8528 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8529 bogst:= d.op_ref.data(1) extract 5;
11 8530 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8531 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8532 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8533 <:spring: :>,
11 8534 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8535 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8536 raf:= data+8;
11 8537 if d.op_ref.raf(1)<>0.0 then
11 8538 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8539 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8540 else write(z_op(nr),<:, ikke startet:>);
11 8541 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8542 \f
11 8542 message procedure operatør side 21 - 810522/cl;
11 8543
11 8543 p_skrevet:= false;
11 8544 for pos:=1 step 1 until d.op_ref.data(3) do
11 8545 begin
12 8546 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8547 if i<>0 then
12 8548 fejlreaktion(5<*læsfil*>,i,
12 8549 <:op kommando(spring,vis):>,0);
12 8550 iaf:=0;
12 8551 i:= fil(j).iaf(1);
12 8552 if i < 0 and -, p_skrevet then
12 8553 begin
13 8554 outchar(z_op(nr),'('); p_skrevet:= true;
13 8555 end;
12 8556 if i > 0 and p_skrevet then
12 8557 begin
13 8558 outchar(z_op(nr),')'); p_skrevet:= false;
13 8559 end;
12 8560 if pos mod 2 = 0 then
12 8561 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8562 else
12 8563 write(z_op(nr),true,3,<<d>,abs i);
12 8564 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8565 end;
11 8566 write(z_op(nr),"*",1);
11 8567 \f
11 8567 message procedure operatør side 22 - 810522/cl;
11 8568
11 8568 end
10 8569 else if kode=33 then <* spring,oversigt *>
10 8570 begin
11 8571 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8572 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8573 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8574
11 8574 for pos:=1 step 1 until d.op_ref.data(1) do
11 8575 begin
12 8576 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8577 if i<>0 then
12 8578 fejlreaktion(5<*læsfil*>,i,
12 8579 <:op kommando(spring-oversigt):>,0);
12 8580 iaf:=0;
12 8581 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8582 bogst:=fil(j).iaf(1) extract 5;
12 8583 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8584 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8585 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8586 string (extend fil(j).iaf(2) shift 24));
12 8587 if fil(j,2)<>0.0 then
12 8588 write(z_op(nr),<:startet :>,<<zddddd>,
12 8589 round systime(4,fil(j,2),r),<:.:>,round r);
12 8590 outchar(z_op(nr),'nl');
12 8591 end;
11 8592 write(z_op(nr),"*",1);
11 8593 end;
10 8594 <* slet fil *>
10 8595 d.op_ref.opkode:= 104;
10 8596 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8597 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8598 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8599 end; <* resultat=3 *>
9 8600
9 8600 end;
8 8601
8 8601 begin
9 8602 \f
9 8602 message procedure operatør side 23 - 940522/cl;
9 8603
9 8603
9 8603 <* 8 SLUT *>
9 8604 trapmode:= 1 shift 13;
9 8605 trap(-2);
9 8606 end;
8 8607
8 8607 begin
9 8608 <* 9 stopniveauer,definer *>
9 8609 integer fno;
9 8610
9 8610 for i:= 1 step 1 until 3 do
9 8611 operatør_stop(nr,i):= ia(i+1);
9 8612 i:= modif_fil(tf_stoptabel,nr,fno);
9 8613 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8614 iaf:=0;
9 8615 for i:= 0,1,2,3 do
9 8616 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8617 setposition(fil(fno),0,0);
9 8618 setposition(z_op(nr),0,0);
9 8619 cursor(z_op(nr),24,1);
9 8620 skriv_kvittering(z_op(nr),0,-1,3);
9 8621 end;
8 8622
8 8622 begin
9 8623 \f
9 8623 message procedure operatør side 24 - 940522/cl;
9 8624
9 8624 <* 10 stopniveauer,vis *>
9 8625 integer bpl,j,k;
9 8626
9 8626 skærm_måde:= 1;
9 8627 setposition(z_op(nr),0,0);
9 8628 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8629 <:stopniveauer: :>);
9 8630 for i:= 0 step 1 until 3 do
9 8631 begin
10 8632 bpl:= operatør_stop(nr,i);
10 8633 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8634 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8635 end;
9 8636 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8637 j:=0;
9 8638 for bpl:= 1 step 1 until max_antal_operatører 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",18);
10 8643 iaf:= bpl*terminal_beskr_længde;
10 8644 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8645 true,6,string bpl_navn(bpl));
10 8646 j:=j+1;
10 8647 end;
9 8648 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8649 j:=0;
9 8650 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8651 if bpl_navn(bpl)<>long<::> then
9 8652 begin
10 8653 if j mod 8 = 0 and j > 0 then
10 8654 write(z_op(nr),"nl",1,"sp",19);
10 8655 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8656 j:=j+1;
10 8657 end;
9 8658 write(z_op(nr),"nl",1,"*",1);
9 8659 end;
8 8660
8 8660 begin
9 8661 <* 11 alarmlængde *>
9 8662 integer fno;
9 8663
9 8663 if indeks > 0 then
9 8664 begin
10 8665 opk_alarm.tab.alarm_lgd:= ia(1);
10 8666 i:= modiffil(tf_alarmlgd,nr,fno);
10 8667 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8668 iaf:= 0;
10 8669 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8670 setposition(fil(fno),0,0);
10 8671 end;
9 8672
9 8672 setposition(z_op(nr),0,0);
9 8673 cursor(z_op(nr),24,1);
9 8674 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8675 end;
8 8676
8 8676 begin
9 8677 <* 12 CC *>
9 8678 integer i, c;
9 8679
9 8679 i:= 1;
9 8680 while læstegn(ia,i+0,c)<>0 and
9 8681 i<(op_spool_postlgd-op_spool_text)//2*3
9 8682 do skrivtegn(d.opref.data,i,c);
9 8683 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8684
9 8684 d.opref.retur:= cs_operatør(nr);
9 8685 signalch(cs_op_spool,opref,op_optype);
9 8686 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8687
9 8687 setposition(z_op(nr),0,0);
9 8688 cursor(z_op(nr),24,1);
9 8689 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8690 end;
8 8691
8 8691 <* 13 EXkluder skærmen *>
8 8692 begin
9 8693 d.opref.resultat:= 2;
9 8694 setposition(z_op(nr),0,0);
9 8695 cursor(z_op(nr),24,1);
9 8696 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8697
9 8697 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8698 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8699 d.vt_op.data(1):= nr;
9 8700 signalch(cs_rad,vt_op,gen_optype);
9 8701 end;
8 8702
8 8702 begin
9 8703 <* 14 CQF-tabel,vis *>
9 8704
9 8704 skærm_måde:= 1;
9 8705 setposition(z_op(nr),0,0);
9 8706 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8707 "esc" add 128,1,<:ÆJ:>);
9 8708 skriv_cqf_tabel(z_op(nr),false);
9 8709 write(z_op(nr),"*",1);
9 8710 end;
8 8711
8 8711 begin
9 8712 <* 15 ALarmlyd,Test *>
9 8713 integer array field tab;
9 8714 integer res;
9 8715
9 8715 tab:= (nr-1)*opk_alarm_tab_lgd;
9 8716 setposition(z_op(nr),0,0);
9 8717 if ia(1)<1 or ia(1)>2 then
9 8718 res:= 64 <* ulovligt tal *>
9 8719 else if opk_alarm.tab.alarm_lgd = 0 then
9 8720 begin
10 8721 if ia(1)=2 then
10 8722 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
10 8723 else
10 8724 write(z_op(nr),"bel",1);
10 8725 res:= 3;
10 8726 end
9 8727 else if ia(1) > opk_alarm.tab.alarm_tilst and
9 8728 ia(1) > opk_alarm.tab.alarm_kmdo then
9 8729 begin
10 8730 opk_alarm.tab.alarm_kmdo:= ia(1);
10 8731 signal_bin(bs_opk_alarm);
10 8732 res:= 3;
10 8733 end
9 8734 else
9 8735 res:= 48; <* i brug *>
9 8736
9 8736 cursor(z_op(nr),24,1);
9 8737 skriv_kvittering(z_op(nr),opref,-1,res);
9 8738 end;
8 8739
8 8739 begin
9 8740 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8741 setposition(z_op(nr),0,0);
9 8742 cursor(z_op(nr),24,1);
9 8743 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8744 end;
8 8745 \f
8 8745 message procedure operatør side x - 810522/hko;
8 8746
8 8746 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8747 <*-4*>
8 8748 end;<*case j *>
7 8749 end <* j > 0 *>
6 8750 else
6 8751 begin
7 8752 <*V*> setposition(z_op(nr),0,0);
7 8753 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8754 skriv_kvittering(z_op(nr),op_ref,-1,
7 8755 45 <*ikke implementeret *>);
7 8756 end;
6 8757 end;<* godkendt *>
5 8758
5 8758 <*V*> setposition(z_op(nr),0,0);
5 8759 <*???*>
5 8760 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8761 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8762 skærmmåde = 0 do
5 8763 begin
6 8764 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8765 begin
7 8766 skriv_skærm_bvs(nr);
7 8767 <*940920 if op_talevej(nr)=0 then status:= 0
7 8768 else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8769 if status>0 then
7 8770 begin
7 8771 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8772 terminaltab.ref(ll):= 0;
7 8773 skriv_skærm_bvs(nr);
7 8774 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8775 end;
7 8776 for i:= 1 step 1 until max_antal_kanaler do
7 8777 begin
7 8778 iaf:= (i-1)*kanalbeskrlængde;
7 8779 inspect(ss_samtale_nedlagt(i),status);
7 8780 if status>0 and
7 8781 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8782 begin
7 8783 kanaltab.iaf.kanal_tilstand:=
7 8784 kanaltab.iaf(1) shift (-10) extract 6 shift 10;
7 8785 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8786 kanaltab.iaf(ll):= 0;
7 8787 skriv_skærm_kanal(nr,i);
7 8788 repeat
7 8789 wait(ss_samtale_nedlagt(i));
7 8790 inspect(ss_samtale_nedlagt(i),status);
7 8791 until status=0;
7 8792 end;
7 8793 end;
7 8794 940920*> cursor(z_op(nr),1,1);
7 8795 setposition(z_op(nr),0,0);
7 8796 end;
6 8797 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8798 and skærmmåde = 0
6 8799 and læsbit_ia(operatørmaske,nr) then
6 8800 begin
7 8801 if sætbit_ia(opkaldsflag,nr,0) = 1 then
7 8802 skriv_skærm_opkaldskø(nr);
7 8803 if sætbit_ia(kanalflag,nr,0) = 1 then
7 8804 begin
8 8805 for i:= 1 step 1 until max_antal_kanaler do
8 8806 skriv_skærm_kanal(nr,i);
8 8807 end;
7 8808 cursor(z_op(nr),1,1);
7 8809 <*V*> setposition(z_op(nr),0,0);
7 8810 end;
6 8811 end;
5 8812 d.op_ref.retur:=cs_att_pulje;
5 8813 disable afslut_kommando(op_ref);
5 8814 end; <* indlæs kommando *>
4 8815
4 8815 begin
5 8816 \f
5 8816 message procedure operatør side x+1 - 810617/hko;
5 8817
5 8817 <* 2: inkluder *>
5 8818 integer k,n;
5 8819 integer array field msk,iaf1;
5 8820
5 8820 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8821 if i=0 then
5 8822 begin
6 8823 fejlreaktion(3<*programfejl*>,nr,
6 8824 <:operatør(nr) eksisterer ikke:>,1);
6 8825 d.op_ref.resultat:=28;
6 8826 end
5 8827 else
5 8828 begin
6 8829 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8830 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8831 else if d.op_ref.opkode = 0 then 0
6 8832 else 3;<*udført*>
6 8833 if i > 0 then
6 8834 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8835 <:operatørskærm reservation:>,1)
6 8836 else
6 8837 begin
7 8838 i:=terminal_tab.ref.terminal_tilstand;
7 8839 <*940418/cl inkluderet sættes i stop - start *>
7 8840 kode:= d.opref.opkode extract 12;
7 8841 if kode <> 0 then
7 8842 terminal_tab.ref.terminal_tilstand:=
7 8843 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8844 else
7 8845 <*940418/cl inkluderet sættes i stop - slut *>
7 8846 terminal_tab.ref.terminal_tilstand:= i extract
7 8847 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8848 for i:= 1 step 1 until max_antal_kanaler do
7 8849 begin
8 8850 iaf:= (i-1)*kanalbeskrlængde;
8 8851 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8852 end;
7 8853 skærm_måde:= 0;
7 8854 sætbit_ia(operatørmaske,nr,
7 8855 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8856 then 0 else 1));
7 8857 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8858 begin
8 8859 msk:= k*op_maske_lgd;
8 8860 if læsbit_ia(bpl_def.msk,nr) then
8 8861 <**> begin
9 8862 n:= 0;
9 8863 for i:= 1 step 1 until max_antal_operatører do
9 8864 if læsbit_ia(bpl_def.msk,i) then
9 8865 begin
10 8866 iaf1:= i*terminal_beskr_længde;
10 8867 if terminal_tab.iaf1.terminal_tilstand
10 8868 shift (-21) < 3 then
10 8869 n:= n+1;
10 8870 end;
9 8871 bpl_tilst(k,1):= n;
9 8872 end;
8 8873 <**> <*
8 8874 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8875 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8876 *> end;
7 8877 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8878 sætbit_ia(opkaldsflag,nr,0);
7 8879 signal_bin(bs_mobil_opkald);
7 8880 <*940418/cl inkluderet sættes i stop - start *>
7 8881 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8882 <*V*> ht_symbol(z_op(nr))
7 8883 else
7 8884 <*940418/cl inkluderet sættes i stop - slut *>
7 8885 <*V*> skriv_skærm(nr);
7 8886 cursor(z_op(nr),24,1);
7 8887 <*V*> setposition(z_op(nr),0,0);
7 8888 end;
6 8889 end;
5 8890 if d.op_ref.opkode = 0 then
5 8891 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8892 else
5 8893 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8894 end;
4 8895
4 8895 begin
5 8896 \f
5 8896 message procedure operatør side x+2 - 820304/hko;
5 8897
5 8897 <* 3: ekskluder *>
5 8898 integer k,n;
5 8899 integer array field iaf1,msk;
5 8900
5 8900 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8901 <*V*> setposition(z_op(nr),0,0);
5 8902 monitor(10) release process:(z_op(nr),0,ia);
5 8903 d.op_ref.resultat:=3;
5 8904 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8905 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8906 terminal_tab.ref.terminal_tilstand extract 21;
5 8907 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8908 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8909 begin
6 8910 msk:= k*op_maske_lgd;
6 8911 if læsbit_ia(bpl_def.msk,nr) then
6 8912 <**> begin
7 8913 n:= 0;
7 8914 for i:= 1 step 1 until max_antal_operatører do
7 8915 if læsbit_ia(bpl_def.msk,i) then
7 8916 begin
8 8917 iaf1:= i*terminal_beskr_længde;
8 8918 if terminal_tab.iaf1.terminal_tilstand
8 8919 shift (-21) < 3 then
8 8920 n:= n+1;
8 8921 end;
7 8922 bpl_tilst(k,1):= n;
7 8923 end;
6 8924 <**> <*
6 8925 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8926 *> end;
5 8927 signal_bin(bs_mobil_opkald);
5 8928 if opk_alarm.tab.alarm_tilst > 0 then
5 8929 begin
6 8930 opk_alarm.tab.alarm_kmdo:= 3;
6 8931 signal_bin(bs_opk_alarm);
6 8932 end;
5 8933 end;
4 8934 begin
5 8935
5 8935 <* 4: opdater skærm *>
5 8936
5 8936 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8937 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8938 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8939 skærmmåde=0 do
5 8940 begin
6 8941
6 8941 <*+2*> if testbit13 and overvåget then
6 8942 disable begin
7 8943 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8944 <:) opkaldsflag::>,"nl",1);
7 8945 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8946 write(out,<: operatørmaske::>,"nl",1);
7 8947 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8948 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8949 ud;
7 8950 end;
6 8951 <*-2*>
6 8952 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8953 begin
7 8954 skriv_skærm_bvs(nr);
7 8955 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8956 if status>0 then
7 8957 begin
7 8958 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8959 terminaltab.ref(ll):= 0;
7 8960 skriv_skærm_bvs(nr);
7 8961 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8962 end;
7 8963 for i:= 1 step 1 until max_antal_kanaler do
7 8964 begin
7 8965 iaf:= (i-1)*kanalbeskrlængde;
7 8966 inspect(ss_samtale_nedlagt(i),status);
7 8967 if status>0 and
7 8968 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8969 begin
7 8970 kanaltab.iaf.kanal_tilstand:=
7 8971 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8972 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8973 kanaltab.iaf(ll):= 0;
7 8974 skriv_skærm_kanal(nr,i);
7 8975 repeat
7 8976 wait(ss_samtale_nedlagt(i));
7 8977 inspect(ss_samtale_nedlagt(i),status);
7 8978 until status=0;
7 8979 end;
7 8980 end;
7 8981 940920*> cursor(z_op(nr),1,1);
7 8982 setposition(z_op(nr),0,0);
7 8983 end;
6 8984 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8985 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8986 begin
7 8987 <*V*> setposition(z_op(nr),0,0);
7 8988 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 8989 skriv_skærm_opkaldskø(nr);
7 8990 if sætbit_ia(kanalflag,nr,0) =1 then
7 8991 begin
8 8992 for i:=1 step 1 until max_antal_kanaler do
8 8993 skriv_skærm_kanal(nr,i);
8 8994 end;
7 8995 cursor(z_op(nr),1,1);
7 8996 <*V*> setposition(z_op(nr),0,0);
7 8997 end;
6 8998 end;
5 8999 end;
4 9000 begin
5 9001 \f
5 9001 message procedure operatør side x+3 - 830310/hko;
5 9002
5 9002 <* 5: samtale etableret *>
5 9003
5 9003 res:= d.op_ref.resultat;
5 9004 b_v:= d.op_ref.data(3) extract 4;
5 9005 b_s:= d.op_ref.data(4);
5 9006 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9007 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 9008 begin
6 9009 sætbit_i(terminal_tab.ref(1),21,1);
6 9010 sætbit_i(terminal_tab.ref(1),22,0);
6 9011 sætbit_i(terminal_tab.ref(1),2,0);
6 9012 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9013 terminal_tab.ref(2):= b_s;
6 9014 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 9015 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 9016 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 9017 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 9018
6 9018 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9019 begin
7 9020 <*V*> setposition(z_op(nr),0,0);
7 9021 skriv_skærm_b_v_s(nr);
7 9022 <*V*> setposition(z_op(nr),0,0);
7 9023 end;
6 9024 end
5 9025 else
5 9026 if terminal_tab.ref(1) shift(-21) = 2 then
5 9027 begin
6 9028 sætbit_i(terminal_tab.ref(1),22,0);
6 9029 sætbit_i(terminal_tab.ref(1),2,0);
6 9030 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9031 terminal_tab.ref(2):= 0;
6 9032 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9033 begin
7 9034 <*V*> setposition(z_op(nr),0,0);
7 9035 cursor(z_op(nr),21,17);
7 9036 write(z_op(nr),<:EJ FORB:>);
7 9037 <*V*> setposition(z_op(nr),0,0);
7 9038 end;
6 9039 end
5 9040 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 9041 <:terminal tilstand:>,1);
5 9042 end;
4 9043
4 9043 begin
5 9044 \f
5 9044 message procedure operatør side x+4 - 810602/hko;
5 9045
5 9045 <* 6: radiokanal ekskluderet *>
5 9046
5 9046 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 9047 pos:= d.op_ref.data(1);
5 9048 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9049 indeks:= terminal_tab.ref(2);
5 9050 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 9051 then indeks extract 4 else 0;
5 9052 if b_v = pos then
5 9053 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 9054 if b_s = pos then
5 9055 begin
6 9056 terminal_tab.ref(2):= 0;
6 9057 sætbit_i(terminal_tab.ref(1),21,0);
6 9058 sætbit_i(terminal_tab.ref(1),22,0);
6 9059 sætbit_i(terminal_tab.ref(1),2,0);
6 9060 end;
5 9061 if skærmmåde=0 then
5 9062 begin
6 9063 if b_v = pos or b_s = pos then
6 9064 <*V*> skriv_skærm_b_v_s(nr);
6 9065 <*V*> skriv_skærm_kanal(nr,pos);
6 9066 cursor(z_op(nr),1,1);
6 9067 setposition(z_op(nr),0,0);
6 9068 end;
5 9069 end;
4 9070
4 9070 begin
5 9071 \f
5 9071 message procedure operatør side x+5 - 950118/cl;
5 9072
5 9072 <* 7: operatørmeddelelse *>
5 9073 integer afs, kl, i;
5 9074 real dato, t;
5 9075
5 9075 cursor(z_op(nr),24,1);
5 9076 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9077 cursor(z_op(nr),23,1);
5 9078 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9079
5 9079 afs:= d.opref.data.op_spool_kilde;
5 9080 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 9081 kl:= round t;
5 9082 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 9083 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 9084 i:= replacechar(1,'.');
5 9085 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 9086 replacechar(1,i);
5 9087 write(z_op(nr),d.opref.data.op_spool_text);
5 9088
5 9088 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 9089 begin
6 9090 if opk_alarm.tab.alarm_lgd > 0 and
6 9091 opk_alarm.tab.alarm_tilst < 1 and
6 9092 opk_alarm.tab.alarm_kmdo < 1
6 9093 then
6 9094 begin
7 9095 opk_alarm.tab.alarm_kmdo := 1;
7 9096 signalbin(bs_opk_alarm);
7 9097 end
6 9098 else
6 9099 if opk_alarm.tab.alarm_lgd = 0 then
6 9100 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 9101 end;
5 9102
5 9102 setposition(z_op(nr),0,0);
5 9103
5 9103 signalch(d.opref.retur,opref,d.opref.optype);
5 9104 end;
4 9105
4 9105 begin
5 9106
5 9106 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 9107 <*-4*>
5 9108 end
4 9109 end; <* case aktion+6 *>
3 9110
3 9110 until false;
3 9111 op_trap:
3 9112 skriv_operatør(zbillede,1);
3 9113 end operatør;
2 9114
2 9114 \f
2 9114 message procedure op_cqftest side 1;
2 9115
2 9115 procedure op_cqftest;
2 9116 begin
3 9117 integer array field opref, ref, ref1;
3 9118 integer i, j, tv, cqf, res, pausetid;
3 9119 real nu, næstetid, kommstart, kommslut;
3 9120
3 9120 procedure skriv_op_cqftest(zud,omfang);
3 9121 value omfang;
3 9122 zone zud;
3 9123 integer omfang;
3 9124 begin
4 9125 write(zud,"nl",1,<:+++ op-cqftest:>);
4 9126 if omfang > 0 then
4 9127 disable begin
5 9128 real t;
5 9129
5 9129 trap(slut);
5 9130 write(zud,"nl",1,
5 9131 <: opref: :>,opref,"nl",1,
5 9132 <: ref: :>,ref,"nl",1,
5 9133 <: i: :>,i,"nl",1,
5 9134 <: tv: :>,tv,"nl",1,
5 9135 <: cqf: :>,cqf,"nl",1,
5 9136 <: res: :>,res,"nl",1,
5 9137 <: pausetid: :>,pausetid,"nl",1,
5 9138 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 9139 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 9140 <::>);
5 9141 skriv_coru(zud,coru_no(292));
5 9142 slut:
5 9143 end;
4 9144 end skriv_op_cqftest;
3 9145
3 9145 trap(op_cqf_trap);
3 9146 stackclaim(1000);
3 9147
3 9147
3 9147 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9148 skriv_op_cqftest(out,0);
3 9149 <*-4*>
3 9150
3 9150 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 9151 repeat
3 9152 i:= sidste_tv_brugt; tv:= 0;
3 9153 repeat
3 9154 i:= (i mod max_antal_taleveje) + 1;
3 9155 if tv_operatør(i) = 0 then tv:= i;
3 9156 until (tv<>0) or (i=sidste_tv_brugt);
3 9157
3 9157 if tv<>0 then
3 9158 begin
4 9159 tv_operatør(tv):= -1;
4 9160 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 9161 for cqf:= 1 step 1 until max_cqf do
4 9162 begin
5 9163 ref:= (cqf-1)*cqf_lgd;
5 9164 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 9165 begin
6 9166 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 9167 d.opref.data(1):= tv;
6 9168 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 9169 disable if testbit19 then
6 9170 begin
7 9171 integer i; <*lav en trap-bar blok*>
7 9172
7 9172 trap(test19_trap);
7 9173 systime(1,0,kommstart);
7 9174 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 9175 skriv_id(zrl,d.opref.data(2),0);
7 9176 test19_trap: outchar(zrl,'nl');
7 9177 end;
6 9178 signalch(cs_rad,opref,op_optype or gen_optype);
6 9179 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 9180 res:= d.opref.resultat;
6 9181 <*+2*>
6 9182 disable if testbit19 then
6 9183 begin
7 9184 integer i; <*lav en trap-bar blok*>
7 9185
7 9185 trap(test19_trap);
7 9186 systime(1,0,kommslut);
7 9187 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 9188 if d.opref.data(7)=2 then outchar(zrl,'*');
7 9189 if d.opref.data(9)<>0 then
7 9190 begin
8 9191 skriv_id(zrl,d.opref.data(9),0);
8 9192 outchar(zrl,' ');
8 9193 end;
7 9194 if d.opref.data(8)<>0 then
7 9195 begin
8 9196 skriv_id(zrl,d.opref.data(8),0);
8 9197 outchar(zrl,' ');
8 9198 end;
7 9199 if d.opref.data(12)<>0 then
7 9200 begin
8 9201 if d.opref.data(12) shift (-20) = 15 then
8 9202 write(zrl,<:OMR*:>)
8 9203 else
8 9204 if d.opref.data(12) shift (-20) = 14 then
8 9205 write(zrl,
8 9206 string områdenavn(d.opref.data(12) extract 20))
8 9207 else
8 9208 skriv_id(zrl,d.opref.data(12),0);
8 9209 outchar(zrl,' ');
8 9210 end;
7 9211 if d.opref.data(10)<>0 then
7 9212 begin
8 9213 skriv_id(zrl,d.opref.data(10),0);
8 9214 outchar(zrl,' ');
8 9215 end;
7 9216 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 9217 <<dd.dd>,kommslut-kommstart);
7 9218 test19_trap: outchar(zrl,'nl');
7 9219 end;
6 9220 <*-2*>
6 9221 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 9222 begin
7 9223 delay(3);
7 9224 d.opref.opkode:= 12 shift 12 + 41;
7 9225 d.opref.resultat:= 0;
7 9226 disable if testbit19 then
7 9227 begin
8 9228 integer i; <*lav en trap-bar blok*>
8 9229
8 9229 trap(test19_trap);
8 9230 systime(1,0,kommstart);
8 9231 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 9232 test19_trap: outchar(zrl,'nl');
8 9233 end;
7 9234 signalch(cs_rad,opref,op_optype or gen_optype);
7 9235 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 9236 <*+2*>
7 9237 disable if testbit19 then
7 9238 begin
8 9239 integer i; <*lav en trap-bar blok*>
8 9240
8 9240 trap(test19_trap);
8 9241 systime(1,0,kommslut);
8 9242 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 9243 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 9244 <<dd.dd>,kommslut-kommstart);
8 9245 test19_trap: outchar(zrl,'nl');
8 9246 end;
7 9247 <*-2*>
7 9248 if d.opref.resultat <> 3 then
7 9249 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 9250 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 9251 begin
8 9252 startoperation(opref,292,cs_cqf,23);
8 9253 i:= 1;
8 9254 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9255 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9256 skriv_tegn(d.opref.data,i,' ');
8 9257 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9258 hægtstring(d.opref.data,i,<: ok!:>);
8 9259 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9260 signalch(cs_io,opref,gen_optype);
8 9261 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9262 end;
7 9263 if cqf_tabel.ref.cqf_bus > 0 then
7 9264 begin
8 9265 cqf_tabel.ref.cqf_fejl:= 0;
8 9266 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 9267 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 9268 end;
7 9269 end <*res=3*>
6 9270 else
6 9271 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 9272 cqf_tabel.ref.cqf_bus > 0
6 9273 then
6 9274 begin
7 9275 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 9276 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 9277 if cqf_tabel.ref.cqf_fejl >= 2 then
7 9278 begin
8 9279 startoperation(opref,292,cs_cqf,23);
8 9280 i:= 1;
8 9281 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9282 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9283 skriv_tegn(d.opref.data,i,' ');
8 9284 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9285 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 9286 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9287 signalch(cs_io,opref,gen_optype);
8 9288 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9289 end;
7 9290 end;
6 9291 delay(10);
6 9292 end;
5 9293 if cqf_tabel.ref.cqf_bus > 0 and
5 9294 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 9295 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 9296 end; <*for cqf*>
4 9297
4 9297 tv_operatør(tv):= 0; tv:= 0;
4 9298 if op_cqf_tab_ændret then
4 9299 begin
5 9300 j:= skrivfil(1033,1,i);
5 9301 if j<>0 then
5 9302 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 9303 sorter_cqftab(1,max_cqf);
5 9304 for cqf:= 1 step 1 until max_cqf do
5 9305 begin
6 9306 ref:= (cqf-1)*cqf_lgd;
6 9307 ref1:= (cqf-1)*cqf_id;
6 9308 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 9309 end;
5 9310 op_cqf_tab_ændret:= false;
5 9311 end;
4 9312 end; <*tv*>
3 9313
3 9313 systime(1,0.0,nu);
3 9314 pausetid:= round(næste_tid - nu);
3 9315 if pausetid < 30 then pausetid:= 30;
3 9316
3 9316 <*V*> delay(pausetid);
3 9317
3 9317 until false;
3 9318
3 9318 op_cqf_trap:
3 9319 disable skriv_op_cqftest(zbillede,1);
3 9320 end op_cqftest;
2 9321 \f
2 9321 message procedure op_spool side 1;
2 9322
2 9322 procedure op_spool;
2 9323 begin
3 9324 integer array field opref, ref;
3 9325 integer næste_tomme, i;
3 9326
3 9326 procedure skriv_op_spool(zud,omfang);
3 9327 value omfang;
3 9328 zone zud;
3 9329 integer omfang;
3 9330 begin
4 9331 write(zud,"nl",1,<:+++ op-spool:>);
4 9332 if omfang > 0 then
4 9333 disable begin
5 9334 real t;
5 9335
5 9335 trap(slut);
5 9336 write(zud,"nl",1,
5 9337 <: opref: :>,opref,"nl",1,
5 9338 <: næste-tomme: :>,næste_tomme,"nl",1,
5 9339 <: ref: :>,ref,"nl",1,
5 9340 <: i: :>,i,"nl",1,
5 9341 <::>);
5 9342 skriv_coru(zud,coru_no(293));
5 9343 slut:
5 9344 end;
4 9345 end skriv_op_spool;
3 9346
3 9346 trap(op_spool_trap);
3 9347 stackclaim(400);
3 9348
3 9348 næste_tomme:= 0;
3 9349
3 9349 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9350 skriv_op_spool(out,0);
3 9351 <*-4*>
3 9352
3 9352 repeat
3 9353 <*V*> waitch(cs_op_spool,opref,true,-1);
3 9354 inspect(ss_op_spool_tomme,i);
3 9355
3 9355 if d.opref.opkode extract 12 <> 37 then
3 9356 begin
4 9357 d.opref.resultat:= 31;
4 9358 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 9359 end
3 9360 else
3 9361 if i<=0 then
3 9362 d.opref.resultat:= 32 <*ingen fri plads*>
3 9363 else
3 9364 begin
4 9365 <*V*> wait(ss_op_spool_tomme);
4 9366 ref:= næste_tomme*op_spool_postlgd;
4 9367 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9368 i:= d.opref.opsize - data;
4 9369 if i > (op_spool_postlgd - op_spool_text) then
4 9370 i:= (op_spool_postlgd - op_spool_text);
4 9371 op_spool_buf.ref.op_spool_kilde:=
4 9372 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9373 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9374 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9375 op_spool_buf.ref(op_spool_postlgd//2):=
4 9376 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9377 d.opref.resultat:= 3;
4 9378
4 9378 signal(ss_op_spool_fulde);
4 9379 end;
3 9380
3 9380 signalch(d.opref.retur,opref,d.opref.optype);
3 9381 until false;
3 9382
3 9382 op_spool_trap:
3 9383 disable skriv_op_spool(zbillede,1);
3 9384 end op_spool;
2 9385 \f
2 9385 message procedure op_medd side 1;
2 9386
2 9386 procedure op_medd;
2 9387 begin
3 9388 integer array field opref, ref;
3 9389 integer næste_fulde, i;
3 9390
3 9390 procedure skriv_op_medd(zud,omfang);
3 9391 value omfang;
3 9392 zone zud;
3 9393 integer omfang;
3 9394 begin
4 9395 write(zud,"nl",1,<:+++ op-medd:>);
4 9396 if omfang > 0 then
4 9397 disable begin
5 9398 real t;
5 9399
5 9399 trap(slut);
5 9400 write(zud,"nl",1,
5 9401 <: opref: :>,opref,"nl",1,
5 9402 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9403 <: ref: :>,ref,"nl",1,
5 9404 <: i: :>,i,"nl",1,
5 9405 <::>);
5 9406 skriv_coru(zud,coru_no(294));
5 9407 slut:
5 9408 end;
4 9409 end skriv_op_medd;
3 9410
3 9410 trap(op_medd_trap);
3 9411 næste_fulde:= 0;
3 9412 stackclaim(400);
3 9413
3 9413 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9414 skriv_op_medd(out,0);
3 9415 <*-4*>
3 9416
3 9416 repeat
3 9417 <*V*> wait(ss_op_spool_fulde);
3 9418 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9419
3 9419 ref:= næste_fulde*op_spool_postlgd;
3 9420 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9421
3 9421 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9422 d.opref.resultat:= 0;
3 9423 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9424 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9425 opref,gen_optype);
3 9426 signal(ss_op_spool_tomme);
3 9427 until false;
3 9428
3 9428 op_medd_trap:
3 9429 disable skriv_op_medd(zbillede,1);
3 9430 end op_medd;
2 9431 \f
2 9431 message procedure alarmur side 1;
2 9432
2 9432 procedure alarmur;
2 9433 begin
3 9434 integer ventetid, nr;
3 9435 integer array field opref, tab;
3 9436 real nu;
3 9437
3 9437 procedure skriv_alarmur(zud,omfang);
3 9438 value omfang;
3 9439 zone zud;
3 9440 integer omfang;
3 9441 begin
4 9442 write(zud,"nl",1,<:+++ alarmur:>);
4 9443 if omfang > 0 then
4 9444 disable begin
5 9445 real t;
5 9446
5 9446 trap(slut);
5 9447 write(zud,"nl",1,
5 9448 <: ventetid: :>,ventetid,"nl",1,
5 9449 <: nr: :>,nr,"nl",1,
5 9450 <: opref: :>,opref,"nl",1,
5 9451 <: tab: :>,tab,"nl",1,
5 9452 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9453 <::>);
5 9454 skriv_coru(zud,coru_no(295));
5 9455 slut:
5 9456 end;
4 9457 end skriv_alarmur;
3 9458
3 9458 trap(alarmur_trap);
3 9459 stackclaim(400);
3 9460
3 9460 systime(1,0.0,nu);
3 9461 ventetid:= -1;
3 9462 repeat
3 9463 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9464 if opref > 0 then
3 9465 signalch(d.opref.retur,opref,op_optype);
3 9466
3 9466 ventetid:= -1;
3 9467 systime(1,0.0,nu);
3 9468 for nr:= 1 step 1 until max_antal_operatører do
3 9469 begin
4 9470 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9471 if opk_alarm.tab.alarm_tilst > 0 and
4 9472 opk_alarm.tab.alarm_lgd >= 0 then
4 9473 begin
5 9474 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9475 begin
6 9476 opk_alarm.tab.alarm_kmdo:= 3;
6 9477 signalbin(bs_opk_alarm);
6 9478 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9479 end
5 9480 else
5 9481 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9482 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9483 end;
4 9484 end;
3 9485 if ventetid=0 then ventetid:= 1;
3 9486 until false;
3 9487
3 9487 alarmur_trap:
3 9488 disable skriv_alarmur(zbillede,1);
3 9489 end alarmur;
2 9490 \f
2 9490 message procedure opkaldsalarmer side 1;
2 9491
2 9491 procedure opkaldsalarmer;
2 9492 begin
3 9493 integer nr, ny_kommando, tilst, aktion, tt;
3 9494 integer array field tab, opref, alarmop;
3 9495
3 9495 procedure skriv_opkaldsalarmer(zud,omfang);
3 9496 value omfang;
3 9497 zone zud;
3 9498 integer omfang;
3 9499 begin
4 9500 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9501 if omfang>0 then
4 9502 disable begin
5 9503 real array field raf;
5 9504 trap(slut);
5 9505 raf:=0;
5 9506 write(zud,"nl",1,
5 9507 <: nr: :>,nr,"nl",1,
5 9508 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9509 <: tilst: :>,tilst,"nl",1,
5 9510 <: aktion: :>,aktion,"nl",1,
5 9511 <: tt: :>,false add tt,1,"nl",1,
5 9512 <: tab: :>,tab,"nl",1,
5 9513 <: opref: :>,opref,"nl",1,
5 9514 <: alarmop: :>,alarmop,"nl",1,
5 9515 <::>);
5 9516 skriv_coru(zud,coru_no(296));
5 9517 slut:
5 9518 end;
4 9519 end skriv_opkaldsalarmer;
3 9520
3 9520 trap(opk_alarm_trap);
3 9521 stackclaim(400);
3 9522
3 9522 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9523 skriv_opkaldsalarmer(out,0);
3 9524 <*-2*>
3 9525
3 9525 repeat
3 9526 wait(bs_opk_alarm);
3 9527 alarmop:= 0;
3 9528 for nr:= 1 step 1 until max_antal_operatører do
3 9529 begin
4 9530 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9531 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9532 tilst:= opk_alarm.tab.alarm_tilst;
4 9533 aktion:= case ny_kommando+1 of (
4 9534 <*ingenting*> case tilst+1 of (4,4,4),
4 9535 <*normal *> case tilst+1 of (1,4,4),
4 9536 <*nød *> case tilst+1 of (2,2,4),
4 9537 <*sluk *> case tilst+1 of (4,3,3));
4 9538 tt:= case aktion of ('B','C','F','-');
4 9539 if tt<>'-' then
4 9540 begin
5 9541 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9542 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9543 d.opref.data(1):= nr+16;
5 9544 signalch(cs_talevejsswitch,opref,op_optype);
5 9545 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9546 if d.opref.resultat = 3 then
5 9547 begin
6 9548 opk_alarm.tab.alarm_kmdo:= 0;
6 9549 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9550 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9551 if aktion < 3 then
6 9552 begin
7 9553 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9554 if alarmop = 0 then
7 9555 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9556 end;
6 9557 end;
5 9558 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9559 end;
4 9560 end;
3 9561 if alarmop<>0 then
3 9562 begin
4 9563 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9564 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9565 end;
3 9566 until false;
3 9567
3 9567 opk_alarm_trap:
3 9568 disable skriv_opkaldsalarmer(zbillede,1);
3 9569 end;
2 9570
2 9570 \f
2 9570 message procedure tvswitch_input side 1 - 940810/cl;
2 9571
2 9571 procedure tv_switch_input;
2 9572 begin
3 9573 integer array field opref;
3 9574 integer tt,ant;
3 9575 boolean ok;
3 9576 integer array ia(1:128);
3 9577
3 9577 procedure skriv_tvswitch_input(zud,omfang);
3 9578 value omfang;
3 9579 zone zud;
3 9580 integer omfang;
3 9581 begin
4 9582 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9583 if omfang>0 then
4 9584 disable begin
5 9585 real array field raf;
5 9586 trap(slut);
5 9587 raf:=0;
5 9588 write(zud,"nl",1,
5 9589 <: opref: :>,opref,"nl",1,
5 9590 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9591 <: ant: :>,ant,"nl",1,
5 9592 <: tt: :>,tt,"nl",1,
5 9593 <::>);
5 9594 write(zud,"nl",1,<:ia: :>);
5 9595 skrivhele(zud,ia.raf,256,2);
5 9596 skriv_coru(zud,coru_no(297));
5 9597 slut:
5 9598 end;
4 9599 end skriv_tvswitch_input;
3 9600 \f
3 9600 boolean procedure læs_tlgr;
3 9601 begin
4 9602 integer kl,ch,i,pos,p;
4 9603 long field lf;
4 9604 boolean ok;
4 9605
4 9605 integer procedure readch(z,c);
4 9606 zone z; integer c;
4 9607 begin
5 9608 readch:= readchar(z,c);
5 9609 <*+2*> if testbit15 and overvåget then
5 9610 disable begin
6 9611 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9612 else write(zrl,"<",1,<<d>,c,">",1);
6 9613 if c='em' then write(zrl,<: *timeout*:>);
6 9614 end;
5 9615 <*-2*>
5 9616 end;
4 9617
4 9617 ok:= false; tt:=' ';
4 9618 repeat
4 9619 readchar(z_tv_in,ch);
4 9620 until ch<>'em';
4 9621 repeatchar(z_tv_in);
4 9622
4 9622 <*+2*>if testbit15 and overvåget then
4 9623 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9624 <*-2*>
4 9625
4 9625 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9626 if ch='%' then
4 9627 begin
5 9628 ant:= 0; pos:= 1; lf:= 4;
5 9629 ok:= true;
5 9630 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9631
5 9631 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9632 skrivtegn(ia,pos,ch);
5 9633
5 9633 p:=pos;
5 9634 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9635
5 9635 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9636 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9637 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9638
5 9638 if ok and ch=' ' then
5 9639 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9640
5 9640 while kl = 2 do
5 9641 begin
6 9642 i:= ch - '0';
6 9643 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9644 if ant < 128 then
6 9645 begin
7 9646 ant:= ant+1;
7 9647 ia(ant):= i;
7 9648 end
6 9649 else
6 9650 ok:= false;
6 9651 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9652 end;
5 9653 if ch<>'nl' then ok:= false;
5 9654 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9655 <* !! setposition(z_tv_in,0,0); !! *>
5 9656 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9657 <*-2*>
5 9658
5 9658 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9659 ok:= ok
5 9660 else if tt='C' or tt='N' or
5 9661 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9662 ok:= ok and ant=1
5 9663 else if tt='X' or tt='Y' then
5 9664 ok:= ok and ant=2
5 9665 else if tt='T' or tt='W' then
5 9666 ok:= ok and ant=64
5 9667 else if tt='R' then
5 9668 ok:= ok and ant extract 1 = 0
5 9669 else
5 9670 begin
6 9671 ok:= false;
6 9672 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9673 end;
5 9674
5 9674 end; <* if ch='%' *>
4 9675 læs_tlgr:= ok;
4 9676 end læs_tlgr;
3 9677 \f
3 9677 trap(tvswitch_input_trap);
3 9678 stackclaim(400);
3 9679 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9680
3 9680 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9681 skriv_tvswitch_input(out,0);
3 9682 <*-2*>
3 9683
3 9683 repeat
3 9684 ok:= læs_tlgr;
3 9685 if ok then
3 9686 begin
4 9687 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9688 start_operation(opref,297,cs_tvswitch_input,0);
4 9689 d.opref.resultat:= tt shift 12 + ant;
4 9690 tofrom(d.opref.data,ia,ant*2);
4 9691 signalch(cs_talevejsswitch,opref,op_optype);
4 9692 end;
3 9693 until false;
3 9694
3 9694 tvswitch_input_trap:
3 9695
3 9695 disable skriv_tvswitch_input(zbillede,1);
3 9696
3 9696 end tvswitch_input;
2 9697 \f
2 9697 message procedure tv_switch_adm side 1 - 940502/cl;
2 9698
2 9698 procedure tv_switch_adm;
2 9699 begin
3 9700 integer array field opref;
3 9701 integer rc;
3 9702
3 9702 procedure skriv_tv_switch_adm(zud,omfang);
3 9703 value omfang;
3 9704 zone zud;
3 9705 integer omfang;
3 9706 begin
4 9707 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9708 if omfang>0 then
4 9709 disable begin
5 9710 trap(slut);
5 9711 write(zud,"nl",1,
5 9712 <: opref: :>,opref,"nl",1,
5 9713 <: rc: :>,rc,"nl",1,
5 9714 <::>);
5 9715 skriv_coru(zud,coru_no(298));
5 9716 slut:
5 9717 end;
4 9718 end skriv_tv_switch_adm;
3 9719
3 9719 trap(tv_switch_adm_trap);
3 9720 stackclaim(400);
3 9721
3 9721 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9722 disable skriv_tv_switch_adm(out,0);
3 9723 <*-2*>
3 9724
3 9724
3 9724
3 9724 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9725 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9726 *>
3 9727
3 9727 repeat
3 9728 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9729 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9730 rc:= 0;
3 9731 repeat
3 9732 signalch(cs_talevejsswitch,opref,op_optype);
3 9733 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9734 rc:= rc+1;
3 9735 until rc=3 or d.opref.resultat=3;
3 9736
3 9736 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9737
3 9737 <*V*> delay(15*60);
3 9738 until false;
3 9739 tv_switch_adm_trap:
3 9740 disable skriv_tv_switch_adm(zbillede,1);
3 9741 end;
2 9742 \f
2 9742 message procedure talevejsswitch side 1 -940426/cl;
2 9743
2 9743 procedure talevejsswitch;
2 9744 begin
3 9745 integer tt, ant, ventetid;
3 9746 integer array field opref, gemt_op, tab;
3 9747 boolean ok;
3 9748 integer array ia(1:128);
3 9749
3 9749 procedure skriv_talevejsswitch(zud,omfang);
3 9750 value omfang;
3 9751 zone zud;
3 9752 integer omfang;
3 9753 begin
4 9754 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9755 if omfang>0 then
4 9756 disable begin
5 9757 real array field raf;
5 9758 trap(slut);
5 9759 raf:= 0;
5 9760 write(zud,"nl",1,
5 9761 <: tt: :>,tt,"nl",1,
5 9762 <: ant: :>,ant,"nl",1,
5 9763 <: ventetid: :>,ventetid,"nl",1,
5 9764 <: opref: :>,opref,"nl",1,
5 9765 <: gemt-op: :>,gemt_op,"nl",1,
5 9766 <: tab: :>,tab,"nl",1,
5 9767 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9768 <::>);
5 9769 write(zud,"nl",1,<:ia: :>);
5 9770 skriv_hele(zud,ia.raf,256,2);
5 9771 skriv_coru(zud,coru_no(299));
5 9772 slut:
5 9773 end;
4 9774 end skriv_talevejsswitch;
3 9775 \f
3 9775 trap(tvswitch_trap);
3 9776 stackclaim(400);
3 9777 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9778
3 9778 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9779 skriv_talevejsswitch(out,0);
3 9780 <*-2*>
3 9781
3 9781 ventetid:= -1; ant:= 0; tt:= ' ';
3 9782 repeat
3 9783 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9784 if opref > 0 then
3 9785 begin
4 9786 if d.opref.opkode extract 12 = 0 then
4 9787 begin <*input fra talevejsswitchen *>
5 9788 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9789 tt:= d.opref.resultat shift (-12) extract 12;
5 9790 ant:= d.opref.resultat extract 12;
5 9791 tofrom(ia,d.opref.data,ant*2);
5 9792 signalch(d.opref.retur,opref,d.opref.optype);
5 9793
5 9793 if tt<>'+' and tt<>'-' then
5 9794 begin
6 9795 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9796 setposition(z_tv_out,0,0);
6 9797 <*+2*> if testbit15 and overvåget then
6 9798 disable begin
7 9799 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9800 outchar(zrl,'nl');
7 9801 end;
6 9802 <*-2*>
6 9803 end;
5 9804 if (tt='+' or tt='-') and gemt_op<>0 then
5 9805 begin
6 9806 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9807 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9808 gemt_op:= 0;
6 9809 ventetid:= -1;
6 9810 end
5 9811 else
5 9812 if tt='R' then
5 9813 begin
6 9814 for i:= 1 step 2 until ant do
6 9815 begin
7 9816 if ia(i) <= max_antal_taleveje and
7 9817 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9818 then
7 9819 begin
8 9820 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9821 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9822 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9823 op_talevej(tv_operatør(ia(i))):= 0;
8 9824 tv_operatør(ia(i)):= ia(i+1)-16;
8 9825 op_talevej(ia(i+1)-16):= ia(i);
8 9826 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9827 end
7 9828 else
7 9829 if ia(i+1) <= max_antal_taleveje and
7 9830 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9831 then
7 9832 begin
8 9833 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9834 tv_operatør(op_talevej(ia(i))):= 0;
8 9835 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9836 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9837 tv_operatør(ia(i+1)):= ia(i)-16;
8 9838 op_talevej(ia(i)-16):= ia(i+1);
8 9839 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9840 end;
7 9841 end;
6 9842 signal_bin(bs_mobil_opkald);
6 9843 <*+2*> if testbit15 and testbit16 and overvåget then
6 9844 disable begin
7 9845 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9846 end;
6 9847 <*-2*>
6 9848 end <* tt='R' and ant>0 *>
5 9849 else
5 9850 if tt='Y' then
5 9851 begin
6 9852 if ia(1) <= max_antal_taleveje and
6 9853 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9854 then
6 9855 begin
7 9856 if tv_operatør(ia(1))=ia(2)-16 and
7 9857 op_talevej(ia(2)-16)=ia(1)
7 9858 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9859 end
6 9860 else
6 9861 if ia(2) <= max_antal_taleveje and
6 9862 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9863 then
6 9864 begin
7 9865 if tv_operatør(ia(2))=ia(1)-16 and
7 9866 op_talevej(ia(1)-16)=ia(2)
7 9867 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9868 end;
6 9869 end
5 9870 else
5 9871 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9872 begin
6 9873 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9874 startoperation(opref,299,cs_op_iomedd,23);
6 9875 ant:= 1;
6 9876 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9877 anbringtal(d.opref.data,ant,ia(1),2);
6 9878 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9879 begin
7 9880 hægtstring(d.opref.data,ant,<: (:>);
7 9881 if bpl_navn(ia(1)-16)=long<::> then
7 9882 begin
8 9883 hægtstring(d.opref.data,ant,<:op:>);
8 9884 anbringtal(d.opref.data,ant,ia(1)-16,
8 9885 if ia(1)-16 > 9 then 2 else 1);
8 9886 end
7 9887 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9888 skrivtegn(d.opref.data,ant,')');
7 9889 end;
6 9890 hægtstring(d.opref.data,ant,
6 9891 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9892 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9893 if tt='P' then <: Tilgængelig:> else
6 9894 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9895 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9896 signalch(cs_io,opref,gen_optype);
6 9897 end
5 9898 else
5 9899 if tt='Z' then
5 9900 begin
6 9901 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9902 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9903 end
5 9904 else
5 9905 begin
6 9906 <* ikke implementeret *>
6 9907 end;
5 9908 end
4 9909 else
4 9910 if d.opref.opkode extract 12 = 44 then
4 9911 begin
5 9912 tt:= d.opref.opkode shift (-12);
5 9913 ok:= true;
5 9914 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' 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 outchar(zrl,'nl');
7 9920 end;
6 9921 <*-2*>
6 9922 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9923 setposition(z_tv_out,0,0);
6 9924 end
5 9925 else
5 9926 if tt='B' or tt='C' or tt='F' then
5 9927 begin
6 9928 <*+2*> if testbit15 and overvåget then
6 9929 disable begin
7 9930 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9931 " ",1,<<d>,d.opref.data(1));
7 9932 outchar(zrl,'nl');
7 9933 end;
6 9934 <*-2*>
6 9935 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9936 d.opref.data(1),"cr",1);
6 9937 setposition(z_tv_out,0,0);
6 9938 end
5 9939 else
5 9940 if tt='A' or tt='D' or tt='T' then
5 9941 begin
6 9942 <*+2*> if testbit15 and overvåget then
6 9943 disable begin
7 9944 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9945 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9946 outchar(zrl,'nl');
7 9947 end;
6 9948 <*-2*>
6 9949 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9950 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9951 setposition(z_tv_out,0,0);
6 9952 end
5 9953 else
5 9954 ok:= false;
5 9955 if ok then
5 9956 begin
6 9957 gemt_op:= opref;
6 9958 ventetid:= 2;
6 9959 end
5 9960 else
5 9961 begin
6 9962 d.opref.resultat:= 4;
6 9963 signalch(d.opref.retur,opref,d.opref.optype);
6 9964 end;
5 9965 end;
4 9966 end
3 9967 else
3 9968 if gemt_op<>0 then
3 9969 begin <*timeout*>
4 9970 d.gemt_op.resultat:= 0;
4 9971 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9972 gemt_op:= 0;
4 9973 ventetid:= -1;
4 9974 <*+2*> if testbit15 and overvåget then
4 9975 disable begin
5 9976 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9977 outchar(zrl,'nl');
5 9978 end;
4 9979 <*-2*>
4 9980 end;
3 9981 until false;
3 9982 tvswitch_trap:
3 9983 disable skriv_talevejsswitch(zbillede,1);
3 9984 end talevejsswitch;
2 9985
2 9985 \f
2 9985 message garage_erklæringer side 1 - 810415/hko;
2 9986
2 9986 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 9987
2 9987 procedure gar_fejl(z,s,b);
2 9988 integer s,b;
2 9989 zone z;
2 9990 begin
3 9991 disable begin
4 9992 integer array iz(1:20);
4 9993 integer i,j,k;
4 9994 integer array field iaf;
4 9995 real array field raf;
4 9996
4 9996 getzone6(z,iz);
4 9997 iaf:=raf:=2;
4 9998 getnumber(iz.raf,7,j);
4 9999
4 9999 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 10000 k:=1;
4 10001
4 10001 j:= terminal_tab.iaf.terminal_tilstand;
4 10002 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 10003 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 10004 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 10005 if s <> (1 shift 21 +2) then
4 10006 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 10007 + terminal_tab.iaf.terminal_tilstand extract 21;
4 10008 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 10009 begin
5 10010 z(1):=real <:<'?'><'em'>:>;
5 10011 b:=2;
5 10012 end;
4 10013 end; <*disable*>
3 10014 end gar_fejl;
2 10015
2 10015 integer cs_gar;
2 10016 integer array cs_garage(1:max_antal_garageterminaler);
2 10017 \f
2 10017 message procedure h_garage side 1 - 810520/hko;
2 10018
2 10018 <* hovedmodulkorutine for garageterminaler *>
2 10019 procedure h_garage;
2 10020 begin
3 10021 integer array field op_ref;
3 10022 integer k,dest_sem;
3 10023 procedure skriv_hgarage(zud,omfang);
3 10024 value omfang;
3 10025 zone zud;
3 10026 integer omfang;
3 10027 begin integer i;
4 10028
4 10028 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 10029 write(zud,"sp",26-i);
4 10030 if omfang>0 then
4 10031 disable begin
5 10032 integer x;
5 10033 trap(slut);
5 10034 write(zud,"nl",1,
5 10035 <: op_ref: :>,op_ref,"nl",1,
5 10036 <: k: :>,k,"nl",1,
5 10037 <: dest_sem: :>,dest_sem,"nl",1,
5 10038 <::>);
5 10039 skriv_coru(zud,coru_no(300));
5 10040 slut:
5 10041 end;
4 10042 end skriv_hgarage;
3 10043
3 10043 trap(hgar_trap);
3 10044 stack_claim(if cm_test then 198 else 146);
3 10045
3 10045 <*+2*>
3 10046 if testbit16 and overvåget or testbit28 then
3 10047 skriv_hgarage(out,0);
3 10048 <*-2*>
3 10049 \f
3 10049 message procedure h_garage side 2 - 811105/hko;
3 10050
3 10050 repeat
3 10051 wait_ch(cs_gar,op_ref,true,-1);
3 10052 <*+4*>
3 10053 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 10054 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 10055 <*-4*>
3 10056
3 10056 k:=d.op_ref.opkode extract 12;
3 10057 dest_sem:=
3 10058 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 10059 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 10060 else -1;
3 10061 <*+4*>
3 10062 if dest_sem=-1 then
3 10063 begin
4 10064 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 10065 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10066 end
3 10067 else
3 10068 <*-4*>
3 10069 if k=7<*inkluder*> then
3 10070 begin
4 10071 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 10072 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 10073 begin
5 10074 d.op_ref.resultat:=3;
5 10075 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 10076 dest_sem:=-2;
5 10077 end;
4 10078 end
3 10079 else
3 10080 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 10081 begin
4 10082 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 10083 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 10084 +terminal_tab.iaf.terminal_tilstand extract 21;
4 10085 end;
3 10086 if dest_sem>0 then
3 10087 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 10088 until false;
3 10089
3 10089 hgar_trap:
3 10090 disable skriv_hgarage(zbillede,1);
3 10091 end h_garage;
2 10092 \f
2 10092 message procedure garage side 1 - 830310/cl;
2 10093
2 10093 procedure garage(nr);
2 10094 value nr;
2 10095 integer nr;
2 10096 begin
3 10097 integer array field op_ref,ref;
3 10098 integer i,kode,aktion,status,opgave,retur_sem,
3 10099 pos,indeks,sep,sluttegn,vogn,ll;
3 10100
3 10100 procedure skriv_garage(zud,omfang);
3 10101 value omfang;
3 10102 zone zud;
3 10103 integer omfang;
3 10104 begin integer i;
4 10105
4 10105 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 10106 write(zud,"sp",26-i);
4 10107 if omfang > 0 then
4 10108 disable begin integer x;
5 10109 trap(slut);
5 10110 write(zud,"nl",1,
5 10111 <: op-ref: :>,op_ref,"nl",1,
5 10112 <: kode: :>,kode,"nl",1,
5 10113 <: ref: :>,ref,"nl",1,
5 10114 <: i: :>,i,"nl",1,
5 10115 <: aktion: :>,aktion,"nl",1,
5 10116 <: retur-sem: :>,retur_sem,"nl",1,
5 10117 <: vogn: :>,vogn,"nl",1,
5 10118 <: ll: :>,ll,"nl",1,
5 10119 <: status: :>,status,"nl",1,
5 10120 <: opgave: :>,opgave,"nl",1,
5 10121 <: pos: :>,pos,"nl",1,
5 10122 <: indeks: :>,indeks,"nl",1,
5 10123 <: sep: :>,sep,"nl",1,
5 10124 <: sluttegn: :>,sluttegn,"nl",1,
5 10125 <::>);
5 10126 skriv_coru(zud,coru_no(300+nr));
5 10127 slut:
5 10128 end;
4 10129 end skriv_garage;
3 10130 \f
3 10130 message procedure garage side 2 - 830310/hko;
3 10131
3 10131 trap(gar_trap);
3 10132 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 10133
3 10133 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 10134
3 10134 <*+2*>
3 10135 if testbit16 and overvåget or testbit28 then
3 10136 skriv_garage(out,0);
3 10137 <*-2*>
3 10138
3 10138 <* attention simulering
3 10139 *>
3 10140 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 10141 begin
4 10142 wait_ch(cs_att_pulje,op_ref,true,-1);
4 10143 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 10144 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 10145 end;
3 10146 <*
3 10147 *>
3 10148 \f
3 10148 message procedure garage side 3 - 830310/hko;
3 10149
3 10149 repeat
3 10150
3 10150 <*V*> wait_ch(cs_garage(nr),
3 10151 op_ref,
3 10152 true,
3 10153 -1<*timeout*>);
3 10154 <*+2*>
3 10155 if testbit17 and overvåget then
3 10156 disable begin
4 10157 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 10158 <: til garage :>,nr);
4 10159 skriv_op(out,op_ref);
4 10160 end;
3 10161 <*-2*>
3 10162
3 10162 kode:= d.op_ref.op_kode;
3 10163 retur_sem:= d.op_ref.retur;
3 10164 i:= terminal_tab.ref.terminal_tilstand;
3 10165 status:= i shift(-21);
3 10166 opgave:=
3 10167 if kode=0 then 1 <* indlæs kommando *> else
3 10168 if kode=7 then 2 <* inkluder *> else
3 10169 if kode=8 then 3 <* ekskluder *> else
3 10170 0; <* afvises *>
3 10171
3 10171 aktion:= case status +1 of(
3 10172 <* status *> <* opgave: 0 1 2 3 *>
3 10173 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 10174 <* 1 - *>(-1),<* ulovlig tilstand *>
3 10175 <* 2 - *>(-1),<* ulovlig tilstand *>
3 10176 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 10177 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 10178 <* 5 - *>(-1),<* ulovlig tilstand *>
3 10179 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 10180 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 10181 -1);
3 10182 \f
3 10182 message procedure garage side 4 - 810424/hko;
3 10183
3 10183 case aktion+6 of
3 10184 begin
4 10185 begin
5 10186 <*-5: terminal optaget *>
5 10187
5 10187 d.op_ref.resultat:= 16;
5 10188 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10189 end;
4 10190
4 10190 begin
5 10191 <*-4: operation uden virkning *>
5 10192
5 10192 afslut_operation(op_ref,-1);
5 10193 end;
4 10194
4 10194 begin
5 10195 <*-3: ulovlig operationskode *>
5 10196
5 10196 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 10197 afslut_operation(op_ref,-1);
5 10198 end;
4 10199
4 10199 begin
5 10200 <*-2: ulovligt garageterminal_nr *>
5 10201
5 10201 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 10202 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10203 end;
4 10204
4 10204 begin
5 10205 <*-1: ulovlig operatørtilstand *>
5 10206
5 10206 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 10207 afslut_operation(op_ref,-1);
5 10208 end;
4 10209
4 10209 begin
5 10210 <* 0: ikke implementeret *>
5 10211
5 10211 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 10212 afslut_operation(op_ref,-1);
5 10213 end;
4 10214
4 10214 begin
5 10215 \f
5 10215 message procedure garage side 5 - 851001/cl;
5 10216
5 10216 <* 1: indlæs kommando *>
5 10217
5 10217
5 10217 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 10218
5 10218 if d.op_ref.resultat > 3 then
5 10219 begin
6 10220 <*V*> setposition(z_gar(nr),0,0);
6 10221 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 10222 skriv_kvittering(z_gar(nr),op_ref,pos,
6 10223 d.op_ref.resultat);
6 10224 end
5 10225 else if d.op_ref.resultat>0 then
5 10226 begin <*godkendt*>
6 10227 kode:=d.op_ref.opkode;
6 10228 i:= kode extract 12;
6 10229 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 10230 else if kode=9 or kode=10 then 2
6 10231 else 0;
6 10232 if j > 0 then
6 10233 begin
7 10234 case j of
7 10235 begin
8 10236 begin
9 10237 \f
9 10237 message procedure garage side 6 - 851001/cl;
9 10238
9 10238 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 10239 integer vogn,ll;
9 10240 integer array field vtop;
9 10241
9 10241 vogn:=ia(1);
9 10242 ll:=ia(2);
9 10243 <*V*> wait_ch(cs_vt_adgang,
9 10244 vt_op,
9 10245 gen_optype,
9 10246 -1<*timeout sek*>);
9 10247 start_operation(vtop,300+nr,cs_garage(nr),
9 10248 kode);
9 10249 d.vt_op.data(1):=vogn;
9 10250 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 10251 indeks:= vt_op;
9 10252 signal_ch(cs_vt,
9 10253 vt_op,
9 10254 gen_optype or gar_optype);
9 10255
9 10255 <*V*> wait_ch(cs_garage(nr),
9 10256 vt_op,
9 10257 gar_optype,
9 10258 -1<*timeout sek*>);
9 10259 <*+2*> if testbit18 and overvåget then
9 10260 disable begin
10 10261 write(out,"nl",1,<:garage :>,<<d>,nr,
10 10262 <:: operation retur fra vt:>);
10 10263 skriv_op(out,vt_op);
10 10264 end;
9 10265 <*-2*>
9 10266 <*+4*> if vt_op<>indeks then
9 10267 fejl_reaktion(11<*fremmede op*>,op_ref,
9 10268 <:garage-kommando:>,0);
9 10269 <*-4*>
9 10270 <*V*> setposition(z_gar(nr),0,0);
9 10271 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 10272 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 10273 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 10274 else vt_op,-1,d.vt_op.resultat);
9 10275 d.vt_op.optype:=gen_optype or vtoptype;
9 10276 disable afslut_operation(vt_op,cs_vt_adgang);
9 10277 end;
8 10278
8 10278 begin
9 10279 \f
9 10279 message procedure garage side 6a - 830310/cl;
9 10280
9 10280 <* 2 vogntabel,linienr/-,busnr *>
9 10281
9 10281 d.op_ref.retur:= cs_garage(nr);
9 10282 tofrom(d.op_ref.data,ia,10);
9 10283 indeks:= op_ref;
9 10284 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 10285 wait_ch(cs_garage(nr),
9 10286 op_ref,
9 10287 gar_optype,
9 10288 -1<*timeout*>);
9 10289 <*+2*> if testbit18 and overvåget then
9 10290 disable begin
10 10291 write(out,"nl",1,<:garage operation retur fra vt:>);
10 10292 skriv_op(out,op_ref);
10 10293 end;
9 10294 <*-2*>
9 10295 <*+4*>
9 10296 if indeks <> op_ref then
9 10297 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 10298 <*-4*>
9 10299 i:= d.op_ref.resultat;
9 10300 if i = 0 or i > 3 then
9 10301 begin
10 10302 <*V*> setposition(z_gar(nr),0,0);
10 10303 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 10304 end
9 10305 else
9 10306 begin
10 10307 integer antal,fil_ref;
10 10308 antal:= d.op_ref.data(6);
10 10309 fil_ref:= d.op_ref.data(7);
10 10310 <*V*> setposition(z_gar(nr),0,0);
10 10311 write(z_gar(nr),"*",24,"sp",6,
10 10312 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 10313 <*V*> setposition(z_gar(nr),0,0);
10 10314 \f
10 10314 message procedure garage side 6c - 841213/cl;
10 10315
10 10315 pos:= 1;
10 10316 while pos <= antal do
10 10317 begin
11 10318 integer bogst,løb;
11 10319
11 10319 disable i:= læs_fil(fil_ref,pos,j);
11 10320 if i <> 0 then
11 10321 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 10322 else
11 10323 begin
12 10324 vogn:= fil(j,1) shift (-24) extract 24;
12 10325 løb:= fil(j,1) extract 24;
12 10326 if d.op_ref.opkode=9 then
12 10327 begin i:=vogn; vogn:=løb; løb:=i; end;
12 10328 ll:= løb shift (-12) extract 10;
12 10329 bogst:= løb shift (-7) extract 5;
12 10330 if bogst > 0 then bogst:= bogst +'A'-1;
12 10331 løb:= løb extract 7;
12 10332 vogn:= vogn extract 14;
12 10333 i:= d.op_ref.opkode-8;
12 10334 for i:= i,i+1 do
12 10335 begin
13 10336 j:= (i+1) extract 1;
13 10337 case j +1 of
13 10338 begin
14 10339 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 10340 false add bogst,1,"/",1,<<d__>,løb);
14 10341 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 10342 end;
13 10343 end;
12 10344 if pos mod 5 = 0 then
12 10345 begin
13 10346 write(z_gar(nr),"nl",1);
13 10347 <*V*> setposition(z_gar(nr),0,0);
13 10348 end
12 10349 else write(z_gar(nr),"sp",3);
12 10350 end;
11 10351 pos:=pos+1;
11 10352 end;
10 10353 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 10354 \f
10 10354 message procedure garage side 6d- 830310/cl;
10 10355
10 10355 d.opref.opkode:=104; <*slet-fil*>
10 10356 d.op_ref.data(4):=filref;
10 10357 indeks:=op_ref;
10 10358 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 10359 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 10360
10 10360 <*+2*> if testbit18 and overvåget then
10 10361 disable begin
11 10362 write(out,"nl",1,<:garage, slet-fil retur:>);
11 10363 skriv_op(out,op_ref);
11 10364 end;
10 10365 <*-2*>
10 10366
10 10366 <*+4*> if op_ref<>indeks then
10 10367 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10368 <*-4*>
10 10369 if d.op_ref.data(9)<>0 then
10 10370 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10371 <:garage, slet_fil:>,1);
10 10372 end;
9 10373 \f
9 10373 message procedure garage side 7 -810424/hko;
9 10374
9 10374 end;
8 10375
8 10375 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10376 <*-4*>
8 10377 end;<*case j *>
7 10378 end <* j > 0 *>
6 10379 else
6 10380 begin
7 10381 <*V*> setposition(z_gar(nr),0,0);
7 10382 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10383 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10384 4 <*kommando ukendt *>);
7 10385 end;
6 10386 end;<* godkendt *>
5 10387
5 10387 <*V*> setposition(z_gar(nr),0,0);
5 10388
5 10388 d.op_ref.opkode:=0; <*telex*>
5 10389
5 10389 disable afslut_operation(op_ref,cs_gar);
5 10390 end; <* indlæs kommando *>
4 10391
4 10391 begin
5 10392 \f
5 10392 message procedure garage side 8 - 841213/cl;
5 10393
5 10393 <* 2: inkluder *>
5 10394
5 10394 d.op_ref.resultat:=3;
5 10395 afslut_operation(op_ref,-1);
5 10396 monitor(8)reserve:(z_gar(nr),0,ia);
5 10397 terminal_tab.ref.terminal_tilstand:=
5 10398 terminal_tab.ref.terminal_tilstand extract 21;
5 10399 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10400 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10401 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10402 end;
4 10403
4 10403 begin
5 10404
5 10404 <* 3: ekskluder *>
5 10405 d.op_ref.resultat:= 3;
5 10406 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10407 terminal_tab.ref.terminal_tilstand extract 21;
5 10408 monitor(10)release:(z_gar(nr),0,ia);
5 10409 afslut_operation(op_ref,-1);
5 10410
5 10410 end;
4 10411
4 10411 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10412 <*-4*>
4 10413 end; <* case aktion+6 *>
3 10414
3 10414 until false;
3 10415 gar_trap:
3 10416 skriv_garage(zbillede,1);
3 10417 end garage;
2 10418
2 10418 \f
2 10418 message procedure radio_erklæringer side 1 - 820304/hko;
2 10419
2 10419 zone z_fr_in(14,1,rad_in_fejl),
2 10420 z_rf_in(14,1,rad_in_fejl),
2 10421 z_fr_out(14,1,rad_out_fejl),
2 10422 z_rf_out(14,1,rad_out_fejl);
2 10423
2 10423 integer array
2 10424 radiofejl,
2 10425 ss_samtale_nedlagt,
2 10426 ss_radio_aktiver(1:max_antal_kanaler),
2 10427 bs_talevej_udkoblet,
2 10428 cs_radio(1:max_antal_taleveje),
2 10429 radio_linietabel(1:max_linienr//3+1),
2 10430 radio_områdetabel(0:max_antal_områder),
2 10431 opkaldskø(opkaldskø_postlængde//2+1:
2 10432 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10433 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10434 hookoff_maske(1:(tv_maske_lgd//2)),
2 10435 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10436
2 10436 integer field
2 10437 kanal_tilstand,
2 10438 kanal_id1,
2 10439 kanal_id2,
2 10440 kanal_spec,
2 10441 kanal_alt_id1,
2 10442 kanal_alt_id2;
2 10443 integer array field
2 10444 kanal_mon_maske,
2 10445 kanal_alarm,
2 10446 opkald_meldt;
2 10447
2 10447 integer
2 10448 cs_rad,
2 10449 cs_radio_medd,
2 10450 cs_radio_adm,
2 10451 cs_radio_ind,
2 10452 cs_radio_ud,
2 10453 cs_radio_pulje,
2 10454 cs_radio_kø,
2 10455 bs_mobil_opkald,
2 10456 bs_opkaldskø_adgang,
2 10457 opkaldskø_ledige,
2 10458 nødopkald_brugt,
2 10459 første_frie_opkald,
2 10460 første_opkald,
2 10461 sidste_opkald,
2 10462 første_nødopkald,
2 10463 sidste_nødopkald,
2 10464 optaget_flag;
2 10465
2 10465 boolean
2 10466 mobil_opkald_aktiveret;
2 10467 \f
2 10467 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10468
2 10468 integer
2 10469 procedure læs_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:=((i-1)*6-linie)*4;
3 10477 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10478 end læs_hex_ciffer;
2 10479
2 10479 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10480
2 10480 integer
2 10481 procedure sæt_hex_ciffer(tabel,linie,op);
2 10482 value linie;
2 10483 integer array tabel;
2 10484 integer linie,op;
2 10485 begin
3 10486 integer i,j;
3 10487
3 10487 i:=(if linie>=0 then linie+6 else linie)//6;
3 10488 j:=(linie-(i-1)*6)*4;
3 10489 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10490 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10491 shift j add (tabel(i) extract j);
3 10492 end sæt_hex_ciffer;
2 10493
2 10493 message procedure hex_to_dec side 1 - 900108/cl;
2 10494
2 10494 integer procedure hex_to_dec(hex);
2 10495 value hex;
2 10496 integer hex;
2 10497 begin
3 10498 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10499 else (hex-'0');
3 10500 end;
2 10501
2 10501 message procedure dec_to_hex side 1 - 900108/cl;
2 10502
2 10502 integer procedure dec_to_hex(dec);
2 10503 value dec;
2 10504 integer dec;
2 10505 begin
3 10506 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10507 else ('A'+dec-10);
3 10508 end;
2 10509
2 10509 message procedure rad_out_fejl side 1 - 820304/hko;
2 10510
2 10510 procedure rad_out_fejl(z,s,b);
2 10511 value s;
2 10512 zone z;
2 10513 integer s,b;
2 10514 begin
3 10515 integer array field iaf;
3 10516 integer pos,tegn,max,i;
3 10517 integer array ia(1:20);
3 10518 long array field laf;
3 10519
3 10519 disable begin
4 10520 laf:= iaf:= 2;
4 10521 tegn:= 1;
4 10522 getzone6(z,ia);
4 10523 max:= ia(16)//2*3;
4 10524 if s = 1 shift 21 + 2 then
4 10525 begin
5 10526 z(1):= real<:<'em'>:>;
5 10527 b:= 2;
5 10528 end
4 10529 else
4 10530 begin
5 10531 pos:= 0;
5 10532 for i:= 1 step 1 until max_antal_kanaler do
5 10533 begin
6 10534 iaf:= (i-1)*kanalbeskr_længde;
6 10535 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10536 if pos>0 then
6 10537 begin
7 10538 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10539 signalbin(bs_mobilopkald);
7 10540 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10541 1 shift 12<*binært*> +1<*fortsæt*>);
7 10542 end;
6 10543 end;
5 10544 end;
4 10545 end;
3 10546 end;
2 10547 \f
2 10547 message procedure rad_in_fejl side 1 - 810601/hko;
2 10548
2 10548 procedure rad_in_fejl(z,s,b);
2 10549 value s;
2 10550 zone z;
2 10551 integer s,b;
2 10552 begin
3 10553 integer array field iaf;
3 10554 integer pos,tegn,max,i;
3 10555 integer array ia(1:20);
3 10556 long array field laf;
3 10557
3 10557 disable begin
4 10558 laf:= iaf:= 2;
4 10559 i:= 1;
4 10560 getzone6(z,ia);
4 10561 max:= ia(16)//2*3;
4 10562 if s shift (-21) extract 1 = 0
4 10563 and s shift(-19) extract 1 = 0 then
4 10564 begin
5 10565 if b = 0 then
5 10566 begin
6 10567 z(1):= real<:!:>;
6 10568 b:= 2;
6 10569 end;
5 10570 end;
4 10571 \f
4 10571 message procedure rad_in_fejl side 2 - 820304/hko;
4 10572
4 10572 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10573 begin
5 10574 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10575 1 shift 12<*binær*> +1<*fortsæt*>);
5 10576 end
4 10577 else
4 10578 if s shift (-19) extract 1 = 1 then
4 10579 begin
5 10580 z(1):= real<:!<'nl'>:>;
5 10581 b:= 2;
5 10582 end
4 10583 else
4 10584 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10585 begin
5 10586 <*
5 10587 if b = 0 then
5 10588 begin
5 10589 *>
5 10590 z(1):= real <:<'em'>:>;
5 10591 b:= 2;
5 10592 <*
5 10593 end
5 10594 else
5 10595 begin
5 10596 tegn:= -1;
5 10597 iaf:= 0;
5 10598 pos:= b//2*3-2;
5 10599 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10600 skriv_tegn(z.iaf,pos,'?');
5 10601 if pos<=max then
5 10602 afslut_text(z.iaf,pos);
5 10603 b:= (pos-1)//3*2;
5 10604 end;
5 10605 *>
5 10606 end;<* s=1 shift 21+2 *>
4 10607 end;
3 10608 if testbit22 and
3 10609 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10610 then
3 10611 delay(60);
3 10612 end rad_in_fejl;
2 10613 \f
2 10613 message procedure afvent_radioinput side 1 - 880901/cl;
2 10614
2 10614 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10615 value rf;
2 10616 zone z_in;
2 10617 integer array tlgr;
2 10618 boolean rf;
2 10619 begin
3 10620 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10621 long array field laf;
3 10622
3 10622 laf:= 0;
3 10623 pos:= 1;
3 10624 repeat
3 10625 i:=readchar(z_in,tegn);
3 10626 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10627 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10628 p:=pos;
3 10629 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10630 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10631 (rf and testbit39)) then
3 10632 disable begin
4 10633 write(zrl,<<zd dd dd.dd >,now,
4 10634 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10635 if tegn='em' then <:*timeout*:> else
4 10636 if pos>=80 then <:*for langt*:> else <::>);
4 10637 outchar(zrl,'nl');
4 10638 end;
3 10639 <*-2*>
3 10640 ac:= -1;
3 10641 if pos >= 80 then
3 10642 begin <* telegram for langt *>
4 10643 repeat readchar(z_in,tegn)
4 10644 until tegn='nl' or tegn='em';
4 10645 end
3 10646 else
3 10647 if pos>1 and tegn='nl' then
3 10648 begin
4 10649 lgd:= 1;
4 10650 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10651 lgd:= lgd-2;
4 10652 if lgd >= 5 then
4 10653 begin
5 10654 lgd:= lgd-2; <* se bort fra checksum *>
5 10655 i:= lgd + 1;
5 10656 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10657 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10658 i:= lgd + 1;
5 10659 skrivtegn(tlgr,i,0);
5 10660 skrivtegn(tlgr,i,0);
5 10661 i:= 1; sum:= 0;
5 10662 while i <= lgd do
5 10663 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10664 if csum >= 0 and csum <> sum then
5 10665 begin
6 10666 <*+2*> if overvåget and (testbit36 or
6 10667 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10668 disable begin
7 10669 write(zrl,<<zd dd dd.dd >,now,
7 10670 (if rf then <:rf:> else <:fr:>),
7 10671 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10672 end;
6 10673 <*-2*>
6 10674 ac:= 6 <* checksumfejl *>
6 10675 end
5 10676 else
5 10677 ac:= 0;
5 10678 end
4 10679 else ac:= 6; <* for kort telegram - retransmitter *>
4 10680 end;
3 10681 afvent_radioinput:= ac;
3 10682 end;
2 10683 \f
2 10683 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10684
2 10684 procedure skriv_kanal_tab(z);
2 10685 zone z;
2 10686 begin
3 10687 integer array field ref;
3 10688 integer i,j,t,op,id1,id2;
3 10689
3 10689 write(z,"ff",1,"nl",1,<:
3 10690 ******** kanal-beskrivelser *******
3 10691
3 10691 a k l p m b n
3 10692 l a y a o s ø
3 10693 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10694 <*
3 10695 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10696 *>
3 10697 "nl",1);
3 10698 for i:=1 step 1 until max_antal_kanaler do
3 10699 begin
4 10700 ref:=(i-1)*kanal_beskr_længde;
4 10701 t:=kanal_tab.ref.kanal_tilstand;
4 10702 id1:=kanal_tab.ref.kanal_id1;
4 10703 id2:=kanal_tab.ref.kanal_id2;
4 10704 write(z,"nl",1,"sp",4,
4 10705 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10706 for j:=11 step -1 until 2 do
4 10707 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10708 write(z,case t extract 2 +1 of
4 10709 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10710 "sp",1);
4 10711 skriv_id(z,id1,9);
4 10712 skriv_id(z,id2,9);
4 10713 t:=kanal_tab.ref.kanal_spec;
4 10714 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10715 write(z,"nl",1,"sp",14,<:mon: :>);
4 10716 for j:= max_antal_taleveje step -1 until 1 do
4 10717 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10718 else "."),1);
4 10719 write(z,"sp",25-max_antal_taleveje);
4 10720 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10721 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10722 end;
3 10723 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10724 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10725 write(z,"nl",2);
3 10726 end skriv_kanal_tab;
2 10727 \f
2 10727 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10728
2 10728 procedure skriv_opkaldskø(z);
2 10729 zone z;
2 10730 begin
3 10731 integer i,bogst,løb,j;
3 10732 integer array field ref;
3 10733 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10734 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10735 <: sig omr :>,"nl",1);
3 10736 for i:= 1 step 1 until max_antal_mobilopkald do
3 10737 begin
4 10738 ref:= i*opkaldskø_postlængde;
4 10739 j:= opkaldskø.ref(1);
4 10740 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10741 j:= opkaldskø.ref(2);
4 10742 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10743 skriv_id(z,j extract 23,9);
4 10744 j:= opkaldskø.ref(3);
4 10745 skriv_id(z,j,7);
4 10746 j:= opkaldskø.ref(4);
4 10747 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10748 << zd>,j extract 8);
4 10749 j:= j shift (-8) extract 4;
4 10750 if j = 1 or j = 2 then
4 10751 write(z,if j=1 then <: normal:> else <: nød :>)
4 10752 else write(z,<<dddd>,j,"sp",3);
4 10753 j:= opkaldskø.ref(5);
4 10754 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10755 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10756 string område_navn(j extract 8) else <:---:>);
4 10757 outchar(z,'nl');
4 10758 end;
3 10759
3 10759 write(z,"nl",1,<<z>,
3 10760 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10761 <:første_opkald=:>,første_opkald,"nl",1,
3 10762 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10763 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10764 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10765 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10766 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10767 "nl",1,<:opkaldsflag::>,"nl",1);
3 10768 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10769 write(z,"nl",2);
3 10770 end skriv_opkaldskø;
2 10771 \f
2 10771 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10772
2 10772 procedure skriv_radio_linie_tabel(z);
2 10773 zone z;
2 10774 begin
3 10775 integer i,j,k;
3 10776
3 10776 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10777 k:= 0;
3 10778 for i:= 1 step 1 until max_linienr do
3 10779 begin
4 10780 læstegn(radio_linietabel,i+1,j);
4 10781 if j > 0 then
4 10782 begin
5 10783 k:= k +1;
5 10784 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10785 "nl",if k mod 5=0 then 1 else 0);
5 10786 end;
4 10787 end;
3 10788 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10789 end skriv_radio_linietabel;
2 10790
2 10790 procedure skriv_radio_områdetabel(z);
2 10791 zone z;
2 10792 begin
3 10793 integer i;
3 10794
3 10794 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10795 for i:= 1 step 1 until max_antal_områder do
3 10796 begin
4 10797 laf:= (i-1)*4;
4 10798 if radio_områdetabel(i)<>0 then
4 10799 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10800 radio_områdetabel(i),"nl",1);
4 10801 end;
3 10802 end skriv_radio_områdetabel;
2 10803 \f
2 10803 message procedure h_radio side 1 - 810520/hko;
2 10804
2 10804 <* hovedmodulkorutine for radiokanaler *>
2 10805 procedure h_radio;
2 10806 begin
3 10807 integer array field op_ref;
3 10808 integer k,dest_sem;
3 10809 procedure skriv_hradio(z,omfang);
3 10810 value omfang;
3 10811 zone z;
3 10812 integer omfang;
3 10813 begin integer i;
4 10814 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10815 write(z,"sp",26-i);
4 10816 if omfang >0 then
4 10817 disable begin integer x;
5 10818 trap(slut);
5 10819 write(z,"nl",1,
5 10820 <: op_ref: :>,op_ref,"nl",1,
5 10821 <: k: :>,k,"nl",1,
5 10822 <: dest_sem: :>,dest_sem,"nl",1,
5 10823 <::>);
5 10824 skriv_coru(z,coru_no(400));
5 10825 slut:
5 10826 end;
4 10827 end skriv_hradio;
3 10828
3 10828 trap(hrad_trap);
3 10829 stack_claim(if cm_test then 198 else 146);
3 10830
3 10830 <*+2*> if testbit32 and overvåget or testbit28 then
3 10831 skriv_hradio(out,0);
3 10832 <*-2*>
3 10833 \f
3 10833 message procedure h_radio side 2 - 820304/hko;
3 10834
3 10834 repeat
3 10835 wait_ch(cs_rad,op_ref,true,-1);
3 10836 <*+2*>if testbit33 and overvåget then
3 10837 disable begin
4 10838 skriv_h_radio(out,0);
4 10839 write(out,<: operation modtaget:>);
4 10840 skriv_op(out,op_ref);
4 10841 end;
3 10842 <*-2*>
3 10843 <*+4*>
3 10844 if (d.op_ref.optype and
3 10845 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10846 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10847 <*-4*>
3 10848
3 10848 k:=d.op_ref.op_kode extract 12;
3 10849 dest_sem:=
3 10850 if k > 0 and k < 7
3 10851 or k=11 or k=12 or k=19
3 10852 or (72<=k and k<=74) or k = 77
3 10853 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10854 then cs_radio_adm
3 10855 else if k=41 <* radiokommando fra operatør *>
3 10856 then cs_radio(d.opref.data(1)) else -1;
3 10857 <*+4*>
3 10858 if dest_sem<1 then
3 10859 begin
4 10860 if dest_sem<0 then
4 10861 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10862 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10863 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10864 end
3 10865 else
3 10866 <*-4*>
3 10867 begin <* operationskode ok *>
4 10868 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10869 end;
3 10870 until false;
3 10871
3 10871 hrad_trap:
3 10872 disable skriv_hradio(zbillede,1);
3 10873 end h_radio;
2 10874 \f
2 10874 message procedure radio side 1 - 820301/hko;
2 10875
2 10875 procedure radio(talevej,op);
2 10876 value talevej,op;
2 10877 integer talevej,op;
2 10878 begin
3 10879 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10880 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10881 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10882 integer array felt,værdi(1:8);
3 10883 boolean byt,nød,frigiv_samtale;
3 10884 real kl;
3 10885 real field rf;
3 10886
3 10886 procedure skriv_radio(z,omfang);
3 10887 value omfang;
3 10888 zone z;
3 10889 integer omfang;
3 10890 begin integer i1;
4 10891 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10892 write(z,"sp",26-i1);
4 10893 if omfang > 0 then
4 10894 disable begin real x;
5 10895 trap(slut);
5 10896 \f
5 10896 message procedure radio side 1a- 820301/hko;
5 10897
5 10897 write(z,"nl",1,
5 10898 <: op_ref: :>,op_ref,"nl",1,
5 10899 <: opref1: :>,opref1,"nl",1,
5 10900 <: iaf: :>,iaf,"nl",1,
5 10901 <: iaf1: :>,iaf1,"nl",1,
5 10902 <: vt-op: :>,vt_op,"nl",1,
5 10903 <: rad-op: :>,rad_op,"nl",1,
5 10904 <: rf: :>,rf,"nl",1,
5 10905 <: nr: :>,nr,"nl",1,
5 10906 <: i: :>,i,"nl",1,
5 10907 <: j: :>,j,"nl",1,
5 10908 <: k: :>,k,"nl",1,
5 10909 <: operatør: :>,operatør,"nl",1,
5 10910 <: tilst: :>,tilst,"nl",1,
5 10911 <: res: :>,res,"nl",1,
5 10912 <: opgave: :>,opgave,"nl",1,
5 10913 <: type: :>,type,"nl",1,
5 10914 <: bus: :>,bus,"nl",1,
5 10915 <: ll: :>,ll,"nl",1,
5 10916 <: ttmm: :>,ttmm,"nl",1,
5 10917 <: vogn: :>,vogn,"nl",1,
5 10918 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10919 <: vtop2: :>,vtop2,"nl",1,
5 10920 <: vtop3: :>,vtop3,"nl",1,
5 10921 <: sig: :>,sig,"nl",1,
5 10922 <: omr: :>,omr,"nl",1,
5 10923 <: garage: :>,garage,"nl",1,
5 10924 <<-dddddd'-dd>,
5 10925 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10926 <:samtaleflag: :>,"nl",1);
5 10927 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10928 skriv_coru(z,coru_no(410+talevej));
5 10929 slut:
5 10930 end;<*disable*>
4 10931 end skriv_radio;
3 10932 \f
3 10932 message procedure udtag_opkald side 1 - 820301/hko;
3 10933
3 10933 integer
3 10934 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10935 value vogn, operatør;
3 10936 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10937 begin
4 10938 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10939 integer array field vt_op,ref,næste,forrige;
4 10940 integer array field iaf1;
4 10941 boolean skal_ud;
4 10942
4 10942 boolean procedure skal_udskrives(fordelt,aktuel);
4 10943 value fordelt,aktuel;
4 10944 integer fordelt,aktuel;
4 10945 begin
5 10946 boolean skal;
5 10947 integer n;
5 10948 integer array field iaf;
5 10949
5 10949 skal:= true;
5 10950 if fordelt > 0 and fordelt<>aktuel then
5 10951 begin
6 10952 for n:= 0 step 1 until 3 do
6 10953 begin
7 10954 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10955 begin
8 10956 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10957 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10958 goto returner;
8 10959 end;
7 10960 end;
6 10961 end;
5 10962 returner:
5 10963 skal_udskrives:= skal;
5 10964 end;
4 10965
4 10965 l:= b:= tm:= t:= 0;
4 10966 garage:= sig:= 0;
4 10967 res:= -1;
4 10968 <*V*> wait(bs_opkaldskø_adgang);
4 10969 ref:= første_nødopkald;
4 10970 if ref <> 0 then
4 10971 t:= 2
4 10972 else
4 10973 begin
5 10974 ref:= første_opkald;
5 10975 t:= if ref = 0 then 0 else 1;
5 10976 end;
4 10977 if t = 0 then res:= +19 <*kø er tom*> else
4 10978 if vogn=0 and omr=0 then
4 10979 begin
5 10980 while ref <> 0 and res = -1 do
5 10981 begin
6 10982 nr:= opkaldskø.ref(4) extract 8;
6 10983 if nr>64 then
6 10984 begin
7 10985 <*opk. primærfordelt til gruppe af btj.pl.*>
7 10986 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 10987 while skal_ud and i<max_antal_operatører do
7 10988 begin
8 10989 i:=i+1;
8 10990 if læsbit_ia(bpl_def.iaf1,i) then
8 10991 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 10992 end;
7 10993 end
6 10994 else
6 10995 skal_ud:= skal_udskrives(nr,operatør);
6 10996
6 10996 if skal_ud then
6 10997 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 10998 *>
6 10999 res:= 0
6 11000 else
6 11001 begin
7 11002 ref:= opkaldskø.ref(1) extract 12;
7 11003 if ref = 0 and t = 2 then
7 11004 begin
8 11005 ref:= første_opkald;
8 11006 t:= if ref = 0 then 0 else 1;
8 11007 end else if ref = 0 then t:= 0;
7 11008 end;
6 11009 end; <*while*>
5 11010 \f
5 11010 message procedure udtag_opkald side 2 - 820304/hko;
5 11011
5 11011 if ref <> 0 then
5 11012 begin
6 11013 b:= opkaldskø.ref(2);
6 11014 <*+4*> if b < 0 then
6 11015 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 11016 <:nødopkald(besvaret/ej meldt):>,1);
6 11017 <*-4*>
6 11018 garage:=b shift(-14) extract 8;
6 11019 b:= b extract 14;
6 11020 l:= opkaldskø.ref(3);
6 11021 tm:= opkaldskø.ref(4);
6 11022 o:= tm extract 8;
6 11023 tm:= tm shift(-12);
6 11024 omr:= opkaldskø.ref(5) extract 8;
6 11025 sig:= opkaldskø.ref(5) shift (-20);
6 11026 end
5 11027 else res:=19; <* kø er tom *>
5 11028 end <*vogn=0 and omr=0 *>
4 11029 else
4 11030 begin
5 11031 <* vogn<>0 or omr<>0 *>
5 11032 i:= 0; tilst:= -1;
5 11033 if vogn shift(-22) = 1 then
5 11034 begin
6 11035 i:= find_busnr(vogn,nr,garage,tilst);
6 11036 l:= vogn;
6 11037 end
5 11038 else
5 11039 if vogn<>0 and (omr=0 or omr>2) then
5 11040 begin
6 11041 o:= 0;
6 11042 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 11043 if i=(-2) then
6 11044 begin
7 11045 o:= omr;
7 11046 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 11047 end;
6 11048 nr:= vogn extract 14;
6 11049 end
5 11050 else nr:= vogn extract 14;
5 11051 if i<0 then ref:= 0;
5 11052 while ref <> 0 and res = -1 do
5 11053 begin
6 11054 i:= opkaldskø.ref(2) extract 14;
6 11055 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 11056 if nr = i and
6 11057 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 11058 else
6 11059 begin
7 11060 ref:= opkaldskø.ref(1) extract 12;
7 11061 if ref = 0 and t = 2 then
7 11062 begin
8 11063 ref:= første_opkald;
8 11064 t:= if ref = 0 then 0 else 1;
8 11065 end else if ref = 0 then t:= 0;
7 11066 end;
6 11067 end; <*while*>
5 11068 \f
5 11068 message procedure udtag_opkald side 3 - 810603/hko;
5 11069
5 11069 if ref <> 0 then
5 11070 begin
6 11071 b:= nr;
6 11072 tm:= opkaldskø.ref(4);
6 11073 o:= tm extract 8;
6 11074 tm:= tm shift(-12);
6 11075 omr:= opkaldskø.ref(5) extract 4;
6 11076 sig:= opkaldskø.ref(5) shift (-20);
6 11077
6 11077 <*+4*> if tilst <> -1 then
6 11078 fejlreaktion(3<*prg.fejl*>,tilst,
6 11079 <:vogntabel_tilstand for vogn i kø:>,1);
6 11080 <*-4*>
6 11081 end;
5 11082 end;
4 11083
4 11083 if ref <> 0 then
4 11084 begin
5 11085 næste:= opkaldskø.ref(1);
5 11086 forrige:= næste shift(-12);
5 11087 næste:= næste extract 12;
5 11088 if forrige <> 0 then
5 11089 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 11090 + næste
5 11091 else if t = 1 then første_opkald:= næste
5 11092 else <*if t = 2 then*> første_nødopkald:= næste;
5 11093
5 11093 if næste <> 0 then
5 11094 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 11095 + forrige shift 12
5 11096 else if t = 1 then sidste_opkald:= forrige
5 11097 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 11098
5 11098 opkaldskø.ref(1):=første_frie_opkald;
5 11099 første_frie_opkald:=ref;
5 11100
5 11100 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 11101 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 11102 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 11103 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 11104 else
5 11105 begin
6 11106 sætbit_ia(opkaldsflag,operatør,1);
6 11107 sætbit_ia(opkaldsflag,o,1);
6 11108 end;
5 11109 signal_bin(bs_mobil_opkald);
5 11110 end;
4 11111 \f
4 11111 message procedure udtag_opkald side 4 - 810531/hko;
4 11112
4 11112 signal_bin(bs_opkaldskø_adgang);
4 11113 bus:= b;
4 11114 type:= t;
4 11115 ll:= l;
4 11116 ttmm:= tm;
4 11117 udtag_opkald:= res;
4 11118 end udtag opkald;
3 11119 \f
3 11119 message procedure frigiv_kanal side 1 - 810603/hko;
3 11120
3 11120 procedure frigiv_kanal(nr);
3 11121 value nr;
3 11122 integer nr;
3 11123 begin
4 11124 integer id1, id2, omr, i;
4 11125 integer array field iaf, vt_op;
4 11126
4 11126 iaf:= (nr-1)*kanal_beskrlængde;
4 11127 id1:= kanal_tab.iaf.kanal_id1;
4 11128 id2:= kanal_tab.iaf.kanal_id2;
4 11129 omr:= kanal_til_omr(nr);
4 11130 if id1 <> 0 then
4 11131 wait(ss_samtale_nedlagt(nr));
4 11132 if id1 shift (-22) < 3 and omr > 2 then
4 11133 begin
5 11134 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11135 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11136 if id1 shift (-22) = 2 then 18 else 17);
5 11137 d.vt_op.data(1):= id1;
5 11138 d.vt_op.data(4):= omr;
5 11139 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11140 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11141 signalch(cs_vt_adgang,vt_op,true);
5 11142 end;
4 11143
4 11143 if id2 <> 0 and id2 shift(-20) <> 12 then
4 11144 wait(ss_samtale_nedlagt(nr));
4 11145 if id2 shift (-22) < 3 and omr > 2 then
4 11146 begin
5 11147 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11148 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11149 if id2 shift (-22) = 2 then 18 else 17);
5 11150 d.vt_op.data(1):= id2;
5 11151 d.vt_op.data(4):= omr;
5 11152 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11153 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11154 signalch(cs_vt_adgang,vt_op,true);
5 11155 end;
4 11156
4 11156 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 11157 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 11158 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 11159 shift (-10) extract 6 shift 10;
4 11160 <* repeat
4 11161 inspect(ss_samtale_nedlagt(nr),i);
4 11162 if i>0 then wait(ss_samtale_nedlagt(nr));
4 11163 until i<=0;
4 11164 *>
4 11165 end frigiv_kanal;
3 11166 \f
3 11166 message procedure hookoff side 1 - 880901/cl;
3 11167
3 11167 integer procedure hookoff(talevej,op,retursem,flash);
3 11168 value talevej,op,retursem,flash;
3 11169 integer talevej,op,retursem;
3 11170 boolean flash;
3 11171 begin
4 11172 integer array field opref;
4 11173
4 11173 opref:= op;
4 11174 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 11175 d.opref.data(1):= talevej;
4 11176 d.opref.data(2):= if flash then 2 else 1;
4 11177 signalch(cs_radio_ud,opref,rad_optype);
4 11178 <*V*> waitch(retursem,opref,rad_optype,-1);
4 11179 hookoff:= d.opref.resultat;
4 11180 end;
3 11181 \f
3 11181 message procedure hookon side 1 - 880901/cl;
3 11182
3 11182 integer procedure hookon(talevej,op,retursem);
3 11183 value talevej,op,retursem;
3 11184 integer talevej,op,retursem;
3 11185 begin
4 11186 integer i,res;
4 11187 integer array field opref;
4 11188
4 11188 if læsbit_ia(hookoff_maske,talevej) then
4 11189 begin
5 11190 inspect(bs_talevej_udkoblet(talevej),i);
5 11191 if i<=0 then
5 11192 begin
6 11193 opref:= op;
6 11194 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 11195 d.opref.data(1):= talevej;
6 11196 signalch(cs_radio_ud,opref,rad_optype);
6 11197 <*V*> waitch(retursem,opref,rad_optype,-1);
6 11198 res:= d.opref.resultat;
6 11199 end
5 11200 else
5 11201 res:= 0;
5 11202
5 11202 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 11203 end
4 11204 else
4 11205 res:= 0;
4 11206
4 11206 sætbit_ia(hookoff_maske,talevej,0);
4 11207 hookon:= res;
4 11208 end;
3 11209 \f
3 11209 message procedure radio side 2 - 820304/hko;
3 11210
3 11210 rad_op:= op;
3 11211
3 11211 trap(radio_trap);
3 11212 stack_claim((if cm_test then 200 else 150) +200);
3 11213
3 11213 <*+2*>if testbit32 and overvåget or testbit28 then
3 11214 skriv_radio(out,0);
3 11215 <*-2*>
3 11216 repeat
3 11217 waitch(cs_radio(talevej),opref,true,-1);
3 11218 <*+2*>
3 11219 if testbit33 and overvåget then
3 11220 disable begin
4 11221 skriv_radio(out,0);
4 11222 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 11223 skriv_op(out,opref);
4 11224 end;
3 11225 <*-2*>
3 11226
3 11226 k:= d.op_ref.opkode extract 12;
3 11227 opgave:= d.opref.opkode shift (-12);
3 11228 operatør:= d.op_ref.data(4);
3 11229
3 11229 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 11230 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 11231 <:radio:>,0);
3 11232 <*-4*>
3 11233 \f
3 11233 message procedure radio side 3 - 880930/cl;
3 11234 if k=41 <*radiokommando fra operatør*> then
3 11235 begin
4 11236 vogn:= d.opref.data(2);
4 11237 res:= -1;
4 11238 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 11239 sig:= 0; omr:= d.opref.data(3) extract 8;
4 11240 bus:= garage:= ll:= 0;
4 11241
4 11241 if opgave=1 or opgave=9 then
4 11242 begin <* opkald til enkelt vogn (CHF) *>
5 11243 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 11244 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 11245 <* ok at kø er tom når vogn er angivet eller VHF *>
5 11246
5 11246 d.opref.data(11):= if res=0 then
5 11247 (if ll<>0 then ll else bus) else vogn;
5 11248
5 11248 if type=2 <*nød*> then
5 11249 begin
6 11250 waitch(cs_radio_pulje,opref1,true,-1);
6 11251 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 11252 d.opref1.data(1):= if ll<>0 then ll else bus;
6 11253 systime(5,0,kl);
6 11254 d.opref1.data(2):= entier(kl/100.0);
6 11255 d.opref1.data(3):= omr;
6 11256 signalch(cs_io,opref1,gen_optype or rad_optype);
6 11257 end
5 11258 end; <* enkeltvogn (CHF) *>
4 11259
4 11259 <* check enkeltvogn for ledig *>
4 11260 if res<=0 and omr=2<*VHF*> and bus=0 and
4 11261 (opgave=1 or opgave=9) then
4 11262 begin
5 11263 for i:= 1 step 1 until max_antal_kanaler do
5 11264 if kanal_til_omr(i)=2 then nr:= i;
5 11265 iaf:= (nr-1)*kanalbeskrlængde;
5 11266 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 11267 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 11268 then res:= 52;
5 11269 end;
4 11270 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 11271 d.opref.data(3)=0 <*std. omr*>) and
4 11272 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 11273 then
4 11274 begin
5 11275 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 11276 if vogn shift (-22) = 1 then
5 11277 begin
6 11278 find_busnr(vogn,bus,garage,res);
6 11279 ll:= vogn;
6 11280 end
5 11281 else
5 11282 if vogn shift (-22) = 0 then
5 11283 begin
6 11284 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 11285 bus:= vogn;
6 11286 end
5 11287 else
5 11288 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 11289 res:= if res=(-1) then 18 <* i kø *> else
5 11290 (if res<>0 then 14 <*opt*> else 0);
5 11291 end
4 11292 else
4 11293 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 11294 opgave <= 2 then
4 11295 begin
5 11296 bus:= vogn; garage:= type:= ttmm:= 0;
5 11297 res:= 0; omr:= 0; sig:= 0;
5 11298 end
4 11299 else
4 11300 if opgave>1 and opgave<>9 then
4 11301 type:= ttmm:= res:= 0;
4 11302 \f
4 11302 message procedure radio side 4 - 880930/cl;
4 11303
4 11303 if res=0 and (opgave<=4 or opgave=9) and
4 11304 (omr<1 or 2<omr) and
4 11305 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 11306 begin <* reserver i vogntabel *>
5 11307 waitch(cs_vt_adgang,vt_op,true,-1);
5 11308 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11309 if opgave <=2 or opgave=9 then 15 else 16);
5 11310 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 11311 (if vogn=0 then garage shift 14 + bus else
5 11312 if ll<>0 then ll else garage shift 14 + bus)
5 11313 else vogn <*gruppeid*>;
5 11314 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 11315 d.opref.data(3) extract 8
5 11316 else omr extract 8;
5 11317 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 11318 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 11319
5 11319 res:= d.vt_op.resultat;
5 11320 if res=3 then res:= 0;
5 11321 vtop2:= d.vt_op.data(2);
5 11322 vtop3:= d.vt_op.data(3);
5 11323 tekn_inf:= d.vt_op.data(4);
5 11324 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 11325 end;
4 11326
4 11326 if res<>0 then
4 11327 begin
5 11328 d.opref.resultat:= res;
5 11329 signalch(d.opref.retur,opref,d.opref.optype);
5 11330 end
4 11331 else
4 11332
4 11332 if opgave <= 9 then
4 11333 begin <* opkald *>
5 11334 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 11335 opgave<>9 and d.opref.data(6)<>0);
5 11336
5 11336 if res<>0 then
5 11337 goto returner_op;
5 11338
5 11338 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 11339 begin
6 11340 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 11341 'H' shift 12 + 60);
6 11342 d.rad_op.data(1):= talevej;
6 11343 d.rad_op.data(2):= 'D';
6 11344 d.rad_op.data(3):= 6; <* rear *>
6 11345 d.rad_op.data(4):= 1; <* rear no *>
6 11346 d.rad_op.data(5):= 0; <* disconnect *>
6 11347 signalch(cs_radio_ud,rad_op,rad_optype);
6 11348 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 11349 if d.rad_op.resultat<>0 then
6 11350 begin
7 11351 res:= d.rad_op.resultat;
7 11352 goto returner_op;
7 11353 end;
6 11354 <*
6 11355 while optaget_flag shift (-1) <> 0 do
6 11356 delay(1);
6 11357 *>
6 11358 end;
5 11359 \f
5 11359 message procedure radio side 5 - 880930/cl;
5 11360
5 11360 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 11361 'B' shift 12 + 60);
5 11362 d.rad_op.data(1):= talevej;
5 11363 d.rad_op.data(2):= 'D';
5 11364 d.rad_op.data(3):= if opgave=9 then 3 else
5 11365 (2 - (opgave extract 1)); <* højttalerkode *>
5 11366
5 11366 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11367 begin
6 11368 j:= 0;
6 11369 for i:= 2 step 1 until max_antal_områder do
6 11370 begin
7 11371 if opgave > 6 or
7 11372 (d.opref.data(3) shift (-20) = 15 and
7 11373 læsbiti(d.opref.data(3),i)) or
7 11374 (d.opref.data(3) shift (-20) = 14 and
7 11375 d.opref.data(3) extract 20 = i)
7 11376 then
7 11377 begin
8 11378 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11379 begin
9 11380 j:= j+1;
9 11381 d.rad_op.data(10+(j-1)*2):=
9 11382 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11383 (if i=2<*VHF*> then 4 else k)
9 11384 shift 8 + <* signal type *>
9 11385 1; <* antal tno *>
9 11386 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11387 end;
8 11388 end;
7 11389 end;
6 11390 d.rad_op.data(4):= j;
6 11391 d.rad_op.data(5):= 0;
6 11392 end
5 11393 else
5 11394 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11395 begin
6 11396 d.rad_op.data(4):= vtop2;
6 11397 d.rad_op.data(5):= vtop3;
6 11398 end
5 11399 else
5 11400 begin <* enkeltvogn *>
6 11401 if omr=0 then
6 11402 begin
7 11403 sig:= tekn_inf shift (-23);
7 11404 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11405 else tekn_inf extract 8;
7 11406 end
6 11407 else
6 11408 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11409
6 11409 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11410 <* tvinges til alm. opkald *>
6 11411 if (opgave=9) and (type=2) and (omr<=3) then
6 11412 begin
7 11413 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11414 opgave:= 1;
7 11415 d.radop.data(3):= 1;
7 11416 end;
6 11417
6 11417 if omr=2 <*VHF*> then sig:= 4 else
6 11418 if omr=1 <*TLF*> then sig:= 7 else
6 11419 <*UHF*> sig:= sig+1;
6 11420 d.rad_op.data(4):= 1;
6 11421 d.rad_op.data(5):= 0;
6 11422 d.rad_op.data(10):=
6 11423 (område_id(omr,2) extract 12) shift 12 +
6 11424 sig shift 8 +
6 11425 1;
6 11426 d.rad_op.data(11):= bus;
6 11427 end;
5 11428 \f
5 11428 message procedure radio side 6 - 880930/cl;
5 11429
5 11429 signalch(cs_radio_ud,rad_op,rad_optype);
5 11430 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11431 res:= d.rad_op.resultat;
5 11432
5 11432 d.rad_op.data(6):= 0;
5 11433 for i:= 1 step 1 until max_antal_områder do
5 11434 if læsbiti(d.rad_op.data(7),i) then
5 11435 increase(d.rad_op.data(6));
5 11436 returner_op:
5 11437 if d.rad_op.data(6)=1 then
5 11438 begin
6 11439 for i:= 1 step 1 until max_antal_områder do
6 11440 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11441 d.opref.data(12):= 14 shift 20 + i;
6 11442 end
5 11443 else
5 11444 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11445 d.opref.data(7):= type;
5 11446 d.opref.data(8):= garage shift 14 + bus;
5 11447 d.opref.data(9):= ll;
5 11448 if res=0 then
5 11449 begin
6 11450 d.opref.resultat:= 3;
6 11451 d.opref.data(5):= d.opref.data(6);
6 11452 j:= 0;
6 11453 for i:= 1 step 1 until max_antal_kanaler do
6 11454 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11455 if j>1 then
6 11456 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11457 else
6 11458 begin
7 11459 j:= 0;
7 11460 for i:= 1 step 1 until max_antal_kanaler do
7 11461 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11462 d.opref.data(6):= 3 shift 22 + j;
7 11463 end;
6 11464 d.opref.data(7):= type;
6 11465 d.opref.data(8):= garage shift 14 + bus;
6 11466 d.opref.data(9):= ll;
6 11467 d.opref.data(10):= d.opref.data(6);
6 11468 for i:= 1 step 1 until max_antal_kanaler do
6 11469 begin
7 11470 if læsbiti(d.rad_op.data(9),i) then
7 11471 begin
8 11472 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11473 j:= pabx_id( kanal_id(i) extract 5 )
8 11474 else
8 11475 j:= radio_id( kanal_id(i) extract 5 );
8 11476 if j>0 and type=0 and operatør>0 then tæl_opkald(j,1);
8 11477
8 11477 iaf:= (i-1)*kanalbeskrlængde;
8 11478 skrivtegn(kanal_tab.iaf,1,talevej);
8 11479 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11480 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11481 kanal_tab.iaf.kanal_id1:=
8 11482 if opgave<=2 or opgave=9 then
8 11483 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11484 else
8 11485 d.opref.data(2);
8 11486 kanal_tab.iaf.kanal_alt_id1:=
8 11487 if opgave<=2 or opgave=9 then
8 11488 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11489 else
8 11490 0;
8 11491 if kanal_tab.iaf.kanal_id1=0 then
8 11492 kanal_tab.iaf.kanal_id1:= 10000;
8 11493 kanal_tab.iaf.kanal_spec:=
8 11494 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11495 end;
7 11496 end;
6 11497 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11498 sætbit_ia(kanalflag,operatør,1);
6 11499 \f
6 11499 message procedure radio side 7 - 880930/cl;
6 11500
6 11500 end
5 11501 else
5 11502 begin
6 11503 d.opref.resultat:= res;
6 11504 if res=20 or res=52 then
6 11505 begin <* tæl ej.forb og opt.kanal *>
7 11506 for i:= 1 step 1 until max_antal_områder do
7 11507 if læsbiti(d.rad_op.data(7),i) then
7 11508 tæl_opkald(i,(if res=20 then 4 else 5));
7 11509 end;
6 11510 if d.opref.data(6)=0 then
6 11511 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11512 <* frigiv fra vogntabel hvis reserveret *>
6 11513 if (opgave<=4 or opgave=9) and
6 11514 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11515 begin
7 11516 waitch(cs_vt_adgang,vt_op,true,-1);
7 11517 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11518 if opgave<=2 or opgave=9 then 17 else 18);
7 11519 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11520 (if vogn=0 then garage shift 14 + bus else
7 11521 if ll<>0 then ll else garage shift 14 + bus)
7 11522 else vogn;
7 11523 d.vt_op.data(4):= omr;
7 11524 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11525 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11526 signalch(cs_vt_adgang,vt_op,true);
7 11527 end;
6 11528 end;
5 11529 signalch(d.opref.retur,opref,d.opref.optype);
5 11530 \f
5 11530 message procedure radio side 8 - 880930/cl;
5 11531
5 11531 end <* opkald *>
4 11532 else
4 11533 if opgave = 10 <* MONITER *> then
4 11534 begin
5 11535 nr:= d.opref.data(2);
5 11536 if nr shift (-20) <> 12 then
5 11537 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11538 nr:= nr extract 20;
5 11539 iaf:= (nr-1)*kanalbeskrlængde;
5 11540 inspect(ss_samtale_nedlagt(nr),i);
5 11541 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11542 kanal_tab.iaf.kanal_id2 extract 20
5 11543 else
5 11544 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11545 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11546 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11547 (i<>0 or j<>0) then
5 11548 begin
6 11549 res:= 0;
6 11550 d.opref.data(5):= 12 shift 20 + k;
6 11551 d.opref.data(6):= 12 shift 20 + nr;
6 11552 sætbit_ia(kanalflag,operatør,1);
6 11553 goto radio_nedlæg;
6 11554 end
5 11555 else
5 11556 if i<>0 or j<>0 then
5 11557 res:= 49
5 11558 else
5 11559 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11560 res:= 49 <* ingen samtale igang *>
5 11561 else
5 11562 begin
6 11563 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11564 if res=0 then
6 11565 begin
7 11566 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11567 'B' shift 12 + 60);
7 11568 d.rad_op.data(1):= talevej;
7 11569 d.rad_op.data(2):= 'V';
7 11570 d.rad_op.data(3):= 0;
7 11571 d.rad_op.data(4):= 1;
7 11572 d.rad_op.data(5):= 0;
7 11573 d.rad_op.data(10):=
7 11574 (kanal_id(nr) shift (-5) shift 18) +
7 11575 (kanal_id(nr) extract 5 shift 12) + 0;
7 11576 signalch(cs_radio_ud,rad_op,rad_optype);
7 11577 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11578 res:= d.rad_op.resultat;
7 11579 if res=0 then
7 11580 begin
8 11581 d.opref.data(5):= 0;
8 11582 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11583 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11584 res:= 3;
8 11585 end;
7 11586 end;
6 11587 end;
5 11588 \f
5 11588 message procedure radio side 9 - 880930/cl;
5 11589 if res=3 then
5 11590 begin
6 11591 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11592 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11593 else
6 11594 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11595 d.opref.data(6):= 12 shift 20 + nr;
6 11596 i:= kanal_tab.iaf.kanal_id2;
6 11597 if i<>0 then
6 11598 begin
7 11599 if i shift (-20) = 12 then
7 11600 begin <* ident2 henviser til anden kanal *>
8 11601 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11602 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11603 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11604 else
8 11605 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11606 d.opref.data(5):= 12 shift 20 + i;
8 11607 end
7 11608 else
7 11609 d.opref.data(5):= 12 shift 20 + nr;
7 11610 end
6 11611 else
6 11612 d.opref.data(5):= 0;
6 11613 end;
5 11614
5 11614 if res<>3 then
5 11615 begin
6 11616 res:= 0;
6 11617 sætbit_ia(kanalflag,operatør,1);
6 11618 goto radio_nedlæg;
6 11619 end;
5 11620 d.opref.resultat:= res;
5 11621 signalch(d.opref.retur,opref,d.opref.optype);
5 11622 \f
5 11622 message procedure radio side 10 - 880930/cl;
5 11623
5 11623 end <* MONITERING *>
4 11624 else
4 11625 if opgave = 11 then <* GENNEMSTILLING *>
4 11626 begin
5 11627 nr:= d.opref.data(6) extract 20;
5 11628 k:= if d.opref.data(5) shift (-20) = 12 then
5 11629 d.opref.data(5) extract 20
5 11630 else
5 11631 0;
5 11632 inspect(ss_samtale_nedlagt(nr),i);
5 11633 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11634 if i<>0 and j<>0 then
5 11635 begin
6 11636 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11637 goto radio_nedlæg;
6 11638 end;
5 11639
5 11639 iaf:= (nr-1)*kanal_beskr_længde;
5 11640 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11641 begin
6 11642 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11643 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11644 then
6 11645 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11646 else
6 11647 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11648 d.opref.data(5)<>0
6 11649 then
6 11650 res:= 0
6 11651 else
6 11652 res:= 21; <* ingen at gennemstille til *>
6 11653 end
5 11654 else
5 11655 res:= 50; <* kanalnr *>
5 11656
5 11656 if res=0 then
5 11657 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11658 if res=0 then
5 11659 begin
6 11660 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11661 kanal_tab.iaf.kanal_tilstand:=
6 11662 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11663 d.opref.data(6):= 0;
6 11664 if kanal_tab.iaf.kanal_id2=0 then
6 11665 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11666
6 11666 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11667 begin <* gennemstillet til anden kanal *>
7 11668 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11669 *kanalbeskrlængde;
7 11670 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11671 kanal_tab.iaf1.kanal_tilstand:=
7 11672 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11673 if kanal_tab.iaf1.kanal_id2=0 then
7 11674 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11675 end;
6 11676 d.opref.data(5):= 0;
6 11677
6 11677 res:= 3;
6 11678 end;
5 11679
5 11679 d.opref.resultat:= res;
5 11680 signalch(d.opref.retur,opref,d.opref.optype);
5 11681 \f
5 11681 message procedure radio side 11 - 880930/cl;
5 11682
5 11682 end
4 11683 else
4 11684 if opgave = 12 then <* NEDLÆG *>
4 11685 begin
5 11686 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11687 radio_nedlæg:
5 11688 if res=0 then
5 11689 begin
6 11690 for k:= 5, 6 do
6 11691 begin
7 11692 if d.opref.data(k) shift (-20) = 12 then
7 11693 begin
8 11694 i:= d.opref.data(k) extract 20;
8 11695 iaf:= (i-1)*kanalbeskrlængde;
8 11696 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11697 frigiv_kanal(d.opref.data(k) extract 20)
8 11698 else
8 11699 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11700 end
7 11701 else
7 11702 if d.opref.data(k) shift (-20) = 13 then
7 11703 begin
8 11704 for i:= 1 step 1 until max_antal_kanaler do
8 11705 if læsbiti(d.opref.data(k),i) then
8 11706 begin
9 11707 iaf:= (i-1)*kanalbeskrlængde;
9 11708 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11709 frigiv_kanal(i)
9 11710 else
9 11711 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11712 end;
8 11713 sætbit_ia(kanalflag,operatør,1);
8 11714 end;
7 11715 end;
6 11716 d.opref.data(5):= 0;
6 11717 d.opref.data(6):= 0;
6 11718 d.opref.data(9):= 0;
6 11719 res:= if opgave=12 then 3 else 49;
6 11720 end;
5 11721 d.opref.resultat:= res;
5 11722 signalch(d.opref.retur,opref,d.opref.optype);
5 11723 end
4 11724 else
4 11725 if opgave=13 then <* R *>
4 11726 begin
5 11727 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11728 'H' shift 12 + 60);
5 11729 d.rad_op.data(1):= talevej;
5 11730 d.rad_op.data(2):= 'M';
5 11731 d.rad_op.data(3):= 0; <*tkt*>
5 11732 d.rad_op.data(4):= 0; <*tkn*>
5 11733 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11734 signalch(cs_radio_ud,rad_op,rad_optype);
5 11735 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11736 res:= d.rad_op.resultat;
5 11737 d.opref.resultat:= if res=0 then 3 else res;
5 11738 signalch(d.opref.retur,opref,d.opref.optype);
5 11739 end
4 11740 else
4 11741 if opgave=14 <* VENTEPOS *> then
4 11742 begin
5 11743 res:= 0;
5 11744 while (res<=3 and d.opref.data(2)>0) do
5 11745 begin
6 11746 nr:= d.opref.data(6) extract 20;
6 11747 k:= if d.opref.data(5) shift (-20) = 12 then
6 11748 d.opref.data(5) extract 20
6 11749 else
6 11750 0;
6 11751 inspect(ss_samtale_nedlagt(nr),i);
6 11752 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11753 if i<>0 or j<>0 then
6 11754 begin
7 11755 res:= hookon(talevej,radop,cs_radio(talevej));
7 11756 goto radio_nedlæg;
7 11757 end;
6 11758
6 11758 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11759
6 11759 if res=0 then
6 11760 begin
7 11761 i:= d.opref.data(5);
7 11762 d.opref.data(5):= d.opref.data(6);
7 11763 d.opref.data(6):= i;
7 11764 res:= 3;
7 11765 end;
6 11766
6 11766 d.opref.data(2):= d.opref.data(2)-1;
6 11767 end;
5 11768 d.opref.resultat:= res;
5 11769 signalch(d.opref.retur,opref,d.opref.optype);
5 11770 end
4 11771 else
4 11772 begin
5 11773 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11774 d.opref.resultat:= 31;
5 11775 signalch(d.opref.retur,opref,d.opref.optype);
5 11776 end;
4 11777
4 11777 end <* radiokommando fra operatør *>
3 11778 else
3 11779 begin
4 11780
4 11780 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11781
4 11781 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11782
4 11782 end;
3 11783
3 11783 until false;
3 11784 radio_trap:
3 11785 disable skriv_radio(zbillede,1);
3 11786 end radio;
2 11787 \f
2 11787 message procedure radio_ind side 1 - 810521/hko;
2 11788
2 11788 procedure radio_ind(op);
2 11789 value op;
2 11790 integer op;
2 11791 begin
3 11792 integer array field op_ref,ref,io_opref;
3 11793 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11794 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11795 integer array typ, val(1:6), answ, tlgr(1:32);
3 11796 integer array field spec;
3 11797 real field rf;
3 11798 long array field laf;
3 11799
3 11799 procedure skriv_radio_ind(zud,omfang);
3 11800 value omfang;
3 11801 zone zud;
3 11802 integer omfang;
3 11803 begin integer ii;
4 11804 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11805 if omfang > 0 then
4 11806 disable begin integer x; long array field tx;
5 11807 tx:= 0;
5 11808 trap(slut);
5 11809 write(zud,"nl",1,
5 11810 <: op-ref: :>,op_ref,"nl",1,
5 11811 <: ref: :>,ref,"nl",1,
5 11812 <: io-opref: :>,io_opref,"nl",1,
5 11813 <: ac: :>,ac,"nl",1,
5 11814 <: lgd: :>,lgd,"nl",1,
5 11815 <: ttyp: :>,ttyp,"nl",1,
5 11816 <: ptyp: :>,ptyp,"nl",1,
5 11817 <: pnum: :>,pnum,"nl",1,
5 11818 <: pos: :>,pos,"nl",1,
5 11819 <: tegn: :>,tegn,"nl",1,
5 11820 <: bs: :>,bs,"nl",1,
5 11821 <: b-pt: :>,b_pt,"nl",1,
5 11822 <: b-pn: :>,b_pn,"nl",1,
5 11823 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11824 <: antal-spec: :>,antal_spec,"nl",1,
5 11825 <: sum: :>,sum,"nl",1,
5 11826 <: csum: :>,csum,"nl",1,
5 11827 <: i: :>,i,"nl",1,
5 11828 <: j: :>,j,"nl",1,
5 11829 <: k: :>,k,"nl",1,
5 11830 <: filref :>,filref,"nl",1,
5 11831 <: zno: :>,zno,"nl",1,
5 11832 <: answ: :>,answ.tx,"nl",1,
5 11833 <: tlgr: :>,tlgr.tx,"nl",1,
5 11834 <: spec: :>,spec,"nl",1);
5 11835 trap(slut);
5 11836 slut:
5 11837 end; <*disable*>
4 11838 end skriv_radio_ind;
3 11839 \f
3 11839 message procedure indsæt_opkald side 1 - 811105/hko;
3 11840
3 11840 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11841 value bus,type,omr,sig;
3 11842 integer bus,type,omr,sig;
3 11843 begin
4 11844 integer res,tilst,ll,operatør;
4 11845 integer array field vt_op,ref,næste,forrige;
4 11846 real r;
4 11847
4 11847 res:= -1;
4 11848 begin
5 11849 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11850 if vt_op <> 0 then
5 11851 begin
6 11852 wait(bs_opkaldskø_adgang);
6 11853 if omr>2 then
6 11854 begin
7 11855 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11856 d.vt_op.data(1):= bus;
7 11857 d.vt_op.data(4):= omr;
7 11858 tilst:= vt_op;
7 11859 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11860 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11861 <*+4*> if tilst <> vt_op then
7 11862 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11863 <*-4*>
7 11864 <*+2*> if testbit34 and overvåget then
7 11865 disable begin
8 11866 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11867 skriv_op(out,vt_op);
8 11868 ud;
8 11869 end;
7 11870 end
6 11871 else
6 11872 begin
7 11873 d.vt_op.data(1):= bus;
7 11874 d.vt_op.data(2):= 0;
7 11875 d.vt_op.data(3):= bus;
7 11876 d.vt_op.data(4):= omr;
7 11877 d.vt_op.resultat:= 0;
7 11878 ref:= første_nødopkald;
7 11879 if ref<>0 then tilst:= 2
7 11880 else
7 11881 begin
8 11882 ref:= første_opkald;
8 11883 tilst:= if ref=0 then 0 else 1;
8 11884 end;
7 11885 if tilst=0 then
7 11886 d.vt_op.resultat:= 3
7 11887 else
7 11888 begin
8 11889 while ref<>0 and d.vt_op.resultat=0 do
8 11890 begin
9 11891 if opkaldskø.ref(2) extract 14 = bus and
9 11892 opkaldskø.ref(5) extract 8 = omr
9 11893 then
9 11894 d.vt_op.resultat:= 18
9 11895 else
9 11896 begin
10 11897 ref:= opkaldskø.ref(1) extract 12;
10 11898 if ref=0 and tilst=2 then
10 11899 begin
11 11900 ref:= første_opkald;
11 11901 tilst:= if ref=0 then 0 else 1;
11 11902 end
10 11903 else
10 11904 if ref=0 then tilst:= 0;
10 11905 end;
9 11906 end;
8 11907 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11908 end;
7 11909 end;
6 11910 <*-2*>
6 11911 \f
6 11911 message procedure indsæt_opkald side 1a- 820301/hko;
6 11912
6 11912 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11913 begin
7 11914 ref:=første_opkald;
7 11915 tilst:=-1;
7 11916 while ref<>0 and tilst=-1 do
7 11917 begin
8 11918 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11919 begin <* udtag normalopkald *>
9 11920 næste:=opkaldskø.ref(1);
9 11921 forrige:=næste shift(-12);
9 11922 næste:=næste extract 12;
9 11923 if forrige<>0 then
9 11924 opkaldskø.forrige(1):=
9 11925 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11926 else
9 11927 første_opkald:=næste;
9 11928 if næste<>0 then
9 11929 opkaldskø.næste(1):=
9 11930 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11931 else
9 11932 sidste_opkald:=forrige;
9 11933 opkaldskø.ref(1):=første_frie_opkald;
9 11934 første_frie_opkald:=ref;
9 11935 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11936 tilst:=0;
9 11937 end
8 11938 else
8 11939 ref:=opkaldskø.ref(1) extract 12;
8 11940 end; <*while*>
7 11941 if tilst=0 then
7 11942 d.vt_op.resultat:=3;
7 11943 end; <*nødopkald bus i kø*>
6 11944 \f
6 11944 message procedure indsæt_opkald side 2 - 820304/hko;
6 11945
6 11945 if d.vt_op.resultat = 3 then
6 11946 begin
7 11947 ll:= d.vt_op.data(2);
7 11948 tilst:= d.vt_op.data(3);
7 11949 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11950 if operatør < 0 or max_antal_operatører < operatør then
7 11951 operatør:= 0;
7 11952 if operatør=0 then
7 11953 operatør:= (tilst shift (-14) extract 8);
7 11954 if operatør=0 then
7 11955 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11956 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11957 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11958 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11959 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11960 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11961 forrige:= (if type = 1 then sidste_opkald
7 11962 else sidste_nødopkald);
7 11963 opkaldskø.ref(1):= forrige shift 12;
7 11964 if type = 1 then
7 11965 begin
8 11966 if første_opkald = 0 then første_opkald:= ref;
8 11967 sidste_opkald:= ref;
8 11968 end
7 11969 else
7 11970 begin <*type = 2*>
8 11971 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11972 sidste_nødopkald:= ref;
8 11973 end;
7 11974 if forrige <> 0 then
7 11975 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11976 shift 12 +ref;
7 11977
7 11977 opkaldskø.ref(2):= tilst extract 22 add
7 11978 (if type=2 then 1 shift 23 else 0);
7 11979 opkaldskø.ref(3):= ll;
7 11980 systime(5,0.0,r);
7 11981 ll:= round r//100;<*ttmm*>
7 11982 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 11983 opkaldskø.ref(5):= sig shift 20 + omr;
7 11984 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 11985 res:= 0;
7 11986 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 11987 opkaldskø_ledige:= opkaldskø_ledige -1;
7 11988 <*meddel opkald til berørte operatører *>
7 11989 signal_bin(bs_mobil_opkald);
7 11990 tæl_opkald(omr,type+1);
7 11991 end <* resultat = 3 *>
6 11992 else
6 11993 begin
7 11994 \f
7 11994 message procedure indsæt_opkald side 3 - 810601/hko;
7 11995
7 11995 <* d.vt_op.resultat <> 3 *>
7 11996
7 11996 res:= d.vt_op.resultat;
7 11997 if res = 10 then
7 11998 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 11999 <:er ikke i bustabel:>,1)
7 12000 else
7 12001 <*+4*> if res <> 14 and res <> 18 then
7 12002 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 12003 <*-4*>
7 12004 ;
7 12005 end;
6 12006 signalbin(bs_opkaldskø_adgang);
6 12007 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 12008 end
5 12009 else
5 12010 res:= -2; <*timeout for cs_vt_adgang*>
5 12011 end;
4 12012 indsæt_opkald:= res;
4 12013 end indsæt_opkald;
3 12014 \f
3 12014 message procedure afvent_telegram side 1 - 880901/cl;
3 12015
3 12015 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12016 integer array tlgr;
3 12017 integer lgd,ttyp,ptyp,pnum;
3 12018 begin
4 12019 integer i, pos, tegn, ac, sum, csum;
4 12020
4 12020 pos:= 1;
4 12021 lgd:= 0;
4 12022 ttyp:= 'Z';
4 12023 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 12024 if ac >= 0 then
4 12025 begin
5 12026 lgd:= 1;
5 12027 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 12028 lgd:= lgd-2;
5 12029 if lgd >= 3 then
5 12030 begin
6 12031 i:= 1;
6 12032 ttyp:= læstegn(tlgr,i,tegn);
6 12033 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 12034 pnum:= læstegn(tlgr,i,tegn) - '@';
6 12035 end
5 12036 else ac:= 6; <* for kort telegram - retransmitter *>
5 12037 end;
4 12038
4 12038 afvent_telegram:= ac;
4 12039 end;
3 12040 \f
3 12040 message procedure b_answ side 1 - 880901/cl;
3 12041
3 12041 procedure b_answ(answ,ht,spec,more,ac);
3 12042 value ht, more,ac;
3 12043 integer array answ, spec;
3 12044 boolean more;
3 12045 integer ht, ac;
3 12046 begin
4 12047 integer pos, i, sum, tegn;
4 12048
4 12048 pos:= 1;
4 12049 skrivtegn(answ,pos,'B');
4 12050 skrivtegn(answ,pos,if more then 'B' else ' ');
4 12051 skrivtegn(answ,pos,ac+'@');
4 12052 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 12053 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 12054 skrivtegn(answ,pos,'@');
4 12055 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 12056 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 12057 for i:= 1 step 1 until spec(1) extract 8 do
4 12058 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 12059 else
4 12060 begin
5 12061 skrivtegn(answ,pos,'D');
5 12062 anbringtal(answ,pos,spec(1+i),-4);
5 12063 end;
4 12064 for i:= 1 step 1 until 4 do
4 12065 skrivtegn(answ,pos,'@');
4 12066 skrivtegn(answ,pos,ht+'@');
4 12067 skrivtegn(answ,pos,'@');
4 12068
4 12068 i:= 1; sum:= 0;
4 12069 while i < pos do
4 12070 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 12071 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 12072 skrivtegn(answ,pos,sum extract 4 + '@');
4 12073 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 12074 end;
3 12075 \f
3 12075 message procedure ann_opkald side 1 - 881108/cl;
3 12076
3 12076 integer procedure ann_opkald(vogn,omr);
3 12077 value vogn,omr;
3 12078 integer vogn,omr;
3 12079 begin
4 12080 integer array field vt_op,ref,næste,forrige;
4 12081 integer res, t, i, o;
4 12082
4 12082 waitch(cs_vt_adgang,vt_op,true,-1);
4 12083 res:= -1;
4 12084 wait(bs_opkaldskø_adgang);
4 12085 ref:= første_nødopkald;
4 12086 if ref <> 0 then
4 12087 t:= 2
4 12088 else
4 12089 begin
5 12090 ref:= første_opkald;
5 12091 t:= if ref<>0 then 1 else 0;
5 12092 end;
4 12093
4 12093 if t=0 then
4 12094 res:= 19 <* kø tom *>
4 12095 else
4 12096 begin
5 12097 while ref<>0 and res=(-1) do
5 12098 begin
6 12099 if vogn=opkaldskø.ref(2) extract 14 and
6 12100 omr=opkaldskø.ref(5) extract 8
6 12101 then
6 12102 res:= 0
6 12103 else
6 12104 begin
7 12105 ref:= opkaldskø.ref(1) extract 12;
7 12106 if ref=0 and t=2 then
7 12107 begin
8 12108 ref:= første_opkald;
8 12109 t:= if ref=0 then 0 else 1;
8 12110 end;
7 12111 end;
6 12112 end; <*while*>
5 12113 \f
5 12113 message procedure ann_opkald side 2 - 881108/cl;
5 12114
5 12114 if ref<>0 then
5 12115 begin
6 12116 start_operation(vt_op,401,cs_radio_ind,17);
6 12117 d.vt_op.data(1):= vogn;
6 12118 d.vt_op.data(4):= omr;
6 12119 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 12120 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 12121
6 12121 o:= opkaldskø.ref(4) extract 8;
6 12122 næste:= opkaldskø.ref(1);
6 12123 forrige:= næste shift (-12);
6 12124 næste:= næste extract 12;
6 12125 if forrige<>0 then
6 12126 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 12127 + næste
6 12128 else
6 12129 if t=2 then første_nødopkald:= næste
6 12130 else første_opkald:= næste;
6 12131
6 12131 if næste<>0 then
6 12132 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 12133 + forrige shift 12
6 12134 else
6 12135 if t=2 then sidste_nødopkald:= forrige
6 12136 else sidste_opkald:= forrige;
6 12137
6 12137 opkaldskø.ref(1):= første_frie_opkald;
6 12138 første_frie_opkald:= ref;
6 12139 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 12140 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 12141
6 12141 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 12142 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 12143 else
6 12144 begin
7 12145 sætbit_ia(opkaldsflag,o,1);
7 12146 end;
6 12147 signalbin(bs_mobilopkald);
6 12148 end;
5 12149 end;
4 12150
4 12150 signalbin(bs_opkaldskø_adgang);
4 12151 signalch(cs_vt_adgang, vt_op, true);
4 12152 ann_opkald:= res;
4 12153 end;
3 12154 \f
3 12154 message procedure frigiv_id side 1 - 881114/cl;
3 12155
3 12155 integer procedure frigiv_id(id,omr);
3 12156 value id,omr;
3 12157 integer id,omr;
3 12158 begin
4 12159 integer array field vt_op;
4 12160
4 12160 if id shift (-22) < 3 and omr > 2 then
4 12161 begin
5 12162 waitch(cs_vt_adgang,vt_op,true,-1);
5 12163 start_operation(vt_op,401,cs_radio_ind,
5 12164 if id shift (-22) = 2 then 18 else 17);
5 12165 d.vt_op.data(1):= id;
5 12166 d.vt_op.data(4):= omr;
5 12167 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 12168 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 12169 frigiv_id:= d.vt_op.resultat;
5 12170 signalch(cs_vt_adgang,vt_op,true);
5 12171 end;
4 12172 end;
3 12173 \f
3 12173 message procedure radio_ind side 2 - 810524/hko;
3 12174 trap(radio_ind_trap);
3 12175 laf:= 0;
3 12176 stack_claim((if cm_test then 200 else 150) +135+75);
3 12177
3 12177 <*+2*>if testbit32 and overvåget or testbit28 then
3 12178 skriv_radio_ind(out,0);
3 12179 <*-2*>
3 12180 answ.laf(1):= long<:<'nl'>:>;
3 12181 io_opref:= op;
3 12182
3 12182 repeat
3 12183 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12184 pos:= 4;
3 12185 if ac = 0 then
3 12186 begin
4 12187 \f
4 12187 message procedure radio_ind side 3 - 881107/cl;
4 12188 if ttyp = 'A' then
4 12189 begin
5 12190 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12191 ac:= 1
5 12192 else
5 12193 begin
6 12194 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 12195 val(1):= ttyp;
6 12196 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 12197 val(2):= pnum;
6 12198 typ(3):= -1;
6 12199 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12200 if opref>0 then
6 12201 begin
7 12202 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 12203 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 12204 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 12205 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 12206 then
7 12207 begin
8 12208 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 12209 end
7 12210 else
7 12211 begin
8 12212 ac:= 0;
8 12213 d.opref.resultat:= 0;
8 12214 sætbit_ia(hookoff_maske,pnum,1);
8 12215 end;
7 12216 signalch(d.opref.retur,opref,d.opref.optype);
7 12217 end
6 12218 else
6 12219 ac:= 2;
6 12220 end;
5 12221 pos:= 1;
5 12222 skrivtegn(answ,pos,'A');
5 12223 skrivtegn(answ,pos,' ');
5 12224 skrivtegn(answ,pos,ac+'@');
5 12225 for i:= 1 step 1 until 5 do
5 12226 skrivtegn(answ,pos,'@');
5 12227 skrivtegn(answ,pos,'0');
5 12228 i:= 1; sum:= 0;
5 12229 while i < pos do
5 12230 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12231 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12232 skrivtegn(answ,pos,sum extract 4 + '@');
5 12233 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12234 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12235 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12236 disable begin
6 12237 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12238 outchar(zrl,'nl');
6 12239 end;
5 12240 <*-2*>
5 12241 disable setposition(z_fr_out,0,0);
5 12242 ac:= -1;
5 12243 \f
5 12243 message procedure radio_ind side 4 - 881107/cl;
5 12244 end <* ttyp=A *>
4 12245 else
4 12246 if ttyp = 'B' then
4 12247 begin
5 12248 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12249 ac:= 1
5 12250 else
5 12251 begin
6 12252 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 12253 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 12254 typ(3):= -1;
6 12255 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12256 if opref > 0 then
6 12257 begin
7 12258 <*+2*> if testbit37 and overvåget then
7 12259 disable begin
8 12260 skriv_radio_ind(out,0);
8 12261 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 12262 skriv_op(out,opref);
8 12263 end;
7 12264 <*-2*>
7 12265 læstegn(tlgr,pos,bs);
7 12266 if bs = 'V' then
7 12267 begin
8 12268 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 12269 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 12270 end;
7 12271 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 12272 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 12273 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 12274 then
7 12275 begin
8 12276 ac:= 1;
8 12277 d.opref.resultat:= 31; <* systemfejl *>
8 12278 signalch(d.opref.retur,opref,d.opref.optype);
8 12279 end
7 12280 else
7 12281 if bs='V' then
7 12282 begin
8 12283 ac:= 0;
8 12284 d.opref.resultat:= 1;
8 12285 d.opref.data(4):= 0;
8 12286 d.opref.data(7):=
8 12287 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 12288 radio_id(b_pn));
8 12289 systime(1,0.0,d.opref.tid);
8 12290 signalch(cs_radio_ind,opref,d.opref.optype);
8 12291 spec:= data+18;
8 12292 b_answ(answ,0,d.opref.spec,false,ac);
8 12293 <*+2*> if (testbit36 or testbit38) and overvåget then
8 12294 disable begin
9 12295 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 12296 outchar(zrl,'nl');
9 12297 end;
8 12298 <*-2*>
8 12299 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 12300 disable setposition(z_fr_out,0,0);
8 12301 ac:= -1;
8 12302 \f
8 12302 message procedure radio_ind side 5 - 881107/cl;
8 12303 end
7 12304 else
7 12305 begin
8 12306 integer sig_type;
8 12307
8 12307 ac:= 0;
8 12308 antal_spec:= d.opref.data(4);
8 12309 filref:= d.opref.data(5);
8 12310 spec:= d.opref.data(6);
8 12311 if antal_spec>0 then
8 12312 begin
9 12313 antal_spec:= antal_spec-1;
9 12314 if filref<>0 then
9 12315 begin
10 12316 læsfil(filref,1,zno);
10 12317 b_pt:= fil(zno).spec(1) shift (-12);
10 12318 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 12319 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 12320 antal_spec>0,ac);
10 12321 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 12322 end
9 12323 else
9 12324 begin
10 12325 b_pt:= d.opref.spec(1) shift (-12);
10 12326 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 12327 b_answ(answ,d.opref.data(3),d.opref.spec,
10 12328 antal_spec>0,ac);
10 12329 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 12330 end;
9 12331
9 12331 <* send answer *>
9 12332 <*+2*> if (testbit36 or testbit38) and overvåget then
9 12333 disable begin
10 12334 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 12335 outchar(zrl,'nl');
10 12336 end;
9 12337 <*-2*>
9 12338 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 12339 disable setposition(z_fr_out,0,0);
9 12340 if ac<>0 then
9 12341 begin
10 12342 antal_spec:= 0;
10 12343 ac:= -1;
10 12344 end
9 12345 else
9 12346 begin
10 12347 for i:= 1 step 1 until max_antal_områder do
10 12348 if område_id(i,2)=b_pt then
10 12349 begin
11 12350 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 12351 if sætbiti(d.opref.data(7),j,1)=0 then
11 12352 d.opref.resultat:= d.opref.resultat + 1;
11 12353 end;
10 12354 end;
9 12355 end;
8 12356 \f
8 12356 message procedure radio_ind side 6 - 881107/cl;
8 12357
8 12357 <* afvent nyt telegram *>
8 12358 d.opref.data(4):= antal_spec;
8 12359 d.opref.data(6):= spec;
8 12360 ac:= -1;
8 12361 systime(1,0.0,d.opref.tid);
8 12362 <*+2*> if testbit37 and overvåget then
8 12363 disable begin
9 12364 skriv_radio_ind(out,0);
9 12365 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 12366 ud;
9 12367 end;
8 12368 <*-2*>
8 12369 signalch(cs_radio_ind,opref,d.opref.optype);
8 12370 end;
7 12371 end
6 12372 else ac:= 2;
6 12373 end;
5 12374 if ac > 0 then
5 12375 begin
6 12376 for i:= 1 step 1 until 6 do val(i):= 0;
6 12377 b_answ(answ,0,val,false,ac);
6 12378 <*+2*>
6 12379 if (testbit36 or testbit38) and overvåget then
6 12380 disable begin
7 12381 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12382 outchar(zrl,'nl');
7 12383 end;
6 12384 <*-2*>
6 12385 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12386 disable setposition(z_fr_out,0,0);
6 12387 ac:= -1;
6 12388 end;
5 12389 \f
5 12389 message procedure radio_ind side 7 - 881107/cl;
5 12390 end <* ttyp = 'B' *>
4 12391 else
4 12392 if ttyp='C' or ttyp='J' then
4 12393 begin
5 12394 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12395 ac:= 1
5 12396 else
5 12397 begin
6 12398 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12399 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12400 typ(3):= -1;
6 12401 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12402 if opref > 0 then
6 12403 begin
7 12404 d.opref.resultat:= d.opref.resultat - 1;
7 12405 if ttyp = 'C' then
7 12406 begin
8 12407 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12408 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12409 j:= 0;
8 12410 for i:= 1 step 1 until max_antal_kanaler do
8 12411 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12412 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12413 d.opref.resultat:= d.opref.resultat-1;
8 12414 sætbiti(optaget_flag,j,1);
8 12415 sætbiti(d.opref.data(9),j,1);
8 12416 end
7 12417 else
7 12418 begin <* INGEN FORBINDELSE *>
8 12419 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12420 end;
7 12421 ac:= 0;
7 12422 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12423 begin
8 12424 systime(1,0,d.opref.tid);
8 12425 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12426 end
7 12427 else
7 12428 begin
8 12429 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12430 if læsbiti(d.opref.data(8),9) then 52 else
8 12431 if læsbiti(d.opref.data(8),10) then 20 else
8 12432 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12433 signalch(d.opref.retur, opref, d.opref.optype);
8 12434 end;
7 12435 end
6 12436 else
6 12437 ac:= 2;
6 12438 end;
5 12439 pos:= 1;
5 12440 skrivtegn(answ,pos,ttyp);
5 12441 skrivtegn(answ,pos,' ');
5 12442 skrivtegn(answ,pos,ac+'@');
5 12443 i:= 1; sum:= 0;
5 12444 while i < pos do
5 12445 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12446 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12447 skrivtegn(answ,pos,sum extract 4 + '@');
5 12448 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12449 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12450 disable begin
6 12451 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12452 outchar(zrl,'nl');
6 12453 end;
5 12454 <*-2*>
5 12455 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12456 disable setposition(z_fr_out,0,0);
5 12457 ac:= -1;
5 12458 \f
5 12458 message procedure radio_ind side 8 - 881107/cl;
5 12459 end <* ttyp = 'C' or 'J' *>
4 12460 else
4 12461 if ttyp = 'D' then
4 12462 begin
5 12463 if ptyp = 4 <* VDU *> then
5 12464 begin
6 12465 if pnum<1 or pnum>max_antal_taleveje then
6 12466 ac:= 1
6 12467 else
6 12468 begin
7 12469 inspect(bs_talevej_udkoblet(pnum),j);
7 12470 if j>=0 then
7 12471 begin
8 12472 sætbit_ia(samtaleflag,pnum,1);
8 12473 signal_bin(bs_mobil_opkald);
8 12474 end;
7 12475 if læsbit_ia(hookoff_maske,pnum) then
7 12476 signalbin(bs_talevej_udkoblet(pnum));
7 12477 ac:= 0;
7 12478 end
6 12479 end
5 12480 else
5 12481 if ptyp=3 or ptyp=2 then
5 12482 begin
6 12483 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12484 ptyp=2 and pnum<>2
6 12485 then
6 12486 ac:= 1
6 12487 else
6 12488 begin
7 12489 if læstegn(tlgr,5,tegn)='D' then
7 12490 begin <* teknisk nr i telegram *>
8 12491 b_pn:= 0;
8 12492 for i:= 1 step 1 until 4 do
8 12493 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12494 end
7 12495 else
7 12496 b_pn:= 0;
7 12497 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12498 i:= 0;
7 12499 for j:= 1 step 1 until max_antal_kanaler do
7 12500 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12501 if i<>0 then
7 12502 begin
8 12503 ref:= (i-1)*kanalbeskrlængde;
8 12504 inspect(ss_samtale_nedlagt(i),j);
8 12505 if j>=0 then
8 12506 begin
9 12507 sætbit_ia(samtaleflag,
9 12508 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12509 signalbin(bs_mobil_opkald);
9 12510 end;
8 12511 signal(ss_samtale_nedlagt(i));
8 12512 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12513 begin
9 12514 if kanal_tab.ref.kanal_id1<>0 and
9 12515 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12516 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12517 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12518 if kanal_tab.ref.kanal_id2<>0 and
9 12519 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12520 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12521 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12522 end;
8 12523 sætbiti(optaget_flag,i,0);
8 12524 end;
7 12525 ac:= 0;
7 12526 end;
6 12527 end
5 12528 else ac:= 1;
5 12529 if ac>=0 then
5 12530 begin
6 12531 pos:= i:= 1; sum:= 0;
6 12532 skrivtegn(answ,pos,'D');
6 12533 skrivtegn(answ,pos,' ');
6 12534 skrivtegn(answ,pos,ac+'@');
6 12535 skrivtegn(answ,pos,'@');
6 12536 while i<pos do
6 12537 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12538 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12539 skrivtegn(answ,pos, sum extract 4 + '@');
6 12540 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12541 <*+2*>
6 12542 if (testbit36 or testbit38) and overvåget then
6 12543 disable begin
7 12544 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12545 outchar(zrl,'nl');
7 12546 end;
6 12547 <*-2*>
6 12548 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12549 disable setposition(z_fr_out,0,0);
6 12550 ac:= -1;
6 12551 end;
5 12552 \f
5 12552 message procedure radio_ind side 9 - 881107/cl;
5 12553 end <* ttyp = D *>
4 12554 else
4 12555 if ttyp='H' then
4 12556 begin
5 12557 integer htyp;
5 12558
5 12558 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12559
5 12559 if htyp='A' then
5 12560 begin <*mobilopkald*>
6 12561 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12562 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12563 ac:= 1
6 12564 else
6 12565 begin
7 12566 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12567 if læstegn(tlgr,6,tegn)='D' then
7 12568 begin <*teknisk nr. i telegram*>
8 12569 b_pn:= 0;
8 12570 for i:= 1 step 1 until 4 do
8 12571 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12572 end
7 12573 else b_pn:= 0;
7 12574 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12575 <* opkaldstype *>
7 12576 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12577 if j>0 then
7 12578 begin
8 12579 if bs=10 then
8 12580 ann_opkald(b_pn,j)
8 12581 else
8 12582 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12583 ac:= 0;
8 12584 end else ac:= 1;
7 12585 end;
6 12586 \f
6 12586 message procedure radio_ind side 10 - 881107/cl;
6 12587 end
5 12588 else
5 12589 if htyp='E' then
5 12590 begin <* radiokanal status *>
6 12591 long onavn;
6 12592
6 12592 ac:= 0;
6 12593 j:= 0;
6 12594 for i:= 1 step 1 until max_antal_kanaler do
6 12595 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12596
6 12596 <* Alarmer for K12 = GLX ignoreres *>
6 12597 <* 94.06.14/CL *>
6 12598 <* Alarmer for K15 = HG ignoreres *>
6 12599 <* 95.07.31/CL *>
6 12600 <* Alarmer for K10 = FS ignoreres *>
6 12601 <* 96.05.27/CL *>
6 12602 if j>0 then
6 12603 begin
7 12604 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12605 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
7 12606 (onavn = long<:FS:>) then 0 else j);
7 12607 end;
6 12608
6 12608 læstegn(tlgr,9,tegn);
6 12609 if j<>0 and (tegn='A' or tegn='E') then
6 12610 begin
7 12611 ref:= (j-1)*kanalbeskrlængde;
7 12612 bs:= if tegn='E' then 0 else 15;
7 12613 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12614 begin
8 12615 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12616 signalbin(bs_mobil_opkald);
8 12617 end;
7 12618 end;
6 12619 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12620 begin
7 12621 waitch(cs_radio_pulje,opref,true,-1);
7 12622 startoperation(opref,401,cs_radio_pulje,23);
7 12623 i:= 1;
7 12624 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12625 if læstegn(tlgr,4,k)<>'@' then
7 12626 begin
8 12627 if k-'@' = 17 then
8 12628 hægtstring(d.opref.data,i,<: AMV:>)
8 12629 else
8 12630 if k-'@' = 18 then
8 12631 hægtstring(d.opref.data,i,<: BHV:>)
8 12632 else
8 12633 begin
9 12634 hægtstring(d.opref.data,i,<: BST:>);
9 12635 anbringtal(d.opref.data,i,k-'@',1);
9 12636 end;
8 12637 end;
7 12638 skrivtegn(d.opref.data,i,' ');
7 12639 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12640 skrivtegn(d.opref.data,i,' ');
7 12641 hægtstring(d.opref.data,i,
7 12642 string område_navn(kanal_til_omr(j)));
7 12643 if '@'<=tegn and tegn<='F' then
7 12644 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12645 <*@*> <:: ukendt fejl:>,
7 12646 <*A*> <:: compad-fejl:>,
7 12647 <*B*> <:: ladefejl:>,
7 12648 <*C*> <:: dør åben:>,
7 12649 <*D*> <:: senderfejl:>,
7 12650 <*E*> <:: compad ok:>,
7 12651 <*F*> <:: liniefejl:>,
7 12652 <::>))
7 12653 else
7 12654 begin
8 12655 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12656 skrivtegn(d.opref.data,i,tegn);
8 12657 end;
7 12658 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12659 signalch(cs_io,opref,gen_optype or rad_optype);
7 12660 ref:= (j-1)*kanalbeskrlængde;
7 12661 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12662 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12663 signalbin(bs_mobilopkald);
7 12664 end;
6 12665 \f
6 12665 message procedure radio_ind side 11 - 881107/cl;
6 12666 end
5 12667 else
5 12668 if htyp='G' then
5 12669 begin <* fjerninkludering/-ekskludering af område *>
6 12670 bs:= læstegn(tlgr,9,tegn)-'@';
6 12671 j:= 0;
6 12672 for i:= 1 step 1 until max_antal_kanaler do
6 12673 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12674 if j<>0 then
6 12675 begin
7 12676 ref:= (j-1)*kanalbeskrlængde;
7 12677 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12678 end;
6 12679 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12680 signalbin(bs_mobilopkald);
6 12681 ac:= 0;
6 12682 end
5 12683 else
5 12684 if htyp='L' then
5 12685 begin <* vogntabelændringer *>
6 12686 long field ll;
6 12687
6 12687 ll:= 10;
6 12688 ac:= 0;
6 12689 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12690 læstegn(tlgr,9,tegn);
6 12691 if (tegn='N') or (tegn='O') then
6 12692 begin
7 12693 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12694 typ(2):= -1;
7 12695 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12696 if opref>0 then
7 12697 begin
8 12698 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12699 signalch(d.opref.retur,opref,d.opref.optype);
8 12700 end;
7 12701 ac:= -1;
7 12702 end
6 12703 else
6 12704 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12705 ac:= -1
6 12706 else
6 12707 if tegn='G' then <*indkodning*>
6 12708 begin
7 12709 pos:= 10; i:= 0;
7 12710 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12711 i:= i*10 + (tegn-'0');
7 12712 i:= i mod 1000;
7 12713 b_pn:= (1 shift 22) + (i shift 12);
7 12714 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12715 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12716 pos:= 14; i:= 0;
7 12717 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12718 i:= i*10 + (tegn-'0');
7 12719 b_pn:= b_pn + i;
7 12720 pos:= 16; i:= 0;
7 12721 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12722 i:= i*10 + (tegn-'0');
7 12723 b_pt:= i;
7 12724 bs:= 11;
7 12725 \f
7 12725 message procedure radio_ind side 12 - 881107/cl;
7 12726 end
6 12727 else
6 12728 if tegn='H' then <*udkodning*>
6 12729 begin
7 12730 pos:= 10; i:= 0;
7 12731 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12732 i:= i*10 + (tegn-'0');
7 12733 b_pt:= i;
7 12734 b_pn:= 0;
7 12735 bs:= 12;
7 12736 end
6 12737 else
6 12738 if tegn='I' then <*slet tabel*>
6 12739 begin
7 12740 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12741 pos:= 10; i:= 0;
7 12742 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12743 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12744 zno:= i;
7 12745 end
6 12746 else ac:= 2;
6 12747 if ac<0 then
6 12748 ac:= 0
6 12749 else
6 12750
6 12750 if ac=0 then
6 12751 begin
7 12752 waitch(cs_vt_adgang,opref,true,-1);
7 12753 startoperation(opref,401,cs_vt_adgang,bs);
7 12754 d.opref.data(1):= b_pt;
7 12755 d.opref.data(2):= b_pn;
7 12756 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12757 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12758 end;
6 12759 end
5 12760 else
5 12761 ac:= 2;
5 12762
5 12762 pos:= 1;
5 12763 skrivtegn(answ,pos,'H');
5 12764 skrivtegn(answ,pos,' ');
5 12765 skrivtegn(answ,pos,ac+'@');
5 12766 i:= 1; sum:= 0;
5 12767 while i < pos do
5 12768 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12769 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12770 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12771 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12772 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12773 disable begin
6 12774 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12775 outchar(zrl,'nl');
6 12776 end;
5 12777 <*-2*>
5 12778 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12779 disable setposition(z_fr_out,0,0);
5 12780 ac:= -1;
5 12781 \f
5 12781 message procedure radio_ind side 13 - 881107/cl;
5 12782 end
4 12783 else
4 12784 if ttyp = 'I' then
4 12785 begin
5 12786 typ(1):= -1;
5 12787 repeat
5 12788 getch(cs_radio_ind,opref,true,typ,val);
5 12789 if opref<>0 then
5 12790 begin
6 12791 d.opref.resultat:= 31;
6 12792 signalch(d.opref.retur,opref,d.opref.op_type);
6 12793 end;
5 12794 until opref=0;
5 12795 for i:= 1 step 1 until max_antal_taleveje do
5 12796 if læsbit_ia(hookoff_maske,i) then
5 12797 begin
6 12798 signalbin(bs_talevej_udkoblet(i));
6 12799 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12800 end;
5 12801 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12802 signal_bin(bs_mobil_opkald);
5 12803 for i:= 1 step 1 until max_antal_kanaler do
5 12804 begin
6 12805 ref:= (i-1)*kanalbeskrlængde;
6 12806 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12807 begin
7 12808 if kanal_tab.ref.kanal_id2<>0 and
7 12809 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12810 then
7 12811 begin
8 12812 signal(ss_samtale_nedlagt(i));
8 12813 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12814 end;
7 12815 if kanal_tab.ref.kanal_id1<>0 then
7 12816 begin
8 12817 signal(ss_samtale_nedlagt(i));
8 12818 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12819 end;
7 12820 end;
6 12821 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12822 end;
5 12823 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12824 startoperation(opref,401,cs_radio_pulje,23);
5 12825 i:= 1;
5 12826 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12827 j:= 4;
5 12828 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12829 begin
6 12830 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12831 end;
5 12832 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12833 signalch(cs_io,opref,gen_optype or rad_optype);
5 12834 optaget_flag:= 0;
5 12835 pos:= i:= 1; sum:= 0;
5 12836 skrivtegn(answ,pos,'I');
5 12837 skrivtegn(answ,pos,' ');
5 12838 skrivtegn(answ,pos,'@');
5 12839 while i<pos do
5 12840 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12841 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12842 skrivtegn(answ,pos,sum extract 4 + '@');
5 12843 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12844 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12845 disable begin
6 12846 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12847 outchar(zrl,'nl');
6 12848 end;
5 12849 <*-2*>
5 12850 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12851 disable setposition(z_fr_out,0,0);
5 12852 ac:= -1;
5 12853 \f
5 12853 message procedure radio_ind side 14 - 881107/cl;
5 12854 end
4 12855 else
4 12856 if ttyp='L' then
4 12857 begin
5 12858 ac:= 0;
5 12859 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12860 if testbit21 then
5 12861 begin
6 12862 waitch(cs_radio_pulje,opref,true,-1);
6 12863 startoperation(opref,401,cs_radio_pulje,23);
6 12864 i:= 1;
6 12865 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12866 j:= 4;
6 12867 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12868 begin
7 12869 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12870 end;
6 12871 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12872 signalch(cs_io,opref,gen_optype or rad_optype);
6 12873 end; <*testbit21*>
5 12874 end
4 12875 else
4 12876 if ttyp='Z' then
4 12877 begin
5 12878 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12879 disable begin
6 12880 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12881 outchar(zrl,'nl');
6 12882 end;
5 12883 <*-2*>
5 12884 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12885 disable setposition(z_fr_out,0,0);
5 12886 ac:= -1;
5 12887 end
4 12888 else
4 12889 ac:= 1;
4 12890 end; <* telegram modtaget ok *>
3 12891 \f
3 12891 message procedure radio_ind side 15 - 881107/cl;
3 12892 if ac>=0 then
3 12893 begin
4 12894 pos:= i:= 1; sum:= 0;
4 12895 skrivtegn(answ,pos,ttyp);
4 12896 skrivtegn(answ,pos,' ');
4 12897 skrivtegn(answ,pos,ac+'@');
4 12898 while i<pos do
4 12899 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12900 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12901 skrivtegn(answ,pos, sum extract 4 + '@');
4 12902 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12903 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12904 disable begin
5 12905 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12906 outchar(zrl,'nl');
5 12907 end;
4 12908 <*-2*>
4 12909 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12910 disable setposition(z_fr_out,0,0);
4 12911 ac:= -1;
4 12912 end;
3 12913
3 12913 typ(1):= 0;
3 12914 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12915 rf:= 4;
3 12916 systime(1,0.0,val.rf);
3 12917 val.rf:= val.rf - 30.0;
3 12918 typ(3):= -1;
3 12919 repeat
3 12920 getch(cs_radio_ind,opref,true,typ,val);
3 12921 if opref>0 then
3 12922 begin
4 12923 d.opref.resultat:= 53; <*annuleret*>
4 12924 signalch(d.opref.retur,opref,d.opref.optype);
4 12925 end;
3 12926 until opref=0;
3 12927
3 12927 until false;
3 12928
3 12928 radio_ind_trap:
3 12929
3 12929 disable skriv_radio_ind(zbillede,1);
3 12930
3 12930 end radio_ind;
2 12931 \f
2 12931 message procedure radio_ud side 1 - 820301/hko;
2 12932
2 12932 procedure radio_ud(op);
2 12933 value op;
2 12934 integer op;
2 12935 begin
3 12936 integer array field opref,io_opref;
3 12937 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12938 integer array answ, tlgr(1:32);
3 12939 long array field laf;
3 12940
3 12940 procedure skriv_radio_ud(z,omfang);
3 12941 value omfang;
3 12942 zone z;
3 12943 integer omfang;
3 12944 begin integer i1;
4 12945 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12946 if omfang > 0 then
4 12947 disable begin real x; long array field tx;
5 12948 tx:= 0;
5 12949 trap(slut);
5 12950 write(z,"nl",1,
5 12951 <: opref: :>,opref,"nl",1,
5 12952 <: io-opref: :>,io_opref,"nl",1,
5 12953 <: opgave: :>,opgave,"nl",1,
5 12954 <: kode: :>,kode,"nl",1,
5 12955 <: pos: :>,pos,"nl",1,
5 12956 <: tegn: :>,tegn,"nl",1,
5 12957 <: i: :>,i,"nl",1,
5 12958 <: sum: :>,sum,"nl",1,
5 12959 <: rc: :>,rc,"nl",1,
5 12960 <: svar-status: :>,svar_status,"nl",1,
5 12961 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12962 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12963 <::>);
5 12964 skriv_coru(z,coru_no(402));
5 12965 slut:
5 12966 end; <*disable*>
4 12967 end skriv_radio_ud;
3 12968
3 12968 trap(radio_ud_trap);
3 12969 laf:= 0;
3 12970 stack_claim((if cm_test then 200 else 150) +35+100);
3 12971
3 12971 <*+2*>if testbit32 and overvåget or testbit28 then
3 12972 skriv_radio_ud(out,0);
3 12973 <*-2*>
3 12974
3 12974 io_opref:= op;
3 12975 \f
3 12975 message procedure radio_ud side 2 - 810529/hko;
3 12976
3 12976 repeat
3 12977
3 12977 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12978 kode:= d.op_ref.opkode;
3 12979 opgave:= kode shift(-12);
3 12980 kode:= kode extract 12;
3 12981 if opgave < 'A' or opgave > 'I' then
3 12982 begin
4 12983 d.opref.resultat:= 31;
4 12984 end
3 12985 else
3 12986 begin
4 12987 pos:= 1;
4 12988 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12989 begin
5 12990 skrivtegn(tlgr,pos,opgave);
5 12991 if d.opref.data(1) = 0 then
5 12992 begin
6 12993 skrivtegn(tlgr,pos,'G');
6 12994 skrivtegn(tlgr,pos,'A');
6 12995 end
5 12996 else
5 12997 begin
6 12998 skrivtegn(tlgr,pos,'D');
6 12999 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 13000 end;
5 13001 if opgave='A' then
5 13002 begin
6 13003 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 13004 end
5 13005 else
5 13006 if opgave='B' then
5 13007 begin
6 13008 skrivtegn(tlgr,pos,d.opref.data(2));
6 13009 if d.opref.data(2)='V' then
6 13010 begin
7 13011 skrivtegn(tlgr,pos,
7 13012 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 13013 skrivtegn(tlgr,pos,
7 13014 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 13015 end;
6 13016 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 13017 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 13018 end
5 13019 else
5 13020 if opgave='H' then
5 13021 begin
6 13022 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 13023 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 13024 hægtstring(tlgr,pos,<:@@@:>);
6 13025 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 13026 skrivtegn(tlgr,pos,'A');
6 13027 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 13028 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 13029 if d.opref.data(2)='L' then
6 13030 begin
7 13031 if d.opref.data(5)=7 then
7 13032 begin
8 13033 anbringtal(tlgr,pos,
8 13034 d.opref.data(8) shift (-12) extract 10,-4);
8 13035 anbringtal(tlgr,pos,
8 13036 d.opref.data(8) extract 7,-2);
8 13037 end
7 13038 else
7 13039 if d.opref.data(5)=8 then
7 13040 begin
8 13041 hægtstring(tlgr,pos,<:FFFFFF:>);
8 13042 end;
7 13043 if d.opref.data(5)<>9 then
7 13044 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 13045 skrivtegn(tlgr,pos,
7 13046 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 13047 skrivtegn(tlgr,pos,
7 13048 dec_to_hex(d.opref.data(6) extract 4));
7 13049 skrivtegn(tlgr,10,pos-11+'@');
7 13050 end;
6 13051 end;
5 13052 end
4 13053 else
4 13054 if opgave='I' then
4 13055 begin
5 13056 hægtstring(tlgr,pos,<:IGA:>);
5 13057 end
4 13058 else d.opref.resultat:= 31; <*systemfejl*>
4 13059 end;
3 13060 \f
3 13060 message procedure radio_ud side 3 - 881107/cl;
3 13061
3 13061 if d.opref.resultat=0 then
3 13062 begin
4 13063 if (opgave <= 'B')
4 13064 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 13065 begin
5 13066 systime(1,0,d.opref.tid);
5 13067 signalch(cs_radio_ind,opref,d.opref.optype);
5 13068 opref:= 0;
5 13069 end;
4 13070 <* beregn checksum og send *>
4 13071 i:= 1; sum:= 0;
4 13072 while i < pos do
4 13073 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 13074 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 13075 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 13076 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 13077 <**********************************************>
4 13078 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 13079
4 13079 if opgave='B' then delay(1);
4 13080
4 13080 <* 94.04.19/cl *>
4 13081 <**********************************************>
4 13082
4 13082 <*+2*> if (testbit36 or testbit39) and overvåget then
4 13083 disable begin
5 13084 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 13085 outchar(zrl,'nl');
5 13086 end;
4 13087 <*-2*>
4 13088 setposition(z_rf_in,0,0);
4 13089 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 13090 disable setposition(z_rf_out,0,0);
4 13091 rc:= 0;
4 13092
4 13092 <* afvent svar*>
4 13093 repeat
4 13094 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 13095 if svar_status=6 then
4 13096 begin
5 13097 svar_status:= -3;
5 13098 goto radio_ud_check;
5 13099 end;
4 13100 pos:= 1;
4 13101 while læstegn(answ,pos,i)<>0 do ;
4 13102 pos:= pos-2;
4 13103 if pos > 0 then
4 13104 begin
5 13105 if pos<3 then
5 13106 svar_status:= -2 <*format error*>
5 13107 else
5 13108 begin
6 13109 if læstegn(answ,3,tegn)<>'@' then
6 13110 svar_status:= tegn - '@'
6 13111 else
6 13112 begin
7 13113 pos:= 1;
7 13114 læstegn(answ,pos,tegn);
7 13115 if tegn<>opgave then
7 13116 svar_status:= -4 <*gal type*>
7 13117 else
7 13118 if læstegn(answ,pos,tegn)<>' ' then
7 13119 svar_status:= -tegn <*fejl*>
7 13120 else
7 13121 svar_status:= læstegn(answ,pos,tegn)-'@';
7 13122 end;
6 13123 end;
5 13124 end
4 13125 else
4 13126 svar_status:= -1;
4 13127 \f
4 13127 message procedure radio_ud side 5 - 881107/cl;
4 13128
4 13128 radio_ud_check:
4 13129 rc:= rc+1;
4 13130 if -3<=svar_status and svar_status< -1 then
4 13131 disable begin
5 13132 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
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: Z@@MJ:>);
6 13137 outchar(zrl,'nl');
6 13138 end;
5 13139 <*-2*>
5 13140 end
4 13141 else
4 13142 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 13143 disable begin
5 13144 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 13145 setposition(z_rf_out,0,0);
5 13146 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13147 begin
6 13148 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 13149 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 13150 end;
5 13151 <*-2*>
5 13152 end
4 13153 else
4 13154 if svar_status=0 and opref<>0 then
4 13155 d.opref.resultat:= 0
4 13156 else
4 13157 if opref<>0 then
4 13158 d.opref.resultat:= 31;
4 13159 until svar_status=0 or rc>3;
4 13160 end;
3 13161 if opref<>0 then
3 13162 begin
4 13163 if svar_status<>0 and rc>3 then
4 13164 d.opref.resultat:= 53; <* annulleret *>
4 13165 signalch(d.opref.retur,opref,d.opref.optype);
4 13166 opref:= 0;
4 13167 end;
3 13168 until false;
3 13169
3 13169 radio_ud_trap:
3 13170
3 13170 disable skriv_radio_ud(zbillede,1);
3 13171
3 13171 end radio_ud;
2 13172 \f
2 13172 message procedure radio_medd_opkald side 1 - 810610/hko;
2 13173
2 13173 procedure radio_medd_opkald;
2 13174 begin
3 13175 integer array field ref,op_ref;
3 13176 integer i;
3 13177
3 13177 procedure skriv_radio_medd_opkald(z,omfang);
3 13178 value omfang;
3 13179 zone z;
3 13180 integer omfang;
3 13181 begin integer x;
4 13182 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 13183 write(z,"sp",26-x);
4 13184 if omfang > 0 then
4 13185 disable begin
5 13186 trap(slut);
5 13187 write(z,"nl",1,
5 13188 <: ref: :>,ref,"nl",1,
5 13189 <: opref: :>,op_ref,"nl",1,
5 13190 <: i: :>,i,"nl",1,
5 13191 <::>);
5 13192 skriv_coru(z,abs curr_coruno);
5 13193 slut:
5 13194 end;<*disable*>
4 13195 end skriv_radio_medd_opkald;
3 13196
3 13196 trap(radio_medd_opkald_trap);
3 13197
3 13197 stack_claim((if cm_test then 200 else 150) +1);
3 13198
3 13198 <*+2*>if testbit32 and overvåget or testbit28 then
3 13199 disable skriv_radio_medd_opkald(out,0);
3 13200 <*-2*>
3 13201 \f
3 13201 message procedure radio_medd_opkald side 2 - 820301/hko;
3 13202
3 13202 repeat
3 13203
3 13203 <*V*> wait(bs_mobil_opkald);
3 13204 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 13205 <*V*> wait(bs_opkaldskø_adgang);
3 13206
3 13206 ref:= første_nød_opkald;
3 13207 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 13208 begin
4 13209 i:= opkaldskø.ref(2);
4 13210 if i < 0 then
4 13211 begin
5 13212 <* nødopkald ikke meldt *>
5 13213
5 13213 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 13214 d.op_ref.data(1):= <* vogn_id *>
5 13215 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 13216 opkaldskø.ref(2):= i extract 22;
5 13217 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 13218 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 13219 i:= op_ref;
5 13220 <*+2*> if testbit35 and overvåget then
5 13221 disable begin
6 13222 write(out,"nl",1,<:radio nød-medd:>);
6 13223 skriv_op(out,op_ref);
6 13224 ud;
6 13225 end;
5 13226 <*-2*>
5 13227 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 13228 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 13229 <*+4*> if i <> op_ref then
5 13230 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 13231 <*-4*>
5 13232 end;<*nødopkald ikke meldt*>
4 13233
4 13233 ref:= opkaldskø.ref(1) extract 12;
4 13234 end; <* melding til io *>
3 13235 \f
3 13235 message procedure radio_medd_opkald side 3 - 820304/hko;
3 13236
3 13236 start_operation(op_ref,403,cs_radio_medd,
3 13237 40<*opdater opkaldskøbill*>);
3 13238 signal_bin(bs_opkaldskø_adgang);
3 13239 <*+2*> if testbit35 and overvåget then
3 13240 disable begin
4 13241 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 13242 skriv_op(out,op_ref);
4 13243 write(out, <:opkaldsflag: :>,"nl",1);
4 13244 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 13245 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 13246 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 13247 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 13248 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 13249 ud;
4 13250 end;
3 13251 <*-2*>
3 13252 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 13253
3 13253 until false;
3 13254
3 13254 radio_medd_opkald_trap:
3 13255
3 13255 disable skriv_radio_medd_opkald(zbillede,1);
3 13256
3 13256 end radio_medd_opkald;
2 13257 \f
2 13257 message procedure radio_adm side 1 - 820301/hko;
2 13258
2 13258 procedure radio_adm(op);
2 13259 value op;
2 13260 integer op;
2 13261 begin
3 13262 integer array field opref, rad_op, iaf;
3 13263 integer nr,i,j,k,res,opgave,tilst,operatør;
3 13264
3 13264 procedure skriv_radio_adm(z,omfang);
3 13265 value omfang;
3 13266 zone z;
3 13267 integer omfang;
3 13268 begin integer i1;
4 13269 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 13270 write(z,"sp",26-i1);
4 13271 if omfang > 0 then
4 13272 disable begin real x;
5 13273 trap(slut);
5 13274 \f
5 13274 message procedure radio_adm side 2- 820301/hko;
5 13275
5 13275 write(z,"nl",1,
5 13276 <: op_ref: :>,op_ref,"nl",1,
5 13277 <: iaf: :>,iaf,"nl",1,
5 13278 <: rad-op: :>,rad_op,"nl",1,
5 13279 <: nr: :>,nr,"nl",1,
5 13280 <: i: :>,i,"nl",1,
5 13281 <: j: :>,j,"nl",1,
5 13282 <: k: :>,k,"nl",1,
5 13283 <: tilst: :>,tilst,"nl",1,
5 13284 <: res: :>,res,"nl",1,
5 13285 <: opgave: :>,opgave,"nl",1,
5 13286 <: operatør: :>,operatør,"nl",1);
5 13287 skriv_coru(z,coru_no(404));
5 13288 slut:
5 13289 end;<*disable*>
4 13290 end skriv_radio_adm;
3 13291 \f
3 13291 message procedure radio_adm side 3 - 820304/hko;
3 13292
3 13292 rad_op:= op;
3 13293
3 13293 trap(radio_adm_trap);
3 13294 stack_claim((if cm_test then 200 else 150) +50);
3 13295
3 13295 <*+2*>if testbit32 and overvåget or testbit28 then
3 13296 skriv_radio_adm(out,0);
3 13297 <*-2*>
3 13298
3 13298 pass;
3 13299 if -,testbit22 then
3 13300 begin
4 13301 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13302 signalch(cs_radio_ud,rad_op,rad_optype);
4 13303 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13304 end;
3 13305 repeat
3 13306 waitch(cs_radio_adm,opref,true,-1);
3 13307 <*+2*>
3 13308 if testbit33 and overvåget then
3 13309 disable begin
4 13310 skriv_radio_adm(out,0);
4 13311 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 13312 skriv_op(out,opref);
4 13313 end;
3 13314 <*-2*>
3 13315
3 13315 k:= d.op_ref.opkode extract 12;
3 13316 opgave:= d.opref.opkode shift (-12);
3 13317 nr:=operatør:=d.op_ref.data(1);
3 13318
3 13318 <*+4*> if (d.op_ref.optype and
3 13319 (gen_optype or io_optype or op_optype or vt_optype))
3 13320 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 13321 <:radio_adm:>,0);
3 13322 <*-4*>
3 13323 if k = 74 <* RA,I *> then
3 13324 begin
4 13325 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13326 signalch(cs_radio_ud,rad_op,rad_optype);
4 13327 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13328 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 13329 else d.rad_op.resultat;
4 13330 signalch(d.opref.retur,opref,d.opref.optype);
4 13331 \f
4 13331 message procedure radio_adm side 4 - 820301/hko;
4 13332 end
3 13333 else
3 13334
3 13334 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 13335 k = 5<*FO,L*> or k = 6<*ST *> then
3 13336 begin
4 13337 if k = 5 or k=77 then
4 13338 begin
5 13339
5 13339 <*V*> wait(bs_opkaldskø_adgang);
5 13340 if k=5 then
5 13341 begin
6 13342 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 13343 begin
7 13344 i:= læs_fil(1035,iaf//512+1,nr);
7 13345 if i <> 0 then
7 13346 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 13347 tofrom(radio_linietabel.iaf,fil(nr),
7 13348 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 13349 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 13350 end;
6 13351
6 13351 for i:= 1 step 1 until max_antal_mobilopkald do
6 13352 begin
7 13353 iaf:= i*opkaldskø_postlængde;
7 13354 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 13355 if nr>0 then
7 13356 begin
8 13357 læs_tegn(radio_linietabel,nr+1,operatør);
8 13358 if operatør>max_antal_operatører then operatør:= 0;
8 13359 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 13360 operatør;
8 13361 end;
7 13362 end;
6 13363 end
5 13364 else
5 13365 if k=77 then
5 13366 begin
6 13367 disable i:= læsfil(1034,1,nr);
6 13368 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 13369 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 13370 for i:= 1 step 1 until max_antal_mobilopkald do
6 13371 begin
7 13372 iaf:= i*opkaldskø_postlængde;
7 13373 nr:= opkaldskø.iaf(5) extract 4;
7 13374 operatør:= radio_områdetabel(nr);
7 13375 if operatør < 0 or max_antal_operatører < operatør then
7 13376 operatør:= 0;
7 13377 if opkaldskø.iaf(4) extract 8=0 and
7 13378 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13379 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13380 operatør;
7 13381 end;
6 13382 end;
5 13383
5 13383 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13384 signal_bin(bs_opkaldskø_adgang);
5 13385
5 13385 signal_bin(bs_mobil_opkald);
5 13386
5 13386 d.op_ref.resultat:= res:= 3;
5 13387 \f
5 13387 message procedure radio_adm side 5 - 820304/hko;
5 13388
5 13388 end <*k = 5 / k = 77*>
4 13389 else
4 13390 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13391 res:= 3;
5 13392 for nr:= 1 step 1 until max_antal_kanaler do
5 13393 begin
6 13394 iaf:= (nr-1)*kanal_beskr_længde;
6 13395 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13396 op_talevej(operatør) then
6 13397 begin
7 13398 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13399 if tilst <> 0 then
7 13400 res:= 16; <*skærm optaget*>
7 13401 end; <* kanal_tab(operatør) = operatør*>
6 13402 end;
5 13403 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13404 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13405 signal_bin(bs_mobil_opkald);
5 13406 d.op_ref.resultat:= res;
5 13407 end;<*k=1,2 eller 6 *>
4 13408
4 13408 <*+2*> if testbit35 and overvåget then
4 13409 disable begin
5 13410 skriv_radio_adm(out,0);
5 13411 write(out,<: sender til :>,
5 13412 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13413 else cs_op);
5 13414 skriv_op(out,op_ref);
5 13415 end;
4 13416 <*-2*>
4 13417
4 13417 if k=5 or k=6 or k=77 or res > 3 then
4 13418 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13419 else
4 13420 begin <*k = (1 eller 2) og res = 3 *>
5 13421 d.op_ref.resultat:=0;
5 13422 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13423 end;
4 13424 \f
4 13424 message procedure radio_adm side 6 - 816610/hko;
4 13425
4 13425 end <*k=1,2,5 eller 6*>
3 13426 else
3 13427 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13428 begin
4 13429 nr:= d.op_ref.data(1);
4 13430 res:= 3;
4 13431
4 13431 if nr<=3 then
4 13432 res:= 51 <* afvist *>
4 13433 else
4 13434 begin
5 13435
5 13435 <* gennemstilling af område *>
5 13436 j:= 1;
5 13437 for i:= 1 step 1 until max_antal_kanaler do
5 13438 begin
6 13439 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13440 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13441 end;
5 13442 nr:= j;
5 13443 iaf:= (nr-1)*kanalbeskrlængde;
5 13444 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13445 begin
6 13446 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13447 d.rad_op.data(1):= 0;
6 13448 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13449 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13450 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13451 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13452 signalch(cs_radio_ud,rad_op,rad_optype);
6 13453 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13454 res:= d.rad_op.resultat;
6 13455 if res=0 then res:= 3;
6 13456 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13457 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13458 end;
5 13459 end;
4 13460 d.op_ref.resultat:=res;
4 13461 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13462 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13463 signal_bin(bs_mobil_opkald);
4 13464 \f
4 13464 message procedure radio_adm side 7 - 880930/cl;
4 13465
4 13465
4 13465 end <* k=3 eller 4 *>
3 13466 else
3 13467 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13468 begin
4 13469 nr:= d.opref.data(1) extract 22;
4 13470 res:= 3;
4 13471 iaf:= (nr-1)*kanalbeskrlængde;
4 13472 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13473 d.rad_op.data(1):= 0;
4 13474 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13475 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13476 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13477 d.rad_op.data(5):= k extract 1;
4 13478 signalch(cs_radio_ud,radop,rad_optype);
4 13479 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13480 res:= d.radop.resultat;
4 13481 if res=0 then res:= 3;
4 13482 j:= if k=72 then 15 else 0;
4 13483 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13484 begin
5 13485 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13486 signalbin(bs_mobilopkald);
5 13487 end;
4 13488 d.opref.resultat:= res;
4 13489 signalch(d.opref.retur,opref,d.opref.optype);
4 13490 end
3 13491 else
3 13492 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13493 begin
4 13494 nr:= d.opref.data(1) extract 8;
4 13495 opgave:= if k=19 then 9 else (k-4);
4 13496 if nr<=3 then
4 13497 res:= 51 <*afvist*>
4 13498 else
4 13499 begin
5 13500 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13501 d.radop.data(1):= 0;
5 13502 d.radop.data(2):= 'L';
5 13503 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13504 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13505 d.radop.data(5):= opgave;
5 13506 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13507 d.radop.data(7):= d.opref.data(2);
5 13508 d.radop.data(8):= d.opref.data(3);
5 13509 signalch(cs_radio_ud,radop,rad_optype);
5 13510 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13511 res:= d.radop.resultat;
5 13512 if res=0 then res:= 3;
5 13513 end;
4 13514 d.opref.resultat:= res;
4 13515 signalch(d.opref.retur,opref,d.opref.optype);
4 13516 end
3 13517 else
3 13518
3 13518 begin
4 13519
4 13519 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13520
4 13520 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13521
4 13521 end;
3 13522
3 13522 until false;
3 13523 radio_adm_trap:
3 13524 disable skriv_radio_adm(zbillede,1);
3 13525 end radio_adm;
2 13526
2 13526 \f
2 13526 message vogntabel erklæringer side 1 - 820301/cl;
2 13527
2 13527 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13528 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13529 cs_vt_log;
2 13530 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13531 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13532 vt_log_slicelgd;
2 13533 integer array bustabel,bustabel1(0:max_antal_busser),
2 13534 linie_løb_tabel(0:max_antal_linie_løb),
2 13535 springtabel(1:max_antal_spring,1:3),
2 13536 gruppetabel(1:max_antal_grupper),
2 13537 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13538 vt_logop(1:2),
2 13539 vt_logdisc(1:4),
2 13540 vt_log_tail(1:10);
2 13541 boolean array busindeks(-1:max_antal_linie_løb),
2 13542 bustilstand(-1:max_antal_busser),
2 13543 linie_løb_indeks(-1:max_antal_busser);
2 13544 real array springtid,springstart(1:max_antal_spring);
2 13545 real vt_logstart;
2 13546 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13547 integer array field v_tekst;
2 13548 real field v_tid;
2 13549
2 13549 zone zvtlog(128,1,stderror);
2 13550
2 13550 \f
2 13550 message vogntabel erklæringer side 2 - 851001/cl;
2 13551
2 13551 procedure skriv_vt_variable(zud);
2 13552 zone zud;
2 13553 begin integer i; long array field laf;
3 13554 laf:= 0;
3 13555 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13556 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13557 <:cs-vt :>,cs_vt,"nl",1,
3 13558 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13559 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13560 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13561 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13562 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13563 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13564 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13565 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13566 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13567 <:vt-op :>,vt_op,"nl",1,
3 13568 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13569 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13570 <:sidste-bus :>,sidste_bus,"nl",1,
3 13571 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13572 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13573 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13574 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13575 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13576 <:tf-springdef :>,tf_springdef,"nl",1,
3 13577 <:vt-logskift :>,vt_logskift,"nl",1,
3 13578 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13579 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13580 <:vt-log-aktiv :>,
3 13581 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13582 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13583 <::>);
3 13584 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13585 laf:= 2;
3 13586 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13587 for i:= 6 step 1 until 10 do
3 13588 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13589 write(zud,"nl",1);
3 13590 end;
2 13591 \f
2 13591 message procedure p_vogntabel side 1 - 820301/cl;
2 13592
2 13592 procedure p_vogntabel(z);
2 13593 zone z;
2 13594 begin
3 13595 integer i,b,s,o,t,li,lb,lø,g;
3 13596 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13597 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13598 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13599 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13600
3 13600 for i:= 1 step 1 until sidste_bus do
3 13601 begin
4 13602 b:= bustabel(i) extract 14;
4 13603 g:= bustabel(i) shift (-14);
4 13604 s:= bustabel1(i) shift (-23);
4 13605 o:= bustabel1(i) extract 8;
4 13606 t:= intg(bustilstand(i));
4 13607 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13608 lø:= li extract 7;
4 13609 lb:= li shift (-7) extract 5;
4 13610 lb:= if lb=0 then 32 else lb+64;
4 13611 li:= li shift (-12) extract 10;
4 13612 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13613 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13614 if g > 0 then string bpl_navn(g) else <: :>,
4 13615 ";",1,true,4,string område_navn(o),
4 13616 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13617 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13618 end;
3 13619 end p_vogntabel;
2 13620 \f
2 13620 message procedure p_gruppetabel side 1 - 810531/cl;
2 13621
2 13621 procedure p_gruppetabel(z);
2 13622 zone z;
2 13623 begin
3 13624 integer i,nr,bogst;
3 13625 boolean spc_gr;
3 13626 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13627 <:max-antal-grupper =:>,max_antal_grupper,
3 13628 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13629 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13630 <:gruppetabel::>);
3 13631 for i:= 1 step 1 until max_antal_grupper do
3 13632 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13633 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13634 gruppetabel(i) extract 7);
3 13635 write(z,"nl",2,<:gruppeopkald::>);
3 13636 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13637 begin
4 13638 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13639 if gruppeopkald(i,1) = 0 then
4 13640 write(z,"sp",11)
4 13641 else
4 13642 begin
5 13643 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13644 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13645 else
5 13646 begin
6 13647 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13648 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13649 if bogst = '@' then bogst:= 'sp';
6 13650 end;
5 13651 if spc_gr then
5 13652 write(z,<:(G:>,<<d>,true,3,nr)
5 13653 else
5 13654 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13655 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13656 end;
4 13657 end;
3 13658 end p_gruppetabel;
2 13659 \f
2 13659 message procedure p_springtabel side 1 - 810519/cl;
2 13660
2 13660 procedure p_springtabel(z);
2 13661 zone z;
2 13662 begin
3 13663 integer li,bo,max,st,nr;
3 13664 long indeks;
3 13665 real t;
3 13666
3 13666 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13667 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13668 <:nr spring-id max status næste-tid:>,"nl",1);
3 13669 for nr:= 1 step 1 until max_antal_spring do
3 13670 begin
4 13671 write(z,<<dd>,nr);
4 13672 <* if springtabel(nr,1)<>0 then *>
4 13673 begin
5 13674 li:= springtabel(nr,1) shift (-5) extract 10;
5 13675 bo:= springtabel(nr,1) extract 5;
5 13676 if bo<>0 then bo:= bo + 'A' - 1;
5 13677 indeks:= extend springtabel(nr,2) shift 24;
5 13678 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13679 max:= springtabel(nr,3) extract 12;
5 13680 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13681 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13682 if springtid(nr)<>0.0 then
5 13683 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13684 else
5 13685 write(z,<< d.d >,0.0);
5 13686 if springstart(nr)<>0.0 then
5 13687 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13688 else
5 13689 write(z,<< d.d >,0.0);
5 13690 end
4 13691 <* else
4 13692 write(z,<: --------:>)*>;
4 13693 write(z,"nl",1);
4 13694 end;
3 13695 end p_springtabel;
2 13696 \f
2 13696 message procedure find_busnr side 1 - 820301/cl;
2 13697
2 13697 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13698 value ll_id;
2 13699 integer ll_id, busnr, garage, tilst;
2 13700 begin
3 13701 integer i,j;
3 13702
3 13702 j:= binærsøg(sidste_linie_løb,
3 13703 (linie_løb_tabel(i) - ll_id), i);
3 13704 if j<>0 then <* linie/løb findes ikke *>
3 13705 begin
4 13706 find_busnr:= -1;
4 13707 busnr:= 0;
4 13708 garage:= 0;
4 13709 tilst:= 0;
4 13710 end
3 13711 else
3 13712 begin
4 13713 busnr:= bustabel(busindeks(i) extract 12);
4 13714 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13715 garage:= busnr shift (-14);
4 13716 busnr:= busnr extract 14;
4 13717 find_busnr:= busindeks(i) extract 12;
4 13718 end;
3 13719 end find_busnr;
2 13720 \f
2 13720 message procedure søg_omr_bus side 1 - 881027/cl;
2 13721
2 13721
2 13721 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13722 value bus;
2 13723 integer bus,ll,gar,omr,sig,tilst;
2 13724 begin
3 13725 integer i,j,nr,bu,bi,bl;
3 13726
3 13726 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13727 nr:= -1;
3 13728 if j=0 then
3 13729 begin
4 13730 bl:= bu:= bi;
4 13731 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13732 while bu<sidste_bus and
4 13733 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13734
4 13734 if bl<>bu then
4 13735 begin
5 13736 <* flere busser med samme tekniske nr. omr skal passe *>
5 13737 nr:= -2;
5 13738 for bi:= bl step 1 until bu do
5 13739 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13740 end
4 13741 else
4 13742 nr:= bi;
4 13743 end;
3 13744
3 13744 if nr<0 then
3 13745 begin
4 13746 <* bus findes ikke *>
4 13747 ll:= gar:= tilst:= sig:= 0;
4 13748 end
3 13749 else
3 13750 begin
4 13751 tilst:= intg(bustilstand(nr));
4 13752 gar:= bustabel(nr) shift (-14);
4 13753 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13754 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13755 sig:= bustabel1(nr) shift (-23);
4 13756 end;
3 13757 søg_omr_bus:= nr;
3 13758 end;
2 13759 \f
2 13759 message procedure find_linie_løb side 1 - 820301/cl;
2 13760
2 13760 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13761 value busnr;
2 13762 integer busnr, linie_løb, garage, tilst;
2 13763 begin
3 13764 integer i,j;
3 13765
3 13765 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13766
3 13766 if j<>0 then <* bus findes ikke *>
3 13767 begin
4 13768 find_linie_løb:= -1;
4 13769 linie_løb:= 0;
4 13770 garage:= 0;
4 13771 tilst:= 0;
4 13772 end
3 13773 else
3 13774 begin
4 13775 tilst:= intg(bustilstand(i));
4 13776 garage:= bustabel(i) shift (-14);
4 13777 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13778 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13779 end;
3 13780 end find_linie_løb;
2 13781 \f
2 13781 message procedure h_vogntabel side 1 - 810413/cl;
2 13782
2 13782 <* hovedmodulcorutine for vogntabelmodul *>
2 13783
2 13783 procedure h_vogntabel;
2 13784 begin
3 13785 integer array field op;
3 13786 integer dest_sem,k;
3 13787
3 13787 procedure skriv_h_vogntabel(zud,omfang);
3 13788 value omfang;
3 13789 zone zud;
3 13790 integer omfang;
3 13791 begin
4 13792 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13793 if omfang<>0 then
4 13794 disable
4 13795 begin
5 13796 skriv_coru(zud,abs curr_coruno);
5 13797 write(zud,"nl",1,<<d>,
5 13798 <:cs-vt :>,cs_vt,"nl",1,
5 13799 <:op :>,op,"nl",1,
5 13800 <:dest-sem :>,dest_sem,"nl",1,
5 13801 <:k :>,k,"nl",1,
5 13802 <::>);
5 13803 end;
4 13804 end;
3 13805 \f
3 13805 message procedure h_vogntabel side 2 - 820301/cl;
3 13806
3 13806 stackclaim(if cm_test then 198 else 146);
3 13807 trap(h_vt_trap);
3 13808
3 13808 <*+2*>
3 13809 <**> disable if testbit47 and overvåget or testbit28 then
3 13810 <**> skriv_h_vogntabel(out,0);
3 13811 <*-2*>
3 13812
3 13812 repeat
3 13813 waitch(cs_vt,op,true,-1);
3 13814 <*+4*>
3 13815 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13816 (d.op.optype and vt_optype) extract 12 = 0 then
3 13817 fejlreaktion(12,op,<:vogntabel:>,0);
3 13818 <*-4*>
3 13819 disable
3 13820 begin
4 13821
4 13821 k:= d.op.opkode extract 12;
4 13822 dest_sem:=
4 13823 if k = 9 then cs_vt_rap else
4 13824 if k = 10 then cs_vt_rap else
4 13825 if k = 11 then cs_vt_opd else
4 13826 if k = 12 then cs_vt_opd else
4 13827 if k = 13 then cs_vt_opd else
4 13828 if k = 14 then cs_vt_tilst else
4 13829 if k = 15 then cs_vt_tilst else
4 13830 if k = 16 then cs_vt_tilst else
4 13831 if k = 17 then cs_vt_tilst else
4 13832 if k = 18 then cs_vt_tilst else
4 13833 if k = 19 then cs_vt_opd else
4 13834 if k = 20 then cs_vt_opd else
4 13835 if k = 21 then cs_vt_auto else
4 13836 if k = 24 then cs_vt_opd else
4 13837 if k = 25 then cs_vt_grp else
4 13838 if k = 26 then cs_vt_grp else
4 13839 if k = 27 then cs_vt_grp else
4 13840 if k = 28 then cs_vt_grp else
4 13841 if k = 30 then cs_vt_spring else
4 13842 if k = 31 then cs_vt_spring else
4 13843 if k = 32 then cs_vt_spring else
4 13844 if k = 33 then cs_vt_spring else
4 13845 if k = 34 then cs_vt_spring else
4 13846 if k = 35 then cs_vt_spring else
4 13847 -1;
4 13848 \f
4 13848 message procedure h_vogntabel side 3 - 810422/cl;
4 13849
4 13849 <*+2*>
4 13850 <**> if testbit41 and overvåget then
4 13851 <**> begin
5 13852 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13853 <**> skriv_op(out,op);
5 13854 <**> end;
4 13855 <*-2*>
4 13856 end;
3 13857
3 13857 if dest_sem = -1 then
3 13858 fejlreaktion(2,k,<:vogntabel:>,0);
3 13859 disable signalch(dest_sem,op,d.op.optype);
3 13860 until false;
3 13861 h_vt_trap:
3 13862 disable skriv_h_vogntabel(zbillede,1);
3 13863 end h_vogntabel;
2 13864 \f
2 13864 message procedure vt_opdater side 1 - 810317/cl;
2 13865
2 13865 procedure vt_opdater(op1);
2 13866 value op1;
2 13867 integer op1;
2 13868 begin
3 13869 integer array field op,radop;
3 13870 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13871 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13872 flin,slin,finx,sinx;
3 13873 integer field bn,ll;
3 13874
3 13874 procedure skriv_vt_opd(zud,omfang);
3 13875 value omfang; integer omfang;
3 13876 zone zud;
3 13877 begin
4 13878 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13879 if omfang <> 0 then
4 13880 disable
4 13881 begin
5 13882 skriv_coru(zud,abs curr_coruno);
5 13883 write(zud,"nl",1,
5 13884 <: op: :>,op,"nl",1,
5 13885 <: radop::>,radop,"nl",1,
5 13886 <: funk: :>,funk,"nl",1,
5 13887 <: res: :>,res,"nl",1,
5 13888 <::>);
5 13889 end;
4 13890 end skriv_vt_opd;
3 13891
3 13891 integer procedure opd_omr(fnk,omr,bus,ll);
3 13892 value fnk,omr,bus,ll;
3 13893 integer fnk,omr,bus,ll;
3 13894 begin
4 13895 opd_omr:= 3;
4 13896 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13897 ændringer skal ikke længere meldes til yderområder *>
4 13898 goto dummy_retur;
4 13899
4 13899 if omr extract 8 > 3 then
4 13900 begin
5 13901 startoperation(radop,501,cs_vt_opd,fnk);
5 13902 d.radop.data(1):= omr;
5 13903 d.radop.data(2):= bus;
5 13904 d.radop.data(3):= ll;
5 13905 signalch(cs_rad,radop,vt_optype);
5 13906 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13907 opd_omr:= d.radop.resultat;
5 13908 end
4 13909 else
4 13910 opd_omr:= 0;
4 13911 dummy_retur:
4 13912 end;
3 13913 message procedure vt_opdater side 1a - 920517/cl;
3 13914
3 13914 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13915 value kilde,kode,bus,ll1,ll2;
3 13916 integer kilde,kode,bus,ll1,ll2;
3 13917 begin
4 13918 integer array field op;
4 13919
4 13919 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13920
4 13920 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13921 systime(1,0.0,d.op.data.v_tid);
4 13922 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13923 d.op.data.v_bus:= bus;
4 13924 d.op.data.v_ll1:= ll1;
4 13925 d.op.data.v_ll2:= ll2;
4 13926 signalch(cs_vt_log,op,vt_optype);
4 13927 end;
3 13928
3 13928 stackclaim((if cm_test then 198 else 146)+125);
3 13929
3 13929 bn:= 4; ll:= 2;
3 13930 radop:= op1;
3 13931 trap(vt_opd_trap);
3 13932
3 13932 <*+2*>
3 13933 <**> disable if testbit47 and overvåget or testbit28 then
3 13934 <**> skriv_vt_opd(out,0);
3 13935 <*-2*>
3 13936 \f
3 13936 message procedure vt_opdater side 2 - 851001/cl;
3 13937
3 13937 vent_op:
3 13938 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13939
3 13939 <*+2*>
3 13940 <**> disable
3 13941 <**> if testbit41 and overvåget then
3 13942 <**> begin
4 13943 <**> skriv_vt_opd(out,0);
4 13944 <**> write(out,<: modtaget operation:>);
4 13945 <**> skriv_op(out,op);
4 13946 <**> end;
3 13947 <*-2*>
3 13948
3 13948 <*+4*>
3 13949 <**>if op<>vt_op then
3 13950 <**>begin
4 13951 <**> disable begin
5 13952 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13953 <**> d.op.resultat:= 31; <*systemfejl*>
5 13954 <**> signalch(d.op.retur,op,d.op.optype);
5 13955 <**> end;
4 13956 <**> goto vent_op;
4 13957 <**>end;
3 13958 <*-4*>
3 13959 disable
3 13960 begin integer opk;
4 13961
4 13961 opk:= d.op.opkode extract 12;
4 13962 funk:= if opk=11 then 1 else
4 13963 if opk=12 then 2 else
4 13964 if opk=13 then 3 else
4 13965 if opk=19 then 4 else
4 13966 if opk=20 then 5 else
4 13967 if opk=24 then 6 else
4 13968 0;
4 13969 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13970 end;
3 13971 res:= 0;
3 13972 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13973 \f
3 13973 message procedure vt_opdater side 3 - 820301/cl;
3 13974
3 13974 indsæt:
3 13975 begin
4 13976 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13977 <*+4*>
4 13978 <**> if d.op.data(1) shift (-22) <> 0 then
4 13979 <**> begin
5 13980 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13981 <**> goto slut_indsæt;
5 13982 <**> end;
4 13983 <*-4*>
4 13984 busnr:= d.op.data(1) extract 14;
4 13985 <*+4*>
4 13986 <**> if d.op.data(2) shift (-22) <> 1 then
4 13987 <**> begin
5 13988 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13989 <**> goto slut_indsæt;
5 13990 <**> end;
4 13991 <*-4*>
4 13992 ll_id:= d.op.data(2);
4 13993 s:= omr:= d.op.data(4) extract 8;
4 13994 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13995 if bi<0 then
4 13996 begin
5 13997 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13998 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13999 end
4 14000 else
4 14001 if s<>0 and s<>omr then
4 14002 res:= 58 <* ulovligt område for bus *>
4 14003 else
4 14004 if intg(bustilstand(bi)) <> 0 then
4 14005 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 14006 else 14 <* optaget *>)
4 14007 else
4 14008 begin
5 14009 if linie_løb_indeks(bi) extract 12 <> 0 then
5 14010 begin <* linie/løb allerede indsat *>
6 14011 res:= 11;
6 14012 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 14013 end
5 14014 else
5 14015 begin
6 14016 \f
6 14016 message procedure vt_opdater side 3a - 900108/cl;
6 14017
6 14017 if d.op.kilde//100 <> 4 then
6 14018 res:= opd_omr(11,gar shift 8 +
6 14019 bustabel1(bi) extract 8,busnr,ll_id);
6 14020 if res>3 then goto slut_indsæt;
6 14021 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 14022 if s=0 then <* linie/løb findes allerede *>
6 14023 begin
7 14024 sig:= busindeks(li) extract 12;
7 14025 d.op.data(3):= bustabel(sig);
7 14026 linie_løb_indeks(sig):= false;
7 14027 disable modiffil(tf_vogntabel,sig,zi);
7 14028 fil(zi).ll:= 0;
7 14029 fil(zi).bn:= bustabel(sig) extract 14 add
7 14030 (bustabel1(sig) extract 8 shift 14);
7 14031 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 14032
7 14032 linie_løb_indeks(bi):= false add li;
7 14033 busindeks(li):= false add bi;
7 14034 disable modiffil(tf_vogntabel,bi,zi);
7 14035 fil(zi).ll:= ll_id;
7 14036 fil(zi).bn:= bustabel(bi) extract 14 add
7 14037 (bustabel1(bi) extract 8 shift 14);
7 14038 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 14039 res:= 3;
7 14040 end
6 14041 else
6 14042 begin
7 14043 \f
7 14043 message procedure vt_opdater side 4 - 810527/cl;
7 14044
7 14044 if s<0 then li:= li +1;
7 14045 if sidste_linie_løb=max_antal_linie_løb then
7 14046 begin
8 14047 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 14048 res:= 31;
8 14049 end
7 14050 else
7 14051 begin
8 14052 for i:= sidste_linie_løb step -1 until li do
8 14053 begin
9 14054 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 14055 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 14056 bus_indeks(i+1):=bus_indeks(i);
9 14057 end;
8 14058 sidste_linie_løb:= sidste_linie_løb +1;
8 14059 linie_løb_tabel(li):= ll_id;
8 14060 linie_løb_indeks(bi):= false add li;
8 14061 busindeks(li):= false add bi;
8 14062 disable s:= modiffil(tf_vogntabel,bi,zi);
8 14063 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 14064 fil(zi).bn:= busnr extract 14 add
8 14065 (bustabel1(bi) extract 8 shift 14);
8 14066 fil(zi).ll:= ll_id;
8 14067 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 14068 res:= 3; <* ok *>
8 14069 end;
7 14070 end;
6 14071 end;
5 14072 end;
4 14073 slut_indsæt:
4 14074 d.op.resultat:= res;
4 14075 end;
3 14076 goto returner;
3 14077 \f
3 14077 message procedure vt_opdater side 5 - 820301/cl;
3 14078
3 14078 udtag:
3 14079 begin
4 14080 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 14081
4 14081 busnr:= ll_id:= 0;
4 14082 omr:= s:= d.op.data(2) extract 8;
4 14083 format:= d.op.data(1) shift (-22);
4 14084 if format=0 then <*busnr*>
4 14085 begin
5 14086 busnr:= d.op.data(1) extract 14;
5 14087 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 14088 if bi<0 then
5 14089 begin
6 14090 if bi=-1 then res:= 10 else
6 14091 if s<>0 then res:= 58 else res:= 57;
6 14092 goto slut_udtag;
6 14093 end;
5 14094 if bi>0 and s<>0 and s<>omr then
5 14095 begin
6 14096 res:= 58; goto slut_udtag;
6 14097 end;
5 14098 li:= linie_løb_indeks(bi) extract 12;
5 14099 busnr:= bustabel(bi);
5 14100 if li=0 or linie_løb_tabel(li)=0 then
5 14101 begin <* bus ej indsat *>
6 14102 res:= 13;
6 14103 goto slut_udtag;
6 14104 end;
5 14105 ll_id:= linie_løb_tabel(li);
5 14106 end
4 14107 else
4 14108 if format=1 then <* linie_løb *>
4 14109 begin
5 14110 ll_id:= d.op.data(1);
5 14111 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 14112 if s<>0 then
5 14113 begin <* linie/løb findes ikke *>
6 14114 res:= 9;
6 14115 goto slut_udtag;
6 14116 end;
5 14117 bi:= busindeks(li) extract 12;
5 14118 busnr:= bustabel(bi);
5 14119 end
4 14120 else <* ulovlig identifikation *>
4 14121 begin
5 14122 res:= 31;
5 14123 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 14124 goto slut_udtag;
5 14125 end;
4 14126 \f
4 14126 message procedure vt_opdater side 6 - 820301/cl;
4 14127
4 14127 tilst:= intg(bustilstand(bi));
4 14128 if tilst<>0 then
4 14129 begin
5 14130 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 14131 goto slut_udtag;
5 14132 end;
4 14133 if d.op.kilde//100 <> 4 then
4 14134 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 14135 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 14136 if res>3 then goto slut_udtag;
4 14137 linie_løb_indeks(bi):= false;
4 14138 for i:= li step 1 until sidste_linie_løb -1 do
4 14139 begin
5 14140 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 14141 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 14142 bus_indeks(i):= bus_indeks(i+1);
5 14143 end;
4 14144 linie_løb_tabel(sidste_linie_løb):= 0;
4 14145 bus_indeks(sidste_linie_løb):= false;
4 14146 sidste_linie_løb:= sidste_linie_løb -1;
4 14147 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 14148 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 14149 fil(zi).ll:= 0;
4 14150 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 14151 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 14152 res:= 3; <* ok *>
4 14153 slut_udtag:
4 14154 d.op.resultat:= res;
4 14155 d.op.data(2):= ll_id;
4 14156 d.op.data(3):= busnr;
4 14157 end;
3 14158 goto returner;
3 14159 \f
3 14159 message procedure vt_opdater side 7 - 851001/cl;
3 14160
3 14160 omkod:
3 14161 flyt:
3 14162 roker:
3 14163 begin
4 14164 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 14165
4 14165 inf1:= inf2:= 0;
4 14166 ll_id1:= d.op.data(1);
4 14167 ll_id2:= d.op.data(2);
4 14168 if ll_id1=ll_id2 then
4 14169 begin
5 14170 res:= 24; inf1:= ll_id2;
5 14171 goto slut_flyt;
5 14172 end;
4 14173 <*+4*>
4 14174 <**> for i:= 1,2 do
4 14175 <**> if d.op.data(i) shift (-22) <> 1 then
4 14176 <**> begin
5 14177 <**> res:= 31;
5 14178 <**> fejlreaktion(10,d.op.data(i),case i of (
5 14179 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 14180 <**> goto slut_flyt;
5 14181 <**> end;
4 14182 <*-4*>
4 14183
4 14183 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 14184 if s<>0 and funk=6 <* roker *> then
4 14185 begin
5 14186 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 14187 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 14188 end;
4 14189 if s<>0 then
4 14190 begin
5 14191 res:= 9; <* ukendt linie/løb *>
5 14192 goto slut_flyt;
5 14193 end;
4 14194 bi1:= busindeks(li1) extract 12;
4 14195 inf1:= bustabel(bi1);
4 14196 tilst:= intg(bustilstand(bi1));
4 14197 if tilst<>0 then <* bus ikke fri *>
4 14198 begin
5 14199 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 14200 goto slut_flyt;
5 14201 end;
4 14202 \f
4 14202 message procedure vt_opdater side 7a- 851001/cl;
4 14203 if d.op.kilde//100 <> 4 then
4 14204
4 14204 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 14205 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 14206 if res>3 then goto slut_flyt;
4 14207
4 14207 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 14208 if s=0 then
4 14209 begin <* ll_id2 er indkodet *>
5 14210 bi2:= busindeks(li2) extract 12;
5 14211 inf2:= bustabel(bi2);
5 14212 tilst:= intg(bustilstand(bi2));
5 14213 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 14214 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 14215 if res>3 then
5 14216 begin
6 14217 inf1:= inf2; inf2:= 0;
6 14218 goto slut_flyt;
6 14219 end;
5 14220
5 14220 if d.op.kilde//100 <> 4 then
5 14221 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 14222 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 14223 if res>3 then goto slut_flyt;
5 14224
5 14224 <* flyt bus *>
5 14225 if funk=6 then
5 14226 linie_løb_indeks(bi2):= false add li1
5 14227 else
5 14228 linie_løb_indeks(bi2):= false;
5 14229 linie_løb_indeks(bi1):= false add li2;
5 14230 if funk=6 then
5 14231 busindeks(li1):= false add bi2
5 14232 else
5 14233 busindeks(li1):= false;
5 14234 busindeks(li2):= false add bi1;
5 14235
5 14235 if funk<>6 then
5 14236 begin
6 14237 <* fjern ll_id1 *>
6 14238 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 14239 begin
7 14240 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 14241 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 14242 busindeks(i):= busindeks(i+1);
7 14243 end;
6 14244 linie_løb_tabel(sidste_linie_løb):= 0;
6 14245 bus_indeks(sidste_linie_løb):= false;
6 14246 sidste_linie_løb:= sidste_linie_løb-1;
6 14247 end;
5 14248
5 14248 <* opdater vogntabelfil *>
5 14249 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 14250 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14251 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 14252 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 14253 if funk=6 then
5 14254 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 14255 else
5 14256 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 14257 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14258 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14259 fil(zi).ll:= ll_id2;
5 14260 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14261 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14262 \f
5 14262 message procedure vt_opdater side 8 - 820301/cl;
5 14263
5 14263 end <* ll_id2 indkodet *>
4 14264 else
4 14265 begin
5 14266 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 14267 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 14268 pm1:= sgn(li2-li1);
5 14269 for i:= li1 step pm1 until li2-pm1 do
5 14270 begin
6 14271 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 14272 busindeks(i):= busindeks(i+pm1);
6 14273 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 14274 end;
5 14275 linie_løb_tabel(li2):= ll_id2;
5 14276 busindeks(li2):= false add bi1;
5 14277 linie_løb_indeks(bi1):= false add li2;
5 14278 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14279 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14280 fil(zi).ll:= ll_id2;
5 14281 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14282 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14283 end;
4 14284 res:= 3; <*udført*>
4 14285 slut_flyt:
4 14286 d.op.resultat:= res;
4 14287 d.op.data(3):= inf1;
4 14288 if funk=5 then d.op.data(4):= inf2;
4 14289 end;
3 14290 goto returner;
3 14291 \f
3 14291 message procedure vt_opdater side 9 - 851001/cl;
3 14292
3 14292 slet:
3 14293 begin
4 14294 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 14295 boolean test24;
4 14296
4 14296 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 14297 omr:= d.op.data(3);
4 14298
4 14298 if d.op.data(1) > d.op.data(2) then
4 14299 begin
5 14300 res:= 44; <* intervalstørrelse ulovlig *>
5 14301 goto slut_slet;
5 14302 end;
4 14303
4 14303 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 14304 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 14305
4 14305 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 14306 if s<0 then finx:= finx+1;
4 14307 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 14308 if s>0 then sinx:= sinx-1;
4 14309
4 14309 for li:= finx step 1 until sinx do
4 14310 begin
5 14311 bi:= busindeks(li) extract 12;
5 14312 gar:= bustabel(bi) shift (-14) extract 8;
5 14313 if intg(bustilstand(bi))=0 and
5 14314 (omr = 0 or (omr > 0 and omr = gar) or
5 14315 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 14316 begin
6 14317 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 14318 linie_løb_indeks(bi):= busindeks(li):= false;
6 14319 linie_løb_tabel(li):= 0;
6 14320 end;
5 14321 end;
4 14322 \f
4 14322 message procedure vt_opdater side 10 - 850820/cl;
4 14323
4 14323 sinx:= finx-1;
4 14324 for li:= finx step 1 until sidste_linie_løb do
4 14325 begin
5 14326 if linie_løb_tabel(li)<>0 then
5 14327 begin
6 14328 sinx:= sinx+1;
6 14329 if sinx<>li then
6 14330 begin
7 14331 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 14332 busindeks(sinx):= busindeks(li);
7 14333 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 14334 linie_løb_tabel(li):= 0;
7 14335 busindeks(li):= false;
7 14336 end;
6 14337 end;
5 14338 end;
4 14339 sidste_linie_løb:= sinx;
4 14340
4 14340 test24:= testbit24; testbit24:= false;
4 14341 for bi:= 1 step 1 until sidste_bus do
4 14342 disable
4 14343 begin
5 14344 s:= modiffil(tf_vogntabel,bi,finx);
5 14345 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 14346 fil(finx).bn:= bustabel(bi) extract 14 add
5 14347 (bustabel1(bi) extract 8 shift 14);
5 14348 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 14349 end;
4 14350 testbit24:= test24;
4 14351 res:= 3;
4 14352
4 14352 slut_slet:
4 14353 d.op.resultat:= res;
4 14354 end;
3 14355 goto returner;
3 14356 \f
3 14356 message procedure vt_opdater side 11 - 810409/cl;
3 14357
3 14357 returner:
3 14358 disable
3 14359 begin
4 14360
4 14360 <*+2*>
4 14361 <**> if testbit40 and overvåget then
4 14362 <**> begin
5 14363 <**> skriv_vt_opd(out,0);
5 14364 <**> write(out,<: vogntabel efter ændring:>);
5 14365 <**> p_vogntabel(out);
5 14366 <**> end;
4 14367 <**> if testbit41 and overvåget then
4 14368 <**> begin
5 14369 <**> skriv_vt_opd(out,0);
5 14370 <**> write(out,<: returner operation:>);
5 14371 <**> skriv_op(out,op);
5 14372 <**> end;
4 14373 <*-2*>
4 14374
4 14374 signalch(d.op.retur,op,d.op.optype);
4 14375 end;
3 14376 goto vent_op;
3 14377
3 14377 vt_opd_trap:
3 14378 disable skriv_vt_opd(zbillede,1);
3 14379
3 14379 end vt_opdater;
2 14380 \f
2 14380 message procedure vt_tilstand side 1 - 810424/cl;
2 14381
2 14381 procedure vt_tilstand(cs_fil,fil_opref);
2 14382 value cs_fil,fil_opref;
2 14383 integer cs_fil,fil_opref;
2 14384 begin
3 14385 integer array field op,filop;
3 14386 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14387 g_type,gr,antal,ej_res,zi,li,filref;
3 14388 integer array identer(1:max_antal_i_gruppe);
3 14389
3 14389 procedure skriv_vt_tilst(zud,omfang);
3 14390 value omfang;
3 14391 zone zud;
3 14392 integer omfang;
3 14393 begin
4 14394 real array field raf;
4 14395 raf:= 0;
4 14396 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14397 if omfang <> 0 then
4 14398 begin
5 14399 skriv_coru(zud,abs curr_coruno);
5 14400 write(zud,"nl",1,<<d>,
5 14401 <:cs-fil :>,cs_fil,"nl",1,
5 14402 <:filop :>,filop,"nl",1,
5 14403 <:op :>,op,"nl",1,
5 14404 <:funk :>,funk,"nl",1,
5 14405 <:format :>,format,"nl",1,
5 14406 <:busid :>,busid,"nl",1,
5 14407 <:res :>,res,"nl",1,
5 14408 <:bi :>,bi,"nl",1,
5 14409 <:tilst :>,tilst,"nl",1,
5 14410 <:opk :>,opk,"nl",1,
5 14411 <:opk-indeks :>,opk_indeks,"nl",1,
5 14412 <:g-type :>,g_type,"nl",1,
5 14413 <:gr :>,gr,"nl",1,
5 14414 <:antal :>,antal,"nl",1,
5 14415 <:ej-res :>,ej_res,"nl",1,
5 14416 <:zi :>,zi,"nl",1,
5 14417 <:li :>,li,"nl",1,
5 14418 <::>);
5 14419 write(zud,"nl",1,<:identer:>);
5 14420 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14421 end;
4 14422 end;
3 14423
3 14423 procedure sorter_gruppe(tab,l,u);
3 14424 value l,u;
3 14425 integer array tab;
3 14426 integer l,u;
3 14427 begin
4 14428 integer array field ii,jj;
4 14429 integer array ww, xx(1:2);
4 14430
4 14430 integer procedure sml(a,b);
4 14431 integer array a,b;
4 14432 begin
5 14433 integer res;
5 14434
5 14434 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14435 if res = 0 then
5 14436 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14437 if res = 0 then
5 14438 res:=
5 14439 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14440 if res = 0 then
5 14441 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14442 sml:= res;
5 14443 end;
4 14444
4 14444 ii:= ((l+u)//2 - 1)*4;
4 14445 tofrom(xx,tab.ii,4);
4 14446 ii:= (l-1)*4; jj:= (u-1)*4;
4 14447 repeat
4 14448 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14449 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14450 if ii <= jj then
4 14451 begin
5 14452 tofrom(ww,tab.ii,4);
5 14453 tofrom(tab.ii,tab.jj,4);
5 14454 tofrom(tab.jj,ww,4);
5 14455 ii:= ii+4;
5 14456 jj:= jj-4;
5 14457 end;
4 14458 until ii>jj;
4 14459 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14460 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14461 end;
3 14462 \f
3 14462 message procedure vt_tilstand side 2 - 820301/cl;
3 14463
3 14463 filop:= filopref;
3 14464 stackclaim(if cm_test then 550 else 500);
3 14465 trap(vt_tilst_trap);
3 14466
3 14466 <*+2*>
3 14467 <**> disable if testbit47 and overvåget or testbit28 then
3 14468 <**> skriv_vt_tilst(out,0);
3 14469 <*-2*>
3 14470
3 14470 vent_op:
3 14471 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14472 <*+2*>disable
3 14473 <**> if (testbit41 and overvåget) or
3 14474 (testbit46 and overvåget and
3 14475 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14476 then
3 14477 <**> begin
4 14478 <**> skriv_vt_tilst(out,0);
4 14479 <**> write(out,<: modtaget operation:>);
4 14480 <**> skriv_op(out,op);
4 14481 <**> end;
3 14482 <*-2*>
3 14483
3 14483 <*+4*>
3 14484 <**> if op <> vt_op then
3 14485 <**> begin
4 14486 <**> disable begin
5 14487 <**> d.op.resultat:= 31;
5 14488 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14489 <**> end;
4 14490 <**> goto returner;
4 14491 <**> end;
3 14492 <*-4*>
3 14493
3 14493 opk:= d.op.opkode extract 12;
3 14494 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14495 if opk = 15 <*bus res *> then 2 else
3 14496 if opk = 16 <*grp res *> then 4 else
3 14497 if opk = 17 <*bus fri *> then 3 else
3 14498 if opk = 18 <*grp fri *> then 5 else
3 14499 0;
3 14500 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14501 res:= 0;
3 14502 format:= d.op.data(1) shift (-22);
3 14503
3 14503 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14504 \f
3 14504 message procedure vt_tilstand side 3 - 820301/cl;
3 14505
3 14505 enkelt_bus:
3 14506 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14507 disable
3 14508 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14509 <*+4*>
4 14510 <**>if format <> 0 and format <> 1 then
4 14511 <**>begin
5 14512 <**> res:= 31;
5 14513 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14514 <**> goto slut_enkelt_bus;
5 14515 <**>end;
4 14516 <*-4*>
4 14517 <* find busnr og tilstand *>
4 14518 case format+1 of
4 14519 begin
5 14520 <* 0: budident *>
5 14521 begin
6 14522 busnr:= d.op.data(1) extract 14;
6 14523 s:= omr:= d.op.data(4) extract 8;
6 14524 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14525 if bi<0 then
6 14526 begin
7 14527 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14528 goto slut_enkelt_bus;
7 14529 end
6 14530 else
6 14531 begin
7 14532 tilst:= intg(bustilstand(bi));
7 14533 end;
6 14534 end;
5 14535
5 14535 <* 1: linie_løb_ident *>
5 14536 begin
6 14537 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14538 if bi < 0 then <* ukendt linie_løb *>
6 14539 begin
7 14540 res:= 9;
7 14541 goto slut_enkelt_bus;
7 14542 end;
6 14543 end;
5 14544 end case;
4 14545 \f
4 14545 message procedure vt_tilstand side 4 - 830310/cl;
4 14546
4 14546 if funk < 3 then
4 14547 begin
5 14548 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14549 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14550 else 0;
5 14551 d.op.data(3):= bustabel(bi);
5 14552 d.op.data(4):= bustabel1(bi);
5 14553 end;
4 14554
4 14554 <* check tilstand *>
4 14555 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14556 res:= 39 <* bus ikke reserveret *>
4 14557 else
4 14558 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14559 res:= 14 <* bus optaget *>
4 14560 else
4 14561 if funk = 1 <* i kø *> and tilst = (-1) then
4 14562 res:= 18 <* i kø *>
4 14563 else
4 14564 res:= 3; <*udført*>
4 14565
4 14565 if res = 3 then
4 14566 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14567
4 14567 slut_enkelt_bus:
4 14568 d.op.resultat:= res;
4 14569 end <*disable*>;
3 14570 goto returner;
3 14571 \f
3 14571 message procedure vt_tilstand side 5 - 810424/cl;
3 14572
3 14572 grp_res: <* reserver gruppe *>
3 14573 disable
3 14574 begin
4 14575
4 14575 <*+4*>
4 14576 <**> if format <> 2 then
4 14577 <**> begin
5 14578 <**> res:= 31;
5 14579 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14580 <**> goto slut_grp_res_1;
5 14581 <**> end;
4 14582 <*-4*>
4 14583
4 14583 <* find frit indeks i opkaldstabel *>
4 14584 opk_indeks:= 0;
4 14585 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14586 begin
5 14587 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14588 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14589 end;
4 14590 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14591 if res <> 0 then goto slut_grp_res_1;
4 14592 g_type:= d.op.data(1) shift (-21) extract 1;
4 14593 if g_type = 1 <*special gruppe*> then
4 14594 begin <*check eksistens*>
5 14595 gr:= 0;
5 14596 for i:= 1 step 1 until max_antal_grupper do
5 14597 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14598 if gr = 0 then <*gruppe ukendt*>
5 14599 begin
6 14600 res:= 8;
6 14601 goto slut_grp_res_1;
6 14602 end;
5 14603 end;
4 14604
4 14604 <* reserver i opkaldstabel *>
4 14605 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14606 \f
4 14606 message procedure vt_tilstand side 6 - 810428/cl;
4 14607
4 14607 <* tilknyt fil *>
4 14608 start_operation(filop,curr_coruid,cs_fil,101);
4 14609 d.filop.data(1):= 0; <*postantal*>
4 14610 d.filop.data(2):= 256; <*postlængde*>
4 14611 d.filop.data(3):= 1; <*segmentantal*>
4 14612 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14613 signalch(cs_opret_fil,filop,vt_optype);
4 14614
4 14614 slut_grp_res_1:
4 14615 if res <> 0 then d.op.resultat:= res;
4 14616 end;
3 14617 if res <> 0 then goto returner;
3 14618
3 14618 waitch(cs_fil,filop,vt_optype,-1);
3 14619
3 14619 <* check filsys-resultat *>
3 14620 if d.filop.data(9) <> 0 then
3 14621 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14622 filref:= d.filop.data(4);
3 14623 \f
3 14623 message procedure vt_tilstand side 7 - 820301/cl;
3 14624 disable if g_type = 0 <*linie-gruppe*> then
3 14625 begin
4 14626 integer s,i,ll_id;
4 14627 integer array field iaf1;
4 14628
4 14628 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14629 iaf1:= 2;
4 14630 s:= binærsøg(sidste_linie_løb,
4 14631 linie_løb_tabel(i) - ll_id, i);
4 14632 if s < 0 then i:= i +1;
4 14633 antal:= ej_res:= 0;
4 14634 skrivfil(filref,1,zi);
4 14635 if i <= sidste_linie_løb then
4 14636 begin
5 14637 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14638 begin
6 14639 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14640 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14641 ej_res:= ej_res+1
6 14642 else
6 14643 begin
7 14644 antal:= antal+1;
7 14645 bi:= busindeks(i) extract 12;
7 14646 fil(zi).iaf1(1):=
7 14647 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14648 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14649 fil(zi).iaf1(2):= bustabel(bi);
7 14650 iaf1:= iaf1+4;
7 14651 bustilstand(bi):= false add opk_indeks;
7 14652 end;
6 14653 i:= i +1;
6 14654 if i > sidste_linie_løb then goto slut_l_grp;
6 14655 end;
5 14656 end;
4 14657 \f
4 14657 message procedure vt_tilstand side 8 - 820301/cl;
4 14658
4 14658 slut_l_grp:
4 14659 end
3 14660 else
3 14661 begin <*special gruppe*>
4 14662 integer i,s,li,omr,gar,tilst;
4 14663 integer array field iaf1;
4 14664
4 14664 iaf1:= 2;
4 14665 antal:= ej_res:= 0;
4 14666 s:= læsfil(tf_gruppedef,gr,zi);
4 14667 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14668 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14669 s:= skrivfil(filref,1,zi);
4 14670 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14671 i:= 1;
4 14672 while identer(i) <> 0 do
4 14673 begin
5 14674 if identer(i) shift (-22) = 0 then
5 14675 begin <*busident*>
6 14676 omr:= 0;
6 14677 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14678 if bi<0 then goto næste_ident;
6 14679 li:= linie_løb_indeks(bi) extract 12;
6 14680 end
5 14681 else
5 14682 begin <*linie/løb ident*>
6 14683 s:= binærsøg(sidste_linie_løb,
6 14684 linie_løb_tabel(li) - identer(i), li);
6 14685 if s <> 0 then goto næste_ident;
6 14686 bi:= busindeks(li) extract 12;
6 14687 end;
5 14688 if (intg(bustilstand(bi))<>0) or
5 14689 (bustabel1(bi) extract 8 <> 3) then
5 14690 ej_res:= ej_res+1
5 14691 else
5 14692 begin
6 14693 antal:= antal +1;
6 14694 fil(zi).iaf1(1):=
6 14695 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14696 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14697 fil(zi).iaf1(2):= bustabel(bi);
6 14698 iaf1:= iaf1+4;
6 14699 bustilstand(bi):= false add opk_indeks;
6 14700 end;
5 14701 næste_ident:
5 14702 i:= i +1;
5 14703 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14704 end;
4 14705 slut_s_grp:
4 14706 end;
3 14707 \f
3 14707 message procedure vt_tilstand side 9 - 820301/cl;
3 14708
3 14708 if antal > 0 then <*ok*>
3 14709 disable begin
4 14710 integer array field spec,akt;
4 14711 integer a;
4 14712 integer field antal_spec;
4 14713
4 14713 antal_spec:= 2; a:= 0;
4 14714 spec:= 2; akt:= 2;
4 14715 sorter_gruppe(fil(zi).spec,1,antal);
4 14716 fil(zi).antal_spec:= 0;
4 14717 while akt//4 < antal do
4 14718 begin
5 14719 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14720 a:= 0;
5 14721 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14722 and a<15 do
5 14723 begin
6 14724 a:= a+1;
6 14725 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14726 akt:= akt+4;
6 14727 end;
5 14728 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14729 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14730 spec:= spec + 2*a + 2;
5 14731 end;
4 14732 antal:= fil(zi).antal_spec;
4 14733 gruppeopkald(opk_indeks,2):= filref;
4 14734 d.op.resultat:= 3;
4 14735 d.op.data(2):= antal;
4 14736 d.op.data(3):= filref;
4 14737 d.op.data(4):= ej_res;
4 14738 end
3 14739 else
3 14740 begin
4 14741 disable begin
5 14742 d.filop.opkode:= 104; <*slet fil*>
5 14743 signalch(cs_slet_fil,filop,vt_optype);
5 14744 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14745 d.op.resultat:= 54;
5 14746 d.op.data(2):= antal;
5 14747 d.op.data(3):= 0;
5 14748 d.op.data(4):= ej_res;
5 14749 end;
4 14750 waitch(cs_fil,filop,vt_optype,-1);
4 14751 if d.filop.data(9) <> 0 then
4 14752 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14753 end;
3 14754 goto returner;
3 14755 \f
3 14755 message procedure vt_tilstand side 10 - 820301/cl;
3 14756
3 14756 grp_fri: <* frigiv gruppe *>
3 14757 disable
3 14758 begin integer i,j,s,ll,gar,omr,tilst;
4 14759 integer array field spec;
4 14760
4 14760 <*+4*>
4 14761 <**> if format <> 2 then
4 14762 <**> begin
5 14763 <**> res:= 31;
5 14764 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14765 <**> goto slut_grp_fri;
5 14766 <**> end;
4 14767 <*-4*>
4 14768
4 14768 <* find indeks i opkaldstabel *>
4 14769 opk_indeks:= 0;
4 14770 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14771 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14772 if opk_indeks = 0 <*ikke fundet*> then
4 14773 begin
5 14774 res:= 40; <*gruppe ej reserveret*>
5 14775 goto slut_grp_fri;
5 14776 end;
4 14777 filref:= gruppeopkald(opk_indeks,2);
4 14778 start_operation(filop,curr_coruid,cs_fil,104);
4 14779 d.filop.data(4):= filref;
4 14780 hentfildim(d.filop.data);
4 14781 læsfil(filref,1,zi);
4 14782 spec:= 0;
4 14783 antal:= fil(zi).spec(1);
4 14784 spec:= spec+2;
4 14785 for i:= 1 step 1 until antal do
4 14786 begin
5 14787 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14788 begin
6 14789 busid:= fil(zi).spec(1+j) extract 14;
6 14790 omr:= 0;
6 14791 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14792 if bi>=0 then bustilstand(bi):= false;
6 14793 end;
5 14794 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14795 end;
4 14796
4 14796 slut_grp_fri:
4 14797 d.op.resultat:= res;
4 14798 end;
3 14799 if res <> 0 then goto returner;
3 14800 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14801 signalch(cs_slet_fil,filop,vt_optype);
3 14802 \f
3 14802 message procedure vt_tilstand side 11 - 810424/cl;
3 14803
3 14803 waitch(cs_fil,filop,vt_optype,-1);
3 14804
3 14804 if d.filop.data(9) <> 0 then
3 14805 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14806 d.op.resultat:= 3;
3 14807
3 14807 returner:
3 14808 disable
3 14809 begin
4 14810 <*+2*>
4 14811 <**> if testbit40 and overvåget then
4 14812 <**> begin
5 14813 <**> skriv_vt_tilst(out,0);
5 14814 <**> write(out,<: vogntabel efter ændring:>);
5 14815 <**> p_vogntabel(out);
5 14816 <**> end;
4 14817 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14818 <**> begin
5 14819 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14820 <**> p_gruppetabel(out);
5 14821 <**> end;
4 14822 <**> if (testbit41 and overvåget) or
4 14823 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14824 <**> begin
5 14825 <**> skriv_vt_tilst(out,0);
5 14826 <**> write(out,<: returner operation:>);
5 14827 <**> skriv_op(out,op);
5 14828 <**> end;
4 14829 <*-2*>
4 14830 signalch(d.op.retur,op,d.op.optype);
4 14831 end;
3 14832 goto vent_op;
3 14833
3 14833 vt_tilst_trap:
3 14834 disable skriv_vt_tilst(zbillede,1);
3 14835
3 14835 end vt_tilstand;
2 14836 \f
2 14836 message procedure vt_rapport side 1 - 810428/cl;
2 14837
2 14837 procedure vt_rapport(cs_fil,fil_opref);
2 14838 value cs_fil,fil_opref;
2 14839 integer cs_fil,fil_opref;
2 14840 begin
3 14841 integer array field op,filop;
3 14842 integer funk,filref,antal,id_ant,res;
3 14843 integer field i1,i2;
3 14844
3 14844 procedure skriv_vt_rap(z,omfang);
3 14845 value omfang;
3 14846 zone z;
3 14847 integer omfang;
3 14848 begin
4 14849 write(z,"nl",1,<:+++ vt_rapport :>);
4 14850 if omfang <> 0 then
4 14851 begin
5 14852 skriv_coru(z,abs curr_coruno);
5 14853 write(z,"nl",1,<<d>,
5 14854 <: cs_fil :>,cs_fil,"nl",1,
5 14855 <: filop :>,filop,"nl",1,
5 14856 <: op :>,op,"nl",1,
5 14857 <: funk :>,funk,"nl",1,
5 14858 <: filref :>,filref,"nl",1,
5 14859 <: antal :>,antal,"nl",1,
5 14860 <: id-ant :>,id_ant,"nl",1,
5 14861 <: res :>,res,"nl",1,
5 14862 <::>);
5 14863
5 14863 end;
4 14864 end skriv_vt_rap;
3 14865
3 14865 stackclaim(if cm_test then 198 else 146);
3 14866 filop:= fil_opref;
3 14867 i1:= 2; i2:= 4;
3 14868 trap(vt_rap_trap);
3 14869
3 14869 <*+2*>
3 14870 <**> disable if testbit47 and overvåget or testbit28 then
3 14871 <**> skriv_vt_rap(out,0);
3 14872 <*-2*>
3 14873 \f
3 14873 message procedure vt_rapport side 2 - 810505/cl;
3 14874
3 14874 vent_op:
3 14875 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14876
3 14876 <*+2*>
3 14877 <**> disable begin
4 14878 <**> if testbit41 and overvåget then
4 14879 <**> begin
5 14880 <**> skriv_vt_rap(out,0);
5 14881 <**> write(out,<: modtaget operation:>);
5 14882 <**> skriv_op(out,op);
5 14883 <**> ud;
5 14884 <**> end;
4 14885 <**> end;<*disable*>
3 14886 <*-2*>
3 14887
3 14887 disable
3 14888 begin
4 14889 integer opk;
4 14890
4 14890 opk:= d.op.opkode extract 12;
4 14891 funk:= if opk = 9 then 1 else
4 14892 if opk =10 then 2 else
4 14893 0;
4 14894 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14895
4 14895 <* opret og tilknyt fil *>
4 14896 start_operation(filop,curr_coruid,cs_fil,101);
4 14897 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14898 d.filop.data(2):= 2; <*postlængde*>
4 14899 d.filop.data(3):=10; <*segmenter*>
4 14900 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14901 signalch(cs_opretfil,filop,vt_optype);
4 14902 end;
3 14903
3 14903 waitch(cs_fil,filop,vt_optype,-1);
3 14904
3 14904 <* check resultat *>
3 14905 if d.filop.data(9) <> 0 then
3 14906 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14907 filref:= d.filop.data(4);
3 14908 antal:= 0;
3 14909 goto case funk of (l_rapport,b_rapport);
3 14910 \f
3 14910 message procedure vt_rapport side 3 - 850820/cl;
3 14911
3 14911 l_rapport:
3 14912 disable
3 14913 begin
4 14914 integer i,j,s,ll,zi;
4 14915 idant:= 0;
4 14916 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14917 <*+4*>
4 14918 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14919 <**> begin
5 14920 <**> res:= 31;
5 14921 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14922 <**> goto l_rap_slut;
5 14923 <**> end;
4 14924 <*-4*>
4 14925 ;
4 14926
4 14926 for i:= 1 step 1 until id_ant do
4 14927 begin
5 14928 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14929 s:= binærsøg(sidste_linie_løb,
5 14930 linie_løb_tabel(j) - ll, j);
5 14931 if s < 0 then j:= j +1;
5 14932
5 14932 if j<= sidste_linie_løb then
5 14933 begin <* skriv identer *>
6 14934 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14935 begin
7 14936 antal:= antal +1;
7 14937 s:= skrivfil(filref,antal,zi);
7 14938 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14939 fil(zi).i1:= linie_løb_tabel(j);
7 14940 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14941 j:= j +1;
7 14942 if j > sidste_bus then goto linie_slut;
7 14943 end;
6 14944 end;
5 14945 linie_slut:
5 14946 end;
4 14947 res:= 3;
4 14948 l_rap_slut:
4 14949 end <*disable*>;
3 14950 goto returner;
3 14951 \f
3 14951 message procedure vt_rapport side 4 - 820301/cl;
3 14952
3 14952 b_rapport:
3 14953 disable
3 14954 begin
4 14955 integer i,j,s,zi,busnr1,busnr2;
4 14956 <*+4*>
4 14957 <**> for i:= 1,2 do
4 14958 <**> if d.op.data(i) shift (-14) <> 0 then
4 14959 <**> begin
5 14960 <**> res:= 31;
5 14961 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14962 <**> goto bus_slut;
5 14963 <**> end;
4 14964 <*-4*>
4 14965
4 14965 busnr1:= d.op.data(1) extract 14;
4 14966 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14967 if busnr1 = 0 or busnr2 < busnr1 then
4 14968 begin
5 14969 res:= 7; <* fejl i busnr *>
5 14970 goto bus_slut;
5 14971 end;
4 14972
4 14972 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14973 - busnr1,j);
4 14974 if s < 0 then j:= j +1;
4 14975 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14976 if j <= sidste_bus then
4 14977 begin <* skriv identer *>
5 14978 while bustabel(j) extract 14 <= busnr2 do
5 14979 begin
6 14980 i:= linie_løb_indeks(j) extract 12;
6 14981 if i<>0 then
6 14982 begin
7 14983 antal:= antal +1;
7 14984 s:= skriv_fil(filref,antal,zi);
7 14985 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14986 fil(zi).i1:= bustabel(j);
7 14987 fil(zi).i2:= linie_løb_tabel(i);
7 14988 end;
6 14989 j:= j +1;
6 14990 if j > sidste_bus then goto bus_slut;
6 14991 end;
5 14992 end;
4 14993 bus_slut:
4 14994 end <*disable*>;
3 14995 res:= 3; <*ok*>
3 14996 \f
3 14996 message procedure vt_rapport side 5 - 810409/cl;
3 14997
3 14997 returner:
3 14998 disable
3 14999 begin
4 15000 d.op.resultat:= res;
4 15001 d.op.data(6):= antal;
4 15002 d.op.data(7):= filref;
4 15003 d.filop.data(1):= antal;
4 15004 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 15005 i:= sæt_fil_dim(d.filop.data);
4 15006 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 15007 <*+2*>
4 15008 <**> if testbit41 and overvåget then
4 15009 <**> begin
5 15010 <**> skriv_vt_rap(out,0);
5 15011 <**> write(out,<: returner operation:>);
5 15012 <**> skriv_op(out,op);
5 15013 <**> end;
4 15014 <*-2*>
4 15015 signalch(d.op.retur,op,d.op.optype);
4 15016 end;
3 15017 goto vent_op;
3 15018
3 15018 vt_rap_trap:
3 15019 disable skriv_vt_rap(zbillede,1);
3 15020
3 15020 end vt_rapport;
2 15021 \f
2 15021 message procedure vt_gruppe side 1 - 810428/cl;
2 15022
2 15022 procedure vt_gruppe(cs_fil,fil_opref);
2 15023
2 15023 value cs_fil,fil_opref;
2 15024 integer cs_fil,fil_opref;
2 15025 begin
3 15026 integer array field op, fil_op, iaf;
3 15027 integer funk, res, filref, gr, i, antal, zi, s;
3 15028 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 15029 max_antal_grupper else max_antal_i_gruppe));
3 15030
3 15030 procedure skriv_vt_gruppe(zud,omfang);
3 15031 value omfang;
3 15032 integer omfang;
3 15033 zone zud;
3 15034 begin
4 15035 integer øg;
4 15036
4 15036 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 15037 if omfang <> 0 then
4 15038 disable
4 15039 begin
5 15040 skriv_coru(zud,abs curr_coruno);
5 15041 write(zud,"nl",1,<<d>,
5 15042 <: cs_fil :>,cs_fil,"nl",1,
5 15043 <: op :>,op,"nl",1,
5 15044 <: filop :>,filop,"nl",1,
5 15045 <: funk :>,funk,"nl",1,
5 15046 <: res :>,res,"nl",1,
5 15047 <: filref :>,filref,"nl",1,
5 15048 <: gr :>,gr,"nl",1,
5 15049 <: i :>,i,"nl",1,
5 15050 <: antal :>,antal,"nl",1,
5 15051 <: zi :>,zi,"nl",1,
5 15052 <: s :>,s,"nl",1,
5 15053 <::>);
5 15054 raf:= 0;
5 15055 system(3,øg,identer);
5 15056 write(zud,"nl",1,<:identer::>);
5 15057 skriv_hele(zud,identer.raf,øg*2,2);
5 15058 end;
4 15059 end;
3 15060
3 15060 stackclaim(if cm_test then 198 else 146);
3 15061 filop:= fil_opref;
3 15062 trap(vt_grp_trap);
3 15063 iaf:= 0;
3 15064 \f
3 15064 message procedure vt_gruppe side 2 - 810409/cl;
3 15065
3 15065 <*+2*>
3 15066 <**> disable if testbit47 and overvåget or testbit28 then
3 15067 <**> skriv_vt_gruppe(out,0);
3 15068 <*-2*>
3 15069
3 15069 vent_op:
3 15070 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 15071 <*+2*>
3 15072 <**>disable
3 15073 <**>begin
4 15074 <**> if testbit41 and overvåget then
4 15075 <**> begin
5 15076 <**> skriv_vt_gruppe(out,0);
5 15077 <**> write(out,<: modtaget operation:>);
5 15078 <**> skriv_op(out,op);
5 15079 <**> ud;
5 15080 <**> end;
4 15081 <**>end;
3 15082 <*-2*>
3 15083
3 15083 disable
3 15084 begin
4 15085 integer opk;
4 15086
4 15086 opk:= d.op.opkode extract 12;
4 15087 funk:= if opk=25 then 1 else
4 15088 if opk=26 then 2 else
4 15089 if opk=27 then 3 else
4 15090 if opk=28 then 4 else
4 15091 0;
4 15092 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 15093 end;
3 15094 <*+4*>
3 15095 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 15096 <**> begin
4 15097 <**> disable begin
5 15098 <**> d.op.resultat:= 31;
5 15099 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 15100 <**> end;
4 15101 <**> goto returner;
4 15102 <**> end;
3 15103 <*-4*>
3 15104
3 15104 goto case funk of(definer,slet,vis,oversigt);
3 15105 \f
3 15105 message procedure vt_gruppe side 3 - 810505/cl;
3 15106
3 15106 definer:
3 15107 disable
3 15108 begin
4 15109 gr:= 0; res:= 0;
4 15110 for i:= max_antal_grupper step -1 until 1 do
4 15111 begin
5 15112 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 15113 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 15114 end;
4 15115 if gr=0 then res:= 32; <*ingen plads*>
4 15116 end;
3 15117 if res<>0 then goto slut_definer;
3 15118 disable
3 15119 begin <*fri plads fundet*>
4 15120 antal:= d.op.data(2);
4 15121 if antal <=0 or max_antal_i_gruppe<antal then
4 15122 res:= 33 <*fejl i gruppestørrelse*>
4 15123 else
4 15124 begin
5 15125 for i:= 1 step 1 until antal do
5 15126 begin
6 15127 s:= læsfil(d.op.data(3),i,zi);
6 15128 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 15129 identer(i):= fil(zi).iaf(1);
6 15130 end;
5 15131 s:= modif_fil(tf_gruppedef,gr,zi);
5 15132 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15133 tofrom(fil(zi).iaf,identer,antal*2);
5 15134 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 15135 fil(zi).iaf(i):= 0;
5 15136 gruppetabel(gr):= d.op.data(1);
5 15137 s:= modiffil(tf_gruppeidenter,gr,zi);
5 15138 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15139 fil(zi).iaf(1):= gruppetabel(gr);
5 15140 res:= 3;
5 15141 end;
4 15142 end;
3 15143 slut_definer:
3 15144 <*slet fil*>
3 15145 start_operation(fil_op,curr_coruid,cs_fil,104);
3 15146 d.filop.data(4):= d.op.data(3);
3 15147 signalch(cs_slet_fil,filop,vt_optype);
3 15148 waitch(cs_fil,filop,vt_optype,-1);
3 15149 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 15150 d.op.resultat:= res;
3 15151 goto returner;
3 15152 \f
3 15152 message procedure vt_gruppe side 4 - 810409/cl;
3 15153
3 15153 slet:
3 15154 disable
3 15155 begin
4 15156 gr:= 0; res:= 0;
4 15157 for i:= 1 step 1 until max_antal_grupper do
4 15158 begin
5 15159 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 15160 end;
4 15161 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 15162 else
4 15163 begin
5 15164 for i:= 1 step 1 until max_antal_gruppeopkald do
5 15165 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 15166 if res = 0 then
5 15167 begin
6 15168 gruppetabel(gr):= 0;
6 15169 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 15170 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 15171 fil(zi).iaf(1):= gruppetabel(gr);
6 15172 res:= 3;
6 15173 end;
5 15174 end;
4 15175 d.op.resultat:= res;
4 15176 end;
3 15177 goto returner;
3 15178 \f
3 15178 message procedure vt_gruppe side 5 - 810505/cl;
3 15179
3 15179 vis:
3 15180 disable
3 15181 begin
4 15182 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 15183 for i:= 1 step 1 until max_antal_grupper do
4 15184 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 15185 if gr = 0 then res:= 8
4 15186 else
4 15187 begin
5 15188 s:= læsfil(tf_gruppedef,gr,zi);
5 15189 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 15190 for i:= 1 step 1 until max_antal_i_gruppe do
5 15191 begin
6 15192 identer(i):= fil(zi).iaf(i);
6 15193 if identer(i) <> 0 then antal:= antal +1;
6 15194 end;
5 15195 start_operation(filop,curr_coruid,cs_fil,101);
5 15196 d.filop.data(1):= antal; <*postantal*>
5 15197 d.filop.data(2):= 1; <*postlængde*>
5 15198 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 15199 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 15200 d.filop.data(5):= d.filop.data(6):=
5 15201 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 15202 signalch(cs_opret_fil,filop,vt_optype);
5 15203 end;
4 15204 end;
3 15205 if res <> 0 then goto slut_vis;
3 15206 waitch(cs_fil,filop,vt_optype,-1);
3 15207 disable
3 15208 begin
4 15209 if d.filop.data(9) <> 0 then
4 15210 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 15211 filref:= d.filop.data(4);
4 15212 for i:= 1 step 1 until antal do
4 15213 begin
5 15214 s:= skrivfil(filref,i,zi);
5 15215 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 15216 fil(zi).iaf(1):= identer(i);
5 15217 end;
4 15218 res:= 3;
4 15219 end;
3 15220 slut_vis:
3 15221 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 15222 goto returner;
3 15223 \f
3 15223 message procedure vt_gruppe side 6 - 810508/cl;
3 15224
3 15224 oversigt:
3 15225 disable
3 15226 begin
4 15227 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 15228 for i:= 1 step 1 until max_antal_grupper do
4 15229 begin
5 15230 if gruppetabel(i) <> 0 then
5 15231 begin
6 15232 antal:= antal +1;
6 15233 identer(antal):= gruppetabel(i);
6 15234 end;
5 15235 end;
4 15236 start_operation(filop,curr_coruid,cs_fil,101);
4 15237 d.filop.data(1):= antal; <*postantal*>
4 15238 d.filop.data(2):= 1; <*postlængde*>
4 15239 d.filop.data(3):= if antal = 0 then 1 else
4 15240 (antal-1)//256 +1; <*segm.antal*>
4 15241 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 15242 d.filop.data(5):= d.filop.data(6):=
4 15243 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 15244 signalch(cs_opretfil,filop,vt_optype);
4 15245 end;
3 15246 waitch(cs_fil,filop,vt_optype,-1);
3 15247 disable
3 15248 begin
4 15249 if d.filop.data(9) <> 0 then
4 15250 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 15251 filref:= d.filop.data(4);
4 15252 for i:= 1 step 1 until antal do
4 15253 begin
5 15254 s:= skriv_fil(filref,i,zi);
5 15255 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 15256 fil(zi).iaf(1):= identer(i);
5 15257 end;
4 15258 d.op.resultat:= 3; <*ok*>
4 15259 d.op.data(1):= antal;
4 15260 d.op.data(2):= filref;
4 15261 end;
3 15262 \f
3 15262 message procedure vt_gruppe side 7 - 810505/cl;
3 15263
3 15263 returner:
3 15264 disable
3 15265 begin
4 15266 <*+2*>
4 15267 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 15268 <**> begin
5 15269 <**> skriv_vt_gruppe(out,0);
5 15270 <**> write(out,<: gruppetabel efter ændring:>);
5 15271 <**> p_gruppetabel(out);
5 15272 <**> end;
4 15273 <**> if testbit41 and overvåget then
4 15274 <**> begin
5 15275 <**> skriv_vt_gruppe(out,0);
5 15276 <**> write(out,<: returner operation:>);
5 15277 <**> skriv_op(out,op);
5 15278 <**> end;
4 15279 <*-2*>
4 15280 signalch(d.op.retur,op,d.op.optype);
4 15281 end;
3 15282 goto vent_op;
3 15283
3 15283 vt_grp_trap:
3 15284 disable skriv_vt_gruppe(zbillede,1);
3 15285
3 15285 end vt_gruppe;
2 15286 \f
2 15286 message procedure vt_spring side 1 - 810506/cl;
2 15287
2 15287 procedure vt_spring(cs_spring_retur,spr_opref);
2 15288 value cs_spring_retur,spr_opref;
2 15289 integer cs_spring_retur,spr_opref;
2 15290 begin
3 15291 integer array field komm_op,spr_op,iaf;
3 15292 real nu;
3 15293 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 15294
3 15294 procedure skriv_vt_spring(zud,omfang);
3 15295 value omfang;
3 15296 zone zud;
3 15297 integer omfang;
3 15298 begin
4 15299 write(zud,"nl",1,<:+++ vt_spring :>);
4 15300 if omfang <> 0 then
4 15301 begin
5 15302 skriv_coru(zud,abs curr_coruno);
5 15303 write(zud,"nl",1,<<d>,
5 15304 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 15305 <:spr-op :>,spr_op,"nl",1,
5 15306 <:komm-op :>,komm_op,"nl",1,
5 15307 <:funk :>,funk,"nl",1,
5 15308 <:interval :>,interval,"nl",1,
5 15309 <:nr :>,nr,"nl",1,
5 15310 <:i :>,i,"nl",1,
5 15311 <:s :>,s,"nl",1,
5 15312 <:id1 :>,id1,"nl",1,
5 15313 <:id2 :>,id2,"nl",1,
5 15314 <:res :>,res,"nl",1,
5 15315 <:res-inf :>,res_inf,"nl",1,
5 15316 <:medd-kode :>,medd_kode,"nl",1,
5 15317 <:zi :>,zi,"nl",1,
5 15318 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 15319 <::>);
5 15320 end;
4 15321 end;
3 15322 \f
3 15322 message procedure vt_spring side 2 - 810506/cl;
3 15323
3 15323 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 15324 value aktion,id1,id2;
3 15325 integer aktion,id1,id2,res,res_inf;
3 15326 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 15327 integer array field akt_op;
4 15328
4 15328 <* vent på adgang til vogntabel *>
4 15329 waitch(cs_vt_adgang,akt_op,true,-1);
4 15330
4 15330 <* start operation *>
4 15331 disable
4 15332 begin
5 15333 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 15334 d.akt_op.data(1):= id1;
5 15335 d.akt_op.data(2):= id2;
5 15336 signalch(cs_vt_opd,akt_op,vt_optype);
5 15337 end;
4 15338
4 15338 <* afvent svar *>
4 15339 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 15340 res:= d.akt_op.resultat;
4 15341 res_inf:= d.akt_op.data(3);
4 15342 <*+2*>
4 15343 <**> disable
4 15344 <**> if testbit45 and overvåget then
4 15345 <**> begin
5 15346 <**> real t;
5 15347 <**> skriv_vt_spring(out,0);
5 15348 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 15349 <**> skriv_id(out,springtabel(nr,1),0);
5 15350 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 15351 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 15352 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 15353 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 15354 <**> d.akt_op.resultat,"sp",2);
5 15355 <**> skriv_id(out,d.akt_op.data(1),8);
5 15356 <**> skriv_id(out,d.akt_op.data(2),8);
5 15357 <**> skriv_id(out,d.akt_op.data(3),8);
5 15358 <**> systime(4,springtid(nr),t);
5 15359 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 15360 <**> end;
4 15361 <*-2*>
4 15362
4 15362 <* åbn adgang til vogntabel *>
4 15363 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 15364 end vt_operation;
3 15365 \f
3 15365 message procedure vt_spring side 2a - 810506/cl;
3 15366
3 15366 procedure io_meddelelse(medd_no,bus,linie,springno);
3 15367 value medd_no,bus,linie,springno;
3 15368 integer medd_no,bus,linie,springno;
3 15369 begin
4 15370 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 15371 d.spr_op.data(1):= medd_no;
4 15372 d.spr_op.data(2):= bus;
4 15373 d.spr_op.data(3):= linie;
4 15374 d.spr_op.data(4):= springtabel(springno,1);
4 15375 d.spr_op.data(5):= springtabel(springno,2);
4 15376 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15377 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15378 end;
3 15379
3 15379 procedure returner_op(op,res);
3 15380 value res;
3 15381 integer array field op;
3 15382 integer res;
3 15383 begin
4 15384 <*+2*>
4 15385 <**> disable
4 15386 <**> if testbit41 and overvåget then
4 15387 <**> begin
5 15388 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15389 <**> skriv_op(out,op);
5 15390 <**> end;
4 15391 <*-2*>
4 15392 d.op.resultat:= res;
4 15393 signalch(d.op.retur,op,d.op.optype);
4 15394 end;
3 15395 \f
3 15395 message procedure vt_spring side 3 - 810603/cl;
3 15396
3 15396 iaf:= 0;
3 15397 spr_op:= spr_opref;
3 15398 stack_claim((if cm_test then 198 else 146) + 24);
3 15399
3 15399 trap(vt_spring_trap);
3 15400
3 15400 for i:= 1 step 1 until max_antal_spring do
3 15401 begin
4 15402 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15403 springtid(i):= springstart(i):= 0.0;
4 15404 end;
3 15405
3 15405 <*+2*>
3 15406 <**> disable
3 15407 <**> if testbit44 and overvåget then
3 15408 <**> begin
4 15409 <**> skriv_vt_spring(out,0);
4 15410 <**> write(out,<: springtabel efter initialisering:>);
4 15411 <**> p_springtabel(out); ud;
4 15412 <**> end;
3 15413 <*-2*>
3 15414
3 15414 <*+2*>
3 15415 <**> disable if testbit47 and overvåget or testbit28 then
3 15416 <**> skriv_vt_spring(out,0);
3 15417 <*-2*>
3 15418 \f
3 15418 message procedure vt_spring side 4 - 810609/cl;
3 15419
3 15419 næste_tid: <* find næste tid *>
3 15420 disable
3 15421 begin
4 15422 interval:= -1; <*vent uendeligt*>
4 15423 systime(1,0.0,nu);
4 15424 for i:= 1 step 1 until max_antal_spring do
4 15425 if springtabel(i,3) < 0 then
4 15426 interval:= 5
4 15427 else
4 15428 if springtid(i) <> 0.0 and
4 15429 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15430 interval:= (if springtid(i) <= nu then 0 else
4 15431 round(springtid(i) -nu));
4 15432 if interval=0 then interval:= 1;
4 15433 end;
3 15434 \f
3 15434 message procedure vt_spring side 4a - 810525/cl;
3 15435
3 15435 <* afvent operation eller timeout *>
3 15436 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15437 if komm_op <> 0 then goto afkod_operation;
3 15438
3 15438 <* timeout *>
3 15439 systime(1,0.0,nu);
3 15440 nr:= 1;
3 15441 næste_sekv:
3 15442 if nr > max_antal_spring then goto næste_tid;
3 15443 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15444 begin
4 15445 nr:= nr +1;
4 15446 goto næste_sekv;
4 15447 end;
3 15448 disable s:= modif_fil(tf_springdef,nr,zi);
3 15449 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15450 if springtabel(nr,3) < 0 then
3 15451 begin <* hængende spring *>
4 15452 if springtid(nr) <= nu then
4 15453 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15454 <* find frit løb *>
5 15455 disable
5 15456 begin
6 15457 id2:= 0;
6 15458 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15459 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15460 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15461 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15462 end;
5 15463 <* send meddelelse til io *>
5 15464 io_meddelelse(5,0,id2,nr);
5 15465
5 15465 <* annuler spring*>
5 15466 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15467 springtid(nr):= springstart(nr):= 0.0;
5 15468 end
4 15469 else
4 15470 begin <* forsøg igen *>
5 15471 \f
5 15471 message procedure vt_spring side 5 - 810525/cl;
5 15472
5 15472 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15473 if i = 2 <* første spring ej udført *> then
5 15474 begin
6 15475 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15476 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15477 id2:= id1;
6 15478 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15479 end
5 15480 else
5 15481 begin
6 15482 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15483 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15484 id2:= id1 shift (-7) shift 7
6 15485 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15486 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15487 end;
5 15488
5 15488 <* check resultat *>
5 15489 medd_kode:= if res = 3 and i = 2 then 7 else
5 15490 if res = 3 and i > 2 then 8 else
5 15491 <* if res = 9 then 1 else
5 15492 if res =12 then 2 else
5 15493 if res =14 then 4 else
5 15494 if res =18 then 3 else *>
5 15495 0;
5 15496 if medd_kode > 0 then
5 15497 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15498 id2 else id1,nr);
5 15499 if res = 3 then
5 15500 begin <* spring udført *>
6 15501 disable s:= modiffil(tf_springdef,nr,zi);
6 15502 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15503 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15504 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15505 if i > 2 then fil(zi).iaf(2+i-2):=
6 15506 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15507 end;
5 15508 end;
4 15509 end <* hængende spring *>
3 15510 else
3 15511 begin
4 15512 i:= spring_tabel(nr,3) shift (-12);
4 15513 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15514 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15515 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15516 + id1 shift (-7) shift 7;
4 15517 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15518 \f
4 15518 message procedure vt_spring side 6 - 820304/cl;
4 15519
4 15519 <* check resultat *>
4 15520 medd_kode:= if res = 3 then 8 else
4 15521 if res = 9 then 1 else
4 15522 if res =12 then 2 else
4 15523 if res =14 then 4 else
4 15524 if res =18 then 3 else
4 15525 if res =60 then 9 else 0;
4 15526 if medd_kode > 0 then
4 15527 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15528
4 15528 <* opdater springtabel *>
4 15529 disable s:= modiffil(tf_springdef,nr,zi);
4 15530 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15531 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15532 begin
5 15533 io_meddelelse(if res=3 then 6 else 5,0,
5 15534 if res=3 then id1 else id2,nr);
5 15535 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15536 springtid(nr):= springstart(nr):= 0.0;
5 15537 end
4 15538 else
4 15539 begin
5 15540 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15541 if res = 3 then
5 15542 begin
6 15543 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15544 (fil(zi).iaf(2+i-1) extract 22);
6 15545 fil(zi).iaf(2+i) := (1 shift 22) add
6 15546 (fil(zi).iaf(2+i) extract 22);
6 15547 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15548 end
5 15549 else
5 15550 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15551 end;
4 15552 end;
3 15553 <*+2*>
3 15554 <**> disable
3 15555 <**> if testbit44 and overvåget then
3 15556 <**> begin
4 15557 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15558 <**> p_springtabel(out); ud;
4 15559 <**> end;
3 15560 <*-2*>
3 15561
3 15561 nr:= nr +1;
3 15562 goto næste_sekv;
3 15563 \f
3 15563 message procedure vt_spring side 7 - 810506/cl;
3 15564
3 15564 afkod_operation:
3 15565 <*+2*>
3 15566 <**> disable
3 15567 <**> if testbit41 and overvåget then
3 15568 <**> begin
4 15569 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15570 <**> skriv_op(out,komm_op);
4 15571 <**> end;
3 15572 <*-2*>
3 15573
3 15573 disable
3 15574 begin integer opk;
4 15575
4 15575 opk:= d.komm_op.opkode extract 12;
4 15576 funk:= if opk = 30 <*sp,d*> then 5 else
4 15577 if opk = 31 <*sp. *> then 1 else
4 15578 if opk = 32 <*sp,v*> then 4 else
4 15579 if opk = 33 <*sp,o*> then 6 else
4 15580 if opk = 34 <*sp,r*> then 2 else
4 15581 if opk = 35 <*sp,a*> then 3 else
4 15582 0;
4 15583 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15584
4 15584 if funk <> 6 <*sp,o*> then
4 15585 begin <* find nr i springtabel *>
5 15586 nr:= 0;
5 15587 for i:= 1 step 1 until max_antal_spring do
5 15588 if springtabel(i,1) = d.komm_op.data(1) and
5 15589 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15590 end;
4 15591 end;
3 15592 if funk = 6 then goto oversigt;
3 15593 if funk = 5 then goto definer;
3 15594
3 15594 if nr = 0 then
3 15595 begin
4 15596 returner_op(komm_op,37<*spring ukendt*>);
4 15597 goto næste_tid;
4 15598 end;
3 15599
3 15599 goto case funk of(start,indsæt,annuler,vis);
3 15600 \f
3 15600 message procedure vt_spring side 8 - 810525/cl;
3 15601
3 15601 start:
3 15602 if springtabel(nr,3) shift (-12) <> 0 then
3 15603 begin returner_op(komm_op,38); goto næste_tid; end;
3 15604 disable
3 15605 begin <* find linie_løb_og_udtag *>
4 15606 s:= modif_fil(tf_springdef,nr,zi);
4 15607 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15608 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15609 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15610 id2:= 0;
4 15611 end;
3 15612 vt_operation(12,id1,id2,res,res_inf);
3 15613
3 15613 disable <* check resultat *>
3 15614 medd_kode:= if res = 3 <*ok*> then 7 else
3 15615 if res = 9 <*linie/løb ukendt*> then 1 else
3 15616 if res =14 <*optaget*> then 4 else
3 15617 if res =18 <*i kø*> then 3 else 0;
3 15618 returner_op(komm_op,3);
3 15619 if medd_kode = 0 then goto næste_tid;
3 15620
3 15620 <* send spring-meddelelse til io *>
3 15621 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15622
3 15622 <* opdater springtabel *>
3 15623 disable
3 15624 begin
4 15625 s:= modif_fil(tf_springdef,nr,zi);
4 15626 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15627 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15628 add (springtabel(nr,3) extract 12);
4 15629 systime(1,0.0,nu);
4 15630 springstart(nr):= nu;
4 15631 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15632 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15633 end;
3 15634 <*+2*>
3 15635 <**> disable
3 15636 <**> if testbit44 and overvåget then
3 15637 <**> begin
4 15638 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15639 <**> p_springtabel(out); ud;
4 15640 <**> end;
3 15641 <*-2*>
3 15642
3 15642 goto næste_tid;
3 15643 \f
3 15643 message procedure vt_spring side 9 - 810506/cl;
3 15644
3 15644 indsæt:
3 15645 if springtabel(nr,3) shift (-12) = 0 then
3 15646 begin <* ikke igangsat *>
4 15647 returner_op(komm_op,41);
4 15648 goto næste_tid;
4 15649 end;
3 15650 <* find frie linie/løb *>
3 15651 disable
3 15652 begin
4 15653 s:= læs_fil(tf_springdef,nr,zi);
4 15654 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15655 id2:= 0;
4 15656 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15657 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15658 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15659 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15660 id1:= d.komm_op.data(3);
4 15661 end;
3 15662
3 15662 if id2<>0 then
3 15663 vt_operation(11,id1,id2,res,res_inf)
3 15664 else
3 15665 res:= 42;
3 15666
3 15666 disable <* check resultat *>
3 15667 medd_kode:= if res = 3 <*ok*> then 8 else
3 15668 if res =10 <*bus ukendt*> then 0 else
3 15669 if res =11 <*bus allerede indsat*> then 0 else
3 15670 if res =12 <*linie/løb allerede besat*> then 2 else
3 15671 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15672 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15673 returner_op(komm_op,res);
3 15674 if medd_kode = 0 then goto næste_tid;
3 15675
3 15675 <* send springmeddelelse til io *>
3 15676 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15677 io_meddelelse(5,0,0,nr);
3 15678 \f
3 15678 message procedure vt_spring side 9a - 810525/cl;
3 15679
3 15679 <* annuler springtabel *>
3 15680 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15681 springtid(nr):= springstart(nr):= 0.0;
3 15682 <*+2*>
3 15683 <**> disable
3 15684 <**> if testbit44 and overvåget then
3 15685 <**> begin
4 15686 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15687 <**> p_springtabel(out); ud;
4 15688 <**> end;
3 15689 <*-2*>
3 15690
3 15690 goto næste_tid;
3 15691 \f
3 15691 message procedure vt_spring side 10 - 810525/cl;
3 15692
3 15692 annuler:
3 15693 disable
3 15694 begin <* find evt. frit linie/løb *>
4 15695 s:= læs_fil(tf_springdef,nr,zi);
4 15696 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15697 id1:= id2:= 0;
4 15698 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15699 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15700 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15701 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15702 returner_op(komm_op,3);
4 15703 end;
3 15704
3 15704 <* send springmeddelelse til io *>
3 15705 io_meddelelse(5,id1,id2,nr);
3 15706
3 15706 <* annuler springtabel *>
3 15707 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15708 springtid(nr):= springstart(nr):= 0.0;
3 15709 <*+2*>
3 15710 <**> disable
3 15711 <**> if testbit44 and overvåget then
3 15712 <**> begin
4 15713 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15714 <**> p_springtabel(out); ud;
4 15715 <**> end;
3 15716 <*-2*>
3 15717
3 15717 goto næste_tid;
3 15718
3 15718 definer:
3 15719 if nr <> 0 then <* allerede defineret *>
3 15720 begin
4 15721 res:= 36;
4 15722 goto slut_definer;
4 15723 end;
3 15724
3 15724 <* find frit nr *>
3 15725 i:= 0;
3 15726 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15727 if springtabel(i,1) = 0 then nr:= i;
3 15728 if nr = 0 then
3 15729 begin
4 15730 res:= 32; <* ingen fri plads *>
4 15731 goto slut_definer;
4 15732 end;
3 15733 \f
3 15733 message procedure vt_spring side 11 - 810525/cl;
3 15734
3 15734 disable
3 15735 begin integer array fdim(1:8),ia(1:32);
4 15736 <* læs sekvens *>
4 15737 fdim(4):= d.komm_op.data(3);
4 15738 s:= hent_fil_dim(fdim);
4 15739 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15740 if fdim(1) > 30 then
4 15741 res:= 35 <* springsekvens for stor *>
4 15742 else
4 15743 begin
5 15744 for i:= 1 step 1 until fdim(1) do
5 15745 begin
6 15746 s:= læs_fil(fdim(4),i,zi);
6 15747 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15748 ia(i):= fil(zi).iaf(1) shift 12;
6 15749 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15750 end;
5 15751 s:= modif_fil(tf_springdef,nr,zi);
5 15752 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15753 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15754 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15755 iaf:= 4;
5 15756 tofrom(fil(zi).iaf,ia,60);
5 15757 iaf:= 0;
5 15758 springtabel(nr,3):= fdim(1);
5 15759 springtid(nr):= springstart(nr):= 0.0;
5 15760 res:= 3;
5 15761 end;
4 15762 end;
3 15763 \f
3 15763 message procedure vt_spring side 11a - 81-525/cl;
3 15764
3 15764 slut_definer:
3 15765
3 15765 <* slet fil *>
3 15766 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15767 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15768 signalch(cs_slet_fil,spr_op,vt_optype);
3 15769 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15770 if d.spr_op.data(9) <> 0 then
3 15771 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15772 returner_op(komm_op,res);
3 15773 <*+2*>
3 15774 <**> disable
3 15775 <**> if testbit44 and overvåget then
3 15776 <**> begin
4 15777 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15778 <**> p_springtabel(out); ud;
4 15779 <**> end;
3 15780 <*-2*>
3 15781 goto næste_tid;
3 15782 \f
3 15782 message procedure vt_spring side 12 - 810525/cl;
3 15783
3 15783 vis:
3 15784 disable
3 15785 begin
4 15786 <* tilknyt fil *>
4 15787 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15788 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15789 d.spr_op.data(2):= 1;
4 15790 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15791 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15792 signalch(cs_opret_fil,spr_op,vt_optype);
4 15793 end;
3 15794
3 15794 <* afvent svar *>
3 15795 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15796 if d.spr_op.data(9) <> 0 then
3 15797 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15798 disable
3 15799 begin integer array ia(1:30);
4 15800 s:= læs_fil(tf_springdef,nr,zi);
4 15801 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15802 iaf:= 4;
4 15803 tofrom(ia,fil(zi).iaf,60);
4 15804 iaf:= 0;
4 15805 for i:= 1 step 1 until d.spr_op.data(1) do
4 15806 begin
5 15807 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15808 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15809 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15810 ia(i) shift (-12) extract 7
5 15811 else -(ia(i) shift (-12) extract 7);
5 15812 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15813 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15814 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15815 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15816 else ia(i) extract 12)
5 15817 else 0;
5 15818 end;
4 15819 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15820 sæt_fil_dim(d.spr_op.data);
4 15821 d.komm_op.data(3):= d.spr_op.data(1);
4 15822 d.komm_op.data(4):= d.spr_op.data(4);
4 15823 raf:= data+8;
4 15824 d.komm_op.raf(1):= springstart(nr);
4 15825 returner_op(komm_op,3);
4 15826 end;
3 15827 goto næste_tid;
3 15828 \f
3 15828 message procedure vt_spring side 13 - 810525/cl;
3 15829
3 15829 oversigt:
3 15830 disable
3 15831 begin
4 15832 <* opret fil *>
4 15833 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15834 d.spr_op.data(1):= max_antal_spring;
4 15835 d.spr_op.data(2):= 4;
4 15836 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15837 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15838 signalch(cs_opret_fil,spr_op,vt_optype);
4 15839 end;
3 15840
3 15840 <* afvent svar *>
3 15841 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15842 if d.spr_op.data(9) <> 0 then
3 15843 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15844 disable
3 15845 begin
4 15846 nr:= 0;
4 15847 for i:= 1 step 1 until max_antal_spring do
4 15848 begin
5 15849 if springtabel(i,1) <> 0 then
5 15850 begin
6 15851 nr:= nr +1;
6 15852 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15853 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15854 fil(zi).iaf(1):= springtabel(i,1);
6 15855 fil(zi).iaf(2):= springtabel(i,2);
6 15856 fil(zi,2):= springstart(i);
6 15857 end;
5 15858 end;
4 15859 d.spr_op.data(1):= nr;
4 15860 s:= sæt_fil_dim(d.spr_op.data);
4 15861 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15862 d.komm_op.data(1):= nr;
4 15863 d.komm_op.data(2):= d.spr_op.data(4);
4 15864 returner_op(komm_op,3);
4 15865 end;
3 15866 goto næste_tid;
3 15867
3 15867 vt_spring_trap:
3 15868 disable skriv_vt_spring(zbillede,1);
3 15869
3 15869 end vt_spring;
2 15870 \f
2 15870 message procedure vt_auto side 1 - 810505/cl;
2 15871
2 15871 procedure vt_auto(cs_auto_retur,auto_opref);
2 15872 value cs_auto_retur,auto_opref;
2 15873 integer cs_auto_retur,auto_opref;
2 15874 begin
3 15875 integer array field op,auto_op,iaf;
3 15876 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15877 res_inf,i,s,zi,kl,døgnstart;
3 15878 real t,nu,næste_tid;
3 15879 boolean optaget;
3 15880 integer array filnavn,nytnavn(1:4);
3 15881
3 15881 procedure skriv_vt_auto(zud,omfang);
3 15882 value omfang;
3 15883 zone zud;
3 15884 integer omfang;
3 15885 begin
4 15886 long array field laf;
4 15887
4 15887 laf:= 0;
4 15888 write(zud,"nl",1,<:+++ vt_auto :>);
4 15889 if omfang<>0 then
4 15890 begin
5 15891 skriv_coru(zud,abs curr_coruno);
5 15892 write(zud,"nl",1,<<d>,
5 15893 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15894 <:op :>,op,"nl",1,
5 15895 <:auto-op :>,auto_op,"nl",1,
5 15896 <:filref :>,filref,"nl",1,
5 15897 <:id1 :>,id1,"nl",1,
5 15898 <:id2 :>,id2,"nl",1,
5 15899 <:aktion :>,aktion,"nl",1,
5 15900 <:postnr :>,postnr,"nl",1,
5 15901 <:sidste-post :>,sidste_post,"nl",1,
5 15902 <:interval :>,interval,"nl",1,
5 15903 <:res :>,res,"nl",1,
5 15904 <:res-inf :>,res_inf,"nl",1,
5 15905 <:i :>,i,"nl",1,
5 15906 <:s :>,s,"nl",1,
5 15907 <:zi :>,zi,"nl",1,
5 15908 <:kl :>,kl,"nl",1,
5 15909 <:døgnstart :>,døgnstart,"nl",1,
5 15910 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15911 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15912 <:nu :>,nu,"nl",1,
5 15913 <:næste-tid :>,næste_tid,"nl",1,
5 15914 <:filnavn :>,filnavn.laf,"nl",1,
5 15915 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15916 <::>);
5 15917 end;
4 15918 end skriv_vt_auto;
3 15919 \f
3 15919 message procedure vt_auto side 2 - 810507/cl;
3 15920
3 15920 iaf:= 0;
3 15921 auto_op:= auto_opref;
3 15922 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15923 optaget:= false;
3 15924 næste_tid:= 0.0;
3 15925 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15926 stack_claim(if cm_test then 298 else 246);
3 15927 trap(vt_auto_trap);
3 15928
3 15928 <*+2*>
3 15929 <**> disable if testbit47 and overvåget or testbit28 then
3 15930 <**> skriv_vt_auto(out,0);
3 15931 <*-2*>
3 15932
3 15932 vent:
3 15933
3 15933 systime(1,0.0,nu);
3 15934 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15935 if næste_tid > nu then round(næste_tid-nu) else
3 15936 if optaget then 5 else 0;
3 15937 if interval=0 then interval:= 1;
3 15938
3 15938 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15939
3 15939 if op<>0 then goto filskift;
3 15940
3 15940 <* vent på adgang til vogntabel *>
3 15941 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15942
3 15942 <* afsend relevant operation til opdatering af vogntabel *>
3 15943 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15944 d.op.data(1):= id1;
3 15945 d.op.data(2):= id2;
3 15946 signalch(cs_vt_opd,op,vt_optype);
3 15947 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15948 res:= d.op.resultat;
3 15949 id2:= d.op.data(2);
3 15950 res_inf:= d.op.data(3);
3 15951
3 15951 <* åbn for vogntabel *>
3 15952 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15953 \f
3 15953 message procedure vt_auto side 3 - 810507/cl;
3 15954
3 15954 <* behandl svar fra opdatering *>
3 15955 <*+2*>
3 15956 <**> disable
3 15957 <**> if testbit45 and overvåget then
3 15958 <**> begin
4 15959 <**> integer li,lø,bo;
4 15960 <**> skriv_vt_auto(out,0);
4 15961 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15962 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15963 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15964 <**> for i:= 1,2 do
4 15965 <**> begin
5 15966 <**> li:= d.op.data(i);
5 15967 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15968 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15969 <**> li:= li shift (-12) extract 10;
5 15970 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15971 <**> end;
4 15972 <**> systime(4,næste_tid,t);
4 15973 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15974 <**> << zd.dd>,t/10000,"nl",1);
4 15975 <**> end;
3 15976 <*-2*>
3 15977 if res=31 then
3 15978 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15979 else
3 15980 if res<>3 then
3 15981 begin
4 15982 if -, optaget then
4 15983 begin
5 15984 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15985 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15986 if res=18 then 3 else if res=60 then 9 else 4;
5 15987 d.auto_op.data(2):= res_inf;
5 15988 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15989 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15990 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15991 end;
4 15992 if res=14 or res=18 then <* i kø eller optaget *>
4 15993 begin
5 15994 optaget:= true;
5 15995 goto vent;
5 15996 end;
4 15997 end;
3 15998 optaget:= false;
3 15999 \f
3 15999 message procedure vt_auto side 4 - 810507/cl;
3 16000
3 16000 <* find næste post *>
3 16001 disable
3 16002 begin
4 16003 if postnr=sidste_post then
4 16004 begin <* døgnskift *>
5 16005 postnr:= 1;
5 16006 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16007 end
4 16008 else postnr:= postnr+1;
4 16009 s:= læsfil(filref,postnr,zi);
4 16010 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 16011 aktion:= fil(zi).iaf(1);
4 16012 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 16013 id1:= fil(zi).iaf(3);
4 16014 id2:= fil(zi).iaf(4);
4 16015 end;
3 16016 goto vent;
3 16017 \f
3 16017 message procedure vt_auto side 5 - 810507/cl;
3 16018
3 16018 filskift:
3 16019
3 16019 <*+2*>
3 16020 <**> disable
3 16021 <**> if testbit41 and overvåget then
3 16022 <**> begin
4 16023 <**> skriv_vt_auto(out,0);
4 16024 <**> write(out,<: modtaget operation::>);
4 16025 <**> skriv_op(out,op);
4 16026 <**> end;
3 16027 <*-2*>
3 16028 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 16029 res:= 46;
3 16030 if d.op.opkode extract 12 <> 21 then
3 16031 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 16032 if filref = 0 then goto knyt;
3 16033
3 16033 <* gem filnavn til io-meddelelse *>
3 16034 disable begin
4 16035 integer array fdim(1:8);
4 16036 integer array field navn;
4 16037 fdim(4):= filref;
4 16038 hentfildim(fdim);
4 16039 navn:= 8;
4 16040 tofrom(filnavn,fdim.navn,8);
4 16041 end;
3 16042
3 16042 <* frivgiv tilknyttet autofil *>
3 16043 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 16044 d.auto_op.data(4):= filref;
3 16045 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 16046 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 16047 if d.auto_op.data(9) <> 0 then
3 16048 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 16049 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 16050 optaget:= false;
3 16051 næste_tid:= 0.0;
3 16052 res:= 3;
3 16053 \f
3 16053 message procedure vt_auto side 6 - 810507/cl;
3 16054
3 16054 <* tilknyt evt. ny autofil *>
3 16055 knyt:
3 16056 if d.op.data(1)<>0 then
3 16057 begin
4 16058 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 16059 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 16060 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 16061 disable
4 16062 begin integer pos1,pos2;
5 16063 pos1:= pos2:= 13;
5 16064 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 16065 begin
6 16066 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 16067 skrivtegn(d.auto_op.data,pos2,i);
6 16068 end;
5 16069 end;
4 16070 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 16071 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 16072 s:= d.auto_op.data(9);
4 16073 if s=0 then res:= 3 <* ok *> else
4 16074 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 16075 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 16076 if s=6 then res:= 48 <* i brug *> else
4 16077 fejlreaktion(14,2,<:auto,filskift:>,0);
4 16078 if res<>3 then goto returner;
4 16079
4 16079 tofrom(nytnavn,d.op.data,8);
4 16080
4 16080 <* find første post *>
4 16081 disable
4 16082 begin
5 16083 døgnstart:= systime(5,0.0,t);
5 16084 kl:= round t;
5 16085 filref:= d.auto_op.data(4);
5 16086 sidste_post:= d.auto_op.data(1);
5 16087 postnr:= 0;
5 16088 for postnr:= postnr+1 while postnr <= sidste_post do
5 16089 begin
6 16090 s:= læsfil(filref,postnr,zi);
6 16091 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 16092 if fil(zi).iaf(2) > kl then goto post_fundet;
6 16093 end;
5 16094 postnr:= 1;
5 16095 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16096 \f
5 16096 message procedure vt_auto side 7 - 810507/cl;
5 16097
5 16097 post_fundet:
5 16098 s:= læsfil(filref,postnr,zi);
5 16099 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 16100 aktion:= fil(zi).iaf(1);
5 16101 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 16102 id1:= fil(zi).iaf(3);
5 16103 id2:= fil(zi).iaf(4);
5 16104 res:= 3;
5 16105 end;
4 16106 end ny fil;
3 16107
3 16107 returner:
3 16108 d.op.resultat:= res;
3 16109 <*+2*>
3 16110 <**> disable
3 16111 <**> if testbit41 and overvåget then
3 16112 <**> begin
4 16113 <**> skriv_vt_auto(out,0);
4 16114 <**> write(out,<: returner operation::>);
4 16115 <**> skriv_op(out,op);
4 16116 <**> end;
3 16117 <*-2*>
3 16118 signalch(d.op.retur,op,d.op.optype);
3 16119
3 16119 if vt_log_aktiv then
3 16120 begin
4 16121 waitch(cs_vt_logpool,op,vt_optype,-1);
4 16122 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 16123 if nytnavn(1)=0 then
4 16124 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 16125 else
4 16126 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 16127 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 16128 systime(1,0.0,d.op.data.v_tid);
4 16129 signalch(cs_vt_log,op,vt_optype);
4 16130 end;
3 16131
3 16131 if filnavn(1)<>0 then
3 16132 begin <* meddelelse til io om annulering *>
4 16133 disable begin
5 16134 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 16135 i:= 1;
5 16136 hægtstring(d.auto_op.data,i,<:auto :>);
5 16137 skriv_text(d.auto_op.data,i,filnavn);
5 16138 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 16139 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 16140 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16141 end;
4 16142 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 16143 end;
3 16144 goto vent;
3 16145
3 16145 vt_auto_trap:
3 16146 disable skriv_vt_auto(zbillede,1);
3 16147
3 16147 end vt_auto;
2 16148 message procedure vt_log side 1 - 920517/cl;
2 16149
2 16149 procedure vt_log;
2 16150 begin
3 16151 integer i,j,ventetid;
3 16152 real dg,t,nu,skiftetid;
3 16153 boolean fil_åben;
3 16154 integer array ia(1:10),dp,dp1(1:8);
3 16155 integer array field op, iaf;
3 16156
3 16156 procedure skriv_vt_log(zud,omfang);
3 16157 value omfang;
3 16158 zone zud;
3 16159 integer omfang;
3 16160 begin
4 16161 write(zud,"nl",1,<:+++ vt-log :>);
4 16162 if omfang<>0 then
4 16163 begin
5 16164 skriv_coru(zud, abs curr_coruno);
5 16165 write(zud,"nl",1,<<d>,
5 16166 <:i :>,i,"nl",1,
5 16167 <:j :>,j,"nl",1,
5 16168 <:ventetid :>,ventetid,"nl",1,
5 16169 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 16170 <:t :>,t,"nl",1,
5 16171 <:nu :>,nu,"nl",1,
5 16172 <:skiftetid :>,skiftetid,"nl",1,
5 16173 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 16174 <:op :>,<<d>,op,"nl",1,
5 16175 <::>);
5 16176 raf:= 0;
5 16177 write(zud,"nl",1,<:ia::>);
5 16178 skrivhele(zud,ia.raf,20,2);
5 16179 write(zud,"nl",2,<:dp::>);
5 16180 skrivhele(zud,dp.raf,16,2);
5 16181 write(zud,"nl",2,<:dp1::>);
5 16182 skrivhele(zud,dp1.raf,16,2);
5 16183 end;
4 16184 end;
3 16185
3 16185 message procedure vt_log side 2 - 920517/cl;
3 16186
3 16186 procedure slet_fil;
3 16187 begin
4 16188 integer segm,res;
4 16189 integer array tail(1:10);
4 16190
4 16190 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 16191 if res=0 then
4 16192 begin
5 16193 segm:= tail(10);
5 16194 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 16195 if res=0 then
5 16196 begin
6 16197 close(zvtlog,true);
6 16198 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 16199 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16200 if res=0 then
6 16201 begin
7 16202 tail(1):= tail(1)+segm;
7 16203 monitor(44)change_entry:(zvtlog,0,tail);
7 16204 end;
6 16205 end;
5 16206 end;
4 16207 end;
3 16208
3 16208 boolean procedure udvid_fil;
3 16209 begin
4 16210 integer res,spos;
4 16211 integer array tail(1:10);
4 16212 zone z(1,1,stderror);
4 16213
4 16213 udvid_fil:= false;
4 16214 open(z,0,<:vtlogpool:>,0); close(z,true);
4 16215 res:= monitor(42)lookup_entry:(z,0,tail);
4 16216 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 16217 begin
5 16218 tail(1):=tail(1) - vt_log_slicelgd;
5 16219 res:=monitor(44)change_entry:(z,0,tail);
5 16220 if res=0 then
5 16221 begin
6 16222 spos:= vt_logtail(1);
6 16223 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 16224 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 16225 if res<>0 then
6 16226 begin
7 16227 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 16228 tail(1):= tail(1) + vt_log_slicelgd;
7 16229 monitor(44)change_entry:(z,0,tail);
7 16230 end
6 16231 else
6 16232 begin
7 16233 setposition(zvtlog,0,spos);
7 16234 udvid_fil:= true;
7 16235 end;
6 16236 end;
5 16237 end;
4 16238 end;
3 16239
3 16239 message procedure vt_log side 3 - 920517/cl;
3 16240
3 16240 boolean procedure ny_fil;
3 16241 begin
4 16242 integer res,i,j;
4 16243 integer array nyt(1:4), ia,tail(1:10);
4 16244 long array field navn;
4 16245 real t;
4 16246
4 16246 navn:=0;
4 16247 if fil_åben then
4 16248 begin
5 16249 close(zvtlog,true);
5 16250 fil_åben:= false;
5 16251 nyt.navn(1):= long<:vtlo:>;
5 16252 nyt.navn(2):= long<::>;
5 16253 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 16254 j:= 'a' - 1;
5 16255 repeat
5 16256 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 16257 if res=3 then
5 16258 begin
6 16259 j:= j+1;
6 16260 if j <= 'å' then skrivtegn(nyt,11,j);
6 16261 end;
5 16262 until (res<>3) or (j > 'å');
5 16263
5 16263 if res=0 then
5 16264 begin
6 16265 open(zvtlog,4,<:vtlogklar:>,0);
6 16266 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16267 if res=0 then
6 16268 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 16269 if res=0 then
6 16270 begin
7 16271 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 16272 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 16273 end;
6 16274
6 16274 if res=0 then
6 16275 begin
7 16276 setposition(zvtlog,0,tail(10)//64);
7 16277 navn:= (tail(10) mod 64)*8;
7 16278 if (tail(1) <= tail(10)//64) then
7 16279 outrec6(zvtlog,512)
7 16280 else
7 16281 swoprec6(zvtlog,512);
7 16282 tofrom(zvtlog.navn,nyt,8);
7 16283 tail(10):= tail(10)+1;
7 16284 setposition(zvtlog,0,tail(10)//64);
7 16285 monitor(44)change_entry:(zvtlog,0,tail);
7 16286 close(zvtlog,true);
7 16287 end
6 16288 else
6 16289 begin
7 16290 navn:= 0;
7 16291 close(zvtlog,true);
7 16292 open(zvtlog,4,<:vtlog:>,0);
7 16293 slet_fil;
7 16294 end;
6 16295 end
5 16296 else
5 16297 slet_fil;
5 16298 end;
4 16299
4 16299 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 16300 <* eller den er blevet slettet. *>
4 16301
4 16301 open(zvtlog,4,<:vtlog:>,0);
4 16302 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 16303 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 16304 vt_logtail(6):= systime(7,0,t);
4 16305
4 16305 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 16306 if res=0 then
4 16307 begin
5 16308 monitor(50)permanent_entry:(zvtlog,3,ia);
5 16309 if res<>0 then
5 16310 monitor(48)remove_entry:(zvtlog,0,ia);
5 16311 end;
4 16312
4 16312 if res=0 then fil_åben:= true;
4 16313
4 16313 ny_fil:= fil_åben;
4 16314 end ny_fil;
3 16315
3 16315 message procedure vt_log side 4 - 920517/cl;
3 16316
3 16316 procedure skriv_post(logpost);
3 16317 integer array logpost;
3 16318 begin
4 16319 integer array field post;
4 16320 real t;
4 16321
4 16321 if vt_logtail(10)//32 < vt_logtail(1) then
4 16322 begin
5 16323 outrec6(zvtlog,512);
5 16324 post:= (vt_logtail(10) mod 32)*16;
5 16325 tofrom(zvtlog.post,logpost,16);
5 16326 vt_logtail(10):= vt_logtail(10)+1;
5 16327 setposition(zvtlog,0,vt_logtail(10)//32);
5 16328 vt_logtail(6):= systime(7,0,t);
5 16329 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 16330 end;
4 16331 end;
3 16332
3 16332 procedure sletsendte;
3 16333 begin
4 16334 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 16335 integer array pooltail,tail,ia(1:10);
4 16336 integer i,res;
4 16337
4 16337 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 16338 res:=monitor(42,zpool,0,pooltail);
4 16339
4 16339 open(z,4,<:vtlogslet:>,0);
4 16340 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 16341 begin
5 16342 if monitor(52,z,0,tail)=0 then
5 16343 begin
6 16344 if monitor(8,z,0,tail)=0 then
6 16345 begin
7 16346 for i:=1 step 1 until tail(10) do
7 16347 begin
8 16348 inrec6(z,8);
8 16349 open(zlog,0,z,0); close(zlog,true);
8 16350 if monitor(42,zlog,0,ia)=0 then
8 16351 begin
9 16352 if monitor(48,zlog,0,ia)=0 then
9 16353 begin
10 16354 pooltail(1):=pooltail(1)+ia(1);
10 16355 end;
9 16356 end;
8 16357 end;
7 16358 tail(10):=0;
7 16359 monitor(44,z,0,tail);
7 16360 end
6 16361 else
6 16362 monitor(64,z,0,tail);
6 16363 end;
5 16364 if res=0 then monitor(44,zpool,0,pooltail);
5 16365 end;
4 16366 close(z,true);
4 16367 end;
3 16368
3 16368 message procedure vt_log side 5 - 920517/cl;
3 16369
3 16369 trap(vt_log_trap);
3 16370 stack_claim(200);
3 16371
3 16371 fil_åben:= false;
3 16372 if -, vt_log_aktiv then goto init_slut;
3 16373 open(zvtlog,4,<:vtlog:>,0);
3 16374 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16375 if i=0 then
3 16376 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16377 if i=0 then
3 16378 begin
4 16379 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16380 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16381 end;
3 16382
3 16382 if (i=0) and (vt_logtail(1)=0) then
3 16383 begin
4 16384 close(zvtlog,true);
4 16385 monitor(48)remove_entry:(zvtlog,0,ia);
4 16386 i:= 1;
4 16387 end;
3 16388
3 16388 disable
3 16389 if i=0 then
3 16390 begin
4 16391 fil_åben:= true;
4 16392 inrec6(zvtlog,512);
4 16393 vt_logstart:= zvtlog.v_tid;
4 16394 systime(1,0.0,nu);
4 16395 if (nu - vt_logstart) < 24*60*60.0 then
4 16396 begin
5 16397 setposition(zvtlog,0,vt_logtail(10)//32);
5 16398 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16399 begin
6 16400 inrec6(zvtlog,512);
6 16401 setposition(zvtlog,0,vt_logtail(10)//32);
6 16402 end;
5 16403 end
4 16404 else
4 16405 begin
5 16406 if ny_fil then
5 16407 begin
6 16408 if udvid_fil then
6 16409 begin
7 16410 systime(1,0.0,dp.v_tid);
7 16411 vt_logstart:= dp.v_tid;
7 16412 dp.v_kode:=0;
7 16413 skriv_post(dp);
7 16414 end
6 16415 else
6 16416 begin
7 16417 close(zvtlog,true);
7 16418 monitor(48)remove_entry:(zvtlog,0,ia);
7 16419 fil_åben:= false;
7 16420 end;
6 16421 end;
5 16422 end;
4 16423 end
3 16424 else
3 16425 begin
4 16426 close(zvtlog,true);
4 16427 if ny_fil then
4 16428 begin
5 16429 if udvid_fil then
5 16430 begin
6 16431 systime(1,0.0,dp.v_tid);
6 16432 vt_logstart:= dp.v_tid;
6 16433 dp.v_kode:=0;
6 16434 skriv_post(dp);
6 16435 end
5 16436 else
5 16437 begin
6 16438 close(zvtlog,true);
6 16439 monitor(48)remove_entry:(zvtlog,0,ia);
6 16440 fil_åben:= false;
6 16441 end;
5 16442 end;
4 16443 end;
3 16444
3 16444 init_slut:
3 16445
3 16445 dg:= systime(5,0,t);
3 16446 if t < vt_logskift then
3 16447 skiftetid:= systid(dg,vt_logskift)
3 16448 else
3 16449 skiftetid:= systid(dg+1,vt_logskift);
3 16450
3 16450 message procedure vt_log side 6 - 920517/cl;
3 16451
3 16451 vent:
3 16452
3 16452 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16453 ventetid:= round(skiftetid - nu);
3 16454 if ventetid < 1 then ventetid:= 1;
3 16455
3 16455 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16456
3 16456 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16457 if op <> 0 then
3 16458 begin
4 16459 tofrom(dp,d.op.data,16);
4 16460 signalch(cs_vt_logpool,op,vt_optype);
4 16461 end;
3 16462
3 16462 if -, vt_log_aktiv then goto vent;
3 16463
3 16463 disable if (op=0) or (nu > skiftetid) then
3 16464 begin
4 16465 if fil_åben then
4 16466 begin
5 16467 dp1.v_tid:= systid(dg,vt_logskift);
5 16468 dp1.v_kode:= 1;
5 16469 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16470 begin
6 16471 if udvid_fil then
6 16472 skriv_post(dp1);
6 16473 end
5 16474 else
5 16475 skriv_post(dp1);
5 16476 end;
4 16477
4 16477 if (op=0) or (nu > skiftetid) then
4 16478 skiftetid:= skiftetid + 24*60*60.0;
4 16479
4 16479 sletsendte;
4 16480
4 16480 if ny_fil then
4 16481 begin
5 16482 if udvid_fil then
5 16483 begin
6 16484 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16485 dp1.v_kode:= 0;
6 16486 skriv_post(dp1);
6 16487 end
5 16488 else
5 16489 begin
6 16490 close(zvtlog,true);
6 16491 monitor(48)remove_entry:(zvtlog,0,ia);
6 16492 fil_åben:= false;
6 16493 end;
5 16494 end;
4 16495 end;
3 16496
3 16496 disable if op<>0 and fil_åben then
3 16497 begin
4 16498 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16499 begin
5 16500 if -, udvid_fil then
5 16501 begin
6 16502 if ny_fil then
6 16503 begin
7 16504 if udvid_fil then
7 16505 begin
8 16506 systime(1,0.0,dp1.v_tid);
8 16507 vt_logstart:= dp1.v_tid;
8 16508 dp1.v_kode:= 0;
8 16509 skriv_post(dp1);
8 16510 end
7 16511 else
7 16512 begin
8 16513 close(zvtlog,true);
8 16514 monitor(48)remove_entry:(zvtlog,0,ia);
8 16515 fil_åben:= false;
8 16516 end;
7 16517 end;
6 16518 end;
5 16519 end;
4 16520
4 16520 if fil_åben then skriv_post(dp);
4 16521 end;
3 16522
3 16522 goto vent;
3 16523
3 16523 vt_log_trap:
3 16524 disable skriv_vt_log(zbillede,1);
3 16525 end vt_log;
2 16526 \f
2 16526
2 16526 algol list.off;
2 16527 message coroutinemonitor - 11 ;
2 16528
2 16528
2 16528 <*************** coroutine monitor procedures ***************>
2 16529
2 16529
2 16529 <***** delay *****
2 16530
2 16530 this procedure links the calling coroutine into the timerqueue and sets
2 16531 the timeout value to 'timeout'. *>
2 16532
2 16532
2 16532 procedure delay (timeout);
2 16533 value timeout;
2 16534 integer timeout;
2 16535 begin
3 16536 link(current, idlequeue);
3 16537 link(current + corutimerchain, timerqueue);
3 16538 d.current.corutimer:= timeout;
3 16539
3 16539
3 16539 passivate;
3 16540 d.current.corutimer:= 0;
3 16541 end;
2 16542 \f
2 16542
2 16542 message coroutinemonitor - 12 ;
2 16543
2 16543
2 16543 <***** pass *****
2 16544
2 16544 this procedure moves the calling coroutine from the head of the ready
2 16545 queue down below all coroutines of lower or equal priority. *>
2 16546
2 16546
2 16546 procedure pass;
2 16547 begin
3 16548 linkprio(current, readyqueue);
3 16549
3 16549
3 16549 passivate;
3 16550 end;
2 16551
2 16551
2 16551 <***** signal ****
2 16552
2 16552 this procedure increases the value af 'semaphore' by 1.
2 16553 in case some coroutine is already waiting, it is linked into the ready
2 16554 queue for activation. the calling coroutine continues execution. *>
2 16555
2 16555
2 16555 procedure signal (semaphore);
2 16556 value semaphore;
2 16557 integer semaphore;
2 16558 begin
3 16559 integer array field sem;
3 16560 sem:= semaphore;
3 16561 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16562 d.sem.simvalue:= d.sem.simvalue + 1;
3 16563
3 16563
3 16563 end;
2 16564 \f
2 16564
2 16564 message coroutinemonitor - 13 ;
2 16565
2 16565
2 16565 <***** wait *****
2 16566
2 16566 this procedure decreases the value of 'semaphore' by 1.
2 16567 in case the value of the semaphore is negative after the decrease, the
2 16568 calling coroutine is linked into the semaphore queue waiting for a
2 16569 coroutine to signal this semaphore. *>
2 16570
2 16570
2 16570 procedure wait (semaphore);
2 16571 value semaphore;
2 16572 integer semaphore;
2 16573 begin
3 16574 integer array field sem;
3 16575 sem:= semaphore;
3 16576 d.sem.simvalue:= d.sem.simvalue - 1;
3 16577
3 16577
3 16577 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16578 passivate;
3 16579 end;
2 16580 \f
2 16580
2 16580 message coroutinemonitor - 14 ;
2 16581
2 16581
2 16581 <***** inspect *****
2 16582
2 16582 this procedure inspects the value of the semaphore and returns it in
2 16583 'elements'.
2 16584 the semaphore is left unchanged. *>
2 16585
2 16585
2 16585 procedure inspect (semaphore, elements);
2 16586 value semaphore;
2 16587 integer semaphore, elements;
2 16588 begin
3 16589 integer array field sem;
3 16590 sem:= semaphore;
3 16591 elements:= d.sem.simvalue;
3 16592
3 16592
3 16592 end;
2 16593 \f
2 16593
2 16593 message coroutinemonitor - 15 ;
2 16594
2 16594
2 16594 <***** signalch *****
2 16595
2 16595 this procedure delivers an operation at 'semaphore'.
2 16596 in case another coroutine is already waiting for an operation of the
2 16597 kind 'operationtype' this coroutine will get the operation and it will
2 16598 be put into the ready queue for activation.
2 16599 in case no coroutine is waiting for the actial kind of operation it is
2 16600 linked into the semaphore queue, at the end of the queue
2 16601 if operation is positive and at the beginning if operation is negative.
2 16602 the calling coroutine continues execution. *>
2 16603
2 16603
2 16603 procedure signalch (semaphore, operation, operationtype);
2 16604 value semaphore, operation, operationtype;
2 16605 integer semaphore, operation;
2 16606 boolean operationtype;
2 16607 begin
3 16608 integer array field firstcoru, currcoru, op,currop;
3 16609 op:= abs operation;
3 16610 d.op.optype:= operationtype;
3 16611 firstcoru:= semaphore + semcoru;
3 16612 currcoru:= d.firstcoru.next;
3 16613 while currcoru <> firstcoru do
3 16614 begin
4 16615 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16616 begin
5 16617 link(operation, 0);
5 16618 d.currcoru.coruop:= operation;
5 16619 linkprio(currcoru, readyqueue);
5 16620 link(currcoru + corutimerchain, idlequeue);
5 16621 goto exit;
5 16622 end else currcoru:= d.currcoru.next;
4 16623 end;
3 16624 currop:=semaphore + semop;
3 16625 if operation < 0 then currop:=d.currop.next;
3 16626 link(op, currop);
3 16627 exit:
3 16628
3 16628
3 16628 end;
2 16629 \f
2 16629
2 16629 message coroutinemonitor - 16 ;
2 16630
2 16630
2 16630 <***** waitch *****
2 16631
2 16631 this procedure fetches an operation from a semaphore.
2 16632 in case an operation matching 'operationtypeset' is already waiting at
2 16633 'semaphore' it is handed over to the calling coroutine.
2 16634 in case no matching operation is waiting, the calling coroutine is
2 16635 linked to the semaphore.
2 16636 in any case the calling coroutine will be stopped and all corouti-
2 16637 nes are rescheduled. *>
2 16638
2 16638
2 16638 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16639 value semaphore, operationtypeset, timeout;
2 16640 integer semaphore, operation, timeout;
2 16641 boolean operationtypeset;
2 16642 begin
3 16643 integer array field firstop, currop;
3 16644 firstop:= semaphore + semop;
3 16645 currop:= d.firstop.next;
3 16646
3 16646
3 16646 while currop <> firstop do
3 16647 begin
4 16648 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16649 begin
5 16650 link(currop, 0);
5 16651 d.current.coruop:= currop;
5 16652 operation:= currop;
5 16653 \f
5 16653
5 16653 message coroutinemonitor - 17 ;
5 16654
5 16654 linkprio(current, readyqueue);
5 16655 passivate;
5 16656 goto exit;
5 16657 end else currop:= d.currop.next;
4 16658 end;
3 16659 linkprio(current, semaphore + semcoru);
3 16660 if timeout > 0 then
3 16661 begin
4 16662 link(current + corutimerchain, timerqueue);
4 16663 d.current.corutimer:= timeout;
4 16664 end else d.current.corutimer:= 0;
3 16665 d.current.corutypeset:= operationtypeset;
3 16666 passivate;
3 16667 if d.current.corutimer < 0 then operation:= 0
3 16668 else operation:= d.current.coruop;
3 16669 d.current.corutimer:= 0;
3 16670 currop:= operation;
3 16671 d.current.coruop:= currop;
3 16672 link(current+corutimerchain, idlequeue);
3 16673 exit:
3 16674
3 16674
3 16674 end;
2 16675 \f
2 16675
2 16675 message coroutinemonitor - 18 ;
2 16676
2 16676
2 16676 <***** inspectch *****
2 16677
2 16677 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16678 the number of matching operations are counted and delivered in 'elements'.
2 16679 if no operations are found the number of coroutines waiting
2 16680 for operations of the typeset are counted and delivered as
2 16681 negative value in 'elements'.
2 16682 the semaphore is left unchanged. *>
2 16683
2 16683
2 16683 procedure inspectch (semaphore, operationtypeset, elements);
2 16684 value semaphore, operationtypeset;
2 16685 integer semaphore, elements;
2 16686 boolean operationtypeset;
2 16687 begin
3 16688 integer array field firstop, currop,firstcoru,currcoru;
3 16689 integer counter;
3 16690 counter:= 0;
3 16691 firstop:= semaphore + semop;
3 16692 currop:= d.firstop.next;
3 16693 while currop <> firstop do
3 16694 begin
4 16695 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16696 counter:= counter + 1;
4 16697 currop:= d.currop.next;
4 16698 end;
3 16699 if counter=0 then
3 16700 begin
4 16701 firstcoru:=semaphore + sem_coru;
4 16702 curr_coru:=d.firstcoru.next;
4 16703 while curr_coru<>first_coru do
4 16704 begin
5 16705 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16706 counter:=counter - 1;
5 16707 curr_coru:=d.curr_coru.next;
5 16708 end;
4 16709 end;
3 16710 elements:= counter;
3 16711
3 16711
3 16711 end;
2 16712 \f
2 16712
2 16712 message coroutinemonitor - 19 ;
2 16713
2 16713
2 16713 <***** csendmessage *****
2 16714
2 16714 this procedure sends the message in 'mess' to the process defined by the name
2 16715 in 'receiver', and returns an identification of the message extension used
2 16716 for sending the message (this identification is to be used for calling 'cwait-
2 16717 answer' or 'cregretmessage'. *>
2 16718
2 16718
2 16718 procedure csendmessage (receiver, mess, messextension);
2 16719 real array receiver;
2 16720 integer array mess;
2 16721 integer messextension;
2 16722 begin
3 16723 integer bufref, messext;
3 16724 messref(maxmessext):= 0;
3 16725 messext:= 1;
3 16726 while messref(messext) <> 0 do messext:= messext + 1;
3 16727 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16728 begin
4 16729 messcode(messext):= 1 shift 12 add 2;
4 16730 mon(16) send message :(0, mess, 0, receiver);
4 16731 messref(messext):= monw2;
4 16732 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16733 end;
3 16734
3 16734
3 16734 end;
2 16735 \f
2 16735
2 16735 message coroutinemonitor - 20 ;
2 16736
2 16736
2 16736 <***** cwaitanswer *****
2 16737
2 16737 this procedure asks the coroutine monitor to get an answer to the message
2 16738 corresponding to 'messextension'. in case the answer has already arrived
2 16739 it stays in the eventqueue until 'cwaitanswer' is called.
2 16740 in case 'timeout' is positive, the coroutine is linked into the timer
2 16741 queue, and in case the answer does not arrive within 'timout' seconds the
2 16742 coroutine is restarted with result = 0. *>
2 16743
2 16743
2 16743 procedure cwaitanswer (messextension, answer, result, timeout);
2 16744 value messextension, timeout;
2 16745 integer messextension, result, timeout;
2 16746 integer array answer;
2 16747 begin
3 16748 integer messext;
3 16749 messext:= messextension;
3 16750 messcode(messext):= messcode(messext) extract 12;
3 16751 link(current, idlequeue);
3 16752 messop(messext):= current;
3 16753 if timeout > 0 then
3 16754 begin
4 16755 link(current + corutimerchain, timerqueue);
4 16756 d.current.corutimer:= timeout;
4 16757 end else d.current.corutimer:= 0;
3 16758
3 16758
3 16758 passivate;
3 16759 if d.current.corutimer < 0 then result:= 0 else
3 16760 begin
4 16761 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16762 result:= monw0;
4 16763 baseevent:= 0;
4 16764 messref(messextension):= 0;
4 16765 end;
3 16766 d.current.corutimer:= 0;
3 16767 link(current+corutimerchain, idlequeue);
3 16768 end;
2 16769 \f
2 16769
2 16769 message coroutinemonitor - 21 ;
2 16770
2 16770
2 16770 <***** cwaitmessage *****
2 16771
2 16771 this procedure asks the coroutine monitor to give it a message, when some-
2 16772 one arrives. in case a message has arrived already it stays at the event queue
2 16773 until 'cwaitmessage' is called.
2 16774 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16775 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16776 with messbufferref = 0. *>
2 16777
2 16777
2 16777 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16778 value timeout, processextension;
2 16779 integer processextension, messbufferref, timeout;
2 16780 integer array mess;
2 16781 begin
3 16782 integer i;
3 16783 integer array field messbuf;
3 16784 proccode(processextension):= 2;
3 16785 procop(processextension):= current;
3 16786 link(current, idlequeue);
3 16787 if timeout > 0 then
3 16788 begin
4 16789 link(current + corutimerchain, timerqueue);
4 16790 d.current.corutimer:= timeout;
4 16791 end else d.current.corutimer:= 0;
3 16792
3 16792
3 16792 passivate;
3 16793 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16794 begin
4 16795 messbuf:= procop(processextension);
4 16796 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16797 proccode(procext):= 1 shift 12;
4 16798 messbufferref:= messbuf;
4 16799 baseevent:= 0;
4 16800 end;
3 16801 d.current.corutimer:= 0;
3 16802 link(current+corutimerchain, idlequeue);
3 16803 end;
2 16804 \f
2 16804
2 16804 message coroutinemonitor - 22 ;
2 16805
2 16805
2 16805 <***** cregretmessage *****
2 16806
2 16806 this procedure regrets the message corresponding to messageexten-
2 16807 sion, to release message buffer and message extension.
2 16808 i/o messages are not regretable. *>
2 16809
2 16809
2 16809
2 16809 procedure cregretmessage (messageextension);
2 16810 value messageextension;
2 16811 integer messageextension;
2 16812 begin
3 16813 integer array field messbuf;
3 16814 messbuf:= messref(messageextension);
3 16815 mon(82) regret message :(0, 0, messbuf, 0);
3 16816 messref(messageextension):= 0;
3 16817
3 16817
3 16817 end;
2 16818 \f
2 16818
2 16818 message coroutinemonitor - 23 ;
2 16819
2 16819
2 16819 <***** semsendmessage *****
2 16820
2 16820 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16821 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16822 by the monitor, when the answer arrives.
2 16823 in case there are too few resources to send the message, the operation is
2 16824 returned immediately with the result field set to zero. *>
2 16825
2 16825
2 16825 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16826 value semaphore, operation, operationtype;
2 16827 real array receiver;
2 16828 integer array mess;
2 16829 integer semaphore, operation;
2 16830 boolean operationtype;
2 16831 begin
3 16832 integer array field op;
3 16833 integer messext;
3 16834 op:= operation;
3 16835 messref(maxmessext):= 0;
3 16836 messext:= 1;
3 16837 while messref(messext) <> 0 do messext:= messext + 1;
3 16838 if messext < maxmessext then
3 16839 begin
4 16840 messop(messext):= op;
4 16841 messcode(messext):=1;
4 16842 d.op(1):= semaphore;
4 16843 d.op.optype:= operationtype;
4 16844 mon(16) send message :(0, mess, 0, receiver);
4 16845 messref(messext):= monw2;
4 16846 end;
3 16847
3 16847
3 16847 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16848 begin <* return the operation immediately with result = 0 *>
4 16849 d.op(9):= 0;
4 16850 signalch(semaphore, op, operationtype);
4 16851 end;
3 16852 end;
2 16853 \f
2 16853
2 16853 message coroutinemonitor - 24 ;
2 16854
2 16854
2 16854 <***** semwaitmessage *****
2 16855
2 16855 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16856 be performed by the coroutine monitor when a message arrives to the process
2 16857 corresponding to 'processextension'. *>
2 16858
2 16858
2 16858 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16859 value processextension, semaphore, operation, operationtype;
2 16860 integer processextension, semaphore, operation;
2 16861 boolean operationtype;
2 16862 begin
3 16863 integer array field op;
3 16864 op:= operation;
3 16865 procop(processextension):= operation;
3 16866 d.op(1):= semaphore;
3 16867 d.op.optype:= operationtype;
3 16868 proccode(processextension):= 1;
3 16869
3 16869
3 16869 end;
2 16870 \f
2 16870
2 16870 message coroutinemonitor - 25 ;
2 16871
2 16871
2 16871 <***** semregretmessage *****
2 16872
2 16872 this procedure regrets a message sent by semsendmessage.
2 16873 the message is identified by the operation in which the answer should be
2 16874 returned.
2 16875 the procedure sets the result field of the operation to zero, and then
2 16876 returns it by performing a signalch. *>
2 16877
2 16877
2 16877 procedure semregretmessage (operation);
2 16878 value operation;
2 16879 integer operation;
2 16880 begin
3 16881 integer i, j;
3 16882 integer array field op, sem;
3 16883 op:= operation;
3 16884 i:= 1;
3 16885 while i < maxmessext do
3 16886 begin
4 16887 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16888 begin
5 16889 mon(82) regret message :(0, 0, messref(i), 0);
5 16890 messref(i):= 0;
5 16891 sem:= d.op(1);
5 16892 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16893 signalch(sem, op, d.op.optype);
5 16894 i:= maxmessext;
5 16895 end;
4 16896 i:= i + 1;
4 16897 end;
3 16898
3 16898
3 16898 end;
2 16899 \f
2 16899
2 16899 message coroutinemonitor - 26 ;
2 16900
2 16900
2 16900 <***** link *****
2 16901
2 16901 this procedure links an object (allocated in the descriptor array 'd') into
2 16902 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16903 are all double chained, and the chainhead is of the same format as the chain
2 16904 fields of the objects.
2 16905 the procedure links the object immediately after the head. *>
2 16906
2 16906
2 16906 procedure link (object, chainhead);
2 16907 value object, chainhead;
2 16908 integer object, chainhead;
2 16909 begin
3 16910 integer array field prevelement, nextelement, chead, obj;
3 16911 obj:= object;
3 16912 chead:= chainhead;
3 16913 prevelement:= d.obj.prev;
3 16914 nextelement:= d.obj.next;
3 16915 d.prevelement.next:= nextelement;
3 16916 d.nextelement.prev:= prevelement;
3 16917 if chead > 0 then <* link into queue *>
3 16918 begin
4 16919 prevelement:= d.chead.prev;
4 16920 d.obj.prev:= prevelement;
4 16921 d.prevelement.next:= obj;
4 16922 d.obj.next:= chead;
4 16923 d.chead.prev:= obj;
4 16924 end else
3 16925 begin <* link onto itself *>
4 16926 d.obj.prev:= obj;
4 16927 d.obj.next:= obj;
4 16928 end;
3 16929 end;
2 16930 \f
2 16930
2 16930 message coroutinemonitor - 27 ;
2 16931
2 16931
2 16931 <***** linkprio *****
2 16932
2 16932 this procedure is used to link coroutines into queues corresponding to
2 16933 the priorities of the actual coroutine and the queue elements.
2 16934 the object is linked immediately before the first coroutine of lower prio-
2 16935 rity. *>
2 16936
2 16936
2 16936 procedure linkprio (object, chainhead);
2 16937 value object, chainhead;
2 16938 integer object, chainhead;
2 16939 begin
3 16940 integer array field currelement, chead, obj;
3 16941 obj:= object;
3 16942 chead:= chainhead;
3 16943 currelement:= d.chead.next;
3 16944 while currelement <> chead
3 16945 and d.currelement.corupriority <= d.obj.corupriority
3 16946 do currelement:= d.currelement.next;
3 16947 link(obj, currelement);
3 16948 end;
2 16949 \f
2 16949
2 16949 message coroutinemonitor - 28 ;
2 16950
2 16950 \f
2 16950
2 16950 message coroutinemonitor - 30a ;
2 16951
2 16951
2 16951 <*************** extention to coroutine monitor procedures **********>
2 16952
2 16952 <***** signalbin *****
2 16953
2 16953 this procedure simulates a binary semaphore on a simple semaphore
2 16954 by testing the value of the semaphore before signaling the
2 16955 semaphore. if the value of the semaphore is one (=open) nothing is
2 16956 done, otherwise a normal signal is carried out. *>
2 16957
2 16957
2 16957 procedure signalbin(semaphore);
2 16958 value semaphore;
2 16959 integer semaphore;
2 16960 begin
3 16961 integer array field sem;
3 16962 integer val;
3 16963 sem:= semaphore;
3 16964 inspect(sem,val);
3 16965 if val<1 then signal(sem);
3 16966 end;
2 16967 \f
2 16967
2 16967 message coroutinemonitor - 30b ;
2 16968
2 16968 <***** coruno *****
2 16969
2 16969 delivers the coroutinenumber for a give coroutine id.
2 16970 if the coroutine does not exists the value 0 is delivered *>
2 16971
2 16971 integer procedure coru_no(coru_id);
2 16972 value coru_id;
2 16973 integer coru_id;
2 16974 begin
3 16975 integer array field cor;
3 16976
3 16976 coru_no:= 0;
3 16977 for cor:= firstcoru step corusize until (coruref-1) do
3 16978 if d.cor.coruident//1000 = coru_id then
3 16979 coru_no:= d.cor.coruident mod 1000;
3 16980 end;
2 16981 \f
2 16981
2 16981 message coroutinemonitor - 30c ;
2 16982
2 16982 <***** coroutine *****
2 16983
2 16983 delivers the referencebyte for the coroutinedescriptor for
2 16984 a coroutine identified by coroutinenumber *>
2 16985
2 16985 integer procedure coroutine(cor_no);
2 16986 value cor_no;
2 16987 integer cor_no;
2 16988 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16989 firstcoru + (cor_no-1)*corusize;
2 16990 \f
2 16990
2 16990 message coroutinemonitor - 30d ;
2 16991
2 16991 <***** curr_coruno *****
2 16992
2 16992 delivers number of calling coroutine
2 16993 curr_coruno:
2 16994 < 0 = -current_coroutine_number in disabled mode
2 16995 = 0 = procedure not called from coroutine
2 16996 > 0 = current_coroutine_number in enabled mode *>
2 16997
2 16997 integer procedure curr_coruno;
2 16998 begin
3 16999 integer i;
3 17000 integer array ia(1:12);
3 17001
3 17001 i:= system(12,0,ia);
3 17002 if i > 0 then
3 17003 begin
4 17004 i:= system(12,1,ia);
4 17005 curr_coruno:= ia(3);
4 17006 end else curr_coruno:= 0;
3 17007 end curr_coruno;
2 17008 \f
2 17008
2 17008 message coroutinemonitor - 30e ;
2 17009
2 17009 <***** curr_coruid *****
2 17010
2 17010 delivers coruident of calling coroutine :
2 17011
2 17011 curr_coruid:
2 17012 > 0 = coruident of calling coroutine
2 17013 = 0 = procedure not called from coroutine *>
2 17014
2 17014 integer procedure curr_coruid;
2 17015 begin
3 17016 integer cor_no;
3 17017 integer array field cor;
3 17018
3 17018 cor_no:= abs curr_coruno;
3 17019 if cor_no <> 0 then
3 17020 begin
4 17021 cor:= coroutine(cor_no);
4 17022 curr_coruid:= d.cor.coruident // 1000;
4 17023 end
3 17024 else curr_coruid:= 0;
3 17025 end curr_coruid;
2 17026 \f
2 17026 message coroutinemonitor - 30f.1 ;
2 17027
2 17027 <**** getch *****
2 17028
2 17028 this procedure searches the queue of operations waiting at 'semaphore'
2 17029 to find an operation that matches the operationstypeset and a set of
2 17030 select-values. each select value is specified by type and fieldvalue
2 17031 in integer array 'type' and by the value in integer array 'val'.
2 17032
2 17032 0: eq 0: not used
2 17033 1: lt 1: boolean
2 17034 2: le 2: integer
2 17035 3: gt 3: long
2 17036 4: ge 4: real
2 17037 5: ne
2 17038 *>
2 17039
2 17039 procedure getch(semaphore,operation,operationtypeset,type,val);
2 17040 value semaphore,operationtypeset;
2 17041 integer semaphore,operation;
2 17042 boolean operationtypeset;
2 17043 integer array type,val;
2 17044 begin
3 17045 integer array field firstop,currop;
3 17046 integer ø,n,i,f,t,rel,i1,i2;
3 17047 boolean field bf,bfval;
3 17048 integer field intf;
3 17049 long field lf,lfval; long l1,l2;
3 17050 real field rf,rfval; real r1,r2;
3 17051
3 17051 boolean match;
3 17052
3 17052 operation:= 0;
3 17053 n:= system(3,ø,type);
3 17054 match:= false;
3 17055 firstop:= semaphore + semop;
3 17056 currop:= d.firstop.next;
3 17057 while currop <> firstop and -,match do
3 17058 begin
4 17059 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 17060 begin
5 17061 i:= n;
5 17062 match:= true;
5 17063 \f
5 17063 message coroutinemonitor - 30f.2 ;
5 17064
5 17064 while match and (if i <= ø then type(i) >= 0 else false) do
5 17065 begin
6 17066 rel:= type(i) shift(-18);
6 17067 t:= type(i) shift(-12) extract 6;
6 17068 f:= type(i) extract 12;
6 17069 if f > 2047 then f:= f -4096;
6 17070 case t+1 of
6 17071 begin
7 17072 ; <* not used *>
7 17073
7 17073 begin <*boolean or signed short integer*>
8 17074 bf:= f;
8 17075 bfval:= 2*i;
8 17076 i1:= d.currop.bf extract 12;
8 17077 if i1 > 2047 then i1:= i1-4096;
8 17078 i2:= val.bfval extract 12;
8 17079 if i2 > 2047 then i2:= i2-4096;
8 17080 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17081 end;
7 17082
7 17082 begin <*integer*>
8 17083 intf:= f;
8 17084 i1:= d.currop.intf;
8 17085 i2:= val(i);
8 17086 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17087 end;
7 17088
7 17088 begin <*long*>
8 17089 lf:= f;
8 17090 lfval:= i*2;
8 17091 l1:= d.currop.lf;
8 17092 l2:= val.lfval;
8 17093 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 17094 end;
7 17095
7 17095 begin <*real*>
8 17096 rf:= f;
8 17097 rfval:= i*2;
8 17098 r1:= d.currop.rf;
8 17099 r2:= val.rfval;
8 17100 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 17101 end;
7 17102
7 17102 end;<*case t+1*>
6 17103
6 17103 i:= i+1;
6 17104 end; <*while match and i<=ø and t>=0 *>
5 17105 \f
5 17105 message coroutinemonitor - 30f.3 ;
5 17106
5 17106 end; <* if operationtypeset and ---*>
4 17107 if -,match then currop:= d.currop.next;
4 17108 end; <*while currop <> firstop and -,match*>
3 17109
3 17109 if match then
3 17110 begin
4 17111 link(currop,0);
4 17112 d.current.coruop:= currop;
4 17113 operation:= currop;
4 17114 end;
3 17115 end getch;
2 17116 \f
2 17116
2 17116 message coroutinemonitor - 31 ;
2 17117
2 17117 activity(maxcoru);
2 17118
2 17118 goto initialization;
2 17119
2 17119
2 17119
2 17119 <*************** event handling ***************>
2 17120
2 17120
2 17120
2 17120 takeexternal:
2 17121 currevent:= baseevent;
2 17122 eventqueueempty:= false;
2 17123 repeat
2 17124 current:= 0;
2 17125 prevevent:= currevent;
2 17126 mon(66) test event :(0, 0, currevent, 0);
2 17127 currevent:= monw2;
2 17128 if monw0 < 0 <* no event *> then goto takeinternal;
2 17129 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 17130 cmi:= monw1
2 17131 else
2 17132 cmi:= - monw0;
2 17133
2 17133 if cmi > 0 then
2 17134 begin <* answer to activity zone *>
3 17135 current:= firstcoru + (cmi - 1) * corusize;
3 17136 linkprio(current, readyqueue);
3 17137 baseevent:= 0;
3 17138 end else
2 17139
2 17139 if cmi = 0 then
2 17140 begin <* message arrived *>
3 17141 \f
3 17141
3 17141 message coroutinemonitor - 32 ;
3 17142
3 17142 receiver:= core.currevent(3);
3 17143 if receiver < 0 then receiver:= - receiver;
3 17144 procref(maxprocext):= receiver;
3 17145 procext:= 1;
3 17146 while procref(procext) <> receiver do procext:= procext + 1;
3 17147 if procext = maxprocext then
3 17148 begin <* receiver unknown *>
4 17149 <* leave the message unchanged *>
4 17150 end else
3 17151 if proccode(procext) shift (-12) = 0 then
3 17152 begin <* the receiver is ready for accepting messages *>
4 17153 mon(26) get event :(0, 0, currevent, 0);
4 17154 case proccode(procext) of
4 17155 begin
5 17156 begin <* message received by semwaitmessage *>
6 17157 op:= procop(procext);
6 17158 sem:= d.op(1);
6 17159 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 17160 d.op(9):= currevent;
6 17161 signalch(sem, op, d.op.optype);
6 17162 proccode(procext):= 1 shift 12;
6 17163 end;
5 17164 begin <* message received by cwaitmessage *>
6 17165 current:= procop(procext);
6 17166 procop(procext):= currevent;
6 17167 linkprio(current, readyqueue);
6 17168 link(current + corutimerchain, idlequeue);
6 17169
6 17169
6 17169 end;
5 17170 end; <* case *>
4 17171 currevent:= baseevent;
4 17172 proccode(procext):= 1 shift 12;
4 17173 end;
3 17174 end <* message *> else
2 17175
2 17175 if cmi = -1 then
2 17176 begin <* answer arrived *>
3 17177 \f
3 17177
3 17177 message coroutinemonitor - 33 ;
3 17178
3 17178 if currevent = timermessage then
3 17179 begin
4 17180 mon(26) get event :(0, 0, currevent, 0);
4 17181 coru:= d.timerqueue.next;
4 17182 while coru <> timerqueue do
4 17183 begin
5 17184 current:= coru - corutimerchain;
5 17185 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 17186 coru:= d.coru.next;
5 17187 if d.current.corutimer <= 0 then
5 17188 begin <* timer perion expired *>
6 17189 d.current.corutimer:= -1;
6 17190 linkprio(current, readyqueue);
6 17191 link(current + corutimerchain, idlequeue);
6 17192 end;
5 17193 end;
4 17194 mon(16) send message :(0, clockmess, 0, clock);
4 17195 timermessage:= monw2;
4 17196 currevent:= baseevent;
4 17197 end <* timer answer *> else
3 17198 begin
4 17199 messref(maxmessext):= currevent;
4 17200 messext:= 1;
4 17201 while messref(messext) <> currevent do messext:= messext + 1;
4 17202 if messext = maxmessext then
4 17203 begin <* the answer is unknown *>
5 17204 <* leave the answer unchanged - it may belong to an activity *>
5 17205 end else
4 17206 if messcode(messext) shift (-12) = 0 then
4 17207 begin
5 17208 case messcode(messext) extract 12 of
5 17209 begin
6 17210 \f
6 17210
6 17210 message coroutinemonitor - 34 ;
6 17211 begin <* answer arrived after semsendmessage *>
7 17212 op:= messop(messext);
7 17213 sem:= d.op(1);
7 17214 mon(18) wait answer :(0, d.op, currevent, 0);
7 17215 d.op(9):= monw0;
7 17216 signalch(sem, op, d.op.optype);
7 17217 messref(messext):= 0;
7 17218 baseevent:= 0;
7 17219 end;
6 17220 begin <* answer arrived after csendmessage *>
7 17221 current:= messop(messext);
7 17222 linkprio(current, readyqueue);
7 17223 link(current + corutimerchain, idlequeue);
7 17224
7 17224
7 17224 end;
6 17225 end;
5 17226 end else baseevent:= currevent;
4 17227 end;
3 17228 end;
2 17229 until eventqueueempty;
2 17230 \f
2 17230
2 17230 message coroutinemonitor - 35 ;
2 17231
2 17231
2 17231
2 17231 <*************** coroutine activation ***************>
2 17232
2 17232 takeinternal:
2 17233
2 17233 current:= d.readyqueue.next;
2 17234 if current = readyqueue then
2 17235 begin
3 17236 mon(24) wait event :(0, 0, prevevent, 0);
3 17237 goto takeexternal;
3 17238 end;
2 17239
2 17239 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17240 <**> begin
3 17241 <**> systime(5,0,r);
3 17242 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17243 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17244 <**> d.current.coruident//1000,<: aktiveres:>);
3 17245 <**> end;
2 17246 <*-2*>
2 17247
2 17247 corustate:= activate(d.current.coruident mod 1000);
2 17248 cmi:= corustate extract 24;
2 17249 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17250 <**> begin
3 17251 <**> systime(5,0,r);
3 17252 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17253 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17254 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 17255 <**> end;
2 17256 <*-2*>
2 17257
2 17257 if cmi = 1 then
2 17258 begin <* programmed passivate *>
3 17259 goto takeexternal;
3 17260 end;
2 17261
2 17261 if cmi = 2 then
2 17262 begin <* implicit passivate in activity *>
3 17263
3 17263
3 17263 link(current, idlequeue);
3 17264 goto takeexternal;
3 17265 end;
2 17266 \f
2 17266
2 17266 message coroutinemonitor - 36 ;
2 17267
2 17267 <* coroutine termination (normal or abnormal) *>
2 17268
2 17268 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 17269 coru_term:
2 17270
2 17270 begin
3 17271 if false and alarmcause extract 24 = (-9) <* break *> and
3 17272 alarmcause shift (-24) extract 24 = 0 then
3 17273 begin
4 17274 endaction:= 2;
4 17275 goto program_slut;
4 17276 end;
3 17277 if alarmcause extract 24 = (-9) <* break *> and
3 17278 alarmcause shift (-24) = 8 <* parent *>
3 17279 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 17280 if alarmcause shift (-24) extract 24 <> -2 or
3 17281 alarmcause extract 24 <> -13 then
3 17282 begin
4 17283 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 17284 alarmcause shift (-24),<:,:>,
4 17285 alarmcause extract 24);
4 17286 for i:=1 step 1 until max_coru do
4 17287 j:=activate(-i); <* kill *>
4 17288 <* skriv billede *>
4 17289 end
3 17290 else
3 17291 begin
4 17292 errorbits:= 0; <* ok.yes warning.no *>
4 17293 goto finale;
4 17294 end;
3 17295 end;
2 17296
2 17296 goto dump;
2 17297
2 17297 link(current, idlequeue);
2 17298 goto takeexternal;
2 17299 \f
2 17299
2 17299 message coroutinemonitor - 37 ;
2 17300
2 17300
2 17300
2 17300 initialization:
2 17301
2 17301
2 17301 <*************** initialization ***************>
2 17302
2 17302 <* chain head *>
2 17303
2 17303 prev:= -2; <* -2 prev *>
2 17304 next:= 0; <* +0 next *>
2 17305
2 17305 <* corutine descriptor *>
2 17306
2 17306 <* -2 prev *>
2 17307 <* +0 next *>
2 17308 <* +2 (link field) *>
2 17309 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 17310 <* +6 (link field) *>
2 17311 coruop:= corutimerchain + 4; <* +8 coruop *>
2 17312 corutimer:= coruop + 2; <*+10 corutimer *>
2 17313 coruident:= corutimer + 2; <*+12 coruident *>
2 17314 corupriority:= coruident + 2; <*+14 corupriority *>
2 17315 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 17316 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 17317
2 17317 <* simple semaphore *>
2 17318
2 17318 <* -2 (link field) *>
2 17319 simcoru:= next; <* +0 simcoru *>
2 17320 simvalue:= simcoru + 2; <* +2 simvalue *>
2 17321
2 17321 <* chained semaphore *>
2 17322
2 17322 <* -2 (link field) *>
2 17323 semcoru:= next; <* +0 semcoru *>
2 17324 <* +2 (link field) *>
2 17325 semop:= semcoru + 4; <* +4 semop *>
2 17326 \f
2 17326
2 17326 message coroutinemonitor - 38 ;
2 17327
2 17327 <* operation *>
2 17328
2 17328 opsize:= next - 6; <* -6 opsize *>
2 17329 optype:= opsize + 1; <* -5 optype *>
2 17330 <* -2 prev *>
2 17331 <* +0 next *>
2 17332 <* +2 operation(1) *>
2 17333 <* +4 operation(2) *>
2 17334 <* +6 - *>
2 17335 <* . - *>
2 17336 <* . - *>
2 17337
2 17337 \f
2 17337
2 17337 message coroutinemonitor - 39 ;
2 17338
2 17338 trap(dump);
2 17339 systime(1, 0, starttime);
2 17340 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 17341 clockmess(1):= 0;
2 17342 clockmess(2):= timeinterval;
2 17343 clock(1):= real <:clock:>;
2 17344 clock(2):= real <::>;
2 17345 mon(16) send message :(0, clockmess, 0, clock);
2 17346 timermessage:= monw2;
2 17347 readyqueue:= 4;
2 17348 initchain(readyqueue);
2 17349 idlequeue:= readyqueue + 4;
2 17350 initchain(idlequeue);
2 17351 timerqueue:= idlequeue + 4;
2 17352 initchain(timerqueue);
2 17353 current:= 0;
2 17354 corucount:= 0;
2 17355 proccount:= 0;
2 17356 baseevent:= 0;
2 17357 coruref:= timerqueue + 4;
2 17358 firstcoru:= coruref;
2 17359 simref:= coruref + maxcoru * corusize;
2 17360 firstsim:= simref;
2 17361 semref:= simref + maxsem * simsize;
2 17362 firstsem:= semref;
2 17363 opref:= semref + maxsemch * semsize + 4;
2 17364 firstop:= opref;
2 17365 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 17366 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 17367 reflectcore(core);
2 17368
2 17368 algol list.on;
2 17369
2 17369 \f
2 17369 message sys_initialisering side 1 - 810601/hko;
2 17370
2 17370 trapmode:= 1 shift 15;
2 17371 errorbits:= 1; <* warning.no ok.no *>
2 17372 trap(coru_term);
2 17373
2 17373 open(zbillede,4,<:billede:>,0);
2 17374 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17375 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17376 system(2,0,ia);
2 17377 open(zdummy,4,ia,0); close(zdummy,false);
2 17378 monitor(42,zdummy,0,ia);
2 17379 laf:= 0;
2 17380 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17381 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17382 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17383
2 17383 open(zrl,4,<:radiolog:>,0);
2 17384 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17385 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17386 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17387 begin
3 17388 ia(1):=1; ia(2):= 3;
3 17389 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17390 monitor(40)create_area:(zrl,0,ia);
3 17391 end;
2 17392
2 17392 for i:=1 step 1 until max_antal_fejltekster do
2 17393 fejltekst(i):= real (case i of (
2 17394 <* 1*><:filsystem:>,
2 17395 <* 2*><:operationskode:>,
2 17396 <* 3*><:programfejl:>,
2 17397 <* 4*><:monitor<'_'>resultat=:>,
2 17398 <* 5*><:læs<'_'>fil:>,
2 17399 <* 6*><:skriv<'_'>fil:>,
2 17400 <* 7*><:modif<'_'>fil:>,
2 17401 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17402 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17403 <*10*><:vogntabel:>,
2 17404 <*11*><:fremmed operation:>,
2 17405 <*12*><:operationstype:>,
2 17406 <*13*><:opret<'_'>fil:>,
2 17407 <*14*><:tilknyt<'_'>fil:>,
2 17408 <*15*><:frigiv<'_'>fil:>,
2 17409 <*16*><:slet<'_'>fil:>,
2 17410 <*17*><:ydre enhed, status=:>,
2 17411 <*18*><:tabelfil:>,
2 17412 <*19*><:radio:>,
2 17413 <*20*><:mobilopkald, bus:>,
2 17414 <*21*><:talevejsswitch:>,
2 17415 <*99*><:ftslut:>));
2 17416
2 17416 for i:= 1 step 1 until max_antal_områder do
2 17417 begin
3 17418 område_navn(i):= long (case i of
3 17419 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17420 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17421 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17422 område_id(i,2):=
3 17423 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17424 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17425 end;
2 17426
2 17426 pabx_id(1):= -1;
2 17427 pabx_id(2):= 1;
2 17428
2 17428 for i:= 1 step 1 until max_antal_radiokanaler do
2 17429 begin
3 17430 radio_id(i):=
3 17431 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17432 end;
2 17433
2 17433 for i:=1 step 1 until max_antal_kanaler do
2 17434 begin
3 17435 kanal_navn(i):= long (case i of (
3 17436 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17437 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17438 kanal_id(i):=
3 17439 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17440 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17441 end;
2 17442
2 17442 for i:= 1 step 1 until op_maske_lgd//2 do
2 17443 ingen_operatører(i):= alle_operatører(i):= 0;
2 17444 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17445 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17446
2 17446 begin
3 17447 long array navn(1:2);
3 17448 long array field doc, ref;
3 17449
3 17449 doc:= 2; iaf:= 0;
3 17450 movestring(navn,1,<:terminal0:>);
3 17451 for i:= 1 step 1 until max_antal_operatører do
3 17452 begin
4 17453 ref:=(i-1)*8; k:=9;
4 17454 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17455 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17456 open(zdummy,8,navn,0); close(zdummy,true);
4 17457 k:= monitor(42,zdummy,0,ia);
4 17458 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17459 else tofrom(terminal_navn.ref,navn,8);
4 17460 operatør_auto_include(i):= false;
4 17461 sætbit_ia(alle_operatører,i,1);
4 17462 end;
3 17463
3 17463 movestring(navn,1,<:garage0:>);
3 17464 for i:= 1 step 1 until max_antal_garageterminaler do
3 17465 begin
4 17466 ref:=(i-1)*8; k:=7;
4 17467 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17468 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17469 open(zdummy,8,navn,0); close(zdummy,true);
4 17470 k:= monitor(42,zdummy,0,ia);
4 17471 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17472 else tofrom(garage_terminal_navn.ref,navn,8);
4 17473 garage_auto_include(i):= false;
4 17474 end;
3 17475 end;
2 17476
2 17476 for i:= 1 step 1 until max_antal_taleveje do
2 17477 sætbit_ia(alle_taleveje,i,1);
2 17478 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17479 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17480 operatør_auto_include(ia(i)):= true;
2 17481 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17482 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17483 garage_auto_include(ia(i)):= true;
2 17484
2 17484
2 17484 \f
2 17484 message fil_init side 1 - 801030/jg;
2 17485
2 17485 begin integer i,antz,tz,s;
3 17486 real array field raf;
3 17487
3 17487 filskrevet:=fillæst:=0; <*fil*>
3 17488 dbsegmax:= 2**18-1;
3 17489
3 17489 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17490 for i:=1 step 1 until dbantez do
3 17491 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17492 for i:=dbantez+1 step 1 until tz do
3 17493 open(fil(i),4,dbsnavn,0);
3 17494 for i:=tz+1 step 1 until antz do
3 17495 open(fil(i),4,dbtnavn,0);
3 17496
3 17496 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17497 dbkatz(i,1):=dbkatz(i,2):=0;
3 17498 for i:=dbantez+1 step 1 until tz do
3 17499 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17500 for i:=tz+1 step 1 until antz do
3 17501 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17502 dbkatz(antz,2):=tz+1;
3 17503 dbsidstetz:=antz;
3 17504 dbsidstesz:=tz;
3 17505
3 17505 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17506 begin integer j;
4 17507 for j:=1,3 step 1 until 6 do
4 17508 dbkate(i,j):=0;
4 17509 dbkate(i,2):=i+1;
4 17510 end;
3 17511 dbkate(dbmaxef,2):=0;
3 17512 dbkatefri:=1;
3 17513 dbantef:=0;
3 17514 \f
3 17514 message fil_init side 2 - 801030/jg;
3 17515
3 17515
3 17515 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17516 begin
4 17517 dbkats(i,1):=0;
4 17518 dbkats(i,2):=i+1;
4 17519 end;
3 17520 dbkats(dbmaxsf,2):=0;
3 17521 dbkatsfri:=1;
3 17522 dbantsf:=0;
3 17523
3 17523 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17524 dbkatb(i):=false add (i+1);
3 17525 dbkatb(dbmaxb):=false;
3 17526 dbkatbfri:=1;
3 17527 dbantb:=0;
3 17528 raf:=4;
3 17529 for i:=1 step 1 until dbmaxtf do
3 17530 begin
4 17531 inrec6(fil(antz),4);
4 17532 dbkatt.raf(i):=fil(antz,1);
4 17533 end;
3 17534 inrec6(fil(antz),4);
3 17535 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17536 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17537 setposition(fil(antz),0,0);
3 17538
3 17538 end filsystem;
2 17539 \f
2 17539 message fil_init side 3 - 810209/cl;
2 17540
2 17540 bs_kats_fri:= nextsem;
2 17541 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17542 <*-3*>
2 17543 bs_kate_fri:= nextsem;
2 17544 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17545 <*-3*>
2 17546 cs_opret_fil:= nextsemch;
2 17547 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17548 <*-3*>
2 17549 cs_tilknyt_fil:= nextsemch;
2 17550 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17551 <*-3*>
2 17552 cs_frigiv_fil:= nextsemch;
2 17553 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17554 <*-3*>
2 17555 cs_slet_fil:= nextsemch;
2 17556 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17557 <*-3*>
2 17558 cs_opret_spoolfil:= nextsemch;
2 17559 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17560 <*-3*>
2 17561 cs_opret_eksternfil:= nextsemch;
2 17562 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17563 <*-3*>
2 17564 \f
2 17564 message fil_init side 4 810209/cl;
2 17565
2 17565
2 17565 <* initialisering af filsystemcoroutiner *>
2 17566
2 17566 i:= nextcoru(001,10,true);
2 17567 j:= newactivity(i,0,opretfil);
2 17568 <*+3*> skriv_newactivity(out,i,j);
2 17569 <*-3*>
2 17570
2 17570 i:= nextcoru(002,10,true);
2 17571 j:= newactivity(i,0,tilknytfil);
2 17572 <*+3*> skriv_newactivity(out,i,j);
2 17573 <*-3*>
2 17574
2 17574 i:= nextcoru(003,10,true);
2 17575 j:= newactivity(i,0,frigivfil);
2 17576 <*+3*> skriv_newactivity(out,i,j);
2 17577 <*-3*>
2 17578
2 17578 i:= nextcoru(004,10,true);
2 17579 j:= newactivity(i,0,sletfil);
2 17580 <*+3*> skriv_newactivity(out,i,j);
2 17581 <*-3*>
2 17582
2 17582 i:= nextcoru(005,10,true);
2 17583 j:= newactivity(i,0,opretspoolfil);
2 17584 <*+3*> skriv_newactivity(out,i,j);
2 17585 <*-3*>
2 17586
2 17586 i:= nextcoru(006,10,true);
2 17587 j:= newactivity(i,0,opreteksternfil);
2 17588 <*+3*> skriv_newactivity(out,i,j);
2 17589 <*-3*>
2 17590 \f
2 17590 message attention_initialisering side 1 - 850820/cl;
2 17591
2 17591 tf_kommandotabel:= 1 shift 10 + 1;
2 17592
2 17592 begin
3 17593 integer i, s, zno;
3 17594 zone z(128,1,stderror);
3 17595 integer array fdim(1:8);
3 17596
3 17596 fdim(4):= tf_kommandotabel;
3 17597 hentfildim(fdim);
3 17598
3 17598 open(z,4,<:htkommando:>,0);
3 17599 for i:= 1 step 1 until fdim(3) do
3 17600 begin
4 17601 inrec6(z,512);
4 17602 s:= skrivfil(tf_kommandotabel,i,zno);
4 17603 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17604 tofrom(fil(zno),z,512);
4 17605 end;
3 17606 close(z,true);
3 17607 end;
2 17608 \f
2 17608 message attention_initialisering side 1a - 810428/hko;
2 17609
2 17609 for j:= system(3,i,terminal_tab) step 1 until i do
2 17610 terminal_tab(j):= 0;
2 17611
2 17611 cs_att_pulje:=next_semch;
2 17612 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17613 <*-3*>
2 17614
2 17614 bs_fortsæt_adgang:= nextsem;
2 17615 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17616 <*-3*>
2 17617 signalbin(bs_fortsæt_adgang);
2 17618
2 17618 for i:= 1,
2 17619 1 step 1 until max_antal_operatører,
2 17620 1 step 1 until max_antal_garageterminaler do
2 17621
2 17621 <* initialisering af pulje med attention_operationer *>
2 17622
2 17622 signalch(cs_att_pulje, <* pulje_semafor *>
2 17623 nextop(data+att_op_længde), <* næste_operation *>
2 17624 gen_optype);
2 17625
2 17625 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17626
2 17626 i:=next_coru(010,<*ident*>
2 17627 2,<*prioritet*>
2 17628 true<*test_maske*>);
2 17629 j:=newactivity( i, <*activityno *>
2 17630 0, <*ikke virtual *>
2 17631 attention);<*ingen parametre*>
2 17632
2 17632 <*+3*>skriv_newactivity(out,i,j);
2 17633 <*-3*>
2 17634
2 17634 \f
2 17634 message io_initialisering side 1 - 810507/hko;
2 17635
2 17635 io_spoolfil:= 1028;
2 17636 begin
3 17637 integer array fdim(1:8);
3 17638 fdim(4):= io_spoolfil;
3 17639 hent_fildim(fdim);
3 17640 io_spool_postantal:= fdim(1);
3 17641 io_spool_postlængde:= fdim(2);
3 17642 end;
2 17643
2 17643 io_spool_post:= 4;
2 17644
2 17644 cs_io:= next_semch;
2 17645 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17646 <*-3*>
2 17647
2 17647 i:= next_coru(100,<*ident *>
2 17648 5,<*prioritet *>
2 17649 true<*test_maske*>);
2 17650
2 17650 j:= new_activity( i,
2 17651 0,
2 17652 h_io);
2 17653
2 17653 <*+3*>skriv_newactivity(out,i,j);
2 17654 <*-3*>
2 17655 cs_io_komm:= next_semch;
2 17656 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17657 <*-3*>
2 17658
2 17658 i:= next_coru(101,<*ident*>
2 17659 10,<*prioritet*>
2 17660 true <*testmaske*>);
2 17661 j:= new_activity( i,
2 17662 0,
2 17663 io_komm);<*ingen parametre*>
2 17664
2 17664 <*+3*>skriv_newactivity(out,i,j);
2 17665 <*-3*>
2 17666 \f
2 17666 message io_initialisering side 2 - 810520/hko/cl;
2 17667
2 17667 bs_zio_adgang:= next_sem;
2 17668 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17669 <*-3*>
2 17670 signal_bin(bs_zio_adgang);
2 17671
2 17671 cs_io_spool:= next_semch;
2 17672 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17673 <*-3*>
2 17674
2 17674 cs_io_fil:=next_semch;
2 17675 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17676 <*-3*>
2 17677 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17678
2 17678 ss_io_spool_fulde:= next_sem;
2 17679 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17680 <*-3*>
2 17681
2 17681 ss_io_spool_tomme:= next_sem;
2 17682 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17683 <*-3*>
2 17684 for i:= 1 step 1 until io_spool_postantal do
2 17685 signal(ss_io_spool_tomme);
2 17686 \f
2 17686 message io_initialisering side 3 - 880901/cl;
2 17687
2 17687 i:= next_coru(102,
2 17688 5,
2 17689 true);
2 17690 j:= new_activity(i,0,io_spool);
2 17691
2 17691 <*+3*>skriv_newactivity(out,i,j);
2 17692 <*-3*>
2 17693
2 17693 i:= next_coru(103,
2 17694 10,
2 17695 true);
2 17696 j:= new_activity(i,0,io_spon);
2 17697
2 17697 <*+3*>skriv_newactivity(out,i,j);
2 17698 <*-3*>
2 17699
2 17699 cs_io_medd:= next_semch;
2 17700 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17701 <*-3*>
2 17702
2 17702 i:= next_coru(104,<*ident *>
2 17703 10,<*prioritet *>
2 17704 true<*test_maske*>);
2 17705
2 17705 j:= new_activity( i,
2 17706 0,
2 17707 io_medd);
2 17708
2 17708 <*+3*>skriv_newactivity(out,i,j);
2 17709 <*-3*>
2 17710
2 17710 cs_io_nulstil:= next_semch;
2 17711 <*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
2 17712 <*-3*>
2 17713
2 17713 i:= next_coru(105,<*ident *>
2 17714 10,<*prioritet *>
2 17715 true<*test_maske*>);
2 17716
2 17716 j:= new_activity( i,
2 17717 0,
2 17718 io_nulstil_tællere);
2 17719
2 17719 <*+3*>skriv_newactivity(out,i,j);
2 17720 <*-3*>
2 17721
2 17721 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17722 i:= monitor(8)reserve process:(z_io,0,ia);
2 17723 if i <> 0 then
2 17724 begin
3 17725 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17726 end
2 17727 else
2 17728 begin
3 17729 ref:= 0;
3 17730 terminal_tab.ref.terminal_tilstand:= 0;
3 17731 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17732 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17733 "sp",1,"*",15,"nl",1);
3 17734 setposition(z_io,0,0);
3 17735 end;
2 17736 \f
2 17736 message operatør_initialisering side 1 - 810520/hko;
2 17737
2 17737 top_bpl_gruppe:= 64;
2 17738
2 17738 bpl_navn(0):= long<::>;
2 17739 for i:= 1 step 1 until 127 do
2 17740 begin
3 17741 k:= læsfil(tf_bpl_navne,i,j);
3 17742 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17743 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17744 if i<=max_antal_operatører then
3 17745 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17746 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17747 top_bpl_gruppe:= i;
3 17748 end;
2 17749
2 17749 for i:= 0 step 1 until 64 do
2 17750 begin
3 17751 iaf:= i*op_maske_lgd;
3 17752 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17753 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17754 if 1<=i and i<= max_antal_operatører then
3 17755 begin
4 17756 bpl_tilst(i,2):= 1;
4 17757 sætbit_ia(bpl_def.iaf,i,1);
4 17758 end;
3 17759 end;
2 17760 for i:= 65 step 1 until 127 do
2 17761 begin
3 17762 k:= læsfil(tf_bpl_def,i-64,j);
3 17763 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17764 iaf:= i*op_maske_lgd;
3 17765 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17766 bpl_tilst(i,1):= 0;
3 17767 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17768 end;
2 17769
2 17769 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17770 iaf:= 0;
2 17771 for i:= 1 step 1 until max_antal_operatører do
2 17772 begin
3 17773 k:= læsfil(tf_stoptabel,i,j);
3 17774 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17775 operatør_stop(i,0):= i;
3 17776 for k:= 1,2,3 do
3 17777 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17778 ant_i_opkø(i):= 0;
3 17779 end;
2 17780
2 17780 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17781 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17782 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17783 sidste_tv_brugt:= max_antal_taleveje;
2 17784
2 17784 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17785 opk_alarm(i):= 0;
2 17786 for i:= 1 step 1 until max_antal_operatører do
2 17787 begin
3 17788 integer array field tab;
3 17789
3 17789 k:= læsfil(tf_alarmlgd,i,j);
3 17790 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17791 tab:= (i-1)*opk_alarm_tab_lgd;
3 17792 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17793 opk_alarm.tab.alarm_start:= 0.0;
3 17794 end;
2 17795
2 17795 op_spool_kilde:= 2;
2 17796 op_spool_tid := 6;
2 17797 op_spool_text := 6;
2 17798 begin
3 17799 long array field laf1, laf2;
3 17800 laf2:= 4; laf1:= 0;
3 17801 op_spool_buf.laf1(1):= long<::>;
3 17802 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17803 op_spool_postantal*op_spool_postlgd-4);
3 17804 end;
2 17805
2 17805 k:=læsfil(1033,1,j);
2 17806 systime(1,0.0,r);
2 17807 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17808 for i:= 1 step 1 until max_cqf do
2 17809 begin
3 17810 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17811 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17812 cqf_tabel.ref.cqf_næste_tid:=
3 17813 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17814 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17815 end;
2 17816 op_cqf_tab_ændret:= true;
2 17817
2 17817 laf:= raf:= 0;
2 17818 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17819 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17820 j:= 1;
2 17821 if i<>0 then
2 17822 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17823 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17824 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17825 j:= 1;
2 17826 if i<>0 then
2 17827 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17828
2 17828 ia(1):= 3; <*canonical*>
2 17829 ia(2):= 0; <*no echo*>
2 17830 ia(3):= 0; <*prompt*>
2 17831 ia(4):= 2; <*timeout*>
2 17832 setcspterm(taleswitch_in_navn.laf,ia);
2 17833 setcspterm(taleswitch_out_navn.laf,ia);
2 17834
2 17834 cs_op:= next_semch;
2 17835
2 17835 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17836 <*-3*>
2 17837
2 17837 cs_op_retur:= next_semch;
2 17838
2 17838 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17839 <*-3*>
2 17840
2 17840 i:= nextcoru(200,<*ident*>
2 17841 10,<*prioitet*>
2 17842 true<*test_maske*>);
2 17843
2 17843 j:= new_activity( i,
2 17844 0,
2 17845 h_operatør);
2 17846
2 17846 <*+3*>skriv_newactivity(out,i,j);
2 17847 <*-3*>
2 17848 \f
2 17848 message operatør_initialisering side 2 - 810520/hko;
2 17849
2 17849 for k:= 1 step 1 until max_antal_operatører do
2 17850 begin
3 17851 ref:= (k-1)*8;
3 17852 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17853 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17854 ref:=k*terminal_beskr_længde;
3 17855 if i = 0 then
3 17856 begin
4 17857 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17858 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17859 end
3 17860 else
3 17861 begin
4 17862 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17863 end;
3 17864
3 17864 cs_operatør(k):= next_semch;
3 17865 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17866 <*-3*>
3 17867
3 17867 cs_op_fil(k):= nextsemch;
3 17868 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17869 <*-3*>
3 17870 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17871
3 17871 i:= next_coru(200+k,<*ident*>
3 17872 10,<*prioitet*>
3 17873 true<*testmaske*>);
3 17874 j:= new_activity( i,
3 17875 0,
3 17876 operatør,k);
3 17877
3 17877 <*+3*>skriv_newactivity(out,i,j);
3 17878 <*-3*>
3 17879 end;
2 17880
2 17880 cs_cqf:= next_semch;
2 17881 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17882 <*-3*>
2 17883
2 17883 signalch(cs_cqf,nextop(60),true);
2 17884
2 17884 i:= next_coru(292, <*ident*>
2 17885 10, <*prioritet*>
2 17886 true <*testmaske*>);
2 17887 j:= new_activity( i,
2 17888 0,
2 17889 op_cqftest);
2 17890 <*+3*>skriv_new_activity(out,i,j);
2 17891 <*-3*>
2 17892
2 17892 cs_op_spool:= next_semch;
2 17893 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17894 <*-3*>
2 17895
2 17895 cs_op_medd:= next_semch;
2 17896 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17897 <*-3*>
2 17898
2 17898 ss_op_spool_tomme:= next_sem;
2 17899 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17900 <*-3*>
2 17901 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17902
2 17902 ss_op_spool_fulde:= next_sem;
2 17903 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17904 <*-3*>
2 17905
2 17905 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17906
2 17906 i:= next_coru(293, <*ident*>
2 17907 10, <*prioritet*>
2 17908 true <*testmaske*>);
2 17909 j:= new_activity( i,
2 17910 0,
2 17911 op_spool);
2 17912 <*+3*>skriv_new_activity(out,i,j);
2 17913 <*-3*>
2 17914
2 17914 i:= next_coru(294, <*ident*>
2 17915 10, <*prioritet*>
2 17916 true <*testmaske*>);
2 17917 j:= new_activity( i,
2 17918 0,
2 17919 op_medd);
2 17920 <*+3*>skriv_new_activity(out,i,j);
2 17921 <*-3*>
2 17922
2 17922 cs_op_iomedd:= next_semch;
2 17923 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17924 <*-3*>
2 17925
2 17925 bs_opk_alarm:= next_sem;
2 17926 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17927 <*-3*>
2 17928
2 17928 cs_opk_alarm:= next_semch;
2 17929 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17930 <*-3*>
2 17931
2 17931 cs_opk_alarm_ur:= next_semch;
2 17932 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17933 <*-3*>
2 17934
2 17934 cs_opk_alarm_ur_ret:= next_semch;
2 17935 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17936 <*-3*>
2 17937
2 17937 cs_tvswitch_adgang:= next_semch;
2 17938 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17939 <*-3*>
2 17940
2 17940 cs_tv_switch_input:= next_semch;
2 17941 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17942 <*-3*>
2 17943
2 17943 cs_tv_switch_adm:= next_semch;
2 17944 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17945 <*-3*>
2 17946
2 17946 cs_talevejsswitch:= next_semch;
2 17947 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17948 <*-3*>
2 17949
2 17949 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17950
2 17950 iaf:= nextop(data+128);
2 17951 if testbit22 then
2 17952 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17953 else
2 17954 begin
3 17955 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17956 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17957 end;
2 17958
2 17958 i:= next_coru(295, <*ident*>
2 17959 8, <*prioritet*>
2 17960 true <*testmaske*>);
2 17961 j:= new_activity( i,
2 17962 0,
2 17963 alarmur);
2 17964 <*+3*>skriv_new_activity(out,i,j);
2 17965 <*-3*>
2 17966
2 17966 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17967
2 17967 i:= next_coru(296, <*ident*>
2 17968 8, <*prioritet*>
2 17969 true <*testmaske*>);
2 17970 j:= new_activity( i,
2 17971 0,
2 17972 opkaldsalarmer);
2 17973 <*+3*>skriv_new_activity(out,i,j);
2 17974 <*-3*>
2 17975
2 17975 i:= next_coru(297, <*ident*>
2 17976 3, <*prioritet*>
2 17977 true <*testmaske*>);
2 17978 j:= new_activity( i,
2 17979 0,
2 17980 tv_switch_input);
2 17981 <*+3*>skriv_new_activity(out,i,j);
2 17982 <*-3*>
2 17983
2 17983 for i:= 1,2 do
2 17984 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17985
2 17985 i:= next_coru(298, <*ident*>
2 17986 20, <*prioritet*>
2 17987 true <*testmaske*>);
2 17988 j:= new_activity( i,
2 17989 0,
2 17990 tv_switch_adm);
2 17991 <*+3*>skriv_new_activity(out,i,j);
2 17992 <*-3*>
2 17993
2 17993 i:= next_coru(299, <*ident*>
2 17994 3, <*prioritet*>
2 17995 true <*testmaske*>);
2 17996 j:= new_activity( i,
2 17997 0,
2 17998 talevejsswitch);
2 17999 <*+3*>skriv_new_activity(out,i,j);
2 18000 <*-3*>
2 18001 \f
2 18001 message garage_initialisering side 1 - 810521/hko;
2 18002
2 18002 cs_gar:= next_semch;
2 18003 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 18004 <*-3*>
2 18005
2 18005 i:= next_coru(300,<*ident*>
2 18006 10,<*prioritet*>
2 18007 true<*test_maske*>);
2 18008
2 18008 j:= new_activity( i,
2 18009 0,
2 18010 h_garage);
2 18011
2 18011 <*+3*>skriv_newactivity(out,i,j);
2 18012 <*-3*>
2 18013
2 18013 for k:= 1 step 1 until max_antal_garageterminaler do
2 18014 begin
3 18015 ref:= (k-1)*8;
3 18016 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 18017 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 18018 i:=monitor(4)process address:(z_gar(k),0,ia);
3 18019 if i = 0 then
3 18020 begin
4 18021 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 18022 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 18023 end
3 18024 else
3 18025 begin
4 18026 terminal_tab.ref.terminal_tilstand:=
4 18027 if garage_auto_include(k) then 0 else 7 shift 21;
4 18028 if garage_auto_include(k) then
4 18029 monitor(8)reserve:(z_gar(k),0,ia);
4 18030 end;
3 18031 cs_garage(k):= next_semch;
3 18032 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 18033 <*-3*>
3 18034 i:= next_coru(300+k,<*ident*>
3 18035 10,<*prioritet*>
3 18036 true <*testmaske*>);
3 18037 j:= new_activity( i,
3 18038 0,
3 18039 garage,k);
3 18040
3 18040 <*+3*>skriv_newactivity(out,i,j);
3 18041 <*-3*>
3 18042
3 18042 end;
2 18043 \f
2 18043 message radio_initialisering side 1 - 820301/hko;
2 18044
2 18044 cs_rad:= next_semch;
2 18045 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 18046 <*-3*>
2 18047
2 18047 i:= next_coru(400,<*ident*>
2 18048 10,<*prioritet*>
2 18049 true<*test_maske*>);
2 18050 j:= new_activity( i,
2 18051 0,
2 18052 h_radio);
2 18053 <*+3*>skriv_newactivity(out,i,j);
2 18054 <*-3*>
2 18055
2 18055 opkalds_kø_ledige:= max_antal_mobilopkald;
2 18056 nødopkald_brugt:= 0;
2 18057 læsfil(1034,1,i);
2 18058 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 18059
2 18059 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 18060 for i:= system(3,j,opkaldskø) step 1 until j do
2 18061 opkaldskø(i):= 0;
2 18062 første_frie_opkald:=opkaldskø_postlængde;
2 18063 første_opkald:=sidste_opkald:=
2 18064 første_nødopkald:=sidste_nødopkald:=j:=0;
2 18065
2 18065 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 18066 begin
3 18067 ref:=i*opkaldskø_postlængde;
3 18068 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 18069 end;
2 18070 ref:=ref+opkaldskø_postlængde;
2 18071 opkaldskø.ref(1):=j shift 12;
2 18072
2 18072 for ref:= 0 step 512 until (max_linienr//768*512) do
2 18073 begin
3 18074 i:= læs_fil(1035,ref//512+1,j);
3 18075 if i <> 0 then
3 18076 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 18077 tofrom(radio_linietabel.ref,fil(j),
3 18078 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 18079 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 18080 end;
2 18081
2 18081 for i:= system(3,j,kanal_tab) step 1 until j do
2 18082 kanal_tab(i):= 0;
2 18083 kanal_tilstand:= 2;
2 18084 kanal_id1:= 4;
2 18085 kanal_id2:= 6;
2 18086 kanal_spec:= 8;
2 18087 kanal_alt_id1:= 10;
2 18088 kanal_alt_id2:= 12;
2 18089 kanal_mon_maske:= 12;
2 18090 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 18091
2 18091 for i:= 1 step 1 until max_antal_kanaler do
2 18092 begin
3 18093 ref:= (i-1)*kanalbeskrlængde;
3 18094 sæthexciffer(kanal_tab.ref,3,15);
3 18095 if kanal_id(i) shift (-5) extract 3 = 2 or
3 18096 kanal_id(i) shift (-5) extract 3 = 3 and
3 18097 radio_id(kanal_id(i) extract 5)<=3
3 18098 then
3 18099 begin
4 18100 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 18101 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 18102 end;
3 18103 end;
2 18104 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 18105 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 18106 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 18107 optaget_flag:= 0;
2 18108 \f
2 18108 message radio_initialisering side 2 - 810524/hko;
2 18109
2 18109 bs_mobil_opkald:= next_sem;
2 18110
2 18110 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 18111 <*-3*>
2 18112
2 18112 bs_opkaldskø_adgang:= next_sem;
2 18113 signal_bin(bs_opkaldskø_adgang);
2 18114
2 18114 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 18115 <*-3*>
2 18116
2 18116 cs_radio_medd:=next_semch;
2 18117 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 18118
2 18118 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 18119 <*-3*>
2 18120
2 18120 i:= next_coru(403,
2 18121 5,<*prioritet*>
2 18122 true<*testmaske*>);
2 18123
2 18123 j:= new_activity( i,
2 18124 0,
2 18125 radio_medd_opkald);
2 18126
2 18126 <*+3*>skriv_newactivity(out,i,j);
2 18127 <*-3*>
2 18128
2 18128 cs_radio_adm:= nextsemch;
2 18129 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 18130 <*-3*>
2 18131
2 18131 i:= next_coru(404,
2 18132 10,
2 18133 true);
2 18134 j:= new_activity(i,
2 18135 0,
2 18136 radio_adm,next_op(data+radio_op_længde));
2 18137 <*+3*>skriv_new_activity(out,i,j);
2 18138 <*-3*>
2 18139 \f
2 18139 message radio_initialisering side 3 - 810526/hko;
2 18140 for k:= 1 step 1 until max_antal_taleveje do
2 18141 begin
3 18142
3 18142 cs_radio(k):=next_semch;
3 18143
3 18143 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 18144 <*-3*>
3 18145
3 18145 bs_talevej_udkoblet(k):= nextsem;
3 18146 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 18147 <*-3*>
3 18148
3 18148 i:=next_coru(410+k,
3 18149 10,
3 18150 true);
3 18151
3 18151 j:=new_activity( i,
3 18152 0,
3 18153 radio,k,next_op(data + radio_op_længde));
3 18154
3 18154 <*+3*>skriv_newactivity(out,i,j);
3 18155 <*-3*>
3 18156 end;
2 18157
2 18157 cs_radio_pulje:=next_semch;
2 18158
2 18158 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 18159 <*-3*>
2 18160
2 18160 for i:= 1 step 1 until radiopulje_størrelse do
2 18161 signal_ch(cs_radio_pulje,
2 18162 next_op(60),
2 18163 gen_optype or rad_optype);
2 18164
2 18164 cs_radio_kø:= next_semch;
2 18165
2 18165 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 18166 <*-3*>
2 18167
2 18167 mobil_opkald_aktiveret:= true;
2 18168 \f
2 18168 message radio_initialisering side 4 - 810522/hko;
2 18169
2 18169 laf:=raf:=0;
2 18170
2 18170 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 18171 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 18172 j:=1;
2 18173 if i <> 0 then
2 18174 fejlreaktion(4<*monitor resultat*>,i,
2 18175 string radio_fr_navn.raf(increase(j)),1);
2 18176 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 18177 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 18178 j:=1;
2 18179 if i <> 0 then
2 18180 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 18181 ia(1):= 3 <*canonical*>;
2 18182 ia(2):= 0 <*no echo*>;
2 18183 ia(3):= 0 <*prompt*>;
2 18184 ia(4):= 5 <*timeout*>;
2 18185 setcspterm(radio_fr_navn.laf,ia);
2 18186
2 18186 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 18187 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 18188 j:= 1;
2 18189 if i <> 0 then
2 18190 fejlreaktion(4<*monitor resultat*>,i,
2 18191 string radio_rf_navn.raf(increase(j)),1);
2 18192 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 18193 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 18194 j:= 1;
2 18195 if i <> 0 then
2 18196 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 18197 ia(1):= 3 <*canonical*>;
2 18198 ia(2):= 0 <*no echo*>;
2 18199 ia(3):= 0 <*prompt*>;
2 18200 ia(4):= 5 <*timeout*>;
2 18201 setcspterm(radio_rf_navn.laf,ia);
2 18202 \f
2 18202 message radio_initialisering side 5 - 810521/hko;
2 18203 for k:= 1 step 1 until max_antal_kanaler do
2 18204 begin
3 18205
3 18205 ss_radio_aktiver(k):=next_sem;
3 18206 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 18207 <*-3*>
3 18208
3 18208 ss_samtale_nedlagt(k):=next_sem;
3 18209 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 18210 <*-3*>
3 18211 end;
2 18212
2 18212 cs_radio_ind:= next_semch;
2 18213 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 18214 <*-3*>
2 18215
2 18215 i:= next_coru(401,<*ident radio_ind*>
2 18216 3, <*prioritet*>
2 18217 true <*testmaske*>);
2 18218 j:= new_activity( i,
2 18219 0,
2 18220 radio_ind,next_op(data + 64));
2 18221
2 18221 <*+3*>skriv_newactivity(out,i,j);
2 18222 <*-3*>
2 18223
2 18223 cs_radio_ud:=next_semch;
2 18224 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 18225 <*-3*>
2 18226
2 18226 i:= next_coru(402,<*ident radio_out*>
2 18227 10,<*prioritet*>
2 18228 true <*testmaske*>);
2 18229 j:= new_activity( i,
2 18230 0,
2 18231 radio_ud,next_op(data + 64));
2 18232
2 18232 <*+3*>skriv_newactivity(out,i,j);
2 18233 <*-3*>
2 18234 \f
2 18234 message vogntabel initialisering side 1 - 820301;
2 18235
2 18235 sidste_bus:= sidste_linie_løb:= 0;
2 18236
2 18236 tf_vogntabel:= 1 shift 10 + 2;
2 18237 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 18238 tf_gruppeidenter:= 1 shift 10 +6;
2 18239 tf_springdef:= 1 shift 10 +7;
2 18240 hent_fil_dim(ia);
2 18241 max_antal_i_gruppe:= ia(2);
2 18242 if ia(1) < max_antal_grupper then
2 18243 max_antal_grupper:= ia(1);
2 18244
2 18244 <* initialisering af interne vogntabeller *>
2 18245 begin
3 18246 long array field laf1,laf2;
3 18247 integer array fdim(1:8);
3 18248 zone z(128,1,stderror);
3 18249 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 18250 long omr,garageid;
3 18251 integer field ll, bn;
3 18252 boolean binær, test24;
3 18253
3 18253 ll:= 2; bn:= 4;
3 18254
3 18254 <* nulstil tabellerne *>
3 18255 laf1:= -2;
3 18256 laf2:= 2;
3 18257 bustabel1.laf2(0):=
3 18258 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 18259 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 18260 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 18261 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 18262 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 18263 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 18264 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 18265 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 18266 \f
3 18266 message vogntabel initialisering side 1a - 810505/cl;
3 18267
3 18267
3 18267 <* initialisering af intern busnummertabel *>
3 18268 open(z,4,<:busnumre:>,0);
3 18269 busnr:= -1;
3 18270 read(z,busnr);
3 18271 while busnr > 0 do
3 18272 begin
4 18273 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 18274 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 18275 sidste_bus:= sidste_bus+1;
4 18276 if sidste_bus > max_antal_busser then
4 18277 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 18278 repeatchar(z); readchar(z,tegn);
4 18279 garageid:= extend 0; binær:= false; omr:= extend 0;
4 18280 g_nr:= o_nr:= 0;
4 18281 if tegn='!' then
4 18282 begin
5 18283 binær:= true;
5 18284 readchar(z,tegn);
5 18285 end;
4 18286 if tegn='/' then <*garageid*>
4 18287 begin
5 18288 readchar(z,tegn); repeatchar(z);
5 18289 if '0'<=tegn and tegn<='9' then
5 18290 begin
6 18291 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 18292 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 18293 if g_nr<>0 and garageid=long<::> then
6 18294 begin
7 18295 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 18296 g_nr:= 0;
7 18297 end;
6 18298 end
5 18299 else
5 18300 begin
6 18301 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 18302 begin
7 18303 garageid:= garageid shift 8 + tegn;
7 18304 readchar(z,tegn);
7 18305 end;
6 18306 while garageid shift (-40) extract 8 = 0 do
6 18307 garageid:= garageid shift 8;
6 18308 g_nr:= find_bpl(garageid);
6 18309 if g_nr=0 then
6 18310 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 18311 end;
5 18312 repeatchar(z); readchar(z,tegn);
5 18313 end;
4 18314 if tegn=';' then
4 18315 begin
5 18316 readchar(z,tegn); repeatchar(z);
5 18317 if '0'<=tegn and tegn<='9' then
5 18318 begin
6 18319 read(z,o_nr);
6 18320 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 18321 if o_nr<>0 then omr:= område_navn(o_nr);
6 18322 if o_nr<>0 and omr=long<::> then
6 18323 begin
7 18324 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 18325 o_nr:= 0;
7 18326 end;
6 18327 end
5 18328 else
5 18329 begin
6 18330 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 18331 begin
7 18332 omr:= omr shift 8 + tegn;
7 18333 readchar(z,tegn);
7 18334 end;
6 18335 while omr shift (-40) extract 8 = 0 do
6 18336 omr:= omr shift 8;
6 18337 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 18338 i:= 1;
6 18339 while i<=max_antal_områder and o_nr=0 do
6 18340 begin
7 18341 if omr=område_navn(i) then o_nr:= i;
7 18342 i:= i+1;
7 18343 end;
6 18344 if o_nr=0 then
6 18345 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 18346 end;
5 18347 repeatchar(z); readchar(z,tegn);
5 18348 end;
4 18349 if o_nr=0 then o_nr:= 3;
4 18350 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 18351 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 18352
4 18352 busnr:= -1;
4 18353 read(z,busnr);
4 18354 end;
3 18355 close(z,true);
3 18356 \f
3 18356 message vogntabel initialisering side 2 - 820301/cl;
3 18357
3 18357 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 18358 test24:= testbit24;
3 18359 testbit24:= false;
3 18360 i:= 1;
3 18361 s:= læsfil(tf_vogntabel,i,zi);
3 18362 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 18363 while fil(zi).bn<>0 do
3 18364 begin
4 18365 if fil(zi).ll <> 0 then
4 18366 begin <* indsæt linie/løb *>
5 18367 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 18368 fil(zi).ll,j);
5 18369 if res < 0 then j:= j+1;
5 18370 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 18371 <:dobbeltregistrering i vogntabel:>,1)
5 18372 else
5 18373 begin
6 18374 o_nr:= fil(zi).bn shift (-14) extract 8;
6 18375 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 18376 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 18377 <:ukendt bus i vogntabel:>,1)
6 18378 else
6 18379 begin
7 18380 if sidste_linie_løb >= max_antal_linie_løb then
7 18381 fejlreaktion(10,fil(zi).bn extract 14,
7 18382 <:for mange linie/løb i vogntabel:>,0);
7 18383 for ll_nr:= sidste_linie_løb step (-1) until j do
7 18384 begin
8 18385 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18386 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18387 end;
7 18388 linie_løb_tabel(j):= fil(zi).ll;
7 18389 bus_indeks(j):= false add b_nr;
7 18390 sidste_linie_løb:= sidste_linie_løb + 1;
7 18391 end;
6 18392 end;
5 18393 end;
4 18394 i:= i+1;
4 18395 s:= læsfil(tf_vogntabel,i,zi);
4 18396 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18397 end;
3 18398 \f
3 18398 message vogntabel initialisering side 3 - 810428/cl;
3 18399
3 18399 <* initialisering af intern linie/løb-indekstabel *>
3 18400 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18401 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18402
3 18402 <* gem ny vogntabel i tabelfil *>
3 18403 for i:= 1 step 1 until sidste_bus do
3 18404 begin
4 18405 s:= skriv_fil(tf_vogntabel,i,zi);
4 18406 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18407 fil(zi).bn:= bustabel(i) extract 14 add
4 18408 (bustabel1(i) extract 8 shift 14);
4 18409 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18410 end;
3 18411 fdim(4):= tf_vogntabel;
3 18412 hent_fil_dim(fdim);
3 18413 pant:= fdim(3) * (256//fdim(2));
3 18414 for i:= sidste_bus+1 step 1 until pant do
3 18415 begin
4 18416 s:= skriv_fil(tf_vogntabel,i,zi);
4 18417 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18418 fil(zi).ll:= fil(zi).bn:= 0;
4 18419 end;
3 18420
3 18420 <* initialisering/nulstilling af gruppetabeller *>
3 18421 for i:= 1 step 1 until max_antal_grupper do
3 18422 begin
4 18423 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18424 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18425 gruppetabel(i):= fil(zi).ll;
4 18426 end;
3 18427 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18428 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18429 testbit24:= test24;
3 18430 end;
2 18431
2 18431
2 18431 <*+2*>
2 18432 <**> if testbit40 then p_vogntabel(out);
2 18433 <**> if testbit43 then p_gruppetabel(out);
2 18434 <*-2*>
2 18435
2 18435 message vogntabel initialisering side 3a -920517/cl;
2 18436
2 18436 <* initialisering for vt_log *>
2 18437
2 18437 v_tid:= 4;
2 18438 v_kode:= 6;
2 18439 v_bus:= 8;
2 18440 v_ll1:= 10;
2 18441 v_ll2:= 12;
2 18442 v_tekst:= 6;
2 18443 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18444 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18445 if vt_log_aktiv then
2 18446 begin
3 18447 integer i;
3 18448 real t;
3 18449 integer array field iaf;
3 18450 integer array
3 18451 tail(1:10),ia(1:10),chead(1:20);
3 18452
3 18452 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18453 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18454 if i=0 then
3 18455 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18456 if i=0 then
3 18457 begin
4 18458 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18459 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18460 end;
3 18461
3 18461 if i=0 then
3 18462 begin
4 18463 iaf:= 2;
4 18464 tofrom(vt_logdisc,tail.iaf,8);
4 18465 i:=slices(vt_logdisc,0,tail,chead);
4 18466 if i > (-2048) then
4 18467 begin
5 18468 vt_log_slicelgd:= chead(15);
5 18469 i:= 0;
5 18470 end;
4 18471 end;
3 18472
3 18472 if i=0 then
3 18473 begin
4 18474 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18475 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18476 if i=0 then
4 18477 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18478 if i=0 then
4 18479 begin
5 18480 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18481 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18482 end;
4 18483
4 18483 if i<>0 then
4 18484 begin
5 18485 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18486 tail(1):= 1;
5 18487 iaf:= 2;
5 18488 tofrom(tail.iaf,vt_logdisc,8);
5 18489 tail(6):=systime(7,0,t);
5 18490 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18491 if i=0 then
5 18492 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18493 end;
4 18494 end;
3 18495
3 18495 if i<>0 then vt_log_aktiv:= false;
3 18496 end;
2 18497
2 18497
2 18497 \f
2 18497 message vogntabel initialisering side 4 - 810520/cl;
2 18498
2 18498 cs_vt:= nextsemch;
2 18499 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18500 <*-3*>
2 18501
2 18501 cs_vt_adgang:= nextsemch;
2 18502 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18503 <*-3*>
2 18504
2 18504 cs_vt_opd:= nextsemch;
2 18505 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18506 <*-3*>
2 18507
2 18507 cs_vt_rap:= nextsemch;
2 18508 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18509 <*-3*>
2 18510
2 18510 cs_vt_tilst:= nextsemch;
2 18511 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18512 <*-3*>
2 18513
2 18513 cs_vt_auto:= nextsemch;
2 18514 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18515 <*-3*>
2 18516
2 18516 cs_vt_grp:= nextsemch;
2 18517 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18518 <*-3*>
2 18519
2 18519 cs_vt_spring:= nextsemch;
2 18520 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18521 <*-3*>
2 18522
2 18522 cs_vt_log:= nextsemch;
2 18523 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18524 <*-3*>
2 18525
2 18525 cs_vt_logpool:= nextsemch;
2 18526 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18527 <*-3*>
2 18528
2 18528 vt_op:= nextop(vt_op_længde);
2 18529 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18530
2 18530 vt_logop(1):= nextop(vt_op_længde);
2 18531 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18532 vt_logop(2):= nextop(vt_op_længde);
2 18533 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18534
2 18534 \f
2 18534 message vogntabel initialisering side 5 - 81-520/cl;
2 18535
2 18535 i:= nextcoru(500, <*ident*>
2 18536 10, <*prioitet*>
2 18537 true <*testmaske*>);
2 18538 j:= new_activity( i,
2 18539 0,
2 18540 h_vogntabel);
2 18541 <*+3*> skriv_newactivity(out,i,j);
2 18542 <*-3*>
2 18543
2 18543 i:= nextcoru(501, <*ident*>
2 18544 10, <*prioritet*>
2 18545 true <*testmaske*>);
2 18546 iaf:= nextop(filop_længde);
2 18547 j:= new_activity(i,
2 18548 0,
2 18549 vt_opdater,iaf);
2 18550 <*+3*> skriv_newactivity(out,i,j);
2 18551 <*-3*>
2 18552
2 18552 i:= nextcoru(502, <*ident*>
2 18553 10, <*prioritet*>
2 18554 true <*testmaske*>);
2 18555 k:= nextsemch;
2 18556 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18557 <*-3*>
2 18558 iaf:= nextop(fil_op_længde);
2 18559 j:= newactivity(i,
2 18560 0,
2 18561 vt_tilstand,
2 18562 k,
2 18563 iaf);
2 18564 <*+3*> skriv_newactivity(out,i,j);
2 18565 <*-3*>
2 18566 \f
2 18566 message vogntabel initialisering side 6 - 810520/cl;
2 18567
2 18567 i:= nextcoru(503, <*ident*>
2 18568 10, <*prioritet*>
2 18569 true <*testmaske*>);
2 18570 k:= nextsemch;
2 18571 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18572 <*-3*>
2 18573 iaf:= nextop(fil_op_længde);
2 18574 j:= newactivity(i,
2 18575 0,
2 18576 vt_rapport,
2 18577 k,
2 18578 iaf);
2 18579 <*+3*> skriv_newactivity(out,i,j);
2 18580 <*-3*>
2 18581
2 18581 i:= nextcoru(504, <*ident*>
2 18582 10, <*prioritet*>
2 18583 true <*testmaske*>);
2 18584 k:= nextsemch;
2 18585 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18586 <*-3*>
2 18587 iaf:= nextop(fil_op_længde);
2 18588 j:= new_activity(i,
2 18589 0,
2 18590 vt_gruppe,
2 18591 k,
2 18592 iaf);
2 18593 <*+3*> skriv_newactivity(out,i,j);
2 18594 <*-3*>
2 18595 \f
2 18595 message vogntabel initialisering side 7 - 810520/cl;
2 18596
2 18596 i:= nextcoru(505, <*ident*>
2 18597 10, <*prioritet*>
2 18598 true <*testmaske*>);
2 18599 k:= nextsemch;
2 18600 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18601 <*-3*>
2 18602 iaf:= nextop(fil_op_længde);
2 18603 j:= newactivity(i,
2 18604 0,
2 18605 vt_spring,
2 18606 k,
2 18607 iaf);
2 18608 <*+3*> skriv_newactivity(out,i,j);
2 18609 <*-3*>
2 18610
2 18610 i:= nextcoru(506, <*ident*>
2 18611 10,
2 18612 true <*testmaske*>);
2 18613 k:= nextsemch;
2 18614 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18615 <*-3*>
2 18616 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18617 j:= newactivity(i,
2 18618 0,
2 18619 vt_auto,
2 18620 k,
2 18621 iaf);
2 18622 <*+3*> skriv_newactivity(out,i,j);
2 18623 <*-3*>
2 18624
2 18624 i:=nextcoru(507, <*ident*>
2 18625 10, <*prioritet*>
2 18626 true <*testmaske*>);
2 18627 j:=newactivity(i,
2 18628 0,
2 18629 vt_log);
2 18630 <*+3*> skriv_newactivity(out,i,j);
2 18631 <*-3*>
2 18632
2 18632 <*+2*>
2 18633 <**> if testbit42 then skriv_vt_variable(out);
2 18634 <*-2*>
2 18635 \f
2 18635 message sysslut initialisering side 1 - 810406/cl;
2 18636 begin
3 18637 zone z(128,1,stderror);
3 18638 integer i,coruid,j,k;
3 18639 integer array field cor;
3 18640
3 18640 open(z,4,<:overvågede:>,0);
3 18641 for i:= read(z,coruid) while i > 0 do
3 18642 begin
4 18643 if coruid = 0 then
4 18644 begin
5 18645 for coruid:= 1 step 1 until maxcoru do
5 18646 begin
6 18647 cor:= coroutine(coruid);
6 18648 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18649 end
5 18650 end
4 18651 else
4 18652 begin
5 18653 cor:= coroutine(coru_no(abs coruid));
5 18654 if cor > 0 then
5 18655 begin
6 18656 d.cor.corutestmask:=
6 18657 (d.cor.corutestmask shift 1 shift (-1)) add
6 18658 ((coruid > 0) extract 1 shift 11);
6 18659 end;
5 18660 end;
4 18661 end;
3 18662 close(z,true);
3 18663
3 18663 læsfil(tf_systællere,1,k);
3 18664 rf:=iaf:= 4;
3 18665 systællere_nulstillet:= fil(k).rf;
3 18666 nulstil_systællere:= fil(k).iaf(1);
3 18667 if systællere_nulstillet=real<::> then
3 18668 begin
4 18669 systællere_nulstillet:= 0.0;
4 18670 nulstil_systællere:= -1;
4 18671 end;
3 18672 iaf:= 32;
3 18673 tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*10);
3 18674 iaf:= 192;
3 18675 tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*10);
3 18676
3 18676 end;
2 18677 \f
2 18677 message sysslut initialisering side 2 - 810603/cl;
2 18678
2 18678
2 18678 if låsning > 0 then
2 18679 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18680
2 18680 if låsning > 1 then
2 18681 <* låsning 2 : *> lock(readchar,1,write,2);
2 18682
2 18682 if låsning > 2 then
2 18683 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18684
2 18684
2 18684
2 18684
2 18684 if låsning > 0 then
2 18685 begin
3 18686 i:= locked(ia);
3 18687 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18688 end;
2 18689 \f
2 18689 message sysslut initialisering side 3 - 810406/cl;
2 18690
2 18690 write(z_io,"nl",2,<:initialisering slut:>);
2 18691 system(2)free core:(i,ra);
2 18692 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18693 setposition(z_io,0,0);
2 18694 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18695 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18696 "nl",1);
2 18697 errorbits:= 3; <* ok.no warning.yes *>
2 18698 \f
2 18698
2 18698 algol list.off;
2 18699 message coroutinemonitor - 40 ;
2 18700
2 18700 if simref <> firstsem then initerror(1, false);
2 18701 if semref <> firstop - 4 then initerror(2, false);
2 18702 if coruref <> firstsim then initerror(3, false);
2 18703 if opref <> optop + 6 then initerror(4, false);
2 18704 if proccount <> maxprocext -1 then initerror(5, false);
2 18705 goto takeexternal;
2 18706
2 18706 dump:
2 18707 op:= op;
2 18708 \f
2 18708 message sys trapaktion side 1 - 810521/hko/cl;
2 18709 trap(finale);
2 18710 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18711 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18712 begin
3 18713 k:= 0;
3 18714 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18715 <:timerqueue->:>));
3 18716 iaf:= i;
3 18717 for iaf:= d.iaf.next while iaf<>i do
3 18718 begin
4 18719 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18720 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18721 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18722 end;
3 18723 end;
2 18724 outchar(zbillede,'nl');
2 18725
2 18725 skriv_opkaldstællere(zbillede);
2 18726
2 18726
2 18726 pfilsystem(zbillede);
2 18727
2 18727
2 18727 write(zbillede,"nl",2,"=",20,<: attentionmodul :>,"=",20,"nl",1);
2 18728
2 18728 write(zbillede,"nl",1,<:attention-flag: :>,"nl",1);
2 18729 outintbits_ia(zbillede,att_flag,1,att_maske_lgd//2);
2 18730
2 18730 write(zbillede,"nl",1,<:attention-signal: :>,"nl",1);
2 18731 outintbits_ia(zbillede,att_signal,1,att_maske_lgd//2);
2 18732 \f
2 18732 message operatør trapaktion1 side 1 - 810521/hko;
2 18733 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18734
2 18734 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18735 for i:= 1 step 1 until max_antal_operatører do
2 18736 begin
3 18737 laf:= (i-1)*8;
3 18738 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18739 case operatør_auto_include(i) extract 2 + 1 of (
3 18740 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18741 terminal_navn.laf,"nl",1);
3 18742 end;
2 18743 write(zbillede,"nl",1);
2 18744
2 18744 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18745 <:betjeningspladsgrupper::>,"nl",1);
2 18746 for i:= 1 step 1 until 127 do
2 18747 if bpl_navn(i)<>long<::> then
2 18748 begin
3 18749 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18750 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18751 write(zbillede,"sp",16-k,<:= :>);
3 18752 iaf:= i*op_maske_lgd; j:=0;
3 18753 for k:= 1 step 1 until max_antal_operatører do
3 18754 begin
4 18755 if læsbit_ia(bpl_def.iaf,k) then
4 18756 begin
5 18757 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18758 write(zbillede,true,6,string bpl_navn(k));
5 18759 j:= j+1;
5 18760 end;
4 18761 end;
3 18762 write(zbillede,"nl",1);
3 18763 end;
2 18764
2 18764 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18765 for i:= 1 step 1 until max_antal_operatører do
2 18766 begin
3 18767 write(zbillede,<<dd >,i);
3 18768 for j:= 0 step 1 until 3 do
3 18769 begin
4 18770 k:= operatør_stop(i,j);
4 18771 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18772 else string bpl_navn(k));
4 18773 end;
3 18774 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18775 end;
2 18776
2 18776 skriv_terminal_tab(zbillede);
2 18777 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18778 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18779 skriv_opk_alarm_tab(zbillede);
2 18780 skriv_talevejs_tab(zbillede);
2 18781 skriv_op_spool_buf(zbillede);
2 18782 skriv_cqf_tabel(zbillede,true);
2 18783 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18784
2 18784 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18785 for i:= 1 step 1 until max_antal_garageterminaler do
2 18786 begin
3 18787 laf:= (i-1)*8;
3 18788 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18789 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18790 end;
2 18791 \f
2 18791 message radio trapaktion side 1 - 820301/hko;
2 18792 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18793 skriv_kanal_tab(zbillede);
2 18794 skriv_opkaldskø(zbillede);
2 18795 skriv_radio_linietabel(zbillede);
2 18796 skriv_radio_områdetabel(zbillede);
2 18797
2 18797 \f
2 18797 message vogntabel trapaktion side 1 - 810520/cl;
2 18798 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18799 skriv_vt_variable(zbillede);
2 18800 p_vogntabel(zbillede);
2 18801 p_gruppetabel(zbillede);
2 18802 p_springtabel(zbillede);
2 18803 \f
2 18803 message sysslut trapaktion side 1 - 810519/cl;
2 18804 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18805 corutable(zbillede);
2 18806 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18807 <: ref værdi prev next:>,"nl",1);
2 18808 iaf:= firstsim;
2 18809 repeat
2 18810 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18811 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18812 iaf:= iaf + simsize;
2 18813 until iaf>=simref;
2 18814 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18815 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18816 iaf:= firstsem;
2 18817 repeat
2 18818 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18819 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18820 iaf:= iaf+semsize;
2 18821 until iaf>=semref;
2 18822 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18823 iaf:= firstop;
2 18824 repeat
2 18825 skriv_op(zbillede,iaf);
2 18826 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18827 until iaf>=optop;
2 18828 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18829 <: messref messcode messop:>,"nl",1);
2 18830 for i:= 1 step 1 until maxmessext do
2 18831 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18832 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18833 <: procref proccode procop:>,"nl",1);
2 18834 for i:= 1 step 1 until maxprocext do
2 18835 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18836
2 18836
2 18836 \f
2 18836 message sys_finale side 1 - 810428/hko;
2 18837
2 18837 finale:
2 18838 trap(slut_finale);
2 18839 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18840 endaction:=0;
2 18841 \f
2 18841 message filsystem finale side 1 - 810428/cl;
2 18842
2 18842 <* lukning af zoner *>
2 18843 write(out,<:lukker filsystem:>); ud;
2 18844 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18845 close(fil(i),true);
2 18846 \f
2 18846 message operatør_finale side 1 - 810428/hko;
2 18847
2 18847 goto op_trap2_slut;
2 18848
2 18848 write(out,<:lukker operatører:>); ud;
2 18849 for k:= 1 step 1 until max_antal_operatører do
2 18850 begin
3 18851 close(z_op(k),true);
3 18852 end;
2 18853 op_trap2_slut:
2 18854 k:=k;
2 18855
2 18855 \f
2 18855 message garage_finale side 1 - 810428/hko;
2 18856
2 18856 write(out,<:lukker garager:>); ud;
2 18857 for k:= 1 step 1 until max_antal_garageterminaler do
2 18858 begin
3 18859 close(z_gar(k),true);
3 18860 end;
2 18861 \f
2 18861 message radio_finale side 1 - 810525/hko;
2 18862 write(out,<:lukker radio:>); ud;
2 18863 close(z_fr_in,true);
2 18864 close(z_fr_out,true);
2 18865 close(z_rf_in,true);
2 18866 close(z_rf_out,true);
2 18867 \f
2 18867 message sysslut finale side 1 - 810530/cl;
2 18868
2 18868 slut_finale:
2 18869
2 18869 trap(exit_finale);
2 18870
2 18870 outchar(zrl,'em');
2 18871 close(zrl,true);
2 18872
2 18872 write(zbillede,
2 18873 "nl",2,<:blocksread=:>,blocksread,
2 18874 "nl",1,<:blocksout= :>,blocksout,
2 18875 "nl",1,<:fillæst= :>,fillæst,
2 18876 "nl",1,<:filskrevet=:>,filskrevet,
2 18877 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18878 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18879 close(zbillede,true);
2 18880 monitor(42,zbillede,0,ia);
2 18881 ia(6):= systime(7,0,0.0);
2 18882 monitor(44,zbillede,0,ia);
2 18883 setposition(z_io,0,0);
2 18884 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18885 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18886 close(z_io,true);
2 18887 exit_finale: trapmode:= 1 shift 10;
2 18888
2 18888 end;
1 18889
1 18889
1 18889 algol list.on;
1 18890 message programslut;
1 18891 program_slut:
1 18892 end
\f
1. 7176169 5773192 611 0 0
2. 14250758 14831191 350 0 0
3. 2082959 723891 419 368 0
4. 7452191 1133338 428 1653 742
5. 13216116 12659754 583 29937 605
6. 13521659 2704629 584 0 0
7. 14133811 5737491 633 0 0
8. 18882 18876 18863 18845 18832 18824 18814 18806 18795 18784
18777 18764 18750 18741 18733 18727 18715 18702 18693 18683
18670 18641 18616 18598 18574 18555 18533 18520 18505 18489
18474 18453 18427 18413 18396 18376 18367 18345 18320 18295
18277 18264 18260 18232 18217 18201 18190 18177 18162 18146
18133 18117 18101 18079 18061 18045 18027 18010 17987 17968
17949 17937 17923 17903 17889 17870 17857 17838 17827 17814
17804 17787 17774 17763 17745 17732 17719 17699 17681 17668
17645 17625 17609 17596 17579 17567 17552 17537 17518 17497
17483 17473 17468 17458 17450 17431 17410 17390 17382 17375
17365 17320 17275 17247 17234 17201 17174 17151 17111 17086
17057 17001 16946 16893 16864 16831 16789 16757 16722 16666
16628 16588 16540 16507 16482 16459 16439 16411 16392 16373
16350 16339 16328 16308 16291 16276 16260 16233 16214 16198
16180 16171 16164 16139 16131 16121 16101 16090 16071 16060
16043 16028 16010 15985 15972 15961 15944 15926 15912 15905
15897 15888 15860 15843 15826 15813 15805 15796 15777 15766
15752 15740 15713 15698 15680 15658 15638 15625 15606 15583
15557 15536 15525 15503 15483 15461 15443 15415 15394 15376
15363 15355 15348 15333 15314 15307 15290 15270 15250 15236
15211 15196 15175 15149 15137 15128 15099 15077 15057 15047
15036 15011 14990 14970 14940 14921 14902 14882 14861 14853
14827 14814 14797 14778 14752 14733 14716 14689 14669 14647
14630 14610 14579 14548 14513 14486 14465 14452 14441 14420
14412 14403 14384 14364 14341 14314 14297 14279 14266 14256
14245 14221 14197 14178 14148 14135 14102 14067 14052 14031
14019 13993 13972 13952 13928 13917 13887 13868 13845 13815
13799 13776 13749 13714 13687 13680 13666 13645 13633 13619
13611 13596 13582 13575 13568 13561 13553 13520 13505 13485
13472 13454 13440 13412 13385 13367 13346 13328 13311 13294
13282 13272 13248 13242 13227 13207 13191 13174 13149 13136
13101 13084 13067 13044 13028 13016 12998 12971 12960 12952
12929 12910 12901 12884 12869 12851 12842 12830 12821 12803
12787 12772 12761 12742 12714 12693 12672 12656 12642 12635
12623 12606 12574 12556 12540 12523 12507 12476 12452 12442
12429 12414 12398 12380 12362 12338 12327 12311 12294 12278
12261 12237 12230 12212 12185 12167 12142 12117 12073 12062
12051 12023 11990 11960 11933 11891 11864 11843 11830 11822
11814 11804 11775 11758 11737 11722 11702 11679 11657 11633
11605 11583 11566 11541 11524 11508 11485 11470 11451 11432
11408 11373 11347 11329 11310 11289 11261 11244 11222 11208
11185 11157 11144 11131 11102 11064 11033 10990 10956 10925
10918 10910 10902 10891 10862 10839 10824 10814 10794 10776
10763 10754 10742 10733 10718 10710 10698 10669 10647 10629
10575 10540 10506 10473 10414 10398 10381 10362 10349 10336
10315 10303 10285 10272 10259 10232 10213 10196 10159 10143
10124 10116 10106 10075 10056 10039 10028 9998 9975 9950
9937 9928 9914 9890 9883 9873 9856 9837 9823 9804
9792 9776 9765 9754 9729 9712 9690 9672 9654 9634
9621 9601 9590 9564 9545 9526 9512 9502 9474 9456
9448 9424 9412 9400 9376 9358 9342 9331 9303 9286
9282 9265 9256 9249 9238 9224 9208 9191 9179 9167
9148 9138 9130 9103 9087 9080 9067 9053 9036 9028
9012 9003 8984 8947 8938 8913 8901 8887 8863 8843
8823 8801 8761 8743 8728 8716 8698 8689 8682 8670
8655 8644 8633 8619 8610 8589 8584 8573 8562 8546
8538 8528 8507 8495 8483 8463 8454 8440 8430 8416
8395 8380 8363 8353 8337 8324 8317 8300 8278 8259
8238 8224 8207 8189 8173 8156 8145 8131 8116 8070
8051 8014 7991 7967 7955 7933 7917 7888 7875 7850
7833 7803 7788 7776 7756 7743 7728 7707 7698 7682
7665 7652 7636 7609 7587 7567 7544 7519 7502 7484
7464 7446 7432 7391 7367 7359 7337 7322 7298 7284
7276 7258 7246 7227 7216 7195 7182 7165 7149 7130
7103 7095 7087 7080 7059 7029 7013 6991 6975 6958
6942 6933 6913 6898 6880 6869 6858 6847 6837 6831
6820 6810 6791 6777 6757 6739 6723 6715 6698 6684
6671 6634 6618 6607 6574 6548 6534 6524 6510 6498
6488 6473 6460 6443 6426 6418 6412 6402 6382 6374
6358 6349 6328 6314 6300 6290 6277 6260 6249 6225
6203 6189 6162 6138 6119 6092 6073 6051 6039 6025
6008 5994 5980 5958 5945 5935 5922 5911 5888 5857
5840 5826 5801 5774 5761 5753 5742 5727 5716 5704
5690 5676 5656 5637 5616 5597 5567 5555 5542 5522
5505 5483 5468 5454 5437 5419 5403 5386 5375 5366
5353 5335 5325 5309 5293 5281 5268 5253 5242 5225
5207 5197 5182 5161 5137 5119 5105 5092 5075 5057
5035 5012 4996 4980 4963 4943 4923 4899 4878 4863
4844 4831 4808 4795 4777 4756 4736 4709 4691 4668
4633 4618 4610 4602 4580 4554 4538 4518 4504 4488
4450 4407 4388 4366 4342 4332 4309 4299 4290 4261
4241 4223 4201 4182 4159 4153 4109 4097 4052 4022
3989 3956 3920 3875 3827 3783 3754 3711 3651 3600
3550 3516 3474 3443 3403 3350 3310 3273 3260 3241
3226 3208 3188 3165 3150 3128 3082 3060 3027 2986
2962 2921 2900 2870 2838 2811 2793 2656 2627 2602
2567 2542 2502 2458 2443 2427 2412 2387 2367 2357
2348 2323 2301 2274 2263 2242 2221 2202 2179 2150
2127 2117 2095 2077 2064 2038 2022 2014 1987 1971
1953 1923 1902 1889 1881 1856 1835 1815 1800 1779
1765 1758 1745 1733 1719 1703 1690 1682 1668 1639
1621 1589 1555 1517 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
14133811 5737491 972 506071 31003
9. 16 120 16 4 960618 215056 buskom1
7 3 1995 306 algftnrts
0 1 0 2 *version
984 400 984 4 flushout
984 44 984 4 911004 101112 sendmessage
985 106 985 12 910308 134214 copyout
986 244 986 12 890821 163833 getzone6
0 410 0 0 out
987 178 987 12 940411 220029 testbit
990 414 990 18 940411 222629 findfpparam
993 46 993 18 890821 163814 system
996 238 996 18 movestring
996 56 996 18 890821 163907 outdate
997 124 997 18 isotable
998 176 997 18 890821 163656 write
1003 310 1003 152 intable
1004 34 1003 152 890821 163503 read
1008 24 1008 340 890821 163714 tofrom
995 420 993 18 stderror
1010 80 1010 340 890821 163740 open
1014 112 1014 340 890821 163754 monitor
1011 344 1010 340 close
1012 22 1010 340 setposition
995 378 993 18 increase
1002 50 997 18 outchar
997 26 997 18 replacechar
1017 98 1017 340 951214 094619 systime
0 1700 0 0 trapmode
1018 302 1018 340 trap
1018 112 1018 340 890821 163915 initzones
1019 268 1019 340 940411 222959 læsbitia
1020 22 1020 340 sign
1020 28 1020 340 890821 163648 ln
1021 432 1021 340 810409 111908 skrivhele
986 320 986 12 setzone6
1029 52 1029 340 inrec6
1029 28 1029 340 890821 163732 changerec6
1030 228 1030 340 940411 222949 sætbitia
1004 36 1003 152 readchar
1031 348 1031 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1032 278 1032 340 940411 222636 skrivtegn
1033 384 1033 340 940411 222639 afsluttext
1034 394 1034 340 940411 222952 læsbiti
1035 498 1035 340 960610 222201 systid
1037 28 1037 340 getnumber
1037 18 1037 340 900925 171358 putnumber
1 656 0 0 errorbits
1044 60 1044 342 940411 222943 sætbiti
1045 354 1045 342 940411 222801 openbs
1047 228 1047 342 940411 222742 hægttekst
1029 54 1029 340 outrec6
0 1704 0 0 alarmcause
1048 332 1048 342 940411 222745 hægtstring
1049 254 1049 342 940411 222749 anbringtal
1003 288 1003 152 repeatchar
1050 444 1050 342 940411 223002 intg
1051 350 1051 342 940411 222739 binærsøg
1020 20 1020 340 sgn
1052 380 1052 342 940411 222646 skrivtext
1029 56 1029 340 swoprec6
1056 56 1053 342 passivate
1053 40 1053 342 890821 163947 activity
1058 78 1058 350 260479 150000 mon
1 1043 1058 350 monw2
1 1039 1058 350 monw0
1 1041 1058 350 monw1
1055 56 1053 342 activate
0 1588 0 0 endaction
1058 320 1058 350 reflectcore
1054 50 1053 342 newactivity
1059 372 1059 358 940327 154135 setcspterm
1061 428 1061 358 941030 233200 slices
1065 52 1065 358 890821 163933 lock
1065 258 1065 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1066 162 1066 358 940411 222622 fpparam
1 1049 1067 358 nl
1 1047 1067 358 220978 131500 bel
1068 330 1068 446 940411 222722 ud
1069 252 1069 446 940411 222656 taltekst
1 1045 1058 350 monw3
986 296 986 12 getshare6
986 398 986 12 setshare6
70 480 1072 446 0
algol end 1072
*if ok.no
*if warning.yes
*o c
▶EOF◀