|
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: 991488 (0xf2100)
Types: TextFile
Names: »buskomudx05 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomudx05 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.16018465.2352
0 1 begin algol list.off;
1 2
1 2 <* variables for claiming (accumulating) basic entities *>
1 3 integer maxsem, maxsemch, maxop, maxcoru, maxmessext, maxprocext, maxnettoop;
1 4
1 4 <* fields defining current position in pools af basic entities
1 5 during initialization *>
1 6 integer array field firstsem, firstsim, firstcoru, firstop, optop;
1 7
1 7 <* variables used as pointers to 'current object' (work variables) *>
1 8 integer messext, procext, timeinterval, testbuffering;
1 9 integer array field timermessage, coru, sem, op, receiver, currevent,
1 10 baseevent, prevevent;
1 11
1 11 <* variables defining the size of basic entities (descriptors) *>
1 12 integer corusize, semsize, simsize, opheadsize;
1 13 integer array clockmess(1:2);
1 14 real array clock(1:3);
1 15 boolean eventqueueempty;
1 16 algol list.on;
1 17
1 17 \f
1 17 message sys_parametererklæringer side 1 - 810127/cl;
1 18
1 18 boolean testbit0 ,testbit1 ,testbit2 ,testbit3 ,testbit4 ,testbit5 ,
1 19 testbit6 ,testbit7 ,testbit8 ,testbit9 ,testbit10,testbit11,
1 20 testbit12,testbit13,testbit14,testbit15,testbit16,testbit17,
1 21 testbit18,testbit19,testbit20,testbit21,testbit22,testbit23,
1 22 testbit24,testbit25,testbit26,testbit27,testbit28,testbit29,
1 23 testbit30,testbit31,testbit32,testbit33,testbit34,testbit35,
1 24 testbit36,testbit37,testbit38,testbit39,testbit40,testbit41,
1 25 testbit42,testbit43,testbit44,testbit45,testbit46,testbit47;
1 26 boolean cl_overvåget,out_tw_lp,
1 27 cm_test;
1 28
1 28 integer låsning;
1 29 \f
1 29 message sys_parametererklæringer side 2 - 810310.hko;
1 30
1 30 <* hjælpevariable *>
1 31
1 31 integer i,j,k;
1 32 integer array ia(1:32);
1 33 integer array field iaf,ref;
1 34
1 34 real r;
1 35 real array ra(1:3);
1 36 real array field raf;
1 37 real field rf;
1 38
1 38 long array la(1:2);
1 39 long array field laf;
1 40
1 40 procedure ud;
1 41 begin
2 42 <*
2 43 outchar(out,'nl');
2 44 if out_tw_lp then setposition(out,0,0);
2 45 *>
2 46 flushout('nl');
2 47 end;
1 48 \f
1 48 message sys_parametererklæringer side 3 - 810310/hko;
1 49
1 49 <* hovedmodul_parametre *>
1 50
1 50 integer
1 51 sys_mod,
1 52 io_mod,
1 53 op_mod,
1 54 gar_mod,
1 55 rad_mod,
1 56 vt_mod;
1 57
1 57 <* operations_parametre *>
1 58
1 58 integer field
1 59 kilde,
1 60 retur,
1 61 resultat,
1 62 opkode;
1 63
1 63 real field
1 64 tid;
1 65
1 65 integer array field
1 66 data;
1 67
1 67 boolean
1 68 sys_optype,
1 69 io_optype,
1 70 op_optype,
1 71 gar_optype,
1 72 rad_optype,
1 73 vt_optype,
1 74 gen_optype;
1 75 \f
1 75 message sys_parametererklæringer side 4 - 820301/hko,cl;
1 76
1 76 <* trimme-variable *>
1 77
1 77 integer
1 78 max_antal_operatører,
1 79 max_antal_taleveje,
1 80 max_antal_garageterminaler,
1 81 max_antal_garager,
1 82 max_antal_områder,
1 83 max_antal_radiokanaler,
1 84 max_antal_pabx,
1 85 max_antal_kanaler,
1 86 max_antal_mobilopkald,
1 87 min_antal_nødopkald,
1 88 max_antal_grupper,
1 89 max_antal_gruppeopkald,
1 90 max_antal_spring,
1 91 max_antal_busser,
1 92 max_antal_linie_løb,
1 93 max_antal_fejltekster,
1 94 max_linienr,
1 95 op_maske_lgd,
1 96 tv_maske_lgd;
1 97
1 97 integer array
1 98 konsol_navn,
1 99 taleswitch_in_navn,
1 100 taleswitch_out_navn,
1 101 radio_fr_navn,
1 102 radio_rf_navn(1:4),
1 103 alfabet(0:255);
1 104
1 104 integer
1 105 tf_systællere,
1 106 tf_stoptabel,
1 107 tf_bplnavne,
1 108 tf_bpldef,
1 109 tf_alarmlgd;
1 110 \f
1 110 message filparm side 1 - 800529/jg/cl;
1 111
1 111 integer
1 112 fil_op_længde,
1 113 dbantez,dbantsz,dbanttz,
1 114 dbmaxtf, dbmaxsf, dbblokt,
1 115 dbmaxb,dbbidlængde,dbbidmax,
1 116 dbmaxef;
1 117 long array
1 118 dbsnavn, dbtnavn(1:2);
1 119
1 119 message attention parametererklæringer side 1 - 810318/hko;
1 120
1 120 integer
1 121 att_op_længde,
1 122 att_maske_lgd,
1 123 terminal_beskr_længde;
1 124 integer field
1 125 terminal_tilstand,
1 126 terminal_suppl;
1 127
1 127 message io_parametererklæringer side 1 - 820301/hko;
1 128
1 128 message operatør_parametererklæringer side 1 - 810422/hko;
1 129
1 129 integer field
1 130 cqf_bus, cqf_fejl,
1 131 alarm_kmdo, alarm_tilst, alarm_gtilst, alarm_lgd;
1 132 real field
1 133 cqf_ok_tid, cqf_næste_tid,
1 134 alarm_start;
1 135 long field
1 136 cqf_id;
1 137
1 137 integer
1 138 max_cqf, cqf_lgd,
1 139 op_spool_postlgd,
1 140 op_spool_postantal,
1 141 opk_alarm_tab_lgd;
1 142
1 142
1 142 \f
1 142 message procedure radio_parametererklæringer side 1 - 810524/hko;
1 143
1 143 integer
1 144 radio_giveup,
1 145 opkaldskø_postlængde,
1 146 kanal_beskr_længde,
1 147 radio_op_længde,
1 148 radio_pulje_størrelse;
1 149
1 149
1 149 \f
1 149 message vogntabel parametererklæringer side 1 - 810309/cl;
1 150
1 150 integer vt_op_længde, vt_logskift;
1 151 boolean vt_log_aktiv;
1 152
1 152 \f
1 152
1 152 algol list.off;
1 153 message coroutinemonitor - 2 ;
1 154
1 154 maxsem:= maxsemch:= maxop:= maxcoru:= maxnettoop:= 0;
1 155 maxmessext:= maxprocext:= 1;
1 156 corusize:= 20;
1 157 simsize:= 6;
1 158 semsize:= 8;
1 159 opheadsize:= 8;
1 160 testbuffering:= 1;
1 161 timeinterval:= 5;
1 162 algol list.on;
1 163 algol list.on;
1 164
1 164 \f
1 164 message sys_parameterinitialisering side 1 - 810305/hko;
1 165
1 165 copyout;
1 166
1 166 cl_overvåget:= false;
1 167 getzone6(out,ia);
1 168 out_tw_lp:= ia(1) extract 12 = 8 or ia(1) extract 12 = 14;
1 169
1 169 testbit0 :=testbit( 0);
1 170 testbit1 :=testbit( 1);
1 171 testbit2 :=testbit( 2);
1 172 testbit3 :=testbit( 3);
1 173 testbit4 :=testbit( 4);
1 174 testbit5 :=testbit( 5);
1 175 testbit6 :=testbit( 6);
1 176 testbit7 :=testbit( 7);
1 177 testbit8 :=testbit( 8);
1 178 testbit9 :=testbit( 9);
1 179 testbit10:=testbit(10);
1 180 testbit11:=testbit(11);
1 181 testbit12:=testbit(12);
1 182 testbit13:=testbit(13);
1 183 testbit14:=testbit(14);
1 184 testbit15:=testbit(15);
1 185 testbit16:=testbit(16);
1 186 testbit17:=testbit(17);
1 187 testbit18:=testbit(18);
1 188 testbit19:=testbit(19);
1 189 testbit20:=testbit(20);
1 190 testbit21:=testbit(21);
1 191 testbit22:=testbit(22);
1 192 testbit23:=testbit(23);
1 193 \f
1 193 message sys_parameterinitialisering side 2 - 810316/cl;
1 194
1 194 testbit24:=testbit(24);
1 195 testbit25:=testbit(25);
1 196 testbit26:=testbit(26);
1 197 testbit27:=testbit(27);
1 198 testbit28:=testbit(28);
1 199 testbit29:=testbit(29);
1 200 testbit30:=testbit(30);
1 201 testbit31:=testbit(31);
1 202 testbit32:=testbit(32);
1 203 testbit33:=testbit(33);
1 204 testbit34:=testbit(34);
1 205 testbit35:=testbit(35);
1 206 testbit36:=testbit(36);
1 207 testbit37:=testbit(37);
1 208 testbit38:=testbit(38);
1 209 testbit39:=testbit(39);
1 210 testbit40:=testbit(40);
1 211 testbit41:=testbit(41);
1 212 testbit42:=testbit(42);
1 213 testbit43:=testbit(43);
1 214 testbit44:=testbit(44);
1 215 testbit45:=testbit(45);
1 216 testbit46:=testbit(46);
1 217 testbit47:=testbit(47);
1 218 cm_test:= false;
1 219 \f
1 219 message sys_parameterinitialisering side 3 - 810409/cl,hko;
1 220
1 220 timeinterval:=1; <* tidsinterval for cmon's timeoutinspection *>
1 221
1 221 if findfpparam(<:låsning:>,true,ia) > 0 then låsning:= ia(1)
1 222 else låsning:= 0;
1 223 \f
1 223 message sys_parameterinitialisering side 4 - 820301/hko/cl;
1 224
1 224 <* initialisering af hovedmodul_parametre *>
1 225
1 225 i:=0; sys_mod:=i;
1 226 i:=i+1; io_mod:=i;
1 227 i:=i+1; op_mod:=i;
1 228 i:=i+1; gar_mod:=i;
1 229 i:=i+1; rad_mod:=i;
1 230 i:=i+1; vt_mod:=i;
1 231
1 231 <* initialisering af operationstyper *>
1 232
1 232 sys_optype:=false add (1 shift sys_mod);
1 233 io_optype:= false add (1 shift io_mod);
1 234 op_optype:= false add (1 shift op_mod);
1 235 gar_optype:=false add (1 shift gar_mod);
1 236 rad_optype:=false add (1 shift rad_mod);
1 237 vt_optype:= false add (1 shift vt_mod);
1 238 gen_optype:=false add (1 shift 11);
1 239
1 239 <* initialisering af fieldvariable for operationer *>
1 240
1 240 i:=2; kilde:=i;
1 241 i:=i+4; tid:=i;
1 242 i:=i+2; retur:=i;
1 243 i:=i+2; opkode:=i;
1 244 i:=i+2; resultat:=i;
1 245 i:=i+0; data:=i;
1 246
1 246 <* initialisering af trimme-variable *>
1 247
1 247 max_antal_operatører:=28; <* hvis > 32 skal tf_systællere udvides *>
1 248 max_antal_taleveje:=12;
1 249 max_antal_garageterminaler:=3;
1 250 max_antal_garager:=99;
1 251 max_antal_radiokanaler:=16;
1 252 max_antal_pabx:=2;
1 253 max_antal_kanaler:=14; <* 1 pabx + 13 radio *>
1 254 max_antal_områder:=11; <* hvis > 16 skal tf_systællere udvides *>
1 255 max_antal_mobilopkald:=100;
1 256 min_antal_nødopkald:=20;
1 257 max_antal_grupper:=16;
1 258 max_antal_gruppeopkald:=16;
1 259 max_antal_spring:=16;
1 260 max_antal_busser:=2000;
1 261 max_antal_linie_løb:=2000;
1 262 max_antal_fejltekster:=21;
1 263 max_linienr:=999; <*<=999*>
1 264
1 264 op_maske_lgd:= ((1+max_antal_operatører+23)//24)*2;
1 265 tv_maske_lgd:= ((1+max_antal_taleveje+23)//24)*2;
1 266 \f
1 266 message sys_parameterinitialisering side 5 - 880901/cl;
1 267
1 267 <* initialisering af konsol-navn *>
1 268 raf:= 0;
1 269 if findfpparam(<:io:>,false,ia)>0 then
1 270 begin
2 271 for i:= 1 step 1 until 4 do konsol_navn(i):= ia(i);
2 272 end
1 273 else
1 274 system(7,0,konsol_navn);
1 275 <*
1 276 movestring(konsol_navn.raf,1,<:console1:>);
1 277 *>
1 278
1 278 raf:= 0;
1 279
1 279 <* intialiserning af talevejsswitchens navn *>
1 280
1 280 movestring(taleswitch_in_navn.raf,1,<:taleswitchi:>);
1 281 movestring(taleswitch_out_navn.raf,1,<:taleswitch:>);
1 282
1 282 <* initialisering af radiokanalnavne *>
1 283
1 283 movestring(radio_fr_navn.raf,1,<:radiofr:>);
1 284 movestring(radio_rf_navn.raf,1,<:radiorf:>);
1 285
1 285 <* initialisering af 'input'-alfabet *>
1 286
1 286 isotable(alfabet);
1 287 alfabet('esc'):= 8 shift 12 + 'esc';
1 288 <* for i:='a' step 1 until 'å' do alfabet(i):=alfabet(i)-32; *>
1 289 for i:= 128 step 1 until 255 do alfabet(i):= 0 shift 12 + i;
1 290 intable(alfabet);
1 291
1 291 <* initialsering af tf_systællere *>
1 292
1 292 tf_systællere:= 1024<*tabelfil*> + 8;
1 293 tf_stoptabel := 1024<*tabelfil*> + 5;
1 294 tf_bpl_navne := 1024<*tabelfil*> + 12;
1 295 tf_bpl_def := 1024<*tabelfil*> + 13;
1 296 tf_alarmlgd := 1024<*tabelfil*> + 14;
1 297
1 297 \f
1 297 message filparminit side 1 - 801030/jg;
1 298
1 298 fil_op_længde:= data + 18 <*halvord*>;
1 299
1 299
1 299 dbantez:= 1;
1 300 dbantsz:= 2;
1 301 dbanttz:= 3; <* >=2 aht. samtidig tilgang*>
1 302 dbblokt:= 8;
1 303 dbmaxsf:= 7;
1 304 dbbidlængde:= 3;
1 305 dbbidmax:= 5;
1 306 dbmaxb:= dbmaxsf * dbbidmax;
1 307 dbmaxef:= 12;
1 308 movestring(dbsnavn,1,<:spoolfil:>);
1 309 movestring(dbtnavn,1,<:tabelfil:>);
1 310 if findfpparam(<:tabelfil:>,false,ia)>0 then
1 311 tofrom(dbtnavn,ia,8);
1 312 \f
1 312 message filparminit side 2 - 801030/jg;
1 313
1 313
1 313 <* reserver og check spoolfil og tabelfil *>
1 314 begin integer s,i,funk,f;
2 315 zone z(128,1,stderror); integer array tail(1:10);
2 316
2 316 for f:=1,2 do
2 317 begin
3 318 <*open(z,4,string (case f of(dbsnavn,dbtnavn)),0);*>
3 319 case f of
3 320 begin
4 321 open(z,4,dbsnavn,0);
4 322 open(z,4,dbtnavn,0);
4 323 end;
3 324 for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do
3 325 begin
4 326 s:=monitor(funk,z,i,tail);
4 327 if s<>0 then system(9,funk*100+s,
4 328 case f of(<:<10>spoolfil:>,<:<10>tabelfil:>));
4 329 end;
3 330 case f of begin
4 331 begin integer antseg; <*spoolfil*>
5 332 antseg:=dbmaxb * dbbidlængde;
5 333 if tail(1) < antseg then
5 334 begin
6 335 tail(1):=antseg;
6 336 s:=monitor(44<*change*>,z,i,tail);
6 337 if s<>0 then
6 338 system(9,44*100+s,<:<10>spoolfil:>);
6 339 end;
5 340 end;
4 341 begin <*tabelfil*>
5 342 dbmaxtf:=tail(10);
5 343 if dbmaxtf<1 or dbmaxtf>1023 then
5 344 system(9,dbmaxtf,<:<10>tabelfil:>);
5 345 end
4 346 end case;
3 347 close(z,false);
3 348 end for;
2 349 end;
1 350 \f
1 350 message attention parameterinitialisering side 1 - 810318/hko;
1 351
1 351 att_op_længde:= 40;
1 352 att_maske_lgd:=
1 353 (1+max_antal_operatører+max_antal_garageterminaler+1+23)//24*2;
1 354 terminal_beskr_længde:=6;
1 355 terminal_tilstand:= 2;
1 356 terminal_suppl:=4;
1 357
1 357 message io_parameterinitialisering side 1 - 810421/hko;
1 358
1 358
1 358 message operatør_parameterinitialisering side 1 - 810422/hko;
1 359
1 359 <* felter i cqf_tabel *>
1 360 cqf_lgd:=
1 361 cqf_næste_tid:= 16;
1 362 cqf_ok_tid := 12;
1 363 cqf_id := 8;
1 364 cqf_fejl := 4;
1 365 cqf_bus := 2;
1 366
1 366 max_cqf:= 64;
1 367
1 367 <* felter i opkaldsalarmtabel *>
1 368 alarm_kmdo := 2;
1 369 alarm_tilst := 4;
1 370 alarm_gtilst:= 6;
1 371 alarm_lgd := 8;
1 372 alarm_start := 12;
1 373
1 373 opk_alarm_tab_lgd:= 12;
1 374 op_spool_postantal:= 16;
1 375 op_spool_postlgd:= 64;
1 376
1 376
1 376 \f
1 376 message procedure radio_parameterinitialisering side 1 - 810601/hko;
1 377
1 377 radio_giveup:= 1 shift 21 + 1 shift 9;
1 378 opkaldskø_postlængde:= 10+op_maske_lgd;
1 379 kanal_beskr_længde:= 12+op_maske_lgd+tv_maske_lgd;
1 380 radio_op_længde:= 30*2;
1 381 radio_pulje_størrelse:= 1+max_antal_taleveje;
1 382
1 382 \f
1 382 message vogntabel parameterinitialisering side 1 - 810309/cl;
1 383
1 383 vt_op_længde:= data + 16; <* halvord *>
1 384
1 384 if findfpparam(<:vtlogskift:>,true,ia) > 0 then
1 385 vt_logskift:= ia(1) else vt_logskift:= -1;
1 386
1 386 vt_log_aktiv:= (vt_logskift >= 0) and (vt_logskift < 240000);
1 387
1 387
1 387 \f
1 387 message filclaim, side 1 - 810202/cl;
1 388
1 388 maxcoru:= maxcoru+6;
1 389 maxsem:= maxsem+2;
1 390 maxsemch:= maxsemch+6;
1 391 \f
1 391 message attention_claiming side 1 - 810318/hko;
1 392
1 392
1 392 maxcoru:=maxcoru+1;
1 393
1 393 max_op:=max_op +1
1 394 +max_antal_operatører
1 395 +max_antal_garageterminaler;
1 396
1 396 max_nettoop:=maxnettoop+(data+att_op_længde)
1 397 *(1+max_antal_operatører
1 398 +max_antal_garageterminaler);
1 399
1 399 max_procext:=max_procext+1;
1 400
1 400 max_sem:= max_sem+1;
1 401
1 401 max_semch:=maxsemch+1;
1 402
1 402
1 402 \f
1 402 message io_claiming side 1 - 810421/hko;
1 403
1 403 max_coru:= max_coru
1 404 + 1 <* hovedmodul io *>
1 405 + 1 <* io kommando *>
1 406 + 1 <* io operatørmeddelelser *>
1 407 + 1 <* io spontane meddelelser *>
1 408 + 1 <* io spoolkorutine *>
1 409 + 1 <* io tællernulstilling *>
1 410 ;
1 411
1 411 max_semch:= max_semch
1 412 + 1 <* cs_io *>
1 413 + 1 <* cs_io_komm *>
1 414 + 1 <* cs_io_fil *>
1 415 + 1 <* cs_io_medd *>
1 416 + 1 <* cs_io_spool *>
1 417 + 1 <* cs_io_nulstil *>
1 418 ;
1 419
1 419 max_sem:= max_sem
1 420 + 1 <* ss_io_spool_fulde *>
1 421 + 1 <* ss_io_spool_tomme *>
1 422 + 1; <* bs_zio_adgang *>
1 423
1 423 max_op:=max_op
1 424 + 1; <* fil-operation *>
1 425
1 425 max_nettoop:=max_nettoop
1 426 + (data+18); <* fil-operation *>
1 427
1 427 \f
1 427 message operatør_claiming side 1 - 810520/hko;
1 428
1 428 max_coru:= max_coru +1 <* h_op *>
1 429 +1 <* alarmur *>
1 430 +1 <* opkaldsalarmer *>
1 431 +1 <* talevejsswitch *>
1 432 +1 <* tv_switch_adm *>
1 433 +1 <* tv_switch_input *>
1 434 +1 <* op_spool *>
1 435 +1 <* op_medd *>
1 436 +1 <* op_cqftest *>
1 437 +max_antal_operatører;
1 438
1 438 max_sem:= 1 <* bs_opk_alarm *>
1 439 +1 <* ss_op_spool_tomme *>
1 440 +1 <* ss_op_spool_fulde *>
1 441 +max_sem;
1 442
1 442 max_semch:= max_semch +1 <* cs_op *>
1 443 +1 <* cs_op_retur *>
1 444 +1 <* cs_opk_alarm_ur *>
1 445 +1 <* cs_opk_alarm_ur_ret *>
1 446 +1 <* cs_opk_alarm *>
1 447 +1 <* cs_talevejsswitch *>
1 448 +1 <* cs_tv_switch_adm *>
1 449 +1 <* cs_tvswitch_adgang *>
1 450 +1 <* cs_tvswitch_input *>
1 451 +1 <* cs_op_iomedd *>
1 452 +1 <* cs_op_spool *>
1 453 +1 <* cs_op_medd *>
1 454 +1 <* cs_cqf *>
1 455 +max_antal_operatører<* cs_operatør *>
1 456 +max_antal_operatører<* cs_op_fil *>;
1 457
1 457 max_op:= max_op + 1 <* talevejsoperation *>
1 458 + 2 <* tv_switch_input *>
1 459 + 1 <* op_iomedd *>
1 460 + 1 <* opk_alarm_ur *>
1 461 + 1 <* op_spool_medd *>
1 462 + 1 <* op_cqftest *>
1 463 + max_antal_operatører;
1 464
1 464 max_netto_op:= filoplængde*max_antal_operatører
1 465 + data+128 <* talevejsoperation *>
1 466 + 2*(data+256) <* tv_switch_input *>
1 467 + 60 <* op_iomedd *>
1 468 + data <* opk_alarm_ur *>
1 469 + data+op_spool_postlgd <* op_spool_med *>
1 470 + 60 <* op_cqftest *>
1 471 + max_netto_op;
1 472
1 472 \f
1 472 message garage_claiming side 1 -810226/hko;
1 473
1 473 max_coru:= max_coru +1
1 474 +max_antal_garageterminaler;
1 475
1 475 max_semch:= max_semch +1
1 476 +max_antal_garageterminaler;
1 477
1 477 \f
1 477 message procedure radio_claiming side 1 - 810526/hko;
1 478
1 478 max_coru:= max_coru
1 479 +1 <* hovedmodul radio *>
1 480 +1 <* opkaldskø_meddelelse *>
1 481 +1 <* radio_adm *>
1 482 +max_antal_taleveje <* radio *>
1 483 +2; <* radio ind/-ud*>
1 484
1 484 max_semch:= max_semch
1 485 +1 <* cs_rad *>
1 486 +max_antal_taleveje <* cs_radio *>
1 487 +1 <* cs_radio_pulje *>
1 488 +1 <* cs_radio_kø *>
1 489 +1 <* cs_radio_medd *>
1 490 +1 <* cs_radio_adm *>
1 491 +2 ; <* cs_radio_ind/-ud *>
1 492
1 492 max_sem:=
1 493 +1 <* bs_mobil_opkald *>
1 494 +1 <* bs_opkaldskø_adgang *>
1 495 +max_antal_kanaler <* ss_radio_aktiver *>
1 496 +max_antal_kanaler <* ss_samtale_nedlagt *>
1 497 +max_antal_taleveje <* bs_talevej_udkoblet *>
1 498 +max_sem;
1 499
1 499 max_op:=
1 500 + radio_pulje_størrelse <* radio_pulje_operationer *>
1 501 + 1 <* radio_medd *>
1 502 + 1 <* radio_adm *>
1 503 + max_antal_taleveje <* operationer for radio *>
1 504 + 2 <* operationer for radio_ind/-ud *>
1 505 + max_op;
1 506
1 506 max_netto_op:=
1 507 + radio_pulje_størrelse * 60 <* radio_pulje_operationer *>
1 508 + data + 6 <* radio_medd *>
1 509 + max_antal_taleveje <* operationer for radio *>
1 510 * (data + radio_op_længde)
1 511 + data + radio_op_længde <* operation for radio_adm *>
1 512 + 2*(data + 64) <* operationer for radio_ind/-ud *>
1 513 + max_netto_op;
1 514 \f
1 514 message vogntabel_claiming side 1 - 810413/cl;
1 515
1 515 maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
1 516 + 1 <* coroutine vt_opdater *>
1 517 + 1 <* coroutine vt_tilstand *>
1 518 + 1 <* coroutine vt_rapport *>
1 519 + 1 <* coroutine vt_gruppe *>
1 520 + 1 <* coroutine vt_spring *>
1 521 + 1 <* coroutine vt_auto *>
1 522 + 1 <* coroutine vt_log *>
1 523 + maxcoru;
1 524
1 524 maxsemch:= 1 <* cs_vt *>
1 525 + 1 <* cs_vt_adgang *>
1 526 + 1 <* cs_vt_logpool *>
1 527 + 1 <* cs_vt_opd *>
1 528 + 1 <* cs_vt_rap *>
1 529 + 1 <* cs_vt_tilst *>
1 530 + 1 <* cs_vtt_auto *>
1 531 + 1 <* cs_vt_grp *>
1 532 + 1 <* cs_vt_spring *>
1 533 + 1 <* cs_vt_log *>
1 534 + 5 <* cs_vt_filretur(coru) *>
1 535 + maxsemch;
1 536
1 536 maxop:= 1 <* vt_op *>
1 537 + 2 <* vt_log_op *>
1 538 + 6 <* vt_fil_op + radop *>
1 539 + maxop;
1 540
1 540 maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
1 541 + 5*fil_op_længde
1 542 + (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
1 543 + maxnettoop;
1 544
1 544 \f
1 544
1 544 algol list.off;
1 545 message coroutinemonitor - 3 ;
1 546
1 546 begin
2 547
2 547 <* work variables - primarily used during initialization *>
2 548 integer array field simref, semref, coruref, opref;
2 549 integer proccount, corucount, messcount, cmi, cmj;
2 550 integer array zoneia(1:20);
2 551
2 551 <* field variables describing the format of basic entities *>
2 552 integer field
2 553 <* chain head *>
2 554 next, prev,
2 555 <* simple semaphore *>
2 556 simvalue, simcoru,
2 557 <* chained semaphore *>
2 558 semop, semcoru,
2 559 <* coroutine *>
2 560 coruop, corutimerchain, corutimer, corupriority, coruident,
2 561 <* operation head *>
2 562 opnext, opsize;
2 563
2 563 \f
2 563
2 563 message coroutinemonitor - 4 ;
2 564
2 564 boolean field
2 565 corutypeset, corutestmask, optype;
2 566 real starttime;
2 567 long corustate;
2 568
2 568 <* field variables used as queue identifiers (addresses) *>
2 569 integer array field current, readyqueue, idlequeue, timerqueue;
2 570
2 570 <* extensions (message- and process- extensions) *>
2 571 integer array messref, messcode, messop (1:maxmessext);
2 572 integer array procref, proccode, procop (1:maxprocext);
2 573
2 573 <* core array used for accessing the core using addresses as field
2 574 variables (as delivered by the monitor functions)
2 575 - descriptor array 'd' in which all basic entities are allocated
2 576 (except for extensions) *>
2 577 integer array core (1:1), d (1:(4 <* readyqueue *> +
2 578 4 <* idlequeue *> +
2 579 4 <* timerqueue *> +
2 580 maxcoru * corusize +
2 581 maxsem * simsize +
2 582 maxsemch * semsize +
2 583 maxop * opheadsize +
2 584 maxnettoop)/2);
2 585 \f
2 585
2 585 message coroutinemonitor - 5 ;
2 586
2 586
2 586
2 586 <*************** initialization procedures ***************>
2 587
2 587
2 587
2 587 procedure initchain (chainref);
2 588 value chainref;
2 589 integer array field chainref;
2 590 begin
3 591 integer array field cref;
3 592 cref:= chainref;
3 593 d.cref.next:= d.cref.prev:= cref;
3 594 end;
2 595 \f
2 595
2 595 message coroutinemonitor - 6 ;
2 596
2 596
2 596 <***** nextsem *****
2 597
2 597 this procedure allocates and initializes the next simple semaphore in the
2 598 pool of claimed semaphores.
2 599 the procedure returns the identification (the address) of the semaphore to
2 600 be used when calling 'signal', 'wait' and 'inspect'. *>
2 601
2 601 integer procedure nextsem;
2 602 begin
3 603 nextsem:= simref;
3 604 if simref >= firstsem then initerror(1, true);
3 605 initchain(simref + simcoru);
3 606 d.simref.simvalue:= 0;
3 607 simref:= simref + simsize;
3 608 end;
2 609
2 609
2 609 <***** nextsemch *****
2 610
2 610 this procedure allocates and initializes the next simple semaphore in the
2 611 pool of claimed semaphores.
2 612 the procedure returns the identification (the address) of the semaphore to
2 613 be used when calling 'signalch', 'waitch' and 'inspectch'. *>
2 614
2 614 integer procedure nextsemch;
2 615 begin
3 616 nextsemch:= semref;
3 617 if semref >= firstop-4 then initerror(2, true);
3 618 initchain(semref + semcoru);
3 619 initchain(semref + semop);
3 620 semref:= semref + semsize;
3 621 end;
2 622 \f
2 622
2 622 message coroutinemonitor - 7 ;
2 623
2 623
2 623 <***** nextcoru *****
2 624
2 624 this procedure initializes the next coroutine description in the pool of
2 625 claimed coroutine descriptions.
2 626 at initialization is defined the priority (an integer value), an identi-
2 627 fication (an integer value 0..8000) and a test pattern (a boolean). *>
2 628
2 628 integer procedure nextcoru(ident, priority, testmask);
2 629 value ident, priority, testmask;
2 630 integer ident, priority;
2 631 boolean testmask;
2 632 begin
3 633 corucount:= corucount + 1;
3 634 if corucount > maxcoru then initerror(3, true);
3 635 nextcoru:= corucount;
3 636 initchain(coruref + next);
3 637 initchain(coruref + corutimerchain);
3 638 initchain(coruref + coruop);
3 639 d.coruref.corupriority:= priority;
3 640 d.coruref.coruident:= ident * 1000 + corucount;
3 641 d.coruref.corutypeset:= false;
3 642 d.coruref.corutimer:= 0;
3 643 d.coruref.corutestmask:= testmask;
3 644 linkprio(coruref, readyqueue);
3 645 current:= coruref;
3 646 coruref:= coruref + corusize;
3 647 end;
2 648 \f
2 648
2 648 message coroutinemonitor - 8 ;
2 649
2 649
2 649 <***** nextop *****
2 650
2 650 this procedure initializes the next operation in the pool of claimed ope-
2 651 rations (heads and buffers).
2 652 the head is allocated and immediately following the head is allocated 'size'
2 653 halfwords forming the operation buffer.
2 654 the procedure returns an identification of the operation (an address) and
2 655 in case this address is held in a field variable 'op', the buffer area may
2 656 be accessed as: d.op(1), d.op(2), d.op(3) ... *>
2 657
2 657 integer procedure nextop (size);
2 658 value size;
2 659 integer size;
2 660 begin
3 661 nextop:= opref;
3 662 if opref >= optop then initerror(4, true);
3 663 initchain(opref + next);
3 664 d.opref.opsize:= size;
3 665 opref:= opref + size + opheadsize;
3 666 end;
2 667 \f
2 667
2 667 message coroutinemonitor - 9 ;
2 668
2 668
2 668 <***** nextprocext *****
2 669
2 669 this procedure initializes the next process extension in the series of
2 670 claimed process extensions.
2 671 the process description address is put into the process extension and the
2 672 state of the extension is initialized to be closed. *>
2 673
2 673 integer procedure nextprocext (processref);
2 674 value processref;
2 675 integer processref;
2 676 begin
3 677 proccount:= proccount + 1;
3 678 if proccount >= maxprocext then initerror(5, true);
3 679 nextprocext:= proccount;
3 680 procref(proccount):= processref;
3 681 proccode(proccount):= 1 shift 12;
3 682 end;
2 683 \f
2 683
2 683 message coroutinemonitor - 10 ;
2 684
2 684
2 684 <***** initerror *****
2 685
2 685 this procedure is activated in case the initialized set of resources does
2 686 not match the claimed set.
2 687 in case more resources are claimed than used, a warning is written,
2 688 in case too few resources are claimed, an error message is written and
2 689 the execution is terminated. *>
2 690
2 690 procedure initerror (resource, exceeded);
2 691 value resource, exceeded;
2 692 integer resource; boolean exceeded;
2 693 begin
3 694 write(out, false add 10, 1,
3 695 if exceeded then <:more :> else <:less :>,
3 696 case resource of (
3 697 <:simple semaphores:>,
3 698 <:chained semaphores:>,
3 699 <:coroutines:>,
3 700 <:operations:>,
3 701 <:process extensions:>),
3 702 <: initialized than claimed:>,
3 703 false add 10, 1);
3 704 if exceeded then goto dump;
3 705 end;
2 706
2 706
2 706 <***** stackclaim *****
2 707
2 707 this procedure is used by a coroutine from its first activation to it
2 708 arrives its first waiting point. the procedure is used to claim an addi-
2 709 tional amount of stack space. this must be done because the maximum
2 710 stack space for a coroutine is set to be the max amount used during its
2 711 very first activation. *>
2 712
2 712
2 712 procedure stackclaim (size);
2 713 value size; integer size;
2 714 begin
3 715 boolean array stackspace (1:size);
3 716 end;
2 717 algol list.on;
2 718
2 718 \f
2 718 message sys_erklæringer side 1 - 810406/cl,hko;
2 719
2 719 zone
2 720 zdummy(1,1,stderror),
2 721 zrl(128,1,stderror),
2 722 zbillede(128,1,stderror);
2 723
2 723 real array
2 724 fejltekst(1:max_antal_fejltekster);
2 725
2 725 real
2 726 systællere_nulstillet;
2 727
2 727 integer
2 728 nulstil_systællere,
2 729 top_bpl_gruppe;
2 730
2 730 integer array
2 731 ingen_operatører, alle_operatører(1:(op_maske_lgd//2)),
2 732 ingen_taleveje, alle_taleveje(1:(tv_maske_lgd//2)),
2 733 bpl_def(1:(128*(op_maske_lgd//2))),
2 734 bpl_tilst(0:127,1:2),
2 735 operatør_stop(0:max_antal_operatører,0:3),
2 736 område_id(1:max_antal_områder,1:2),
2 737 pabx_id(1:max_antal_pabx),
2 738 radio_id(1:max_antal_radiokanaler),
2 739 kanal_id(1:max_antal_kanaler),
2 740 opkalds_tællere(1:(max_antal_områder*5)), <* maxantal <= 16 *>
2 741 operatør_tællere(1:(max_antal_operatører*5)); <* maxantal <= 32 *>
2 742
2 742 boolean array
2 743 operatør_auto_include(1:max_antal_operatører),
2 744 garage_auto_include(1:max_antal_garageterminaler);
2 745
2 745 long array
2 746 terminal_navn(1:(2*max_antal_operatører)),
2 747 garage_terminal_navn(1:(2*max_antal_garageterminaler)),
2 748 bpl_navn(0:127),
2 749 område_navn(1:max_antal_områder),
2 750 kanal_navn(1:max_antal_kanaler);
2 751 \f
2 751 message procedure findområde side 1 - 880901/cl;
2 752
2 752 integer procedure find_bpl(navn);
2 753 value navn;
2 754 long navn;
2 755 begin
3 756 integer i;
3 757
3 757 find_bpl:= 0;
3 758 for i:= 0 step 1 until 127 do
3 759 if navn = bpl_navn(i) then find_bpl:= i;
3 760 end;
2 761
2 761 integer procedure findområde(omr);
2 762 value omr;
2 763 integer omr;
2 764 begin
3 765 integer i;
3 766
3 766 if omr = '*' shift 16 then findområde:= -1 else
3 767 begin
4 768 findområde:= 0;
4 769 for i:= 1 step 1 until max_antal_områder do
4 770 if (extend omr) shift 24=område_navn(i) then findområde:= i;
4 771 end;
3 772 end;
2 773 \f
2 773 message procedure tæl_opkald side 1 - 880926/cl;
2 774
2 774 procedure opdater_tf_systællere;
2 775 begin
3 776 integer zi;
3 777 integer array field iaf;
3 778 real field rf;
3 779
3 779 disable begin
4 780 skrivfil(tf_systællere,1,zi);
4 781 rf:= iaf:= 4;
4 782 fil(zi).rf:= systællere_nulstillet;
4 783 fil(zi).iaf(1):= nulstil_systællere;
4 784 iaf:= 32;
4 785 tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*10);
4 786 iaf:= 192;
4 787 tofrom(fil(zi).iaf,operatør_tællere,max_antal_operatører*10);
4 788 setposition(fil(zi),0,0);
4 789 end;
3 790 end;
2 791
2 791 procedure tæl_opkald(område,type);
2 792 value område,type;
2 793 integer område,type;
2 794 begin
3 795 increase(opkalds_tællere((område-1)*5+type));
3 796 disable opdater_tf_systællere;
3 797 end;
2 798
2 798 procedure tæl_opkald_pr_operatør(operatør,type);
2 799 value operatør,type;
2 800 integer operatør,type;
2 801 begin
3 802 increase(operatør_tællere((operatør-1)*5+type));
3 803 disable opdater_tf_systællere;
3 804 end;
2 805
2 805 procedure skriv_opkaldstællere(z);
2 806 zone z;
2 807 begin
3 808 integer omr,typ,rpc;
3 809 real r;
3 810
3 810 write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
3 811 <:omr ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 812 for omr:= 1 step 1 until max_antal_områder do
3 813 begin
4 814 write(z,true,6,string område_navn(omr),":",1);
4 815 for typ:= 1 step 1 until 5 do
4 816 write(z,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
4 817 outchar(z,'nl');
4 818 end;
3 819
3 819 write(z,"nl",1,
3 820 <:oper. ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 821 for omr:= 1 step 1 until max_antal_operatører do
3 822 begin
4 823 if bpl_navn(omr)=long<::> then
4 824 write(z,"sp",6-write(z,<:op:>,<<d>,omr),":",1)
4 825 else
4 826 write(z,true,6,string bpl_navn(omr),":",1);
4 827 for typ:= 1 step 1 until 5 do
4 828 write(z,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
4 829 outchar(z,'nl');
4 830 end;
3 831
3 831 rpc:= replace_char(1,':');
3 832 write(z,"nl",1,<:nulstilles :>);
3 833 if nulstil_systællere = (-1) then write(z,<:ikke automatisk:>,"nl",1)
3 834 else write(z,<:automatisk kl. :>,<<zd dd dd>,nulstil_systællere,"nl",1);
3 835 replace_char(1,'.');
3 836 write(z,<:nulstillet d. :>,<<zd dd dd>,
3 837 systime(4,systællere_nulstillet,r)," ",1);
3 838 replace_char(1,':');
3 839 write(z,<<zd dd dd>,r,"nl",1);
3 840 replace_char(1,rpc);
3 841 end;
2 842 \f
2 842 message procedure start_operation side 1 - 810521/hko;
2 843
2 843 procedure start_operation(op_ref,kor,ret_sem,kode);
2 844 value kor,ret_sem,kode;
2 845 integer array field op_ref;
2 846 integer kor,ret_sem,kode;
2 847 <*
2 848 op_ref: kald, reference til operation
2 849
2 849 kor: kald, kilde= hovedmodulnr*100 +løbenr
2 850 = korutineident.
2 851 ret_sem: kald, retursemafor
2 852
2 852 kode: kald, suppl shift 12 + operationskode
2 853
2 853 proceduren initialiserer en operations hoved med
2 854 parameterværdierne samt tidfeltet med aktueltid.
2 855 resultatfelt og datafelter nulstilles.
2 856
2 856 *>
2 857 begin
3 858 integer i;
3 859 d.op_ref.kilde:= kor;
3 860 systime(1,0,d.op_ref.tid);
3 861 d.op_ref.retur:=ret_sem;
3 862 d.op_ref.op_kode:=kode;
3 863 d.op_ref.resultat:=0;
3 864 for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
3 865 d.op_ref.data(i):=0;
3 866 end start_operation;
2 867 \f
2 867 message procedure afslut_operation side 1 - 810331/hko;
2 868
2 868 procedure afslut_operation(op_ref,sem);
2 869 value op_ref,sem;
2 870 integer op_ref,sem;
2 871 begin
3 872 integer array field op;
3 873 op:=op_ref;
3 874 if sem>0 then signal_ch(sem,op,d.op.optype) else
3 875 if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
3 876 ;
3 877 end afslut_operation;
2 878 \f
2 878 message procedure fejlreaktion - side 1 - 810424/cl,hko;
2 879
2 879 procedure fejlreaktion(nr,værdi,str,måde);
2 880 value nr,værdi,måde;
2 881 integer nr,værdi,måde;
2 882 string str;
2 883 begin
3 884 disable begin
4 885 write(out,<:<10>!!! :>);
4 886 if nr>0 and nr <=max_antal_fejltekster then
4 887 write(out,string fejltekst(nr))
4 888 else write(out,<:fejl nr.:>,nr);
4 889 outchar(out,'sp');
4 890 if måde shift (-12) extract 2=1 then
4 891 outintbits(out,værdi)
4 892 else
4 893 if måde shift (-12) extract 2=2 then
4 894 write(out,<:":>,false add værdi,1,<:":>)
4 895 else
4 896 write(out,værdi);
4 897 write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
4 898 <: korutine nr=:>,<<d>, abs curr_coruno,
4 899 <: ident=:>,curr_coruid,"nl",0);
4 900 if testbit27 and måde extract 12=1 then
4 901 trace(1);
4 902 ud;
4 903 end;<*disable*>
3 904 if måde extract 12 =2 then trapmode:=1 shift 13;
3 905 if måde extract 12= 0 then trap(-1)
3 906 else if måde extract 12 = 2 then trap(-2);
3 907 end fejlreaktion;
2 908
2 908 procedure trace(n);
2 909 value n;
2 910 integer n;
2 911 begin
3 912 trap(finis);
3 913 trap(n);
3 914 finis:
3 915 end trace;
2 916 \f
2 916 message procedure overvåget side 1 - 810413/cl;
2 917
2 917 boolean procedure overvåget;
2 918 begin
3 919 disable begin
4 920 integer i,måde;
4 921 integer array field cor;
4 922 integer array ia(1:12);
4 923
4 923 i:= system(12,0,ia);
4 924 if i > 0 then
4 925 begin
5 926 i:= system(12,1,ia);
5 927 måde:= ia(3);
5 928 end
4 929 else måde:= 0;
4 930
4 930 if måde<>0 then
4 931 begin
5 932 cor:= coroutine(abs ia(3));
5 933 overvåget:= d.cor.corutestmask shift (-11);
5 934 end
4 935 else overvåget:= cl_overvåget;
4 936 end;
3 937 end;
2 938 \f
2 938 message procedure antal_bits_ia side 1 - 940424/cl;
2 939
2 939 integer procedure antal_bits_ia(ia,n,ø);
2 940 value n,ø;
2 941 integer array ia;
2 942 integer n,ø;
2 943 begin
3 944 integer i, ant;
3 945
3 945 ant:= 0;
3 946 for i:= n step 1 until ø do
3 947 if læsbit_ia(ia,i) then ant:= ant+1;
3 948 end;
2 949
2 949 message procedure trunk_til_omr side 1 - 881006/cl;
2 950
2 950 integer procedure trunk_til_omr(trunk);
2 951 value trunk; integer trunk;
2 952 begin
3 953 integer i,j;
3 954
3 954 j:=0;
3 955 for i:= 1 step 1 until max_antal_områder do
3 956 if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
3 957 trunk_til_omr:=j;
3 958 end;
2 959
2 959 integer procedure omr_til_trunk(omr);
2 960 value omr; integer omr;
2 961 begin
3 962 omr_til_trunk:= område_id(omr,2) extract 12;
3 963 end;
2 964
2 964 integer procedure port_til_omr(port);
2 965 value port; integer port;
2 966 begin
3 967 if port shift (-6) extract 6 = 2 then
3 968 port_til_omr:= pabx_id(port extract 6)
3 969 else
3 970 if port shift (-6) extract 6 = 3 then
3 971 port_til_omr:= radio_id(port extract 6)
3 972 else
3 973 port_til_omr:= 0;
3 974 end;
2 975
2 975 integer procedure kanal_til_port(kanal);
2 976 value kanal; integer kanal;
2 977 begin
3 978 kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
3 979 kanal_id(kanal) extract 5;
3 980 end;
2 981
2 981 integer procedure port_til_kanal(port);
2 982 value port; integer port;
2 983 begin
3 984 integer i,j;
3 985
3 985 j:=0;
3 986 for i:= 1 step 1 until max_antal_kanaler do
3 987 if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
3 988 port_til_kanal:= j;
3 989 end;
2 990
2 990 integer procedure kanal_til_omr(kanal);
2 991 value kanal; integer kanal;
2 992 begin
3 993 kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
3 994 end;
2 995
2 995 \f
2 995 message procedure out_xxx_bits side 1 - 810406/cl;
2 996
2 996 procedure outboolbits(zud,b);
2 997 value b;
2 998 zone zud;
2 999 boolean b;
2 1000 begin
3 1001 integer i;
3 1002
3 1002 for i:= -11 step 1 until 0 do
3 1003 outchar(zud,if b shift i then '1' else '.');
3 1004 end;
2 1005
2 1005 procedure outintbits(zud,j);
2 1006 value j;
2 1007 zone zud;
2 1008 integer j;
2 1009 begin
3 1010 integer i;
3 1011
3 1011 for i:= -23 step 1 until 0 do
3 1012 begin
4 1013 outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
4 1014 if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
4 1015 end;
3 1016 end;
2 1017
2 1017 procedure outintbits_ia(zud,ia,n,ø);
2 1018 value n,ø;
2 1019 zone zud;
2 1020 integer array ia;
2 1021 integer n,ø;
2 1022 begin
3 1023 integer i;
3 1024
3 1024 for i:= n step 1 until ø do
3 1025 begin
4 1026 outintbits(zud,ia(i));
4 1027 outchar(zud,'nl');
4 1028 end;
3 1029 end;
2 1030
2 1030 real procedure now;
2 1031 begin
3 1032 real f,r,r1; long l;
3 1033
3 1033 systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
3 1034 systime(4,r,r1);
3 1035 now:= r1+f;
3 1036 end;
2 1037 \f
2 1037 message procedure skriv_id side 1 - 820301/cl;
2 1038
2 1038 procedure skriv_id(z,id,lgd);
2 1039 value id,lgd;
2 1040 integer id,lgd;
2 1041 zone z;
2 1042 begin
3 1043 integer type,p,li,lø,bo;
3 1044
3 1044 type:= id shift (-22);
3 1045 case type+1 of
3 1046 begin
4 1047 <* 1: bus *>
4 1048 begin
5 1049 p:= write(z,<<d>,id extract 14);
5 1050 if id shift (-14) <> 0 then
5 1051 p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
5 1052 end;
4 1053
4 1053 <* 2: linie/løb *>
4 1054 begin
5 1055 li:= id shift (-12) extract 10;
5 1056 bo:= id shift (-7) extract 5;
5 1057 if bo<>0 then bo:= bo + 'A' - 1;
5 1058 lø:= id extract 7;
5 1059 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
5 1060 end;
4 1061
4 1061 <* 3: gruppe *>
4 1062 begin
5 1063 if id shift (-21) = 4 <* linie-gruppe *> then
5 1064 begin
6 1065 li:= id shift (-5) extract 10;
6 1066 bo:= id extract 5;
6 1067 if bo<>0 then bo:= bo + 'A' - 1;
6 1068 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
6 1069 end
5 1070 else <* special-gruppe *>
5 1071 p:= write(z,"G",1,<<d>,id extract 7);
5 1072 end;
4 1073
4 1073 <* 4: telefon *>
4 1074 begin
5 1075 bo:= id shift (-20) extract 2;
5 1076 li:= id extract 20;
5 1077 case bo+1 of
5 1078 begin
6 1079 p:= write(z,string kanalnavn(li));
6 1080 p:= write(z,<:K*:>);
6 1081 p:= write(z,<:OMR :>,string områdenavn(li));
6 1082 p:= write(z,<:OMR*:>);
6 1083 end;
5 1084 end;
4 1085 end case;
3 1086 write(z,"sp",lgd-p);
3 1087 end skriv_id;
2 1088 <*+3*>
2 1089 \f
2 1089 message skriv_new_sem side 1 - 810520/cl;
2 1090
2 1090 procedure skriv_new_sem(z,type,ref,navn);
2 1091 value type,ref;
2 1092 zone z;
2 1093 integer type,ref;
2 1094 string navn;
2 1095 <* skriver en identifikation af en semafor 'ref' i zonen z.
2 1096
2 1096 type: 1=binær sem
2 1097 2=simpel sem
2 1098 3=kædet sem
2 1099
2 1099 ref: semaforreference
2 1100
2 1100 navn: semafornavn, max 18 tegn
2 1101 *>
2 1102 begin
3 1103 disable if testbit29 then
3 1104 write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
3 1105 true,5,<<zddd>,ref,true,19,navn);
3 1106 end;
2 1107 \f
2 1107 message procedure skriv_newactivity side 1 - 810520/hko/cl;
2 1108
2 1108 <**> procedure skriv_newactivity(zud,actno,cause);
2 1109 <**> value actno,cause;
2 1110 <**> zone zud;
2 1111 <**> integer actno,cause;
2 1112 <**> begin
3 1113 <*+2*>
3 1114 <**> if testbit28 then
3 1115 <**> begin integer array field cor;
4 1116 <**> cor:= coroutine(actno);
4 1117 <**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
4 1118 <**> << zdd>,d.cor.coruident//1000);
4 1119 <**> end;
3 1120 <**> if -, testbit23 then goto skriv_newact_slut;
3 1121 <*-2*>
3 1122 <**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
3 1123 <**> <:) cause=:>,<<-d>,cause);
3 1124 <**> if cause<1 then write(zud,<: !!!:>);
3 1125 <**> skriv_coru(zud,actno);
3 1126 <**> skriv_newact_slut:
3 1127 <**> end skriv_newactivity;
2 1128 <*-3*>
2 1129 <*+99*>
2 1130 \f
2 1130 message procedure skriv_activity side 1 - 810313/hko;
2 1131
2 1131 <**> procedure skriv_activity(zud,actno);
2 1132 <**> value actno;
2 1133 <**> zone zud;
2 1134 <**> integer actno;
2 1135 <**> begin
3 1136 <**> integer i;
3 1137 <**> integer array iact(1:12);
3 1138 <**>
3 1139 <**> i:=system(12,actno,iact);
3 1140 <**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
3 1141 <**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
3 1142 <**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
3 1143 <**> if i>0 and actno>0 and actno<=i then
3 1144 <**> begin
4 1145 <**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
4 1146 <**> (<:tom:>,<:passivate:>,
4 1147 <**> <:implicit passivate:>,<:activate:>));
4 1148 <**> if iact(1)<>0 then
4 1149 <**> write(zud,<: ventende på message:>,iact(1));
4 1150 <**> if iact(7)>0 then
4 1151 <**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
4 1152 <**> <:hovedlager stak benyttes af activity(:>,<<d>,
4 1153 <**> iact(2));
4 1154 <**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
4 1155 <**> iact(4),iact(5),iact(6),iact(10),iact(11));
4 1156 <**> if iact(9)<> 1 shift 22 then
4 1157 <**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
4 1158 <**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
4 1159 <**> end;
3 1160 <**> end skriv_activity
2 1161 <*-99*>
2 1162 <*+98*>
2 1163 \f
2 1163 message procedure identificer side 1 - 810520/cl;
2 1164
2 1164 procedure identificer(z);
2 1165 zone z;
2 1166 begin
3 1167 disable write(z,<:coroutine::>,<< dd>,curr_coruno,
3 1168 <: ident::>,<< zdd >,curr_coruid);
3 1169 end;
2 1170 \f
2 1170 message procedure skriv_coru side 1 - 810317/cl;
2 1171
2 1171 <**> procedure skriv_coru(zud,cor_no);
2 1172 <**> value cor_no;
2 1173 <**> zone zud;
2 1174 <**> integer cor_no;
2 1175 <**> begin
3 1176 <**> integer i;
3 1177 <**> integer array field cor;
3 1178 <**>
3 1179 <**>
3 1180 <**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
3 1181 <**>
3 1182 <**> cor:= coroutine(cor_no);
3 1183 <**> if cor = -1 then
3 1184 <**> write(zud,<: eksisterer ikke !!!:>)
3 1185 <**> else
3 1186 <**> begin
4 1187 <**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
4 1188 <**> <: refbyte: :>,<<d>,cor,"nl",1,
4 1189 <**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
4 1190 <**> <: next: :>,d.cor.next,"nl",1,
4 1191 <**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
4 1192 <**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
4 1193 <**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
4 1194 <**> <: opchain.next: :>,d.cor.coruop,"nl",1,
4 1195 <**> <: timer: :>,d.cor.corutimer,"nl",1,
4 1196 <**> <: priority: :>,d.cor.corupriority,"nl",1,
4 1197 <**> <: typeset: :>);
4 1198 <**> for i:= -11 step 1 until 0 do
4 1199 <**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
4 1200 <**> write(zud,"nl",1,<: testmask: :>);
4 1201 <**> for i:= -11 step 1 until 0 do
4 1202 <**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
4 1203 <*+99*>
4 1204 <**> skriv_activity(zud,cor_no);
4 1205 <*-99*>
4 1206 <**> end;
3 1207 <**> end skriv_coru;
2 1208 <*-98*>
2 1209 <*+98*>
2 1210 \f
2 1210 message procedure skriv_op side 1 - 810409/cl;
2 1211
2 1211 <**> procedure skriv_op(zud,opref);
2 1212 <**> value opref;
2 1213 <**> integer opref;
2 1214 <**> zone zud;
2 1215 <**> begin
3 1216 <**> integer array field op;
3 1217 <**> real array field raf;
3 1218 <**> integer lgd,i;
3 1219 <**> real t;
3 1220 <**>
3 1221 <**> raf:= data;
3 1222 <**> op:= opref;
3 1223 <**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
3 1224 <**> if opref<first_op ! optop<=opref then
3 1225 <**> begin
4 1226 <**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
4 1227 <**> goto slut_skriv_op;
4 1228 <**> end;
3 1229 <**>
3 1230 <**> lgd:= d.op.opsize;
3 1231 <**> write(zud,"nl",1,<<d>,
3 1232 <**> <: opsize :>,d.op.opsize,"nl",1,
3 1233 <**> <: optype :>);
3 1234 <**> for i:= -11 step 1 until 0 do
3 1235 <**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
3 1236 <**> write(zud,"nl",1,<<d>,
3 1237 <**> <: prev :>,d.op.prev,"nl",1,
3 1238 <**> <: next :>,d.op.next);
3 1239 <**> if lgd=0 then goto slut_skriv_op;
3 1240 <**> write(zud,"nl",1,<<d>,
3 1241 <**> <: kilde :>,d.op.kilde extract 10,"nl",1,
3 1242 <**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
3 1243 <**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
3 1244 d.op.retur,"nl",1,
3 1245 <**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
3 1246 <**> d.op.opkode extract 12,"nl",1,
3 1247 <**> <: resultat :>,d.op.resultat,"nl",2,
3 1248 <**> <:data::>);
3 1249 <**> skriv_hele(zud,d.op.raf,lgd-data,1278);
3 1250 <**>slut_skriv_op:
3 1251 <**> end skriv_op;
2 1252 <*-98*>
2 1253 \f
2 1253 message procedure corutable side 1 - 810406/cl;
2 1254
2 1254 procedure corutable(zud);
2 1255 zone zud;
2 1256 begin
3 1257 integer i;
3 1258 integer array field cor;
3 1259
3 1259 write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
3 1260 <:no id ref chain timerch opchain timer pr:>,
3 1261 <: typeset testmask:>,"nl",2);
3 1262 for i:= 1 step 1 until maxcoru do
3 1263 begin
4 1264 cor:= coroutine(i);
4 1265 write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
4 1266 d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
4 1267 d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
4 1268 d.cor.corutimer,<< dd>,d.cor.corupriority);
4 1269 outchar(zud,'sp');
4 1270 outboolbits(zud,d.cor.corutypeset);
4 1271 outchar(zud,'sp');
4 1272 outboolbits(zud,d.cor.corutestmask);
4 1273 outchar(zud,'nl');
4 1274 end;
3 1275 end;
2 1276 \f
2 1276 message filglobal side 1 - 790302/jg;
2 1277
2 1277 integer
2 1278 dbantsf,dbkatsfri,
2 1279 dbantb,dbkatbfri,
2 1280 dbantef,dbkatefri,
2 1281 dbsidstesz,dbsidstetz,
2 1282 dbsegmax,
2 1283 filskrevet,fillæst;
2 1284 integer
2 1285 bs_kats_fri, bs_kate_fri,
2 1286 cs_opret_fil, cs_tilknyt_fil,
2 1287 cs_frigiv_fil, cs_slet_fil,
2 1288 cs_opret_spoolfil, cs_opret_eksternfil;
2 1289 integer array
2 1290 dbkatt(1:dbmaxtf,1:2),
2 1291 dbkats(1:dbmaxsf,1:2),
2 1292 dbkate(1:dbmaxef,1:6),
2 1293 dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
2 1294 boolean array
2 1295 dbkatb(1:dbmaxb);
2 1296 zone array
2 1297 fil(dbantez+dbantsz+dbanttz,128,1,stderror);
2 1298 \f
2 1298 message hentfildim side 1 - 781120/jg;
2 1299
2 1299
2 1299 integer procedure hentfildim(fdim);
2 1300 integer array fdim;
2 1301 <*inddata filref i fdim(4),uddata fdim(1:8)*>
2 1302
2 1302 begin integer ftype,fno,katf,i,s;
3 1303 ftype:=fdim(4) shift (-10);
3 1304 fno:=fdim(4) extract 10;
3 1305 if ftype>3 or ftype=0 or fno=0 then
3 1306 begin s:=1; goto udgang; end;
3 1307 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
3 1308 begin s:=1; goto udgang end; <*paramfejl*>
3 1309 katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
3 1310 if katf extract 9 = 0 then
3 1311 begin s:=2; goto udgang end; <*tom indgang*>
3 1312
3 1312 fdim(1):=katf shift (-9); <*post antal*>
3 1313 fdim(2):=katf extract 9; <*post længde*>
3 1314 fdim(3):=case ftype of( <*seg antal*>
3 1315 dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
3 1316 extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
3 1317 dbkate(fno,2) extract 18);
3 1318 for i:=5 step 1 until 8 do <*externt filnavn*>
3 1319 fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
3 1320 s:=0;
3 1321 udgang:
3 1322 hentfildim:=s;
3 1323 <*+2*>
3 1324 <*tz*> if testbit24 and overvåget then <*zt*>
3 1325 <*tz*> begin <*zt*>
4 1326 <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
4 1327 <*tz*> pfdim(fdim); <*zt*>
4 1328 <*tz*> ud; <*zt*>
4 1329 <*tz*> end; <*zt*>
3 1330 <*-2*>
3 1331 end hentfildim;
2 1332 \f
2 1332 message sætfildim side 1 - 780916/jg;
2 1333
2 1333 integer procedure sætfildim(fdim);
2 1334 integer array fdim;
2 1335 <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
2 1336
2 1336 begin
3 1337 integer ftype,fno,katf,s,pl;
3 1338 integer array gdim(1:8);
3 1339 gdim(4):=fdim(4);
3 1340 s:=hentfildim(gdim);
3 1341 if s>0 then
3 1342 goto udgang;
3 1343 fno:=fdim(4) extract 10;
3 1344 ftype:=fdim(4) shift (-10);
3 1345 pl:= fdim(2) extract 12;
3 1346 if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
3 1347 begin
4 1348 s:=1; <*parameter fejl*>
4 1349 goto udgang
4 1350 end;
3 1351 if fdim(1)>256//pl*fdim(3) then
3 1352 begin
4 1353 s:=1;
4 1354 goto udgang;
4 1355 end;
3 1356
3 1356 <*segant*>
3 1357 if ftype=3 then
3 1358 begin integer segant;
4 1359 segant:= fdim(3);
4 1360 if segant > dbsegmax then
4 1361 begin
5 1362 s:=4; <*ingen plads*>
5 1363 goto udgang
5 1364 end;
4 1365 \f
4 1365 message sætfildim side 2 - 780916/jg;
4 1366
4 1366
4 1366 if segant<>gdim(3) then
4 1367 begin integer i,z,s; array field enavn; integer array tail(1:10);
5 1368 z:=dbkate(fno,2) shift (-19); if z>0 then begin
6 1369 if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
6 1370 begin integer array zd(1:20);
7 1371 getzone6(fil(z),zd);
7 1372 if zd(13)>5 and zd(9)>=segant then
7 1373 begin <*dødt segment skal ikke udskrives*>
8 1374 zd(13):=5;
8 1375 setzone6(fil(z),zd)
8 1376 end
7 1377 end end;
5 1378 \f
5 1378 message sætfildim side 3 - 801031/jg;
5 1379
5 1379
5 1379 enavn:=8; <*ændr fil størrelse*>
5 1380 i:=1;
5 1381 open(zdummy,0,string gdim.enavn(increase(i)),0);
5 1382 s:=monitor(42,zdummy,0,tail); <*lookup*>
5 1383 if s>0 then
5 1384 fejlreaktion(1,s,<:lookup entry:>,0);
5 1385 tail(1):=segant;
5 1386 s:=monitor(44,zdummy,0,tail); <*change entry*>
5 1387 close(zdummy,false);
5 1388 if s<>0 then
5 1389 begin
6 1390 if s=6 then
6 1391 begin <*ingen plads*>
7 1392 s:=4; goto udgang
7 1393 end
6 1394 else fejlreaktion(1,s,<:change entry:>,0);
6 1395 end;
5 1396 dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
5 1397 add segant;
5 1398 \f
5 1398 message sætfildim side 4 - 801013/jg;
5 1399
5 1399
5 1399 end;
4 1400 fdim(3):=segant
4 1401 end
3 1402 else
3 1403 if fdim(3)>gdim(3) then
3 1404 begin
4 1405 s:=4; <*altid ingen plads*>
4 1406 goto udgang
4 1407 end
3 1408 else fdim(3):=gdim(3); <*samme længde*>
3 1409 <*postantal,postlængde*>
3 1410 katf:=fdim(1) shift 9 add pl;
3 1411 case ftype of begin
4 1412 dbkatt(fno,1):=katf;
4 1413 dbkats(fno,1):=katf;
4 1414 dbkate(fno,1):=katf end;
3 1415 udgang:
3 1416 sætfildim:=s;
3 1417 <*+2*>
3 1418 <*tz*> if testbit24 and overvåget then <*zt*>
3 1419 <*tz*> begin integer i; <*zt*>
4 1420 <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
4 1421 <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
4 1422 <*tz*> pfdim(gdim); <*zt*>
4 1423 <*tz*> ud; <*zt*>
4 1424 <*tz*> end; <*zt*>
3 1425 <*-2*>
3 1426 end sætfildim;
2 1427 \f
2 1427 message findfilenavn side 1 - 780916/jg;
2 1428
2 1428 integer procedure findfilenavn(navn);
2 1429 real array navn;
2 1430
2 1430 begin
3 1431 integer fno; array field enavn;
3 1432 for fno:=1 step 1 until dbmaxef do
3 1433 if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
3 1434 begin
4 1435 enavn:=fno*12+4;
4 1436 if navn(1)=dbkate.enavn(1) and
4 1437 navn(2)=dbkate.enavn(2) then
4 1438 begin
5 1439 findfilenavn:=fno;
5 1440 goto udgang
5 1441 end
4 1442 end;
3 1443 findfilenavn:=0;
3 1444 udgang:
3 1445 end findfilenavn;
2 1446 \f
2 1446 message læsfil side 1 - 781120/jg;
2 1447
2 1447 integer procedure læsfil(filref,postindex,zoneno);
2 1448 value filref,postindex;
2 1449 integer filref,postindex,zoneno;
2 1450 <*+2*>
2 1451 <*tz*> begin integer i,o,s; <*zt*>
3 1452 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1453 <*-2*>
3 1454
3 1454 læsfil:=tilgangfil(filref,postindex,zoneno,5);
3 1455
3 1455 <*+2*>
3 1456 <*tz*> if testbit24 and overvåget then <*zt*>
3 1457 <*tz*> begin <*zt*>
4 1458 <*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*>
4 1459 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1460 <*tz*> end; <*zt*>
3 1461 <*tz*> end procedure; <*zt*>
2 1462 <*-2*>
2 1463 \f
2 1463 message skrivfil side 1 - 781120/jg;
2 1464
2 1464 integer procedure skrivfil(filref,postindex,zoneno);
2 1465 value filref,postindex;
2 1466 integer filref,postindex,zoneno;
2 1467 <*+2*>
2 1468 <*tz*> begin integer i,o,s; <*zt*>
3 1469 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1470 <*-2*>
3 1471
3 1471 skrivfil:=tilgangfil(filref,postindex,zoneno,6);
3 1472
3 1472 <*+2*>
3 1473 <*tz*> if testbit24 and overvåget then <*zt*>
3 1474 <*tz*> begin <*zt*>
4 1475 <*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
4 1476 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1477 <*tz*> end; <*zt*>
3 1478 <*tz*> end procedure; <*zt*>
2 1479 <*-2*>
2 1480 \f
2 1480 message modiffil side 1 - 781120/jg;
2 1481
2 1481 integer procedure modiffil(filref,postindex,zoneno);
2 1482 value filref,postindex;
2 1483 integer filref,postindex,zoneno;
2 1484 <*+2*>
2 1485 <*tz*> begin integer i,o,s; <*zt*>
3 1486 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1487 <*-2*>
3 1488
3 1488 modiffil:=tilgangfil(filref,postindex,zoneno,7);
3 1489
3 1489 <*+2*>
3 1490 <*tz*> if testbit24 and overvåget then <*zt*>
3 1491 <*tz*> begin <*zt*>
4 1492 <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
4 1493 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1494 <*tz*> end; <*zt*>
3 1495 <*tz*> end procedure; <*zt*>
2 1496 <*-2*>
2 1497 \f
2 1497 message tilgangfil side 1 - 781003/jg;
2 1498
2 1498 integer procedure tilgangfil(filref,postindex,zoneno,operation);
2 1499 value filref,postindex,operation;
2 1500 integer filref,postindex,zoneno,operation;
2 1501 <*proceduren kaldes fra læsfil,skrivfil og modiffil*>
2 1502
2 1502 begin
3 1503 integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
3 1504 integer array zd(1:20),fdim(1:8);
3 1505
3 1505
3 1505
3 1505 <*hent katalog*>
3 1506
3 1506 fdim(4):=filref;
3 1507 st:=hentfildim(fdim);
3 1508 if st<>0 then
3 1509 goto udgang; <*parameter fejl eller fil findes ikke*>
3 1510 fno:=filref extract 10;
3 1511 ftype:=filref shift (-10);
3 1512 pl:=fdim(2);
3 1513 katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
3 1514 \f
3 1514 message tilgangfil side 2 - 781003/jg;
3 1515
3 1515
3 1515
3 1515 <*find segment adr og check postindex*>
3 1516
3 1516 pps:=256//pl; <*poster pr segment*>
3 1517 seg:=(postindex-1)//pps; <*relativt segment*>
3 1518 pr:=(postindex-1) mod pps; <*post relativ til seg*>
3 1519 if postindex <1 then
3 1520 begin <*parameter fejl*>
4 1521 st:=1;
4 1522 goto udgang
4 1523 end;
3 1524 if seg>=fdim(3) then
3 1525 begin <*post findes ikke*>
4 1526 st:=3;
4 1527 goto udgang
4 1528 end;
3 1529 case ftype of
3 1530 begin <*find absolut segment*>
4 1531
4 1531 <*tabelfil*>
4 1532 seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
4 1533
4 1533 begin <*spoolfil*>
5 1534 integer i,bidno;
5 1535 bidno:=katf extract 12;
5 1536 for i:=seg//dbbidlængde step -1 until 1 do
5 1537 bidno:=dbkatb(bidno) extract 12;
5 1538 seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
5 1539 end;
4 1540
4 1540 <*extern fil,seg ok*>
4 1541
4 1541 end case find abs seg;
3 1542 \f
3 1542 message tilgangfil side 3 - 801030/jg;
3 1543
3 1543 <*alloker zone*>
3 1544
3 1544 zno:=katf shift(-19);
3 1545 case ftype of begin
4 1546
4 1546 begin <*tabelfil*>
5 1547 integer førstetz;
5 1548 førstetz:=dbkatz(dbsidstetz,2);
5 1549 if zno=0 then
5 1550 zno:=førstetz
5 1551 else if dbkatz(zno,1)<>filref then
5 1552 zno:=førstetz
5 1553 else if zno <> førstetz and zno <> dbsidstetz then
5 1554 begin integer z;
6 1555 for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
6 1556 dbkatz(z,2):=dbkatz(zno,2);
6 1557 dbkatz(zno,2):=førstetz;
6 1558 dbkatz(dbsidstetz,2):=zno;
6 1559 end;
5 1560 dbsidstetz:=zno
5 1561 end;
4 1562 \f
4 1562 message tilgangfil side 4 - 801030/jg;
4 1563
4 1563
4 1563 begin <*spoolfil*>
5 1564 integer p,zslut,z;
5 1565 if zno>0 then begin if dbkatz(zno,1) =filref then
6 1566 goto udgangs end; <*strategi 1*>
5 1567 p:=0;
5 1568 zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
5 1569 zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
5 1570 for z:=dbantez+dbantsz step -1 until zslut do
5 1571 begin integer zfref;
6 1572 zfref:=dbkatz(z,1);
6 1573 if zfref extract 10=0 then <*fri zone*>
6 1574 begin <*strategi 2*>
7 1575 zno:=z;
7 1576 goto udgangs
7 1577 end
6 1578 else
6 1579 if zfref shift (-10)=2 then
6 1580 begin <*zone tilknyttet spoolfil*>
7 1581 integer q;
7 1582 q:=dbkatz(z,2); <*prioritet*>
7 1583 if q>p then
7 1584 begin <*strategi 3*>
8 1585 p:=q;
8 1586 zno:=z
8 1587 end
7 1588 end;
6 1589 end z;
5 1590 udgangs:
5 1591 if zno> dbantez then dbsidstesz:=zno;
5 1592 end;
4 1593 \f
4 1593 message tilgangfil side 5 - 780916/jg;
4 1594
4 1594 begin <*extern fil*>
5 1595 integer z;
5 1596 if zno=0 then
5 1597 zno:=1
5 1598 else if dbkatz(zno,1) = filref then
5 1599 goto udgange; <*strategi 1*>
5 1600 for z:=1 step 1 until dbantez do
5 1601 begin integer zfref;
6 1602 zfref:=dbkatz(z,1);
6 1603 if zfref=0 then <*zone fri*>
6 1604 begin zno:=z; goto udgange end <*strategi 2*>
6 1605 else if zfref shift (-10) =2 then <*spoolfil*>
6 1606 zno:=z; <*strategi 3*> <*else strategi 4-5*>
6 1607 end z;
5 1608 udgange:
5 1609 end
4 1610 end case alloker zone;
3 1611
3 1611
3 1611
3 1611 <*åbn zone*>
3 1612
3 1612 if zno<=dbantez then
3 1613 begin <*extern zone;spool og tabel zoner altid åbne*>
4 1614 integer zfref;
4 1615 zfref:=dbkatz(zno,1);
4 1616 if zfref<>0 and zfref<>filref and ftype=3 then
4 1617 begin <*luk hvis ny extern fil*>
5 1618 getzone6(fil(zno),zd);
5 1619 if zd(13)>5 then filskrevet:=filskrevet+1;
5 1620 zfref:=0;
5 1621 close(fil(zno),false);
5 1622 end;
4 1623 if zfref=0 then
4 1624 begin <*åbn zone*>
5 1625 array field enavn; integer i;
5 1626 enavn:=4*2; i:=1;
5 1627 open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
5 1628 string fdim.enavn(increase(i))),0)
5 1629 end
4 1630 end;
3 1631 \f
3 1631 message tilgangfil side 6 - 780916/jg;
3 1632
3 1632
3 1632
3 1632 <*hent segment og sæt zone descriptor*>
3 1633
3 1633 getzone6(fil(zno),zd);
3 1634 zstate:=zd(13);
3 1635 if zstate=0 or zd(9)<>seg then
3 1636 begin <*positioner*>
4 1637 if zstate>5 then
4 1638 filskrevet:=filskrevet+1;
4 1639 setposition(fil(zno),0,seg);
4 1640 if -,(operation=6 and pr=0) then
4 1641 begin <*læs seg medmindre op er skriv første post*>
5 1642 inrec6(fil(zno),512);
5 1643 fillæst:=fillæst+1
5 1644 end;
4 1645 zstate:=operation
4 1646 end
3 1647 else <*zstate:=max(operation,zone state)*>
3 1648 if operation>zstate then
3 1649 zstate:=operation;
3 1650 zd(9):=seg;
3 1651 zd(13):=zstate;
3 1652 zd(16):=pl shift 1;
3 1653 zd(14):=zd(19)+pr*zd(16);
3 1654 setzone6(fil(zno),zd);
3 1655 \f
3 1655 message tilgangfil side 7 - 780916/jg;
3 1656
3 1656
3 1656
3 1656 <*opdater kataloger*>
3 1657
3 1657 katf:=zno shift 19 add (katf extract 19);
3 1658 case ftype of
3 1659 begin
4 1660 dbkatt(fno,2):=katf;
4 1661 dbkats(fno,2):=katf;
4 1662 dbkate(fno,2):=katf
4 1663 end;
3 1664 dbkatz(zno,1):= filref;
3 1665 if ftype=3 then dbkatz(zno,2):=0 else
3 1666 <*if ftype=1 then allerede opd under zoneallokering*>
3 1667 if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
3 1668 if zstate=5 then (if pr=pps-1 then 2 else 1)
3 1669 else if zstate=6 and pr=pps-1 then 3 else 0;
3 1670
3 1670
3 1670
3 1670 <*udgang*>
3 1671
3 1671 udgang:
3 1672 if st=0 then
3 1673 zoneno:=zno
3 1674 else zoneno:=0; <*fejl*>
3 1675 tilgangfil:=st;
3 1676 end tilgangfil;
2 1677 \f
2 1677
2 1677 message pfilsystem side 1 - 781003/jg;
2 1678
2 1678 procedure pfilparm(z);
2 1679 zone z;
2 1680 write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
2 1681 dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
2 1682 <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
2 1683 dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
2 1684
2 1684 procedure pfilglobal(z);
2 1685 zone z;
2 1686 write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
2 1687 <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
2 1688 <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
2 1689 <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
2 1690 <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
2 1691 <:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
2 1692
2 1692
2 1692 procedure pdbkate(z,i);
2 1693 value i; integer i;
2 1694 zone z;
2 1695 begin integer j; array field navn;
3 1696 navn:=i*12+4; j:=1;
3 1697 write(z,<:<10>dbkate(:>,i,<:)=:>,
3 1698 dbkate(i,1) shift (-9),
3 1699 dbkate(i,1) extract 9,
3 1700 dbkate(i,2) shift (-19),
3 1701 dbkate(i,2) shift (-18) extract 1,
3 1702 dbkate(i,2) extract 18,
3 1703 <: :>,string dbkate.navn(increase(j)));
3 1704 end;
2 1705 \f
2 1705 message pfilsystem side 2 - 781003/jg;
2 1706
2 1706
2 1706
2 1706 procedure pdbkats(z,i);
2 1707 value i; integer i;
2 1708 zone z;
2 1709 write(z,<:<10>dbkats(:>,i,<:)=:>,
2 1710 dbkats(i,1) shift (-9),
2 1711 dbkats(i,1) extract 9,
2 1712 dbkats(i,2) shift (-19),
2 1713 dbkats(i,2) shift (-18) extract 1,
2 1714 dbkats(i,2) shift (-12) extract 6,
2 1715 dbkats(i,2) extract 12);
2 1716
2 1716 procedure pdbkatb(z,i);
2 1717 value i;integer i;
2 1718 zone z;
2 1719 write(z,<:<10>dbkatb(:>,i,<:)=:>,
2 1720 dbkatb(i) extract 12);
2 1721
2 1721 procedure pdbkatt(z,i);
2 1722 value i; integer i;
2 1723 zone z;
2 1724 write(z,<:<10>dbkatt(:>,i,<:)=:>,
2 1725 dbkatt(i,1) shift (-9),
2 1726 dbkatt(i,1) extract 9,
2 1727 dbkatt(i,2) shift (-19),
2 1728 dbkatt(i,2) shift (-18) extract 1,
2 1729 dbkatt(i,2) extract 18);
2 1730
2 1730 procedure pdbkatz(z,i);
2 1731 value i; integer i;
2 1732 zone z;
2 1733 write(z,<:<10>dbkatz(:>,i,<:)=:>,
2 1734 dbkatz(i,1),dbkatz(i,2));
2 1735 \f
2 1735 message pfilsystem side 3 - 781003/jg;
2 1736
2 1736
2 1736
2 1736 procedure pfil(z,i);
2 1737 value i; integer i;
2 1738 zone z;
2 1739 begin integer j,k; array field navn; integer array zd(1:20);
3 1740 navn:=2; k:=1;
3 1741 getzone6(fil(i),zd);
3 1742 write(z,<:<10>fil(:>,i,<:)=:>,
3 1743 zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
3 1744 string zd.navn(increase(k)));
3 1745 for j:=6 step 1 until 10 do write(z,zd(j));
3 1746 write(z,<:<10>:>);
3 1747 for j:=11 step 1 until 20 do write(z,zd(j));
3 1748 end;
2 1749
2 1749 procedure pfilsystem(z);
2 1750 zone z;
2 1751 begin integer i;
3 1752
3 1752 write(z,<:<12>udskrift af variable i filsystem:>);
3 1753 write(z,<:<10><10>filparm::>);
3 1754 pfilparm(z);
3 1755 write(z,<:<10><10>filglobal::>);
3 1756 pfilglobal(z);
3 1757 write(z,<:<10><10>fil: zone descriptor:>);
3 1758 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
3 1759 write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
3 1760 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
3 1761 write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
3 1762 for i :=1 step 1 until dbmaxef do pdbkate(z,i);
3 1763 write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
3 1764 for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
3 1765 write(z,<:<10><10>dbkatb: katbref:>);
3 1766 for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
3 1767 write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
3 1768 for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
3 1769 end pfilsystem;
2 1770 \f
2 1770 message pfilsystem side 4 - 781003/jg;
2 1771
2 1771
2 1771
2 1771 procedure pfdim(fdim);
2 1772 integer array fdim;
2 1773 begin
3 1774 integer i;
3 1775 array field navn;
3 1776 i:=1;navn:=8;
3 1777 write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
3 1778 string fdim.navn(increase(i)));
3 1779 end pfdim;
2 1780 \f
2 1780 message opretfil side 0 - 810529/cl;
2 1781
2 1781 procedure opretfil;
2 1782 <* checker parametre og vidresender operation
2 1783 til opret_spoolfil eller opret_eksternfil *>
2 1784
2 1784 begin
3 1785 integer array field op;
3 1786 integer status,pant,pl,segant,p_nøgle,fno,ftype;
3 1787
3 1787 procedure skriv_opret_fil(z,omfang);
3 1788 value omfang;
3 1789 zone z;
3 1790 integer omfang;
3 1791 begin
4 1792 write(z,"nl",1,<:+++ opret fil :>);
4 1793 if omfang > 0 then
4 1794 disable
4 1795 begin
5 1796 skriv_coru(z,abs curr_coruno);
5 1797 write(z,"nl",1,<<d>,
5 1798 <:op :>,op,"nl",1,
5 1799 <:status :>,status,"nl",1,
5 1800 <:pant :>,pant,"nl",1,
5 1801 <:pl :>,pl,"nl",1,
5 1802 <:segant :>,segant,"nl",1,
5 1803 <:p-nøgle:>,p_nøgle,"nl",1,
5 1804 <:fno :>,fno,"nl",1,
5 1805 <:ftype :>,ftype,"nl",1,
5 1806 <::>);
5 1807 end;
4 1808 end skriv_opret_fil;
3 1809 \f
3 1809 message opretfil side 1 - 810526/cl;
3 1810
3 1810 trap(opretfil_trap);
3 1811 <*+2*>
3 1812 <**> disable if testbit28 then
3 1813 <**> skriv_opret_fil(out,0);
3 1814 <*-2*>
3 1815
3 1815 stack_claim(if cm_test then 200 else 150);
3 1816
3 1816 <*+2*>
3 1817 <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
3 1818 <*-2*>
3 1819
3 1819 trin1:
3 1820 waitch(cs_opret_fil,op,true,-1);
3 1821
3 1821 trin2: <* check parametre *>
3 1822 disable begin
4 1823
4 1823 ftype:= d.op.data(4) shift (-10);
4 1824 fno:= d.op.data(4) extract 10;
4 1825 if ftype<2 or ftype>3 or fno<>0 then
4 1826 begin
5 1827 status:= 1; <*parameterfejl*>
5 1828 goto returner;
5 1829 end;
4 1830
4 1830 pant:= d.op.data(1);
4 1831 pl:= d.op.data(2);
4 1832 segant:= d.op.data(3);
4 1833 p_nøgle:= d.op.opkode shift (-12);
4 1834 if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
4 1835 or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
4 1836 status:= 1 <*parameterfejl *>
4 1837 else
4 1838 if pant>256//pl*segant then status:= 1 else
4 1839 if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
4 1840 status:= 4 <*ingen plads*>
4 1841 else
4 1842 status:=0;
4 1843 \f
4 1843 message opretfil side 2 - 810526/cl;
4 1844
4 1844
4 1844 returner:
4 1845
4 1845 d.op.data(9):= status;
4 1846
4 1846 <*+2*>
4 1847 <*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
4 1848 <*tz*> begin <*zt*>
5 1849 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 1850 <*tz*> pfdim(d.op.data); <*zt*>
5 1851 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1852 <*tz*> end; <*zt*>
4 1853 <*-2*>
4 1854
4 1854 <*returner eller vidresend operation*>
4 1855 signalch(if status>0 then d.op.retur else
4 1856 case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
4 1857 op,d.op.optype);
4 1858 end;
3 1859 goto trin1;
3 1860 opretfil_trap:
3 1861 disable skriv_opret_fil(zbillede,1);
3 1862
3 1862 end opretfil;
2 1863 \f
2 1863 message tilknytfil side 0 - 810526/cl;
2 1864
2 1864 procedure tilknytfil;
2 1865 <* tilknytter ekstern fil og returnerer intern filid *>
2 1866
2 1866 begin
3 1867 integer array field op;
3 1868 integer status,i,fno,segant,pa,pl,sliceant,s;
3 1869 array field enavn;
3 1870 integer array tail(1:10);
3 1871
3 1871 procedure skriv_tilknyt_fil(z,omfang);
3 1872 value omfang;
3 1873 zone z;
3 1874 integer omfang;
3 1875 begin
4 1876 write(z,"nl",1,<:+++ tilknyt fil :>);
4 1877 if omfang > 0 then
4 1878 disable
4 1879 begin real array field raf;
5 1880 skriv_coru(z,abs curr_coruno);
5 1881 write(z,"nl",1,<<d>,
5 1882 <:op :>,op,"nl",1,
5 1883 <:status :>,status,"nl",1,
5 1884 <:i :>,i,"nl",1,
5 1885 <:fno :>,fno,"nl",1,
5 1886 <:segant :>,segant,"nl",1,
5 1887 <:pa :>,pa,"nl",1,
5 1888 <:pl :>,pl,"nl",1,
5 1889 <:sliceant:>,sliceant,"nl",1,
5 1890 <:s :>,s,"nl",1,
5 1891 <::>);
5 1892 raf:= 0;
5 1893 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 1894 write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
5 1895 end;
4 1896 end skriv_tilknyt_fil;
3 1897 \f
3 1897 message tilknytfil side 1 - 810529/cl;
3 1898
3 1898 stack_claim(if cm_test then 200 else 150);
3 1899 trap(tilknytfil_trap);
3 1900
3 1900 <*+2*>
3 1901 <**> if testbit28 then
3 1902 <**> skriv_tilknyt_fil(out,0);
3 1903 <*-2*>
3 1904
3 1904 trin1:
3 1905 waitch(cs_tilknyt_fil,op,true,-1);
3 1906
3 1906 trin2:
3 1907 wait(bs_kate_fri);
3 1908
3 1908 trin3:
3 1909 disable begin
4 1910
4 1910 <* find ekstern rapportfil *>
4 1911 enavn:= 8;
4 1912 if find_fil_enavn(d.op.data.enavn)>0 then
4 1913 begin
5 1914 status:= 6; <* fil i brug *>
5 1915 goto returner;
5 1916 end;
4 1917 open(zdummy,0,d.op.data.enavn,0);
4 1918 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 1919 if s<>0 then
4 1920 begin
5 1921 if s=3 then status:= 2 <* fil findes ikke *>
5 1922 else if s=6 then status:= 1 <* parameterfejl, navn *>
5 1923 else fejlreaktion(1,s,<:lookup entry:>,0);
5 1924 goto returner;
5 1925 end;
4 1926 if tail(9)<>d.op.data(4) <* contentskey,subno *> then
4 1927 begin
5 1928 status:= 5; <* forkert indhold *> goto returner;
5 1929 end;
4 1930 segant:= tail(1);
4 1931 if segant>db_seg_max then
4 1932 segant:= db_seg_max;
4 1933 pa:= tail(10);
4 1934 pl:= tail(7) extract 12;
4 1935 if pl < 1 or pl > 256 then
4 1936 begin status:= 7; goto returner; end;
4 1937 \f
4 1937 message tilknytfil side 2 - 810529/cl;
4 1938 if pa>256//pl*segant then
4 1939 begin status:= 7; goto returner; end;
4 1940
4 1940 <* reserver *>
4 1941 s:= monitor(52)create area:(zdummy,0,ia);
4 1942 if s<>0 then
4 1943 begin
5 1944 if s=3 then status:= 2 <* fil findes ikke *>
5 1945 else if s=1 <* areaclaims exeeded *> then
5 1946 begin
6 1947 status:= 4;
6 1948 fejlreaktion(1,s,<:create area:>,1);
6 1949 end
5 1950 else fejlreaktion(1,s,<:create area:>,0);
5 1951 goto returner;
5 1952 end;
4 1953
4 1953 s:= monitor(8)reserve:(zdummy,0,ia);
4 1954 if s<>0 then
4 1955 begin
5 1956 if s<3 then status:= 6 <* i brug *>
5 1957 else fejlreaktion(1,s,<:reserve:>,0);
5 1958 monitor(64)remove area:(zdummy,0,ia);
5 1959 goto returner;
5 1960 end;
4 1961
4 1961 tail(7):= 1 shift 12 +pl; <* tilknyttet *>
4 1962 s:= monitor(44)change entry:(zdummy,0,tail);
4 1963 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 1964
4 1964 <* opdater katalog *>
4 1965 dbantef:= dbantef+1;
4 1966 fno:= dbkatefri;
4 1967 dbkatefri:= dbkate(fno,2);
4 1968 dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
4 1969 dbkate(fno,2):= segant;
4 1970 for i:= 5 step 1 until 8 do
4 1971 dbkate(fno,i-2):= d.op.data(i);
4 1972
4 1972 <* returparametre *>
4 1973 d.op.data(1):= pa;
4 1974 d.op.data(2):= pl;
4 1975 d.op.data(3):= segant;
4 1976 d.op.data(4):= 3 shift 10 +fno;
4 1977 status:= 0;
4 1978 \f
4 1978 message tilknytfil side 3 - 810526/cl;
4 1979
4 1979
4 1979 returner:
4 1980 close(zdummy,false);
4 1981 d.op.data(9):= status;
4 1982
4 1982
4 1982 <*+2*>
4 1983 <*tz*> if testbit24 and overvåget then <*zt*>
4 1984 <*tz*> begin <*zt*>
5 1985 <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
5 1986 <*tz*> pfdim(d.op.data); <*zt*>
5 1987 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1988 <*tz*> end; <*zt*>
4 1989 <*-2*>
4 1990
4 1990 signalch(d.op.retur,op,d.op.optype);
4 1991 if dbantef < dbmaxef then
4 1992 signalbin(bs_kate_fri);
4 1993 end;
3 1994 goto trin1;
3 1995 tilknytfil_trap:
3 1996 disable skriv_tilknyt_fil(zbillede,1);
3 1997 end tilknyt_fil;
2 1998 \f
2 1998 message frigivfil side 0 - 810529/cl;
2 1999
2 1999 procedure frigivfil;
2 2000 <* frigiver en tilknyttet ekstern fil *>
2 2001
2 2001 begin
3 2002 integer array field op;
3 2003 integer status,fref,ftype,fno,s,i,z;
3 2004 array field enavn;
3 2005 integer array tail(1:10);
3 2006
3 2006 procedure skriv_frigiv_fil(zud,omfang);
3 2007 value omfang;
3 2008 zone zud;
3 2009 integer omfang;
3 2010 begin
4 2011 write(zud,"nl",1,<:+++ frigiv fil :>);
4 2012 if omfang > 0 then
4 2013 disable
4 2014 begin real array field raf;
5 2015 skriv_coru(zud,abs curr_coruno);
5 2016 write(zud,"nl",1,<<d>,
5 2017 <:op :>,op,"nl",1,
5 2018 <:status:>,status,"nl",1,
5 2019 <:fref :>,fref,"nl",1,
5 2020 <:ftype :>,ftype,"nl",1,
5 2021 <:fno :>,fno,"nl",1,
5 2022 <:s :>,s,"nl",1,
5 2023 <:i :>,i,"nl",1,
5 2024 <:z :>,z,"nl",1,
5 2025 <::>);
5 2026 raf:= 0;
5 2027 write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
5 2028 end;
4 2029 end skriv_frigiv_fil;
3 2030 \f
3 2030 message frigivfil side 1 - 810526/cl;
3 2031
3 2031
3 2031 stack_claim(if cm_test then 200 else 150);
3 2032 trap(frigivfil_trap);
3 2033
3 2033 <*+2*>
3 2034 <**> disable if testbit28 then
3 2035 <**> skriv_frigiv_fil(out,0);
3 2036 <*-2*>
3 2037
3 2037 trin1:
3 2038 waitch(cs_frigiv_fil,op,true,-1);
3 2039
3 2039 trin2:
3 2040 disable begin
4 2041
4 2041 <* find fil *>
4 2042 fref:= d.op.data(4);
4 2043 ftype:= fref shift (-10);
4 2044 fno:= fref extract 10;
4 2045 if ftype=0 or ftype>3 or fno=0 then
4 2046 begin status:= 1; goto returner; end;
4 2047 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2048 begin status:= 1; goto returner; end;
4 2049 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2050 extract 9 = 0 then
4 2051 begin
5 2052 status:= 2; <* fil findes ikke *>
5 2053 goto returner;
5 2054 end;
4 2055 if ftype <> 3 then
4 2056 begin status:= 5; goto returner; end;
4 2057
4 2057 <* frigiv evt. tilknyttet zone og areaprocess *>
4 2058 z:= dbkate(fno,2) shift (-19);
4 2059 if z > 0 then
4 2060 begin
5 2061 if dbkatz(z,1)=fref then
5 2062 begin integer array zd(1:20);
6 2063 getzone6(fil(z),zd);
6 2064 if zd(13)>5 then filskrevet:= filskrevet +1;
6 2065 close(fil(z),true);
6 2066 dbkatz(z,1):= 0;
6 2067 end;
5 2068 end;
4 2069 \f
4 2069 message frigivfil side 2 - 810526/cl;
4 2070
4 2070 <* opdater tail *>
4 2071 enavn:= fno*12+4;
4 2072 open(zdummy,0,dbkate.enavn,0);
4 2073 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 2074 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
4 2075 tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
4 2076 tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
4 2077 s:= monitor(44)change entry:(zdummy,0,tail);
4 2078 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 2079 monitor(64)remove process:(zdummy,0,tail);
4 2080 close(zdummy,true);
4 2081
4 2081 <* frigiv indgang *>
4 2082 for i:= 1, 3 step 1 until 6 do
4 2083 dbkate(fno,1):= 0;
4 2084 dbkate(fno,2):= dbkatefri;
4 2085 dbkatefri:= fno;
4 2086 dbantef:= dbantef -1;
4 2087 signalbin(bs_kate_fri);
4 2088 d.op.data(4):= 0; <* filref null *>
4 2089 status:= 0;
4 2090
4 2090 returner:
4 2091 d.op.data(9):= status;
4 2092 <*+2*>
4 2093 <*tz*> if testbit24 and overvåget then <*zt*>
4 2094 <*tz*> begin <*zt*>
5 2095 <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
5 2096 <*tz*> pfdim(d.op.data); <*zt*>
5 2097 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2098 <*tz*> end; <*zt*>
4 2099 <*-2*>
4 2100
4 2100 signalch(d.op.retur,op,d.op.optype);
4 2101 end;
3 2102 goto trin1;
3 2103 frigiv_fil_trap:
3 2104 disable skriv_frigiv_fil(zbillede,1);
3 2105 end frigivfil;
2 2106 \f
2 2106 message sletfil side 0 - 810526/cl;
2 2107
2 2107 procedure sletfil;
2 2108 <* sletter en spool- eller ekstern fil *>
2 2109
2 2109 begin
3 2110 integer array field op;
3 2111 integer fref,fno,ftype,status;
3 2112
3 2112 procedure skriv_slet_fil(z,omfang);
3 2113 value omfang;
3 2114 zone z;
3 2115 integer omfang;
3 2116 begin
4 2117 write(z,"nl",1,<:+++ slet fil :>);
4 2118 if omfang > 0 then
4 2119 disable
4 2120 begin
5 2121 skriv_coru(z,abs curr_coruno);
5 2122 write(z,"nl",1,<<d>,
5 2123 <:op :>,op,"nl",1,
5 2124 <:fref :>,fref,"nl",1,
5 2125 <:fno :>,fno,"nl",1,
5 2126 <:ftype :>,ftype,"nl",1,
5 2127 <:status:>,status,"nl",1,
5 2128 <::>);
5 2129 end;
4 2130 end skriv_slet_fil;
3 2131 \f
3 2131 message sletfil side 1 - 810526/cl;
3 2132
3 2132 stack_claim(if cm_test then 200 else 150);
3 2133
3 2133 trap(sletfil_trap);
3 2134 <*+2*>
3 2135 <**> disable if testbit28 then
3 2136 <**> skriv_slet_fil(out,0);
3 2137 <*-2*>
3 2138
3 2138 trin1:
3 2139 waitch(cs_slet_fil,op,true,-1);
3 2140
3 2140 trin2:
3 2141 disable begin
4 2142
4 2142 <* find fil *>
4 2143 fref:= d.op.data(4);
4 2144 ftype:= fref shift (-10);
4 2145 fno:= fref extract 10;
4 2146 if ftype=0 or ftype>3 or fno=0 then
4 2147 begin status:= 1; goto returner; end;
4 2148 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2149 begin status:= 1; goto returner; end;
4 2150 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2151 extract 9 = 0 then
4 2152 begin
5 2153 status:= 2; <* fil findes ikke *>
5 2154 goto returner;
5 2155 end;
4 2156
4 2156
4 2156 <* slet spool- eller ekstern fil *>
4 2157 case ftype of
4 2158 begin
5 2159
5 2159 <* tabelfil - ingen aktion *>
5 2160 ;
5 2161 \f
5 2161 message sletfil side 2 - 810203/cl;
5 2162
5 2162 <* spoolfil *>
5 2163 begin
6 2164 integer z,bidno,bf,bidant,i;
6 2165
6 2165 <* hvis tilknyttet så frigiv *>
6 2166 z:= dbkats(fno,2) shift (-19);
6 2167 if z>0 then
6 2168 begin
7 2169 if dbkatz(z,1)=fref then
7 2170 begin integer array zd(1:20);
8 2171 dbkatz(z,1):= 2 shift 10;
8 2172 getzone6(fil(z),zd); <*annuler evt. udskrivning*>
8 2173 if zd(13)>5 then
8 2174 begin zd(13):= 0; setzone6(fil(z),zd); end;
8 2175 end;
7 2176 end;
6 2177
6 2177 <* frigiv bidder *>
6 2178 bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
6 2179 bidant:= dbkats(fno,2) shift (-12) extract 6;
6 2180 for i:= bidant -1 step -1 until 1 do
6 2181 bidno:= dbkatb(bidno) extract 12;
6 2182 dbkatb(bidno):= false add dbkatbfri;
6 2183 dbkatbfri:= bf;
6 2184 dbantb:= dbantb-bidant;
6 2185
6 2185 <* frigiv indgang *>
6 2186 dbkats(fno,1):= 0;
6 2187 dbkats(fno,2):= dbkatsfri;
6 2188 dbkatsfri:= fno;
6 2189 dbantsf:= dbantsf -1;
6 2190 signalbin(bs_kats_fri);
6 2191 end spoolfil;
5 2192 \f
5 2192 message sletfil side 3 - 810203/cl;
5 2193
5 2193 <* extern fil *>
5 2194 begin
6 2195 integer i,s,z;
6 2196 real array field enavn;
6 2197 integer array tail(1:10);
6 2198
6 2198 <* find head and tail *>
6 2199 enavn:= fno*12+4;
6 2200 open(zdummy,0,dbkate.enavn,0);
6 2201 s:= monitor(42)lookup entry:(zdummy,0,tail);
6 2202 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
6 2203
6 2203 <*frigiv evt. tilknyttet zone og areaprocess*>
6 2204 z:=dbkate(fno,2) shift (-19);
6 2205 if z>0 then
6 2206 begin
7 2207 if dbkatz(z,1)=fref then
7 2208 begin integer array zd(1:20);
8 2209 getzone6(fil(z),zd);
8 2210 if zd(13)>5 then <* udskrivning *>
8 2211 begin <*annuler*>
9 2212 zd(13):= 0;
9 2213 setzone6(fil(z),zd);
9 2214 end;
8 2215 close(fil(z),true);
8 2216 dbkatz(z,1):= 0;
8 2217 end;
7 2218 end;
6 2219
6 2219 <* fjern entry *>
6 2220 s:= monitor(48)remove entry:(zdummy,0,tail);
6 2221 if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
6 2222 close(zdummy,true);
6 2223
6 2223 <* frigiv indgang *>
6 2224 for i:=1, 3 step 1 until 6 do
6 2225 dbkate(fno,i):= 0;
6 2226 dbkate(fno,2):= dbkatefri;
6 2227 dbkatefri:= fno;
6 2228 dbantef:= dbantef -1;
6 2229 signalbin(bs_kate_fri);
6 2230 end eksternfil;
5 2231
5 2231 end ftype;
4 2232 \f
4 2232 message sletfil side 4 - 810526/cl;
4 2233
4 2233
4 2233 status:= 0;
4 2234 if ftype > 1 then
4 2235 d.op.data(4):= 0; <*filref null*>
4 2236
4 2236 returner:
4 2237 d.op.data(9):= status;
4 2238
4 2238 <*+2*>
4 2239 <*tz*> if testbit24 and overvåget then <*zt*>
4 2240 <*tz*> begin <*zt*>
5 2241 <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
5 2242 <*tz*> pfdim(d.op.data); <*zt*>
5 2243 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2244 <*tz*> end; <*zt*>
4 2245 <*-2*>
4 2246
4 2246 signalch(d.op.retur,op,d.op.optype);
4 2247 end;
3 2248 goto trin1;
3 2249 sletfil_trap:
3 2250 disable skriv_slet_fil(zbillede,1);
3 2251 end sletfil;
2 2252 \f
2 2252 message opretspoolfil side 0 - 810526/cl;
2 2253
2 2253 procedure opretspoolfil;
2 2254 <* opretter en spoolfil og returnerer intern filid *>
2 2255
2 2255 begin
3 2256 integer array field op;
3 2257 integer bidantal,fno,i,bs,bidstart;
3 2258
3 2258 procedure skriv_opret_spoolfil(z,omfang);
3 2259 value omfang;
3 2260 zone z;
3 2261 integer omfang;
3 2262 begin
4 2263 write(z,"nl",1,<:+++ opret spoolfil :>);
4 2264 if omfang > 0 then
4 2265 disable
4 2266 begin
5 2267 skriv_coru(z,abs curr_coruno);
5 2268 write(z,"nl",1,<<d>,
5 2269 <:op :>,op,"nl",1,
5 2270 <:bidantal:>,bidantal,"nl",1,
5 2271 <:fno :>,fno,"nl",1,
5 2272 <:i :>,i,"nl",1,
5 2273 <:bs :>,bs,"nl",1,
5 2274 <:bidstart:>,bidstart,"nl",1,
5 2275 <::>);
5 2276 end;
4 2277 end skriv_opret_spoolfil;
3 2278 \f
3 2278 message opretspoolfil side 1 - 810526/cl;
3 2279
3 2279 stack_claim(if cm_test then 200 else 150);
3 2280
3 2280 signalbin(bs_kats_fri); <*initialiseres til åben*>
3 2281
3 2281 trap(opretspool_trap);
3 2282 <*+2*>
3 2283 <**> disable if testbit28 then
3 2284 <**> skriv_opret_spoolfil(out,0);
3 2285 <*-2*>
3 2286 trin1:
3 2287 waitch(cs_opret_spoolfil,op,true,-1);
3 2288
3 2288 trin2:
3 2289 bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
3 2290 wait(bs_kats_fri);
3 2291
3 2291 trin3:
3 2292 if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
3 2293 begin
4 2294 wait(bs_kats_fri);
4 2295 goto trin3;
4 2296 end;
3 2297 disable begin
4 2298
4 2298 <*alloker bidder*>
4 2299 bs:= bidstart:= dbkatbfri;
4 2300 for i:= bidantal-1 step -1 until 1 do
4 2301 bs:= dbkatb(bs) extract 12;
4 2302 dbkatbfri:= dbkatb(bs) extract 12;
4 2303 dbkatb(bs):= false; <*sidste ref null*>
4 2304 dbantb:= dbantb+bidantal;
4 2305
4 2305 <*alloker indgang*>
4 2306 fno:= dbkatsfri;
4 2307 dbkatsfri:= dbkats(fno,2);
4 2308 dbantsf:= dbantsf +1;
4 2309 dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
4 2310 d.op.data(2) extract 9; <*postlængde*>
4 2311 dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
4 2312 \f
4 2312 message opretspoolfil side 2 - 810526/cl;
4 2313
4 2313 <*returner*>
4 2314 d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
4 2315 d.op.data(4):= 2 shift 10 add fno; <*filref*>
4 2316 for i:= 5 step 1 until 8 do <*filnavn null*>
4 2317 d.op.data(i):= 0;
4 2318 d.op.data(9):= 0; <*status ok*>
4 2319
4 2319 <*+2*>
4 2320 <*tz*> if testbit24 and overvåget then <*zt*>
4 2321 <*tz*> begin <*zt*>
5 2322 <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
5 2323 <*tz*> pfdim(d.op.data); <*zt*>
5 2324 <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
5 2325 <*tz*> end; <*zt*>
4 2326 <*-2*>
4 2327
4 2327 signalch(d.op.retur,op,d.op.optype);
4 2328 if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
4 2329 end;
3 2330 goto trin1;
3 2331
3 2331 opretspool_trap:
3 2332 disable skriv_opret_spoolfil(zbillede,1);
3 2333
3 2333 end opretspoolfil;
2 2334 \f
2 2334 message opreteksternfil side 0 - 810526/cl;
2 2335
2 2335 procedure opreteksternfil;
2 2336 <* opretter og knytter en ekstern fil *>
2 2337
2 2337 begin
3 2338 integer array field op;
3 2339 integer status,s,i,fno,p_nøgle;
3 2340 integer array tail(1:10),zd(1:20);
3 2341 real r;
3 2342 real array field enavn;
3 2343
3 2343 procedure skriv_opret_ekstfil(z,omfang);
3 2344 value omfang;
3 2345 zone z;
3 2346 integer omfang;
3 2347 begin
4 2348 write(z,"nl",1,<:+++ opret ekstern fil :>);
4 2349 if omfang > 0 then
4 2350 disable
4 2351 begin real array field raf;
5 2352 skriv_coru(z,abs curr_coruno);
5 2353 write(z,"nl",1,<<d>,
5 2354 <:op :>,op,"nl",1,
5 2355 <:status :>,status,"nl",1,
5 2356 <:s :>,s,"nl",1,
5 2357 <:i :>,i,"nl",1,
5 2358 <:fno :>,fno,"nl",1,
5 2359 <:p-nøgle:>,p_nøgle,"nl",1,
5 2360 <::>);
5 2361 raf:= 0;
5 2362 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 2363 write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
5 2364 end;
4 2365 end skriv_opret_ekstfil;
3 2366 \f
3 2366 message opreteksternfil side 1 - 810526/cl;
3 2367
3 2367 stack_claim(if cm_test then 200 else 150);
3 2368
3 2368 signalbin(bs_kate_fri); <*initialiseres til åben*>
3 2369
3 2369 trap(opretekst_trap);
3 2370 <*+2*>
3 2371 <**> disable if testbit28 then
3 2372 <**> skriv_opret_ekstfil(out,0);
3 2373 <*-2*>
3 2374 trin1:
3 2375 waitch(cs_opret_eksternfil,op,true,-1);
3 2376
3 2376 trin2:
3 2377 wait(bs_kate_fri);
3 2378
3 2378 trin3:
3 2379 <*opret temporær fil og tilknyt den*>
3 2380 disable begin
4 2381
4 2381 enavn:= 8;
4 2382 <*opret*>
4 2383 open(zdummy,0,d.op.data.enavn,0);
4 2384 tail(1):= d.op.data(3); <*segant*>
4 2385 tail(2):= 1;
4 2386 tail(6):= systime(7,0,r); <*shortclock*>
4 2387 tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
4 2388 tail(8):= 0;
4 2389 tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
4 2390 tail(10):= d.op.data(1); <*postantal*>
4 2391 s:= monitor(40)create entry:(zdummy,0,tail);
4 2392 if s<>0 then
4 2393 begin
5 2394 if s=4 <*claims exeeded*> then
5 2395 begin
6 2396 status:= 4;
6 2397 fejlreaktion(1,s,<:create entry:>,1);
6 2398 goto returner;
6 2399 end;
5 2400 if s=3 <*navn ikke unikt*> then
5 2401 begin status:= 6; goto returner; end;
5 2402 fejlreaktion(1,s,<:create entry:>,0);
5 2403 end;
4 2404 \f
4 2404 message opreteksternfil side 2 - 810203/cl;
4 2405
4 2405 p_nøgle:= d.op.opkode shift (-12);
4 2406 s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
4 2407 if s<>0 then
4 2408 begin
5 2409 if s=6 then
5 2410 begin <*claims exeeded*>
6 2411 status:= 4;
6 2412 fejlreaktion(1,s,<:permanent entry:>,1);
6 2413 monitor(48)remove entry:(zdummy,0,tail);
6 2414 goto returner;
6 2415 end
5 2416 else fejlreaktion(1,s,<:permanent entry:>,0);
5 2417 end;
4 2418
4 2418 <*reserver*>
4 2419 s:= monitor(52)create areaprocess:(zdummy,0,zd);
4 2420 if s<>0 then
4 2421 begin
5 2422 fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
5 2423 status:= 4;
5 2424 monitor(48)remove entry:(zdummy,0,zd);
5 2425 goto returner;
5 2426 end;
4 2427
4 2427 s:= monitor(8)reserve:(zdummy,0,zd);
4 2428 if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
4 2429
4 2429 <*tilknyt*>
4 2430 dbantef:= dbantef +1;
4 2431 fno:= dbkatefri;
4 2432 dbkatefri:= dbkate(fno,2);
4 2433 dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
4 2434 dbkate(fno,2):= tail(1);
4 2435 getzone6(zdummy,zd);
4 2436 for i:= 2 step 1 until 5 do
4 2437 dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
4 2438 d.op.data(3):= tail(1);
4 2439 d.op.data(4):= 3 shift 10 +fno;
4 2440 status:= 0;
4 2441 \f
4 2441 message opreteksternfil side 3 - 810526/cl;
4 2442
4 2442 returner:
4 2443
4 2443 close(zdummy,false);
4 2444 d.op.data(9):= status;
4 2445
4 2445 <*+2*>
4 2446 <*tz*> if testbit24 and overvåget then <*zt*>
4 2447 <*tz*> begin <*zt*>
5 2448 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 2449 <*tz*> pfdim(d.op.data); <*zt*>
5 2450 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2451 <*tz*> end; <*zt*>
4 2452 <*-2*>
4 2453
4 2453 signalch(d.op.retur,op,d.op.optype);
4 2454 if dbantef<dbmaxef then signalbin(bs_kate_fri);
4 2455 end;
3 2456 goto trin1;
3 2457
3 2457 opretekst_trap:
3 2458 disable skriv_opret_ekstfil(zbillede,1);
3 2459
3 2459 end opreteksternfil;
2 2460
2 2460 \f
2 2460 message attention_erklæringer side 1 - 850820/cl;
2 2461
2 2461 integer
2 2462 tf_kommandotabel,
2 2463 cs_att_pulje,
2 2464 bs_fortsæt_adgang,
2 2465 att_proc_ref;
2 2466
2 2466 integer array
2 2467 att_flag,
2 2468 att_signal(1:att_maske_lgd//2);
2 2469
2 2469 integer array
2 2470 terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
2 2471 max_antal_operatører+max_antal_garageterminaler)),
2 2472 fortsæt(1:32);
2 2473 \f
2 2473 message procedure afslut_kommando side 1 - 810507/hko;
2 2474
2 2474 procedure afslut_kommando(op_ref);
2 2475 integer array field op_ref;
2 2476 begin integer nr,i,sem;
3 2477 i:= d.op_ref.kilde;
3 2478 nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
3 2479 else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
3 2480 sætbit_ia(att_flag,nr,0);
3 2481 d.op_ref.optype:=gen_optype;
3 2482 <* "husket" attention disabled ****************
3 2483 if sætbit_ia(att_signal,nr,0)=1 then
3 2484 begin
3 2485 sem:=if i=299 then cs_talevejsswitch else
3 2486 case i//100 of (cs_io_komm,cs_operatør(i mod 100),
3 2487 cs_garage(i mod 100));
3 2488 afslut_operation(op_ref,0);
3 2489 start_operation(op_ref,i,cs_att_pulje,0);
3 2490 signal_ch(sem,op_ref,gen_optype);
3 2491 end
3 2492 else
3 2493 ********************* disable "husket" attention *>
3 2494 afslut_operation(op_ref,cs_att_pulje);
3 2495 end;
2 2496 \f
2 2496 message procedure læs_store side 1 - 880919/cl;
2 2497
2 2497 integer procedure læs_store(z,c);
2 2498 zone z;
2 2499 integer c;
2 2500 begin
3 2501 læs_store:= readchar(z,c);
3 2502 if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
3 2503 end;
2 2504 \f
2 2504 message procedure param side 1 - 810226/cl;
2 2505
2 2505
2 2505
2 2505 integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
2 2506 value tabel_id;
2 2507 integer pos, tabel_id, type, sep;
2 2508 integer array txt, spec, værdi;
2 2509
2 2509
2 2509
2 2509 <*************************************>
2 2510 <* *>
2 2511 <* CLAUS LARSEN: 15.07.77 *>
2 2512 <* *>
2 2513 <*************************************>
2 2514
2 2514
2 2514
2 2514
2 2514 <* param syntax-analyserer en parameterliste, og *>
2 2515 <* bestemmer næste parameter og den separator der *>
2 2516 <* afslutter parameteren *>
2 2517
2 2517
2 2517
2 2517 begin
3 2518 integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
3 2519 real array indgang(1:2);
3 2520 integer i, j, tegn, tegn_pos, tal, hashnøgle,
3 2521 zone_nr, top, max_segm, start_segm, lpos;
3 2522 boolean minus, separator;
3 2523 lpos := pos;
3 2524 type:=-1;
3 2525 for i:=1 step 1 until 4 do værdi(i):=0;
3 2526 \f
3 2526 message procedure param side 2 - 810428/cl,hko;
3 2527
3 2527
3 2527
3 2527 <* grænsecheck for pos *>
3 2528 begin
4 2529 integer nedre, øvre;
4 2530
4 2530 nedre := system(3,øvre,txt);
4 2531 nedre := nedre * 3 - 2;
4 2532 øvre := øvre * 3;
4 2533 if lpos < (nedre - 1) or øvre < lpos then
4 2534 begin
5 2535 sep:= -1;
5 2536 param:= 5;
5 2537 goto slut;
5 2538 end;
4 2539
4 2539 <* er parameterlisten slut *>
4 2540 lpos:= lpos+1;
4 2541 læs_tegn(txt,lpos,tegn);
4 2542 if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
4 2543 begin
5 2544 lpos := lpos - 2;
5 2545 sep := tegn;
5 2546 param := 5;
5 2547
5 2547 goto slut;
5 2548 end else lpos:= lpos-1;
4 2549 end;
3 2550 \f
3 2550 message procedure param side 3 - 810428/cl;
3 2551
3 2551
3 2551 <* initialisering *>
3 2552 for i := 1 step 1 until 4 do
3 2553 aktuel_param(i) := 0;
3 2554 minus := separator := false;
3 2555
3 2555 <* initialiser klassetabel *>
3 2556 for i := 65 step 1 until 93,
3 2557 97 step 1 until 125 do klasse(i) := 1;
3 2558 for i := 48 step 1 until 57 do klasse(i) := 2;
3 2559 for i := 0 step 1 until 47, 58 step 1 until 64,
3 2560 94, 95, 96, 126, 127 do klasse(i) := 4;
3 2561
3 2561
3 2561 <* sæt specialtegn *>
3 2562 i := 1;
3 2563 læs_tegn(spec,i,tegn);
3 2564 while tegn <> 0 do
3 2565 begin
4 2566 if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
4 2567 klasse(tegn) := 3;
4 2568 læs_tegn(spec,i,tegn);
4 2569 end;
3 2570 \f
3 2570 message procedure param side 4 - 810226/cl;
3 2571
3 2571
3 2571 <* læs første tegn i ny parameter og bestem typen *>
3 2572 læs_tegn(txt,lpos,tegn);
3 2573
3 2573 case klasse(tegn) of
3 2574 begin
4 2575
4 2575 <* case 1 - bogstav *>
4 2576 begin
5 2577 type := 0;
5 2578 param := 0;
5 2579 tegn_pos := 1;
5 2580 hashnøgle := 0;
5 2581
5 2581 <* læs parameter *>
5 2582 while tegn_pos < 12 and klasse(tegn) <> 4 do
5 2583 begin
6 2584 hashnøgle := hashnøgle + tegn;
6 2585 skriv_tegn(aktuel_param,tegn_pos,tegn);
6 2586 læs_tegn(txt,lpos,tegn);
6 2587 end;
5 2588
5 2588 <* find separator *>
5 2589 while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
5 2590 sep := tegn;
5 2591 \f
5 2591 message procedure param side 5 - 810226/cl;
5 2592
5 2592 <* tabelopslag *>
5 2593 if tabel_id <> 0 then
5 2594 begin
6 2595 <* hent max_segm *>
6 2596
6 2596 fdim(4) := tabel_id;
6 2597 j := hent_fil_dim(fdim);
6 2598 if j > 0 then
6 2599 begin
7 2600 param := 4;
7 2601 for i := 1 step 1 until 4 do
7 2602 værdi(i) := aktuel_param(i);
7 2603 goto slut;
7 2604 end;
6 2605 max_segm := fdim(3);
6 2606
6 2606 <* forbered opslag *>
6 2607 start_segm := (hashnøgle mod max_segm) + 1;
6 2608 indgang(1) := 0.0 shift 48 add aktuel_param(1)
6 2609 shift 24 add aktuel_param(2);
6 2610 indgang(2) := 0.0 shift 48 add aktuel_param(3)
6 2611 shift 24 add aktuel_param(4);
6 2612 hashnøgle := start_segm;
6 2613 \f
6 2613 message procedure param side 6 - 810226/cl;
6 2614
6 2614 <* søg navn *>
6 2615 repeat
6 2616 <* læs segment *>
6 2617 læs_fil(tabel_id,hashnøgle,zone_nr);
6 2618
6 2618 <* beregn sidste element *>
6 2619 top := fil(zone_nr,1) extract 24;
6 2620 top := (top - 1) * 4 + 2;
6 2621
6 2621 <* søg *>
6 2622 for i := 2 step 4 until top do
6 2623 if fil(zone_nr,i) = indgang(1) and
6 2624 fil(zone_nr,i+1) = indgang(2) then
6 2625 begin
7 2626 <* fundet *>
7 2627 værdi(1) := fil(zone_nr,i+2) shift (-24)
7 2628 extract 24;
7 2629 værdi(2) := fil(zone_nr,i+2) extract 24;
7 2630 værdi(3) := fil(zone_nr,i+3) shift (-24)
7 2631 extract 24;
7 2632 værdi(4) := fil(zone_nr,i+3) extract 24;
7 2633 goto fundet;
7 2634 end;
6 2635
6 2635 if top = 122 then <*overløb *>
6 2636 hashnøgle := (hashnøgle mod max_segm) + 1;
6 2637 until top < 122 or hashnøgle = start_segm;
6 2638
6 2638 <* navn findes ikke *>
6 2639 param := 2;
6 2640 for j := 1 step 1 until 4 do
6 2641 værdi(j) := aktuel_param(j);
6 2642 fundet: ;
6 2643 end <*tabel_id <> 0 *>
5 2644 else
5 2645 for i := 1 step 1 until 4 do
5 2646 værdi(i) := aktuel_param(i);
5 2647 end <* case 1 *>;
4 2648 \f
4 2648 message procedure param side 7 - 810310/cl,hko;
4 2649
4 2649 <* case 2 - ciffer *>
4 2650 cif: begin
5 2651 type:=tal := 0;
5 2652 while klasse(tegn) = 2 do
5 2653 begin
6 2654 type:=type+1;
6 2655 tal := tal * 10 + (tegn - 48);
6 2656 læs_tegn(txt,lpos,tegn);
6 2657 end;
5 2658 if minus then tal := -tal;
5 2659 værdi(1) := tal;
5 2660 sep := tegn;
5 2661 param := 0;
5 2662 end <* case 2 *>;
4 2663 \f
4 2663 message procedure param side 8 - 810428/cl;
4 2664
4 2664 <* case 3 - specialtegn *>
4 2665 spc: begin
5 2666 if tegn = '-' then
5 2667 begin
6 2668 læs_tegn(txt,lpos,tegn);
6 2669 if klasse(tegn) = 2 then
6 2670 begin
7 2671 minus := true;
7 2672 goto cif;
7 2673 end
6 2674 else
6 2675 begin
7 2676 tegn := '-';
7 2677 lpos := lpos - 1;
7 2678 end;
6 2679 end;
5 2680 <* syntaxfejl *>
5 2681 param := if separator then 1 else 3;
5 2682 sep := tegn;
5 2683 end <* case 3 *>;
4 2684
4 2684 <* case 4 - separator *>
4 2685 begin
5 2686 separator := true;
5 2687 goto spc;
5 2688 end <* case 4 *>;
4 2689
4 2689 end <* case *>;
3 2690
3 2690 lpos := lpos - 1;
3 2691 slut:
3 2692 pos := lpos;
3 2693 end;
2 2694 \f
2 2694 message procedure læs_param_sæt side 1 - 830310/cl;
2 2695
2 2695 integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
2 2696 integer array tekst, parm;
2 2697 integer pos,ant, term,res;
2 2698
2 2698 <* proceduren læser et sammenhørende sæt parametre
2 2699 afsluttet med (sp),(nl),(;),(,) eller (nul)
2 2700
2 2700 læs_param_sæt returstatus eller 'typen' af det læste parametersæt
2 2701 (retur,int)
2 2702 type ant parm indeholder:
2 2703 <0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
2 2704 0: 0 (ingenting) 'rest kommando er tom'
2 2705 1: 1 (tekst) 'indtil 11 tegn'
2 2706 2: 1 (pos.tal)
2 2707 3: 1 (neg.tal)
2 2708 4: 1 (pos.tal<1000)(bogstav) 'linienummer'
2 2709 5: 1 G(pos.tal<100) 'gruppe_ident'
2 2710 6: 2 (linie)/(løb) 'vogn_ident'
2 2711 7: 3 (bus)/(linie)/(løb)
2 2712 8: 3 (linie).(indeks):(løb)
2 2713 9: 2 (linie).(indeks)
2 2714 10: 2 (pos.tal).(pos.tal)
2 2715 11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
2 2716 12: 3 D.(dato).(tid)
2 2717
2 2717 tekst indeholder teksten hvori parametersættet
2 2718 (kald,int.arr.) skal søges.
2 2719
2 2719 pos
2 2720 (kald/retur,int.) position efter hvilken søgningen starter, og
2 2721 ved retur positionen for afsluttende tegn.
2 2722 (ikke ændret ved fejl)
2 2723
2 2723 ant hvis kaldeværdien er >0 skal parametersættet
2 2724 (kald/retur,int) indeholde det angivne antal enkeltparametre,
2 2725 i modsat fald returneres med fejltype -26
2 2726 (skilletegn) eller -25 (parameter mangler).
2 2727 ellers læses op til 3 enkeltparametre. retur-
2 2728 værdien afhænger af det læste parametersæts
2 2729 type, se ovenfor under læs_param_sæt.
2 2730 \f
2 2730 message procedure læs_param_sæt side 2 - 810428/hko;
2 2731
2 2731 parm skal omfatte elementerne 1 til 4.
2 2732 (retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
2 2733 terne værdien 0.
2 2734
2 2734 type (element,indhold)
2 2735 1: 1-4,teksten
2 2736 2-3: 1, talværdien
2 2737 4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
2 2738 5: 1, talværdi (uden G)
2 2739 6: 1, (som'4') shift 7 + løb
2 2740 7: 1, bus
2 2741 2, linie/løb som '6'
2 2742 8: 1, tal shift 5 eller som '4'
2 2743 2, tekst (1-3 bogstaver)
2 2744 3, løb
2 2745 9: 1 og 2, som '8'
2 2746 10: 1, talværdi
2 2747 2, talværdi
2 2748 11: 1, som '5'
2 2749 2, vogn (bus eller linie/løb)
2 2750 12: 1, dato
2 2751 2, tid
2 2752
2 2752 term iso-tegnværdien for tegnet der afslutter
2 2753 (retur,int) parameter_sættet.
2 2754
2 2754 res som læs_param_sæt.
2 2755 (retur,int)
2 2756
2 2756 *>
2 2757 \f
2 2757 message procedure læs_param_sæt side 3 - 810310/hko;
2 2758
2 2758 begin
3 2759 integer max_ant;
3 2760
3 2760 max_ant:= 3;
3 2761
3 2761 begin
4 2762 integer
4 2763 i,j,k, <* hjælpe variable *>
4 2764 nr, <* nummer på parameter i sættet *>
4 2765 apos, <* aktuel tegnposition *>
4 2766 cifre, <* parametertype (param: 0=tekst, >1=tal) *>
4 2767 sep; <* afsluttende skilletegn ved param *>
4 2768
4 2768 integer array field
4 2769 iaf; <* hjælpe variabel *>
4 2770
4 2770 integer array
4 2771 par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
4 2772 s, <* 1 element med separator for hver parameter *>
4 2773 t(1:max_ant), <* 1 element med typen for hver parameter *>
4 2774 værdi(1:4), <* værdi af aktuel parameter jvf. param *>
4 2775 spec(1:1); <* specialtegn i navne jvf. param *>
4 2776
4 2776 <* de interne typer af enkeltparametre er
4 2777
4 2777 type parameter
4 2778
4 2778 1: 1-3 tegn tekst (1 ord)
4 2779 2: 4-6 tegn (2 ord)
4 2780 3: 7-9 tegn (3 ord)
4 2781 4:10-11 tegn (4 ord)
4 2782 5: positivt heltal
4 2783 6: negativt heltal
4 2784 7: positivt heltal<1000 efterfulgt af stort bogstav
4 2785 8: G efterfulgt af positivt heltal<100
4 2786
4 2786 *>
4 2787 \f
4 2787 message procedure læs_param_sæt side 4 - 810408/hko;
4 2788
4 2788 nr:= 0;
4 2789 res:= -1;
4 2790 spec(1):= 0; <* ingen specialtegn *>
4 2791 apos:= pos;
4 2792 for i:= 1 step 1 until 4 do parm(i):= 0;
4 2793 for i:= 1 step 1 until max_ant do
4 2794 begin
5 2795 s(i):= t(i):= 0;
5 2796 for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
5 2797 end;
4 2798 repeat
4 2799 <* skip foranstillede sp-tegn *>
4 2800 for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
4 2801 while i=1 and sep='sp' do;
4 2802 <*+2*>
4 2803 begin
5 2804 if testbit25 and testbit26 then
5 2805 disable begin
6 2806 write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
6 2807 i,apos,cifre,sep);
6 2808 laf:=0;
6 2809 if cifre<>0 then
6 2810 write(out,<: værdi(1-4)::>,
6 2811 << -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
6 2812 else write(out,<: værdi::>,værdi.laf);
6 2813 ud;
6 2814 end;
5 2815 end;
4 2816 <*-2*>
4 2817 ;
4 2818 if i<>0 then <* ikke ok *>
4 2819 begin
5 2820 if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
5 2821 begin
6 2822 apos:= apos -1;
6 2823 res:= 0;
6 2824 end
5 2825 else if i=1 then res:=-26 <* skilletegn *>
5 2826 else <* i=5 *> res:= -25 <* parameter mangler *>
5 2827 end
4 2828 else <* i=0 *>
4 2829 begin
5 2830 if sep=',' or sep=';' then apos:=apos-1;
5 2831 iaf:= nr*8;
5 2832 nr:= nr +1;
5 2833 \f
5 2833 message procedure læs_param_sæt side 5 - 810520/hko/cl;
5 2834
5 2834 if cifre=0 <* navne_parameter *> then
5 2835 begin
6 2836 if værdi(2)=0
6 2837 and læstegn(værdi,1,i)='G'
6 2838 and læstegn(værdi,2,j)>'0' and j<='9'
6 2839 and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
6 2840 then
6 2841 begin <* gruppenavn, repræsenteres som tal *>
7 2842 t(nr):= 8;
7 2843 j:= j -'0';
7 2844 par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
7 2845 s(nr):= sep;
7 2846 end
6 2847 else
6 2848 begin <* generel tekst *>
7 2849 i:= 0;
7 2850 for i:= i +1 while i<=4 do
7 2851 begin
8 2852 if værdi(i)<>0 then
8 2853 begin
9 2854 t(nr):= i;
9 2855 par.iaf(i):= værdi(i);
9 2856 end
8 2857 else i:= 4;
8 2858 end;
7 2859 s(nr):= sep;
7 2860 end <* generel tekst *>
6 2861 end <* navne_parameter *>
5 2862 else
5 2863 begin <* talparameter *>
6 2864 i:= if værdi(1)<0 then 6 <* neg.tal *>
6 2865 else if værdi(1)>0 and værdi(1)<1000
6 2866 and sep>='A' and sep<='Å' then 7
6 2867 else 5 <* positivt tal *>;
6 2868 t(nr):= i;
6 2869 par.iaf(1):= if i<>7 then værdi(1)
6 2870 else værdi(1) shift 5 +(sep+1-'A');
6 2871 par.iaf(2):= cifre;
6 2872 apos:= apos+1;
6 2873 s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
6 2874 apos:= apos-1;
6 2875 end;
5 2876 end;<* i=0 *>
4 2877 until (ant>0 and nr=ant)
4 2878 or nr=max_ant
4 2879 or res<> -1
4 2880 or sep='sp' or sep=';' or sep='em'
4 2881 or sep=',' or sep='nl' or sep='nul';
4 2882 \f
4 2882 message procedure læs_param_sæt side 6 - 810508/hko;
4 2883
4 2883 if ant>nr then res:= -25 <*parameter mangler*>
4 2884 else
4 2885 if nr=0 or t(1)=0 then
4 2886 begin <* ingen parameter før skilletegn *>
5 2887 if res=-25 then res:= 0;
5 2888 end
4 2889 else if sep<>'sp' and sep<>'nl' and sep <> 'em'
4 2890 and sep<>';' and sep<>',' then
4 2891 begin <* ulovligt afsluttende skilletegn *>
5 2892 res:= -26;
5 2893 end
4 2894 else
4 2895 begin <* en eller flere lovligt afsluttede parametre *>
5 2896 if t(1)<5 and nr=1 then
5 2897
5 2897 <* 1 navne_parameter *>
5 2898
5 2898 begin
6 2899 res:= 1;
6 2900 tofrom(parm,par,8);
6 2901 end
5 2902 else if <*t(1)<9 and *> nr=1 then
5 2903
5 2903 <* 1 parameter af anden type *>
5 2904
5 2904 begin <*tal,linie eller gruppe *>
6 2905 res:= t(1) -3;
6 2906 parm(1):= par(1);
6 2907 end
5 2908 else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
5 2909
5 2909 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
5 2910
5 2910 begin
6 2911 i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
6 2912 j:= par(5); <* internt *>
6 2913 k:= par(9); <* *>
6 2914 if nr=2 then
6 2915 <* 2 parametre i sættet *>
6 2916 begin
7 2917 res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
7 2918 else if s(1)='.' and t(2)=1 then 9
7 2919 else if s(1)='-' and t(1)=5 and t(2)=5 then 10
7 2920 else if s(1)<>'/' and s(1)<>'.'
7 2921 and s(1)<>'-' then -26 <* skilletegn *>
7 2922 else -27;<* parametertype*>
7 2923 \f
7 2923 message procedure læs_param_sæt side 7 - 810501/hko;
7 2924
7 2924 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2925
7 2925 <* 2 parametre i sættet *>
7 2926 if res=6 then
7 2927 begin
8 2928 if (i<1 or i>999) and t(1)=5 then
8 2929 res:= -5 <* ulovligt linienr *>
8 2930 else if (j<1 or j>99) then
8 2931 res:= -6 <* ulovligt løbsnr *>
8 2932 else
8 2933 begin
9 2934 if t(1)=5 then i:= i shift 5;
9 2935 parm(1):= i shift 7 +j;
9 2936 end;
8 2937 end <* res=6 *>
7 2938 else if res=9 then
7 2939 begin
8 2940 if t(1)=5 and (i<1 or 999<i) then
8 2941 res:= -5 <*ulovligt linienr*>
8 2942 else
8 2943 begin
9 2944 if t(1)=5 then i:=i shift 5;
9 2945 parm(1):= i;
9 2946 parm(2):= j;
9 2947 end;
8 2948 end <* res=9 *>
7 2949 else if res=10 then
7 2950 begin
8 2951 begin
9 2952 parm(1):= i;
9 2953 parm(2):= j;
9 2954 end;
8 2955 end; <* res=10 *>
7 2956 end <* nr=2 *>
6 2957 else
6 2958 if nr=3 then
6 2959 <* 3 paramtre i sættet *>
6 2960 begin
7 2961 res:= if (s(1)='/' or s(1)='.') and
7 2962 (s(2)='/' or s(2)='.') then 7
7 2963 else if s(1)='.' and s(2)=':' then 8
7 2964 else -26; <* skilletegn *>
7 2965 \f
7 2965 message procedure læs_param_sæt side 8 - 810501/hko;
7 2966
7 2966 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2967 <* 3 parametre i sættet *>
7 2968 if res=7 then
7 2969 begin
8 2970 if t(1)<>5 or (t(2)<>5 and t(2)<>7)
8 2971 or t(3)<>5 then
8 2972 res:= -27 <* parametertype *>
8 2973 else
8 2974 if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
8 2975 else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
8 2976 else if k<1 or k>99 then res:= -6 <* løb *>
8 2977 else
8 2978 begin <* ok *>
9 2979 parm(1):= i;
9 2980 if t(2)=5 then j:= j shift 5;
9 2981 parm(2):= j shift 7 +k;
9 2982 end;
8 2983 end
7 2984 else if res=8 then
7 2985 begin
8 2986 if t(2)<>1 or t(3)<>5 then res:= -27
8 2987 else if t(1)=5 and (i<1 or i>999) then res:= -5
8 2988 else if k<1 or k>99 then res:= -6
8 2989 else
8 2990 begin
9 2991 if t(1)=5 then i:= i shift 5;
9 2992 parm(1):= i;
9 2993 parm(2):= j;
9 2994 parm(3):= k;
9 2995 end;
8 2996 end;
7 2997 end <* nr=3 *>
6 2998 else res:=-24; <* syntaks *>
6 2999 \f
6 2999 message procedure læs_param_sæt side 9 - 810428/hko;
6 3000
6 3000 end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
5 3001 else if t(1)=8 <* gruppe_id *> then
5 3002 begin
6 3003 <* mere end 1 parameter , hvoraf den første
6 3004 er en gruppe_identifikation ved navn.
6 3005 lovlige parametre er alle internt repræsenteret i et ord *>
6 3006
6 3006 i:=par(1);
6 3007 j:=par(5);
6 3008 k:=par(9);
6 3009
6 3009 if nr=2 then
6 3010 <* 2 parametre *>
6 3011 begin
7 3012 res:=if s(1)=':' and t(2)=5 then 11
7 3013 else if s(1)<>':' then -26 <* skilletegn *>
7 3014 else -27; <*param.type *>
7 3015 if res=11 then
7 3016 begin
8 3017 if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
8 3018 else
8 3019 begin
9 3020 parm(1):=i;
9 3021 parm(2):=j;
9 3022 end;
8 3023 end;
7 3024 \f
7 3024 message procedure læs_param_sæt side 10 - 810428/hko;
7 3025
7 3025 <* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
7 3026
7 3026 end <*nr=2*>
6 3027 else if nr=3 then
6 3028 <* 3 parametre *>
6 3029 begin
7 3030 res:=if s(1)=':' and s(2)='/' then 11
7 3031 else -26; <* skilletegn *>
7 3032 if res=11 then
7 3033 begin
8 3034 if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
8 3035 else
8 3036 begin
9 3037 if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
9 3038 else
9 3039 begin
10 3040 parm(1):=i;
10 3041 if t(2)=5 then j:=j shift 5;
10 3042 parm(2):= 1 shift 22 +j shift 7 +k;
10 3043 end;
9 3044 end;
8 3045 end;
7 3046 end <* nr=3 *>
6 3047 else res:=-24; <* syntaks *>
6 3048 \f
6 3048 message procedure læs_param_sæt side 11 - 810501/hko;
6 3049
6 3049 end <* t(1)=8 *>
5 3050 else if t(1)=1 and par(1)= 'D' shift 16 then
5 3051 begin
6 3052 <* mere end 1 parameter i sættet og 1. parameter er et 'D'.
6 3053 lovlige parametre er alle internt repræsenteret i et ord. *>
6 3054 i:=par(1);
6 3055 j:=par(5);
6 3056 k:=par(9);
6 3057
6 3057 if nr=3 then
6 3058 begin
7 3059 res:=if s(1)='.' and s(2)='.' then 12
7 3060 else -26; <* skilletegn *>
7 3061 if res=12 then
7 3062 begin
8 3063 if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
8 3064 else
8 3065 begin
9 3066 integer år,md,dg,tt,mm,ss;
9 3067 real dato,tid;
9 3068 år:=j//10000;
9 3069 md:=(j//100) mod 100;
9 3070 dg:=j mod 100;
9 3071 cifre:= par(10);
9 3072 tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
9 3073 else k;
9 3074 mm:=if cifre>4 then (k//100) mod 100
9 3075 else if cifre>2 then k mod 100 else 0;
9 3076 ss:=if cifre>4 then k mod 100 else 0;
9 3077 \f
9 3077 message procedure læs_param_sæt side 12 - 810501/hko;
9 3078
9 3078 dato:=systime(5,0.0,tid);
9 3079 if j=0 then dg:=round dato mod 100;
9 3080 if år=0 and md=0 then md:=(round dato//100) mod 100;
9 3081 if år=0 then år:=round dato//10000;
9 3082 if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
9 3083 res:=-24 <* syntaks *>
9 3084 else if dg<1 or dg > (case md of (
9 3085 31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
9 3086 31,31,30, 31,30,31)) then res:=-24
9 3087 else
9 3088 begin
10 3089 parm(1):=år*10000+md*100+dg;
10 3090 parm(2):=tt*10000+mm*100+ss;
10 3091 end;
9 3092 end;
8 3093
8 3093 end; <* res=12 *>
7 3094 end <* nr=3 *>
6 3095 else res:=-24; <*syntaks*>
6 3096 end <* t(1)=1 and par(1)='D' shift 16 *>
5 3097
5 3097 else res:=-27;<*parametertype*>
5 3098 end; <* en eller flere parametre *>
4 3099
4 3099 læs_param_sæt:= res;
4 3100 term:= sep;
4 3101 if res>= 0 then pos:= apos;
4 3102 end;
3 3103 end læs_param_sæt;
2 3104 \f
2 3104 message procedure læs_kommando side 1 - 810428/hko;
2 3105
2 3105 integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
2 3106 value kilde;
2 3107 zone z;
2 3108 integer kilde, pos,indeks,sep,slut_tegn;
2 3109 integer array field op_ref;
2 3110
2 3110 <* proceduren indlæser er kommmando fra en terminal (telex,
2 3111 skærm eller skrivemaskine). ved indlæsning fra skærm eller
2 3112 skrivemaskine inviteres først ved udskrivning af '>'-tegn.
2 3113 for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
2 3114 23'ende linie inden invitation.
2 3115 *>
2 3116 \f
2 3116 message procedure læs_kommando side 2 - 810428/hko;
2 3117
2 3117 begin
3 3118 integer
3 3119 a_pos,
3 3120 a_res,res,
3 3121 i,j,k;
3 3122 boolean
3 3123 skip;
3 3124
3 3124 <*V*>setposition(z,0,0);
3 3125
3 3125 case kilde//100 of
3 3126 begin
4 3127 begin <* io *>
5 3128 write(z,"nl",1,">",1);
5 3129 end;
4 3130
4 3130 begin <* operatør *>
5 3131 cursor(z,24,1);
5 3132 write(z,"esc" add 128,1,<:ÆK:>);
5 3133 cursor(z,23,1);
5 3134 write(z,"esc" add 128,1,<:ÆK:>);
5 3135 outchar(z,'>');
5 3136 end;
4 3137
4 3137 begin <* garageterminal *> ;
5 3138 outchar(z,'nl');
5 3139 end
4 3140 end;
3 3141
3 3141 <*V*>setposition(z,0,0);
3 3142 \f
3 3142 message procedure læs_kommando side 3 - 810921/hko,cl;
3 3143
3 3143 res:=0;
3 3144 skip:= false;
3 3145 <*V*>
3 3146 k:=læs_store(z,i);
3 3147
3 3147 apos:= 1;
3 3148 while k<=6 <*klasse=bogstav*> do
3 3149 begin
4 3150 if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
4 3151 <*V*> k:= læs_store(z,i);
4 3152 end;
3 3153
3 3153 skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
3 3154
3 3154 if i=',' and a_pos>1 then
3 3155 begin
4 3156 skrivtegn(d.op_ref.data,a_pos,i);
4 3157 repeat
4 3158 <*V*> k:= læs_store(z,i);
4 3159 if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
4 3160 until k>=7;
4 3161 end;
3 3162
3 3162 pos:=a_pos;
3 3163 while k<8 do
3 3164 begin
4 3165 if a_pos< (att_op_længde//2*3-2) then
4 3166 skriv_tegn(d.op_ref.data,a_pos,i);
4 3167 skip:= skip or i='?';
4 3168 <*V*> k:= læs_store(z,i);
4 3169 pos:=pos+1;
4 3170 end;
3 3171
3 3171 skip:= skip or i='?' or i='esc';
3 3172 slut_tegn:= i;
3 3173 skrivtegn(d.op_ref.data,apos,'em');
3 3174 afslut_text(d.op_ref.data,apos);
3 3175 \f
3 3175 message procedure læs_kommando side 4 - 820301/hko/cl;
3 3176
3 3176 disable
3 3177 begin
4 3178 integer
4 3179 i1,
4 3180 nr,
4 3181 partype,
4 3182 cifre;
4 3183 integer array
4 3184 spec(1:1),
4 3185 værdi(1:4);
4 3186
4 3186 <*+2*>
4 3187 if testbit25 and overvåget then
4 3188 disable begin
5 3189 real array field raf;
5 3190 write(out,"nl",1,<:kommando læst::>);
5 3191 laf:=data;
5 3192 write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
5 3193 <: skip=:>,if skip then <:true:> else <:false:>);
5 3194 ud;
5 3195 end;
4 3196 <*-2*>
4 3197
4 3197 for i:=1 step 1 until 32 do ia(i):=0;
4 3198
4 3198 if skip then
4 3199 begin
5 3200 res:=53; <*annulleret*>
5 3201 pos:= -1;
5 3202 goto slut_læskommando;
5 3203 end;
4 3204 \f
4 3204 message procedure læs_kommando side 5 - 850820/cl;
4 3205
4 3205 i:= kilde//100; <* hovedmodul *>
4 3206 k:= kilde mod 100; <* løbenr *>
4 3207 <* if pos>79 then linieoverløb; *>
4 3208 pos:=a_pos:=0;
4 3209 spec(1):= ',' shift 16;
4 3210
4 3210 <*+4*>
4 3211 if k<1 or k>(case i of (1,max_antal_operatører,
4 3212 max_antal_garageterminaler)) then
4 3213 begin
5 3214 fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
5 3215 res:=31;
5 3216 end
4 3217 else
4 3218 <*-4*>
4 3219 if i>0 and i<4 then <* io, operatør eller garageterminal *>
4 3220 begin
5 3221 <* læs operationskode *>
5 3222 j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
5 3223
5 3223 res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
5 3224 else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
5 3225 else if j=2 then 4 <*ukendt kommando*>
5 3226 else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
5 3227 else if sep<>'sp' and sep<>','
5 3228 and sep<>'nl' and sep<>';'
5 3229 and sep<>'nul' and sep<>'em' then 26
5 3230 <*skilletegn*>
5 3231 else if -, læsbit_i(værdi(4),i-1) then 4
5 3232 <* logand(extend 0 add værdi(4)
5 3233 extend 1 shift (case i of (0,k,8+k)))=0 then 4
5 3234 *> <*ukendt kommando*>
5 3235 else 1;
5 3236 \f
5 3236 message procedure læs_kommando side 5a- 810409/hko;
5 3237
5 3237 <*+2*>if testbit25 and overvåget then
5 3238 begin
6 3239 write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
6 3240 << -dddd>,j,apos,cifre,sep,res,
6 3241 <: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
6 3242 "nl",0);
6 3243 if j<>0 then skriv_op(out,op_ref);
6 3244 ud;
6 3245 end;
5 3246 <*-2*>
5 3247
5 3247 if res=31 then fejlreaktion(18<*tabelfil*>,j,
5 3248 <:=res, filnr 1025, læskommando:>,0);
5 3249
5 3249 if res=1 then <* operationskode ok *>
5 3250 begin
6 3251 if sep<>'sp' then apos:=apos-1;
6 3252 d.op_ref.opkode:=værdi(1);
6 3253 indeks:=værdi(2);
6 3254 partype:= værdi(3);
6 3255 nr:= 0;
6 3256 pos:= apos;
6 3257 \f
6 3257 message procedure læs_kommando side 6 - 810409/hko;
6 3258
6 3258 while res=1 do
6 3259 begin
7 3260 læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
7 3261 værdi,sep,a_res);
7 3262 nr:= nr +1;
7 3263 i1:= værdi(1);
7 3264 <*+2*> if testbit25 and overvåget then
7 3265 begin
8 3266 write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
8 3267 apos,sep,ares,<: værdi(1-4)::>,
8 3268 værdi(1),værdi(2),værdi(3),værdi(4),
8 3269 "nl",0);
8 3270 ud;
8 3271 end;
7 3272 <*-2*>
7 3273 case par_type of
7 3274 begin
8 3275
8 3275 <*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
8 3276
8 3276 begin
9 3277 if nr=1 then
9 3278 begin
10 3279 if a_res=0 then res:=2 <*godkendt*>
10 3280 else if a_res=2 and (i1<1 or i1>9999)
10 3281 then res:=7 <*busnr ulovligt*>
10 3282 else if a_res=2 or a_res=6 then
10 3283 begin
11 3284 ia(1):= if a_res=2 then i1
11 3285 else 1 shift 22 +i1;
11 3286 end
10 3287 else res:= 27; <*parametertype*>
10 3288 if res<4 then pos:= apos;
10 3289 end <*nr=1*>
9 3290 else
9 3291 if nr=2 then
9 3292 begin
10 3293 if ares=0 then res:= 2 <*godkendt*>
10 3294 else if ares=1 then
10 3295 begin
11 3296 ia(2):= find_område(i1);
11 3297 if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
11 3298 end
10 3299 else res:= 27; <* syntaks, parametertype *>
10 3300 end
9 3301 else
9 3302 if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
9 3303 end;
8 3304 \f
8 3304 message procedure læs_kommando side 7 - 810226/hko;
8 3305
8 3305 <*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
8 3306
8 3306 begin
9 3307 if nr=1 then
9 3308 begin
10 3309 if a_res=0 then res:=25 <*parameter mangler*>
10 3310 else if a_res=2 and (i1<1 or i1>9999)
10 3311 then res:=7 <*busnr ulovligt*>
10 3312 else if a_res=2 or a_res=6 then
10 3313 begin
11 3314 ia(1):=if a_res=2 then i1
11 3315 else 1 shift 22 +i1;
11 3316 end
10 3317 else res:= 27; <*parametertype*>
10 3318 if res<4 then pos:=a_pos;
10 3319 end
9 3320 else
9 3321 if nr=2 then
9 3322 begin
10 3323 if ares=0 then res:= 2 <*godkendt*> else
10 3324 if ares=1 and ia(1) shift (-21) = 0 then
10 3325 begin
11 3326 ia(2):= findområde(i1);
11 3327 if ia(2)=0 then res:= 56; <*område ukendt*>
11 3328 end
10 3329 else res:= 27;
10 3330 if res<4 then pos:= apos;
10 3331 end
9 3332 else
9 3333 if ares=0 then res:= 2 else res:= 24<*syntaks*>;
9 3334 end;
8 3335 \f
8 3335 message procedure læs_kommando side 8 - 810223/hko;
8 3336
8 3336 <*3: (<linie>!G<nr>) *>
8 3337
8 3337 begin
9 3338 if nr=1 then
9 3339 begin
10 3340 if a_res=0 then res:=25 <*parameter mangler*>
10 3341 else if a_res=2 and (i1<1 or i1>999) then res:=5
10 3342 <*linienr ulovligt*>
10 3343 else if a_res=2 or a_res=4 or a_res=5 then
10 3344 begin
11 3345 ia(1):=
11 3346 if a_res=2 then 4 shift 21 +i1 shift 5
11 3347 else if a_res=4 then 4 shift 21 +i1
11 3348 else <* a_res=5 *> 5 shift 21 +i1;
11 3349 end
10 3350 else res:=27; <* parametertype *>
10 3351 if res<4 then pos:= a_pos;
10 3352 end
9 3353 else
9 3354 res:= if nr=2 and a_res<>0 then 24<*syntaks*>
9 3355 else 2;<*godkendt*>
9 3356 end;
8 3357
8 3357 <*4: <ingenting> *>
8 3358
8 3358 begin
9 3359 res:= if a_res<>0 then 24<*syntaks*>
9 3360 else 2;<*godkendt*>
9 3361 end;
8 3362 \f
8 3362 message procedure læs_kommando side 9 - 810226/hko;
8 3363
8 3363 <*5: (<kanalnr>) *>
8 3364
8 3364 begin
9 3365 long field lf;
9 3366
9 3366 if nr=1 then
9 3367 begin
10 3368 if a_res=0 then res:= 25
10 3369 else if a_res<>1 then res:=27<*parametertype*>
10 3370 else
10 3371 begin
11 3372 j:= 0; lf:= 4;
11 3373 for i:= 1 step 1 until max_antal_kanaler do
11 3374 if kanal_navn(i)=værdi.lf then j:= i;
11 3375 if j<>0 then
11 3376 begin
12 3377 ia(1):= 3 shift 22 + j;
12 3378 res:= 2;
12 3379 end
11 3380 else
11 3381 res:= 17; <* kanal ukendt *>
11 3382 end;
10 3383 if res<4 then pos:= a_pos;
10 3384 end
9 3385 else
9 3386 res:=if nr=2 and a_res<>0 then 24<*syntaks*>
9 3387 else 2;<*godkendt*>
9 3388 end;
8 3389 \f
8 3389 message procedure læs_kommando side 10 - 810415/hko;
8 3390
8 3390 <*6: <busnr>/<linie>/<løb> (<område>) *>
8 3391
8 3391 begin
9 3392 if nr=1 then
9 3393 begin
10 3394 if a_res=0 then res:=25<*parameter mangler*>
10 3395 else if a_res=7 then
10 3396 begin
11 3397 ia(1):= i1;
11 3398 ia(2):= 1 shift 22 + værdi(2);
11 3399 end
10 3400 else res:=27;<*parametertype*>
10 3401 if res<4 then pos:= apos;
10 3402 end
9 3403 else
9 3404 if nr=2 then
9 3405 begin
10 3406 if ares=0 then res:= 2 <*godkendt*> else
10 3407 if ares=1 then
10 3408 begin
11 3409 ia(3):= findområde(i1);
11 3410 if ia(3)=0 then res:= 56; <* område ukendt *>
11 3411 end
10 3412 else res:= 27; <*parametertype*>
10 3413 if res<4 then pos:= apos;
10 3414 end
9 3415 else
9 3416 if ares=0 then res:= 2 else res:= 24;
9 3417 end;
8 3418 \f
8 3418 message procedure læs_kommando side 11 - 810512/hko/cl;
8 3419
8 3419
8 3419 <* att_op_længde//2-2 *>
8 3420 <*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
8 3421 <* 1 *>
8 3422
8 3422 begin
9 3423 if nr=1 then
9 3424 begin
10 3425 if a_res=0 then res:=25 <*parameter mangler*>
10 3426 else if a_res=8 then
10 3427 begin
11 3428 ia(1):= 4 shift 21 + i1;
11 3429 ia(2):= værdi(2);
11 3430 ia(3):= værdi(3);
11 3431 indeks:= 3;
11 3432 end
10 3433 else res:=27;<*parametertype*>
10 3434 end
9 3435 else if nr<=att_op_længde//2-2 then
9 3436 begin
10 3437 if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
10 3438 else if a_res=0 then res:=25 <* parameter mangler *>
10 3439 else if a_res=10 then
10 3440 begin
11 3441 if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
11 3442 begin
12 3443 ia(nr+2):= i1 shift 12 + værdi(2);
12 3444 indeks:= nr +2;
12 3445 end
11 3446 else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
11 3447 else res:=6; <*løb-nr ulovligt*>
11 3448 end
10 3449 else res:=27;<*parametertype*>
10 3450 end
9 3451 else
9 3452 res:= if a_res=0 then 2 else 24;<* syntaks *>
9 3453 if res<4 then pos:=a_pos;
9 3454 end;
8 3455 \f
8 3455 message procedure læs_kommando side 12 - 810306/hko;
8 3456
8 3456 <*8: (<operatør>!<radiokanal>!<garageterminal>) *>
8 3457
8 3457 begin
9 3458 if nr=1 then
9 3459 begin
10 3460 if a_res=0 then res:=25 <* parameter mangler *>
10 3461 else if a_res=2 then
10 3462 begin
11 3463 j:=d.op_ref.opkode;
11 3464 ia(1):=i1;
11 3465 k:=(j+1)//2;
11 3466 if k<1 or k=3 or k>4 then
11 3467 fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
11 3468 else
11 3469 begin
12 3470 if k=4 then k:=3;
12 3471 if i1<1 or i1> (case k of
12 3472 (max_antal_operatører,max_antal_radiokanaler,
12 3473 max_antal_garageterminaler))
12 3474 then res:=case k of (28,29,17);
12 3475 end;
11 3476 end
10 3477 else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
10 3478 begin
11 3479 laf:= 0;
11 3480 ia(1):= find_bpl(værdi.laf(1));
11 3481 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3482 end
10 3483 else res:=27; <*parametertype*>
10 3484 end
9 3485 else
9 3486 if nr=2 and d.opref.opkode=1 then
9 3487 begin
10 3488 <* åbningstilstand for operatørplads *>
10 3489 if a_res=0 then res:= 2 <*godkendt*>
10 3490 else if a_res<>1 then res:= 27 <*parametertype*>
10 3491 else begin
11 3492 res:= 2<*godkendt*>;
11 3493 j:= værdi(1) shift (-16);
11 3494 if j='S' then ia(2):= 3 else
11 3495 if j<>'Å' then res:= 24; <*syntaks*>
11 3496 end;
10 3497 end
9 3498 else
9 3499 begin
10 3500 res:=if a_res=0 then 2 <* godkendt *>
10 3501 else 24;<* syntaks *>
10 3502 end;
9 3503 if res<4 then pos:=a_pos;
9 3504 end; <* partype 8 *>
8 3505 \f
8 3505 message procedure læs_kommando side 13 - 810306/hko;
8 3506
8 3506
8 3506 <* att_op_længde//2 *>
8 3507 <*9: <operatør>((+!-)<linienr>) *>
8 3508 <* 1 *>
8 3509
8 3509 begin
9 3510 if nr=1 then
9 3511 begin
10 3512 if a_res=0 then res:=25 <* parameter mangler *>
10 3513 else if a_res=2 then
10 3514 begin
11 3515 ia(1):=i1;
11 3516 if i1<1 or i1>max_antal_operatører then res:=28;
11 3517 end
10 3518 else if a_res=1 then
10 3519 begin
11 3520 laf:= 0;
11 3521 ia(1):= find_bpl(værdi.laf(1));
11 3522 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3523 end
10 3524 else res:=27; <* parametertype *>
10 3525 end
9 3526 else if nr<=att_op_længde//2 then
9 3527 begin <* nr>1 *>
10 3528 if a_res=0 then res:=(if nr>2 then 2 else 25)
10 3529 else if a_res=2 or a_res=3 then
10 3530 begin
11 3531 ia(nr):=i1; indeks:= nr;
11 3532 if i1=0 or abs(i1)>999 then res:=5;
11 3533 end
10 3534 else res:=27; <* parametertype *>
10 3535 if res<4 then pos:=a_pos;
10 3536 end
9 3537 else
9 3538 res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
9 3539 else 2;
9 3540 end; <* partype 9 *>
8 3541 \f
8 3541 message procedure læs_kommando side 14 - 810428/hko;
8 3542
8 3542 <* 2 *>
8 3543 <*10: (bus) *>
8 3544 <* 1 *>
8 3545
8 3545 begin
9 3546 if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
9 3547 else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
9 3548 else if a_res=0 then res:=2 <* godkendt *>
9 3549 else if a_res<>2 then res:=27 <* parametertype *>
9 3550 else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
9 3551 else
9 3552 ia(nr):=i1;
9 3553 end;
8 3554
8 3554 <* 5 *>
8 3555 <*11: (<linie>) *>
8 3556 <* 1 *>
8 3557
8 3557 begin
9 3558 if a_res=0 and nr=1 then res:=25
9 3559 else if a_res<>0 and nr>5 then res:=24
9 3560 else if a_res=0 then res:=2
9 3561 else if a_res<>2 and a_res<>4 then res:=27
9 3562 else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
9 3563 else
9 3564 ia(nr):=
9 3565 (if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
9 3566 end;
8 3567 \f
8 3567 message procedure læs_kommando side 15 - 810306/hko;
8 3568
8 3568 <*12: (<ingenting>!<navn>) *>
8 3569
8 3569 begin
9 3570 if nr=1 then
9 3571 begin
10 3572 if a_res=0 then res:=2 <*godkendt*>
10 3573 else if a_res=1 then
10 3574 tofrom(ia,værdi,8)
10 3575 else res:=27; <* parametertype *>
10 3576 end
9 3577 else
9 3578 res:=if a_res<>0 then 24 <* syntaks (for mange) *>
9 3579 else 2;
9 3580 end; <* partype 12 *>
8 3581 \f
8 3581 message procedure læs_kommando side 16 - 810512/hko/cl;
8 3582
8 3582 <* 15 *>
8 3583 <*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
8 3584 <* 1 *>
8 3585
8 3585 begin
9 3586 if nr=1 then
9 3587 begin
10 3588 if a_res=0 then res:=25 <* parameter mangler *>
10 3589 else
10 3590 if a_res=11 then
10 3591 begin
11 3592 ia(1):= 5 shift 21 + i1;
11 3593 ia(2):=værdi(2);
11 3594 indeks:= 2;
11 3595 end
10 3596 else res:=27; <* parametertype *>
10 3597 end
9 3598 else if nr<= att_op_længde//2-1 then
9 3599 begin
10 3600 if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
10 3601 else if a_res=0 then res:=25 <* parameter mangler *>
10 3602 else if ares=2 and (i1<1 or i1>9999) then
10 3603 res:= 7 <*busnr ulovligt*>
10 3604 else if a_res=2 or a_res=6 then
10 3605 begin
11 3606 ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
11 3607 indeks:= nr+1;
11 3608 end
10 3609 else res:=27; <* parametertype *>
10 3610 end
9 3611 else
9 3612 res:=if a_res=0 then 2 <*godkendt *>
9 3613 else 24;<* syntaks *>
9 3614 if res<4 then pos:=a_pos;
9 3615 end; <* partype 13 *>
8 3616 \f
8 3616 message procedure læs_kommando side 17 - 810311/hko;
8 3617
8 3617 <*14: <linie>.<indeks> *>
8 3618
8 3618 begin
9 3619 if nr=1 then
9 3620 begin
10 3621 if a_res=0 then res:=25 <* parameter mangler *>
10 3622 else if a_res=9 then
10 3623 begin
11 3624 ia(1):= 1 shift 23 +i1;
11 3625 ia(2):= værdi(2);
11 3626 end
10 3627 else res:=27; <* parametertype *>
10 3628 end
9 3629 else <* nr>1 *>
9 3630 res:= if a_res=0 then 2 <* godkendt *>
9 3631 else 24;<* syntaks *>
9 3632 end; <* partype 14 *>
8 3633 \f
8 3633 message procedure læs_kommando side 18 - 810313/hko;
8 3634
8 3634 <*15: <linie>.<indeks> <bus> *>
8 3635
8 3635 begin
9 3636 if nr=1 then
9 3637 begin
10 3638 if a_res=0 then res:= 25 <* parameter mangler *>
10 3639 else if a_res=9 then
10 3640 begin
11 3641 ia(1):= 1 shift 23 +i1;
11 3642 ia(2):= værdi(2);
11 3643 end
10 3644 else res:=27; <* parametertype *>
10 3645 end
9 3646 else if nr=2 then
9 3647 begin
10 3648 if a_res=0 then res:=25
10 3649 else if a_res=2 then
10 3650 begin
11 3651 if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
11 3652 else ia(3):= i1;
11 3653 end
10 3654 else res:=27; <*parametertype *>
10 3655 end
9 3656 else
9 3657 res:=if a_res=0 then 2 <* godkendt *>
9 3658 else 24;<* syntaks *>
9 3659 if res<4 then pos:=a_pos;
9 3660 end; <* partype 15 *>
8 3661 \f
8 3661 message procedure læs_kommando side 19 - 810311/hko;
8 3662
8 3662 <*16: (<ingenting>!D.<dato>.<klokkeslet> *>
8 3663
8 3663 begin
9 3664 if nr=1 then
9 3665 begin
10 3666 if a_res=0 then res:=2 <* godkendt *>
10 3667 else if a_res=12 then
10 3668 begin
11 3669 raf:=0;
11 3670 ia.raf(1):= systid(i1,værdi(2));
11 3671 end
10 3672 else res:=27; <* parametertype *>
10 3673 end
9 3674 else
9 3675 res:= if a_res=0 then 2 <* godkendt *>
9 3676 else 24;<* syntaks *>
9 3677 if res<4 then pos:=a_pos;
9 3678 end; <* partype 16 *>
8 3679 \f
8 3679 message procedure læs_kommando side 20 - 810511/hko;
8 3680
8 3680 <*17: G<grp.nr> *>
8 3681
8 3681 begin
9 3682 if nr=1 then
9 3683 begin
10 3684 if a_res=0 then res:=25 <*parameter mangler *>
10 3685 else if a_res=5 then
10 3686 begin
11 3687 ia(1):= 5 shift 21 +i1;
11 3688 end
10 3689 else res:=27; <* parametertype *>
10 3690 end
9 3691 else
9 3692 res:= if a_res=0 then 2 <* godkendt *>
9 3693 else 24;<* syntaks *>
9 3694 end; <* partype 17 *>
8 3695
8 3695 <* att_op_længde//2 *>
8 3696 <*18: (<heltal>) *>
8 3697 <* 1 *>
8 3698
8 3698 begin
9 3699 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3700 else
9 3701 if nr<=att_op_længde//2 then
9 3702 begin
10 3703 if a_res=2 or a_res=3 <* pos/neg heltal *> then
10 3704 begin
11 3705 ia(nr):= i1; indeks:= nr;
11 3706 end
10 3707 else if a_res=0 then res:= 2
10 3708 else res:= 27; <*parametertype*>
10 3709 end
9 3710 else
9 3711 res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
9 3712 end;
8 3713 \f
8 3713 message procedure læs_kommando side 21 - 820302/cl;
8 3714
8 3714 <*19: <linie>/<løb> <linie>/<løb> *>
8 3715
8 3715 begin
9 3716 if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3717 else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
9 3718 else if nr<3 then
9 3719 begin
10 3720 ia(nr):=i1 + 1 shift 22;
10 3721 end
9 3722 else
9 3723 res:= if a_res=0 then 2 <*godkendt*>
9 3724 else 24;<*syntaks (for mange)*>
9 3725 if res<4 then pos:= a_pos;
9 3726 end; <* partype 19 *>
8 3727
8 3727 <*20: <busnr> <kortnavn> *>
8 3728 begin
9 3729 if nr=1 then
9 3730 begin
10 3731 if ares=0 then res:= 25 else
10 3732 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3733 if ares<>2 then res:= 27 else ia(1):= i1;
10 3734 end
9 3735 else
9 3736 if nr=2 then
9 3737 begin
10 3738 if ares=1 and værdi(2) extract 8 = 0 then
10 3739 begin
11 3740 ia(2):= værdi(1); ia(3):= værdi(2);
11 3741 end
10 3742 else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
10 3743 end
9 3744 else
9 3745 if ares=0 then res:= 2 else res:= 24;
9 3746 end; <* partype 20 *>
8 3747 \f
8 3747 message procedure læs_kommando side 22 - 851001/cl;
8 3748
8 3748 <* 2 *>
8 3749 <*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
8 3750 <* 0 *>
8 3751
8 3751 begin
9 3752 laf:= 0;
9 3753 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3754 else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
9 3755 else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
9 3756 else if a_res=0 then res:= 2 <*godkendt*>
9 3757 else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
9 3758 else if (a_res=2 or a_res=4) and nr<=2 then
9 3759 begin
10 3760 if ia(3)<>0 then res:= 27 else
10 3761 ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
10 3762 end
9 3763 else
9 3764 if ares=1 then
9 3765 begin
10 3766 if nr=1 then
10 3767 begin
11 3768 ia(1):= (4 shift 21) + (1 shift 5);
11 3769 ia(2):= (4 shift 21) + (999 shift 5);
11 3770 end;
10 3771 if ia(3)=-2 then
10 3772 begin
11 3773 if i1=long<:ALL:> shift (-24) extract 24 then
11 3774 ia(3):= -1
11 3775 else
11 3776 begin
12 3777 ia(3):= findområde(i1);
12 3778 if ia(3)=0 then res:= 56 else
12 3779 ia(3):= 14 shift 20 + ia(3);
12 3780 end;
11 3781 end
10 3782 else
10 3783 if ia(3) = 0 then
10 3784 begin
11 3785 if i1 = long<:OMR:> shift (-24) extract (24) then
11 3786 ia(3):= -2
11 3787 else
11 3788 ia(3):= find_bpl(værdi.laf(1));
11 3789 if ia(3)=0 then res:= 55;
11 3790 end
10 3791 else res:= 24;
10 3792 end
9 3793 else res:= 27; <*parametertype*>
9 3794 if res<4 then pos:= apos;
9 3795 end;
8 3796
8 3796 <*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
8 3797
8 3797 begin
9 3798 if nr=1 then
9 3799 begin
10 3800 if ares=0 then res:= 25 <*parameter mangler*>
10 3801 else if ares=2 and (i1<1 or i1>9999)
10 3802 then res:= 7 <* busnr ulovligt *>
10 3803 else if ares=2 or ares=6 then
10 3804 begin
11 3805 ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
11 3806 end
10 3807 else res:= 27 <* parametertype *>
10 3808 end
9 3809 else
9 3810 if nr=2 then
9 3811 begin
10 3812 if ares=0 then res:= 2 <* godkendt *>
10 3813 else if ares=1 then
10 3814 begin
11 3815 ia(2):= findområde(i1);
11 3816 if ia(2)=0 then res:= 17 <*kanal ukendt*>
11 3817 end
10 3818 else
10 3819 res:= 27; <* parametertype *>
10 3820 end
9 3821 else if ares=0 then res:= 2 <*godkendt*>
9 3822 else res:= 24; <*syntaks*>
9 3823 if res < 4 then pos:= apos;
9 3824 end;
8 3825
8 3825 <*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
8 3826
8 3826 begin
9 3827 if nr=1 then
9 3828 begin
10 3829 if ares=0 then res:= 25 else
10 3830 if ares=2 and (i1<1 or i1>999) then res:= 5 else
10 3831 if ares=2 or ares=4 or ares=5 then
10 3832 begin
11 3833 ia(1):=
11 3834 if ares=2 then 4 shift 21 + i1 shift 5 else
11 3835 if ares=4 then 4 shift 21 + i1 else
11 3836 5 shift 21 + i1;
11 3837 end
10 3838 else res:= 27;
10 3839 if res < 4 then pos:= apos;
10 3840 end
9 3841 else
9 3842 if nr=2 then
9 3843 begin
10 3844 if ares=0 then res:= 2 else
10 3845 if ares=1 then
10 3846 begin
11 3847 ia(2):= findområde(i1);
11 3848 if ia(2)=0 then res:= 17;
11 3849 end
10 3850 else res:= 27;
10 3851 end
9 3852 else
9 3853 if ares=0 then res:= 2 else res:= 24;
9 3854 end;
8 3855
8 3855 <*24: ( <ingenting> ! <område> ! * ) *>
8 3856
8 3856 begin
9 3857 if nr=1 then
9 3858 begin
10 3859 if ares=0 then res:= 2 else
10 3860 if ares=1 then
10 3861 begin
11 3862 if i1=long<:ALL:> shift (-24) extract 24 then
11 3863 ia(1):= (-1) shift (-3) shift 3
11 3864 else
11 3865 begin
12 3866 k:= findområde(i1);
12 3867 if k=0 then res:= 17 else
12 3868 ia(1):= 14 shift 20 + k;
12 3869 end;
11 3870 end
10 3871 else res:= 27;
10 3872 end
9 3873 else
9 3874 if ares=0 then res:= 2 else res:= 24;
9 3875 if res < 4 then pos:= apos;
9 3876 end;
8 3877
8 3877 <*25: <område> *>
8 3878
8 3878 begin
9 3879 if nr=1 then
9 3880 begin
10 3881 if ares=0 then res:= 25 else
10 3882 if ares=1 then
10 3883 begin
11 3884 if i1 = '*' shift 16 then ia(1):= -1 else
11 3885 ia(1):= findområde(i1);
11 3886 if ia(1)=0 then res:= 17;
11 3887 end
10 3888 else res:= 27;
10 3889 end
9 3890 else
9 3891 if ares=0 then res:= 2 else res:= 24;
9 3892 if res < 4 then pos:= apos;
9 3893 end;
8 3894
8 3894 <*26: <busnr> *>
8 3895 begin
9 3896 if nr=1 then
9 3897 begin
10 3898 if ares=0 then res:= 25 else
10 3899 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3900 if ares<>2 then res:= 27 else ia(1):= i1;
10 3901 end
9 3902 else
9 3903 if ares=0 then res:= 2 else res:= 24;
9 3904 end;
8 3905
8 3905 <* 8 *>
8 3906 <*27: <operatørnr> (<område>) *>
8 3907 <* 1 *>
8 3908 begin
9 3909 if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3910 else if nr=1 then
9 3911 begin
10 3912 if a_res=2 then
10 3913 begin
11 3914 ia(1):= i1;
11 3915 if i1 < 0 or max_antal_operatører < i1 then res:= 28;
11 3916 end
10 3917 else if a_res=1 then
10 3918 begin
11 3919 laf:= 0;
11 3920 ia(1):= find_bpl(værdi.laf(1));
11 3921 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3922 end
10 3923 else res:= 27; <*parametertype*>
10 3924 end
9 3925 else
9 3926 begin
10 3927 if a_res=0 then res:= (if nr > 2 then 2 else 25)
10 3928 else if nr > 9 then res:= 24
10 3929 else if a_res=1 then
10 3930 begin
11 3931 ia(nr):= find_område(i1);
11 3932 indeks:= nr;
11 3933 if ia(nr)=0 then res:= 56;
11 3934 end
10 3935 else res:= 27;
10 3936 end;
9 3937 if res < 4 then pos:= a_pos;
9 3938 end <* partype 27 *>;
8 3939
8 3939 <*28: (<ingenting>!<kanalnr>) *>
8 3940 begin
9 3941 long field lf;
9 3942
9 3942 if nr=1 then
9 3943 begin
10 3944 if ares=0 then res:= 2 else
10 3945 if ares=1 then
10 3946 begin
11 3947 j:= 0; lf:= 4;
11 3948 for i:= 1 step 1 until max_antal_kanaler do
11 3949 if kanal_navn(i)=værdi.lf then j:= i;
11 3950 if j<>0 then
11 3951 begin
12 3952 ia(1):= 3 shift 22 + j;
12 3953 res:= 2;
12 3954 end
11 3955 else
11 3956 res:= 17; <*kanal ukendt*>
11 3957 end
10 3958 else
10 3959 res:= 27; <*parametertype*>
10 3960 if res < 4 then pos:= apos;
10 3961 end
9 3962 else
9 3963 res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
9 3964 end;
8 3965
8 3965 <* n *>
8 3966 <*29: <btj.pl.navn> ( <operatørnavn>) *>
8 3967 <* 0 *>
8 3968 begin
9 3969 laf:= 0;
9 3970 if nr=1 then
9 3971 begin
10 3972 if a_res=0 then res:= 25 <*parameter mangler*>
10 3973 else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
10 3974 else begin
11 3975 indeks:= 2;
11 3976 ia(1):= værdi(1); ia(2):= værdi(2);
11 3977 j:= find_bpl(værdi.laf(1));
11 3978 if 0<j and j<=max_antal_operatører then
11 3979 res:= 62; <*ulovligt navn*>
11 3980 end;
10 3981 end
9 3982 else
9 3983 begin
10 3984 if a_res=0 then res:= 2 <*godkendt*>
10 3985 else if a_res<>1 then res:= 27 <*parametertype*>
10 3986 else begin
11 3987 indeks:= indeks+1;
11 3988 ia(indeks):= find_bpl(værdi.laf(1));
11 3989 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3990 res:= 28; <*ukendt operatør*>
11 3991 end;
10 3992 end;
9 3993 if res<4 then pos:= a_pos;
9 3994 end;
8 3995
8 3995 <* 3 *>
8 3996 <*30: (<operatørnavn>) ( <btj.pl.navn>) *>
8 3997 <* io 0 *>
8 3998
8 3998 begin
9 3999 boolean io;
9 4000
9 4000 io:= (kilde//100 = 1);
9 4001 laf:= 0;
9 4002 if -,io and nr=1 then
9 4003 begin
10 4004 indeks:= 1;
10 4005 ia(1):= kilde mod 100; <*egen operatørplads*>
10 4006 end;
9 4007
9 4007 if io and nr=1 then
9 4008 begin
10 4009 if a_res=0 then res:= 25 <*parameter mangler*>
10 4010 else if a_res<>1 then res:= 27 <*parametertype*>
10 4011 else begin
11 4012 indeks:= nr;
11 4013 ia(indeks):= find_bpl(værdi.laf(1));
11 4014 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 4015 res:= 28; <*ukendt operatør*>
11 4016 end;
10 4017 end
9 4018 else
9 4019 begin
10 4020 if a_res=0 then res:= 2<*godkendt*>
10 4021 else if indeks=4 then res:= 24 <*syntaks, for mange*>
10 4022 else if a_res<>1 then res:= 27 <*parametertype*>
10 4023 else begin
11 4024 indeks:= indeks+1;
11 4025 ia(indeks):= find_bpl(værdi.laf(1));
11 4026 if ia(indeks)=0 then res:= 46 <*navn ukendt*>
11 4027 else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
11 4028 end;
10 4029 end;
9 4030 if res<4 then pos:= a_pos;
9 4031 end;
8 4032
8 4032 <* *>
8 4033 <*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
8 4034 <* *>
8 4035
8 4035 begin
9 4036 laf:= 0;
9 4037 if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
9 4038 else
9 4039 if nr=1 then
9 4040 begin
10 4041 if a_res=2 then
10 4042 begin
11 4043 ia(1):= i1;
11 4044 if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
11 4045 end else res:= 27; <*parametertype*>
10 4046 end
9 4047 else
9 4048 if nr=2 then
9 4049 begin
10 4050 if a_res=1 and værdi(2) extract 8 = 0 then
10 4051 begin
11 4052 ia(2):= værdi(1); ia(3):= værdi(2);
11 4053 j:= find_bpl(værdi.laf(1));
11 4054 if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
11 4055 end
10 4056 else res:= if a_res=0 then 2 <*godkendt*>
10 4057 else 27 <*parametertype*>;
10 4058 end
9 4059 else
9 4060 if nr=3 then
9 4061 begin
10 4062 if a_res=0 then res:=2 <*godkendt*>
10 4063 else if a_res<>1 then res:= 27 <*parametertype*>
10 4064 else begin
11 4065 j:= værdi(1) shift (-16);
11 4066 if j='Å' then ia(4):= 1 else
11 4067 if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
11 4068 end;
10 4069 end
9 4070 else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
9 4071 if res<4 then pos:= a_pos;
9 4072 end;
8 4073
8 4073 <* 1 *>
8 4074 <*32: (heltal) *>
8 4075 <* 0 *>
8 4076 begin
9 4077 if nr=1 then
9 4078 begin
10 4079 if ares=0 then
10 4080 begin
11 4081 indeks:= 0; res:= 2;
11 4082 end
10 4083 else
10 4084 if ares=2 or ares=3 then
10 4085 begin
11 4086 ia(nr):= i1; indeks:= nr;
11 4087 end
10 4088 else res:=27; <*parametertype*>
10 4089 end
9 4090 else
9 4091 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4092 if res < 4 then pos:= a_pos;
9 4093 end;
8 4094
8 4094 <*33 generel tekst*>
8 4095 begin
9 4096 integer p,p1,ch,lgd;
9 4097
9 4097 if nr=1 and a_res<>0 then
9 4098 begin
10 4099 p:=pos; p1:=1;
10 4100 lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
10 4101 if 95<lgd then lgd:=95;
10 4102 repeat læstegn(d.opref.data,p,ch) until ch<>' ';
10 4103 while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
10 4104 begin
11 4105 skrivtegn(ia,p1,ch);
11 4106 læstegn(d.opref.data,p,ch);
11 4107 end;
10 4108 if p1=1 then res:= 25 else res:= 2;
10 4109 repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
10 4110 end
9 4111 else
9 4112 if a_res=0 then res:= 25 else res:= 24;
9 4113 end;
8 4114
8 4114 <*34: (heltal) *>
8 4115 begin
9 4116 if nr=1 then
9 4117 begin
10 4118 if ares=0 then res:= 25 else
10 4119 if ares=2 or ares=3 then
10 4120 begin
11 4121 ia(nr):= i1; indeks:= nr;
11 4122 end
10 4123 else res:=27; <*parametertype*>
10 4124 end
9 4125 else
9 4126 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4127 if res < 4 then pos:= a_pos;
9 4128 end;
8 4129
8 4129 <*+4*> begin
9 4130 fejlreaktion(4<*systemfejl*>,partype,
9 4131 <:parametertype fejl i kommandofil:>,1);
9 4132 res:=31;
9 4133 end
8 4134 <*-4*>
8 4135 end;<*case partype*>
7 4136 end;<* while læs_param_sæt *>
6 4137 end; <* operationskode ok *>
5 4138 end
4 4139 else
4 4140 begin
5 4141 fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
5 4142 end;
4 4143
4 4143 if a_res<0 then res:= -a_res;
4 4144 slut_læskommando:
4 4145
4 4145 læs_kommando:=d.op_ref.resultat:= res;
4 4146 end;<* disable-blok*>
3 4147 end læs_kommando;
2 4148 \f
2 4148 message procedure skriv_kvittering side 1 - 820301/hko/cl;
2 4149
2 4149 procedure skriv_kvittering(z,ref,pos,res);
2 4150 value ref,pos,res;
2 4151 zone z;
2 4152 integer ref,pos,res;
2 4153 begin
3 4154 integer array field op;
3 4155 integer pos1,tegn;
3 4156 op:=ref;
3 4157 if res<1 or res>3 then write(z,<:*** :>);
3 4158 write(z,case res+1 of (
3 4159 <* 0*><:ubehandlet:>,
3 4160 <* 1*><:ok:>,
3 4161 <* 2*><:godkendt:>,
3 4162 <* 3*><:udført:>,
3 4163 <* 4*><:kommando ukendt:>,
3 4164
3 4164 <* 5*><:linie-nr ulovligt:>,
3 4165 <* 6*><:løb-nr ulovligt:>,
3 4166 <* 7*><:bus-nr ulovligt:>,
3 4167 <* 8*><:gruppe ukendt:>,
3 4168 <* 9*><:linie/løb ukendt:>,
3 4169
3 4169 <*10*><:bus-nr ukendt:>,
3 4170 <*11*><:bus allerede indsat på :>,
3 4171 <*12*><:linie/løb allerede besat af :>,
3 4172 <*13*><:bus ikke indsat:>,
3 4173 <*14*><:bus optaget:>,
3 4174
3 4174 <*15*><:gruppe optaget:>,
3 4175 <*16*><:skærm optaget:>,
3 4176 <*17*><:kanal ukendt:>,
3 4177 <*18*><:bus i kø:>,
3 4178 <*19*><:kø er tom:>,
3 4179
3 4179 <*20*><:ej forbindelse :>,
3 4180 <*21*><:ingen at gennemstille til:>,
3 4181 <*22*><:ingen samtale at nedlægge:>,
3 4182 <*23*><:ingen samtale at monitere:>,
3 4183 <*24*><:syntaks:>,
3 4184
3 4184 <*25*><:syntaks, parameter mangler:>,
3 4185 <*26*><:syntaks, skilletegn:>,
3 4186 <*27*><:syntaks, parametertype:>,
3 4187 <*28*><:operatør ukendt:>,
3 4188 <*29*><:garageterminal ukendt:>,
3 4189 \f
3 4189
3 4189 <*30*><:rapport kan ikke dannes:>,
3 4190 <*31*><:systemfejl:>,
3 4191 <*32*><:ingen fri plads:>,
3 4192 <*33*><:gruppe for stor:>,
3 4193 <*34*><:gruppe allerede defineret:>,
3 4194
3 4194 <*35*><:springsekvens for stor:>,
3 4195 <*36*><:spring allerede defineret:>,
3 4196 <*37*><:spring ukendt:>,
3 4197 <*38*><:spring allerede igangsat:>,
3 4198 <*39*><:bus ikke reserveret:>,
3 4199
3 4199 <*40*><:gruppe ikke reserveret:>,
3 4200 <*41*><:spring ikke igangsat:>,
3 4201 <*42*><:intet frit linie/løb:>,
3 4202 <*43*><:ændring af dato/tid ikke lovlig:>,
3 4203 <*44*><:interval-størrelse ulovlig:>,
3 4204
3 4204 <*45*><:ikke implementeret:>,
3 4205 <*46*><:navn ukendt:>,
3 4206 <*47*><:forkert indhold:>,
3 4207 <*48*><:i brug:>,
3 4208 <*49*><:ingen samtale igang:>,
3 4209
3 4209 <*50*><:kanal:>,
3 4210 <*51*><:afvist:>,
3 4211 <*52*><:kanal optaget :>,
3 4212 <*53*><:annulleret:>,
3 4213 <*54*><:ingen busser at kalde op:>,
3 4214
3 4214 <*55*><:garagenavn ukendt:>,
3 4215 <*56*><:område ukendt:>,
3 4216 <*57*><:område nødvendigt:>,
3 4217 <*58*><:ulovligt område for bus:>,
3 4218 <*59*><:radiofejl :>,
3 4219
3 4219 <*60*><:område kan ikke opdateres:>,
3 4220 <*61*><:ingen talevej:>,
3 4221 <*62*><:ulovligt navn:>,
3 4222 <*63*><:alarmlængde: :>,
3 4223 <*64*><:ulovligt tal:>,
3 4224
3 4224 <*99*><:- <'?'> -:>));
3 4225 \f
3 4225 message procedure skriv_kvittering side 3 - 820301/hko;
3 4226 if res=3 and op<>0 then
3 4227 begin
4 4228 if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
4 4229 begin
5 4230 i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
5 4231 if i<>0 then write(z,i,<: udtaget:>);
5 4232 end;
4 4233 end;
3 4234 if res = 11 or res = 12 then
3 4235 i:=ref;
3 4236 if res=11 then write(z,i shift(-12) extract 10,
3 4237 if i shift(-7) extract 5 =0 then false
3 4238 else "A" add (i shift(-7) extract 5 -1),1,
3 4239 <:/:>,<<d>,i extract 7) else
3 4240 if res=12 then write(z,i extract 14) else
3 4241 if res = 20 or res = 52 or res = 59 then
3 4242 begin
4 4243 i:= d.op.data(12);
4 4244 if i <> 0 then skriv_id(z,i,8);
4 4245 i:=d.op.data(2);
4 4246 if i=0 then i:=d.op.data(9);
4 4247 if i=0 then i:=d.op.data(8);
4 4248 skriv_id(z,i,8);
4 4249 end;
3 4250 if res=63 then
3 4251 begin
4 4252 i:= ref;
4 4253 if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
4 4254 end;
3 4255
3 4255 if pos>=0 then
3 4256 begin
4 4257 pos:=pos+1;
4 4258 outchar(z,':');
4 4259 tegn:=-1;
4 4260 while tegn<>10 and tegn<>0 do
4 4261 outchar(z,læs_tegn(d.op.data,pos,tegn));
4 4262 end;
3 4263 <*V*>setposition(z,0,0);
3 4264 end skriv_kvittering;
2 4265 \f
2 4265 message procedure cursor, side 1 - 810213/hko;
2 4266
2 4266 procedure cursor(z,linie,pos);
2 4267 value linie,pos;
2 4268 zone z;
2 4269 integer linie,pos;
2 4270 begin
3 4271 if linie>0 and linie<25
3 4272 and pos>0 and pos<81 then
3 4273 begin
4 4274 write(z,"esc" add 128,1,<:Æ:>,
4 4275 <<d>,linie,<:;:>,pos,<:H:>);
4 4276 end;
3 4277 end cursor;
2 4278 \f
2 4278 message procedure attention side 1 - 810529/hko;
2 4279
2 4279 procedure attention;
2 4280 begin
3 4281 integer i, j, k;
3 4282 integer array field op_ref,mess_ref;
3 4283 integer array att_message(1:9);
3 4284 long array field laf1, laf2;
3 4285 boolean optaget;
3 4286 procedure skriv_attention(zud,omfang);
3 4287 integer omfang;
3 4288 zone zud;
3 4289 begin
4 4290 write(zud,"nl",1,<:+++ attention :>);
4 4291 if omfang <> 0 then
4 4292 disable begin integer x;
5 4293 trap(slut);
5 4294 write(zud,"nl",1,
5 4295 <: i: :>,i,"nl",1,
5 4296 <: j: :>,j,"nl",1,
5 4297 <: k: :>,k,"nl",1,
5 4298 <: op-ref: :>,op_ref,"nl",1,
5 4299 <: mess-ref: :>,mess_ref,"nl",1,
5 4300 <: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
5 4301 <: laf2 :>,laf2,"nl",1,
5 4302 <: att-message::>,"nl",1,
5 4303 <::>);
5 4304 raf:= 0;
5 4305 skriv_hele(zud,att_message.raf,18,127);
5 4306 skriv_coru(zud,coru_no(010));
5 4307 slut:
5 4308 end;
4 4309 end skriv_attention;
3 4310
3 4310 integer procedure udtag_tal(tekst,pos);
3 4311 long array tekst;
3 4312 integer pos;
3 4313 begin
4 4314 integer i;
4 4315
4 4315 if getnumber(tekst,pos,i) >= 0 then
4 4316 udtag_tal:= i
4 4317 else
4 4318 udtag_tal:= 0;
4 4319 end;
3 4320
3 4320 for i:= 1 step 1 until att_maske_lgd//2 do
3 4321 att_signal(i):=att_flag(i):=0;
3 4322 trap(att_trap);
3 4323 stack_claim((if cm_test then 198 else 146)+50);
3 4324 <*+2*>
3 4325 if testbit26 and overvåget or testbit28 then
3 4326 skriv_attention(out,0);
3 4327 <*-2*>
3 4328 \f
3 4328 message procedure attention side 2 - 810406/hko;
3 4329
3 4329 repeat
3 4330
3 4330 wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
3 4331
3 4331 repeat
3 4332 <*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
3 4333 raf:= laf1:= 0;
3 4334 laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
3 4335
3 4335 <*+2*>if testbit7 and overvåget then
3 4336 disable begin
4 4337 laf2:= abs(laf);
4 4338 write(out,"nl",1,<:attention - :>);
4 4339 if laf<=0 then write(out,<:Regrettet :>);
4 4340 write(out,<:Message modtaget fra :>);
4 4341 if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
4 4342 skriv_hele(out,att_message.raf,16,127);
4 4343 ud;
4 4344 end;
3 4345 <*-2*>
3 4346 \f
3 4346 message procedure attention side 3 - 830310/cl;
3 4347
3 4347 if laf <= 0 then
3 4348 i:= -1
3 4349 else
3 4350 if core.laf(1)=konsol_navn.laf1(1)
3 4351 and core.laf(2)=konsol_navn.laf1(2) then
3 4352 i:= 101
3 4353 else
3 4354 begin
4 4355 i:= -1; j:= 1;
4 4356 while i=(-1) and (j <= max_antal_operatører) do
4 4357 begin
5 4358 laf2:= (j-1)*8;
5 4359 if core.laf(1) = terminal_navn.laf2(1)
5 4360 and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
5 4361 j:= j+1;
5 4362 end;
4 4363 j:= 1;
4 4364 while i=(-1) and (j<=max_antal_garageterminaler) do
4 4365 begin
5 4366 laf2:= (j-1)*8;
5 4367 if core.laf(1) = garage_terminal_navn.laf2(1)
5 4368 and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
5 4369 j:= j+1;
5 4370 end;
4 4371 end;
3 4372
3 4372 if i=101 or (201<=i and i<=200+max_antal_operatører)
3 4373 <* or (301<=i and i<=300+max_antal_garageterminaler) *>
3 4374 then
3 4375 begin
4 4376
4 4376 j:= if i=101 then 0
4 4377 else max_antal_operatører*(i//100-2)+i mod 100;
4 4378
4 4378 ref:=j*terminal_beskr_længde;
4 4379 att_message(9):=
4 4380 if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
4 4381 else 4 <*disconnected*>;
4 4382 optaget:=læsbit_ia(att_flag,j);
4 4383 if optaget and att_message(9)=1 then
4 4384 sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
4 4385 else optaget:=optaget or att_message(9)<>1;
4 4386 if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
4 4387 begin <* att fra ekskluderet operatør - inkluder *>
5 4388 start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
5 4389 d.op_ref.data(1):= i mod 100;
5 4390 signalch(cs_rad,op_ref,gen_optype);
5 4391 waitch(cs_att_pulje,op_ref,true,-1);
5 4392 end;
4 4393 end
3 4394 else
3 4395 begin
4 4396 optaget:= true;
4 4397 att_message(9):= 2 <*rejected*>;
4 4398 end;
3 4399
3 4399 monitor(22)send_answer:(zdummy,mess_ref,att_message);
3 4400
3 4400 until -,optaget;
3 4401 \f
3 4401 message procedure attention side 4 - 810424/hko;
3 4402
3 4402 sætbit_ia(att_flag,j,1);
3 4403
3 4403 start_operation(op_ref,i,cs_att_pulje,0);
3 4404
3 4404 signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
3 4405
3 4405 until false;
3 4406
3 4406 att_trap:
3 4407
3 4407 skriv_attention(zbillede,1);
3 4408
3 4408
3 4408 end attention;
2 4409
2 4409 \f
2 4409 message io_erklæringer side 1 - 810421/hko;
2 4410
2 4410 integer
2 4411 cs_io,
2 4412 cs_io_komm,
2 4413 cs_io_fil,
2 4414 cs_io_spool,
2 4415 cs_io_medd,
2 4416 cs_io_nulstil,
2 4417 ss_io_spool_tomme,
2 4418 ss_io_spool_fulde,
2 4419 bs_zio_adgang,
2 4420 io_spool_fil,
2 4421 io_spool_postantal,
2 4422 io_spool_postlængde;
2 4423
2 4423 integer array field
2 4424 io_spool_post;
2 4425
2 4425 zone z_io(32,1,io_fejl);
2 4426
2 4426 procedure io_fejl(z,s,b);
2 4427 integer s,b;
2 4428 zone z;
2 4429 begin
3 4430 disable begin
4 4431 integer array iz(1:20);
4 4432 integer i,j,k;
4 4433 integer array field iaf;
4 4434 real array field raf;
4 4435 if s<>(1 shift 21 + 2) then
4 4436 begin
5 4437 getzone6(z,iz);
5 4438 raf:=2;
5 4439 iaf:=0;
5 4440 k:=1;
5 4441
5 4441 j:= terminal_tab.iaf.terminal_tilstand;
5 4442 if j shift(-21)<>6 then
5 4443 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
5 4444 1 shift 12 <*binært*> +1 <*fortsæt*>);
5 4445 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
5 4446 + terminal_tab.iaf.terminal_tilstand extract 21;
5 4447 end;
4 4448 z(1):=real <:<'?'><'?'><'em'>:>;
4 4449 b:=2;
4 4450 end; <*disable*>
3 4451 end io_fejl;
2 4452 \f
2 4452 message procedure skriv_auto_spring_medd side 1 - 820301/hko;
2 4453
2 4453 procedure skriv_auto_spring_medd(z,medd,tid);
2 4454 value tid;
2 4455 zone z;
2 4456 real tid;
2 4457 integer array medd;
2 4458 begin
3 4459 disable begin
4 4460 real t;
4 4461 integer kode,bus,linie,bogst,løb,dato,kl;
4 4462 long array indeks(1:1);
4 4463 kode:= medd(1);
4 4464 indeks(1):= extend medd(5) shift 24;
4 4465 if kode > 0 and kode < 10 then
4 4466 begin
5 4467 write(z,"nl",0,<:-<'>'>:>,case kode of(
5 4468 <*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
5 4469 <*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
5 4470 <*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
5 4471 <*4*><:vogn optaget:>, <* - i - - / - *>
5 4472 <*5*><:spring annulleret:>, <*udløb af ventetid *>
5 4473 <*6*><::>, <* - af springliste *>
5 4474 <*7*><::>, <*start af springsekvens *>
5 4475 <*8*><::>, <*afvikling af springsekvens *>
5 4476 <*9*><:område kan ikke opdateres:>,<*vt-ændring*>
5 4477 <::>));
5 4478 <* if kode = 5 then
5 4479 begin
5 4480 bogst:= medd(4);
5 4481 linie:= bogst shift(-5) extract 10;
5 4482 bogst:= bogst extract 5;
5 4483 if bogst > 0 then bogst:= bogst +'A'-1;
5 4484 write(z,"sp",1,<<z>,linie,false add bogst,1,
5 4485 ".",1,indeks);
5 4486 end;
5 4487 *>
5 4488 outchar(z,'sp');
5 4489 bus:= medd(2) extract 14;
5 4490 if bus > 0 then
5 4491 write(z,<<z>,bus,"/",1);
5 4492 løb:= medd(3);
5 4493 <*+4*> if løb shift(-22) <> 1 and løb <> 0 then
5 4494 fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
5 4495 <*-4*>
5 4496 \f
5 4496 message procedure skriv_auto_spring_medd side 2 - 810507/hko;
5 4497
5 4497 linie:= løb shift(-12) extract 10;
5 4498 bogst:= løb shift(-7) extract 5;
5 4499 if bogst > 0 then bogst:= bogst +'A'-1;
5 4500 løb:= løb extract 7;
5 4501 if medd(3) <> 0 or kode <> 5 then
5 4502 begin
6 4503 write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
6 4504 if kode = 5 or kode = 6 then write(z,<:er frit :>);
6 4505 end;
5 4506 if kode = 7 or kode = 8 then
5 4507 write(z,<*indeks,"sp",1,*>
5 4508 if kode=7 then <:udtaget :> else <:indsat :>);
5 4509
5 4509 dato:= systime(4,tid,t);
5 4510 kl:= t/100.0;
5 4511 løb:= replace_char(1<*space in number*>,'.');
5 4512 write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
5 4513 replace_char(1,løb);
5 4514 end
4 4515 else <*kode < 1 or kode > 8*>
4 4516 fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
4 4517 end; <*disable*>
3 4518 end skriv_auto_spring_medd;
2 4519 \f
2 4519 message procedure h_io side 1 - 810507/hko;
2 4520
2 4520 <* hovedmodulkorutine for io *>
2 4521 procedure h_io;
2 4522 begin
3 4523 integer array field op_ref;
3 4524 integer k,dest_sem;
3 4525 procedure skriv_hio(zud,omfang);
3 4526 value omfang;
3 4527 zone zud;
3 4528 integer omfang;
3 4529 begin
4 4530
4 4530 write(zud,"nl",1,<:+++ hovedmodul io :>);
4 4531 if omfang>0 then
4 4532 disable begin integer x;
5 4533 trap(slut);
5 4534 write(zud,"nl",1,
5 4535 <: op_ref: :>,op_ref,"nl",1,
5 4536 <: k: :>,k,"nl",1,
5 4537 <: dest_sem: :>,dest_sem,"nl",1,
5 4538 <::>);
5 4539 skriv_coru(zud,coru_no(100));
5 4540 slut:
5 4541 end;
4 4542 end skriv_hio;
3 4543
3 4543 trap(hio_trap);
3 4544 stack_claim(if cm_test then 198 else 146);
3 4545
3 4545 <*+2*>
3 4546 if testbit0 and overvåget or testbit28 then
3 4547 skriv_hio(out,0);
3 4548 <*-2*>
3 4549 \f
3 4549 message procedure h_io side 2 - 810507/hko;
3 4550
3 4550 repeat
3 4551 wait_ch(cs_io,op_ref,true,-1);
3 4552 <*+4*>
3 4553 if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
3 4554 then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
3 4555 <*-4*>
3 4556
3 4556 k:=d.op_ref.opkode extract 12;
3 4557 dest_sem:=
3 4558 if k = 0 <*attention*> then cs_io_komm else
3 4559
3 4559 if k = 22 <*auto vt opdatering*>
3 4560 or k = 23 <*generel meddelelse*>
3 4561 or k = 36 <*spring meddelelse*>
3 4562 or k = 44 <*udeladt i gruppeopkald*>
3 4563 or k = 45 <*nødopkald modtaget*>
3 4564 or k = 46 <*nødopkald besvaret*> then cs_io_spool else
3 4565
3 4565 if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
3 4566 0;
3 4567 <*+4*>
3 4568 if dest_sem = 0 then
3 4569 begin
4 4570 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
4 4571 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 4572 end
3 4573 else
3 4574 <*-4*>
3 4575 begin
4 4576 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 4577 end;
3 4578 until false;
3 4579
3 4579 hio_trap:
3 4580 disable skriv_hio(zbillede,1);
3 4581 end h_io;
2 4582 \f
2 4582 message procedure io_komm side 1 - 810507/hko;
2 4583
2 4583 procedure io_komm;
2 4584 begin
3 4585 integer array field op_ref,ref,vt_op,iaf;
3 4586 integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
3 4587 pos,indeks,sep,sluttegn,operatør,i,j,k;
3 4588 long navn;
3 4589
3 4589 procedure skriv_io_komm(zud,omfang);
3 4590 value omfang;
3 4591 zone zud;
3 4592 integer omfang;
3 4593 begin
4 4594
4 4594 disable
4 4595
4 4595 write(zud,"nl",1,<:+++ io_komm :>);
4 4596 if omfang > 0 then
4 4597 disable begin integer x;
5 4598 trap(slut);
5 4599 write(zud,"nl",1,
5 4600 <: op-ref: :>,op_ref,"nl",1,
5 4601 <: kode: :>,kode,"nl",1,
5 4602 <: aktion: :>,aktion,"nl",1,
5 4603 <: ref: :>,ref,"nl",1,
5 4604 <: vt_op: :>,vt_op,"nl",1,
5 4605 <: status: :>,status,"nl",1,
5 4606 <: opgave: :>,opgave,"nl",1,
5 4607 <: dest-sem: :>,dest_sem,"nl",1,
5 4608 <: iaf: :>,iaf,"nl",1,
5 4609 <: i: :>,i,"nl",1,
5 4610 <: j: :>,j,"nl",1,
5 4611 <: k: :>,k,"nl",1,
5 4612 <: navn: :>,string navn,"nl",1,
5 4613 <: pos: :>,pos,"nl",1,
5 4614 <: indeks: :>,indeks,"nl",1,
5 4615 <: sep: :>,sep,"nl",1,
5 4616 <: sluttegn: :>,sluttegn,"nl",1,
5 4617 <: vogn: :>,vogn,"nl",1,
5 4618 <: ll: :>,ll,"nl",1,
5 4619 <: omr: :>,omr,"nl",1,
5 4620 <: operatør: :>,operatør,"nl",1,
5 4621 <::>);
5 4622 skriv_coru(zud,coru_no(101));
5 4623 slut:
5 4624 end;
4 4625 end skriv_io_komm;
3 4626 \f
3 4626 message procedure io_komm side 2 - 810424/hko;
3 4627
3 4627 trap(io_komm_trap);
3 4628 stack_claim((if cm_test then 200 else 146)+24+200);
3 4629
3 4629 ref:=0;
3 4630 navn:= long<::>;
3 4631
3 4631 <*+2*>
3 4632 if testbit0 and overvåget or testbit28 then
3 4633 skriv_io_komm(out,0);
3 4634 <*-2*>
3 4635
3 4635 repeat
3 4636
3 4636 <*V*> wait_ch(cs_io_komm,
3 4637 op_ref,
3 4638 true,
3 4639 -1<*timeout*>);
3 4640 <*+2*>
3 4641 if testbit1 and overvåget then
3 4642 disable begin
4 4643 skriv_io_komm(out,0);
4 4644 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
4 4645 <: til io :>);
4 4646 skriv_op(out,op_ref);
4 4647 end;
3 4648 <*-2*>
3 4649
3 4649 kode:= d.op_ref.op_kode;
3 4650 i:= terminal_tab.ref.terminal_tilstand;
3 4651 status:= i shift(-21);
3 4652 opgave:=
3 4653 if kode=0 then 1 <* indlæs kommando *> else
3 4654 0; <* afvises *>
3 4655
3 4655 aktion:= if opgave = 0 then 0 else
3 4656 (case status +1 of(
3 4657 <* status *>
3 4658 <* 0 klar *>(1),
3 4659 <* 1 - *>(-1),<* ulovlig tilstand *>
3 4660 <* 2 - *>(-1),<* ulovlig tilstand *>
3 4661 <* 3 stoppet *>(2),
3 4662 <* 4 noneksist *>(-1),<* ulovlig tilstand *>
3 4663 <* 5 - *>(-1),<* ulovlig tilstand *>
3 4664 <* 6 - *>(-1),<* ulovlig tilstand *>
3 4665 <* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
3 4666 -1));
3 4667 \f
3 4667 message procedure io_komm side 3 - 810428/hko;
3 4668
3 4668 case aktion+6 of
3 4669 begin
4 4670 begin
5 4671 <*-5: terminal optaget *>
5 4672
5 4672 d.op_ref.resultat:= 16;
5 4673 afslut_operation(op_ref,-1);
5 4674 end;
4 4675
4 4675 begin
5 4676 <*-4: operation uden virkning *>
5 4677
5 4677 afslut_operation(op_ref,-1);
5 4678 end;
4 4679
4 4679 begin
5 4680 <*-3: ulovlig operationskode *>
5 4681
5 4681 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 4682 afslut_operation(op_ref,-1);
5 4683 end;
4 4684
4 4684 begin
5 4685 <*-2: ulovlig aktion *>
5 4686
5 4686 fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
5 4687 afslut_operation(op_ref,-1);
5 4688 end;
4 4689
4 4689 begin
5 4690 <*-1: ulovlig io_tilstand *>
5 4691
5 4691 fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
5 4692 afslut_operation(op_ref,-1);
5 4693 end;
4 4694
4 4694 begin
5 4695 <* 0: ikke implementeret *>
5 4696
5 4696 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 4697 afslut_operation(op_ref,-1);
5 4698 end;
4 4699
4 4699 begin
5 4700 \f
5 4700 message procedure io_komm side 4 - 851001/cl;
5 4701
5 4701 <* 1: indlæs kommando *>
5 4702 <*V*> wait(bs_zio_adgang);
5 4703
5 4703 <*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
5 4704
5 4704 if d.op_ref.resultat > 3 then
5 4705 begin
6 4706 <*V*> setposition(z_io,0,0);
6 4707 if sluttegn<>'nl' then outchar(z_io,'nl');
6 4708 skriv_kvittering(z_io,op_ref,pos,
6 4709 d.op_ref.resultat);
6 4710 end
5 4711 else if d.op_ref.resultat>0 then
5 4712 begin <*godkendt*>
6 4713 kode:=d.op_ref.opkode;
6 4714 i:= kode extract 12;
6 4715 j:= if kode < 5 or
6 4716 kode=7 or kode=8 or
6 4717 kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
6 4718 if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
6 4719 if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
6 4720 if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
6 4721 kode=20 or kode=24 then 4<*VO,F/VO,R*>else
6 4722 if kode =21 then 5 <*AU*> else
6 4723 if kode =25 then 6 <*GR,D*> else
6 4724 if kode =26 then 5 <*GR,S*> else
6 4725 if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
6 4726 if kode =30 then 10 <*SP,D*> else
6 4727 if kode =31 then 5 <*SP*> else
6 4728 if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
6 4729 if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
6 4730 if kode=71 then 11 <*FO,V*> else
6 4731 if kode =75 then 12 <*TÆ,V *>else
6 4732 if kode =76 then 12 <*TÆ,N *>else
6 4733 if kode =65 then 13 <*BE,N *>else
6 4734 if kode =66 then 14 <*BE,G *>else
6 4735 if kode =67 then 15 <*BE,V *>else
6 4736 if kode =68 then 16 <*ST,D *>else
6 4737 if kode =69 then 17 <*ST,V *>else
6 4738 if kode =36 then 18 <*AL *>else
6 4739 if kode =37 then 19 <*CC *>else
6 4740 if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
6 4741 if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
6 4742 0;
6 4743 if j > 0 then
6 4744 begin
7 4745 case j of
7 4746 begin
8 4747 begin
9 4748 \f
9 4748 message procedure io_komm side 5 - 810424/hko;
9 4749
9 4749 <* 1: inkluder/ekskluder ydre enhed *>
9 4750
9 4750 d.op_ref.retur:= cs_io_komm;
9 4751 if kode=1 then d.opref.opkode:=
9 4752 ia(2) shift 12 + d.opref.opkode extract 12;
9 4753 d.op_ref.data(1):= ia(1);
9 4754 signal_ch(if kode < 5 or kode>=72 then cs_rad
9 4755 else cs_gar,
9 4756 op_ref,gen_optype or io_optype);
9 4757 indeks:= op_ref;
9 4758 wait_ch(cs_io_komm,
9 4759 op_ref,
9 4760 true,
9 4761 -1<*timeout*>);
9 4762 <*+4*> if op_ref <> indeks then
9 4763 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4764 <*-4*>
9 4765 <*V*> setposition(z_io,0,0);
9 4766 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4767 skriv_kvittering(z_io,op_ref,-1,
9 4768 d.op_ref.resultat);
9 4769 end;
8 4770
8 4770 begin
9 4771 \f
9 4771 message procedure io_komm side 6 - 810501/hko;
9 4772
9 4772 <* 2: tid/attention,ja/attention,nej
9 4773 slut/slut med billede *>
9 4774
9 4774 case d.op_ref.opkode -79 of
9 4775 begin
10 4776
10 4776 <* 80: TI *> begin
11 4777 setposition(z_io,0,0);
11 4778 if sluttegn<>'nl' then outchar(z_io,'nl');
11 4779 if ia(1) <> 0 or ia(2) <> 0 then
11 4780 begin real field rf;
12 4781 rf:= 4;
12 4782 trap(forbudt);
12 4783 <*V*> setposition(z_io,0,0);
12 4784 systime(3,ia.rf,0.0);
12 4785 if false then
12 4786 begin
13 4787 forbudt: skriv_kvittering(z_io,0,-1,
13 4788 43<*ændring af dato/tid ikke lovlig*>);
13 4789 end
12 4790 else
12 4791 skriv_kvittering(z_io,0,-1,3);
12 4792 end
11 4793 else
11 4794 begin
12 4795 setposition(z_io,0,0);
12 4796 write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
12 4797 end;
11 4798 end TI;
10 4799 \f
10 4799 message procedure io_komm side 7 - 810424/hko;
10 4800
10 4800 <*81: AT,J*> begin
11 4801 <*V*> setposition(z_io,0,0);
11 4802 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4803 monitor(10)release process:(z_io,0,ia);
11 4804 skriv_kvittering(z_io,0,-1,3);
11 4805 end;
10 4806
10 4806 <* 82: AT,N*> begin
11 4807 i:= monitor(8)reserve process:(z_io,0,ia);
11 4808 <*V*> setposition(z_io,0,0);
11 4809 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4810 skriv_kvittering(z_io,0,-1,
11 4811 if i = 0 then 3 else 0);
11 4812 end;
10 4813
10 4813 <* 83: SL *> begin
11 4814 errorbits:=0; <* warning.no ok.yes *>
11 4815 trapmode:= 1 shift 13;
11 4816 trap(-2);
11 4817 end;
10 4818
10 4818 <* 84: SL,B *>begin
11 4819 errorbits:=1; <* warning.no ok.no *>
11 4820 trap(-3);
11 4821 end;
10 4822 <* 85: SL,K *>begin
11 4823 errorbits:=1; <* warning.no ok.no *>
11 4824 disable sæt_bit_i(trapmode,15,0);
11 4825 trap(-3);
11 4826 end;
10 4827 \f
10 4827 message procedure io_komm side 7a - 810511/cl;
10 4828
10 4828 <* 86: TE,J *>begin
11 4829 setposition(z_io,0,0);
11 4830 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4831 for i:= 1 step 1 until indeks do
11 4832 if 0<=ia(i) and ia(i)<=47 then
11 4833 begin
12 4834 case (ia(i)+1) of
12 4835 begin
13 4836 testbit0 := true;testbit1 := true;testbit2 := true;
13 4837 testbit3 := true;testbit4 := true;testbit5 := true;
13 4838 testbit6 := true;testbit7 := true;testbit8 := true;
13 4839 testbit9 := true;testbit10:= true;testbit11:= true;
13 4840 testbit12:= true;testbit13:= true;testbit14:= true;
13 4841 testbit15:= true;testbit16:= true;testbit17:= true;
13 4842 testbit18:= true;testbit19:= true;testbit20:= true;
13 4843 testbit21:= true;testbit22:= true;testbit23:= true;
13 4844 testbit24:= true;testbit25:= true;testbit26:= true;
13 4845 testbit27:= true;testbit28:= true;testbit29:= true;
13 4846 testbit30:= true;testbit31:= true;testbit32:= true;
13 4847 testbit33:= true;testbit34:= true;testbit35:= true;
13 4848 testbit36:= true;testbit37:= true;testbit38:= true;
13 4849 testbit39:= true;testbit40:= true;testbit41:= true;
13 4850 testbit42:= true;testbit43:= true;testbit44:= true;
13 4851 testbit45:= true;testbit46:= true;testbit47:= true;
13 4852 end;
12 4853 end;
11 4854 skriv_kvittering(z_io,0,-1,3);
11 4855 end;
10 4856 \f
10 4856 message procedure io_komm side 7b - 810511/cl;
10 4857
10 4857 <* 87: TE,N *>begin
11 4858 setposition(z_io,0,0);
11 4859 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4860 for i:= 1 step 1 until indeks do
11 4861 if 0<=ia(i) and ia(i)<=47 then
11 4862 begin
12 4863 case (ia(i)+1) of
12 4864 begin
13 4865 testbit0 := false;testbit1 := false;testbit2 := false;
13 4866 testbit3 := false;testbit4 := false;testbit5 := false;
13 4867 testbit6 := false;testbit7 := false;testbit8 := false;
13 4868 testbit9 := false;testbit10:= false;testbit11:= false;
13 4869 testbit12:= false;testbit13:= false;testbit14:= false;
13 4870 testbit15:= false;testbit16:= false;testbit17:= false;
13 4871 testbit18:= false;testbit19:= false;testbit20:= false;
13 4872 testbit21:= false;testbit22:= false;testbit23:= false;
13 4873 testbit24:= false;testbit25:= false;testbit26:= false;
13 4874 testbit27:= false;testbit28:= false;testbit29:= false;
13 4875 testbit30:= false;testbit31:= false;testbit32:= false;
13 4876 testbit33:= false;testbit34:= false;testbit35:= false;
13 4877 testbit36:= false;testbit37:= false;testbit38:= false;
13 4878 testbit39:= false;testbit40:= false;testbit41:= false;
13 4879 testbit42:= false;testbit43:= false;testbit44:= false;
13 4880 testbit45:= false;testbit46:= false;testbit47:= false;
13 4881 end;
12 4882 end;
11 4883 skriv_kvittering(z_io,0,-1,3);
11 4884 end;
10 4885
10 4885 <* 88: O *> begin
11 4886 integer array odescr,zdescr(1:20);
11 4887 long array field laf;
11 4888 integer res, i, j;
11 4889
11 4889 i:= j:= 1;
11 4890 while læstegn(ia,i,res)<>0 do
11 4891 begin
12 4892 if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
12 4893 skrivtegn(ia,j,res);
12 4894 end;
11 4895
11 4895 laf:= 2;
11 4896 getzone6(out,odescr);
11 4897 getzone6(z_io,zdescr);
11 4898 close(out,zdescr.laf(1)<>odescr.laf(1) or
11 4899 zdescr.laf(2)<>odescr.laf(2));
11 4900 laf:= 0;
11 4901
11 4901 if ia(1)=0 then
11 4902 begin
12 4903 res:= 3;
12 4904 j:= 0;
12 4905 end
11 4906 else
11 4907 begin
12 4908 j:= res:= openbs(out,j,ia,0);
12 4909 if res<>0 then
12 4910 res:= 46;
12 4911 end;
11 4912 if res<>0 then
11 4913 begin
12 4914 open(out,8,konsol_navn,0);
12 4915 if j<>0 then
12 4916 begin
13 4917 i:= 1;
13 4918 fejlreaktion(4,j,string ia.laf(increase(i)),1);
13 4919 end;
12 4920 end
11 4921 else res:= 3;
11 4922 setposition(z_io,0,0);
11 4923 skriv_kvittering(z_io,0,-1,res);
11 4924 end;
10 4925 end;<*case d.op_ref.opkode -79*>
9 4926 end;<*case 2*>
8 4927 begin
9 4928 \f
9 4928 message procedure io_komm side 8 - 810424/hko;
9 4929
9 4929 <* 3: vogntabel,linienr/-,busnr*>
9 4930
9 4930 d.op_ref.retur:= cs_io_komm;
9 4931 tofrom(d.op_ref.data,ia,10);
9 4932 indeks:= op_ref;
9 4933 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 4934 wait_ch(cs_io_komm,
9 4935 op_ref,
9 4936 io_optype,
9 4937 -1<*timeout*>);
9 4938 <*+2*> if testbit2 and overvåget then
9 4939 disable begin
10 4940 skriv_io_komm(out,0);
10 4941 write(out,"nl",1,<:io operation retur fra vt:>);
10 4942 skriv_op(out,op_ref);
10 4943 end;
9 4944 <*-2*>
9 4945 <*+4*> if indeks <> op_ref then
9 4946 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4947 <*-4*>
9 4948
9 4948 i:=d.op_ref.resultat;
9 4949 if i<1 or i>3 then
9 4950 begin
10 4951 <*V*> setposition(z_io,0,0);
10 4952 if sluttegn<>'nl' then outchar(z_io,'nl');
10 4953 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 4954 end
9 4955 else
9 4956 begin
10 4957 \f
10 4957 message procedure io_komm side 9 - 820301/hko,cl;
10 4958
10 4958 integer antal,filref;
10 4959
10 4959 antal:= d.op_ref.data(6);
10 4960 fil_ref:= d.op_ref.data(7);
10 4961 pos:= 0;
10 4962 <*V*> setposition(zio,0,0);
10 4963 if sluttegn <> 'nl' then outchar(z_io,'nl');
10 4964 for pos:= pos +1 while pos <= antal do
10 4965 begin
11 4966 integer bogst,løb;
11 4967
11 4967 disable i:= læsfil(fil_ref,pos,j);
11 4968 if i <> 0 then
11 4969 fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
11 4970 vogn:= fil(j,1) shift (-24) extract 24;
11 4971 løb:= fil(j,1) extract 24;
11 4972 if d.op_ref.opkode=9 then
11 4973 begin i:=vogn; vogn:=løb; løb:=i; end;
11 4974 ll:= løb shift(-12) extract 10;
11 4975 bogst:= løb shift(-7) extract 5;
11 4976 if bogst > 0 then bogst:= bogst+'A'-1;
11 4977 løb:= løb extract 7;
11 4978 vogn:= vogn extract 14;
11 4979 i:= d.op_ref.opkode -8;
11 4980 for i:= i,i +1 do
11 4981 begin
12 4982 j:= (i+1) extract 1;
12 4983 case j+1 of
12 4984 begin
13 4985 write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 4986 false add bogst,1,"/",1,true,3,<<d>,løb);
13 4987 write(zio,<<dddd>,vogn,"sp",1);
13 4988 end;
12 4989 end;
11 4990 if pos mod 5 = 0 then
11 4991 begin
12 4992 outchar(zio,'nl');
12 4993 <*V*> setposition(zio,0,0);
12 4994 end
11 4995 else write(zio,"sp",3);
11 4996 end;
10 4997 write(zio,"*",1);
10 4998 \f
10 4998 message procedure io_komm side 9a - 810505/hko;
10 4999
10 4999 d.op_ref.opkode:=104;<*slet fil*>
10 5000 d.op_ref.data(4):=filref;
10 5001 indeks:=op_ref;
10 5002 signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
10 5003 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
10 5004
10 5004 <*+2*> if testbit2 and overvåget then
10 5005 disable begin
11 5006 skriv_io_komm(out,0);
11 5007 write(out,"nl",1,<:io operation retur fra sletfil:>);
11 5008 skriv_op(out,op_ref);
11 5009 end;
10 5010 <*-2*>
10 5011
10 5011 <*+4*> if op_ref<>indeks then
10 5012 fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
10 5013 <*-4*>
10 5014 if d.op_ref.data(9)<>0 then
10 5015 fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 5016 <:io-komm, sletfil:>,1);
10 5017 end;
9 5018 end;
8 5019
8 5019 begin
9 5020 \f
9 5020 message procedure io_komm side 10 - 820301/hko;
9 5021
9 5021 <* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
9 5022
9 5022 vogn:=ia(1);
9 5023 ll:=ia(2);
9 5024 omr:= if kode=11 or kode=19 then ia(3) else
9 5025 if kode=12 then ia(2) else 0;
9 5026 if kode=19 and omr<=0 then
9 5027 begin
10 5028 if omr=-1 then omr:= 0
10 5029 else omr:= 14 shift 20 + 3; <*OMR TCT*>
10 5030 end;
9 5031 <*V*> wait_ch(cs_vt_adgang,
9 5032 vt_op,
9 5033 gen_optype,
9 5034 -1<*timeout sek*>);
9 5035 start_operation(vtop,101,cs_io_komm,
9 5036 kode);
9 5037 d.vt_op.data(1):=vogn;
9 5038 d.vt_op.data(2):=ll;
9 5039 d.vt_op.data(if kode=19 then 3 else 4):= omr;
9 5040 indeks:= vt_op;
9 5041 signal_ch(cs_vt,
9 5042 vt_op,
9 5043 gen_optype or io_optype);
9 5044
9 5044 <*V*> wait_ch(cs_io_komm,
9 5045 vt_op,
9 5046 io_optype,
9 5047 -1<*timeout sek*>);
9 5048 <*+2*> if testbit2 and overvåget then
9 5049 disable begin
10 5050 skriv_io_komm(out,0);
10 5051 write(out,"nl",1,
10 5052 <:iooperation retur fra vt:>);
10 5053 skriv_op(out,vt_op);
10 5054 end;
9 5055 <*-2*>
9 5056 <*+4*> if vt_op<>indeks then
9 5057 fejl_reaktion(11<*fremmede op*>,op_ref,
9 5058 <:io-kommando:>,0);
9 5059 <*-4*>
9 5060 <*V*> setposition(z_io,0,0);
9 5061 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5062 skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
9 5063 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 5064 else vt_op,-1,d.vt_op.resultat);
9 5065 d.vt_op.optype:= genoptype or vt_optype;
9 5066 disable afslut_operation(vt_op,cs_vt_adgang);
9 5067 end;
8 5068
8 5068 begin
9 5069 \f
9 5069 message procedure io_komm side 11 - 810428/hko;
9 5070
9 5070 <* 5 autofil-skift
9 5071 gruppe,slet
9 5072 spring (igangsæt)
9 5073 spring,annuler
9 5074 spring,reserve *>
9 5075
9 5075 tofrom(d.op_ref.data,ia,8);
9 5076 d.op_ref.retur:=cs_io_komm;
9 5077 indeks:=op_ref;
9 5078 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5079 <*V*> wait_ch(cs_io_komm,
9 5080 op_ref,
9 5081 io_optype,
9 5082 -1<*timeout*>);
9 5083 <*+2*> if testbit2 and overvåget then
9 5084 disable begin
10 5085 skriv_io_komm(out,0);
10 5086 write(out,"nl",1,<:io operation retur fra vt:>);
10 5087 skriv_op(out,op_ref);
10 5088 end;
9 5089 <*-2*>
9 5090 <*+4*> if indeks<>op_ref then
9 5091 fejlreaktion(11<*fremmed post*>,op_ref,
9 5092 <:io-kommando(autofil):>,0);
9 5093 <*-4*>
9 5094
9 5094 <*V*> setposition(z_io,0,0);
9 5095 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5096 skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
9 5097 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 5098 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 5099 end;
8 5100
8 5100 begin
9 5101 \f
9 5101 message procedure io_komm side 12 - 820301/hko/cl;
9 5102
9 5102 <* 6 gruppedefinition *>
9 5103
9 5103 tofrom(d.op_ref.data,ia,indeks*2);
9 5104 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5105 start_operation(vt_op,101,cs_io_komm,
9 5106 101<*opret fil*>);
9 5107 d.vt_op.data(1):=256;<*postantal*>
9 5108 d.vt_op.data(2):=1; <*postlængde*>
9 5109 d.vt_op.data(3):=1; <*segmentantal*>
9 5110 d.vt_op.data(4):=
9 5111 2 shift 10; <*spool fil*>
9 5112 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5113 pos:=vt_op;<*variabel lånes*>
9 5114 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5115 <*+4*> if vt_op<>pos then
9 5116 fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
9 5117 if d.vt_op.data(9)<>0 then
9 5118 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5119 <:io-kommando(gruppedefinition):>,0);
9 5120 <*-4*>
9 5121 iaf:=0;
9 5122 for i:=1 step 1 until indeks-1 do
9 5123 begin
10 5124 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5125 if k<>0 then
10 5126 fejlreaktion(7<*modif-fil*>,k,
10 5127 <:io kommando(gruppe-def):>,0);
10 5128 fil(j).iaf(1):=d.op_ref.data(i+1);
10 5129 end;
9 5130 while sep = ',' do
9 5131 begin
10 5132 wait(bs_fortsæt_adgang);
10 5133 pos:= 1; j:= 0;
10 5134 while læs_store(z_io,i) < 8 do
10 5135 begin
11 5136 skrivtegn(fortsæt,pos,i);
11 5137 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5138 end;
10 5139 skrivtegn(fortsæt,pos,'em');
10 5140 afsluttext(fortsæt,pos);
10 5141 sluttegn:= i;
10 5142 if j<>0 then
10 5143 begin
11 5144 setposition(z_io,0,0);
11 5145 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5146 skriv_kvittering(zio,opref,-1,53);<*annulleret*>
11 5147 goto gr_ann;
11 5148 end;
10 5149 \f
10 5149 message procedure io_komm side 13 - 810512/hko/cl;
10 5150
10 5150 disable begin
11 5151 integer array værdi(1:4);
11 5152 integer a_pos,res;
11 5153 pos:= 0;
11 5154 repeat
11 5155 apos:= pos;
11 5156 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5157 if res >= 0 then
11 5158 begin
12 5159 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5160 else if res=0 then res:= -25 <*parameter mangler*>
12 5161 else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
12 5162 res:= -7 <*busnr ulovligt*>
12 5163 else if res=2 or res=6 then
12 5164 begin
13 5165 k:=modiffil(d.vt_op.data(4),indeks,j);
13 5166 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5167 <:io kommando(gruppe-def):>,0);
13 5168 iaf:= 0;
13 5169 fil(j).iaf(1):= værdi(1) +
13 5170 (if res=6 then 1 shift 22 else 0);
13 5171 indeks:= indeks+1;
13 5172 if sep = ',' then res:= 0;
13 5173 end
12 5174 else res:= -27; <*parametertype*>
12 5175 end;
11 5176 if res>0 then pos:= a_pos;
11 5177 until sep<>'sp' or res<=0;
11 5178
11 5178 if res<0 then
11 5179 begin
12 5180 d.op_ref.resultat:= -res;
12 5181 i:=1;
12 5182 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5183 afsluttext(d.op_ref.data,i);
12 5184 end;
11 5185 end;
10 5186 \f
10 5186 message procedure io_komm side 13a - 810512/hko/cl;
10 5187
10 5187 if d.op_ref.resultat > 3 then
10 5188 begin
11 5189 setposition(z_io,0,0);
11 5190 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5191 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5192 goto gr_ann;
11 5193 end;
10 5194 signalbin(bs_fortsæt_adgang);
10 5195 end while sep = ',';
9 5196 d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
9 5197 k:= sætfildim(d.vt_op.data);
9 5198 if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
9 5199 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5200 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5201 d.op_ref.retur:=cs_io_komm;
9 5202 pos:=op_ref;
9 5203 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5204 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5205 <*+4*> if pos<>op_ref then
9 5206 fejlreaktion(11<*fremmed post*>,op_ref,
9 5207 <:io kommando(gruppedef retur fra vt):>,0);
9 5208 <*-4*>
9 5209
9 5209 <*V*> setposition(z_io,0,0);
9 5210 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5211 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5212
9 5212 if false then
9 5213 begin
10 5214 gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5215 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5216 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5217 end;
9 5218
9 5218 end;
8 5219
8 5219 begin
9 5220 \f
9 5220 message procedure io_komm side 14 - 810525/hko/cl;
9 5221
9 5221 <* 7 gruppe(-oversigts-)rapport *>
9 5222
9 5222 d.op_ref.retur:=cs_io_komm;
9 5223 d.op_ref.data(1):=ia(1);
9 5224 indeks:=op_ref;
9 5225 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5226 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5227
9 5227 <*+4*> if op_ref<>indeks then
9 5228 fejlreaktion(11<*fremmed post*>,op_ref,
9 5229 <:io-kommando(gruppe-rapport):>,0);
9 5230 <*-4*>
9 5231
9 5231 <*V*> setposition(z_io,0,0);
9 5232 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5233 if d.op_ref.resultat<>3 then
9 5234 begin
10 5235 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5236 end
9 5237 else
9 5238 begin
10 5239 integer bogst,løb;
10 5240
10 5240 if kode = 27 then <* gruppe,vis *>
10 5241 begin
11 5242 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
11 5243 "G",1,<<z>,d.op_ref.data(1) extract 7,
11 5244 "sp",2,"-",5,"nl",1);
11 5245 \f
11 5245 message procedure io_komm side 15 - 820301/hko;
11 5246
11 5246 for pos:=1 step 1 until d.op_ref.data(2) do
11 5247 begin
12 5248 disable i:=læsfil(d.op_ref.data(3),pos,j);
12 5249 if i<>0 then
12 5250 fejlreaktion(5<*læsfil*>,i,
12 5251 <:io_kommando(gruppe,vis):>,0);
12 5252 iaf:=0;
12 5253 vogn:=fil(j).iaf(1);
12 5254 if vogn shift(-22) =0 then
12 5255 write(z_io,<<ddddddd>,vogn extract 14)
12 5256 else
12 5257 begin
13 5258 løb:=vogn extract 7;
13 5259 bogst:=vogn shift(-7) extract 5;
13 5260 if bogst>0 then bogst:=bogst+'A'-1;
13 5261 ll:=vogn shift(-12) extract 10;
13 5262 write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5263 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5264 end;
12 5265 if pos mod 8 =0 then outchar(z_io,'nl')
12 5266 else write(z_io,"sp",2);
12 5267 end;
11 5268 write(z_io,"*",1);
11 5269 \f
11 5269 message procedure io_komm side 16 - 810512/hko/cl;
11 5270
11 5270 end
10 5271 else if kode=28 then <* gruppe,oversigt *>
10 5272 begin
11 5273 write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
11 5274 "sp",2,"-",5,"nl",2);
11 5275 for pos:=1 step 1 until d.op_ref.data(1) do
11 5276 begin
12 5277 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5278 if i<>0 then
12 5279 fejlreaktion(5<*læsfil*>,i,
12 5280 <:io-kommando(gruppe-oversigt):>,0);
12 5281 iaf:=0;
12 5282 ll:=fil(j).iaf(1);
12 5283 write(z_io,"G",1,<<z>,true,3,ll extract 7);
12 5284 if pos mod 10 =0 then outchar(z_io,'nl')
12 5285 else write(z_io,"sp",3);
12 5286 end;
11 5287 write(z_io,"*",1);
11 5288 end;
10 5289 <* slet fil *>
10 5290 d.op_ref.opkode:= 104;
10 5291 d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
10 5292 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5293 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5294 end; <* resultat=3 *>
9 5295
9 5295 end;
8 5296
8 5296 begin
9 5297 \f
9 5297 message procedure io_komm side 17 - 810525/cl;
9 5298
9 5298 <* 8 spring(-oversigts-)rapport *>
9 5299
9 5299 d.op_ref.retur:=cs_io_komm;
9 5300 tofrom(d.op_ref.data,ia,4);
9 5301 indeks:=op_ref;
9 5302 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5303 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5304
9 5304 <*+4*> if op_ref<>indeks then
9 5305 fejlreaktion(11<*fremmed post*>,op_ref,
9 5306 <:io-kommando(spring-rapport):>,0);
9 5307 <*-4*>
9 5308
9 5308 <*V*> setposition(z_io,0,0);
9 5309 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5310 if d.op_ref.resultat<>3 then
9 5311 begin
10 5312 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5313 end
9 5314 else
9 5315 begin
10 5316 boolean p_skrevet;
10 5317 integer bogst,løb;
10 5318
10 5318 if kode = 32 then <* spring,vis *>
10 5319 begin
11 5320 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 5321 bogst:= d.op_ref.data(1) extract 5;
11 5322 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 5323 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
11 5324 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 5325 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 5326 raf:= data+8;
11 5327 if d.op_ref.raf(1)<>0.0 then
11 5328 write(z_io,<:, startet :>,<<zddddd>,round
11 5329 systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 5330 else
11 5331 write(z_io,<:, ikke startet:>);
11 5332 write(z_io,"sp",2,"-",5,"nl",1);
11 5333 \f
11 5333 message procedure io_komm side 18 - 810518/cl;
11 5334
11 5334 p_skrevet:= false;
11 5335 for pos:=1 step 1 until d.op_ref.data(3) do
11 5336 begin
12 5337 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 5338 if i<>0 then
12 5339 fejlreaktion(5<*læsfil*>,i,
12 5340 <:io_kommando(spring,vis):>,0);
12 5341 iaf:=0;
12 5342 i:= fil(j).iaf(1);
12 5343 if i < 0 and -, p_skrevet then
12 5344 begin
13 5345 outchar(z_io,'('); p_skrevet:= true;
13 5346 end;
12 5347 if i > 0 and p_skrevet then
12 5348 begin
13 5349 outchar(z_io,')'); p_skrevet:= false;
13 5350 end;
12 5351 if pos mod 2 = 0 then
12 5352 write(z_io,<< dd>,abs i,<:.:>)
12 5353 else
12 5354 write(z_io,true,3,<<d>,abs i);
12 5355 if pos mod 21 = 0 then outchar(z_io,'nl');
12 5356 end;
11 5357 write(z_io,"*",1);
11 5358 \f
11 5358 message procedure io_komm side 19 - 810525/cl;
11 5359
11 5359 end
10 5360 else if kode=33 then <* spring,oversigt *>
10 5361 begin
11 5362 write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
11 5363 "sp",2,"-",5,"nl",2);
11 5364 for pos:=1 step 1 until d.op_ref.data(1) do
11 5365 begin
12 5366 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5367 if i<>0 then
12 5368 fejlreaktion(5<*læsfil*>,i,
12 5369 <:io-kommando(spring-oversigt):>,0);
12 5370 iaf:=0;
12 5371 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 5372 bogst:=fil(j).iaf(1) extract 5;
12 5373 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 5374 write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 5375 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 5376 string (extend fil(j).iaf(2) shift 24));
12 5377 if fil(j,2)<>0.0 then
12 5378 write(z_io,<:startet :>,<<zddddd>,
12 5379 round systime(4,fil(j,2),r),<:.:>,round r);
12 5380 outchar(z_io,'nl');
12 5381 end;
11 5382 write(z_io,"*",1);
11 5383 end;
10 5384 <* slet fil *>
10 5385 d.op_ref.opkode:= 104;
10 5386 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 5387 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5388 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5389 end; <* resultat=3 *>
9 5390
9 5390 end;
8 5391
8 5391 begin
9 5392 \f
9 5392 message procedure io_komm side 20 - 820302/hko;
9 5393
9 5393 <* 9 fordeling af linier/områder på operatører *>
9 5394
9 5394 d.op_ref.retur:=cs_io_komm;
9 5395 disable
9 5396 if kode=5 then
9 5397 begin
10 5398 integer array io_linietabel(1:max_linienr//3+1);
10 5399
10 5399 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5400 begin
11 5401 i:= læs_fil(1035,ref//512+1,j);
11 5402 if i <> 0 then
11 5403 fejlreaktion(5,i,<:liniefordelingstabel:>,0);
11 5404 tofrom(io_linietabel.ref,fil(j),
11 5405 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
11 5406 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
11 5407 end;
10 5408 ref:=0;
10 5409 operatør:=ia(1);
10 5410 for j:=2 step 1 until indeks do
10 5411 begin
11 5412 ll:=ia(j);
11 5413 if ll<>0 then
11 5414 skrivtegn(io_linietabel,abs(ll)+1,
11 5415 if ll>0 then operatør else 0);
11 5416 end;
10 5417 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5418 begin
11 5419 i:= skriv_fil(1035,ref//512+1,j);
11 5420 if i <> 0 then
11 5421 fejlreaktion(6,i,<:liniefordelingstabel:>,0);
11 5422 tofrom(fil(j),io_linietabel.ref,
11 5423 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
11 5424 then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
11 5425 );
11 5426 end;
10 5427 ref:=0;
10 5428 end
9 5429 else
9 5430 begin
10 5431 modiffil(1034,1,i);
10 5432 ref:=0;
10 5433 operatør:=ia(1);
10 5434 for j:=2 step 1 until indeks do
10 5435 begin
11 5436 ll:=ia(j);
11 5437 fil(i).ref(ll):= if ll>0 then operatør else 0;
11 5438 end;
10 5439 end;
9 5440 indeks:=op_ref;
9 5441 signal_ch(cs_rad,op_ref,gen_optype or io_optype);
9 5442 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
9 5443
9 5443 <*+4*> if op_ref<>indeks then
9 5444 fejlreaktion(11<*fr.post*>,op_ref,
9 5445 <:io-komm,liniefordeling retur fra rad:>,0);
9 5446 <*-4*>
9 5447
9 5447 <*V*> setposition(z_io,0,0);
9 5448 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5449 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5450
9 5450 end;
8 5451
8 5451 begin
9 5452 \f
9 5452 message procedure io_komm side 21 - 820301/cl;
9 5453
9 5453 <* 10 springdefinition *>
9 5454
9 5454 tofrom(d.op_ref.data,ia,indeks*2);
9 5455 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5456 start_operation(vt_op,101,cs_io_komm,
9 5457 101<*opret fil*>);
9 5458 d.vt_op.data(1):=128;<*postantal*>
9 5459 d.vt_op.data(2):=2; <*postlængde*>
9 5460 d.vt_op.data(3):=1; <*segmentantal*>
9 5461 d.vt_op.data(4):=
9 5462 2 shift 10; <*spool fil*>
9 5463 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5464 pos:=vt_op;<*variabel lånes*>
9 5465 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5466 <*+4*> if vt_op<>pos then
9 5467 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 5468 if d.vt_op.data(9)<>0 then
9 5469 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5470 <:io-kommando(springdefinition):>,0);
9 5471 <*-4*>
9 5472 iaf:=0;
9 5473 for i:=1 step 1 until indeks-2 do
9 5474 begin
10 5475 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5476 if k<>0 then
10 5477 fejlreaktion(7<*modif-fil*>,k,
10 5478 <:io kommando(spring-def):>,0);
10 5479 fil(j).iaf(1):=d.op_ref.data(i+2);
10 5480 end;
9 5481 while sep = ',' do
9 5482 begin
10 5483 wait(bs_fortsæt_adgang);
10 5484 pos:= 1; j:= 0;
10 5485 while læs_store(z_io,i) < 8 do
10 5486 begin
11 5487 skrivtegn(fortsæt,pos,i);
11 5488 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5489 end;
10 5490 skrivtegn(fortsæt,pos,'em');
10 5491 afsluttext(fortsæt,pos);
10 5492 sluttegn:= i;
10 5493 if j<>0 then
10 5494 begin
11 5495 setposition(z_io,0,0);
11 5496 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5497 skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
11 5498 goto sp_ann;
11 5499 end;
10 5500 \f
10 5500 message procedure io_komm side 22 - 810519/cl;
10 5501
10 5501 disable begin
11 5502 integer array værdi(1:4);
11 5503 integer a_pos,res;
11 5504 pos:= 0;
11 5505 repeat
11 5506 apos:= pos;
11 5507 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5508 if res >= 0 then
11 5509 begin
12 5510 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5511 else if res=0 then res:= -25 <*parameter mangler*>
12 5512 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 5513 res:= -44 <*intervalstørrelse ulovlig*>
12 5514 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 5515 res:= -6 <*løbnr ulovligt*>
12 5516 else if res=10 then
12 5517 begin
13 5518 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 5519 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5520 <:io kommando(spring-def):>,0);
13 5521 iaf:= 0;
13 5522 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 5523 indeks:= indeks+1;
13 5524 if sep = ',' then res:= 0;
13 5525 end
12 5526 else res:= -27; <*parametertype*>
12 5527 end;
11 5528 if res>0 then pos:= a_pos;
11 5529 until sep<>'sp' or res<=0;
11 5530
11 5530 if res<0 then
11 5531 begin
12 5532 d.op_ref.resultat:= -res;
12 5533 i:=1;
12 5534 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5535 afsluttext(d.op_ref.data,i);
12 5536 end;
11 5537 end;
10 5538 \f
10 5538 message procedure io_komm side 23 - 810519/cl;
10 5539
10 5539 if d.op_ref.resultat > 3 then
10 5540 begin
11 5541 setposition(z_io,0,0);
11 5542 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5543 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5544 goto sp_ann;
11 5545 end;
10 5546 signalbin(bs_fortsæt_adgang);
10 5547 end while sep = ',';
9 5548 d.vt_op.data(1):= indeks-2;
9 5549 k:= sætfildim(d.vt_op.data);
9 5550 if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
9 5551 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5552 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5553 d.op_ref.retur:=cs_io_komm;
9 5554 pos:=op_ref;
9 5555 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5556 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5557 <*+4*> if pos<>op_ref then
9 5558 fejlreaktion(11<*fremmed post*>,op_ref,
9 5559 <:io kommando(springdef retur fra vt):>,0);
9 5560 <*-4*>
9 5561
9 5561 <*V*> setposition(z_io,0,0);
9 5562 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5563 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5564
9 5564 if false then
9 5565 begin
10 5566 sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5567 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5568 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5569 signalbin(bs_fortsæt_adgang);
10 5570 end;
9 5571
9 5571 end;
8 5572 begin
9 5573 integer i,j,k,opr,lin,max_lin;
9 5574 boolean o_ud, t_ud;
9 5575 \f
9 5575 message procedure io_komm side 23a - 820301/cl;
9 5576
9 5576 <* 11 fordelingsrapport *>
9 5577
9 5577 <*V*> setposition(z_io,0,0);
9 5578 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5579
9 5579 max_lin:= max_linienr;
9 5580 for opr:= 1 step 1 until max_antal_operatører, 0 do
9 5581 begin
10 5582 o_ud:= t_ud:= false;
10 5583 k:= 0;
10 5584
10 5584 if opr<>0 then
10 5585 begin
11 5586 j:= k:= 0;
11 5587 for lin:= 1 step 1 until max_lin do
11 5588 begin
12 5589 læs_tegn(radio_linietabel,lin+1,i);
12 5590 if i<>0 then j:= lin;
12 5591 if opr=i and opr<>0 then
12 5592 begin
13 5593 if -, o_ud then
13 5594 begin
14 5595 o_ud:= true;
14 5596 if opr<>0 then
14 5597 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
14 5598 "sp",2,string bpl_navn(opr))
14 5599 else
14 5600 write(z_io,"nl",1,<:ikke fordelte:>);
14 5601 end;
13 5602 if -, t_ud then
13 5603 begin
14 5604 write(z_io,<:<'nl'> linier: :>);
14 5605 t_ud:= true;
14 5606 end;
13 5607 k:=k+1;
13 5608 if k>1 and k mod 10 = 1 then
13 5609 write(z_io,"nl",1,"sp",13);
13 5610 write(z_io,<<ddd >,lin);
13 5611 end;
12 5612 if lin=max_lin then max_lin:= j;
12 5613 end;
11 5614 end;
10 5615
10 5615 k:= 0; t_ud:= false;
10 5616 for i:= 1 step 1 until max_antal_områder do
10 5617 begin
11 5618 if radio_områdetabel(i)= opr then
11 5619 begin
12 5620 if -, o_ud then
12 5621 begin
13 5622 o_ud:= true;
13 5623 if opr<>0 then
13 5624 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
13 5625 "sp",2,string bpl_navn(opr))
13 5626 else
13 5627 write(z_io,"nl",1,<:ikke fordelte:>);
13 5628 end;
12 5629 if -, t_ud then
12 5630 begin
13 5631 write(z_io,<:<'nl'> områder: :>);
13 5632 t_ud:= true;
13 5633 end;
12 5634 k:= k+1;
12 5635 if k>1 and k mod 10 = 1 then
12 5636 write(z_io,"nl",1,"sp",13);
12 5637 write(z_io,true,4,string område_navn(i));
12 5638 end;
11 5639 end;
10 5640 if o_ud then write(z_io,"nl",1);
10 5641 end;
9 5642 write(z_io,"*",1);
9 5643 end;
8 5644
8 5644 begin
9 5645 integer omr,typ,sum;
9 5646 integer array ialt(1:5);
9 5647 real r;
9 5648 \f
9 5648 message procedure io_komm side 24 - 810501/hko;
9 5649
9 5649 <* 12 vis/nulstil opkaldstællere *>
9 5650
9 5650 setposition(z_io,0,0);
9 5651 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5652
9 5652 if kode=76 and indeks=1 then
9 5653 begin <* TÆ,N <tid> *>
10 5654 if ia(1)<(-1) or 2400<ia(1) then
10 5655 skriv_kvittering(z_io,opref,-1,64)
10 5656 else
10 5657 begin
11 5658 if ia(1)=(-1) then nulstil_systællere:= -1
11 5659 else nulstil_systællere:= (ia(1) mod 2400)*100;
11 5660 opdater_tf_systællere;
11 5661 skriv_kvittering(z_io,opref,-1,3);
11 5662 end;
10 5663 end
9 5664 else
9 5665 begin
10 5666 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5667
10 5667 write(z_io,
10 5668 <:område udgående alm. ind nød ind:>,
10 5669 <: ind ialt total ej forb. optaget:>,"nl",1);
10 5670 for omr := 1 step 1 until max_antal_områder do
10 5671 begin
11 5672 sum:= 0;
11 5673 write(z_io,true,6,string område_navn(omr),":",1);
11 5674 for typ:= 1 step 1 until 3 do
11 5675 begin
12 5676 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5677 sum:= sum + opkalds_tællere((omr-1)*5+typ);
12 5678 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5679 end;
11 5680 write(z_io,<< ddddddd>,
11 5681 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
11 5682 for typ:= 4 step 1 until 5 do
11 5683 begin
12 5684 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5685 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5686 end;
11 5687 write(z_io,"nl",1);
11 5688 end;
10 5689 sum:= 0;
10 5690 write(z_io,"nl",1,<:ialt ::>);
10 5691 for typ:= 1 step 1 until 3 do
10 5692 begin
11 5693 write(z_io,<< ddddddd>,ialt(typ));
11 5694 sum:= sum+ialt(typ);
11 5695 end;
10 5696 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5697 ialt(4), ialt(5), "nl",3);
10 5698
10 5698 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5699 write(z_io,
10 5700 <:oper. udgående alm. ind nød ind:>,
10 5701 <: ind ialt total ej forb. optaget:>,"nl",1);
10 5702 for omr := 1 step 1 until max_antal_operatører do
10 5703 begin
11 5704 sum:= 0;
11 5705 if bpl_navn(omr)=long<::> then
11 5706 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
11 5707 else
11 5708 write(z_io,true,6,string bpl_navn(omr),":",1);
11 5709 for typ:= 1 step 1 until 3 do
11 5710 begin
12 5711 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
12 5712 sum:= sum + operatør_tællere((omr-1)*5+typ);
12 5713 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5714 end;
11 5715 write(z_io,<< ddddddd>,
11 5716 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
11 5717 for typ:= 4 step 1 until 5 do
11 5718 begin
12 5719 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
12 5720 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5721 end;
11 5722 write(z_io,"nl",1);
11 5723 end;
10 5724 sum:= 0;
10 5725 write(z_io,"nl",1,<:ialt ::>);
10 5726 for typ:= 1 step 1 until 3 do
10 5727 begin
11 5728 write(z_io,<< ddddddd>,ialt(typ));
11 5729 sum:= sum+ialt(typ);
11 5730 end;
10 5731 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5732 ialt(4),ialt(5),"nl",2);
10 5733
10 5733 typ:= replacechar(1,':');
10 5734 write(z_io,<:tællere nulstilles :>);
10 5735 if nulstil_systællere=(-1) then
10 5736 write(z_io,<:ikke automatisk:>,"nl",1)
10 5737 else
10 5738 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
10 5739 nulstil_systællere,"nl",1);
10 5740 replacechar(1,'.');
10 5741 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
10 5742 systime(4,systællere_nulstillet,r));
10 5743 replacechar(1,':');
10 5744 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
10 5745 replacechar(1,typ);
10 5746 write(z_io,"*",1,"nl",1);
10 5747 setposition(z_io,0,0);
10 5748
10 5748 if kode = 76 <* nulstil tællere *> then
10 5749 disable begin
11 5750 for omr:= 1 step 1 until max_antal_områder*5 do
11 5751 opkalds_tællere(omr):= 0;
11 5752 for omr:= 1 step 1 until max_antal_operatører*5 do
11 5753 operatør_tællere(omr):= 0;
11 5754 systime(1,0.0,systællere_nulstillet);
11 5755 opdater_tf_systællere;
11 5756 typ:= replacechar(1,'.');
11 5757 write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
11 5758 systime(4,systællere_nulstillet,r));
11 5759 replacechar(1,':');
11 5760 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
11 5761 replacechar(1,typ);
11 5762 setposition(z_io,0,0);
11 5763 end;
10 5764 end;
9 5765 end;
8 5766
8 5766 begin
9 5767 \f
9 5767 message procedure io_komm side 25 - 940522/cl;
9 5768
9 5768 <* 13 navngiv betjeningsplads *>
9 5769 boolean incl;
9 5770 long field lf;
9 5771
9 5771 lf:=6;
9 5772 operatør:= ia(1);
9 5773 navn:= ia.lf;
9 5774 incl:= false add (ia(4) extract 8);
9 5775
9 5775 if navn=long<::> then
9 5776 begin
10 5777 <* nedlæg navn - check for i brug *>
10 5778 iaf:= operatør*terminal_beskr_længde;
10 5779 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5780 d.opref.resultat:= 48 <*i brug*>
10 5781 else
10 5782 begin
11 5783 for i:= 65 step 1 until top_bpl_gruppe do
11 5784 begin
12 5785 iaf:= i*op_maske_lgd;
12 5786 if læsbit_ia(bpl_def.iaf,operatør) then
12 5787 d.opref.resultat:= 48<*i brug*>;
12 5788 end;
11 5789 end;
10 5790 if d.opref.resultat <= 3 then
10 5791 begin
11 5792 for i:= 1 step 1 until sidste_bus do
11 5793 if bustabel(i) shift (-14) extract 8 = operatør then
11 5794 d.opref.resultat:= 48<*i brug*>;
11 5795 end;
10 5796 end
9 5797 else
9 5798 begin
10 5799 <* opret/omdøb *>
10 5800 i:= find_bpl(navn);
10 5801 if i<>0 and i<>operatør then
10 5802 d.opref.resultat:= 48 <*i brug*>;
10 5803 end;
9 5804 if d.opref.resultat<=3 then
9 5805 begin
10 5806 bpl_navn(operatør):= navn;
10 5807 operatør_auto_include(operatør):= incl;
10 5808 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5809 if k<>0 then
10 5810 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5811 lf:= 4;
10 5812 fil(ll).lf:= navn add (incl extract 8);
10 5813 setposition(fil(ll),0,0);
10 5814
10 5814 <* skriv bplnavne *>
10 5815 disable begin
11 5816 zone z(128,1,stderror);
11 5817 long array field laf;
11 5818 integer array ia(1:10);
11 5819
11 5819 open(z,4,<:bplnavne:>,0);
11 5820 laf:= 0;
11 5821 outrec6(z,512);
11 5822 for i:= 1 step 1 until 127 do
11 5823 z.laf(i):= bpl_navn(i);
11 5824 close(z,true);
11 5825 monitor(42,z,0,ia);
11 5826 ia(6):= systime(7,0,0.0);
11 5827 monitor(44,z,0,ia);
11 5828 end;
10 5829 d.opref.resultat:= 3;<*udført*>
10 5830 end;
9 5831
9 5831 setposition(z_io,0,0);
9 5832 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5833 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5834 end;
8 5835
8 5835 begin
9 5836 \f
9 5836 message procedure io_komm side 26 - 940522/cl;
9 5837
9 5837 <* 14 betjeningsplads - gruppe *>
9 5838 integer ant_i_gruppe;
9 5839 long field lf;
9 5840 integer array maske(1:op_maske_lgd//2);
9 5841
9 5841 lf:= 4; ant_i_gruppe:= 0;
9 5842 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5843 navn:= ia.lf;
9 5844 operatør:= find_bpl(navn);
9 5845 for i:= 3 step 1 until indeks do
9 5846 if sætbit_ia(maske,ia(i),1)=0 then
9 5847 ant_i_gruppe:= ant_i_gruppe+1;
9 5848 if ant_i_gruppe=0 then
9 5849 begin
10 5850 <* slet gruppe *>
10 5851 if operatør<=64 then
10 5852 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5853 else 62<*navn ulovligt*>)
10 5854 else
10 5855 begin
11 5856 for i:= 1 step 1 until max_antal_operatører do
11 5857 for j:= 1 step 1 until 3 do
11 5858 if operatør_stop(i,j)=operatør then
11 5859 d.opref.resultat:= 48<*i brug*>;
11 5860 end;
10 5861 navn:= long<::>;
10 5862 end
9 5863 else
9 5864 begin
10 5865 if 1<=operatør and operatør<=64 then
10 5866 d.opref.resultat:= 62<*navn ulovligt*>
10 5867 else
10 5868 if operatør=0 then
10 5869 begin
11 5870 i:=65;
11 5871 while i<=127 and operatør=0 do
11 5872 begin
12 5873 if bpl_navn(i)=long<::> then operatør:=i;
12 5874 i:= i+1;
12 5875 end;
11 5876 if operatør=0 then
11 5877 d.opref.resultat:= 32<*ikke plads*>
11 5878 else if operatør>top_bpl_gruppe then
11 5879 top_bpl_gruppe:= operatør;
11 5880 end;
10 5881 end;
9 5882 if d.opref.resultat<=3 then
9 5883 begin
10 5884 bpl_navn(operatør):= navn;
10 5885 iaf:= operatør*op_maske_lgd;
10 5886 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5887 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5888 for i:= 1 step 1 until max_antal_operatører do
10 5889 begin
11 5890 if læsbit_ia(maske,i) then
11 5891 begin
12 5892 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5893 if læsbit_ia(operatør_maske,i) then
12 5894 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5895 end;
11 5896 end;
10 5897 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5898 if k<>0 then
10 5899 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5900 lf:= 4;
10 5901 fil(ll).lf:= navn;
10 5902 setposition(fil(ll),0,0);
10 5903 iaf:= 0;
10 5904 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5905 if k<>0 then
10 5906 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5907 for i:= 1 step 1 until op_maske_lgd//2 do
10 5908 fil(ll).iaf(i):= maske(i);
10 5909 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5910 setposition(fil(ll),0,0);
10 5911 d.opref.resultat:= 3;
10 5912 end;
9 5913
9 5913 setposition(z_io,0,0);
9 5914 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5915 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5916 end;
8 5917
8 5917 begin
9 5918 \f
9 5918 message procedure io_komm side 27 - 940522/cl;
9 5919
9 5919 <* 15 vis betjeningspladsdefinitioner *>
9 5920
9 5920 setposition(z_io,0,0);
9 5921 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5922 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5923 for i:= 1 step 1 until max_antal_operatører do
9 5924 begin
10 5925 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5926 case operatør_auto_include(i) extract 2 + 1 of(
10 5927 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5928 if i mod 4 = 0 then write(z_io,"nl",1)
10 5929 else write(z_io,"sp",5);
10 5930 end;
9 5931 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5932 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5933 for i:= 65 step 1 until top_bpl_gruppe do
9 5934 begin
10 5935 ll:=0; iaf:= i*op_maske_lgd;
10 5936 if bpl_navn(i)<>long<::> then
10 5937 begin
11 5938 write(z_io,true,6,string bpl_navn(i),":",1);
11 5939 for j:= 1 step 1 until max_antal_operatører do
11 5940 begin
12 5941 if læsbit_ia(bpl_def.iaf,j) then
12 5942 begin
13 5943 if ll mod 8 = 0 and ll<>0 then
13 5944 write(z_io,"nl",1,"sp",7);
13 5945 write(z_io,"sp",2,string bpl_navn(j));
13 5946 ll:=ll+1;
13 5947 end;
12 5948 end;
11 5949 write(z_io,"nl",1);
11 5950 end;
10 5951 end;
9 5952 write(z_io,"*",1);
9 5953 end;
8 5954
8 5954 begin
9 5955 \f
9 5955 message procedure io_komm side 28 - 940522/cl;
9 5956
9 5956 <* 16 stopniveau,definer *>
9 5957
9 5957 operatør:= ia(1);
9 5958 iaf:= operatør*terminal_beskr_længde;
9 5959 for i:= 1 step 1 until 3 do
9 5960 operatør_stop(operatør,i):= ia(i+1);
9 5961 if -,læsbit_ia(operatørmaske,operatør) then
9 5962 begin
10 5963 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5964 signal_bin(bs_mobilopkald);
10 5965 end;
9 5966 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5967 if k<>0 then
9 5968 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 5969 iaf:= 0;
9 5970 for i:= 0 step 1 until 3 do
9 5971 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 5972 setposition(fil(ll),0,0);
9 5973 setposition(z_io,0,0);
9 5974 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5975 skriv_kvittering(z_io,0,-1,3);
9 5976 end;
8 5977
8 5977 begin
9 5978 \f
9 5978 message procedure io_komm side 29 - 940522/cl;
9 5979
9 5979 <* 17 stopniveauer,vis *>
9 5980
9 5980 setposition(z_io,0,0);
9 5981 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5982
9 5982 for operatør:= 1 step 1 until max_antal_operatører do
9 5983 begin
10 5984 iaf:=operatør*terminal_beskr_længde;
10 5985 ll:=0;
10 5986 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 5987 string bpl_navn(operatør),<:(:>,
10 5988 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 5989 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 5990 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 5991 for i:= 1 step 1 until 3 do
10 5992 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 5993 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 5994 else string bpl_navn(operatør_stop(operatør,i)));
10 5995 if operatør mod 2 = 1 then
10 5996 write(z_io,"sp",40-ll)
10 5997 else
10 5998 write(z_io,"nl",1);
10 5999 end;
9 6000 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6001 write(z_io,"*",1);
9 6002 end;
8 6003
8 6003 begin
9 6004 \f
9 6004 message procedure io_komm side 30 - 941007/cl;
9 6005
9 6005 <* 18 alarmlængder *>
9 6006
9 6006 setposition(z_io,0,0);
9 6007 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6008
9 6008 for operatør:= 1 step 1 until max_antal_operatører do
9 6009 begin
10 6010 ll:=0;
10 6011 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6012 string bpl_navn(operatør));
10 6013 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 6014 if opk_alarm.iaf.alarm_lgd < 0 then
10 6015 ll:= ll+write(z_io,<:uendelig:>)
10 6016 else
10 6017 ll:= ll+write(z_io,<<ddddddd>,
10 6018 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 6019
10 6019 if operatør mod 2 = 1 then
10 6020 write(z_io,"sp",40-ll)
10 6021 else
10 6022 write(z_io,"nl",1);
10 6023 end;
9 6024 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6025 write(z_io,"*",1);
9 6026 end;
8 6027
8 6027 begin
9 6028 <* 19 CC *>
9 6029 integer i, c;
9 6030
9 6030 i:= 1;
9 6031 while læstegn(ia,i+0,c)<>0 and
9 6032 i<(op_spool_postlgd-op_spool_text)//2*3
9 6033 do skrivtegn(d.opref.data,i,c);
9 6034 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 6035
9 6035 d.opref.retur:= cs_io_komm;
9 6036 signalch(cs_op,opref,io_optype or gen_optype);
9 6037 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 6038
9 6038 setposition(z_io,0,0);
9 6039 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6040 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 6041 end;
8 6042
8 6042 begin
9 6043 <* 20: CQF,I CQF,U CQF,V *>
9 6044 integer kode, res, i, j;
9 6045 integer array field iaf, iaf1;
9 6046 long field navn;
9 6047
9 6047 kode:= d.opref.opkode extract 12;
9 6048 navn:= 6; res:= 0;
9 6049 if kode=90 <*CQF,I*> then
9 6050 begin
10 6051 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 6052 res:= 10 <*busnr ukendt*>
10 6053 else
10 6054 begin
11 6055 j:= -1;
11 6056 for i:= 1 step 1 until max_cqf do
11 6057 begin
12 6058 iaf:= (i-1)*cqf_lgd;
12 6059 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 6060 ia.navn = cqf_tabel.iaf.cqf_id
12 6061 then res:= 48; <*i brug*>
12 6062 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 6063 end;
11 6064 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 6065 if res=0 then
11 6066 begin
12 6067 iaf:= (j-1)*cqf_lgd;
12 6068 cqf_tabel.iaf.cqf_bus:= ia(1);
12 6069 cqf_tabel.iaf.cqf_fejl:= 0;
12 6070 cqf_tabel.iaf.cqf_id:= ia.navn;
12 6071 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 6072 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 6073 res:= 3;
12 6074 end;
11 6075 end;
10 6076 setposition(z_io,0,0);
10 6077 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6078 skriv_kvittering(z_io,opref,-1,res);
10 6079 end
9 6080 else
9 6081 if kode=91 <*CQF,U*> then
9 6082 begin
10 6083 j:= -1;
10 6084 for i:= 1 step 1 until max_cqf do
10 6085 begin
11 6086 iaf:= (i-1)*cqf_lgd;
11 6087 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 6088 end;
10 6089 if j>=0 then
10 6090 begin
11 6091 iaf:= (j-1)*cqf_lgd;
11 6092 for i:= 1 step 1 until cqf_lgd//2 do
11 6093 cqf_tabel.iaf(i):= 0;
11 6094 res:= 3;
11 6095 end
10 6096 else res:= 13; <*bus ikke indsat*>
10 6097 setposition(z_io,0,0);
10 6098 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6099 skriv_kvittering(z_io,opref,-1,res);
10 6100 end
9 6101 else
9 6102 begin
10 6103 setposition(z_io,0,0);
10 6104 skriv_cqf_tabel(z_io,false);
10 6105 outchar(z_io,'*');
10 6106 setposition(z_io,0,0);
10 6107 end;
9 6108
9 6108 if kode=90 or kode=91 then
9 6109 begin
10 6110 j:= skrivfil(1033,1,i);
10 6111 if j<>0 then
10 6112 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 6113 for k:= 1 step 1 until max_cqf do
10 6114 begin
11 6115 iaf1:= (k-1)*cqf_lgd;
11 6116 iaf := (k-1)*cqf_id;
11 6117 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 6118 end;
10 6119 op_cqf_tab_ændret:= true;
10 6120 end;
9 6121 end;<*CQF*>
8 6122
8 6122
8 6122 begin
9 6123 \f
9 6123 message procedure io_komm side xx - 940522/cl;
9 6124
9 6124
9 6124
9 6124 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 6125 <*-3*>
9 6126 end
8 6127 end;<*case j *>
7 6128 end <* j > 0 *>
6 6129 else
6 6130 begin
7 6131 <*V*> setposition(z_io,0,0);
7 6132 if sluttegn<>'nl' then outchar(z_io,'nl');
7 6133 skriv_kvittering(z_io,op_ref,-1,
7 6134 45 <* ikke implementeret *>);
7 6135 end;
6 6136 end;<* godkendt *>
5 6137
5 6137 <*V*> setposition(z_io,0,0);
5 6138 signal_bin(bs_zio_adgang);
5 6139 d.op_ref.retur:=cs_att_pulje;
5 6140 disable afslut_kommando(op_ref);
5 6141 end; <* indlæs kommando *>
4 6142
4 6142 begin
5 6143 \f
5 6143 message procedure io_komm side xx+1 - 810428/hko;
5 6144
5 6144 <* 2: aktiver efter stop *>
5 6145 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 6146 terminal_tab.ref.terminal_tilstand extract 21;
5 6147 afslut_operation(op_ref,-1);
5 6148 signal_bin(bs_zio_adgang);
5 6149 end;
4 6150
4 6150 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6151 <*-3*>
4 6152 end; <* case aktion+6 *>
3 6153
3 6153 until false;
3 6154 io_komm_trap:
3 6155 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6156 alarmcause extract 24 = (-13)) then
3 6157 disable skriv_io_komm(zbillede,1);
3 6158 end io_komm;
2 6159 \f
2 6159 message procedure io_spool side 1 - 810507/hko;
2 6160
2 6160 procedure io_spool;
2 6161 begin
3 6162 integer
3 6163 næste_tomme,nr;
3 6164 integer array field
3 6165 op_ref;
3 6166
3 6166 procedure skriv_io_spool(zud,omfang);
3 6167 value omfang;
3 6168 zone zud;
3 6169 integer omfang;
3 6170 begin
4 6171 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6172 if omfang > 0 then
4 6173 disable begin integer x;
5 6174 trap(slut);
5 6175 write(zud,"nl",1,
5 6176 <: opref: :>,op_ref,"nl",1,
5 6177 <: næstetomme::>,næste_tomme,"nl",1,
5 6178 <: nr :>,nr,"nl",1,
5 6179 <::>);
5 6180 skriv_coru(zud,coru_no(102));
5 6181 slut:
5 6182 end;<*disable*>
4 6183 end skriv_io_spool;
3 6184
3 6184 trap(io_spool_trap);
3 6185 næste_tomme:= 1;
3 6186 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6187 <*+2*>
3 6188 if testbit0 and overvåget or testbit28 then
3 6189 skriv_io_spool(out,0);
3 6190 <*-2*>
3 6191 \f
3 6191 message procedure io_spool side 2 - 810602/hko;
3 6192
3 6192 repeat
3 6193
3 6193 wait_ch(cs_io_spool,
3 6194 op_ref,
3 6195 true,
3 6196 -1<*timeout*>);
3 6197
3 6197 i:= d.op_ref.opkode;
3 6198 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6199 begin
4 6200 wait(ss_io_spool_tomme);
4 6201 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6202 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6203
4 6203 i:= d.op_ref.opsize;
4 6204 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6205 begin
5 6206 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6207 i:= io_spool_postlængde*2 -io_spool_post;
5 6208 end;
4 6209 <*-4*>
4 6210 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6211 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6212 signal(ss_io_spool_fulde);
4 6213 d.op_ref.resultat:= 1;
4 6214 end
3 6215 else
3 6216 begin
4 6217 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6218 <:io_spool_korutine:>,1);
4 6219 end;
3 6220
3 6220 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6221
3 6221 until false;
3 6222
3 6222 io_spool_trap:
3 6223
3 6223 disable skriv_io_spool(zbillede,1);
3 6224 end io_spool;
2 6225 \f
2 6225 message procedure io_spon side 1 - 810507/hko;
2 6226
2 6226 procedure io_spon;
2 6227 begin
3 6228 integer
3 6229 næste_fulde,nr,i,dato,kl;
3 6230 real t;
3 6231
3 6231 procedure skriv_io_spon(zud,omfang);
3 6232 value omfang;
3 6233 zone zud;
3 6234 integer omfang;
3 6235 begin
4 6236 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6237 if omfang > 0 then
4 6238 disable begin integer x;
5 6239 trap(slut);
5 6240 write(zud,"nl",1,
5 6241 <: næste-fulde::>,næste_fulde,"nl",1,
5 6242 <: nr :>,nr,"nl",1,
5 6243 <::>);
5 6244 skriv_coru(zud,coru_no(103));
5 6245 slut:
5 6246 end;<*disable*>
4 6247 end skriv_io_spon;
3 6248
3 6248 trap(io_spon_trap);
3 6249 næste_fulde:= 1;
3 6250 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6251 <*+2*>
3 6252 if testbit0 and overvåget or testbit28 then
3 6253 skriv_io_spon(out,0);
3 6254 <*-2*>
3 6255 \f
3 6255 message procedure io_spon side 2 - 810602/hko/cl;
3 6256
3 6256 repeat
3 6257
3 6257 <*V*> wait(ss_io_spool_fulde);
3 6258 <*V*> wait(bs_zio_adgang);
3 6259
3 6259 <*V*> setposition(zio,0,0);
3 6260
3 6260 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6261 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6262
3 6262 laf:=data;
3 6263 k:= fil(nr).io_spool_post.opkode;
3 6264 if k = 22 or k = 36 then
3 6265 disable begin
4 6266 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6267 if k=36 then
4 6268 begin
5 6269 i:= fil(nr).io_spool_post.data(4);
5 6270 j:= i extract 5;
5 6271 if j<>0 then j:=j+'A'-1;
5 6272 i:= i shift (-5) extract 10;
5 6273 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6274 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6275 end;
4 6276 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6277 fil(nr).io_spool_post.tid)
4 6278 end
3 6279 else if k = 23 then
3 6280 disable
3 6281 begin
4 6282 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6283 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6284 kl:= round t;
4 6285 i:= replace_char(1<*space in number*>,'.');
4 6286 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6287 replace_char(1,i);
4 6288 end
3 6289 else if k = 45 or k = 46 then
3 6290 disable begin
4 6291 integer vogn,linie,bogst,løb,t;
4 6292
4 6292 t:=fil(nr).io_spool_post.data(2);
4 6293 outchar(z_io,'nl');
4 6294 if k = 45 then
4 6295 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6296
4 6296 write(zio,<:nødopkald fra :>);
4 6297 vogn:= fil(nr).io_spool_post.data(1);
4 6298 i:= vogn shift (-22);
4 6299 if i < 2 then
4 6300 skrivid(zio,vogn,9)
4 6301 else
4 6302 begin
5 6303 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6304 write(zio,<:!!!:>,vogn);
5 6305 end;
4 6306 \f
4 6306 message procedure io_spon side 3 - 810507/hko;
4 6307
4 6307 if fil(nr).io_spool_post.data(3)<>0 then
4 6308 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6309
4 6309 if k = 46 then
4 6310 begin
5 6311 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6312 end;
4 6313 end <*disable*>
3 6314 else
3 6315 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6316
3 6316 fil(nr,1):= fil(nr,1) add 1;
3 6317
3 6317 <*V*> setposition(zio,0,0);
3 6318
3 6318 signal_bin(bs_zio_adgang);
3 6319
3 6319 signal(ss_io_spool_tomme);
3 6320
3 6320 until false;
3 6321
3 6321 io_spon_trap:
3 6322 skriv_io_spon(zbillede,1);
3 6323
3 6323 end io_spon;
2 6324 \f
2 6324 message procedure io_medd side 1;
2 6325
2 6325 procedure io_medd;
2 6326 begin
3 6327 integer array field opref;
3 6328 integer afs, kl, i;
3 6329 real dato, t;
3 6330
3 6330
3 6330 procedure skriv_io_medd(zud,omfang);
3 6331 value omfang;
3 6332 zone zud;
3 6333 integer omfang;
3 6334 begin
4 6335 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6336 if omfang > 0 then
4 6337 disable begin integer x;
5 6338 trap(slut);
5 6339 write(zud,"nl",1,
5 6340 <: opref: :>,opref,"nl",1,
5 6341 <: afs: :>,afs,"nl",1,
5 6342 <: kl: :>,kl,"nl",1,
5 6343 <: i: :>,i,"nl",1,
5 6344 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6345 <: t: :>,t,"nl",1,
5 6346 <::>);
5 6347 skriv_coru(zud,coru_no(104));
5 6348 slut:
5 6349 end;<*disable*>
4 6350 end skriv_io_medd;
3 6351
3 6351 trap(io_medd_trap);
3 6352 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6353 <*+2*>
3 6354 if testbit0 and overvåget or testbit28 then
3 6355 skriv_io_medd(out,0);
3 6356 <*-2*>
3 6357 \f
3 6357 message procedure io_medd side 2;
3 6358
3 6358 repeat
3 6359 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6360 <*V*> wait(bs_zio_adgang);
3 6361
3 6361 afs:= d.opref.data.op_spool_kilde;
3 6362 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6363 kl:= round t;
3 6364 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6365 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6366 i:= replacechar(1,'.');
3 6367 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6368 replacechar(1,i);
3 6369 write(z_io,d.opref.data.op_spool_text);
3 6370 setposition(z_io,0,0);
3 6371
3 6371 signalbin(bs_zio_adgang);
3 6372 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6373 until false;
3 6374
3 6374 io_medd_trap:
3 6375 skriv_io_medd(zbillede,1);
3 6376
3 6376 end io_medd;
2 6377
2 6377 procedure io_nulstil_tællere;
2 6378 begin
3 6379 real nu, dato, kl, forr, næste, et_døgn, r;
3 6380 integer array field opref;
3 6381 integer ventetid, omr, typ, sum;
3 6382 integer array ialt(1:5);
3 6383
3 6383 procedure skriv_io_null(zud,omfang);
3 6384 value omfang;
3 6385 zone zud;
3 6386 integer omfang;
3 6387 begin
4 6388 disable write(zud,"nl",1,<:+++ io_nulstil_tællere :>);
4 6389 if omfang > 0 then
4 6390 disable begin real t; real array field raf;
5 6391 raf:=0;
5 6392 trap(slut);
5 6393 write(zud,"nl",1,
5 6394 <: opref: :>,opref,"nl",1,
5 6395 <: ventetid: :>,ventetid,"nl",1,
5 6396 <: omr: :>,omr,"nl",1,
5 6397 <: typ: :>,typ,"nl",1,
5 6398 <: sum: :>,sum,"nl",1,
5 6399 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 6400 <: forr: :>,systime(4,forr,t),t,"nl",1,
5 6401 <: næste: :>,systime(4,næste,t),t,"nl",1,
5 6402 <: r: :>,systime(4,r,t),t,"nl",1,
5 6403 <: dato: :>,dato,"nl",1,
5 6404 <: kl: :>,kl,"nl",1,
5 6405 <: et-døgn: :>,<< dddddd>,et_døgn,"nl",1,
5 6406 <::>);
5 6407 write(zud,"nl",1,<:ialt: :>);
5 6408 skriv_hele(zud,ialt.raf,10,2);
5 6409 skriv_coru(zud,coru_no(105));
5 6410 slut:
5 6411 end;<*disable*>
4 6412 end skriv_io_null;
3 6413
3 6413 trap(io_null_trap);
3 6414 stack_claim(500);
3 6415 <*+2*>
3 6416 if testbit0 and overvåget or testbit28 then
3 6417 skriv_io_null(out,0);
3 6418 <*-2*>
3 6419 et_døgn:= 24*60*60.0;
3 6420 systime(1,0.0,nu);
3 6421 dato:= systime(4,nu,kl);
3 6422 if nulstil_systællere >= 0 then
3 6423 begin
4 6424 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6425 + et_døgn
4 6426 else næste:= systid(dato,nulstil_systællere);
4 6427 forr:= næste - et_døgn;
4 6428 if (forr - systællere_nulstillet) > et_døgn then
4 6429 næste:= nu;
4 6430 end;
3 6431
3 6431 repeat
3 6432 ventetid:= (if nulstil_systællere < 0 then (-1) else (næste - nu));
3 6433 <*V*> waitch(cs_io_nulstil,opref,io_optype,ventetid);
3 6434
3 6434 if opref <= 0 then
3 6435 begin
4 6436 <* nulstil opkaldstællere *>
4 6437 wait(bs_zio_adgang);
4 6438 setposition(z_io,0,0);
4 6439
4 6439 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6440
4 6440 write(z_io,"nl",1,<:!TÆ,N (automatisk):>,"nl",2,
4 6441 <:område udgående alm. ind nød ind:>,
4 6442 <: ind ialt total ej forb. optaget:>,"nl",1);
4 6443 for omr := 1 step 1 until max_antal_områder do
4 6444 begin
5 6445 sum:= 0;
5 6446 write(z_io,true,6,string område_navn(omr),":",1);
5 6447 for typ:= 1 step 1 until 3 do
5 6448 begin
6 6449 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6450 sum:= sum + opkalds_tællere((omr-1)*5+typ);
6 6451 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6452 end;
5 6453 write(z_io,<< ddddddd>,
5 6454 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
5 6455 for typ:= 4 step 1 until 5 do
5 6456 begin
6 6457 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6458 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6459 end;
5 6460 write(z_io,"nl",1);
5 6461 end;
4 6462 sum:= 0;
4 6463 write(z_io,"nl",1,<:ialt ::>);
4 6464 for typ:= 1 step 1 until 3 do
4 6465 begin
5 6466 write(z_io,<< ddddddd>,ialt(typ));
5 6467 sum:= sum+ialt(typ);
5 6468 end;
4 6469 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6470 ialt(4), ialt(5), "nl",3);
4 6471
4 6471 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6472 write(z_io,<:oper. udgående alm. ind nød ind:>,
4 6473 <: ind ialt total ej forb. optaget:>,"nl",1);
4 6474 for omr := 1 step 1 until max_antal_operatører do
4 6475 begin
5 6476 sum:= 0;
5 6477 if bpl_navn(omr)=long<::> then
5 6478 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
5 6479 else
5 6480 write(z_io,true,6,string bpl_navn(omr),":",1);
5 6481 for typ:= 1 step 1 until 3 do
5 6482 begin
6 6483 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
6 6484 sum:= sum + operatør_tællere((omr-1)*5+typ);
6 6485 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6486 end;
5 6487 write(z_io,<< ddddddd>,
5 6488 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
5 6489 for typ:= 4 step 1 until 5 do
5 6490 begin
6 6491 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
6 6492 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6493 end;
5 6494 write(z_io,"nl",1);
5 6495 end;
4 6496 sum:= 0;
4 6497 write(z_io,"nl",1,<:ialt ::>);
4 6498 for typ:= 1 step 1 until 3 do
4 6499 begin
5 6500 write(z_io,<< ddddddd>,ialt(typ));
5 6501 sum:= sum+ialt(typ);
5 6502 end;
4 6503 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6504 ialt(4),ialt(5),"nl",2);
4 6505
4 6505 typ:= replacechar(1,':');
4 6506 write(z_io,<:tællere nulstilles :>);
4 6507 if nulstil_systællere=(-1) then
4 6508 write(z_io,<:ikke automatisk:>,"nl",1)
4 6509 else
4 6510 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
4 6511 nulstil_systællere,"nl",1);
4 6512 replacechar(1,'.');
4 6513 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
4 6514 systime(4,systællere_nulstillet,r));
4 6515 replacechar(1,':');
4 6516 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
4 6517 replacechar(1,typ);
4 6518 write(z_io,"*",1,"nl",1);
4 6519 setposition(z_io,0,0);
4 6520 signal_bin(bs_zio_adgang);
4 6521
4 6521 for omr:= 1 step 1 until max_antal_områder*5 do
4 6522 opkalds_tællere(omr):= 0;
4 6523 for omr:= 1 step 1 until max_antal_operatører*5 do
4 6524 operatør_tællere(omr):= 0;
4 6525 systællere_nulstillet:= næste;
4 6526 opdater_tf_systællere;
4 6527 end
3 6528 else
3 6529 signalch(d.opref.retur,opref,d.opref.optype);
3 6530
3 6530 systime(1,0.0,nu);
3 6531 dato:= systime(4,nu,kl);
3 6532 if nulstil_systællere >= 0 then
3 6533 begin
4 6534 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6535 + et_døgn
4 6536 else næste:= systid(dato,nulstil_systællere);
4 6537 forr:= næste - et_døgn;
4 6538 end;
3 6539 until false;
3 6540
3 6540 io_null_trap:
3 6541 skriv_io_null(zbillede,1);
3 6542 end io_nulstil_tællere;
2 6543
2 6543 \f
2 6543 message operatør_erklæringer side 1 - 810602/hko;
2 6544 integer
2 6545 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6546 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6547 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6548 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6549 integer array
2 6550 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6551 operatørmaske(1:op_maske_lgd//2),
2 6552 op_talevej(0:max_antal_operatører),
2 6553 tv_operatør(0:max_antal_taleveje),
2 6554 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6555 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6556 ant_i_opkø,
2 6557 cs_operatør,
2 6558 cs_op_fil(1:max_antal_operatører);
2 6559 boolean
2 6560 op_cqf_tab_ændret;
2 6561 integer field
2 6562 op_spool_kilde;
2 6563 real field
2 6564 op_spool_tid;
2 6565 long array field
2 6566 op_spool_text;
2 6567 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6568 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6569 \f
2 6569 message procedure op_fejl side 1 - 830310/hko;
2 6570
2 6570 procedure op_fejl(z,s,b);
2 6571 integer s,b;
2 6572 zone z;
2 6573 begin
3 6574 disable begin
4 6575 integer array iz(1:20);
4 6576 integer i,j,k,n;
4 6577 integer array field iaf,iaf1,msk;
4 6578 boolean input;
4 6579 real array field laf,laf1;
4 6580
4 6580 getzone6(z,iz);
4 6581 iaf:=laf:=2;
4 6582 input:= iz(13) = 1;
4 6583 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6584 if iz.laf(1)=terminal_navn.laf1(1) and
4 6585 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6586
4 6586 <*+2*> if testbit31 then
4 6587 <**> begin
5 6588 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6589 <**> <:s=:>); outintbits(out,s);
5 6590 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6591 <**> else <:output:>,"nl",1);
5 6592 <**> setposition(out,0,0);
5 6593 <**> end;
4 6594 <*-2*>
4 6595 iaf:=j*terminal_beskr_længde;
4 6596 k:=1;
4 6597
4 6597 i:= terminal_tab.iaf.terminal_tilstand;
4 6598 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6599 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6600 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6601 if s <> (1 shift 21 +2) then
4 6602 begin
5 6603 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6604 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6605 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6606 sæt_bit_ia(opkaldsflag,j,0);
5 6607 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6608 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6609 begin
6 6610 msk:= k*op_maske_lgd;
6 6611 if læsbit_ia(bpl_def.msk,j) then
6 6612 <**> begin
7 6613 n:= 0;
7 6614 for i:= 1 step 1 until max_antal_operatører do
7 6615 if læsbit_ia(bpl_def.msk,i) then
7 6616 begin
8 6617 iaf1:= i*terminal_beskr_længde;
8 6618 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6619 n:= n+1;
8 6620 end;
7 6621 bpl_tilst(j,1):= n;
7 6622 end;
6 6623 <**> <*
6 6624 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6625 *> end;
5 6626 signal_bin(bs_mobil_opkald);
5 6627 end;
4 6628
4 6628 if input or -,input then
4 6629 begin
5 6630 z(1):=real <:<'?'><'?'><'em'>:>;
5 6631 b:=2;
5 6632 end;
4 6633 end; <*disable*>
3 6634 end op_fejl;
2 6635 \f
2 6635 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6636
2 6636 procedure tvswitch_fejl(z,s,b);
2 6637 integer s,b;
2 6638 zone z;
2 6639 begin
3 6640 disable begin
4 6641 integer array iz(1:20);
4 6642 integer i,j,k;
4 6643 integer array field iaf;
4 6644 boolean input;
4 6645 real array field raf;
4 6646
4 6646 getzone6(z,iz);
4 6647 iaf:=raf:=2;
4 6648 input:= iz(13) = 1;
4 6649 <*+2*> if testbit31 then
4 6650 <**> begin
5 6651 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6652 <**> <:s=:>); outintbits(out,s);
5 6653 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6654 <**> else <:output:>,"nl",1);
5 6655 <**> skrivhele(out,z,b,5);
5 6656 <**> setposition(out,0,0);
5 6657 <**> end;
4 6658 <*-2*>
4 6659 k:=1;
4 6660 if s <> (1 shift 21 +2) then
4 6661 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6662 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6663
4 6663 if input or -,input then
4 6664 begin
5 6665 z(1):=real <:<'em'>:>;
5 6666 b:=2;
5 6667 end;
4 6668 end; <*disable*>
3 6669 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6670 end tvswitch_fejl;
2 6671
2 6671 procedure skriv_talevejs_tab(z);
2 6672 zone z;
2 6673 begin
3 6674 write(z,"nl",2,<:talevejsswitch::>);
3 6675 write(z,"nl",1,<: operatører::>,"nl",1);
3 6676 for i:= 1 step 1 until max_antal_operatører do
3 6677 begin
4 6678 write(z,<< dd>,i,":",1,op_talevej(i));
4 6679 if i mod 8=0 then outchar(z,'nl');
4 6680 end;
3 6681 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6682 for i:= 1 step 1 until max_antal_taleveje do
3 6683 begin
4 6684 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6685 if i mod 8=0 then outchar(z,'nl');
4 6686 end;
3 6687 write(z,"nl",3);
3 6688 end;
2 6689 \f
2 6689 message procedure skriv_opk_alarm_tab side 1;
2 6690
2 6690 procedure skriv_opk_alarm_tab(z);
2 6691 zone z;
2 6692 begin
3 6693 integer nr;
3 6694 integer array field tab;
3 6695 real t;
3 6696
3 6696 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6697 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6698 for nr:=1 step 1 until max_antal_operatører do
3 6699 begin
4 6700 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6701 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6702 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6703 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6704 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6705 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6706 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6707 "nl",1);
4 6708 end;
3 6709 end;
2 6710 \f
2 6710 message procedure skriv_op_spool_buf side 1;
2 6711
2 6711 procedure skriv_op_spool_buf(z);
2 6712 zone z;
2 6713 begin
3 6714 integer array field ref;
3 6715 integer nr, kilde;
3 6716 real dato, kl;
3 6717
3 6717 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6718 for nr:= 1 step 1 until op_spool_postantal do
3 6719 begin
4 6720 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6721 ref:= (nr-1)*op_spool_postlgd;
4 6722 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6723 begin
5 6724 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6725 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6726 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6727 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6728 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6729 op_spool_buf.ref.op_spool_text);
5 6730 end;
4 6731 outchar(z,'nl');
4 6732 end;
3 6733 end;
2 6734
2 6734 procedure skriv_cqf_tabel(z,lang);
2 6735 value lang;
2 6736 zone z;
2 6737 boolean lang;
2 6738 begin
3 6739 integer array field ref;
3 6740 integer i,ant;
3 6741 real dato, kl;
3 6742
3 6742 ant:= 0;
3 6743 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6744 if -,lang then
3 6745 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6746 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6747 else
3 6748 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6749 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6750 for i:= 1 step 1 until max_cqf do
3 6751 begin
4 6752 ref:= (i-1)*cqf_lgd;
4 6753 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6754 begin
5 6755 ant:= ant+1;
5 6756 if lang then
5 6757 write(z,<<dd>,i,":",1);
5 6758 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6759 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6760 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6761 begin
6 6762 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6763 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6764 end
5 6765 else
5 6766 write(z,"sp",14,"?",1);
5 6767 if lang then
5 6768 begin
6 6769 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6770 begin
7 6771 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6772 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6773 end
6 6774 else
6 6775 write(z,"sp",14,"?",1);
6 6776 end
5 6777 else
5 6778 write(z,"sp",2);
5 6779 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6780 end;
4 6781 end;
3 6782 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6783 end;
2 6784
2 6784 procedure sorter_cqftab(l,u);
2 6785 value l,u;
2 6786 integer l,u;
2 6787 begin
3 6788 integer array field ii,jj;
3 6789 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6790
3 6790 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6791 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6792 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6793 repeat
3 6794 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6795 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6796 if ii <= jj then
3 6797 begin
4 6798 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6799 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6800 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6801 ii:= ii+cqf_lgd;
4 6802 jj:= jj-cqf_lgd;
4 6803 end;
3 6804 until ii>jj;
3 6805 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6806 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6807 end;
2 6808 \f
2 6808 message procedure ht_symbol side 1 - 851001/cl;
2 6809
2 6809 procedure ht_symbol(z);
2 6810 zone z;
2 6811 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6812
2 6812
2 6812
2 6812
2 6812 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6812 @@ @@ @@
2 6812 @@ @@ @@
2 6812 @@ @@ @@
2 6812 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6812 @@ @@
2 6812 @@ @@
2 6812 @@ @@
2 6812 @@ @@@@@@@@@@@@@ @@
2 6812 @@ @@ @@ @@
2 6812 @@ @@ @@ @@
2 6812 @@ @@ @@ @@
2 6812 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6812 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6813 \f
2 6813 message procedure definer_taster side 1 - 891214,cl;
2 6814
2 6814 procedure definer_taster(nr);
2 6815 value nr;
2 6816 integer nr;
2 6817 begin
3 6818
3 6818 setposition(z_op(nr),0,0);
3 6819 write(z_op(nr),
3 6820 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6821 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6822 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6823 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6824 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6825 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6826 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6827 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6828 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6829 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6830 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6831 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6832 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6833 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6834 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6835 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6836 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6837 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6838 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6839 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6840 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6841 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6842 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6843 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6844 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6845 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6846 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6847 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6848 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6849 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6850 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6851 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6852 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6853 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6854 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6855 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6856 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6857 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6858 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6859 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6860 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6861 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6862 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6863 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6864 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6865 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6866 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6867 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6868 <::>);
3 6869 end;
2 6870 \f
2 6870 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6871
2 6871 procedure skriv_terminal_tab(z);
2 6872 zone z;
2 6873 begin
3 6874 integer array field ref;
3 6875 integer t1,i,j,id,k;
3 6876
3 6876 write(z,"ff",1,<:
3 6877 ******* terminalbeskrivelser ********
3 6878
3 6878 # a k l p m m n o
3 6879 1 l a y a o o ø p
3 6880 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6881 <*
3 6882 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6883 *>
3 6884 for i:=1 step 1 until max_antal_operatører do
3 6885 begin
4 6886 ref:=i*terminal_beskr_længde;
4 6887 t1:=terminal_tab.ref(1);
4 6888 id:=terminal_tab.ref(2);
4 6889 k:=terminal_tab.ref(3);
4 6890 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6891 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6892 "sp",1);
4 6893 for j:=11 step -1 until 2 do
4 6894 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6895 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6896 "sp",1);
4 6897 skriv_id(z,id,9);
4 6898 skriv_id(z,k,9);
4 6899 end;
3 6900 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6901 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6902 write(z,"nl",1);
3 6903 end skriv_terminal_tab;
2 6904 \f
2 6904 message procedure h_operatør side 1 - 810520/hko;
2 6905
2 6905 <* hovedmodulkorutine for operatørterminaler *>
2 6906 procedure h_operatør;
2 6907 begin
3 6908 integer array field op_ref;
3 6909 integer k,nr,ant,ref,dest_sem;
3 6910 procedure skriv_hoperatør(zud,omfang);
3 6911 value omfang;
3 6912 zone zud;
3 6913 integer omfang;
3 6914 begin
4 6915
4 6915 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6916 if omfang>0 then
4 6917 disable begin integer x;
5 6918 trap(slut);
5 6919 write(zud,"nl",1,
5 6920 <: op_ref: :>,op_ref,"nl",1,
5 6921 <: nr: :>,nr,"nl",1,
5 6922 <: ant: :>,ant,"nl",1,
5 6923 <: ref: :>,ref,"nl",1,
5 6924 <: k: :>,k,"nl",1,
5 6925 <: dest_sem: :>,dest_sem,"nl",1,
5 6926 <::>);
5 6927 skriv_coru(zud,coru_no(200));
5 6928 slut:
5 6929 end;
4 6930 end skriv_hoperatør;
3 6931
3 6931 trap(hop_trap);
3 6932 stack_claim(if cm_test then 198 else 146);
3 6933
3 6933 <*+2*>
3 6934 if testbit8 and overvåget or testbit28 then
3 6935 skriv_hoperatør(out,0);
3 6936 <*-2*>
3 6937 \f
3 6937 message procedure h_operatør side 2 - 820304/hko;
3 6938
3 6938 repeat
3 6939 wait_ch(cs_op,op_ref,true,-1);
3 6940 <*+4*>
3 6941 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6942 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6943 <*-4*>
3 6944
3 6944 k:=d.op_ref.opkode extract 12;
3 6945 dest_sem:=
3 6946 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6947 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6948 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6949 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6950 if k=37 then cs_op_spool else
3 6951 if k=40 or k=38 then 0
3 6952 else -1;
3 6953 <*+4*>
3 6954 if dest_sem=-1 then
3 6955 begin
4 6956 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6957 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6958 end
3 6959 else
3 6960 <*-4*>
3 6961 if k=40 then
3 6962 begin
4 6963 dest_sem:= d.op_ref.retur;
4 6964 d.op_ref.retur:= cs_op_retur;
4 6965 for nr:= 1 step 1 until max_antal_operatører do
4 6966 begin
5 6967 inspect_ch(cs_operatør(nr),genoptype,ant);
5 6968 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 6969 or læsbit_ia(samtaleflag,nr))
5 6970 and læsbit_ia(operatørmaske,nr) then
5 6971 begin
6 6972 ref:= op_ref;
6 6973 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6974 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6975 <*+4*> if op_ref <> ref then
6 6976 fejlreaktion(11<*fr.post*>,op_ref,
6 6977 <:opdater opkaldskø,retur:>,0);
6 6978 <*-4*>
6 6979 end;
5 6980 end;
4 6981 d.op_ref.retur:= dest_sem;
4 6982 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6983 end
3 6984 else
3 6985 if k=38 then
3 6986 begin
4 6987 dest_sem:= d.opref.retur;
4 6988 d.op_ref.retur:= cs_op_retur;
4 6989 for nr:= 1 step 1 until max_antal_operatører do
4 6990 begin
5 6991 if d.opref.data.op_spool_kilde <> nr then
5 6992 begin
6 6993 ref:= op_ref;
6 6994 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6995 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6996 <*+4*> if op_ref <> ref then
6 6997 fejlreaktion(11<*fr.post*>,op_ref,
6 6998 <:opdater opkaldskø,retur:>,0);
6 6999 <*-4*>
6 7000 end;
5 7001 end;
4 7002 if d.opref.data.op_spool_kilde<>0 then
4 7003 begin
5 7004 ref:= op_ref;
5 7005 nr:= d.opref.data.op_spool_kilde;
5 7006 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 7007 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 7008 <*+4*> if op_ref <> ref then
5 7009 fejlreaktion(11<*fr.post*>,op_ref,
5 7010 <:operatørmedddelelse, retur:>,0);
5 7011 <*-4*>
5 7012 d.op_ref.retur:= dest_sem;
5 7013 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 7014 end
4 7015 else
4 7016 begin
5 7017 d.op_ref.retur:= dest_sem;
5 7018 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 7019 end;
4 7020 end
3 7021 else
3 7022 begin
4 7023 \f
4 7023 message procedure h_operatør side 3 - 810601/hko;
4 7024
4 7024 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 7025 begin
5 7026 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 7027 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 7028 +terminal_tab.iaf.terminal_tilstand extract 21;
5 7029 end;
4 7030 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7031 end;
3 7032 until false;
3 7033
3 7033 hop_trap:
3 7034 disable skriv_hoperatør(zbillede,1);
3 7035 end h_operatør;
2 7036 \f
2 7036 message procedure operatør side 1 - 820304/hko;
2 7037
2 7037 procedure operatør(nr);
2 7038 value nr;
2 7039 integer nr;
2 7040 begin
3 7041 integer array field op_ref,ref,vt_op,iaf,tab;
3 7042 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 7043 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 7044 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 7045 real kommstart,kommslut;
3 7046 \f
3 7046 message procedure operatør side 1a - 820301/hko;
3 7047
3 7047 procedure skriv_operatør(zud,omfang);
3 7048 value omfang;
3 7049 zone zud;
3 7050 integer omfang;
3 7051 begin integer i;
4 7052
4 7052 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 7053 write(zud,"sp",26-i);
4 7054 if omfang > 0 then
4 7055 disable begin
5 7056 integer x;
5 7057 trap(slut);
5 7058 write(zud,"nl",1,
5 7059 <: op-ref: :>,op_ref,"nl",1,
5 7060 <: kode: :>,kode,"nl",1,
5 7061 <: aktion: :>,aktion,"nl",1,
5 7062 <: ref: :>,ref,"nl",1,
5 7063 <: vt_op: :>,vt_op,"nl",1,
5 7064 <: iaf: :>,iaf,"nl",1,
5 7065 <: status: :>,status,"nl",1,
5 7066 <: tilstand: :>,tilstand,"nl",1,
5 7067 <: bv: :>,bv,"nl",1,
5 7068 <: bs: :>,bs,"nl",1,
5 7069 <: bs-tilst: :>,bs_tilst,"nl",1,
5 7070 <: kanal: :>,kanal,"nl",1,
5 7071 <: opgave: :>,opgave,"nl",1,
5 7072 <: pos: :>,pos,"nl",1,
5 7073 <: indeks: :>,indeks,"nl",1,
5 7074 <: sep: :>,sep,"nl",1,
5 7075 <: sluttegn: :>,sluttegn,"nl",1,
5 7076 <: vogn: :>,vogn,"nl",1,
5 7077 <: ll: :>,ll,"nl",1,
5 7078 <: garage: :>,garage,"nl",1,
5 7079 <: skærmmåde: :>,skærmmåde,"nl",1,
5 7080 <: res: :>,res,"nl",1,
5 7081 <: tab: :>,tab,"nl",1,
5 7082 <: rkom: :>,rkom,"nl",1,
5 7083 <: par1: :>,par1,"nl",1,
5 7084 <: par2: :>,par2,"nl",1,
5 7085 <::>);
5 7086 skriv_coru(zud,coru_no(200+nr));
5 7087 slut:
5 7088 end;
4 7089 end skriv_operatør;
3 7090 \f
3 7090 message procedure skærmstatus side 1 - 810518/hko;
3 7091
3 7091 integer
3 7092 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 7093 integer tilstand,b_v,b_s,b_s_tilst;
3 7094 begin
4 7095 integer i,j;
4 7096
4 7096 i:= terminal_tab.ref(1);
4 7097 b_s:= terminal_tab.ref(2);
4 7098 b_s_tilst:= i extract 12;
4 7099 j:= b_s_tilst extract 3;
4 7100 b_v:= i shift (-12) extract 4;
4 7101 tilstand:= i shift (-21);
4 7102
4 7102 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 7103 if b_v = 0 and j = 1<*opkald*> then 1 else
4 7104 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 7105 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 7106 end skærmstatus;
3 7107 \f
3 7107 message procedure skriv_skærm side 1 - 810522/hko;
3 7108
3 7108 procedure skriv_skærm(nr);
3 7109 value nr;
3 7110 integer nr;
3 7111 begin
4 7112 integer i;
4 7113
4 7113 disable definer_taster(nr);
4 7114
4 7114 skriv_skærm_maske(nr);
4 7115 skriv_skærm_opkaldskø(nr);
4 7116 skriv_skærm_b_v_s(nr);
4 7117 for i:= 1 step 1 until max_antal_kanaler do
4 7118 skriv_skærm_kanal(nr,i);
4 7119 cursor(z_op(nr),1,1);
4 7120 <*V*> setposition(z_op(nr),0,0);
4 7121 end skriv_skærm;
3 7122 \f
3 7122 message procedure skriv_skærm_id side 1 - 830310/hko;
3 7123
3 7123 procedure skriv_skærm_id(nr,id,nød);
3 7124 value nr,id,nød;
3 7125 integer nr,id;
3 7126 boolean nød;
3 7127 begin
4 7128 integer linie,løb,bogst,i,p;
4 7129
4 7129 i:= id shift (-22);
4 7130
4 7130 case i+1 of
4 7131 begin
5 7132 begin <* busnr *>
6 7133 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 7134 (id extract 14) mod 10000);
6 7135 if id shift (-14) extract 8 > 0 then
6 7136 p:= p+write(z_op(nr),".",1,
6 7137 string bpl_navn(id shift (-14) extract 8));
6 7138 write(z_op(nr),"sp",11-p);
6 7139 end;
5 7140
5 7140 begin <*linie/løb*>
6 7141 linie:= id shift (-12) extract 10;
6 7142 bogst:= id shift (-7) extract 5;
6 7143 if bogst > 0 then bogst:= bogst +'A'-1;
6 7144 løb:= id extract 7;
6 7145 write(z_op(nr),if nød then "*" else "sp",1,
6 7146 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 7147 false add bogst,1,"/",1,løb,
6 7148 "sp",if løb > 9 then 3 else 4);
6 7149 end;
5 7150
5 7150 begin <*gruppe*>
6 7151 write(z_op(nr),<:GRP :>);
6 7152 if id shift (-21) extract 1 = 1 then
6 7153 begin <*specialgruppe*>
7 7154 løb:= id extract 7;
7 7155 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 7156 <<d>,løb,"sp",2);
7 7157 end
6 7158 else
6 7159 begin
7 7160 linie:= id shift (-5) extract 10;
7 7161 bogst:= id extract 5;
7 7162 if bogst > 0 then bogst:= bogst +'A'-1;
7 7163 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 7164 false add bogst,1,"sp",2);
7 7165 end;
6 7166 end;
5 7167
5 7167 <* kanal eller område *>
5 7168 begin
6 7169 linie:= (id shift (-20) extract 2) + 1;
6 7170 case linie of
6 7171 begin
7 7172 write(z_op(nr),"sp",11-write(z_op(nr),
7 7173 string kanal_navn(id extract 20)));
7 7174 write(z_op(nr),<:K*:>,"sp",9);
7 7175 write(z_op(nr),"sp",11-write(z_op(nr),
7 7176 <:OMR :>,string område_navn(id extract 20)));
7 7177 write(z_op(nr),<:ALLE:>,"sp",7);
7 7178 end;
6 7179 end;
5 7180
5 7180 end <* case i *>
4 7181 end skriv_skærm_id;
3 7182 \f
3 7182 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 7183
3 7183 procedure skriv_skærm_kanal(nr,kanal);
3 7184 value nr,kanal;
3 7185 integer nr,kanal;
3 7186 begin
4 7187 integer i,j,k,t,omr;
4 7188 integer array field tref,kref;
4 7189 boolean nød;
4 7190
4 7190 tref:= nr*terminal_beskr_længde;
4 7191 kref:= (kanal-1)*kanal_beskr_længde;
4 7192 t:= kanaltab.kref.kanal_tilstand;
4 7193 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 7194 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 7195 cursor(z_op(nr),kanal+2,28);
4 7196 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 7197 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 7198 " ",1," ",1);
4 7199 write(z_op(nr),true,6,string kanal_navn(kanal));
4 7200 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 7201 pabx_id(kanal_id(kanal) extract 5)
4 7202 else
4 7203 radio_id(kanal_id(kanal) extract 5);
4 7204 for i:= -2 step 1 until 0 do
4 7205 begin
5 7206 write(z_op(nr),
5 7207 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 7208 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 7209 end;
4 7210 write(z_op(nr),<:: :>);
4 7211 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 7212 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 7213 begin
5 7214 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 7215 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 7216 end
4 7217 else
4 7218 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 7219 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 7220 else
4 7221 if i > 0 and
4 7222 ( true <* i <> nr *> <* OPT også ud på egen skærm 960527/CL *> or
4 7223 j = kanal <* kanal = kanalnr for ventepos *> or
4 7224 (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 7225 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 7226 begin
5 7227 write(z_op(nr),<:OPT :>);
5 7228 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 7229 else write(z_op(nr),string bpl_navn(i));
5 7230 end
4 7231 else
4 7232 if false then
4 7233 begin
5 7234 i:= kanaltab.kref.kanal_id1;
5 7235 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 7236 skriv_skærm_id(nr,i,nød);
5 7237 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 7238 i:= kanaltab.kref.kanal_id2;
5 7239 if i<>0 then skriv_skærm_id(nr,i,false);
5 7240 end;
4 7241 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7242 end skriv_skærm_kanal;
3 7243 \f
3 7243 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 7244
3 7244 procedure skriv_skærm_b_v_s(nr);
3 7245 value nr;
3 7246 integer nr;
3 7247 begin
4 7248 integer i,j,k,kv,ks,t;
4 7249 integer array field tref,kref;
4 7250
4 7250 tref:= nr*terminal_beskr_længde;
4 7251 i:= terminal_tab.tref.terminal_tilstand;
4 7252 kv:= i shift (-12) extract 4;
4 7253 ks:= terminaltab.tref(2) extract 20;
4 7254 <*V*> setposition(z_op(nr),0,0);
4 7255 cursor(z_op(nr),18,28);
4 7256 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7257 cursor(z_op(nr),20,28);
4 7258 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7259 cursor(z_op(nr),21,28);
4 7260 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7261 cursor(z_op(nr),20,28);
4 7262 if op_talevej(nr)<>0 then
4 7263 begin
5 7264 cursor(z_op(nr),18,28);
5 7265 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 7266 end;
4 7267 if kv <> 0 then
4 7268 begin
5 7269 kref:= (kv-1)*kanal_beskr_længde;
5 7270 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 7271 else kanaltab.kref.kanal_id2;
5 7272 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 7273 else kanaltab.kref.kanal_alt_id2;
5 7274 write(z_op(nr),true,6,string kanal_navn(kv));
5 7275 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 7276 skriv_skærm_id(nr,k,false);
5 7277 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 7278 end;
4 7279
4 7279 cursor(z_op(nr),21,28);
4 7280 j:= terminal_tab.tref(2);
4 7281 if i shift (-21) <> 0 <*ikke ledig*> then
4 7282 begin
5 7283 \f
5 7283 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 7284
5 7284 if i shift (-21) = 1 <*samtale*> then
5 7285 begin
6 7286 if j shift (-20) = 12 then
6 7287 begin
7 7288 write(z_op(nr),true,6,string kanal_navn(ks));
7 7289 end
6 7290 else
6 7291 begin
7 7292 write(z_op(nr),true,6,<:K*:>);
7 7293 k:= 0;
7 7294 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 7295 k:= k+1;
7 7296 ks:= k;
7 7297 end;
6 7298 kref:= (ks-1)*kanal_beskr_længde;
6 7299 t:= kanaltab.kref.kanaltilstand;
6 7300 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 7301 t shift (-3) extract 1 = 1);
6 7302 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 7303 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 7304 if t shift (-5) extract 1 = 1 then <:MON :> else
6 7305 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 7306 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 7307 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 7308 if t shift (-9) extract 1 = 1 then
6 7309 write(z_op(nr),<:ALLE :>);
6 7310 if t shift (-8) extract 1 = 1 then
6 7311 write(z_op(nr),<:KATASTROFE :>);
6 7312 k:= kanaltab.kref.kanal_spec;
6 7313 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7314 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7315 end
5 7316 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7317 begin
6 7318 write(z_op(nr),<:K-:>,"sp",3);
6 7319 if j <> 0 then
6 7320 skriv_skærm_id(nr,j,false)
6 7321 else
6 7322 begin
7 7323 j:=terminal_tab.tref(3);
7 7324 skriv_skærm_id(nr,j,
7 7325 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7326 else 0));
7 7327 end;
6 7328 write(z_op(nr),<:OPT:>);
6 7329 end;
5 7330 end;
4 7331 <*V*> setposition(z_op(nr),0,0);
4 7332 end skriv_skærm_b_v_s;
3 7333 \f
3 7333 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7334
3 7334 procedure skriv_skærm_maske(nr);
3 7335 value nr;
3 7336 integer nr;
3 7337 begin
4 7338 integer i;
4 7339 <*V*> setposition(z_op(nr),0,0);
4 7340 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7341 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7342 "sp",1,"*",5,"nl",1,"-",80);
4 7343
4 7343 for i:= 3 step 1 until 21 do
4 7344 begin
5 7345 cursor(z_op(nr),i,26);
5 7346 outchar(z_op(nr),'!');
5 7347 end;
4 7348 cursor(z_op(nr),22,1);
4 7349 write(z_op(nr),"-",80);
4 7350 cursor(z_op(nr),1,1);
4 7351 <*V*> setposition(z_op(nr),0,0);
4 7352 end skriv_skærm_maske;
3 7353 \f
3 7353 message procedure skal_udskrives side 1 - 940522/cl;
3 7354
3 7354 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7355 value fordelt_til,aktuel_skærm;
3 7356 integer fordelt_til,aktuel_skærm;
3 7357 begin
4 7358 boolean skal_ud;
4 7359 integer n;
4 7360 integer array field iaf;
4 7361
4 7361 skal_ud:= true;
4 7362 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7363 begin
5 7364 for n:= 0 step 1 until 3 do
5 7365 begin
6 7366 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7367 begin
7 7368 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7369 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7370 goto returner;
7 7371 end;
6 7372 end;
5 7373 end;
4 7374 returner:
4 7375 skal_udskrives:= skal_ud;
4 7376 end;
3 7377
3 7377 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7378
3 7378 procedure skriv_skærm_opkaldskø(nr);
3 7379 value nr;
3 7380 integer nr;
3 7381 begin
4 7382 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7383 integer array field ref,iaf,tab;
4 7384 boolean skal_ud;
4 7385
4 7385 <*V*> wait(bs_opkaldskø_adgang);
4 7386 setposition(z_op(nr),0,0);
4 7387 ant:= 0; kmdo:= 0;
4 7388 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7389 ref:= første_nødopkald;
4 7390 if ref=0 then ref:=første_opkald;
4 7391 while ref <> 0 do
4 7392 begin
5 7393 i:= opkaldskø.ref(4);
5 7394 operatør:= i extract 8;
5 7395 type:=i shift (-8) extract 4;
5 7396
5 7396 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7397 *>
5 7398 if operatør > 64 then
5 7399 begin
6 7400 <* fordelt til gruppe af betjeningspladser *>
6 7401 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7402 while skal_ud and i<max_antal_operatører do
6 7403 begin
7 7404 i:=i+1;
7 7405 if læsbit_ia(bpl_def.iaf,i) then
7 7406 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7407 end;
6 7408 end
5 7409 else
5 7410 skal_ud:= skal_udskrives(operatør,nr);
5 7411 if skal_ud then
5 7412 begin
6 7413 ant:= ant +1;
6 7414 if ant < 6 then
6 7415 begin
7 7416 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7417 ttmm:= i shift (-12);
7 7418 vogn:= opkaldskø.ref(3);
7 7419 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7420 skriv_skærm_id(nr,vogn,type=2);
7 7421 write(z_op(nr),true,4,
7 7422 string område_navn(opkaldskø.ref(5) extract 4),
7 7423 <<zd.dd>,ttmm/100.0);
7 7424 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7425 begin
8 7426 if opkaldskø.ref(5) extract 4 <= 2 or
8 7427 opk_alarm.tab.alarm_lgd = 0 then
8 7428 begin
9 7429 if type=2 then
9 7430 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7431 else
9 7432 write(z_op(nr),"bel",1);
9 7433 end
8 7434 else if type>kmdo then kmdo:= type;
8 7435 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7436 end;
7 7437 end;<* ant < 6 *>
6 7438 end;<* operatør ok *>
5 7439
5 7439 ref:= opkaldskø.ref(1) extract 12;
5 7440 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7441 end;
4 7442 \f
4 7442 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7443
4 7443 signal_bin(bs_opkaldskø_adgang);
4 7444 if kmdo > opk_alarm.tab.alarm_tilst and
4 7445 kmdo > opk_alarm.tab.alarm_kmdo then
4 7446 begin
5 7447 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7448 signal_bin(bs_opk_alarm);
5 7449 end;
4 7450 if ant > 5 then
4 7451 begin
5 7452 cursor(z_op(nr),13,9);
5 7453 write(z_op(nr),<<+ddd>,ant-5);
5 7454 end
4 7455 else
4 7456 begin
5 7457 for i:= ant +1 step 1 until 6 do
5 7458 begin
6 7459 cursor(z_op(nr),i*2+1,1);
6 7460 write(z_op(nr),"sp",25);
6 7461 end;
5 7462 end;
4 7463 ant_i_opkø(nr):= ant;
4 7464 cursor(z_op(nr),1,1);
4 7465 <*V*> setposition(z_op(nr),0,0);
4 7466 end skriv_skærm_opkaldskø;
3 7467 \f
3 7467 message procedure operatør side 2 - 810522/hko;
3 7468
3 7468 trap(op_trap);
3 7469 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7470
3 7470 ref:= nr*terminal_beskr_længde;
3 7471 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7472 skærmmåde:= 0; <*normal*>
3 7473
3 7473 if operatør_auto_include(nr) then
3 7474 begin
4 7475 waitch(cs_att_pulje,opref,true,-1);
4 7476 i:= operatør_auto_include(nr) extract 2;
4 7477 if i<>3 then i:= 0;
4 7478 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7479 d.opref.data(1):= nr;
4 7480 signalch(cs_rad,opref,gen_optype or io_optype);
4 7481 end;
3 7482
3 7482 <*+2*>
3 7483 if testbit8 and overvåget or testbit28 then
3 7484 skriv_operatør(out,0);
3 7485 <*-2*>
3 7486 \f
3 7486 message procedure operatør side 3 - 810602/hko;
3 7487
3 7487 repeat
3 7488
3 7488 <*V*> wait_ch(cs_operatør(nr),
3 7489 op_ref,
3 7490 true,
3 7491 -1<*timeout*>);
3 7492 <*+2*>
3 7493 if testbit9 and overvåget then
3 7494 disable begin
4 7495 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7496 <: til operatør :>,nr);
4 7497 skriv_op(out,op_ref);
4 7498 end;
3 7499 <*-2*>
3 7500 monitor(8)reserve process:(z_op(nr),0,ia);
3 7501 kode:= d.op_ref.op_kode extract 12;
3 7502 i:= terminal_tab.ref.terminal_tilstand;
3 7503 status:= i shift(-21);
3 7504 opgave:=
3 7505 if kode=0 then 1 <* indlæs kommando *> else
3 7506 if kode=1 then 2 <* inkluder *> else
3 7507 if kode=2 then 3 <* ekskluder *> else
3 7508 if kode=40 then 4 <* opdater skærm *> else
3 7509 if kode=43 then 5 <* opkald etableret *> else
3 7510 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7511 if kode=38 then 7 <* operatør meddelelse *> else
3 7512 0; <* afvises *>
3 7513
3 7513 aktion:= case status +1 of(
3 7514 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7515 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7516 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7517 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7518 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7519 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7520 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7521 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7522 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7523 -1);
3 7524 \f
3 7524 message procedure operatør side 4 - 810424/hko;
3 7525
3 7525 case aktion+6 of
3 7526 begin
4 7527 begin
5 7528 <*-5: terminal optaget *>
5 7529
5 7529 d.op_ref.resultat:= 16;
5 7530 afslut_operation(op_ref,-1);
5 7531 end;
4 7532
4 7532 begin
5 7533 <*-4: operation uden virkning *>
5 7534
5 7534 afslut_operation(op_ref,-1);
5 7535 end;
4 7536
4 7536 begin
5 7537 <*-3: ulovlig operationskode *>
5 7538
5 7538 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7539 afslut_operation(op_ref,-1);
5 7540 end;
4 7541
4 7541 begin
5 7542 <*-2: ulovligt operatørterminal_nr *>
5 7543
5 7543 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7544 afslut_operation(op_ref,-1);
5 7545 end;
4 7546
4 7546 begin
5 7547 <*-1: ulovlig operatørtilstand *>
5 7548
5 7548 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7549 afslut_operation(op_ref,-1);
5 7550 end;
4 7551
4 7551 begin
5 7552 <* 0: ikke implementeret *>
5 7553
5 7553 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7554 afslut_operation(op_ref,-1);
5 7555 end;
4 7556
4 7556 begin
5 7557 \f
5 7557 message procedure operatør side 5 - 851001/cl;
5 7558
5 7558 <* 1: indlæs kommando *>
5 7559
5 7559
5 7559 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7560 if opk_alarm.tab.alarm_tilst > 0 then
5 7561 begin
6 7562 opk_alarm.tab.alarm_kmdo:= 3;
6 7563 signal_bin(bs_opk_alarm);
6 7564 pass;
6 7565 end;
5 7566 if d.op_ref.resultat > 3 then
5 7567 begin
6 7568 <*V*> setposition(z_op(nr),0,0);
6 7569 cursor(z_op(nr),24,1);
6 7570 skriv_kvittering(z_op(nr),op_ref,pos,
6 7571 d.op_ref.resultat);
6 7572 end
5 7573 else if d.op_ref.resultat = -1 then
5 7574 begin
6 7575 skærmmåde:= 0;
6 7576 skrivskærm(nr);
6 7577 end
5 7578 else if d.op_ref.resultat>0 then
5 7579 begin <*godkendt*>
6 7580 kode:=d.op_ref.opkode;
6 7581 i:= kode extract 12;
6 7582 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7583 if kode = 19 then 1 <*VO,S *> else
6 7584 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7585 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7586 if kode = 6 then 4 <*STop*> else
6 7587 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7588 if kode = 30 then 5 <*SP,D*> else
6 7589 if kode = 31 then 6 <*SP*> else
6 7590 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7591 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7592 if kode = 83 then 8 <*SL*> else
6 7593 if kode = 68 then 9 <*ST,D*> else
6 7594 if kode = 69 then 10 <*ST,V*> else
6 7595 if kode = 36 then 11 <*AL*> else
6 7596 if kode = 37 then 12 <*CC*> else
6 7597 if kode = 2 then 13 <*EX*> else
6 7598 if kode = 92 then 14 <*CQF,V*> else
6 7599 if kode = 38 then 15 <*AL,T*> else
6 7600 0;
6 7601 if j > 0 then
6 7602 begin
7 7603 case j of
7 7604 begin
8 7605 begin
9 7606 \f
9 7606 message procedure operatør side 6 - 851001/cl;
9 7607
9 7607 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7608
9 7608 vogn:=ia(1);
9 7609 ll:=ia(2);
9 7610 kanal:= if kode=11 or kode=19 then ia(3) else
9 7611 if kode=12 then ia(2) else 0;
9 7612 <*V*> wait_ch(cs_vt_adgang,
9 7613 vt_op,
9 7614 gen_optype,
9 7615 -1<*timeout sek*>);
9 7616 start_operation(vtop,200+nr,cs_operatør(nr),
9 7617 kode);
9 7618 d.vt_op.data(1):=vogn;
9 7619 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7620 d.vt_op.data(2):=ll;
9 7621 if kode=19 then d.vt_op.data(3):= kanal else
9 7622 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7623 indeks:= vt_op;
9 7624 signal_ch(cs_vt,
9 7625 vt_op,
9 7626 gen_optype or op_optype);
9 7627
9 7627 <*V*> wait_ch(cs_operatør(nr),
9 7628 vt_op,
9 7629 op_optype,
9 7630 -1<*timeout sek*>);
9 7631 <*+2*> if testbit10 and overvåget then
9 7632 disable begin
10 7633 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7634 <:: operation retur fra vt:>);
10 7635 skriv_op(out,vt_op);
10 7636 end;
9 7637 <*-2*>
9 7638 <*+4*> if vt_op<>indeks then
9 7639 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7640 <:operatør-kommando:>,0);
9 7641 <*-4*>
9 7642 <*V*> setposition(z_op(nr),0,0);
9 7643 cursor(z_op(nr),24,1);
9 7644 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7645 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7646 else vt_op,-1,d.vt_op.resultat);
9 7647 d.vt_op.optype:= gen_optype or vt_optype;
9 7648 disable afslut_operation(vt_op,cs_vt_adgang);
9 7649 end;
8 7650 begin
9 7651 \f
9 7651 message procedure operatør side 7 - 810921/hko,cl;
9 7652
9 7652 <* 2 vogntabel,linienr/-,busnr *>
9 7653
9 7653 d.op_ref.retur:= cs_operatør(nr);
9 7654 tofrom(d.op_ref.data,ia,10);
9 7655 indeks:= op_ref;
9 7656 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7657 wait_ch(cs_operatør(nr),
9 7658 op_ref,
9 7659 op_optype,
9 7660 -1<*timeout*>);
9 7661 <*+2*> if testbit10 and overvåget then
9 7662 disable begin
10 7663 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7664 skriv_op(out,op_ref);
10 7665 end;
9 7666 <*-2*>
9 7667 <*+4*>
9 7668 if indeks <> op_ref then
9 7669 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7670 <*-4*>
9 7671 i:= d.op_ref.resultat;
9 7672 if i = 0 or i > 3 then
9 7673 begin
10 7674 <*V*> setposition(z_op(nr),0,0);
10 7675 cursor(z_op(nr),24,1);
10 7676 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7677 end
9 7678 else
9 7679 begin
10 7680 integer antal,fil_ref;
10 7681
10 7681 skærm_måde:= 1;
10 7682 antal:= d.op_ref.data(6);
10 7683 fil_ref:= d.op_ref.data(7);
10 7684 <*V*> setposition(z_op(nr),0,0);
10 7685 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7686 "sp",14,"*",10,"sp",6,
10 7687 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7688 <*V*> setposition(z_op(nr),0,0);
10 7689 \f
10 7689 message procedure operatør side 8 - 841213/cl;
10 7690
10 7690 pos:= 1;
10 7691 while pos <= antal do
10 7692 begin
11 7693 integer bogst,løb;
11 7694
11 7694 disable i:= læs_fil(fil_ref,pos,j);
11 7695 if i <> 0 then
11 7696 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7697 else
11 7698 begin
12 7699 vogn:= fil(j,1) shift (-24) extract 24;
12 7700 løb:= fil(j,1) extract 24;
12 7701 if d.op_ref.opkode=9 then
12 7702 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7703 ll:= løb shift (-12) extract 10;
12 7704 bogst:= løb shift (-7) extract 5;
12 7705 if bogst > 0 then bogst:= bogst +'A'-1;
12 7706 løb:= løb extract 7;
12 7707 vogn:= vogn extract 14;
12 7708 i:= d.op_ref.opkode-8;
12 7709 for i:= i,i+1 do
12 7710 begin
13 7711 j:= (i+1) extract 1;
13 7712 case j +1 of
13 7713 begin
14 7714 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7715 false add bogst,1,"/",1,<<d__>,løb);
14 7716 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7717 end;
13 7718 end;
12 7719 if pos mod 5 = 0 then
12 7720 begin
13 7721 outchar(z_op(nr),'nl');
13 7722 <*V*> setposition(z_op(nr),0,0);
13 7723 end
12 7724 else write(z_op(nr),"sp",3);
12 7725 end;
11 7726 pos:=pos+1;
11 7727 end;
10 7728 write(z_op(nr),"*",1,"nl",1);
10 7729 \f
10 7729 message procedure operatør side 8a- 810507/hko;
10 7730
10 7730 d.opref.opkode:=104; <*slet-fil*>
10 7731 d.op_ref.data(4):=filref;
10 7732 indeks:=op_ref;
10 7733 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7734 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7735
10 7735 <*+2*> if testbit10 and overvåget then
10 7736 disable begin
11 7737 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7738 skriv_op(out,op_ref);
11 7739 end;
10 7740 <*-2*>
10 7741
10 7741 <*+4*> if op_ref<>indeks then
10 7742 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7743 <*-4*>
10 7744 if d.op_ref.data(9)<>0 then
10 7745 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7746 <:operatør, slet_fil:>,1);
10 7747 end;
9 7748 end;
8 7749
8 7749 begin
9 7750 \f
9 7750 message procedure operatør side 9 - 830310/hko;
9 7751
9 7751 <* 3 radio_kommandoer *>
9 7752
9 7752 kode:= d.op_ref.opkode;
9 7753 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7754 disable if testbit14 then
9 7755 begin
10 7756 integer i; <*lav en trap-bar blok*>
10 7757
10 7757 trap(test14_trap);
10 7758 systime(1,0,kommstart);
10 7759 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7760 string bpl_navn(nr),<: start :>,case rkom of (
10 7761 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7762 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7763 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7764 <:GE,T:>),<: :>);
10 7765 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7766 rkom=16 or rkom=17 or rkom=19)
10 7767 then
10 7768 begin
11 7769 if par1<>0 then skriv_id(zrl,par1,0);
11 7770 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7771 write(zrl,"sp",1,string områdenavn(par2));
11 7772 end
10 7773 else
10 7774 if rkom=10 and par1<>0 then
10 7775 write(zrl,string kanalnavn(par1 extract 20))
10 7776 else
10 7777 if rkom=5 or rkom=6 then
10 7778 begin
11 7779 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7780 if par1 shift (-20)=14 then
11 7781 write(zrl,string områdenavn(par1 extract 20));
11 7782 end;
10 7783 test14_trap: outchar(zrl,'nl');
10 7784 end;
9 7785 d.op_ref.data(4):= nr; <*operatør*>
9 7786 opgave:=
9 7787 if kode = 45 <*OP *> then 1 else
9 7788 if kode = 46 <*ME *> then 2 else
9 7789 if kode = 47 <*OP,G*> then 3 else
9 7790 if kode = 48 <*ME,G*> then 4 else
9 7791 if kode = 49 <*OP,A*> then 5 else
9 7792 if kode = 50 <*ME,A*> then 6 else
9 7793 if kode = 51 <*KA,C*> then 7 else
9 7794 if kode = 52 <*KA,P*> then 8 else
9 7795 if kode = 53 <*OP,L*> then 9 else
9 7796 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7797 if kode = 55 <*VE *> then 14 else
9 7798 if kode = 56 <*NE *> then 12 else
9 7799 if kode = 57 <*OP,V*> then 1 else
9 7800 if kode = 58 <*OP,T*> then 1 else
9 7801 if kode = 59 <*R *> then 13 else
9 7802 if kode = 60 <*GE *> then 15 else
9 7803 if kode = 61 <*GE,G*> then 16 else
9 7804 if kode = 62 <*GE,V*> then 15 else
9 7805 if kode = 63 <*GE,T*> then 15 else
9 7806 -1;
9 7807 <*+4*> if opgave < 0 then
9 7808 fejlreaktion(2<*operationskode*>,kode,
9 7809 <:operatør, radio-kommando :>,0);
9 7810 <*-4*>
9 7811 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7812 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7813 if 5<=opgave and opgave<=8 then
9 7814 d.opref.data(2):= -1;
9 7815 if opgave=13 then d.opref.data(2):=
9 7816 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7817 then 0 else 1);
9 7818 if opgave = 14 then d.opref.data(2):= 1;
9 7819 if opgave=7 or opgave=8 then
9 7820 d.opref.data(3):= -1
9 7821 else
9 7822 if opgave=5 or opgave=6 then
9 7823 begin
10 7824 if ia(1) shift (-20) = 15 then
10 7825 begin
11 7826 d.opref.data(3):= 15 shift 20;
11 7827 for j:= 1 step 1 until max_antal_kanaler do
11 7828 begin
12 7829 iaf:= (j-1)*kanalbeskrlængde;
12 7830 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7831 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7832 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7833 end;
11 7834 end
10 7835 else
10 7836 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7837 else ia(1);
10 7838 end
9 7839 else
9 7840 if kode = 57 then d.opref.data(3):= 2 else
9 7841 if kode = 58 then d.opref.data(3):= 1 else
9 7842 if kode = 62 then d.opref.data(3):= 2 else
9 7843 if kode = 63 then d.opref.data(3):= 1 else
9 7844 d.opref.data(3):= ia(2);
9 7845
9 7845 <* !!! i første if-sætning nedenfor er 'status>1'
9 7846 rettet til 'status>0' for at forhindre
9 7847 at opkald nr. 2 kan udføres med et allerede
9 7848 etableret opkald i skærmens s-felt,
9 7849 jvf. ulykke d. 7/2-1995
9 7850 !!! *>
9 7851 res:=
9 7852 if (opgave=1 or opgave=3) and status>0
9 7853 then 16 <*skærm optaget*> else
9 7854 if (opgave=15 or opgave=16) and
9 7855 status>1 then 16 <*skærm optaget*> else
9 7856 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7857 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7858 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7859 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7860 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7861 then 52 else 1) else
9 7862 if opgave<11 and status>0 then 16 else
9 7863 if opgave=11 and status<2 then 21 else
9 7864 if opgave=12 and status=0 then 22 else
9 7865 if opgave=13 and status=0 then 49 else
9 7866 if opgave=14 and status<>3 then 21 else 1;
9 7867 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7868 begin <* specialbetingelser for TLF og VHF *>
10 7869 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7870 end;
9 7871 if skærmmåde<>0 then
9 7872 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7873 kode:= opgave;
9 7874 if opgave = 15 then opgave:= 1 else
9 7875 if opgave = 16 then opgave:= 3;
9 7876 \f
9 7876 message procedure operatør side 10 - 810616/hko;
9 7877
9 7877 <* tilknyt talevej (om nødvendigt) *>
9 7878 if res = 1 and op_talevej(nr)=0 then
9 7879 begin
10 7880 i:= sidste_tv_brugt;
10 7881 repeat
10 7882 i:= (i mod max_antal_taleveje)+1;
10 7883 if tv_operatør(i)=0 then
10 7884 begin
11 7885 tv_operatør(i):= nr;
11 7886 op_talevej(nr):= i;
11 7887 end;
10 7888 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7889 if op_talevej(nr)=0 then
10 7890 res:=61
10 7891 else
10 7892 begin
11 7893 sidste_tv_brugt:=
11 7894 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7895
11 7895 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7896 start_operation(iaf,200+nr,cs_operatør(nr),
11 7897 'A' shift 12 + 44);
11 7898 d.iaf.data(1):= op_talevej(nr);
11 7899 d.iaf.data(2):= nr+16;
11 7900 ll:= 0;
11 7901 repeat
11 7902 signalch(cs_talevejsswitch,iaf,op_optype);
11 7903 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7904 ll:= ll+1;
11 7905 until ll=3 or d.iaf.resultat=3;
11 7906 res:= if d.iaf.resultat=3 then 1 else 61;
11 7907 <* ********* *>
11 7908 delay(1);
11 7909 start_operation(iaf,200+nr,cs_operatør(nr),
11 7910 'R' shift 12 + 44);
11 7911 ll:= 0;
11 7912 repeat
11 7913 signalch(cs_talevejsswitch,iaf,op_optype);
11 7914 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7915 ll:= ll+1;
11 7916 until ll=3 or d.iaf.resultat=3;
11 7917 <* ********* *>
11 7918 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7919 if res<>1 then
11 7920 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7921 end;
10 7922 end;
9 7923 if op_talevej(nr)=0 then res:= 61;
9 7924 d.op_ref.data(1):= op_talevej(nr);
9 7925
9 7925 if res <= 1 then
9 7926 begin
10 7927 til_radio: <* send operation til radiomodul *>
10 7928 d.op_ref.opkode:= opgave shift 12 + 41;
10 7929 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7930 else 0;
10 7931 d.op_ref.data(6):= b_s;
10 7932 d.op_ref.resultat:=0;
10 7933 d.op_ref.retur:= cs_operatør(nr);
10 7934 indeks:= op_ref;
10 7935 <*+2*> if testbit11 and overvåget then
10 7936 disable begin
11 7937 skriv_operatør(out,0);
11 7938 write(out,<: operation til radio:>);
11 7939 skriv_op(out,op_ref); ud;
11 7940 end;
10 7941 <*-2*>
10 7942 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7943 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7944
10 7944 <*+2*> if testbit12 and overvåget then
10 7945 disable begin
11 7946 skriv_operatør(out,0);
11 7947 write(out,<: operation retur fra radio:>);
11 7948 skriv_op(out,op_ref); ud;
11 7949 end;
10 7950 <*-2*>
10 7951 <*+4*> if op_ref <> indeks then
10 7952 fejlreaktion(11<*fr.post*>,op_ref,
10 7953 <:operatør, retur fra radio:>,0);
10 7954 <*-4*>
10 7955 \f
10 7955 message procedure operatør side 11 - 810529/hko;
10 7956
10 7956 res:= d.op_ref.resultat;
10 7957 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7958 begin
11 7959 <*+4*> if res < 2 then
11 7960 fejlreaktion(3<*prg.fejl*>,res,
11 7961 <: operatør,radio_op,resultat:>,1);
11 7962 <*-4*>
11 7963 if res = 1 then res:= 0;
11 7964 end
10 7965 else
10 7966 begin <* res = 2 eller 3 *>
11 7967 s_kanal:= v_kanal:= 0;
11 7968 opgave:= d.opref.opkode shift (-12);
11 7969 bv:= d.op_ref.data(5) extract 4;
11 7970 bs:= d.op_ref.data(6);
11 7971 if opgave < 10 then
11 7972 begin
12 7973 j:= d.op_ref.data(7) <*type*>;
12 7974 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 7975 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 7976 terminal_tab.ref(1):= i
12 7977 +(if res=2 then 4 <*optaget*> else 0)
12 7978 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 7979 then 8 <*nød*> else 0)
12 7980 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 7981 then 16 else 0)
12 7982 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 7983 + (if opgave=9 then 128 else
12 7984 if opgave>=7 then 256 else
12 7985 if opgave>=5 then 512 else 0)
12 7986 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 7987 else if b_s = 0 then 0 <*tilstand = ledig *>
12 7988 else 1 shift 21 <*tilstand = samtale*>);
12 7989 if (res=3 or res=20 or res=52) and 0<=j and j<3 then
12 7990 disable tæl_opkald_pr_operatør(nr,
12 7991 (if res=20 then 4 else if res=52 then 5 else j+1));
12 7992 end
11 7993 else if opgave=10 <*monitering*> or
11 7994 opgave=14 <*ventepos *> then
11 7995 begin
12 7996 <*+4*> if res = 2 then
12 7997 fejlreaktion(3<*prg.fejl*>,res,
12 7998 <: operatør,moniter,res:>,1);
12 7999 <*-4*>
12 8000 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 8001 i:= if bs<0 then
12 8002 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 8003 terminal_tab.ref(1):= i +
12 8004 (if bs < 0 then (1 shift 21) else 0);
12 8005 if opgave=10 then
12 8006 begin
13 8007 s_kanal:= bs;
13 8008 v_kanal:= d.opref.data(5);
13 8009 end;
12 8010 \f
12 8010 message procedure operatør side 12 - 810603/hko;
12 8011 end
11 8012 else if opgave=11 or opgave=12 then
11 8013 begin
12 8014 <*+4*> if res = 2 then
12 8015 fejlreaktion(3<*prg.fejl*>,res,
12 8016 <: operatør,ge/ne,res:>,1);
12 8017 <*-4*>
12 8018 if opgave=11 <*GE*> and res<>49 then
12 8019 begin
13 8020 s_kanal:= terminal_tab.ref(2);
13 8021 v_kanal:= 12 shift 20 +
13 8022 (terminal_tab.ref(1) shift (-12) extract 4);
13 8023 end;
12 8024 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 8025 end
11 8026 else
11 8027 if opgave=13 then
11 8028 begin
12 8029 if res=2 then
12 8030 fejlreaktion(3<*prg.fejl*>,res,
12 8031 <:operatør,R,res:>,1);
12 8032 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 8033 d.opref.data(2));
12 8034 end
11 8035 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 8036 <*-4*>
11 8037 ;
11 8038 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 8039
11 8039 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 8040 terminal_tab.ref(2):= b_s;
11 8041 terminal_tab.ref(3):= d.op_ref.data(11);
11 8042 if (opgave<10 or opgave=14) and res=3 then
11 8043 <*så henviser b_s til radiokanal*>
11 8044 begin
12 8045 if bs shift (-20) = 12 then
12 8046 begin
13 8047 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 8048 kanaltab.iaf.kanal_tilstand:=
13 8049 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 8050 +terminal_tab.ref(1) extract 10;
13 8051 end
12 8052 else
12 8053 begin
13 8054 for i:= 1 step 1 until max_antal_kanaler do
13 8055 begin
14 8056 if læsbit_i(bs,i) then
14 8057 begin
15 8058 iaf:= (i-1)*kanal_beskr_længde;
15 8059 kanaltab.iaf.kanaltilstand:=
15 8060 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 8061 + terminal_tab.ref(1) extract 10;
15 8062 end;
14 8063 end;
13 8064 end;
12 8065 end;
11 8066 if kode=15 or kode=16 then
11 8067 begin
12 8068 if opgave<10 then
12 8069 begin
13 8070 opgave:= 11;
13 8071 kanal:= (12 shift 20) +
13 8072 d.opref.data(6) extract 20;
13 8073 goto til_radio;
13 8074 end
12 8075 else
12 8076 if opgave=11 then
12 8077 begin
13 8078 opgave:= 10;
13 8079 d.opref.data(2):= kanal;
13 8080 goto til_radio;
13 8081 end;
12 8082 end
11 8083 else
11 8084 if (kode=1 or kode=3) then
11 8085 begin
12 8086 if opgave<10 and bv<>0 then
12 8087 begin
13 8088 opgave:= 14;
13 8089 d.opref.data(2):= 2;
13 8090 goto til_radio;
13 8091 end;
12 8092 end;
11 8093 <*V*> skriv_skærm_b_v_s(nr);
11 8094 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 8095 skriv_skærm_opkaldskø(nr);
11 8096 for i:= s_kanal, v_kanal do
11 8097 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 8098 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 8099 signalbin(bs_mobilopkald);
11 8100 <*V*> setposition(z_op(nr),0,0);
11 8101 end; <* res = 2 eller 3 *>
10 8102 end; <* res <= 1 *>
9 8103 <* frigiv talevej (om nødvendigt) *>
9 8104 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 8105 and terminal_tab.ref(2)=0 <*b_s*>
9 8106 and op_talevej(nr)<>0
9 8107 then
9 8108 begin
10 8109 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 8110 start_operation(iaf,200+nr,cs_operatør(nr),
10 8111 'D' shift 12 + 44);
10 8112 d.iaf.data(1):= op_talevej(nr);
10 8113 d.iaf.data(2):= nr+16;
10 8114 ll:= 0;
10 8115 repeat
10 8116 signalch(cs_talevejsswitch,iaf,op_optype);
10 8117 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 8118 ll:= ll+1;
10 8119 until ll=3 or d.iaf.resultat=3;
10 8120 ll:= d.iaf.resultat;
10 8121 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 8122 if ll<>3 then
10 8123 fejlreaktion(21,op_talevej(nr)*100+nr,
10 8124 <:frigiv operatør fejlet:>,1)
10 8125 else
10 8126 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 8127 skriv_skærm_b_v_s(nr);
10 8128 end;
9 8129 disable if testbit14 then
9 8130 begin
10 8131 integer t; <*lav en trap-bar blok*>
10 8132
10 8132 trap(test14_trap);
10 8133 systime(1,0,kommslut);
10 8134 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 8135 string bpl_navn(nr),<: slut :>,case rkom of (
10 8136 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 8137 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 8138 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 8139 <:GE,T:>),<: :>);
10 8140 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 8141 rkom=16 or rkom=17 or rkom=19)
10 8142 then
10 8143 begin
11 8144 if d.opref.data(7)=2 then outchar(zrl,'*');
11 8145 if d.opref.data(9)<>0 then
11 8146 begin
12 8147 skriv_id(zrl,d.opref.data(9),0);
12 8148 outchar(zrl,' ');
12 8149 end;
11 8150 if d.opref.data(8)<>0 then
11 8151 begin
12 8152 skriv_id(zrl,d.opref.data(8),0);
12 8153 outchar(zrl,' ');
12 8154 end;
11 8155 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 8156 d.opref.data(2)<>0 then
11 8157 begin
12 8158 skriv_id(zrl,d.opref.data(2),0);
12 8159 outchar(zrl,' ');
12 8160 end;
11 8161 if d.opref.data(12)<>0 then
11 8162 begin
12 8163 if d.opref.data(12) shift (-20) = 15 then
12 8164 write(zrl,<:OMR*:>)
12 8165 else
12 8166 if d.opref.data(12) shift (-20) = 14 then
12 8167 write(zrl,
12 8168 string områdenavn(d.opref.data(12) extract 20))
12 8169 else
12 8170 skriv_id(zrl,d.opref.data(12),0);
12 8171 outchar(zrl,' ');
12 8172 end;
11 8173 t:= terminal_tab.ref.terminaltilstand extract 10;
11 8174 if res=3 and rkom=1 and
11 8175 (t shift (-4) extract 1 = 1) and
11 8176 (t extract 2 <> 3)
11 8177 then
11 8178 begin
12 8179 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 8180 kanal_beskr_længde;
12 8181 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 8182 extract 12)/100," ",1);
12 8183 end;
11 8184 if d.opref.data(10)<>0 then
11 8185 begin
12 8186 skriv_id(zrl,d.opref.data(10),0);
12 8187 outchar(zrl,' ');
12 8188 end;
11 8189 end
10 8190 else
10 8191 if rkom=10 and par1<>0 then
10 8192 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 8193 else
10 8194 if rkom=5 or rkom=6 then
10 8195 begin
11 8196 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 8197 if par1 shift (-20)=14 then
11 8198 write(zrl,string områdenavn(par1 extract 20));
11 8199 outchar(zrl,' ');
11 8200 end;
10 8201 if op_talevej(nr) > 0 then
10 8202 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 8203 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 8204 <<dd.dd>,kommslut-kommstart);
10 8205 test14_trap: outchar(zrl,'nl');
10 8206 end;
9 8207
9 8207 <*V*> setposition(z_op(nr),0,0);
9 8208 cursor(z_op(nr),24,1);
9 8209 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 8210 end; <* radio-kommando *>
8 8211 begin
9 8212 \f
9 8212 message procedure operatør side 13 - 810518/hko;
9 8213
9 8213 <* 4 stop kommando *>
9 8214
9 8214 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 8215 if tilstand <> 0 then
9 8216 begin
10 8217 d.op_ref.resultat:= 16; <*skærm optaget*>
10 8218 end
9 8219 else
9 8220 begin
10 8221 d.op_ref.retur:= cs_operatør(nr);
10 8222 d.op_ref.resultat:= 0;
10 8223 d.op_ref.data(1):= nr;
10 8224 indeks:= op_ref;
10 8225 <*+2*> if testbit11 and overvåget then
10 8226 disable begin
11 8227 skriv_operatør(out,0);
11 8228 write(out,<: stop_operation til radio:>);
11 8229 skriv_op(out,op_ref); ud;
11 8230 end;
10 8231 <*-2*>
10 8232 if opk_alarm.tab.alarm_tilst > 0 then
10 8233 begin
11 8234 opk_alarm.tab.alarm_kmdo:= 3;
11 8235 signal_bin(bs_opk_alarm);
11 8236 end;
10 8237
10 8237 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 8238 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 8239 <*+2*> if testbit12 and overvåget then
10 8240 disable begin
11 8241 skriv_operatør(out,0);
11 8242 write(out,<: operation retur fra radio:>);
11 8243 skriv_op(out,op_ref); ud;
11 8244 end;
10 8245 <*-2*>
10 8246 <*+4*> if indeks <> op_ref then
10 8247 fejlreaktion(11<*fr.post*>,op_ref,
10 8248 <: operatør, retur fra radio:>,0);
10 8249 <*-4*>
10 8250 \f
10 8250 message procedure operatør side 14 - 810527/hko;
10 8251
10 8251 if d.op_ref.resultat = 3 then
10 8252 begin
11 8253 integer k,n;
11 8254 integer array field msk,iaf1;
11 8255
11 8255 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 8256 +terminal_tab.ref.terminal_tilstand extract 21;
11 8257 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 8258 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 8259 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 8260 begin
12 8261 msk:= k*op_maske_lgd;
12 8262 if læsbit_ia(bpl_def.msk,nr) then
12 8263 <**> begin
13 8264 n:= 0;
13 8265 for i:= 1 step 1 until max_antal_operatører do
13 8266 if læsbit_ia(bpl_def.msk,i) then
13 8267 begin
14 8268 iaf1:= i*terminal_beskr_længde;
14 8269 if terminal_tab.iaf1.terminal_tilstand
14 8270 shift (-21) < 3 then
14 8271 n:= n+1;
14 8272 end;
13 8273 bpl_tilst(k,1):= n;
13 8274 end;
12 8275 <**> <*
12 8276 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 8277 *> end;
11 8278 signal_bin(bs_mobil_opkald);
11 8279 <*V*> setposition(z_op(nr),0,0);
11 8280 ht_symbol(z_op(nr));
11 8281 end;
10 8282 end;
9 8283 <*V*> setposition(z_op(nr),0,0);
9 8284 cursor(z_op(nr),24,1);
9 8285 if d.op_ref.resultat<> 3 then
9 8286 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8287 end;
8 8288 begin
9 8289 boolean l22;
9 8290 \f
9 8290 message procedure operatør side 15 - 810521/cl;
9 8291
9 8291 <* 5 springdefinition *>
9 8292 l22:= false;
9 8293 if sep=',' then
9 8294 disable begin
10 8295 setposition(z_op(nr),0,0);
10 8296 cursor(z_op(nr),22,1);
10 8297 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 8298 l22:= true; pos:= 1;
10 8299 while læstegn(d.op_ref.data,pos,i)<>0 do
10 8300 outchar(z_op(nr),i);
10 8301 end;
9 8302
9 8302 tofrom(d.op_ref.data,ia,indeks*2);
9 8303 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 8304 start_operation(vt_op,200+nr,cs_operatør(nr),
9 8305 101<*opret fil*>);
9 8306 d.vt_op.data(1):=128;<*postantal*>
9 8307 d.vt_op.data(2):=2; <*postlængde*>
9 8308 d.vt_op.data(3):=1; <*segmentantal*>
9 8309 d.vt_op.data(4):=
9 8310 2 shift 10; <*spool fil*>
9 8311 signal_ch(cs_opret_fil,vt_op,op_optype);
9 8312 pos:=vt_op;<*variabel lånes*>
9 8313 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 8314 <*+4*> if vt_op<>pos then
9 8315 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 8316 if d.vt_op.data(9)<>0 then
9 8317 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8318 <:op kommando(springdefinition):>,0);
9 8319 <*-4*>
9 8320 iaf:=0;
9 8321 for i:=1 step 1 until indeks-2 do
9 8322 begin
10 8323 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8324 if k<>0 then
10 8325 fejlreaktion(7<*modif-fil*>,k,
10 8326 <:op kommando(spring-def):>,0);
10 8327 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8328 end;
9 8329 \f
9 8329 message procedure operatør side 15a - 820301/cl;
9 8330
9 8330 while sep = ',' do
9 8331 begin
10 8332 setposition(z_op(nr),0,0);
10 8333 cursor(z_op(nr),23,1);
10 8334 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8335 setposition(z_op(nr),0,0);
10 8336 wait(bs_fortsæt_adgang);
10 8337 pos:= 1; j:= 0;
10 8338 while læs_store(z_op(nr),i) < 8 do
10 8339 begin
11 8340 skrivtegn(fortsæt,pos,i);
11 8341 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8342 end;
10 8343 skrivtegn(fortsæt,pos,'em');
10 8344 afsluttext(fortsæt,pos);
10 8345 sluttegn:= i;
10 8346 if j<>0 then
10 8347 begin
11 8348 setposition(z_op(nr),0,0);
11 8349 cursor(z_op(nr),24,1);
11 8350 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8351 cursor(z_op(nr),1,1);
11 8352 goto sp_ann;
11 8353 end;
10 8354 \f
10 8354 message procedure operatør side 16 - 810521/cl;
10 8355
10 8355 disable begin
11 8356 integer array værdi(1:4);
11 8357 integer a_pos,res;
11 8358 pos:= 0;
11 8359 repeat
11 8360 apos:= pos;
11 8361 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8362 if res >= 0 then
11 8363 begin
12 8364 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8365 else if res=0 then res:= -25 <*parameter mangler*>
12 8366 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8367 res:= -44 <*intervalstørrelse ulovlig*>
12 8368 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8369 res:= -6 <*løbnr ulovligt*>
12 8370 else if res=10 then
12 8371 begin
13 8372 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8373 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8374 <:op kommando(spring-def):>,0);
13 8375 iaf:= 0;
13 8376 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8377 indeks:= indeks+1;
13 8378 if sep = ',' then res:= 0;
13 8379 end
12 8380 else res:= -27; <*parametertype*>
12 8381 end;
11 8382 if res>0 then pos:= a_pos;
11 8383 until sep<>'sp' or res<=0;
11 8384
11 8384 if res<0 then
11 8385 begin
12 8386 d.op_ref.resultat:= -res;
12 8387 i:=1; j:= 1;
12 8388 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8389 afsluttext(d.op_ref.data,i);
12 8390 end;
11 8391 end;
10 8392 \f
10 8392 message procedure operatør side 17 - 810521/cl;
10 8393
10 8393 if d.op_ref.resultat > 3 then
10 8394 begin
11 8395 setposition(z_op(nr),0,0);
11 8396 if l22 then
11 8397 begin
12 8398 cursor(z_op(nr),22,1); l22:= false;
12 8399 write(z_op(nr),"-",80);
12 8400 end;
11 8401 cursor(z_op(nr),24,1);
11 8402 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8403 goto sp_ann;
11 8404 end;
10 8405 if sep=',' then
10 8406 begin
11 8407 setposition(z_op(nr),0,0);
11 8408 cursor(z_op(nr),22,1);
11 8409 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8410 pos:= 1; l22:= true;
11 8411 while læstegn(fortsæt,pos,i)<>0 do
11 8412 outchar(z_op(nr),i);
11 8413 end;
10 8414 signalbin(bs_fortsæt_adgang);
10 8415 end while sep = ',';
9 8416 d.vt_op.data(1):= indeks-2;
9 8417 k:= sætfildim(d.vt_op.data);
9 8418 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8419 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8420 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8421 d.op_ref.retur:=cs_operatør(nr);
9 8422 pos:=op_ref;
9 8423 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8424 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8425 <*+4*> if pos<>op_ref then
9 8426 fejlreaktion(11<*fremmed post*>,op_ref,
9 8427 <:op kommando(springdef retur fra vt):>,0);
9 8428 <*-4*>
9 8429 \f
9 8429 message procedure operatør side 18 - 810521/cl;
9 8430
9 8430 <*V*> setposition(z_op(nr),0,0);
9 8431 if l22 then
9 8432 begin
10 8433 cursor(z_op(nr),22,1);
10 8434 write(z_op(nr),"-",80);
10 8435 end;
9 8436 cursor(z_op(nr),24,1);
9 8437 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8438
9 8438 if false then
9 8439 begin
10 8440 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8441 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8442 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8443 signalbin(bs_fortsæt_adgang);
10 8444 end;
9 8445
9 8445 end;
8 8446
8 8446 begin
9 8447 \f
9 8447 message procedure operatør side 19 - 810522/cl;
9 8448
9 8448 <* 6 spring (igangsæt)
9 8449 spring,annuler
9 8450 spring,reserve *>
9 8451
9 8451 tofrom(d.op_ref.data,ia,6);
9 8452 d.op_ref.retur:=cs_operatør(nr);
9 8453 indeks:=op_ref;
9 8454 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8455 <*V*> wait_ch(cs_operatør(nr),
9 8456 op_ref,
9 8457 op_optype,
9 8458 -1<*timeout*>);
9 8459 <*+2*> if testbit10 and overvåget then
9 8460 disable begin
10 8461 skriv_operatør(out,0);
10 8462 write(out,"nl",1,<:op operation retur fra vt:>);
10 8463 skriv_op(out,op_ref);
10 8464 end;
9 8465 <*-2*>
9 8466 <*+4*> if indeks<>op_ref then
9 8467 fejlreaktion(11<*fremmed post*>,op_ref,
9 8468 <:op kommando(spring):>,0);
9 8469 <*-4*>
9 8470
9 8470 <*V*> setposition(z_op(nr),0,0);
9 8471 cursor(z_op(nr),24,1);
9 8472 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8473 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8474 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8475 end;
8 8476
8 8476 begin
9 8477 \f
9 8477 message procedure operatør side 20 - 810525/cl;
9 8478
9 8478 <* 7 spring(-oversigts-)rapport *>
9 8479
9 8479 d.op_ref.retur:=cs_operatør(nr);
9 8480 tofrom(d.op_ref.data,ia,4);
9 8481 indeks:=op_ref;
9 8482 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8483 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8484 <*+2*> disable if testbit10 and overvåget then
9 8485 begin
10 8486 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8487 skriv_op(out,op_ref);
10 8488 end;
9 8489 <*-2*>
9 8490
9 8490 <*+4*> if op_ref<>indeks then
9 8491 fejlreaktion(11<*fremmed post*>,op_ref,
9 8492 <:op kommando(spring-rapport):>,0);
9 8493 <*-4*>
9 8494
9 8494 <*V*> setposition(z_op(nr),0,0);
9 8495 if d.op_ref.resultat<>3 then
9 8496 begin
10 8497 cursor(z_op(nr),24,1);
10 8498 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8499 end
9 8500 else
9 8501 begin
10 8502 boolean p_skrevet;
10 8503 integer bogst,løb;
10 8504
10 8504 skærmmåde:= 1;
10 8505
10 8505 if kode = 32 then <* spring,vis *>
10 8506 begin
11 8507 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8508 bogst:= d.op_ref.data(1) extract 5;
11 8509 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8510 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8511 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8512 <:spring: :>,
11 8513 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8514 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8515 raf:= data+8;
11 8516 if d.op_ref.raf(1)<>0.0 then
11 8517 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8518 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8519 else write(z_op(nr),<:, ikke startet:>);
11 8520 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8521 \f
11 8521 message procedure operatør side 21 - 810522/cl;
11 8522
11 8522 p_skrevet:= false;
11 8523 for pos:=1 step 1 until d.op_ref.data(3) do
11 8524 begin
12 8525 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8526 if i<>0 then
12 8527 fejlreaktion(5<*læsfil*>,i,
12 8528 <:op kommando(spring,vis):>,0);
12 8529 iaf:=0;
12 8530 i:= fil(j).iaf(1);
12 8531 if i < 0 and -, p_skrevet then
12 8532 begin
13 8533 outchar(z_op(nr),'('); p_skrevet:= true;
13 8534 end;
12 8535 if i > 0 and p_skrevet then
12 8536 begin
13 8537 outchar(z_op(nr),')'); p_skrevet:= false;
13 8538 end;
12 8539 if pos mod 2 = 0 then
12 8540 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8541 else
12 8542 write(z_op(nr),true,3,<<d>,abs i);
12 8543 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8544 end;
11 8545 write(z_op(nr),"*",1);
11 8546 \f
11 8546 message procedure operatør side 22 - 810522/cl;
11 8547
11 8547 end
10 8548 else if kode=33 then <* spring,oversigt *>
10 8549 begin
11 8550 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8551 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8552 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8553
11 8553 for pos:=1 step 1 until d.op_ref.data(1) do
11 8554 begin
12 8555 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8556 if i<>0 then
12 8557 fejlreaktion(5<*læsfil*>,i,
12 8558 <:op kommando(spring-oversigt):>,0);
12 8559 iaf:=0;
12 8560 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8561 bogst:=fil(j).iaf(1) extract 5;
12 8562 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8563 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8564 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8565 string (extend fil(j).iaf(2) shift 24));
12 8566 if fil(j,2)<>0.0 then
12 8567 write(z_op(nr),<:startet :>,<<zddddd>,
12 8568 round systime(4,fil(j,2),r),<:.:>,round r);
12 8569 outchar(z_op(nr),'nl');
12 8570 end;
11 8571 write(z_op(nr),"*",1);
11 8572 end;
10 8573 <* slet fil *>
10 8574 d.op_ref.opkode:= 104;
10 8575 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8576 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8577 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8578 end; <* resultat=3 *>
9 8579
9 8579 end;
8 8580
8 8580 begin
9 8581 \f
9 8581 message procedure operatør side 23 - 940522/cl;
9 8582
9 8582
9 8582 <* 8 SLUT *>
9 8583 trapmode:= 1 shift 13;
9 8584 trap(-2);
9 8585 end;
8 8586
8 8586 begin
9 8587 <* 9 stopniveauer,definer *>
9 8588 integer fno;
9 8589
9 8589 for i:= 1 step 1 until 3 do
9 8590 operatør_stop(nr,i):= ia(i+1);
9 8591 i:= modif_fil(tf_stoptabel,nr,fno);
9 8592 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8593 iaf:=0;
9 8594 for i:= 0,1,2,3 do
9 8595 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8596 setposition(fil(fno),0,0);
9 8597 setposition(z_op(nr),0,0);
9 8598 cursor(z_op(nr),24,1);
9 8599 skriv_kvittering(z_op(nr),0,-1,3);
9 8600 end;
8 8601
8 8601 begin
9 8602 \f
9 8602 message procedure operatør side 24 - 940522/cl;
9 8603
9 8603 <* 10 stopniveauer,vis *>
9 8604 integer bpl,j,k;
9 8605
9 8605 skærm_måde:= 1;
9 8606 setposition(z_op(nr),0,0);
9 8607 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8608 <:stopniveauer: :>);
9 8609 for i:= 0 step 1 until 3 do
9 8610 begin
10 8611 bpl:= operatør_stop(nr,i);
10 8612 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8613 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8614 end;
9 8615 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8616 j:=0;
9 8617 for bpl:= 1 step 1 until max_antal_operatører do
9 8618 if bpl_navn(bpl)<>long<::> then
9 8619 begin
10 8620 if j mod 8 = 0 and j > 0 then
10 8621 write(z_op(nr),"nl",1,"sp",18);
10 8622 iaf:= bpl*terminal_beskr_længde;
10 8623 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8624 true,6,string bpl_navn(bpl));
10 8625 j:=j+1;
10 8626 end;
9 8627 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8628 j:=0;
9 8629 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8630 if bpl_navn(bpl)<>long<::> then
9 8631 begin
10 8632 if j mod 8 = 0 and j > 0 then
10 8633 write(z_op(nr),"nl",1,"sp",19);
10 8634 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8635 j:=j+1;
10 8636 end;
9 8637 write(z_op(nr),"nl",1,"*",1);
9 8638 end;
8 8639
8 8639 begin
9 8640 <* 11 alarmlængde *>
9 8641 integer fno;
9 8642
9 8642 if indeks > 0 then
9 8643 begin
10 8644 opk_alarm.tab.alarm_lgd:= ia(1);
10 8645 i:= modiffil(tf_alarmlgd,nr,fno);
10 8646 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8647 iaf:= 0;
10 8648 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8649 setposition(fil(fno),0,0);
10 8650 end;
9 8651
9 8651 setposition(z_op(nr),0,0);
9 8652 cursor(z_op(nr),24,1);
9 8653 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8654 end;
8 8655
8 8655 begin
9 8656 <* 12 CC *>
9 8657 integer i, c;
9 8658
9 8658 i:= 1;
9 8659 while læstegn(ia,i+0,c)<>0 and
9 8660 i<(op_spool_postlgd-op_spool_text)//2*3
9 8661 do skrivtegn(d.opref.data,i,c);
9 8662 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8663
9 8663 d.opref.retur:= cs_operatør(nr);
9 8664 signalch(cs_op_spool,opref,op_optype);
9 8665 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8666
9 8666 setposition(z_op(nr),0,0);
9 8667 cursor(z_op(nr),24,1);
9 8668 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8669 end;
8 8670
8 8670 <* 13 EXkluder skærmen *>
8 8671 begin
9 8672 d.opref.resultat:= 2;
9 8673 setposition(z_op(nr),0,0);
9 8674 cursor(z_op(nr),24,1);
9 8675 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8676
9 8676 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8677 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8678 d.vt_op.data(1):= nr;
9 8679 signalch(cs_rad,vt_op,gen_optype);
9 8680 end;
8 8681
8 8681 begin
9 8682 <* 14 CQF-tabel,vis *>
9 8683
9 8683 skærm_måde:= 1;
9 8684 setposition(z_op(nr),0,0);
9 8685 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8686 "esc" add 128,1,<:ÆJ:>);
9 8687 skriv_cqf_tabel(z_op(nr),false);
9 8688 write(z_op(nr),"*",1);
9 8689 end;
8 8690
8 8690 begin
9 8691 <* 15 ALarmlyd,Test *>
9 8692 integer array field tab;
9 8693 integer res;
9 8694
9 8694 tab:= (nr-1)*opk_alarm_tab_lgd;
9 8695 setposition(z_op(nr),0,0);
9 8696 if ia(1)<1 or ia(1)>2 then
9 8697 res:= 64 <* ulovligt tal *>
9 8698 else if opk_alarm.tab.alarm_lgd = 0 then
9 8699 begin
10 8700 if ia(1)=2 then
10 8701 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
10 8702 else
10 8703 write(z_op(nr),"bel",1);
10 8704 res:= 3;
10 8705 end
9 8706 else if ia(1) > opk_alarm.tab.alarm_tilst and
9 8707 ia(1) > opk_alarm.tab.alarm_kmdo then
9 8708 begin
10 8709 opk_alarm.tab.alarm_kmdo:= ia(1);
10 8710 signal_bin(bs_opk_alarm);
10 8711 res:= 3;
10 8712 end
9 8713 else
9 8714 res:= 48; <* i brug *>
9 8715
9 8715 cursor(z_op(nr),24,1);
9 8716 skriv_kvittering(z_op(nr),opref,-1,res);
9 8717 end;
8 8718
8 8718 begin
9 8719 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8720 setposition(z_op(nr),0,0);
9 8721 cursor(z_op(nr),24,1);
9 8722 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8723 end;
8 8724 \f
8 8724 message procedure operatør side x - 810522/hko;
8 8725
8 8725 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8726 <*-4*>
8 8727 end;<*case j *>
7 8728 end <* j > 0 *>
6 8729 else
6 8730 begin
7 8731 <*V*> setposition(z_op(nr),0,0);
7 8732 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8733 skriv_kvittering(z_op(nr),op_ref,-1,
7 8734 45 <*ikke implementeret *>);
7 8735 end;
6 8736 end;<* godkendt *>
5 8737
5 8737 <*V*> setposition(z_op(nr),0,0);
5 8738 <*???*>
5 8739 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8740 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8741 skærmmåde = 0 do
5 8742 begin
6 8743 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8744 begin
7 8745 skriv_skærm_bvs(nr);
7 8746 <*940920 if op_talevej(nr)=0 then status:= 0
7 8747 else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8748 if status>0 then
7 8749 begin
7 8750 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8751 terminaltab.ref(ll):= 0;
7 8752 skriv_skærm_bvs(nr);
7 8753 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8754 end;
7 8755 for i:= 1 step 1 until max_antal_kanaler do
7 8756 begin
7 8757 iaf:= (i-1)*kanalbeskrlængde;
7 8758 inspect(ss_samtale_nedlagt(i),status);
7 8759 if status>0 and
7 8760 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8761 begin
7 8762 kanaltab.iaf.kanal_tilstand:=
7 8763 kanaltab.iaf(1) shift (-10) extract 6 shift 10;
7 8764 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8765 kanaltab.iaf(ll):= 0;
7 8766 skriv_skærm_kanal(nr,i);
7 8767 repeat
7 8768 wait(ss_samtale_nedlagt(i));
7 8769 inspect(ss_samtale_nedlagt(i),status);
7 8770 until status=0;
7 8771 end;
7 8772 end;
7 8773 940920*> cursor(z_op(nr),1,1);
7 8774 setposition(z_op(nr),0,0);
7 8775 end;
6 8776 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8777 and skærmmåde = 0
6 8778 and læsbit_ia(operatørmaske,nr) then
6 8779 begin
7 8780 if sætbit_ia(opkaldsflag,nr,0) = 1 then
7 8781 skriv_skærm_opkaldskø(nr);
7 8782 if sætbit_ia(kanalflag,nr,0) = 1 then
7 8783 begin
8 8784 for i:= 1 step 1 until max_antal_kanaler do
8 8785 skriv_skærm_kanal(nr,i);
8 8786 end;
7 8787 cursor(z_op(nr),1,1);
7 8788 <*V*> setposition(z_op(nr),0,0);
7 8789 end;
6 8790 end;
5 8791 d.op_ref.retur:=cs_att_pulje;
5 8792 disable afslut_kommando(op_ref);
5 8793 end; <* indlæs kommando *>
4 8794
4 8794 begin
5 8795 \f
5 8795 message procedure operatør side x+1 - 810617/hko;
5 8796
5 8796 <* 2: inkluder *>
5 8797 integer k,n;
5 8798 integer array field msk,iaf1;
5 8799
5 8799 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8800 if i=0 then
5 8801 begin
6 8802 fejlreaktion(3<*programfejl*>,nr,
6 8803 <:operatør(nr) eksisterer ikke:>,1);
6 8804 d.op_ref.resultat:=28;
6 8805 end
5 8806 else
5 8807 begin
6 8808 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8809 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8810 else if d.op_ref.opkode = 0 then 0
6 8811 else 3;<*udført*>
6 8812 if i > 0 then
6 8813 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8814 <:operatørskærm reservation:>,1)
6 8815 else
6 8816 begin
7 8817 i:=terminal_tab.ref.terminal_tilstand;
7 8818 <*940418/cl inkluderet sættes i stop - start *>
7 8819 kode:= d.opref.opkode extract 12;
7 8820 if kode <> 0 then
7 8821 terminal_tab.ref.terminal_tilstand:=
7 8822 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8823 else
7 8824 <*940418/cl inkluderet sættes i stop - slut *>
7 8825 terminal_tab.ref.terminal_tilstand:= i extract
7 8826 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8827 for i:= 1 step 1 until max_antal_kanaler do
7 8828 begin
8 8829 iaf:= (i-1)*kanalbeskrlængde;
8 8830 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8831 end;
7 8832 skærm_måde:= 0;
7 8833 sætbit_ia(operatørmaske,nr,
7 8834 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8835 then 0 else 1));
7 8836 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8837 begin
8 8838 msk:= k*op_maske_lgd;
8 8839 if læsbit_ia(bpl_def.msk,nr) then
8 8840 <**> begin
9 8841 n:= 0;
9 8842 for i:= 1 step 1 until max_antal_operatører do
9 8843 if læsbit_ia(bpl_def.msk,i) then
9 8844 begin
10 8845 iaf1:= i*terminal_beskr_længde;
10 8846 if terminal_tab.iaf1.terminal_tilstand
10 8847 shift (-21) < 3 then
10 8848 n:= n+1;
10 8849 end;
9 8850 bpl_tilst(k,1):= n;
9 8851 end;
8 8852 <**> <*
8 8853 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8854 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8855 *> end;
7 8856 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8857 sætbit_ia(opkaldsflag,nr,0);
7 8858 signal_bin(bs_mobil_opkald);
7 8859 <*940418/cl inkluderet sættes i stop - start *>
7 8860 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8861 <*V*> ht_symbol(z_op(nr))
7 8862 else
7 8863 <*940418/cl inkluderet sættes i stop - slut *>
7 8864 <*V*> skriv_skærm(nr);
7 8865 cursor(z_op(nr),24,1);
7 8866 <*V*> setposition(z_op(nr),0,0);
7 8867 end;
6 8868 end;
5 8869 if d.op_ref.opkode = 0 then
5 8870 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8871 else
5 8872 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8873 end;
4 8874
4 8874 begin
5 8875 \f
5 8875 message procedure operatør side x+2 - 820304/hko;
5 8876
5 8876 <* 3: ekskluder *>
5 8877 integer k,n;
5 8878 integer array field iaf1,msk;
5 8879
5 8879 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8880 <*V*> setposition(z_op(nr),0,0);
5 8881 monitor(10) release process:(z_op(nr),0,ia);
5 8882 d.op_ref.resultat:=3;
5 8883 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8884 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8885 terminal_tab.ref.terminal_tilstand extract 21;
5 8886 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8887 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8888 begin
6 8889 msk:= k*op_maske_lgd;
6 8890 if læsbit_ia(bpl_def.msk,nr) then
6 8891 <**> begin
7 8892 n:= 0;
7 8893 for i:= 1 step 1 until max_antal_operatører do
7 8894 if læsbit_ia(bpl_def.msk,i) then
7 8895 begin
8 8896 iaf1:= i*terminal_beskr_længde;
8 8897 if terminal_tab.iaf1.terminal_tilstand
8 8898 shift (-21) < 3 then
8 8899 n:= n+1;
8 8900 end;
7 8901 bpl_tilst(k,1):= n;
7 8902 end;
6 8903 <**> <*
6 8904 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8905 *> end;
5 8906 signal_bin(bs_mobil_opkald);
5 8907 if opk_alarm.tab.alarm_tilst > 0 then
5 8908 begin
6 8909 opk_alarm.tab.alarm_kmdo:= 3;
6 8910 signal_bin(bs_opk_alarm);
6 8911 end;
5 8912 end;
4 8913 begin
5 8914
5 8914 <* 4: opdater skærm *>
5 8915
5 8915 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8916 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8917 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8918 skærmmåde=0 do
5 8919 begin
6 8920
6 8920 <*+2*> if testbit13 and overvåget then
6 8921 disable begin
7 8922 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8923 <:) opkaldsflag::>,"nl",1);
7 8924 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8925 write(out,<: operatørmaske::>,"nl",1);
7 8926 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8927 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8928 ud;
7 8929 end;
6 8930 <*-2*>
6 8931 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8932 begin
7 8933 skriv_skærm_bvs(nr);
7 8934 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8935 if status>0 then
7 8936 begin
7 8937 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8938 terminaltab.ref(ll):= 0;
7 8939 skriv_skærm_bvs(nr);
7 8940 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8941 end;
7 8942 for i:= 1 step 1 until max_antal_kanaler do
7 8943 begin
7 8944 iaf:= (i-1)*kanalbeskrlængde;
7 8945 inspect(ss_samtale_nedlagt(i),status);
7 8946 if status>0 and
7 8947 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8948 begin
7 8949 kanaltab.iaf.kanal_tilstand:=
7 8950 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8951 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8952 kanaltab.iaf(ll):= 0;
7 8953 skriv_skærm_kanal(nr,i);
7 8954 repeat
7 8955 wait(ss_samtale_nedlagt(i));
7 8956 inspect(ss_samtale_nedlagt(i),status);
7 8957 until status=0;
7 8958 end;
7 8959 end;
7 8960 940920*> cursor(z_op(nr),1,1);
7 8961 setposition(z_op(nr),0,0);
7 8962 end;
6 8963 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8964 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8965 begin
7 8966 <*V*> setposition(z_op(nr),0,0);
7 8967 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 8968 skriv_skærm_opkaldskø(nr);
7 8969 if sætbit_ia(kanalflag,nr,0) =1 then
7 8970 begin
8 8971 for i:=1 step 1 until max_antal_kanaler do
8 8972 skriv_skærm_kanal(nr,i);
8 8973 end;
7 8974 cursor(z_op(nr),1,1);
7 8975 <*V*> setposition(z_op(nr),0,0);
7 8976 end;
6 8977 end;
5 8978 end;
4 8979 begin
5 8980 \f
5 8980 message procedure operatør side x+3 - 830310/hko;
5 8981
5 8981 <* 5: samtale etableret *>
5 8982
5 8982 res:= d.op_ref.resultat;
5 8983 b_v:= d.op_ref.data(3) extract 4;
5 8984 b_s:= d.op_ref.data(4);
5 8985 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8986 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 8987 begin
6 8988 sætbit_i(terminal_tab.ref(1),21,1);
6 8989 sætbit_i(terminal_tab.ref(1),22,0);
6 8990 sætbit_i(terminal_tab.ref(1),2,0);
6 8991 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 8992 terminal_tab.ref(2):= b_s;
6 8993 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 8994 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 8995 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 8996 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 8997
6 8997 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8998 begin
7 8999 <*V*> setposition(z_op(nr),0,0);
7 9000 skriv_skærm_b_v_s(nr);
7 9001 <*V*> setposition(z_op(nr),0,0);
7 9002 end;
6 9003 end
5 9004 else
5 9005 if terminal_tab.ref(1) shift(-21) = 2 then
5 9006 begin
6 9007 sætbit_i(terminal_tab.ref(1),22,0);
6 9008 sætbit_i(terminal_tab.ref(1),2,0);
6 9009 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9010 terminal_tab.ref(2):= 0;
6 9011 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9012 begin
7 9013 <*V*> setposition(z_op(nr),0,0);
7 9014 cursor(z_op(nr),21,17);
7 9015 write(z_op(nr),<:EJ FORB:>);
7 9016 <*V*> setposition(z_op(nr),0,0);
7 9017 end;
6 9018 end
5 9019 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 9020 <:terminal tilstand:>,1);
5 9021 end;
4 9022
4 9022 begin
5 9023 \f
5 9023 message procedure operatør side x+4 - 810602/hko;
5 9024
5 9024 <* 6: radiokanal ekskluderet *>
5 9025
5 9025 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 9026 pos:= d.op_ref.data(1);
5 9027 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9028 indeks:= terminal_tab.ref(2);
5 9029 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 9030 then indeks extract 4 else 0;
5 9031 if b_v = pos then
5 9032 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 9033 if b_s = pos then
5 9034 begin
6 9035 terminal_tab.ref(2):= 0;
6 9036 sætbit_i(terminal_tab.ref(1),21,0);
6 9037 sætbit_i(terminal_tab.ref(1),22,0);
6 9038 sætbit_i(terminal_tab.ref(1),2,0);
6 9039 end;
5 9040 if skærmmåde=0 then
5 9041 begin
6 9042 if b_v = pos or b_s = pos then
6 9043 <*V*> skriv_skærm_b_v_s(nr);
6 9044 <*V*> skriv_skærm_kanal(nr,pos);
6 9045 cursor(z_op(nr),1,1);
6 9046 setposition(z_op(nr),0,0);
6 9047 end;
5 9048 end;
4 9049
4 9049 begin
5 9050 \f
5 9050 message procedure operatør side x+5 - 950118/cl;
5 9051
5 9051 <* 7: operatørmeddelelse *>
5 9052 integer afs, kl, i;
5 9053 real dato, t;
5 9054
5 9054 cursor(z_op(nr),24,1);
5 9055 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9056 cursor(z_op(nr),23,1);
5 9057 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9058
5 9058 afs:= d.opref.data.op_spool_kilde;
5 9059 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 9060 kl:= round t;
5 9061 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 9062 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 9063 i:= replacechar(1,'.');
5 9064 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 9065 replacechar(1,i);
5 9066 write(z_op(nr),d.opref.data.op_spool_text);
5 9067
5 9067 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 9068 begin
6 9069 if opk_alarm.tab.alarm_lgd > 0 and
6 9070 opk_alarm.tab.alarm_tilst < 1 and
6 9071 opk_alarm.tab.alarm_kmdo < 1
6 9072 then
6 9073 begin
7 9074 opk_alarm.tab.alarm_kmdo := 1;
7 9075 signalbin(bs_opk_alarm);
7 9076 end
6 9077 else
6 9078 if opk_alarm.tab.alarm_lgd = 0 then
6 9079 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 9080 end;
5 9081
5 9081 setposition(z_op(nr),0,0);
5 9082
5 9082 signalch(d.opref.retur,opref,d.opref.optype);
5 9083 end;
4 9084
4 9084 begin
5 9085
5 9085 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 9086 <*-4*>
5 9087 end
4 9088 end; <* case aktion+6 *>
3 9089
3 9089 until false;
3 9090 op_trap:
3 9091 skriv_operatør(zbillede,1);
3 9092 end operatør;
2 9093
2 9093 \f
2 9093 message procedure op_cqftest side 1;
2 9094
2 9094 procedure op_cqftest;
2 9095 begin
3 9096 integer array field opref, ref, ref1;
3 9097 integer i, j, tv, cqf, res, pausetid;
3 9098 real nu, næstetid, kommstart, kommslut;
3 9099
3 9099 procedure skriv_op_cqftest(zud,omfang);
3 9100 value omfang;
3 9101 zone zud;
3 9102 integer omfang;
3 9103 begin
4 9104 write(zud,"nl",1,<:+++ op-cqftest:>);
4 9105 if omfang > 0 then
4 9106 disable begin
5 9107 real t;
5 9108
5 9108 trap(slut);
5 9109 write(zud,"nl",1,
5 9110 <: opref: :>,opref,"nl",1,
5 9111 <: ref: :>,ref,"nl",1,
5 9112 <: i: :>,i,"nl",1,
5 9113 <: tv: :>,tv,"nl",1,
5 9114 <: cqf: :>,cqf,"nl",1,
5 9115 <: res: :>,res,"nl",1,
5 9116 <: pausetid: :>,pausetid,"nl",1,
5 9117 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 9118 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 9119 <::>);
5 9120 skriv_coru(zud,coru_no(292));
5 9121 slut:
5 9122 end;
4 9123 end skriv_op_cqftest;
3 9124
3 9124 trap(op_cqf_trap);
3 9125 stackclaim(1000);
3 9126
3 9126
3 9126 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9127 skriv_op_cqftest(out,0);
3 9128 <*-4*>
3 9129
3 9129 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 9130 repeat
3 9131 i:= sidste_tv_brugt; tv:= 0;
3 9132 repeat
3 9133 i:= (i mod max_antal_taleveje) + 1;
3 9134 if tv_operatør(i) = 0 then tv:= i;
3 9135 until (tv<>0) or (i=sidste_tv_brugt);
3 9136
3 9136 if tv<>0 then
3 9137 begin
4 9138 tv_operatør(tv):= -1;
4 9139 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 9140 for cqf:= 1 step 1 until max_cqf do
4 9141 begin
5 9142 ref:= (cqf-1)*cqf_lgd;
5 9143 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 9144 begin
6 9145 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 9146 d.opref.data(1):= tv;
6 9147 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 9148 disable if testbit19 then
6 9149 begin
7 9150 integer i; <*lav en trap-bar blok*>
7 9151
7 9151 trap(test19_trap);
7 9152 systime(1,0,kommstart);
7 9153 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 9154 skriv_id(zrl,d.opref.data(2),0);
7 9155 test19_trap: outchar(zrl,'nl');
7 9156 end;
6 9157 signalch(cs_rad,opref,op_optype or gen_optype);
6 9158 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 9159 res:= d.opref.resultat;
6 9160 <*+2*>
6 9161 disable if testbit19 then
6 9162 begin
7 9163 integer i; <*lav en trap-bar blok*>
7 9164
7 9164 trap(test19_trap);
7 9165 systime(1,0,kommslut);
7 9166 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 9167 if d.opref.data(7)=2 then outchar(zrl,'*');
7 9168 if d.opref.data(9)<>0 then
7 9169 begin
8 9170 skriv_id(zrl,d.opref.data(9),0);
8 9171 outchar(zrl,' ');
8 9172 end;
7 9173 if d.opref.data(8)<>0 then
7 9174 begin
8 9175 skriv_id(zrl,d.opref.data(8),0);
8 9176 outchar(zrl,' ');
8 9177 end;
7 9178 if d.opref.data(12)<>0 then
7 9179 begin
8 9180 if d.opref.data(12) shift (-20) = 15 then
8 9181 write(zrl,<:OMR*:>)
8 9182 else
8 9183 if d.opref.data(12) shift (-20) = 14 then
8 9184 write(zrl,
8 9185 string områdenavn(d.opref.data(12) extract 20))
8 9186 else
8 9187 skriv_id(zrl,d.opref.data(12),0);
8 9188 outchar(zrl,' ');
8 9189 end;
7 9190 if d.opref.data(10)<>0 then
7 9191 begin
8 9192 skriv_id(zrl,d.opref.data(10),0);
8 9193 outchar(zrl,' ');
8 9194 end;
7 9195 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 9196 <<dd.dd>,kommslut-kommstart);
7 9197 test19_trap: outchar(zrl,'nl');
7 9198 end;
6 9199 <*-2*>
6 9200 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 9201 begin
7 9202 delay(3);
7 9203 d.opref.opkode:= 12 shift 12 + 41;
7 9204 d.opref.resultat:= 0;
7 9205 disable if testbit19 then
7 9206 begin
8 9207 integer i; <*lav en trap-bar blok*>
8 9208
8 9208 trap(test19_trap);
8 9209 systime(1,0,kommstart);
8 9210 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 9211 test19_trap: outchar(zrl,'nl');
8 9212 end;
7 9213 signalch(cs_rad,opref,op_optype or gen_optype);
7 9214 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 9215 <*+2*>
7 9216 disable if testbit19 then
7 9217 begin
8 9218 integer i; <*lav en trap-bar blok*>
8 9219
8 9219 trap(test19_trap);
8 9220 systime(1,0,kommslut);
8 9221 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 9222 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 9223 <<dd.dd>,kommslut-kommstart);
8 9224 test19_trap: outchar(zrl,'nl');
8 9225 end;
7 9226 <*-2*>
7 9227 if d.opref.resultat <> 3 then
7 9228 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 9229 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 9230 begin
8 9231 startoperation(opref,292,cs_cqf,23);
8 9232 i:= 1;
8 9233 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9234 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9235 skriv_tegn(d.opref.data,i,' ');
8 9236 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9237 hægtstring(d.opref.data,i,<: ok!:>);
8 9238 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9239 signalch(cs_io,opref,gen_optype);
8 9240 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9241 end;
7 9242 if cqf_tabel.ref.cqf_bus > 0 then
7 9243 begin
8 9244 cqf_tabel.ref.cqf_fejl:= 0;
8 9245 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 9246 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 9247 end;
7 9248 end <*res=3*>
6 9249 else
6 9250 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 9251 cqf_tabel.ref.cqf_bus > 0
6 9252 then
6 9253 begin
7 9254 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 9255 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 9256 if cqf_tabel.ref.cqf_fejl >= 2 then
7 9257 begin
8 9258 startoperation(opref,292,cs_cqf,23);
8 9259 i:= 1;
8 9260 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9261 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9262 skriv_tegn(d.opref.data,i,' ');
8 9263 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9264 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 9265 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9266 signalch(cs_io,opref,gen_optype);
8 9267 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9268 end;
7 9269 end;
6 9270 delay(10);
6 9271 end;
5 9272 if cqf_tabel.ref.cqf_bus > 0 and
5 9273 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 9274 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 9275 end; <*for cqf*>
4 9276
4 9276 tv_operatør(tv):= 0; tv:= 0;
4 9277 if op_cqf_tab_ændret then
4 9278 begin
5 9279 j:= skrivfil(1033,1,i);
5 9280 if j<>0 then
5 9281 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 9282 sorter_cqftab(1,max_cqf);
5 9283 for cqf:= 1 step 1 until max_cqf do
5 9284 begin
6 9285 ref:= (cqf-1)*cqf_lgd;
6 9286 ref1:= (cqf-1)*cqf_id;
6 9287 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 9288 end;
5 9289 op_cqf_tab_ændret:= false;
5 9290 end;
4 9291 end; <*tv*>
3 9292
3 9292 systime(1,0.0,nu);
3 9293 pausetid:= round(næste_tid - nu);
3 9294 if pausetid < 30 then pausetid:= 30;
3 9295
3 9295 <*V*> delay(pausetid);
3 9296
3 9296 until false;
3 9297
3 9297 op_cqf_trap:
3 9298 disable skriv_op_cqftest(zbillede,1);
3 9299 end op_cqftest;
2 9300 \f
2 9300 message procedure op_spool side 1;
2 9301
2 9301 procedure op_spool;
2 9302 begin
3 9303 integer array field opref, ref;
3 9304 integer næste_tomme, i;
3 9305
3 9305 procedure skriv_op_spool(zud,omfang);
3 9306 value omfang;
3 9307 zone zud;
3 9308 integer omfang;
3 9309 begin
4 9310 write(zud,"nl",1,<:+++ op-spool:>);
4 9311 if omfang > 0 then
4 9312 disable begin
5 9313 real t;
5 9314
5 9314 trap(slut);
5 9315 write(zud,"nl",1,
5 9316 <: opref: :>,opref,"nl",1,
5 9317 <: næste-tomme: :>,næste_tomme,"nl",1,
5 9318 <: ref: :>,ref,"nl",1,
5 9319 <: i: :>,i,"nl",1,
5 9320 <::>);
5 9321 skriv_coru(zud,coru_no(293));
5 9322 slut:
5 9323 end;
4 9324 end skriv_op_spool;
3 9325
3 9325 trap(op_spool_trap);
3 9326 stackclaim(400);
3 9327
3 9327 næste_tomme:= 0;
3 9328
3 9328 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9329 skriv_op_spool(out,0);
3 9330 <*-4*>
3 9331
3 9331 repeat
3 9332 <*V*> waitch(cs_op_spool,opref,true,-1);
3 9333 inspect(ss_op_spool_tomme,i);
3 9334
3 9334 if d.opref.opkode extract 12 <> 37 then
3 9335 begin
4 9336 d.opref.resultat:= 31;
4 9337 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 9338 end
3 9339 else
3 9340 if i<=0 then
3 9341 d.opref.resultat:= 32 <*ingen fri plads*>
3 9342 else
3 9343 begin
4 9344 <*V*> wait(ss_op_spool_tomme);
4 9345 ref:= næste_tomme*op_spool_postlgd;
4 9346 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9347 i:= d.opref.opsize - data;
4 9348 if i > (op_spool_postlgd - op_spool_text) then
4 9349 i:= (op_spool_postlgd - op_spool_text);
4 9350 op_spool_buf.ref.op_spool_kilde:=
4 9351 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9352 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9353 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9354 op_spool_buf.ref(op_spool_postlgd//2):=
4 9355 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9356 d.opref.resultat:= 3;
4 9357
4 9357 signal(ss_op_spool_fulde);
4 9358 end;
3 9359
3 9359 signalch(d.opref.retur,opref,d.opref.optype);
3 9360 until false;
3 9361
3 9361 op_spool_trap:
3 9362 disable skriv_op_spool(zbillede,1);
3 9363 end op_spool;
2 9364 \f
2 9364 message procedure op_medd side 1;
2 9365
2 9365 procedure op_medd;
2 9366 begin
3 9367 integer array field opref, ref;
3 9368 integer næste_fulde, i;
3 9369
3 9369 procedure skriv_op_medd(zud,omfang);
3 9370 value omfang;
3 9371 zone zud;
3 9372 integer omfang;
3 9373 begin
4 9374 write(zud,"nl",1,<:+++ op-medd:>);
4 9375 if omfang > 0 then
4 9376 disable begin
5 9377 real t;
5 9378
5 9378 trap(slut);
5 9379 write(zud,"nl",1,
5 9380 <: opref: :>,opref,"nl",1,
5 9381 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9382 <: ref: :>,ref,"nl",1,
5 9383 <: i: :>,i,"nl",1,
5 9384 <::>);
5 9385 skriv_coru(zud,coru_no(294));
5 9386 slut:
5 9387 end;
4 9388 end skriv_op_medd;
3 9389
3 9389 trap(op_medd_trap);
3 9390 næste_fulde:= 0;
3 9391 stackclaim(400);
3 9392
3 9392 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9393 skriv_op_medd(out,0);
3 9394 <*-4*>
3 9395
3 9395 repeat
3 9396 <*V*> wait(ss_op_spool_fulde);
3 9397 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9398
3 9398 ref:= næste_fulde*op_spool_postlgd;
3 9399 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9400
3 9400 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9401 d.opref.resultat:= 0;
3 9402 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9403 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9404 opref,gen_optype);
3 9405 signal(ss_op_spool_tomme);
3 9406 until false;
3 9407
3 9407 op_medd_trap:
3 9408 disable skriv_op_medd(zbillede,1);
3 9409 end op_medd;
2 9410 \f
2 9410 message procedure alarmur side 1;
2 9411
2 9411 procedure alarmur;
2 9412 begin
3 9413 integer ventetid, nr;
3 9414 integer array field opref, tab;
3 9415 real nu;
3 9416
3 9416 procedure skriv_alarmur(zud,omfang);
3 9417 value omfang;
3 9418 zone zud;
3 9419 integer omfang;
3 9420 begin
4 9421 write(zud,"nl",1,<:+++ alarmur:>);
4 9422 if omfang > 0 then
4 9423 disable begin
5 9424 real t;
5 9425
5 9425 trap(slut);
5 9426 write(zud,"nl",1,
5 9427 <: ventetid: :>,ventetid,"nl",1,
5 9428 <: nr: :>,nr,"nl",1,
5 9429 <: opref: :>,opref,"nl",1,
5 9430 <: tab: :>,tab,"nl",1,
5 9431 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9432 <::>);
5 9433 skriv_coru(zud,coru_no(295));
5 9434 slut:
5 9435 end;
4 9436 end skriv_alarmur;
3 9437
3 9437 trap(alarmur_trap);
3 9438 stackclaim(400);
3 9439
3 9439 systime(1,0.0,nu);
3 9440 ventetid:= -1;
3 9441 repeat
3 9442 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9443 if opref > 0 then
3 9444 signalch(d.opref.retur,opref,op_optype);
3 9445
3 9445 ventetid:= -1;
3 9446 systime(1,0.0,nu);
3 9447 for nr:= 1 step 1 until max_antal_operatører do
3 9448 begin
4 9449 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9450 if opk_alarm.tab.alarm_tilst > 0 and
4 9451 opk_alarm.tab.alarm_lgd >= 0 then
4 9452 begin
5 9453 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9454 begin
6 9455 opk_alarm.tab.alarm_kmdo:= 3;
6 9456 signalbin(bs_opk_alarm);
6 9457 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9458 end
5 9459 else
5 9460 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9461 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9462 end;
4 9463 end;
3 9464 if ventetid=0 then ventetid:= 1;
3 9465 until false;
3 9466
3 9466 alarmur_trap:
3 9467 disable skriv_alarmur(zbillede,1);
3 9468 end alarmur;
2 9469 \f
2 9469 message procedure opkaldsalarmer side 1;
2 9470
2 9470 procedure opkaldsalarmer;
2 9471 begin
3 9472 integer nr, ny_kommando, tilst, aktion, tt;
3 9473 integer array field tab, opref, alarmop;
3 9474
3 9474 procedure skriv_opkaldsalarmer(zud,omfang);
3 9475 value omfang;
3 9476 zone zud;
3 9477 integer omfang;
3 9478 begin
4 9479 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9480 if omfang>0 then
4 9481 disable begin
5 9482 real array field raf;
5 9483 trap(slut);
5 9484 raf:=0;
5 9485 write(zud,"nl",1,
5 9486 <: nr: :>,nr,"nl",1,
5 9487 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9488 <: tilst: :>,tilst,"nl",1,
5 9489 <: aktion: :>,aktion,"nl",1,
5 9490 <: tt: :>,false add tt,1,"nl",1,
5 9491 <: tab: :>,tab,"nl",1,
5 9492 <: opref: :>,opref,"nl",1,
5 9493 <: alarmop: :>,alarmop,"nl",1,
5 9494 <::>);
5 9495 skriv_coru(zud,coru_no(296));
5 9496 slut:
5 9497 end;
4 9498 end skriv_opkaldsalarmer;
3 9499
3 9499 trap(opk_alarm_trap);
3 9500 stackclaim(400);
3 9501
3 9501 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9502 skriv_opkaldsalarmer(out,0);
3 9503 <*-2*>
3 9504
3 9504 repeat
3 9505 wait(bs_opk_alarm);
3 9506 alarmop:= 0;
3 9507 for nr:= 1 step 1 until max_antal_operatører do
3 9508 begin
4 9509 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9510 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9511 tilst:= opk_alarm.tab.alarm_tilst;
4 9512 aktion:= case ny_kommando+1 of (
4 9513 <*ingenting*> case tilst+1 of (4,4,4),
4 9514 <*normal *> case tilst+1 of (1,4,4),
4 9515 <*nød *> case tilst+1 of (2,2,4),
4 9516 <*sluk *> case tilst+1 of (4,3,3));
4 9517 tt:= case aktion of ('B','C','F','-');
4 9518 if tt<>'-' then
4 9519 begin
5 9520 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9521 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9522 d.opref.data(1):= nr+16;
5 9523 signalch(cs_talevejsswitch,opref,op_optype);
5 9524 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9525 if d.opref.resultat = 3 then
5 9526 begin
6 9527 opk_alarm.tab.alarm_kmdo:= 0;
6 9528 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9529 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9530 if aktion < 3 then
6 9531 begin
7 9532 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9533 if alarmop = 0 then
7 9534 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9535 end;
6 9536 end;
5 9537 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9538 end;
4 9539 end;
3 9540 if alarmop<>0 then
3 9541 begin
4 9542 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9543 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9544 end;
3 9545 until false;
3 9546
3 9546 opk_alarm_trap:
3 9547 disable skriv_opkaldsalarmer(zbillede,1);
3 9548 end;
2 9549
2 9549 \f
2 9549 message procedure tvswitch_input side 1 - 940810/cl;
2 9550
2 9550 procedure tv_switch_input;
2 9551 begin
3 9552 integer array field opref;
3 9553 integer tt,ant;
3 9554 boolean ok;
3 9555 integer array ia(1:128);
3 9556
3 9556 procedure skriv_tvswitch_input(zud,omfang);
3 9557 value omfang;
3 9558 zone zud;
3 9559 integer omfang;
3 9560 begin
4 9561 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9562 if omfang>0 then
4 9563 disable begin
5 9564 real array field raf;
5 9565 trap(slut);
5 9566 raf:=0;
5 9567 write(zud,"nl",1,
5 9568 <: opref: :>,opref,"nl",1,
5 9569 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9570 <: ant: :>,ant,"nl",1,
5 9571 <: tt: :>,tt,"nl",1,
5 9572 <::>);
5 9573 write(zud,"nl",1,<:ia: :>);
5 9574 skrivhele(zud,ia.raf,256,2);
5 9575 skriv_coru(zud,coru_no(297));
5 9576 slut:
5 9577 end;
4 9578 end skriv_tvswitch_input;
3 9579 \f
3 9579 boolean procedure læs_tlgr;
3 9580 begin
4 9581 integer kl,ch,i,pos,p;
4 9582 long field lf;
4 9583 boolean ok;
4 9584
4 9584 integer procedure readch(z,c);
4 9585 zone z; integer c;
4 9586 begin
5 9587 readch:= readchar(z,c);
5 9588 <*+2*> if testbit15 and overvåget then
5 9589 disable begin
6 9590 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9591 else write(zrl,"<",1,<<d>,c,">",1);
6 9592 if c='em' then write(zrl,<: *timeout*:>);
6 9593 end;
5 9594 <*-2*>
5 9595 end;
4 9596
4 9596 ok:= false; tt:=' ';
4 9597 repeat
4 9598 readchar(z_tv_in,ch);
4 9599 until ch<>'em';
4 9600 repeatchar(z_tv_in);
4 9601
4 9601 <*+2*>if testbit15 and overvåget then
4 9602 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9603 <*-2*>
4 9604
4 9604 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9605 if ch='%' then
4 9606 begin
5 9607 ant:= 0; pos:= 1; lf:= 4;
5 9608 ok:= true;
5 9609 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9610
5 9610 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9611 skrivtegn(ia,pos,ch);
5 9612
5 9612 p:=pos;
5 9613 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9614
5 9614 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9615 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9616 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9617
5 9617 if ok and ch=' ' then
5 9618 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9619
5 9619 while kl = 2 do
5 9620 begin
6 9621 i:= ch - '0';
6 9622 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9623 if ant < 128 then
6 9624 begin
7 9625 ant:= ant+1;
7 9626 ia(ant):= i;
7 9627 end
6 9628 else
6 9629 ok:= false;
6 9630 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9631 end;
5 9632 if ch<>'nl' then ok:= false;
5 9633 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9634 <* !! setposition(z_tv_in,0,0); !! *>
5 9635 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9636 <*-2*>
5 9637
5 9637 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9638 ok:= ok
5 9639 else if tt='C' or tt='N' or
5 9640 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9641 ok:= ok and ant=1
5 9642 else if tt='X' or tt='Y' then
5 9643 ok:= ok and ant=2
5 9644 else if tt='T' or tt='W' then
5 9645 ok:= ok and ant=64
5 9646 else if tt='R' then
5 9647 ok:= ok and ant extract 1 = 0
5 9648 else
5 9649 begin
6 9650 ok:= false;
6 9651 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9652 end;
5 9653
5 9653 end; <* if ch='%' *>
4 9654 læs_tlgr:= ok;
4 9655 end læs_tlgr;
3 9656 \f
3 9656 trap(tvswitch_input_trap);
3 9657 stackclaim(400);
3 9658 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9659
3 9659 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9660 skriv_tvswitch_input(out,0);
3 9661 <*-2*>
3 9662
3 9662 repeat
3 9663 ok:= læs_tlgr;
3 9664 if ok then
3 9665 begin
4 9666 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9667 start_operation(opref,297,cs_tvswitch_input,0);
4 9668 d.opref.resultat:= tt shift 12 + ant;
4 9669 tofrom(d.opref.data,ia,ant*2);
4 9670 signalch(cs_talevejsswitch,opref,op_optype);
4 9671 end;
3 9672 until false;
3 9673
3 9673 tvswitch_input_trap:
3 9674
3 9674 disable skriv_tvswitch_input(zbillede,1);
3 9675
3 9675 end tvswitch_input;
2 9676 \f
2 9676 message procedure tv_switch_adm side 1 - 940502/cl;
2 9677
2 9677 procedure tv_switch_adm;
2 9678 begin
3 9679 integer array field opref;
3 9680 integer rc;
3 9681
3 9681 procedure skriv_tv_switch_adm(zud,omfang);
3 9682 value omfang;
3 9683 zone zud;
3 9684 integer omfang;
3 9685 begin
4 9686 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9687 if omfang>0 then
4 9688 disable begin
5 9689 trap(slut);
5 9690 write(zud,"nl",1,
5 9691 <: opref: :>,opref,"nl",1,
5 9692 <: rc: :>,rc,"nl",1,
5 9693 <::>);
5 9694 skriv_coru(zud,coru_no(298));
5 9695 slut:
5 9696 end;
4 9697 end skriv_tv_switch_adm;
3 9698
3 9698 trap(tv_switch_adm_trap);
3 9699 stackclaim(400);
3 9700
3 9700 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9701 disable skriv_tv_switch_adm(out,0);
3 9702 <*-2*>
3 9703
3 9703
3 9703
3 9703 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9704 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9705 *>
3 9706
3 9706 repeat
3 9707 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9708 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9709 rc:= 0;
3 9710 repeat
3 9711 signalch(cs_talevejsswitch,opref,op_optype);
3 9712 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9713 rc:= rc+1;
3 9714 until rc=3 or d.opref.resultat=3;
3 9715
3 9715 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9716
3 9716 <*V*> delay(15*60);
3 9717 until false;
3 9718 tv_switch_adm_trap:
3 9719 disable skriv_tv_switch_adm(zbillede,1);
3 9720 end;
2 9721 \f
2 9721 message procedure talevejsswitch side 1 -940426/cl;
2 9722
2 9722 procedure talevejsswitch;
2 9723 begin
3 9724 integer tt, ant, ventetid;
3 9725 integer array field opref, gemt_op, tab;
3 9726 boolean ok;
3 9727 integer array ia(1:128);
3 9728
3 9728 procedure skriv_talevejsswitch(zud,omfang);
3 9729 value omfang;
3 9730 zone zud;
3 9731 integer omfang;
3 9732 begin
4 9733 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9734 if omfang>0 then
4 9735 disable begin
5 9736 real array field raf;
5 9737 trap(slut);
5 9738 raf:= 0;
5 9739 write(zud,"nl",1,
5 9740 <: tt: :>,tt,"nl",1,
5 9741 <: ant: :>,ant,"nl",1,
5 9742 <: ventetid: :>,ventetid,"nl",1,
5 9743 <: opref: :>,opref,"nl",1,
5 9744 <: gemt-op: :>,gemt_op,"nl",1,
5 9745 <: tab: :>,tab,"nl",1,
5 9746 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9747 <::>);
5 9748 write(zud,"nl",1,<:ia: :>);
5 9749 skriv_hele(zud,ia.raf,256,2);
5 9750 skriv_coru(zud,coru_no(299));
5 9751 slut:
5 9752 end;
4 9753 end skriv_talevejsswitch;
3 9754 \f
3 9754 trap(tvswitch_trap);
3 9755 stackclaim(400);
3 9756 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9757
3 9757 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9758 skriv_talevejsswitch(out,0);
3 9759 <*-2*>
3 9760
3 9760 ventetid:= -1; ant:= 0; tt:= ' ';
3 9761 repeat
3 9762 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9763 if opref > 0 then
3 9764 begin
4 9765 if d.opref.opkode extract 12 = 0 then
4 9766 begin <*input fra talevejsswitchen *>
5 9767 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9768 tt:= d.opref.resultat shift (-12) extract 12;
5 9769 ant:= d.opref.resultat extract 12;
5 9770 tofrom(ia,d.opref.data,ant*2);
5 9771 signalch(d.opref.retur,opref,d.opref.optype);
5 9772
5 9772 if tt<>'+' and tt<>'-' then
5 9773 begin
6 9774 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9775 setposition(z_tv_out,0,0);
6 9776 <*+2*> if testbit15 and overvåget then
6 9777 disable begin
7 9778 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9779 outchar(zrl,'nl');
7 9780 end;
6 9781 <*-2*>
6 9782 end;
5 9783 if (tt='+' or tt='-') and gemt_op<>0 then
5 9784 begin
6 9785 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9786 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9787 gemt_op:= 0;
6 9788 ventetid:= -1;
6 9789 end
5 9790 else
5 9791 if tt='R' then
5 9792 begin
6 9793 for i:= 1 step 2 until ant do
6 9794 begin
7 9795 if ia(i) <= max_antal_taleveje and
7 9796 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9797 then
7 9798 begin
8 9799 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9800 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9801 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9802 op_talevej(tv_operatør(ia(i))):= 0;
8 9803 tv_operatør(ia(i)):= ia(i+1)-16;
8 9804 op_talevej(ia(i+1)-16):= ia(i);
8 9805 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9806 end
7 9807 else
7 9808 if ia(i+1) <= max_antal_taleveje and
7 9809 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9810 then
7 9811 begin
8 9812 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9813 tv_operatør(op_talevej(ia(i))):= 0;
8 9814 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9815 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9816 tv_operatør(ia(i+1)):= ia(i)-16;
8 9817 op_talevej(ia(i)-16):= ia(i+1);
8 9818 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9819 end;
7 9820 end;
6 9821 signal_bin(bs_mobil_opkald);
6 9822 <*+2*> if testbit15 and testbit16 and overvåget then
6 9823 disable begin
7 9824 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9825 end;
6 9826 <*-2*>
6 9827 end <* tt='R' and ant>0 *>
5 9828 else
5 9829 if tt='Y' then
5 9830 begin
6 9831 if ia(1) <= max_antal_taleveje and
6 9832 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9833 then
6 9834 begin
7 9835 if tv_operatør(ia(1))=ia(2)-16 and
7 9836 op_talevej(ia(2)-16)=ia(1)
7 9837 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9838 end
6 9839 else
6 9840 if ia(2) <= max_antal_taleveje and
6 9841 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9842 then
6 9843 begin
7 9844 if tv_operatør(ia(2))=ia(1)-16 and
7 9845 op_talevej(ia(1)-16)=ia(2)
7 9846 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9847 end;
6 9848 end
5 9849 else
5 9850 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9851 begin
6 9852 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9853 startoperation(opref,299,cs_op_iomedd,23);
6 9854 ant:= 1;
6 9855 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9856 anbringtal(d.opref.data,ant,ia(1),2);
6 9857 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9858 begin
7 9859 hægtstring(d.opref.data,ant,<: (:>);
7 9860 if bpl_navn(ia(1)-16)=long<::> then
7 9861 begin
8 9862 hægtstring(d.opref.data,ant,<:op:>);
8 9863 anbringtal(d.opref.data,ant,ia(1)-16,
8 9864 if ia(1)-16 > 9 then 2 else 1);
8 9865 end
7 9866 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9867 skrivtegn(d.opref.data,ant,')');
7 9868 end;
6 9869 hægtstring(d.opref.data,ant,
6 9870 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9871 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9872 if tt='P' then <: Tilgængelig:> else
6 9873 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9874 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9875 signalch(cs_io,opref,gen_optype);
6 9876 end
5 9877 else
5 9878 if tt='Z' then
5 9879 begin
6 9880 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9881 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9882 end
5 9883 else
5 9884 begin
6 9885 <* ikke implementeret *>
6 9886 end;
5 9887 end
4 9888 else
4 9889 if d.opref.opkode extract 12 = 44 then
4 9890 begin
5 9891 tt:= d.opref.opkode shift (-12);
5 9892 ok:= true;
5 9893 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9894 begin
6 9895 <*+2*> if testbit15 and overvåget then
6 9896 disable begin
7 9897 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9898 outchar(zrl,'nl');
7 9899 end;
6 9900 <*-2*>
6 9901 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9902 setposition(z_tv_out,0,0);
6 9903 end
5 9904 else
5 9905 if tt='B' or tt='C' or tt='F' then
5 9906 begin
6 9907 <*+2*> if testbit15 and overvåget then
6 9908 disable begin
7 9909 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9910 " ",1,<<d>,d.opref.data(1));
7 9911 outchar(zrl,'nl');
7 9912 end;
6 9913 <*-2*>
6 9914 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9915 d.opref.data(1),"cr",1);
6 9916 setposition(z_tv_out,0,0);
6 9917 end
5 9918 else
5 9919 if tt='A' or tt='D' or tt='T' then
5 9920 begin
6 9921 <*+2*> if testbit15 and overvåget then
6 9922 disable begin
7 9923 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9924 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9925 outchar(zrl,'nl');
7 9926 end;
6 9927 <*-2*>
6 9928 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9929 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9930 setposition(z_tv_out,0,0);
6 9931 end
5 9932 else
5 9933 ok:= false;
5 9934 if ok then
5 9935 begin
6 9936 gemt_op:= opref;
6 9937 ventetid:= 2;
6 9938 end
5 9939 else
5 9940 begin
6 9941 d.opref.resultat:= 4;
6 9942 signalch(d.opref.retur,opref,d.opref.optype);
6 9943 end;
5 9944 end;
4 9945 end
3 9946 else
3 9947 if gemt_op<>0 then
3 9948 begin <*timeout*>
4 9949 d.gemt_op.resultat:= 0;
4 9950 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9951 gemt_op:= 0;
4 9952 ventetid:= -1;
4 9953 <*+2*> if testbit15 and overvåget then
4 9954 disable begin
5 9955 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9956 outchar(zrl,'nl');
5 9957 end;
4 9958 <*-2*>
4 9959 end;
3 9960 until false;
3 9961 tvswitch_trap:
3 9962 disable skriv_talevejsswitch(zbillede,1);
3 9963 end talevejsswitch;
2 9964
2 9964 \f
2 9964 message garage_erklæringer side 1 - 810415/hko;
2 9965
2 9965 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 9966
2 9966 procedure gar_fejl(z,s,b);
2 9967 integer s,b;
2 9968 zone z;
2 9969 begin
3 9970 disable begin
4 9971 integer array iz(1:20);
4 9972 integer i,j,k;
4 9973 integer array field iaf;
4 9974 real array field raf;
4 9975
4 9975 getzone6(z,iz);
4 9976 iaf:=raf:=2;
4 9977 getnumber(iz.raf,7,j);
4 9978
4 9978 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 9979 k:=1;
4 9980
4 9980 j:= terminal_tab.iaf.terminal_tilstand;
4 9981 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 9982 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 9983 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 9984 if s <> (1 shift 21 +2) then
4 9985 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 9986 + terminal_tab.iaf.terminal_tilstand extract 21;
4 9987 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 9988 begin
5 9989 z(1):=real <:<'?'><'em'>:>;
5 9990 b:=2;
5 9991 end;
4 9992 end; <*disable*>
3 9993 end gar_fejl;
2 9994
2 9994 integer cs_gar;
2 9995 integer array cs_garage(1:max_antal_garageterminaler);
2 9996 \f
2 9996 message procedure h_garage side 1 - 810520/hko;
2 9997
2 9997 <* hovedmodulkorutine for garageterminaler *>
2 9998 procedure h_garage;
2 9999 begin
3 10000 integer array field op_ref;
3 10001 integer k,dest_sem;
3 10002 procedure skriv_hgarage(zud,omfang);
3 10003 value omfang;
3 10004 zone zud;
3 10005 integer omfang;
3 10006 begin integer i;
4 10007
4 10007 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 10008 write(zud,"sp",26-i);
4 10009 if omfang>0 then
4 10010 disable begin
5 10011 integer x;
5 10012 trap(slut);
5 10013 write(zud,"nl",1,
5 10014 <: op_ref: :>,op_ref,"nl",1,
5 10015 <: k: :>,k,"nl",1,
5 10016 <: dest_sem: :>,dest_sem,"nl",1,
5 10017 <::>);
5 10018 skriv_coru(zud,coru_no(300));
5 10019 slut:
5 10020 end;
4 10021 end skriv_hgarage;
3 10022
3 10022 trap(hgar_trap);
3 10023 stack_claim(if cm_test then 198 else 146);
3 10024
3 10024 <*+2*>
3 10025 if testbit16 and overvåget or testbit28 then
3 10026 skriv_hgarage(out,0);
3 10027 <*-2*>
3 10028 \f
3 10028 message procedure h_garage side 2 - 811105/hko;
3 10029
3 10029 repeat
3 10030 wait_ch(cs_gar,op_ref,true,-1);
3 10031 <*+4*>
3 10032 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 10033 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 10034 <*-4*>
3 10035
3 10035 k:=d.op_ref.opkode extract 12;
3 10036 dest_sem:=
3 10037 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 10038 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 10039 else -1;
3 10040 <*+4*>
3 10041 if dest_sem=-1 then
3 10042 begin
4 10043 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 10044 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10045 end
3 10046 else
3 10047 <*-4*>
3 10048 if k=7<*inkluder*> then
3 10049 begin
4 10050 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 10051 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 10052 begin
5 10053 d.op_ref.resultat:=3;
5 10054 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 10055 dest_sem:=-2;
5 10056 end;
4 10057 end
3 10058 else
3 10059 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 10060 begin
4 10061 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 10062 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 10063 +terminal_tab.iaf.terminal_tilstand extract 21;
4 10064 end;
3 10065 if dest_sem>0 then
3 10066 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 10067 until false;
3 10068
3 10068 hgar_trap:
3 10069 disable skriv_hgarage(zbillede,1);
3 10070 end h_garage;
2 10071 \f
2 10071 message procedure garage side 1 - 830310/cl;
2 10072
2 10072 procedure garage(nr);
2 10073 value nr;
2 10074 integer nr;
2 10075 begin
3 10076 integer array field op_ref,ref;
3 10077 integer i,kode,aktion,status,opgave,retur_sem,
3 10078 pos,indeks,sep,sluttegn,vogn,ll;
3 10079
3 10079 procedure skriv_garage(zud,omfang);
3 10080 value omfang;
3 10081 zone zud;
3 10082 integer omfang;
3 10083 begin integer i;
4 10084
4 10084 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 10085 write(zud,"sp",26-i);
4 10086 if omfang > 0 then
4 10087 disable begin integer x;
5 10088 trap(slut);
5 10089 write(zud,"nl",1,
5 10090 <: op-ref: :>,op_ref,"nl",1,
5 10091 <: kode: :>,kode,"nl",1,
5 10092 <: ref: :>,ref,"nl",1,
5 10093 <: i: :>,i,"nl",1,
5 10094 <: aktion: :>,aktion,"nl",1,
5 10095 <: retur-sem: :>,retur_sem,"nl",1,
5 10096 <: vogn: :>,vogn,"nl",1,
5 10097 <: ll: :>,ll,"nl",1,
5 10098 <: status: :>,status,"nl",1,
5 10099 <: opgave: :>,opgave,"nl",1,
5 10100 <: pos: :>,pos,"nl",1,
5 10101 <: indeks: :>,indeks,"nl",1,
5 10102 <: sep: :>,sep,"nl",1,
5 10103 <: sluttegn: :>,sluttegn,"nl",1,
5 10104 <::>);
5 10105 skriv_coru(zud,coru_no(300+nr));
5 10106 slut:
5 10107 end;
4 10108 end skriv_garage;
3 10109 \f
3 10109 message procedure garage side 2 - 830310/hko;
3 10110
3 10110 trap(gar_trap);
3 10111 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 10112
3 10112 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 10113
3 10113 <*+2*>
3 10114 if testbit16 and overvåget or testbit28 then
3 10115 skriv_garage(out,0);
3 10116 <*-2*>
3 10117
3 10117 <* attention simulering
3 10118 *>
3 10119 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 10120 begin
4 10121 wait_ch(cs_att_pulje,op_ref,true,-1);
4 10122 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 10123 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 10124 end;
3 10125 <*
3 10126 *>
3 10127 \f
3 10127 message procedure garage side 3 - 830310/hko;
3 10128
3 10128 repeat
3 10129
3 10129 <*V*> wait_ch(cs_garage(nr),
3 10130 op_ref,
3 10131 true,
3 10132 -1<*timeout*>);
3 10133 <*+2*>
3 10134 if testbit17 and overvåget then
3 10135 disable begin
4 10136 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 10137 <: til garage :>,nr);
4 10138 skriv_op(out,op_ref);
4 10139 end;
3 10140 <*-2*>
3 10141
3 10141 kode:= d.op_ref.op_kode;
3 10142 retur_sem:= d.op_ref.retur;
3 10143 i:= terminal_tab.ref.terminal_tilstand;
3 10144 status:= i shift(-21);
3 10145 opgave:=
3 10146 if kode=0 then 1 <* indlæs kommando *> else
3 10147 if kode=7 then 2 <* inkluder *> else
3 10148 if kode=8 then 3 <* ekskluder *> else
3 10149 0; <* afvises *>
3 10150
3 10150 aktion:= case status +1 of(
3 10151 <* status *> <* opgave: 0 1 2 3 *>
3 10152 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 10153 <* 1 - *>(-1),<* ulovlig tilstand *>
3 10154 <* 2 - *>(-1),<* ulovlig tilstand *>
3 10155 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 10156 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 10157 <* 5 - *>(-1),<* ulovlig tilstand *>
3 10158 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 10159 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 10160 -1);
3 10161 \f
3 10161 message procedure garage side 4 - 810424/hko;
3 10162
3 10162 case aktion+6 of
3 10163 begin
4 10164 begin
5 10165 <*-5: terminal optaget *>
5 10166
5 10166 d.op_ref.resultat:= 16;
5 10167 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10168 end;
4 10169
4 10169 begin
5 10170 <*-4: operation uden virkning *>
5 10171
5 10171 afslut_operation(op_ref,-1);
5 10172 end;
4 10173
4 10173 begin
5 10174 <*-3: ulovlig operationskode *>
5 10175
5 10175 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 10176 afslut_operation(op_ref,-1);
5 10177 end;
4 10178
4 10178 begin
5 10179 <*-2: ulovligt garageterminal_nr *>
5 10180
5 10180 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 10181 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10182 end;
4 10183
4 10183 begin
5 10184 <*-1: ulovlig operatørtilstand *>
5 10185
5 10185 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 10186 afslut_operation(op_ref,-1);
5 10187 end;
4 10188
4 10188 begin
5 10189 <* 0: ikke implementeret *>
5 10190
5 10190 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 10191 afslut_operation(op_ref,-1);
5 10192 end;
4 10193
4 10193 begin
5 10194 \f
5 10194 message procedure garage side 5 - 851001/cl;
5 10195
5 10195 <* 1: indlæs kommando *>
5 10196
5 10196
5 10196 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 10197
5 10197 if d.op_ref.resultat > 3 then
5 10198 begin
6 10199 <*V*> setposition(z_gar(nr),0,0);
6 10200 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 10201 skriv_kvittering(z_gar(nr),op_ref,pos,
6 10202 d.op_ref.resultat);
6 10203 end
5 10204 else if d.op_ref.resultat>0 then
5 10205 begin <*godkendt*>
6 10206 kode:=d.op_ref.opkode;
6 10207 i:= kode extract 12;
6 10208 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 10209 else if kode=9 or kode=10 then 2
6 10210 else 0;
6 10211 if j > 0 then
6 10212 begin
7 10213 case j of
7 10214 begin
8 10215 begin
9 10216 \f
9 10216 message procedure garage side 6 - 851001/cl;
9 10217
9 10217 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 10218 integer vogn,ll;
9 10219 integer array field vtop;
9 10220
9 10220 vogn:=ia(1);
9 10221 ll:=ia(2);
9 10222 <*V*> wait_ch(cs_vt_adgang,
9 10223 vt_op,
9 10224 gen_optype,
9 10225 -1<*timeout sek*>);
9 10226 start_operation(vtop,300+nr,cs_garage(nr),
9 10227 kode);
9 10228 d.vt_op.data(1):=vogn;
9 10229 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 10230 indeks:= vt_op;
9 10231 signal_ch(cs_vt,
9 10232 vt_op,
9 10233 gen_optype or gar_optype);
9 10234
9 10234 <*V*> wait_ch(cs_garage(nr),
9 10235 vt_op,
9 10236 gar_optype,
9 10237 -1<*timeout sek*>);
9 10238 <*+2*> if testbit18 and overvåget then
9 10239 disable begin
10 10240 write(out,"nl",1,<:garage :>,<<d>,nr,
10 10241 <:: operation retur fra vt:>);
10 10242 skriv_op(out,vt_op);
10 10243 end;
9 10244 <*-2*>
9 10245 <*+4*> if vt_op<>indeks then
9 10246 fejl_reaktion(11<*fremmede op*>,op_ref,
9 10247 <:garage-kommando:>,0);
9 10248 <*-4*>
9 10249 <*V*> setposition(z_gar(nr),0,0);
9 10250 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 10251 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 10252 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 10253 else vt_op,-1,d.vt_op.resultat);
9 10254 d.vt_op.optype:=gen_optype or vtoptype;
9 10255 disable afslut_operation(vt_op,cs_vt_adgang);
9 10256 end;
8 10257
8 10257 begin
9 10258 \f
9 10258 message procedure garage side 6a - 830310/cl;
9 10259
9 10259 <* 2 vogntabel,linienr/-,busnr *>
9 10260
9 10260 d.op_ref.retur:= cs_garage(nr);
9 10261 tofrom(d.op_ref.data,ia,10);
9 10262 indeks:= op_ref;
9 10263 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 10264 wait_ch(cs_garage(nr),
9 10265 op_ref,
9 10266 gar_optype,
9 10267 -1<*timeout*>);
9 10268 <*+2*> if testbit18 and overvåget then
9 10269 disable begin
10 10270 write(out,"nl",1,<:garage operation retur fra vt:>);
10 10271 skriv_op(out,op_ref);
10 10272 end;
9 10273 <*-2*>
9 10274 <*+4*>
9 10275 if indeks <> op_ref then
9 10276 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 10277 <*-4*>
9 10278 i:= d.op_ref.resultat;
9 10279 if i = 0 or i > 3 then
9 10280 begin
10 10281 <*V*> setposition(z_gar(nr),0,0);
10 10282 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 10283 end
9 10284 else
9 10285 begin
10 10286 integer antal,fil_ref;
10 10287 antal:= d.op_ref.data(6);
10 10288 fil_ref:= d.op_ref.data(7);
10 10289 <*V*> setposition(z_gar(nr),0,0);
10 10290 write(z_gar(nr),"*",24,"sp",6,
10 10291 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 10292 <*V*> setposition(z_gar(nr),0,0);
10 10293 \f
10 10293 message procedure garage side 6c - 841213/cl;
10 10294
10 10294 pos:= 1;
10 10295 while pos <= antal do
10 10296 begin
11 10297 integer bogst,løb;
11 10298
11 10298 disable i:= læs_fil(fil_ref,pos,j);
11 10299 if i <> 0 then
11 10300 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 10301 else
11 10302 begin
12 10303 vogn:= fil(j,1) shift (-24) extract 24;
12 10304 løb:= fil(j,1) extract 24;
12 10305 if d.op_ref.opkode=9 then
12 10306 begin i:=vogn; vogn:=løb; løb:=i; end;
12 10307 ll:= løb shift (-12) extract 10;
12 10308 bogst:= løb shift (-7) extract 5;
12 10309 if bogst > 0 then bogst:= bogst +'A'-1;
12 10310 løb:= løb extract 7;
12 10311 vogn:= vogn extract 14;
12 10312 i:= d.op_ref.opkode-8;
12 10313 for i:= i,i+1 do
12 10314 begin
13 10315 j:= (i+1) extract 1;
13 10316 case j +1 of
13 10317 begin
14 10318 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 10319 false add bogst,1,"/",1,<<d__>,løb);
14 10320 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 10321 end;
13 10322 end;
12 10323 if pos mod 5 = 0 then
12 10324 begin
13 10325 write(z_gar(nr),"nl",1);
13 10326 <*V*> setposition(z_gar(nr),0,0);
13 10327 end
12 10328 else write(z_gar(nr),"sp",3);
12 10329 end;
11 10330 pos:=pos+1;
11 10331 end;
10 10332 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 10333 \f
10 10333 message procedure garage side 6d- 830310/cl;
10 10334
10 10334 d.opref.opkode:=104; <*slet-fil*>
10 10335 d.op_ref.data(4):=filref;
10 10336 indeks:=op_ref;
10 10337 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 10338 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 10339
10 10339 <*+2*> if testbit18 and overvåget then
10 10340 disable begin
11 10341 write(out,"nl",1,<:garage, slet-fil retur:>);
11 10342 skriv_op(out,op_ref);
11 10343 end;
10 10344 <*-2*>
10 10345
10 10345 <*+4*> if op_ref<>indeks then
10 10346 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10347 <*-4*>
10 10348 if d.op_ref.data(9)<>0 then
10 10349 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10350 <:garage, slet_fil:>,1);
10 10351 end;
9 10352 \f
9 10352 message procedure garage side 7 -810424/hko;
9 10353
9 10353 end;
8 10354
8 10354 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10355 <*-4*>
8 10356 end;<*case j *>
7 10357 end <* j > 0 *>
6 10358 else
6 10359 begin
7 10360 <*V*> setposition(z_gar(nr),0,0);
7 10361 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10362 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10363 4 <*kommando ukendt *>);
7 10364 end;
6 10365 end;<* godkendt *>
5 10366
5 10366 <*V*> setposition(z_gar(nr),0,0);
5 10367
5 10367 d.op_ref.opkode:=0; <*telex*>
5 10368
5 10368 disable afslut_operation(op_ref,cs_gar);
5 10369 end; <* indlæs kommando *>
4 10370
4 10370 begin
5 10371 \f
5 10371 message procedure garage side 8 - 841213/cl;
5 10372
5 10372 <* 2: inkluder *>
5 10373
5 10373 d.op_ref.resultat:=3;
5 10374 afslut_operation(op_ref,-1);
5 10375 monitor(8)reserve:(z_gar(nr),0,ia);
5 10376 terminal_tab.ref.terminal_tilstand:=
5 10377 terminal_tab.ref.terminal_tilstand extract 21;
5 10378 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10379 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10380 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10381 end;
4 10382
4 10382 begin
5 10383
5 10383 <* 3: ekskluder *>
5 10384 d.op_ref.resultat:= 3;
5 10385 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10386 terminal_tab.ref.terminal_tilstand extract 21;
5 10387 monitor(10)release:(z_gar(nr),0,ia);
5 10388 afslut_operation(op_ref,-1);
5 10389
5 10389 end;
4 10390
4 10390 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10391 <*-4*>
4 10392 end; <* case aktion+6 *>
3 10393
3 10393 until false;
3 10394 gar_trap:
3 10395 skriv_garage(zbillede,1);
3 10396 end garage;
2 10397
2 10397 \f
2 10397 message procedure radio_erklæringer side 1 - 820304/hko;
2 10398
2 10398 zone z_fr_in(14,1,rad_in_fejl),
2 10399 z_rf_in(14,1,rad_in_fejl),
2 10400 z_fr_out(14,1,rad_out_fejl),
2 10401 z_rf_out(14,1,rad_out_fejl);
2 10402
2 10402 integer array
2 10403 radiofejl,
2 10404 ss_samtale_nedlagt,
2 10405 ss_radio_aktiver(1:max_antal_kanaler),
2 10406 bs_talevej_udkoblet,
2 10407 cs_radio(1:max_antal_taleveje),
2 10408 radio_linietabel(1:max_linienr//3+1),
2 10409 radio_områdetabel(0:max_antal_områder),
2 10410 opkaldskø(opkaldskø_postlængde//2+1:
2 10411 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10412 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10413 hookoff_maske(1:(tv_maske_lgd//2)),
2 10414 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10415
2 10415 integer field
2 10416 kanal_tilstand,
2 10417 kanal_id1,
2 10418 kanal_id2,
2 10419 kanal_spec,
2 10420 kanal_alt_id1,
2 10421 kanal_alt_id2;
2 10422 integer array field
2 10423 kanal_mon_maske,
2 10424 kanal_alarm,
2 10425 opkald_meldt;
2 10426
2 10426 integer
2 10427 cs_rad,
2 10428 cs_radio_medd,
2 10429 cs_radio_adm,
2 10430 cs_radio_ind,
2 10431 cs_radio_ud,
2 10432 cs_radio_pulje,
2 10433 cs_radio_kø,
2 10434 bs_mobil_opkald,
2 10435 bs_opkaldskø_adgang,
2 10436 opkaldskø_ledige,
2 10437 nødopkald_brugt,
2 10438 første_frie_opkald,
2 10439 første_opkald,
2 10440 sidste_opkald,
2 10441 første_nødopkald,
2 10442 sidste_nødopkald,
2 10443 optaget_flag;
2 10444
2 10444 boolean
2 10445 mobil_opkald_aktiveret;
2 10446 \f
2 10446 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10447
2 10447 integer
2 10448 procedure læs_hex_ciffer(tabel,linie,op);
2 10449 value linie;
2 10450 integer array tabel;
2 10451 integer linie,op;
2 10452 begin
3 10453 integer i,j;
3 10454
3 10454 i:=(if linie>=0 then linie+6 else linie)//6;
3 10455 j:=((i-1)*6-linie)*4;
3 10456 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10457 end læs_hex_ciffer;
2 10458
2 10458 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10459
2 10459 integer
2 10460 procedure sæt_hex_ciffer(tabel,linie,op);
2 10461 value linie;
2 10462 integer array tabel;
2 10463 integer linie,op;
2 10464 begin
3 10465 integer i,j;
3 10466
3 10466 i:=(if linie>=0 then linie+6 else linie)//6;
3 10467 j:=(linie-(i-1)*6)*4;
3 10468 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10469 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10470 shift j add (tabel(i) extract j);
3 10471 end sæt_hex_ciffer;
2 10472
2 10472 message procedure hex_to_dec side 1 - 900108/cl;
2 10473
2 10473 integer procedure hex_to_dec(hex);
2 10474 value hex;
2 10475 integer hex;
2 10476 begin
3 10477 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10478 else (hex-'0');
3 10479 end;
2 10480
2 10480 message procedure dec_to_hex side 1 - 900108/cl;
2 10481
2 10481 integer procedure dec_to_hex(dec);
2 10482 value dec;
2 10483 integer dec;
2 10484 begin
3 10485 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10486 else ('A'+dec-10);
3 10487 end;
2 10488
2 10488 message procedure rad_out_fejl side 1 - 820304/hko;
2 10489
2 10489 procedure rad_out_fejl(z,s,b);
2 10490 value s;
2 10491 zone z;
2 10492 integer s,b;
2 10493 begin
3 10494 integer array field iaf;
3 10495 integer pos,tegn,max,i;
3 10496 integer array ia(1:20);
3 10497 long array field laf;
3 10498
3 10498 disable begin
4 10499 laf:= iaf:= 2;
4 10500 tegn:= 1;
4 10501 getzone6(z,ia);
4 10502 max:= ia(16)//2*3;
4 10503 if s = 1 shift 21 + 2 then
4 10504 begin
5 10505 z(1):= real<:<'em'>:>;
5 10506 b:= 2;
5 10507 end
4 10508 else
4 10509 begin
5 10510 pos:= 0;
5 10511 for i:= 1 step 1 until max_antal_kanaler do
5 10512 begin
6 10513 iaf:= (i-1)*kanalbeskr_længde;
6 10514 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10515 if pos>0 then
6 10516 begin
7 10517 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10518 signalbin(bs_mobilopkald);
7 10519 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10520 1 shift 12<*binært*> +1<*fortsæt*>);
7 10521 end;
6 10522 end;
5 10523 end;
4 10524 end;
3 10525 end;
2 10526 \f
2 10526 message procedure rad_in_fejl side 1 - 810601/hko;
2 10527
2 10527 procedure rad_in_fejl(z,s,b);
2 10528 value s;
2 10529 zone z;
2 10530 integer s,b;
2 10531 begin
3 10532 integer array field iaf;
3 10533 integer pos,tegn,max,i;
3 10534 integer array ia(1:20);
3 10535 long array field laf;
3 10536
3 10536 disable begin
4 10537 laf:= iaf:= 2;
4 10538 i:= 1;
4 10539 getzone6(z,ia);
4 10540 max:= ia(16)//2*3;
4 10541 if s shift (-21) extract 1 = 0
4 10542 and s shift(-19) extract 1 = 0 then
4 10543 begin
5 10544 if b = 0 then
5 10545 begin
6 10546 z(1):= real<:!:>;
6 10547 b:= 2;
6 10548 end;
5 10549 end;
4 10550 \f
4 10550 message procedure rad_in_fejl side 2 - 820304/hko;
4 10551
4 10551 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10552 begin
5 10553 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10554 1 shift 12<*binær*> +1<*fortsæt*>);
5 10555 end
4 10556 else
4 10557 if s shift (-19) extract 1 = 1 then
4 10558 begin
5 10559 z(1):= real<:!<'nl'>:>;
5 10560 b:= 2;
5 10561 end
4 10562 else
4 10563 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10564 begin
5 10565 <*
5 10566 if b = 0 then
5 10567 begin
5 10568 *>
5 10569 z(1):= real <:<'em'>:>;
5 10570 b:= 2;
5 10571 <*
5 10572 end
5 10573 else
5 10574 begin
5 10575 tegn:= -1;
5 10576 iaf:= 0;
5 10577 pos:= b//2*3-2;
5 10578 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10579 skriv_tegn(z.iaf,pos,'?');
5 10580 if pos<=max then
5 10581 afslut_text(z.iaf,pos);
5 10582 b:= (pos-1)//3*2;
5 10583 end;
5 10584 *>
5 10585 end;<* s=1 shift 21+2 *>
4 10586 end;
3 10587 if testbit22 and
3 10588 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10589 then
3 10590 delay(60);
3 10591 end rad_in_fejl;
2 10592 \f
2 10592 message procedure afvent_radioinput side 1 - 880901/cl;
2 10593
2 10593 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10594 value rf;
2 10595 zone z_in;
2 10596 integer array tlgr;
2 10597 boolean rf;
2 10598 begin
3 10599 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10600 long array field laf;
3 10601
3 10601 laf:= 0;
3 10602 pos:= 1;
3 10603 repeat
3 10604 i:=readchar(z_in,tegn);
3 10605 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10606 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10607 p:=pos;
3 10608 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10609 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10610 (rf and testbit39)) then
3 10611 disable begin
4 10612 write(zrl,<<zd dd dd.dd >,now,
4 10613 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10614 if tegn='em' then <:*timeout*:> else
4 10615 if pos>=80 then <:*for langt*:> else <::>);
4 10616 outchar(zrl,'nl');
4 10617 end;
3 10618 <*-2*>
3 10619 ac:= -1;
3 10620 if pos >= 80 then
3 10621 begin <* telegram for langt *>
4 10622 repeat readchar(z_in,tegn)
4 10623 until tegn='nl' or tegn='em';
4 10624 end
3 10625 else
3 10626 if pos>1 and tegn='nl' then
3 10627 begin
4 10628 lgd:= 1;
4 10629 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10630 lgd:= lgd-2;
4 10631 if lgd >= 5 then
4 10632 begin
5 10633 lgd:= lgd-2; <* se bort fra checksum *>
5 10634 i:= lgd + 1;
5 10635 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10636 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10637 i:= lgd + 1;
5 10638 skrivtegn(tlgr,i,0);
5 10639 skrivtegn(tlgr,i,0);
5 10640 i:= 1; sum:= 0;
5 10641 while i <= lgd do
5 10642 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10643 if csum >= 0 and csum <> sum then
5 10644 begin
6 10645 <*+2*> if overvåget and (testbit36 or
6 10646 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10647 disable begin
7 10648 write(zrl,<<zd dd dd.dd >,now,
7 10649 (if rf then <:rf:> else <:fr:>),
7 10650 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10651 end;
6 10652 <*-2*>
6 10653 ac:= 6 <* checksumfejl *>
6 10654 end
5 10655 else
5 10656 ac:= 0;
5 10657 end
4 10658 else ac:= 6; <* for kort telegram - retransmitter *>
4 10659 end;
3 10660 afvent_radioinput:= ac;
3 10661 end;
2 10662 \f
2 10662 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10663
2 10663 procedure skriv_kanal_tab(z);
2 10664 zone z;
2 10665 begin
3 10666 integer array field ref;
3 10667 integer i,j,t,op,id1,id2;
3 10668
3 10668 write(z,"ff",1,"nl",1,<:
3 10669 ******** kanal-beskrivelser *******
3 10670
3 10670 a k l p m b n
3 10671 l a y a o s ø
3 10672 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10673 <*
3 10674 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10675 *>
3 10676 "nl",1);
3 10677 for i:=1 step 1 until max_antal_kanaler do
3 10678 begin
4 10679 ref:=(i-1)*kanal_beskr_længde;
4 10680 t:=kanal_tab.ref.kanal_tilstand;
4 10681 id1:=kanal_tab.ref.kanal_id1;
4 10682 id2:=kanal_tab.ref.kanal_id2;
4 10683 write(z,"nl",1,"sp",4,
4 10684 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10685 for j:=11 step -1 until 2 do
4 10686 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10687 write(z,case t extract 2 +1 of
4 10688 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10689 "sp",1);
4 10690 skriv_id(z,id1,9);
4 10691 skriv_id(z,id2,9);
4 10692 t:=kanal_tab.ref.kanal_spec;
4 10693 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10694 write(z,"nl",1,"sp",14,<:mon: :>);
4 10695 for j:= max_antal_taleveje step -1 until 1 do
4 10696 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10697 else "."),1);
4 10698 write(z,"sp",25-max_antal_taleveje);
4 10699 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10700 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10701 end;
3 10702 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10703 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10704 write(z,"nl",2);
3 10705 end skriv_kanal_tab;
2 10706 \f
2 10706 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10707
2 10707 procedure skriv_opkaldskø(z);
2 10708 zone z;
2 10709 begin
3 10710 integer i,bogst,løb,j;
3 10711 integer array field ref;
3 10712 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10713 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10714 <: sig omr :>,"nl",1);
3 10715 for i:= 1 step 1 until max_antal_mobilopkald do
3 10716 begin
4 10717 ref:= i*opkaldskø_postlængde;
4 10718 j:= opkaldskø.ref(1);
4 10719 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10720 j:= opkaldskø.ref(2);
4 10721 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10722 skriv_id(z,j extract 23,9);
4 10723 j:= opkaldskø.ref(3);
4 10724 skriv_id(z,j,7);
4 10725 j:= opkaldskø.ref(4);
4 10726 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10727 << zd>,j extract 8);
4 10728 j:= j shift (-8) extract 4;
4 10729 if j = 1 or j = 2 then
4 10730 write(z,if j=1 then <: normal:> else <: nød :>)
4 10731 else write(z,<<dddd>,j,"sp",3);
4 10732 j:= opkaldskø.ref(5);
4 10733 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10734 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10735 string område_navn(j extract 8) else <:---:>);
4 10736 outchar(z,'nl');
4 10737 end;
3 10738
3 10738 write(z,"nl",1,<<z>,
3 10739 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10740 <:første_opkald=:>,første_opkald,"nl",1,
3 10741 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10742 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10743 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10744 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10745 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10746 "nl",1,<:opkaldsflag::>,"nl",1);
3 10747 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10748 write(z,"nl",2);
3 10749 end skriv_opkaldskø;
2 10750 \f
2 10750 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10751
2 10751 procedure skriv_radio_linie_tabel(z);
2 10752 zone z;
2 10753 begin
3 10754 integer i,j,k;
3 10755
3 10755 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10756 k:= 0;
3 10757 for i:= 1 step 1 until max_linienr do
3 10758 begin
4 10759 læstegn(radio_linietabel,i+1,j);
4 10760 if j > 0 then
4 10761 begin
5 10762 k:= k +1;
5 10763 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10764 "nl",if k mod 5=0 then 1 else 0);
5 10765 end;
4 10766 end;
3 10767 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10768 end skriv_radio_linietabel;
2 10769
2 10769 procedure skriv_radio_områdetabel(z);
2 10770 zone z;
2 10771 begin
3 10772 integer i;
3 10773
3 10773 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10774 for i:= 1 step 1 until max_antal_områder do
3 10775 begin
4 10776 laf:= (i-1)*4;
4 10777 if radio_områdetabel(i)<>0 then
4 10778 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10779 radio_områdetabel(i),"nl",1);
4 10780 end;
3 10781 end skriv_radio_områdetabel;
2 10782 \f
2 10782 message procedure h_radio side 1 - 810520/hko;
2 10783
2 10783 <* hovedmodulkorutine for radiokanaler *>
2 10784 procedure h_radio;
2 10785 begin
3 10786 integer array field op_ref;
3 10787 integer k,dest_sem;
3 10788 procedure skriv_hradio(z,omfang);
3 10789 value omfang;
3 10790 zone z;
3 10791 integer omfang;
3 10792 begin integer i;
4 10793 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10794 write(z,"sp",26-i);
4 10795 if omfang >0 then
4 10796 disable begin integer x;
5 10797 trap(slut);
5 10798 write(z,"nl",1,
5 10799 <: op_ref: :>,op_ref,"nl",1,
5 10800 <: k: :>,k,"nl",1,
5 10801 <: dest_sem: :>,dest_sem,"nl",1,
5 10802 <::>);
5 10803 skriv_coru(z,coru_no(400));
5 10804 slut:
5 10805 end;
4 10806 end skriv_hradio;
3 10807
3 10807 trap(hrad_trap);
3 10808 stack_claim(if cm_test then 198 else 146);
3 10809
3 10809 <*+2*> if testbit32 and overvåget or testbit28 then
3 10810 skriv_hradio(out,0);
3 10811 <*-2*>
3 10812 \f
3 10812 message procedure h_radio side 2 - 820304/hko;
3 10813
3 10813 repeat
3 10814 wait_ch(cs_rad,op_ref,true,-1);
3 10815 <*+2*>if testbit33 and overvåget then
3 10816 disable begin
4 10817 skriv_h_radio(out,0);
4 10818 write(out,<: operation modtaget:>);
4 10819 skriv_op(out,op_ref);
4 10820 end;
3 10821 <*-2*>
3 10822 <*+4*>
3 10823 if (d.op_ref.optype and
3 10824 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10825 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10826 <*-4*>
3 10827
3 10827 k:=d.op_ref.op_kode extract 12;
3 10828 dest_sem:=
3 10829 if k > 0 and k < 7
3 10830 or k=11 or k=12 or k=19
3 10831 or (72<=k and k<=74) or k = 77
3 10832 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10833 then cs_radio_adm
3 10834 else if k=41 <* radiokommando fra operatør *>
3 10835 then cs_radio(d.opref.data(1)) else -1;
3 10836 <*+4*>
3 10837 if dest_sem<1 then
3 10838 begin
4 10839 if dest_sem<0 then
4 10840 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10841 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10842 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10843 end
3 10844 else
3 10845 <*-4*>
3 10846 begin <* operationskode ok *>
4 10847 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10848 end;
3 10849 until false;
3 10850
3 10850 hrad_trap:
3 10851 disable skriv_hradio(zbillede,1);
3 10852 end h_radio;
2 10853 \f
2 10853 message procedure radio side 1 - 820301/hko;
2 10854
2 10854 procedure radio(talevej,op);
2 10855 value talevej,op;
2 10856 integer talevej,op;
2 10857 begin
3 10858 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10859 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10860 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10861 integer array felt,værdi(1:8);
3 10862 boolean byt,nød,frigiv_samtale;
3 10863 real kl;
3 10864 real field rf;
3 10865
3 10865 procedure skriv_radio(z,omfang);
3 10866 value omfang;
3 10867 zone z;
3 10868 integer omfang;
3 10869 begin integer i1;
4 10870 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10871 write(z,"sp",26-i1);
4 10872 if omfang > 0 then
4 10873 disable begin real x;
5 10874 trap(slut);
5 10875 \f
5 10875 message procedure radio side 1a- 820301/hko;
5 10876
5 10876 write(z,"nl",1,
5 10877 <: op_ref: :>,op_ref,"nl",1,
5 10878 <: opref1: :>,opref1,"nl",1,
5 10879 <: iaf: :>,iaf,"nl",1,
5 10880 <: iaf1: :>,iaf1,"nl",1,
5 10881 <: vt-op: :>,vt_op,"nl",1,
5 10882 <: rad-op: :>,rad_op,"nl",1,
5 10883 <: rf: :>,rf,"nl",1,
5 10884 <: nr: :>,nr,"nl",1,
5 10885 <: i: :>,i,"nl",1,
5 10886 <: j: :>,j,"nl",1,
5 10887 <: k: :>,k,"nl",1,
5 10888 <: operatør: :>,operatør,"nl",1,
5 10889 <: tilst: :>,tilst,"nl",1,
5 10890 <: res: :>,res,"nl",1,
5 10891 <: opgave: :>,opgave,"nl",1,
5 10892 <: type: :>,type,"nl",1,
5 10893 <: bus: :>,bus,"nl",1,
5 10894 <: ll: :>,ll,"nl",1,
5 10895 <: ttmm: :>,ttmm,"nl",1,
5 10896 <: vogn: :>,vogn,"nl",1,
5 10897 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10898 <: vtop2: :>,vtop2,"nl",1,
5 10899 <: vtop3: :>,vtop3,"nl",1,
5 10900 <: sig: :>,sig,"nl",1,
5 10901 <: omr: :>,omr,"nl",1,
5 10902 <: garage: :>,garage,"nl",1,
5 10903 <<-dddddd'-dd>,
5 10904 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10905 <:samtaleflag: :>,"nl",1);
5 10906 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10907 skriv_coru(z,coru_no(410+talevej));
5 10908 slut:
5 10909 end;<*disable*>
4 10910 end skriv_radio;
3 10911 \f
3 10911 message procedure udtag_opkald side 1 - 820301/hko;
3 10912
3 10912 integer
3 10913 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10914 value vogn, operatør;
3 10915 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10916 begin
4 10917 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10918 integer array field vt_op,ref,næste,forrige;
4 10919 integer array field iaf1;
4 10920 boolean skal_ud;
4 10921
4 10921 boolean procedure skal_udskrives(fordelt,aktuel);
4 10922 value fordelt,aktuel;
4 10923 integer fordelt,aktuel;
4 10924 begin
5 10925 boolean skal;
5 10926 integer n;
5 10927 integer array field iaf;
5 10928
5 10928 skal:= true;
5 10929 if fordelt > 0 and fordelt<>aktuel then
5 10930 begin
6 10931 for n:= 0 step 1 until 3 do
6 10932 begin
7 10933 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10934 begin
8 10935 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10936 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10937 goto returner;
8 10938 end;
7 10939 end;
6 10940 end;
5 10941 returner:
5 10942 skal_udskrives:= skal;
5 10943 end;
4 10944
4 10944 l:= b:= tm:= t:= 0;
4 10945 garage:= sig:= 0;
4 10946 res:= -1;
4 10947 <*V*> wait(bs_opkaldskø_adgang);
4 10948 ref:= første_nødopkald;
4 10949 if ref <> 0 then
4 10950 t:= 2
4 10951 else
4 10952 begin
5 10953 ref:= første_opkald;
5 10954 t:= if ref = 0 then 0 else 1;
5 10955 end;
4 10956 if t = 0 then res:= +19 <*kø er tom*> else
4 10957 if vogn=0 and omr=0 then
4 10958 begin
5 10959 while ref <> 0 and res = -1 do
5 10960 begin
6 10961 nr:= opkaldskø.ref(4) extract 8;
6 10962 if nr>64 then
6 10963 begin
7 10964 <*opk. primærfordelt til gruppe af btj.pl.*>
7 10965 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 10966 while skal_ud and i<max_antal_operatører do
7 10967 begin
8 10968 i:=i+1;
8 10969 if læsbit_ia(bpl_def.iaf1,i) then
8 10970 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 10971 end;
7 10972 end
6 10973 else
6 10974 skal_ud:= skal_udskrives(nr,operatør);
6 10975
6 10975 if skal_ud then
6 10976 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 10977 *>
6 10978 res:= 0
6 10979 else
6 10980 begin
7 10981 ref:= opkaldskø.ref(1) extract 12;
7 10982 if ref = 0 and t = 2 then
7 10983 begin
8 10984 ref:= første_opkald;
8 10985 t:= if ref = 0 then 0 else 1;
8 10986 end else if ref = 0 then t:= 0;
7 10987 end;
6 10988 end; <*while*>
5 10989 \f
5 10989 message procedure udtag_opkald side 2 - 820304/hko;
5 10990
5 10990 if ref <> 0 then
5 10991 begin
6 10992 b:= opkaldskø.ref(2);
6 10993 <*+4*> if b < 0 then
6 10994 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 10995 <:nødopkald(besvaret/ej meldt):>,1);
6 10996 <*-4*>
6 10997 garage:=b shift(-14) extract 8;
6 10998 b:= b extract 14;
6 10999 l:= opkaldskø.ref(3);
6 11000 tm:= opkaldskø.ref(4);
6 11001 o:= tm extract 8;
6 11002 tm:= tm shift(-12);
6 11003 omr:= opkaldskø.ref(5) extract 8;
6 11004 sig:= opkaldskø.ref(5) shift (-20);
6 11005 end
5 11006 else res:=19; <* kø er tom *>
5 11007 end <*vogn=0 and omr=0 *>
4 11008 else
4 11009 begin
5 11010 <* vogn<>0 or omr<>0 *>
5 11011 i:= 0; tilst:= -1;
5 11012 if vogn shift(-22) = 1 then
5 11013 begin
6 11014 i:= find_busnr(vogn,nr,garage,tilst);
6 11015 l:= vogn;
6 11016 end
5 11017 else
5 11018 if vogn<>0 and (omr=0 or omr>2) then
5 11019 begin
6 11020 o:= 0;
6 11021 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 11022 if i=(-2) then
6 11023 begin
7 11024 o:= omr;
7 11025 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 11026 end;
6 11027 nr:= vogn extract 14;
6 11028 end
5 11029 else nr:= vogn extract 14;
5 11030 if i<0 then ref:= 0;
5 11031 while ref <> 0 and res = -1 do
5 11032 begin
6 11033 i:= opkaldskø.ref(2) extract 14;
6 11034 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 11035 if nr = i and
6 11036 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 11037 else
6 11038 begin
7 11039 ref:= opkaldskø.ref(1) extract 12;
7 11040 if ref = 0 and t = 2 then
7 11041 begin
8 11042 ref:= første_opkald;
8 11043 t:= if ref = 0 then 0 else 1;
8 11044 end else if ref = 0 then t:= 0;
7 11045 end;
6 11046 end; <*while*>
5 11047 \f
5 11047 message procedure udtag_opkald side 3 - 810603/hko;
5 11048
5 11048 if ref <> 0 then
5 11049 begin
6 11050 b:= nr;
6 11051 tm:= opkaldskø.ref(4);
6 11052 o:= tm extract 8;
6 11053 tm:= tm shift(-12);
6 11054 omr:= opkaldskø.ref(5) extract 4;
6 11055 sig:= opkaldskø.ref(5) shift (-20);
6 11056
6 11056 <*+4*> if tilst <> -1 then
6 11057 fejlreaktion(3<*prg.fejl*>,tilst,
6 11058 <:vogntabel_tilstand for vogn i kø:>,1);
6 11059 <*-4*>
6 11060 end;
5 11061 end;
4 11062
4 11062 if ref <> 0 then
4 11063 begin
5 11064 næste:= opkaldskø.ref(1);
5 11065 forrige:= næste shift(-12);
5 11066 næste:= næste extract 12;
5 11067 if forrige <> 0 then
5 11068 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 11069 + næste
5 11070 else if t = 1 then første_opkald:= næste
5 11071 else <*if t = 2 then*> første_nødopkald:= næste;
5 11072
5 11072 if næste <> 0 then
5 11073 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 11074 + forrige shift 12
5 11075 else if t = 1 then sidste_opkald:= forrige
5 11076 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 11077
5 11077 opkaldskø.ref(1):=første_frie_opkald;
5 11078 første_frie_opkald:=ref;
5 11079
5 11079 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 11080 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 11081 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 11082 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 11083 else
5 11084 begin
6 11085 sætbit_ia(opkaldsflag,operatør,1);
6 11086 sætbit_ia(opkaldsflag,o,1);
6 11087 end;
5 11088 signal_bin(bs_mobil_opkald);
5 11089 end;
4 11090 \f
4 11090 message procedure udtag_opkald side 4 - 810531/hko;
4 11091
4 11091 signal_bin(bs_opkaldskø_adgang);
4 11092 bus:= b;
4 11093 type:= t;
4 11094 ll:= l;
4 11095 ttmm:= tm;
4 11096 udtag_opkald:= res;
4 11097 end udtag opkald;
3 11098 \f
3 11098 message procedure frigiv_kanal side 1 - 810603/hko;
3 11099
3 11099 procedure frigiv_kanal(nr);
3 11100 value nr;
3 11101 integer nr;
3 11102 begin
4 11103 integer id1, id2, omr, i;
4 11104 integer array field iaf, vt_op;
4 11105
4 11105 iaf:= (nr-1)*kanal_beskrlængde;
4 11106 id1:= kanal_tab.iaf.kanal_id1;
4 11107 id2:= kanal_tab.iaf.kanal_id2;
4 11108 omr:= kanal_til_omr(nr);
4 11109 if id1 <> 0 then
4 11110 wait(ss_samtale_nedlagt(nr));
4 11111 if id1 shift (-22) < 3 and omr > 2 then
4 11112 begin
5 11113 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11114 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11115 if id1 shift (-22) = 2 then 18 else 17);
5 11116 d.vt_op.data(1):= id1;
5 11117 d.vt_op.data(4):= omr;
5 11118 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11119 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11120 signalch(cs_vt_adgang,vt_op,true);
5 11121 end;
4 11122
4 11122 if id2 <> 0 and id2 shift(-20) <> 12 then
4 11123 wait(ss_samtale_nedlagt(nr));
4 11124 if id2 shift (-22) < 3 and omr > 2 then
4 11125 begin
5 11126 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11127 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11128 if id2 shift (-22) = 2 then 18 else 17);
5 11129 d.vt_op.data(1):= id2;
5 11130 d.vt_op.data(4):= omr;
5 11131 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11132 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11133 signalch(cs_vt_adgang,vt_op,true);
5 11134 end;
4 11135
4 11135 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 11136 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 11137 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 11138 shift (-10) extract 6 shift 10;
4 11139 <* repeat
4 11140 inspect(ss_samtale_nedlagt(nr),i);
4 11141 if i>0 then wait(ss_samtale_nedlagt(nr));
4 11142 until i<=0;
4 11143 *>
4 11144 end frigiv_kanal;
3 11145 \f
3 11145 message procedure hookoff side 1 - 880901/cl;
3 11146
3 11146 integer procedure hookoff(talevej,op,retursem,flash);
3 11147 value talevej,op,retursem,flash;
3 11148 integer talevej,op,retursem;
3 11149 boolean flash;
3 11150 begin
4 11151 integer array field opref;
4 11152
4 11152 opref:= op;
4 11153 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 11154 d.opref.data(1):= talevej;
4 11155 d.opref.data(2):= if flash then 2 else 1;
4 11156 signalch(cs_radio_ud,opref,rad_optype);
4 11157 <*V*> waitch(retursem,opref,rad_optype,-1);
4 11158 hookoff:= d.opref.resultat;
4 11159 end;
3 11160 \f
3 11160 message procedure hookon side 1 - 880901/cl;
3 11161
3 11161 integer procedure hookon(talevej,op,retursem);
3 11162 value talevej,op,retursem;
3 11163 integer talevej,op,retursem;
3 11164 begin
4 11165 integer i,res;
4 11166 integer array field opref;
4 11167
4 11167 if læsbit_ia(hookoff_maske,talevej) then
4 11168 begin
5 11169 inspect(bs_talevej_udkoblet(talevej),i);
5 11170 if i<=0 then
5 11171 begin
6 11172 opref:= op;
6 11173 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 11174 d.opref.data(1):= talevej;
6 11175 signalch(cs_radio_ud,opref,rad_optype);
6 11176 <*V*> waitch(retursem,opref,rad_optype,-1);
6 11177 res:= d.opref.resultat;
6 11178 end
5 11179 else
5 11180 res:= 0;
5 11181
5 11181 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 11182 end
4 11183 else
4 11184 res:= 0;
4 11185
4 11185 sætbit_ia(hookoff_maske,talevej,0);
4 11186 hookon:= res;
4 11187 end;
3 11188 \f
3 11188 message procedure radio side 2 - 820304/hko;
3 11189
3 11189 rad_op:= op;
3 11190
3 11190 trap(radio_trap);
3 11191 stack_claim((if cm_test then 200 else 150) +200);
3 11192
3 11192 <*+2*>if testbit32 and overvåget or testbit28 then
3 11193 skriv_radio(out,0);
3 11194 <*-2*>
3 11195 repeat
3 11196 waitch(cs_radio(talevej),opref,true,-1);
3 11197 <*+2*>
3 11198 if testbit33 and overvåget then
3 11199 disable begin
4 11200 skriv_radio(out,0);
4 11201 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 11202 skriv_op(out,opref);
4 11203 end;
3 11204 <*-2*>
3 11205
3 11205 k:= d.op_ref.opkode extract 12;
3 11206 opgave:= d.opref.opkode shift (-12);
3 11207 operatør:= d.op_ref.data(4);
3 11208
3 11208 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 11209 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 11210 <:radio:>,0);
3 11211 <*-4*>
3 11212 \f
3 11212 message procedure radio side 3 - 880930/cl;
3 11213 if k=41 <*radiokommando fra operatør*> then
3 11214 begin
4 11215 vogn:= d.opref.data(2);
4 11216 res:= -1;
4 11217 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 11218 sig:= 0; omr:= d.opref.data(3) extract 8;
4 11219 bus:= garage:= ll:= 0;
4 11220
4 11220 if opgave=1 or opgave=9 then
4 11221 begin <* opkald til enkelt vogn (CHF) *>
5 11222 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 11223 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 11224 <* ok at kø er tom når vogn er angivet eller VHF *>
5 11225
5 11225 d.opref.data(11):= if res=0 then
5 11226 (if ll<>0 then ll else bus) else vogn;
5 11227
5 11227 if type=2 <*nød*> then
5 11228 begin
6 11229 waitch(cs_radio_pulje,opref1,true,-1);
6 11230 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 11231 d.opref1.data(1):= if ll<>0 then ll else bus;
6 11232 systime(5,0,kl);
6 11233 d.opref1.data(2):= entier(kl/100.0);
6 11234 d.opref1.data(3):= omr;
6 11235 signalch(cs_io,opref1,gen_optype or rad_optype);
6 11236 end
5 11237 end; <* enkeltvogn (CHF) *>
4 11238
4 11238 <* check enkeltvogn for ledig *>
4 11239 if res<=0 and omr=2<*VHF*> and bus=0 and
4 11240 (opgave=1 or opgave=9) then
4 11241 begin
5 11242 for i:= 1 step 1 until max_antal_kanaler do
5 11243 if kanal_til_omr(i)=2 then nr:= i;
5 11244 iaf:= (nr-1)*kanalbeskrlængde;
5 11245 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 11246 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 11247 then res:= 52;
5 11248 end;
4 11249 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 11250 d.opref.data(3)=0 <*std. omr*>) and
4 11251 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 11252 then
4 11253 begin
5 11254 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 11255 if vogn shift (-22) = 1 then
5 11256 begin
6 11257 find_busnr(vogn,bus,garage,res);
6 11258 ll:= vogn;
6 11259 end
5 11260 else
5 11261 if vogn shift (-22) = 0 then
5 11262 begin
6 11263 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 11264 bus:= vogn;
6 11265 end
5 11266 else
5 11267 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 11268 res:= if res=(-1) then 18 <* i kø *> else
5 11269 (if res<>0 then 14 <*opt*> else 0);
5 11270 end
4 11271 else
4 11272 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 11273 opgave <= 2 then
4 11274 begin
5 11275 bus:= vogn; garage:= type:= ttmm:= 0;
5 11276 res:= 0; omr:= 0; sig:= 0;
5 11277 end
4 11278 else
4 11279 if opgave>1 and opgave<>9 then
4 11280 type:= ttmm:= res:= 0;
4 11281 \f
4 11281 message procedure radio side 4 - 880930/cl;
4 11282
4 11282 if res=0 and (opgave<=4 or opgave=9) and
4 11283 (omr<1 or 2<omr) and
4 11284 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 11285 begin <* reserver i vogntabel *>
5 11286 waitch(cs_vt_adgang,vt_op,true,-1);
5 11287 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11288 if opgave <=2 or opgave=9 then 15 else 16);
5 11289 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 11290 (if vogn=0 then garage shift 14 + bus else
5 11291 if ll<>0 then ll else garage shift 14 + bus)
5 11292 else vogn <*gruppeid*>;
5 11293 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 11294 d.opref.data(3) extract 8
5 11295 else omr extract 8;
5 11296 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 11297 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 11298
5 11298 res:= d.vt_op.resultat;
5 11299 if res=3 then res:= 0;
5 11300 vtop2:= d.vt_op.data(2);
5 11301 vtop3:= d.vt_op.data(3);
5 11302 tekn_inf:= d.vt_op.data(4);
5 11303 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 11304 end;
4 11305
4 11305 if res<>0 then
4 11306 begin
5 11307 d.opref.resultat:= res;
5 11308 signalch(d.opref.retur,opref,d.opref.optype);
5 11309 end
4 11310 else
4 11311
4 11311 if opgave <= 9 then
4 11312 begin <* opkald *>
5 11313 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 11314 opgave<>9 and d.opref.data(6)<>0);
5 11315
5 11315 if res<>0 then
5 11316 goto returner_op;
5 11317
5 11317 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 11318 begin
6 11319 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 11320 'H' shift 12 + 60);
6 11321 d.rad_op.data(1):= talevej;
6 11322 d.rad_op.data(2):= 'D';
6 11323 d.rad_op.data(3):= 6; <* rear *>
6 11324 d.rad_op.data(4):= 1; <* rear no *>
6 11325 d.rad_op.data(5):= 0; <* disconnect *>
6 11326 signalch(cs_radio_ud,rad_op,rad_optype);
6 11327 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 11328 if d.rad_op.resultat<>0 then
6 11329 begin
7 11330 res:= d.rad_op.resultat;
7 11331 goto returner_op;
7 11332 end;
6 11333 <*
6 11334 while optaget_flag shift (-1) <> 0 do
6 11335 delay(1);
6 11336 *>
6 11337 end;
5 11338 \f
5 11338 message procedure radio side 5 - 880930/cl;
5 11339
5 11339 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 11340 'B' shift 12 + 60);
5 11341 d.rad_op.data(1):= talevej;
5 11342 d.rad_op.data(2):= 'D';
5 11343 d.rad_op.data(3):= if opgave=9 then 3 else
5 11344 (2 - (opgave extract 1)); <* højttalerkode *>
5 11345
5 11345 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11346 begin
6 11347 j:= 0;
6 11348 for i:= 2 step 1 until max_antal_områder do
6 11349 begin
7 11350 if opgave > 6 or
7 11351 (d.opref.data(3) shift (-20) = 15 and
7 11352 læsbiti(d.opref.data(3),i)) or
7 11353 (d.opref.data(3) shift (-20) = 14 and
7 11354 d.opref.data(3) extract 20 = i)
7 11355 then
7 11356 begin
8 11357 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11358 begin
9 11359 j:= j+1;
9 11360 d.rad_op.data(10+(j-1)*2):=
9 11361 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11362 (if i=2<*VHF*> then 4 else k)
9 11363 shift 8 + <* signal type *>
9 11364 1; <* antal tno *>
9 11365 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11366 end;
8 11367 end;
7 11368 end;
6 11369 d.rad_op.data(4):= j;
6 11370 d.rad_op.data(5):= 0;
6 11371 end
5 11372 else
5 11373 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11374 begin
6 11375 d.rad_op.data(4):= vtop2;
6 11376 d.rad_op.data(5):= vtop3;
6 11377 end
5 11378 else
5 11379 begin <* enkeltvogn *>
6 11380 if omr=0 then
6 11381 begin
7 11382 sig:= tekn_inf shift (-23);
7 11383 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11384 else tekn_inf extract 8;
7 11385 end
6 11386 else
6 11387 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11388
6 11388 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11389 <* tvinges til alm. opkald *>
6 11390 if (opgave=9) and (type=2) and (omr<=3) then
6 11391 begin
7 11392 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11393 opgave:= 1;
7 11394 d.radop.data(3):= 1;
7 11395 end;
6 11396
6 11396 if omr=2 <*VHF*> then sig:= 4 else
6 11397 if omr=1 <*TLF*> then sig:= 7 else
6 11398 <*UHF*> sig:= sig+1;
6 11399 d.rad_op.data(4):= 1;
6 11400 d.rad_op.data(5):= 0;
6 11401 d.rad_op.data(10):=
6 11402 (område_id(omr,2) extract 12) shift 12 +
6 11403 sig shift 8 +
6 11404 1;
6 11405 d.rad_op.data(11):= bus;
6 11406 end;
5 11407 \f
5 11407 message procedure radio side 6 - 880930/cl;
5 11408
5 11408 signalch(cs_radio_ud,rad_op,rad_optype);
5 11409 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11410 res:= d.rad_op.resultat;
5 11411
5 11411 d.rad_op.data(6):= 0;
5 11412 for i:= 1 step 1 until max_antal_områder do
5 11413 if læsbiti(d.rad_op.data(7),i) then
5 11414 increase(d.rad_op.data(6));
5 11415 returner_op:
5 11416 if d.rad_op.data(6)=1 then
5 11417 begin
6 11418 for i:= 1 step 1 until max_antal_områder do
6 11419 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11420 d.opref.data(12):= 14 shift 20 + i;
6 11421 end
5 11422 else
5 11423 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11424 d.opref.data(7):= type;
5 11425 d.opref.data(8):= garage shift 14 + bus;
5 11426 d.opref.data(9):= ll;
5 11427 if res=0 then
5 11428 begin
6 11429 d.opref.resultat:= 3;
6 11430 d.opref.data(5):= d.opref.data(6);
6 11431 j:= 0;
6 11432 for i:= 1 step 1 until max_antal_kanaler do
6 11433 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11434 if j>1 then
6 11435 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11436 else
6 11437 begin
7 11438 j:= 0;
7 11439 for i:= 1 step 1 until max_antal_kanaler do
7 11440 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11441 d.opref.data(6):= 3 shift 22 + j;
7 11442 end;
6 11443 d.opref.data(7):= type;
6 11444 d.opref.data(8):= garage shift 14 + bus;
6 11445 d.opref.data(9):= ll;
6 11446 d.opref.data(10):= d.opref.data(6);
6 11447 for i:= 1 step 1 until max_antal_kanaler do
6 11448 begin
7 11449 if læsbiti(d.rad_op.data(9),i) then
7 11450 begin
8 11451 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11452 j:= pabx_id( kanal_id(i) extract 5 )
8 11453 else
8 11454 j:= radio_id( kanal_id(i) extract 5 );
8 11455 if j>0 and type=0 and operatør>0 then tæl_opkald(j,1);
8 11456
8 11456 iaf:= (i-1)*kanalbeskrlængde;
8 11457 skrivtegn(kanal_tab.iaf,1,talevej);
8 11458 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11459 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11460 kanal_tab.iaf.kanal_id1:=
8 11461 if opgave<=2 or opgave=9 then
8 11462 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11463 else
8 11464 d.opref.data(2);
8 11465 kanal_tab.iaf.kanal_alt_id1:=
8 11466 if opgave<=2 or opgave=9 then
8 11467 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11468 else
8 11469 0;
8 11470 if kanal_tab.iaf.kanal_id1=0 then
8 11471 kanal_tab.iaf.kanal_id1:= 10000;
8 11472 kanal_tab.iaf.kanal_spec:=
8 11473 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11474 end;
7 11475 end;
6 11476 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11477 sætbit_ia(kanalflag,operatør,1);
6 11478 \f
6 11478 message procedure radio side 7 - 880930/cl;
6 11479
6 11479 end
5 11480 else
5 11481 begin
6 11482 d.opref.resultat:= res;
6 11483 if res=20 or res=52 then
6 11484 begin <* tæl ej.forb og opt.kanal *>
7 11485 for i:= 1 step 1 until max_antal_områder do
7 11486 if læsbiti(d.rad_op.data(7),i) then
7 11487 tæl_opkald(i,(if res=20 then 4 else 5));
7 11488 end;
6 11489 if d.opref.data(6)=0 then
6 11490 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11491 <* frigiv fra vogntabel hvis reserveret *>
6 11492 if (opgave<=4 or opgave=9) and
6 11493 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11494 begin
7 11495 waitch(cs_vt_adgang,vt_op,true,-1);
7 11496 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11497 if opgave<=2 or opgave=9 then 17 else 18);
7 11498 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11499 (if vogn=0 then garage shift 14 + bus else
7 11500 if ll<>0 then ll else garage shift 14 + bus)
7 11501 else vogn;
7 11502 d.vt_op.data(4):= omr;
7 11503 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11504 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11505 signalch(cs_vt_adgang,vt_op,true);
7 11506 end;
6 11507 end;
5 11508 signalch(d.opref.retur,opref,d.opref.optype);
5 11509 \f
5 11509 message procedure radio side 8 - 880930/cl;
5 11510
5 11510 end <* opkald *>
4 11511 else
4 11512 if opgave = 10 <* MONITER *> then
4 11513 begin
5 11514 nr:= d.opref.data(2);
5 11515 if nr shift (-20) <> 12 then
5 11516 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11517 nr:= nr extract 20;
5 11518 iaf:= (nr-1)*kanalbeskrlængde;
5 11519 inspect(ss_samtale_nedlagt(nr),i);
5 11520 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11521 kanal_tab.iaf.kanal_id2 extract 20
5 11522 else
5 11523 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11524 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11525 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11526 (i<>0 or j<>0) then
5 11527 begin
6 11528 res:= 0;
6 11529 d.opref.data(5):= 12 shift 20 + k;
6 11530 d.opref.data(6):= 12 shift 20 + nr;
6 11531 sætbit_ia(kanalflag,operatør,1);
6 11532 goto radio_nedlæg;
6 11533 end
5 11534 else
5 11535 if i<>0 or j<>0 then
5 11536 res:= 49
5 11537 else
5 11538 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11539 res:= 49 <* ingen samtale igang *>
5 11540 else
5 11541 begin
6 11542 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11543 if res=0 then
6 11544 begin
7 11545 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11546 'B' shift 12 + 60);
7 11547 d.rad_op.data(1):= talevej;
7 11548 d.rad_op.data(2):= 'V';
7 11549 d.rad_op.data(3):= 0;
7 11550 d.rad_op.data(4):= 1;
7 11551 d.rad_op.data(5):= 0;
7 11552 d.rad_op.data(10):=
7 11553 (kanal_id(nr) shift (-5) shift 18) +
7 11554 (kanal_id(nr) extract 5 shift 12) + 0;
7 11555 signalch(cs_radio_ud,rad_op,rad_optype);
7 11556 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11557 res:= d.rad_op.resultat;
7 11558 if res=0 then
7 11559 begin
8 11560 d.opref.data(5):= 0;
8 11561 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11562 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11563 res:= 3;
8 11564 end;
7 11565 end;
6 11566 end;
5 11567 \f
5 11567 message procedure radio side 9 - 880930/cl;
5 11568 if res=3 then
5 11569 begin
6 11570 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11571 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11572 else
6 11573 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11574 d.opref.data(6):= 12 shift 20 + nr;
6 11575 i:= kanal_tab.iaf.kanal_id2;
6 11576 if i<>0 then
6 11577 begin
7 11578 if i shift (-20) = 12 then
7 11579 begin <* ident2 henviser til anden kanal *>
8 11580 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11581 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11582 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11583 else
8 11584 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11585 d.opref.data(5):= 12 shift 20 + i;
8 11586 end
7 11587 else
7 11588 d.opref.data(5):= 12 shift 20 + nr;
7 11589 end
6 11590 else
6 11591 d.opref.data(5):= 0;
6 11592 end;
5 11593
5 11593 if res<>3 then
5 11594 begin
6 11595 res:= 0;
6 11596 sætbit_ia(kanalflag,operatør,1);
6 11597 goto radio_nedlæg;
6 11598 end;
5 11599 d.opref.resultat:= res;
5 11600 signalch(d.opref.retur,opref,d.opref.optype);
5 11601 \f
5 11601 message procedure radio side 10 - 880930/cl;
5 11602
5 11602 end <* MONITERING *>
4 11603 else
4 11604 if opgave = 11 then <* GENNEMSTILLING *>
4 11605 begin
5 11606 nr:= d.opref.data(6) extract 20;
5 11607 k:= if d.opref.data(5) shift (-20) = 12 then
5 11608 d.opref.data(5) extract 20
5 11609 else
5 11610 0;
5 11611 inspect(ss_samtale_nedlagt(nr),i);
5 11612 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11613 if i<>0 and j<>0 then
5 11614 begin
6 11615 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11616 goto radio_nedlæg;
6 11617 end;
5 11618
5 11618 iaf:= (nr-1)*kanal_beskr_længde;
5 11619 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11620 begin
6 11621 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11622 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11623 then
6 11624 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11625 else
6 11626 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11627 d.opref.data(5)<>0
6 11628 then
6 11629 res:= 0
6 11630 else
6 11631 res:= 21; <* ingen at gennemstille til *>
6 11632 end
5 11633 else
5 11634 res:= 50; <* kanalnr *>
5 11635
5 11635 if res=0 then
5 11636 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11637 if res=0 then
5 11638 begin
6 11639 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11640 kanal_tab.iaf.kanal_tilstand:=
6 11641 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11642 d.opref.data(6):= 0;
6 11643 if kanal_tab.iaf.kanal_id2=0 then
6 11644 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11645
6 11645 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11646 begin <* gennemstillet til anden kanal *>
7 11647 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11648 *kanalbeskrlængde;
7 11649 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11650 kanal_tab.iaf1.kanal_tilstand:=
7 11651 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11652 if kanal_tab.iaf1.kanal_id2=0 then
7 11653 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11654 end;
6 11655 d.opref.data(5):= 0;
6 11656
6 11656 res:= 3;
6 11657 end;
5 11658
5 11658 d.opref.resultat:= res;
5 11659 signalch(d.opref.retur,opref,d.opref.optype);
5 11660 \f
5 11660 message procedure radio side 11 - 880930/cl;
5 11661
5 11661 end
4 11662 else
4 11663 if opgave = 12 then <* NEDLÆG *>
4 11664 begin
5 11665 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11666 radio_nedlæg:
5 11667 if res=0 then
5 11668 begin
6 11669 for k:= 5, 6 do
6 11670 begin
7 11671 if d.opref.data(k) shift (-20) = 12 then
7 11672 begin
8 11673 i:= d.opref.data(k) extract 20;
8 11674 iaf:= (i-1)*kanalbeskrlængde;
8 11675 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11676 frigiv_kanal(d.opref.data(k) extract 20)
8 11677 else
8 11678 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11679 end
7 11680 else
7 11681 if d.opref.data(k) shift (-20) = 13 then
7 11682 begin
8 11683 for i:= 1 step 1 until max_antal_kanaler do
8 11684 if læsbiti(d.opref.data(k),i) then
8 11685 begin
9 11686 iaf:= (i-1)*kanalbeskrlængde;
9 11687 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11688 frigiv_kanal(i)
9 11689 else
9 11690 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11691 end;
8 11692 sætbit_ia(kanalflag,operatør,1);
8 11693 end;
7 11694 end;
6 11695 d.opref.data(5):= 0;
6 11696 d.opref.data(6):= 0;
6 11697 d.opref.data(9):= 0;
6 11698 res:= if opgave=12 then 3 else 49;
6 11699 end;
5 11700 d.opref.resultat:= res;
5 11701 signalch(d.opref.retur,opref,d.opref.optype);
5 11702 end
4 11703 else
4 11704 if opgave=13 then <* R *>
4 11705 begin
5 11706 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11707 'H' shift 12 + 60);
5 11708 d.rad_op.data(1):= talevej;
5 11709 d.rad_op.data(2):= 'M';
5 11710 d.rad_op.data(3):= 0; <*tkt*>
5 11711 d.rad_op.data(4):= 0; <*tkn*>
5 11712 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11713 signalch(cs_radio_ud,rad_op,rad_optype);
5 11714 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11715 res:= d.rad_op.resultat;
5 11716 d.opref.resultat:= if res=0 then 3 else res;
5 11717 signalch(d.opref.retur,opref,d.opref.optype);
5 11718 end
4 11719 else
4 11720 if opgave=14 <* VENTEPOS *> then
4 11721 begin
5 11722 res:= 0;
5 11723 while (res<=3 and d.opref.data(2)>0) do
5 11724 begin
6 11725 nr:= d.opref.data(6) extract 20;
6 11726 k:= if d.opref.data(5) shift (-20) = 12 then
6 11727 d.opref.data(5) extract 20
6 11728 else
6 11729 0;
6 11730 inspect(ss_samtale_nedlagt(nr),i);
6 11731 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11732 if i<>0 or j<>0 then
6 11733 begin
7 11734 res:= hookon(talevej,radop,cs_radio(talevej));
7 11735 goto radio_nedlæg;
7 11736 end;
6 11737
6 11737 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11738
6 11738 if res=0 then
6 11739 begin
7 11740 i:= d.opref.data(5);
7 11741 d.opref.data(5):= d.opref.data(6);
7 11742 d.opref.data(6):= i;
7 11743 res:= 3;
7 11744 end;
6 11745
6 11745 d.opref.data(2):= d.opref.data(2)-1;
6 11746 end;
5 11747 d.opref.resultat:= res;
5 11748 signalch(d.opref.retur,opref,d.opref.optype);
5 11749 end
4 11750 else
4 11751 begin
5 11752 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11753 d.opref.resultat:= 31;
5 11754 signalch(d.opref.retur,opref,d.opref.optype);
5 11755 end;
4 11756
4 11756 end <* radiokommando fra operatør *>
3 11757 else
3 11758 begin
4 11759
4 11759 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11760
4 11760 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11761
4 11761 end;
3 11762
3 11762 until false;
3 11763 radio_trap:
3 11764 disable skriv_radio(zbillede,1);
3 11765 end radio;
2 11766 \f
2 11766 message procedure radio_ind side 1 - 810521/hko;
2 11767
2 11767 procedure radio_ind(op);
2 11768 value op;
2 11769 integer op;
2 11770 begin
3 11771 integer array field op_ref,ref,io_opref;
3 11772 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11773 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11774 integer array typ, val(1:6), answ, tlgr(1:32);
3 11775 integer array field spec;
3 11776 real field rf;
3 11777 long array field laf;
3 11778
3 11778 procedure skriv_radio_ind(zud,omfang);
3 11779 value omfang;
3 11780 zone zud;
3 11781 integer omfang;
3 11782 begin integer ii;
4 11783 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11784 if omfang > 0 then
4 11785 disable begin integer x; long array field tx;
5 11786 tx:= 0;
5 11787 trap(slut);
5 11788 write(zud,"nl",1,
5 11789 <: op-ref: :>,op_ref,"nl",1,
5 11790 <: ref: :>,ref,"nl",1,
5 11791 <: io-opref: :>,io_opref,"nl",1,
5 11792 <: ac: :>,ac,"nl",1,
5 11793 <: lgd: :>,lgd,"nl",1,
5 11794 <: ttyp: :>,ttyp,"nl",1,
5 11795 <: ptyp: :>,ptyp,"nl",1,
5 11796 <: pnum: :>,pnum,"nl",1,
5 11797 <: pos: :>,pos,"nl",1,
5 11798 <: tegn: :>,tegn,"nl",1,
5 11799 <: bs: :>,bs,"nl",1,
5 11800 <: b-pt: :>,b_pt,"nl",1,
5 11801 <: b-pn: :>,b_pn,"nl",1,
5 11802 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11803 <: antal-spec: :>,antal_spec,"nl",1,
5 11804 <: sum: :>,sum,"nl",1,
5 11805 <: csum: :>,csum,"nl",1,
5 11806 <: i: :>,i,"nl",1,
5 11807 <: j: :>,j,"nl",1,
5 11808 <: k: :>,k,"nl",1,
5 11809 <: filref :>,filref,"nl",1,
5 11810 <: zno: :>,zno,"nl",1,
5 11811 <: answ: :>,answ.tx,"nl",1,
5 11812 <: tlgr: :>,tlgr.tx,"nl",1,
5 11813 <: spec: :>,spec,"nl",1);
5 11814 trap(slut);
5 11815 slut:
5 11816 end; <*disable*>
4 11817 end skriv_radio_ind;
3 11818 \f
3 11818 message procedure indsæt_opkald side 1 - 811105/hko;
3 11819
3 11819 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11820 value bus,type,omr,sig;
3 11821 integer bus,type,omr,sig;
3 11822 begin
4 11823 integer res,tilst,ll,operatør;
4 11824 integer array field vt_op,ref,næste,forrige;
4 11825 real r;
4 11826
4 11826 res:= -1;
4 11827 begin
5 11828 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11829 if vt_op <> 0 then
5 11830 begin
6 11831 wait(bs_opkaldskø_adgang);
6 11832 if omr>2 then
6 11833 begin
7 11834 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11835 d.vt_op.data(1):= bus;
7 11836 d.vt_op.data(4):= omr;
7 11837 tilst:= vt_op;
7 11838 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11839 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11840 <*+4*> if tilst <> vt_op then
7 11841 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11842 <*-4*>
7 11843 <*+2*> if testbit34 and overvåget then
7 11844 disable begin
8 11845 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11846 skriv_op(out,vt_op);
8 11847 ud;
8 11848 end;
7 11849 end
6 11850 else
6 11851 begin
7 11852 d.vt_op.data(1):= bus;
7 11853 d.vt_op.data(2):= 0;
7 11854 d.vt_op.data(3):= bus;
7 11855 d.vt_op.data(4):= omr;
7 11856 d.vt_op.resultat:= 0;
7 11857 ref:= første_nødopkald;
7 11858 if ref<>0 then tilst:= 2
7 11859 else
7 11860 begin
8 11861 ref:= første_opkald;
8 11862 tilst:= if ref=0 then 0 else 1;
8 11863 end;
7 11864 if tilst=0 then
7 11865 d.vt_op.resultat:= 3
7 11866 else
7 11867 begin
8 11868 while ref<>0 and d.vt_op.resultat=0 do
8 11869 begin
9 11870 if opkaldskø.ref(2) extract 14 = bus and
9 11871 opkaldskø.ref(5) extract 8 = omr
9 11872 then
9 11873 d.vt_op.resultat:= 18
9 11874 else
9 11875 begin
10 11876 ref:= opkaldskø.ref(1) extract 12;
10 11877 if ref=0 and tilst=2 then
10 11878 begin
11 11879 ref:= første_opkald;
11 11880 tilst:= if ref=0 then 0 else 1;
11 11881 end
10 11882 else
10 11883 if ref=0 then tilst:= 0;
10 11884 end;
9 11885 end;
8 11886 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11887 end;
7 11888 end;
6 11889 <*-2*>
6 11890 \f
6 11890 message procedure indsæt_opkald side 1a- 820301/hko;
6 11891
6 11891 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11892 begin
7 11893 ref:=første_opkald;
7 11894 tilst:=-1;
7 11895 while ref<>0 and tilst=-1 do
7 11896 begin
8 11897 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11898 begin <* udtag normalopkald *>
9 11899 næste:=opkaldskø.ref(1);
9 11900 forrige:=næste shift(-12);
9 11901 næste:=næste extract 12;
9 11902 if forrige<>0 then
9 11903 opkaldskø.forrige(1):=
9 11904 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11905 else
9 11906 første_opkald:=næste;
9 11907 if næste<>0 then
9 11908 opkaldskø.næste(1):=
9 11909 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11910 else
9 11911 sidste_opkald:=forrige;
9 11912 opkaldskø.ref(1):=første_frie_opkald;
9 11913 første_frie_opkald:=ref;
9 11914 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11915 tilst:=0;
9 11916 end
8 11917 else
8 11918 ref:=opkaldskø.ref(1) extract 12;
8 11919 end; <*while*>
7 11920 if tilst=0 then
7 11921 d.vt_op.resultat:=3;
7 11922 end; <*nødopkald bus i kø*>
6 11923 \f
6 11923 message procedure indsæt_opkald side 2 - 820304/hko;
6 11924
6 11924 if d.vt_op.resultat = 3 then
6 11925 begin
7 11926 ll:= d.vt_op.data(2);
7 11927 tilst:= d.vt_op.data(3);
7 11928 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11929 if operatør < 0 or max_antal_operatører < operatør then
7 11930 operatør:= 0;
7 11931 if operatør=0 then
7 11932 operatør:= (tilst shift (-14) extract 8);
7 11933 if operatør=0 then
7 11934 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11935 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11936 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11937 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11938 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11939 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11940 forrige:= (if type = 1 then sidste_opkald
7 11941 else sidste_nødopkald);
7 11942 opkaldskø.ref(1):= forrige shift 12;
7 11943 if type = 1 then
7 11944 begin
8 11945 if første_opkald = 0 then første_opkald:= ref;
8 11946 sidste_opkald:= ref;
8 11947 end
7 11948 else
7 11949 begin <*type = 2*>
8 11950 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11951 sidste_nødopkald:= ref;
8 11952 end;
7 11953 if forrige <> 0 then
7 11954 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11955 shift 12 +ref;
7 11956
7 11956 opkaldskø.ref(2):= tilst extract 22 add
7 11957 (if type=2 then 1 shift 23 else 0);
7 11958 opkaldskø.ref(3):= ll;
7 11959 systime(5,0.0,r);
7 11960 ll:= round r//100;<*ttmm*>
7 11961 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 11962 opkaldskø.ref(5):= sig shift 20 + omr;
7 11963 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 11964 res:= 0;
7 11965 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 11966 opkaldskø_ledige:= opkaldskø_ledige -1;
7 11967 <*meddel opkald til berørte operatører *>
7 11968 signal_bin(bs_mobil_opkald);
7 11969 tæl_opkald(omr,type+1);
7 11970 end <* resultat = 3 *>
6 11971 else
6 11972 begin
7 11973 \f
7 11973 message procedure indsæt_opkald side 3 - 810601/hko;
7 11974
7 11974 <* d.vt_op.resultat <> 3 *>
7 11975
7 11975 res:= d.vt_op.resultat;
7 11976 if res = 10 then
7 11977 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 11978 <:er ikke i bustabel:>,1)
7 11979 else
7 11980 <*+4*> if res <> 14 and res <> 18 then
7 11981 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 11982 <*-4*>
7 11983 ;
7 11984 end;
6 11985 signalbin(bs_opkaldskø_adgang);
6 11986 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 11987 end
5 11988 else
5 11989 res:= -2; <*timeout for cs_vt_adgang*>
5 11990 end;
4 11991 indsæt_opkald:= res;
4 11992 end indsæt_opkald;
3 11993 \f
3 11993 message procedure afvent_telegram side 1 - 880901/cl;
3 11994
3 11994 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 11995 integer array tlgr;
3 11996 integer lgd,ttyp,ptyp,pnum;
3 11997 begin
4 11998 integer i, pos, tegn, ac, sum, csum;
4 11999
4 11999 pos:= 1;
4 12000 lgd:= 0;
4 12001 ttyp:= 'Z';
4 12002 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 12003 if ac >= 0 then
4 12004 begin
5 12005 lgd:= 1;
5 12006 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 12007 lgd:= lgd-2;
5 12008 if lgd >= 3 then
5 12009 begin
6 12010 i:= 1;
6 12011 ttyp:= læstegn(tlgr,i,tegn);
6 12012 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 12013 pnum:= læstegn(tlgr,i,tegn) - '@';
6 12014 end
5 12015 else ac:= 6; <* for kort telegram - retransmitter *>
5 12016 end;
4 12017
4 12017 afvent_telegram:= ac;
4 12018 end;
3 12019 \f
3 12019 message procedure b_answ side 1 - 880901/cl;
3 12020
3 12020 procedure b_answ(answ,ht,spec,more,ac);
3 12021 value ht, more,ac;
3 12022 integer array answ, spec;
3 12023 boolean more;
3 12024 integer ht, ac;
3 12025 begin
4 12026 integer pos, i, sum, tegn;
4 12027
4 12027 pos:= 1;
4 12028 skrivtegn(answ,pos,'B');
4 12029 skrivtegn(answ,pos,if more then 'B' else ' ');
4 12030 skrivtegn(answ,pos,ac+'@');
4 12031 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 12032 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 12033 skrivtegn(answ,pos,'@');
4 12034 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 12035 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 12036 for i:= 1 step 1 until spec(1) extract 8 do
4 12037 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 12038 else
4 12039 begin
5 12040 skrivtegn(answ,pos,'D');
5 12041 anbringtal(answ,pos,spec(1+i),-4);
5 12042 end;
4 12043 for i:= 1 step 1 until 4 do
4 12044 skrivtegn(answ,pos,'@');
4 12045 skrivtegn(answ,pos,ht+'@');
4 12046 skrivtegn(answ,pos,'@');
4 12047
4 12047 i:= 1; sum:= 0;
4 12048 while i < pos do
4 12049 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 12050 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 12051 skrivtegn(answ,pos,sum extract 4 + '@');
4 12052 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 12053 end;
3 12054 \f
3 12054 message procedure ann_opkald side 1 - 881108/cl;
3 12055
3 12055 integer procedure ann_opkald(vogn,omr);
3 12056 value vogn,omr;
3 12057 integer vogn,omr;
3 12058 begin
4 12059 integer array field vt_op,ref,næste,forrige;
4 12060 integer res, t, i, o;
4 12061
4 12061 waitch(cs_vt_adgang,vt_op,true,-1);
4 12062 res:= -1;
4 12063 wait(bs_opkaldskø_adgang);
4 12064 ref:= første_nødopkald;
4 12065 if ref <> 0 then
4 12066 t:= 2
4 12067 else
4 12068 begin
5 12069 ref:= første_opkald;
5 12070 t:= if ref<>0 then 1 else 0;
5 12071 end;
4 12072
4 12072 if t=0 then
4 12073 res:= 19 <* kø tom *>
4 12074 else
4 12075 begin
5 12076 while ref<>0 and res=(-1) do
5 12077 begin
6 12078 if vogn=opkaldskø.ref(2) extract 14 and
6 12079 omr=opkaldskø.ref(5) extract 8
6 12080 then
6 12081 res:= 0
6 12082 else
6 12083 begin
7 12084 ref:= opkaldskø.ref(1) extract 12;
7 12085 if ref=0 and t=2 then
7 12086 begin
8 12087 ref:= første_opkald;
8 12088 t:= if ref=0 then 0 else 1;
8 12089 end;
7 12090 end;
6 12091 end; <*while*>
5 12092 \f
5 12092 message procedure ann_opkald side 2 - 881108/cl;
5 12093
5 12093 if ref<>0 then
5 12094 begin
6 12095 start_operation(vt_op,401,cs_radio_ind,17);
6 12096 d.vt_op.data(1):= vogn;
6 12097 d.vt_op.data(4):= omr;
6 12098 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 12099 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 12100
6 12100 o:= opkaldskø.ref(4) extract 8;
6 12101 næste:= opkaldskø.ref(1);
6 12102 forrige:= næste shift (-12);
6 12103 næste:= næste extract 12;
6 12104 if forrige<>0 then
6 12105 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 12106 + næste
6 12107 else
6 12108 if t=2 then første_nødopkald:= næste
6 12109 else første_opkald:= næste;
6 12110
6 12110 if næste<>0 then
6 12111 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 12112 + forrige shift 12
6 12113 else
6 12114 if t=2 then sidste_nødopkald:= forrige
6 12115 else sidste_opkald:= forrige;
6 12116
6 12116 opkaldskø.ref(1):= første_frie_opkald;
6 12117 første_frie_opkald:= ref;
6 12118 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 12119 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 12120
6 12120 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 12121 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 12122 else
6 12123 begin
7 12124 sætbit_ia(opkaldsflag,o,1);
7 12125 end;
6 12126 signalbin(bs_mobilopkald);
6 12127 end;
5 12128 end;
4 12129
4 12129 signalbin(bs_opkaldskø_adgang);
4 12130 signalch(cs_vt_adgang, vt_op, true);
4 12131 ann_opkald:= res;
4 12132 end;
3 12133 \f
3 12133 message procedure frigiv_id side 1 - 881114/cl;
3 12134
3 12134 integer procedure frigiv_id(id,omr);
3 12135 value id,omr;
3 12136 integer id,omr;
3 12137 begin
4 12138 integer array field vt_op;
4 12139
4 12139 if id shift (-22) < 3 and omr > 2 then
4 12140 begin
5 12141 waitch(cs_vt_adgang,vt_op,true,-1);
5 12142 start_operation(vt_op,401,cs_radio_ind,
5 12143 if id shift (-22) = 2 then 18 else 17);
5 12144 d.vt_op.data(1):= id;
5 12145 d.vt_op.data(4):= omr;
5 12146 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 12147 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 12148 frigiv_id:= d.vt_op.resultat;
5 12149 signalch(cs_vt_adgang,vt_op,true);
5 12150 end;
4 12151 end;
3 12152 \f
3 12152 message procedure radio_ind side 2 - 810524/hko;
3 12153 trap(radio_ind_trap);
3 12154 laf:= 0;
3 12155 stack_claim((if cm_test then 200 else 150) +135+75);
3 12156
3 12156 <*+2*>if testbit32 and overvåget or testbit28 then
3 12157 skriv_radio_ind(out,0);
3 12158 <*-2*>
3 12159 answ.laf(1):= long<:<'nl'>:>;
3 12160 io_opref:= op;
3 12161
3 12161 repeat
3 12162 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12163 pos:= 4;
3 12164 if ac = 0 then
3 12165 begin
4 12166 \f
4 12166 message procedure radio_ind side 3 - 881107/cl;
4 12167 if ttyp = 'A' then
4 12168 begin
5 12169 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12170 ac:= 1
5 12171 else
5 12172 begin
6 12173 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 12174 val(1):= ttyp;
6 12175 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 12176 val(2):= pnum;
6 12177 typ(3):= -1;
6 12178 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12179 if opref>0 then
6 12180 begin
7 12181 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 12182 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 12183 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 12184 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 12185 then
7 12186 begin
8 12187 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 12188 end
7 12189 else
7 12190 begin
8 12191 ac:= 0;
8 12192 d.opref.resultat:= 0;
8 12193 sætbit_ia(hookoff_maske,pnum,1);
8 12194 end;
7 12195 signalch(d.opref.retur,opref,d.opref.optype);
7 12196 end
6 12197 else
6 12198 ac:= 2;
6 12199 end;
5 12200 pos:= 1;
5 12201 skrivtegn(answ,pos,'A');
5 12202 skrivtegn(answ,pos,' ');
5 12203 skrivtegn(answ,pos,ac+'@');
5 12204 for i:= 1 step 1 until 5 do
5 12205 skrivtegn(answ,pos,'@');
5 12206 skrivtegn(answ,pos,'0');
5 12207 i:= 1; sum:= 0;
5 12208 while i < pos do
5 12209 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12210 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12211 skrivtegn(answ,pos,sum extract 4 + '@');
5 12212 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12213 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12214 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12215 disable begin
6 12216 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12217 outchar(zrl,'nl');
6 12218 end;
5 12219 <*-2*>
5 12220 disable setposition(z_fr_out,0,0);
5 12221 ac:= -1;
5 12222 \f
5 12222 message procedure radio_ind side 4 - 881107/cl;
5 12223 end <* ttyp=A *>
4 12224 else
4 12225 if ttyp = 'B' then
4 12226 begin
5 12227 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12228 ac:= 1
5 12229 else
5 12230 begin
6 12231 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 12232 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 12233 typ(3):= -1;
6 12234 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12235 if opref > 0 then
6 12236 begin
7 12237 <*+2*> if testbit37 and overvåget then
7 12238 disable begin
8 12239 skriv_radio_ind(out,0);
8 12240 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 12241 skriv_op(out,opref);
8 12242 end;
7 12243 <*-2*>
7 12244 læstegn(tlgr,pos,bs);
7 12245 if bs = 'V' then
7 12246 begin
8 12247 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 12248 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 12249 end;
7 12250 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 12251 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 12252 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 12253 then
7 12254 begin
8 12255 ac:= 1;
8 12256 d.opref.resultat:= 31; <* systemfejl *>
8 12257 signalch(d.opref.retur,opref,d.opref.optype);
8 12258 end
7 12259 else
7 12260 if bs='V' then
7 12261 begin
8 12262 ac:= 0;
8 12263 d.opref.resultat:= 1;
8 12264 d.opref.data(4):= 0;
8 12265 d.opref.data(7):=
8 12266 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 12267 radio_id(b_pn));
8 12268 systime(1,0.0,d.opref.tid);
8 12269 signalch(cs_radio_ind,opref,d.opref.optype);
8 12270 spec:= data+18;
8 12271 b_answ(answ,0,d.opref.spec,false,ac);
8 12272 <*+2*> if (testbit36 or testbit38) and overvåget then
8 12273 disable begin
9 12274 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 12275 outchar(zrl,'nl');
9 12276 end;
8 12277 <*-2*>
8 12278 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 12279 disable setposition(z_fr_out,0,0);
8 12280 ac:= -1;
8 12281 \f
8 12281 message procedure radio_ind side 5 - 881107/cl;
8 12282 end
7 12283 else
7 12284 begin
8 12285 integer sig_type;
8 12286
8 12286 ac:= 0;
8 12287 antal_spec:= d.opref.data(4);
8 12288 filref:= d.opref.data(5);
8 12289 spec:= d.opref.data(6);
8 12290 if antal_spec>0 then
8 12291 begin
9 12292 antal_spec:= antal_spec-1;
9 12293 if filref<>0 then
9 12294 begin
10 12295 læsfil(filref,1,zno);
10 12296 b_pt:= fil(zno).spec(1) shift (-12);
10 12297 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 12298 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 12299 antal_spec>0,ac);
10 12300 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 12301 end
9 12302 else
9 12303 begin
10 12304 b_pt:= d.opref.spec(1) shift (-12);
10 12305 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 12306 b_answ(answ,d.opref.data(3),d.opref.spec,
10 12307 antal_spec>0,ac);
10 12308 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 12309 end;
9 12310
9 12310 <* send answer *>
9 12311 <*+2*> if (testbit36 or testbit38) and overvåget then
9 12312 disable begin
10 12313 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 12314 outchar(zrl,'nl');
10 12315 end;
9 12316 <*-2*>
9 12317 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 12318 disable setposition(z_fr_out,0,0);
9 12319 if ac<>0 then
9 12320 begin
10 12321 antal_spec:= 0;
10 12322 ac:= -1;
10 12323 end
9 12324 else
9 12325 begin
10 12326 for i:= 1 step 1 until max_antal_områder do
10 12327 if område_id(i,2)=b_pt then
10 12328 begin
11 12329 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 12330 if sætbiti(d.opref.data(7),j,1)=0 then
11 12331 d.opref.resultat:= d.opref.resultat + 1;
11 12332 end;
10 12333 end;
9 12334 end;
8 12335 \f
8 12335 message procedure radio_ind side 6 - 881107/cl;
8 12336
8 12336 <* afvent nyt telegram *>
8 12337 d.opref.data(4):= antal_spec;
8 12338 d.opref.data(6):= spec;
8 12339 ac:= -1;
8 12340 systime(1,0.0,d.opref.tid);
8 12341 <*+2*> if testbit37 and overvåget then
8 12342 disable begin
9 12343 skriv_radio_ind(out,0);
9 12344 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 12345 ud;
9 12346 end;
8 12347 <*-2*>
8 12348 signalch(cs_radio_ind,opref,d.opref.optype);
8 12349 end;
7 12350 end
6 12351 else ac:= 2;
6 12352 end;
5 12353 if ac > 0 then
5 12354 begin
6 12355 for i:= 1 step 1 until 6 do val(i):= 0;
6 12356 b_answ(answ,0,val,false,ac);
6 12357 <*+2*>
6 12358 if (testbit36 or testbit38) and overvåget then
6 12359 disable begin
7 12360 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12361 outchar(zrl,'nl');
7 12362 end;
6 12363 <*-2*>
6 12364 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12365 disable setposition(z_fr_out,0,0);
6 12366 ac:= -1;
6 12367 end;
5 12368 \f
5 12368 message procedure radio_ind side 7 - 881107/cl;
5 12369 end <* ttyp = 'B' *>
4 12370 else
4 12371 if ttyp='C' or ttyp='J' then
4 12372 begin
5 12373 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12374 ac:= 1
5 12375 else
5 12376 begin
6 12377 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12378 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12379 typ(3):= -1;
6 12380 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12381 if opref > 0 then
6 12382 begin
7 12383 d.opref.resultat:= d.opref.resultat - 1;
7 12384 if ttyp = 'C' then
7 12385 begin
8 12386 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12387 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12388 j:= 0;
8 12389 for i:= 1 step 1 until max_antal_kanaler do
8 12390 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12391 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12392 d.opref.resultat:= d.opref.resultat-1;
8 12393 sætbiti(optaget_flag,j,1);
8 12394 sætbiti(d.opref.data(9),j,1);
8 12395 end
7 12396 else
7 12397 begin <* INGEN FORBINDELSE *>
8 12398 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12399 end;
7 12400 ac:= 0;
7 12401 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12402 begin
8 12403 systime(1,0,d.opref.tid);
8 12404 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12405 end
7 12406 else
7 12407 begin
8 12408 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12409 if læsbiti(d.opref.data(8),9) then 52 else
8 12410 if læsbiti(d.opref.data(8),10) then 20 else
8 12411 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12412 signalch(d.opref.retur, opref, d.opref.optype);
8 12413 end;
7 12414 end
6 12415 else
6 12416 ac:= 2;
6 12417 end;
5 12418 pos:= 1;
5 12419 skrivtegn(answ,pos,ttyp);
5 12420 skrivtegn(answ,pos,' ');
5 12421 skrivtegn(answ,pos,ac+'@');
5 12422 i:= 1; sum:= 0;
5 12423 while i < pos do
5 12424 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12425 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12426 skrivtegn(answ,pos,sum extract 4 + '@');
5 12427 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12428 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12429 disable begin
6 12430 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12431 outchar(zrl,'nl');
6 12432 end;
5 12433 <*-2*>
5 12434 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12435 disable setposition(z_fr_out,0,0);
5 12436 ac:= -1;
5 12437 \f
5 12437 message procedure radio_ind side 8 - 881107/cl;
5 12438 end <* ttyp = 'C' or 'J' *>
4 12439 else
4 12440 if ttyp = 'D' then
4 12441 begin
5 12442 if ptyp = 4 <* VDU *> then
5 12443 begin
6 12444 if pnum<1 or pnum>max_antal_taleveje then
6 12445 ac:= 1
6 12446 else
6 12447 begin
7 12448 inspect(bs_talevej_udkoblet(pnum),j);
7 12449 if j>=0 then
7 12450 begin
8 12451 sætbit_ia(samtaleflag,pnum,1);
8 12452 signal_bin(bs_mobil_opkald);
8 12453 end;
7 12454 if læsbit_ia(hookoff_maske,pnum) then
7 12455 signalbin(bs_talevej_udkoblet(pnum));
7 12456 ac:= 0;
7 12457 end
6 12458 end
5 12459 else
5 12460 if ptyp=3 or ptyp=2 then
5 12461 begin
6 12462 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12463 ptyp=2 and pnum<>2
6 12464 then
6 12465 ac:= 1
6 12466 else
6 12467 begin
7 12468 if læstegn(tlgr,5,tegn)='D' then
7 12469 begin <* teknisk nr i telegram *>
8 12470 b_pn:= 0;
8 12471 for i:= 1 step 1 until 4 do
8 12472 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12473 end
7 12474 else
7 12475 b_pn:= 0;
7 12476 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12477 i:= 0;
7 12478 for j:= 1 step 1 until max_antal_kanaler do
7 12479 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12480 if i<>0 then
7 12481 begin
8 12482 ref:= (i-1)*kanalbeskrlængde;
8 12483 inspect(ss_samtale_nedlagt(i),j);
8 12484 if j>=0 then
8 12485 begin
9 12486 sætbit_ia(samtaleflag,
9 12487 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12488 signalbin(bs_mobil_opkald);
9 12489 end;
8 12490 signal(ss_samtale_nedlagt(i));
8 12491 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12492 begin
9 12493 if kanal_tab.ref.kanal_id1<>0 and
9 12494 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12495 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12496 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12497 if kanal_tab.ref.kanal_id2<>0 and
9 12498 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12499 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12500 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12501 end;
8 12502 sætbiti(optaget_flag,i,0);
8 12503 end;
7 12504 ac:= 0;
7 12505 end;
6 12506 end
5 12507 else ac:= 1;
5 12508 if ac>=0 then
5 12509 begin
6 12510 pos:= i:= 1; sum:= 0;
6 12511 skrivtegn(answ,pos,'D');
6 12512 skrivtegn(answ,pos,' ');
6 12513 skrivtegn(answ,pos,ac+'@');
6 12514 skrivtegn(answ,pos,'@');
6 12515 while i<pos do
6 12516 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12517 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12518 skrivtegn(answ,pos, sum extract 4 + '@');
6 12519 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12520 <*+2*>
6 12521 if (testbit36 or testbit38) and overvåget then
6 12522 disable begin
7 12523 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12524 outchar(zrl,'nl');
7 12525 end;
6 12526 <*-2*>
6 12527 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12528 disable setposition(z_fr_out,0,0);
6 12529 ac:= -1;
6 12530 end;
5 12531 \f
5 12531 message procedure radio_ind side 9 - 881107/cl;
5 12532 end <* ttyp = D *>
4 12533 else
4 12534 if ttyp='H' then
4 12535 begin
5 12536 integer htyp;
5 12537
5 12537 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12538
5 12538 if htyp='A' then
5 12539 begin <*mobilopkald*>
6 12540 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12541 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12542 ac:= 1
6 12543 else
6 12544 begin
7 12545 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12546 if læstegn(tlgr,6,tegn)='D' then
7 12547 begin <*teknisk nr. i telegram*>
8 12548 b_pn:= 0;
8 12549 for i:= 1 step 1 until 4 do
8 12550 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12551 end
7 12552 else b_pn:= 0;
7 12553 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12554 <* opkaldstype *>
7 12555 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12556 if j>0 then
7 12557 begin
8 12558 if bs=10 then
8 12559 ann_opkald(b_pn,j)
8 12560 else
8 12561 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12562 ac:= 0;
8 12563 end else ac:= 1;
7 12564 end;
6 12565 \f
6 12565 message procedure radio_ind side 10 - 881107/cl;
6 12566 end
5 12567 else
5 12568 if htyp='E' then
5 12569 begin <* radiokanal status *>
6 12570 long onavn;
6 12571
6 12571 ac:= 0;
6 12572 j:= 0;
6 12573 for i:= 1 step 1 until max_antal_kanaler do
6 12574 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12575
6 12575 <* Alarmer for K12 = GLX ignoreres *>
6 12576 <* 94.06.14/CL *>
6 12577 <* Alarmer for K15 = HG ignoreres *>
6 12578 <* 95.07.31/CL *>
6 12579 <* Alarmer for K10 = FS ignoreres *>
6 12580 <* 96.05.27/CL *>
6 12581 if j>0 then
6 12582 begin
7 12583 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12584 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
7 12585 (onavn = long<:FS:>) then 0 else j);
7 12586 end;
6 12587
6 12587 læstegn(tlgr,9,tegn);
6 12588 if j<>0 and (tegn='A' or tegn='E') then
6 12589 begin
7 12590 ref:= (j-1)*kanalbeskrlængde;
7 12591 bs:= if tegn='E' then 0 else 15;
7 12592 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12593 begin
8 12594 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12595 signalbin(bs_mobil_opkald);
8 12596 end;
7 12597 end;
6 12598 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12599 begin
7 12600 waitch(cs_radio_pulje,opref,true,-1);
7 12601 startoperation(opref,401,cs_radio_pulje,23);
7 12602 i:= 1;
7 12603 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12604 if læstegn(tlgr,4,k)<>'@' then
7 12605 begin
8 12606 if k-'@' = 17 then
8 12607 hægtstring(d.opref.data,i,<: AMV:>)
8 12608 else
8 12609 if k-'@' = 18 then
8 12610 hægtstring(d.opref.data,i,<: BHV:>)
8 12611 else
8 12612 begin
9 12613 hægtstring(d.opref.data,i,<: BST:>);
9 12614 anbringtal(d.opref.data,i,k-'@',1);
9 12615 end;
8 12616 end;
7 12617 skrivtegn(d.opref.data,i,' ');
7 12618 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12619 skrivtegn(d.opref.data,i,' ');
7 12620 hægtstring(d.opref.data,i,
7 12621 string område_navn(kanal_til_omr(j)));
7 12622 if '@'<=tegn and tegn<='F' then
7 12623 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12624 <*@*> <:: ukendt fejl:>,
7 12625 <*A*> <:: compad-fejl:>,
7 12626 <*B*> <:: ladefejl:>,
7 12627 <*C*> <:: dør åben:>,
7 12628 <*D*> <:: senderfejl:>,
7 12629 <*E*> <:: compad ok:>,
7 12630 <*F*> <:: liniefejl:>,
7 12631 <::>))
7 12632 else
7 12633 begin
8 12634 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12635 skrivtegn(d.opref.data,i,tegn);
8 12636 end;
7 12637 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12638 signalch(cs_io,opref,gen_optype or rad_optype);
7 12639 ref:= (j-1)*kanalbeskrlængde;
7 12640 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12641 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12642 signalbin(bs_mobilopkald);
7 12643 end;
6 12644 \f
6 12644 message procedure radio_ind side 11 - 881107/cl;
6 12645 end
5 12646 else
5 12647 if htyp='G' then
5 12648 begin <* fjerninkludering/-ekskludering af område *>
6 12649 bs:= læstegn(tlgr,9,tegn)-'@';
6 12650 j:= 0;
6 12651 for i:= 1 step 1 until max_antal_kanaler do
6 12652 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12653 if j<>0 then
6 12654 begin
7 12655 ref:= (j-1)*kanalbeskrlængde;
7 12656 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12657 end;
6 12658 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12659 signalbin(bs_mobilopkald);
6 12660 ac:= 0;
6 12661 end
5 12662 else
5 12663 if htyp='L' then
5 12664 begin <* vogntabelændringer *>
6 12665 long field ll;
6 12666
6 12666 ll:= 10;
6 12667 ac:= 0;
6 12668 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12669 læstegn(tlgr,9,tegn);
6 12670 if (tegn='N') or (tegn='O') then
6 12671 begin
7 12672 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12673 typ(2):= -1;
7 12674 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12675 if opref>0 then
7 12676 begin
8 12677 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12678 signalch(d.opref.retur,opref,d.opref.optype);
8 12679 end;
7 12680 ac:= -1;
7 12681 end
6 12682 else
6 12683 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12684 ac:= -1
6 12685 else
6 12686 if tegn='G' then <*indkodning*>
6 12687 begin
7 12688 pos:= 10; i:= 0;
7 12689 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12690 i:= i*10 + (tegn-'0');
7 12691 i:= i mod 1000;
7 12692 b_pn:= (1 shift 22) + (i shift 12);
7 12693 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12694 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12695 pos:= 14; i:= 0;
7 12696 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12697 i:= i*10 + (tegn-'0');
7 12698 b_pn:= b_pn + i;
7 12699 pos:= 16; i:= 0;
7 12700 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12701 i:= i*10 + (tegn-'0');
7 12702 b_pt:= i;
7 12703 bs:= 11;
7 12704 \f
7 12704 message procedure radio_ind side 12 - 881107/cl;
7 12705 end
6 12706 else
6 12707 if tegn='H' then <*udkodning*>
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 b_pt:= i;
7 12713 b_pn:= 0;
7 12714 bs:= 12;
7 12715 end
6 12716 else
6 12717 if tegn='I' then <*slet tabel*>
6 12718 begin
7 12719 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12720 pos:= 10; i:= 0;
7 12721 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12722 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12723 zno:= i;
7 12724 end
6 12725 else ac:= 2;
6 12726 if ac<0 then
6 12727 ac:= 0
6 12728 else
6 12729
6 12729 if ac=0 then
6 12730 begin
7 12731 waitch(cs_vt_adgang,opref,true,-1);
7 12732 startoperation(opref,401,cs_vt_adgang,bs);
7 12733 d.opref.data(1):= b_pt;
7 12734 d.opref.data(2):= b_pn;
7 12735 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12736 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12737 end;
6 12738 end
5 12739 else
5 12740 ac:= 2;
5 12741
5 12741 pos:= 1;
5 12742 skrivtegn(answ,pos,'H');
5 12743 skrivtegn(answ,pos,' ');
5 12744 skrivtegn(answ,pos,ac+'@');
5 12745 i:= 1; sum:= 0;
5 12746 while i < pos do
5 12747 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12748 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12749 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12750 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12751 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12752 disable begin
6 12753 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12754 outchar(zrl,'nl');
6 12755 end;
5 12756 <*-2*>
5 12757 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12758 disable setposition(z_fr_out,0,0);
5 12759 ac:= -1;
5 12760 \f
5 12760 message procedure radio_ind side 13 - 881107/cl;
5 12761 end
4 12762 else
4 12763 if ttyp = 'I' then
4 12764 begin
5 12765 typ(1):= -1;
5 12766 repeat
5 12767 getch(cs_radio_ind,opref,true,typ,val);
5 12768 if opref<>0 then
5 12769 begin
6 12770 d.opref.resultat:= 31;
6 12771 signalch(d.opref.retur,opref,d.opref.op_type);
6 12772 end;
5 12773 until opref=0;
5 12774 for i:= 1 step 1 until max_antal_taleveje do
5 12775 if læsbit_ia(hookoff_maske,i) then
5 12776 begin
6 12777 signalbin(bs_talevej_udkoblet(i));
6 12778 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12779 end;
5 12780 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12781 signal_bin(bs_mobil_opkald);
5 12782 for i:= 1 step 1 until max_antal_kanaler do
5 12783 begin
6 12784 ref:= (i-1)*kanalbeskrlængde;
6 12785 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12786 begin
7 12787 if kanal_tab.ref.kanal_id2<>0 and
7 12788 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12789 then
7 12790 begin
8 12791 signal(ss_samtale_nedlagt(i));
8 12792 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12793 end;
7 12794 if kanal_tab.ref.kanal_id1<>0 then
7 12795 begin
8 12796 signal(ss_samtale_nedlagt(i));
8 12797 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12798 end;
7 12799 end;
6 12800 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12801 end;
5 12802 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12803 startoperation(opref,401,cs_radio_pulje,23);
5 12804 i:= 1;
5 12805 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12806 j:= 4;
5 12807 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12808 begin
6 12809 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12810 end;
5 12811 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12812 signalch(cs_io,opref,gen_optype or rad_optype);
5 12813 optaget_flag:= 0;
5 12814 pos:= i:= 1; sum:= 0;
5 12815 skrivtegn(answ,pos,'I');
5 12816 skrivtegn(answ,pos,' ');
5 12817 skrivtegn(answ,pos,'@');
5 12818 while i<pos do
5 12819 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12820 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12821 skrivtegn(answ,pos,sum extract 4 + '@');
5 12822 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12823 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12824 disable begin
6 12825 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12826 outchar(zrl,'nl');
6 12827 end;
5 12828 <*-2*>
5 12829 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12830 disable setposition(z_fr_out,0,0);
5 12831 ac:= -1;
5 12832 \f
5 12832 message procedure radio_ind side 14 - 881107/cl;
5 12833 end
4 12834 else
4 12835 if ttyp='L' then
4 12836 begin
5 12837 ac:= 0;
5 12838 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12839 if testbit21 then
5 12840 begin
6 12841 waitch(cs_radio_pulje,opref,true,-1);
6 12842 startoperation(opref,401,cs_radio_pulje,23);
6 12843 i:= 1;
6 12844 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12845 j:= 4;
6 12846 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12847 begin
7 12848 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12849 end;
6 12850 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12851 signalch(cs_io,opref,gen_optype or rad_optype);
6 12852 end; <*testbit21*>
5 12853 end
4 12854 else
4 12855 if ttyp='Z' then
4 12856 begin
5 12857 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12858 disable begin
6 12859 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12860 outchar(zrl,'nl');
6 12861 end;
5 12862 <*-2*>
5 12863 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12864 disable setposition(z_fr_out,0,0);
5 12865 ac:= -1;
5 12866 end
4 12867 else
4 12868 ac:= 1;
4 12869 end; <* telegram modtaget ok *>
3 12870 \f
3 12870 message procedure radio_ind side 15 - 881107/cl;
3 12871 if ac>=0 then
3 12872 begin
4 12873 pos:= i:= 1; sum:= 0;
4 12874 skrivtegn(answ,pos,ttyp);
4 12875 skrivtegn(answ,pos,' ');
4 12876 skrivtegn(answ,pos,ac+'@');
4 12877 while i<pos do
4 12878 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12879 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12880 skrivtegn(answ,pos, sum extract 4 + '@');
4 12881 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12882 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12883 disable begin
5 12884 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12885 outchar(zrl,'nl');
5 12886 end;
4 12887 <*-2*>
4 12888 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12889 disable setposition(z_fr_out,0,0);
4 12890 ac:= -1;
4 12891 end;
3 12892
3 12892 typ(1):= 0;
3 12893 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12894 rf:= 4;
3 12895 systime(1,0.0,val.rf);
3 12896 val.rf:= val.rf - 30.0;
3 12897 typ(3):= -1;
3 12898 repeat
3 12899 getch(cs_radio_ind,opref,true,typ,val);
3 12900 if opref>0 then
3 12901 begin
4 12902 d.opref.resultat:= 53; <*annuleret*>
4 12903 signalch(d.opref.retur,opref,d.opref.optype);
4 12904 end;
3 12905 until opref=0;
3 12906
3 12906 until false;
3 12907
3 12907 radio_ind_trap:
3 12908
3 12908 disable skriv_radio_ind(zbillede,1);
3 12909
3 12909 end radio_ind;
2 12910 \f
2 12910 message procedure radio_ud side 1 - 820301/hko;
2 12911
2 12911 procedure radio_ud(op);
2 12912 value op;
2 12913 integer op;
2 12914 begin
3 12915 integer array field opref,io_opref;
3 12916 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12917 integer array answ, tlgr(1:32);
3 12918 long array field laf;
3 12919
3 12919 procedure skriv_radio_ud(z,omfang);
3 12920 value omfang;
3 12921 zone z;
3 12922 integer omfang;
3 12923 begin integer i1;
4 12924 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12925 if omfang > 0 then
4 12926 disable begin real x; long array field tx;
5 12927 tx:= 0;
5 12928 trap(slut);
5 12929 write(z,"nl",1,
5 12930 <: opref: :>,opref,"nl",1,
5 12931 <: io-opref: :>,io_opref,"nl",1,
5 12932 <: opgave: :>,opgave,"nl",1,
5 12933 <: kode: :>,kode,"nl",1,
5 12934 <: pos: :>,pos,"nl",1,
5 12935 <: tegn: :>,tegn,"nl",1,
5 12936 <: i: :>,i,"nl",1,
5 12937 <: sum: :>,sum,"nl",1,
5 12938 <: rc: :>,rc,"nl",1,
5 12939 <: svar-status: :>,svar_status,"nl",1,
5 12940 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12941 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12942 <::>);
5 12943 skriv_coru(z,coru_no(402));
5 12944 slut:
5 12945 end; <*disable*>
4 12946 end skriv_radio_ud;
3 12947
3 12947 trap(radio_ud_trap);
3 12948 laf:= 0;
3 12949 stack_claim((if cm_test then 200 else 150) +35+100);
3 12950
3 12950 <*+2*>if testbit32 and overvåget or testbit28 then
3 12951 skriv_radio_ud(out,0);
3 12952 <*-2*>
3 12953
3 12953 io_opref:= op;
3 12954 \f
3 12954 message procedure radio_ud side 2 - 810529/hko;
3 12955
3 12955 repeat
3 12956
3 12956 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12957 kode:= d.op_ref.opkode;
3 12958 opgave:= kode shift(-12);
3 12959 kode:= kode extract 12;
3 12960 if opgave < 'A' or opgave > 'I' then
3 12961 begin
4 12962 d.opref.resultat:= 31;
4 12963 end
3 12964 else
3 12965 begin
4 12966 pos:= 1;
4 12967 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12968 begin
5 12969 skrivtegn(tlgr,pos,opgave);
5 12970 if d.opref.data(1) = 0 then
5 12971 begin
6 12972 skrivtegn(tlgr,pos,'G');
6 12973 skrivtegn(tlgr,pos,'A');
6 12974 end
5 12975 else
5 12976 begin
6 12977 skrivtegn(tlgr,pos,'D');
6 12978 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 12979 end;
5 12980 if opgave='A' then
5 12981 begin
6 12982 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 12983 end
5 12984 else
5 12985 if opgave='B' then
5 12986 begin
6 12987 skrivtegn(tlgr,pos,d.opref.data(2));
6 12988 if d.opref.data(2)='V' then
6 12989 begin
7 12990 skrivtegn(tlgr,pos,
7 12991 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 12992 skrivtegn(tlgr,pos,
7 12993 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 12994 end;
6 12995 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 12996 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 12997 end
5 12998 else
5 12999 if opgave='H' then
5 13000 begin
6 13001 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 13002 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 13003 hægtstring(tlgr,pos,<:@@@:>);
6 13004 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 13005 skrivtegn(tlgr,pos,'A');
6 13006 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 13007 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 13008 if d.opref.data(2)='L' then
6 13009 begin
7 13010 if d.opref.data(5)=7 then
7 13011 begin
8 13012 anbringtal(tlgr,pos,
8 13013 d.opref.data(8) shift (-12) extract 10,-4);
8 13014 anbringtal(tlgr,pos,
8 13015 d.opref.data(8) extract 7,-2);
8 13016 end
7 13017 else
7 13018 if d.opref.data(5)=8 then
7 13019 begin
8 13020 hægtstring(tlgr,pos,<:FFFFFF:>);
8 13021 end;
7 13022 if d.opref.data(5)<>9 then
7 13023 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 13024 skrivtegn(tlgr,pos,
7 13025 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 13026 skrivtegn(tlgr,pos,
7 13027 dec_to_hex(d.opref.data(6) extract 4));
7 13028 skrivtegn(tlgr,10,pos-11+'@');
7 13029 end;
6 13030 end;
5 13031 end
4 13032 else
4 13033 if opgave='I' then
4 13034 begin
5 13035 hægtstring(tlgr,pos,<:IGA:>);
5 13036 end
4 13037 else d.opref.resultat:= 31; <*systemfejl*>
4 13038 end;
3 13039 \f
3 13039 message procedure radio_ud side 3 - 881107/cl;
3 13040
3 13040 if d.opref.resultat=0 then
3 13041 begin
4 13042 if (opgave <= 'B')
4 13043 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 13044 begin
5 13045 systime(1,0,d.opref.tid);
5 13046 signalch(cs_radio_ind,opref,d.opref.optype);
5 13047 opref:= 0;
5 13048 end;
4 13049 <* beregn checksum og send *>
4 13050 i:= 1; sum:= 0;
4 13051 while i < pos do
4 13052 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 13053 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 13054 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 13055 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 13056 <**********************************************>
4 13057 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 13058
4 13058 if opgave='B' then delay(1);
4 13059
4 13059 <* 94.04.19/cl *>
4 13060 <**********************************************>
4 13061
4 13061 <*+2*> if (testbit36 or testbit39) and overvåget then
4 13062 disable begin
5 13063 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 13064 outchar(zrl,'nl');
5 13065 end;
4 13066 <*-2*>
4 13067 setposition(z_rf_in,0,0);
4 13068 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 13069 disable setposition(z_rf_out,0,0);
4 13070 rc:= 0;
4 13071
4 13071 <* afvent svar*>
4 13072 repeat
4 13073 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 13074 if svar_status=6 then
4 13075 begin
5 13076 svar_status:= -3;
5 13077 goto radio_ud_check;
5 13078 end;
4 13079 pos:= 1;
4 13080 while læstegn(answ,pos,i)<>0 do ;
4 13081 pos:= pos-2;
4 13082 if pos > 0 then
4 13083 begin
5 13084 if pos<3 then
5 13085 svar_status:= -2 <*format error*>
5 13086 else
5 13087 begin
6 13088 if læstegn(answ,3,tegn)<>'@' then
6 13089 svar_status:= tegn - '@'
6 13090 else
6 13091 begin
7 13092 pos:= 1;
7 13093 læstegn(answ,pos,tegn);
7 13094 if tegn<>opgave then
7 13095 svar_status:= -4 <*gal type*>
7 13096 else
7 13097 if læstegn(answ,pos,tegn)<>' ' then
7 13098 svar_status:= -tegn <*fejl*>
7 13099 else
7 13100 svar_status:= læstegn(answ,pos,tegn)-'@';
7 13101 end;
6 13102 end;
5 13103 end
4 13104 else
4 13105 svar_status:= -1;
4 13106 \f
4 13106 message procedure radio_ud side 5 - 881107/cl;
4 13107
4 13107 radio_ud_check:
4 13108 rc:= rc+1;
4 13109 if -3<=svar_status and svar_status< -1 then
4 13110 disable begin
5 13111 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 13112 setposition(z_rf_out,0,0);
5 13113 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13114 begin
6 13115 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 13116 outchar(zrl,'nl');
6 13117 end;
5 13118 <*-2*>
5 13119 end
4 13120 else
4 13121 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 13122 disable begin
5 13123 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 13124 setposition(z_rf_out,0,0);
5 13125 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13126 begin
6 13127 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 13128 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 13129 end;
5 13130 <*-2*>
5 13131 end
4 13132 else
4 13133 if svar_status=0 and opref<>0 then
4 13134 d.opref.resultat:= 0
4 13135 else
4 13136 if opref<>0 then
4 13137 d.opref.resultat:= 31;
4 13138 until svar_status=0 or rc>3;
4 13139 end;
3 13140 if opref<>0 then
3 13141 begin
4 13142 if svar_status<>0 and rc>3 then
4 13143 d.opref.resultat:= 53; <* annulleret *>
4 13144 signalch(d.opref.retur,opref,d.opref.optype);
4 13145 opref:= 0;
4 13146 end;
3 13147 until false;
3 13148
3 13148 radio_ud_trap:
3 13149
3 13149 disable skriv_radio_ud(zbillede,1);
3 13150
3 13150 end radio_ud;
2 13151 \f
2 13151 message procedure radio_medd_opkald side 1 - 810610/hko;
2 13152
2 13152 procedure radio_medd_opkald;
2 13153 begin
3 13154 integer array field ref,op_ref;
3 13155 integer i;
3 13156
3 13156 procedure skriv_radio_medd_opkald(z,omfang);
3 13157 value omfang;
3 13158 zone z;
3 13159 integer omfang;
3 13160 begin integer x;
4 13161 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 13162 write(z,"sp",26-x);
4 13163 if omfang > 0 then
4 13164 disable begin
5 13165 trap(slut);
5 13166 write(z,"nl",1,
5 13167 <: ref: :>,ref,"nl",1,
5 13168 <: opref: :>,op_ref,"nl",1,
5 13169 <: i: :>,i,"nl",1,
5 13170 <::>);
5 13171 skriv_coru(z,abs curr_coruno);
5 13172 slut:
5 13173 end;<*disable*>
4 13174 end skriv_radio_medd_opkald;
3 13175
3 13175 trap(radio_medd_opkald_trap);
3 13176
3 13176 stack_claim((if cm_test then 200 else 150) +1);
3 13177
3 13177 <*+2*>if testbit32 and overvåget or testbit28 then
3 13178 disable skriv_radio_medd_opkald(out,0);
3 13179 <*-2*>
3 13180 \f
3 13180 message procedure radio_medd_opkald side 2 - 820301/hko;
3 13181
3 13181 repeat
3 13182
3 13182 <*V*> wait(bs_mobil_opkald);
3 13183 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 13184 <*V*> wait(bs_opkaldskø_adgang);
3 13185
3 13185 ref:= første_nød_opkald;
3 13186 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 13187 begin
4 13188 i:= opkaldskø.ref(2);
4 13189 if i < 0 then
4 13190 begin
5 13191 <* nødopkald ikke meldt *>
5 13192
5 13192 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 13193 d.op_ref.data(1):= <* vogn_id *>
5 13194 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 13195 opkaldskø.ref(2):= i extract 22;
5 13196 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 13197 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 13198 i:= op_ref;
5 13199 <*+2*> if testbit35 and overvåget then
5 13200 disable begin
6 13201 write(out,"nl",1,<:radio nød-medd:>);
6 13202 skriv_op(out,op_ref);
6 13203 ud;
6 13204 end;
5 13205 <*-2*>
5 13206 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 13207 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 13208 <*+4*> if i <> op_ref then
5 13209 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 13210 <*-4*>
5 13211 end;<*nødopkald ikke meldt*>
4 13212
4 13212 ref:= opkaldskø.ref(1) extract 12;
4 13213 end; <* melding til io *>
3 13214 \f
3 13214 message procedure radio_medd_opkald side 3 - 820304/hko;
3 13215
3 13215 start_operation(op_ref,403,cs_radio_medd,
3 13216 40<*opdater opkaldskøbill*>);
3 13217 signal_bin(bs_opkaldskø_adgang);
3 13218 <*+2*> if testbit35 and overvåget then
3 13219 disable begin
4 13220 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 13221 skriv_op(out,op_ref);
4 13222 write(out, <:opkaldsflag: :>,"nl",1);
4 13223 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 13224 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 13225 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 13226 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 13227 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 13228 ud;
4 13229 end;
3 13230 <*-2*>
3 13231 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 13232
3 13232 until false;
3 13233
3 13233 radio_medd_opkald_trap:
3 13234
3 13234 disable skriv_radio_medd_opkald(zbillede,1);
3 13235
3 13235 end radio_medd_opkald;
2 13236 \f
2 13236 message procedure radio_adm side 1 - 820301/hko;
2 13237
2 13237 procedure radio_adm(op);
2 13238 value op;
2 13239 integer op;
2 13240 begin
3 13241 integer array field opref, rad_op, iaf;
3 13242 integer nr,i,j,k,res,opgave,tilst,operatør;
3 13243
3 13243 procedure skriv_radio_adm(z,omfang);
3 13244 value omfang;
3 13245 zone z;
3 13246 integer omfang;
3 13247 begin integer i1;
4 13248 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 13249 write(z,"sp",26-i1);
4 13250 if omfang > 0 then
4 13251 disable begin real x;
5 13252 trap(slut);
5 13253 \f
5 13253 message procedure radio_adm side 2- 820301/hko;
5 13254
5 13254 write(z,"nl",1,
5 13255 <: op_ref: :>,op_ref,"nl",1,
5 13256 <: iaf: :>,iaf,"nl",1,
5 13257 <: rad-op: :>,rad_op,"nl",1,
5 13258 <: nr: :>,nr,"nl",1,
5 13259 <: i: :>,i,"nl",1,
5 13260 <: j: :>,j,"nl",1,
5 13261 <: k: :>,k,"nl",1,
5 13262 <: tilst: :>,tilst,"nl",1,
5 13263 <: res: :>,res,"nl",1,
5 13264 <: opgave: :>,opgave,"nl",1,
5 13265 <: operatør: :>,operatør,"nl",1);
5 13266 skriv_coru(z,coru_no(404));
5 13267 slut:
5 13268 end;<*disable*>
4 13269 end skriv_radio_adm;
3 13270 \f
3 13270 message procedure radio_adm side 3 - 820304/hko;
3 13271
3 13271 rad_op:= op;
3 13272
3 13272 trap(radio_adm_trap);
3 13273 stack_claim((if cm_test then 200 else 150) +50);
3 13274
3 13274 <*+2*>if testbit32 and overvåget or testbit28 then
3 13275 skriv_radio_adm(out,0);
3 13276 <*-2*>
3 13277
3 13277 pass;
3 13278 if -,testbit22 then
3 13279 begin
4 13280 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13281 signalch(cs_radio_ud,rad_op,rad_optype);
4 13282 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13283 end;
3 13284 repeat
3 13285 waitch(cs_radio_adm,opref,true,-1);
3 13286 <*+2*>
3 13287 if testbit33 and overvåget then
3 13288 disable begin
4 13289 skriv_radio_adm(out,0);
4 13290 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 13291 skriv_op(out,opref);
4 13292 end;
3 13293 <*-2*>
3 13294
3 13294 k:= d.op_ref.opkode extract 12;
3 13295 opgave:= d.opref.opkode shift (-12);
3 13296 nr:=operatør:=d.op_ref.data(1);
3 13297
3 13297 <*+4*> if (d.op_ref.optype and
3 13298 (gen_optype or io_optype or op_optype or vt_optype))
3 13299 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 13300 <:radio_adm:>,0);
3 13301 <*-4*>
3 13302 if k = 74 <* RA,I *> then
3 13303 begin
4 13304 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13305 signalch(cs_radio_ud,rad_op,rad_optype);
4 13306 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13307 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 13308 else d.rad_op.resultat;
4 13309 signalch(d.opref.retur,opref,d.opref.optype);
4 13310 \f
4 13310 message procedure radio_adm side 4 - 820301/hko;
4 13311 end
3 13312 else
3 13313
3 13313 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 13314 k = 5<*FO,L*> or k = 6<*ST *> then
3 13315 begin
4 13316 if k = 5 or k=77 then
4 13317 begin
5 13318
5 13318 <*V*> wait(bs_opkaldskø_adgang);
5 13319 if k=5 then
5 13320 begin
6 13321 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 13322 begin
7 13323 i:= læs_fil(1035,iaf//512+1,nr);
7 13324 if i <> 0 then
7 13325 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 13326 tofrom(radio_linietabel.iaf,fil(nr),
7 13327 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 13328 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 13329 end;
6 13330
6 13330 for i:= 1 step 1 until max_antal_mobilopkald do
6 13331 begin
7 13332 iaf:= i*opkaldskø_postlængde;
7 13333 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 13334 if nr>0 then
7 13335 begin
8 13336 læs_tegn(radio_linietabel,nr+1,operatør);
8 13337 if operatør>max_antal_operatører then operatør:= 0;
8 13338 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 13339 operatør;
8 13340 end;
7 13341 end;
6 13342 end
5 13343 else
5 13344 if k=77 then
5 13345 begin
6 13346 disable i:= læsfil(1034,1,nr);
6 13347 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 13348 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 13349 for i:= 1 step 1 until max_antal_mobilopkald do
6 13350 begin
7 13351 iaf:= i*opkaldskø_postlængde;
7 13352 nr:= opkaldskø.iaf(5) extract 4;
7 13353 operatør:= radio_områdetabel(nr);
7 13354 if operatør < 0 or max_antal_operatører < operatør then
7 13355 operatør:= 0;
7 13356 if opkaldskø.iaf(4) extract 8=0 and
7 13357 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13358 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13359 operatør;
7 13360 end;
6 13361 end;
5 13362
5 13362 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13363 signal_bin(bs_opkaldskø_adgang);
5 13364
5 13364 signal_bin(bs_mobil_opkald);
5 13365
5 13365 d.op_ref.resultat:= res:= 3;
5 13366 \f
5 13366 message procedure radio_adm side 5 - 820304/hko;
5 13367
5 13367 end <*k = 5 / k = 77*>
4 13368 else
4 13369 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13370 res:= 3;
5 13371 for nr:= 1 step 1 until max_antal_kanaler do
5 13372 begin
6 13373 iaf:= (nr-1)*kanal_beskr_længde;
6 13374 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13375 op_talevej(operatør) then
6 13376 begin
7 13377 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13378 if tilst <> 0 then
7 13379 res:= 16; <*skærm optaget*>
7 13380 end; <* kanal_tab(operatør) = operatør*>
6 13381 end;
5 13382 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13383 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13384 signal_bin(bs_mobil_opkald);
5 13385 d.op_ref.resultat:= res;
5 13386 end;<*k=1,2 eller 6 *>
4 13387
4 13387 <*+2*> if testbit35 and overvåget then
4 13388 disable begin
5 13389 skriv_radio_adm(out,0);
5 13390 write(out,<: sender til :>,
5 13391 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13392 else cs_op);
5 13393 skriv_op(out,op_ref);
5 13394 end;
4 13395 <*-2*>
4 13396
4 13396 if k=5 or k=6 or k=77 or res > 3 then
4 13397 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13398 else
4 13399 begin <*k = (1 eller 2) og res = 3 *>
5 13400 d.op_ref.resultat:=0;
5 13401 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13402 end;
4 13403 \f
4 13403 message procedure radio_adm side 6 - 816610/hko;
4 13404
4 13404 end <*k=1,2,5 eller 6*>
3 13405 else
3 13406 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13407 begin
4 13408 nr:= d.op_ref.data(1);
4 13409 res:= 3;
4 13410
4 13410 if nr<=3 then
4 13411 res:= 51 <* afvist *>
4 13412 else
4 13413 begin
5 13414
5 13414 <* gennemstilling af område *>
5 13415 j:= 1;
5 13416 for i:= 1 step 1 until max_antal_kanaler do
5 13417 begin
6 13418 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13419 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13420 end;
5 13421 nr:= j;
5 13422 iaf:= (nr-1)*kanalbeskrlængde;
5 13423 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13424 begin
6 13425 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13426 d.rad_op.data(1):= 0;
6 13427 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13428 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13429 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13430 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13431 signalch(cs_radio_ud,rad_op,rad_optype);
6 13432 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13433 res:= d.rad_op.resultat;
6 13434 if res=0 then res:= 3;
6 13435 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13436 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13437 end;
5 13438 end;
4 13439 d.op_ref.resultat:=res;
4 13440 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13441 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13442 signal_bin(bs_mobil_opkald);
4 13443 \f
4 13443 message procedure radio_adm side 7 - 880930/cl;
4 13444
4 13444
4 13444 end <* k=3 eller 4 *>
3 13445 else
3 13446 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13447 begin
4 13448 nr:= d.opref.data(1) extract 22;
4 13449 res:= 3;
4 13450 iaf:= (nr-1)*kanalbeskrlængde;
4 13451 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13452 d.rad_op.data(1):= 0;
4 13453 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13454 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13455 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13456 d.rad_op.data(5):= k extract 1;
4 13457 signalch(cs_radio_ud,radop,rad_optype);
4 13458 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13459 res:= d.radop.resultat;
4 13460 if res=0 then res:= 3;
4 13461 j:= if k=72 then 15 else 0;
4 13462 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13463 begin
5 13464 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13465 signalbin(bs_mobilopkald);
5 13466 end;
4 13467 d.opref.resultat:= res;
4 13468 signalch(d.opref.retur,opref,d.opref.optype);
4 13469 end
3 13470 else
3 13471 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13472 begin
4 13473 nr:= d.opref.data(1) extract 8;
4 13474 opgave:= if k=19 then 9 else (k-4);
4 13475 if nr<=3 then
4 13476 res:= 51 <*afvist*>
4 13477 else
4 13478 begin
5 13479 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13480 d.radop.data(1):= 0;
5 13481 d.radop.data(2):= 'L';
5 13482 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13483 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13484 d.radop.data(5):= opgave;
5 13485 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13486 d.radop.data(7):= d.opref.data(2);
5 13487 d.radop.data(8):= d.opref.data(3);
5 13488 signalch(cs_radio_ud,radop,rad_optype);
5 13489 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13490 res:= d.radop.resultat;
5 13491 if res=0 then res:= 3;
5 13492 end;
4 13493 d.opref.resultat:= res;
4 13494 signalch(d.opref.retur,opref,d.opref.optype);
4 13495 end
3 13496 else
3 13497
3 13497 begin
4 13498
4 13498 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13499
4 13499 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13500
4 13500 end;
3 13501
3 13501 until false;
3 13502 radio_adm_trap:
3 13503 disable skriv_radio_adm(zbillede,1);
3 13504 end radio_adm;
2 13505
2 13505 \f
2 13505 message vogntabel erklæringer side 1 - 820301/cl;
2 13506
2 13506 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13507 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13508 cs_vt_log;
2 13509 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13510 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13511 vt_log_slicelgd;
2 13512 integer array bustabel,bustabel1(0:max_antal_busser),
2 13513 linie_løb_tabel(0:max_antal_linie_løb),
2 13514 springtabel(1:max_antal_spring,1:3),
2 13515 gruppetabel(1:max_antal_grupper),
2 13516 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13517 vt_logop(1:2),
2 13518 vt_logdisc(1:4),
2 13519 vt_log_tail(1:10);
2 13520 boolean array busindeks(-1:max_antal_linie_løb),
2 13521 bustilstand(-1:max_antal_busser),
2 13522 linie_løb_indeks(-1:max_antal_busser);
2 13523 real array springtid,springstart(1:max_antal_spring);
2 13524 real vt_logstart;
2 13525 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13526 integer array field v_tekst;
2 13527 real field v_tid;
2 13528
2 13528 zone zvtlog(128,1,stderror);
2 13529
2 13529 \f
2 13529 message vogntabel erklæringer side 2 - 851001/cl;
2 13530
2 13530 procedure skriv_vt_variable(zud);
2 13531 zone zud;
2 13532 begin integer i; long array field laf;
3 13533 laf:= 0;
3 13534 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13535 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13536 <:cs-vt :>,cs_vt,"nl",1,
3 13537 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13538 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13539 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13540 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13541 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13542 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13543 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13544 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13545 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13546 <:vt-op :>,vt_op,"nl",1,
3 13547 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13548 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13549 <:sidste-bus :>,sidste_bus,"nl",1,
3 13550 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13551 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13552 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13553 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13554 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13555 <:tf-springdef :>,tf_springdef,"nl",1,
3 13556 <:vt-logskift :>,vt_logskift,"nl",1,
3 13557 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13558 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13559 <:vt-log-aktiv :>,
3 13560 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13561 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13562 <::>);
3 13563 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13564 laf:= 2;
3 13565 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13566 for i:= 6 step 1 until 10 do
3 13567 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13568 write(zud,"nl",1);
3 13569 end;
2 13570 \f
2 13570 message procedure p_vogntabel side 1 - 820301/cl;
2 13571
2 13571 procedure p_vogntabel(z);
2 13572 zone z;
2 13573 begin
3 13574 integer i,b,s,o,t,li,lb,lø,g;
3 13575 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13576 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13577 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13578 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13579
3 13579 for i:= 1 step 1 until sidste_bus do
3 13580 begin
4 13581 b:= bustabel(i) extract 14;
4 13582 g:= bustabel(i) shift (-14);
4 13583 s:= bustabel1(i) shift (-23);
4 13584 o:= bustabel1(i) extract 8;
4 13585 t:= intg(bustilstand(i));
4 13586 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13587 lø:= li extract 7;
4 13588 lb:= li shift (-7) extract 5;
4 13589 lb:= if lb=0 then 32 else lb+64;
4 13590 li:= li shift (-12) extract 10;
4 13591 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13592 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13593 if g > 0 then string bpl_navn(g) else <: :>,
4 13594 ";",1,true,4,string område_navn(o),
4 13595 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13596 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13597 end;
3 13598 end p_vogntabel;
2 13599 \f
2 13599 message procedure p_gruppetabel side 1 - 810531/cl;
2 13600
2 13600 procedure p_gruppetabel(z);
2 13601 zone z;
2 13602 begin
3 13603 integer i,nr,bogst;
3 13604 boolean spc_gr;
3 13605 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13606 <:max-antal-grupper =:>,max_antal_grupper,
3 13607 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13608 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13609 <:gruppetabel::>);
3 13610 for i:= 1 step 1 until max_antal_grupper do
3 13611 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13612 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13613 gruppetabel(i) extract 7);
3 13614 write(z,"nl",2,<:gruppeopkald::>);
3 13615 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13616 begin
4 13617 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13618 if gruppeopkald(i,1) = 0 then
4 13619 write(z,"sp",11)
4 13620 else
4 13621 begin
5 13622 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13623 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13624 else
5 13625 begin
6 13626 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13627 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13628 if bogst = '@' then bogst:= 'sp';
6 13629 end;
5 13630 if spc_gr then
5 13631 write(z,<:(G:>,<<d>,true,3,nr)
5 13632 else
5 13633 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13634 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13635 end;
4 13636 end;
3 13637 end p_gruppetabel;
2 13638 \f
2 13638 message procedure p_springtabel side 1 - 810519/cl;
2 13639
2 13639 procedure p_springtabel(z);
2 13640 zone z;
2 13641 begin
3 13642 integer li,bo,max,st,nr;
3 13643 long indeks;
3 13644 real t;
3 13645
3 13645 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13646 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13647 <:nr spring-id max status næste-tid:>,"nl",1);
3 13648 for nr:= 1 step 1 until max_antal_spring do
3 13649 begin
4 13650 write(z,<<dd>,nr);
4 13651 <* if springtabel(nr,1)<>0 then *>
4 13652 begin
5 13653 li:= springtabel(nr,1) shift (-5) extract 10;
5 13654 bo:= springtabel(nr,1) extract 5;
5 13655 if bo<>0 then bo:= bo + 'A' - 1;
5 13656 indeks:= extend springtabel(nr,2) shift 24;
5 13657 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13658 max:= springtabel(nr,3) extract 12;
5 13659 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13660 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13661 if springtid(nr)<>0.0 then
5 13662 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13663 else
5 13664 write(z,<< d.d >,0.0);
5 13665 if springstart(nr)<>0.0 then
5 13666 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13667 else
5 13668 write(z,<< d.d >,0.0);
5 13669 end
4 13670 <* else
4 13671 write(z,<: --------:>)*>;
4 13672 write(z,"nl",1);
4 13673 end;
3 13674 end p_springtabel;
2 13675 \f
2 13675 message procedure find_busnr side 1 - 820301/cl;
2 13676
2 13676 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13677 value ll_id;
2 13678 integer ll_id, busnr, garage, tilst;
2 13679 begin
3 13680 integer i,j;
3 13681
3 13681 j:= binærsøg(sidste_linie_løb,
3 13682 (linie_løb_tabel(i) - ll_id), i);
3 13683 if j<>0 then <* linie/løb findes ikke *>
3 13684 begin
4 13685 find_busnr:= -1;
4 13686 busnr:= 0;
4 13687 garage:= 0;
4 13688 tilst:= 0;
4 13689 end
3 13690 else
3 13691 begin
4 13692 busnr:= bustabel(busindeks(i) extract 12);
4 13693 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13694 garage:= busnr shift (-14);
4 13695 busnr:= busnr extract 14;
4 13696 find_busnr:= busindeks(i) extract 12;
4 13697 end;
3 13698 end find_busnr;
2 13699 \f
2 13699 message procedure søg_omr_bus side 1 - 881027/cl;
2 13700
2 13700
2 13700 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13701 value bus;
2 13702 integer bus,ll,gar,omr,sig,tilst;
2 13703 begin
3 13704 integer i,j,nr,bu,bi,bl;
3 13705
3 13705 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13706 nr:= -1;
3 13707 if j=0 then
3 13708 begin
4 13709 bl:= bu:= bi;
4 13710 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13711 while bu<sidste_bus and
4 13712 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13713
4 13713 if bl<>bu then
4 13714 begin
5 13715 <* flere busser med samme tekniske nr. omr skal passe *>
5 13716 nr:= -2;
5 13717 for bi:= bl step 1 until bu do
5 13718 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13719 end
4 13720 else
4 13721 nr:= bi;
4 13722 end;
3 13723
3 13723 if nr<0 then
3 13724 begin
4 13725 <* bus findes ikke *>
4 13726 ll:= gar:= tilst:= sig:= 0;
4 13727 end
3 13728 else
3 13729 begin
4 13730 tilst:= intg(bustilstand(nr));
4 13731 gar:= bustabel(nr) shift (-14);
4 13732 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13733 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13734 sig:= bustabel1(nr) shift (-23);
4 13735 end;
3 13736 søg_omr_bus:= nr;
3 13737 end;
2 13738 \f
2 13738 message procedure find_linie_løb side 1 - 820301/cl;
2 13739
2 13739 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13740 value busnr;
2 13741 integer busnr, linie_løb, garage, tilst;
2 13742 begin
3 13743 integer i,j;
3 13744
3 13744 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13745
3 13745 if j<>0 then <* bus findes ikke *>
3 13746 begin
4 13747 find_linie_løb:= -1;
4 13748 linie_løb:= 0;
4 13749 garage:= 0;
4 13750 tilst:= 0;
4 13751 end
3 13752 else
3 13753 begin
4 13754 tilst:= intg(bustilstand(i));
4 13755 garage:= bustabel(i) shift (-14);
4 13756 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13757 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13758 end;
3 13759 end find_linie_løb;
2 13760 \f
2 13760 message procedure h_vogntabel side 1 - 810413/cl;
2 13761
2 13761 <* hovedmodulcorutine for vogntabelmodul *>
2 13762
2 13762 procedure h_vogntabel;
2 13763 begin
3 13764 integer array field op;
3 13765 integer dest_sem,k;
3 13766
3 13766 procedure skriv_h_vogntabel(zud,omfang);
3 13767 value omfang;
3 13768 zone zud;
3 13769 integer omfang;
3 13770 begin
4 13771 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13772 if omfang<>0 then
4 13773 disable
4 13774 begin
5 13775 skriv_coru(zud,abs curr_coruno);
5 13776 write(zud,"nl",1,<<d>,
5 13777 <:cs-vt :>,cs_vt,"nl",1,
5 13778 <:op :>,op,"nl",1,
5 13779 <:dest-sem :>,dest_sem,"nl",1,
5 13780 <:k :>,k,"nl",1,
5 13781 <::>);
5 13782 end;
4 13783 end;
3 13784 \f
3 13784 message procedure h_vogntabel side 2 - 820301/cl;
3 13785
3 13785 stackclaim(if cm_test then 198 else 146);
3 13786 trap(h_vt_trap);
3 13787
3 13787 <*+2*>
3 13788 <**> disable if testbit47 and overvåget or testbit28 then
3 13789 <**> skriv_h_vogntabel(out,0);
3 13790 <*-2*>
3 13791
3 13791 repeat
3 13792 waitch(cs_vt,op,true,-1);
3 13793 <*+4*>
3 13794 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13795 (d.op.optype and vt_optype) extract 12 = 0 then
3 13796 fejlreaktion(12,op,<:vogntabel:>,0);
3 13797 <*-4*>
3 13798 disable
3 13799 begin
4 13800
4 13800 k:= d.op.opkode extract 12;
4 13801 dest_sem:=
4 13802 if k = 9 then cs_vt_rap else
4 13803 if k = 10 then cs_vt_rap else
4 13804 if k = 11 then cs_vt_opd else
4 13805 if k = 12 then cs_vt_opd else
4 13806 if k = 13 then cs_vt_opd else
4 13807 if k = 14 then cs_vt_tilst else
4 13808 if k = 15 then cs_vt_tilst else
4 13809 if k = 16 then cs_vt_tilst else
4 13810 if k = 17 then cs_vt_tilst else
4 13811 if k = 18 then cs_vt_tilst else
4 13812 if k = 19 then cs_vt_opd else
4 13813 if k = 20 then cs_vt_opd else
4 13814 if k = 21 then cs_vt_auto else
4 13815 if k = 24 then cs_vt_opd else
4 13816 if k = 25 then cs_vt_grp else
4 13817 if k = 26 then cs_vt_grp else
4 13818 if k = 27 then cs_vt_grp else
4 13819 if k = 28 then cs_vt_grp else
4 13820 if k = 30 then cs_vt_spring else
4 13821 if k = 31 then cs_vt_spring else
4 13822 if k = 32 then cs_vt_spring else
4 13823 if k = 33 then cs_vt_spring else
4 13824 if k = 34 then cs_vt_spring else
4 13825 if k = 35 then cs_vt_spring else
4 13826 -1;
4 13827 \f
4 13827 message procedure h_vogntabel side 3 - 810422/cl;
4 13828
4 13828 <*+2*>
4 13829 <**> if testbit41 and overvåget then
4 13830 <**> begin
5 13831 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13832 <**> skriv_op(out,op);
5 13833 <**> end;
4 13834 <*-2*>
4 13835 end;
3 13836
3 13836 if dest_sem = -1 then
3 13837 fejlreaktion(2,k,<:vogntabel:>,0);
3 13838 disable signalch(dest_sem,op,d.op.optype);
3 13839 until false;
3 13840 h_vt_trap:
3 13841 disable skriv_h_vogntabel(zbillede,1);
3 13842 end h_vogntabel;
2 13843 \f
2 13843 message procedure vt_opdater side 1 - 810317/cl;
2 13844
2 13844 procedure vt_opdater(op1);
2 13845 value op1;
2 13846 integer op1;
2 13847 begin
3 13848 integer array field op,radop;
3 13849 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13850 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13851 flin,slin,finx,sinx;
3 13852 integer field bn,ll;
3 13853
3 13853 procedure skriv_vt_opd(zud,omfang);
3 13854 value omfang; integer omfang;
3 13855 zone zud;
3 13856 begin
4 13857 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13858 if omfang <> 0 then
4 13859 disable
4 13860 begin
5 13861 skriv_coru(zud,abs curr_coruno);
5 13862 write(zud,"nl",1,
5 13863 <: op: :>,op,"nl",1,
5 13864 <: radop::>,radop,"nl",1,
5 13865 <: funk: :>,funk,"nl",1,
5 13866 <: res: :>,res,"nl",1,
5 13867 <::>);
5 13868 end;
4 13869 end skriv_vt_opd;
3 13870
3 13870 integer procedure opd_omr(fnk,omr,bus,ll);
3 13871 value fnk,omr,bus,ll;
3 13872 integer fnk,omr,bus,ll;
3 13873 begin
4 13874 opd_omr:= 3;
4 13875 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13876 ændringer skal ikke længere meldes til yderområder *>
4 13877 goto dummy_retur;
4 13878
4 13878 if omr extract 8 > 3 then
4 13879 begin
5 13880 startoperation(radop,501,cs_vt_opd,fnk);
5 13881 d.radop.data(1):= omr;
5 13882 d.radop.data(2):= bus;
5 13883 d.radop.data(3):= ll;
5 13884 signalch(cs_rad,radop,vt_optype);
5 13885 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13886 opd_omr:= d.radop.resultat;
5 13887 end
4 13888 else
4 13889 opd_omr:= 0;
4 13890 dummy_retur:
4 13891 end;
3 13892 message procedure vt_opdater side 1a - 920517/cl;
3 13893
3 13893 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13894 value kilde,kode,bus,ll1,ll2;
3 13895 integer kilde,kode,bus,ll1,ll2;
3 13896 begin
4 13897 integer array field op;
4 13898
4 13898 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13899
4 13899 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13900 systime(1,0.0,d.op.data.v_tid);
4 13901 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13902 d.op.data.v_bus:= bus;
4 13903 d.op.data.v_ll1:= ll1;
4 13904 d.op.data.v_ll2:= ll2;
4 13905 signalch(cs_vt_log,op,vt_optype);
4 13906 end;
3 13907
3 13907 stackclaim((if cm_test then 198 else 146)+125);
3 13908
3 13908 bn:= 4; ll:= 2;
3 13909 radop:= op1;
3 13910 trap(vt_opd_trap);
3 13911
3 13911 <*+2*>
3 13912 <**> disable if testbit47 and overvåget or testbit28 then
3 13913 <**> skriv_vt_opd(out,0);
3 13914 <*-2*>
3 13915 \f
3 13915 message procedure vt_opdater side 2 - 851001/cl;
3 13916
3 13916 vent_op:
3 13917 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13918
3 13918 <*+2*>
3 13919 <**> disable
3 13920 <**> if testbit41 and overvåget then
3 13921 <**> begin
4 13922 <**> skriv_vt_opd(out,0);
4 13923 <**> write(out,<: modtaget operation:>);
4 13924 <**> skriv_op(out,op);
4 13925 <**> end;
3 13926 <*-2*>
3 13927
3 13927 <*+4*>
3 13928 <**>if op<>vt_op then
3 13929 <**>begin
4 13930 <**> disable begin
5 13931 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13932 <**> d.op.resultat:= 31; <*systemfejl*>
5 13933 <**> signalch(d.op.retur,op,d.op.optype);
5 13934 <**> end;
4 13935 <**> goto vent_op;
4 13936 <**>end;
3 13937 <*-4*>
3 13938 disable
3 13939 begin integer opk;
4 13940
4 13940 opk:= d.op.opkode extract 12;
4 13941 funk:= if opk=11 then 1 else
4 13942 if opk=12 then 2 else
4 13943 if opk=13 then 3 else
4 13944 if opk=19 then 4 else
4 13945 if opk=20 then 5 else
4 13946 if opk=24 then 6 else
4 13947 0;
4 13948 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13949 end;
3 13950 res:= 0;
3 13951 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13952 \f
3 13952 message procedure vt_opdater side 3 - 820301/cl;
3 13953
3 13953 indsæt:
3 13954 begin
4 13955 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13956 <*+4*>
4 13957 <**> if d.op.data(1) shift (-22) <> 0 then
4 13958 <**> begin
5 13959 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13960 <**> goto slut_indsæt;
5 13961 <**> end;
4 13962 <*-4*>
4 13963 busnr:= d.op.data(1) extract 14;
4 13964 <*+4*>
4 13965 <**> if d.op.data(2) shift (-22) <> 1 then
4 13966 <**> begin
5 13967 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13968 <**> goto slut_indsæt;
5 13969 <**> end;
4 13970 <*-4*>
4 13971 ll_id:= d.op.data(2);
4 13972 s:= omr:= d.op.data(4) extract 8;
4 13973 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13974 if bi<0 then
4 13975 begin
5 13976 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13977 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13978 end
4 13979 else
4 13980 if s<>0 and s<>omr then
4 13981 res:= 58 <* ulovligt område for bus *>
4 13982 else
4 13983 if intg(bustilstand(bi)) <> 0 then
4 13984 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 13985 else 14 <* optaget *>)
4 13986 else
4 13987 begin
5 13988 if linie_løb_indeks(bi) extract 12 <> 0 then
5 13989 begin <* linie/løb allerede indsat *>
6 13990 res:= 11;
6 13991 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 13992 end
5 13993 else
5 13994 begin
6 13995 \f
6 13995 message procedure vt_opdater side 3a - 900108/cl;
6 13996
6 13996 if d.op.kilde//100 <> 4 then
6 13997 res:= opd_omr(11,gar shift 8 +
6 13998 bustabel1(bi) extract 8,busnr,ll_id);
6 13999 if res>3 then goto slut_indsæt;
6 14000 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 14001 if s=0 then <* linie/løb findes allerede *>
6 14002 begin
7 14003 sig:= busindeks(li) extract 12;
7 14004 d.op.data(3):= bustabel(sig);
7 14005 linie_løb_indeks(sig):= false;
7 14006 disable modiffil(tf_vogntabel,sig,zi);
7 14007 fil(zi).ll:= 0;
7 14008 fil(zi).bn:= bustabel(sig) extract 14 add
7 14009 (bustabel1(sig) extract 8 shift 14);
7 14010 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 14011
7 14011 linie_løb_indeks(bi):= false add li;
7 14012 busindeks(li):= false add bi;
7 14013 disable modiffil(tf_vogntabel,bi,zi);
7 14014 fil(zi).ll:= ll_id;
7 14015 fil(zi).bn:= bustabel(bi) extract 14 add
7 14016 (bustabel1(bi) extract 8 shift 14);
7 14017 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 14018 res:= 3;
7 14019 end
6 14020 else
6 14021 begin
7 14022 \f
7 14022 message procedure vt_opdater side 4 - 810527/cl;
7 14023
7 14023 if s<0 then li:= li +1;
7 14024 if sidste_linie_løb=max_antal_linie_løb then
7 14025 begin
8 14026 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 14027 res:= 31;
8 14028 end
7 14029 else
7 14030 begin
8 14031 for i:= sidste_linie_løb step -1 until li do
8 14032 begin
9 14033 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 14034 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 14035 bus_indeks(i+1):=bus_indeks(i);
9 14036 end;
8 14037 sidste_linie_løb:= sidste_linie_løb +1;
8 14038 linie_løb_tabel(li):= ll_id;
8 14039 linie_løb_indeks(bi):= false add li;
8 14040 busindeks(li):= false add bi;
8 14041 disable s:= modiffil(tf_vogntabel,bi,zi);
8 14042 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 14043 fil(zi).bn:= busnr extract 14 add
8 14044 (bustabel1(bi) extract 8 shift 14);
8 14045 fil(zi).ll:= ll_id;
8 14046 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 14047 res:= 3; <* ok *>
8 14048 end;
7 14049 end;
6 14050 end;
5 14051 end;
4 14052 slut_indsæt:
4 14053 d.op.resultat:= res;
4 14054 end;
3 14055 goto returner;
3 14056 \f
3 14056 message procedure vt_opdater side 5 - 820301/cl;
3 14057
3 14057 udtag:
3 14058 begin
4 14059 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 14060
4 14060 busnr:= ll_id:= 0;
4 14061 omr:= s:= d.op.data(2) extract 8;
4 14062 format:= d.op.data(1) shift (-22);
4 14063 if format=0 then <*busnr*>
4 14064 begin
5 14065 busnr:= d.op.data(1) extract 14;
5 14066 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 14067 if bi<0 then
5 14068 begin
6 14069 if bi=-1 then res:= 10 else
6 14070 if s<>0 then res:= 58 else res:= 57;
6 14071 goto slut_udtag;
6 14072 end;
5 14073 if bi>0 and s<>0 and s<>omr then
5 14074 begin
6 14075 res:= 58; goto slut_udtag;
6 14076 end;
5 14077 li:= linie_løb_indeks(bi) extract 12;
5 14078 busnr:= bustabel(bi);
5 14079 if li=0 or linie_løb_tabel(li)=0 then
5 14080 begin <* bus ej indsat *>
6 14081 res:= 13;
6 14082 goto slut_udtag;
6 14083 end;
5 14084 ll_id:= linie_løb_tabel(li);
5 14085 end
4 14086 else
4 14087 if format=1 then <* linie_løb *>
4 14088 begin
5 14089 ll_id:= d.op.data(1);
5 14090 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 14091 if s<>0 then
5 14092 begin <* linie/løb findes ikke *>
6 14093 res:= 9;
6 14094 goto slut_udtag;
6 14095 end;
5 14096 bi:= busindeks(li) extract 12;
5 14097 busnr:= bustabel(bi);
5 14098 end
4 14099 else <* ulovlig identifikation *>
4 14100 begin
5 14101 res:= 31;
5 14102 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 14103 goto slut_udtag;
5 14104 end;
4 14105 \f
4 14105 message procedure vt_opdater side 6 - 820301/cl;
4 14106
4 14106 tilst:= intg(bustilstand(bi));
4 14107 if tilst<>0 then
4 14108 begin
5 14109 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 14110 goto slut_udtag;
5 14111 end;
4 14112 if d.op.kilde//100 <> 4 then
4 14113 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 14114 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 14115 if res>3 then goto slut_udtag;
4 14116 linie_løb_indeks(bi):= false;
4 14117 for i:= li step 1 until sidste_linie_løb -1 do
4 14118 begin
5 14119 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 14120 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 14121 bus_indeks(i):= bus_indeks(i+1);
5 14122 end;
4 14123 linie_løb_tabel(sidste_linie_løb):= 0;
4 14124 bus_indeks(sidste_linie_løb):= false;
4 14125 sidste_linie_løb:= sidste_linie_løb -1;
4 14126 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 14127 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 14128 fil(zi).ll:= 0;
4 14129 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 14130 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 14131 res:= 3; <* ok *>
4 14132 slut_udtag:
4 14133 d.op.resultat:= res;
4 14134 d.op.data(2):= ll_id;
4 14135 d.op.data(3):= busnr;
4 14136 end;
3 14137 goto returner;
3 14138 \f
3 14138 message procedure vt_opdater side 7 - 851001/cl;
3 14139
3 14139 omkod:
3 14140 flyt:
3 14141 roker:
3 14142 begin
4 14143 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 14144
4 14144 inf1:= inf2:= 0;
4 14145 ll_id1:= d.op.data(1);
4 14146 ll_id2:= d.op.data(2);
4 14147 if ll_id1=ll_id2 then
4 14148 begin
5 14149 res:= 24; inf1:= ll_id2;
5 14150 goto slut_flyt;
5 14151 end;
4 14152 <*+4*>
4 14153 <**> for i:= 1,2 do
4 14154 <**> if d.op.data(i) shift (-22) <> 1 then
4 14155 <**> begin
5 14156 <**> res:= 31;
5 14157 <**> fejlreaktion(10,d.op.data(i),case i of (
5 14158 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 14159 <**> goto slut_flyt;
5 14160 <**> end;
4 14161 <*-4*>
4 14162
4 14162 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 14163 if s<>0 and funk=6 <* roker *> then
4 14164 begin
5 14165 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 14166 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 14167 end;
4 14168 if s<>0 then
4 14169 begin
5 14170 res:= 9; <* ukendt linie/løb *>
5 14171 goto slut_flyt;
5 14172 end;
4 14173 bi1:= busindeks(li1) extract 12;
4 14174 inf1:= bustabel(bi1);
4 14175 tilst:= intg(bustilstand(bi1));
4 14176 if tilst<>0 then <* bus ikke fri *>
4 14177 begin
5 14178 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 14179 goto slut_flyt;
5 14180 end;
4 14181 \f
4 14181 message procedure vt_opdater side 7a- 851001/cl;
4 14182 if d.op.kilde//100 <> 4 then
4 14183
4 14183 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 14184 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 14185 if res>3 then goto slut_flyt;
4 14186
4 14186 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 14187 if s=0 then
4 14188 begin <* ll_id2 er indkodet *>
5 14189 bi2:= busindeks(li2) extract 12;
5 14190 inf2:= bustabel(bi2);
5 14191 tilst:= intg(bustilstand(bi2));
5 14192 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 14193 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 14194 if res>3 then
5 14195 begin
6 14196 inf1:= inf2; inf2:= 0;
6 14197 goto slut_flyt;
6 14198 end;
5 14199
5 14199 if d.op.kilde//100 <> 4 then
5 14200 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 14201 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 14202 if res>3 then goto slut_flyt;
5 14203
5 14203 <* flyt bus *>
5 14204 if funk=6 then
5 14205 linie_løb_indeks(bi2):= false add li1
5 14206 else
5 14207 linie_løb_indeks(bi2):= false;
5 14208 linie_løb_indeks(bi1):= false add li2;
5 14209 if funk=6 then
5 14210 busindeks(li1):= false add bi2
5 14211 else
5 14212 busindeks(li1):= false;
5 14213 busindeks(li2):= false add bi1;
5 14214
5 14214 if funk<>6 then
5 14215 begin
6 14216 <* fjern ll_id1 *>
6 14217 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 14218 begin
7 14219 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 14220 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 14221 busindeks(i):= busindeks(i+1);
7 14222 end;
6 14223 linie_løb_tabel(sidste_linie_løb):= 0;
6 14224 bus_indeks(sidste_linie_løb):= false;
6 14225 sidste_linie_løb:= sidste_linie_løb-1;
6 14226 end;
5 14227
5 14227 <* opdater vogntabelfil *>
5 14228 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 14229 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14230 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 14231 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 14232 if funk=6 then
5 14233 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 14234 else
5 14235 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 14236 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14237 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14238 fil(zi).ll:= ll_id2;
5 14239 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14240 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14241 \f
5 14241 message procedure vt_opdater side 8 - 820301/cl;
5 14242
5 14242 end <* ll_id2 indkodet *>
4 14243 else
4 14244 begin
5 14245 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 14246 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 14247 pm1:= sgn(li2-li1);
5 14248 for i:= li1 step pm1 until li2-pm1 do
5 14249 begin
6 14250 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 14251 busindeks(i):= busindeks(i+pm1);
6 14252 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 14253 end;
5 14254 linie_løb_tabel(li2):= ll_id2;
5 14255 busindeks(li2):= false add bi1;
5 14256 linie_løb_indeks(bi1):= false add li2;
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 end;
4 14263 res:= 3; <*udført*>
4 14264 slut_flyt:
4 14265 d.op.resultat:= res;
4 14266 d.op.data(3):= inf1;
4 14267 if funk=5 then d.op.data(4):= inf2;
4 14268 end;
3 14269 goto returner;
3 14270 \f
3 14270 message procedure vt_opdater side 9 - 851001/cl;
3 14271
3 14271 slet:
3 14272 begin
4 14273 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 14274 boolean test24;
4 14275
4 14275 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 14276 omr:= d.op.data(3);
4 14277
4 14277 if d.op.data(1) > d.op.data(2) then
4 14278 begin
5 14279 res:= 44; <* intervalstørrelse ulovlig *>
5 14280 goto slut_slet;
5 14281 end;
4 14282
4 14282 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 14283 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 14284
4 14284 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 14285 if s<0 then finx:= finx+1;
4 14286 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 14287 if s>0 then sinx:= sinx-1;
4 14288
4 14288 for li:= finx step 1 until sinx do
4 14289 begin
5 14290 bi:= busindeks(li) extract 12;
5 14291 gar:= bustabel(bi) shift (-14) extract 8;
5 14292 if intg(bustilstand(bi))=0 and
5 14293 (omr = 0 or (omr > 0 and omr = gar) or
5 14294 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 14295 begin
6 14296 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 14297 linie_løb_indeks(bi):= busindeks(li):= false;
6 14298 linie_løb_tabel(li):= 0;
6 14299 end;
5 14300 end;
4 14301 \f
4 14301 message procedure vt_opdater side 10 - 850820/cl;
4 14302
4 14302 sinx:= finx-1;
4 14303 for li:= finx step 1 until sidste_linie_løb do
4 14304 begin
5 14305 if linie_løb_tabel(li)<>0 then
5 14306 begin
6 14307 sinx:= sinx+1;
6 14308 if sinx<>li then
6 14309 begin
7 14310 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 14311 busindeks(sinx):= busindeks(li);
7 14312 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 14313 linie_løb_tabel(li):= 0;
7 14314 busindeks(li):= false;
7 14315 end;
6 14316 end;
5 14317 end;
4 14318 sidste_linie_løb:= sinx;
4 14319
4 14319 test24:= testbit24; testbit24:= false;
4 14320 for bi:= 1 step 1 until sidste_bus do
4 14321 disable
4 14322 begin
5 14323 s:= modiffil(tf_vogntabel,bi,finx);
5 14324 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 14325 fil(finx).bn:= bustabel(bi) extract 14 add
5 14326 (bustabel1(bi) extract 8 shift 14);
5 14327 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 14328 end;
4 14329 testbit24:= test24;
4 14330 res:= 3;
4 14331
4 14331 slut_slet:
4 14332 d.op.resultat:= res;
4 14333 end;
3 14334 goto returner;
3 14335 \f
3 14335 message procedure vt_opdater side 11 - 810409/cl;
3 14336
3 14336 returner:
3 14337 disable
3 14338 begin
4 14339
4 14339 <*+2*>
4 14340 <**> if testbit40 and overvåget then
4 14341 <**> begin
5 14342 <**> skriv_vt_opd(out,0);
5 14343 <**> write(out,<: vogntabel efter ændring:>);
5 14344 <**> p_vogntabel(out);
5 14345 <**> end;
4 14346 <**> if testbit41 and overvåget then
4 14347 <**> begin
5 14348 <**> skriv_vt_opd(out,0);
5 14349 <**> write(out,<: returner operation:>);
5 14350 <**> skriv_op(out,op);
5 14351 <**> end;
4 14352 <*-2*>
4 14353
4 14353 signalch(d.op.retur,op,d.op.optype);
4 14354 end;
3 14355 goto vent_op;
3 14356
3 14356 vt_opd_trap:
3 14357 disable skriv_vt_opd(zbillede,1);
3 14358
3 14358 end vt_opdater;
2 14359 \f
2 14359 message procedure vt_tilstand side 1 - 810424/cl;
2 14360
2 14360 procedure vt_tilstand(cs_fil,fil_opref);
2 14361 value cs_fil,fil_opref;
2 14362 integer cs_fil,fil_opref;
2 14363 begin
3 14364 integer array field op,filop;
3 14365 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14366 g_type,gr,antal,ej_res,zi,li,filref;
3 14367 integer array identer(1:max_antal_i_gruppe);
3 14368
3 14368 procedure skriv_vt_tilst(zud,omfang);
3 14369 value omfang;
3 14370 zone zud;
3 14371 integer omfang;
3 14372 begin
4 14373 real array field raf;
4 14374 raf:= 0;
4 14375 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14376 if omfang <> 0 then
4 14377 begin
5 14378 skriv_coru(zud,abs curr_coruno);
5 14379 write(zud,"nl",1,<<d>,
5 14380 <:cs-fil :>,cs_fil,"nl",1,
5 14381 <:filop :>,filop,"nl",1,
5 14382 <:op :>,op,"nl",1,
5 14383 <:funk :>,funk,"nl",1,
5 14384 <:format :>,format,"nl",1,
5 14385 <:busid :>,busid,"nl",1,
5 14386 <:res :>,res,"nl",1,
5 14387 <:bi :>,bi,"nl",1,
5 14388 <:tilst :>,tilst,"nl",1,
5 14389 <:opk :>,opk,"nl",1,
5 14390 <:opk-indeks :>,opk_indeks,"nl",1,
5 14391 <:g-type :>,g_type,"nl",1,
5 14392 <:gr :>,gr,"nl",1,
5 14393 <:antal :>,antal,"nl",1,
5 14394 <:ej-res :>,ej_res,"nl",1,
5 14395 <:zi :>,zi,"nl",1,
5 14396 <:li :>,li,"nl",1,
5 14397 <::>);
5 14398 write(zud,"nl",1,<:identer:>);
5 14399 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14400 end;
4 14401 end;
3 14402
3 14402 procedure sorter_gruppe(tab,l,u);
3 14403 value l,u;
3 14404 integer array tab;
3 14405 integer l,u;
3 14406 begin
4 14407 integer array field ii,jj;
4 14408 integer array ww, xx(1:2);
4 14409
4 14409 integer procedure sml(a,b);
4 14410 integer array a,b;
4 14411 begin
5 14412 integer res;
5 14413
5 14413 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14414 if res = 0 then
5 14415 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14416 if res = 0 then
5 14417 res:=
5 14418 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14419 if res = 0 then
5 14420 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14421 sml:= res;
5 14422 end;
4 14423
4 14423 ii:= ((l+u)//2 - 1)*4;
4 14424 tofrom(xx,tab.ii,4);
4 14425 ii:= (l-1)*4; jj:= (u-1)*4;
4 14426 repeat
4 14427 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14428 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14429 if ii <= jj then
4 14430 begin
5 14431 tofrom(ww,tab.ii,4);
5 14432 tofrom(tab.ii,tab.jj,4);
5 14433 tofrom(tab.jj,ww,4);
5 14434 ii:= ii+4;
5 14435 jj:= jj-4;
5 14436 end;
4 14437 until ii>jj;
4 14438 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14439 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14440 end;
3 14441 \f
3 14441 message procedure vt_tilstand side 2 - 820301/cl;
3 14442
3 14442 filop:= filopref;
3 14443 stackclaim(if cm_test then 550 else 500);
3 14444 trap(vt_tilst_trap);
3 14445
3 14445 <*+2*>
3 14446 <**> disable if testbit47 and overvåget or testbit28 then
3 14447 <**> skriv_vt_tilst(out,0);
3 14448 <*-2*>
3 14449
3 14449 vent_op:
3 14450 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14451 <*+2*>disable
3 14452 <**> if (testbit41 and overvåget) or
3 14453 (testbit46 and overvåget and
3 14454 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14455 then
3 14456 <**> begin
4 14457 <**> skriv_vt_tilst(out,0);
4 14458 <**> write(out,<: modtaget operation:>);
4 14459 <**> skriv_op(out,op);
4 14460 <**> end;
3 14461 <*-2*>
3 14462
3 14462 <*+4*>
3 14463 <**> if op <> vt_op then
3 14464 <**> begin
4 14465 <**> disable begin
5 14466 <**> d.op.resultat:= 31;
5 14467 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14468 <**> end;
4 14469 <**> goto returner;
4 14470 <**> end;
3 14471 <*-4*>
3 14472
3 14472 opk:= d.op.opkode extract 12;
3 14473 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14474 if opk = 15 <*bus res *> then 2 else
3 14475 if opk = 16 <*grp res *> then 4 else
3 14476 if opk = 17 <*bus fri *> then 3 else
3 14477 if opk = 18 <*grp fri *> then 5 else
3 14478 0;
3 14479 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14480 res:= 0;
3 14481 format:= d.op.data(1) shift (-22);
3 14482
3 14482 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14483 \f
3 14483 message procedure vt_tilstand side 3 - 820301/cl;
3 14484
3 14484 enkelt_bus:
3 14485 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14486 disable
3 14487 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14488 <*+4*>
4 14489 <**>if format <> 0 and format <> 1 then
4 14490 <**>begin
5 14491 <**> res:= 31;
5 14492 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14493 <**> goto slut_enkelt_bus;
5 14494 <**>end;
4 14495 <*-4*>
4 14496 <* find busnr og tilstand *>
4 14497 case format+1 of
4 14498 begin
5 14499 <* 0: budident *>
5 14500 begin
6 14501 busnr:= d.op.data(1) extract 14;
6 14502 s:= omr:= d.op.data(4) extract 8;
6 14503 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14504 if bi<0 then
6 14505 begin
7 14506 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14507 goto slut_enkelt_bus;
7 14508 end
6 14509 else
6 14510 begin
7 14511 tilst:= intg(bustilstand(bi));
7 14512 end;
6 14513 end;
5 14514
5 14514 <* 1: linie_løb_ident *>
5 14515 begin
6 14516 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14517 if bi < 0 then <* ukendt linie_løb *>
6 14518 begin
7 14519 res:= 9;
7 14520 goto slut_enkelt_bus;
7 14521 end;
6 14522 end;
5 14523 end case;
4 14524 \f
4 14524 message procedure vt_tilstand side 4 - 830310/cl;
4 14525
4 14525 if funk < 3 then
4 14526 begin
5 14527 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14528 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14529 else 0;
5 14530 d.op.data(3):= bustabel(bi);
5 14531 d.op.data(4):= bustabel1(bi);
5 14532 end;
4 14533
4 14533 <* check tilstand *>
4 14534 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14535 res:= 39 <* bus ikke reserveret *>
4 14536 else
4 14537 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14538 res:= 14 <* bus optaget *>
4 14539 else
4 14540 if funk = 1 <* i kø *> and tilst = (-1) then
4 14541 res:= 18 <* i kø *>
4 14542 else
4 14543 res:= 3; <*udført*>
4 14544
4 14544 if res = 3 then
4 14545 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14546
4 14546 slut_enkelt_bus:
4 14547 d.op.resultat:= res;
4 14548 end <*disable*>;
3 14549 goto returner;
3 14550 \f
3 14550 message procedure vt_tilstand side 5 - 810424/cl;
3 14551
3 14551 grp_res: <* reserver gruppe *>
3 14552 disable
3 14553 begin
4 14554
4 14554 <*+4*>
4 14555 <**> if format <> 2 then
4 14556 <**> begin
5 14557 <**> res:= 31;
5 14558 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14559 <**> goto slut_grp_res_1;
5 14560 <**> end;
4 14561 <*-4*>
4 14562
4 14562 <* find frit indeks i opkaldstabel *>
4 14563 opk_indeks:= 0;
4 14564 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14565 begin
5 14566 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14567 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14568 end;
4 14569 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14570 if res <> 0 then goto slut_grp_res_1;
4 14571 g_type:= d.op.data(1) shift (-21) extract 1;
4 14572 if g_type = 1 <*special gruppe*> then
4 14573 begin <*check eksistens*>
5 14574 gr:= 0;
5 14575 for i:= 1 step 1 until max_antal_grupper do
5 14576 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14577 if gr = 0 then <*gruppe ukendt*>
5 14578 begin
6 14579 res:= 8;
6 14580 goto slut_grp_res_1;
6 14581 end;
5 14582 end;
4 14583
4 14583 <* reserver i opkaldstabel *>
4 14584 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14585 \f
4 14585 message procedure vt_tilstand side 6 - 810428/cl;
4 14586
4 14586 <* tilknyt fil *>
4 14587 start_operation(filop,curr_coruid,cs_fil,101);
4 14588 d.filop.data(1):= 0; <*postantal*>
4 14589 d.filop.data(2):= 256; <*postlængde*>
4 14590 d.filop.data(3):= 1; <*segmentantal*>
4 14591 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14592 signalch(cs_opret_fil,filop,vt_optype);
4 14593
4 14593 slut_grp_res_1:
4 14594 if res <> 0 then d.op.resultat:= res;
4 14595 end;
3 14596 if res <> 0 then goto returner;
3 14597
3 14597 waitch(cs_fil,filop,vt_optype,-1);
3 14598
3 14598 <* check filsys-resultat *>
3 14599 if d.filop.data(9) <> 0 then
3 14600 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14601 filref:= d.filop.data(4);
3 14602 \f
3 14602 message procedure vt_tilstand side 7 - 820301/cl;
3 14603 disable if g_type = 0 <*linie-gruppe*> then
3 14604 begin
4 14605 integer s,i,ll_id;
4 14606 integer array field iaf1;
4 14607
4 14607 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14608 iaf1:= 2;
4 14609 s:= binærsøg(sidste_linie_løb,
4 14610 linie_løb_tabel(i) - ll_id, i);
4 14611 if s < 0 then i:= i +1;
4 14612 antal:= ej_res:= 0;
4 14613 skrivfil(filref,1,zi);
4 14614 if i <= sidste_linie_løb then
4 14615 begin
5 14616 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14617 begin
6 14618 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14619 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14620 ej_res:= ej_res+1
6 14621 else
6 14622 begin
7 14623 antal:= antal+1;
7 14624 bi:= busindeks(i) extract 12;
7 14625 fil(zi).iaf1(1):=
7 14626 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14627 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14628 fil(zi).iaf1(2):= bustabel(bi);
7 14629 iaf1:= iaf1+4;
7 14630 bustilstand(bi):= false add opk_indeks;
7 14631 end;
6 14632 i:= i +1;
6 14633 if i > sidste_linie_løb then goto slut_l_grp;
6 14634 end;
5 14635 end;
4 14636 \f
4 14636 message procedure vt_tilstand side 8 - 820301/cl;
4 14637
4 14637 slut_l_grp:
4 14638 end
3 14639 else
3 14640 begin <*special gruppe*>
4 14641 integer i,s,li,omr,gar,tilst;
4 14642 integer array field iaf1;
4 14643
4 14643 iaf1:= 2;
4 14644 antal:= ej_res:= 0;
4 14645 s:= læsfil(tf_gruppedef,gr,zi);
4 14646 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14647 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14648 s:= skrivfil(filref,1,zi);
4 14649 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14650 i:= 1;
4 14651 while identer(i) <> 0 do
4 14652 begin
5 14653 if identer(i) shift (-22) = 0 then
5 14654 begin <*busident*>
6 14655 omr:= 0;
6 14656 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14657 if bi<0 then goto næste_ident;
6 14658 li:= linie_løb_indeks(bi) extract 12;
6 14659 end
5 14660 else
5 14661 begin <*linie/løb ident*>
6 14662 s:= binærsøg(sidste_linie_løb,
6 14663 linie_løb_tabel(li) - identer(i), li);
6 14664 if s <> 0 then goto næste_ident;
6 14665 bi:= busindeks(li) extract 12;
6 14666 end;
5 14667 if (intg(bustilstand(bi))<>0) or
5 14668 (bustabel1(bi) extract 8 <> 3) then
5 14669 ej_res:= ej_res+1
5 14670 else
5 14671 begin
6 14672 antal:= antal +1;
6 14673 fil(zi).iaf1(1):=
6 14674 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14675 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14676 fil(zi).iaf1(2):= bustabel(bi);
6 14677 iaf1:= iaf1+4;
6 14678 bustilstand(bi):= false add opk_indeks;
6 14679 end;
5 14680 næste_ident:
5 14681 i:= i +1;
5 14682 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14683 end;
4 14684 slut_s_grp:
4 14685 end;
3 14686 \f
3 14686 message procedure vt_tilstand side 9 - 820301/cl;
3 14687
3 14687 if antal > 0 then <*ok*>
3 14688 disable begin
4 14689 integer array field spec,akt;
4 14690 integer a;
4 14691 integer field antal_spec;
4 14692
4 14692 antal_spec:= 2; a:= 0;
4 14693 spec:= 2; akt:= 2;
4 14694 sorter_gruppe(fil(zi).spec,1,antal);
4 14695 fil(zi).antal_spec:= 0;
4 14696 while akt//4 < antal do
4 14697 begin
5 14698 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14699 a:= 0;
5 14700 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14701 and a<15 do
5 14702 begin
6 14703 a:= a+1;
6 14704 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14705 akt:= akt+4;
6 14706 end;
5 14707 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14708 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14709 spec:= spec + 2*a + 2;
5 14710 end;
4 14711 antal:= fil(zi).antal_spec;
4 14712 gruppeopkald(opk_indeks,2):= filref;
4 14713 d.op.resultat:= 3;
4 14714 d.op.data(2):= antal;
4 14715 d.op.data(3):= filref;
4 14716 d.op.data(4):= ej_res;
4 14717 end
3 14718 else
3 14719 begin
4 14720 disable begin
5 14721 d.filop.opkode:= 104; <*slet fil*>
5 14722 signalch(cs_slet_fil,filop,vt_optype);
5 14723 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14724 d.op.resultat:= 54;
5 14725 d.op.data(2):= antal;
5 14726 d.op.data(3):= 0;
5 14727 d.op.data(4):= ej_res;
5 14728 end;
4 14729 waitch(cs_fil,filop,vt_optype,-1);
4 14730 if d.filop.data(9) <> 0 then
4 14731 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14732 end;
3 14733 goto returner;
3 14734 \f
3 14734 message procedure vt_tilstand side 10 - 820301/cl;
3 14735
3 14735 grp_fri: <* frigiv gruppe *>
3 14736 disable
3 14737 begin integer i,j,s,ll,gar,omr,tilst;
4 14738 integer array field spec;
4 14739
4 14739 <*+4*>
4 14740 <**> if format <> 2 then
4 14741 <**> begin
5 14742 <**> res:= 31;
5 14743 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14744 <**> goto slut_grp_fri;
5 14745 <**> end;
4 14746 <*-4*>
4 14747
4 14747 <* find indeks i opkaldstabel *>
4 14748 opk_indeks:= 0;
4 14749 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14750 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14751 if opk_indeks = 0 <*ikke fundet*> then
4 14752 begin
5 14753 res:= 40; <*gruppe ej reserveret*>
5 14754 goto slut_grp_fri;
5 14755 end;
4 14756 filref:= gruppeopkald(opk_indeks,2);
4 14757 start_operation(filop,curr_coruid,cs_fil,104);
4 14758 d.filop.data(4):= filref;
4 14759 hentfildim(d.filop.data);
4 14760 læsfil(filref,1,zi);
4 14761 spec:= 0;
4 14762 antal:= fil(zi).spec(1);
4 14763 spec:= spec+2;
4 14764 for i:= 1 step 1 until antal do
4 14765 begin
5 14766 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14767 begin
6 14768 busid:= fil(zi).spec(1+j) extract 14;
6 14769 omr:= 0;
6 14770 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14771 if bi>=0 then bustilstand(bi):= false;
6 14772 end;
5 14773 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14774 end;
4 14775
4 14775 slut_grp_fri:
4 14776 d.op.resultat:= res;
4 14777 end;
3 14778 if res <> 0 then goto returner;
3 14779 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14780 signalch(cs_slet_fil,filop,vt_optype);
3 14781 \f
3 14781 message procedure vt_tilstand side 11 - 810424/cl;
3 14782
3 14782 waitch(cs_fil,filop,vt_optype,-1);
3 14783
3 14783 if d.filop.data(9) <> 0 then
3 14784 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14785 d.op.resultat:= 3;
3 14786
3 14786 returner:
3 14787 disable
3 14788 begin
4 14789 <*+2*>
4 14790 <**> if testbit40 and overvåget then
4 14791 <**> begin
5 14792 <**> skriv_vt_tilst(out,0);
5 14793 <**> write(out,<: vogntabel efter ændring:>);
5 14794 <**> p_vogntabel(out);
5 14795 <**> end;
4 14796 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14797 <**> begin
5 14798 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14799 <**> p_gruppetabel(out);
5 14800 <**> end;
4 14801 <**> if (testbit41 and overvåget) or
4 14802 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14803 <**> begin
5 14804 <**> skriv_vt_tilst(out,0);
5 14805 <**> write(out,<: returner operation:>);
5 14806 <**> skriv_op(out,op);
5 14807 <**> end;
4 14808 <*-2*>
4 14809 signalch(d.op.retur,op,d.op.optype);
4 14810 end;
3 14811 goto vent_op;
3 14812
3 14812 vt_tilst_trap:
3 14813 disable skriv_vt_tilst(zbillede,1);
3 14814
3 14814 end vt_tilstand;
2 14815 \f
2 14815 message procedure vt_rapport side 1 - 810428/cl;
2 14816
2 14816 procedure vt_rapport(cs_fil,fil_opref);
2 14817 value cs_fil,fil_opref;
2 14818 integer cs_fil,fil_opref;
2 14819 begin
3 14820 integer array field op,filop;
3 14821 integer funk,filref,antal,id_ant,res;
3 14822 integer field i1,i2;
3 14823
3 14823 procedure skriv_vt_rap(z,omfang);
3 14824 value omfang;
3 14825 zone z;
3 14826 integer omfang;
3 14827 begin
4 14828 write(z,"nl",1,<:+++ vt_rapport :>);
4 14829 if omfang <> 0 then
4 14830 begin
5 14831 skriv_coru(z,abs curr_coruno);
5 14832 write(z,"nl",1,<<d>,
5 14833 <: cs_fil :>,cs_fil,"nl",1,
5 14834 <: filop :>,filop,"nl",1,
5 14835 <: op :>,op,"nl",1,
5 14836 <: funk :>,funk,"nl",1,
5 14837 <: filref :>,filref,"nl",1,
5 14838 <: antal :>,antal,"nl",1,
5 14839 <: id-ant :>,id_ant,"nl",1,
5 14840 <: res :>,res,"nl",1,
5 14841 <::>);
5 14842
5 14842 end;
4 14843 end skriv_vt_rap;
3 14844
3 14844 stackclaim(if cm_test then 198 else 146);
3 14845 filop:= fil_opref;
3 14846 i1:= 2; i2:= 4;
3 14847 trap(vt_rap_trap);
3 14848
3 14848 <*+2*>
3 14849 <**> disable if testbit47 and overvåget or testbit28 then
3 14850 <**> skriv_vt_rap(out,0);
3 14851 <*-2*>
3 14852 \f
3 14852 message procedure vt_rapport side 2 - 810505/cl;
3 14853
3 14853 vent_op:
3 14854 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14855
3 14855 <*+2*>
3 14856 <**> disable begin
4 14857 <**> if testbit41 and overvåget then
4 14858 <**> begin
5 14859 <**> skriv_vt_rap(out,0);
5 14860 <**> write(out,<: modtaget operation:>);
5 14861 <**> skriv_op(out,op);
5 14862 <**> ud;
5 14863 <**> end;
4 14864 <**> end;<*disable*>
3 14865 <*-2*>
3 14866
3 14866 disable
3 14867 begin
4 14868 integer opk;
4 14869
4 14869 opk:= d.op.opkode extract 12;
4 14870 funk:= if opk = 9 then 1 else
4 14871 if opk =10 then 2 else
4 14872 0;
4 14873 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14874
4 14874 <* opret og tilknyt fil *>
4 14875 start_operation(filop,curr_coruid,cs_fil,101);
4 14876 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14877 d.filop.data(2):= 2; <*postlængde*>
4 14878 d.filop.data(3):=10; <*segmenter*>
4 14879 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14880 signalch(cs_opretfil,filop,vt_optype);
4 14881 end;
3 14882
3 14882 waitch(cs_fil,filop,vt_optype,-1);
3 14883
3 14883 <* check resultat *>
3 14884 if d.filop.data(9) <> 0 then
3 14885 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14886 filref:= d.filop.data(4);
3 14887 antal:= 0;
3 14888 goto case funk of (l_rapport,b_rapport);
3 14889 \f
3 14889 message procedure vt_rapport side 3 - 850820/cl;
3 14890
3 14890 l_rapport:
3 14891 disable
3 14892 begin
4 14893 integer i,j,s,ll,zi;
4 14894 idant:= 0;
4 14895 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14896 <*+4*>
4 14897 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14898 <**> begin
5 14899 <**> res:= 31;
5 14900 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14901 <**> goto l_rap_slut;
5 14902 <**> end;
4 14903 <*-4*>
4 14904 ;
4 14905
4 14905 for i:= 1 step 1 until id_ant do
4 14906 begin
5 14907 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14908 s:= binærsøg(sidste_linie_løb,
5 14909 linie_løb_tabel(j) - ll, j);
5 14910 if s < 0 then j:= j +1;
5 14911
5 14911 if j<= sidste_linie_løb then
5 14912 begin <* skriv identer *>
6 14913 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14914 begin
7 14915 antal:= antal +1;
7 14916 s:= skrivfil(filref,antal,zi);
7 14917 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14918 fil(zi).i1:= linie_løb_tabel(j);
7 14919 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14920 j:= j +1;
7 14921 if j > sidste_bus then goto linie_slut;
7 14922 end;
6 14923 end;
5 14924 linie_slut:
5 14925 end;
4 14926 res:= 3;
4 14927 l_rap_slut:
4 14928 end <*disable*>;
3 14929 goto returner;
3 14930 \f
3 14930 message procedure vt_rapport side 4 - 820301/cl;
3 14931
3 14931 b_rapport:
3 14932 disable
3 14933 begin
4 14934 integer i,j,s,zi,busnr1,busnr2;
4 14935 <*+4*>
4 14936 <**> for i:= 1,2 do
4 14937 <**> if d.op.data(i) shift (-14) <> 0 then
4 14938 <**> begin
5 14939 <**> res:= 31;
5 14940 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14941 <**> goto bus_slut;
5 14942 <**> end;
4 14943 <*-4*>
4 14944
4 14944 busnr1:= d.op.data(1) extract 14;
4 14945 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14946 if busnr1 = 0 or busnr2 < busnr1 then
4 14947 begin
5 14948 res:= 7; <* fejl i busnr *>
5 14949 goto bus_slut;
5 14950 end;
4 14951
4 14951 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14952 - busnr1,j);
4 14953 if s < 0 then j:= j +1;
4 14954 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14955 if j <= sidste_bus then
4 14956 begin <* skriv identer *>
5 14957 while bustabel(j) extract 14 <= busnr2 do
5 14958 begin
6 14959 i:= linie_løb_indeks(j) extract 12;
6 14960 if i<>0 then
6 14961 begin
7 14962 antal:= antal +1;
7 14963 s:= skriv_fil(filref,antal,zi);
7 14964 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14965 fil(zi).i1:= bustabel(j);
7 14966 fil(zi).i2:= linie_løb_tabel(i);
7 14967 end;
6 14968 j:= j +1;
6 14969 if j > sidste_bus then goto bus_slut;
6 14970 end;
5 14971 end;
4 14972 bus_slut:
4 14973 end <*disable*>;
3 14974 res:= 3; <*ok*>
3 14975 \f
3 14975 message procedure vt_rapport side 5 - 810409/cl;
3 14976
3 14976 returner:
3 14977 disable
3 14978 begin
4 14979 d.op.resultat:= res;
4 14980 d.op.data(6):= antal;
4 14981 d.op.data(7):= filref;
4 14982 d.filop.data(1):= antal;
4 14983 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 14984 i:= sæt_fil_dim(d.filop.data);
4 14985 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 14986 <*+2*>
4 14987 <**> if testbit41 and overvåget then
4 14988 <**> begin
5 14989 <**> skriv_vt_rap(out,0);
5 14990 <**> write(out,<: returner operation:>);
5 14991 <**> skriv_op(out,op);
5 14992 <**> end;
4 14993 <*-2*>
4 14994 signalch(d.op.retur,op,d.op.optype);
4 14995 end;
3 14996 goto vent_op;
3 14997
3 14997 vt_rap_trap:
3 14998 disable skriv_vt_rap(zbillede,1);
3 14999
3 14999 end vt_rapport;
2 15000 \f
2 15000 message procedure vt_gruppe side 1 - 810428/cl;
2 15001
2 15001 procedure vt_gruppe(cs_fil,fil_opref);
2 15002
2 15002 value cs_fil,fil_opref;
2 15003 integer cs_fil,fil_opref;
2 15004 begin
3 15005 integer array field op, fil_op, iaf;
3 15006 integer funk, res, filref, gr, i, antal, zi, s;
3 15007 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 15008 max_antal_grupper else max_antal_i_gruppe));
3 15009
3 15009 procedure skriv_vt_gruppe(zud,omfang);
3 15010 value omfang;
3 15011 integer omfang;
3 15012 zone zud;
3 15013 begin
4 15014 integer øg;
4 15015
4 15015 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 15016 if omfang <> 0 then
4 15017 disable
4 15018 begin
5 15019 skriv_coru(zud,abs curr_coruno);
5 15020 write(zud,"nl",1,<<d>,
5 15021 <: cs_fil :>,cs_fil,"nl",1,
5 15022 <: op :>,op,"nl",1,
5 15023 <: filop :>,filop,"nl",1,
5 15024 <: funk :>,funk,"nl",1,
5 15025 <: res :>,res,"nl",1,
5 15026 <: filref :>,filref,"nl",1,
5 15027 <: gr :>,gr,"nl",1,
5 15028 <: i :>,i,"nl",1,
5 15029 <: antal :>,antal,"nl",1,
5 15030 <: zi :>,zi,"nl",1,
5 15031 <: s :>,s,"nl",1,
5 15032 <::>);
5 15033 raf:= 0;
5 15034 system(3,øg,identer);
5 15035 write(zud,"nl",1,<:identer::>);
5 15036 skriv_hele(zud,identer.raf,øg*2,2);
5 15037 end;
4 15038 end;
3 15039
3 15039 stackclaim(if cm_test then 198 else 146);
3 15040 filop:= fil_opref;
3 15041 trap(vt_grp_trap);
3 15042 iaf:= 0;
3 15043 \f
3 15043 message procedure vt_gruppe side 2 - 810409/cl;
3 15044
3 15044 <*+2*>
3 15045 <**> disable if testbit47 and overvåget or testbit28 then
3 15046 <**> skriv_vt_gruppe(out,0);
3 15047 <*-2*>
3 15048
3 15048 vent_op:
3 15049 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 15050 <*+2*>
3 15051 <**>disable
3 15052 <**>begin
4 15053 <**> if testbit41 and overvåget then
4 15054 <**> begin
5 15055 <**> skriv_vt_gruppe(out,0);
5 15056 <**> write(out,<: modtaget operation:>);
5 15057 <**> skriv_op(out,op);
5 15058 <**> ud;
5 15059 <**> end;
4 15060 <**>end;
3 15061 <*-2*>
3 15062
3 15062 disable
3 15063 begin
4 15064 integer opk;
4 15065
4 15065 opk:= d.op.opkode extract 12;
4 15066 funk:= if opk=25 then 1 else
4 15067 if opk=26 then 2 else
4 15068 if opk=27 then 3 else
4 15069 if opk=28 then 4 else
4 15070 0;
4 15071 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 15072 end;
3 15073 <*+4*>
3 15074 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 15075 <**> begin
4 15076 <**> disable begin
5 15077 <**> d.op.resultat:= 31;
5 15078 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 15079 <**> end;
4 15080 <**> goto returner;
4 15081 <**> end;
3 15082 <*-4*>
3 15083
3 15083 goto case funk of(definer,slet,vis,oversigt);
3 15084 \f
3 15084 message procedure vt_gruppe side 3 - 810505/cl;
3 15085
3 15085 definer:
3 15086 disable
3 15087 begin
4 15088 gr:= 0; res:= 0;
4 15089 for i:= max_antal_grupper step -1 until 1 do
4 15090 begin
5 15091 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 15092 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 15093 end;
4 15094 if gr=0 then res:= 32; <*ingen plads*>
4 15095 end;
3 15096 if res<>0 then goto slut_definer;
3 15097 disable
3 15098 begin <*fri plads fundet*>
4 15099 antal:= d.op.data(2);
4 15100 if antal <=0 or max_antal_i_gruppe<antal then
4 15101 res:= 33 <*fejl i gruppestørrelse*>
4 15102 else
4 15103 begin
5 15104 for i:= 1 step 1 until antal do
5 15105 begin
6 15106 s:= læsfil(d.op.data(3),i,zi);
6 15107 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 15108 identer(i):= fil(zi).iaf(1);
6 15109 end;
5 15110 s:= modif_fil(tf_gruppedef,gr,zi);
5 15111 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15112 tofrom(fil(zi).iaf,identer,antal*2);
5 15113 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 15114 fil(zi).iaf(i):= 0;
5 15115 gruppetabel(gr):= d.op.data(1);
5 15116 s:= modiffil(tf_gruppeidenter,gr,zi);
5 15117 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15118 fil(zi).iaf(1):= gruppetabel(gr);
5 15119 res:= 3;
5 15120 end;
4 15121 end;
3 15122 slut_definer:
3 15123 <*slet fil*>
3 15124 start_operation(fil_op,curr_coruid,cs_fil,104);
3 15125 d.filop.data(4):= d.op.data(3);
3 15126 signalch(cs_slet_fil,filop,vt_optype);
3 15127 waitch(cs_fil,filop,vt_optype,-1);
3 15128 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 15129 d.op.resultat:= res;
3 15130 goto returner;
3 15131 \f
3 15131 message procedure vt_gruppe side 4 - 810409/cl;
3 15132
3 15132 slet:
3 15133 disable
3 15134 begin
4 15135 gr:= 0; res:= 0;
4 15136 for i:= 1 step 1 until max_antal_grupper do
4 15137 begin
5 15138 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 15139 end;
4 15140 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 15141 else
4 15142 begin
5 15143 for i:= 1 step 1 until max_antal_gruppeopkald do
5 15144 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 15145 if res = 0 then
5 15146 begin
6 15147 gruppetabel(gr):= 0;
6 15148 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 15149 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 15150 fil(zi).iaf(1):= gruppetabel(gr);
6 15151 res:= 3;
6 15152 end;
5 15153 end;
4 15154 d.op.resultat:= res;
4 15155 end;
3 15156 goto returner;
3 15157 \f
3 15157 message procedure vt_gruppe side 5 - 810505/cl;
3 15158
3 15158 vis:
3 15159 disable
3 15160 begin
4 15161 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 15162 for i:= 1 step 1 until max_antal_grupper do
4 15163 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 15164 if gr = 0 then res:= 8
4 15165 else
4 15166 begin
5 15167 s:= læsfil(tf_gruppedef,gr,zi);
5 15168 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 15169 for i:= 1 step 1 until max_antal_i_gruppe do
5 15170 begin
6 15171 identer(i):= fil(zi).iaf(i);
6 15172 if identer(i) <> 0 then antal:= antal +1;
6 15173 end;
5 15174 start_operation(filop,curr_coruid,cs_fil,101);
5 15175 d.filop.data(1):= antal; <*postantal*>
5 15176 d.filop.data(2):= 1; <*postlængde*>
5 15177 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 15178 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 15179 d.filop.data(5):= d.filop.data(6):=
5 15180 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 15181 signalch(cs_opret_fil,filop,vt_optype);
5 15182 end;
4 15183 end;
3 15184 if res <> 0 then goto slut_vis;
3 15185 waitch(cs_fil,filop,vt_optype,-1);
3 15186 disable
3 15187 begin
4 15188 if d.filop.data(9) <> 0 then
4 15189 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 15190 filref:= d.filop.data(4);
4 15191 for i:= 1 step 1 until antal do
4 15192 begin
5 15193 s:= skrivfil(filref,i,zi);
5 15194 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 15195 fil(zi).iaf(1):= identer(i);
5 15196 end;
4 15197 res:= 3;
4 15198 end;
3 15199 slut_vis:
3 15200 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 15201 goto returner;
3 15202 \f
3 15202 message procedure vt_gruppe side 6 - 810508/cl;
3 15203
3 15203 oversigt:
3 15204 disable
3 15205 begin
4 15206 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 15207 for i:= 1 step 1 until max_antal_grupper do
4 15208 begin
5 15209 if gruppetabel(i) <> 0 then
5 15210 begin
6 15211 antal:= antal +1;
6 15212 identer(antal):= gruppetabel(i);
6 15213 end;
5 15214 end;
4 15215 start_operation(filop,curr_coruid,cs_fil,101);
4 15216 d.filop.data(1):= antal; <*postantal*>
4 15217 d.filop.data(2):= 1; <*postlængde*>
4 15218 d.filop.data(3):= if antal = 0 then 1 else
4 15219 (antal-1)//256 +1; <*segm.antal*>
4 15220 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 15221 d.filop.data(5):= d.filop.data(6):=
4 15222 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 15223 signalch(cs_opretfil,filop,vt_optype);
4 15224 end;
3 15225 waitch(cs_fil,filop,vt_optype,-1);
3 15226 disable
3 15227 begin
4 15228 if d.filop.data(9) <> 0 then
4 15229 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 15230 filref:= d.filop.data(4);
4 15231 for i:= 1 step 1 until antal do
4 15232 begin
5 15233 s:= skriv_fil(filref,i,zi);
5 15234 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 15235 fil(zi).iaf(1):= identer(i);
5 15236 end;
4 15237 d.op.resultat:= 3; <*ok*>
4 15238 d.op.data(1):= antal;
4 15239 d.op.data(2):= filref;
4 15240 end;
3 15241 \f
3 15241 message procedure vt_gruppe side 7 - 810505/cl;
3 15242
3 15242 returner:
3 15243 disable
3 15244 begin
4 15245 <*+2*>
4 15246 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 15247 <**> begin
5 15248 <**> skriv_vt_gruppe(out,0);
5 15249 <**> write(out,<: gruppetabel efter ændring:>);
5 15250 <**> p_gruppetabel(out);
5 15251 <**> end;
4 15252 <**> if testbit41 and overvåget then
4 15253 <**> begin
5 15254 <**> skriv_vt_gruppe(out,0);
5 15255 <**> write(out,<: returner operation:>);
5 15256 <**> skriv_op(out,op);
5 15257 <**> end;
4 15258 <*-2*>
4 15259 signalch(d.op.retur,op,d.op.optype);
4 15260 end;
3 15261 goto vent_op;
3 15262
3 15262 vt_grp_trap:
3 15263 disable skriv_vt_gruppe(zbillede,1);
3 15264
3 15264 end vt_gruppe;
2 15265 \f
2 15265 message procedure vt_spring side 1 - 810506/cl;
2 15266
2 15266 procedure vt_spring(cs_spring_retur,spr_opref);
2 15267 value cs_spring_retur,spr_opref;
2 15268 integer cs_spring_retur,spr_opref;
2 15269 begin
3 15270 integer array field komm_op,spr_op,iaf;
3 15271 real nu;
3 15272 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 15273
3 15273 procedure skriv_vt_spring(zud,omfang);
3 15274 value omfang;
3 15275 zone zud;
3 15276 integer omfang;
3 15277 begin
4 15278 write(zud,"nl",1,<:+++ vt_spring :>);
4 15279 if omfang <> 0 then
4 15280 begin
5 15281 skriv_coru(zud,abs curr_coruno);
5 15282 write(zud,"nl",1,<<d>,
5 15283 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 15284 <:spr-op :>,spr_op,"nl",1,
5 15285 <:komm-op :>,komm_op,"nl",1,
5 15286 <:funk :>,funk,"nl",1,
5 15287 <:interval :>,interval,"nl",1,
5 15288 <:nr :>,nr,"nl",1,
5 15289 <:i :>,i,"nl",1,
5 15290 <:s :>,s,"nl",1,
5 15291 <:id1 :>,id1,"nl",1,
5 15292 <:id2 :>,id2,"nl",1,
5 15293 <:res :>,res,"nl",1,
5 15294 <:res-inf :>,res_inf,"nl",1,
5 15295 <:medd-kode :>,medd_kode,"nl",1,
5 15296 <:zi :>,zi,"nl",1,
5 15297 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 15298 <::>);
5 15299 end;
4 15300 end;
3 15301 \f
3 15301 message procedure vt_spring side 2 - 810506/cl;
3 15302
3 15302 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 15303 value aktion,id1,id2;
3 15304 integer aktion,id1,id2,res,res_inf;
3 15305 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 15306 integer array field akt_op;
4 15307
4 15307 <* vent på adgang til vogntabel *>
4 15308 waitch(cs_vt_adgang,akt_op,true,-1);
4 15309
4 15309 <* start operation *>
4 15310 disable
4 15311 begin
5 15312 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 15313 d.akt_op.data(1):= id1;
5 15314 d.akt_op.data(2):= id2;
5 15315 signalch(cs_vt_opd,akt_op,vt_optype);
5 15316 end;
4 15317
4 15317 <* afvent svar *>
4 15318 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 15319 res:= d.akt_op.resultat;
4 15320 res_inf:= d.akt_op.data(3);
4 15321 <*+2*>
4 15322 <**> disable
4 15323 <**> if testbit45 and overvåget then
4 15324 <**> begin
5 15325 <**> real t;
5 15326 <**> skriv_vt_spring(out,0);
5 15327 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 15328 <**> skriv_id(out,springtabel(nr,1),0);
5 15329 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 15330 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 15331 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 15332 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 15333 <**> d.akt_op.resultat,"sp",2);
5 15334 <**> skriv_id(out,d.akt_op.data(1),8);
5 15335 <**> skriv_id(out,d.akt_op.data(2),8);
5 15336 <**> skriv_id(out,d.akt_op.data(3),8);
5 15337 <**> systime(4,springtid(nr),t);
5 15338 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 15339 <**> end;
4 15340 <*-2*>
4 15341
4 15341 <* åbn adgang til vogntabel *>
4 15342 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 15343 end vt_operation;
3 15344 \f
3 15344 message procedure vt_spring side 2a - 810506/cl;
3 15345
3 15345 procedure io_meddelelse(medd_no,bus,linie,springno);
3 15346 value medd_no,bus,linie,springno;
3 15347 integer medd_no,bus,linie,springno;
3 15348 begin
4 15349 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 15350 d.spr_op.data(1):= medd_no;
4 15351 d.spr_op.data(2):= bus;
4 15352 d.spr_op.data(3):= linie;
4 15353 d.spr_op.data(4):= springtabel(springno,1);
4 15354 d.spr_op.data(5):= springtabel(springno,2);
4 15355 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15356 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15357 end;
3 15358
3 15358 procedure returner_op(op,res);
3 15359 value res;
3 15360 integer array field op;
3 15361 integer res;
3 15362 begin
4 15363 <*+2*>
4 15364 <**> disable
4 15365 <**> if testbit41 and overvåget then
4 15366 <**> begin
5 15367 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15368 <**> skriv_op(out,op);
5 15369 <**> end;
4 15370 <*-2*>
4 15371 d.op.resultat:= res;
4 15372 signalch(d.op.retur,op,d.op.optype);
4 15373 end;
3 15374 \f
3 15374 message procedure vt_spring side 3 - 810603/cl;
3 15375
3 15375 iaf:= 0;
3 15376 spr_op:= spr_opref;
3 15377 stack_claim((if cm_test then 198 else 146) + 24);
3 15378
3 15378 trap(vt_spring_trap);
3 15379
3 15379 for i:= 1 step 1 until max_antal_spring do
3 15380 begin
4 15381 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15382 springtid(i):= springstart(i):= 0.0;
4 15383 end;
3 15384
3 15384 <*+2*>
3 15385 <**> disable
3 15386 <**> if testbit44 and overvåget then
3 15387 <**> begin
4 15388 <**> skriv_vt_spring(out,0);
4 15389 <**> write(out,<: springtabel efter initialisering:>);
4 15390 <**> p_springtabel(out); ud;
4 15391 <**> end;
3 15392 <*-2*>
3 15393
3 15393 <*+2*>
3 15394 <**> disable if testbit47 and overvåget or testbit28 then
3 15395 <**> skriv_vt_spring(out,0);
3 15396 <*-2*>
3 15397 \f
3 15397 message procedure vt_spring side 4 - 810609/cl;
3 15398
3 15398 næste_tid: <* find næste tid *>
3 15399 disable
3 15400 begin
4 15401 interval:= -1; <*vent uendeligt*>
4 15402 systime(1,0.0,nu);
4 15403 for i:= 1 step 1 until max_antal_spring do
4 15404 if springtabel(i,3) < 0 then
4 15405 interval:= 5
4 15406 else
4 15407 if springtid(i) <> 0.0 and
4 15408 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15409 interval:= (if springtid(i) <= nu then 0 else
4 15410 round(springtid(i) -nu));
4 15411 if interval=0 then interval:= 1;
4 15412 end;
3 15413 \f
3 15413 message procedure vt_spring side 4a - 810525/cl;
3 15414
3 15414 <* afvent operation eller timeout *>
3 15415 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15416 if komm_op <> 0 then goto afkod_operation;
3 15417
3 15417 <* timeout *>
3 15418 systime(1,0.0,nu);
3 15419 nr:= 1;
3 15420 næste_sekv:
3 15421 if nr > max_antal_spring then goto næste_tid;
3 15422 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15423 begin
4 15424 nr:= nr +1;
4 15425 goto næste_sekv;
4 15426 end;
3 15427 disable s:= modif_fil(tf_springdef,nr,zi);
3 15428 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15429 if springtabel(nr,3) < 0 then
3 15430 begin <* hængende spring *>
4 15431 if springtid(nr) <= nu then
4 15432 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15433 <* find frit løb *>
5 15434 disable
5 15435 begin
6 15436 id2:= 0;
6 15437 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15438 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15439 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15440 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15441 end;
5 15442 <* send meddelelse til io *>
5 15443 io_meddelelse(5,0,id2,nr);
5 15444
5 15444 <* annuler spring*>
5 15445 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15446 springtid(nr):= springstart(nr):= 0.0;
5 15447 end
4 15448 else
4 15449 begin <* forsøg igen *>
5 15450 \f
5 15450 message procedure vt_spring side 5 - 810525/cl;
5 15451
5 15451 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15452 if i = 2 <* første spring ej udført *> then
5 15453 begin
6 15454 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15455 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15456 id2:= id1;
6 15457 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15458 end
5 15459 else
5 15460 begin
6 15461 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15462 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15463 id2:= id1 shift (-7) shift 7
6 15464 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15465 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15466 end;
5 15467
5 15467 <* check resultat *>
5 15468 medd_kode:= if res = 3 and i = 2 then 7 else
5 15469 if res = 3 and i > 2 then 8 else
5 15470 <* if res = 9 then 1 else
5 15471 if res =12 then 2 else
5 15472 if res =14 then 4 else
5 15473 if res =18 then 3 else *>
5 15474 0;
5 15475 if medd_kode > 0 then
5 15476 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15477 id2 else id1,nr);
5 15478 if res = 3 then
5 15479 begin <* spring udført *>
6 15480 disable s:= modiffil(tf_springdef,nr,zi);
6 15481 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15482 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15483 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15484 if i > 2 then fil(zi).iaf(2+i-2):=
6 15485 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15486 end;
5 15487 end;
4 15488 end <* hængende spring *>
3 15489 else
3 15490 begin
4 15491 i:= spring_tabel(nr,3) shift (-12);
4 15492 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15493 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15494 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15495 + id1 shift (-7) shift 7;
4 15496 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15497 \f
4 15497 message procedure vt_spring side 6 - 820304/cl;
4 15498
4 15498 <* check resultat *>
4 15499 medd_kode:= if res = 3 then 8 else
4 15500 if res = 9 then 1 else
4 15501 if res =12 then 2 else
4 15502 if res =14 then 4 else
4 15503 if res =18 then 3 else
4 15504 if res =60 then 9 else 0;
4 15505 if medd_kode > 0 then
4 15506 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15507
4 15507 <* opdater springtabel *>
4 15508 disable s:= modiffil(tf_springdef,nr,zi);
4 15509 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15510 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15511 begin
5 15512 io_meddelelse(if res=3 then 6 else 5,0,
5 15513 if res=3 then id1 else id2,nr);
5 15514 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15515 springtid(nr):= springstart(nr):= 0.0;
5 15516 end
4 15517 else
4 15518 begin
5 15519 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15520 if res = 3 then
5 15521 begin
6 15522 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15523 (fil(zi).iaf(2+i-1) extract 22);
6 15524 fil(zi).iaf(2+i) := (1 shift 22) add
6 15525 (fil(zi).iaf(2+i) extract 22);
6 15526 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15527 end
5 15528 else
5 15529 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15530 end;
4 15531 end;
3 15532 <*+2*>
3 15533 <**> disable
3 15534 <**> if testbit44 and overvåget then
3 15535 <**> begin
4 15536 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15537 <**> p_springtabel(out); ud;
4 15538 <**> end;
3 15539 <*-2*>
3 15540
3 15540 nr:= nr +1;
3 15541 goto næste_sekv;
3 15542 \f
3 15542 message procedure vt_spring side 7 - 810506/cl;
3 15543
3 15543 afkod_operation:
3 15544 <*+2*>
3 15545 <**> disable
3 15546 <**> if testbit41 and overvåget then
3 15547 <**> begin
4 15548 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15549 <**> skriv_op(out,komm_op);
4 15550 <**> end;
3 15551 <*-2*>
3 15552
3 15552 disable
3 15553 begin integer opk;
4 15554
4 15554 opk:= d.komm_op.opkode extract 12;
4 15555 funk:= if opk = 30 <*sp,d*> then 5 else
4 15556 if opk = 31 <*sp. *> then 1 else
4 15557 if opk = 32 <*sp,v*> then 4 else
4 15558 if opk = 33 <*sp,o*> then 6 else
4 15559 if opk = 34 <*sp,r*> then 2 else
4 15560 if opk = 35 <*sp,a*> then 3 else
4 15561 0;
4 15562 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15563
4 15563 if funk <> 6 <*sp,o*> then
4 15564 begin <* find nr i springtabel *>
5 15565 nr:= 0;
5 15566 for i:= 1 step 1 until max_antal_spring do
5 15567 if springtabel(i,1) = d.komm_op.data(1) and
5 15568 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15569 end;
4 15570 end;
3 15571 if funk = 6 then goto oversigt;
3 15572 if funk = 5 then goto definer;
3 15573
3 15573 if nr = 0 then
3 15574 begin
4 15575 returner_op(komm_op,37<*spring ukendt*>);
4 15576 goto næste_tid;
4 15577 end;
3 15578
3 15578 goto case funk of(start,indsæt,annuler,vis);
3 15579 \f
3 15579 message procedure vt_spring side 8 - 810525/cl;
3 15580
3 15580 start:
3 15581 if springtabel(nr,3) shift (-12) <> 0 then
3 15582 begin returner_op(komm_op,38); goto næste_tid; end;
3 15583 disable
3 15584 begin <* find linie_løb_og_udtag *>
4 15585 s:= modif_fil(tf_springdef,nr,zi);
4 15586 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15587 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15588 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15589 id2:= 0;
4 15590 end;
3 15591 vt_operation(12,id1,id2,res,res_inf);
3 15592
3 15592 disable <* check resultat *>
3 15593 medd_kode:= if res = 3 <*ok*> then 7 else
3 15594 if res = 9 <*linie/løb ukendt*> then 1 else
3 15595 if res =14 <*optaget*> then 4 else
3 15596 if res =18 <*i kø*> then 3 else 0;
3 15597 returner_op(komm_op,3);
3 15598 if medd_kode = 0 then goto næste_tid;
3 15599
3 15599 <* send spring-meddelelse til io *>
3 15600 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15601
3 15601 <* opdater springtabel *>
3 15602 disable
3 15603 begin
4 15604 s:= modif_fil(tf_springdef,nr,zi);
4 15605 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15606 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15607 add (springtabel(nr,3) extract 12);
4 15608 systime(1,0.0,nu);
4 15609 springstart(nr):= nu;
4 15610 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15611 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15612 end;
3 15613 <*+2*>
3 15614 <**> disable
3 15615 <**> if testbit44 and overvåget then
3 15616 <**> begin
4 15617 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15618 <**> p_springtabel(out); ud;
4 15619 <**> end;
3 15620 <*-2*>
3 15621
3 15621 goto næste_tid;
3 15622 \f
3 15622 message procedure vt_spring side 9 - 810506/cl;
3 15623
3 15623 indsæt:
3 15624 if springtabel(nr,3) shift (-12) = 0 then
3 15625 begin <* ikke igangsat *>
4 15626 returner_op(komm_op,41);
4 15627 goto næste_tid;
4 15628 end;
3 15629 <* find frie linie/løb *>
3 15630 disable
3 15631 begin
4 15632 s:= læs_fil(tf_springdef,nr,zi);
4 15633 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15634 id2:= 0;
4 15635 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15636 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15637 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15638 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15639 id1:= d.komm_op.data(3);
4 15640 end;
3 15641
3 15641 if id2<>0 then
3 15642 vt_operation(11,id1,id2,res,res_inf)
3 15643 else
3 15644 res:= 42;
3 15645
3 15645 disable <* check resultat *>
3 15646 medd_kode:= if res = 3 <*ok*> then 8 else
3 15647 if res =10 <*bus ukendt*> then 0 else
3 15648 if res =11 <*bus allerede indsat*> then 0 else
3 15649 if res =12 <*linie/løb allerede besat*> then 2 else
3 15650 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15651 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15652 returner_op(komm_op,res);
3 15653 if medd_kode = 0 then goto næste_tid;
3 15654
3 15654 <* send springmeddelelse til io *>
3 15655 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15656 io_meddelelse(5,0,0,nr);
3 15657 \f
3 15657 message procedure vt_spring side 9a - 810525/cl;
3 15658
3 15658 <* annuler springtabel *>
3 15659 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15660 springtid(nr):= springstart(nr):= 0.0;
3 15661 <*+2*>
3 15662 <**> disable
3 15663 <**> if testbit44 and overvåget then
3 15664 <**> begin
4 15665 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15666 <**> p_springtabel(out); ud;
4 15667 <**> end;
3 15668 <*-2*>
3 15669
3 15669 goto næste_tid;
3 15670 \f
3 15670 message procedure vt_spring side 10 - 810525/cl;
3 15671
3 15671 annuler:
3 15672 disable
3 15673 begin <* find evt. frit linie/løb *>
4 15674 s:= læs_fil(tf_springdef,nr,zi);
4 15675 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15676 id1:= id2:= 0;
4 15677 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15678 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15679 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15680 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15681 returner_op(komm_op,3);
4 15682 end;
3 15683
3 15683 <* send springmeddelelse til io *>
3 15684 io_meddelelse(5,id1,id2,nr);
3 15685
3 15685 <* annuler springtabel *>
3 15686 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15687 springtid(nr):= springstart(nr):= 0.0;
3 15688 <*+2*>
3 15689 <**> disable
3 15690 <**> if testbit44 and overvåget then
3 15691 <**> begin
4 15692 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15693 <**> p_springtabel(out); ud;
4 15694 <**> end;
3 15695 <*-2*>
3 15696
3 15696 goto næste_tid;
3 15697
3 15697 definer:
3 15698 if nr <> 0 then <* allerede defineret *>
3 15699 begin
4 15700 res:= 36;
4 15701 goto slut_definer;
4 15702 end;
3 15703
3 15703 <* find frit nr *>
3 15704 i:= 0;
3 15705 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15706 if springtabel(i,1) = 0 then nr:= i;
3 15707 if nr = 0 then
3 15708 begin
4 15709 res:= 32; <* ingen fri plads *>
4 15710 goto slut_definer;
4 15711 end;
3 15712 \f
3 15712 message procedure vt_spring side 11 - 810525/cl;
3 15713
3 15713 disable
3 15714 begin integer array fdim(1:8),ia(1:32);
4 15715 <* læs sekvens *>
4 15716 fdim(4):= d.komm_op.data(3);
4 15717 s:= hent_fil_dim(fdim);
4 15718 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15719 if fdim(1) > 30 then
4 15720 res:= 35 <* springsekvens for stor *>
4 15721 else
4 15722 begin
5 15723 for i:= 1 step 1 until fdim(1) do
5 15724 begin
6 15725 s:= læs_fil(fdim(4),i,zi);
6 15726 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15727 ia(i):= fil(zi).iaf(1) shift 12;
6 15728 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15729 end;
5 15730 s:= modif_fil(tf_springdef,nr,zi);
5 15731 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15732 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15733 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15734 iaf:= 4;
5 15735 tofrom(fil(zi).iaf,ia,60);
5 15736 iaf:= 0;
5 15737 springtabel(nr,3):= fdim(1);
5 15738 springtid(nr):= springstart(nr):= 0.0;
5 15739 res:= 3;
5 15740 end;
4 15741 end;
3 15742 \f
3 15742 message procedure vt_spring side 11a - 81-525/cl;
3 15743
3 15743 slut_definer:
3 15744
3 15744 <* slet fil *>
3 15745 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15746 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15747 signalch(cs_slet_fil,spr_op,vt_optype);
3 15748 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15749 if d.spr_op.data(9) <> 0 then
3 15750 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15751 returner_op(komm_op,res);
3 15752 <*+2*>
3 15753 <**> disable
3 15754 <**> if testbit44 and overvåget then
3 15755 <**> begin
4 15756 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15757 <**> p_springtabel(out); ud;
4 15758 <**> end;
3 15759 <*-2*>
3 15760 goto næste_tid;
3 15761 \f
3 15761 message procedure vt_spring side 12 - 810525/cl;
3 15762
3 15762 vis:
3 15763 disable
3 15764 begin
4 15765 <* tilknyt fil *>
4 15766 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15767 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15768 d.spr_op.data(2):= 1;
4 15769 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15770 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15771 signalch(cs_opret_fil,spr_op,vt_optype);
4 15772 end;
3 15773
3 15773 <* afvent svar *>
3 15774 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15775 if d.spr_op.data(9) <> 0 then
3 15776 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15777 disable
3 15778 begin integer array ia(1:30);
4 15779 s:= læs_fil(tf_springdef,nr,zi);
4 15780 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15781 iaf:= 4;
4 15782 tofrom(ia,fil(zi).iaf,60);
4 15783 iaf:= 0;
4 15784 for i:= 1 step 1 until d.spr_op.data(1) do
4 15785 begin
5 15786 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15787 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15788 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15789 ia(i) shift (-12) extract 7
5 15790 else -(ia(i) shift (-12) extract 7);
5 15791 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15792 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15793 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15794 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15795 else ia(i) extract 12)
5 15796 else 0;
5 15797 end;
4 15798 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15799 sæt_fil_dim(d.spr_op.data);
4 15800 d.komm_op.data(3):= d.spr_op.data(1);
4 15801 d.komm_op.data(4):= d.spr_op.data(4);
4 15802 raf:= data+8;
4 15803 d.komm_op.raf(1):= springstart(nr);
4 15804 returner_op(komm_op,3);
4 15805 end;
3 15806 goto næste_tid;
3 15807 \f
3 15807 message procedure vt_spring side 13 - 810525/cl;
3 15808
3 15808 oversigt:
3 15809 disable
3 15810 begin
4 15811 <* opret fil *>
4 15812 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15813 d.spr_op.data(1):= max_antal_spring;
4 15814 d.spr_op.data(2):= 4;
4 15815 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15816 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15817 signalch(cs_opret_fil,spr_op,vt_optype);
4 15818 end;
3 15819
3 15819 <* afvent svar *>
3 15820 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15821 if d.spr_op.data(9) <> 0 then
3 15822 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15823 disable
3 15824 begin
4 15825 nr:= 0;
4 15826 for i:= 1 step 1 until max_antal_spring do
4 15827 begin
5 15828 if springtabel(i,1) <> 0 then
5 15829 begin
6 15830 nr:= nr +1;
6 15831 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15832 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15833 fil(zi).iaf(1):= springtabel(i,1);
6 15834 fil(zi).iaf(2):= springtabel(i,2);
6 15835 fil(zi,2):= springstart(i);
6 15836 end;
5 15837 end;
4 15838 d.spr_op.data(1):= nr;
4 15839 s:= sæt_fil_dim(d.spr_op.data);
4 15840 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15841 d.komm_op.data(1):= nr;
4 15842 d.komm_op.data(2):= d.spr_op.data(4);
4 15843 returner_op(komm_op,3);
4 15844 end;
3 15845 goto næste_tid;
3 15846
3 15846 vt_spring_trap:
3 15847 disable skriv_vt_spring(zbillede,1);
3 15848
3 15848 end vt_spring;
2 15849 \f
2 15849 message procedure vt_auto side 1 - 810505/cl;
2 15850
2 15850 procedure vt_auto(cs_auto_retur,auto_opref);
2 15851 value cs_auto_retur,auto_opref;
2 15852 integer cs_auto_retur,auto_opref;
2 15853 begin
3 15854 integer array field op,auto_op,iaf;
3 15855 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15856 res_inf,i,s,zi,kl,døgnstart;
3 15857 real t,nu,næste_tid;
3 15858 boolean optaget;
3 15859 integer array filnavn,nytnavn(1:4);
3 15860
3 15860 procedure skriv_vt_auto(zud,omfang);
3 15861 value omfang;
3 15862 zone zud;
3 15863 integer omfang;
3 15864 begin
4 15865 long array field laf;
4 15866
4 15866 laf:= 0;
4 15867 write(zud,"nl",1,<:+++ vt_auto :>);
4 15868 if omfang<>0 then
4 15869 begin
5 15870 skriv_coru(zud,abs curr_coruno);
5 15871 write(zud,"nl",1,<<d>,
5 15872 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15873 <:op :>,op,"nl",1,
5 15874 <:auto-op :>,auto_op,"nl",1,
5 15875 <:filref :>,filref,"nl",1,
5 15876 <:id1 :>,id1,"nl",1,
5 15877 <:id2 :>,id2,"nl",1,
5 15878 <:aktion :>,aktion,"nl",1,
5 15879 <:postnr :>,postnr,"nl",1,
5 15880 <:sidste-post :>,sidste_post,"nl",1,
5 15881 <:interval :>,interval,"nl",1,
5 15882 <:res :>,res,"nl",1,
5 15883 <:res-inf :>,res_inf,"nl",1,
5 15884 <:i :>,i,"nl",1,
5 15885 <:s :>,s,"nl",1,
5 15886 <:zi :>,zi,"nl",1,
5 15887 <:kl :>,kl,"nl",1,
5 15888 <:døgnstart :>,døgnstart,"nl",1,
5 15889 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15890 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15891 <:nu :>,nu,"nl",1,
5 15892 <:næste-tid :>,næste_tid,"nl",1,
5 15893 <:filnavn :>,filnavn.laf,"nl",1,
5 15894 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15895 <::>);
5 15896 end;
4 15897 end skriv_vt_auto;
3 15898 \f
3 15898 message procedure vt_auto side 2 - 810507/cl;
3 15899
3 15899 iaf:= 0;
3 15900 auto_op:= auto_opref;
3 15901 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15902 optaget:= false;
3 15903 næste_tid:= 0.0;
3 15904 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15905 stack_claim(if cm_test then 298 else 246);
3 15906 trap(vt_auto_trap);
3 15907
3 15907 <*+2*>
3 15908 <**> disable if testbit47 and overvåget or testbit28 then
3 15909 <**> skriv_vt_auto(out,0);
3 15910 <*-2*>
3 15911
3 15911 vent:
3 15912
3 15912 systime(1,0.0,nu);
3 15913 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15914 if næste_tid > nu then round(næste_tid-nu) else
3 15915 if optaget then 5 else 0;
3 15916 if interval=0 then interval:= 1;
3 15917
3 15917 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15918
3 15918 if op<>0 then goto filskift;
3 15919
3 15919 <* vent på adgang til vogntabel *>
3 15920 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15921
3 15921 <* afsend relevant operation til opdatering af vogntabel *>
3 15922 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15923 d.op.data(1):= id1;
3 15924 d.op.data(2):= id2;
3 15925 signalch(cs_vt_opd,op,vt_optype);
3 15926 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15927 res:= d.op.resultat;
3 15928 id2:= d.op.data(2);
3 15929 res_inf:= d.op.data(3);
3 15930
3 15930 <* åbn for vogntabel *>
3 15931 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15932 \f
3 15932 message procedure vt_auto side 3 - 810507/cl;
3 15933
3 15933 <* behandl svar fra opdatering *>
3 15934 <*+2*>
3 15935 <**> disable
3 15936 <**> if testbit45 and overvåget then
3 15937 <**> begin
4 15938 <**> integer li,lø,bo;
4 15939 <**> skriv_vt_auto(out,0);
4 15940 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15941 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15942 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15943 <**> for i:= 1,2 do
4 15944 <**> begin
5 15945 <**> li:= d.op.data(i);
5 15946 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15947 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15948 <**> li:= li shift (-12) extract 10;
5 15949 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15950 <**> end;
4 15951 <**> systime(4,næste_tid,t);
4 15952 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15953 <**> << zd.dd>,t/10000,"nl",1);
4 15954 <**> end;
3 15955 <*-2*>
3 15956 if res=31 then
3 15957 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15958 else
3 15959 if res<>3 then
3 15960 begin
4 15961 if -, optaget then
4 15962 begin
5 15963 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15964 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15965 if res=18 then 3 else if res=60 then 9 else 4;
5 15966 d.auto_op.data(2):= res_inf;
5 15967 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15968 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15969 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15970 end;
4 15971 if res=14 or res=18 then <* i kø eller optaget *>
4 15972 begin
5 15973 optaget:= true;
5 15974 goto vent;
5 15975 end;
4 15976 end;
3 15977 optaget:= false;
3 15978 \f
3 15978 message procedure vt_auto side 4 - 810507/cl;
3 15979
3 15979 <* find næste post *>
3 15980 disable
3 15981 begin
4 15982 if postnr=sidste_post then
4 15983 begin <* døgnskift *>
5 15984 postnr:= 1;
5 15985 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15986 end
4 15987 else postnr:= postnr+1;
4 15988 s:= læsfil(filref,postnr,zi);
4 15989 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 15990 aktion:= fil(zi).iaf(1);
4 15991 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 15992 id1:= fil(zi).iaf(3);
4 15993 id2:= fil(zi).iaf(4);
4 15994 end;
3 15995 goto vent;
3 15996 \f
3 15996 message procedure vt_auto side 5 - 810507/cl;
3 15997
3 15997 filskift:
3 15998
3 15998 <*+2*>
3 15999 <**> disable
3 16000 <**> if testbit41 and overvåget then
3 16001 <**> begin
4 16002 <**> skriv_vt_auto(out,0);
4 16003 <**> write(out,<: modtaget operation::>);
4 16004 <**> skriv_op(out,op);
4 16005 <**> end;
3 16006 <*-2*>
3 16007 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 16008 res:= 46;
3 16009 if d.op.opkode extract 12 <> 21 then
3 16010 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 16011 if filref = 0 then goto knyt;
3 16012
3 16012 <* gem filnavn til io-meddelelse *>
3 16013 disable begin
4 16014 integer array fdim(1:8);
4 16015 integer array field navn;
4 16016 fdim(4):= filref;
4 16017 hentfildim(fdim);
4 16018 navn:= 8;
4 16019 tofrom(filnavn,fdim.navn,8);
4 16020 end;
3 16021
3 16021 <* frivgiv tilknyttet autofil *>
3 16022 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 16023 d.auto_op.data(4):= filref;
3 16024 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 16025 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 16026 if d.auto_op.data(9) <> 0 then
3 16027 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 16028 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 16029 optaget:= false;
3 16030 næste_tid:= 0.0;
3 16031 res:= 3;
3 16032 \f
3 16032 message procedure vt_auto side 6 - 810507/cl;
3 16033
3 16033 <* tilknyt evt. ny autofil *>
3 16034 knyt:
3 16035 if d.op.data(1)<>0 then
3 16036 begin
4 16037 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 16038 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 16039 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 16040 disable
4 16041 begin integer pos1,pos2;
5 16042 pos1:= pos2:= 13;
5 16043 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 16044 begin
6 16045 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 16046 skrivtegn(d.auto_op.data,pos2,i);
6 16047 end;
5 16048 end;
4 16049 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 16050 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 16051 s:= d.auto_op.data(9);
4 16052 if s=0 then res:= 3 <* ok *> else
4 16053 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 16054 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 16055 if s=6 then res:= 48 <* i brug *> else
4 16056 fejlreaktion(14,2,<:auto,filskift:>,0);
4 16057 if res<>3 then goto returner;
4 16058
4 16058 tofrom(nytnavn,d.op.data,8);
4 16059
4 16059 <* find første post *>
4 16060 disable
4 16061 begin
5 16062 døgnstart:= systime(5,0.0,t);
5 16063 kl:= round t;
5 16064 filref:= d.auto_op.data(4);
5 16065 sidste_post:= d.auto_op.data(1);
5 16066 postnr:= 0;
5 16067 for postnr:= postnr+1 while postnr <= sidste_post do
5 16068 begin
6 16069 s:= læsfil(filref,postnr,zi);
6 16070 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 16071 if fil(zi).iaf(2) > kl then goto post_fundet;
6 16072 end;
5 16073 postnr:= 1;
5 16074 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16075 \f
5 16075 message procedure vt_auto side 7 - 810507/cl;
5 16076
5 16076 post_fundet:
5 16077 s:= læsfil(filref,postnr,zi);
5 16078 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 16079 aktion:= fil(zi).iaf(1);
5 16080 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 16081 id1:= fil(zi).iaf(3);
5 16082 id2:= fil(zi).iaf(4);
5 16083 res:= 3;
5 16084 end;
4 16085 end ny fil;
3 16086
3 16086 returner:
3 16087 d.op.resultat:= res;
3 16088 <*+2*>
3 16089 <**> disable
3 16090 <**> if testbit41 and overvåget then
3 16091 <**> begin
4 16092 <**> skriv_vt_auto(out,0);
4 16093 <**> write(out,<: returner operation::>);
4 16094 <**> skriv_op(out,op);
4 16095 <**> end;
3 16096 <*-2*>
3 16097 signalch(d.op.retur,op,d.op.optype);
3 16098
3 16098 if vt_log_aktiv then
3 16099 begin
4 16100 waitch(cs_vt_logpool,op,vt_optype,-1);
4 16101 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 16102 if nytnavn(1)=0 then
4 16103 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 16104 else
4 16105 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 16106 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 16107 systime(1,0.0,d.op.data.v_tid);
4 16108 signalch(cs_vt_log,op,vt_optype);
4 16109 end;
3 16110
3 16110 if filnavn(1)<>0 then
3 16111 begin <* meddelelse til io om annulering *>
4 16112 disable begin
5 16113 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 16114 i:= 1;
5 16115 hægtstring(d.auto_op.data,i,<:auto :>);
5 16116 skriv_text(d.auto_op.data,i,filnavn);
5 16117 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 16118 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 16119 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16120 end;
4 16121 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 16122 end;
3 16123 goto vent;
3 16124
3 16124 vt_auto_trap:
3 16125 disable skriv_vt_auto(zbillede,1);
3 16126
3 16126 end vt_auto;
2 16127 message procedure vt_log side 1 - 920517/cl;
2 16128
2 16128 procedure vt_log;
2 16129 begin
3 16130 integer i,j,ventetid;
3 16131 real dg,t,nu,skiftetid;
3 16132 boolean fil_åben;
3 16133 integer array ia(1:10),dp,dp1(1:8);
3 16134 integer array field op, iaf;
3 16135
3 16135 procedure skriv_vt_log(zud,omfang);
3 16136 value omfang;
3 16137 zone zud;
3 16138 integer omfang;
3 16139 begin
4 16140 write(zud,"nl",1,<:+++ vt-log :>);
4 16141 if omfang<>0 then
4 16142 begin
5 16143 skriv_coru(zud, abs curr_coruno);
5 16144 write(zud,"nl",1,<<d>,
5 16145 <:i :>,i,"nl",1,
5 16146 <:j :>,j,"nl",1,
5 16147 <:ventetid :>,ventetid,"nl",1,
5 16148 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 16149 <:t :>,t,"nl",1,
5 16150 <:nu :>,nu,"nl",1,
5 16151 <:skiftetid :>,skiftetid,"nl",1,
5 16152 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 16153 <:op :>,<<d>,op,"nl",1,
5 16154 <::>);
5 16155 raf:= 0;
5 16156 write(zud,"nl",1,<:ia::>);
5 16157 skrivhele(zud,ia.raf,20,2);
5 16158 write(zud,"nl",2,<:dp::>);
5 16159 skrivhele(zud,dp.raf,16,2);
5 16160 write(zud,"nl",2,<:dp1::>);
5 16161 skrivhele(zud,dp1.raf,16,2);
5 16162 end;
4 16163 end;
3 16164
3 16164 message procedure vt_log side 2 - 920517/cl;
3 16165
3 16165 procedure slet_fil;
3 16166 begin
4 16167 integer segm,res;
4 16168 integer array tail(1:10);
4 16169
4 16169 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 16170 if res=0 then
4 16171 begin
5 16172 segm:= tail(10);
5 16173 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 16174 if res=0 then
5 16175 begin
6 16176 close(zvtlog,true);
6 16177 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 16178 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16179 if res=0 then
6 16180 begin
7 16181 tail(1):= tail(1)+segm;
7 16182 monitor(44)change_entry:(zvtlog,0,tail);
7 16183 end;
6 16184 end;
5 16185 end;
4 16186 end;
3 16187
3 16187 boolean procedure udvid_fil;
3 16188 begin
4 16189 integer res,spos;
4 16190 integer array tail(1:10);
4 16191 zone z(1,1,stderror);
4 16192
4 16192 udvid_fil:= false;
4 16193 open(z,0,<:vtlogpool:>,0); close(z,true);
4 16194 res:= monitor(42)lookup_entry:(z,0,tail);
4 16195 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 16196 begin
5 16197 tail(1):=tail(1) - vt_log_slicelgd;
5 16198 res:=monitor(44)change_entry:(z,0,tail);
5 16199 if res=0 then
5 16200 begin
6 16201 spos:= vt_logtail(1);
6 16202 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 16203 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 16204 if res<>0 then
6 16205 begin
7 16206 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 16207 tail(1):= tail(1) + vt_log_slicelgd;
7 16208 monitor(44)change_entry:(z,0,tail);
7 16209 end
6 16210 else
6 16211 begin
7 16212 setposition(zvtlog,0,spos);
7 16213 udvid_fil:= true;
7 16214 end;
6 16215 end;
5 16216 end;
4 16217 end;
3 16218
3 16218 message procedure vt_log side 3 - 920517/cl;
3 16219
3 16219 boolean procedure ny_fil;
3 16220 begin
4 16221 integer res,i,j;
4 16222 integer array nyt(1:4), ia,tail(1:10);
4 16223 long array field navn;
4 16224 real t;
4 16225
4 16225 navn:=0;
4 16226 if fil_åben then
4 16227 begin
5 16228 close(zvtlog,true);
5 16229 fil_åben:= false;
5 16230 nyt.navn(1):= long<:vtlo:>;
5 16231 nyt.navn(2):= long<::>;
5 16232 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 16233 j:= 'a' - 1;
5 16234 repeat
5 16235 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 16236 if res=3 then
5 16237 begin
6 16238 j:= j+1;
6 16239 if j <= 'å' then skrivtegn(nyt,11,j);
6 16240 end;
5 16241 until (res<>3) or (j > 'å');
5 16242
5 16242 if res=0 then
5 16243 begin
6 16244 open(zvtlog,4,<:vtlogklar:>,0);
6 16245 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16246 if res=0 then
6 16247 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 16248 if res=0 then
6 16249 begin
7 16250 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 16251 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 16252 end;
6 16253
6 16253 if res=0 then
6 16254 begin
7 16255 setposition(zvtlog,0,tail(10)//64);
7 16256 navn:= (tail(10) mod 64)*8;
7 16257 if (tail(1) <= tail(10)//64) then
7 16258 outrec6(zvtlog,512)
7 16259 else
7 16260 swoprec6(zvtlog,512);
7 16261 tofrom(zvtlog.navn,nyt,8);
7 16262 tail(10):= tail(10)+1;
7 16263 setposition(zvtlog,0,tail(10)//64);
7 16264 monitor(44)change_entry:(zvtlog,0,tail);
7 16265 close(zvtlog,true);
7 16266 end
6 16267 else
6 16268 begin
7 16269 navn:= 0;
7 16270 close(zvtlog,true);
7 16271 open(zvtlog,4,<:vtlog:>,0);
7 16272 slet_fil;
7 16273 end;
6 16274 end
5 16275 else
5 16276 slet_fil;
5 16277 end;
4 16278
4 16278 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 16279 <* eller den er blevet slettet. *>
4 16280
4 16280 open(zvtlog,4,<:vtlog:>,0);
4 16281 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 16282 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 16283 vt_logtail(6):= systime(7,0,t);
4 16284
4 16284 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 16285 if res=0 then
4 16286 begin
5 16287 monitor(50)permanent_entry:(zvtlog,3,ia);
5 16288 if res<>0 then
5 16289 monitor(48)remove_entry:(zvtlog,0,ia);
5 16290 end;
4 16291
4 16291 if res=0 then fil_åben:= true;
4 16292
4 16292 ny_fil:= fil_åben;
4 16293 end ny_fil;
3 16294
3 16294 message procedure vt_log side 4 - 920517/cl;
3 16295
3 16295 procedure skriv_post(logpost);
3 16296 integer array logpost;
3 16297 begin
4 16298 integer array field post;
4 16299 real t;
4 16300
4 16300 if vt_logtail(10)//32 < vt_logtail(1) then
4 16301 begin
5 16302 outrec6(zvtlog,512);
5 16303 post:= (vt_logtail(10) mod 32)*16;
5 16304 tofrom(zvtlog.post,logpost,16);
5 16305 vt_logtail(10):= vt_logtail(10)+1;
5 16306 setposition(zvtlog,0,vt_logtail(10)//32);
5 16307 vt_logtail(6):= systime(7,0,t);
5 16308 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 16309 end;
4 16310 end;
3 16311
3 16311 procedure sletsendte;
3 16312 begin
4 16313 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 16314 integer array pooltail,tail,ia(1:10);
4 16315 integer i,res;
4 16316
4 16316 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 16317 res:=monitor(42,zpool,0,pooltail);
4 16318
4 16318 open(z,4,<:vtlogslet:>,0);
4 16319 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 16320 begin
5 16321 if monitor(52,z,0,tail)=0 then
5 16322 begin
6 16323 if monitor(8,z,0,tail)=0 then
6 16324 begin
7 16325 for i:=1 step 1 until tail(10) do
7 16326 begin
8 16327 inrec6(z,8);
8 16328 open(zlog,0,z,0); close(zlog,true);
8 16329 if monitor(42,zlog,0,ia)=0 then
8 16330 begin
9 16331 if monitor(48,zlog,0,ia)=0 then
9 16332 begin
10 16333 pooltail(1):=pooltail(1)+ia(1);
10 16334 end;
9 16335 end;
8 16336 end;
7 16337 tail(10):=0;
7 16338 monitor(44,z,0,tail);
7 16339 end
6 16340 else
6 16341 monitor(64,z,0,tail);
6 16342 end;
5 16343 if res=0 then monitor(44,zpool,0,pooltail);
5 16344 end;
4 16345 close(z,true);
4 16346 end;
3 16347
3 16347 message procedure vt_log side 5 - 920517/cl;
3 16348
3 16348 trap(vt_log_trap);
3 16349 stack_claim(200);
3 16350
3 16350 fil_åben:= false;
3 16351 if -, vt_log_aktiv then goto init_slut;
3 16352 open(zvtlog,4,<:vtlog:>,0);
3 16353 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16354 if i=0 then
3 16355 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16356 if i=0 then
3 16357 begin
4 16358 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16359 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16360 end;
3 16361
3 16361 if (i=0) and (vt_logtail(1)=0) then
3 16362 begin
4 16363 close(zvtlog,true);
4 16364 monitor(48)remove_entry:(zvtlog,0,ia);
4 16365 i:= 1;
4 16366 end;
3 16367
3 16367 disable
3 16368 if i=0 then
3 16369 begin
4 16370 fil_åben:= true;
4 16371 inrec6(zvtlog,512);
4 16372 vt_logstart:= zvtlog.v_tid;
4 16373 systime(1,0.0,nu);
4 16374 if (nu - vt_logstart) < 24*60*60.0 then
4 16375 begin
5 16376 setposition(zvtlog,0,vt_logtail(10)//32);
5 16377 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16378 begin
6 16379 inrec6(zvtlog,512);
6 16380 setposition(zvtlog,0,vt_logtail(10)//32);
6 16381 end;
5 16382 end
4 16383 else
4 16384 begin
5 16385 if ny_fil then
5 16386 begin
6 16387 if udvid_fil then
6 16388 begin
7 16389 systime(1,0.0,dp.v_tid);
7 16390 vt_logstart:= dp.v_tid;
7 16391 dp.v_kode:=0;
7 16392 skriv_post(dp);
7 16393 end
6 16394 else
6 16395 begin
7 16396 close(zvtlog,true);
7 16397 monitor(48)remove_entry:(zvtlog,0,ia);
7 16398 fil_åben:= false;
7 16399 end;
6 16400 end;
5 16401 end;
4 16402 end
3 16403 else
3 16404 begin
4 16405 close(zvtlog,true);
4 16406 if ny_fil then
4 16407 begin
5 16408 if udvid_fil then
5 16409 begin
6 16410 systime(1,0.0,dp.v_tid);
6 16411 vt_logstart:= dp.v_tid;
6 16412 dp.v_kode:=0;
6 16413 skriv_post(dp);
6 16414 end
5 16415 else
5 16416 begin
6 16417 close(zvtlog,true);
6 16418 monitor(48)remove_entry:(zvtlog,0,ia);
6 16419 fil_åben:= false;
6 16420 end;
5 16421 end;
4 16422 end;
3 16423
3 16423 init_slut:
3 16424
3 16424 dg:= systime(5,0,t);
3 16425 if t < vt_logskift then
3 16426 skiftetid:= systid(dg,vt_logskift)
3 16427 else
3 16428 skiftetid:= systid(dg+1,vt_logskift);
3 16429
3 16429 message procedure vt_log side 6 - 920517/cl;
3 16430
3 16430 vent:
3 16431
3 16431 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16432 ventetid:= round(skiftetid - nu);
3 16433 if ventetid < 1 then ventetid:= 1;
3 16434
3 16434 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16435
3 16435 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16436 if op <> 0 then
3 16437 begin
4 16438 tofrom(dp,d.op.data,16);
4 16439 signalch(cs_vt_logpool,op,vt_optype);
4 16440 end;
3 16441
3 16441 if -, vt_log_aktiv then goto vent;
3 16442
3 16442 disable if (op=0) or (nu > skiftetid) then
3 16443 begin
4 16444 if fil_åben then
4 16445 begin
5 16446 dp1.v_tid:= systid(dg,vt_logskift);
5 16447 dp1.v_kode:= 1;
5 16448 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16449 begin
6 16450 if udvid_fil then
6 16451 skriv_post(dp1);
6 16452 end
5 16453 else
5 16454 skriv_post(dp1);
5 16455 end;
4 16456
4 16456 if (op=0) or (nu > skiftetid) then
4 16457 skiftetid:= skiftetid + 24*60*60.0;
4 16458
4 16458 sletsendte;
4 16459
4 16459 if ny_fil then
4 16460 begin
5 16461 if udvid_fil then
5 16462 begin
6 16463 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16464 dp1.v_kode:= 0;
6 16465 skriv_post(dp1);
6 16466 end
5 16467 else
5 16468 begin
6 16469 close(zvtlog,true);
6 16470 monitor(48)remove_entry:(zvtlog,0,ia);
6 16471 fil_åben:= false;
6 16472 end;
5 16473 end;
4 16474 end;
3 16475
3 16475 disable if op<>0 and fil_åben then
3 16476 begin
4 16477 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16478 begin
5 16479 if -, udvid_fil then
5 16480 begin
6 16481 if ny_fil then
6 16482 begin
7 16483 if udvid_fil then
7 16484 begin
8 16485 systime(1,0.0,dp1.v_tid);
8 16486 vt_logstart:= dp1.v_tid;
8 16487 dp1.v_kode:= 0;
8 16488 skriv_post(dp1);
8 16489 end
7 16490 else
7 16491 begin
8 16492 close(zvtlog,true);
8 16493 monitor(48)remove_entry:(zvtlog,0,ia);
8 16494 fil_åben:= false;
8 16495 end;
7 16496 end;
6 16497 end;
5 16498 end;
4 16499
4 16499 if fil_åben then skriv_post(dp);
4 16500 end;
3 16501
3 16501 goto vent;
3 16502
3 16502 vt_log_trap:
3 16503 disable skriv_vt_log(zbillede,1);
3 16504 end vt_log;
2 16505 \f
2 16505
2 16505 algol list.off;
2 16506 message coroutinemonitor - 11 ;
2 16507
2 16507
2 16507 <*************** coroutine monitor procedures ***************>
2 16508
2 16508
2 16508 <***** delay *****
2 16509
2 16509 this procedure links the calling coroutine into the timerqueue and sets
2 16510 the timeout value to 'timeout'. *>
2 16511
2 16511
2 16511 procedure delay (timeout);
2 16512 value timeout;
2 16513 integer timeout;
2 16514 begin
3 16515 link(current, idlequeue);
3 16516 link(current + corutimerchain, timerqueue);
3 16517 d.current.corutimer:= timeout;
3 16518
3 16518
3 16518 passivate;
3 16519 d.current.corutimer:= 0;
3 16520 end;
2 16521 \f
2 16521
2 16521 message coroutinemonitor - 12 ;
2 16522
2 16522
2 16522 <***** pass *****
2 16523
2 16523 this procedure moves the calling coroutine from the head of the ready
2 16524 queue down below all coroutines of lower or equal priority. *>
2 16525
2 16525
2 16525 procedure pass;
2 16526 begin
3 16527 linkprio(current, readyqueue);
3 16528
3 16528
3 16528 passivate;
3 16529 end;
2 16530
2 16530
2 16530 <***** signal ****
2 16531
2 16531 this procedure increases the value af 'semaphore' by 1.
2 16532 in case some coroutine is already waiting, it is linked into the ready
2 16533 queue for activation. the calling coroutine continues execution. *>
2 16534
2 16534
2 16534 procedure signal (semaphore);
2 16535 value semaphore;
2 16536 integer semaphore;
2 16537 begin
3 16538 integer array field sem;
3 16539 sem:= semaphore;
3 16540 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16541 d.sem.simvalue:= d.sem.simvalue + 1;
3 16542
3 16542
3 16542 end;
2 16543 \f
2 16543
2 16543 message coroutinemonitor - 13 ;
2 16544
2 16544
2 16544 <***** wait *****
2 16545
2 16545 this procedure decreases the value of 'semaphore' by 1.
2 16546 in case the value of the semaphore is negative after the decrease, the
2 16547 calling coroutine is linked into the semaphore queue waiting for a
2 16548 coroutine to signal this semaphore. *>
2 16549
2 16549
2 16549 procedure wait (semaphore);
2 16550 value semaphore;
2 16551 integer semaphore;
2 16552 begin
3 16553 integer array field sem;
3 16554 sem:= semaphore;
3 16555 d.sem.simvalue:= d.sem.simvalue - 1;
3 16556
3 16556
3 16556 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16557 passivate;
3 16558 end;
2 16559 \f
2 16559
2 16559 message coroutinemonitor - 14 ;
2 16560
2 16560
2 16560 <***** inspect *****
2 16561
2 16561 this procedure inspects the value of the semaphore and returns it in
2 16562 'elements'.
2 16563 the semaphore is left unchanged. *>
2 16564
2 16564
2 16564 procedure inspect (semaphore, elements);
2 16565 value semaphore;
2 16566 integer semaphore, elements;
2 16567 begin
3 16568 integer array field sem;
3 16569 sem:= semaphore;
3 16570 elements:= d.sem.simvalue;
3 16571
3 16571
3 16571 end;
2 16572 \f
2 16572
2 16572 message coroutinemonitor - 15 ;
2 16573
2 16573
2 16573 <***** signalch *****
2 16574
2 16574 this procedure delivers an operation at 'semaphore'.
2 16575 in case another coroutine is already waiting for an operation of the
2 16576 kind 'operationtype' this coroutine will get the operation and it will
2 16577 be put into the ready queue for activation.
2 16578 in case no coroutine is waiting for the actial kind of operation it is
2 16579 linked into the semaphore queue, at the end of the queue
2 16580 if operation is positive and at the beginning if operation is negative.
2 16581 the calling coroutine continues execution. *>
2 16582
2 16582
2 16582 procedure signalch (semaphore, operation, operationtype);
2 16583 value semaphore, operation, operationtype;
2 16584 integer semaphore, operation;
2 16585 boolean operationtype;
2 16586 begin
3 16587 integer array field firstcoru, currcoru, op,currop;
3 16588 op:= abs operation;
3 16589 d.op.optype:= operationtype;
3 16590 firstcoru:= semaphore + semcoru;
3 16591 currcoru:= d.firstcoru.next;
3 16592 while currcoru <> firstcoru do
3 16593 begin
4 16594 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16595 begin
5 16596 link(operation, 0);
5 16597 d.currcoru.coruop:= operation;
5 16598 linkprio(currcoru, readyqueue);
5 16599 link(currcoru + corutimerchain, idlequeue);
5 16600 goto exit;
5 16601 end else currcoru:= d.currcoru.next;
4 16602 end;
3 16603 currop:=semaphore + semop;
3 16604 if operation < 0 then currop:=d.currop.next;
3 16605 link(op, currop);
3 16606 exit:
3 16607
3 16607
3 16607 end;
2 16608 \f
2 16608
2 16608 message coroutinemonitor - 16 ;
2 16609
2 16609
2 16609 <***** waitch *****
2 16610
2 16610 this procedure fetches an operation from a semaphore.
2 16611 in case an operation matching 'operationtypeset' is already waiting at
2 16612 'semaphore' it is handed over to the calling coroutine.
2 16613 in case no matching operation is waiting, the calling coroutine is
2 16614 linked to the semaphore.
2 16615 in any case the calling coroutine will be stopped and all corouti-
2 16616 nes are rescheduled. *>
2 16617
2 16617
2 16617 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16618 value semaphore, operationtypeset, timeout;
2 16619 integer semaphore, operation, timeout;
2 16620 boolean operationtypeset;
2 16621 begin
3 16622 integer array field firstop, currop;
3 16623 firstop:= semaphore + semop;
3 16624 currop:= d.firstop.next;
3 16625
3 16625
3 16625 while currop <> firstop do
3 16626 begin
4 16627 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16628 begin
5 16629 link(currop, 0);
5 16630 d.current.coruop:= currop;
5 16631 operation:= currop;
5 16632 \f
5 16632
5 16632 message coroutinemonitor - 17 ;
5 16633
5 16633 linkprio(current, readyqueue);
5 16634 passivate;
5 16635 goto exit;
5 16636 end else currop:= d.currop.next;
4 16637 end;
3 16638 linkprio(current, semaphore + semcoru);
3 16639 if timeout > 0 then
3 16640 begin
4 16641 link(current + corutimerchain, timerqueue);
4 16642 d.current.corutimer:= timeout;
4 16643 end else d.current.corutimer:= 0;
3 16644 d.current.corutypeset:= operationtypeset;
3 16645 passivate;
3 16646 if d.current.corutimer < 0 then operation:= 0
3 16647 else operation:= d.current.coruop;
3 16648 d.current.corutimer:= 0;
3 16649 currop:= operation;
3 16650 d.current.coruop:= currop;
3 16651 link(current+corutimerchain, idlequeue);
3 16652 exit:
3 16653
3 16653
3 16653 end;
2 16654 \f
2 16654
2 16654 message coroutinemonitor - 18 ;
2 16655
2 16655
2 16655 <***** inspectch *****
2 16656
2 16656 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16657 the number of matching operations are counted and delivered in 'elements'.
2 16658 if no operations are found the number of coroutines waiting
2 16659 for operations of the typeset are counted and delivered as
2 16660 negative value in 'elements'.
2 16661 the semaphore is left unchanged. *>
2 16662
2 16662
2 16662 procedure inspectch (semaphore, operationtypeset, elements);
2 16663 value semaphore, operationtypeset;
2 16664 integer semaphore, elements;
2 16665 boolean operationtypeset;
2 16666 begin
3 16667 integer array field firstop, currop,firstcoru,currcoru;
3 16668 integer counter;
3 16669 counter:= 0;
3 16670 firstop:= semaphore + semop;
3 16671 currop:= d.firstop.next;
3 16672 while currop <> firstop do
3 16673 begin
4 16674 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16675 counter:= counter + 1;
4 16676 currop:= d.currop.next;
4 16677 end;
3 16678 if counter=0 then
3 16679 begin
4 16680 firstcoru:=semaphore + sem_coru;
4 16681 curr_coru:=d.firstcoru.next;
4 16682 while curr_coru<>first_coru do
4 16683 begin
5 16684 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16685 counter:=counter - 1;
5 16686 curr_coru:=d.curr_coru.next;
5 16687 end;
4 16688 end;
3 16689 elements:= counter;
3 16690
3 16690
3 16690 end;
2 16691 \f
2 16691
2 16691 message coroutinemonitor - 19 ;
2 16692
2 16692
2 16692 <***** csendmessage *****
2 16693
2 16693 this procedure sends the message in 'mess' to the process defined by the name
2 16694 in 'receiver', and returns an identification of the message extension used
2 16695 for sending the message (this identification is to be used for calling 'cwait-
2 16696 answer' or 'cregretmessage'. *>
2 16697
2 16697
2 16697 procedure csendmessage (receiver, mess, messextension);
2 16698 real array receiver;
2 16699 integer array mess;
2 16700 integer messextension;
2 16701 begin
3 16702 integer bufref, messext;
3 16703 messref(maxmessext):= 0;
3 16704 messext:= 1;
3 16705 while messref(messext) <> 0 do messext:= messext + 1;
3 16706 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16707 begin
4 16708 messcode(messext):= 1 shift 12 add 2;
4 16709 mon(16) send message :(0, mess, 0, receiver);
4 16710 messref(messext):= monw2;
4 16711 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16712 end;
3 16713
3 16713
3 16713 end;
2 16714 \f
2 16714
2 16714 message coroutinemonitor - 20 ;
2 16715
2 16715
2 16715 <***** cwaitanswer *****
2 16716
2 16716 this procedure asks the coroutine monitor to get an answer to the message
2 16717 corresponding to 'messextension'. in case the answer has already arrived
2 16718 it stays in the eventqueue until 'cwaitanswer' is called.
2 16719 in case 'timeout' is positive, the coroutine is linked into the timer
2 16720 queue, and in case the answer does not arrive within 'timout' seconds the
2 16721 coroutine is restarted with result = 0. *>
2 16722
2 16722
2 16722 procedure cwaitanswer (messextension, answer, result, timeout);
2 16723 value messextension, timeout;
2 16724 integer messextension, result, timeout;
2 16725 integer array answer;
2 16726 begin
3 16727 integer messext;
3 16728 messext:= messextension;
3 16729 messcode(messext):= messcode(messext) extract 12;
3 16730 link(current, idlequeue);
3 16731 messop(messext):= current;
3 16732 if timeout > 0 then
3 16733 begin
4 16734 link(current + corutimerchain, timerqueue);
4 16735 d.current.corutimer:= timeout;
4 16736 end else d.current.corutimer:= 0;
3 16737
3 16737
3 16737 passivate;
3 16738 if d.current.corutimer < 0 then result:= 0 else
3 16739 begin
4 16740 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16741 result:= monw0;
4 16742 baseevent:= 0;
4 16743 messref(messextension):= 0;
4 16744 end;
3 16745 d.current.corutimer:= 0;
3 16746 link(current+corutimerchain, idlequeue);
3 16747 end;
2 16748 \f
2 16748
2 16748 message coroutinemonitor - 21 ;
2 16749
2 16749
2 16749 <***** cwaitmessage *****
2 16750
2 16750 this procedure asks the coroutine monitor to give it a message, when some-
2 16751 one arrives. in case a message has arrived already it stays at the event queue
2 16752 until 'cwaitmessage' is called.
2 16753 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16754 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16755 with messbufferref = 0. *>
2 16756
2 16756
2 16756 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16757 value timeout, processextension;
2 16758 integer processextension, messbufferref, timeout;
2 16759 integer array mess;
2 16760 begin
3 16761 integer i;
3 16762 integer array field messbuf;
3 16763 proccode(processextension):= 2;
3 16764 procop(processextension):= current;
3 16765 link(current, idlequeue);
3 16766 if timeout > 0 then
3 16767 begin
4 16768 link(current + corutimerchain, timerqueue);
4 16769 d.current.corutimer:= timeout;
4 16770 end else d.current.corutimer:= 0;
3 16771
3 16771
3 16771 passivate;
3 16772 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16773 begin
4 16774 messbuf:= procop(processextension);
4 16775 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16776 proccode(procext):= 1 shift 12;
4 16777 messbufferref:= messbuf;
4 16778 baseevent:= 0;
4 16779 end;
3 16780 d.current.corutimer:= 0;
3 16781 link(current+corutimerchain, idlequeue);
3 16782 end;
2 16783 \f
2 16783
2 16783 message coroutinemonitor - 22 ;
2 16784
2 16784
2 16784 <***** cregretmessage *****
2 16785
2 16785 this procedure regrets the message corresponding to messageexten-
2 16786 sion, to release message buffer and message extension.
2 16787 i/o messages are not regretable. *>
2 16788
2 16788
2 16788
2 16788 procedure cregretmessage (messageextension);
2 16789 value messageextension;
2 16790 integer messageextension;
2 16791 begin
3 16792 integer array field messbuf;
3 16793 messbuf:= messref(messageextension);
3 16794 mon(82) regret message :(0, 0, messbuf, 0);
3 16795 messref(messageextension):= 0;
3 16796
3 16796
3 16796 end;
2 16797 \f
2 16797
2 16797 message coroutinemonitor - 23 ;
2 16798
2 16798
2 16798 <***** semsendmessage *****
2 16799
2 16799 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16800 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16801 by the monitor, when the answer arrives.
2 16802 in case there are too few resources to send the message, the operation is
2 16803 returned immediately with the result field set to zero. *>
2 16804
2 16804
2 16804 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16805 value semaphore, operation, operationtype;
2 16806 real array receiver;
2 16807 integer array mess;
2 16808 integer semaphore, operation;
2 16809 boolean operationtype;
2 16810 begin
3 16811 integer array field op;
3 16812 integer messext;
3 16813 op:= operation;
3 16814 messref(maxmessext):= 0;
3 16815 messext:= 1;
3 16816 while messref(messext) <> 0 do messext:= messext + 1;
3 16817 if messext < maxmessext then
3 16818 begin
4 16819 messop(messext):= op;
4 16820 messcode(messext):=1;
4 16821 d.op(1):= semaphore;
4 16822 d.op.optype:= operationtype;
4 16823 mon(16) send message :(0, mess, 0, receiver);
4 16824 messref(messext):= monw2;
4 16825 end;
3 16826
3 16826
3 16826 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16827 begin <* return the operation immediately with result = 0 *>
4 16828 d.op(9):= 0;
4 16829 signalch(semaphore, op, operationtype);
4 16830 end;
3 16831 end;
2 16832 \f
2 16832
2 16832 message coroutinemonitor - 24 ;
2 16833
2 16833
2 16833 <***** semwaitmessage *****
2 16834
2 16834 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16835 be performed by the coroutine monitor when a message arrives to the process
2 16836 corresponding to 'processextension'. *>
2 16837
2 16837
2 16837 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16838 value processextension, semaphore, operation, operationtype;
2 16839 integer processextension, semaphore, operation;
2 16840 boolean operationtype;
2 16841 begin
3 16842 integer array field op;
3 16843 op:= operation;
3 16844 procop(processextension):= operation;
3 16845 d.op(1):= semaphore;
3 16846 d.op.optype:= operationtype;
3 16847 proccode(processextension):= 1;
3 16848
3 16848
3 16848 end;
2 16849 \f
2 16849
2 16849 message coroutinemonitor - 25 ;
2 16850
2 16850
2 16850 <***** semregretmessage *****
2 16851
2 16851 this procedure regrets a message sent by semsendmessage.
2 16852 the message is identified by the operation in which the answer should be
2 16853 returned.
2 16854 the procedure sets the result field of the operation to zero, and then
2 16855 returns it by performing a signalch. *>
2 16856
2 16856
2 16856 procedure semregretmessage (operation);
2 16857 value operation;
2 16858 integer operation;
2 16859 begin
3 16860 integer i, j;
3 16861 integer array field op, sem;
3 16862 op:= operation;
3 16863 i:= 1;
3 16864 while i < maxmessext do
3 16865 begin
4 16866 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16867 begin
5 16868 mon(82) regret message :(0, 0, messref(i), 0);
5 16869 messref(i):= 0;
5 16870 sem:= d.op(1);
5 16871 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16872 signalch(sem, op, d.op.optype);
5 16873 i:= maxmessext;
5 16874 end;
4 16875 i:= i + 1;
4 16876 end;
3 16877
3 16877
3 16877 end;
2 16878 \f
2 16878
2 16878 message coroutinemonitor - 26 ;
2 16879
2 16879
2 16879 <***** link *****
2 16880
2 16880 this procedure links an object (allocated in the descriptor array 'd') into
2 16881 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16882 are all double chained, and the chainhead is of the same format as the chain
2 16883 fields of the objects.
2 16884 the procedure links the object immediately after the head. *>
2 16885
2 16885
2 16885 procedure link (object, chainhead);
2 16886 value object, chainhead;
2 16887 integer object, chainhead;
2 16888 begin
3 16889 integer array field prevelement, nextelement, chead, obj;
3 16890 obj:= object;
3 16891 chead:= chainhead;
3 16892 prevelement:= d.obj.prev;
3 16893 nextelement:= d.obj.next;
3 16894 d.prevelement.next:= nextelement;
3 16895 d.nextelement.prev:= prevelement;
3 16896 if chead > 0 then <* link into queue *>
3 16897 begin
4 16898 prevelement:= d.chead.prev;
4 16899 d.obj.prev:= prevelement;
4 16900 d.prevelement.next:= obj;
4 16901 d.obj.next:= chead;
4 16902 d.chead.prev:= obj;
4 16903 end else
3 16904 begin <* link onto itself *>
4 16905 d.obj.prev:= obj;
4 16906 d.obj.next:= obj;
4 16907 end;
3 16908 end;
2 16909 \f
2 16909
2 16909 message coroutinemonitor - 27 ;
2 16910
2 16910
2 16910 <***** linkprio *****
2 16911
2 16911 this procedure is used to link coroutines into queues corresponding to
2 16912 the priorities of the actual coroutine and the queue elements.
2 16913 the object is linked immediately before the first coroutine of lower prio-
2 16914 rity. *>
2 16915
2 16915
2 16915 procedure linkprio (object, chainhead);
2 16916 value object, chainhead;
2 16917 integer object, chainhead;
2 16918 begin
3 16919 integer array field currelement, chead, obj;
3 16920 obj:= object;
3 16921 chead:= chainhead;
3 16922 currelement:= d.chead.next;
3 16923 while currelement <> chead
3 16924 and d.currelement.corupriority <= d.obj.corupriority
3 16925 do currelement:= d.currelement.next;
3 16926 link(obj, currelement);
3 16927 end;
2 16928 \f
2 16928
2 16928 message coroutinemonitor - 28 ;
2 16929
2 16929 \f
2 16929
2 16929 message coroutinemonitor - 30a ;
2 16930
2 16930
2 16930 <*************** extention to coroutine monitor procedures **********>
2 16931
2 16931 <***** signalbin *****
2 16932
2 16932 this procedure simulates a binary semaphore on a simple semaphore
2 16933 by testing the value of the semaphore before signaling the
2 16934 semaphore. if the value of the semaphore is one (=open) nothing is
2 16935 done, otherwise a normal signal is carried out. *>
2 16936
2 16936
2 16936 procedure signalbin(semaphore);
2 16937 value semaphore;
2 16938 integer semaphore;
2 16939 begin
3 16940 integer array field sem;
3 16941 integer val;
3 16942 sem:= semaphore;
3 16943 inspect(sem,val);
3 16944 if val<1 then signal(sem);
3 16945 end;
2 16946 \f
2 16946
2 16946 message coroutinemonitor - 30b ;
2 16947
2 16947 <***** coruno *****
2 16948
2 16948 delivers the coroutinenumber for a give coroutine id.
2 16949 if the coroutine does not exists the value 0 is delivered *>
2 16950
2 16950 integer procedure coru_no(coru_id);
2 16951 value coru_id;
2 16952 integer coru_id;
2 16953 begin
3 16954 integer array field cor;
3 16955
3 16955 coru_no:= 0;
3 16956 for cor:= firstcoru step corusize until (coruref-1) do
3 16957 if d.cor.coruident//1000 = coru_id then
3 16958 coru_no:= d.cor.coruident mod 1000;
3 16959 end;
2 16960 \f
2 16960
2 16960 message coroutinemonitor - 30c ;
2 16961
2 16961 <***** coroutine *****
2 16962
2 16962 delivers the referencebyte for the coroutinedescriptor for
2 16963 a coroutine identified by coroutinenumber *>
2 16964
2 16964 integer procedure coroutine(cor_no);
2 16965 value cor_no;
2 16966 integer cor_no;
2 16967 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16968 firstcoru + (cor_no-1)*corusize;
2 16969 \f
2 16969
2 16969 message coroutinemonitor - 30d ;
2 16970
2 16970 <***** curr_coruno *****
2 16971
2 16971 delivers number of calling coroutine
2 16972 curr_coruno:
2 16973 < 0 = -current_coroutine_number in disabled mode
2 16974 = 0 = procedure not called from coroutine
2 16975 > 0 = current_coroutine_number in enabled mode *>
2 16976
2 16976 integer procedure curr_coruno;
2 16977 begin
3 16978 integer i;
3 16979 integer array ia(1:12);
3 16980
3 16980 i:= system(12,0,ia);
3 16981 if i > 0 then
3 16982 begin
4 16983 i:= system(12,1,ia);
4 16984 curr_coruno:= ia(3);
4 16985 end else curr_coruno:= 0;
3 16986 end curr_coruno;
2 16987 \f
2 16987
2 16987 message coroutinemonitor - 30e ;
2 16988
2 16988 <***** curr_coruid *****
2 16989
2 16989 delivers coruident of calling coroutine :
2 16990
2 16990 curr_coruid:
2 16991 > 0 = coruident of calling coroutine
2 16992 = 0 = procedure not called from coroutine *>
2 16993
2 16993 integer procedure curr_coruid;
2 16994 begin
3 16995 integer cor_no;
3 16996 integer array field cor;
3 16997
3 16997 cor_no:= abs curr_coruno;
3 16998 if cor_no <> 0 then
3 16999 begin
4 17000 cor:= coroutine(cor_no);
4 17001 curr_coruid:= d.cor.coruident // 1000;
4 17002 end
3 17003 else curr_coruid:= 0;
3 17004 end curr_coruid;
2 17005 \f
2 17005 message coroutinemonitor - 30f.1 ;
2 17006
2 17006 <**** getch *****
2 17007
2 17007 this procedure searches the queue of operations waiting at 'semaphore'
2 17008 to find an operation that matches the operationstypeset and a set of
2 17009 select-values. each select value is specified by type and fieldvalue
2 17010 in integer array 'type' and by the value in integer array 'val'.
2 17011
2 17011 0: eq 0: not used
2 17012 1: lt 1: boolean
2 17013 2: le 2: integer
2 17014 3: gt 3: long
2 17015 4: ge 4: real
2 17016 5: ne
2 17017 *>
2 17018
2 17018 procedure getch(semaphore,operation,operationtypeset,type,val);
2 17019 value semaphore,operationtypeset;
2 17020 integer semaphore,operation;
2 17021 boolean operationtypeset;
2 17022 integer array type,val;
2 17023 begin
3 17024 integer array field firstop,currop;
3 17025 integer ø,n,i,f,t,rel,i1,i2;
3 17026 boolean field bf,bfval;
3 17027 integer field intf;
3 17028 long field lf,lfval; long l1,l2;
3 17029 real field rf,rfval; real r1,r2;
3 17030
3 17030 boolean match;
3 17031
3 17031 operation:= 0;
3 17032 n:= system(3,ø,type);
3 17033 match:= false;
3 17034 firstop:= semaphore + semop;
3 17035 currop:= d.firstop.next;
3 17036 while currop <> firstop and -,match do
3 17037 begin
4 17038 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 17039 begin
5 17040 i:= n;
5 17041 match:= true;
5 17042 \f
5 17042 message coroutinemonitor - 30f.2 ;
5 17043
5 17043 while match and (if i <= ø then type(i) >= 0 else false) do
5 17044 begin
6 17045 rel:= type(i) shift(-18);
6 17046 t:= type(i) shift(-12) extract 6;
6 17047 f:= type(i) extract 12;
6 17048 if f > 2047 then f:= f -4096;
6 17049 case t+1 of
6 17050 begin
7 17051 ; <* not used *>
7 17052
7 17052 begin <*boolean or signed short integer*>
8 17053 bf:= f;
8 17054 bfval:= 2*i;
8 17055 i1:= d.currop.bf extract 12;
8 17056 if i1 > 2047 then i1:= i1-4096;
8 17057 i2:= val.bfval extract 12;
8 17058 if i2 > 2047 then i2:= i2-4096;
8 17059 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17060 end;
7 17061
7 17061 begin <*integer*>
8 17062 intf:= f;
8 17063 i1:= d.currop.intf;
8 17064 i2:= val(i);
8 17065 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17066 end;
7 17067
7 17067 begin <*long*>
8 17068 lf:= f;
8 17069 lfval:= i*2;
8 17070 l1:= d.currop.lf;
8 17071 l2:= val.lfval;
8 17072 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 17073 end;
7 17074
7 17074 begin <*real*>
8 17075 rf:= f;
8 17076 rfval:= i*2;
8 17077 r1:= d.currop.rf;
8 17078 r2:= val.rfval;
8 17079 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 17080 end;
7 17081
7 17081 end;<*case t+1*>
6 17082
6 17082 i:= i+1;
6 17083 end; <*while match and i<=ø and t>=0 *>
5 17084 \f
5 17084 message coroutinemonitor - 30f.3 ;
5 17085
5 17085 end; <* if operationtypeset and ---*>
4 17086 if -,match then currop:= d.currop.next;
4 17087 end; <*while currop <> firstop and -,match*>
3 17088
3 17088 if match then
3 17089 begin
4 17090 link(currop,0);
4 17091 d.current.coruop:= currop;
4 17092 operation:= currop;
4 17093 end;
3 17094 end getch;
2 17095 \f
2 17095
2 17095 message coroutinemonitor - 31 ;
2 17096
2 17096 activity(maxcoru);
2 17097
2 17097 goto initialization;
2 17098
2 17098
2 17098
2 17098 <*************** event handling ***************>
2 17099
2 17099
2 17099
2 17099 takeexternal:
2 17100 currevent:= baseevent;
2 17101 eventqueueempty:= false;
2 17102 repeat
2 17103 current:= 0;
2 17104 prevevent:= currevent;
2 17105 mon(66) test event :(0, 0, currevent, 0);
2 17106 currevent:= monw2;
2 17107 if monw0 < 0 <* no event *> then goto takeinternal;
2 17108 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 17109 cmi:= monw1
2 17110 else
2 17111 cmi:= - monw0;
2 17112
2 17112 if cmi > 0 then
2 17113 begin <* answer to activity zone *>
3 17114 current:= firstcoru + (cmi - 1) * corusize;
3 17115 linkprio(current, readyqueue);
3 17116 baseevent:= 0;
3 17117 end else
2 17118
2 17118 if cmi = 0 then
2 17119 begin <* message arrived *>
3 17120 \f
3 17120
3 17120 message coroutinemonitor - 32 ;
3 17121
3 17121 receiver:= core.currevent(3);
3 17122 if receiver < 0 then receiver:= - receiver;
3 17123 procref(maxprocext):= receiver;
3 17124 procext:= 1;
3 17125 while procref(procext) <> receiver do procext:= procext + 1;
3 17126 if procext = maxprocext then
3 17127 begin <* receiver unknown *>
4 17128 <* leave the message unchanged *>
4 17129 end else
3 17130 if proccode(procext) shift (-12) = 0 then
3 17131 begin <* the receiver is ready for accepting messages *>
4 17132 mon(26) get event :(0, 0, currevent, 0);
4 17133 case proccode(procext) of
4 17134 begin
5 17135 begin <* message received by semwaitmessage *>
6 17136 op:= procop(procext);
6 17137 sem:= d.op(1);
6 17138 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 17139 d.op(9):= currevent;
6 17140 signalch(sem, op, d.op.optype);
6 17141 proccode(procext):= 1 shift 12;
6 17142 end;
5 17143 begin <* message received by cwaitmessage *>
6 17144 current:= procop(procext);
6 17145 procop(procext):= currevent;
6 17146 linkprio(current, readyqueue);
6 17147 link(current + corutimerchain, idlequeue);
6 17148
6 17148
6 17148 end;
5 17149 end; <* case *>
4 17150 currevent:= baseevent;
4 17151 proccode(procext):= 1 shift 12;
4 17152 end;
3 17153 end <* message *> else
2 17154
2 17154 if cmi = -1 then
2 17155 begin <* answer arrived *>
3 17156 \f
3 17156
3 17156 message coroutinemonitor - 33 ;
3 17157
3 17157 if currevent = timermessage then
3 17158 begin
4 17159 mon(26) get event :(0, 0, currevent, 0);
4 17160 coru:= d.timerqueue.next;
4 17161 while coru <> timerqueue do
4 17162 begin
5 17163 current:= coru - corutimerchain;
5 17164 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 17165 coru:= d.coru.next;
5 17166 if d.current.corutimer <= 0 then
5 17167 begin <* timer perion expired *>
6 17168 d.current.corutimer:= -1;
6 17169 linkprio(current, readyqueue);
6 17170 link(current + corutimerchain, idlequeue);
6 17171 end;
5 17172 end;
4 17173 mon(16) send message :(0, clockmess, 0, clock);
4 17174 timermessage:= monw2;
4 17175 currevent:= baseevent;
4 17176 end <* timer answer *> else
3 17177 begin
4 17178 messref(maxmessext):= currevent;
4 17179 messext:= 1;
4 17180 while messref(messext) <> currevent do messext:= messext + 1;
4 17181 if messext = maxmessext then
4 17182 begin <* the answer is unknown *>
5 17183 <* leave the answer unchanged - it may belong to an activity *>
5 17184 end else
4 17185 if messcode(messext) shift (-12) = 0 then
4 17186 begin
5 17187 case messcode(messext) extract 12 of
5 17188 begin
6 17189 \f
6 17189
6 17189 message coroutinemonitor - 34 ;
6 17190 begin <* answer arrived after semsendmessage *>
7 17191 op:= messop(messext);
7 17192 sem:= d.op(1);
7 17193 mon(18) wait answer :(0, d.op, currevent, 0);
7 17194 d.op(9):= monw0;
7 17195 signalch(sem, op, d.op.optype);
7 17196 messref(messext):= 0;
7 17197 baseevent:= 0;
7 17198 end;
6 17199 begin <* answer arrived after csendmessage *>
7 17200 current:= messop(messext);
7 17201 linkprio(current, readyqueue);
7 17202 link(current + corutimerchain, idlequeue);
7 17203
7 17203
7 17203 end;
6 17204 end;
5 17205 end else baseevent:= currevent;
4 17206 end;
3 17207 end;
2 17208 until eventqueueempty;
2 17209 \f
2 17209
2 17209 message coroutinemonitor - 35 ;
2 17210
2 17210
2 17210
2 17210 <*************** coroutine activation ***************>
2 17211
2 17211 takeinternal:
2 17212
2 17212 current:= d.readyqueue.next;
2 17213 if current = readyqueue then
2 17214 begin
3 17215 mon(24) wait event :(0, 0, prevevent, 0);
3 17216 goto takeexternal;
3 17217 end;
2 17218
2 17218 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17219 <**> begin
3 17220 <**> systime(5,0,r);
3 17221 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17222 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17223 <**> d.current.coruident//1000,<: aktiveres:>);
3 17224 <**> end;
2 17225 <*-2*>
2 17226
2 17226 corustate:= activate(d.current.coruident mod 1000);
2 17227 cmi:= corustate extract 24;
2 17228 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17229 <**> begin
3 17230 <**> systime(5,0,r);
3 17231 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17232 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17233 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 17234 <**> end;
2 17235 <*-2*>
2 17236
2 17236 if cmi = 1 then
2 17237 begin <* programmed passivate *>
3 17238 goto takeexternal;
3 17239 end;
2 17240
2 17240 if cmi = 2 then
2 17241 begin <* implicit passivate in activity *>
3 17242
3 17242
3 17242 link(current, idlequeue);
3 17243 goto takeexternal;
3 17244 end;
2 17245 \f
2 17245
2 17245 message coroutinemonitor - 36 ;
2 17246
2 17246 <* coroutine termination (normal or abnormal) *>
2 17247
2 17247 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 17248 coru_term:
2 17249
2 17249 begin
3 17250 if false and alarmcause extract 24 = (-9) <* break *> and
3 17251 alarmcause shift (-24) extract 24 = 0 then
3 17252 begin
4 17253 endaction:= 2;
4 17254 goto program_slut;
4 17255 end;
3 17256 if alarmcause extract 24 = (-9) <* break *> and
3 17257 alarmcause shift (-24) = 8 <* parent *>
3 17258 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 17259 if alarmcause shift (-24) extract 24 <> -2 or
3 17260 alarmcause extract 24 <> -13 then
3 17261 begin
4 17262 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 17263 alarmcause shift (-24),<:,:>,
4 17264 alarmcause extract 24);
4 17265 for i:=1 step 1 until max_coru do
4 17266 j:=activate(-i); <* kill *>
4 17267 <* skriv billede *>
4 17268 end
3 17269 else
3 17270 begin
4 17271 errorbits:= 0; <* ok.yes warning.no *>
4 17272 goto finale;
4 17273 end;
3 17274 end;
2 17275
2 17275 goto dump;
2 17276
2 17276 link(current, idlequeue);
2 17277 goto takeexternal;
2 17278 \f
2 17278
2 17278 message coroutinemonitor - 37 ;
2 17279
2 17279
2 17279
2 17279 initialization:
2 17280
2 17280
2 17280 <*************** initialization ***************>
2 17281
2 17281 <* chain head *>
2 17282
2 17282 prev:= -2; <* -2 prev *>
2 17283 next:= 0; <* +0 next *>
2 17284
2 17284 <* corutine descriptor *>
2 17285
2 17285 <* -2 prev *>
2 17286 <* +0 next *>
2 17287 <* +2 (link field) *>
2 17288 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 17289 <* +6 (link field) *>
2 17290 coruop:= corutimerchain + 4; <* +8 coruop *>
2 17291 corutimer:= coruop + 2; <*+10 corutimer *>
2 17292 coruident:= corutimer + 2; <*+12 coruident *>
2 17293 corupriority:= coruident + 2; <*+14 corupriority *>
2 17294 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 17295 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 17296
2 17296 <* simple semaphore *>
2 17297
2 17297 <* -2 (link field) *>
2 17298 simcoru:= next; <* +0 simcoru *>
2 17299 simvalue:= simcoru + 2; <* +2 simvalue *>
2 17300
2 17300 <* chained semaphore *>
2 17301
2 17301 <* -2 (link field) *>
2 17302 semcoru:= next; <* +0 semcoru *>
2 17303 <* +2 (link field) *>
2 17304 semop:= semcoru + 4; <* +4 semop *>
2 17305 \f
2 17305
2 17305 message coroutinemonitor - 38 ;
2 17306
2 17306 <* operation *>
2 17307
2 17307 opsize:= next - 6; <* -6 opsize *>
2 17308 optype:= opsize + 1; <* -5 optype *>
2 17309 <* -2 prev *>
2 17310 <* +0 next *>
2 17311 <* +2 operation(1) *>
2 17312 <* +4 operation(2) *>
2 17313 <* +6 - *>
2 17314 <* . - *>
2 17315 <* . - *>
2 17316
2 17316 \f
2 17316
2 17316 message coroutinemonitor - 39 ;
2 17317
2 17317 trap(dump);
2 17318 systime(1, 0, starttime);
2 17319 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 17320 clockmess(1):= 0;
2 17321 clockmess(2):= timeinterval;
2 17322 clock(1):= real <:clock:>;
2 17323 clock(2):= real <::>;
2 17324 mon(16) send message :(0, clockmess, 0, clock);
2 17325 timermessage:= monw2;
2 17326 readyqueue:= 4;
2 17327 initchain(readyqueue);
2 17328 idlequeue:= readyqueue + 4;
2 17329 initchain(idlequeue);
2 17330 timerqueue:= idlequeue + 4;
2 17331 initchain(timerqueue);
2 17332 current:= 0;
2 17333 corucount:= 0;
2 17334 proccount:= 0;
2 17335 baseevent:= 0;
2 17336 coruref:= timerqueue + 4;
2 17337 firstcoru:= coruref;
2 17338 simref:= coruref + maxcoru * corusize;
2 17339 firstsim:= simref;
2 17340 semref:= simref + maxsem * simsize;
2 17341 firstsem:= semref;
2 17342 opref:= semref + maxsemch * semsize + 4;
2 17343 firstop:= opref;
2 17344 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 17345 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 17346 reflectcore(core);
2 17347
2 17347 algol list.on;
2 17348
2 17348 \f
2 17348 message sys_initialisering side 1 - 810601/hko;
2 17349
2 17349 trapmode:= 1 shift 15;
2 17350 errorbits:= 1; <* warning.no ok.no *>
2 17351 trap(coru_term);
2 17352
2 17352 open(zbillede,4,<:billede:>,0);
2 17353 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17354 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17355 system(2,0,ia);
2 17356 open(zdummy,4,ia,0); close(zdummy,false);
2 17357 monitor(42,zdummy,0,ia);
2 17358 laf:= 0;
2 17359 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17360 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17361 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17362
2 17362 open(zrl,4,<:radiolog:>,0);
2 17363 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17364 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17365 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17366 begin
3 17367 ia(1):=1; ia(2):= 3;
3 17368 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17369 monitor(40)create_area:(zrl,0,ia);
3 17370 end;
2 17371
2 17371 for i:=1 step 1 until max_antal_fejltekster do
2 17372 fejltekst(i):= real (case i of (
2 17373 <* 1*><:filsystem:>,
2 17374 <* 2*><:operationskode:>,
2 17375 <* 3*><:programfejl:>,
2 17376 <* 4*><:monitor<'_'>resultat=:>,
2 17377 <* 5*><:læs<'_'>fil:>,
2 17378 <* 6*><:skriv<'_'>fil:>,
2 17379 <* 7*><:modif<'_'>fil:>,
2 17380 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17381 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17382 <*10*><:vogntabel:>,
2 17383 <*11*><:fremmed operation:>,
2 17384 <*12*><:operationstype:>,
2 17385 <*13*><:opret<'_'>fil:>,
2 17386 <*14*><:tilknyt<'_'>fil:>,
2 17387 <*15*><:frigiv<'_'>fil:>,
2 17388 <*16*><:slet<'_'>fil:>,
2 17389 <*17*><:ydre enhed, status=:>,
2 17390 <*18*><:tabelfil:>,
2 17391 <*19*><:radio:>,
2 17392 <*20*><:mobilopkald, bus:>,
2 17393 <*21*><:talevejsswitch:>,
2 17394 <*99*><:ftslut:>));
2 17395
2 17395 for i:= 1 step 1 until max_antal_områder do
2 17396 begin
3 17397 område_navn(i):= long (case i of
3 17398 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17399 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17400 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17401 område_id(i,2):=
3 17402 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17403 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17404 end;
2 17405
2 17405 pabx_id(1):= -1;
2 17406 pabx_id(2):= 1;
2 17407
2 17407 for i:= 1 step 1 until max_antal_radiokanaler do
2 17408 begin
3 17409 radio_id(i):=
3 17410 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17411 end;
2 17412
2 17412 for i:=1 step 1 until max_antal_kanaler do
2 17413 begin
3 17414 kanal_navn(i):= long (case i of (
3 17415 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17416 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17417 kanal_id(i):=
3 17418 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17419 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17420 end;
2 17421
2 17421 for i:= 1 step 1 until op_maske_lgd//2 do
2 17422 ingen_operatører(i):= alle_operatører(i):= 0;
2 17423 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17424 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17425
2 17425 begin
3 17426 long array navn(1:2);
3 17427 long array field doc, ref;
3 17428
3 17428 doc:= 2; iaf:= 0;
3 17429 movestring(navn,1,<:terminal0:>);
3 17430 for i:= 1 step 1 until max_antal_operatører do
3 17431 begin
4 17432 ref:=(i-1)*8; k:=9;
4 17433 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17434 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17435 open(zdummy,8,navn,0); close(zdummy,true);
4 17436 k:= monitor(42,zdummy,0,ia);
4 17437 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17438 else tofrom(terminal_navn.ref,navn,8);
4 17439 operatør_auto_include(i):= false;
4 17440 sætbit_ia(alle_operatører,i,1);
4 17441 end;
3 17442
3 17442 movestring(navn,1,<:garage0:>);
3 17443 for i:= 1 step 1 until max_antal_garageterminaler do
3 17444 begin
4 17445 ref:=(i-1)*8; k:=7;
4 17446 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17447 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17448 open(zdummy,8,navn,0); close(zdummy,true);
4 17449 k:= monitor(42,zdummy,0,ia);
4 17450 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17451 else tofrom(garage_terminal_navn.ref,navn,8);
4 17452 garage_auto_include(i):= false;
4 17453 end;
3 17454 end;
2 17455
2 17455 for i:= 1 step 1 until max_antal_taleveje do
2 17456 sætbit_ia(alle_taleveje,i,1);
2 17457 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17458 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17459 operatør_auto_include(ia(i)):= true;
2 17460 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17461 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17462 garage_auto_include(ia(i)):= true;
2 17463
2 17463
2 17463 \f
2 17463 message fil_init side 1 - 801030/jg;
2 17464
2 17464 begin integer i,antz,tz,s;
3 17465 real array field raf;
3 17466
3 17466 filskrevet:=fillæst:=0; <*fil*>
3 17467 dbsegmax:= 2**18-1;
3 17468
3 17468 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17469 for i:=1 step 1 until dbantez do
3 17470 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17471 for i:=dbantez+1 step 1 until tz do
3 17472 open(fil(i),4,dbsnavn,0);
3 17473 for i:=tz+1 step 1 until antz do
3 17474 open(fil(i),4,dbtnavn,0);
3 17475
3 17475 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17476 dbkatz(i,1):=dbkatz(i,2):=0;
3 17477 for i:=dbantez+1 step 1 until tz do
3 17478 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17479 for i:=tz+1 step 1 until antz do
3 17480 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17481 dbkatz(antz,2):=tz+1;
3 17482 dbsidstetz:=antz;
3 17483 dbsidstesz:=tz;
3 17484
3 17484 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17485 begin integer j;
4 17486 for j:=1,3 step 1 until 6 do
4 17487 dbkate(i,j):=0;
4 17488 dbkate(i,2):=i+1;
4 17489 end;
3 17490 dbkate(dbmaxef,2):=0;
3 17491 dbkatefri:=1;
3 17492 dbantef:=0;
3 17493 \f
3 17493 message fil_init side 2 - 801030/jg;
3 17494
3 17494
3 17494 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17495 begin
4 17496 dbkats(i,1):=0;
4 17497 dbkats(i,2):=i+1;
4 17498 end;
3 17499 dbkats(dbmaxsf,2):=0;
3 17500 dbkatsfri:=1;
3 17501 dbantsf:=0;
3 17502
3 17502 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17503 dbkatb(i):=false add (i+1);
3 17504 dbkatb(dbmaxb):=false;
3 17505 dbkatbfri:=1;
3 17506 dbantb:=0;
3 17507 raf:=4;
3 17508 for i:=1 step 1 until dbmaxtf do
3 17509 begin
4 17510 inrec6(fil(antz),4);
4 17511 dbkatt.raf(i):=fil(antz,1);
4 17512 end;
3 17513 inrec6(fil(antz),4);
3 17514 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17515 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17516 setposition(fil(antz),0,0);
3 17517
3 17517 end filsystem;
2 17518 \f
2 17518 message fil_init side 3 - 810209/cl;
2 17519
2 17519 bs_kats_fri:= nextsem;
2 17520 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17521 <*-3*>
2 17522 bs_kate_fri:= nextsem;
2 17523 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17524 <*-3*>
2 17525 cs_opret_fil:= nextsemch;
2 17526 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17527 <*-3*>
2 17528 cs_tilknyt_fil:= nextsemch;
2 17529 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17530 <*-3*>
2 17531 cs_frigiv_fil:= nextsemch;
2 17532 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17533 <*-3*>
2 17534 cs_slet_fil:= nextsemch;
2 17535 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17536 <*-3*>
2 17537 cs_opret_spoolfil:= nextsemch;
2 17538 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17539 <*-3*>
2 17540 cs_opret_eksternfil:= nextsemch;
2 17541 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17542 <*-3*>
2 17543 \f
2 17543 message fil_init side 4 810209/cl;
2 17544
2 17544
2 17544 <* initialisering af filsystemcoroutiner *>
2 17545
2 17545 i:= nextcoru(001,10,true);
2 17546 j:= newactivity(i,0,opretfil);
2 17547 <*+3*> skriv_newactivity(out,i,j);
2 17548 <*-3*>
2 17549
2 17549 i:= nextcoru(002,10,true);
2 17550 j:= newactivity(i,0,tilknytfil);
2 17551 <*+3*> skriv_newactivity(out,i,j);
2 17552 <*-3*>
2 17553
2 17553 i:= nextcoru(003,10,true);
2 17554 j:= newactivity(i,0,frigivfil);
2 17555 <*+3*> skriv_newactivity(out,i,j);
2 17556 <*-3*>
2 17557
2 17557 i:= nextcoru(004,10,true);
2 17558 j:= newactivity(i,0,sletfil);
2 17559 <*+3*> skriv_newactivity(out,i,j);
2 17560 <*-3*>
2 17561
2 17561 i:= nextcoru(005,10,true);
2 17562 j:= newactivity(i,0,opretspoolfil);
2 17563 <*+3*> skriv_newactivity(out,i,j);
2 17564 <*-3*>
2 17565
2 17565 i:= nextcoru(006,10,true);
2 17566 j:= newactivity(i,0,opreteksternfil);
2 17567 <*+3*> skriv_newactivity(out,i,j);
2 17568 <*-3*>
2 17569 \f
2 17569 message attention_initialisering side 1 - 850820/cl;
2 17570
2 17570 tf_kommandotabel:= 1 shift 10 + 1;
2 17571
2 17571 begin
3 17572 integer i, s, zno;
3 17573 zone z(128,1,stderror);
3 17574 integer array fdim(1:8);
3 17575
3 17575 fdim(4):= tf_kommandotabel;
3 17576 hentfildim(fdim);
3 17577
3 17577 open(z,4,<:htkommando:>,0);
3 17578 for i:= 1 step 1 until fdim(3) do
3 17579 begin
4 17580 inrec6(z,512);
4 17581 s:= skrivfil(tf_kommandotabel,i,zno);
4 17582 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17583 tofrom(fil(zno),z,512);
4 17584 end;
3 17585 close(z,true);
3 17586 end;
2 17587 \f
2 17587 message attention_initialisering side 1a - 810428/hko;
2 17588
2 17588 for j:= system(3,i,terminal_tab) step 1 until i do
2 17589 terminal_tab(j):= 0;
2 17590
2 17590 cs_att_pulje:=next_semch;
2 17591 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17592 <*-3*>
2 17593
2 17593 bs_fortsæt_adgang:= nextsem;
2 17594 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17595 <*-3*>
2 17596 signalbin(bs_fortsæt_adgang);
2 17597
2 17597 for i:= 1,
2 17598 1 step 1 until max_antal_operatører,
2 17599 1 step 1 until max_antal_garageterminaler do
2 17600
2 17600 <* initialisering af pulje med attention_operationer *>
2 17601
2 17601 signalch(cs_att_pulje, <* pulje_semafor *>
2 17602 nextop(data+att_op_længde), <* næste_operation *>
2 17603 gen_optype);
2 17604
2 17604 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17605
2 17605 i:=next_coru(010,<*ident*>
2 17606 2,<*prioritet*>
2 17607 true<*test_maske*>);
2 17608 j:=newactivity( i, <*activityno *>
2 17609 0, <*ikke virtual *>
2 17610 attention);<*ingen parametre*>
2 17611
2 17611 <*+3*>skriv_newactivity(out,i,j);
2 17612 <*-3*>
2 17613 \f
2 17613 message io_initialisering side 1 - 810507/hko;
2 17614
2 17614 io_spoolfil:= 1028;
2 17615 begin
3 17616 integer array fdim(1:8);
3 17617 fdim(4):= io_spoolfil;
3 17618 hent_fildim(fdim);
3 17619 io_spool_postantal:= fdim(1);
3 17620 io_spool_postlængde:= fdim(2);
3 17621 end;
2 17622
2 17622 io_spool_post:= 4;
2 17623
2 17623 cs_io:= next_semch;
2 17624 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17625 <*-3*>
2 17626
2 17626 i:= next_coru(100,<*ident *>
2 17627 5,<*prioritet *>
2 17628 true<*test_maske*>);
2 17629
2 17629 j:= new_activity( i,
2 17630 0,
2 17631 h_io);
2 17632
2 17632 <*+3*>skriv_newactivity(out,i,j);
2 17633 <*-3*>
2 17634 cs_io_komm:= next_semch;
2 17635 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17636 <*-3*>
2 17637
2 17637 i:= next_coru(101,<*ident*>
2 17638 10,<*prioritet*>
2 17639 true <*testmaske*>);
2 17640 j:= new_activity( i,
2 17641 0,
2 17642 io_komm);<*ingen parametre*>
2 17643
2 17643 <*+3*>skriv_newactivity(out,i,j);
2 17644 <*-3*>
2 17645 \f
2 17645 message io_initialisering side 2 - 810520/hko/cl;
2 17646
2 17646 bs_zio_adgang:= next_sem;
2 17647 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17648 <*-3*>
2 17649 signal_bin(bs_zio_adgang);
2 17650
2 17650 cs_io_spool:= next_semch;
2 17651 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17652 <*-3*>
2 17653
2 17653 cs_io_fil:=next_semch;
2 17654 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17655 <*-3*>
2 17656 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17657
2 17657 ss_io_spool_fulde:= next_sem;
2 17658 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17659 <*-3*>
2 17660
2 17660 ss_io_spool_tomme:= next_sem;
2 17661 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17662 <*-3*>
2 17663 for i:= 1 step 1 until io_spool_postantal do
2 17664 signal(ss_io_spool_tomme);
2 17665 \f
2 17665 message io_initialisering side 3 - 880901/cl;
2 17666
2 17666 i:= next_coru(102,
2 17667 5,
2 17668 true);
2 17669 j:= new_activity(i,0,io_spool);
2 17670
2 17670 <*+3*>skriv_newactivity(out,i,j);
2 17671 <*-3*>
2 17672
2 17672 i:= next_coru(103,
2 17673 10,
2 17674 true);
2 17675 j:= new_activity(i,0,io_spon);
2 17676
2 17676 <*+3*>skriv_newactivity(out,i,j);
2 17677 <*-3*>
2 17678
2 17678 cs_io_medd:= next_semch;
2 17679 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17680 <*-3*>
2 17681
2 17681 i:= next_coru(104,<*ident *>
2 17682 10,<*prioritet *>
2 17683 true<*test_maske*>);
2 17684
2 17684 j:= new_activity( i,
2 17685 0,
2 17686 io_medd);
2 17687
2 17687 <*+3*>skriv_newactivity(out,i,j);
2 17688 <*-3*>
2 17689
2 17689 cs_io_nulstil:= next_semch;
2 17690 <*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
2 17691 <*-3*>
2 17692
2 17692 i:= next_coru(105,<*ident *>
2 17693 10,<*prioritet *>
2 17694 true<*test_maske*>);
2 17695
2 17695 j:= new_activity( i,
2 17696 0,
2 17697 io_nulstil_tællere);
2 17698
2 17698 <*+3*>skriv_newactivity(out,i,j);
2 17699 <*-3*>
2 17700
2 17700 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17701 i:= monitor(8)reserve process:(z_io,0,ia);
2 17702 if i <> 0 then
2 17703 begin
3 17704 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17705 end
2 17706 else
2 17707 begin
3 17708 ref:= 0;
3 17709 terminal_tab.ref.terminal_tilstand:= 0;
3 17710 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17711 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17712 "sp",1,"*",15,"nl",1);
3 17713 setposition(z_io,0,0);
3 17714 end;
2 17715 \f
2 17715 message operatør_initialisering side 1 - 810520/hko;
2 17716
2 17716 top_bpl_gruppe:= 64;
2 17717
2 17717 bpl_navn(0):= long<::>;
2 17718 for i:= 1 step 1 until 127 do
2 17719 begin
3 17720 k:= læsfil(tf_bpl_navne,i,j);
3 17721 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17722 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17723 if i<=max_antal_operatører then
3 17724 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17725 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17726 top_bpl_gruppe:= i;
3 17727 end;
2 17728
2 17728 for i:= 0 step 1 until 64 do
2 17729 begin
3 17730 iaf:= i*op_maske_lgd;
3 17731 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17732 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17733 if 1<=i and i<= max_antal_operatører then
3 17734 begin
4 17735 bpl_tilst(i,2):= 1;
4 17736 sætbit_ia(bpl_def.iaf,i,1);
4 17737 end;
3 17738 end;
2 17739 for i:= 65 step 1 until 127 do
2 17740 begin
3 17741 k:= læsfil(tf_bpl_def,i-64,j);
3 17742 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17743 iaf:= i*op_maske_lgd;
3 17744 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17745 bpl_tilst(i,1):= 0;
3 17746 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17747 end;
2 17748
2 17748 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17749 iaf:= 0;
2 17750 for i:= 1 step 1 until max_antal_operatører do
2 17751 begin
3 17752 k:= læsfil(tf_stoptabel,i,j);
3 17753 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17754 operatør_stop(i,0):= i;
3 17755 for k:= 1,2,3 do
3 17756 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17757 ant_i_opkø(i):= 0;
3 17758 end;
2 17759
2 17759 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17760 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17761 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17762 sidste_tv_brugt:= max_antal_taleveje;
2 17763
2 17763 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17764 opk_alarm(i):= 0;
2 17765 for i:= 1 step 1 until max_antal_operatører do
2 17766 begin
3 17767 integer array field tab;
3 17768
3 17768 k:= læsfil(tf_alarmlgd,i,j);
3 17769 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17770 tab:= (i-1)*opk_alarm_tab_lgd;
3 17771 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17772 opk_alarm.tab.alarm_start:= 0.0;
3 17773 end;
2 17774
2 17774 op_spool_kilde:= 2;
2 17775 op_spool_tid := 6;
2 17776 op_spool_text := 6;
2 17777 begin
3 17778 long array field laf1, laf2;
3 17779 laf2:= 4; laf1:= 0;
3 17780 op_spool_buf.laf1(1):= long<::>;
3 17781 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17782 op_spool_postantal*op_spool_postlgd-4);
3 17783 end;
2 17784
2 17784 k:=læsfil(1033,1,j);
2 17785 systime(1,0.0,r);
2 17786 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17787 for i:= 1 step 1 until max_cqf do
2 17788 begin
3 17789 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17790 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17791 cqf_tabel.ref.cqf_næste_tid:=
3 17792 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17793 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17794 end;
2 17795 op_cqf_tab_ændret:= true;
2 17796
2 17796 laf:= raf:= 0;
2 17797 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17798 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17799 j:= 1;
2 17800 if i<>0 then
2 17801 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17802 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17803 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17804 j:= 1;
2 17805 if i<>0 then
2 17806 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17807
2 17807 ia(1):= 3; <*canonical*>
2 17808 ia(2):= 0; <*no echo*>
2 17809 ia(3):= 0; <*prompt*>
2 17810 ia(4):= 2; <*timeout*>
2 17811 setcspterm(taleswitch_in_navn.laf,ia);
2 17812 setcspterm(taleswitch_out_navn.laf,ia);
2 17813
2 17813 cs_op:= next_semch;
2 17814
2 17814 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17815 <*-3*>
2 17816
2 17816 cs_op_retur:= next_semch;
2 17817
2 17817 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17818 <*-3*>
2 17819
2 17819 i:= nextcoru(200,<*ident*>
2 17820 10,<*prioitet*>
2 17821 true<*test_maske*>);
2 17822
2 17822 j:= new_activity( i,
2 17823 0,
2 17824 h_operatør);
2 17825
2 17825 <*+3*>skriv_newactivity(out,i,j);
2 17826 <*-3*>
2 17827 \f
2 17827 message operatør_initialisering side 2 - 810520/hko;
2 17828
2 17828 for k:= 1 step 1 until max_antal_operatører do
2 17829 begin
3 17830 ref:= (k-1)*8;
3 17831 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17832 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17833 ref:=k*terminal_beskr_længde;
3 17834 if i = 0 then
3 17835 begin
4 17836 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17837 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17838 end
3 17839 else
3 17840 begin
4 17841 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17842 end;
3 17843
3 17843 cs_operatør(k):= next_semch;
3 17844 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17845 <*-3*>
3 17846
3 17846 cs_op_fil(k):= nextsemch;
3 17847 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17848 <*-3*>
3 17849 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17850
3 17850 i:= next_coru(200+k,<*ident*>
3 17851 10,<*prioitet*>
3 17852 true<*testmaske*>);
3 17853 j:= new_activity( i,
3 17854 0,
3 17855 operatør,k);
3 17856
3 17856 <*+3*>skriv_newactivity(out,i,j);
3 17857 <*-3*>
3 17858 end;
2 17859
2 17859 cs_cqf:= next_semch;
2 17860 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17861 <*-3*>
2 17862
2 17862 signalch(cs_cqf,nextop(60),true);
2 17863
2 17863 i:= next_coru(292, <*ident*>
2 17864 10, <*prioritet*>
2 17865 true <*testmaske*>);
2 17866 j:= new_activity( i,
2 17867 0,
2 17868 op_cqftest);
2 17869 <*+3*>skriv_new_activity(out,i,j);
2 17870 <*-3*>
2 17871
2 17871 cs_op_spool:= next_semch;
2 17872 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17873 <*-3*>
2 17874
2 17874 cs_op_medd:= next_semch;
2 17875 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17876 <*-3*>
2 17877
2 17877 ss_op_spool_tomme:= next_sem;
2 17878 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17879 <*-3*>
2 17880 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17881
2 17881 ss_op_spool_fulde:= next_sem;
2 17882 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17883 <*-3*>
2 17884
2 17884 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17885
2 17885 i:= next_coru(293, <*ident*>
2 17886 10, <*prioritet*>
2 17887 true <*testmaske*>);
2 17888 j:= new_activity( i,
2 17889 0,
2 17890 op_spool);
2 17891 <*+3*>skriv_new_activity(out,i,j);
2 17892 <*-3*>
2 17893
2 17893 i:= next_coru(294, <*ident*>
2 17894 10, <*prioritet*>
2 17895 true <*testmaske*>);
2 17896 j:= new_activity( i,
2 17897 0,
2 17898 op_medd);
2 17899 <*+3*>skriv_new_activity(out,i,j);
2 17900 <*-3*>
2 17901
2 17901 cs_op_iomedd:= next_semch;
2 17902 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17903 <*-3*>
2 17904
2 17904 bs_opk_alarm:= next_sem;
2 17905 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17906 <*-3*>
2 17907
2 17907 cs_opk_alarm:= next_semch;
2 17908 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17909 <*-3*>
2 17910
2 17910 cs_opk_alarm_ur:= next_semch;
2 17911 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17912 <*-3*>
2 17913
2 17913 cs_opk_alarm_ur_ret:= next_semch;
2 17914 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17915 <*-3*>
2 17916
2 17916 cs_tvswitch_adgang:= next_semch;
2 17917 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17918 <*-3*>
2 17919
2 17919 cs_tv_switch_input:= next_semch;
2 17920 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17921 <*-3*>
2 17922
2 17922 cs_tv_switch_adm:= next_semch;
2 17923 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17924 <*-3*>
2 17925
2 17925 cs_talevejsswitch:= next_semch;
2 17926 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17927 <*-3*>
2 17928
2 17928 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17929
2 17929 iaf:= nextop(data+128);
2 17930 if testbit22 then
2 17931 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17932 else
2 17933 begin
3 17934 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17935 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17936 end;
2 17937
2 17937 i:= next_coru(295, <*ident*>
2 17938 8, <*prioritet*>
2 17939 true <*testmaske*>);
2 17940 j:= new_activity( i,
2 17941 0,
2 17942 alarmur);
2 17943 <*+3*>skriv_new_activity(out,i,j);
2 17944 <*-3*>
2 17945
2 17945 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17946
2 17946 i:= next_coru(296, <*ident*>
2 17947 8, <*prioritet*>
2 17948 true <*testmaske*>);
2 17949 j:= new_activity( i,
2 17950 0,
2 17951 opkaldsalarmer);
2 17952 <*+3*>skriv_new_activity(out,i,j);
2 17953 <*-3*>
2 17954
2 17954 i:= next_coru(297, <*ident*>
2 17955 3, <*prioritet*>
2 17956 true <*testmaske*>);
2 17957 j:= new_activity( i,
2 17958 0,
2 17959 tv_switch_input);
2 17960 <*+3*>skriv_new_activity(out,i,j);
2 17961 <*-3*>
2 17962
2 17962 for i:= 1,2 do
2 17963 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17964
2 17964 i:= next_coru(298, <*ident*>
2 17965 20, <*prioritet*>
2 17966 true <*testmaske*>);
2 17967 j:= new_activity( i,
2 17968 0,
2 17969 tv_switch_adm);
2 17970 <*+3*>skriv_new_activity(out,i,j);
2 17971 <*-3*>
2 17972
2 17972 i:= next_coru(299, <*ident*>
2 17973 3, <*prioritet*>
2 17974 true <*testmaske*>);
2 17975 j:= new_activity( i,
2 17976 0,
2 17977 talevejsswitch);
2 17978 <*+3*>skriv_new_activity(out,i,j);
2 17979 <*-3*>
2 17980 \f
2 17980 message garage_initialisering side 1 - 810521/hko;
2 17981
2 17981 cs_gar:= next_semch;
2 17982 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 17983 <*-3*>
2 17984
2 17984 i:= next_coru(300,<*ident*>
2 17985 10,<*prioritet*>
2 17986 true<*test_maske*>);
2 17987
2 17987 j:= new_activity( i,
2 17988 0,
2 17989 h_garage);
2 17990
2 17990 <*+3*>skriv_newactivity(out,i,j);
2 17991 <*-3*>
2 17992
2 17992 for k:= 1 step 1 until max_antal_garageterminaler do
2 17993 begin
3 17994 ref:= (k-1)*8;
3 17995 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 17996 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 17997 i:=monitor(4)process address:(z_gar(k),0,ia);
3 17998 if i = 0 then
3 17999 begin
4 18000 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 18001 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 18002 end
3 18003 else
3 18004 begin
4 18005 terminal_tab.ref.terminal_tilstand:=
4 18006 if garage_auto_include(k) then 0 else 7 shift 21;
4 18007 if garage_auto_include(k) then
4 18008 monitor(8)reserve:(z_gar(k),0,ia);
4 18009 end;
3 18010 cs_garage(k):= next_semch;
3 18011 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 18012 <*-3*>
3 18013 i:= next_coru(300+k,<*ident*>
3 18014 10,<*prioritet*>
3 18015 true <*testmaske*>);
3 18016 j:= new_activity( i,
3 18017 0,
3 18018 garage,k);
3 18019
3 18019 <*+3*>skriv_newactivity(out,i,j);
3 18020 <*-3*>
3 18021
3 18021 end;
2 18022 \f
2 18022 message radio_initialisering side 1 - 820301/hko;
2 18023
2 18023 cs_rad:= next_semch;
2 18024 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 18025 <*-3*>
2 18026
2 18026 i:= next_coru(400,<*ident*>
2 18027 10,<*prioritet*>
2 18028 true<*test_maske*>);
2 18029 j:= new_activity( i,
2 18030 0,
2 18031 h_radio);
2 18032 <*+3*>skriv_newactivity(out,i,j);
2 18033 <*-3*>
2 18034
2 18034 opkalds_kø_ledige:= max_antal_mobilopkald;
2 18035 nødopkald_brugt:= 0;
2 18036 læsfil(1034,1,i);
2 18037 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 18038
2 18038 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 18039 for i:= system(3,j,opkaldskø) step 1 until j do
2 18040 opkaldskø(i):= 0;
2 18041 første_frie_opkald:=opkaldskø_postlængde;
2 18042 første_opkald:=sidste_opkald:=
2 18043 første_nødopkald:=sidste_nødopkald:=j:=0;
2 18044
2 18044 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 18045 begin
3 18046 ref:=i*opkaldskø_postlængde;
3 18047 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 18048 end;
2 18049 ref:=ref+opkaldskø_postlængde;
2 18050 opkaldskø.ref(1):=j shift 12;
2 18051
2 18051 for ref:= 0 step 512 until (max_linienr//768*512) do
2 18052 begin
3 18053 i:= læs_fil(1035,ref//512+1,j);
3 18054 if i <> 0 then
3 18055 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 18056 tofrom(radio_linietabel.ref,fil(j),
3 18057 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 18058 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 18059 end;
2 18060
2 18060 for i:= system(3,j,kanal_tab) step 1 until j do
2 18061 kanal_tab(i):= 0;
2 18062 kanal_tilstand:= 2;
2 18063 kanal_id1:= 4;
2 18064 kanal_id2:= 6;
2 18065 kanal_spec:= 8;
2 18066 kanal_alt_id1:= 10;
2 18067 kanal_alt_id2:= 12;
2 18068 kanal_mon_maske:= 12;
2 18069 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 18070
2 18070 for i:= 1 step 1 until max_antal_kanaler do
2 18071 begin
3 18072 ref:= (i-1)*kanalbeskrlængde;
3 18073 sæthexciffer(kanal_tab.ref,3,15);
3 18074 if kanal_id(i) shift (-5) extract 3 = 2 or
3 18075 kanal_id(i) shift (-5) extract 3 = 3 and
3 18076 radio_id(kanal_id(i) extract 5)<=3
3 18077 then
3 18078 begin
4 18079 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 18080 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 18081 end;
3 18082 end;
2 18083 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 18084 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 18085 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 18086 optaget_flag:= 0;
2 18087 \f
2 18087 message radio_initialisering side 2 - 810524/hko;
2 18088
2 18088 bs_mobil_opkald:= next_sem;
2 18089
2 18089 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 18090 <*-3*>
2 18091
2 18091 bs_opkaldskø_adgang:= next_sem;
2 18092 signal_bin(bs_opkaldskø_adgang);
2 18093
2 18093 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 18094 <*-3*>
2 18095
2 18095 cs_radio_medd:=next_semch;
2 18096 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 18097
2 18097 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 18098 <*-3*>
2 18099
2 18099 i:= next_coru(403,
2 18100 5,<*prioritet*>
2 18101 true<*testmaske*>);
2 18102
2 18102 j:= new_activity( i,
2 18103 0,
2 18104 radio_medd_opkald);
2 18105
2 18105 <*+3*>skriv_newactivity(out,i,j);
2 18106 <*-3*>
2 18107
2 18107 cs_radio_adm:= nextsemch;
2 18108 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 18109 <*-3*>
2 18110
2 18110 i:= next_coru(404,
2 18111 10,
2 18112 true);
2 18113 j:= new_activity(i,
2 18114 0,
2 18115 radio_adm,next_op(data+radio_op_længde));
2 18116 <*+3*>skriv_new_activity(out,i,j);
2 18117 <*-3*>
2 18118 \f
2 18118 message radio_initialisering side 3 - 810526/hko;
2 18119 for k:= 1 step 1 until max_antal_taleveje do
2 18120 begin
3 18121
3 18121 cs_radio(k):=next_semch;
3 18122
3 18122 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 18123 <*-3*>
3 18124
3 18124 bs_talevej_udkoblet(k):= nextsem;
3 18125 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 18126 <*-3*>
3 18127
3 18127 i:=next_coru(410+k,
3 18128 10,
3 18129 true);
3 18130
3 18130 j:=new_activity( i,
3 18131 0,
3 18132 radio,k,next_op(data + radio_op_længde));
3 18133
3 18133 <*+3*>skriv_newactivity(out,i,j);
3 18134 <*-3*>
3 18135 end;
2 18136
2 18136 cs_radio_pulje:=next_semch;
2 18137
2 18137 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 18138 <*-3*>
2 18139
2 18139 for i:= 1 step 1 until radiopulje_størrelse do
2 18140 signal_ch(cs_radio_pulje,
2 18141 next_op(60),
2 18142 gen_optype or rad_optype);
2 18143
2 18143 cs_radio_kø:= next_semch;
2 18144
2 18144 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 18145 <*-3*>
2 18146
2 18146 mobil_opkald_aktiveret:= true;
2 18147 \f
2 18147 message radio_initialisering side 4 - 810522/hko;
2 18148
2 18148 laf:=raf:=0;
2 18149
2 18149 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 18150 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 18151 j:=1;
2 18152 if i <> 0 then
2 18153 fejlreaktion(4<*monitor resultat*>,i,
2 18154 string radio_fr_navn.raf(increase(j)),1);
2 18155 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 18156 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 18157 j:=1;
2 18158 if i <> 0 then
2 18159 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 18160 ia(1):= 3 <*canonical*>;
2 18161 ia(2):= 0 <*no echo*>;
2 18162 ia(3):= 0 <*prompt*>;
2 18163 ia(4):= 5 <*timeout*>;
2 18164 setcspterm(radio_fr_navn.laf,ia);
2 18165
2 18165 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 18166 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 18167 j:= 1;
2 18168 if i <> 0 then
2 18169 fejlreaktion(4<*monitor resultat*>,i,
2 18170 string radio_rf_navn.raf(increase(j)),1);
2 18171 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 18172 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 18173 j:= 1;
2 18174 if i <> 0 then
2 18175 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 18176 ia(1):= 3 <*canonical*>;
2 18177 ia(2):= 0 <*no echo*>;
2 18178 ia(3):= 0 <*prompt*>;
2 18179 ia(4):= 5 <*timeout*>;
2 18180 setcspterm(radio_rf_navn.laf,ia);
2 18181 \f
2 18181 message radio_initialisering side 5 - 810521/hko;
2 18182 for k:= 1 step 1 until max_antal_kanaler do
2 18183 begin
3 18184
3 18184 ss_radio_aktiver(k):=next_sem;
3 18185 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 18186 <*-3*>
3 18187
3 18187 ss_samtale_nedlagt(k):=next_sem;
3 18188 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 18189 <*-3*>
3 18190 end;
2 18191
2 18191 cs_radio_ind:= next_semch;
2 18192 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 18193 <*-3*>
2 18194
2 18194 i:= next_coru(401,<*ident radio_ind*>
2 18195 3, <*prioritet*>
2 18196 true <*testmaske*>);
2 18197 j:= new_activity( i,
2 18198 0,
2 18199 radio_ind,next_op(data + 64));
2 18200
2 18200 <*+3*>skriv_newactivity(out,i,j);
2 18201 <*-3*>
2 18202
2 18202 cs_radio_ud:=next_semch;
2 18203 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 18204 <*-3*>
2 18205
2 18205 i:= next_coru(402,<*ident radio_out*>
2 18206 10,<*prioritet*>
2 18207 true <*testmaske*>);
2 18208 j:= new_activity( i,
2 18209 0,
2 18210 radio_ud,next_op(data + 64));
2 18211
2 18211 <*+3*>skriv_newactivity(out,i,j);
2 18212 <*-3*>
2 18213 \f
2 18213 message vogntabel initialisering side 1 - 820301;
2 18214
2 18214 sidste_bus:= sidste_linie_løb:= 0;
2 18215
2 18215 tf_vogntabel:= 1 shift 10 + 2;
2 18216 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 18217 tf_gruppeidenter:= 1 shift 10 +6;
2 18218 tf_springdef:= 1 shift 10 +7;
2 18219 hent_fil_dim(ia);
2 18220 max_antal_i_gruppe:= ia(2);
2 18221 if ia(1) < max_antal_grupper then
2 18222 max_antal_grupper:= ia(1);
2 18223
2 18223 <* initialisering af interne vogntabeller *>
2 18224 begin
3 18225 long array field laf1,laf2;
3 18226 integer array fdim(1:8);
3 18227 zone z(128,1,stderror);
3 18228 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 18229 long omr,garageid;
3 18230 integer field ll, bn;
3 18231 boolean binær, test24;
3 18232
3 18232 ll:= 2; bn:= 4;
3 18233
3 18233 <* nulstil tabellerne *>
3 18234 laf1:= -2;
3 18235 laf2:= 2;
3 18236 bustabel1.laf2(0):=
3 18237 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 18238 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 18239 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 18240 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 18241 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 18242 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 18243 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 18244 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 18245 \f
3 18245 message vogntabel initialisering side 1a - 810505/cl;
3 18246
3 18246
3 18246 <* initialisering af intern busnummertabel *>
3 18247 open(z,4,<:busnumre:>,0);
3 18248 busnr:= -1;
3 18249 read(z,busnr);
3 18250 while busnr > 0 do
3 18251 begin
4 18252 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 18253 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 18254 sidste_bus:= sidste_bus+1;
4 18255 if sidste_bus > max_antal_busser then
4 18256 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 18257 repeatchar(z); readchar(z,tegn);
4 18258 garageid:= extend 0; binær:= false; omr:= extend 0;
4 18259 g_nr:= o_nr:= 0;
4 18260 if tegn='!' then
4 18261 begin
5 18262 binær:= true;
5 18263 readchar(z,tegn);
5 18264 end;
4 18265 if tegn='/' then <*garageid*>
4 18266 begin
5 18267 readchar(z,tegn); repeatchar(z);
5 18268 if '0'<=tegn and tegn<='9' then
5 18269 begin
6 18270 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 18271 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 18272 if g_nr<>0 and garageid=long<::> then
6 18273 begin
7 18274 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 18275 g_nr:= 0;
7 18276 end;
6 18277 end
5 18278 else
5 18279 begin
6 18280 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 18281 begin
7 18282 garageid:= garageid shift 8 + tegn;
7 18283 readchar(z,tegn);
7 18284 end;
6 18285 while garageid shift (-40) extract 8 = 0 do
6 18286 garageid:= garageid shift 8;
6 18287 g_nr:= find_bpl(garageid);
6 18288 if g_nr=0 then
6 18289 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 18290 end;
5 18291 repeatchar(z); readchar(z,tegn);
5 18292 end;
4 18293 if tegn=';' then
4 18294 begin
5 18295 readchar(z,tegn); repeatchar(z);
5 18296 if '0'<=tegn and tegn<='9' then
5 18297 begin
6 18298 read(z,o_nr);
6 18299 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 18300 if o_nr<>0 then omr:= område_navn(o_nr);
6 18301 if o_nr<>0 and omr=long<::> then
6 18302 begin
7 18303 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 18304 o_nr:= 0;
7 18305 end;
6 18306 end
5 18307 else
5 18308 begin
6 18309 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 18310 begin
7 18311 omr:= omr shift 8 + tegn;
7 18312 readchar(z,tegn);
7 18313 end;
6 18314 while omr shift (-40) extract 8 = 0 do
6 18315 omr:= omr shift 8;
6 18316 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 18317 i:= 1;
6 18318 while i<=max_antal_områder and o_nr=0 do
6 18319 begin
7 18320 if omr=område_navn(i) then o_nr:= i;
7 18321 i:= i+1;
7 18322 end;
6 18323 if o_nr=0 then
6 18324 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 18325 end;
5 18326 repeatchar(z); readchar(z,tegn);
5 18327 end;
4 18328 if o_nr=0 then o_nr:= 3;
4 18329 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 18330 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 18331
4 18331 busnr:= -1;
4 18332 read(z,busnr);
4 18333 end;
3 18334 close(z,true);
3 18335 \f
3 18335 message vogntabel initialisering side 2 - 820301/cl;
3 18336
3 18336 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 18337 test24:= testbit24;
3 18338 testbit24:= false;
3 18339 i:= 1;
3 18340 s:= læsfil(tf_vogntabel,i,zi);
3 18341 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 18342 while fil(zi).bn<>0 do
3 18343 begin
4 18344 if fil(zi).ll <> 0 then
4 18345 begin <* indsæt linie/løb *>
5 18346 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 18347 fil(zi).ll,j);
5 18348 if res < 0 then j:= j+1;
5 18349 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 18350 <:dobbeltregistrering i vogntabel:>,1)
5 18351 else
5 18352 begin
6 18353 o_nr:= fil(zi).bn shift (-14) extract 8;
6 18354 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 18355 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 18356 <:ukendt bus i vogntabel:>,1)
6 18357 else
6 18358 begin
7 18359 if sidste_linie_løb >= max_antal_linie_løb then
7 18360 fejlreaktion(10,fil(zi).bn extract 14,
7 18361 <:for mange linie/løb i vogntabel:>,0);
7 18362 for ll_nr:= sidste_linie_løb step (-1) until j do
7 18363 begin
8 18364 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18365 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18366 end;
7 18367 linie_løb_tabel(j):= fil(zi).ll;
7 18368 bus_indeks(j):= false add b_nr;
7 18369 sidste_linie_løb:= sidste_linie_løb + 1;
7 18370 end;
6 18371 end;
5 18372 end;
4 18373 i:= i+1;
4 18374 s:= læsfil(tf_vogntabel,i,zi);
4 18375 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18376 end;
3 18377 \f
3 18377 message vogntabel initialisering side 3 - 810428/cl;
3 18378
3 18378 <* initialisering af intern linie/løb-indekstabel *>
3 18379 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18380 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18381
3 18381 <* gem ny vogntabel i tabelfil *>
3 18382 for i:= 1 step 1 until sidste_bus do
3 18383 begin
4 18384 s:= skriv_fil(tf_vogntabel,i,zi);
4 18385 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18386 fil(zi).bn:= bustabel(i) extract 14 add
4 18387 (bustabel1(i) extract 8 shift 14);
4 18388 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18389 end;
3 18390 fdim(4):= tf_vogntabel;
3 18391 hent_fil_dim(fdim);
3 18392 pant:= fdim(3) * (256//fdim(2));
3 18393 for i:= sidste_bus+1 step 1 until pant do
3 18394 begin
4 18395 s:= skriv_fil(tf_vogntabel,i,zi);
4 18396 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18397 fil(zi).ll:= fil(zi).bn:= 0;
4 18398 end;
3 18399
3 18399 <* initialisering/nulstilling af gruppetabeller *>
3 18400 for i:= 1 step 1 until max_antal_grupper do
3 18401 begin
4 18402 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18403 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18404 gruppetabel(i):= fil(zi).ll;
4 18405 end;
3 18406 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18407 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18408 testbit24:= test24;
3 18409 end;
2 18410
2 18410
2 18410 <*+2*>
2 18411 <**> if testbit40 then p_vogntabel(out);
2 18412 <**> if testbit43 then p_gruppetabel(out);
2 18413 <*-2*>
2 18414
2 18414 message vogntabel initialisering side 3a -920517/cl;
2 18415
2 18415 <* initialisering for vt_log *>
2 18416
2 18416 v_tid:= 4;
2 18417 v_kode:= 6;
2 18418 v_bus:= 8;
2 18419 v_ll1:= 10;
2 18420 v_ll2:= 12;
2 18421 v_tekst:= 6;
2 18422 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18423 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18424 if vt_log_aktiv then
2 18425 begin
3 18426 integer i;
3 18427 real t;
3 18428 integer array field iaf;
3 18429 integer array
3 18430 tail(1:10),ia(1:10),chead(1:20);
3 18431
3 18431 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18432 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18433 if i=0 then
3 18434 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18435 if i=0 then
3 18436 begin
4 18437 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18438 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18439 end;
3 18440
3 18440 if i=0 then
3 18441 begin
4 18442 iaf:= 2;
4 18443 tofrom(vt_logdisc,tail.iaf,8);
4 18444 i:=slices(vt_logdisc,0,tail,chead);
4 18445 if i > (-2048) then
4 18446 begin
5 18447 vt_log_slicelgd:= chead(15);
5 18448 i:= 0;
5 18449 end;
4 18450 end;
3 18451
3 18451 if i=0 then
3 18452 begin
4 18453 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18454 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18455 if i=0 then
4 18456 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18457 if i=0 then
4 18458 begin
5 18459 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18460 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18461 end;
4 18462
4 18462 if i<>0 then
4 18463 begin
5 18464 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18465 tail(1):= 1;
5 18466 iaf:= 2;
5 18467 tofrom(tail.iaf,vt_logdisc,8);
5 18468 tail(6):=systime(7,0,t);
5 18469 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18470 if i=0 then
5 18471 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18472 end;
4 18473 end;
3 18474
3 18474 if i<>0 then vt_log_aktiv:= false;
3 18475 end;
2 18476
2 18476
2 18476 \f
2 18476 message vogntabel initialisering side 4 - 810520/cl;
2 18477
2 18477 cs_vt:= nextsemch;
2 18478 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18479 <*-3*>
2 18480
2 18480 cs_vt_adgang:= nextsemch;
2 18481 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18482 <*-3*>
2 18483
2 18483 cs_vt_opd:= nextsemch;
2 18484 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18485 <*-3*>
2 18486
2 18486 cs_vt_rap:= nextsemch;
2 18487 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18488 <*-3*>
2 18489
2 18489 cs_vt_tilst:= nextsemch;
2 18490 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18491 <*-3*>
2 18492
2 18492 cs_vt_auto:= nextsemch;
2 18493 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18494 <*-3*>
2 18495
2 18495 cs_vt_grp:= nextsemch;
2 18496 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18497 <*-3*>
2 18498
2 18498 cs_vt_spring:= nextsemch;
2 18499 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18500 <*-3*>
2 18501
2 18501 cs_vt_log:= nextsemch;
2 18502 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18503 <*-3*>
2 18504
2 18504 cs_vt_logpool:= nextsemch;
2 18505 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18506 <*-3*>
2 18507
2 18507 vt_op:= nextop(vt_op_længde);
2 18508 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18509
2 18509 vt_logop(1):= nextop(vt_op_længde);
2 18510 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18511 vt_logop(2):= nextop(vt_op_længde);
2 18512 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18513
2 18513 \f
2 18513 message vogntabel initialisering side 5 - 81-520/cl;
2 18514
2 18514 i:= nextcoru(500, <*ident*>
2 18515 10, <*prioitet*>
2 18516 true <*testmaske*>);
2 18517 j:= new_activity( i,
2 18518 0,
2 18519 h_vogntabel);
2 18520 <*+3*> skriv_newactivity(out,i,j);
2 18521 <*-3*>
2 18522
2 18522 i:= nextcoru(501, <*ident*>
2 18523 10, <*prioritet*>
2 18524 true <*testmaske*>);
2 18525 iaf:= nextop(filop_længde);
2 18526 j:= new_activity(i,
2 18527 0,
2 18528 vt_opdater,iaf);
2 18529 <*+3*> skriv_newactivity(out,i,j);
2 18530 <*-3*>
2 18531
2 18531 i:= nextcoru(502, <*ident*>
2 18532 10, <*prioritet*>
2 18533 true <*testmaske*>);
2 18534 k:= nextsemch;
2 18535 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18536 <*-3*>
2 18537 iaf:= nextop(fil_op_længde);
2 18538 j:= newactivity(i,
2 18539 0,
2 18540 vt_tilstand,
2 18541 k,
2 18542 iaf);
2 18543 <*+3*> skriv_newactivity(out,i,j);
2 18544 <*-3*>
2 18545 \f
2 18545 message vogntabel initialisering side 6 - 810520/cl;
2 18546
2 18546 i:= nextcoru(503, <*ident*>
2 18547 10, <*prioritet*>
2 18548 true <*testmaske*>);
2 18549 k:= nextsemch;
2 18550 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18551 <*-3*>
2 18552 iaf:= nextop(fil_op_længde);
2 18553 j:= newactivity(i,
2 18554 0,
2 18555 vt_rapport,
2 18556 k,
2 18557 iaf);
2 18558 <*+3*> skriv_newactivity(out,i,j);
2 18559 <*-3*>
2 18560
2 18560 i:= nextcoru(504, <*ident*>
2 18561 10, <*prioritet*>
2 18562 true <*testmaske*>);
2 18563 k:= nextsemch;
2 18564 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18565 <*-3*>
2 18566 iaf:= nextop(fil_op_længde);
2 18567 j:= new_activity(i,
2 18568 0,
2 18569 vt_gruppe,
2 18570 k,
2 18571 iaf);
2 18572 <*+3*> skriv_newactivity(out,i,j);
2 18573 <*-3*>
2 18574 \f
2 18574 message vogntabel initialisering side 7 - 810520/cl;
2 18575
2 18575 i:= nextcoru(505, <*ident*>
2 18576 10, <*prioritet*>
2 18577 true <*testmaske*>);
2 18578 k:= nextsemch;
2 18579 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18580 <*-3*>
2 18581 iaf:= nextop(fil_op_længde);
2 18582 j:= newactivity(i,
2 18583 0,
2 18584 vt_spring,
2 18585 k,
2 18586 iaf);
2 18587 <*+3*> skriv_newactivity(out,i,j);
2 18588 <*-3*>
2 18589
2 18589 i:= nextcoru(506, <*ident*>
2 18590 10,
2 18591 true <*testmaske*>);
2 18592 k:= nextsemch;
2 18593 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18594 <*-3*>
2 18595 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18596 j:= newactivity(i,
2 18597 0,
2 18598 vt_auto,
2 18599 k,
2 18600 iaf);
2 18601 <*+3*> skriv_newactivity(out,i,j);
2 18602 <*-3*>
2 18603
2 18603 i:=nextcoru(507, <*ident*>
2 18604 10, <*prioritet*>
2 18605 true <*testmaske*>);
2 18606 j:=newactivity(i,
2 18607 0,
2 18608 vt_log);
2 18609 <*+3*> skriv_newactivity(out,i,j);
2 18610 <*-3*>
2 18611
2 18611 <*+2*>
2 18612 <**> if testbit42 then skriv_vt_variable(out);
2 18613 <*-2*>
2 18614 \f
2 18614 message sysslut initialisering side 1 - 810406/cl;
2 18615 begin
3 18616 zone z(128,1,stderror);
3 18617 integer i,coruid,j,k;
3 18618 integer array field cor;
3 18619
3 18619 open(z,4,<:overvågede:>,0);
3 18620 for i:= read(z,coruid) while i > 0 do
3 18621 begin
4 18622 if coruid = 0 then
4 18623 begin
5 18624 for coruid:= 1 step 1 until maxcoru do
5 18625 begin
6 18626 cor:= coroutine(coruid);
6 18627 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18628 end
5 18629 end
4 18630 else
4 18631 begin
5 18632 cor:= coroutine(coru_no(abs coruid));
5 18633 if cor > 0 then
5 18634 begin
6 18635 d.cor.corutestmask:=
6 18636 (d.cor.corutestmask shift 1 shift (-1)) add
6 18637 ((coruid > 0) extract 1 shift 11);
6 18638 end;
5 18639 end;
4 18640 end;
3 18641 close(z,true);
3 18642
3 18642 læsfil(tf_systællere,1,k);
3 18643 rf:=iaf:= 4;
3 18644 systællere_nulstillet:= fil(k).rf;
3 18645 nulstil_systællere:= fil(k).iaf(1);
3 18646 if systællere_nulstillet=real<::> then
3 18647 begin
4 18648 systællere_nulstillet:= 0.0;
4 18649 nulstil_systællere:= -1;
4 18650 end;
3 18651 iaf:= 32;
3 18652 tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*10);
3 18653 iaf:= 192;
3 18654 tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*10);
3 18655
3 18655 end;
2 18656 \f
2 18656 message sysslut initialisering side 2 - 810603/cl;
2 18657
2 18657
2 18657 if låsning > 0 then
2 18658 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18659
2 18659 if låsning > 1 then
2 18660 <* låsning 2 : *> lock(readchar,1,write,2);
2 18661
2 18661 if låsning > 2 then
2 18662 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18663
2 18663
2 18663
2 18663
2 18663 if låsning > 0 then
2 18664 begin
3 18665 i:= locked(ia);
3 18666 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18667 end;
2 18668 \f
2 18668 message sysslut initialisering side 3 - 810406/cl;
2 18669
2 18669 write(z_io,"nl",2,<:initialisering slut:>);
2 18670 system(2)free core:(i,ra);
2 18671 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18672 setposition(z_io,0,0);
2 18673 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18674 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18675 "nl",1);
2 18676 errorbits:= 3; <* ok.no warning.yes *>
2 18677 \f
2 18677
2 18677 algol list.off;
2 18678 message coroutinemonitor - 40 ;
2 18679
2 18679 if simref <> firstsem then initerror(1, false);
2 18680 if semref <> firstop - 4 then initerror(2, false);
2 18681 if coruref <> firstsim then initerror(3, false);
2 18682 if opref <> optop + 6 then initerror(4, false);
2 18683 if proccount <> maxprocext -1 then initerror(5, false);
2 18684 goto takeexternal;
2 18685
2 18685 dump:
2 18686 op:= op;
2 18687 \f
2 18687 message sys trapaktion side 1 - 810521/hko/cl;
2 18688 trap(finale);
2 18689 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18690 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18691 begin
3 18692 k:= 0;
3 18693 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18694 <:timerqueue->:>));
3 18695 iaf:= i;
3 18696 for iaf:= d.iaf.next while iaf<>i do
3 18697 begin
4 18698 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18699 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18700 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18701 end;
3 18702 end;
2 18703 outchar(zbillede,'nl');
2 18704
2 18704 skriv_opkaldstællere(zbillede);
2 18705
2 18705
2 18705 pfilsystem(zbillede);
2 18706
2 18706 \f
2 18706 message operatør trapaktion1 side 1 - 810521/hko;
2 18707 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18708
2 18708 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18709 for i:= 1 step 1 until max_antal_operatører do
2 18710 begin
3 18711 laf:= (i-1)*8;
3 18712 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18713 case operatør_auto_include(i) extract 2 + 1 of (
3 18714 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18715 terminal_navn.laf,"nl",1);
3 18716 end;
2 18717 write(zbillede,"nl",1);
2 18718
2 18718 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18719 <:betjeningspladsgrupper::>,"nl",1);
2 18720 for i:= 1 step 1 until 127 do
2 18721 if bpl_navn(i)<>long<::> then
2 18722 begin
3 18723 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18724 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18725 write(zbillede,"sp",16-k,<:= :>);
3 18726 iaf:= i*op_maske_lgd; j:=0;
3 18727 for k:= 1 step 1 until max_antal_operatører do
3 18728 begin
4 18729 if læsbit_ia(bpl_def.iaf,k) then
4 18730 begin
5 18731 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18732 write(zbillede,true,6,string bpl_navn(k));
5 18733 j:= j+1;
5 18734 end;
4 18735 end;
3 18736 write(zbillede,"nl",1);
3 18737 end;
2 18738
2 18738 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18739 for i:= 1 step 1 until max_antal_operatører do
2 18740 begin
3 18741 write(zbillede,<<dd >,i);
3 18742 for j:= 0 step 1 until 3 do
3 18743 begin
4 18744 k:= operatør_stop(i,j);
4 18745 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18746 else string bpl_navn(k));
4 18747 end;
3 18748 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18749 end;
2 18750
2 18750 skriv_terminal_tab(zbillede);
2 18751 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18752 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18753 skriv_opk_alarm_tab(zbillede);
2 18754 skriv_talevejs_tab(zbillede);
2 18755 skriv_op_spool_buf(zbillede);
2 18756 skriv_cqf_tabel(zbillede,true);
2 18757 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18758
2 18758 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18759 for i:= 1 step 1 until max_antal_garageterminaler do
2 18760 begin
3 18761 laf:= (i-1)*8;
3 18762 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18763 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18764 end;
2 18765 \f
2 18765 message radio trapaktion side 1 - 820301/hko;
2 18766 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18767 skriv_kanal_tab(zbillede);
2 18768 skriv_opkaldskø(zbillede);
2 18769 skriv_radio_linietabel(zbillede);
2 18770 skriv_radio_områdetabel(zbillede);
2 18771
2 18771 \f
2 18771 message vogntabel trapaktion side 1 - 810520/cl;
2 18772 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18773 skriv_vt_variable(zbillede);
2 18774 p_vogntabel(zbillede);
2 18775 p_gruppetabel(zbillede);
2 18776 p_springtabel(zbillede);
2 18777 \f
2 18777 message sysslut trapaktion side 1 - 810519/cl;
2 18778 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18779 corutable(zbillede);
2 18780 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18781 <: ref værdi prev next:>,"nl",1);
2 18782 iaf:= firstsim;
2 18783 repeat
2 18784 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18785 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18786 iaf:= iaf + simsize;
2 18787 until iaf>=simref;
2 18788 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18789 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18790 iaf:= firstsem;
2 18791 repeat
2 18792 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18793 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18794 iaf:= iaf+semsize;
2 18795 until iaf>=semref;
2 18796 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18797 iaf:= firstop;
2 18798 repeat
2 18799 skriv_op(zbillede,iaf);
2 18800 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18801 until iaf>=optop;
2 18802 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18803 <: messref messcode messop:>,"nl",1);
2 18804 for i:= 1 step 1 until maxmessext do
2 18805 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18806 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18807 <: procref proccode procop:>,"nl",1);
2 18808 for i:= 1 step 1 until maxprocext do
2 18809 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18810
2 18810
2 18810 \f
2 18810 message sys_finale side 1 - 810428/hko;
2 18811
2 18811 finale:
2 18812 trap(slut_finale);
2 18813 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18814 endaction:=0;
2 18815 \f
2 18815 message filsystem finale side 1 - 810428/cl;
2 18816
2 18816 <* lukning af zoner *>
2 18817 write(out,<:lukker filsystem:>); ud;
2 18818 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18819 close(fil(i),true);
2 18820 \f
2 18820 message operatør_finale side 1 - 810428/hko;
2 18821
2 18821 goto op_trap2_slut;
2 18822
2 18822 write(out,<:lukker operatører:>); ud;
2 18823 for k:= 1 step 1 until max_antal_operatører do
2 18824 begin
3 18825 close(z_op(k),true);
3 18826 end;
2 18827 op_trap2_slut:
2 18828 k:=k;
2 18829
2 18829 \f
2 18829 message garage_finale side 1 - 810428/hko;
2 18830
2 18830 write(out,<:lukker garager:>); ud;
2 18831 for k:= 1 step 1 until max_antal_garageterminaler do
2 18832 begin
3 18833 close(z_gar(k),true);
3 18834 end;
2 18835 \f
2 18835 message radio_finale side 1 - 810525/hko;
2 18836 write(out,<:lukker radio:>); ud;
2 18837 close(z_fr_in,true);
2 18838 close(z_fr_out,true);
2 18839 close(z_rf_in,true);
2 18840 close(z_rf_out,true);
2 18841 \f
2 18841 message sysslut finale side 1 - 810530/cl;
2 18842
2 18842 slut_finale:
2 18843
2 18843 trap(exit_finale);
2 18844
2 18844 outchar(zrl,'em');
2 18845 close(zrl,true);
2 18846
2 18846 write(zbillede,
2 18847 "nl",2,<:blocksread=:>,blocksread,
2 18848 "nl",1,<:blocksout= :>,blocksout,
2 18849 "nl",1,<:fillæst= :>,fillæst,
2 18850 "nl",1,<:filskrevet=:>,filskrevet,
2 18851 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18852 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18853 close(zbillede,true);
2 18854 monitor(42,zbillede,0,ia);
2 18855 ia(6):= systime(7,0,0.0);
2 18856 monitor(44,zbillede,0,ia);
2 18857 setposition(z_io,0,0);
2 18858 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18859 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18860 close(z_io,true);
2 18861 exit_finale: trapmode:= 1 shift 10;
2 18862
2 18862 end;
1 18863
1 18863
1 18863 algol list.on;
1 18864 message programslut;
1 18865 program_slut:
1 18866 end
\f
1. 7028219 14549615 609 0 0
2. 13908039 9904266 350 0 0
3. 1551811 243360 418 368 0
4. 6707625 10849847 428 1653 742
5. 11913650 9513348 582 29884 605
6. 11753653 11690366 583 0 0
7. 11863649 12658528 632 0 0
8. 18856 18850 18837 18819 18806 18798 18788 18780 18769 18758
18751 18738 18724 18715 18707 18693 18681 18672 18662 18648
18620 18595 18577 18553 18533 18512 18499 18484 18468 18453
18432 18406 18392 18375 18355 18346 18324 18299 18274 18256
18243 18239 18211 18196 18180 18169 18156 18141 18125 18112
18096 18080 18058 18040 18024 18006 17989 17966 17947 17928
17916 17902 17882 17868 17849 17836 17817 17806 17793 17783
17766 17753 17742 17724 17711 17698 17678 17660 17647 17624
17604 17588 17575 17558 17546 17531 17516 17497 17476 17462
17452 17447 17437 17429 17410 17389 17369 17361 17354 17344
17299 17254 17226 17213 17180 17153 17130 17090 17065 17036
16980 16925 16872 16843 16810 16768 16736 16701 16645 16607
16567 16519 16486 16461 16438 16418 16390 16371 16352 16329
16318 16307 16287 16270 16255 16239 16212 16193 16177 16159
16150 16143 16118 16110 16100 16080 16069 16050 16039 16022
16007 15989 15964 15951 15940 15923 15905 15891 15884 15876
15867 15839 15822 15805 15792 15784 15775 15756 15745 15731
15719 15692 15677 15659 15637 15617 15604 15585 15562 15536
15515 15504 15482 15462 15440 15422 15394 15373 15355 15342
15334 15327 15312 15293 15286 15269 15249 15229 15215 15190
15175 15154 15128 15116 15107 15078 15056 15036 15026 15015
14990 14969 14949 14919 14900 14881 14861 14840 14832 14806
14793 14776 14757 14731 14712 14695 14668 14648 14626 14609
14589 14558 14527 14492 14465 14444 14431 14420 14399 14391
14382 14363 14343 14320 14293 14276 14258 14245 14235 14224
14200 14176 14157 14127 14114 14081 14046 14031 14010 13998
13972 13951 13931 13907 13896 13866 13847 13824 13794 13778
13755 13728 13693 13666 13659 13645 13624 13612 13598 13590
13575 13561 13554 13547 13540 13532 13499 13484 13464 13451
13433 13419 13391 13364 13346 13325 13307 13290 13273 13261
13251 13227 13221 13206 13186 13170 13153 13128 13115 13080
13063 13046 13023 13007 12995 12977 12950 12939 12931 12908
12889 12880 12863 12848 12830 12821 12809 12800 12782 12766
12751 12740 12721 12693 12672 12651 12635 12621 12614 12602
12585 12553 12535 12519 12502 12486 12455 12431 12421 12408
12393 12377 12359 12341 12317 12306 12290 12273 12257 12240
12216 12209 12191 12164 12146 12121 12096 12052 12041 12030
12002 11969 11939 11912 11870 11843 11822 11809 11801 11793
11783 11754 11737 11716 11701 11681 11658 11636 11612 11584
11562 11545 11520 11503 11487 11464 11449 11430 11411 11387
11352 11326 11308 11289 11268 11240 11223 11201 11187 11164
11136 11123 11110 11081 11043 11012 10969 10935 10904 10897
10889 10881 10870 10841 10818 10803 10793 10773 10755 10742
10733 10721 10712 10697 10689 10677 10648 10626 10608 10554
10519 10485 10452 10393 10377 10360 10341 10328 10315 10294
10282 10264 10251 10238 10211 10192 10175 10138 10122 10103
10095 10085 10054 10035 10018 10007 9977 9954 9929 9916
9907 9893 9869 9862 9852 9835 9816 9802 9783 9771
9755 9744 9733 9708 9691 9669 9651 9633 9613 9600
9580 9569 9543 9524 9505 9491 9481 9453 9435 9427
9403 9391 9379 9355 9337 9321 9310 9282 9265 9261
9244 9235 9228 9217 9203 9187 9170 9158 9146 9127
9117 9109 9082 9066 9059 9046 9032 9015 9007 8991
8982 8963 8926 8917 8892 8880 8866 8842 8822 8802
8780 8740 8722 8707 8695 8677 8668 8661 8649 8634
8623 8612 8598 8589 8568 8563 8552 8541 8525 8517
8507 8486 8474 8462 8442 8433 8419 8409 8395 8374
8359 8342 8332 8316 8303 8296 8279 8257 8238 8217
8203 8186 8168 8152 8135 8124 8110 8095 8049 8030
7993 7970 7947 7933 7912 7896 7867 7853 7831 7812
7781 7766 7754 7735 7722 7706 7687 7676 7661 7645
7633 7615 7585 7564 7543 7520 7497 7480 7464 7441
7424 7406 7369 7346 7339 7314 7302 7279 7265 7256
7237 7225 7208 7196 7175 7163 7145 7127 7105 7083
7075 7067 7060 7034 7007 6989 6969 6951 6935 6923
6903 6894 6877 6860 6849 6838 6827 6817 6812 6800
6790 6771 6758 6731 6720 6704 6696 6678 6662 6651
6615 6599 6585 6553 6526 6514 6504 6491 6478 6469
6454 6440 6421 6407 6400 6395 6372 6365 6352 6341
6320 6308 6295 6282 6273 6257 6241 6220 6201 6180
6171 6138 6116 6098 6071 6047 6034 6020 6006 5989
5973 5960 5938 5926 5915 5904 5890 5859 5833 5823
5808 5780 5758 5744 5736 5724 5708 5698 5685 5673
5654 5636 5610 5591 5566 5552 5539 5519 5501 5479
5467 5449 5431 5416 5401 5381 5374 5363 5349 5332
5324 5306 5291 5278 5266 5250 5238 5222 5204 5192
5176 5156 5134 5118 5103 5087 5066 5051 5026 5007
4993 4974 4960 4941 4922 4897 4874 4861 4841 4830
4807 4791 4774 4755 4732 4708 4691 4654 4632 4617
4609 4601 4578 4553 4536 4516 4503 4471 4446 4404
4386 4360 4341 4330 4306 4297 4277 4258 4239 4219
4197 4178 4158 4141 4106 4086 4045 4013 3986 3948
3910 3863 3815 3777 3742 3701 3641 3593 3547 3503
3471 3439 3395 3343 3297 3273 3258 3240 3223 3197
3177 3159 3146 3124 3080 3055 3015 2980 2958 2919
2890 2867 2837 2810 2790 2652 2623 2590 2560 2533
2481 2453 2437 2422 2402 2384 2363 2356 2337 2322
2290 2272 2255 2239 2215 2200 2173 2144 2124 2102
2086 2074 2055 2029 2019 2005 1985 1963 1948 1917
1894 1886 1876 1851 1831 1808 1798 1777 1763 1755
1743 1728 1713 1699 1688 1681 1660 1633 1616 1571
1545 1507 1476 1456 1421 1394 1381 1354 1324 1305
1270 1262 1246 1242 1234 1207 1195 1189 1175 1157
1150 1141 1122 1105 1079 1052 1027 1000 963 927
901 893 874 857 834 824 814 795 781 743
714 678 637 605 509 374 331 315 284 271
217 203 189 175 102 1 1 1 1
11863649 12658528 969 506071 31003
9. 16 310 16 4 960611 213027 buskom1
7 3 1995 306 algftnrts
0 1 0 2 *version
982 400 982 4 flushout
982 44 982 4 911004 101112 sendmessage
983 106 983 12 910308 134214 copyout
984 244 984 12 890821 163833 getzone6
0 410 0 0 out
985 178 985 12 940411 220029 testbit
988 414 988 18 940411 222629 findfpparam
991 46 991 18 890821 163814 system
994 238 994 18 movestring
994 56 994 18 890821 163907 outdate
995 124 995 18 isotable
996 176 995 18 890821 163656 write
1001 310 1001 152 intable
1002 34 1001 152 890821 163503 read
1006 24 1006 340 890821 163714 tofrom
993 420 991 18 stderror
1008 80 1008 340 890821 163740 open
1012 112 1012 340 890821 163754 monitor
1009 344 1008 340 close
1010 22 1008 340 setposition
993 378 991 18 increase
1000 50 995 18 outchar
995 26 995 18 replacechar
1015 98 1015 340 951214 094619 systime
0 1700 0 0 trapmode
1016 302 1016 340 trap
1016 112 1016 340 890821 163915 initzones
1017 268 1017 340 940411 222959 læsbitia
1018 22 1018 340 sign
1018 28 1018 340 890821 163648 ln
1019 432 1019 340 810409 111908 skrivhele
984 320 984 12 setzone6
1027 52 1027 340 inrec6
1027 28 1027 340 890821 163732 changerec6
1028 228 1028 340 940411 222949 sætbitia
1002 36 1001 152 readchar
1029 348 1029 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1030 278 1030 340 940411 222636 skrivtegn
1031 384 1031 340 940411 222639 afsluttext
1032 394 1032 340 940411 222952 læsbiti
1033 498 1033 340 960610 222201 systid
1035 28 1035 340 getnumber
1035 18 1035 340 900925 171358 putnumber
1 656 0 0 errorbits
1042 60 1042 342 940411 222943 sætbiti
1043 354 1043 342 940411 222801 openbs
1045 228 1045 342 940411 222742 hægttekst
1027 54 1027 340 outrec6
0 1704 0 0 alarmcause
1046 332 1046 342 940411 222745 hægtstring
1047 254 1047 342 940411 222749 anbringtal
1001 288 1001 152 repeatchar
1048 444 1048 342 940411 223002 intg
1049 350 1049 342 940411 222739 binærsøg
1018 20 1018 340 sgn
1050 380 1050 342 940411 222646 skrivtext
1027 56 1027 340 swoprec6
1054 56 1051 342 passivate
1051 40 1051 342 890821 163947 activity
1056 78 1056 350 260479 150000 mon
1 1043 1056 350 monw2
1 1039 1056 350 monw0
1 1041 1056 350 monw1
1053 56 1051 342 activate
0 1588 0 0 endaction
1056 320 1056 350 reflectcore
1052 50 1051 342 newactivity
1057 372 1057 358 940327 154135 setcspterm
1059 428 1059 358 941030 233200 slices
1063 52 1063 358 890821 163933 lock
1063 258 1063 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1064 162 1064 358 940411 222622 fpparam
1 1049 1065 358 nl
1 1047 1065 358 220978 131500 bel
1066 330 1066 446 940411 222722 ud
1067 252 1067 446 940411 222656 taltekst
1 1045 1056 350 monw3
984 296 984 12 getshare6
984 398 984 12 setshare6
70 480 1070 446 0
algol end 1070
*if ok.no
*if warning.yes
*o c
▶EOF◀