|
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: 993024 (0xf2700)
Types: TextFile
Names: »buskomudx03 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomudx03 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.5340101.2316
0 1 begin algol list.off;
1 2
1 2 <* variables for claiming (accumulating) basic entities *>
1 3 integer maxsem, maxsemch, maxop, maxcoru, maxmessext, maxprocext, maxnettoop;
1 4
1 4 <* fields defining current position in pools af basic entities
1 5 during initialization *>
1 6 integer array field firstsem, firstsim, firstcoru, firstop, optop;
1 7
1 7 <* variables used as pointers to 'current object' (work variables) *>
1 8 integer messext, procext, timeinterval, testbuffering;
1 9 integer array field timermessage, coru, sem, op, receiver, currevent,
1 10 baseevent, prevevent;
1 11
1 11 <* variables defining the size of basic entities (descriptors) *>
1 12 integer corusize, semsize, simsize, opheadsize;
1 13 integer array clockmess(1:2);
1 14 real array clock(1:3);
1 15 boolean eventqueueempty;
1 16 algol list.on;
1 17
1 17 \f
1 17 message sys_parametererklæringer side 1 - 810127/cl;
1 18
1 18 boolean testbit0 ,testbit1 ,testbit2 ,testbit3 ,testbit4 ,testbit5 ,
1 19 testbit6 ,testbit7 ,testbit8 ,testbit9 ,testbit10,testbit11,
1 20 testbit12,testbit13,testbit14,testbit15,testbit16,testbit17,
1 21 testbit18,testbit19,testbit20,testbit21,testbit22,testbit23,
1 22 testbit24,testbit25,testbit26,testbit27,testbit28,testbit29,
1 23 testbit30,testbit31,testbit32,testbit33,testbit34,testbit35,
1 24 testbit36,testbit37,testbit38,testbit39,testbit40,testbit41,
1 25 testbit42,testbit43,testbit44,testbit45,testbit46,testbit47;
1 26 boolean cl_overvåget,out_tw_lp,
1 27 cm_test;
1 28
1 28 integer låsning;
1 29 \f
1 29 message sys_parametererklæringer side 2 - 810310.hko;
1 30
1 30 <* hjælpevariable *>
1 31
1 31 integer i,j,k;
1 32 integer array ia(1:32);
1 33 integer array field iaf,ref;
1 34
1 34 real r;
1 35 real array ra(1:3);
1 36 real array field raf;
1 37 real field rf;
1 38
1 38 long array la(1:2);
1 39 long array field laf;
1 40
1 40 procedure ud;
1 41 begin
2 42 <*
2 43 outchar(out,'nl');
2 44 if out_tw_lp then setposition(out,0,0);
2 45 *>
2 46 flushout('nl');
2 47 end;
1 48 \f
1 48 message sys_parametererklæringer side 3 - 810310/hko;
1 49
1 49 <* hovedmodul_parametre *>
1 50
1 50 integer
1 51 sys_mod,
1 52 io_mod,
1 53 op_mod,
1 54 gar_mod,
1 55 rad_mod,
1 56 vt_mod;
1 57
1 57 <* operations_parametre *>
1 58
1 58 integer field
1 59 kilde,
1 60 retur,
1 61 resultat,
1 62 opkode;
1 63
1 63 real field
1 64 tid;
1 65
1 65 integer array field
1 66 data;
1 67
1 67 boolean
1 68 sys_optype,
1 69 io_optype,
1 70 op_optype,
1 71 gar_optype,
1 72 rad_optype,
1 73 vt_optype,
1 74 gen_optype;
1 75 \f
1 75 message sys_parametererklæringer side 4 - 820301/hko,cl;
1 76
1 76 <* trimme-variable *>
1 77
1 77 integer
1 78 max_antal_operatører,
1 79 max_antal_taleveje,
1 80 max_antal_garageterminaler,
1 81 max_antal_garager,
1 82 max_antal_områder,
1 83 max_antal_radiokanaler,
1 84 max_antal_pabx,
1 85 max_antal_kanaler,
1 86 max_antal_mobilopkald,
1 87 min_antal_nødopkald,
1 88 max_antal_grupper,
1 89 max_antal_gruppeopkald,
1 90 max_antal_spring,
1 91 max_antal_busser,
1 92 max_antal_linie_løb,
1 93 max_antal_fejltekster,
1 94 max_linienr,
1 95 op_maske_lgd,
1 96 tv_maske_lgd;
1 97
1 97 integer array
1 98 konsol_navn,
1 99 taleswitch_in_navn,
1 100 taleswitch_out_navn,
1 101 radio_fr_navn,
1 102 radio_rf_navn(1:4),
1 103 alfabet(0:255);
1 104
1 104 integer
1 105 tf_systællere,
1 106 tf_stoptabel,
1 107 tf_bplnavne,
1 108 tf_bpldef,
1 109 tf_alarmlgd;
1 110 \f
1 110 message filparm side 1 - 800529/jg/cl;
1 111
1 111 integer
1 112 fil_op_længde,
1 113 dbantez,dbantsz,dbanttz,
1 114 dbmaxtf, dbmaxsf, dbblokt,
1 115 dbmaxb,dbbidlængde,dbbidmax,
1 116 dbmaxef;
1 117 long array
1 118 dbsnavn, dbtnavn(1:2);
1 119
1 119 message attention parametererklæringer side 1 - 810318/hko;
1 120
1 120 integer
1 121 att_op_længde,
1 122 att_maske_lgd,
1 123 terminal_beskr_længde;
1 124 integer field
1 125 terminal_tilstand,
1 126 terminal_suppl;
1 127
1 127 message io_parametererklæringer side 1 - 820301/hko;
1 128
1 128 message operatør_parametererklæringer side 1 - 810422/hko;
1 129
1 129 integer field
1 130 cqf_bus, cqf_fejl,
1 131 alarm_kmdo, alarm_tilst, alarm_gtilst, alarm_lgd;
1 132 real field
1 133 cqf_ok_tid, cqf_næste_tid,
1 134 alarm_start;
1 135 long field
1 136 cqf_id;
1 137
1 137 integer
1 138 max_cqf, cqf_lgd,
1 139 op_spool_postlgd,
1 140 op_spool_postantal,
1 141 opk_alarm_tab_lgd;
1 142
1 142
1 142 \f
1 142 message procedure radio_parametererklæringer side 1 - 810524/hko;
1 143
1 143 integer
1 144 radio_giveup,
1 145 opkaldskø_postlængde,
1 146 kanal_beskr_længde,
1 147 radio_op_længde,
1 148 radio_pulje_størrelse;
1 149
1 149
1 149 \f
1 149 message vogntabel parametererklæringer side 1 - 810309/cl;
1 150
1 150 integer vt_op_længde, vt_logskift;
1 151 boolean vt_log_aktiv;
1 152
1 152 \f
1 152
1 152 algol list.off;
1 153 message coroutinemonitor - 2 ;
1 154
1 154 maxsem:= maxsemch:= maxop:= maxcoru:= maxnettoop:= 0;
1 155 maxmessext:= maxprocext:= 1;
1 156 corusize:= 20;
1 157 simsize:= 6;
1 158 semsize:= 8;
1 159 opheadsize:= 8;
1 160 testbuffering:= 1;
1 161 timeinterval:= 5;
1 162 algol list.on;
1 163 algol list.on;
1 164
1 164 \f
1 164 message sys_parameterinitialisering side 1 - 810305/hko;
1 165
1 165 copyout;
1 166
1 166 cl_overvåget:= false;
1 167 getzone6(out,ia);
1 168 out_tw_lp:= ia(1) extract 12 = 8 or ia(1) extract 12 = 14;
1 169
1 169 testbit0 :=testbit( 0);
1 170 testbit1 :=testbit( 1);
1 171 testbit2 :=testbit( 2);
1 172 testbit3 :=testbit( 3);
1 173 testbit4 :=testbit( 4);
1 174 testbit5 :=testbit( 5);
1 175 testbit6 :=testbit( 6);
1 176 testbit7 :=testbit( 7);
1 177 testbit8 :=testbit( 8);
1 178 testbit9 :=testbit( 9);
1 179 testbit10:=testbit(10);
1 180 testbit11:=testbit(11);
1 181 testbit12:=testbit(12);
1 182 testbit13:=testbit(13);
1 183 testbit14:=testbit(14);
1 184 testbit15:=testbit(15);
1 185 testbit16:=testbit(16);
1 186 testbit17:=testbit(17);
1 187 testbit18:=testbit(18);
1 188 testbit19:=testbit(19);
1 189 testbit20:=testbit(20);
1 190 testbit21:=testbit(21);
1 191 testbit22:=testbit(22);
1 192 testbit23:=testbit(23);
1 193 \f
1 193 message sys_parameterinitialisering side 2 - 810316/cl;
1 194
1 194 testbit24:=testbit(24);
1 195 testbit25:=testbit(25);
1 196 testbit26:=testbit(26);
1 197 testbit27:=testbit(27);
1 198 testbit28:=testbit(28);
1 199 testbit29:=testbit(29);
1 200 testbit30:=testbit(30);
1 201 testbit31:=testbit(31);
1 202 testbit32:=testbit(32);
1 203 testbit33:=testbit(33);
1 204 testbit34:=testbit(34);
1 205 testbit35:=testbit(35);
1 206 testbit36:=testbit(36);
1 207 testbit37:=testbit(37);
1 208 testbit38:=testbit(38);
1 209 testbit39:=testbit(39);
1 210 testbit40:=testbit(40);
1 211 testbit41:=testbit(41);
1 212 testbit42:=testbit(42);
1 213 testbit43:=testbit(43);
1 214 testbit44:=testbit(44);
1 215 testbit45:=testbit(45);
1 216 testbit46:=testbit(46);
1 217 testbit47:=testbit(47);
1 218 cm_test:= false;
1 219 \f
1 219 message sys_parameterinitialisering side 3 - 810409/cl,hko;
1 220
1 220 timeinterval:=1; <* tidsinterval for cmon's timeoutinspection *>
1 221
1 221 if findfpparam(<:låsning:>,true,ia) > 0 then låsning:= ia(1)
1 222 else låsning:= 0;
1 223 \f
1 223 message sys_parameterinitialisering side 4 - 820301/hko/cl;
1 224
1 224 <* initialisering af hovedmodul_parametre *>
1 225
1 225 i:=0; sys_mod:=i;
1 226 i:=i+1; io_mod:=i;
1 227 i:=i+1; op_mod:=i;
1 228 i:=i+1; gar_mod:=i;
1 229 i:=i+1; rad_mod:=i;
1 230 i:=i+1; vt_mod:=i;
1 231
1 231 <* initialisering af operationstyper *>
1 232
1 232 sys_optype:=false add (1 shift sys_mod);
1 233 io_optype:= false add (1 shift io_mod);
1 234 op_optype:= false add (1 shift op_mod);
1 235 gar_optype:=false add (1 shift gar_mod);
1 236 rad_optype:=false add (1 shift rad_mod);
1 237 vt_optype:= false add (1 shift vt_mod);
1 238 gen_optype:=false add (1 shift 11);
1 239
1 239 <* initialisering af fieldvariable for operationer *>
1 240
1 240 i:=2; kilde:=i;
1 241 i:=i+4; tid:=i;
1 242 i:=i+2; retur:=i;
1 243 i:=i+2; opkode:=i;
1 244 i:=i+2; resultat:=i;
1 245 i:=i+0; data:=i;
1 246
1 246 <* initialisering af trimme-variable *>
1 247
1 247 max_antal_operatører:=28; <* hvis > 32 skal tf_systællere udvides *>
1 248 max_antal_taleveje:=12;
1 249 max_antal_garageterminaler:=3;
1 250 max_antal_garager:=99;
1 251 max_antal_radiokanaler:=16;
1 252 max_antal_pabx:=2;
1 253 max_antal_kanaler:=14; <* 1 pabx + 13 radio *>
1 254 max_antal_områder:=11; <* hvis > 16 skal tf_systællere udvides *>
1 255 max_antal_mobilopkald:=100;
1 256 min_antal_nødopkald:=20;
1 257 max_antal_grupper:=16;
1 258 max_antal_gruppeopkald:=16;
1 259 max_antal_spring:=16;
1 260 max_antal_busser:=2000;
1 261 max_antal_linie_løb:=2000;
1 262 max_antal_fejltekster:=21;
1 263 max_linienr:=999; <*<=999*>
1 264
1 264 op_maske_lgd:= ((1+max_antal_operatører+23)//24)*2;
1 265 tv_maske_lgd:= ((1+max_antal_taleveje+23)//24)*2;
1 266 \f
1 266 message sys_parameterinitialisering side 5 - 880901/cl;
1 267
1 267 <* initialisering af konsol-navn *>
1 268 raf:= 0;
1 269 if findfpparam(<:io:>,false,ia)>0 then
1 270 begin
2 271 for i:= 1 step 1 until 4 do konsol_navn(i):= ia(i);
2 272 end
1 273 else
1 274 system(7,0,konsol_navn);
1 275 <*
1 276 movestring(konsol_navn.raf,1,<:console1:>);
1 277 *>
1 278
1 278 raf:= 0;
1 279
1 279 <* intialiserning af talevejsswitchens navn *>
1 280
1 280 movestring(taleswitch_in_navn.raf,1,<:taleswitchi:>);
1 281 movestring(taleswitch_out_navn.raf,1,<:taleswitch:>);
1 282
1 282 <* initialisering af radiokanalnavne *>
1 283
1 283 movestring(radio_fr_navn.raf,1,<:radiofr:>);
1 284 movestring(radio_rf_navn.raf,1,<:radiorf:>);
1 285
1 285 <* initialisering af 'input'-alfabet *>
1 286
1 286 isotable(alfabet);
1 287 alfabet('esc'):= 8 shift 12 + 'esc';
1 288 <* for i:='a' step 1 until 'å' do alfabet(i):=alfabet(i)-32; *>
1 289 for i:= 128 step 1 until 255 do alfabet(i):= 0 shift 12 + i;
1 290 intable(alfabet);
1 291
1 291 <* initialsering af tf_systællere *>
1 292
1 292 tf_systællere:= 1024<*tabelfil*> + 8;
1 293 tf_stoptabel := 1024<*tabelfil*> + 5;
1 294 tf_bpl_navne := 1024<*tabelfil*> + 12;
1 295 tf_bpl_def := 1024<*tabelfil*> + 13;
1 296 tf_alarmlgd := 1024<*tabelfil*> + 14;
1 297
1 297 \f
1 297 message filparminit side 1 - 801030/jg;
1 298
1 298 fil_op_længde:= data + 18 <*halvord*>;
1 299
1 299
1 299 dbantez:= 1;
1 300 dbantsz:= 2;
1 301 dbanttz:= 3; <* >=2 aht. samtidig tilgang*>
1 302 dbblokt:= 8;
1 303 dbmaxsf:= 7;
1 304 dbbidlængde:= 3;
1 305 dbbidmax:= 5;
1 306 dbmaxb:= dbmaxsf * dbbidmax;
1 307 dbmaxef:= 12;
1 308 movestring(dbsnavn,1,<:spoolfil:>);
1 309 movestring(dbtnavn,1,<:tabelfil:>);
1 310 if findfpparam(<:tabelfil:>,false,ia)>0 then
1 311 tofrom(dbtnavn,ia,8);
1 312 \f
1 312 message filparminit side 2 - 801030/jg;
1 313
1 313
1 313 <* reserver og check spoolfil og tabelfil *>
1 314 begin integer s,i,funk,f;
2 315 zone z(128,1,stderror); integer array tail(1:10);
2 316
2 316 for f:=1,2 do
2 317 begin
3 318 <*open(z,4,string (case f of(dbsnavn,dbtnavn)),0);*>
3 319 case f of
3 320 begin
4 321 open(z,4,dbsnavn,0);
4 322 open(z,4,dbtnavn,0);
4 323 end;
3 324 for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do
3 325 begin
4 326 s:=monitor(funk,z,i,tail);
4 327 if s<>0 then system(9,funk*100+s,
4 328 case f of(<:<10>spoolfil:>,<:<10>tabelfil:>));
4 329 end;
3 330 case f of begin
4 331 begin integer antseg; <*spoolfil*>
5 332 antseg:=dbmaxb * dbbidlængde;
5 333 if tail(1) < antseg then
5 334 begin
6 335 tail(1):=antseg;
6 336 s:=monitor(44<*change*>,z,i,tail);
6 337 if s<>0 then
6 338 system(9,44*100+s,<:<10>spoolfil:>);
6 339 end;
5 340 end;
4 341 begin <*tabelfil*>
5 342 dbmaxtf:=tail(10);
5 343 if dbmaxtf<1 or dbmaxtf>1023 then
5 344 system(9,dbmaxtf,<:<10>tabelfil:>);
5 345 end
4 346 end case;
3 347 close(z,false);
3 348 end for;
2 349 end;
1 350 \f
1 350 message attention parameterinitialisering side 1 - 810318/hko;
1 351
1 351 att_op_længde:= 40;
1 352 att_maske_lgd:=
1 353 (1+max_antal_operatører+max_antal_garageterminaler+1+23)//24*2;
1 354 terminal_beskr_længde:=6;
1 355 terminal_tilstand:= 2;
1 356 terminal_suppl:=4;
1 357
1 357 message io_parameterinitialisering side 1 - 810421/hko;
1 358
1 358
1 358 message operatør_parameterinitialisering side 1 - 810422/hko;
1 359
1 359 <* felter i cqf_tabel *>
1 360 cqf_lgd:=
1 361 cqf_næste_tid:= 16;
1 362 cqf_ok_tid := 12;
1 363 cqf_id := 8;
1 364 cqf_fejl := 4;
1 365 cqf_bus := 2;
1 366
1 366 max_cqf:= 64;
1 367
1 367 <* felter i opkaldsalarmtabel *>
1 368 alarm_kmdo := 2;
1 369 alarm_tilst := 4;
1 370 alarm_gtilst:= 6;
1 371 alarm_lgd := 8;
1 372 alarm_start := 12;
1 373
1 373 opk_alarm_tab_lgd:= 12;
1 374 op_spool_postantal:= 16;
1 375 op_spool_postlgd:= 64;
1 376
1 376
1 376 \f
1 376 message procedure radio_parameterinitialisering side 1 - 810601/hko;
1 377
1 377 radio_giveup:= 1 shift 21 + 1 shift 9;
1 378 opkaldskø_postlængde:= 10+op_maske_lgd;
1 379 kanal_beskr_længde:= 12+op_maske_lgd+tv_maske_lgd;
1 380 radio_op_længde:= 30*2;
1 381 radio_pulje_størrelse:= 1+max_antal_taleveje;
1 382
1 382 \f
1 382 message vogntabel parameterinitialisering side 1 - 810309/cl;
1 383
1 383 vt_op_længde:= data + 16; <* halvord *>
1 384
1 384 if findfpparam(<:vtlogskift:>,true,ia) > 0 then
1 385 vt_logskift:= ia(1) else vt_logskift:= -1;
1 386
1 386 vt_log_aktiv:= (vt_logskift >= 0) and (vt_logskift < 240000);
1 387
1 387
1 387 \f
1 387 message filclaim, side 1 - 810202/cl;
1 388
1 388 maxcoru:= maxcoru+6;
1 389 maxsem:= maxsem+2;
1 390 maxsemch:= maxsemch+6;
1 391 \f
1 391 message attention_claiming side 1 - 810318/hko;
1 392
1 392
1 392 maxcoru:=maxcoru+1;
1 393
1 393 max_op:=max_op +1
1 394 +max_antal_operatører
1 395 +max_antal_garageterminaler;
1 396
1 396 max_nettoop:=maxnettoop+(data+att_op_længde)
1 397 *(1+max_antal_operatører
1 398 +max_antal_garageterminaler);
1 399
1 399 max_procext:=max_procext+1;
1 400
1 400 max_sem:= max_sem+1;
1 401
1 401 max_semch:=maxsemch+1;
1 402
1 402
1 402 \f
1 402 message io_claiming side 1 - 810421/hko;
1 403
1 403 max_coru:= max_coru
1 404 + 1 <* hovedmodul io *>
1 405 + 1 <* io kommando *>
1 406 + 1 <* io operatørmeddelelser *>
1 407 + 1 <* io spontane meddelelser *>
1 408 + 1 <* io spoolkorutine *>
1 409 + 1 <* io tællernulstilling *>
1 410 ;
1 411
1 411 max_semch:= max_semch
1 412 + 1 <* cs_io *>
1 413 + 1 <* cs_io_komm *>
1 414 + 1 <* cs_io_fil *>
1 415 + 1 <* cs_io_medd *>
1 416 + 1 <* cs_io_spool *>
1 417 + 1 <* cs_io_nulstil *>
1 418 ;
1 419
1 419 max_sem:= max_sem
1 420 + 1 <* ss_io_spool_fulde *>
1 421 + 1 <* ss_io_spool_tomme *>
1 422 + 1; <* bs_zio_adgang *>
1 423
1 423 max_op:=max_op
1 424 + 1; <* fil-operation *>
1 425
1 425 max_nettoop:=max_nettoop
1 426 + (data+18); <* fil-operation *>
1 427
1 427 \f
1 427 message operatør_claiming side 1 - 810520/hko;
1 428
1 428 max_coru:= max_coru +1 <* h_op *>
1 429 +1 <* alarmur *>
1 430 +1 <* opkaldsalarmer *>
1 431 +1 <* talevejsswitch *>
1 432 +1 <* tv_switch_adm *>
1 433 +1 <* tv_switch_input *>
1 434 +1 <* op_spool *>
1 435 +1 <* op_medd *>
1 436 +1 <* op_cqftest *>
1 437 +max_antal_operatører;
1 438
1 438 max_sem:= 1 <* bs_opk_alarm *>
1 439 +1 <* ss_op_spool_tomme *>
1 440 +1 <* ss_op_spool_fulde *>
1 441 +max_sem;
1 442
1 442 max_semch:= max_semch +1 <* cs_op *>
1 443 +1 <* cs_op_retur *>
1 444 +1 <* cs_opk_alarm_ur *>
1 445 +1 <* cs_opk_alarm_ur_ret *>
1 446 +1 <* cs_opk_alarm *>
1 447 +1 <* cs_talevejsswitch *>
1 448 +1 <* cs_tv_switch_adm *>
1 449 +1 <* cs_tvswitch_adgang *>
1 450 +1 <* cs_tvswitch_input *>
1 451 +1 <* cs_op_iomedd *>
1 452 +1 <* cs_op_spool *>
1 453 +1 <* cs_op_medd *>
1 454 +1 <* cs_cqf *>
1 455 +max_antal_operatører<* cs_operatør *>
1 456 +max_antal_operatører<* cs_op_fil *>;
1 457
1 457 max_op:= max_op + 1 <* talevejsoperation *>
1 458 + 2 <* tv_switch_input *>
1 459 + 1 <* op_iomedd *>
1 460 + 1 <* opk_alarm_ur *>
1 461 + 1 <* op_spool_medd *>
1 462 + 1 <* op_cqftest *>
1 463 + max_antal_operatører;
1 464
1 464 max_netto_op:= filoplængde*max_antal_operatører
1 465 + data+128 <* talevejsoperation *>
1 466 + 2*(data+256) <* tv_switch_input *>
1 467 + 60 <* op_iomedd *>
1 468 + data <* opk_alarm_ur *>
1 469 + data+op_spool_postlgd <* op_spool_med *>
1 470 + 60 <* op_cqftest *>
1 471 + max_netto_op;
1 472
1 472 \f
1 472 message garage_claiming side 1 -810226/hko;
1 473
1 473 max_coru:= max_coru +1
1 474 +max_antal_garageterminaler;
1 475
1 475 max_semch:= max_semch +1
1 476 +max_antal_garageterminaler;
1 477
1 477 \f
1 477 message procedure radio_claiming side 1 - 810526/hko;
1 478
1 478 max_coru:= max_coru
1 479 +1 <* hovedmodul radio *>
1 480 +1 <* opkaldskø_meddelelse *>
1 481 +1 <* radio_adm *>
1 482 +max_antal_taleveje <* radio *>
1 483 +2; <* radio ind/-ud*>
1 484
1 484 max_semch:= max_semch
1 485 +1 <* cs_rad *>
1 486 +max_antal_taleveje <* cs_radio *>
1 487 +1 <* cs_radio_pulje *>
1 488 +1 <* cs_radio_kø *>
1 489 +1 <* cs_radio_medd *>
1 490 +1 <* cs_radio_adm *>
1 491 +2 ; <* cs_radio_ind/-ud *>
1 492
1 492 max_sem:=
1 493 +1 <* bs_mobil_opkald *>
1 494 +1 <* bs_opkaldskø_adgang *>
1 495 +max_antal_kanaler <* ss_radio_aktiver *>
1 496 +max_antal_kanaler <* ss_samtale_nedlagt *>
1 497 +max_antal_taleveje <* bs_talevej_udkoblet *>
1 498 +max_sem;
1 499
1 499 max_op:=
1 500 + radio_pulje_størrelse <* radio_pulje_operationer *>
1 501 + 1 <* radio_medd *>
1 502 + 1 <* radio_adm *>
1 503 + max_antal_taleveje <* operationer for radio *>
1 504 + 2 <* operationer for radio_ind/-ud *>
1 505 + max_op;
1 506
1 506 max_netto_op:=
1 507 + radio_pulje_størrelse * 60 <* radio_pulje_operationer *>
1 508 + data + 6 <* radio_medd *>
1 509 + max_antal_taleveje <* operationer for radio *>
1 510 * (data + radio_op_længde)
1 511 + data + radio_op_længde <* operation for radio_adm *>
1 512 + 2*(data + 64) <* operationer for radio_ind/-ud *>
1 513 + max_netto_op;
1 514 \f
1 514 message vogntabel_claiming side 1 - 810413/cl;
1 515
1 515 maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
1 516 + 1 <* coroutine vt_opdater *>
1 517 + 1 <* coroutine vt_tilstand *>
1 518 + 1 <* coroutine vt_rapport *>
1 519 + 1 <* coroutine vt_gruppe *>
1 520 + 1 <* coroutine vt_spring *>
1 521 + 1 <* coroutine vt_auto *>
1 522 + 1 <* coroutine vt_log *>
1 523 + maxcoru;
1 524
1 524 maxsemch:= 1 <* cs_vt *>
1 525 + 1 <* cs_vt_adgang *>
1 526 + 1 <* cs_vt_logpool *>
1 527 + 1 <* cs_vt_opd *>
1 528 + 1 <* cs_vt_rap *>
1 529 + 1 <* cs_vt_tilst *>
1 530 + 1 <* cs_vtt_auto *>
1 531 + 1 <* cs_vt_grp *>
1 532 + 1 <* cs_vt_spring *>
1 533 + 1 <* cs_vt_log *>
1 534 + 5 <* cs_vt_filretur(coru) *>
1 535 + maxsemch;
1 536
1 536 maxop:= 1 <* vt_op *>
1 537 + 2 <* vt_log_op *>
1 538 + 6 <* vt_fil_op + radop *>
1 539 + maxop;
1 540
1 540 maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
1 541 + 5*fil_op_længde
1 542 + (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
1 543 + maxnettoop;
1 544
1 544 \f
1 544
1 544 algol list.off;
1 545 message coroutinemonitor - 3 ;
1 546
1 546 begin
2 547
2 547 <* work variables - primarily used during initialization *>
2 548 integer array field simref, semref, coruref, opref;
2 549 integer proccount, corucount, messcount, cmi, cmj;
2 550 integer array zoneia(1:20);
2 551
2 551 <* field variables describing the format of basic entities *>
2 552 integer field
2 553 <* chain head *>
2 554 next, prev,
2 555 <* simple semaphore *>
2 556 simvalue, simcoru,
2 557 <* chained semaphore *>
2 558 semop, semcoru,
2 559 <* coroutine *>
2 560 coruop, corutimerchain, corutimer, corupriority, coruident,
2 561 <* operation head *>
2 562 opnext, opsize;
2 563
2 563 \f
2 563
2 563 message coroutinemonitor - 4 ;
2 564
2 564 boolean field
2 565 corutypeset, corutestmask, optype;
2 566 real starttime;
2 567 long corustate;
2 568
2 568 <* field variables used as queue identifiers (addresses) *>
2 569 integer array field current, readyqueue, idlequeue, timerqueue;
2 570
2 570 <* extensions (message- and process- extensions) *>
2 571 integer array messref, messcode, messop (1:maxmessext);
2 572 integer array procref, proccode, procop (1:maxprocext);
2 573
2 573 <* core array used for accessing the core using addresses as field
2 574 variables (as delivered by the monitor functions)
2 575 - descriptor array 'd' in which all basic entities are allocated
2 576 (except for extensions) *>
2 577 integer array core (1:1), d (1:(4 <* readyqueue *> +
2 578 4 <* idlequeue *> +
2 579 4 <* timerqueue *> +
2 580 maxcoru * corusize +
2 581 maxsem * simsize +
2 582 maxsemch * semsize +
2 583 maxop * opheadsize +
2 584 maxnettoop)/2);
2 585 \f
2 585
2 585 message coroutinemonitor - 5 ;
2 586
2 586
2 586
2 586 <*************** initialization procedures ***************>
2 587
2 587
2 587
2 587 procedure initchain (chainref);
2 588 value chainref;
2 589 integer array field chainref;
2 590 begin
3 591 integer array field cref;
3 592 cref:= chainref;
3 593 d.cref.next:= d.cref.prev:= cref;
3 594 end;
2 595 \f
2 595
2 595 message coroutinemonitor - 6 ;
2 596
2 596
2 596 <***** nextsem *****
2 597
2 597 this procedure allocates and initializes the next simple semaphore in the
2 598 pool of claimed semaphores.
2 599 the procedure returns the identification (the address) of the semaphore to
2 600 be used when calling 'signal', 'wait' and 'inspect'. *>
2 601
2 601 integer procedure nextsem;
2 602 begin
3 603 nextsem:= simref;
3 604 if simref >= firstsem then initerror(1, true);
3 605 initchain(simref + simcoru);
3 606 d.simref.simvalue:= 0;
3 607 simref:= simref + simsize;
3 608 end;
2 609
2 609
2 609 <***** nextsemch *****
2 610
2 610 this procedure allocates and initializes the next simple semaphore in the
2 611 pool of claimed semaphores.
2 612 the procedure returns the identification (the address) of the semaphore to
2 613 be used when calling 'signalch', 'waitch' and 'inspectch'. *>
2 614
2 614 integer procedure nextsemch;
2 615 begin
3 616 nextsemch:= semref;
3 617 if semref >= firstop-4 then initerror(2, true);
3 618 initchain(semref + semcoru);
3 619 initchain(semref + semop);
3 620 semref:= semref + semsize;
3 621 end;
2 622 \f
2 622
2 622 message coroutinemonitor - 7 ;
2 623
2 623
2 623 <***** nextcoru *****
2 624
2 624 this procedure initializes the next coroutine description in the pool of
2 625 claimed coroutine descriptions.
2 626 at initialization is defined the priority (an integer value), an identi-
2 627 fication (an integer value 0..8000) and a test pattern (a boolean). *>
2 628
2 628 integer procedure nextcoru(ident, priority, testmask);
2 629 value ident, priority, testmask;
2 630 integer ident, priority;
2 631 boolean testmask;
2 632 begin
3 633 corucount:= corucount + 1;
3 634 if corucount > maxcoru then initerror(3, true);
3 635 nextcoru:= corucount;
3 636 initchain(coruref + next);
3 637 initchain(coruref + corutimerchain);
3 638 initchain(coruref + coruop);
3 639 d.coruref.corupriority:= priority;
3 640 d.coruref.coruident:= ident * 1000 + corucount;
3 641 d.coruref.corutypeset:= false;
3 642 d.coruref.corutimer:= 0;
3 643 d.coruref.corutestmask:= testmask;
3 644 linkprio(coruref, readyqueue);
3 645 current:= coruref;
3 646 coruref:= coruref + corusize;
3 647 end;
2 648 \f
2 648
2 648 message coroutinemonitor - 8 ;
2 649
2 649
2 649 <***** nextop *****
2 650
2 650 this procedure initializes the next operation in the pool of claimed ope-
2 651 rations (heads and buffers).
2 652 the head is allocated and immediately following the head is allocated 'size'
2 653 halfwords forming the operation buffer.
2 654 the procedure returns an identification of the operation (an address) and
2 655 in case this address is held in a field variable 'op', the buffer area may
2 656 be accessed as: d.op(1), d.op(2), d.op(3) ... *>
2 657
2 657 integer procedure nextop (size);
2 658 value size;
2 659 integer size;
2 660 begin
3 661 nextop:= opref;
3 662 if opref >= optop then initerror(4, true);
3 663 initchain(opref + next);
3 664 d.opref.opsize:= size;
3 665 opref:= opref + size + opheadsize;
3 666 end;
2 667 \f
2 667
2 667 message coroutinemonitor - 9 ;
2 668
2 668
2 668 <***** nextprocext *****
2 669
2 669 this procedure initializes the next process extension in the series of
2 670 claimed process extensions.
2 671 the process description address is put into the process extension and the
2 672 state of the extension is initialized to be closed. *>
2 673
2 673 integer procedure nextprocext (processref);
2 674 value processref;
2 675 integer processref;
2 676 begin
3 677 proccount:= proccount + 1;
3 678 if proccount >= maxprocext then initerror(5, true);
3 679 nextprocext:= proccount;
3 680 procref(proccount):= processref;
3 681 proccode(proccount):= 1 shift 12;
3 682 end;
2 683 \f
2 683
2 683 message coroutinemonitor - 10 ;
2 684
2 684
2 684 <***** initerror *****
2 685
2 685 this procedure is activated in case the initialized set of resources does
2 686 not match the claimed set.
2 687 in case more resources are claimed than used, a warning is written,
2 688 in case too few resources are claimed, an error message is written and
2 689 the execution is terminated. *>
2 690
2 690 procedure initerror (resource, exceeded);
2 691 value resource, exceeded;
2 692 integer resource; boolean exceeded;
2 693 begin
3 694 write(out, false add 10, 1,
3 695 if exceeded then <:more :> else <:less :>,
3 696 case resource of (
3 697 <:simple semaphores:>,
3 698 <:chained semaphores:>,
3 699 <:coroutines:>,
3 700 <:operations:>,
3 701 <:process extensions:>),
3 702 <: initialized than claimed:>,
3 703 false add 10, 1);
3 704 if exceeded then goto dump;
3 705 end;
2 706
2 706
2 706 <***** stackclaim *****
2 707
2 707 this procedure is used by a coroutine from its first activation to it
2 708 arrives its first waiting point. the procedure is used to claim an addi-
2 709 tional amount of stack space. this must be done because the maximum
2 710 stack space for a coroutine is set to be the max amount used during its
2 711 very first activation. *>
2 712
2 712
2 712 procedure stackclaim (size);
2 713 value size; integer size;
2 714 begin
3 715 boolean array stackspace (1:size);
3 716 end;
2 717 algol list.on;
2 718
2 718 \f
2 718 message sys_erklæringer side 1 - 810406/cl,hko;
2 719
2 719 zone
2 720 zdummy(1,1,stderror),
2 721 zrl(128,1,stderror),
2 722 zbillede(128,1,stderror);
2 723
2 723 real array
2 724 fejltekst(1:max_antal_fejltekster);
2 725
2 725 real
2 726 systællere_nulstillet;
2 727
2 727 integer
2 728 nulstil_systællere,
2 729 top_bpl_gruppe;
2 730
2 730 integer array
2 731 ingen_operatører, alle_operatører(1:(op_maske_lgd//2)),
2 732 ingen_taleveje, alle_taleveje(1:(tv_maske_lgd//2)),
2 733 bpl_def(1:(128*(op_maske_lgd//2))),
2 734 bpl_tilst(0:127,1:2),
2 735 operatør_stop(0:max_antal_operatører,0:3),
2 736 område_id(1:max_antal_områder,1:2),
2 737 pabx_id(1:max_antal_pabx),
2 738 radio_id(1:max_antal_radiokanaler),
2 739 kanal_id(1:max_antal_kanaler),
2 740 opkalds_tællere(1:(max_antal_områder*5)), <* maxantal <= 16 *>
2 741 operatør_tællere(1:(max_antal_operatører*5)); <* maxantal <= 32 *>
2 742
2 742 boolean array
2 743 operatør_auto_include(1:max_antal_operatører),
2 744 garage_auto_include(1:max_antal_garageterminaler);
2 745
2 745 long array
2 746 terminal_navn(1:(2*max_antal_operatører)),
2 747 garage_terminal_navn(1:(2*max_antal_garageterminaler)),
2 748 bpl_navn(0:127),
2 749 område_navn(1:max_antal_områder),
2 750 kanal_navn(1:max_antal_kanaler);
2 751 \f
2 751 message procedure findområde side 1 - 880901/cl;
2 752
2 752 integer procedure find_bpl(navn);
2 753 value navn;
2 754 long navn;
2 755 begin
3 756 integer i;
3 757
3 757 find_bpl:= 0;
3 758 for i:= 0 step 1 until 127 do
3 759 if navn = bpl_navn(i) then find_bpl:= i;
3 760 end;
2 761
2 761 integer procedure findområde(omr);
2 762 value omr;
2 763 integer omr;
2 764 begin
3 765 integer i;
3 766
3 766 if omr = '*' shift 16 then findområde:= -1 else
3 767 begin
4 768 findområde:= 0;
4 769 for i:= 1 step 1 until max_antal_områder do
4 770 if (extend omr) shift 24=område_navn(i) then findområde:= i;
4 771 end;
3 772 end;
2 773 \f
2 773 message procedure tæl_opkald side 1 - 880926/cl;
2 774
2 774 procedure opdater_tf_systællere;
2 775 begin
3 776 integer zi;
3 777 integer array field iaf;
3 778 real field rf;
3 779
3 779 disable begin
4 780 skrivfil(tf_systællere,1,zi);
4 781 rf:= iaf:= 4;
4 782 fil(zi).rf:= systællere_nulstillet;
4 783 fil(zi).iaf(1):= nulstil_systællere;
4 784 iaf:= 32;
4 785 tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*10);
4 786 iaf:= 192;
4 787 tofrom(fil(zi).iaf,operatør_tællere,max_antal_operatører*10);
4 788 setposition(fil(zi),0,0);
4 789 end;
3 790 end;
2 791
2 791 procedure tæl_opkald(område,type);
2 792 value område,type;
2 793 integer område,type;
2 794 begin
3 795 increase(opkalds_tællere((område-1)*5+type));
3 796 disable opdater_tf_systællere;
3 797 end;
2 798
2 798 procedure tæl_opkald_pr_operatør(operatør,type);
2 799 value operatør,type;
2 800 integer operatør,type;
2 801 begin
3 802 increase(operatør_tællere((operatør-1)*5+type));
3 803 disable opdater_tf_systællere;
3 804 end;
2 805
2 805 procedure skriv_opkaldstællere(z);
2 806 zone z;
2 807 begin
3 808 integer omr,typ,rpc;
3 809 real r;
3 810
3 810 write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
3 811 <:omr ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 812 for omr:= 1 step 1 until max_antal_områder do
3 813 begin
4 814 write(z,true,6,string område_navn(omr),":",1);
4 815 for typ:= 1 step 1 until 5 do
4 816 write(z,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
4 817 outchar(z,'nl');
4 818 end;
3 819
3 819 write(z,"nl",1,
3 820 <:oper. ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 821 for omr:= 1 step 1 until max_antal_operatører do
3 822 begin
4 823 if bpl_navn(omr)=long<::> then
4 824 write(z,"sp",6-write(z,<:op:>,<<d>,omr),":",1)
4 825 else
4 826 write(z,true,6,string bpl_navn(omr),":",1);
4 827 for typ:= 1 step 1 until 5 do
4 828 write(z,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
4 829 outchar(z,'nl');
4 830 end;
3 831
3 831 rpc:= replace_char(1,':');
3 832 write(z,"nl",1,<:nulstilles :>);
3 833 if nulstil_systællere = (-1) then write(z,<:ikke automatisk:>,"nl",1)
3 834 else write(z,<:automatisk kl. :>,<<zd dd dd>,nulstil_systællere,"nl",1);
3 835 replace_char(1,'.');
3 836 write(z,<:nulstillet d. :>,<<zd dd dd>,
3 837 systime(4,systællere_nulstillet,r)," ",1);
3 838 replace_char(1,':');
3 839 write(z,<<zd dd dd>,r,"nl",1);
3 840 replace_char(1,rpc);
3 841 end;
2 842 \f
2 842 message procedure start_operation side 1 - 810521/hko;
2 843
2 843 procedure start_operation(op_ref,kor,ret_sem,kode);
2 844 value kor,ret_sem,kode;
2 845 integer array field op_ref;
2 846 integer kor,ret_sem,kode;
2 847 <*
2 848 op_ref: kald, reference til operation
2 849
2 849 kor: kald, kilde= hovedmodulnr*100 +løbenr
2 850 = korutineident.
2 851 ret_sem: kald, retursemafor
2 852
2 852 kode: kald, suppl shift 12 + operationskode
2 853
2 853 proceduren initialiserer en operations hoved med
2 854 parameterværdierne samt tidfeltet med aktueltid.
2 855 resultatfelt og datafelter nulstilles.
2 856
2 856 *>
2 857 begin
3 858 integer i;
3 859 d.op_ref.kilde:= kor;
3 860 systime(1,0,d.op_ref.tid);
3 861 d.op_ref.retur:=ret_sem;
3 862 d.op_ref.op_kode:=kode;
3 863 d.op_ref.resultat:=0;
3 864 for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
3 865 d.op_ref.data(i):=0;
3 866 end start_operation;
2 867 \f
2 867 message procedure afslut_operation side 1 - 810331/hko;
2 868
2 868 procedure afslut_operation(op_ref,sem);
2 869 value op_ref,sem;
2 870 integer op_ref,sem;
2 871 begin
3 872 integer array field op;
3 873 op:=op_ref;
3 874 if sem>0 then signal_ch(sem,op,d.op.optype) else
3 875 if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
3 876 ;
3 877 end afslut_operation;
2 878 \f
2 878 message procedure fejlreaktion - side 1 - 810424/cl,hko;
2 879
2 879 procedure fejlreaktion(nr,værdi,str,måde);
2 880 value nr,værdi,måde;
2 881 integer nr,værdi,måde;
2 882 string str;
2 883 begin
3 884 disable begin
4 885 write(out,<:<10>!!! :>);
4 886 if nr>0 and nr <=max_antal_fejltekster then
4 887 write(out,string fejltekst(nr))
4 888 else write(out,<:fejl nr.:>,nr);
4 889 outchar(out,'sp');
4 890 if måde shift (-12) extract 2=1 then
4 891 outintbits(out,værdi)
4 892 else
4 893 if måde shift (-12) extract 2=2 then
4 894 write(out,<:":>,false add værdi,1,<:":>)
4 895 else
4 896 write(out,værdi);
4 897 write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
4 898 <: korutine nr=:>,<<d>, abs curr_coruno,
4 899 <: ident=:>,curr_coruid,"nl",0);
4 900 if testbit27 and måde extract 12=1 then
4 901 trace(1);
4 902 ud;
4 903 end;<*disable*>
3 904 if måde extract 12 =2 then trapmode:=1 shift 13;
3 905 if måde extract 12= 0 then trap(-1)
3 906 else if måde extract 12 = 2 then trap(-2);
3 907 end fejlreaktion;
2 908
2 908 procedure trace(n);
2 909 value n;
2 910 integer n;
2 911 begin
3 912 trap(finis);
3 913 trap(n);
3 914 finis:
3 915 end trace;
2 916 \f
2 916 message procedure overvåget side 1 - 810413/cl;
2 917
2 917 boolean procedure overvåget;
2 918 begin
3 919 disable begin
4 920 integer i,måde;
4 921 integer array field cor;
4 922 integer array ia(1:12);
4 923
4 923 i:= system(12,0,ia);
4 924 if i > 0 then
4 925 begin
5 926 i:= system(12,1,ia);
5 927 måde:= ia(3);
5 928 end
4 929 else måde:= 0;
4 930
4 930 if måde<>0 then
4 931 begin
5 932 cor:= coroutine(abs ia(3));
5 933 overvåget:= d.cor.corutestmask shift (-11);
5 934 end
4 935 else overvåget:= cl_overvåget;
4 936 end;
3 937 end;
2 938 \f
2 938 message procedure antal_bits_ia side 1 - 940424/cl;
2 939
2 939 integer procedure antal_bits_ia(ia,n,ø);
2 940 value n,ø;
2 941 integer array ia;
2 942 integer n,ø;
2 943 begin
3 944 integer i, ant;
3 945
3 945 ant:= 0;
3 946 for i:= n step 1 until ø do
3 947 if læsbit_ia(ia,i) then ant:= ant+1;
3 948 end;
2 949
2 949 message procedure trunk_til_omr side 1 - 881006/cl;
2 950
2 950 integer procedure trunk_til_omr(trunk);
2 951 value trunk; integer trunk;
2 952 begin
3 953 integer i,j;
3 954
3 954 j:=0;
3 955 for i:= 1 step 1 until max_antal_områder do
3 956 if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
3 957 trunk_til_omr:=j;
3 958 end;
2 959
2 959 integer procedure omr_til_trunk(omr);
2 960 value omr; integer omr;
2 961 begin
3 962 omr_til_trunk:= område_id(omr,2) extract 12;
3 963 end;
2 964
2 964 integer procedure port_til_omr(port);
2 965 value port; integer port;
2 966 begin
3 967 if port shift (-6) extract 6 = 2 then
3 968 port_til_omr:= pabx_id(port extract 6)
3 969 else
3 970 if port shift (-6) extract 6 = 3 then
3 971 port_til_omr:= radio_id(port extract 6)
3 972 else
3 973 port_til_omr:= 0;
3 974 end;
2 975
2 975 integer procedure kanal_til_port(kanal);
2 976 value kanal; integer kanal;
2 977 begin
3 978 kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
3 979 kanal_id(kanal) extract 5;
3 980 end;
2 981
2 981 integer procedure port_til_kanal(port);
2 982 value port; integer port;
2 983 begin
3 984 integer i,j;
3 985
3 985 j:=0;
3 986 for i:= 1 step 1 until max_antal_kanaler do
3 987 if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
3 988 port_til_kanal:= j;
3 989 end;
2 990
2 990 integer procedure kanal_til_omr(kanal);
2 991 value kanal; integer kanal;
2 992 begin
3 993 kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
3 994 end;
2 995
2 995 \f
2 995 message procedure out_xxx_bits side 1 - 810406/cl;
2 996
2 996 procedure outboolbits(zud,b);
2 997 value b;
2 998 zone zud;
2 999 boolean b;
2 1000 begin
3 1001 integer i;
3 1002
3 1002 for i:= -11 step 1 until 0 do
3 1003 outchar(zud,if b shift i then '1' else '.');
3 1004 end;
2 1005
2 1005 procedure outintbits(zud,j);
2 1006 value j;
2 1007 zone zud;
2 1008 integer j;
2 1009 begin
3 1010 integer i;
3 1011
3 1011 for i:= -23 step 1 until 0 do
3 1012 begin
4 1013 outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
4 1014 if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
4 1015 end;
3 1016 end;
2 1017
2 1017 procedure outintbits_ia(zud,ia,n,ø);
2 1018 value n,ø;
2 1019 zone zud;
2 1020 integer array ia;
2 1021 integer n,ø;
2 1022 begin
3 1023 integer i;
3 1024
3 1024 for i:= n step 1 until ø do
3 1025 begin
4 1026 outintbits(zud,ia(i));
4 1027 outchar(zud,'nl');
4 1028 end;
3 1029 end;
2 1030
2 1030 real procedure now;
2 1031 begin
3 1032 real f,r,r1; long l;
3 1033
3 1033 systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
3 1034 systime(4,r,r1);
3 1035 now:= r1+f;
3 1036 end;
2 1037 \f
2 1037 message procedure skriv_id side 1 - 820301/cl;
2 1038
2 1038 procedure skriv_id(z,id,lgd);
2 1039 value id,lgd;
2 1040 integer id,lgd;
2 1041 zone z;
2 1042 begin
3 1043 integer type,p,li,lø,bo;
3 1044
3 1044 type:= id shift (-22);
3 1045 case type+1 of
3 1046 begin
4 1047 <* 1: bus *>
4 1048 begin
5 1049 p:= write(z,<<d>,id extract 14);
5 1050 if id shift (-14) <> 0 then
5 1051 p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
5 1052 end;
4 1053
4 1053 <* 2: linie/løb *>
4 1054 begin
5 1055 li:= id shift (-12) extract 10;
5 1056 bo:= id shift (-7) extract 5;
5 1057 if bo<>0 then bo:= bo + 'A' - 1;
5 1058 lø:= id extract 7;
5 1059 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
5 1060 end;
4 1061
4 1061 <* 3: gruppe *>
4 1062 begin
5 1063 if id shift (-21) = 4 <* linie-gruppe *> then
5 1064 begin
6 1065 li:= id shift (-5) extract 10;
6 1066 bo:= id extract 5;
6 1067 if bo<>0 then bo:= bo + 'A' - 1;
6 1068 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
6 1069 end
5 1070 else <* special-gruppe *>
5 1071 p:= write(z,"G",1,<<d>,id extract 7);
5 1072 end;
4 1073
4 1073 <* 4: telefon *>
4 1074 begin
5 1075 bo:= id shift (-20) extract 2;
5 1076 li:= id extract 20;
5 1077 case bo+1 of
5 1078 begin
6 1079 p:= write(z,string kanalnavn(li));
6 1080 p:= write(z,<:K*:>);
6 1081 p:= write(z,<:OMR :>,string områdenavn(li));
6 1082 p:= write(z,<:OMR*:>);
6 1083 end;
5 1084 end;
4 1085 end case;
3 1086 write(z,"sp",lgd-p);
3 1087 end skriv_id;
2 1088 <*+3*>
2 1089 \f
2 1089 message skriv_new_sem side 1 - 810520/cl;
2 1090
2 1090 procedure skriv_new_sem(z,type,ref,navn);
2 1091 value type,ref;
2 1092 zone z;
2 1093 integer type,ref;
2 1094 string navn;
2 1095 <* skriver en identifikation af en semafor 'ref' i zonen z.
2 1096
2 1096 type: 1=binær sem
2 1097 2=simpel sem
2 1098 3=kædet sem
2 1099
2 1099 ref: semaforreference
2 1100
2 1100 navn: semafornavn, max 18 tegn
2 1101 *>
2 1102 begin
3 1103 disable if testbit29 then
3 1104 write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
3 1105 true,5,<<zddd>,ref,true,19,navn);
3 1106 end;
2 1107 \f
2 1107 message procedure skriv_newactivity side 1 - 810520/hko/cl;
2 1108
2 1108 <**> procedure skriv_newactivity(zud,actno,cause);
2 1109 <**> value actno,cause;
2 1110 <**> zone zud;
2 1111 <**> integer actno,cause;
2 1112 <**> begin
3 1113 <*+2*>
3 1114 <**> if testbit28 then
3 1115 <**> begin integer array field cor;
4 1116 <**> cor:= coroutine(actno);
4 1117 <**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
4 1118 <**> << zdd>,d.cor.coruident//1000);
4 1119 <**> end;
3 1120 <**> if -, testbit23 then goto skriv_newact_slut;
3 1121 <*-2*>
3 1122 <**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
3 1123 <**> <:) cause=:>,<<-d>,cause);
3 1124 <**> if cause<1 then write(zud,<: !!!:>);
3 1125 <**> skriv_coru(zud,actno);
3 1126 <**> skriv_newact_slut:
3 1127 <**> end skriv_newactivity;
2 1128 <*-3*>
2 1129 <*+99*>
2 1130 \f
2 1130 message procedure skriv_activity side 1 - 810313/hko;
2 1131
2 1131 <**> procedure skriv_activity(zud,actno);
2 1132 <**> value actno;
2 1133 <**> zone zud;
2 1134 <**> integer actno;
2 1135 <**> begin
3 1136 <**> integer i;
3 1137 <**> integer array iact(1:12);
3 1138 <**>
3 1139 <**> i:=system(12,actno,iact);
3 1140 <**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
3 1141 <**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
3 1142 <**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
3 1143 <**> if i>0 and actno>0 and actno<=i then
3 1144 <**> begin
4 1145 <**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
4 1146 <**> (<:tom:>,<:passivate:>,
4 1147 <**> <:implicit passivate:>,<:activate:>));
4 1148 <**> if iact(1)<>0 then
4 1149 <**> write(zud,<: ventende på message:>,iact(1));
4 1150 <**> if iact(7)>0 then
4 1151 <**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
4 1152 <**> <:hovedlager stak benyttes af activity(:>,<<d>,
4 1153 <**> iact(2));
4 1154 <**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
4 1155 <**> iact(4),iact(5),iact(6),iact(10),iact(11));
4 1156 <**> if iact(9)<> 1 shift 22 then
4 1157 <**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
4 1158 <**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
4 1159 <**> end;
3 1160 <**> end skriv_activity
2 1161 <*-99*>
2 1162 <*+98*>
2 1163 \f
2 1163 message procedure identificer side 1 - 810520/cl;
2 1164
2 1164 procedure identificer(z);
2 1165 zone z;
2 1166 begin
3 1167 disable write(z,<:coroutine::>,<< dd>,curr_coruno,
3 1168 <: ident::>,<< zdd >,curr_coruid);
3 1169 end;
2 1170 \f
2 1170 message procedure skriv_coru side 1 - 810317/cl;
2 1171
2 1171 <**> procedure skriv_coru(zud,cor_no);
2 1172 <**> value cor_no;
2 1173 <**> zone zud;
2 1174 <**> integer cor_no;
2 1175 <**> begin
3 1176 <**> integer i;
3 1177 <**> integer array field cor;
3 1178 <**>
3 1179 <**>
3 1180 <**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
3 1181 <**>
3 1182 <**> cor:= coroutine(cor_no);
3 1183 <**> if cor = -1 then
3 1184 <**> write(zud,<: eksisterer ikke !!!:>)
3 1185 <**> else
3 1186 <**> begin
4 1187 <**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
4 1188 <**> <: refbyte: :>,<<d>,cor,"nl",1,
4 1189 <**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
4 1190 <**> <: next: :>,d.cor.next,"nl",1,
4 1191 <**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
4 1192 <**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
4 1193 <**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
4 1194 <**> <: opchain.next: :>,d.cor.coruop,"nl",1,
4 1195 <**> <: timer: :>,d.cor.corutimer,"nl",1,
4 1196 <**> <: priority: :>,d.cor.corupriority,"nl",1,
4 1197 <**> <: typeset: :>);
4 1198 <**> for i:= -11 step 1 until 0 do
4 1199 <**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
4 1200 <**> write(zud,"nl",1,<: testmask: :>);
4 1201 <**> for i:= -11 step 1 until 0 do
4 1202 <**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
4 1203 <*+99*>
4 1204 <**> skriv_activity(zud,cor_no);
4 1205 <*-99*>
4 1206 <**> end;
3 1207 <**> end skriv_coru;
2 1208 <*-98*>
2 1209 <*+98*>
2 1210 \f
2 1210 message procedure skriv_op side 1 - 810409/cl;
2 1211
2 1211 <**> procedure skriv_op(zud,opref);
2 1212 <**> value opref;
2 1213 <**> integer opref;
2 1214 <**> zone zud;
2 1215 <**> begin
3 1216 <**> integer array field op;
3 1217 <**> real array field raf;
3 1218 <**> integer lgd,i;
3 1219 <**> real t;
3 1220 <**>
3 1221 <**> raf:= data;
3 1222 <**> op:= opref;
3 1223 <**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
3 1224 <**> if opref<first_op ! optop<=opref then
3 1225 <**> begin
4 1226 <**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
4 1227 <**> goto slut_skriv_op;
4 1228 <**> end;
3 1229 <**>
3 1230 <**> lgd:= d.op.opsize;
3 1231 <**> write(zud,"nl",1,<<d>,
3 1232 <**> <: opsize :>,d.op.opsize,"nl",1,
3 1233 <**> <: optype :>);
3 1234 <**> for i:= -11 step 1 until 0 do
3 1235 <**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
3 1236 <**> write(zud,"nl",1,<<d>,
3 1237 <**> <: prev :>,d.op.prev,"nl",1,
3 1238 <**> <: next :>,d.op.next);
3 1239 <**> if lgd=0 then goto slut_skriv_op;
3 1240 <**> write(zud,"nl",1,<<d>,
3 1241 <**> <: kilde :>,d.op.kilde extract 10,"nl",1,
3 1242 <**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
3 1243 <**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
3 1244 d.op.retur,"nl",1,
3 1245 <**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
3 1246 <**> d.op.opkode extract 12,"nl",1,
3 1247 <**> <: resultat :>,d.op.resultat,"nl",2,
3 1248 <**> <:data::>);
3 1249 <**> skriv_hele(zud,d.op.raf,lgd-data,1278);
3 1250 <**>slut_skriv_op:
3 1251 <**> end skriv_op;
2 1252 <*-98*>
2 1253 \f
2 1253 message procedure corutable side 1 - 810406/cl;
2 1254
2 1254 procedure corutable(zud);
2 1255 zone zud;
2 1256 begin
3 1257 integer i;
3 1258 integer array field cor;
3 1259
3 1259 write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
3 1260 <:no id ref chain timerch opchain timer pr:>,
3 1261 <: typeset testmask:>,"nl",2);
3 1262 for i:= 1 step 1 until maxcoru do
3 1263 begin
4 1264 cor:= coroutine(i);
4 1265 write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
4 1266 d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
4 1267 d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
4 1268 d.cor.corutimer,<< dd>,d.cor.corupriority);
4 1269 outchar(zud,'sp');
4 1270 outboolbits(zud,d.cor.corutypeset);
4 1271 outchar(zud,'sp');
4 1272 outboolbits(zud,d.cor.corutestmask);
4 1273 outchar(zud,'nl');
4 1274 end;
3 1275 end;
2 1276 \f
2 1276 message filglobal side 1 - 790302/jg;
2 1277
2 1277 integer
2 1278 dbantsf,dbkatsfri,
2 1279 dbantb,dbkatbfri,
2 1280 dbantef,dbkatefri,
2 1281 dbsidstesz,dbsidstetz,
2 1282 dbsegmax,
2 1283 filskrevet,fillæst;
2 1284 integer
2 1285 bs_kats_fri, bs_kate_fri,
2 1286 cs_opret_fil, cs_tilknyt_fil,
2 1287 cs_frigiv_fil, cs_slet_fil,
2 1288 cs_opret_spoolfil, cs_opret_eksternfil;
2 1289 integer array
2 1290 dbkatt(1:dbmaxtf,1:2),
2 1291 dbkats(1:dbmaxsf,1:2),
2 1292 dbkate(1:dbmaxef,1:6),
2 1293 dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
2 1294 boolean array
2 1295 dbkatb(1:dbmaxb);
2 1296 zone array
2 1297 fil(dbantez+dbantsz+dbanttz,128,1,stderror);
2 1298 \f
2 1298 message hentfildim side 1 - 781120/jg;
2 1299
2 1299
2 1299 integer procedure hentfildim(fdim);
2 1300 integer array fdim;
2 1301 <*inddata filref i fdim(4),uddata fdim(1:8)*>
2 1302
2 1302 begin integer ftype,fno,katf,i,s;
3 1303 ftype:=fdim(4) shift (-10);
3 1304 fno:=fdim(4) extract 10;
3 1305 if ftype>3 or ftype=0 or fno=0 then
3 1306 begin s:=1; goto udgang; end;
3 1307 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
3 1308 begin s:=1; goto udgang end; <*paramfejl*>
3 1309 katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
3 1310 if katf extract 9 = 0 then
3 1311 begin s:=2; goto udgang end; <*tom indgang*>
3 1312
3 1312 fdim(1):=katf shift (-9); <*post antal*>
3 1313 fdim(2):=katf extract 9; <*post længde*>
3 1314 fdim(3):=case ftype of( <*seg antal*>
3 1315 dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
3 1316 extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
3 1317 dbkate(fno,2) extract 18);
3 1318 for i:=5 step 1 until 8 do <*externt filnavn*>
3 1319 fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
3 1320 s:=0;
3 1321 udgang:
3 1322 hentfildim:=s;
3 1323 <*+2*>
3 1324 <*tz*> if testbit24 and overvåget then <*zt*>
3 1325 <*tz*> begin <*zt*>
4 1326 <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
4 1327 <*tz*> pfdim(fdim); <*zt*>
4 1328 <*tz*> ud; <*zt*>
4 1329 <*tz*> end; <*zt*>
3 1330 <*-2*>
3 1331 end hentfildim;
2 1332 \f
2 1332 message sætfildim side 1 - 780916/jg;
2 1333
2 1333 integer procedure sætfildim(fdim);
2 1334 integer array fdim;
2 1335 <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
2 1336
2 1336 begin
3 1337 integer ftype,fno,katf,s,pl;
3 1338 integer array gdim(1:8);
3 1339 gdim(4):=fdim(4);
3 1340 s:=hentfildim(gdim);
3 1341 if s>0 then
3 1342 goto udgang;
3 1343 fno:=fdim(4) extract 10;
3 1344 ftype:=fdim(4) shift (-10);
3 1345 pl:= fdim(2) extract 12;
3 1346 if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
3 1347 begin
4 1348 s:=1; <*parameter fejl*>
4 1349 goto udgang
4 1350 end;
3 1351 if fdim(1)>256//pl*fdim(3) then
3 1352 begin
4 1353 s:=1;
4 1354 goto udgang;
4 1355 end;
3 1356
3 1356 <*segant*>
3 1357 if ftype=3 then
3 1358 begin integer segant;
4 1359 segant:= fdim(3);
4 1360 if segant > dbsegmax then
4 1361 begin
5 1362 s:=4; <*ingen plads*>
5 1363 goto udgang
5 1364 end;
4 1365 \f
4 1365 message sætfildim side 2 - 780916/jg;
4 1366
4 1366
4 1366 if segant<>gdim(3) then
4 1367 begin integer i,z,s; array field enavn; integer array tail(1:10);
5 1368 z:=dbkate(fno,2) shift (-19); if z>0 then begin
6 1369 if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
6 1370 begin integer array zd(1:20);
7 1371 getzone6(fil(z),zd);
7 1372 if zd(13)>5 and zd(9)>=segant then
7 1373 begin <*dødt segment skal ikke udskrives*>
8 1374 zd(13):=5;
8 1375 setzone6(fil(z),zd)
8 1376 end
7 1377 end end;
5 1378 \f
5 1378 message sætfildim side 3 - 801031/jg;
5 1379
5 1379
5 1379 enavn:=8; <*ændr fil størrelse*>
5 1380 i:=1;
5 1381 open(zdummy,0,string gdim.enavn(increase(i)),0);
5 1382 s:=monitor(42,zdummy,0,tail); <*lookup*>
5 1383 if s>0 then
5 1384 fejlreaktion(1,s,<:lookup entry:>,0);
5 1385 tail(1):=segant;
5 1386 s:=monitor(44,zdummy,0,tail); <*change entry*>
5 1387 close(zdummy,false);
5 1388 if s<>0 then
5 1389 begin
6 1390 if s=6 then
6 1391 begin <*ingen plads*>
7 1392 s:=4; goto udgang
7 1393 end
6 1394 else fejlreaktion(1,s,<:change entry:>,0);
6 1395 end;
5 1396 dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
5 1397 add segant;
5 1398 \f
5 1398 message sætfildim side 4 - 801013/jg;
5 1399
5 1399
5 1399 end;
4 1400 fdim(3):=segant
4 1401 end
3 1402 else
3 1403 if fdim(3)>gdim(3) then
3 1404 begin
4 1405 s:=4; <*altid ingen plads*>
4 1406 goto udgang
4 1407 end
3 1408 else fdim(3):=gdim(3); <*samme længde*>
3 1409 <*postantal,postlængde*>
3 1410 katf:=fdim(1) shift 9 add pl;
3 1411 case ftype of begin
4 1412 dbkatt(fno,1):=katf;
4 1413 dbkats(fno,1):=katf;
4 1414 dbkate(fno,1):=katf end;
3 1415 udgang:
3 1416 sætfildim:=s;
3 1417 <*+2*>
3 1418 <*tz*> if testbit24 and overvåget then <*zt*>
3 1419 <*tz*> begin integer i; <*zt*>
4 1420 <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
4 1421 <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
4 1422 <*tz*> pfdim(gdim); <*zt*>
4 1423 <*tz*> ud; <*zt*>
4 1424 <*tz*> end; <*zt*>
3 1425 <*-2*>
3 1426 end sætfildim;
2 1427 \f
2 1427 message findfilenavn side 1 - 780916/jg;
2 1428
2 1428 integer procedure findfilenavn(navn);
2 1429 real array navn;
2 1430
2 1430 begin
3 1431 integer fno; array field enavn;
3 1432 for fno:=1 step 1 until dbmaxef do
3 1433 if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
3 1434 begin
4 1435 enavn:=fno*12+4;
4 1436 if navn(1)=dbkate.enavn(1) and
4 1437 navn(2)=dbkate.enavn(2) then
4 1438 begin
5 1439 findfilenavn:=fno;
5 1440 goto udgang
5 1441 end
4 1442 end;
3 1443 findfilenavn:=0;
3 1444 udgang:
3 1445 end findfilenavn;
2 1446 \f
2 1446 message læsfil side 1 - 781120/jg;
2 1447
2 1447 integer procedure læsfil(filref,postindex,zoneno);
2 1448 value filref,postindex;
2 1449 integer filref,postindex,zoneno;
2 1450 <*+2*>
2 1451 <*tz*> begin integer i,o,s; <*zt*>
3 1452 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1453 <*-2*>
3 1454
3 1454 læsfil:=tilgangfil(filref,postindex,zoneno,5);
3 1455
3 1455 <*+2*>
3 1456 <*tz*> if testbit24 and overvåget then <*zt*>
3 1457 <*tz*> begin <*zt*>
4 1458 <*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*>
4 1459 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1460 <*tz*> end; <*zt*>
3 1461 <*tz*> end procedure; <*zt*>
2 1462 <*-2*>
2 1463 \f
2 1463 message skrivfil side 1 - 781120/jg;
2 1464
2 1464 integer procedure skrivfil(filref,postindex,zoneno);
2 1465 value filref,postindex;
2 1466 integer filref,postindex,zoneno;
2 1467 <*+2*>
2 1468 <*tz*> begin integer i,o,s; <*zt*>
3 1469 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1470 <*-2*>
3 1471
3 1471 skrivfil:=tilgangfil(filref,postindex,zoneno,6);
3 1472
3 1472 <*+2*>
3 1473 <*tz*> if testbit24 and overvåget then <*zt*>
3 1474 <*tz*> begin <*zt*>
4 1475 <*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
4 1476 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1477 <*tz*> end; <*zt*>
3 1478 <*tz*> end procedure; <*zt*>
2 1479 <*-2*>
2 1480 \f
2 1480 message modiffil side 1 - 781120/jg;
2 1481
2 1481 integer procedure modiffil(filref,postindex,zoneno);
2 1482 value filref,postindex;
2 1483 integer filref,postindex,zoneno;
2 1484 <*+2*>
2 1485 <*tz*> begin integer i,o,s; <*zt*>
3 1486 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1487 <*-2*>
3 1488
3 1488 modiffil:=tilgangfil(filref,postindex,zoneno,7);
3 1489
3 1489 <*+2*>
3 1490 <*tz*> if testbit24 and overvåget then <*zt*>
3 1491 <*tz*> begin <*zt*>
4 1492 <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
4 1493 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1494 <*tz*> end; <*zt*>
3 1495 <*tz*> end procedure; <*zt*>
2 1496 <*-2*>
2 1497 \f
2 1497 message tilgangfil side 1 - 781003/jg;
2 1498
2 1498 integer procedure tilgangfil(filref,postindex,zoneno,operation);
2 1499 value filref,postindex,operation;
2 1500 integer filref,postindex,zoneno,operation;
2 1501 <*proceduren kaldes fra læsfil,skrivfil og modiffil*>
2 1502
2 1502 begin
3 1503 integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
3 1504 integer array zd(1:20),fdim(1:8);
3 1505
3 1505
3 1505
3 1505 <*hent katalog*>
3 1506
3 1506 fdim(4):=filref;
3 1507 st:=hentfildim(fdim);
3 1508 if st<>0 then
3 1509 goto udgang; <*parameter fejl eller fil findes ikke*>
3 1510 fno:=filref extract 10;
3 1511 ftype:=filref shift (-10);
3 1512 pl:=fdim(2);
3 1513 katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
3 1514 \f
3 1514 message tilgangfil side 2 - 781003/jg;
3 1515
3 1515
3 1515
3 1515 <*find segment adr og check postindex*>
3 1516
3 1516 pps:=256//pl; <*poster pr segment*>
3 1517 seg:=(postindex-1)//pps; <*relativt segment*>
3 1518 pr:=(postindex-1) mod pps; <*post relativ til seg*>
3 1519 if postindex <1 then
3 1520 begin <*parameter fejl*>
4 1521 st:=1;
4 1522 goto udgang
4 1523 end;
3 1524 if seg>=fdim(3) then
3 1525 begin <*post findes ikke*>
4 1526 st:=3;
4 1527 goto udgang
4 1528 end;
3 1529 case ftype of
3 1530 begin <*find absolut segment*>
4 1531
4 1531 <*tabelfil*>
4 1532 seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
4 1533
4 1533 begin <*spoolfil*>
5 1534 integer i,bidno;
5 1535 bidno:=katf extract 12;
5 1536 for i:=seg//dbbidlængde step -1 until 1 do
5 1537 bidno:=dbkatb(bidno) extract 12;
5 1538 seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
5 1539 end;
4 1540
4 1540 <*extern fil,seg ok*>
4 1541
4 1541 end case find abs seg;
3 1542 \f
3 1542 message tilgangfil side 3 - 801030/jg;
3 1543
3 1543 <*alloker zone*>
3 1544
3 1544 zno:=katf shift(-19);
3 1545 case ftype of begin
4 1546
4 1546 begin <*tabelfil*>
5 1547 integer førstetz;
5 1548 førstetz:=dbkatz(dbsidstetz,2);
5 1549 if zno=0 then
5 1550 zno:=førstetz
5 1551 else if dbkatz(zno,1)<>filref then
5 1552 zno:=førstetz
5 1553 else if zno <> førstetz and zno <> dbsidstetz then
5 1554 begin integer z;
6 1555 for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
6 1556 dbkatz(z,2):=dbkatz(zno,2);
6 1557 dbkatz(zno,2):=førstetz;
6 1558 dbkatz(dbsidstetz,2):=zno;
6 1559 end;
5 1560 dbsidstetz:=zno
5 1561 end;
4 1562 \f
4 1562 message tilgangfil side 4 - 801030/jg;
4 1563
4 1563
4 1563 begin <*spoolfil*>
5 1564 integer p,zslut,z;
5 1565 if zno>0 then begin if dbkatz(zno,1) =filref then
6 1566 goto udgangs end; <*strategi 1*>
5 1567 p:=0;
5 1568 zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
5 1569 zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
5 1570 for z:=dbantez+dbantsz step -1 until zslut do
5 1571 begin integer zfref;
6 1572 zfref:=dbkatz(z,1);
6 1573 if zfref extract 10=0 then <*fri zone*>
6 1574 begin <*strategi 2*>
7 1575 zno:=z;
7 1576 goto udgangs
7 1577 end
6 1578 else
6 1579 if zfref shift (-10)=2 then
6 1580 begin <*zone tilknyttet spoolfil*>
7 1581 integer q;
7 1582 q:=dbkatz(z,2); <*prioritet*>
7 1583 if q>p then
7 1584 begin <*strategi 3*>
8 1585 p:=q;
8 1586 zno:=z
8 1587 end
7 1588 end;
6 1589 end z;
5 1590 udgangs:
5 1591 if zno> dbantez then dbsidstesz:=zno;
5 1592 end;
4 1593 \f
4 1593 message tilgangfil side 5 - 780916/jg;
4 1594
4 1594 begin <*extern fil*>
5 1595 integer z;
5 1596 if zno=0 then
5 1597 zno:=1
5 1598 else if dbkatz(zno,1) = filref then
5 1599 goto udgange; <*strategi 1*>
5 1600 for z:=1 step 1 until dbantez do
5 1601 begin integer zfref;
6 1602 zfref:=dbkatz(z,1);
6 1603 if zfref=0 then <*zone fri*>
6 1604 begin zno:=z; goto udgange end <*strategi 2*>
6 1605 else if zfref shift (-10) =2 then <*spoolfil*>
6 1606 zno:=z; <*strategi 3*> <*else strategi 4-5*>
6 1607 end z;
5 1608 udgange:
5 1609 end
4 1610 end case alloker zone;
3 1611
3 1611
3 1611
3 1611 <*åbn zone*>
3 1612
3 1612 if zno<=dbantez then
3 1613 begin <*extern zone;spool og tabel zoner altid åbne*>
4 1614 integer zfref;
4 1615 zfref:=dbkatz(zno,1);
4 1616 if zfref<>0 and zfref<>filref and ftype=3 then
4 1617 begin <*luk hvis ny extern fil*>
5 1618 getzone6(fil(zno),zd);
5 1619 if zd(13)>5 then filskrevet:=filskrevet+1;
5 1620 zfref:=0;
5 1621 close(fil(zno),false);
5 1622 end;
4 1623 if zfref=0 then
4 1624 begin <*åbn zone*>
5 1625 array field enavn; integer i;
5 1626 enavn:=4*2; i:=1;
5 1627 open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
5 1628 string fdim.enavn(increase(i))),0)
5 1629 end
4 1630 end;
3 1631 \f
3 1631 message tilgangfil side 6 - 780916/jg;
3 1632
3 1632
3 1632
3 1632 <*hent segment og sæt zone descriptor*>
3 1633
3 1633 getzone6(fil(zno),zd);
3 1634 zstate:=zd(13);
3 1635 if zstate=0 or zd(9)<>seg then
3 1636 begin <*positioner*>
4 1637 if zstate>5 then
4 1638 filskrevet:=filskrevet+1;
4 1639 setposition(fil(zno),0,seg);
4 1640 if -,(operation=6 and pr=0) then
4 1641 begin <*læs seg medmindre op er skriv første post*>
5 1642 inrec6(fil(zno),512);
5 1643 fillæst:=fillæst+1
5 1644 end;
4 1645 zstate:=operation
4 1646 end
3 1647 else <*zstate:=max(operation,zone state)*>
3 1648 if operation>zstate then
3 1649 zstate:=operation;
3 1650 zd(9):=seg;
3 1651 zd(13):=zstate;
3 1652 zd(16):=pl shift 1;
3 1653 zd(14):=zd(19)+pr*zd(16);
3 1654 setzone6(fil(zno),zd);
3 1655 \f
3 1655 message tilgangfil side 7 - 780916/jg;
3 1656
3 1656
3 1656
3 1656 <*opdater kataloger*>
3 1657
3 1657 katf:=zno shift 19 add (katf extract 19);
3 1658 case ftype of
3 1659 begin
4 1660 dbkatt(fno,2):=katf;
4 1661 dbkats(fno,2):=katf;
4 1662 dbkate(fno,2):=katf
4 1663 end;
3 1664 dbkatz(zno,1):= filref;
3 1665 if ftype=3 then dbkatz(zno,2):=0 else
3 1666 <*if ftype=1 then allerede opd under zoneallokering*>
3 1667 if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
3 1668 if zstate=5 then (if pr=pps-1 then 2 else 1)
3 1669 else if zstate=6 and pr=pps-1 then 3 else 0;
3 1670
3 1670
3 1670
3 1670 <*udgang*>
3 1671
3 1671 udgang:
3 1672 if st=0 then
3 1673 zoneno:=zno
3 1674 else zoneno:=0; <*fejl*>
3 1675 tilgangfil:=st;
3 1676 end tilgangfil;
2 1677 \f
2 1677
2 1677 message pfilsystem side 1 - 781003/jg;
2 1678
2 1678 procedure pfilparm(z);
2 1679 zone z;
2 1680 write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
2 1681 dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
2 1682 <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
2 1683 dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
2 1684
2 1684 procedure pfilglobal(z);
2 1685 zone z;
2 1686 write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
2 1687 <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
2 1688 <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
2 1689 <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
2 1690 <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
2 1691 <:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
2 1692
2 1692
2 1692 procedure pdbkate(z,i);
2 1693 value i; integer i;
2 1694 zone z;
2 1695 begin integer j; array field navn;
3 1696 navn:=i*12+4; j:=1;
3 1697 write(z,<:<10>dbkate(:>,i,<:)=:>,
3 1698 dbkate(i,1) shift (-9),
3 1699 dbkate(i,1) extract 9,
3 1700 dbkate(i,2) shift (-19),
3 1701 dbkate(i,2) shift (-18) extract 1,
3 1702 dbkate(i,2) extract 18,
3 1703 <: :>,string dbkate.navn(increase(j)));
3 1704 end;
2 1705 \f
2 1705 message pfilsystem side 2 - 781003/jg;
2 1706
2 1706
2 1706
2 1706 procedure pdbkats(z,i);
2 1707 value i; integer i;
2 1708 zone z;
2 1709 write(z,<:<10>dbkats(:>,i,<:)=:>,
2 1710 dbkats(i,1) shift (-9),
2 1711 dbkats(i,1) extract 9,
2 1712 dbkats(i,2) shift (-19),
2 1713 dbkats(i,2) shift (-18) extract 1,
2 1714 dbkats(i,2) shift (-12) extract 6,
2 1715 dbkats(i,2) extract 12);
2 1716
2 1716 procedure pdbkatb(z,i);
2 1717 value i;integer i;
2 1718 zone z;
2 1719 write(z,<:<10>dbkatb(:>,i,<:)=:>,
2 1720 dbkatb(i) extract 12);
2 1721
2 1721 procedure pdbkatt(z,i);
2 1722 value i; integer i;
2 1723 zone z;
2 1724 write(z,<:<10>dbkatt(:>,i,<:)=:>,
2 1725 dbkatt(i,1) shift (-9),
2 1726 dbkatt(i,1) extract 9,
2 1727 dbkatt(i,2) shift (-19),
2 1728 dbkatt(i,2) shift (-18) extract 1,
2 1729 dbkatt(i,2) extract 18);
2 1730
2 1730 procedure pdbkatz(z,i);
2 1731 value i; integer i;
2 1732 zone z;
2 1733 write(z,<:<10>dbkatz(:>,i,<:)=:>,
2 1734 dbkatz(i,1),dbkatz(i,2));
2 1735 \f
2 1735 message pfilsystem side 3 - 781003/jg;
2 1736
2 1736
2 1736
2 1736 procedure pfil(z,i);
2 1737 value i; integer i;
2 1738 zone z;
2 1739 begin integer j,k; array field navn; integer array zd(1:20);
3 1740 navn:=2; k:=1;
3 1741 getzone6(fil(i),zd);
3 1742 write(z,<:<10>fil(:>,i,<:)=:>,
3 1743 zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
3 1744 string zd.navn(increase(k)));
3 1745 for j:=6 step 1 until 10 do write(z,zd(j));
3 1746 write(z,<:<10>:>);
3 1747 for j:=11 step 1 until 20 do write(z,zd(j));
3 1748 end;
2 1749
2 1749 procedure pfilsystem(z);
2 1750 zone z;
2 1751 begin integer i;
3 1752
3 1752 write(z,<:<12>udskrift af variable i filsystem:>);
3 1753 write(z,<:<10><10>filparm::>);
3 1754 pfilparm(z);
3 1755 write(z,<:<10><10>filglobal::>);
3 1756 pfilglobal(z);
3 1757 write(z,<:<10><10>fil: zone descriptor:>);
3 1758 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
3 1759 write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
3 1760 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
3 1761 write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
3 1762 for i :=1 step 1 until dbmaxef do pdbkate(z,i);
3 1763 write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
3 1764 for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
3 1765 write(z,<:<10><10>dbkatb: katbref:>);
3 1766 for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
3 1767 write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
3 1768 for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
3 1769 end pfilsystem;
2 1770 \f
2 1770 message pfilsystem side 4 - 781003/jg;
2 1771
2 1771
2 1771
2 1771 procedure pfdim(fdim);
2 1772 integer array fdim;
2 1773 begin
3 1774 integer i;
3 1775 array field navn;
3 1776 i:=1;navn:=8;
3 1777 write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
3 1778 string fdim.navn(increase(i)));
3 1779 end pfdim;
2 1780 \f
2 1780 message opretfil side 0 - 810529/cl;
2 1781
2 1781 procedure opretfil;
2 1782 <* checker parametre og vidresender operation
2 1783 til opret_spoolfil eller opret_eksternfil *>
2 1784
2 1784 begin
3 1785 integer array field op;
3 1786 integer status,pant,pl,segant,p_nøgle,fno,ftype;
3 1787
3 1787 procedure skriv_opret_fil(z,omfang);
3 1788 value omfang;
3 1789 zone z;
3 1790 integer omfang;
3 1791 begin
4 1792 write(z,"nl",1,<:+++ opret fil :>);
4 1793 if omfang > 0 then
4 1794 disable
4 1795 begin
5 1796 skriv_coru(z,abs curr_coruno);
5 1797 write(z,"nl",1,<<d>,
5 1798 <:op :>,op,"nl",1,
5 1799 <:status :>,status,"nl",1,
5 1800 <:pant :>,pant,"nl",1,
5 1801 <:pl :>,pl,"nl",1,
5 1802 <:segant :>,segant,"nl",1,
5 1803 <:p-nøgle:>,p_nøgle,"nl",1,
5 1804 <:fno :>,fno,"nl",1,
5 1805 <:ftype :>,ftype,"nl",1,
5 1806 <::>);
5 1807 end;
4 1808 end skriv_opret_fil;
3 1809 \f
3 1809 message opretfil side 1 - 810526/cl;
3 1810
3 1810 trap(opretfil_trap);
3 1811 <*+2*>
3 1812 <**> disable if testbit28 then
3 1813 <**> skriv_opret_fil(out,0);
3 1814 <*-2*>
3 1815
3 1815 stack_claim(if cm_test then 200 else 150);
3 1816
3 1816 <*+2*>
3 1817 <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
3 1818 <*-2*>
3 1819
3 1819 trin1:
3 1820 waitch(cs_opret_fil,op,true,-1);
3 1821
3 1821 trin2: <* check parametre *>
3 1822 disable begin
4 1823
4 1823 ftype:= d.op.data(4) shift (-10);
4 1824 fno:= d.op.data(4) extract 10;
4 1825 if ftype<2 or ftype>3 or fno<>0 then
4 1826 begin
5 1827 status:= 1; <*parameterfejl*>
5 1828 goto returner;
5 1829 end;
4 1830
4 1830 pant:= d.op.data(1);
4 1831 pl:= d.op.data(2);
4 1832 segant:= d.op.data(3);
4 1833 p_nøgle:= d.op.opkode shift (-12);
4 1834 if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
4 1835 or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
4 1836 status:= 1 <*parameterfejl *>
4 1837 else
4 1838 if pant>256//pl*segant then status:= 1 else
4 1839 if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
4 1840 status:= 4 <*ingen plads*>
4 1841 else
4 1842 status:=0;
4 1843 \f
4 1843 message opretfil side 2 - 810526/cl;
4 1844
4 1844
4 1844 returner:
4 1845
4 1845 d.op.data(9):= status;
4 1846
4 1846 <*+2*>
4 1847 <*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
4 1848 <*tz*> begin <*zt*>
5 1849 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 1850 <*tz*> pfdim(d.op.data); <*zt*>
5 1851 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1852 <*tz*> end; <*zt*>
4 1853 <*-2*>
4 1854
4 1854 <*returner eller vidresend operation*>
4 1855 signalch(if status>0 then d.op.retur else
4 1856 case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
4 1857 op,d.op.optype);
4 1858 end;
3 1859 goto trin1;
3 1860 opretfil_trap:
3 1861 disable skriv_opret_fil(zbillede,1);
3 1862
3 1862 end opretfil;
2 1863 \f
2 1863 message tilknytfil side 0 - 810526/cl;
2 1864
2 1864 procedure tilknytfil;
2 1865 <* tilknytter ekstern fil og returnerer intern filid *>
2 1866
2 1866 begin
3 1867 integer array field op;
3 1868 integer status,i,fno,segant,pa,pl,sliceant,s;
3 1869 array field enavn;
3 1870 integer array tail(1:10);
3 1871
3 1871 procedure skriv_tilknyt_fil(z,omfang);
3 1872 value omfang;
3 1873 zone z;
3 1874 integer omfang;
3 1875 begin
4 1876 write(z,"nl",1,<:+++ tilknyt fil :>);
4 1877 if omfang > 0 then
4 1878 disable
4 1879 begin real array field raf;
5 1880 skriv_coru(z,abs curr_coruno);
5 1881 write(z,"nl",1,<<d>,
5 1882 <:op :>,op,"nl",1,
5 1883 <:status :>,status,"nl",1,
5 1884 <:i :>,i,"nl",1,
5 1885 <:fno :>,fno,"nl",1,
5 1886 <:segant :>,segant,"nl",1,
5 1887 <:pa :>,pa,"nl",1,
5 1888 <:pl :>,pl,"nl",1,
5 1889 <:sliceant:>,sliceant,"nl",1,
5 1890 <:s :>,s,"nl",1,
5 1891 <::>);
5 1892 raf:= 0;
5 1893 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 1894 write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
5 1895 end;
4 1896 end skriv_tilknyt_fil;
3 1897 \f
3 1897 message tilknytfil side 1 - 810529/cl;
3 1898
3 1898 stack_claim(if cm_test then 200 else 150);
3 1899 trap(tilknytfil_trap);
3 1900
3 1900 <*+2*>
3 1901 <**> if testbit28 then
3 1902 <**> skriv_tilknyt_fil(out,0);
3 1903 <*-2*>
3 1904
3 1904 trin1:
3 1905 waitch(cs_tilknyt_fil,op,true,-1);
3 1906
3 1906 trin2:
3 1907 wait(bs_kate_fri);
3 1908
3 1908 trin3:
3 1909 disable begin
4 1910
4 1910 <* find ekstern rapportfil *>
4 1911 enavn:= 8;
4 1912 if find_fil_enavn(d.op.data.enavn)>0 then
4 1913 begin
5 1914 status:= 6; <* fil i brug *>
5 1915 goto returner;
5 1916 end;
4 1917 open(zdummy,0,d.op.data.enavn,0);
4 1918 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 1919 if s<>0 then
4 1920 begin
5 1921 if s=3 then status:= 2 <* fil findes ikke *>
5 1922 else if s=6 then status:= 1 <* parameterfejl, navn *>
5 1923 else fejlreaktion(1,s,<:lookup entry:>,0);
5 1924 goto returner;
5 1925 end;
4 1926 if tail(9)<>d.op.data(4) <* contentskey,subno *> then
4 1927 begin
5 1928 status:= 5; <* forkert indhold *> goto returner;
5 1929 end;
4 1930 segant:= tail(1);
4 1931 if segant>db_seg_max then
4 1932 segant:= db_seg_max;
4 1933 pa:= tail(10);
4 1934 pl:= tail(7) extract 12;
4 1935 if pl < 1 or pl > 256 then
4 1936 begin status:= 7; goto returner; end;
4 1937 \f
4 1937 message tilknytfil side 2 - 810529/cl;
4 1938 if pa>256//pl*segant then
4 1939 begin status:= 7; goto returner; end;
4 1940
4 1940 <* reserver *>
4 1941 s:= monitor(52)create area:(zdummy,0,ia);
4 1942 if s<>0 then
4 1943 begin
5 1944 if s=3 then status:= 2 <* fil findes ikke *>
5 1945 else if s=1 <* areaclaims exeeded *> then
5 1946 begin
6 1947 status:= 4;
6 1948 fejlreaktion(1,s,<:create area:>,1);
6 1949 end
5 1950 else fejlreaktion(1,s,<:create area:>,0);
5 1951 goto returner;
5 1952 end;
4 1953
4 1953 s:= monitor(8)reserve:(zdummy,0,ia);
4 1954 if s<>0 then
4 1955 begin
5 1956 if s<3 then status:= 6 <* i brug *>
5 1957 else fejlreaktion(1,s,<:reserve:>,0);
5 1958 monitor(64)remove area:(zdummy,0,ia);
5 1959 goto returner;
5 1960 end;
4 1961
4 1961 tail(7):= 1 shift 12 +pl; <* tilknyttet *>
4 1962 s:= monitor(44)change entry:(zdummy,0,tail);
4 1963 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 1964
4 1964 <* opdater katalog *>
4 1965 dbantef:= dbantef+1;
4 1966 fno:= dbkatefri;
4 1967 dbkatefri:= dbkate(fno,2);
4 1968 dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
4 1969 dbkate(fno,2):= segant;
4 1970 for i:= 5 step 1 until 8 do
4 1971 dbkate(fno,i-2):= d.op.data(i);
4 1972
4 1972 <* returparametre *>
4 1973 d.op.data(1):= pa;
4 1974 d.op.data(2):= pl;
4 1975 d.op.data(3):= segant;
4 1976 d.op.data(4):= 3 shift 10 +fno;
4 1977 status:= 0;
4 1978 \f
4 1978 message tilknytfil side 3 - 810526/cl;
4 1979
4 1979
4 1979 returner:
4 1980 close(zdummy,false);
4 1981 d.op.data(9):= status;
4 1982
4 1982
4 1982 <*+2*>
4 1983 <*tz*> if testbit24 and overvåget then <*zt*>
4 1984 <*tz*> begin <*zt*>
5 1985 <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
5 1986 <*tz*> pfdim(d.op.data); <*zt*>
5 1987 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1988 <*tz*> end; <*zt*>
4 1989 <*-2*>
4 1990
4 1990 signalch(d.op.retur,op,d.op.optype);
4 1991 if dbantef < dbmaxef then
4 1992 signalbin(bs_kate_fri);
4 1993 end;
3 1994 goto trin1;
3 1995 tilknytfil_trap:
3 1996 disable skriv_tilknyt_fil(zbillede,1);
3 1997 end tilknyt_fil;
2 1998 \f
2 1998 message frigivfil side 0 - 810529/cl;
2 1999
2 1999 procedure frigivfil;
2 2000 <* frigiver en tilknyttet ekstern fil *>
2 2001
2 2001 begin
3 2002 integer array field op;
3 2003 integer status,fref,ftype,fno,s,i,z;
3 2004 array field enavn;
3 2005 integer array tail(1:10);
3 2006
3 2006 procedure skriv_frigiv_fil(zud,omfang);
3 2007 value omfang;
3 2008 zone zud;
3 2009 integer omfang;
3 2010 begin
4 2011 write(zud,"nl",1,<:+++ frigiv fil :>);
4 2012 if omfang > 0 then
4 2013 disable
4 2014 begin real array field raf;
5 2015 skriv_coru(zud,abs curr_coruno);
5 2016 write(zud,"nl",1,<<d>,
5 2017 <:op :>,op,"nl",1,
5 2018 <:status:>,status,"nl",1,
5 2019 <:fref :>,fref,"nl",1,
5 2020 <:ftype :>,ftype,"nl",1,
5 2021 <:fno :>,fno,"nl",1,
5 2022 <:s :>,s,"nl",1,
5 2023 <:i :>,i,"nl",1,
5 2024 <:z :>,z,"nl",1,
5 2025 <::>);
5 2026 raf:= 0;
5 2027 write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
5 2028 end;
4 2029 end skriv_frigiv_fil;
3 2030 \f
3 2030 message frigivfil side 1 - 810526/cl;
3 2031
3 2031
3 2031 stack_claim(if cm_test then 200 else 150);
3 2032 trap(frigivfil_trap);
3 2033
3 2033 <*+2*>
3 2034 <**> disable if testbit28 then
3 2035 <**> skriv_frigiv_fil(out,0);
3 2036 <*-2*>
3 2037
3 2037 trin1:
3 2038 waitch(cs_frigiv_fil,op,true,-1);
3 2039
3 2039 trin2:
3 2040 disable begin
4 2041
4 2041 <* find fil *>
4 2042 fref:= d.op.data(4);
4 2043 ftype:= fref shift (-10);
4 2044 fno:= fref extract 10;
4 2045 if ftype=0 or ftype>3 or fno=0 then
4 2046 begin status:= 1; goto returner; end;
4 2047 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2048 begin status:= 1; goto returner; end;
4 2049 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2050 extract 9 = 0 then
4 2051 begin
5 2052 status:= 2; <* fil findes ikke *>
5 2053 goto returner;
5 2054 end;
4 2055 if ftype <> 3 then
4 2056 begin status:= 5; goto returner; end;
4 2057
4 2057 <* frigiv evt. tilknyttet zone og areaprocess *>
4 2058 z:= dbkate(fno,2) shift (-19);
4 2059 if z > 0 then
4 2060 begin
5 2061 if dbkatz(z,1)=fref then
5 2062 begin integer array zd(1:20);
6 2063 getzone6(fil(z),zd);
6 2064 if zd(13)>5 then filskrevet:= filskrevet +1;
6 2065 close(fil(z),true);
6 2066 dbkatz(z,1):= 0;
6 2067 end;
5 2068 end;
4 2069 \f
4 2069 message frigivfil side 2 - 810526/cl;
4 2070
4 2070 <* opdater tail *>
4 2071 enavn:= fno*12+4;
4 2072 open(zdummy,0,dbkate.enavn,0);
4 2073 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 2074 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
4 2075 tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
4 2076 tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
4 2077 s:= monitor(44)change entry:(zdummy,0,tail);
4 2078 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 2079 monitor(64)remove process:(zdummy,0,tail);
4 2080 close(zdummy,true);
4 2081
4 2081 <* frigiv indgang *>
4 2082 for i:= 1, 3 step 1 until 6 do
4 2083 dbkate(fno,1):= 0;
4 2084 dbkate(fno,2):= dbkatefri;
4 2085 dbkatefri:= fno;
4 2086 dbantef:= dbantef -1;
4 2087 signalbin(bs_kate_fri);
4 2088 d.op.data(4):= 0; <* filref null *>
4 2089 status:= 0;
4 2090
4 2090 returner:
4 2091 d.op.data(9):= status;
4 2092 <*+2*>
4 2093 <*tz*> if testbit24 and overvåget then <*zt*>
4 2094 <*tz*> begin <*zt*>
5 2095 <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
5 2096 <*tz*> pfdim(d.op.data); <*zt*>
5 2097 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2098 <*tz*> end; <*zt*>
4 2099 <*-2*>
4 2100
4 2100 signalch(d.op.retur,op,d.op.optype);
4 2101 end;
3 2102 goto trin1;
3 2103 frigiv_fil_trap:
3 2104 disable skriv_frigiv_fil(zbillede,1);
3 2105 end frigivfil;
2 2106 \f
2 2106 message sletfil side 0 - 810526/cl;
2 2107
2 2107 procedure sletfil;
2 2108 <* sletter en spool- eller ekstern fil *>
2 2109
2 2109 begin
3 2110 integer array field op;
3 2111 integer fref,fno,ftype,status;
3 2112
3 2112 procedure skriv_slet_fil(z,omfang);
3 2113 value omfang;
3 2114 zone z;
3 2115 integer omfang;
3 2116 begin
4 2117 write(z,"nl",1,<:+++ slet fil :>);
4 2118 if omfang > 0 then
4 2119 disable
4 2120 begin
5 2121 skriv_coru(z,abs curr_coruno);
5 2122 write(z,"nl",1,<<d>,
5 2123 <:op :>,op,"nl",1,
5 2124 <:fref :>,fref,"nl",1,
5 2125 <:fno :>,fno,"nl",1,
5 2126 <:ftype :>,ftype,"nl",1,
5 2127 <:status:>,status,"nl",1,
5 2128 <::>);
5 2129 end;
4 2130 end skriv_slet_fil;
3 2131 \f
3 2131 message sletfil side 1 - 810526/cl;
3 2132
3 2132 stack_claim(if cm_test then 200 else 150);
3 2133
3 2133 trap(sletfil_trap);
3 2134 <*+2*>
3 2135 <**> disable if testbit28 then
3 2136 <**> skriv_slet_fil(out,0);
3 2137 <*-2*>
3 2138
3 2138 trin1:
3 2139 waitch(cs_slet_fil,op,true,-1);
3 2140
3 2140 trin2:
3 2141 disable begin
4 2142
4 2142 <* find fil *>
4 2143 fref:= d.op.data(4);
4 2144 ftype:= fref shift (-10);
4 2145 fno:= fref extract 10;
4 2146 if ftype=0 or ftype>3 or fno=0 then
4 2147 begin status:= 1; goto returner; end;
4 2148 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2149 begin status:= 1; goto returner; end;
4 2150 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2151 extract 9 = 0 then
4 2152 begin
5 2153 status:= 2; <* fil findes ikke *>
5 2154 goto returner;
5 2155 end;
4 2156
4 2156
4 2156 <* slet spool- eller ekstern fil *>
4 2157 case ftype of
4 2158 begin
5 2159
5 2159 <* tabelfil - ingen aktion *>
5 2160 ;
5 2161 \f
5 2161 message sletfil side 2 - 810203/cl;
5 2162
5 2162 <* spoolfil *>
5 2163 begin
6 2164 integer z,bidno,bf,bidant,i;
6 2165
6 2165 <* hvis tilknyttet så frigiv *>
6 2166 z:= dbkats(fno,2) shift (-19);
6 2167 if z>0 then
6 2168 begin
7 2169 if dbkatz(z,1)=fref then
7 2170 begin integer array zd(1:20);
8 2171 dbkatz(z,1):= 2 shift 10;
8 2172 getzone6(fil(z),zd); <*annuler evt. udskrivning*>
8 2173 if zd(13)>5 then
8 2174 begin zd(13):= 0; setzone6(fil(z),zd); end;
8 2175 end;
7 2176 end;
6 2177
6 2177 <* frigiv bidder *>
6 2178 bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
6 2179 bidant:= dbkats(fno,2) shift (-12) extract 6;
6 2180 for i:= bidant -1 step -1 until 1 do
6 2181 bidno:= dbkatb(bidno) extract 12;
6 2182 dbkatb(bidno):= false add dbkatbfri;
6 2183 dbkatbfri:= bf;
6 2184 dbantb:= dbantb-bidant;
6 2185
6 2185 <* frigiv indgang *>
6 2186 dbkats(fno,1):= 0;
6 2187 dbkats(fno,2):= dbkatsfri;
6 2188 dbkatsfri:= fno;
6 2189 dbantsf:= dbantsf -1;
6 2190 signalbin(bs_kats_fri);
6 2191 end spoolfil;
5 2192 \f
5 2192 message sletfil side 3 - 810203/cl;
5 2193
5 2193 <* extern fil *>
5 2194 begin
6 2195 integer i,s,z;
6 2196 real array field enavn;
6 2197 integer array tail(1:10);
6 2198
6 2198 <* find head and tail *>
6 2199 enavn:= fno*12+4;
6 2200 open(zdummy,0,dbkate.enavn,0);
6 2201 s:= monitor(42)lookup entry:(zdummy,0,tail);
6 2202 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
6 2203
6 2203 <*frigiv evt. tilknyttet zone og areaprocess*>
6 2204 z:=dbkate(fno,2) shift (-19);
6 2205 if z>0 then
6 2206 begin
7 2207 if dbkatz(z,1)=fref then
7 2208 begin integer array zd(1:20);
8 2209 getzone6(fil(z),zd);
8 2210 if zd(13)>5 then <* udskrivning *>
8 2211 begin <*annuler*>
9 2212 zd(13):= 0;
9 2213 setzone6(fil(z),zd);
9 2214 end;
8 2215 close(fil(z),true);
8 2216 dbkatz(z,1):= 0;
8 2217 end;
7 2218 end;
6 2219
6 2219 <* fjern entry *>
6 2220 s:= monitor(48)remove entry:(zdummy,0,tail);
6 2221 if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
6 2222 close(zdummy,true);
6 2223
6 2223 <* frigiv indgang *>
6 2224 for i:=1, 3 step 1 until 6 do
6 2225 dbkate(fno,i):= 0;
6 2226 dbkate(fno,2):= dbkatefri;
6 2227 dbkatefri:= fno;
6 2228 dbantef:= dbantef -1;
6 2229 signalbin(bs_kate_fri);
6 2230 end eksternfil;
5 2231
5 2231 end ftype;
4 2232 \f
4 2232 message sletfil side 4 - 810526/cl;
4 2233
4 2233
4 2233 status:= 0;
4 2234 if ftype > 1 then
4 2235 d.op.data(4):= 0; <*filref null*>
4 2236
4 2236 returner:
4 2237 d.op.data(9):= status;
4 2238
4 2238 <*+2*>
4 2239 <*tz*> if testbit24 and overvåget then <*zt*>
4 2240 <*tz*> begin <*zt*>
5 2241 <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
5 2242 <*tz*> pfdim(d.op.data); <*zt*>
5 2243 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2244 <*tz*> end; <*zt*>
4 2245 <*-2*>
4 2246
4 2246 signalch(d.op.retur,op,d.op.optype);
4 2247 end;
3 2248 goto trin1;
3 2249 sletfil_trap:
3 2250 disable skriv_slet_fil(zbillede,1);
3 2251 end sletfil;
2 2252 \f
2 2252 message opretspoolfil side 0 - 810526/cl;
2 2253
2 2253 procedure opretspoolfil;
2 2254 <* opretter en spoolfil og returnerer intern filid *>
2 2255
2 2255 begin
3 2256 integer array field op;
3 2257 integer bidantal,fno,i,bs,bidstart;
3 2258
3 2258 procedure skriv_opret_spoolfil(z,omfang);
3 2259 value omfang;
3 2260 zone z;
3 2261 integer omfang;
3 2262 begin
4 2263 write(z,"nl",1,<:+++ opret spoolfil :>);
4 2264 if omfang > 0 then
4 2265 disable
4 2266 begin
5 2267 skriv_coru(z,abs curr_coruno);
5 2268 write(z,"nl",1,<<d>,
5 2269 <:op :>,op,"nl",1,
5 2270 <:bidantal:>,bidantal,"nl",1,
5 2271 <:fno :>,fno,"nl",1,
5 2272 <:i :>,i,"nl",1,
5 2273 <:bs :>,bs,"nl",1,
5 2274 <:bidstart:>,bidstart,"nl",1,
5 2275 <::>);
5 2276 end;
4 2277 end skriv_opret_spoolfil;
3 2278 \f
3 2278 message opretspoolfil side 1 - 810526/cl;
3 2279
3 2279 stack_claim(if cm_test then 200 else 150);
3 2280
3 2280 signalbin(bs_kats_fri); <*initialiseres til åben*>
3 2281
3 2281 trap(opretspool_trap);
3 2282 <*+2*>
3 2283 <**> disable if testbit28 then
3 2284 <**> skriv_opret_spoolfil(out,0);
3 2285 <*-2*>
3 2286 trin1:
3 2287 waitch(cs_opret_spoolfil,op,true,-1);
3 2288
3 2288 trin2:
3 2289 bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
3 2290 wait(bs_kats_fri);
3 2291
3 2291 trin3:
3 2292 if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
3 2293 begin
4 2294 wait(bs_kats_fri);
4 2295 goto trin3;
4 2296 end;
3 2297 disable begin
4 2298
4 2298 <*alloker bidder*>
4 2299 bs:= bidstart:= dbkatbfri;
4 2300 for i:= bidantal-1 step -1 until 1 do
4 2301 bs:= dbkatb(bs) extract 12;
4 2302 dbkatbfri:= dbkatb(bs) extract 12;
4 2303 dbkatb(bs):= false; <*sidste ref null*>
4 2304 dbantb:= dbantb+bidantal;
4 2305
4 2305 <*alloker indgang*>
4 2306 fno:= dbkatsfri;
4 2307 dbkatsfri:= dbkats(fno,2);
4 2308 dbantsf:= dbantsf +1;
4 2309 dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
4 2310 d.op.data(2) extract 9; <*postlængde*>
4 2311 dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
4 2312 \f
4 2312 message opretspoolfil side 2 - 810526/cl;
4 2313
4 2313 <*returner*>
4 2314 d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
4 2315 d.op.data(4):= 2 shift 10 add fno; <*filref*>
4 2316 for i:= 5 step 1 until 8 do <*filnavn null*>
4 2317 d.op.data(i):= 0;
4 2318 d.op.data(9):= 0; <*status ok*>
4 2319
4 2319 <*+2*>
4 2320 <*tz*> if testbit24 and overvåget then <*zt*>
4 2321 <*tz*> begin <*zt*>
5 2322 <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
5 2323 <*tz*> pfdim(d.op.data); <*zt*>
5 2324 <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
5 2325 <*tz*> end; <*zt*>
4 2326 <*-2*>
4 2327
4 2327 signalch(d.op.retur,op,d.op.optype);
4 2328 if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
4 2329 end;
3 2330 goto trin1;
3 2331
3 2331 opretspool_trap:
3 2332 disable skriv_opret_spoolfil(zbillede,1);
3 2333
3 2333 end opretspoolfil;
2 2334 \f
2 2334 message opreteksternfil side 0 - 810526/cl;
2 2335
2 2335 procedure opreteksternfil;
2 2336 <* opretter og knytter en ekstern fil *>
2 2337
2 2337 begin
3 2338 integer array field op;
3 2339 integer status,s,i,fno,p_nøgle;
3 2340 integer array tail(1:10),zd(1:20);
3 2341 real r;
3 2342 real array field enavn;
3 2343
3 2343 procedure skriv_opret_ekstfil(z,omfang);
3 2344 value omfang;
3 2345 zone z;
3 2346 integer omfang;
3 2347 begin
4 2348 write(z,"nl",1,<:+++ opret ekstern fil :>);
4 2349 if omfang > 0 then
4 2350 disable
4 2351 begin real array field raf;
5 2352 skriv_coru(z,abs curr_coruno);
5 2353 write(z,"nl",1,<<d>,
5 2354 <:op :>,op,"nl",1,
5 2355 <:status :>,status,"nl",1,
5 2356 <:s :>,s,"nl",1,
5 2357 <:i :>,i,"nl",1,
5 2358 <:fno :>,fno,"nl",1,
5 2359 <:p-nøgle:>,p_nøgle,"nl",1,
5 2360 <::>);
5 2361 raf:= 0;
5 2362 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 2363 write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
5 2364 end;
4 2365 end skriv_opret_ekstfil;
3 2366 \f
3 2366 message opreteksternfil side 1 - 810526/cl;
3 2367
3 2367 stack_claim(if cm_test then 200 else 150);
3 2368
3 2368 signalbin(bs_kate_fri); <*initialiseres til åben*>
3 2369
3 2369 trap(opretekst_trap);
3 2370 <*+2*>
3 2371 <**> disable if testbit28 then
3 2372 <**> skriv_opret_ekstfil(out,0);
3 2373 <*-2*>
3 2374 trin1:
3 2375 waitch(cs_opret_eksternfil,op,true,-1);
3 2376
3 2376 trin2:
3 2377 wait(bs_kate_fri);
3 2378
3 2378 trin3:
3 2379 <*opret temporær fil og tilknyt den*>
3 2380 disable begin
4 2381
4 2381 enavn:= 8;
4 2382 <*opret*>
4 2383 open(zdummy,0,d.op.data.enavn,0);
4 2384 tail(1):= d.op.data(3); <*segant*>
4 2385 tail(2):= 1;
4 2386 tail(6):= systime(7,0,r); <*shortclock*>
4 2387 tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
4 2388 tail(8):= 0;
4 2389 tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
4 2390 tail(10):= d.op.data(1); <*postantal*>
4 2391 s:= monitor(40)create entry:(zdummy,0,tail);
4 2392 if s<>0 then
4 2393 begin
5 2394 if s=4 <*claims exeeded*> then
5 2395 begin
6 2396 status:= 4;
6 2397 fejlreaktion(1,s,<:create entry:>,1);
6 2398 goto returner;
6 2399 end;
5 2400 if s=3 <*navn ikke unikt*> then
5 2401 begin status:= 6; goto returner; end;
5 2402 fejlreaktion(1,s,<:create entry:>,0);
5 2403 end;
4 2404 \f
4 2404 message opreteksternfil side 2 - 810203/cl;
4 2405
4 2405 p_nøgle:= d.op.opkode shift (-12);
4 2406 s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
4 2407 if s<>0 then
4 2408 begin
5 2409 if s=6 then
5 2410 begin <*claims exeeded*>
6 2411 status:= 4;
6 2412 fejlreaktion(1,s,<:permanent entry:>,1);
6 2413 monitor(48)remove entry:(zdummy,0,tail);
6 2414 goto returner;
6 2415 end
5 2416 else fejlreaktion(1,s,<:permanent entry:>,0);
5 2417 end;
4 2418
4 2418 <*reserver*>
4 2419 s:= monitor(52)create areaprocess:(zdummy,0,zd);
4 2420 if s<>0 then
4 2421 begin
5 2422 fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
5 2423 status:= 4;
5 2424 monitor(48)remove entry:(zdummy,0,zd);
5 2425 goto returner;
5 2426 end;
4 2427
4 2427 s:= monitor(8)reserve:(zdummy,0,zd);
4 2428 if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
4 2429
4 2429 <*tilknyt*>
4 2430 dbantef:= dbantef +1;
4 2431 fno:= dbkatefri;
4 2432 dbkatefri:= dbkate(fno,2);
4 2433 dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
4 2434 dbkate(fno,2):= tail(1);
4 2435 getzone6(zdummy,zd);
4 2436 for i:= 2 step 1 until 5 do
4 2437 dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
4 2438 d.op.data(3):= tail(1);
4 2439 d.op.data(4):= 3 shift 10 +fno;
4 2440 status:= 0;
4 2441 \f
4 2441 message opreteksternfil side 3 - 810526/cl;
4 2442
4 2442 returner:
4 2443
4 2443 close(zdummy,false);
4 2444 d.op.data(9):= status;
4 2445
4 2445 <*+2*>
4 2446 <*tz*> if testbit24 and overvåget then <*zt*>
4 2447 <*tz*> begin <*zt*>
5 2448 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 2449 <*tz*> pfdim(d.op.data); <*zt*>
5 2450 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2451 <*tz*> end; <*zt*>
4 2452 <*-2*>
4 2453
4 2453 signalch(d.op.retur,op,d.op.optype);
4 2454 if dbantef<dbmaxef then signalbin(bs_kate_fri);
4 2455 end;
3 2456 goto trin1;
3 2457
3 2457 opretekst_trap:
3 2458 disable skriv_opret_ekstfil(zbillede,1);
3 2459
3 2459 end opreteksternfil;
2 2460
2 2460 \f
2 2460 message attention_erklæringer side 1 - 850820/cl;
2 2461
2 2461 integer
2 2462 tf_kommandotabel,
2 2463 cs_att_pulje,
2 2464 bs_fortsæt_adgang,
2 2465 att_proc_ref;
2 2466
2 2466 integer array
2 2467 att_flag,
2 2468 att_signal(1:att_maske_lgd//2);
2 2469
2 2469 integer array
2 2470 terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
2 2471 max_antal_operatører+max_antal_garageterminaler)),
2 2472 fortsæt(1:32);
2 2473 \f
2 2473 message procedure afslut_kommando side 1 - 810507/hko;
2 2474
2 2474 procedure afslut_kommando(op_ref);
2 2475 integer array field op_ref;
2 2476 begin integer nr,i,sem;
3 2477 i:= d.op_ref.kilde;
3 2478 nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
3 2479 else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
3 2480 sætbit_ia(att_flag,nr,0);
3 2481 d.op_ref.optype:=gen_optype;
3 2482 <* "husket" attention disabled ****************
3 2483 if sætbit_ia(att_signal,nr,0)=1 then
3 2484 begin
3 2485 sem:=if i=299 then cs_talevejsswitch else
3 2486 case i//100 of (cs_io_komm,cs_operatør(i mod 100),
3 2487 cs_garage(i mod 100));
3 2488 afslut_operation(op_ref,0);
3 2489 start_operation(op_ref,i,cs_att_pulje,0);
3 2490 signal_ch(sem,op_ref,gen_optype);
3 2491 end
3 2492 else
3 2493 ********************* disable "husket" attention *>
3 2494 afslut_operation(op_ref,cs_att_pulje);
3 2495 end;
2 2496 \f
2 2496 message procedure læs_store side 1 - 880919/cl;
2 2497
2 2497 integer procedure læs_store(z,c);
2 2498 zone z;
2 2499 integer c;
2 2500 begin
3 2501 læs_store:= readchar(z,c);
3 2502 if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
3 2503 end;
2 2504 \f
2 2504 message procedure param side 1 - 810226/cl;
2 2505
2 2505
2 2505
2 2505 integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
2 2506 value tabel_id;
2 2507 integer pos, tabel_id, type, sep;
2 2508 integer array txt, spec, værdi;
2 2509
2 2509
2 2509
2 2509 <*************************************>
2 2510 <* *>
2 2511 <* CLAUS LARSEN: 15.07.77 *>
2 2512 <* *>
2 2513 <*************************************>
2 2514
2 2514
2 2514
2 2514
2 2514 <* param syntax-analyserer en parameterliste, og *>
2 2515 <* bestemmer næste parameter og den separator der *>
2 2516 <* afslutter parameteren *>
2 2517
2 2517
2 2517
2 2517 begin
3 2518 integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
3 2519 real array indgang(1:2);
3 2520 integer i, j, tegn, tegn_pos, tal, hashnøgle,
3 2521 zone_nr, top, max_segm, start_segm, lpos;
3 2522 boolean minus, separator;
3 2523 lpos := pos;
3 2524 type:=-1;
3 2525 for i:=1 step 1 until 4 do værdi(i):=0;
3 2526 \f
3 2526 message procedure param side 2 - 810428/cl,hko;
3 2527
3 2527
3 2527
3 2527 <* grænsecheck for pos *>
3 2528 begin
4 2529 integer nedre, øvre;
4 2530
4 2530 nedre := system(3,øvre,txt);
4 2531 nedre := nedre * 3 - 2;
4 2532 øvre := øvre * 3;
4 2533 if lpos < (nedre - 1) or øvre < lpos then
4 2534 begin
5 2535 sep:= -1;
5 2536 param:= 5;
5 2537 goto slut;
5 2538 end;
4 2539
4 2539 <* er parameterlisten slut *>
4 2540 lpos:= lpos+1;
4 2541 læs_tegn(txt,lpos,tegn);
4 2542 if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
4 2543 begin
5 2544 lpos := lpos - 2;
5 2545 sep := tegn;
5 2546 param := 5;
5 2547
5 2547 goto slut;
5 2548 end else lpos:= lpos-1;
4 2549 end;
3 2550 \f
3 2550 message procedure param side 3 - 810428/cl;
3 2551
3 2551
3 2551 <* initialisering *>
3 2552 for i := 1 step 1 until 4 do
3 2553 aktuel_param(i) := 0;
3 2554 minus := separator := false;
3 2555
3 2555 <* initialiser klassetabel *>
3 2556 for i := 65 step 1 until 93,
3 2557 97 step 1 until 125 do klasse(i) := 1;
3 2558 for i := 48 step 1 until 57 do klasse(i) := 2;
3 2559 for i := 0 step 1 until 47, 58 step 1 until 64,
3 2560 94, 95, 96, 126, 127 do klasse(i) := 4;
3 2561
3 2561
3 2561 <* sæt specialtegn *>
3 2562 i := 1;
3 2563 læs_tegn(spec,i,tegn);
3 2564 while tegn <> 0 do
3 2565 begin
4 2566 if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
4 2567 klasse(tegn) := 3;
4 2568 læs_tegn(spec,i,tegn);
4 2569 end;
3 2570 \f
3 2570 message procedure param side 4 - 810226/cl;
3 2571
3 2571
3 2571 <* læs første tegn i ny parameter og bestem typen *>
3 2572 læs_tegn(txt,lpos,tegn);
3 2573
3 2573 case klasse(tegn) of
3 2574 begin
4 2575
4 2575 <* case 1 - bogstav *>
4 2576 begin
5 2577 type := 0;
5 2578 param := 0;
5 2579 tegn_pos := 1;
5 2580 hashnøgle := 0;
5 2581
5 2581 <* læs parameter *>
5 2582 while tegn_pos < 12 and klasse(tegn) <> 4 do
5 2583 begin
6 2584 hashnøgle := hashnøgle + tegn;
6 2585 skriv_tegn(aktuel_param,tegn_pos,tegn);
6 2586 læs_tegn(txt,lpos,tegn);
6 2587 end;
5 2588
5 2588 <* find separator *>
5 2589 while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
5 2590 sep := tegn;
5 2591 \f
5 2591 message procedure param side 5 - 810226/cl;
5 2592
5 2592 <* tabelopslag *>
5 2593 if tabel_id <> 0 then
5 2594 begin
6 2595 <* hent max_segm *>
6 2596
6 2596 fdim(4) := tabel_id;
6 2597 j := hent_fil_dim(fdim);
6 2598 if j > 0 then
6 2599 begin
7 2600 param := 4;
7 2601 for i := 1 step 1 until 4 do
7 2602 værdi(i) := aktuel_param(i);
7 2603 goto slut;
7 2604 end;
6 2605 max_segm := fdim(3);
6 2606
6 2606 <* forbered opslag *>
6 2607 start_segm := (hashnøgle mod max_segm) + 1;
6 2608 indgang(1) := 0.0 shift 48 add aktuel_param(1)
6 2609 shift 24 add aktuel_param(2);
6 2610 indgang(2) := 0.0 shift 48 add aktuel_param(3)
6 2611 shift 24 add aktuel_param(4);
6 2612 hashnøgle := start_segm;
6 2613 \f
6 2613 message procedure param side 6 - 810226/cl;
6 2614
6 2614 <* søg navn *>
6 2615 repeat
6 2616 <* læs segment *>
6 2617 læs_fil(tabel_id,hashnøgle,zone_nr);
6 2618
6 2618 <* beregn sidste element *>
6 2619 top := fil(zone_nr,1) extract 24;
6 2620 top := (top - 1) * 4 + 2;
6 2621
6 2621 <* søg *>
6 2622 for i := 2 step 4 until top do
6 2623 if fil(zone_nr,i) = indgang(1) and
6 2624 fil(zone_nr,i+1) = indgang(2) then
6 2625 begin
7 2626 <* fundet *>
7 2627 værdi(1) := fil(zone_nr,i+2) shift (-24)
7 2628 extract 24;
7 2629 værdi(2) := fil(zone_nr,i+2) extract 24;
7 2630 værdi(3) := fil(zone_nr,i+3) shift (-24)
7 2631 extract 24;
7 2632 værdi(4) := fil(zone_nr,i+3) extract 24;
7 2633 goto fundet;
7 2634 end;
6 2635
6 2635 if top = 122 then <*overløb *>
6 2636 hashnøgle := (hashnøgle mod max_segm) + 1;
6 2637 until top < 122 or hashnøgle = start_segm;
6 2638
6 2638 <* navn findes ikke *>
6 2639 param := 2;
6 2640 for j := 1 step 1 until 4 do
6 2641 værdi(j) := aktuel_param(j);
6 2642 fundet: ;
6 2643 end <*tabel_id <> 0 *>
5 2644 else
5 2645 for i := 1 step 1 until 4 do
5 2646 værdi(i) := aktuel_param(i);
5 2647 end <* case 1 *>;
4 2648 \f
4 2648 message procedure param side 7 - 810310/cl,hko;
4 2649
4 2649 <* case 2 - ciffer *>
4 2650 cif: begin
5 2651 type:=tal := 0;
5 2652 while klasse(tegn) = 2 do
5 2653 begin
6 2654 type:=type+1;
6 2655 tal := tal * 10 + (tegn - 48);
6 2656 læs_tegn(txt,lpos,tegn);
6 2657 end;
5 2658 if minus then tal := -tal;
5 2659 værdi(1) := tal;
5 2660 sep := tegn;
5 2661 param := 0;
5 2662 end <* case 2 *>;
4 2663 \f
4 2663 message procedure param side 8 - 810428/cl;
4 2664
4 2664 <* case 3 - specialtegn *>
4 2665 spc: begin
5 2666 if tegn = '-' then
5 2667 begin
6 2668 læs_tegn(txt,lpos,tegn);
6 2669 if klasse(tegn) = 2 then
6 2670 begin
7 2671 minus := true;
7 2672 goto cif;
7 2673 end
6 2674 else
6 2675 begin
7 2676 tegn := '-';
7 2677 lpos := lpos - 1;
7 2678 end;
6 2679 end;
5 2680 <* syntaxfejl *>
5 2681 param := if separator then 1 else 3;
5 2682 sep := tegn;
5 2683 end <* case 3 *>;
4 2684
4 2684 <* case 4 - separator *>
4 2685 begin
5 2686 separator := true;
5 2687 goto spc;
5 2688 end <* case 4 *>;
4 2689
4 2689 end <* case *>;
3 2690
3 2690 lpos := lpos - 1;
3 2691 slut:
3 2692 pos := lpos;
3 2693 end;
2 2694 \f
2 2694 message procedure læs_param_sæt side 1 - 830310/cl;
2 2695
2 2695 integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
2 2696 integer array tekst, parm;
2 2697 integer pos,ant, term,res;
2 2698
2 2698 <* proceduren læser et sammenhørende sæt parametre
2 2699 afsluttet med (sp),(nl),(;),(,) eller (nul)
2 2700
2 2700 læs_param_sæt returstatus eller 'typen' af det læste parametersæt
2 2701 (retur,int)
2 2702 type ant parm indeholder:
2 2703 <0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
2 2704 0: 0 (ingenting) 'rest kommando er tom'
2 2705 1: 1 (tekst) 'indtil 11 tegn'
2 2706 2: 1 (pos.tal)
2 2707 3: 1 (neg.tal)
2 2708 4: 1 (pos.tal<1000)(bogstav) 'linienummer'
2 2709 5: 1 G(pos.tal<100) 'gruppe_ident'
2 2710 6: 2 (linie)/(løb) 'vogn_ident'
2 2711 7: 3 (bus)/(linie)/(løb)
2 2712 8: 3 (linie).(indeks):(løb)
2 2713 9: 2 (linie).(indeks)
2 2714 10: 2 (pos.tal).(pos.tal)
2 2715 11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
2 2716 12: 3 D.(dato).(tid)
2 2717
2 2717 tekst indeholder teksten hvori parametersættet
2 2718 (kald,int.arr.) skal søges.
2 2719
2 2719 pos
2 2720 (kald/retur,int.) position efter hvilken søgningen starter, og
2 2721 ved retur positionen for afsluttende tegn.
2 2722 (ikke ændret ved fejl)
2 2723
2 2723 ant hvis kaldeværdien er >0 skal parametersættet
2 2724 (kald/retur,int) indeholde det angivne antal enkeltparametre,
2 2725 i modsat fald returneres med fejltype -26
2 2726 (skilletegn) eller -25 (parameter mangler).
2 2727 ellers læses op til 3 enkeltparametre. retur-
2 2728 værdien afhænger af det læste parametersæts
2 2729 type, se ovenfor under læs_param_sæt.
2 2730 \f
2 2730 message procedure læs_param_sæt side 2 - 810428/hko;
2 2731
2 2731 parm skal omfatte elementerne 1 til 4.
2 2732 (retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
2 2733 terne værdien 0.
2 2734
2 2734 type (element,indhold)
2 2735 1: 1-4,teksten
2 2736 2-3: 1, talværdien
2 2737 4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
2 2738 5: 1, talværdi (uden G)
2 2739 6: 1, (som'4') shift 7 + løb
2 2740 7: 1, bus
2 2741 2, linie/løb som '6'
2 2742 8: 1, tal shift 5 eller som '4'
2 2743 2, tekst (1-3 bogstaver)
2 2744 3, løb
2 2745 9: 1 og 2, som '8'
2 2746 10: 1, talværdi
2 2747 2, talværdi
2 2748 11: 1, som '5'
2 2749 2, vogn (bus eller linie/løb)
2 2750 12: 1, dato
2 2751 2, tid
2 2752
2 2752 term iso-tegnværdien for tegnet der afslutter
2 2753 (retur,int) parameter_sættet.
2 2754
2 2754 res som læs_param_sæt.
2 2755 (retur,int)
2 2756
2 2756 *>
2 2757 \f
2 2757 message procedure læs_param_sæt side 3 - 810310/hko;
2 2758
2 2758 begin
3 2759 integer max_ant;
3 2760
3 2760 max_ant:= 3;
3 2761
3 2761 begin
4 2762 integer
4 2763 i,j,k, <* hjælpe variable *>
4 2764 nr, <* nummer på parameter i sættet *>
4 2765 apos, <* aktuel tegnposition *>
4 2766 cifre, <* parametertype (param: 0=tekst, >1=tal) *>
4 2767 sep; <* afsluttende skilletegn ved param *>
4 2768
4 2768 integer array field
4 2769 iaf; <* hjælpe variabel *>
4 2770
4 2770 integer array
4 2771 par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
4 2772 s, <* 1 element med separator for hver parameter *>
4 2773 t(1:max_ant), <* 1 element med typen for hver parameter *>
4 2774 værdi(1:4), <* værdi af aktuel parameter jvf. param *>
4 2775 spec(1:1); <* specialtegn i navne jvf. param *>
4 2776
4 2776 <* de interne typer af enkeltparametre er
4 2777
4 2777 type parameter
4 2778
4 2778 1: 1-3 tegn tekst (1 ord)
4 2779 2: 4-6 tegn (2 ord)
4 2780 3: 7-9 tegn (3 ord)
4 2781 4:10-11 tegn (4 ord)
4 2782 5: positivt heltal
4 2783 6: negativt heltal
4 2784 7: positivt heltal<1000 efterfulgt af stort bogstav
4 2785 8: G efterfulgt af positivt heltal<100
4 2786
4 2786 *>
4 2787 \f
4 2787 message procedure læs_param_sæt side 4 - 810408/hko;
4 2788
4 2788 nr:= 0;
4 2789 res:= -1;
4 2790 spec(1):= 0; <* ingen specialtegn *>
4 2791 apos:= pos;
4 2792 for i:= 1 step 1 until 4 do parm(i):= 0;
4 2793 for i:= 1 step 1 until max_ant do
4 2794 begin
5 2795 s(i):= t(i):= 0;
5 2796 for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
5 2797 end;
4 2798 repeat
4 2799 <* skip foranstillede sp-tegn *>
4 2800 for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
4 2801 while i=1 and sep='sp' do;
4 2802 <*+2*>
4 2803 begin
5 2804 if testbit25 and testbit26 then
5 2805 disable begin
6 2806 write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
6 2807 i,apos,cifre,sep);
6 2808 laf:=0;
6 2809 if cifre<>0 then
6 2810 write(out,<: værdi(1-4)::>,
6 2811 << -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
6 2812 else write(out,<: værdi::>,værdi.laf);
6 2813 ud;
6 2814 end;
5 2815 end;
4 2816 <*-2*>
4 2817 ;
4 2818 if i<>0 then <* ikke ok *>
4 2819 begin
5 2820 if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
5 2821 begin
6 2822 apos:= apos -1;
6 2823 res:= 0;
6 2824 end
5 2825 else if i=1 then res:=-26 <* skilletegn *>
5 2826 else <* i=5 *> res:= -25 <* parameter mangler *>
5 2827 end
4 2828 else <* i=0 *>
4 2829 begin
5 2830 if sep=',' or sep=';' then apos:=apos-1;
5 2831 iaf:= nr*8;
5 2832 nr:= nr +1;
5 2833 \f
5 2833 message procedure læs_param_sæt side 5 - 810520/hko/cl;
5 2834
5 2834 if cifre=0 <* navne_parameter *> then
5 2835 begin
6 2836 if værdi(2)=0
6 2837 and læstegn(værdi,1,i)='G'
6 2838 and læstegn(værdi,2,j)>'0' and j<='9'
6 2839 and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
6 2840 then
6 2841 begin <* gruppenavn, repræsenteres som tal *>
7 2842 t(nr):= 8;
7 2843 j:= j -'0';
7 2844 par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
7 2845 s(nr):= sep;
7 2846 end
6 2847 else
6 2848 begin <* generel tekst *>
7 2849 i:= 0;
7 2850 for i:= i +1 while i<=4 do
7 2851 begin
8 2852 if værdi(i)<>0 then
8 2853 begin
9 2854 t(nr):= i;
9 2855 par.iaf(i):= værdi(i);
9 2856 end
8 2857 else i:= 4;
8 2858 end;
7 2859 s(nr):= sep;
7 2860 end <* generel tekst *>
6 2861 end <* navne_parameter *>
5 2862 else
5 2863 begin <* talparameter *>
6 2864 i:= if værdi(1)<0 then 6 <* neg.tal *>
6 2865 else if værdi(1)>0 and værdi(1)<1000
6 2866 and sep>='A' and sep<='Å' then 7
6 2867 else 5 <* positivt tal *>;
6 2868 t(nr):= i;
6 2869 par.iaf(1):= if i<>7 then værdi(1)
6 2870 else værdi(1) shift 5 +(sep+1-'A');
6 2871 par.iaf(2):= cifre;
6 2872 apos:= apos+1;
6 2873 s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
6 2874 apos:= apos-1;
6 2875 end;
5 2876 end;<* i=0 *>
4 2877 until (ant>0 and nr=ant)
4 2878 or nr=max_ant
4 2879 or res<> -1
4 2880 or sep='sp' or sep=';' or sep='em'
4 2881 or sep=',' or sep='nl' or sep='nul';
4 2882 \f
4 2882 message procedure læs_param_sæt side 6 - 810508/hko;
4 2883
4 2883 if ant>nr then res:= -25 <*parameter mangler*>
4 2884 else
4 2885 if nr=0 or t(1)=0 then
4 2886 begin <* ingen parameter før skilletegn *>
5 2887 if res=-25 then res:= 0;
5 2888 end
4 2889 else if sep<>'sp' and sep<>'nl' and sep <> 'em'
4 2890 and sep<>';' and sep<>',' then
4 2891 begin <* ulovligt afsluttende skilletegn *>
5 2892 res:= -26;
5 2893 end
4 2894 else
4 2895 begin <* en eller flere lovligt afsluttede parametre *>
5 2896 if t(1)<5 and nr=1 then
5 2897
5 2897 <* 1 navne_parameter *>
5 2898
5 2898 begin
6 2899 res:= 1;
6 2900 tofrom(parm,par,8);
6 2901 end
5 2902 else if <*t(1)<9 and *> nr=1 then
5 2903
5 2903 <* 1 parameter af anden type *>
5 2904
5 2904 begin <*tal,linie eller gruppe *>
6 2905 res:= t(1) -3;
6 2906 parm(1):= par(1);
6 2907 end
5 2908 else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
5 2909
5 2909 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
5 2910
5 2910 begin
6 2911 i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
6 2912 j:= par(5); <* internt *>
6 2913 k:= par(9); <* *>
6 2914 if nr=2 then
6 2915 <* 2 parametre i sættet *>
6 2916 begin
7 2917 res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
7 2918 else if s(1)='.' and t(2)=1 then 9
7 2919 else if s(1)='-' and t(1)=5 and t(2)=5 then 10
7 2920 else if s(1)<>'/' and s(1)<>'.'
7 2921 and s(1)<>'-' then -26 <* skilletegn *>
7 2922 else -27;<* parametertype*>
7 2923 \f
7 2923 message procedure læs_param_sæt side 7 - 810501/hko;
7 2924
7 2924 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2925
7 2925 <* 2 parametre i sættet *>
7 2926 if res=6 then
7 2927 begin
8 2928 if (i<1 or i>999) and t(1)=5 then
8 2929 res:= -5 <* ulovligt linienr *>
8 2930 else if (j<1 or j>99) then
8 2931 res:= -6 <* ulovligt løbsnr *>
8 2932 else
8 2933 begin
9 2934 if t(1)=5 then i:= i shift 5;
9 2935 parm(1):= i shift 7 +j;
9 2936 end;
8 2937 end <* res=6 *>
7 2938 else if res=9 then
7 2939 begin
8 2940 if t(1)=5 and (i<1 or 999<i) then
8 2941 res:= -5 <*ulovligt linienr*>
8 2942 else
8 2943 begin
9 2944 if t(1)=5 then i:=i shift 5;
9 2945 parm(1):= i;
9 2946 parm(2):= j;
9 2947 end;
8 2948 end <* res=9 *>
7 2949 else if res=10 then
7 2950 begin
8 2951 begin
9 2952 parm(1):= i;
9 2953 parm(2):= j;
9 2954 end;
8 2955 end; <* res=10 *>
7 2956 end <* nr=2 *>
6 2957 else
6 2958 if nr=3 then
6 2959 <* 3 paramtre i sættet *>
6 2960 begin
7 2961 res:= if (s(1)='/' or s(1)='.') and
7 2962 (s(2)='/' or s(2)='.') then 7
7 2963 else if s(1)='.' and s(2)=':' then 8
7 2964 else -26; <* skilletegn *>
7 2965 \f
7 2965 message procedure læs_param_sæt side 8 - 810501/hko;
7 2966
7 2966 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2967 <* 3 parametre i sættet *>
7 2968 if res=7 then
7 2969 begin
8 2970 if t(1)<>5 or (t(2)<>5 and t(2)<>7)
8 2971 or t(3)<>5 then
8 2972 res:= -27 <* parametertype *>
8 2973 else
8 2974 if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
8 2975 else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
8 2976 else if k<1 or k>99 then res:= -6 <* løb *>
8 2977 else
8 2978 begin <* ok *>
9 2979 parm(1):= i;
9 2980 if t(2)=5 then j:= j shift 5;
9 2981 parm(2):= j shift 7 +k;
9 2982 end;
8 2983 end
7 2984 else if res=8 then
7 2985 begin
8 2986 if t(2)<>1 or t(3)<>5 then res:= -27
8 2987 else if t(1)=5 and (i<1 or i>999) then res:= -5
8 2988 else if k<1 or k>99 then res:= -6
8 2989 else
8 2990 begin
9 2991 if t(1)=5 then i:= i shift 5;
9 2992 parm(1):= i;
9 2993 parm(2):= j;
9 2994 parm(3):= k;
9 2995 end;
8 2996 end;
7 2997 end <* nr=3 *>
6 2998 else res:=-24; <* syntaks *>
6 2999 \f
6 2999 message procedure læs_param_sæt side 9 - 810428/hko;
6 3000
6 3000 end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
5 3001 else if t(1)=8 <* gruppe_id *> then
5 3002 begin
6 3003 <* mere end 1 parameter , hvoraf den første
6 3004 er en gruppe_identifikation ved navn.
6 3005 lovlige parametre er alle internt repræsenteret i et ord *>
6 3006
6 3006 i:=par(1);
6 3007 j:=par(5);
6 3008 k:=par(9);
6 3009
6 3009 if nr=2 then
6 3010 <* 2 parametre *>
6 3011 begin
7 3012 res:=if s(1)=':' and t(2)=5 then 11
7 3013 else if s(1)<>':' then -26 <* skilletegn *>
7 3014 else -27; <*param.type *>
7 3015 if res=11 then
7 3016 begin
8 3017 if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
8 3018 else
8 3019 begin
9 3020 parm(1):=i;
9 3021 parm(2):=j;
9 3022 end;
8 3023 end;
7 3024 \f
7 3024 message procedure læs_param_sæt side 10 - 810428/hko;
7 3025
7 3025 <* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
7 3026
7 3026 end <*nr=2*>
6 3027 else if nr=3 then
6 3028 <* 3 parametre *>
6 3029 begin
7 3030 res:=if s(1)=':' and s(2)='/' then 11
7 3031 else -26; <* skilletegn *>
7 3032 if res=11 then
7 3033 begin
8 3034 if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
8 3035 else
8 3036 begin
9 3037 if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
9 3038 else
9 3039 begin
10 3040 parm(1):=i;
10 3041 if t(2)=5 then j:=j shift 5;
10 3042 parm(2):= 1 shift 22 +j shift 7 +k;
10 3043 end;
9 3044 end;
8 3045 end;
7 3046 end <* nr=3 *>
6 3047 else res:=-24; <* syntaks *>
6 3048 \f
6 3048 message procedure læs_param_sæt side 11 - 810501/hko;
6 3049
6 3049 end <* t(1)=8 *>
5 3050 else if t(1)=1 and par(1)= 'D' shift 16 then
5 3051 begin
6 3052 <* mere end 1 parameter i sættet og 1. parameter er et 'D'.
6 3053 lovlige parametre er alle internt repræsenteret i et ord. *>
6 3054 i:=par(1);
6 3055 j:=par(5);
6 3056 k:=par(9);
6 3057
6 3057 if nr=3 then
6 3058 begin
7 3059 res:=if s(1)='.' and s(2)='.' then 12
7 3060 else -26; <* skilletegn *>
7 3061 if res=12 then
7 3062 begin
8 3063 if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
8 3064 else
8 3065 begin
9 3066 integer år,md,dg,tt,mm,ss;
9 3067 real dato,tid;
9 3068 år:=j//10000;
9 3069 md:=(j//100) mod 100;
9 3070 dg:=j mod 100;
9 3071 cifre:= par(10);
9 3072 tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
9 3073 else k;
9 3074 mm:=if cifre>4 then (k//100) mod 100
9 3075 else if cifre>2 then k mod 100 else 0;
9 3076 ss:=if cifre>4 then k mod 100 else 0;
9 3077 \f
9 3077 message procedure læs_param_sæt side 12 - 810501/hko;
9 3078
9 3078 dato:=systime(5,0.0,tid);
9 3079 if j=0 then dg:=round dato mod 100;
9 3080 if år=0 and md=0 then md:=(round dato//100) mod 100;
9 3081 if år=0 then år:=round dato//10000;
9 3082 if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
9 3083 res:=-24 <* syntaks *>
9 3084 else if dg<1 or dg > (case md of (
9 3085 31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
9 3086 31,31,30, 31,30,31)) then res:=-24
9 3087 else
9 3088 begin
10 3089 parm(1):=år*10000+md*100+dg;
10 3090 parm(2):=tt*10000+mm*100+ss;
10 3091 end;
9 3092 end;
8 3093
8 3093 end; <* res=12 *>
7 3094 end <* nr=3 *>
6 3095 else res:=-24; <*syntaks*>
6 3096 end <* t(1)=1 and par(1)='D' shift 16 *>
5 3097
5 3097 else res:=-27;<*parametertype*>
5 3098 end; <* en eller flere parametre *>
4 3099
4 3099 læs_param_sæt:= res;
4 3100 term:= sep;
4 3101 if res>= 0 then pos:= apos;
4 3102 end;
3 3103 end læs_param_sæt;
2 3104 \f
2 3104 message procedure læs_kommando side 1 - 810428/hko;
2 3105
2 3105 integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
2 3106 value kilde;
2 3107 zone z;
2 3108 integer kilde, pos,indeks,sep,slut_tegn;
2 3109 integer array field op_ref;
2 3110
2 3110 <* proceduren indlæser er kommmando fra en terminal (telex,
2 3111 skærm eller skrivemaskine). ved indlæsning fra skærm eller
2 3112 skrivemaskine inviteres først ved udskrivning af '>'-tegn.
2 3113 for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
2 3114 23'ende linie inden invitation.
2 3115 *>
2 3116 \f
2 3116 message procedure læs_kommando side 2 - 810428/hko;
2 3117
2 3117 begin
3 3118 integer
3 3119 a_pos,
3 3120 a_res,res,
3 3121 i,j,k;
3 3122 boolean
3 3123 skip;
3 3124
3 3124 <*V*>setposition(z,0,0);
3 3125
3 3125 case kilde//100 of
3 3126 begin
4 3127 begin <* io *>
5 3128 write(z,"nl",1,">",1);
5 3129 end;
4 3130
4 3130 begin <* operatør *>
5 3131 cursor(z,24,1);
5 3132 write(z,"esc" add 128,1,<:ÆK:>);
5 3133 cursor(z,23,1);
5 3134 write(z,"esc" add 128,1,<:ÆK:>);
5 3135 outchar(z,'>');
5 3136 end;
4 3137
4 3137 begin <* garageterminal *> ;
5 3138 outchar(z,'nl');
5 3139 end
4 3140 end;
3 3141
3 3141 <*V*>setposition(z,0,0);
3 3142 \f
3 3142 message procedure læs_kommando side 3 - 810921/hko,cl;
3 3143
3 3143 res:=0;
3 3144 skip:= false;
3 3145 <*V*>
3 3146 k:=læs_store(z,i);
3 3147
3 3147 apos:= 1;
3 3148 while k<=6 <*klasse=bogstav*> do
3 3149 begin
4 3150 if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
4 3151 <*V*> k:= læs_store(z,i);
4 3152 end;
3 3153
3 3153 skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
3 3154
3 3154 if i=',' and a_pos>1 then
3 3155 begin
4 3156 skrivtegn(d.op_ref.data,a_pos,i);
4 3157 repeat
4 3158 <*V*> k:= læs_store(z,i);
4 3159 if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
4 3160 until k>=7;
4 3161 end;
3 3162
3 3162 pos:=a_pos;
3 3163 while k<8 do
3 3164 begin
4 3165 if a_pos< (att_op_længde//2*3-2) then
4 3166 skriv_tegn(d.op_ref.data,a_pos,i);
4 3167 skip:= skip or i='?';
4 3168 <*V*> k:= læs_store(z,i);
4 3169 pos:=pos+1;
4 3170 end;
3 3171
3 3171 skip:= skip or i='?' or i='esc';
3 3172 slut_tegn:= i;
3 3173 skrivtegn(d.op_ref.data,apos,'em');
3 3174 afslut_text(d.op_ref.data,apos);
3 3175 \f
3 3175 message procedure læs_kommando side 4 - 820301/hko/cl;
3 3176
3 3176 disable
3 3177 begin
4 3178 integer
4 3179 i1,
4 3180 nr,
4 3181 partype,
4 3182 cifre;
4 3183 integer array
4 3184 spec(1:1),
4 3185 værdi(1:4);
4 3186
4 3186 <*+2*>
4 3187 if testbit25 and overvåget then
4 3188 disable begin
5 3189 real array field raf;
5 3190 write(out,"nl",1,<:kommando læst::>);
5 3191 laf:=data;
5 3192 write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
5 3193 <: skip=:>,if skip then <:true:> else <:false:>);
5 3194 ud;
5 3195 end;
4 3196 <*-2*>
4 3197
4 3197 for i:=1 step 1 until 32 do ia(i):=0;
4 3198
4 3198 if skip then
4 3199 begin
5 3200 res:=53; <*annulleret*>
5 3201 pos:= -1;
5 3202 goto slut_læskommando;
5 3203 end;
4 3204 \f
4 3204 message procedure læs_kommando side 5 - 850820/cl;
4 3205
4 3205 i:= kilde//100; <* hovedmodul *>
4 3206 k:= kilde mod 100; <* løbenr *>
4 3207 <* if pos>79 then linieoverløb; *>
4 3208 pos:=a_pos:=0;
4 3209 spec(1):= ',' shift 16;
4 3210
4 3210 <*+4*>
4 3211 if k<1 or k>(case i of (1,max_antal_operatører,
4 3212 max_antal_garageterminaler)) then
4 3213 begin
5 3214 fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
5 3215 res:=31;
5 3216 end
4 3217 else
4 3218 <*-4*>
4 3219 if i>0 and i<4 then <* io, operatør eller garageterminal *>
4 3220 begin
5 3221 <* læs operationskode *>
5 3222 j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
5 3223
5 3223 res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
5 3224 else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
5 3225 else if j=2 then 4 <*ukendt kommando*>
5 3226 else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
5 3227 else if sep<>'sp' and sep<>','
5 3228 and sep<>'nl' and sep<>';'
5 3229 and sep<>'nul' and sep<>'em' then 26
5 3230 <*skilletegn*>
5 3231 else if -, læsbit_i(værdi(4),i-1) then 4
5 3232 <* logand(extend 0 add værdi(4)
5 3233 extend 1 shift (case i of (0,k,8+k)))=0 then 4
5 3234 *> <*ukendt kommando*>
5 3235 else 1;
5 3236 \f
5 3236 message procedure læs_kommando side 5a- 810409/hko;
5 3237
5 3237 <*+2*>if testbit25 and overvåget then
5 3238 begin
6 3239 write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
6 3240 << -dddd>,j,apos,cifre,sep,res,
6 3241 <: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
6 3242 "nl",0);
6 3243 if j<>0 then skriv_op(out,op_ref);
6 3244 ud;
6 3245 end;
5 3246 <*-2*>
5 3247
5 3247 if res=31 then fejlreaktion(18<*tabelfil*>,j,
5 3248 <:=res, filnr 1025, læskommando:>,0);
5 3249
5 3249 if res=1 then <* operationskode ok *>
5 3250 begin
6 3251 if sep<>'sp' then apos:=apos-1;
6 3252 d.op_ref.opkode:=værdi(1);
6 3253 indeks:=værdi(2);
6 3254 partype:= værdi(3);
6 3255 nr:= 0;
6 3256 pos:= apos;
6 3257 \f
6 3257 message procedure læs_kommando side 6 - 810409/hko;
6 3258
6 3258 while res=1 do
6 3259 begin
7 3260 læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
7 3261 værdi,sep,a_res);
7 3262 nr:= nr +1;
7 3263 i1:= værdi(1);
7 3264 <*+2*> if testbit25 and overvåget then
7 3265 begin
8 3266 write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
8 3267 apos,sep,ares,<: værdi(1-4)::>,
8 3268 værdi(1),værdi(2),værdi(3),værdi(4),
8 3269 "nl",0);
8 3270 ud;
8 3271 end;
7 3272 <*-2*>
7 3273 case par_type of
7 3274 begin
8 3275
8 3275 <*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
8 3276
8 3276 begin
9 3277 if nr=1 then
9 3278 begin
10 3279 if a_res=0 then res:=2 <*godkendt*>
10 3280 else if a_res=2 and (i1<1 or i1>9999)
10 3281 then res:=7 <*busnr ulovligt*>
10 3282 else if a_res=2 or a_res=6 then
10 3283 begin
11 3284 ia(1):= if a_res=2 then i1
11 3285 else 1 shift 22 +i1;
11 3286 end
10 3287 else res:= 27; <*parametertype*>
10 3288 if res<4 then pos:= apos;
10 3289 end <*nr=1*>
9 3290 else
9 3291 if nr=2 then
9 3292 begin
10 3293 if ares=0 then res:= 2 <*godkendt*>
10 3294 else if ares=1 then
10 3295 begin
11 3296 ia(2):= find_område(i1);
11 3297 if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
11 3298 end
10 3299 else res:= 27; <* syntaks, parametertype *>
10 3300 end
9 3301 else
9 3302 if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
9 3303 end;
8 3304 \f
8 3304 message procedure læs_kommando side 7 - 810226/hko;
8 3305
8 3305 <*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
8 3306
8 3306 begin
9 3307 if nr=1 then
9 3308 begin
10 3309 if a_res=0 then res:=25 <*parameter mangler*>
10 3310 else if a_res=2 and (i1<1 or i1>9999)
10 3311 then res:=7 <*busnr ulovligt*>
10 3312 else if a_res=2 or a_res=6 then
10 3313 begin
11 3314 ia(1):=if a_res=2 then i1
11 3315 else 1 shift 22 +i1;
11 3316 end
10 3317 else res:= 27; <*parametertype*>
10 3318 if res<4 then pos:=a_pos;
10 3319 end
9 3320 else
9 3321 if nr=2 then
9 3322 begin
10 3323 if ares=0 then res:= 2 <*godkendt*> else
10 3324 if ares=1 and ia(1) shift (-21) = 0 then
10 3325 begin
11 3326 ia(2):= findområde(i1);
11 3327 if ia(2)=0 then res:= 56; <*område ukendt*>
11 3328 end
10 3329 else res:= 27;
10 3330 if res<4 then pos:= apos;
10 3331 end
9 3332 else
9 3333 if ares=0 then res:= 2 else res:= 24<*syntaks*>;
9 3334 end;
8 3335 \f
8 3335 message procedure læs_kommando side 8 - 810223/hko;
8 3336
8 3336 <*3: (<linie>!G<nr>) *>
8 3337
8 3337 begin
9 3338 if nr=1 then
9 3339 begin
10 3340 if a_res=0 then res:=25 <*parameter mangler*>
10 3341 else if a_res=2 and (i1<1 or i1>999) then res:=5
10 3342 <*linienr ulovligt*>
10 3343 else if a_res=2 or a_res=4 or a_res=5 then
10 3344 begin
11 3345 ia(1):=
11 3346 if a_res=2 then 4 shift 21 +i1 shift 5
11 3347 else if a_res=4 then 4 shift 21 +i1
11 3348 else <* a_res=5 *> 5 shift 21 +i1;
11 3349 end
10 3350 else res:=27; <* parametertype *>
10 3351 if res<4 then pos:= a_pos;
10 3352 end
9 3353 else
9 3354 res:= if nr=2 and a_res<>0 then 24<*syntaks*>
9 3355 else 2;<*godkendt*>
9 3356 end;
8 3357
8 3357 <*4: <ingenting> *>
8 3358
8 3358 begin
9 3359 res:= if a_res<>0 then 24<*syntaks*>
9 3360 else 2;<*godkendt*>
9 3361 end;
8 3362 \f
8 3362 message procedure læs_kommando side 9 - 810226/hko;
8 3363
8 3363 <*5: (<kanalnr>) *>
8 3364
8 3364 begin
9 3365 long field lf;
9 3366
9 3366 if nr=1 then
9 3367 begin
10 3368 if a_res=0 then res:= 25
10 3369 else if a_res<>1 then res:=27<*parametertype*>
10 3370 else
10 3371 begin
11 3372 j:= 0; lf:= 4;
11 3373 for i:= 1 step 1 until max_antal_kanaler do
11 3374 if kanal_navn(i)=værdi.lf then j:= i;
11 3375 if j<>0 then
11 3376 begin
12 3377 ia(1):= 3 shift 22 + j;
12 3378 res:= 2;
12 3379 end
11 3380 else
11 3381 res:= 17; <* kanal ukendt *>
11 3382 end;
10 3383 if res<4 then pos:= a_pos;
10 3384 end
9 3385 else
9 3386 res:=if nr=2 and a_res<>0 then 24<*syntaks*>
9 3387 else 2;<*godkendt*>
9 3388 end;
8 3389 \f
8 3389 message procedure læs_kommando side 10 - 810415/hko;
8 3390
8 3390 <*6: <busnr>/<linie>/<løb> (<område>) *>
8 3391
8 3391 begin
9 3392 if nr=1 then
9 3393 begin
10 3394 if a_res=0 then res:=25<*parameter mangler*>
10 3395 else if a_res=7 then
10 3396 begin
11 3397 ia(1):= i1;
11 3398 ia(2):= 1 shift 22 + værdi(2);
11 3399 end
10 3400 else res:=27;<*parametertype*>
10 3401 if res<4 then pos:= apos;
10 3402 end
9 3403 else
9 3404 if nr=2 then
9 3405 begin
10 3406 if ares=0 then res:= 2 <*godkendt*> else
10 3407 if ares=1 then
10 3408 begin
11 3409 ia(3):= findområde(i1);
11 3410 if ia(3)=0 then res:= 56; <* område ukendt *>
11 3411 end
10 3412 else res:= 27; <*parametertype*>
10 3413 if res<4 then pos:= apos;
10 3414 end
9 3415 else
9 3416 if ares=0 then res:= 2 else res:= 24;
9 3417 end;
8 3418 \f
8 3418 message procedure læs_kommando side 11 - 810512/hko/cl;
8 3419
8 3419
8 3419 <* att_op_længde//2-2 *>
8 3420 <*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
8 3421 <* 1 *>
8 3422
8 3422 begin
9 3423 if nr=1 then
9 3424 begin
10 3425 if a_res=0 then res:=25 <*parameter mangler*>
10 3426 else if a_res=8 then
10 3427 begin
11 3428 ia(1):= 4 shift 21 + i1;
11 3429 ia(2):= værdi(2);
11 3430 ia(3):= værdi(3);
11 3431 indeks:= 3;
11 3432 end
10 3433 else res:=27;<*parametertype*>
10 3434 end
9 3435 else if nr<=att_op_længde//2-2 then
9 3436 begin
10 3437 if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
10 3438 else if a_res=0 then res:=25 <* parameter mangler *>
10 3439 else if a_res=10 then
10 3440 begin
11 3441 if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
11 3442 begin
12 3443 ia(nr+2):= i1 shift 12 + værdi(2);
12 3444 indeks:= nr +2;
12 3445 end
11 3446 else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
11 3447 else res:=6; <*løb-nr ulovligt*>
11 3448 end
10 3449 else res:=27;<*parametertype*>
10 3450 end
9 3451 else
9 3452 res:= if a_res=0 then 2 else 24;<* syntaks *>
9 3453 if res<4 then pos:=a_pos;
9 3454 end;
8 3455 \f
8 3455 message procedure læs_kommando side 12 - 810306/hko;
8 3456
8 3456 <*8: (<operatør>!<radiokanal>!<garageterminal>) *>
8 3457
8 3457 begin
9 3458 if nr=1 then
9 3459 begin
10 3460 if a_res=0 then res:=25 <* parameter mangler *>
10 3461 else if a_res=2 then
10 3462 begin
11 3463 j:=d.op_ref.opkode;
11 3464 ia(1):=i1;
11 3465 k:=(j+1)//2;
11 3466 if k<1 or k=3 or k>4 then
11 3467 fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
11 3468 else
11 3469 begin
12 3470 if k=4 then k:=3;
12 3471 if i1<1 or i1> (case k of
12 3472 (max_antal_operatører,max_antal_radiokanaler,
12 3473 max_antal_garageterminaler))
12 3474 then res:=case k of (28,29,17);
12 3475 end;
11 3476 end
10 3477 else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
10 3478 begin
11 3479 laf:= 0;
11 3480 ia(1):= find_bpl(værdi.laf(1));
11 3481 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3482 end
10 3483 else res:=27; <*parametertype*>
10 3484 end
9 3485 else
9 3486 if nr=2 and d.opref.opkode=1 then
9 3487 begin
10 3488 <* åbningstilstand for operatørplads *>
10 3489 if a_res=0 then res:= 2 <*godkendt*>
10 3490 else if a_res<>1 then res:= 27 <*parametertype*>
10 3491 else begin
11 3492 res:= 2<*godkendt*>;
11 3493 j:= værdi(1) shift (-16);
11 3494 if j='S' then ia(2):= 3 else
11 3495 if j<>'Å' then res:= 24; <*syntaks*>
11 3496 end;
10 3497 end
9 3498 else
9 3499 begin
10 3500 res:=if a_res=0 then 2 <* godkendt *>
10 3501 else 24;<* syntaks *>
10 3502 end;
9 3503 if res<4 then pos:=a_pos;
9 3504 end; <* partype 8 *>
8 3505 \f
8 3505 message procedure læs_kommando side 13 - 810306/hko;
8 3506
8 3506
8 3506 <* att_op_længde//2 *>
8 3507 <*9: <operatør>((+!-)<linienr>) *>
8 3508 <* 1 *>
8 3509
8 3509 begin
9 3510 if nr=1 then
9 3511 begin
10 3512 if a_res=0 then res:=25 <* parameter mangler *>
10 3513 else if a_res=2 then
10 3514 begin
11 3515 ia(1):=i1;
11 3516 if i1<1 or i1>max_antal_operatører then res:=28;
11 3517 end
10 3518 else if a_res=1 then
10 3519 begin
11 3520 laf:= 0;
11 3521 ia(1):= find_bpl(værdi.laf(1));
11 3522 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3523 end
10 3524 else res:=27; <* parametertype *>
10 3525 end
9 3526 else if nr<=att_op_længde//2 then
9 3527 begin <* nr>1 *>
10 3528 if a_res=0 then res:=(if nr>2 then 2 else 25)
10 3529 else if a_res=2 or a_res=3 then
10 3530 begin
11 3531 ia(nr):=i1; indeks:= nr;
11 3532 if i1=0 or abs(i1)>999 then res:=5;
11 3533 end
10 3534 else res:=27; <* parametertype *>
10 3535 if res<4 then pos:=a_pos;
10 3536 end
9 3537 else
9 3538 res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
9 3539 else 2;
9 3540 end; <* partype 9 *>
8 3541 \f
8 3541 message procedure læs_kommando side 14 - 810428/hko;
8 3542
8 3542 <* 2 *>
8 3543 <*10: (bus) *>
8 3544 <* 1 *>
8 3545
8 3545 begin
9 3546 if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
9 3547 else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
9 3548 else if a_res=0 then res:=2 <* godkendt *>
9 3549 else if a_res<>2 then res:=27 <* parametertype *>
9 3550 else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
9 3551 else
9 3552 ia(nr):=i1;
9 3553 end;
8 3554
8 3554 <* 5 *>
8 3555 <*11: (<linie>) *>
8 3556 <* 1 *>
8 3557
8 3557 begin
9 3558 if a_res=0 and nr=1 then res:=25
9 3559 else if a_res<>0 and nr>5 then res:=24
9 3560 else if a_res=0 then res:=2
9 3561 else if a_res<>2 and a_res<>4 then res:=27
9 3562 else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
9 3563 else
9 3564 ia(nr):=
9 3565 (if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
9 3566 end;
8 3567 \f
8 3567 message procedure læs_kommando side 15 - 810306/hko;
8 3568
8 3568 <*12: (<ingenting>!<navn>) *>
8 3569
8 3569 begin
9 3570 if nr=1 then
9 3571 begin
10 3572 if a_res=0 then res:=2 <*godkendt*>
10 3573 else if a_res=1 then
10 3574 tofrom(ia,værdi,8)
10 3575 else res:=27; <* parametertype *>
10 3576 end
9 3577 else
9 3578 res:=if a_res<>0 then 24 <* syntaks (for mange) *>
9 3579 else 2;
9 3580 end; <* partype 12 *>
8 3581 \f
8 3581 message procedure læs_kommando side 16 - 810512/hko/cl;
8 3582
8 3582 <* 15 *>
8 3583 <*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
8 3584 <* 1 *>
8 3585
8 3585 begin
9 3586 if nr=1 then
9 3587 begin
10 3588 if a_res=0 then res:=25 <* parameter mangler *>
10 3589 else
10 3590 if a_res=11 then
10 3591 begin
11 3592 ia(1):= 5 shift 21 + i1;
11 3593 ia(2):=værdi(2);
11 3594 indeks:= 2;
11 3595 end
10 3596 else res:=27; <* parametertype *>
10 3597 end
9 3598 else if nr<= att_op_længde//2-1 then
9 3599 begin
10 3600 if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
10 3601 else if a_res=0 then res:=25 <* parameter mangler *>
10 3602 else if ares=2 and (i1<1 or i1>9999) then
10 3603 res:= 7 <*busnr ulovligt*>
10 3604 else if a_res=2 or a_res=6 then
10 3605 begin
11 3606 ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
11 3607 indeks:= nr+1;
11 3608 end
10 3609 else res:=27; <* parametertype *>
10 3610 end
9 3611 else
9 3612 res:=if a_res=0 then 2 <*godkendt *>
9 3613 else 24;<* syntaks *>
9 3614 if res<4 then pos:=a_pos;
9 3615 end; <* partype 13 *>
8 3616 \f
8 3616 message procedure læs_kommando side 17 - 810311/hko;
8 3617
8 3617 <*14: <linie>.<indeks> *>
8 3618
8 3618 begin
9 3619 if nr=1 then
9 3620 begin
10 3621 if a_res=0 then res:=25 <* parameter mangler *>
10 3622 else if a_res=9 then
10 3623 begin
11 3624 ia(1):= 1 shift 23 +i1;
11 3625 ia(2):= værdi(2);
11 3626 end
10 3627 else res:=27; <* parametertype *>
10 3628 end
9 3629 else <* nr>1 *>
9 3630 res:= if a_res=0 then 2 <* godkendt *>
9 3631 else 24;<* syntaks *>
9 3632 end; <* partype 14 *>
8 3633 \f
8 3633 message procedure læs_kommando side 18 - 810313/hko;
8 3634
8 3634 <*15: <linie>.<indeks> <bus> *>
8 3635
8 3635 begin
9 3636 if nr=1 then
9 3637 begin
10 3638 if a_res=0 then res:= 25 <* parameter mangler *>
10 3639 else if a_res=9 then
10 3640 begin
11 3641 ia(1):= 1 shift 23 +i1;
11 3642 ia(2):= værdi(2);
11 3643 end
10 3644 else res:=27; <* parametertype *>
10 3645 end
9 3646 else if nr=2 then
9 3647 begin
10 3648 if a_res=0 then res:=25
10 3649 else if a_res=2 then
10 3650 begin
11 3651 if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
11 3652 else ia(3):= i1;
11 3653 end
10 3654 else res:=27; <*parametertype *>
10 3655 end
9 3656 else
9 3657 res:=if a_res=0 then 2 <* godkendt *>
9 3658 else 24;<* syntaks *>
9 3659 if res<4 then pos:=a_pos;
9 3660 end; <* partype 15 *>
8 3661 \f
8 3661 message procedure læs_kommando side 19 - 810311/hko;
8 3662
8 3662 <*16: (<ingenting>!D.<dato>.<klokkeslet> *>
8 3663
8 3663 begin
9 3664 if nr=1 then
9 3665 begin
10 3666 if a_res=0 then res:=2 <* godkendt *>
10 3667 else if a_res=12 then
10 3668 begin
11 3669 raf:=0;
11 3670 ia.raf(1):= systid(i1,værdi(2));
11 3671 end
10 3672 else res:=27; <* parametertype *>
10 3673 end
9 3674 else
9 3675 res:= if a_res=0 then 2 <* godkendt *>
9 3676 else 24;<* syntaks *>
9 3677 if res<4 then pos:=a_pos;
9 3678 end; <* partype 16 *>
8 3679 \f
8 3679 message procedure læs_kommando side 20 - 810511/hko;
8 3680
8 3680 <*17: G<grp.nr> *>
8 3681
8 3681 begin
9 3682 if nr=1 then
9 3683 begin
10 3684 if a_res=0 then res:=25 <*parameter mangler *>
10 3685 else if a_res=5 then
10 3686 begin
11 3687 ia(1):= 5 shift 21 +i1;
11 3688 end
10 3689 else res:=27; <* parametertype *>
10 3690 end
9 3691 else
9 3692 res:= if a_res=0 then 2 <* godkendt *>
9 3693 else 24;<* syntaks *>
9 3694 end; <* partype 17 *>
8 3695
8 3695 <* att_op_længde//2 *>
8 3696 <*18: (<heltal>) *>
8 3697 <* 1 *>
8 3698
8 3698 begin
9 3699 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3700 else
9 3701 if nr<=att_op_længde//2 then
9 3702 begin
10 3703 if a_res=2 or a_res=3 <* pos/neg heltal *> then
10 3704 begin
11 3705 ia(nr):= i1; indeks:= nr;
11 3706 end
10 3707 else if a_res=0 then res:= 2
10 3708 else res:= 27; <*parametertype*>
10 3709 end
9 3710 else
9 3711 res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
9 3712 end;
8 3713 \f
8 3713 message procedure læs_kommando side 21 - 820302/cl;
8 3714
8 3714 <*19: <linie>/<løb> <linie>/<løb> *>
8 3715
8 3715 begin
9 3716 if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3717 else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
9 3718 else if nr<3 then
9 3719 begin
10 3720 ia(nr):=i1 + 1 shift 22;
10 3721 end
9 3722 else
9 3723 res:= if a_res=0 then 2 <*godkendt*>
9 3724 else 24;<*syntaks (for mange)*>
9 3725 if res<4 then pos:= a_pos;
9 3726 end; <* partype 19 *>
8 3727
8 3727 <*20: <busnr> <kortnavn> *>
8 3728 begin
9 3729 if nr=1 then
9 3730 begin
10 3731 if ares=0 then res:= 25 else
10 3732 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3733 if ares<>2 then res:= 27 else ia(1):= i1;
10 3734 end
9 3735 else
9 3736 if nr=2 then
9 3737 begin
10 3738 if ares=1 and værdi(2) extract 8 = 0 then
10 3739 begin
11 3740 ia(2):= værdi(1); ia(3):= værdi(2);
11 3741 end
10 3742 else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
10 3743 end
9 3744 else
9 3745 if ares=0 then res:= 2 else res:= 24;
9 3746 end; <* partype 20 *>
8 3747 \f
8 3747 message procedure læs_kommando side 22 - 851001/cl;
8 3748
8 3748 <* 2 *>
8 3749 <*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
8 3750 <* 0 *>
8 3751
8 3751 begin
9 3752 laf:= 0;
9 3753 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3754 else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
9 3755 else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
9 3756 else if a_res=0 then res:= 2 <*godkendt*>
9 3757 else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
9 3758 else if (a_res=2 or a_res=4) and nr<=2 then
9 3759 begin
10 3760 if ia(3)<>0 then res:= 27 else
10 3761 ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
10 3762 end
9 3763 else
9 3764 if ares=1 then
9 3765 begin
10 3766 if nr=1 then
10 3767 begin
11 3768 ia(1):= (4 shift 21) + (1 shift 5);
11 3769 ia(2):= (4 shift 21) + (999 shift 5);
11 3770 end;
10 3771 if ia(3)=-2 then
10 3772 begin
11 3773 if i1=long<:ALL:> shift (-24) extract 24 then
11 3774 ia(3):= -1
11 3775 else
11 3776 begin
12 3777 ia(3):= findområde(i1);
12 3778 if ia(3)=0 then res:= 56 else
12 3779 ia(3):= 14 shift 20 + ia(3);
12 3780 end;
11 3781 end
10 3782 else
10 3783 if ia(3) = 0 then
10 3784 begin
11 3785 if i1 = long<:OMR:> shift (-24) extract (24) then
11 3786 ia(3):= -2
11 3787 else
11 3788 ia(3):= find_bpl(værdi.laf(1));
11 3789 if ia(3)=0 then res:= 55;
11 3790 end
10 3791 else res:= 24;
10 3792 end
9 3793 else res:= 27; <*parametertype*>
9 3794 if res<4 then pos:= apos;
9 3795 end;
8 3796
8 3796 <*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
8 3797
8 3797 begin
9 3798 if nr=1 then
9 3799 begin
10 3800 if ares=0 then res:= 25 <*parameter mangler*>
10 3801 else if ares=2 and (i1<1 or i1>9999)
10 3802 then res:= 7 <* busnr ulovligt *>
10 3803 else if ares=2 or ares=6 then
10 3804 begin
11 3805 ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
11 3806 end
10 3807 else res:= 27 <* parametertype *>
10 3808 end
9 3809 else
9 3810 if nr=2 then
9 3811 begin
10 3812 if ares=0 then res:= 2 <* godkendt *>
10 3813 else if ares=1 then
10 3814 begin
11 3815 ia(2):= findområde(i1);
11 3816 if ia(2)=0 then res:= 17 <*kanal ukendt*>
11 3817 end
10 3818 else
10 3819 res:= 27; <* parametertype *>
10 3820 end
9 3821 else if ares=0 then res:= 2 <*godkendt*>
9 3822 else res:= 24; <*syntaks*>
9 3823 if res < 4 then pos:= apos;
9 3824 end;
8 3825
8 3825 <*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
8 3826
8 3826 begin
9 3827 if nr=1 then
9 3828 begin
10 3829 if ares=0 then res:= 25 else
10 3830 if ares=2 and (i1<1 or i1>999) then res:= 5 else
10 3831 if ares=2 or ares=4 or ares=5 then
10 3832 begin
11 3833 ia(1):=
11 3834 if ares=2 then 4 shift 21 + i1 shift 5 else
11 3835 if ares=4 then 4 shift 21 + i1 else
11 3836 5 shift 21 + i1;
11 3837 end
10 3838 else res:= 27;
10 3839 if res < 4 then pos:= apos;
10 3840 end
9 3841 else
9 3842 if nr=2 then
9 3843 begin
10 3844 if ares=0 then res:= 2 else
10 3845 if ares=1 then
10 3846 begin
11 3847 ia(2):= findområde(i1);
11 3848 if ia(2)=0 then res:= 17;
11 3849 end
10 3850 else res:= 27;
10 3851 end
9 3852 else
9 3853 if ares=0 then res:= 2 else res:= 24;
9 3854 end;
8 3855
8 3855 <*24: ( <ingenting> ! <område> ! * ) *>
8 3856
8 3856 begin
9 3857 if nr=1 then
9 3858 begin
10 3859 if ares=0 then res:= 2 else
10 3860 if ares=1 then
10 3861 begin
11 3862 if i1=long<:ALL:> shift (-24) extract 24 then
11 3863 ia(1):= (-1) shift (-3) shift 3
11 3864 else
11 3865 begin
12 3866 k:= findområde(i1);
12 3867 if k=0 then res:= 17 else
12 3868 ia(1):= 14 shift 20 + k;
12 3869 end;
11 3870 end
10 3871 else res:= 27;
10 3872 end
9 3873 else
9 3874 if ares=0 then res:= 2 else res:= 24;
9 3875 if res < 4 then pos:= apos;
9 3876 end;
8 3877
8 3877 <*25: <område> *>
8 3878
8 3878 begin
9 3879 if nr=1 then
9 3880 begin
10 3881 if ares=0 then res:= 25 else
10 3882 if ares=1 then
10 3883 begin
11 3884 if i1 = '*' shift 16 then ia(1):= -1 else
11 3885 ia(1):= findområde(i1);
11 3886 if ia(1)=0 then res:= 17;
11 3887 end
10 3888 else res:= 27;
10 3889 end
9 3890 else
9 3891 if ares=0 then res:= 2 else res:= 24;
9 3892 if res < 4 then pos:= apos;
9 3893 end;
8 3894
8 3894 <*26: <busnr> *>
8 3895 begin
9 3896 if nr=1 then
9 3897 begin
10 3898 if ares=0 then res:= 25 else
10 3899 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3900 if ares<>2 then res:= 27 else ia(1):= i1;
10 3901 end
9 3902 else
9 3903 if ares=0 then res:= 2 else res:= 24;
9 3904 end;
8 3905
8 3905 <* 8 *>
8 3906 <*27: <operatørnr> (<område>) *>
8 3907 <* 1 *>
8 3908 begin
9 3909 if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3910 else if nr=1 then
9 3911 begin
10 3912 if a_res=2 then
10 3913 begin
11 3914 ia(1):= i1;
11 3915 if i1 < 0 or max_antal_operatører < i1 then res:= 28;
11 3916 end
10 3917 else if a_res=1 then
10 3918 begin
11 3919 laf:= 0;
11 3920 ia(1):= find_bpl(værdi.laf(1));
11 3921 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3922 end
10 3923 else res:= 27; <*parametertype*>
10 3924 end
9 3925 else
9 3926 begin
10 3927 if a_res=0 then res:= (if nr > 2 then 2 else 25)
10 3928 else if nr > 9 then res:= 24
10 3929 else if a_res=1 then
10 3930 begin
11 3931 ia(nr):= find_område(i1);
11 3932 indeks:= nr;
11 3933 if ia(nr)=0 then res:= 56;
11 3934 end
10 3935 else res:= 27;
10 3936 end;
9 3937 if res < 4 then pos:= a_pos;
9 3938 end <* partype 27 *>;
8 3939
8 3939 <*28: (<ingenting>!<kanalnr>) *>
8 3940 begin
9 3941 long field lf;
9 3942
9 3942 if nr=1 then
9 3943 begin
10 3944 if ares=0 then res:= 2 else
10 3945 if ares=1 then
10 3946 begin
11 3947 j:= 0; lf:= 4;
11 3948 for i:= 1 step 1 until max_antal_kanaler do
11 3949 if kanal_navn(i)=værdi.lf then j:= i;
11 3950 if j<>0 then
11 3951 begin
12 3952 ia(1):= 3 shift 22 + j;
12 3953 res:= 2;
12 3954 end
11 3955 else
11 3956 res:= 17; <*kanal ukendt*>
11 3957 end
10 3958 else
10 3959 res:= 27; <*parametertype*>
10 3960 if res < 4 then pos:= apos;
10 3961 end
9 3962 else
9 3963 res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
9 3964 end;
8 3965
8 3965 <* n *>
8 3966 <*29: <btj.pl.navn> ( <operatørnavn>) *>
8 3967 <* 0 *>
8 3968 begin
9 3969 laf:= 0;
9 3970 if nr=1 then
9 3971 begin
10 3972 if a_res=0 then res:= 25 <*parameter mangler*>
10 3973 else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
10 3974 else begin
11 3975 indeks:= 2;
11 3976 ia(1):= værdi(1); ia(2):= værdi(2);
11 3977 j:= find_bpl(værdi.laf(1));
11 3978 if 0<j and j<=max_antal_operatører then
11 3979 res:= 62; <*ulovligt navn*>
11 3980 end;
10 3981 end
9 3982 else
9 3983 begin
10 3984 if a_res=0 then res:= 2 <*godkendt*>
10 3985 else if a_res<>1 then res:= 27 <*parametertype*>
10 3986 else begin
11 3987 indeks:= indeks+1;
11 3988 ia(indeks):= find_bpl(værdi.laf(1));
11 3989 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3990 res:= 28; <*ukendt operatør*>
11 3991 end;
10 3992 end;
9 3993 if res<4 then pos:= a_pos;
9 3994 end;
8 3995
8 3995 <* 3 *>
8 3996 <*30: (<operatørnavn>) ( <btj.pl.navn>) *>
8 3997 <* io 0 *>
8 3998
8 3998 begin
9 3999 boolean io;
9 4000
9 4000 io:= (kilde//100 = 1);
9 4001 laf:= 0;
9 4002 if -,io and nr=1 then
9 4003 begin
10 4004 indeks:= 1;
10 4005 ia(1):= kilde mod 100; <*egen operatørplads*>
10 4006 end;
9 4007
9 4007 if io and nr=1 then
9 4008 begin
10 4009 if a_res=0 then res:= 25 <*parameter mangler*>
10 4010 else if a_res<>1 then res:= 27 <*parametertype*>
10 4011 else begin
11 4012 indeks:= nr;
11 4013 ia(indeks):= find_bpl(værdi.laf(1));
11 4014 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 4015 res:= 28; <*ukendt operatør*>
11 4016 end;
10 4017 end
9 4018 else
9 4019 begin
10 4020 if a_res=0 then res:= 2<*godkendt*>
10 4021 else if indeks=4 then res:= 24 <*syntaks, for mange*>
10 4022 else if a_res<>1 then res:= 27 <*parametertype*>
10 4023 else begin
11 4024 indeks:= indeks+1;
11 4025 ia(indeks):= find_bpl(værdi.laf(1));
11 4026 if ia(indeks)=0 then res:= 46 <*navn ukendt*>
11 4027 else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
11 4028 end;
10 4029 end;
9 4030 if res<4 then pos:= a_pos;
9 4031 end;
8 4032
8 4032 <* *>
8 4033 <*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
8 4034 <* *>
8 4035
8 4035 begin
9 4036 laf:= 0;
9 4037 if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
9 4038 else
9 4039 if nr=1 then
9 4040 begin
10 4041 if a_res=2 then
10 4042 begin
11 4043 ia(1):= i1;
11 4044 if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
11 4045 end else res:= 27; <*parametertype*>
10 4046 end
9 4047 else
9 4048 if nr=2 then
9 4049 begin
10 4050 if a_res=1 and værdi(2) extract 8 = 0 then
10 4051 begin
11 4052 ia(2):= værdi(1); ia(3):= værdi(2);
11 4053 j:= find_bpl(værdi.laf(1));
11 4054 if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
11 4055 end
10 4056 else res:= if a_res=0 then 2 <*godkendt*>
10 4057 else 27 <*parametertype*>;
10 4058 end
9 4059 else
9 4060 if nr=3 then
9 4061 begin
10 4062 if a_res=0 then res:=2 <*godkendt*>
10 4063 else if a_res<>1 then res:= 27 <*parametertype*>
10 4064 else begin
11 4065 j:= værdi(1) shift (-16);
11 4066 if j='Å' then ia(4):= 1 else
11 4067 if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
11 4068 end;
10 4069 end
9 4070 else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
9 4071 if res<4 then pos:= a_pos;
9 4072 end;
8 4073
8 4073 <* 1 *>
8 4074 <*32: (heltal) *>
8 4075 <* 0 *>
8 4076 begin
9 4077 if nr=1 then
9 4078 begin
10 4079 if ares=0 then
10 4080 begin
11 4081 indeks:= 0; res:= 2;
11 4082 end
10 4083 else
10 4084 if ares=2 or ares=3 then
10 4085 begin
11 4086 ia(nr):= i1; indeks:= nr;
11 4087 end
10 4088 else res:=27; <*parametertype*>
10 4089 end
9 4090 else
9 4091 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4092 if res < 4 then pos:= a_pos;
9 4093 end;
8 4094
8 4094 <*33 generel tekst*>
8 4095 begin
9 4096 integer p,p1,ch,lgd;
9 4097
9 4097 if nr=1 and a_res<>0 then
9 4098 begin
10 4099 p:=pos; p1:=1;
10 4100 lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
10 4101 if 95<lgd then lgd:=95;
10 4102 repeat læstegn(d.opref.data,p,ch) until ch<>' ';
10 4103 while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
10 4104 begin
11 4105 skrivtegn(ia,p1,ch);
11 4106 læstegn(d.opref.data,p,ch);
11 4107 end;
10 4108 if p1=1 then res:= 25 else res:= 2;
10 4109 repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
10 4110 end
9 4111 else
9 4112 if a_res=0 then res:= 25 else res:= 24;
9 4113 end;
8 4114
8 4114 <*34: (heltal) *>
8 4115 begin
9 4116 if nr=1 then
9 4117 begin
10 4118 if ares=0 then res:= 25 else
10 4119 if ares=2 or ares=3 then
10 4120 begin
11 4121 ia(nr):= i1; indeks:= nr;
11 4122 end
10 4123 else res:=27; <*parametertype*>
10 4124 end
9 4125 else
9 4126 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4127 if res < 4 then pos:= a_pos;
9 4128 end;
8 4129
8 4129 <*+4*> begin
9 4130 fejlreaktion(4<*systemfejl*>,partype,
9 4131 <:parametertype fejl i kommandofil:>,1);
9 4132 res:=31;
9 4133 end
8 4134 <*-4*>
8 4135 end;<*case partype*>
7 4136 end;<* while læs_param_sæt *>
6 4137 end; <* operationskode ok *>
5 4138 end
4 4139 else
4 4140 begin
5 4141 fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
5 4142 end;
4 4143
4 4143 if a_res<0 then res:= -a_res;
4 4144 slut_læskommando:
4 4145
4 4145 læs_kommando:=d.op_ref.resultat:= res;
4 4146 end;<* disable-blok*>
3 4147 end læs_kommando;
2 4148 \f
2 4148 message procedure skriv_kvittering side 1 - 820301/hko/cl;
2 4149
2 4149 procedure skriv_kvittering(z,ref,pos,res);
2 4150 value ref,pos,res;
2 4151 zone z;
2 4152 integer ref,pos,res;
2 4153 begin
3 4154 integer array field op;
3 4155 integer pos1,tegn;
3 4156 op:=ref;
3 4157 if res<1 or res>3 then write(z,<:*** :>);
3 4158 write(z,case res+1 of (
3 4159 <* 0*><:ubehandlet:>,
3 4160 <* 1*><:ok:>,
3 4161 <* 2*><:godkendt:>,
3 4162 <* 3*><:udført:>,
3 4163 <* 4*><:kommando ukendt:>,
3 4164
3 4164 <* 5*><:linie-nr ulovligt:>,
3 4165 <* 6*><:løb-nr ulovligt:>,
3 4166 <* 7*><:bus-nr ulovligt:>,
3 4167 <* 8*><:gruppe ukendt:>,
3 4168 <* 9*><:linie/løb ukendt:>,
3 4169
3 4169 <*10*><:bus-nr ukendt:>,
3 4170 <*11*><:bus allerede indsat på :>,
3 4171 <*12*><:linie/løb allerede besat af :>,
3 4172 <*13*><:bus ikke indsat:>,
3 4173 <*14*><:bus optaget:>,
3 4174
3 4174 <*15*><:gruppe optaget:>,
3 4175 <*16*><:skærm optaget:>,
3 4176 <*17*><:kanal ukendt:>,
3 4177 <*18*><:bus i kø:>,
3 4178 <*19*><:kø er tom:>,
3 4179
3 4179 <*20*><:ej forbindelse :>,
3 4180 <*21*><:ingen at gennemstille til:>,
3 4181 <*22*><:ingen samtale at nedlægge:>,
3 4182 <*23*><:ingen samtale at monitere:>,
3 4183 <*24*><:syntaks:>,
3 4184
3 4184 <*25*><:syntaks, parameter mangler:>,
3 4185 <*26*><:syntaks, skilletegn:>,
3 4186 <*27*><:syntaks, parametertype:>,
3 4187 <*28*><:operatør ukendt:>,
3 4188 <*29*><:garageterminal ukendt:>,
3 4189 \f
3 4189
3 4189 <*30*><:rapport kan ikke dannes:>,
3 4190 <*31*><:systemfejl:>,
3 4191 <*32*><:ingen fri plads:>,
3 4192 <*33*><:gruppe for stor:>,
3 4193 <*34*><:gruppe allerede defineret:>,
3 4194
3 4194 <*35*><:springsekvens for stor:>,
3 4195 <*36*><:spring allerede defineret:>,
3 4196 <*37*><:spring ukendt:>,
3 4197 <*38*><:spring allerede igangsat:>,
3 4198 <*39*><:bus ikke reserveret:>,
3 4199
3 4199 <*40*><:gruppe ikke reserveret:>,
3 4200 <*41*><:spring ikke igangsat:>,
3 4201 <*42*><:intet frit linie/løb:>,
3 4202 <*43*><:ændring af dato/tid ikke lovlig:>,
3 4203 <*44*><:interval-størrelse ulovlig:>,
3 4204
3 4204 <*45*><:ikke implementeret:>,
3 4205 <*46*><:navn ukendt:>,
3 4206 <*47*><:forkert indhold:>,
3 4207 <*48*><:i brug:>,
3 4208 <*49*><:ingen samtale igang:>,
3 4209
3 4209 <*50*><:kanal:>,
3 4210 <*51*><:afvist:>,
3 4211 <*52*><:kanal optaget :>,
3 4212 <*53*><:annulleret:>,
3 4213 <*54*><:ingen busser at kalde op:>,
3 4214
3 4214 <*55*><:garagenavn ukendt:>,
3 4215 <*56*><:område ukendt:>,
3 4216 <*57*><:område nødvendigt:>,
3 4217 <*58*><:ulovligt område for bus:>,
3 4218 <*59*><:radiofejl :>,
3 4219
3 4219 <*60*><:område kan ikke opdateres:>,
3 4220 <*61*><:ingen talevej:>,
3 4221 <*62*><:ulovligt navn:>,
3 4222 <*63*><:alarmlængde: :>,
3 4223 <*64*><:ulovligt tal:>,
3 4224
3 4224 <*99*><:- <'?'> -:>));
3 4225 \f
3 4225 message procedure skriv_kvittering side 3 - 820301/hko;
3 4226 if res=3 and op<>0 then
3 4227 begin
4 4228 if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
4 4229 begin
5 4230 i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
5 4231 if i<>0 then write(z,i,<: udtaget:>);
5 4232 end;
4 4233 end;
3 4234 if res = 11 or res = 12 then
3 4235 i:=ref;
3 4236 if res=11 then write(z,i shift(-12) extract 10,
3 4237 if i shift(-7) extract 5 =0 then false
3 4238 else "A" add (i shift(-7) extract 5 -1),1,
3 4239 <:/:>,<<d>,i extract 7) else
3 4240 if res=12 then write(z,i extract 14) else
3 4241 if res = 20 or res = 52 or res = 59 then
3 4242 begin
4 4243 i:= d.op.data(12);
4 4244 if i <> 0 then skriv_id(z,i,8);
4 4245 i:=d.op.data(2);
4 4246 if i=0 then i:=d.op.data(9);
4 4247 if i=0 then i:=d.op.data(8);
4 4248 skriv_id(z,i,8);
4 4249 end;
3 4250 if res=63 then
3 4251 begin
4 4252 i:= ref;
4 4253 if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
4 4254 end;
3 4255
3 4255 if pos>=0 then
3 4256 begin
4 4257 pos:=pos+1;
4 4258 outchar(z,':');
4 4259 tegn:=-1;
4 4260 while tegn<>10 and tegn<>0 do
4 4261 outchar(z,læs_tegn(d.op.data,pos,tegn));
4 4262 end;
3 4263 <*V*>setposition(z,0,0);
3 4264 end skriv_kvittering;
2 4265 \f
2 4265 message procedure cursor, side 1 - 810213/hko;
2 4266
2 4266 procedure cursor(z,linie,pos);
2 4267 value linie,pos;
2 4268 zone z;
2 4269 integer linie,pos;
2 4270 begin
3 4271 if linie>0 and linie<25
3 4272 and pos>0 and pos<81 then
3 4273 begin
4 4274 write(z,"esc" add 128,1,<:Æ:>,
4 4275 <<d>,linie,<:;:>,pos,<:H:>);
4 4276 end;
3 4277 end cursor;
2 4278 \f
2 4278 message procedure attention side 1 - 810529/hko;
2 4279
2 4279 procedure attention;
2 4280 begin
3 4281 integer i, j, k;
3 4282 integer array field op_ref,mess_ref;
3 4283 integer array att_message(1:9);
3 4284 long array field laf1, laf2;
3 4285 boolean optaget;
3 4286 procedure skriv_attention(zud,omfang);
3 4287 integer omfang;
3 4288 zone zud;
3 4289 begin
4 4290 write(zud,"nl",1,<:+++ attention :>);
4 4291 if omfang <> 0 then
4 4292 disable begin integer x;
5 4293 trap(slut);
5 4294 write(zud,"nl",1,
5 4295 <: i: :>,i,"nl",1,
5 4296 <: j: :>,j,"nl",1,
5 4297 <: k: :>,k,"nl",1,
5 4298 <: op-ref: :>,op_ref,"nl",1,
5 4299 <: mess-ref: :>,mess_ref,"nl",1,
5 4300 <: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
5 4301 <: laf2 :>,laf2,"nl",1,
5 4302 <: att-message::>,"nl",1,
5 4303 <::>);
5 4304 raf:= 0;
5 4305 skriv_hele(zud,att_message.raf,18,127);
5 4306 skriv_coru(zud,coru_no(010));
5 4307 slut:
5 4308 end;
4 4309 end skriv_attention;
3 4310
3 4310 integer procedure udtag_tal(tekst,pos);
3 4311 long array tekst;
3 4312 integer pos;
3 4313 begin
4 4314 integer i;
4 4315
4 4315 if getnumber(tekst,pos,i) >= 0 then
4 4316 udtag_tal:= i
4 4317 else
4 4318 udtag_tal:= 0;
4 4319 end;
3 4320
3 4320 for i:= 1 step 1 until att_maske_lgd//2 do
3 4321 att_signal(i):=att_flag(i):=0;
3 4322 trap(att_trap);
3 4323 stack_claim((if cm_test then 198 else 146)+50);
3 4324 <*+2*>
3 4325 if testbit26 and overvåget or testbit28 then
3 4326 skriv_attention(out,0);
3 4327 <*-2*>
3 4328 \f
3 4328 message procedure attention side 2 - 810406/hko;
3 4329
3 4329 repeat
3 4330
3 4330 wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
3 4331
3 4331 repeat
3 4332 <*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
3 4333 raf:= laf1:= 0;
3 4334 laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
3 4335
3 4335 <*+2*>if testbit7 and overvåget then
3 4336 disable begin
4 4337 laf2:= abs(laf);
4 4338 write(out,"nl",1,<:attention - :>);
4 4339 if laf<=0 then write(out,<:Regrettet :>);
4 4340 write(out,<:Message modtaget fra :>);
4 4341 if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
4 4342 skriv_hele(out,att_message.raf,16,127);
4 4343 ud;
4 4344 end;
3 4345 <*-2*>
3 4346 \f
3 4346 message procedure attention side 3 - 830310/cl;
3 4347
3 4347 if laf <= 0 then
3 4348 i:= -1
3 4349 else
3 4350 if core.laf(1)=konsol_navn.laf1(1)
3 4351 and core.laf(2)=konsol_navn.laf1(2) then
3 4352 i:= 101
3 4353 else
3 4354 begin
4 4355 i:= -1; j:= 1;
4 4356 while i=(-1) and (j <= max_antal_operatører) do
4 4357 begin
5 4358 laf2:= (j-1)*8;
5 4359 if core.laf(1) = terminal_navn.laf2(1)
5 4360 and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
5 4361 j:= j+1;
5 4362 end;
4 4363 j:= 1;
4 4364 while i=(-1) and (j<=max_antal_garageterminaler) do
4 4365 begin
5 4366 laf2:= (j-1)*8;
5 4367 if core.laf(1) = garage_terminal_navn.laf2(1)
5 4368 and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
5 4369 j:= j+1;
5 4370 end;
4 4371 end;
3 4372
3 4372 if i=101 or (201<=i and i<=200+max_antal_operatører)
3 4373 <* or (301<=i and i<=300+max_antal_garageterminaler) *>
3 4374 then
3 4375 begin
4 4376
4 4376 j:= if i=101 then 0
4 4377 else max_antal_operatører*(i//100-2)+i mod 100;
4 4378
4 4378 ref:=j*terminal_beskr_længde;
4 4379 att_message(9):=
4 4380 if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
4 4381 else 4 <*disconnected*>;
4 4382 optaget:=læsbit_ia(att_flag,j);
4 4383 if optaget and att_message(9)=1 then
4 4384 sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
4 4385 else optaget:=optaget or att_message(9)<>1;
4 4386 if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
4 4387 begin <* att fra ekskluderet operatør - inkluder *>
5 4388 start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
5 4389 d.op_ref.data(1):= i mod 100;
5 4390 signalch(cs_rad,op_ref,gen_optype);
5 4391 waitch(cs_att_pulje,op_ref,true,-1);
5 4392 end;
4 4393 end
3 4394 else
3 4395 begin
4 4396 optaget:= true;
4 4397 att_message(9):= 2 <*rejected*>;
4 4398 end;
3 4399
3 4399 monitor(22)send_answer:(zdummy,mess_ref,att_message);
3 4400
3 4400 until -,optaget;
3 4401 \f
3 4401 message procedure attention side 4 - 810424/hko;
3 4402
3 4402 sætbit_ia(att_flag,j,1);
3 4403
3 4403 start_operation(op_ref,i,cs_att_pulje,0);
3 4404
3 4404 signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
3 4405
3 4405 until false;
3 4406
3 4406 att_trap:
3 4407
3 4407 skriv_attention(zbillede,1);
3 4408
3 4408
3 4408 end attention;
2 4409
2 4409 \f
2 4409 message io_erklæringer side 1 - 810421/hko;
2 4410
2 4410 integer
2 4411 cs_io,
2 4412 cs_io_komm,
2 4413 cs_io_fil,
2 4414 cs_io_spool,
2 4415 cs_io_medd,
2 4416 cs_io_nulstil,
2 4417 ss_io_spool_tomme,
2 4418 ss_io_spool_fulde,
2 4419 bs_zio_adgang,
2 4420 io_spool_fil,
2 4421 io_spool_postantal,
2 4422 io_spool_postlængde;
2 4423
2 4423 integer array field
2 4424 io_spool_post;
2 4425
2 4425 zone z_io(32,1,io_fejl);
2 4426
2 4426 procedure io_fejl(z,s,b);
2 4427 integer s,b;
2 4428 zone z;
2 4429 begin
3 4430 disable begin
4 4431 integer array iz(1:20);
4 4432 integer i,j,k;
4 4433 integer array field iaf;
4 4434 real array field raf;
4 4435 if s<>(1 shift 21 + 2) then
4 4436 begin
5 4437 getzone6(z,iz);
5 4438 raf:=2;
5 4439 iaf:=0;
5 4440 k:=1;
5 4441
5 4441 j:= terminal_tab.iaf.terminal_tilstand;
5 4442 if j shift(-21)<>6 then
5 4443 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
5 4444 1 shift 12 <*binært*> +1 <*fortsæt*>);
5 4445 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
5 4446 + terminal_tab.iaf.terminal_tilstand extract 21;
5 4447 end;
4 4448 z(1):=real <:<'?'><'?'><'em'>:>;
4 4449 b:=2;
4 4450 end; <*disable*>
3 4451 end io_fejl;
2 4452 \f
2 4452 message procedure skriv_auto_spring_medd side 1 - 820301/hko;
2 4453
2 4453 procedure skriv_auto_spring_medd(z,medd,tid);
2 4454 value tid;
2 4455 zone z;
2 4456 real tid;
2 4457 integer array medd;
2 4458 begin
3 4459 disable begin
4 4460 real t;
4 4461 integer kode,bus,linie,bogst,løb,dato,kl;
4 4462 long array indeks(1:1);
4 4463 kode:= medd(1);
4 4464 indeks(1):= extend medd(5) shift 24;
4 4465 if kode > 0 and kode < 10 then
4 4466 begin
5 4467 write(z,"nl",0,<:-<'>'>:>,case kode of(
5 4468 <*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
5 4469 <*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
5 4470 <*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
5 4471 <*4*><:vogn optaget:>, <* - i - - / - *>
5 4472 <*5*><:spring annulleret:>, <*udløb af ventetid *>
5 4473 <*6*><::>, <* - af springliste *>
5 4474 <*7*><::>, <*start af springsekvens *>
5 4475 <*8*><::>, <*afvikling af springsekvens *>
5 4476 <*9*><:område kan ikke opdateres:>,<*vt-ændring*>
5 4477 <::>));
5 4478 <* if kode = 5 then
5 4479 begin
5 4480 bogst:= medd(4);
5 4481 linie:= bogst shift(-5) extract 10;
5 4482 bogst:= bogst extract 5;
5 4483 if bogst > 0 then bogst:= bogst +'A'-1;
5 4484 write(z,"sp",1,<<z>,linie,false add bogst,1,
5 4485 ".",1,indeks);
5 4486 end;
5 4487 *>
5 4488 outchar(z,'sp');
5 4489 bus:= medd(2) extract 14;
5 4490 if bus > 0 then
5 4491 write(z,<<z>,bus,"/",1);
5 4492 løb:= medd(3);
5 4493 <*+4*> if løb shift(-22) <> 1 and løb <> 0 then
5 4494 fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
5 4495 <*-4*>
5 4496 \f
5 4496 message procedure skriv_auto_spring_medd side 2 - 810507/hko;
5 4497
5 4497 linie:= løb shift(-12) extract 10;
5 4498 bogst:= løb shift(-7) extract 5;
5 4499 if bogst > 0 then bogst:= bogst +'A'-1;
5 4500 løb:= løb extract 7;
5 4501 if medd(3) <> 0 or kode <> 5 then
5 4502 begin
6 4503 write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
6 4504 if kode = 5 or kode = 6 then write(z,<:er frit :>);
6 4505 end;
5 4506 if kode = 7 or kode = 8 then
5 4507 write(z,<*indeks,"sp",1,*>
5 4508 if kode=7 then <:udtaget :> else <:indsat :>);
5 4509
5 4509 dato:= systime(4,tid,t);
5 4510 kl:= t/100.0;
5 4511 løb:= replace_char(1<*space in number*>,'.');
5 4512 write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
5 4513 replace_char(1,løb);
5 4514 end
4 4515 else <*kode < 1 or kode > 8*>
4 4516 fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
4 4517 end; <*disable*>
3 4518 end skriv_auto_spring_medd;
2 4519 \f
2 4519 message procedure h_io side 1 - 810507/hko;
2 4520
2 4520 <* hovedmodulkorutine for io *>
2 4521 procedure h_io;
2 4522 begin
3 4523 integer array field op_ref;
3 4524 integer k,dest_sem;
3 4525 procedure skriv_hio(zud,omfang);
3 4526 value omfang;
3 4527 zone zud;
3 4528 integer omfang;
3 4529 begin
4 4530
4 4530 write(zud,"nl",1,<:+++ hovedmodul io :>);
4 4531 if omfang>0 then
4 4532 disable begin integer x;
5 4533 trap(slut);
5 4534 write(zud,"nl",1,
5 4535 <: op_ref: :>,op_ref,"nl",1,
5 4536 <: k: :>,k,"nl",1,
5 4537 <: dest_sem: :>,dest_sem,"nl",1,
5 4538 <::>);
5 4539 skriv_coru(zud,coru_no(100));
5 4540 slut:
5 4541 end;
4 4542 end skriv_hio;
3 4543
3 4543 trap(hio_trap);
3 4544 stack_claim(if cm_test then 198 else 146);
3 4545
3 4545 <*+2*>
3 4546 if testbit0 and overvåget or testbit28 then
3 4547 skriv_hio(out,0);
3 4548 <*-2*>
3 4549 \f
3 4549 message procedure h_io side 2 - 810507/hko;
3 4550
3 4550 repeat
3 4551 wait_ch(cs_io,op_ref,true,-1);
3 4552 <*+4*>
3 4553 if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
3 4554 then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
3 4555 <*-4*>
3 4556
3 4556 k:=d.op_ref.opkode extract 12;
3 4557 dest_sem:=
3 4558 if k = 0 <*attention*> then cs_io_komm else
3 4559
3 4559 if k = 22 <*auto vt opdatering*>
3 4560 or k = 23 <*generel meddelelse*>
3 4561 or k = 36 <*spring meddelelse*>
3 4562 or k = 44 <*udeladt i gruppeopkald*>
3 4563 or k = 45 <*nødopkald modtaget*>
3 4564 or k = 46 <*nødopkald besvaret*> then cs_io_spool else
3 4565
3 4565 if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
3 4566 0;
3 4567 <*+4*>
3 4568 if dest_sem = 0 then
3 4569 begin
4 4570 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
4 4571 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 4572 end
3 4573 else
3 4574 <*-4*>
3 4575 begin
4 4576 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 4577 end;
3 4578 until false;
3 4579
3 4579 hio_trap:
3 4580 disable skriv_hio(zbillede,1);
3 4581 end h_io;
2 4582 \f
2 4582 message procedure io_komm side 1 - 810507/hko;
2 4583
2 4583 procedure io_komm;
2 4584 begin
3 4585 integer array field op_ref,ref,vt_op,iaf;
3 4586 integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
3 4587 pos,indeks,sep,sluttegn,operatør,i,j,k;
3 4588 long navn;
3 4589
3 4589 procedure skriv_io_komm(zud,omfang);
3 4590 value omfang;
3 4591 zone zud;
3 4592 integer omfang;
3 4593 begin
4 4594
4 4594 disable
4 4595
4 4595 write(zud,"nl",1,<:+++ io_komm :>);
4 4596 if omfang > 0 then
4 4597 disable begin integer x;
5 4598 trap(slut);
5 4599 write(zud,"nl",1,
5 4600 <: op-ref: :>,op_ref,"nl",1,
5 4601 <: kode: :>,kode,"nl",1,
5 4602 <: aktion: :>,aktion,"nl",1,
5 4603 <: ref: :>,ref,"nl",1,
5 4604 <: vt_op: :>,vt_op,"nl",1,
5 4605 <: status: :>,status,"nl",1,
5 4606 <: opgave: :>,opgave,"nl",1,
5 4607 <: dest-sem: :>,dest_sem,"nl",1,
5 4608 <: iaf: :>,iaf,"nl",1,
5 4609 <: i: :>,i,"nl",1,
5 4610 <: j: :>,j,"nl",1,
5 4611 <: k: :>,k,"nl",1,
5 4612 <: navn: :>,string navn,"nl",1,
5 4613 <: pos: :>,pos,"nl",1,
5 4614 <: indeks: :>,indeks,"nl",1,
5 4615 <: sep: :>,sep,"nl",1,
5 4616 <: sluttegn: :>,sluttegn,"nl",1,
5 4617 <: vogn: :>,vogn,"nl",1,
5 4618 <: ll: :>,ll,"nl",1,
5 4619 <: omr: :>,omr,"nl",1,
5 4620 <: operatør: :>,operatør,"nl",1,
5 4621 <::>);
5 4622 skriv_coru(zud,coru_no(101));
5 4623 slut:
5 4624 end;
4 4625 end skriv_io_komm;
3 4626 \f
3 4626 message procedure io_komm side 2 - 810424/hko;
3 4627
3 4627 trap(io_komm_trap);
3 4628 stack_claim((if cm_test then 200 else 146)+24+200);
3 4629
3 4629 ref:=0;
3 4630 navn:= long<::>;
3 4631
3 4631 <*+2*>
3 4632 if testbit0 and overvåget or testbit28 then
3 4633 skriv_io_komm(out,0);
3 4634 <*-2*>
3 4635
3 4635 repeat
3 4636
3 4636 <*V*> wait_ch(cs_io_komm,
3 4637 op_ref,
3 4638 true,
3 4639 -1<*timeout*>);
3 4640 <*+2*>
3 4641 if testbit1 and overvåget then
3 4642 disable begin
4 4643 skriv_io_komm(out,0);
4 4644 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
4 4645 <: til io :>);
4 4646 skriv_op(out,op_ref);
4 4647 end;
3 4648 <*-2*>
3 4649
3 4649 kode:= d.op_ref.op_kode;
3 4650 i:= terminal_tab.ref.terminal_tilstand;
3 4651 status:= i shift(-21);
3 4652 opgave:=
3 4653 if kode=0 then 1 <* indlæs kommando *> else
3 4654 0; <* afvises *>
3 4655
3 4655 aktion:= if opgave = 0 then 0 else
3 4656 (case status +1 of(
3 4657 <* status *>
3 4658 <* 0 klar *>(1),
3 4659 <* 1 - *>(-1),<* ulovlig tilstand *>
3 4660 <* 2 - *>(-1),<* ulovlig tilstand *>
3 4661 <* 3 stoppet *>(2),
3 4662 <* 4 noneksist *>(-1),<* ulovlig tilstand *>
3 4663 <* 5 - *>(-1),<* ulovlig tilstand *>
3 4664 <* 6 - *>(-1),<* ulovlig tilstand *>
3 4665 <* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
3 4666 -1));
3 4667 \f
3 4667 message procedure io_komm side 3 - 810428/hko;
3 4668
3 4668 case aktion+6 of
3 4669 begin
4 4670 begin
5 4671 <*-5: terminal optaget *>
5 4672
5 4672 d.op_ref.resultat:= 16;
5 4673 afslut_operation(op_ref,-1);
5 4674 end;
4 4675
4 4675 begin
5 4676 <*-4: operation uden virkning *>
5 4677
5 4677 afslut_operation(op_ref,-1);
5 4678 end;
4 4679
4 4679 begin
5 4680 <*-3: ulovlig operationskode *>
5 4681
5 4681 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 4682 afslut_operation(op_ref,-1);
5 4683 end;
4 4684
4 4684 begin
5 4685 <*-2: ulovlig aktion *>
5 4686
5 4686 fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
5 4687 afslut_operation(op_ref,-1);
5 4688 end;
4 4689
4 4689 begin
5 4690 <*-1: ulovlig io_tilstand *>
5 4691
5 4691 fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
5 4692 afslut_operation(op_ref,-1);
5 4693 end;
4 4694
4 4694 begin
5 4695 <* 0: ikke implementeret *>
5 4696
5 4696 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 4697 afslut_operation(op_ref,-1);
5 4698 end;
4 4699
4 4699 begin
5 4700 \f
5 4700 message procedure io_komm side 4 - 851001/cl;
5 4701
5 4701 <* 1: indlæs kommando *>
5 4702 <*V*> wait(bs_zio_adgang);
5 4703
5 4703 <*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
5 4704
5 4704 if d.op_ref.resultat > 3 then
5 4705 begin
6 4706 <*V*> setposition(z_io,0,0);
6 4707 if sluttegn<>'nl' then outchar(z_io,'nl');
6 4708 skriv_kvittering(z_io,op_ref,pos,
6 4709 d.op_ref.resultat);
6 4710 end
5 4711 else if d.op_ref.resultat>0 then
5 4712 begin <*godkendt*>
6 4713 kode:=d.op_ref.opkode;
6 4714 i:= kode extract 12;
6 4715 j:= if kode < 5 or
6 4716 kode=7 or kode=8 or
6 4717 kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
6 4718 if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
6 4719 if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
6 4720 if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
6 4721 kode=20 or kode=24 then 4<*VO,F/VO,R*>else
6 4722 if kode =21 then 5 <*AU*> else
6 4723 if kode =25 then 6 <*GR,D*> else
6 4724 if kode =26 then 5 <*GR,S*> else
6 4725 if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
6 4726 if kode =30 then 10 <*SP,D*> else
6 4727 if kode =31 then 5 <*SP*> else
6 4728 if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
6 4729 if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
6 4730 if kode=71 then 11 <*FO,V*> else
6 4731 if kode =75 then 12 <*TÆ,V *>else
6 4732 if kode =76 then 12 <*TÆ,N *>else
6 4733 if kode =65 then 13 <*BE,N *>else
6 4734 if kode =66 then 14 <*BE,G *>else
6 4735 if kode =67 then 15 <*BE,V *>else
6 4736 if kode =68 then 16 <*ST,D *>else
6 4737 if kode =69 then 17 <*ST,V *>else
6 4738 if kode =36 then 18 <*AL *>else
6 4739 if kode =37 then 19 <*CC *>else
6 4740 if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
6 4741 if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
6 4742 0;
6 4743 if j > 0 then
6 4744 begin
7 4745 case j of
7 4746 begin
8 4747 begin
9 4748 \f
9 4748 message procedure io_komm side 5 - 810424/hko;
9 4749
9 4749 <* 1: inkluder/ekskluder ydre enhed *>
9 4750
9 4750 d.op_ref.retur:= cs_io_komm;
9 4751 if kode=1 then d.opref.opkode:=
9 4752 ia(2) shift 12 + d.opref.opkode extract 12;
9 4753 d.op_ref.data(1):= ia(1);
9 4754 signal_ch(if kode < 5 or kode>=72 then cs_rad
9 4755 else cs_gar,
9 4756 op_ref,gen_optype or io_optype);
9 4757 indeks:= op_ref;
9 4758 wait_ch(cs_io_komm,
9 4759 op_ref,
9 4760 true,
9 4761 -1<*timeout*>);
9 4762 <*+4*> if op_ref <> indeks then
9 4763 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4764 <*-4*>
9 4765 <*V*> setposition(z_io,0,0);
9 4766 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4767 skriv_kvittering(z_io,op_ref,-1,
9 4768 d.op_ref.resultat);
9 4769 end;
8 4770
8 4770 begin
9 4771 \f
9 4771 message procedure io_komm side 6 - 810501/hko;
9 4772
9 4772 <* 2: tid/attention,ja/attention,nej
9 4773 slut/slut med billede *>
9 4774
9 4774 case d.op_ref.opkode -79 of
9 4775 begin
10 4776
10 4776 <* 80: TI *> begin
11 4777 setposition(z_io,0,0);
11 4778 if sluttegn<>'nl' then outchar(z_io,'nl');
11 4779 if ia(1) <> 0 or ia(2) <> 0 then
11 4780 begin real field rf;
12 4781 rf:= 4;
12 4782 trap(forbudt);
12 4783 <*V*> setposition(z_io,0,0);
12 4784 systime(3,ia.rf,0.0);
12 4785 if false then
12 4786 begin
13 4787 forbudt: skriv_kvittering(z_io,0,-1,
13 4788 43<*ændring af dato/tid ikke lovlig*>);
13 4789 end
12 4790 else
12 4791 skriv_kvittering(z_io,0,-1,3);
12 4792 end
11 4793 else
11 4794 begin
12 4795 setposition(z_io,0,0);
12 4796 write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
12 4797 end;
11 4798 end TI;
10 4799 \f
10 4799 message procedure io_komm side 7 - 810424/hko;
10 4800
10 4800 <*81: AT,J*> begin
11 4801 <*V*> setposition(z_io,0,0);
11 4802 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4803 monitor(10)release process:(z_io,0,ia);
11 4804 skriv_kvittering(z_io,0,-1,3);
11 4805 end;
10 4806
10 4806 <* 82: AT,N*> begin
11 4807 i:= monitor(8)reserve process:(z_io,0,ia);
11 4808 <*V*> setposition(z_io,0,0);
11 4809 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4810 skriv_kvittering(z_io,0,-1,
11 4811 if i = 0 then 3 else 0);
11 4812 end;
10 4813
10 4813 <* 83: SL *> begin
11 4814 errorbits:=0; <* warning.no ok.yes *>
11 4815 trapmode:= 1 shift 13;
11 4816 trap(-2);
11 4817 end;
10 4818
10 4818 <* 84: SL,B *>begin
11 4819 errorbits:=1; <* warning.no ok.no *>
11 4820 trap(-3);
11 4821 end;
10 4822 <* 85: SL,K *>begin
11 4823 errorbits:=1; <* warning.no ok.no *>
11 4824 disable sæt_bit_i(trapmode,15,0);
11 4825 trap(-3);
11 4826 end;
10 4827 \f
10 4827 message procedure io_komm side 7a - 810511/cl;
10 4828
10 4828 <* 86: TE,J *>begin
11 4829 setposition(z_io,0,0);
11 4830 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4831 for i:= 1 step 1 until indeks do
11 4832 if 0<=ia(i) and ia(i)<=47 then
11 4833 begin
12 4834 case (ia(i)+1) of
12 4835 begin
13 4836 testbit0 := true;testbit1 := true;testbit2 := true;
13 4837 testbit3 := true;testbit4 := true;testbit5 := true;
13 4838 testbit6 := true;testbit7 := true;testbit8 := true;
13 4839 testbit9 := true;testbit10:= true;testbit11:= true;
13 4840 testbit12:= true;testbit13:= true;testbit14:= true;
13 4841 testbit15:= true;testbit16:= true;testbit17:= true;
13 4842 testbit18:= true;testbit19:= true;testbit20:= true;
13 4843 testbit21:= true;testbit22:= true;testbit23:= true;
13 4844 testbit24:= true;testbit25:= true;testbit26:= true;
13 4845 testbit27:= true;testbit28:= true;testbit29:= true;
13 4846 testbit30:= true;testbit31:= true;testbit32:= true;
13 4847 testbit33:= true;testbit34:= true;testbit35:= true;
13 4848 testbit36:= true;testbit37:= true;testbit38:= true;
13 4849 testbit39:= true;testbit40:= true;testbit41:= true;
13 4850 testbit42:= true;testbit43:= true;testbit44:= true;
13 4851 testbit45:= true;testbit46:= true;testbit47:= true;
13 4852 end;
12 4853 end;
11 4854 skriv_kvittering(z_io,0,-1,3);
11 4855 end;
10 4856 \f
10 4856 message procedure io_komm side 7b - 810511/cl;
10 4857
10 4857 <* 87: TE,N *>begin
11 4858 setposition(z_io,0,0);
11 4859 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4860 for i:= 1 step 1 until indeks do
11 4861 if 0<=ia(i) and ia(i)<=47 then
11 4862 begin
12 4863 case (ia(i)+1) of
12 4864 begin
13 4865 testbit0 := false;testbit1 := false;testbit2 := false;
13 4866 testbit3 := false;testbit4 := false;testbit5 := false;
13 4867 testbit6 := false;testbit7 := false;testbit8 := false;
13 4868 testbit9 := false;testbit10:= false;testbit11:= false;
13 4869 testbit12:= false;testbit13:= false;testbit14:= false;
13 4870 testbit15:= false;testbit16:= false;testbit17:= false;
13 4871 testbit18:= false;testbit19:= false;testbit20:= false;
13 4872 testbit21:= false;testbit22:= false;testbit23:= false;
13 4873 testbit24:= false;testbit25:= false;testbit26:= false;
13 4874 testbit27:= false;testbit28:= false;testbit29:= false;
13 4875 testbit30:= false;testbit31:= false;testbit32:= false;
13 4876 testbit33:= false;testbit34:= false;testbit35:= false;
13 4877 testbit36:= false;testbit37:= false;testbit38:= false;
13 4878 testbit39:= false;testbit40:= false;testbit41:= false;
13 4879 testbit42:= false;testbit43:= false;testbit44:= false;
13 4880 testbit45:= false;testbit46:= false;testbit47:= false;
13 4881 end;
12 4882 end;
11 4883 skriv_kvittering(z_io,0,-1,3);
11 4884 end;
10 4885
10 4885 <* 88: O *> begin
11 4886 integer array odescr,zdescr(1:20);
11 4887 long array field laf;
11 4888 integer res, i, j;
11 4889
11 4889 i:= j:= 1;
11 4890 while læstegn(ia,i,res)<>0 do
11 4891 begin
12 4892 if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
12 4893 skrivtegn(ia,j,res);
12 4894 end;
11 4895
11 4895 laf:= 2;
11 4896 getzone6(out,odescr);
11 4897 getzone6(z_io,zdescr);
11 4898 close(out,zdescr.laf(1)<>odescr.laf(1) or
11 4899 zdescr.laf(2)<>odescr.laf(2));
11 4900 laf:= 0;
11 4901
11 4901 if ia(1)=0 then
11 4902 begin
12 4903 res:= 3;
12 4904 j:= 0;
12 4905 end
11 4906 else
11 4907 begin
12 4908 j:= res:= openbs(out,j,ia,0);
12 4909 if res<>0 then
12 4910 res:= 46;
12 4911 end;
11 4912 if res<>0 then
11 4913 begin
12 4914 open(out,8,konsol_navn,0);
12 4915 if j<>0 then
12 4916 begin
13 4917 i:= 1;
13 4918 fejlreaktion(4,j,string ia.laf(increase(i)),1);
13 4919 end;
12 4920 end
11 4921 else res:= 3;
11 4922 setposition(z_io,0,0);
11 4923 skriv_kvittering(z_io,0,-1,res);
11 4924 end;
10 4925 end;<*case d.op_ref.opkode -79*>
9 4926 end;<*case 2*>
8 4927 begin
9 4928 \f
9 4928 message procedure io_komm side 8 - 810424/hko;
9 4929
9 4929 <* 3: vogntabel,linienr/-,busnr*>
9 4930
9 4930 d.op_ref.retur:= cs_io_komm;
9 4931 tofrom(d.op_ref.data,ia,10);
9 4932 indeks:= op_ref;
9 4933 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 4934 wait_ch(cs_io_komm,
9 4935 op_ref,
9 4936 io_optype,
9 4937 -1<*timeout*>);
9 4938 <*+2*> if testbit2 and overvåget then
9 4939 disable begin
10 4940 skriv_io_komm(out,0);
10 4941 write(out,"nl",1,<:io operation retur fra vt:>);
10 4942 skriv_op(out,op_ref);
10 4943 end;
9 4944 <*-2*>
9 4945 <*+4*> if indeks <> op_ref then
9 4946 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4947 <*-4*>
9 4948
9 4948 i:=d.op_ref.resultat;
9 4949 if i<1 or i>3 then
9 4950 begin
10 4951 <*V*> setposition(z_io,0,0);
10 4952 if sluttegn<>'nl' then outchar(z_io,'nl');
10 4953 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 4954 end
9 4955 else
9 4956 begin
10 4957 \f
10 4957 message procedure io_komm side 9 - 820301/hko,cl;
10 4958
10 4958 integer antal,filref;
10 4959
10 4959 antal:= d.op_ref.data(6);
10 4960 fil_ref:= d.op_ref.data(7);
10 4961 pos:= 0;
10 4962 <*V*> setposition(zio,0,0);
10 4963 if sluttegn <> 'nl' then outchar(z_io,'nl');
10 4964 for pos:= pos +1 while pos <= antal do
10 4965 begin
11 4966 integer bogst,løb;
11 4967
11 4967 disable i:= læsfil(fil_ref,pos,j);
11 4968 if i <> 0 then
11 4969 fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
11 4970 vogn:= fil(j,1) shift (-24) extract 24;
11 4971 løb:= fil(j,1) extract 24;
11 4972 if d.op_ref.opkode=9 then
11 4973 begin i:=vogn; vogn:=løb; løb:=i; end;
11 4974 ll:= løb shift(-12) extract 10;
11 4975 bogst:= løb shift(-7) extract 5;
11 4976 if bogst > 0 then bogst:= bogst+'A'-1;
11 4977 løb:= løb extract 7;
11 4978 vogn:= vogn extract 14;
11 4979 i:= d.op_ref.opkode -8;
11 4980 for i:= i,i +1 do
11 4981 begin
12 4982 j:= (i+1) extract 1;
12 4983 case j+1 of
12 4984 begin
13 4985 write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 4986 false add bogst,1,"/",1,true,3,<<d>,løb);
13 4987 write(zio,<<dddd>,vogn,"sp",1);
13 4988 end;
12 4989 end;
11 4990 if pos mod 5 = 0 then
11 4991 begin
12 4992 outchar(zio,'nl');
12 4993 <*V*> setposition(zio,0,0);
12 4994 end
11 4995 else write(zio,"sp",3);
11 4996 end;
10 4997 write(zio,"*",1);
10 4998 \f
10 4998 message procedure io_komm side 9a - 810505/hko;
10 4999
10 4999 d.op_ref.opkode:=104;<*slet fil*>
10 5000 d.op_ref.data(4):=filref;
10 5001 indeks:=op_ref;
10 5002 signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
10 5003 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
10 5004
10 5004 <*+2*> if testbit2 and overvåget then
10 5005 disable begin
11 5006 skriv_io_komm(out,0);
11 5007 write(out,"nl",1,<:io operation retur fra sletfil:>);
11 5008 skriv_op(out,op_ref);
11 5009 end;
10 5010 <*-2*>
10 5011
10 5011 <*+4*> if op_ref<>indeks then
10 5012 fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
10 5013 <*-4*>
10 5014 if d.op_ref.data(9)<>0 then
10 5015 fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 5016 <:io-komm, sletfil:>,1);
10 5017 end;
9 5018 end;
8 5019
8 5019 begin
9 5020 \f
9 5020 message procedure io_komm side 10 - 820301/hko;
9 5021
9 5021 <* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
9 5022
9 5022 vogn:=ia(1);
9 5023 ll:=ia(2);
9 5024 omr:= if kode=11 or kode=19 then ia(3) else
9 5025 if kode=12 then ia(2) else 0;
9 5026 if kode=19 and omr<=0 then
9 5027 begin
10 5028 if omr=-1 then omr:= 0
10 5029 else omr:= 14 shift 20 + 3; <*OMR TCT*>
10 5030 end;
9 5031 <*V*> wait_ch(cs_vt_adgang,
9 5032 vt_op,
9 5033 gen_optype,
9 5034 -1<*timeout sek*>);
9 5035 start_operation(vtop,101,cs_io_komm,
9 5036 kode);
9 5037 d.vt_op.data(1):=vogn;
9 5038 d.vt_op.data(2):=ll;
9 5039 d.vt_op.data(if kode=19 then 3 else 4):= omr;
9 5040 indeks:= vt_op;
9 5041 signal_ch(cs_vt,
9 5042 vt_op,
9 5043 gen_optype or io_optype);
9 5044
9 5044 <*V*> wait_ch(cs_io_komm,
9 5045 vt_op,
9 5046 io_optype,
9 5047 -1<*timeout sek*>);
9 5048 <*+2*> if testbit2 and overvåget then
9 5049 disable begin
10 5050 skriv_io_komm(out,0);
10 5051 write(out,"nl",1,
10 5052 <:iooperation retur fra vt:>);
10 5053 skriv_op(out,vt_op);
10 5054 end;
9 5055 <*-2*>
9 5056 <*+4*> if vt_op<>indeks then
9 5057 fejl_reaktion(11<*fremmede op*>,op_ref,
9 5058 <:io-kommando:>,0);
9 5059 <*-4*>
9 5060 <*V*> setposition(z_io,0,0);
9 5061 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5062 skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
9 5063 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 5064 else vt_op,-1,d.vt_op.resultat);
9 5065 d.vt_op.optype:= genoptype or vt_optype;
9 5066 disable afslut_operation(vt_op,cs_vt_adgang);
9 5067 end;
8 5068
8 5068 begin
9 5069 \f
9 5069 message procedure io_komm side 11 - 810428/hko;
9 5070
9 5070 <* 5 autofil-skift
9 5071 gruppe,slet
9 5072 spring (igangsæt)
9 5073 spring,annuler
9 5074 spring,reserve *>
9 5075
9 5075 tofrom(d.op_ref.data,ia,8);
9 5076 d.op_ref.retur:=cs_io_komm;
9 5077 indeks:=op_ref;
9 5078 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5079 <*V*> wait_ch(cs_io_komm,
9 5080 op_ref,
9 5081 io_optype,
9 5082 -1<*timeout*>);
9 5083 <*+2*> if testbit2 and overvåget then
9 5084 disable begin
10 5085 skriv_io_komm(out,0);
10 5086 write(out,"nl",1,<:io operation retur fra vt:>);
10 5087 skriv_op(out,op_ref);
10 5088 end;
9 5089 <*-2*>
9 5090 <*+4*> if indeks<>op_ref then
9 5091 fejlreaktion(11<*fremmed post*>,op_ref,
9 5092 <:io-kommando(autofil):>,0);
9 5093 <*-4*>
9 5094
9 5094 <*V*> setposition(z_io,0,0);
9 5095 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5096 skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
9 5097 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 5098 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 5099 end;
8 5100
8 5100 begin
9 5101 \f
9 5101 message procedure io_komm side 12 - 820301/hko/cl;
9 5102
9 5102 <* 6 gruppedefinition *>
9 5103
9 5103 tofrom(d.op_ref.data,ia,indeks*2);
9 5104 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5105 start_operation(vt_op,101,cs_io_komm,
9 5106 101<*opret fil*>);
9 5107 d.vt_op.data(1):=256;<*postantal*>
9 5108 d.vt_op.data(2):=1; <*postlængde*>
9 5109 d.vt_op.data(3):=1; <*segmentantal*>
9 5110 d.vt_op.data(4):=
9 5111 2 shift 10; <*spool fil*>
9 5112 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5113 pos:=vt_op;<*variabel lånes*>
9 5114 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5115 <*+4*> if vt_op<>pos then
9 5116 fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
9 5117 if d.vt_op.data(9)<>0 then
9 5118 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5119 <:io-kommando(gruppedefinition):>,0);
9 5120 <*-4*>
9 5121 iaf:=0;
9 5122 for i:=1 step 1 until indeks-1 do
9 5123 begin
10 5124 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5125 if k<>0 then
10 5126 fejlreaktion(7<*modif-fil*>,k,
10 5127 <:io kommando(gruppe-def):>,0);
10 5128 fil(j).iaf(1):=d.op_ref.data(i+1);
10 5129 end;
9 5130 while sep = ',' do
9 5131 begin
10 5132 wait(bs_fortsæt_adgang);
10 5133 pos:= 1; j:= 0;
10 5134 while læs_store(z_io,i) < 8 do
10 5135 begin
11 5136 skrivtegn(fortsæt,pos,i);
11 5137 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5138 end;
10 5139 skrivtegn(fortsæt,pos,'em');
10 5140 afsluttext(fortsæt,pos);
10 5141 sluttegn:= i;
10 5142 if j<>0 then
10 5143 begin
11 5144 setposition(z_io,0,0);
11 5145 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5146 skriv_kvittering(zio,opref,-1,53);<*annulleret*>
11 5147 goto gr_ann;
11 5148 end;
10 5149 \f
10 5149 message procedure io_komm side 13 - 810512/hko/cl;
10 5150
10 5150 disable begin
11 5151 integer array værdi(1:4);
11 5152 integer a_pos,res;
11 5153 pos:= 0;
11 5154 repeat
11 5155 apos:= pos;
11 5156 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5157 if res >= 0 then
11 5158 begin
12 5159 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5160 else if res=0 then res:= -25 <*parameter mangler*>
12 5161 else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
12 5162 res:= -7 <*busnr ulovligt*>
12 5163 else if res=2 or res=6 then
12 5164 begin
13 5165 k:=modiffil(d.vt_op.data(4),indeks,j);
13 5166 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5167 <:io kommando(gruppe-def):>,0);
13 5168 iaf:= 0;
13 5169 fil(j).iaf(1):= værdi(1) +
13 5170 (if res=6 then 1 shift 22 else 0);
13 5171 indeks:= indeks+1;
13 5172 if sep = ',' then res:= 0;
13 5173 end
12 5174 else res:= -27; <*parametertype*>
12 5175 end;
11 5176 if res>0 then pos:= a_pos;
11 5177 until sep<>'sp' or res<=0;
11 5178
11 5178 if res<0 then
11 5179 begin
12 5180 d.op_ref.resultat:= -res;
12 5181 i:=1;
12 5182 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5183 afsluttext(d.op_ref.data,i);
12 5184 end;
11 5185 end;
10 5186 \f
10 5186 message procedure io_komm side 13a - 810512/hko/cl;
10 5187
10 5187 if d.op_ref.resultat > 3 then
10 5188 begin
11 5189 setposition(z_io,0,0);
11 5190 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5191 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5192 goto gr_ann;
11 5193 end;
10 5194 signalbin(bs_fortsæt_adgang);
10 5195 end while sep = ',';
9 5196 d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
9 5197 k:= sætfildim(d.vt_op.data);
9 5198 if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
9 5199 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5200 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5201 d.op_ref.retur:=cs_io_komm;
9 5202 pos:=op_ref;
9 5203 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5204 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5205 <*+4*> if pos<>op_ref then
9 5206 fejlreaktion(11<*fremmed post*>,op_ref,
9 5207 <:io kommando(gruppedef retur fra vt):>,0);
9 5208 <*-4*>
9 5209
9 5209 <*V*> setposition(z_io,0,0);
9 5210 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5211 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5212
9 5212 if false then
9 5213 begin
10 5214 gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5215 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5216 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5217 end;
9 5218
9 5218 end;
8 5219
8 5219 begin
9 5220 \f
9 5220 message procedure io_komm side 14 - 810525/hko/cl;
9 5221
9 5221 <* 7 gruppe(-oversigts-)rapport *>
9 5222
9 5222 d.op_ref.retur:=cs_io_komm;
9 5223 d.op_ref.data(1):=ia(1);
9 5224 indeks:=op_ref;
9 5225 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5226 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5227
9 5227 <*+4*> if op_ref<>indeks then
9 5228 fejlreaktion(11<*fremmed post*>,op_ref,
9 5229 <:io-kommando(gruppe-rapport):>,0);
9 5230 <*-4*>
9 5231
9 5231 <*V*> setposition(z_io,0,0);
9 5232 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5233 if d.op_ref.resultat<>3 then
9 5234 begin
10 5235 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5236 end
9 5237 else
9 5238 begin
10 5239 integer bogst,løb;
10 5240
10 5240 if kode = 27 then <* gruppe,vis *>
10 5241 begin
11 5242 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
11 5243 "G",1,<<z>,d.op_ref.data(1) extract 7,
11 5244 "sp",2,"-",5,"nl",1);
11 5245 \f
11 5245 message procedure io_komm side 15 - 820301/hko;
11 5246
11 5246 for pos:=1 step 1 until d.op_ref.data(2) do
11 5247 begin
12 5248 disable i:=læsfil(d.op_ref.data(3),pos,j);
12 5249 if i<>0 then
12 5250 fejlreaktion(5<*læsfil*>,i,
12 5251 <:io_kommando(gruppe,vis):>,0);
12 5252 iaf:=0;
12 5253 vogn:=fil(j).iaf(1);
12 5254 if vogn shift(-22) =0 then
12 5255 write(z_io,<<ddddddd>,vogn extract 14)
12 5256 else
12 5257 begin
13 5258 løb:=vogn extract 7;
13 5259 bogst:=vogn shift(-7) extract 5;
13 5260 if bogst>0 then bogst:=bogst+'A'-1;
13 5261 ll:=vogn shift(-12) extract 10;
13 5262 write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5263 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5264 end;
12 5265 if pos mod 8 =0 then outchar(z_io,'nl')
12 5266 else write(z_io,"sp",2);
12 5267 end;
11 5268 write(z_io,"*",1);
11 5269 \f
11 5269 message procedure io_komm side 16 - 810512/hko/cl;
11 5270
11 5270 end
10 5271 else if kode=28 then <* gruppe,oversigt *>
10 5272 begin
11 5273 write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
11 5274 "sp",2,"-",5,"nl",2);
11 5275 for pos:=1 step 1 until d.op_ref.data(1) do
11 5276 begin
12 5277 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5278 if i<>0 then
12 5279 fejlreaktion(5<*læsfil*>,i,
12 5280 <:io-kommando(gruppe-oversigt):>,0);
12 5281 iaf:=0;
12 5282 ll:=fil(j).iaf(1);
12 5283 write(z_io,"G",1,<<z>,true,3,ll extract 7);
12 5284 if pos mod 10 =0 then outchar(z_io,'nl')
12 5285 else write(z_io,"sp",3);
12 5286 end;
11 5287 write(z_io,"*",1);
11 5288 end;
10 5289 <* slet fil *>
10 5290 d.op_ref.opkode:= 104;
10 5291 d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
10 5292 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5293 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5294 end; <* resultat=3 *>
9 5295
9 5295 end;
8 5296
8 5296 begin
9 5297 \f
9 5297 message procedure io_komm side 17 - 810525/cl;
9 5298
9 5298 <* 8 spring(-oversigts-)rapport *>
9 5299
9 5299 d.op_ref.retur:=cs_io_komm;
9 5300 tofrom(d.op_ref.data,ia,4);
9 5301 indeks:=op_ref;
9 5302 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5303 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5304
9 5304 <*+4*> if op_ref<>indeks then
9 5305 fejlreaktion(11<*fremmed post*>,op_ref,
9 5306 <:io-kommando(spring-rapport):>,0);
9 5307 <*-4*>
9 5308
9 5308 <*V*> setposition(z_io,0,0);
9 5309 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5310 if d.op_ref.resultat<>3 then
9 5311 begin
10 5312 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5313 end
9 5314 else
9 5315 begin
10 5316 boolean p_skrevet;
10 5317 integer bogst,løb;
10 5318
10 5318 if kode = 32 then <* spring,vis *>
10 5319 begin
11 5320 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 5321 bogst:= d.op_ref.data(1) extract 5;
11 5322 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 5323 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
11 5324 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 5325 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 5326 raf:= data+8;
11 5327 if d.op_ref.raf(1)<>0.0 then
11 5328 write(z_io,<:, startet :>,<<zddddd>,round
11 5329 systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 5330 else
11 5331 write(z_io,<:, ikke startet:>);
11 5332 write(z_io,"sp",2,"-",5,"nl",1);
11 5333 \f
11 5333 message procedure io_komm side 18 - 810518/cl;
11 5334
11 5334 p_skrevet:= false;
11 5335 for pos:=1 step 1 until d.op_ref.data(3) do
11 5336 begin
12 5337 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 5338 if i<>0 then
12 5339 fejlreaktion(5<*læsfil*>,i,
12 5340 <:io_kommando(spring,vis):>,0);
12 5341 iaf:=0;
12 5342 i:= fil(j).iaf(1);
12 5343 if i < 0 and -, p_skrevet then
12 5344 begin
13 5345 outchar(z_io,'('); p_skrevet:= true;
13 5346 end;
12 5347 if i > 0 and p_skrevet then
12 5348 begin
13 5349 outchar(z_io,')'); p_skrevet:= false;
13 5350 end;
12 5351 if pos mod 2 = 0 then
12 5352 write(z_io,<< dd>,abs i,<:.:>)
12 5353 else
12 5354 write(z_io,true,3,<<d>,abs i);
12 5355 if pos mod 21 = 0 then outchar(z_io,'nl');
12 5356 end;
11 5357 write(z_io,"*",1);
11 5358 \f
11 5358 message procedure io_komm side 19 - 810525/cl;
11 5359
11 5359 end
10 5360 else if kode=33 then <* spring,oversigt *>
10 5361 begin
11 5362 write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
11 5363 "sp",2,"-",5,"nl",2);
11 5364 for pos:=1 step 1 until d.op_ref.data(1) do
11 5365 begin
12 5366 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5367 if i<>0 then
12 5368 fejlreaktion(5<*læsfil*>,i,
12 5369 <:io-kommando(spring-oversigt):>,0);
12 5370 iaf:=0;
12 5371 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 5372 bogst:=fil(j).iaf(1) extract 5;
12 5373 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 5374 write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 5375 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 5376 string (extend fil(j).iaf(2) shift 24));
12 5377 if fil(j,2)<>0.0 then
12 5378 write(z_io,<:startet :>,<<zddddd>,
12 5379 round systime(4,fil(j,2),r),<:.:>,round r);
12 5380 outchar(z_io,'nl');
12 5381 end;
11 5382 write(z_io,"*",1);
11 5383 end;
10 5384 <* slet fil *>
10 5385 d.op_ref.opkode:= 104;
10 5386 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 5387 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5388 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5389 end; <* resultat=3 *>
9 5390
9 5390 end;
8 5391
8 5391 begin
9 5392 \f
9 5392 message procedure io_komm side 20 - 820302/hko;
9 5393
9 5393 <* 9 fordeling af linier/områder på operatører *>
9 5394
9 5394 d.op_ref.retur:=cs_io_komm;
9 5395 disable
9 5396 if kode=5 then
9 5397 begin
10 5398 integer array io_linietabel(1:max_linienr//3+1);
10 5399
10 5399 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5400 begin
11 5401 i:= læs_fil(1035,ref//512+1,j);
11 5402 if i <> 0 then
11 5403 fejlreaktion(5,i,<:liniefordelingstabel:>,0);
11 5404 tofrom(io_linietabel.ref,fil(j),
11 5405 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
11 5406 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
11 5407 end;
10 5408 ref:=0;
10 5409 operatør:=ia(1);
10 5410 for j:=2 step 1 until indeks do
10 5411 begin
11 5412 ll:=ia(j);
11 5413 if ll<>0 then
11 5414 skrivtegn(io_linietabel,abs(ll)+1,
11 5415 if ll>0 then operatør else 0);
11 5416 end;
10 5417 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5418 begin
11 5419 i:= skriv_fil(1035,ref//512+1,j);
11 5420 if i <> 0 then
11 5421 fejlreaktion(6,i,<:liniefordelingstabel:>,0);
11 5422 tofrom(fil(j),io_linietabel.ref,
11 5423 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
11 5424 then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
11 5425 );
11 5426 end;
10 5427 ref:=0;
10 5428 end
9 5429 else
9 5430 begin
10 5431 modiffil(1034,1,i);
10 5432 ref:=0;
10 5433 operatør:=ia(1);
10 5434 for j:=2 step 1 until indeks do
10 5435 begin
11 5436 ll:=ia(j);
11 5437 fil(i).ref(ll):= if ll>0 then operatør else 0;
11 5438 end;
10 5439 end;
9 5440 indeks:=op_ref;
9 5441 signal_ch(cs_rad,op_ref,gen_optype or io_optype);
9 5442 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
9 5443
9 5443 <*+4*> if op_ref<>indeks then
9 5444 fejlreaktion(11<*fr.post*>,op_ref,
9 5445 <:io-komm,liniefordeling retur fra rad:>,0);
9 5446 <*-4*>
9 5447
9 5447 <*V*> setposition(z_io,0,0);
9 5448 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5449 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5450
9 5450 end;
8 5451
8 5451 begin
9 5452 \f
9 5452 message procedure io_komm side 21 - 820301/cl;
9 5453
9 5453 <* 10 springdefinition *>
9 5454
9 5454 tofrom(d.op_ref.data,ia,indeks*2);
9 5455 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5456 start_operation(vt_op,101,cs_io_komm,
9 5457 101<*opret fil*>);
9 5458 d.vt_op.data(1):=128;<*postantal*>
9 5459 d.vt_op.data(2):=2; <*postlængde*>
9 5460 d.vt_op.data(3):=1; <*segmentantal*>
9 5461 d.vt_op.data(4):=
9 5462 2 shift 10; <*spool fil*>
9 5463 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5464 pos:=vt_op;<*variabel lånes*>
9 5465 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5466 <*+4*> if vt_op<>pos then
9 5467 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 5468 if d.vt_op.data(9)<>0 then
9 5469 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5470 <:io-kommando(springdefinition):>,0);
9 5471 <*-4*>
9 5472 iaf:=0;
9 5473 for i:=1 step 1 until indeks-2 do
9 5474 begin
10 5475 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5476 if k<>0 then
10 5477 fejlreaktion(7<*modif-fil*>,k,
10 5478 <:io kommando(spring-def):>,0);
10 5479 fil(j).iaf(1):=d.op_ref.data(i+2);
10 5480 end;
9 5481 while sep = ',' do
9 5482 begin
10 5483 wait(bs_fortsæt_adgang);
10 5484 pos:= 1; j:= 0;
10 5485 while læs_store(z_io,i) < 8 do
10 5486 begin
11 5487 skrivtegn(fortsæt,pos,i);
11 5488 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5489 end;
10 5490 skrivtegn(fortsæt,pos,'em');
10 5491 afsluttext(fortsæt,pos);
10 5492 sluttegn:= i;
10 5493 if j<>0 then
10 5494 begin
11 5495 setposition(z_io,0,0);
11 5496 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5497 skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
11 5498 goto sp_ann;
11 5499 end;
10 5500 \f
10 5500 message procedure io_komm side 22 - 810519/cl;
10 5501
10 5501 disable begin
11 5502 integer array værdi(1:4);
11 5503 integer a_pos,res;
11 5504 pos:= 0;
11 5505 repeat
11 5506 apos:= pos;
11 5507 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5508 if res >= 0 then
11 5509 begin
12 5510 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5511 else if res=0 then res:= -25 <*parameter mangler*>
12 5512 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 5513 res:= -44 <*intervalstørrelse ulovlig*>
12 5514 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 5515 res:= -6 <*løbnr ulovligt*>
12 5516 else if res=10 then
12 5517 begin
13 5518 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 5519 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5520 <:io kommando(spring-def):>,0);
13 5521 iaf:= 0;
13 5522 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 5523 indeks:= indeks+1;
13 5524 if sep = ',' then res:= 0;
13 5525 end
12 5526 else res:= -27; <*parametertype*>
12 5527 end;
11 5528 if res>0 then pos:= a_pos;
11 5529 until sep<>'sp' or res<=0;
11 5530
11 5530 if res<0 then
11 5531 begin
12 5532 d.op_ref.resultat:= -res;
12 5533 i:=1;
12 5534 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5535 afsluttext(d.op_ref.data,i);
12 5536 end;
11 5537 end;
10 5538 \f
10 5538 message procedure io_komm side 23 - 810519/cl;
10 5539
10 5539 if d.op_ref.resultat > 3 then
10 5540 begin
11 5541 setposition(z_io,0,0);
11 5542 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5543 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5544 goto sp_ann;
11 5545 end;
10 5546 signalbin(bs_fortsæt_adgang);
10 5547 end while sep = ',';
9 5548 d.vt_op.data(1):= indeks-2;
9 5549 k:= sætfildim(d.vt_op.data);
9 5550 if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
9 5551 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5552 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5553 d.op_ref.retur:=cs_io_komm;
9 5554 pos:=op_ref;
9 5555 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5556 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5557 <*+4*> if pos<>op_ref then
9 5558 fejlreaktion(11<*fremmed post*>,op_ref,
9 5559 <:io kommando(springdef retur fra vt):>,0);
9 5560 <*-4*>
9 5561
9 5561 <*V*> setposition(z_io,0,0);
9 5562 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5563 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5564
9 5564 if false then
9 5565 begin
10 5566 sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5567 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5568 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5569 signalbin(bs_fortsæt_adgang);
10 5570 end;
9 5571
9 5571 end;
8 5572 begin
9 5573 integer i,j,k,opr,lin,max_lin;
9 5574 boolean o_ud, t_ud;
9 5575 \f
9 5575 message procedure io_komm side 23a - 820301/cl;
9 5576
9 5576 <* 11 fordelingsrapport *>
9 5577
9 5577 <*V*> setposition(z_io,0,0);
9 5578 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5579
9 5579 max_lin:= max_linienr;
9 5580 for opr:= 1 step 1 until max_antal_operatører, 0 do
9 5581 begin
10 5582 o_ud:= t_ud:= false;
10 5583 k:= 0;
10 5584
10 5584 if opr<>0 then
10 5585 begin
11 5586 j:= k:= 0;
11 5587 for lin:= 1 step 1 until max_lin do
11 5588 begin
12 5589 læs_tegn(radio_linietabel,lin+1,i);
12 5590 if i<>0 then j:= lin;
12 5591 if opr=i and opr<>0 then
12 5592 begin
13 5593 if -, o_ud then
13 5594 begin
14 5595 o_ud:= true;
14 5596 if opr<>0 then
14 5597 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
14 5598 "sp",2,string bpl_navn(opr))
14 5599 else
14 5600 write(z_io,"nl",1,<:ikke fordelte:>);
14 5601 end;
13 5602 if -, t_ud then
13 5603 begin
14 5604 write(z_io,<:<'nl'> linier: :>);
14 5605 t_ud:= true;
14 5606 end;
13 5607 k:=k+1;
13 5608 if k>1 and k mod 10 = 1 then
13 5609 write(z_io,"nl",1,"sp",13);
13 5610 write(z_io,<<ddd >,lin);
13 5611 end;
12 5612 if lin=max_lin then max_lin:= j;
12 5613 end;
11 5614 end;
10 5615
10 5615 k:= 0; t_ud:= false;
10 5616 for i:= 1 step 1 until max_antal_områder do
10 5617 begin
11 5618 if radio_områdetabel(i)= opr then
11 5619 begin
12 5620 if -, o_ud then
12 5621 begin
13 5622 o_ud:= true;
13 5623 if opr<>0 then
13 5624 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
13 5625 "sp",2,string bpl_navn(opr))
13 5626 else
13 5627 write(z_io,"nl",1,<:ikke fordelte:>);
13 5628 end;
12 5629 if -, t_ud then
12 5630 begin
13 5631 write(z_io,<:<'nl'> områder: :>);
13 5632 t_ud:= true;
13 5633 end;
12 5634 k:= k+1;
12 5635 if k>1 and k mod 10 = 1 then
12 5636 write(z_io,"nl",1,"sp",13);
12 5637 write(z_io,true,4,string område_navn(i));
12 5638 end;
11 5639 end;
10 5640 if o_ud then write(z_io,"nl",1);
10 5641 end;
9 5642 write(z_io,"*",1);
9 5643 end;
8 5644
8 5644 begin
9 5645 integer omr,typ,sum;
9 5646 integer array ialt(1:5);
9 5647 real r;
9 5648 \f
9 5648 message procedure io_komm side 24 - 810501/hko;
9 5649
9 5649 <* 12 vis/nulstil opkaldstællere *>
9 5650
9 5650
9 5650 if kode=76 and indeks=1 then
9 5651 begin <* TÆ,N <tid> *>
10 5652 if ia(1)<(-1) or 2400<ia(1) then
10 5653 begin
11 5654 setposition(z_io,0,0);
11 5655 if sluttegn<>'nl' then outchar(z_io,'nl');
11 5656 skriv_kvittering(z_io,opref,-1,64);
11 5657 end
10 5658 else
10 5659 begin
11 5660 if ia(1)=(-1) then nulstil_systællere:= -1
11 5661 else nulstil_systællere:= (ia(1) mod 2400)*100;
11 5662 opdater_tf_systællere;
11 5663 typ:= opref; <* typ lånes til gemmevariabel *>
11 5664 d.opref.retur:= cs_io_komm;
11 5665 signal_ch(cs_io_nulstil,opref,io_optype);
11 5666 <*V*> wait_ch(cs_io_komm,opref,io_optype,-1);
11 5667 <*+4*> if opref <> typ then
11 5668 fejlreaktion(11<*fremmed post*>,opref,
11 5669 <:io_kommando:>,0);
11 5670 <*-4*>
11 5671 setposition(z_io,0,0);
11 5672 if sluttegn<>'nl' then outchar(z_io,'nl');
11 5673 skriv_kvittering(z_io,opref,-1,3);
11 5674 end;
10 5675 end
9 5676 else
9 5677 begin
10 5678 setposition(z_io,0,0);
10 5679 if sluttegn<>'nl' then outchar(z_io,'nl');
10 5680 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5681
10 5681 write(z_io,
10 5682 <:område udgående alm.ind nød ind:>,
10 5683 <: ind-ialt total ej forb. optaget:>,"nl",1);
10 5684 for omr := 1 step 1 until max_antal_områder do
10 5685 begin
11 5686 sum:= 0;
11 5687 write(z_io,true,6,string område_navn(omr),":",1);
11 5688 for typ:= 1 step 1 until 3 do
11 5689 begin
12 5690 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5691 sum:= sum + opkalds_tællere((omr-1)*5+typ);
12 5692 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5693 end;
11 5694 write(z_io,<< ddddddd>,
11 5695 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
11 5696 for typ:= 4 step 1 until 5 do
11 5697 begin
12 5698 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5699 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5700 end;
11 5701 write(z_io,"nl",1);
11 5702 end;
10 5703 sum:= 0;
10 5704 write(z_io,"nl",1,<:ialt ::>);
10 5705 for typ:= 1 step 1 until 3 do
10 5706 begin
11 5707 write(z_io,<< ddddddd>,ialt(typ));
11 5708 sum:= sum+ialt(typ);
11 5709 end;
10 5710 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5711 ialt(4), ialt(5), "nl",3);
10 5712
10 5712 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5713 write(z_io,
10 5714 <:oper. udgående alm.ind nød ind:>,
10 5715 <: ind-ialt total ej forb. optaget:>,"nl",1);
10 5716 for omr := 1 step 1 until max_antal_operatører do
10 5717 begin
11 5718 sum:= 0;
11 5719 if bpl_navn(omr)=long<::> then
11 5720 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
11 5721 else
11 5722 write(z_io,true,6,string bpl_navn(omr),":",1);
11 5723 for typ:= 1 step 1 until 3 do
11 5724 begin
12 5725 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
12 5726 sum:= sum + operatør_tællere((omr-1)*5+typ);
12 5727 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5728 end;
11 5729 write(z_io,<< ddddddd>,
11 5730 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
11 5731 for typ:= 4 step 1 until 5 do
11 5732 begin
12 5733 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
12 5734 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5735 end;
11 5736 write(z_io,"nl",1);
11 5737 end;
10 5738 sum:= 0;
10 5739 write(z_io,"nl",1,<:ialt ::>);
10 5740 for typ:= 1 step 1 until 3 do
10 5741 begin
11 5742 write(z_io,<< ddddddd>,ialt(typ));
11 5743 sum:= sum+ialt(typ);
11 5744 end;
10 5745 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5746 ialt(4),ialt(5),"nl",2);
10 5747
10 5747 typ:= replacechar(1,':');
10 5748 write(z_io,<:tællere nulstilles :>);
10 5749 if nulstil_systællere=(-1) then
10 5750 write(z_io,<:ikke automatisk:>,"nl",1)
10 5751 else
10 5752 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
10 5753 nulstil_systællere,"nl",1);
10 5754 replacechar(1,'.');
10 5755 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
10 5756 systime(4,systællere_nulstillet,r));
10 5757 replacechar(1,':');
10 5758 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
10 5759 replacechar(1,typ);
10 5760 write(z_io,"*",1,"nl",1);
10 5761 setposition(z_io,0,0);
10 5762
10 5762 if kode = 76 <* nulstil tællere *> then
10 5763 disable begin
11 5764 for omr:= 1 step 1 until max_antal_områder*5 do
11 5765 opkalds_tællere(omr):= 0;
11 5766 for omr:= 1 step 1 until max_antal_operatører*5 do
11 5767 operatør_tællere(omr):= 0;
11 5768 systime(1,0.0,systællere_nulstillet);
11 5769 opdater_tf_systællere;
11 5770 typ:= replacechar(1,'.');
11 5771 write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
11 5772 systime(4,systællere_nulstillet,r));
11 5773 replacechar(1,':');
11 5774 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
11 5775 replacechar(1,typ);
11 5776 setposition(z_io,0,0);
11 5777 end;
10 5778 end;
9 5779 end;
8 5780
8 5780 begin
9 5781 \f
9 5781 message procedure io_komm side 25 - 940522/cl;
9 5782
9 5782 <* 13 navngiv betjeningsplads *>
9 5783 boolean incl;
9 5784 long field lf;
9 5785
9 5785 lf:=6;
9 5786 operatør:= ia(1);
9 5787 navn:= ia.lf;
9 5788 incl:= false add (ia(4) extract 8);
9 5789
9 5789 if navn=long<::> then
9 5790 begin
10 5791 <* nedlæg navn - check for i brug *>
10 5792 iaf:= operatør*terminal_beskr_længde;
10 5793 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5794 d.opref.resultat:= 48 <*i brug*>
10 5795 else
10 5796 begin
11 5797 for i:= 65 step 1 until top_bpl_gruppe do
11 5798 begin
12 5799 iaf:= i*op_maske_lgd;
12 5800 if læsbit_ia(bpl_def.iaf,operatør) then
12 5801 d.opref.resultat:= 48<*i brug*>;
12 5802 end;
11 5803 end;
10 5804 if d.opref.resultat <= 3 then
10 5805 begin
11 5806 for i:= 1 step 1 until sidste_bus do
11 5807 if bustabel(i) shift (-14) extract 8 = operatør then
11 5808 d.opref.resultat:= 48<*i brug*>;
11 5809 end;
10 5810 end
9 5811 else
9 5812 begin
10 5813 <* opret/omdøb *>
10 5814 i:= find_bpl(navn);
10 5815 if i<>0 and i<>operatør then
10 5816 d.opref.resultat:= 48 <*i brug*>;
10 5817 end;
9 5818 if d.opref.resultat<=3 then
9 5819 begin
10 5820 bpl_navn(operatør):= navn;
10 5821 operatør_auto_include(operatør):= incl;
10 5822 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5823 if k<>0 then
10 5824 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5825 lf:= 4;
10 5826 fil(ll).lf:= navn add (incl extract 8);
10 5827 setposition(fil(ll),0,0);
10 5828
10 5828 <* skriv bplnavne *>
10 5829 disable begin
11 5830 zone z(128,1,stderror);
11 5831 long array field laf;
11 5832 integer array ia(1:10);
11 5833
11 5833 open(z,4,<:bplnavne:>,0);
11 5834 laf:= 0;
11 5835 outrec6(z,512);
11 5836 for i:= 1 step 1 until 127 do
11 5837 z.laf(i):= bpl_navn(i);
11 5838 close(z,true);
11 5839 monitor(42,z,0,ia);
11 5840 ia(6):= systime(7,0,0.0);
11 5841 monitor(44,z,0,ia);
11 5842 end;
10 5843 d.opref.resultat:= 3;<*udført*>
10 5844 end;
9 5845
9 5845 setposition(z_io,0,0);
9 5846 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5847 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5848 end;
8 5849
8 5849 begin
9 5850 \f
9 5850 message procedure io_komm side 26 - 940522/cl;
9 5851
9 5851 <* 14 betjeningsplads - gruppe *>
9 5852 integer ant_i_gruppe;
9 5853 long field lf;
9 5854 integer array maske(1:op_maske_lgd//2);
9 5855
9 5855 lf:= 4; ant_i_gruppe:= 0;
9 5856 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5857 navn:= ia.lf;
9 5858 operatør:= find_bpl(navn);
9 5859 for i:= 3 step 1 until indeks do
9 5860 if sætbit_ia(maske,ia(i),1)=0 then
9 5861 ant_i_gruppe:= ant_i_gruppe+1;
9 5862 if ant_i_gruppe=0 then
9 5863 begin
10 5864 <* slet gruppe *>
10 5865 if operatør<=64 then
10 5866 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5867 else 62<*navn ulovligt*>)
10 5868 else
10 5869 begin
11 5870 for i:= 1 step 1 until max_antal_operatører do
11 5871 for j:= 1 step 1 until 3 do
11 5872 if operatør_stop(i,j)=operatør then
11 5873 d.opref.resultat:= 48<*i brug*>;
11 5874 end;
10 5875 navn:= long<::>;
10 5876 end
9 5877 else
9 5878 begin
10 5879 if 1<=operatør and operatør<=64 then
10 5880 d.opref.resultat:= 62<*navn ulovligt*>
10 5881 else
10 5882 if operatør=0 then
10 5883 begin
11 5884 i:=65;
11 5885 while i<=127 and operatør=0 do
11 5886 begin
12 5887 if bpl_navn(i)=long<::> then operatør:=i;
12 5888 i:= i+1;
12 5889 end;
11 5890 if operatør=0 then
11 5891 d.opref.resultat:= 32<*ikke plads*>
11 5892 else if operatør>top_bpl_gruppe then
11 5893 top_bpl_gruppe:= operatør;
11 5894 end;
10 5895 end;
9 5896 if d.opref.resultat<=3 then
9 5897 begin
10 5898 bpl_navn(operatør):= navn;
10 5899 iaf:= operatør*op_maske_lgd;
10 5900 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5901 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5902 for i:= 1 step 1 until max_antal_operatører do
10 5903 begin
11 5904 if læsbit_ia(maske,i) then
11 5905 begin
12 5906 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5907 if læsbit_ia(operatør_maske,i) then
12 5908 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5909 end;
11 5910 end;
10 5911 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5912 if k<>0 then
10 5913 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5914 lf:= 4;
10 5915 fil(ll).lf:= navn;
10 5916 setposition(fil(ll),0,0);
10 5917 iaf:= 0;
10 5918 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5919 if k<>0 then
10 5920 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5921 for i:= 1 step 1 until op_maske_lgd//2 do
10 5922 fil(ll).iaf(i):= maske(i);
10 5923 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5924 setposition(fil(ll),0,0);
10 5925 d.opref.resultat:= 3;
10 5926 end;
9 5927
9 5927 setposition(z_io,0,0);
9 5928 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5929 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5930 end;
8 5931
8 5931 begin
9 5932 \f
9 5932 message procedure io_komm side 27 - 940522/cl;
9 5933
9 5933 <* 15 vis betjeningspladsdefinitioner *>
9 5934
9 5934 setposition(z_io,0,0);
9 5935 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5936 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5937 for i:= 1 step 1 until max_antal_operatører do
9 5938 begin
10 5939 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5940 case operatør_auto_include(i) extract 2 + 1 of(
10 5941 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5942 if i mod 4 = 0 then write(z_io,"nl",1)
10 5943 else write(z_io,"sp",5);
10 5944 end;
9 5945 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5946 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5947 for i:= 65 step 1 until top_bpl_gruppe do
9 5948 begin
10 5949 ll:=0; iaf:= i*op_maske_lgd;
10 5950 if bpl_navn(i)<>long<::> then
10 5951 begin
11 5952 write(z_io,true,6,string bpl_navn(i),":",1);
11 5953 for j:= 1 step 1 until max_antal_operatører do
11 5954 begin
12 5955 if læsbit_ia(bpl_def.iaf,j) then
12 5956 begin
13 5957 if ll mod 8 = 0 and ll<>0 then
13 5958 write(z_io,"nl",1,"sp",7);
13 5959 write(z_io,"sp",2,string bpl_navn(j));
13 5960 ll:=ll+1;
13 5961 end;
12 5962 end;
11 5963 write(z_io,"nl",1);
11 5964 end;
10 5965 end;
9 5966 write(z_io,"*",1);
9 5967 end;
8 5968
8 5968 begin
9 5969 \f
9 5969 message procedure io_komm side 28 - 940522/cl;
9 5970
9 5970 <* 16 stopniveau,definer *>
9 5971
9 5971 operatør:= ia(1);
9 5972 iaf:= operatør*terminal_beskr_længde;
9 5973 for i:= 1 step 1 until 3 do
9 5974 operatør_stop(operatør,i):= ia(i+1);
9 5975 if -,læsbit_ia(operatørmaske,operatør) then
9 5976 begin
10 5977 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5978 signal_bin(bs_mobilopkald);
10 5979 end;
9 5980 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5981 if k<>0 then
9 5982 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 5983 iaf:= 0;
9 5984 for i:= 0 step 1 until 3 do
9 5985 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 5986 setposition(fil(ll),0,0);
9 5987 setposition(z_io,0,0);
9 5988 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5989 skriv_kvittering(z_io,0,-1,3);
9 5990 end;
8 5991
8 5991 begin
9 5992 \f
9 5992 message procedure io_komm side 29 - 940522/cl;
9 5993
9 5993 <* 17 stopniveauer,vis *>
9 5994
9 5994 setposition(z_io,0,0);
9 5995 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5996
9 5996 for operatør:= 1 step 1 until max_antal_operatører do
9 5997 begin
10 5998 iaf:=operatør*terminal_beskr_længde;
10 5999 ll:=0;
10 6000 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6001 string bpl_navn(operatør),<:(:>,
10 6002 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 6003 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 6004 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 6005 for i:= 1 step 1 until 3 do
10 6006 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 6007 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 6008 else string bpl_navn(operatør_stop(operatør,i)));
10 6009 if operatør mod 2 = 1 then
10 6010 write(z_io,"sp",40-ll)
10 6011 else
10 6012 write(z_io,"nl",1);
10 6013 end;
9 6014 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6015 write(z_io,"*",1);
9 6016 end;
8 6017
8 6017 begin
9 6018 \f
9 6018 message procedure io_komm side 30 - 941007/cl;
9 6019
9 6019 <* 18 alarmlængder *>
9 6020
9 6020 setposition(z_io,0,0);
9 6021 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6022
9 6022 for operatør:= 1 step 1 until max_antal_operatører do
9 6023 begin
10 6024 ll:=0;
10 6025 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6026 string bpl_navn(operatør));
10 6027 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 6028 if opk_alarm.iaf.alarm_lgd < 0 then
10 6029 ll:= ll+write(z_io,<:uendelig:>)
10 6030 else
10 6031 ll:= ll+write(z_io,<<ddddddd>,
10 6032 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 6033
10 6033 if operatør mod 2 = 1 then
10 6034 write(z_io,"sp",40-ll)
10 6035 else
10 6036 write(z_io,"nl",1);
10 6037 end;
9 6038 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6039 write(z_io,"*",1);
9 6040 end;
8 6041
8 6041 begin
9 6042 <* 19 CC *>
9 6043 integer i, c;
9 6044
9 6044 i:= 1;
9 6045 while læstegn(ia,i+0,c)<>0 and
9 6046 i<(op_spool_postlgd-op_spool_text)//2*3
9 6047 do skrivtegn(d.opref.data,i,c);
9 6048 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 6049
9 6049 d.opref.retur:= cs_io_komm;
9 6050 signalch(cs_op,opref,io_optype or gen_optype);
9 6051 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 6052
9 6052 setposition(z_io,0,0);
9 6053 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6054 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 6055 end;
8 6056
8 6056 begin
9 6057 <* 20: CQF,I CQF,U CQF,V *>
9 6058 integer kode, res, i, j;
9 6059 integer array field iaf, iaf1;
9 6060 long field navn;
9 6061
9 6061 kode:= d.opref.opkode extract 12;
9 6062 navn:= 6; res:= 0;
9 6063 if kode=90 <*CQF,I*> then
9 6064 begin
10 6065 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 6066 res:= 10 <*busnr ukendt*>
10 6067 else
10 6068 begin
11 6069 j:= -1;
11 6070 for i:= 1 step 1 until max_cqf do
11 6071 begin
12 6072 iaf:= (i-1)*cqf_lgd;
12 6073 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 6074 ia.navn = cqf_tabel.iaf.cqf_id
12 6075 then res:= 48; <*i brug*>
12 6076 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 6077 end;
11 6078 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 6079 if res=0 then
11 6080 begin
12 6081 iaf:= (j-1)*cqf_lgd;
12 6082 cqf_tabel.iaf.cqf_bus:= ia(1);
12 6083 cqf_tabel.iaf.cqf_fejl:= 0;
12 6084 cqf_tabel.iaf.cqf_id:= ia.navn;
12 6085 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 6086 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 6087 res:= 3;
12 6088 end;
11 6089 end;
10 6090 setposition(z_io,0,0);
10 6091 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6092 skriv_kvittering(z_io,opref,-1,res);
10 6093 end
9 6094 else
9 6095 if kode=91 <*CQF,U*> then
9 6096 begin
10 6097 j:= -1;
10 6098 for i:= 1 step 1 until max_cqf do
10 6099 begin
11 6100 iaf:= (i-1)*cqf_lgd;
11 6101 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 6102 end;
10 6103 if j>=0 then
10 6104 begin
11 6105 iaf:= (j-1)*cqf_lgd;
11 6106 for i:= 1 step 1 until cqf_lgd//2 do
11 6107 cqf_tabel.iaf(i):= 0;
11 6108 res:= 3;
11 6109 end
10 6110 else res:= 13; <*bus ikke indsat*>
10 6111 setposition(z_io,0,0);
10 6112 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6113 skriv_kvittering(z_io,opref,-1,res);
10 6114 end
9 6115 else
9 6116 begin
10 6117 setposition(z_io,0,0);
10 6118 skriv_cqf_tabel(z_io,false);
10 6119 outchar(z_io,'*');
10 6120 setposition(z_io,0,0);
10 6121 end;
9 6122
9 6122 if kode=90 or kode=91 then
9 6123 begin
10 6124 j:= skrivfil(1033,1,i);
10 6125 if j<>0 then
10 6126 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 6127 for k:= 1 step 1 until max_cqf do
10 6128 begin
11 6129 iaf1:= (k-1)*cqf_lgd;
11 6130 iaf := (k-1)*cqf_id;
11 6131 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 6132 end;
10 6133 op_cqf_tab_ændret:= true;
10 6134 end;
9 6135 end;<*CQF*>
8 6136
8 6136
8 6136 begin
9 6137 \f
9 6137 message procedure io_komm side xx - 940522/cl;
9 6138
9 6138
9 6138
9 6138 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 6139 <*-3*>
9 6140 end
8 6141 end;<*case j *>
7 6142 end <* j > 0 *>
6 6143 else
6 6144 begin
7 6145 <*V*> setposition(z_io,0,0);
7 6146 if sluttegn<>'nl' then outchar(z_io,'nl');
7 6147 skriv_kvittering(z_io,op_ref,-1,
7 6148 45 <* ikke implementeret *>);
7 6149 end;
6 6150 end;<* godkendt *>
5 6151
5 6151 <*V*> setposition(z_io,0,0);
5 6152 signal_bin(bs_zio_adgang);
5 6153 d.op_ref.retur:=cs_att_pulje;
5 6154 disable afslut_kommando(op_ref);
5 6155 end; <* indlæs kommando *>
4 6156
4 6156 begin
5 6157 \f
5 6157 message procedure io_komm side xx+1 - 810428/hko;
5 6158
5 6158 <* 2: aktiver efter stop *>
5 6159 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 6160 terminal_tab.ref.terminal_tilstand extract 21;
5 6161 afslut_operation(op_ref,-1);
5 6162 signal_bin(bs_zio_adgang);
5 6163 end;
4 6164
4 6164 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6165 <*-3*>
4 6166 end; <* case aktion+6 *>
3 6167
3 6167 until false;
3 6168 io_komm_trap:
3 6169 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6170 alarmcause extract 24 = (-13)) then
3 6171 disable skriv_io_komm(zbillede,1);
3 6172 end io_komm;
2 6173 \f
2 6173 message procedure io_spool side 1 - 810507/hko;
2 6174
2 6174 procedure io_spool;
2 6175 begin
3 6176 integer
3 6177 næste_tomme,nr;
3 6178 integer array field
3 6179 op_ref;
3 6180
3 6180 procedure skriv_io_spool(zud,omfang);
3 6181 value omfang;
3 6182 zone zud;
3 6183 integer omfang;
3 6184 begin
4 6185 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6186 if omfang > 0 then
4 6187 disable begin integer x;
5 6188 trap(slut);
5 6189 write(zud,"nl",1,
5 6190 <: opref: :>,op_ref,"nl",1,
5 6191 <: næstetomme::>,næste_tomme,"nl",1,
5 6192 <: nr :>,nr,"nl",1,
5 6193 <::>);
5 6194 skriv_coru(zud,coru_no(102));
5 6195 slut:
5 6196 end;<*disable*>
4 6197 end skriv_io_spool;
3 6198
3 6198 trap(io_spool_trap);
3 6199 næste_tomme:= 1;
3 6200 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6201 <*+2*>
3 6202 if testbit0 and overvåget or testbit28 then
3 6203 skriv_io_spool(out,0);
3 6204 <*-2*>
3 6205 \f
3 6205 message procedure io_spool side 2 - 810602/hko;
3 6206
3 6206 repeat
3 6207
3 6207 wait_ch(cs_io_spool,
3 6208 op_ref,
3 6209 true,
3 6210 -1<*timeout*>);
3 6211
3 6211 i:= d.op_ref.opkode;
3 6212 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6213 begin
4 6214 wait(ss_io_spool_tomme);
4 6215 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6216 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6217
4 6217 i:= d.op_ref.opsize;
4 6218 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6219 begin
5 6220 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6221 i:= io_spool_postlængde*2 -io_spool_post;
5 6222 end;
4 6223 <*-4*>
4 6224 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6225 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6226 signal(ss_io_spool_fulde);
4 6227 d.op_ref.resultat:= 1;
4 6228 end
3 6229 else
3 6230 begin
4 6231 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6232 <:io_spool_korutine:>,1);
4 6233 end;
3 6234
3 6234 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6235
3 6235 until false;
3 6236
3 6236 io_spool_trap:
3 6237
3 6237 disable skriv_io_spool(zbillede,1);
3 6238 end io_spool;
2 6239 \f
2 6239 message procedure io_spon side 1 - 810507/hko;
2 6240
2 6240 procedure io_spon;
2 6241 begin
3 6242 integer
3 6243 næste_fulde,nr,i,dato,kl;
3 6244 real t;
3 6245
3 6245 procedure skriv_io_spon(zud,omfang);
3 6246 value omfang;
3 6247 zone zud;
3 6248 integer omfang;
3 6249 begin
4 6250 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6251 if omfang > 0 then
4 6252 disable begin integer x;
5 6253 trap(slut);
5 6254 write(zud,"nl",1,
5 6255 <: næste-fulde::>,næste_fulde,"nl",1,
5 6256 <: nr :>,nr,"nl",1,
5 6257 <::>);
5 6258 skriv_coru(zud,coru_no(103));
5 6259 slut:
5 6260 end;<*disable*>
4 6261 end skriv_io_spon;
3 6262
3 6262 trap(io_spon_trap);
3 6263 næste_fulde:= 1;
3 6264 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6265 <*+2*>
3 6266 if testbit0 and overvåget or testbit28 then
3 6267 skriv_io_spon(out,0);
3 6268 <*-2*>
3 6269 \f
3 6269 message procedure io_spon side 2 - 810602/hko/cl;
3 6270
3 6270 repeat
3 6271
3 6271 <*V*> wait(ss_io_spool_fulde);
3 6272 <*V*> wait(bs_zio_adgang);
3 6273
3 6273 <*V*> setposition(zio,0,0);
3 6274
3 6274 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6275 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6276
3 6276 laf:=data;
3 6277 k:= fil(nr).io_spool_post.opkode;
3 6278 if k = 22 or k = 36 then
3 6279 disable begin
4 6280 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6281 if k=36 then
4 6282 begin
5 6283 i:= fil(nr).io_spool_post.data(4);
5 6284 j:= i extract 5;
5 6285 if j<>0 then j:=j+'A'-1;
5 6286 i:= i shift (-5) extract 10;
5 6287 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6288 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6289 end;
4 6290 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6291 fil(nr).io_spool_post.tid)
4 6292 end
3 6293 else if k = 23 then
3 6294 disable
3 6295 begin
4 6296 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6297 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6298 kl:= round t;
4 6299 i:= replace_char(1<*space in number*>,'.');
4 6300 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6301 replace_char(1,i);
4 6302 end
3 6303 else if k = 45 or k = 46 then
3 6304 disable begin
4 6305 integer vogn,linie,bogst,løb,t;
4 6306
4 6306 t:=fil(nr).io_spool_post.data(2);
4 6307 outchar(z_io,'nl');
4 6308 if k = 45 then
4 6309 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6310
4 6310 write(zio,<:nødopkald fra :>);
4 6311 vogn:= fil(nr).io_spool_post.data(1);
4 6312 i:= vogn shift (-22);
4 6313 if i < 2 then
4 6314 skrivid(zio,vogn,9)
4 6315 else
4 6316 begin
5 6317 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6318 write(zio,<:!!!:>,vogn);
5 6319 end;
4 6320 \f
4 6320 message procedure io_spon side 3 - 810507/hko;
4 6321
4 6321 if fil(nr).io_spool_post.data(3)<>0 then
4 6322 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6323
4 6323 if k = 46 then
4 6324 begin
5 6325 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6326 end;
4 6327 end <*disable*>
3 6328 else
3 6329 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6330
3 6330 fil(nr,1):= fil(nr,1) add 1;
3 6331
3 6331 <*V*> setposition(zio,0,0);
3 6332
3 6332 signal_bin(bs_zio_adgang);
3 6333
3 6333 signal(ss_io_spool_tomme);
3 6334
3 6334 until false;
3 6335
3 6335 io_spon_trap:
3 6336 skriv_io_spon(zbillede,1);
3 6337
3 6337 end io_spon;
2 6338 \f
2 6338 message procedure io_medd side 1;
2 6339
2 6339 procedure io_medd;
2 6340 begin
3 6341 integer array field opref;
3 6342 integer afs, kl, i;
3 6343 real dato, t;
3 6344
3 6344
3 6344 procedure skriv_io_medd(zud,omfang);
3 6345 value omfang;
3 6346 zone zud;
3 6347 integer omfang;
3 6348 begin
4 6349 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6350 if omfang > 0 then
4 6351 disable begin integer x;
5 6352 trap(slut);
5 6353 write(zud,"nl",1,
5 6354 <: opref: :>,opref,"nl",1,
5 6355 <: afs: :>,afs,"nl",1,
5 6356 <: kl: :>,kl,"nl",1,
5 6357 <: i: :>,i,"nl",1,
5 6358 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6359 <: t: :>,t,"nl",1,
5 6360 <::>);
5 6361 skriv_coru(zud,coru_no(104));
5 6362 slut:
5 6363 end;<*disable*>
4 6364 end skriv_io_medd;
3 6365
3 6365 trap(io_medd_trap);
3 6366 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6367 <*+2*>
3 6368 if testbit0 and overvåget or testbit28 then
3 6369 skriv_io_medd(out,0);
3 6370 <*-2*>
3 6371 \f
3 6371 message procedure io_medd side 2;
3 6372
3 6372 repeat
3 6373 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6374 <*V*> wait(bs_zio_adgang);
3 6375
3 6375 afs:= d.opref.data.op_spool_kilde;
3 6376 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6377 kl:= round t;
3 6378 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6379 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6380 i:= replacechar(1,'.');
3 6381 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6382 replacechar(1,i);
3 6383 write(z_io,d.opref.data.op_spool_text);
3 6384 setposition(z_io,0,0);
3 6385
3 6385 signalbin(bs_zio_adgang);
3 6386 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6387 until false;
3 6388
3 6388 io_medd_trap:
3 6389 skriv_io_medd(zbillede,1);
3 6390
3 6390 end io_medd;
2 6391
2 6391 procedure io_nulstil_tællere;
2 6392 begin
3 6393 real nu, dato, kl, forr, næste, et_døgn, r;
3 6394 integer array field opref;
3 6395 integer ventetid, omr, typ, sum;
3 6396 integer array ialt(1:5);
3 6397
3 6397 procedure skriv_io_null(zud,omfang);
3 6398 value omfang;
3 6399 zone zud;
3 6400 integer omfang;
3 6401 begin
4 6402 disable write(zud,"nl",1,<:+++ io_nulstil_tællere :>);
4 6403 if omfang > 0 then
4 6404 disable begin real t; real array field raf;
5 6405 raf:=0;
5 6406 trap(slut);
5 6407 write(zud,"nl",1,
5 6408 <: opref: :>,opref,"nl",1,
5 6409 <: ventetid: :>,ventetid,"nl",1,
5 6410 <: omr: :>,omr,"nl",1,
5 6411 <: typ: :>,typ,"nl",1,
5 6412 <: sum: :>,sum,"nl",1);
5 6413 write(zud,
5 6414 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1);
5 6415 write(zud,
5 6416 <: forr: :>,<< zddddd>,systime(4,forr,t),t,"nl",1);
5 6417 write(zud,
5 6418 <: næste: :>,<< zddddd>,systime(4,næste,t),t,"nl",1);
5 6419 write(zud,
5 6420 <: r: :>,<< zddddd>,systime(4,r,t),t,"nl",1,
5 6421 <: dato: :>,dato,"nl",1,
5 6422 <: kl: :>,kl,"nl",1,
5 6423 <: et-døgn: :>,<< dddddd>,et_døgn,"nl",1,
5 6424 <::>);
5 6425 write(zud,"nl",1,<:ialt: :>);
5 6426 skriv_hele(zud,ialt.raf,10,2);
5 6427 skriv_coru(zud,coru_no(105));
5 6428 slut:
5 6429 end;<*disable*>
4 6430 end skriv_io_null;
3 6431
3 6431 trap(io_null_trap);
3 6432 et_døgn:= 24*60*60.0;
3 6433 stack_claim(500);
3 6434 <*+2*>
3 6435 if testbit0 and overvåget or testbit28 then
3 6436 skriv_io_null(out,0);
3 6437 <*-2*>
3 6438 pass;
3 6439
3 6439 systime(1,0.0,nu);
3 6440 dato:= systime(4,nu,kl);
3 6441 if nulstil_systællere >= 0 then
3 6442 begin
4 6443 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6444 + et_døgn
4 6445 else næste:= systid(dato,nulstil_systællere);
4 6446 forr:= næste - et_døgn;
4 6447 if (forr - systællere_nulstillet) > et_døgn then
4 6448 næste:= nu;
4 6449 end;
3 6450
3 6450 repeat
3 6451 ventetid:= (if nulstil_systællere < 0 then (-1) else (næste - nu));
3 6452 <*V*> waitch(cs_io_nulstil,opref,io_optype,ventetid);
3 6453
3 6453 if opref <= 0 then
3 6454 begin
4 6455 <* nulstil opkaldstællere *>
4 6456 wait(bs_zio_adgang);
4 6457 setposition(z_io,0,0);
4 6458
4 6458 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6459
4 6459 write(z_io,"nl",1,<:!TÆ,N (automatisk):>,"nl",2,
4 6460 <:område udgående alm.ind nød ind:>,
4 6461 <: ind-ialt total ej forb. optaget:>,"nl",1);
4 6462 for omr := 1 step 1 until max_antal_områder do
4 6463 begin
5 6464 sum:= 0;
5 6465 write(z_io,true,6,string område_navn(omr),":",1);
5 6466 for typ:= 1 step 1 until 3 do
5 6467 begin
6 6468 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6469 sum:= sum + opkalds_tællere((omr-1)*5+typ);
6 6470 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6471 end;
5 6472 write(z_io,<< ddddddd>,
5 6473 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
5 6474 for typ:= 4 step 1 until 5 do
5 6475 begin
6 6476 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6477 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6478 end;
5 6479 write(z_io,"nl",1);
5 6480 end;
4 6481 sum:= 0;
4 6482 write(z_io,"nl",1,<:ialt ::>);
4 6483 for typ:= 1 step 1 until 3 do
4 6484 begin
5 6485 write(z_io,<< ddddddd>,ialt(typ));
5 6486 sum:= sum+ialt(typ);
5 6487 end;
4 6488 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6489 ialt(4), ialt(5), "nl",3);
4 6490
4 6490 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6491 write(z_io,<:oper. udgående alm.ind nød ind:>,
4 6492 <: ind-ialt total ej forb. optaget:>,"nl",1);
4 6493 for omr := 1 step 1 until max_antal_operatører do
4 6494 begin
5 6495 sum:= 0;
5 6496 if bpl_navn(omr)=long<::> then
5 6497 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
5 6498 else
5 6499 write(z_io,true,6,string bpl_navn(omr),":",1);
5 6500 for typ:= 1 step 1 until 3 do
5 6501 begin
6 6502 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
6 6503 sum:= sum + operatør_tællere((omr-1)*5+typ);
6 6504 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6505 end;
5 6506 write(z_io,<< ddddddd>,
5 6507 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
5 6508 for typ:= 4 step 1 until 5 do
5 6509 begin
6 6510 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
6 6511 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6512 end;
5 6513 write(z_io,"nl",1);
5 6514 end;
4 6515 sum:= 0;
4 6516 write(z_io,"nl",1,<:ialt ::>);
4 6517 for typ:= 1 step 1 until 3 do
4 6518 begin
5 6519 write(z_io,<< ddddddd>,ialt(typ));
5 6520 sum:= sum+ialt(typ);
5 6521 end;
4 6522 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6523 ialt(4),ialt(5),"nl",2);
4 6524
4 6524 typ:= replacechar(1,':');
4 6525 write(z_io,<:tællere nulstilles :>);
4 6526 if nulstil_systællere=(-1) then
4 6527 write(z_io,<:ikke automatisk:>,"nl",1)
4 6528 else
4 6529 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
4 6530 nulstil_systællere,"nl",1);
4 6531 replacechar(1,'.');
4 6532 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
4 6533 systime(4,systællere_nulstillet,r));
4 6534 replacechar(1,':');
4 6535 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
4 6536 replacechar(1,typ);
4 6537 write(z_io,"*",1,"nl",1);
4 6538 setposition(z_io,0,0);
4 6539 signal_bin(bs_zio_adgang);
4 6540
4 6540 for omr:= 1 step 1 until max_antal_områder*5 do
4 6541 opkalds_tællere(omr):= 0;
4 6542 for omr:= 1 step 1 until max_antal_operatører*5 do
4 6543 operatør_tællere(omr):= 0;
4 6544 systællere_nulstillet:= næste;
4 6545 opdater_tf_systællere;
4 6546 end
3 6547 else
3 6548 signalch(d.opref.retur,opref,d.opref.optype);
3 6549
3 6549 systime(1,0.0,nu);
3 6550 dato:= systime(4,nu,kl);
3 6551 if nulstil_systællere >= 0 then
3 6552 begin
4 6553 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6554 + et_døgn
4 6555 else næste:= systid(dato,nulstil_systællere);
4 6556 forr:= næste - et_døgn;
4 6557 end;
3 6558 until false;
3 6559
3 6559 io_null_trap:
3 6560 skriv_io_null(zbillede,1);
3 6561 end io_nulstil_tællere;
2 6562
2 6562 \f
2 6562 message operatør_erklæringer side 1 - 810602/hko;
2 6563 integer
2 6564 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6565 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6566 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6567 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6568 integer array
2 6569 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6570 operatørmaske(1:op_maske_lgd//2),
2 6571 op_talevej(0:max_antal_operatører),
2 6572 tv_operatør(0:max_antal_taleveje),
2 6573 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6574 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6575 ant_i_opkø,
2 6576 cs_operatør,
2 6577 cs_op_fil(1:max_antal_operatører);
2 6578 boolean
2 6579 op_cqf_tab_ændret;
2 6580 integer field
2 6581 op_spool_kilde;
2 6582 real field
2 6583 op_spool_tid;
2 6584 long array field
2 6585 op_spool_text;
2 6586 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6587 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6588 \f
2 6588 message procedure op_fejl side 1 - 830310/hko;
2 6589
2 6589 procedure op_fejl(z,s,b);
2 6590 integer s,b;
2 6591 zone z;
2 6592 begin
3 6593 disable begin
4 6594 integer array iz(1:20);
4 6595 integer i,j,k,n;
4 6596 integer array field iaf,iaf1,msk;
4 6597 boolean input;
4 6598 real array field laf,laf1;
4 6599
4 6599 getzone6(z,iz);
4 6600 iaf:=laf:=2;
4 6601 input:= iz(13) = 1;
4 6602 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6603 if iz.laf(1)=terminal_navn.laf1(1) and
4 6604 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6605
4 6605 <*+2*> if testbit31 then
4 6606 <**> begin
5 6607 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6608 <**> <:s=:>); outintbits(out,s);
5 6609 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6610 <**> else <:output:>,"nl",1);
5 6611 <**> setposition(out,0,0);
5 6612 <**> end;
4 6613 <*-2*>
4 6614 iaf:=j*terminal_beskr_længde;
4 6615 k:=1;
4 6616
4 6616 i:= terminal_tab.iaf.terminal_tilstand;
4 6617 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6618 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6619 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6620 if s <> (1 shift 21 +2) then
4 6621 begin
5 6622 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6623 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6624 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6625 sæt_bit_ia(opkaldsflag,j,0);
5 6626 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6627 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6628 begin
6 6629 msk:= k*op_maske_lgd;
6 6630 if læsbit_ia(bpl_def.msk,j) then
6 6631 <**> begin
7 6632 n:= 0;
7 6633 for i:= 1 step 1 until max_antal_operatører do
7 6634 if læsbit_ia(bpl_def.msk,i) then
7 6635 begin
8 6636 iaf1:= i*terminal_beskr_længde;
8 6637 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6638 n:= n+1;
8 6639 end;
7 6640 bpl_tilst(j,1):= n;
7 6641 end;
6 6642 <**> <*
6 6643 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6644 *> end;
5 6645 signal_bin(bs_mobil_opkald);
5 6646 end;
4 6647
4 6647 if input or -,input then
4 6648 begin
5 6649 z(1):=real <:<'?'><'?'><'em'>:>;
5 6650 b:=2;
5 6651 end;
4 6652 end; <*disable*>
3 6653 end op_fejl;
2 6654 \f
2 6654 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6655
2 6655 procedure tvswitch_fejl(z,s,b);
2 6656 integer s,b;
2 6657 zone z;
2 6658 begin
3 6659 disable begin
4 6660 integer array iz(1:20);
4 6661 integer i,j,k;
4 6662 integer array field iaf;
4 6663 boolean input;
4 6664 real array field raf;
4 6665
4 6665 getzone6(z,iz);
4 6666 iaf:=raf:=2;
4 6667 input:= iz(13) = 1;
4 6668 <*+2*> if testbit31 then
4 6669 <**> begin
5 6670 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6671 <**> <:s=:>); outintbits(out,s);
5 6672 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6673 <**> else <:output:>,"nl",1);
5 6674 <**> skrivhele(out,z,b,5);
5 6675 <**> setposition(out,0,0);
5 6676 <**> end;
4 6677 <*-2*>
4 6678 k:=1;
4 6679 if s <> (1 shift 21 +2) then
4 6680 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6681 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6682
4 6682 if input or -,input then
4 6683 begin
5 6684 z(1):=real <:<'em'>:>;
5 6685 b:=2;
5 6686 end;
4 6687 end; <*disable*>
3 6688 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6689 end tvswitch_fejl;
2 6690
2 6690 procedure skriv_talevejs_tab(z);
2 6691 zone z;
2 6692 begin
3 6693 write(z,"nl",2,<:talevejsswitch::>);
3 6694 write(z,"nl",1,<: operatører::>,"nl",1);
3 6695 for i:= 1 step 1 until max_antal_operatører do
3 6696 begin
4 6697 write(z,<< dd>,i,":",1,op_talevej(i));
4 6698 if i mod 8=0 then outchar(z,'nl');
4 6699 end;
3 6700 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6701 for i:= 1 step 1 until max_antal_taleveje do
3 6702 begin
4 6703 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6704 if i mod 8=0 then outchar(z,'nl');
4 6705 end;
3 6706 write(z,"nl",3);
3 6707 end;
2 6708 \f
2 6708 message procedure skriv_opk_alarm_tab side 1;
2 6709
2 6709 procedure skriv_opk_alarm_tab(z);
2 6710 zone z;
2 6711 begin
3 6712 integer nr;
3 6713 integer array field tab;
3 6714 real t;
3 6715
3 6715 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6716 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6717 for nr:=1 step 1 until max_antal_operatører do
3 6718 begin
4 6719 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6720 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6721 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6722 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6723 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6724 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6725 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6726 "nl",1);
4 6727 end;
3 6728 end;
2 6729 \f
2 6729 message procedure skriv_op_spool_buf side 1;
2 6730
2 6730 procedure skriv_op_spool_buf(z);
2 6731 zone z;
2 6732 begin
3 6733 integer array field ref;
3 6734 integer nr, kilde;
3 6735 real dato, kl;
3 6736
3 6736 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6737 for nr:= 1 step 1 until op_spool_postantal do
3 6738 begin
4 6739 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6740 ref:= (nr-1)*op_spool_postlgd;
4 6741 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6742 begin
5 6743 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6744 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6745 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6746 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6747 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6748 op_spool_buf.ref.op_spool_text);
5 6749 end;
4 6750 outchar(z,'nl');
4 6751 end;
3 6752 end;
2 6753
2 6753 procedure skriv_cqf_tabel(z,lang);
2 6754 value lang;
2 6755 zone z;
2 6756 boolean lang;
2 6757 begin
3 6758 integer array field ref;
3 6759 integer i,ant;
3 6760 real dato, kl;
3 6761
3 6761 ant:= 0;
3 6762 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6763 if -,lang then
3 6764 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6765 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6766 else
3 6767 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6768 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6769 for i:= 1 step 1 until max_cqf do
3 6770 begin
4 6771 ref:= (i-1)*cqf_lgd;
4 6772 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6773 begin
5 6774 ant:= ant+1;
5 6775 if lang then
5 6776 write(z,<<dd>,i,":",1);
5 6777 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6778 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6779 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6780 begin
6 6781 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6782 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6783 end
5 6784 else
5 6785 write(z,"sp",14,"?",1);
5 6786 if lang then
5 6787 begin
6 6788 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6789 begin
7 6790 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6791 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6792 end
6 6793 else
6 6794 write(z,"sp",14,"?",1);
6 6795 end
5 6796 else
5 6797 write(z,"sp",2);
5 6798 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6799 end;
4 6800 end;
3 6801 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6802 end;
2 6803
2 6803 procedure sorter_cqftab(l,u);
2 6804 value l,u;
2 6805 integer l,u;
2 6806 begin
3 6807 integer array field ii,jj;
3 6808 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6809
3 6809 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6810 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6811 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6812 repeat
3 6813 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6814 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6815 if ii <= jj then
3 6816 begin
4 6817 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6818 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6819 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6820 ii:= ii+cqf_lgd;
4 6821 jj:= jj-cqf_lgd;
4 6822 end;
3 6823 until ii>jj;
3 6824 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6825 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6826 end;
2 6827 \f
2 6827 message procedure ht_symbol side 1 - 851001/cl;
2 6828
2 6828 procedure ht_symbol(z);
2 6829 zone z;
2 6830 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6831
2 6831
2 6831
2 6831
2 6831 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6831 @@ @@ @@
2 6831 @@ @@ @@
2 6831 @@ @@ @@
2 6831 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6831 @@ @@
2 6831 @@ @@
2 6831 @@ @@
2 6831 @@ @@@@@@@@@@@@@ @@
2 6831 @@ @@ @@ @@
2 6831 @@ @@ @@ @@
2 6831 @@ @@ @@ @@
2 6831 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6831 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6832 \f
2 6832 message procedure definer_taster side 1 - 891214,cl;
2 6833
2 6833 procedure definer_taster(nr);
2 6834 value nr;
2 6835 integer nr;
2 6836 begin
3 6837
3 6837 setposition(z_op(nr),0,0);
3 6838 write(z_op(nr),
3 6839 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6840 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6841 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6842 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6843 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6844 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6845 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6846 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6847 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6848 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6849 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6850 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6851 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6852 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6853 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6854 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6855 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6856 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6857 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6858 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6859 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6860 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6861 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6862 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6863 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6864 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6865 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6866 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6867 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6868 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6869 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6870 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6871 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6872 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6873 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6874 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6875 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6876 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6877 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6878 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6879 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6880 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6881 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6882 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6883 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6884 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6885 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6886 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6887 <::>);
3 6888 end;
2 6889 \f
2 6889 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6890
2 6890 procedure skriv_terminal_tab(z);
2 6891 zone z;
2 6892 begin
3 6893 integer array field ref;
3 6894 integer t1,i,j,id,k;
3 6895
3 6895 write(z,"ff",1,<:
3 6896 ******* terminalbeskrivelser ********
3 6897
3 6897 # a k l p m m n o
3 6898 1 l a y a o o ø p
3 6899 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6900 <*
3 6901 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6902 *>
3 6903 for i:=1 step 1 until max_antal_operatører do
3 6904 begin
4 6905 ref:=i*terminal_beskr_længde;
4 6906 t1:=terminal_tab.ref(1);
4 6907 id:=terminal_tab.ref(2);
4 6908 k:=terminal_tab.ref(3);
4 6909 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6910 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6911 "sp",1);
4 6912 for j:=11 step -1 until 2 do
4 6913 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6914 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6915 "sp",1);
4 6916 skriv_id(z,id,9);
4 6917 skriv_id(z,k,9);
4 6918 end;
3 6919 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6920 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6921 write(z,"nl",1);
3 6922 end skriv_terminal_tab;
2 6923 \f
2 6923 message procedure h_operatør side 1 - 810520/hko;
2 6924
2 6924 <* hovedmodulkorutine for operatørterminaler *>
2 6925 procedure h_operatør;
2 6926 begin
3 6927 integer array field op_ref;
3 6928 integer k,nr,ant,ref,dest_sem;
3 6929 procedure skriv_hoperatør(zud,omfang);
3 6930 value omfang;
3 6931 zone zud;
3 6932 integer omfang;
3 6933 begin
4 6934
4 6934 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6935 if omfang>0 then
4 6936 disable begin integer x;
5 6937 trap(slut);
5 6938 write(zud,"nl",1,
5 6939 <: op_ref: :>,op_ref,"nl",1,
5 6940 <: nr: :>,nr,"nl",1,
5 6941 <: ant: :>,ant,"nl",1,
5 6942 <: ref: :>,ref,"nl",1,
5 6943 <: k: :>,k,"nl",1,
5 6944 <: dest_sem: :>,dest_sem,"nl",1,
5 6945 <::>);
5 6946 skriv_coru(zud,coru_no(200));
5 6947 slut:
5 6948 end;
4 6949 end skriv_hoperatør;
3 6950
3 6950 trap(hop_trap);
3 6951 stack_claim(if cm_test then 198 else 146);
3 6952
3 6952 <*+2*>
3 6953 if testbit8 and overvåget or testbit28 then
3 6954 skriv_hoperatør(out,0);
3 6955 <*-2*>
3 6956 \f
3 6956 message procedure h_operatør side 2 - 820304/hko;
3 6957
3 6957 repeat
3 6958 wait_ch(cs_op,op_ref,true,-1);
3 6959 <*+4*>
3 6960 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6961 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6962 <*-4*>
3 6963
3 6963 k:=d.op_ref.opkode extract 12;
3 6964 dest_sem:=
3 6965 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6966 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6967 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6968 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6969 if k=37 then cs_op_spool else
3 6970 if k=40 or k=38 then 0
3 6971 else -1;
3 6972 <*+4*>
3 6973 if dest_sem=-1 then
3 6974 begin
4 6975 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6976 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6977 end
3 6978 else
3 6979 <*-4*>
3 6980 if k=40 then
3 6981 begin
4 6982 dest_sem:= d.op_ref.retur;
4 6983 d.op_ref.retur:= cs_op_retur;
4 6984 for nr:= 1 step 1 until max_antal_operatører do
4 6985 begin
5 6986 inspect_ch(cs_operatør(nr),genoptype,ant);
5 6987 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 6988 or læsbit_ia(samtaleflag,nr))
5 6989 and læsbit_ia(operatørmaske,nr) then
5 6990 begin
6 6991 ref:= op_ref;
6 6992 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6993 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6994 <*+4*> if op_ref <> ref then
6 6995 fejlreaktion(11<*fr.post*>,op_ref,
6 6996 <:opdater opkaldskø,retur:>,0);
6 6997 <*-4*>
6 6998 end;
5 6999 end;
4 7000 d.op_ref.retur:= dest_sem;
4 7001 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7002 end
3 7003 else
3 7004 if k=38 then
3 7005 begin
4 7006 dest_sem:= d.opref.retur;
4 7007 d.op_ref.retur:= cs_op_retur;
4 7008 for nr:= 1 step 1 until max_antal_operatører do
4 7009 begin
5 7010 if d.opref.data.op_spool_kilde <> nr then
5 7011 begin
6 7012 ref:= op_ref;
6 7013 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 7014 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 7015 <*+4*> if op_ref <> ref then
6 7016 fejlreaktion(11<*fr.post*>,op_ref,
6 7017 <:opdater opkaldskø,retur:>,0);
6 7018 <*-4*>
6 7019 end;
5 7020 end;
4 7021 if d.opref.data.op_spool_kilde<>0 then
4 7022 begin
5 7023 ref:= op_ref;
5 7024 nr:= d.opref.data.op_spool_kilde;
5 7025 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 7026 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 7027 <*+4*> if op_ref <> ref then
5 7028 fejlreaktion(11<*fr.post*>,op_ref,
5 7029 <:operatørmedddelelse, retur:>,0);
5 7030 <*-4*>
5 7031 d.op_ref.retur:= dest_sem;
5 7032 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 7033 end
4 7034 else
4 7035 begin
5 7036 d.op_ref.retur:= dest_sem;
5 7037 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 7038 end;
4 7039 end
3 7040 else
3 7041 begin
4 7042 \f
4 7042 message procedure h_operatør side 3 - 810601/hko;
4 7043
4 7043 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 7044 begin
5 7045 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 7046 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 7047 +terminal_tab.iaf.terminal_tilstand extract 21;
5 7048 end;
4 7049 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7050 end;
3 7051 until false;
3 7052
3 7052 hop_trap:
3 7053 disable skriv_hoperatør(zbillede,1);
3 7054 end h_operatør;
2 7055 \f
2 7055 message procedure operatør side 1 - 820304/hko;
2 7056
2 7056 procedure operatør(nr);
2 7057 value nr;
2 7058 integer nr;
2 7059 begin
3 7060 integer array field op_ref,ref,vt_op,iaf,tab;
3 7061 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 7062 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 7063 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 7064 real kommstart,kommslut;
3 7065 \f
3 7065 message procedure operatør side 1a - 820301/hko;
3 7066
3 7066 procedure skriv_operatør(zud,omfang);
3 7067 value omfang;
3 7068 zone zud;
3 7069 integer omfang;
3 7070 begin integer i;
4 7071
4 7071 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 7072 write(zud,"sp",26-i);
4 7073 if omfang > 0 then
4 7074 disable begin
5 7075 integer x;
5 7076 trap(slut);
5 7077 write(zud,"nl",1,
5 7078 <: op-ref: :>,op_ref,"nl",1,
5 7079 <: kode: :>,kode,"nl",1,
5 7080 <: aktion: :>,aktion,"nl",1,
5 7081 <: ref: :>,ref,"nl",1,
5 7082 <: vt_op: :>,vt_op,"nl",1,
5 7083 <: iaf: :>,iaf,"nl",1,
5 7084 <: status: :>,status,"nl",1,
5 7085 <: tilstand: :>,tilstand,"nl",1,
5 7086 <: bv: :>,bv,"nl",1,
5 7087 <: bs: :>,bs,"nl",1,
5 7088 <: bs-tilst: :>,bs_tilst,"nl",1,
5 7089 <: kanal: :>,kanal,"nl",1,
5 7090 <: opgave: :>,opgave,"nl",1,
5 7091 <: pos: :>,pos,"nl",1,
5 7092 <: indeks: :>,indeks,"nl",1,
5 7093 <: sep: :>,sep,"nl",1,
5 7094 <: sluttegn: :>,sluttegn,"nl",1,
5 7095 <: vogn: :>,vogn,"nl",1,
5 7096 <: ll: :>,ll,"nl",1,
5 7097 <: garage: :>,garage,"nl",1,
5 7098 <: skærmmåde: :>,skærmmåde,"nl",1,
5 7099 <: res: :>,res,"nl",1,
5 7100 <: tab: :>,tab,"nl",1,
5 7101 <: rkom: :>,rkom,"nl",1,
5 7102 <: par1: :>,par1,"nl",1,
5 7103 <: par2: :>,par2,"nl",1,
5 7104 <::>);
5 7105 skriv_coru(zud,coru_no(200+nr));
5 7106 slut:
5 7107 end;
4 7108 end skriv_operatør;
3 7109 \f
3 7109 message procedure skærmstatus side 1 - 810518/hko;
3 7110
3 7110 integer
3 7111 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 7112 integer tilstand,b_v,b_s,b_s_tilst;
3 7113 begin
4 7114 integer i,j;
4 7115
4 7115 i:= terminal_tab.ref(1);
4 7116 b_s:= terminal_tab.ref(2);
4 7117 b_s_tilst:= i extract 12;
4 7118 j:= b_s_tilst extract 3;
4 7119 b_v:= i shift (-12) extract 4;
4 7120 tilstand:= i shift (-21);
4 7121
4 7121 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 7122 if b_v = 0 and j = 1<*opkald*> then 1 else
4 7123 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 7124 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 7125 end skærmstatus;
3 7126 \f
3 7126 message procedure skriv_skærm side 1 - 810522/hko;
3 7127
3 7127 procedure skriv_skærm(nr);
3 7128 value nr;
3 7129 integer nr;
3 7130 begin
4 7131 integer i;
4 7132
4 7132 disable definer_taster(nr);
4 7133
4 7133 skriv_skærm_maske(nr);
4 7134 skriv_skærm_opkaldskø(nr);
4 7135 skriv_skærm_b_v_s(nr);
4 7136 for i:= 1 step 1 until max_antal_kanaler do
4 7137 skriv_skærm_kanal(nr,i);
4 7138 cursor(z_op(nr),1,1);
4 7139 <*V*> setposition(z_op(nr),0,0);
4 7140 end skriv_skærm;
3 7141 \f
3 7141 message procedure skriv_skærm_id side 1 - 830310/hko;
3 7142
3 7142 procedure skriv_skærm_id(nr,id,nød);
3 7143 value nr,id,nød;
3 7144 integer nr,id;
3 7145 boolean nød;
3 7146 begin
4 7147 integer linie,løb,bogst,i,p;
4 7148
4 7148 i:= id shift (-22);
4 7149
4 7149 case i+1 of
4 7150 begin
5 7151 begin <* busnr *>
6 7152 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 7153 (id extract 14) mod 10000);
6 7154 if id shift (-14) extract 8 > 0 then
6 7155 p:= p+write(z_op(nr),".",1,
6 7156 string bpl_navn(id shift (-14) extract 8));
6 7157 write(z_op(nr),"sp",11-p);
6 7158 end;
5 7159
5 7159 begin <*linie/løb*>
6 7160 linie:= id shift (-12) extract 10;
6 7161 bogst:= id shift (-7) extract 5;
6 7162 if bogst > 0 then bogst:= bogst +'A'-1;
6 7163 løb:= id extract 7;
6 7164 write(z_op(nr),if nød then "*" else "sp",1,
6 7165 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 7166 false add bogst,1,"/",1,løb,
6 7167 "sp",if løb > 9 then 3 else 4);
6 7168 end;
5 7169
5 7169 begin <*gruppe*>
6 7170 write(z_op(nr),<:GRP :>);
6 7171 if id shift (-21) extract 1 = 1 then
6 7172 begin <*specialgruppe*>
7 7173 løb:= id extract 7;
7 7174 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 7175 <<d>,løb,"sp",2);
7 7176 end
6 7177 else
6 7178 begin
7 7179 linie:= id shift (-5) extract 10;
7 7180 bogst:= id extract 5;
7 7181 if bogst > 0 then bogst:= bogst +'A'-1;
7 7182 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 7183 false add bogst,1,"sp",2);
7 7184 end;
6 7185 end;
5 7186
5 7186 <* kanal eller område *>
5 7187 begin
6 7188 linie:= (id shift (-20) extract 2) + 1;
6 7189 case linie of
6 7190 begin
7 7191 write(z_op(nr),"sp",11-write(z_op(nr),
7 7192 string kanal_navn(id extract 20)));
7 7193 write(z_op(nr),<:K*:>,"sp",9);
7 7194 write(z_op(nr),"sp",11-write(z_op(nr),
7 7195 <:OMR :>,string område_navn(id extract 20)));
7 7196 write(z_op(nr),<:ALLE:>,"sp",7);
7 7197 end;
6 7198 end;
5 7199
5 7199 end <* case i *>
4 7200 end skriv_skærm_id;
3 7201 \f
3 7201 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 7202
3 7202 procedure skriv_skærm_kanal(nr,kanal);
3 7203 value nr,kanal;
3 7204 integer nr,kanal;
3 7205 begin
4 7206 integer i,j,k,t,omr;
4 7207 integer array field tref,kref;
4 7208 boolean nød;
4 7209
4 7209 tref:= nr*terminal_beskr_længde;
4 7210 kref:= (kanal-1)*kanal_beskr_længde;
4 7211 t:= kanaltab.kref.kanal_tilstand;
4 7212 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 7213 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 7214 cursor(z_op(nr),kanal+2,28);
4 7215 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 7216 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 7217 " ",1," ",1);
4 7218 write(z_op(nr),true,6,string kanal_navn(kanal));
4 7219 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 7220 pabx_id(kanal_id(kanal) extract 5)
4 7221 else
4 7222 radio_id(kanal_id(kanal) extract 5);
4 7223 for i:= -2 step 1 until 0 do
4 7224 begin
5 7225 write(z_op(nr),
5 7226 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 7227 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 7228 end;
4 7229 write(z_op(nr),<:: :>);
4 7230 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 7231 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 7232 begin
5 7233 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 7234 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 7235 end
4 7236 else
4 7237 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 7238 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 7239 else
4 7240 if i > 0 and
4 7241 ( true <* i <> nr *> <* OPT også ud på egen skærm 960527/CL *> or
4 7242 j = kanal <* kanal = kanalnr for ventepos *> or
4 7243 (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 7244 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 7245 begin
5 7246 write(z_op(nr),<:OPT :>);
5 7247 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 7248 else write(z_op(nr),string bpl_navn(i));
5 7249 end
4 7250 else
4 7251 if false then
4 7252 begin
5 7253 i:= kanaltab.kref.kanal_id1;
5 7254 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 7255 skriv_skærm_id(nr,i,nød);
5 7256 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 7257 i:= kanaltab.kref.kanal_id2;
5 7258 if i<>0 then skriv_skærm_id(nr,i,false);
5 7259 end;
4 7260 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7261 end skriv_skærm_kanal;
3 7262 \f
3 7262 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 7263
3 7263 procedure skriv_skærm_b_v_s(nr);
3 7264 value nr;
3 7265 integer nr;
3 7266 begin
4 7267 integer i,j,k,kv,ks,t;
4 7268 integer array field tref,kref;
4 7269
4 7269 tref:= nr*terminal_beskr_længde;
4 7270 i:= terminal_tab.tref.terminal_tilstand;
4 7271 kv:= i shift (-12) extract 4;
4 7272 ks:= terminaltab.tref(2) extract 20;
4 7273 <*V*> setposition(z_op(nr),0,0);
4 7274 cursor(z_op(nr),18,28);
4 7275 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7276 cursor(z_op(nr),20,28);
4 7277 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7278 cursor(z_op(nr),21,28);
4 7279 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7280 cursor(z_op(nr),20,28);
4 7281 if op_talevej(nr)<>0 then
4 7282 begin
5 7283 cursor(z_op(nr),18,28);
5 7284 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 7285 end;
4 7286 if kv <> 0 then
4 7287 begin
5 7288 kref:= (kv-1)*kanal_beskr_længde;
5 7289 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 7290 else kanaltab.kref.kanal_id2;
5 7291 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 7292 else kanaltab.kref.kanal_alt_id2;
5 7293 write(z_op(nr),true,6,string kanal_navn(kv));
5 7294 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 7295 skriv_skærm_id(nr,k,false);
5 7296 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 7297 end;
4 7298
4 7298 cursor(z_op(nr),21,28);
4 7299 j:= terminal_tab.tref(2);
4 7300 if i shift (-21) <> 0 <*ikke ledig*> then
4 7301 begin
5 7302 \f
5 7302 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 7303
5 7303 if i shift (-21) = 1 <*samtale*> then
5 7304 begin
6 7305 if j shift (-20) = 12 then
6 7306 begin
7 7307 write(z_op(nr),true,6,string kanal_navn(ks));
7 7308 end
6 7309 else
6 7310 begin
7 7311 write(z_op(nr),true,6,<:K*:>);
7 7312 k:= 0;
7 7313 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 7314 k:= k+1;
7 7315 ks:= k;
7 7316 end;
6 7317 kref:= (ks-1)*kanal_beskr_længde;
6 7318 t:= kanaltab.kref.kanaltilstand;
6 7319 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 7320 t shift (-3) extract 1 = 1);
6 7321 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 7322 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 7323 if t shift (-5) extract 1 = 1 then <:MON :> else
6 7324 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 7325 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 7326 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 7327 if t shift (-9) extract 1 = 1 then
6 7328 write(z_op(nr),<:ALLE :>);
6 7329 if t shift (-8) extract 1 = 1 then
6 7330 write(z_op(nr),<:KATASTROFE :>);
6 7331 k:= kanaltab.kref.kanal_spec;
6 7332 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7333 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7334 end
5 7335 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7336 begin
6 7337 write(z_op(nr),<:K-:>,"sp",3);
6 7338 if j <> 0 then
6 7339 skriv_skærm_id(nr,j,false)
6 7340 else
6 7341 begin
7 7342 j:=terminal_tab.tref(3);
7 7343 skriv_skærm_id(nr,j,
7 7344 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7345 else 0));
7 7346 end;
6 7347 write(z_op(nr),<:OPT:>);
6 7348 end;
5 7349 end;
4 7350 <*V*> setposition(z_op(nr),0,0);
4 7351 end skriv_skærm_b_v_s;
3 7352 \f
3 7352 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7353
3 7353 procedure skriv_skærm_maske(nr);
3 7354 value nr;
3 7355 integer nr;
3 7356 begin
4 7357 integer i;
4 7358 <*V*> setposition(z_op(nr),0,0);
4 7359 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7360 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7361 "sp",1,"*",5,"nl",1,"-",80);
4 7362
4 7362 for i:= 3 step 1 until 21 do
4 7363 begin
5 7364 cursor(z_op(nr),i,26);
5 7365 outchar(z_op(nr),'!');
5 7366 end;
4 7367 cursor(z_op(nr),22,1);
4 7368 write(z_op(nr),"-",80);
4 7369 cursor(z_op(nr),1,1);
4 7370 <*V*> setposition(z_op(nr),0,0);
4 7371 end skriv_skærm_maske;
3 7372 \f
3 7372 message procedure skal_udskrives side 1 - 940522/cl;
3 7373
3 7373 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7374 value fordelt_til,aktuel_skærm;
3 7375 integer fordelt_til,aktuel_skærm;
3 7376 begin
4 7377 boolean skal_ud;
4 7378 integer n;
4 7379 integer array field iaf;
4 7380
4 7380 skal_ud:= true;
4 7381 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7382 begin
5 7383 for n:= 0 step 1 until 3 do
5 7384 begin
6 7385 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7386 begin
7 7387 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7388 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7389 goto returner;
7 7390 end;
6 7391 end;
5 7392 end;
4 7393 returner:
4 7394 skal_udskrives:= skal_ud;
4 7395 end;
3 7396
3 7396 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7397
3 7397 procedure skriv_skærm_opkaldskø(nr);
3 7398 value nr;
3 7399 integer nr;
3 7400 begin
4 7401 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7402 integer array field ref,iaf,tab;
4 7403 boolean skal_ud;
4 7404
4 7404 <*V*> wait(bs_opkaldskø_adgang);
4 7405 setposition(z_op(nr),0,0);
4 7406 ant:= 0; kmdo:= 0;
4 7407 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7408 ref:= første_nødopkald;
4 7409 if ref=0 then ref:=første_opkald;
4 7410 while ref <> 0 do
4 7411 begin
5 7412 i:= opkaldskø.ref(4);
5 7413 operatør:= i extract 8;
5 7414 type:=i shift (-8) extract 4;
5 7415
5 7415 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7416 *>
5 7417 if operatør > 64 then
5 7418 begin
6 7419 <* fordelt til gruppe af betjeningspladser *>
6 7420 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7421 while skal_ud and i<max_antal_operatører do
6 7422 begin
7 7423 i:=i+1;
7 7424 if læsbit_ia(bpl_def.iaf,i) then
7 7425 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7426 end;
6 7427 end
5 7428 else
5 7429 skal_ud:= skal_udskrives(operatør,nr);
5 7430 if skal_ud then
5 7431 begin
6 7432 ant:= ant +1;
6 7433 if ant < 6 then
6 7434 begin
7 7435 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7436 ttmm:= i shift (-12);
7 7437 vogn:= opkaldskø.ref(3);
7 7438 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7439 skriv_skærm_id(nr,vogn,type=2);
7 7440 write(z_op(nr),true,4,
7 7441 string område_navn(opkaldskø.ref(5) extract 4),
7 7442 <<zd.dd>,ttmm/100.0);
7 7443 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7444 begin
8 7445 if opkaldskø.ref(5) extract 4 <= 2 or
8 7446 opk_alarm.tab.alarm_lgd = 0 then
8 7447 begin
9 7448 if type=2 then
9 7449 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7450 else
9 7451 write(z_op(nr),"bel",1);
9 7452 end
8 7453 else if type>kmdo then kmdo:= type;
8 7454 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7455 end;
7 7456 end;<* ant < 6 *>
6 7457 end;<* operatør ok *>
5 7458
5 7458 ref:= opkaldskø.ref(1) extract 12;
5 7459 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7460 end;
4 7461 \f
4 7461 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7462
4 7462 signal_bin(bs_opkaldskø_adgang);
4 7463 if kmdo > opk_alarm.tab.alarm_tilst and
4 7464 kmdo > opk_alarm.tab.alarm_kmdo then
4 7465 begin
5 7466 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7467 signal_bin(bs_opk_alarm);
5 7468 end;
4 7469 if ant > 5 then
4 7470 begin
5 7471 cursor(z_op(nr),13,9);
5 7472 write(z_op(nr),<<+ddd>,ant-5);
5 7473 end
4 7474 else
4 7475 begin
5 7476 for i:= ant +1 step 1 until 6 do
5 7477 begin
6 7478 cursor(z_op(nr),i*2+1,1);
6 7479 write(z_op(nr),"sp",25);
6 7480 end;
5 7481 end;
4 7482 ant_i_opkø(nr):= ant;
4 7483 cursor(z_op(nr),1,1);
4 7484 <*V*> setposition(z_op(nr),0,0);
4 7485 end skriv_skærm_opkaldskø;
3 7486 \f
3 7486 message procedure operatør side 2 - 810522/hko;
3 7487
3 7487 trap(op_trap);
3 7488 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7489
3 7489 ref:= nr*terminal_beskr_længde;
3 7490 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7491 skærmmåde:= 0; <*normal*>
3 7492
3 7492 if operatør_auto_include(nr) then
3 7493 begin
4 7494 waitch(cs_att_pulje,opref,true,-1);
4 7495 i:= operatør_auto_include(nr) extract 2;
4 7496 if i<>3 then i:= 0;
4 7497 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7498 d.opref.data(1):= nr;
4 7499 signalch(cs_rad,opref,gen_optype or io_optype);
4 7500 end;
3 7501
3 7501 <*+2*>
3 7502 if testbit8 and overvåget or testbit28 then
3 7503 skriv_operatør(out,0);
3 7504 <*-2*>
3 7505 \f
3 7505 message procedure operatør side 3 - 810602/hko;
3 7506
3 7506 repeat
3 7507
3 7507 <*V*> wait_ch(cs_operatør(nr),
3 7508 op_ref,
3 7509 true,
3 7510 -1<*timeout*>);
3 7511 <*+2*>
3 7512 if testbit9 and overvåget then
3 7513 disable begin
4 7514 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7515 <: til operatør :>,nr);
4 7516 skriv_op(out,op_ref);
4 7517 end;
3 7518 <*-2*>
3 7519 monitor(8)reserve process:(z_op(nr),0,ia);
3 7520 kode:= d.op_ref.op_kode extract 12;
3 7521 i:= terminal_tab.ref.terminal_tilstand;
3 7522 status:= i shift(-21);
3 7523 opgave:=
3 7524 if kode=0 then 1 <* indlæs kommando *> else
3 7525 if kode=1 then 2 <* inkluder *> else
3 7526 if kode=2 then 3 <* ekskluder *> else
3 7527 if kode=40 then 4 <* opdater skærm *> else
3 7528 if kode=43 then 5 <* opkald etableret *> else
3 7529 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7530 if kode=38 then 7 <* operatør meddelelse *> else
3 7531 0; <* afvises *>
3 7532
3 7532 aktion:= case status +1 of(
3 7533 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7534 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7535 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7536 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7537 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7538 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7539 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7540 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7541 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7542 -1);
3 7543 \f
3 7543 message procedure operatør side 4 - 810424/hko;
3 7544
3 7544 case aktion+6 of
3 7545 begin
4 7546 begin
5 7547 <*-5: terminal optaget *>
5 7548
5 7548 d.op_ref.resultat:= 16;
5 7549 afslut_operation(op_ref,-1);
5 7550 end;
4 7551
4 7551 begin
5 7552 <*-4: operation uden virkning *>
5 7553
5 7553 afslut_operation(op_ref,-1);
5 7554 end;
4 7555
4 7555 begin
5 7556 <*-3: ulovlig operationskode *>
5 7557
5 7557 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7558 afslut_operation(op_ref,-1);
5 7559 end;
4 7560
4 7560 begin
5 7561 <*-2: ulovligt operatørterminal_nr *>
5 7562
5 7562 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7563 afslut_operation(op_ref,-1);
5 7564 end;
4 7565
4 7565 begin
5 7566 <*-1: ulovlig operatørtilstand *>
5 7567
5 7567 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7568 afslut_operation(op_ref,-1);
5 7569 end;
4 7570
4 7570 begin
5 7571 <* 0: ikke implementeret *>
5 7572
5 7572 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7573 afslut_operation(op_ref,-1);
5 7574 end;
4 7575
4 7575 begin
5 7576 \f
5 7576 message procedure operatør side 5 - 851001/cl;
5 7577
5 7577 <* 1: indlæs kommando *>
5 7578
5 7578
5 7578 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7579 if opk_alarm.tab.alarm_tilst > 0 then
5 7580 begin
6 7581 opk_alarm.tab.alarm_kmdo:= 3;
6 7582 signal_bin(bs_opk_alarm);
6 7583 pass;
6 7584 end;
5 7585 if d.op_ref.resultat > 3 then
5 7586 begin
6 7587 <*V*> setposition(z_op(nr),0,0);
6 7588 cursor(z_op(nr),24,1);
6 7589 skriv_kvittering(z_op(nr),op_ref,pos,
6 7590 d.op_ref.resultat);
6 7591 end
5 7592 else if d.op_ref.resultat = -1 then
5 7593 begin
6 7594 skærmmåde:= 0;
6 7595 skrivskærm(nr);
6 7596 end
5 7597 else if d.op_ref.resultat>0 then
5 7598 begin <*godkendt*>
6 7599 kode:=d.op_ref.opkode;
6 7600 i:= kode extract 12;
6 7601 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7602 if kode = 19 then 1 <*VO,S *> else
6 7603 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7604 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7605 if kode = 6 then 4 <*STop*> else
6 7606 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7607 if kode = 30 then 5 <*SP,D*> else
6 7608 if kode = 31 then 6 <*SP*> else
6 7609 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7610 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7611 if kode = 83 then 8 <*SL*> else
6 7612 if kode = 68 then 9 <*ST,D*> else
6 7613 if kode = 69 then 10 <*ST,V*> else
6 7614 if kode = 36 then 11 <*AL*> else
6 7615 if kode = 37 then 12 <*CC*> else
6 7616 if kode = 2 then 13 <*EX*> else
6 7617 if kode = 92 then 14 <*CQF,V*> else
6 7618 if kode = 38 then 15 <*AL,T*> else
6 7619 0;
6 7620 if j > 0 then
6 7621 begin
7 7622 case j of
7 7623 begin
8 7624 begin
9 7625 \f
9 7625 message procedure operatør side 6 - 851001/cl;
9 7626
9 7626 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7627
9 7627 vogn:=ia(1);
9 7628 ll:=ia(2);
9 7629 kanal:= if kode=11 or kode=19 then ia(3) else
9 7630 if kode=12 then ia(2) else 0;
9 7631 <*V*> wait_ch(cs_vt_adgang,
9 7632 vt_op,
9 7633 gen_optype,
9 7634 -1<*timeout sek*>);
9 7635 start_operation(vtop,200+nr,cs_operatør(nr),
9 7636 kode);
9 7637 d.vt_op.data(1):=vogn;
9 7638 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7639 d.vt_op.data(2):=ll;
9 7640 if kode=19 then d.vt_op.data(3):= kanal else
9 7641 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7642 indeks:= vt_op;
9 7643 signal_ch(cs_vt,
9 7644 vt_op,
9 7645 gen_optype or op_optype);
9 7646
9 7646 <*V*> wait_ch(cs_operatør(nr),
9 7647 vt_op,
9 7648 op_optype,
9 7649 -1<*timeout sek*>);
9 7650 <*+2*> if testbit10 and overvåget then
9 7651 disable begin
10 7652 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7653 <:: operation retur fra vt:>);
10 7654 skriv_op(out,vt_op);
10 7655 end;
9 7656 <*-2*>
9 7657 <*+4*> if vt_op<>indeks then
9 7658 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7659 <:operatør-kommando:>,0);
9 7660 <*-4*>
9 7661 <*V*> setposition(z_op(nr),0,0);
9 7662 cursor(z_op(nr),24,1);
9 7663 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7664 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7665 else vt_op,-1,d.vt_op.resultat);
9 7666 d.vt_op.optype:= gen_optype or vt_optype;
9 7667 disable afslut_operation(vt_op,cs_vt_adgang);
9 7668 end;
8 7669 begin
9 7670 \f
9 7670 message procedure operatør side 7 - 810921/hko,cl;
9 7671
9 7671 <* 2 vogntabel,linienr/-,busnr *>
9 7672
9 7672 d.op_ref.retur:= cs_operatør(nr);
9 7673 tofrom(d.op_ref.data,ia,10);
9 7674 indeks:= op_ref;
9 7675 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7676 wait_ch(cs_operatør(nr),
9 7677 op_ref,
9 7678 op_optype,
9 7679 -1<*timeout*>);
9 7680 <*+2*> if testbit10 and overvåget then
9 7681 disable begin
10 7682 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7683 skriv_op(out,op_ref);
10 7684 end;
9 7685 <*-2*>
9 7686 <*+4*>
9 7687 if indeks <> op_ref then
9 7688 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7689 <*-4*>
9 7690 i:= d.op_ref.resultat;
9 7691 if i = 0 or i > 3 then
9 7692 begin
10 7693 <*V*> setposition(z_op(nr),0,0);
10 7694 cursor(z_op(nr),24,1);
10 7695 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7696 end
9 7697 else
9 7698 begin
10 7699 integer antal,fil_ref;
10 7700
10 7700 skærm_måde:= 1;
10 7701 antal:= d.op_ref.data(6);
10 7702 fil_ref:= d.op_ref.data(7);
10 7703 <*V*> setposition(z_op(nr),0,0);
10 7704 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7705 "sp",14,"*",10,"sp",6,
10 7706 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7707 <*V*> setposition(z_op(nr),0,0);
10 7708 \f
10 7708 message procedure operatør side 8 - 841213/cl;
10 7709
10 7709 pos:= 1;
10 7710 while pos <= antal do
10 7711 begin
11 7712 integer bogst,løb;
11 7713
11 7713 disable i:= læs_fil(fil_ref,pos,j);
11 7714 if i <> 0 then
11 7715 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7716 else
11 7717 begin
12 7718 vogn:= fil(j,1) shift (-24) extract 24;
12 7719 løb:= fil(j,1) extract 24;
12 7720 if d.op_ref.opkode=9 then
12 7721 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7722 ll:= løb shift (-12) extract 10;
12 7723 bogst:= løb shift (-7) extract 5;
12 7724 if bogst > 0 then bogst:= bogst +'A'-1;
12 7725 løb:= løb extract 7;
12 7726 vogn:= vogn extract 14;
12 7727 i:= d.op_ref.opkode-8;
12 7728 for i:= i,i+1 do
12 7729 begin
13 7730 j:= (i+1) extract 1;
13 7731 case j +1 of
13 7732 begin
14 7733 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7734 false add bogst,1,"/",1,<<d__>,løb);
14 7735 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7736 end;
13 7737 end;
12 7738 if pos mod 5 = 0 then
12 7739 begin
13 7740 outchar(z_op(nr),'nl');
13 7741 <*V*> setposition(z_op(nr),0,0);
13 7742 end
12 7743 else write(z_op(nr),"sp",3);
12 7744 end;
11 7745 pos:=pos+1;
11 7746 end;
10 7747 write(z_op(nr),"*",1,"nl",1);
10 7748 \f
10 7748 message procedure operatør side 8a- 810507/hko;
10 7749
10 7749 d.opref.opkode:=104; <*slet-fil*>
10 7750 d.op_ref.data(4):=filref;
10 7751 indeks:=op_ref;
10 7752 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7753 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7754
10 7754 <*+2*> if testbit10 and overvåget then
10 7755 disable begin
11 7756 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7757 skriv_op(out,op_ref);
11 7758 end;
10 7759 <*-2*>
10 7760
10 7760 <*+4*> if op_ref<>indeks then
10 7761 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7762 <*-4*>
10 7763 if d.op_ref.data(9)<>0 then
10 7764 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7765 <:operatør, slet_fil:>,1);
10 7766 end;
9 7767 end;
8 7768
8 7768 begin
9 7769 \f
9 7769 message procedure operatør side 9 - 830310/hko;
9 7770
9 7770 <* 3 radio_kommandoer *>
9 7771
9 7771 kode:= d.op_ref.opkode;
9 7772 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7773 disable if testbit14 then
9 7774 begin
10 7775 integer i; <*lav en trap-bar blok*>
10 7776
10 7776 trap(test14_trap);
10 7777 systime(1,0,kommstart);
10 7778 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7779 string bpl_navn(nr),<: start :>,case rkom of (
10 7780 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7781 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7782 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7783 <:GE,T:>),<: :>);
10 7784 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7785 rkom=16 or rkom=17 or rkom=19)
10 7786 then
10 7787 begin
11 7788 if par1<>0 then skriv_id(zrl,par1,0);
11 7789 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7790 write(zrl,"sp",1,string områdenavn(par2));
11 7791 end
10 7792 else
10 7793 if rkom=10 and par1<>0 then
10 7794 write(zrl,string kanalnavn(par1 extract 20))
10 7795 else
10 7796 if rkom=5 or rkom=6 then
10 7797 begin
11 7798 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7799 if par1 shift (-20)=14 then
11 7800 write(zrl,string områdenavn(par1 extract 20));
11 7801 end;
10 7802 test14_trap: outchar(zrl,'nl');
10 7803 end;
9 7804 d.op_ref.data(4):= nr; <*operatør*>
9 7805 opgave:=
9 7806 if kode = 45 <*OP *> then 1 else
9 7807 if kode = 46 <*ME *> then 2 else
9 7808 if kode = 47 <*OP,G*> then 3 else
9 7809 if kode = 48 <*ME,G*> then 4 else
9 7810 if kode = 49 <*OP,A*> then 5 else
9 7811 if kode = 50 <*ME,A*> then 6 else
9 7812 if kode = 51 <*KA,C*> then 7 else
9 7813 if kode = 52 <*KA,P*> then 8 else
9 7814 if kode = 53 <*OP,L*> then 9 else
9 7815 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7816 if kode = 55 <*VE *> then 14 else
9 7817 if kode = 56 <*NE *> then 12 else
9 7818 if kode = 57 <*OP,V*> then 1 else
9 7819 if kode = 58 <*OP,T*> then 1 else
9 7820 if kode = 59 <*R *> then 13 else
9 7821 if kode = 60 <*GE *> then 15 else
9 7822 if kode = 61 <*GE,G*> then 16 else
9 7823 if kode = 62 <*GE,V*> then 15 else
9 7824 if kode = 63 <*GE,T*> then 15 else
9 7825 -1;
9 7826 <*+4*> if opgave < 0 then
9 7827 fejlreaktion(2<*operationskode*>,kode,
9 7828 <:operatør, radio-kommando :>,0);
9 7829 <*-4*>
9 7830 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7831 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7832 if 5<=opgave and opgave<=8 then
9 7833 d.opref.data(2):= -1;
9 7834 if opgave=13 then d.opref.data(2):=
9 7835 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7836 then 0 else 1);
9 7837 if opgave = 14 then d.opref.data(2):= 1;
9 7838 if opgave=7 or opgave=8 then
9 7839 d.opref.data(3):= -1
9 7840 else
9 7841 if opgave=5 or opgave=6 then
9 7842 begin
10 7843 if ia(1) shift (-20) = 15 then
10 7844 begin
11 7845 d.opref.data(3):= 15 shift 20;
11 7846 for j:= 1 step 1 until max_antal_kanaler do
11 7847 begin
12 7848 iaf:= (j-1)*kanalbeskrlængde;
12 7849 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7850 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7851 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7852 end;
11 7853 end
10 7854 else
10 7855 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7856 else ia(1);
10 7857 end
9 7858 else
9 7859 if kode = 57 then d.opref.data(3):= 2 else
9 7860 if kode = 58 then d.opref.data(3):= 1 else
9 7861 if kode = 62 then d.opref.data(3):= 2 else
9 7862 if kode = 63 then d.opref.data(3):= 1 else
9 7863 d.opref.data(3):= ia(2);
9 7864
9 7864 <* !!! i første if-sætning nedenfor er 'status>1'
9 7865 rettet til 'status>0' for at forhindre
9 7866 at opkald nr. 2 kan udføres med et allerede
9 7867 etableret opkald i skærmens s-felt,
9 7868 jvf. ulykke d. 7/2-1995
9 7869 !!! *>
9 7870 res:=
9 7871 if (opgave=1 or opgave=3) and status>0
9 7872 then 16 <*skærm optaget*> else
9 7873 if (opgave=15 or opgave=16) and
9 7874 status>1 then 16 <*skærm optaget*> else
9 7875 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7876 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7877 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7878 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7879 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7880 then 52 else 1) else
9 7881 if opgave<11 and status>0 then 16 else
9 7882 if opgave=11 and status<2 then 21 else
9 7883 if opgave=12 and status=0 then 22 else
9 7884 if opgave=13 and status=0 then 49 else
9 7885 if opgave=14 and status<>3 then 21 else 1;
9 7886 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7887 begin <* specialbetingelser for TLF og VHF *>
10 7888 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7889 end;
9 7890 if skærmmåde<>0 then
9 7891 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7892 kode:= opgave;
9 7893 if opgave = 15 then opgave:= 1 else
9 7894 if opgave = 16 then opgave:= 3;
9 7895 \f
9 7895 message procedure operatør side 10 - 810616/hko;
9 7896
9 7896 <* tilknyt talevej (om nødvendigt) *>
9 7897 if res = 1 and op_talevej(nr)=0 then
9 7898 begin
10 7899 i:= sidste_tv_brugt;
10 7900 repeat
10 7901 i:= (i mod max_antal_taleveje)+1;
10 7902 if tv_operatør(i)=0 then
10 7903 begin
11 7904 tv_operatør(i):= nr;
11 7905 op_talevej(nr):= i;
11 7906 end;
10 7907 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7908 if op_talevej(nr)=0 then
10 7909 res:=61
10 7910 else
10 7911 begin
11 7912 sidste_tv_brugt:=
11 7913 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7914
11 7914 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7915 start_operation(iaf,200+nr,cs_operatør(nr),
11 7916 'A' shift 12 + 44);
11 7917 d.iaf.data(1):= op_talevej(nr);
11 7918 d.iaf.data(2):= nr+16;
11 7919 ll:= 0;
11 7920 repeat
11 7921 signalch(cs_talevejsswitch,iaf,op_optype);
11 7922 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7923 ll:= ll+1;
11 7924 until ll=3 or d.iaf.resultat=3;
11 7925 res:= if d.iaf.resultat=3 then 1 else 61;
11 7926 <* ********* *>
11 7927 delay(1);
11 7928 start_operation(iaf,200+nr,cs_operatør(nr),
11 7929 'R' shift 12 + 44);
11 7930 ll:= 0;
11 7931 repeat
11 7932 signalch(cs_talevejsswitch,iaf,op_optype);
11 7933 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7934 ll:= ll+1;
11 7935 until ll=3 or d.iaf.resultat=3;
11 7936 <* ********* *>
11 7937 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7938 if res<>1 then
11 7939 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7940 end;
10 7941 end;
9 7942 if op_talevej(nr)=0 then res:= 61;
9 7943 d.op_ref.data(1):= op_talevej(nr);
9 7944
9 7944 if res <= 1 then
9 7945 begin
10 7946 til_radio: <* send operation til radiomodul *>
10 7947 d.op_ref.opkode:= opgave shift 12 + 41;
10 7948 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7949 else 0;
10 7950 d.op_ref.data(6):= b_s;
10 7951 d.op_ref.resultat:=0;
10 7952 d.op_ref.retur:= cs_operatør(nr);
10 7953 indeks:= op_ref;
10 7954 <*+2*> if testbit11 and overvåget then
10 7955 disable begin
11 7956 skriv_operatør(out,0);
11 7957 write(out,<: operation til radio:>);
11 7958 skriv_op(out,op_ref); ud;
11 7959 end;
10 7960 <*-2*>
10 7961 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7962 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7963
10 7963 <*+2*> if testbit12 and overvåget then
10 7964 disable begin
11 7965 skriv_operatør(out,0);
11 7966 write(out,<: operation retur fra radio:>);
11 7967 skriv_op(out,op_ref); ud;
11 7968 end;
10 7969 <*-2*>
10 7970 <*+4*> if op_ref <> indeks then
10 7971 fejlreaktion(11<*fr.post*>,op_ref,
10 7972 <:operatør, retur fra radio:>,0);
10 7973 <*-4*>
10 7974 \f
10 7974 message procedure operatør side 11 - 810529/hko;
10 7975
10 7975 res:= d.op_ref.resultat;
10 7976 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7977 begin
11 7978 <*+4*> if res < 2 then
11 7979 fejlreaktion(3<*prg.fejl*>,res,
11 7980 <: operatør,radio_op,resultat:>,1);
11 7981 <*-4*>
11 7982 if res = 1 then res:= 0;
11 7983 end
10 7984 else
10 7985 begin <* res = 2 eller 3 *>
11 7986 s_kanal:= v_kanal:= 0;
11 7987 opgave:= d.opref.opkode shift (-12);
11 7988 bv:= d.op_ref.data(5) extract 4;
11 7989 bs:= d.op_ref.data(6);
11 7990 if opgave < 10 then
11 7991 begin
12 7992 j:= d.op_ref.data(7) <*type*>;
12 7993 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 7994 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 7995 terminal_tab.ref(1):= i
12 7996 +(if res=2 then 4 <*optaget*> else 0)
12 7997 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 7998 then 8 <*nød*> else 0)
12 7999 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 8000 then 16 else 0)
12 8001 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 8002 + (if opgave=9 then 128 else
12 8003 if opgave>=7 then 256 else
12 8004 if opgave>=5 then 512 else 0)
12 8005 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 8006 else if b_s = 0 then 0 <*tilstand = ledig *>
12 8007 else 1 shift 21 <*tilstand = samtale*>);
12 8008 if (res=3 or res=20 or res=52) and 0<=j and j<3 then
12 8009 disable tæl_opkald_pr_operatør(nr,
12 8010 (if res=20 then 4 else if res=52 then 5 else j+1));
12 8011 end
11 8012 else if opgave=10 <*monitering*> or
11 8013 opgave=14 <*ventepos *> then
11 8014 begin
12 8015 <*+4*> if res = 2 then
12 8016 fejlreaktion(3<*prg.fejl*>,res,
12 8017 <: operatør,moniter,res:>,1);
12 8018 <*-4*>
12 8019 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 8020 i:= if bs<0 then
12 8021 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 8022 terminal_tab.ref(1):= i +
12 8023 (if bs < 0 then (1 shift 21) else 0);
12 8024 if opgave=10 then
12 8025 begin
13 8026 s_kanal:= bs;
13 8027 v_kanal:= d.opref.data(5);
13 8028 end;
12 8029 \f
12 8029 message procedure operatør side 12 - 810603/hko;
12 8030 end
11 8031 else if opgave=11 or opgave=12 then
11 8032 begin
12 8033 <*+4*> if res = 2 then
12 8034 fejlreaktion(3<*prg.fejl*>,res,
12 8035 <: operatør,ge/ne,res:>,1);
12 8036 <*-4*>
12 8037 if opgave=11 <*GE*> and res<>49 then
12 8038 begin
13 8039 s_kanal:= terminal_tab.ref(2);
13 8040 v_kanal:= 12 shift 20 +
13 8041 (terminal_tab.ref(1) shift (-12) extract 4);
13 8042 end;
12 8043 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 8044 end
11 8045 else
11 8046 if opgave=13 then
11 8047 begin
12 8048 if res=2 then
12 8049 fejlreaktion(3<*prg.fejl*>,res,
12 8050 <:operatør,R,res:>,1);
12 8051 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 8052 d.opref.data(2));
12 8053 end
11 8054 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 8055 <*-4*>
11 8056 ;
11 8057 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 8058
11 8058 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 8059 terminal_tab.ref(2):= b_s;
11 8060 terminal_tab.ref(3):= d.op_ref.data(11);
11 8061 if (opgave<10 or opgave=14) and res=3 then
11 8062 <*så henviser b_s til radiokanal*>
11 8063 begin
12 8064 if bs shift (-20) = 12 then
12 8065 begin
13 8066 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 8067 kanaltab.iaf.kanal_tilstand:=
13 8068 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 8069 +terminal_tab.ref(1) extract 10;
13 8070 end
12 8071 else
12 8072 begin
13 8073 for i:= 1 step 1 until max_antal_kanaler do
13 8074 begin
14 8075 if læsbit_i(bs,i) then
14 8076 begin
15 8077 iaf:= (i-1)*kanal_beskr_længde;
15 8078 kanaltab.iaf.kanaltilstand:=
15 8079 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 8080 + terminal_tab.ref(1) extract 10;
15 8081 end;
14 8082 end;
13 8083 end;
12 8084 end;
11 8085 if kode=15 or kode=16 then
11 8086 begin
12 8087 if opgave<10 then
12 8088 begin
13 8089 opgave:= 11;
13 8090 kanal:= (12 shift 20) +
13 8091 d.opref.data(6) extract 20;
13 8092 goto til_radio;
13 8093 end
12 8094 else
12 8095 if opgave=11 then
12 8096 begin
13 8097 opgave:= 10;
13 8098 d.opref.data(2):= kanal;
13 8099 goto til_radio;
13 8100 end;
12 8101 end
11 8102 else
11 8103 if (kode=1 or kode=3) then
11 8104 begin
12 8105 if opgave<10 and bv<>0 then
12 8106 begin
13 8107 opgave:= 14;
13 8108 d.opref.data(2):= 2;
13 8109 goto til_radio;
13 8110 end;
12 8111 end;
11 8112 <*V*> skriv_skærm_b_v_s(nr);
11 8113 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 8114 skriv_skærm_opkaldskø(nr);
11 8115 for i:= s_kanal, v_kanal do
11 8116 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 8117 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 8118 signalbin(bs_mobilopkald);
11 8119 <*V*> setposition(z_op(nr),0,0);
11 8120 end; <* res = 2 eller 3 *>
10 8121 end; <* res <= 1 *>
9 8122 <* frigiv talevej (om nødvendigt) *>
9 8123 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 8124 and terminal_tab.ref(2)=0 <*b_s*>
9 8125 and op_talevej(nr)<>0
9 8126 then
9 8127 begin
10 8128 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 8129 start_operation(iaf,200+nr,cs_operatør(nr),
10 8130 'D' shift 12 + 44);
10 8131 d.iaf.data(1):= op_talevej(nr);
10 8132 d.iaf.data(2):= nr+16;
10 8133 ll:= 0;
10 8134 repeat
10 8135 signalch(cs_talevejsswitch,iaf,op_optype);
10 8136 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 8137 ll:= ll+1;
10 8138 until ll=3 or d.iaf.resultat=3;
10 8139 ll:= d.iaf.resultat;
10 8140 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 8141 if ll<>3 then
10 8142 fejlreaktion(21,op_talevej(nr)*100+nr,
10 8143 <:frigiv operatør fejlet:>,1)
10 8144 else
10 8145 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 8146 skriv_skærm_b_v_s(nr);
10 8147 end;
9 8148 disable if testbit14 then
9 8149 begin
10 8150 integer t; <*lav en trap-bar blok*>
10 8151
10 8151 trap(test14_trap);
10 8152 systime(1,0,kommslut);
10 8153 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 8154 string bpl_navn(nr),<: slut :>,case rkom of (
10 8155 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 8156 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 8157 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 8158 <:GE,T:>),<: :>);
10 8159 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 8160 rkom=16 or rkom=17 or rkom=19)
10 8161 then
10 8162 begin
11 8163 if d.opref.data(7)=2 then outchar(zrl,'*');
11 8164 if d.opref.data(9)<>0 then
11 8165 begin
12 8166 skriv_id(zrl,d.opref.data(9),0);
12 8167 outchar(zrl,' ');
12 8168 end;
11 8169 if d.opref.data(8)<>0 then
11 8170 begin
12 8171 skriv_id(zrl,d.opref.data(8),0);
12 8172 outchar(zrl,' ');
12 8173 end;
11 8174 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 8175 d.opref.data(2)<>0 then
11 8176 begin
12 8177 skriv_id(zrl,d.opref.data(2),0);
12 8178 outchar(zrl,' ');
12 8179 end;
11 8180 if d.opref.data(12)<>0 then
11 8181 begin
12 8182 if d.opref.data(12) shift (-20) = 15 then
12 8183 write(zrl,<:OMR*:>)
12 8184 else
12 8185 if d.opref.data(12) shift (-20) = 14 then
12 8186 write(zrl,
12 8187 string områdenavn(d.opref.data(12) extract 20))
12 8188 else
12 8189 skriv_id(zrl,d.opref.data(12),0);
12 8190 outchar(zrl,' ');
12 8191 end;
11 8192 t:= terminal_tab.ref.terminaltilstand extract 10;
11 8193 if res=3 and rkom=1 and
11 8194 (t shift (-4) extract 1 = 1) and
11 8195 (t extract 2 <> 3)
11 8196 then
11 8197 begin
12 8198 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 8199 kanal_beskr_længde;
12 8200 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 8201 extract 12)/100," ",1);
12 8202 end;
11 8203 if d.opref.data(10)<>0 then
11 8204 begin
12 8205 skriv_id(zrl,d.opref.data(10),0);
12 8206 outchar(zrl,' ');
12 8207 end;
11 8208 end
10 8209 else
10 8210 if rkom=10 and par1<>0 then
10 8211 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 8212 else
10 8213 if rkom=5 or rkom=6 then
10 8214 begin
11 8215 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 8216 if par1 shift (-20)=14 then
11 8217 write(zrl,string områdenavn(par1 extract 20));
11 8218 outchar(zrl,' ');
11 8219 end;
10 8220 if op_talevej(nr) > 0 then
10 8221 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 8222 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 8223 <<dd.dd>,kommslut-kommstart);
10 8224 test14_trap: outchar(zrl,'nl');
10 8225 end;
9 8226
9 8226 <*V*> setposition(z_op(nr),0,0);
9 8227 cursor(z_op(nr),24,1);
9 8228 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 8229 end; <* radio-kommando *>
8 8230 begin
9 8231 \f
9 8231 message procedure operatør side 13 - 810518/hko;
9 8232
9 8232 <* 4 stop kommando *>
9 8233
9 8233 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 8234 if tilstand <> 0 then
9 8235 begin
10 8236 d.op_ref.resultat:= 16; <*skærm optaget*>
10 8237 end
9 8238 else
9 8239 begin
10 8240 d.op_ref.retur:= cs_operatør(nr);
10 8241 d.op_ref.resultat:= 0;
10 8242 d.op_ref.data(1):= nr;
10 8243 indeks:= op_ref;
10 8244 <*+2*> if testbit11 and overvåget then
10 8245 disable begin
11 8246 skriv_operatør(out,0);
11 8247 write(out,<: stop_operation til radio:>);
11 8248 skriv_op(out,op_ref); ud;
11 8249 end;
10 8250 <*-2*>
10 8251 if opk_alarm.tab.alarm_tilst > 0 then
10 8252 begin
11 8253 opk_alarm.tab.alarm_kmdo:= 3;
11 8254 signal_bin(bs_opk_alarm);
11 8255 end;
10 8256
10 8256 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 8257 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 8258 <*+2*> if testbit12 and overvåget then
10 8259 disable begin
11 8260 skriv_operatør(out,0);
11 8261 write(out,<: operation retur fra radio:>);
11 8262 skriv_op(out,op_ref); ud;
11 8263 end;
10 8264 <*-2*>
10 8265 <*+4*> if indeks <> op_ref then
10 8266 fejlreaktion(11<*fr.post*>,op_ref,
10 8267 <: operatør, retur fra radio:>,0);
10 8268 <*-4*>
10 8269 \f
10 8269 message procedure operatør side 14 - 810527/hko;
10 8270
10 8270 if d.op_ref.resultat = 3 then
10 8271 begin
11 8272 integer k,n;
11 8273 integer array field msk,iaf1;
11 8274
11 8274 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 8275 +terminal_tab.ref.terminal_tilstand extract 21;
11 8276 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 8277 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 8278 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 8279 begin
12 8280 msk:= k*op_maske_lgd;
12 8281 if læsbit_ia(bpl_def.msk,nr) then
12 8282 <**> begin
13 8283 n:= 0;
13 8284 for i:= 1 step 1 until max_antal_operatører do
13 8285 if læsbit_ia(bpl_def.msk,i) then
13 8286 begin
14 8287 iaf1:= i*terminal_beskr_længde;
14 8288 if terminal_tab.iaf1.terminal_tilstand
14 8289 shift (-21) < 3 then
14 8290 n:= n+1;
14 8291 end;
13 8292 bpl_tilst(k,1):= n;
13 8293 end;
12 8294 <**> <*
12 8295 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 8296 *> end;
11 8297 signal_bin(bs_mobil_opkald);
11 8298 <*V*> setposition(z_op(nr),0,0);
11 8299 ht_symbol(z_op(nr));
11 8300 end;
10 8301 end;
9 8302 <*V*> setposition(z_op(nr),0,0);
9 8303 cursor(z_op(nr),24,1);
9 8304 if d.op_ref.resultat<> 3 then
9 8305 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8306 end;
8 8307 begin
9 8308 boolean l22;
9 8309 \f
9 8309 message procedure operatør side 15 - 810521/cl;
9 8310
9 8310 <* 5 springdefinition *>
9 8311 l22:= false;
9 8312 if sep=',' then
9 8313 disable begin
10 8314 setposition(z_op(nr),0,0);
10 8315 cursor(z_op(nr),22,1);
10 8316 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 8317 l22:= true; pos:= 1;
10 8318 while læstegn(d.op_ref.data,pos,i)<>0 do
10 8319 outchar(z_op(nr),i);
10 8320 end;
9 8321
9 8321 tofrom(d.op_ref.data,ia,indeks*2);
9 8322 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 8323 start_operation(vt_op,200+nr,cs_operatør(nr),
9 8324 101<*opret fil*>);
9 8325 d.vt_op.data(1):=128;<*postantal*>
9 8326 d.vt_op.data(2):=2; <*postlængde*>
9 8327 d.vt_op.data(3):=1; <*segmentantal*>
9 8328 d.vt_op.data(4):=
9 8329 2 shift 10; <*spool fil*>
9 8330 signal_ch(cs_opret_fil,vt_op,op_optype);
9 8331 pos:=vt_op;<*variabel lånes*>
9 8332 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 8333 <*+4*> if vt_op<>pos then
9 8334 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 8335 if d.vt_op.data(9)<>0 then
9 8336 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8337 <:op kommando(springdefinition):>,0);
9 8338 <*-4*>
9 8339 iaf:=0;
9 8340 for i:=1 step 1 until indeks-2 do
9 8341 begin
10 8342 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8343 if k<>0 then
10 8344 fejlreaktion(7<*modif-fil*>,k,
10 8345 <:op kommando(spring-def):>,0);
10 8346 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8347 end;
9 8348 \f
9 8348 message procedure operatør side 15a - 820301/cl;
9 8349
9 8349 while sep = ',' do
9 8350 begin
10 8351 setposition(z_op(nr),0,0);
10 8352 cursor(z_op(nr),23,1);
10 8353 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8354 setposition(z_op(nr),0,0);
10 8355 wait(bs_fortsæt_adgang);
10 8356 pos:= 1; j:= 0;
10 8357 while læs_store(z_op(nr),i) < 8 do
10 8358 begin
11 8359 skrivtegn(fortsæt,pos,i);
11 8360 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8361 end;
10 8362 skrivtegn(fortsæt,pos,'em');
10 8363 afsluttext(fortsæt,pos);
10 8364 sluttegn:= i;
10 8365 if j<>0 then
10 8366 begin
11 8367 setposition(z_op(nr),0,0);
11 8368 cursor(z_op(nr),24,1);
11 8369 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8370 cursor(z_op(nr),1,1);
11 8371 goto sp_ann;
11 8372 end;
10 8373 \f
10 8373 message procedure operatør side 16 - 810521/cl;
10 8374
10 8374 disable begin
11 8375 integer array værdi(1:4);
11 8376 integer a_pos,res;
11 8377 pos:= 0;
11 8378 repeat
11 8379 apos:= pos;
11 8380 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8381 if res >= 0 then
11 8382 begin
12 8383 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8384 else if res=0 then res:= -25 <*parameter mangler*>
12 8385 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8386 res:= -44 <*intervalstørrelse ulovlig*>
12 8387 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8388 res:= -6 <*løbnr ulovligt*>
12 8389 else if res=10 then
12 8390 begin
13 8391 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8392 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8393 <:op kommando(spring-def):>,0);
13 8394 iaf:= 0;
13 8395 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8396 indeks:= indeks+1;
13 8397 if sep = ',' then res:= 0;
13 8398 end
12 8399 else res:= -27; <*parametertype*>
12 8400 end;
11 8401 if res>0 then pos:= a_pos;
11 8402 until sep<>'sp' or res<=0;
11 8403
11 8403 if res<0 then
11 8404 begin
12 8405 d.op_ref.resultat:= -res;
12 8406 i:=1; j:= 1;
12 8407 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8408 afsluttext(d.op_ref.data,i);
12 8409 end;
11 8410 end;
10 8411 \f
10 8411 message procedure operatør side 17 - 810521/cl;
10 8412
10 8412 if d.op_ref.resultat > 3 then
10 8413 begin
11 8414 setposition(z_op(nr),0,0);
11 8415 if l22 then
11 8416 begin
12 8417 cursor(z_op(nr),22,1); l22:= false;
12 8418 write(z_op(nr),"-",80);
12 8419 end;
11 8420 cursor(z_op(nr),24,1);
11 8421 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8422 goto sp_ann;
11 8423 end;
10 8424 if sep=',' then
10 8425 begin
11 8426 setposition(z_op(nr),0,0);
11 8427 cursor(z_op(nr),22,1);
11 8428 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8429 pos:= 1; l22:= true;
11 8430 while læstegn(fortsæt,pos,i)<>0 do
11 8431 outchar(z_op(nr),i);
11 8432 end;
10 8433 signalbin(bs_fortsæt_adgang);
10 8434 end while sep = ',';
9 8435 d.vt_op.data(1):= indeks-2;
9 8436 k:= sætfildim(d.vt_op.data);
9 8437 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8438 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8439 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8440 d.op_ref.retur:=cs_operatør(nr);
9 8441 pos:=op_ref;
9 8442 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8443 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8444 <*+4*> if pos<>op_ref then
9 8445 fejlreaktion(11<*fremmed post*>,op_ref,
9 8446 <:op kommando(springdef retur fra vt):>,0);
9 8447 <*-4*>
9 8448 \f
9 8448 message procedure operatør side 18 - 810521/cl;
9 8449
9 8449 <*V*> setposition(z_op(nr),0,0);
9 8450 if l22 then
9 8451 begin
10 8452 cursor(z_op(nr),22,1);
10 8453 write(z_op(nr),"-",80);
10 8454 end;
9 8455 cursor(z_op(nr),24,1);
9 8456 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8457
9 8457 if false then
9 8458 begin
10 8459 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8460 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8461 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8462 signalbin(bs_fortsæt_adgang);
10 8463 end;
9 8464
9 8464 end;
8 8465
8 8465 begin
9 8466 \f
9 8466 message procedure operatør side 19 - 810522/cl;
9 8467
9 8467 <* 6 spring (igangsæt)
9 8468 spring,annuler
9 8469 spring,reserve *>
9 8470
9 8470 tofrom(d.op_ref.data,ia,6);
9 8471 d.op_ref.retur:=cs_operatør(nr);
9 8472 indeks:=op_ref;
9 8473 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8474 <*V*> wait_ch(cs_operatør(nr),
9 8475 op_ref,
9 8476 op_optype,
9 8477 -1<*timeout*>);
9 8478 <*+2*> if testbit10 and overvåget then
9 8479 disable begin
10 8480 skriv_operatør(out,0);
10 8481 write(out,"nl",1,<:op operation retur fra vt:>);
10 8482 skriv_op(out,op_ref);
10 8483 end;
9 8484 <*-2*>
9 8485 <*+4*> if indeks<>op_ref then
9 8486 fejlreaktion(11<*fremmed post*>,op_ref,
9 8487 <:op kommando(spring):>,0);
9 8488 <*-4*>
9 8489
9 8489 <*V*> setposition(z_op(nr),0,0);
9 8490 cursor(z_op(nr),24,1);
9 8491 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8492 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8493 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8494 end;
8 8495
8 8495 begin
9 8496 \f
9 8496 message procedure operatør side 20 - 810525/cl;
9 8497
9 8497 <* 7 spring(-oversigts-)rapport *>
9 8498
9 8498 d.op_ref.retur:=cs_operatør(nr);
9 8499 tofrom(d.op_ref.data,ia,4);
9 8500 indeks:=op_ref;
9 8501 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8502 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8503 <*+2*> disable if testbit10 and overvåget then
9 8504 begin
10 8505 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8506 skriv_op(out,op_ref);
10 8507 end;
9 8508 <*-2*>
9 8509
9 8509 <*+4*> if op_ref<>indeks then
9 8510 fejlreaktion(11<*fremmed post*>,op_ref,
9 8511 <:op kommando(spring-rapport):>,0);
9 8512 <*-4*>
9 8513
9 8513 <*V*> setposition(z_op(nr),0,0);
9 8514 if d.op_ref.resultat<>3 then
9 8515 begin
10 8516 cursor(z_op(nr),24,1);
10 8517 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8518 end
9 8519 else
9 8520 begin
10 8521 boolean p_skrevet;
10 8522 integer bogst,løb;
10 8523
10 8523 skærmmåde:= 1;
10 8524
10 8524 if kode = 32 then <* spring,vis *>
10 8525 begin
11 8526 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8527 bogst:= d.op_ref.data(1) extract 5;
11 8528 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8529 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8530 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8531 <:spring: :>,
11 8532 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8533 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8534 raf:= data+8;
11 8535 if d.op_ref.raf(1)<>0.0 then
11 8536 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8537 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8538 else write(z_op(nr),<:, ikke startet:>);
11 8539 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8540 \f
11 8540 message procedure operatør side 21 - 810522/cl;
11 8541
11 8541 p_skrevet:= false;
11 8542 for pos:=1 step 1 until d.op_ref.data(3) do
11 8543 begin
12 8544 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8545 if i<>0 then
12 8546 fejlreaktion(5<*læsfil*>,i,
12 8547 <:op kommando(spring,vis):>,0);
12 8548 iaf:=0;
12 8549 i:= fil(j).iaf(1);
12 8550 if i < 0 and -, p_skrevet then
12 8551 begin
13 8552 outchar(z_op(nr),'('); p_skrevet:= true;
13 8553 end;
12 8554 if i > 0 and p_skrevet then
12 8555 begin
13 8556 outchar(z_op(nr),')'); p_skrevet:= false;
13 8557 end;
12 8558 if pos mod 2 = 0 then
12 8559 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8560 else
12 8561 write(z_op(nr),true,3,<<d>,abs i);
12 8562 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8563 end;
11 8564 write(z_op(nr),"*",1);
11 8565 \f
11 8565 message procedure operatør side 22 - 810522/cl;
11 8566
11 8566 end
10 8567 else if kode=33 then <* spring,oversigt *>
10 8568 begin
11 8569 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8570 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8571 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8572
11 8572 for pos:=1 step 1 until d.op_ref.data(1) do
11 8573 begin
12 8574 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8575 if i<>0 then
12 8576 fejlreaktion(5<*læsfil*>,i,
12 8577 <:op kommando(spring-oversigt):>,0);
12 8578 iaf:=0;
12 8579 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8580 bogst:=fil(j).iaf(1) extract 5;
12 8581 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8582 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8583 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8584 string (extend fil(j).iaf(2) shift 24));
12 8585 if fil(j,2)<>0.0 then
12 8586 write(z_op(nr),<:startet :>,<<zddddd>,
12 8587 round systime(4,fil(j,2),r),<:.:>,round r);
12 8588 outchar(z_op(nr),'nl');
12 8589 end;
11 8590 write(z_op(nr),"*",1);
11 8591 end;
10 8592 <* slet fil *>
10 8593 d.op_ref.opkode:= 104;
10 8594 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8595 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8596 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8597 end; <* resultat=3 *>
9 8598
9 8598 end;
8 8599
8 8599 begin
9 8600 \f
9 8600 message procedure operatør side 23 - 940522/cl;
9 8601
9 8601
9 8601 <* 8 SLUT *>
9 8602 trapmode:= 1 shift 13;
9 8603 trap(-2);
9 8604 end;
8 8605
8 8605 begin
9 8606 <* 9 stopniveauer,definer *>
9 8607 integer fno;
9 8608
9 8608 for i:= 1 step 1 until 3 do
9 8609 operatør_stop(nr,i):= ia(i+1);
9 8610 i:= modif_fil(tf_stoptabel,nr,fno);
9 8611 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8612 iaf:=0;
9 8613 for i:= 0,1,2,3 do
9 8614 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8615 setposition(fil(fno),0,0);
9 8616 setposition(z_op(nr),0,0);
9 8617 cursor(z_op(nr),24,1);
9 8618 skriv_kvittering(z_op(nr),0,-1,3);
9 8619 end;
8 8620
8 8620 begin
9 8621 \f
9 8621 message procedure operatør side 24 - 940522/cl;
9 8622
9 8622 <* 10 stopniveauer,vis *>
9 8623 integer bpl,j,k;
9 8624
9 8624 skærm_måde:= 1;
9 8625 setposition(z_op(nr),0,0);
9 8626 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8627 <:stopniveauer: :>);
9 8628 for i:= 0 step 1 until 3 do
9 8629 begin
10 8630 bpl:= operatør_stop(nr,i);
10 8631 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8632 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8633 end;
9 8634 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8635 j:=0;
9 8636 for bpl:= 1 step 1 until max_antal_operatører do
9 8637 if bpl_navn(bpl)<>long<::> then
9 8638 begin
10 8639 if j mod 8 = 0 and j > 0 then
10 8640 write(z_op(nr),"nl",1,"sp",18);
10 8641 iaf:= bpl*terminal_beskr_længde;
10 8642 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8643 true,6,string bpl_navn(bpl));
10 8644 j:=j+1;
10 8645 end;
9 8646 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8647 j:=0;
9 8648 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8649 if bpl_navn(bpl)<>long<::> then
9 8650 begin
10 8651 if j mod 8 = 0 and j > 0 then
10 8652 write(z_op(nr),"nl",1,"sp",19);
10 8653 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8654 j:=j+1;
10 8655 end;
9 8656 write(z_op(nr),"nl",1,"*",1);
9 8657 end;
8 8658
8 8658 begin
9 8659 <* 11 alarmlængde *>
9 8660 integer fno;
9 8661
9 8661 if indeks > 0 then
9 8662 begin
10 8663 opk_alarm.tab.alarm_lgd:= ia(1);
10 8664 i:= modiffil(tf_alarmlgd,nr,fno);
10 8665 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8666 iaf:= 0;
10 8667 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8668 setposition(fil(fno),0,0);
10 8669 end;
9 8670
9 8670 setposition(z_op(nr),0,0);
9 8671 cursor(z_op(nr),24,1);
9 8672 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8673 end;
8 8674
8 8674 begin
9 8675 <* 12 CC *>
9 8676 integer i, c;
9 8677
9 8677 i:= 1;
9 8678 while læstegn(ia,i+0,c)<>0 and
9 8679 i<(op_spool_postlgd-op_spool_text)//2*3
9 8680 do skrivtegn(d.opref.data,i,c);
9 8681 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8682
9 8682 d.opref.retur:= cs_operatør(nr);
9 8683 signalch(cs_op_spool,opref,op_optype);
9 8684 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8685
9 8685 setposition(z_op(nr),0,0);
9 8686 cursor(z_op(nr),24,1);
9 8687 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8688 end;
8 8689
8 8689 <* 13 EXkluder skærmen *>
8 8690 begin
9 8691 d.opref.resultat:= 2;
9 8692 setposition(z_op(nr),0,0);
9 8693 cursor(z_op(nr),24,1);
9 8694 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8695
9 8695 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8696 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8697 d.vt_op.data(1):= nr;
9 8698 signalch(cs_rad,vt_op,gen_optype);
9 8699 end;
8 8700
8 8700 begin
9 8701 <* 14 CQF-tabel,vis *>
9 8702
9 8702 skærm_måde:= 1;
9 8703 setposition(z_op(nr),0,0);
9 8704 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8705 "esc" add 128,1,<:ÆJ:>);
9 8706 skriv_cqf_tabel(z_op(nr),false);
9 8707 write(z_op(nr),"*",1);
9 8708 end;
8 8709
8 8709 begin
9 8710 <* 15 ALarmlyd,Test *>
9 8711 integer array field tab;
9 8712 integer res;
9 8713
9 8713 tab:= (nr-1)*opk_alarm_tab_lgd;
9 8714 setposition(z_op(nr),0,0);
9 8715 if ia(1)<1 or ia(1)>2 then
9 8716 res:= 64 <* ulovligt tal *>
9 8717 else if opk_alarm.tab.alarm_lgd = 0 then
9 8718 begin
10 8719 if ia(1)=2 then
10 8720 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
10 8721 else
10 8722 write(z_op(nr),"bel",1);
10 8723 res:= 3;
10 8724 end
9 8725 else if ia(1) > opk_alarm.tab.alarm_tilst and
9 8726 ia(1) > opk_alarm.tab.alarm_kmdo then
9 8727 begin
10 8728 opk_alarm.tab.alarm_kmdo:= ia(1);
10 8729 signal_bin(bs_opk_alarm);
10 8730 res:= 3;
10 8731 end
9 8732 else
9 8733 res:= 48; <* i brug *>
9 8734
9 8734 cursor(z_op(nr),24,1);
9 8735 skriv_kvittering(z_op(nr),opref,-1,res);
9 8736 end;
8 8737
8 8737 begin
9 8738 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8739 setposition(z_op(nr),0,0);
9 8740 cursor(z_op(nr),24,1);
9 8741 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8742 end;
8 8743 \f
8 8743 message procedure operatør side x - 810522/hko;
8 8744
8 8744 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8745 <*-4*>
8 8746 end;<*case j *>
7 8747 end <* j > 0 *>
6 8748 else
6 8749 begin
7 8750 <*V*> setposition(z_op(nr),0,0);
7 8751 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8752 skriv_kvittering(z_op(nr),op_ref,-1,
7 8753 45 <*ikke implementeret *>);
7 8754 end;
6 8755 end;<* godkendt *>
5 8756
5 8756 <*V*> setposition(z_op(nr),0,0);
5 8757 <*???*>
5 8758 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8759 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8760 skærmmåde = 0 do
5 8761 begin
6 8762 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8763 begin
7 8764 skriv_skærm_bvs(nr);
7 8765 <*940920 if op_talevej(nr)=0 then status:= 0
7 8766 else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8767 if status>0 then
7 8768 begin
7 8769 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8770 terminaltab.ref(ll):= 0;
7 8771 skriv_skærm_bvs(nr);
7 8772 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8773 end;
7 8774 for i:= 1 step 1 until max_antal_kanaler do
7 8775 begin
7 8776 iaf:= (i-1)*kanalbeskrlængde;
7 8777 inspect(ss_samtale_nedlagt(i),status);
7 8778 if status>0 and
7 8779 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8780 begin
7 8781 kanaltab.iaf.kanal_tilstand:=
7 8782 kanaltab.iaf(1) shift (-10) extract 6 shift 10;
7 8783 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8784 kanaltab.iaf(ll):= 0;
7 8785 skriv_skærm_kanal(nr,i);
7 8786 repeat
7 8787 wait(ss_samtale_nedlagt(i));
7 8788 inspect(ss_samtale_nedlagt(i),status);
7 8789 until status=0;
7 8790 end;
7 8791 end;
7 8792 940920*> cursor(z_op(nr),1,1);
7 8793 setposition(z_op(nr),0,0);
7 8794 end;
6 8795 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8796 and skærmmåde = 0
6 8797 and læsbit_ia(operatørmaske,nr) then
6 8798 begin
7 8799 if sætbit_ia(opkaldsflag,nr,0) = 1 then
7 8800 skriv_skærm_opkaldskø(nr);
7 8801 if sætbit_ia(kanalflag,nr,0) = 1 then
7 8802 begin
8 8803 for i:= 1 step 1 until max_antal_kanaler do
8 8804 skriv_skærm_kanal(nr,i);
8 8805 end;
7 8806 cursor(z_op(nr),1,1);
7 8807 <*V*> setposition(z_op(nr),0,0);
7 8808 end;
6 8809 end;
5 8810 d.op_ref.retur:=cs_att_pulje;
5 8811 disable afslut_kommando(op_ref);
5 8812 end; <* indlæs kommando *>
4 8813
4 8813 begin
5 8814 \f
5 8814 message procedure operatør side x+1 - 810617/hko;
5 8815
5 8815 <* 2: inkluder *>
5 8816 integer k,n;
5 8817 integer array field msk,iaf1;
5 8818
5 8818 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8819 if i=0 then
5 8820 begin
6 8821 fejlreaktion(3<*programfejl*>,nr,
6 8822 <:operatør(nr) eksisterer ikke:>,1);
6 8823 d.op_ref.resultat:=28;
6 8824 end
5 8825 else
5 8826 begin
6 8827 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8828 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8829 else if d.op_ref.opkode = 0 then 0
6 8830 else 3;<*udført*>
6 8831 if i > 0 then
6 8832 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8833 <:operatørskærm reservation:>,1)
6 8834 else
6 8835 begin
7 8836 i:=terminal_tab.ref.terminal_tilstand;
7 8837 <*940418/cl inkluderet sættes i stop - start *>
7 8838 kode:= d.opref.opkode extract 12;
7 8839 if kode <> 0 then
7 8840 terminal_tab.ref.terminal_tilstand:=
7 8841 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8842 else
7 8843 <*940418/cl inkluderet sættes i stop - slut *>
7 8844 terminal_tab.ref.terminal_tilstand:= i extract
7 8845 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8846 for i:= 1 step 1 until max_antal_kanaler do
7 8847 begin
8 8848 iaf:= (i-1)*kanalbeskrlængde;
8 8849 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8850 end;
7 8851 skærm_måde:= 0;
7 8852 sætbit_ia(operatørmaske,nr,
7 8853 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8854 then 0 else 1));
7 8855 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8856 begin
8 8857 msk:= k*op_maske_lgd;
8 8858 if læsbit_ia(bpl_def.msk,nr) then
8 8859 <**> begin
9 8860 n:= 0;
9 8861 for i:= 1 step 1 until max_antal_operatører do
9 8862 if læsbit_ia(bpl_def.msk,i) then
9 8863 begin
10 8864 iaf1:= i*terminal_beskr_længde;
10 8865 if terminal_tab.iaf1.terminal_tilstand
10 8866 shift (-21) < 3 then
10 8867 n:= n+1;
10 8868 end;
9 8869 bpl_tilst(k,1):= n;
9 8870 end;
8 8871 <**> <*
8 8872 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8873 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8874 *> end;
7 8875 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8876 sætbit_ia(opkaldsflag,nr,0);
7 8877 signal_bin(bs_mobil_opkald);
7 8878 <*940418/cl inkluderet sættes i stop - start *>
7 8879 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8880 <*V*> ht_symbol(z_op(nr))
7 8881 else
7 8882 <*940418/cl inkluderet sættes i stop - slut *>
7 8883 <*V*> skriv_skærm(nr);
7 8884 cursor(z_op(nr),24,1);
7 8885 <*V*> setposition(z_op(nr),0,0);
7 8886 end;
6 8887 end;
5 8888 if d.op_ref.opkode = 0 then
5 8889 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8890 else
5 8891 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8892 end;
4 8893
4 8893 begin
5 8894 \f
5 8894 message procedure operatør side x+2 - 820304/hko;
5 8895
5 8895 <* 3: ekskluder *>
5 8896 integer k,n;
5 8897 integer array field iaf1,msk;
5 8898
5 8898 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8899 <*V*> setposition(z_op(nr),0,0);
5 8900 monitor(10) release process:(z_op(nr),0,ia);
5 8901 d.op_ref.resultat:=3;
5 8902 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8903 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8904 terminal_tab.ref.terminal_tilstand extract 21;
5 8905 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8906 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8907 begin
6 8908 msk:= k*op_maske_lgd;
6 8909 if læsbit_ia(bpl_def.msk,nr) then
6 8910 <**> begin
7 8911 n:= 0;
7 8912 for i:= 1 step 1 until max_antal_operatører do
7 8913 if læsbit_ia(bpl_def.msk,i) then
7 8914 begin
8 8915 iaf1:= i*terminal_beskr_længde;
8 8916 if terminal_tab.iaf1.terminal_tilstand
8 8917 shift (-21) < 3 then
8 8918 n:= n+1;
8 8919 end;
7 8920 bpl_tilst(k,1):= n;
7 8921 end;
6 8922 <**> <*
6 8923 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8924 *> end;
5 8925 signal_bin(bs_mobil_opkald);
5 8926 if opk_alarm.tab.alarm_tilst > 0 then
5 8927 begin
6 8928 opk_alarm.tab.alarm_kmdo:= 3;
6 8929 signal_bin(bs_opk_alarm);
6 8930 end;
5 8931 end;
4 8932 begin
5 8933
5 8933 <* 4: opdater skærm *>
5 8934
5 8934 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8935 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8936 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8937 skærmmåde=0 do
5 8938 begin
6 8939
6 8939 <*+2*> if testbit13 and overvåget then
6 8940 disable begin
7 8941 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8942 <:) opkaldsflag::>,"nl",1);
7 8943 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8944 write(out,<: operatørmaske::>,"nl",1);
7 8945 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8946 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8947 ud;
7 8948 end;
6 8949 <*-2*>
6 8950 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8951 begin
7 8952 skriv_skærm_bvs(nr);
7 8953 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8954 if status>0 then
7 8955 begin
7 8956 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8957 terminaltab.ref(ll):= 0;
7 8958 skriv_skærm_bvs(nr);
7 8959 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8960 end;
7 8961 for i:= 1 step 1 until max_antal_kanaler do
7 8962 begin
7 8963 iaf:= (i-1)*kanalbeskrlængde;
7 8964 inspect(ss_samtale_nedlagt(i),status);
7 8965 if status>0 and
7 8966 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8967 begin
7 8968 kanaltab.iaf.kanal_tilstand:=
7 8969 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8970 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8971 kanaltab.iaf(ll):= 0;
7 8972 skriv_skærm_kanal(nr,i);
7 8973 repeat
7 8974 wait(ss_samtale_nedlagt(i));
7 8975 inspect(ss_samtale_nedlagt(i),status);
7 8976 until status=0;
7 8977 end;
7 8978 end;
7 8979 940920*> cursor(z_op(nr),1,1);
7 8980 setposition(z_op(nr),0,0);
7 8981 end;
6 8982 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8983 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8984 begin
7 8985 <*V*> setposition(z_op(nr),0,0);
7 8986 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 8987 skriv_skærm_opkaldskø(nr);
7 8988 if sætbit_ia(kanalflag,nr,0) =1 then
7 8989 begin
8 8990 for i:=1 step 1 until max_antal_kanaler do
8 8991 skriv_skærm_kanal(nr,i);
8 8992 end;
7 8993 cursor(z_op(nr),1,1);
7 8994 <*V*> setposition(z_op(nr),0,0);
7 8995 end;
6 8996 end;
5 8997 end;
4 8998 begin
5 8999 \f
5 8999 message procedure operatør side x+3 - 830310/hko;
5 9000
5 9000 <* 5: samtale etableret *>
5 9001
5 9001 res:= d.op_ref.resultat;
5 9002 b_v:= d.op_ref.data(3) extract 4;
5 9003 b_s:= d.op_ref.data(4);
5 9004 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9005 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 9006 begin
6 9007 sætbit_i(terminal_tab.ref(1),21,1);
6 9008 sætbit_i(terminal_tab.ref(1),22,0);
6 9009 sætbit_i(terminal_tab.ref(1),2,0);
6 9010 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9011 terminal_tab.ref(2):= b_s;
6 9012 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 9013 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 9014 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 9015 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 9016
6 9016 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9017 begin
7 9018 <*V*> setposition(z_op(nr),0,0);
7 9019 skriv_skærm_b_v_s(nr);
7 9020 <*V*> setposition(z_op(nr),0,0);
7 9021 end;
6 9022 end
5 9023 else
5 9024 if terminal_tab.ref(1) shift(-21) = 2 then
5 9025 begin
6 9026 sætbit_i(terminal_tab.ref(1),22,0);
6 9027 sætbit_i(terminal_tab.ref(1),2,0);
6 9028 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9029 terminal_tab.ref(2):= 0;
6 9030 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9031 begin
7 9032 <*V*> setposition(z_op(nr),0,0);
7 9033 cursor(z_op(nr),21,17);
7 9034 write(z_op(nr),<:EJ FORB:>);
7 9035 <*V*> setposition(z_op(nr),0,0);
7 9036 end;
6 9037 end
5 9038 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 9039 <:terminal tilstand:>,1);
5 9040 end;
4 9041
4 9041 begin
5 9042 \f
5 9042 message procedure operatør side x+4 - 810602/hko;
5 9043
5 9043 <* 6: radiokanal ekskluderet *>
5 9044
5 9044 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 9045 pos:= d.op_ref.data(1);
5 9046 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9047 indeks:= terminal_tab.ref(2);
5 9048 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 9049 then indeks extract 4 else 0;
5 9050 if b_v = pos then
5 9051 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 9052 if b_s = pos then
5 9053 begin
6 9054 terminal_tab.ref(2):= 0;
6 9055 sætbit_i(terminal_tab.ref(1),21,0);
6 9056 sætbit_i(terminal_tab.ref(1),22,0);
6 9057 sætbit_i(terminal_tab.ref(1),2,0);
6 9058 end;
5 9059 if skærmmåde=0 then
5 9060 begin
6 9061 if b_v = pos or b_s = pos then
6 9062 <*V*> skriv_skærm_b_v_s(nr);
6 9063 <*V*> skriv_skærm_kanal(nr,pos);
6 9064 cursor(z_op(nr),1,1);
6 9065 setposition(z_op(nr),0,0);
6 9066 end;
5 9067 end;
4 9068
4 9068 begin
5 9069 \f
5 9069 message procedure operatør side x+5 - 950118/cl;
5 9070
5 9070 <* 7: operatørmeddelelse *>
5 9071 integer afs, kl, i;
5 9072 real dato, t;
5 9073
5 9073 cursor(z_op(nr),24,1);
5 9074 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9075 cursor(z_op(nr),23,1);
5 9076 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9077
5 9077 afs:= d.opref.data.op_spool_kilde;
5 9078 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 9079 kl:= round t;
5 9080 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 9081 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 9082 i:= replacechar(1,'.');
5 9083 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 9084 replacechar(1,i);
5 9085 write(z_op(nr),d.opref.data.op_spool_text);
5 9086
5 9086 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 9087 begin
6 9088 if opk_alarm.tab.alarm_lgd > 0 and
6 9089 opk_alarm.tab.alarm_tilst < 1 and
6 9090 opk_alarm.tab.alarm_kmdo < 1
6 9091 then
6 9092 begin
7 9093 opk_alarm.tab.alarm_kmdo := 1;
7 9094 signalbin(bs_opk_alarm);
7 9095 end
6 9096 else
6 9097 if opk_alarm.tab.alarm_lgd = 0 then
6 9098 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 9099 end;
5 9100
5 9100 setposition(z_op(nr),0,0);
5 9101
5 9101 signalch(d.opref.retur,opref,d.opref.optype);
5 9102 end;
4 9103
4 9103 begin
5 9104
5 9104 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 9105 <*-4*>
5 9106 end
4 9107 end; <* case aktion+6 *>
3 9108
3 9108 until false;
3 9109 op_trap:
3 9110 skriv_operatør(zbillede,1);
3 9111 end operatør;
2 9112
2 9112 \f
2 9112 message procedure op_cqftest side 1;
2 9113
2 9113 procedure op_cqftest;
2 9114 begin
3 9115 integer array field opref, ref, ref1;
3 9116 integer i, j, tv, cqf, res, pausetid;
3 9117 real nu, næstetid, kommstart, kommslut;
3 9118
3 9118 procedure skriv_op_cqftest(zud,omfang);
3 9119 value omfang;
3 9120 zone zud;
3 9121 integer omfang;
3 9122 begin
4 9123 write(zud,"nl",1,<:+++ op-cqftest:>);
4 9124 if omfang > 0 then
4 9125 disable begin
5 9126 real t;
5 9127
5 9127 trap(slut);
5 9128 write(zud,"nl",1,
5 9129 <: opref: :>,opref,"nl",1,
5 9130 <: ref: :>,ref,"nl",1,
5 9131 <: i: :>,i,"nl",1,
5 9132 <: tv: :>,tv,"nl",1,
5 9133 <: cqf: :>,cqf,"nl",1,
5 9134 <: res: :>,res,"nl",1,
5 9135 <: pausetid: :>,pausetid,"nl",1,
5 9136 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 9137 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 9138 <::>);
5 9139 skriv_coru(zud,coru_no(292));
5 9140 slut:
5 9141 end;
4 9142 end skriv_op_cqftest;
3 9143
3 9143 trap(op_cqf_trap);
3 9144 stackclaim(1000);
3 9145
3 9145
3 9145 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9146 skriv_op_cqftest(out,0);
3 9147 <*-4*>
3 9148
3 9148 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 9149 repeat
3 9150 i:= sidste_tv_brugt; tv:= 0;
3 9151 repeat
3 9152 i:= (i mod max_antal_taleveje) + 1;
3 9153 if tv_operatør(i) = 0 then tv:= i;
3 9154 until (tv<>0) or (i=sidste_tv_brugt);
3 9155
3 9155 if tv<>0 then
3 9156 begin
4 9157 tv_operatør(tv):= -1;
4 9158 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 9159 for cqf:= 1 step 1 until max_cqf do
4 9160 begin
5 9161 ref:= (cqf-1)*cqf_lgd;
5 9162 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 9163 begin
6 9164 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 9165 d.opref.data(1):= tv;
6 9166 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 9167 disable if testbit19 then
6 9168 begin
7 9169 integer i; <*lav en trap-bar blok*>
7 9170
7 9170 trap(test19_trap);
7 9171 systime(1,0,kommstart);
7 9172 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 9173 skriv_id(zrl,d.opref.data(2),0);
7 9174 test19_trap: outchar(zrl,'nl');
7 9175 end;
6 9176 signalch(cs_rad,opref,op_optype or gen_optype);
6 9177 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 9178 res:= d.opref.resultat;
6 9179 <*+2*>
6 9180 disable if testbit19 then
6 9181 begin
7 9182 integer i; <*lav en trap-bar blok*>
7 9183
7 9183 trap(test19_trap);
7 9184 systime(1,0,kommslut);
7 9185 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 9186 if d.opref.data(7)=2 then outchar(zrl,'*');
7 9187 if d.opref.data(9)<>0 then
7 9188 begin
8 9189 skriv_id(zrl,d.opref.data(9),0);
8 9190 outchar(zrl,' ');
8 9191 end;
7 9192 if d.opref.data(8)<>0 then
7 9193 begin
8 9194 skriv_id(zrl,d.opref.data(8),0);
8 9195 outchar(zrl,' ');
8 9196 end;
7 9197 if d.opref.data(12)<>0 then
7 9198 begin
8 9199 if d.opref.data(12) shift (-20) = 15 then
8 9200 write(zrl,<:OMR*:>)
8 9201 else
8 9202 if d.opref.data(12) shift (-20) = 14 then
8 9203 write(zrl,
8 9204 string områdenavn(d.opref.data(12) extract 20))
8 9205 else
8 9206 skriv_id(zrl,d.opref.data(12),0);
8 9207 outchar(zrl,' ');
8 9208 end;
7 9209 if d.opref.data(10)<>0 then
7 9210 begin
8 9211 skriv_id(zrl,d.opref.data(10),0);
8 9212 outchar(zrl,' ');
8 9213 end;
7 9214 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 9215 <<dd.dd>,kommslut-kommstart);
7 9216 test19_trap: outchar(zrl,'nl');
7 9217 end;
6 9218 <*-2*>
6 9219 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 9220 begin
7 9221 delay(3);
7 9222 d.opref.opkode:= 12 shift 12 + 41;
7 9223 d.opref.resultat:= 0;
7 9224 disable if testbit19 then
7 9225 begin
8 9226 integer i; <*lav en trap-bar blok*>
8 9227
8 9227 trap(test19_trap);
8 9228 systime(1,0,kommstart);
8 9229 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 9230 test19_trap: outchar(zrl,'nl');
8 9231 end;
7 9232 signalch(cs_rad,opref,op_optype or gen_optype);
7 9233 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 9234 <*+2*>
7 9235 disable if testbit19 then
7 9236 begin
8 9237 integer i; <*lav en trap-bar blok*>
8 9238
8 9238 trap(test19_trap);
8 9239 systime(1,0,kommslut);
8 9240 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 9241 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 9242 <<dd.dd>,kommslut-kommstart);
8 9243 test19_trap: outchar(zrl,'nl');
8 9244 end;
7 9245 <*-2*>
7 9246 if d.opref.resultat <> 3 then
7 9247 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 9248 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 9249 begin
8 9250 startoperation(opref,292,cs_cqf,23);
8 9251 i:= 1;
8 9252 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9253 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9254 skriv_tegn(d.opref.data,i,' ');
8 9255 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9256 hægtstring(d.opref.data,i,<: ok!:>);
8 9257 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9258 signalch(cs_io,opref,gen_optype);
8 9259 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9260 end;
7 9261 if cqf_tabel.ref.cqf_bus > 0 then
7 9262 begin
8 9263 cqf_tabel.ref.cqf_fejl:= 0;
8 9264 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 9265 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 9266 end;
7 9267 end <*res=3*>
6 9268 else
6 9269 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 9270 cqf_tabel.ref.cqf_bus > 0
6 9271 then
6 9272 begin
7 9273 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 9274 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 9275 if cqf_tabel.ref.cqf_fejl >= 2 then
7 9276 begin
8 9277 startoperation(opref,292,cs_cqf,23);
8 9278 i:= 1;
8 9279 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9280 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9281 skriv_tegn(d.opref.data,i,' ');
8 9282 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9283 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 9284 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9285 signalch(cs_io,opref,gen_optype);
8 9286 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9287 end;
7 9288 end;
6 9289 delay(10);
6 9290 end;
5 9291 if cqf_tabel.ref.cqf_bus > 0 and
5 9292 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 9293 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 9294 end; <*for cqf*>
4 9295
4 9295 tv_operatør(tv):= 0; tv:= 0;
4 9296 if op_cqf_tab_ændret then
4 9297 begin
5 9298 j:= skrivfil(1033,1,i);
5 9299 if j<>0 then
5 9300 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 9301 sorter_cqftab(1,max_cqf);
5 9302 for cqf:= 1 step 1 until max_cqf do
5 9303 begin
6 9304 ref:= (cqf-1)*cqf_lgd;
6 9305 ref1:= (cqf-1)*cqf_id;
6 9306 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 9307 end;
5 9308 op_cqf_tab_ændret:= false;
5 9309 end;
4 9310 end; <*tv*>
3 9311
3 9311 systime(1,0.0,nu);
3 9312 pausetid:= round(næste_tid - nu);
3 9313 if pausetid < 30 then pausetid:= 30;
3 9314
3 9314 <*V*> delay(pausetid);
3 9315
3 9315 until false;
3 9316
3 9316 op_cqf_trap:
3 9317 disable skriv_op_cqftest(zbillede,1);
3 9318 end op_cqftest;
2 9319 \f
2 9319 message procedure op_spool side 1;
2 9320
2 9320 procedure op_spool;
2 9321 begin
3 9322 integer array field opref, ref;
3 9323 integer næste_tomme, i;
3 9324
3 9324 procedure skriv_op_spool(zud,omfang);
3 9325 value omfang;
3 9326 zone zud;
3 9327 integer omfang;
3 9328 begin
4 9329 write(zud,"nl",1,<:+++ op-spool:>);
4 9330 if omfang > 0 then
4 9331 disable begin
5 9332 real t;
5 9333
5 9333 trap(slut);
5 9334 write(zud,"nl",1,
5 9335 <: opref: :>,opref,"nl",1,
5 9336 <: næste-tomme: :>,næste_tomme,"nl",1,
5 9337 <: ref: :>,ref,"nl",1,
5 9338 <: i: :>,i,"nl",1,
5 9339 <::>);
5 9340 skriv_coru(zud,coru_no(293));
5 9341 slut:
5 9342 end;
4 9343 end skriv_op_spool;
3 9344
3 9344 trap(op_spool_trap);
3 9345 stackclaim(400);
3 9346
3 9346 næste_tomme:= 0;
3 9347
3 9347 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9348 skriv_op_spool(out,0);
3 9349 <*-4*>
3 9350
3 9350 repeat
3 9351 <*V*> waitch(cs_op_spool,opref,true,-1);
3 9352 inspect(ss_op_spool_tomme,i);
3 9353
3 9353 if d.opref.opkode extract 12 <> 37 then
3 9354 begin
4 9355 d.opref.resultat:= 31;
4 9356 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 9357 end
3 9358 else
3 9359 if i<=0 then
3 9360 d.opref.resultat:= 32 <*ingen fri plads*>
3 9361 else
3 9362 begin
4 9363 <*V*> wait(ss_op_spool_tomme);
4 9364 ref:= næste_tomme*op_spool_postlgd;
4 9365 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9366 i:= d.opref.opsize - data;
4 9367 if i > (op_spool_postlgd - op_spool_text) then
4 9368 i:= (op_spool_postlgd - op_spool_text);
4 9369 op_spool_buf.ref.op_spool_kilde:=
4 9370 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9371 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9372 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9373 op_spool_buf.ref(op_spool_postlgd//2):=
4 9374 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9375 d.opref.resultat:= 3;
4 9376
4 9376 signal(ss_op_spool_fulde);
4 9377 end;
3 9378
3 9378 signalch(d.opref.retur,opref,d.opref.optype);
3 9379 until false;
3 9380
3 9380 op_spool_trap:
3 9381 disable skriv_op_spool(zbillede,1);
3 9382 end op_spool;
2 9383 \f
2 9383 message procedure op_medd side 1;
2 9384
2 9384 procedure op_medd;
2 9385 begin
3 9386 integer array field opref, ref;
3 9387 integer næste_fulde, i;
3 9388
3 9388 procedure skriv_op_medd(zud,omfang);
3 9389 value omfang;
3 9390 zone zud;
3 9391 integer omfang;
3 9392 begin
4 9393 write(zud,"nl",1,<:+++ op-medd:>);
4 9394 if omfang > 0 then
4 9395 disable begin
5 9396 real t;
5 9397
5 9397 trap(slut);
5 9398 write(zud,"nl",1,
5 9399 <: opref: :>,opref,"nl",1,
5 9400 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9401 <: ref: :>,ref,"nl",1,
5 9402 <: i: :>,i,"nl",1,
5 9403 <::>);
5 9404 skriv_coru(zud,coru_no(294));
5 9405 slut:
5 9406 end;
4 9407 end skriv_op_medd;
3 9408
3 9408 trap(op_medd_trap);
3 9409 næste_fulde:= 0;
3 9410 stackclaim(400);
3 9411
3 9411 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9412 skriv_op_medd(out,0);
3 9413 <*-4*>
3 9414
3 9414 repeat
3 9415 <*V*> wait(ss_op_spool_fulde);
3 9416 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9417
3 9417 ref:= næste_fulde*op_spool_postlgd;
3 9418 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9419
3 9419 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9420 d.opref.resultat:= 0;
3 9421 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9422 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9423 opref,gen_optype);
3 9424 signal(ss_op_spool_tomme);
3 9425 until false;
3 9426
3 9426 op_medd_trap:
3 9427 disable skriv_op_medd(zbillede,1);
3 9428 end op_medd;
2 9429 \f
2 9429 message procedure alarmur side 1;
2 9430
2 9430 procedure alarmur;
2 9431 begin
3 9432 integer ventetid, nr;
3 9433 integer array field opref, tab;
3 9434 real nu;
3 9435
3 9435 procedure skriv_alarmur(zud,omfang);
3 9436 value omfang;
3 9437 zone zud;
3 9438 integer omfang;
3 9439 begin
4 9440 write(zud,"nl",1,<:+++ alarmur:>);
4 9441 if omfang > 0 then
4 9442 disable begin
5 9443 real t;
5 9444
5 9444 trap(slut);
5 9445 write(zud,"nl",1,
5 9446 <: ventetid: :>,ventetid,"nl",1,
5 9447 <: nr: :>,nr,"nl",1,
5 9448 <: opref: :>,opref,"nl",1,
5 9449 <: tab: :>,tab,"nl",1,
5 9450 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9451 <::>);
5 9452 skriv_coru(zud,coru_no(295));
5 9453 slut:
5 9454 end;
4 9455 end skriv_alarmur;
3 9456
3 9456 trap(alarmur_trap);
3 9457 stackclaim(400);
3 9458
3 9458 systime(1,0.0,nu);
3 9459 ventetid:= -1;
3 9460 repeat
3 9461 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9462 if opref > 0 then
3 9463 signalch(d.opref.retur,opref,op_optype);
3 9464
3 9464 ventetid:= -1;
3 9465 systime(1,0.0,nu);
3 9466 for nr:= 1 step 1 until max_antal_operatører do
3 9467 begin
4 9468 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9469 if opk_alarm.tab.alarm_tilst > 0 and
4 9470 opk_alarm.tab.alarm_lgd >= 0 then
4 9471 begin
5 9472 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9473 begin
6 9474 opk_alarm.tab.alarm_kmdo:= 3;
6 9475 signalbin(bs_opk_alarm);
6 9476 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9477 end
5 9478 else
5 9479 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9480 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9481 end;
4 9482 end;
3 9483 if ventetid=0 then ventetid:= 1;
3 9484 until false;
3 9485
3 9485 alarmur_trap:
3 9486 disable skriv_alarmur(zbillede,1);
3 9487 end alarmur;
2 9488 \f
2 9488 message procedure opkaldsalarmer side 1;
2 9489
2 9489 procedure opkaldsalarmer;
2 9490 begin
3 9491 integer nr, ny_kommando, tilst, aktion, tt;
3 9492 integer array field tab, opref, alarmop;
3 9493
3 9493 procedure skriv_opkaldsalarmer(zud,omfang);
3 9494 value omfang;
3 9495 zone zud;
3 9496 integer omfang;
3 9497 begin
4 9498 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9499 if omfang>0 then
4 9500 disable begin
5 9501 real array field raf;
5 9502 trap(slut);
5 9503 raf:=0;
5 9504 write(zud,"nl",1,
5 9505 <: nr: :>,nr,"nl",1,
5 9506 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9507 <: tilst: :>,tilst,"nl",1,
5 9508 <: aktion: :>,aktion,"nl",1,
5 9509 <: tt: :>,false add tt,1,"nl",1,
5 9510 <: tab: :>,tab,"nl",1,
5 9511 <: opref: :>,opref,"nl",1,
5 9512 <: alarmop: :>,alarmop,"nl",1,
5 9513 <::>);
5 9514 skriv_coru(zud,coru_no(296));
5 9515 slut:
5 9516 end;
4 9517 end skriv_opkaldsalarmer;
3 9518
3 9518 trap(opk_alarm_trap);
3 9519 stackclaim(400);
3 9520
3 9520 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9521 skriv_opkaldsalarmer(out,0);
3 9522 <*-2*>
3 9523
3 9523 repeat
3 9524 wait(bs_opk_alarm);
3 9525 alarmop:= 0;
3 9526 for nr:= 1 step 1 until max_antal_operatører do
3 9527 begin
4 9528 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9529 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9530 tilst:= opk_alarm.tab.alarm_tilst;
4 9531 aktion:= case ny_kommando+1 of (
4 9532 <*ingenting*> case tilst+1 of (4,4,4),
4 9533 <*normal *> case tilst+1 of (1,4,4),
4 9534 <*nød *> case tilst+1 of (2,2,4),
4 9535 <*sluk *> case tilst+1 of (4,3,3));
4 9536 tt:= case aktion of ('B','C','F','-');
4 9537 if tt<>'-' then
4 9538 begin
5 9539 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9540 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9541 d.opref.data(1):= nr+16;
5 9542 signalch(cs_talevejsswitch,opref,op_optype);
5 9543 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9544 if d.opref.resultat = 3 then
5 9545 begin
6 9546 opk_alarm.tab.alarm_kmdo:= 0;
6 9547 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9548 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9549 if aktion < 3 then
6 9550 begin
7 9551 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9552 if alarmop = 0 then
7 9553 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9554 end;
6 9555 end;
5 9556 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9557 end;
4 9558 end;
3 9559 if alarmop<>0 then
3 9560 begin
4 9561 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9562 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9563 end;
3 9564 until false;
3 9565
3 9565 opk_alarm_trap:
3 9566 disable skriv_opkaldsalarmer(zbillede,1);
3 9567 end;
2 9568
2 9568 \f
2 9568 message procedure tvswitch_input side 1 - 940810/cl;
2 9569
2 9569 procedure tv_switch_input;
2 9570 begin
3 9571 integer array field opref;
3 9572 integer tt,ant;
3 9573 boolean ok;
3 9574 integer array ia(1:128);
3 9575
3 9575 procedure skriv_tvswitch_input(zud,omfang);
3 9576 value omfang;
3 9577 zone zud;
3 9578 integer omfang;
3 9579 begin
4 9580 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9581 if omfang>0 then
4 9582 disable begin
5 9583 real array field raf;
5 9584 trap(slut);
5 9585 raf:=0;
5 9586 write(zud,"nl",1,
5 9587 <: opref: :>,opref,"nl",1,
5 9588 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9589 <: ant: :>,ant,"nl",1,
5 9590 <: tt: :>,tt,"nl",1,
5 9591 <::>);
5 9592 write(zud,"nl",1,<:ia: :>);
5 9593 skrivhele(zud,ia.raf,256,2);
5 9594 skriv_coru(zud,coru_no(297));
5 9595 slut:
5 9596 end;
4 9597 end skriv_tvswitch_input;
3 9598 \f
3 9598 boolean procedure læs_tlgr;
3 9599 begin
4 9600 integer kl,ch,i,pos,p;
4 9601 long field lf;
4 9602 boolean ok;
4 9603
4 9603 integer procedure readch(z,c);
4 9604 zone z; integer c;
4 9605 begin
5 9606 readch:= readchar(z,c);
5 9607 <*+2*> if testbit15 and overvåget then
5 9608 disable begin
6 9609 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9610 else write(zrl,"<",1,<<d>,c,">",1);
6 9611 if c='em' then write(zrl,<: *timeout*:>);
6 9612 end;
5 9613 <*-2*>
5 9614 end;
4 9615
4 9615 ok:= false; tt:=' ';
4 9616 repeat
4 9617 readchar(z_tv_in,ch);
4 9618 until ch<>'em';
4 9619 repeatchar(z_tv_in);
4 9620
4 9620 <*+2*>if testbit15 and overvåget then
4 9621 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9622 <*-2*>
4 9623
4 9623 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9624 if ch='%' then
4 9625 begin
5 9626 ant:= 0; pos:= 1; lf:= 4;
5 9627 ok:= true;
5 9628 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9629
5 9629 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9630 skrivtegn(ia,pos,ch);
5 9631
5 9631 p:=pos;
5 9632 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9633
5 9633 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9634 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9635 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9636
5 9636 if ok and ch=' ' then
5 9637 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9638
5 9638 while kl = 2 do
5 9639 begin
6 9640 i:= ch - '0';
6 9641 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9642 if ant < 128 then
6 9643 begin
7 9644 ant:= ant+1;
7 9645 ia(ant):= i;
7 9646 end
6 9647 else
6 9648 ok:= false;
6 9649 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9650 end;
5 9651 if ch<>'nl' then ok:= false;
5 9652 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9653 <* !! setposition(z_tv_in,0,0); !! *>
5 9654 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9655 <*-2*>
5 9656
5 9656 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9657 ok:= ok
5 9658 else if tt='C' or tt='N' or
5 9659 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9660 ok:= ok and ant=1
5 9661 else if tt='X' or tt='Y' then
5 9662 ok:= ok and ant=2
5 9663 else if tt='T' or tt='W' then
5 9664 ok:= ok and ant=64
5 9665 else if tt='R' then
5 9666 ok:= ok and ant extract 1 = 0
5 9667 else
5 9668 begin
6 9669 ok:= false;
6 9670 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9671 end;
5 9672
5 9672 end; <* if ch='%' *>
4 9673 læs_tlgr:= ok;
4 9674 end læs_tlgr;
3 9675 \f
3 9675 trap(tvswitch_input_trap);
3 9676 stackclaim(400);
3 9677 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9678
3 9678 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9679 skriv_tvswitch_input(out,0);
3 9680 <*-2*>
3 9681
3 9681 repeat
3 9682 ok:= læs_tlgr;
3 9683 if ok then
3 9684 begin
4 9685 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9686 start_operation(opref,297,cs_tvswitch_input,0);
4 9687 d.opref.resultat:= tt shift 12 + ant;
4 9688 tofrom(d.opref.data,ia,ant*2);
4 9689 signalch(cs_talevejsswitch,opref,op_optype);
4 9690 end;
3 9691 until false;
3 9692
3 9692 tvswitch_input_trap:
3 9693
3 9693 disable skriv_tvswitch_input(zbillede,1);
3 9694
3 9694 end tvswitch_input;
2 9695 \f
2 9695 message procedure tv_switch_adm side 1 - 940502/cl;
2 9696
2 9696 procedure tv_switch_adm;
2 9697 begin
3 9698 integer array field opref;
3 9699 integer rc;
3 9700
3 9700 procedure skriv_tv_switch_adm(zud,omfang);
3 9701 value omfang;
3 9702 zone zud;
3 9703 integer omfang;
3 9704 begin
4 9705 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9706 if omfang>0 then
4 9707 disable begin
5 9708 trap(slut);
5 9709 write(zud,"nl",1,
5 9710 <: opref: :>,opref,"nl",1,
5 9711 <: rc: :>,rc,"nl",1,
5 9712 <::>);
5 9713 skriv_coru(zud,coru_no(298));
5 9714 slut:
5 9715 end;
4 9716 end skriv_tv_switch_adm;
3 9717
3 9717 trap(tv_switch_adm_trap);
3 9718 stackclaim(400);
3 9719
3 9719 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9720 disable skriv_tv_switch_adm(out,0);
3 9721 <*-2*>
3 9722
3 9722
3 9722
3 9722 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9723 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9724 *>
3 9725
3 9725 repeat
3 9726 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9727 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9728 rc:= 0;
3 9729 repeat
3 9730 signalch(cs_talevejsswitch,opref,op_optype);
3 9731 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9732 rc:= rc+1;
3 9733 until rc=3 or d.opref.resultat=3;
3 9734
3 9734 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9735
3 9735 <*V*> delay(15*60);
3 9736 until false;
3 9737 tv_switch_adm_trap:
3 9738 disable skriv_tv_switch_adm(zbillede,1);
3 9739 end;
2 9740 \f
2 9740 message procedure talevejsswitch side 1 -940426/cl;
2 9741
2 9741 procedure talevejsswitch;
2 9742 begin
3 9743 integer tt, ant, ventetid;
3 9744 integer array field opref, gemt_op, tab;
3 9745 boolean ok;
3 9746 integer array ia(1:128);
3 9747
3 9747 procedure skriv_talevejsswitch(zud,omfang);
3 9748 value omfang;
3 9749 zone zud;
3 9750 integer omfang;
3 9751 begin
4 9752 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9753 if omfang>0 then
4 9754 disable begin
5 9755 real array field raf;
5 9756 trap(slut);
5 9757 raf:= 0;
5 9758 write(zud,"nl",1,
5 9759 <: tt: :>,tt,"nl",1,
5 9760 <: ant: :>,ant,"nl",1,
5 9761 <: ventetid: :>,ventetid,"nl",1,
5 9762 <: opref: :>,opref,"nl",1,
5 9763 <: gemt-op: :>,gemt_op,"nl",1,
5 9764 <: tab: :>,tab,"nl",1,
5 9765 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9766 <::>);
5 9767 write(zud,"nl",1,<:ia: :>);
5 9768 skriv_hele(zud,ia.raf,256,2);
5 9769 skriv_coru(zud,coru_no(299));
5 9770 slut:
5 9771 end;
4 9772 end skriv_talevejsswitch;
3 9773 \f
3 9773 trap(tvswitch_trap);
3 9774 stackclaim(400);
3 9775 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9776
3 9776 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9777 skriv_talevejsswitch(out,0);
3 9778 <*-2*>
3 9779
3 9779 ventetid:= -1; ant:= 0; tt:= ' ';
3 9780 repeat
3 9781 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9782 if opref > 0 then
3 9783 begin
4 9784 if d.opref.opkode extract 12 = 0 then
4 9785 begin <*input fra talevejsswitchen *>
5 9786 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9787 tt:= d.opref.resultat shift (-12) extract 12;
5 9788 ant:= d.opref.resultat extract 12;
5 9789 tofrom(ia,d.opref.data,ant*2);
5 9790 signalch(d.opref.retur,opref,d.opref.optype);
5 9791
5 9791 if tt<>'+' and tt<>'-' then
5 9792 begin
6 9793 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9794 setposition(z_tv_out,0,0);
6 9795 <*+2*> if testbit15 and overvåget then
6 9796 disable begin
7 9797 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9798 outchar(zrl,'nl');
7 9799 end;
6 9800 <*-2*>
6 9801 end;
5 9802 if (tt='+' or tt='-') and gemt_op<>0 then
5 9803 begin
6 9804 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9805 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9806 gemt_op:= 0;
6 9807 ventetid:= -1;
6 9808 end
5 9809 else
5 9810 if tt='R' then
5 9811 begin
6 9812 for i:= 1 step 2 until ant do
6 9813 begin
7 9814 if ia(i) <= max_antal_taleveje and
7 9815 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9816 then
7 9817 begin
8 9818 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9819 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9820 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9821 op_talevej(tv_operatør(ia(i))):= 0;
8 9822 tv_operatør(ia(i)):= ia(i+1)-16;
8 9823 op_talevej(ia(i+1)-16):= ia(i);
8 9824 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9825 end
7 9826 else
7 9827 if ia(i+1) <= max_antal_taleveje and
7 9828 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9829 then
7 9830 begin
8 9831 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9832 tv_operatør(op_talevej(ia(i))):= 0;
8 9833 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9834 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9835 tv_operatør(ia(i+1)):= ia(i)-16;
8 9836 op_talevej(ia(i)-16):= ia(i+1);
8 9837 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9838 end;
7 9839 end;
6 9840 signal_bin(bs_mobil_opkald);
6 9841 <*+2*> if testbit15 and testbit16 and overvåget then
6 9842 disable begin
7 9843 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9844 end;
6 9845 <*-2*>
6 9846 end <* tt='R' and ant>0 *>
5 9847 else
5 9848 if tt='Y' then
5 9849 begin
6 9850 if ia(1) <= max_antal_taleveje and
6 9851 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9852 then
6 9853 begin
7 9854 if tv_operatør(ia(1))=ia(2)-16 and
7 9855 op_talevej(ia(2)-16)=ia(1)
7 9856 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9857 end
6 9858 else
6 9859 if ia(2) <= max_antal_taleveje and
6 9860 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9861 then
6 9862 begin
7 9863 if tv_operatør(ia(2))=ia(1)-16 and
7 9864 op_talevej(ia(1)-16)=ia(2)
7 9865 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9866 end;
6 9867 end
5 9868 else
5 9869 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9870 begin
6 9871 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9872 startoperation(opref,299,cs_op_iomedd,23);
6 9873 ant:= 1;
6 9874 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9875 anbringtal(d.opref.data,ant,ia(1),2);
6 9876 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9877 begin
7 9878 hægtstring(d.opref.data,ant,<: (:>);
7 9879 if bpl_navn(ia(1)-16)=long<::> then
7 9880 begin
8 9881 hægtstring(d.opref.data,ant,<:op:>);
8 9882 anbringtal(d.opref.data,ant,ia(1)-16,
8 9883 if ia(1)-16 > 9 then 2 else 1);
8 9884 end
7 9885 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9886 skrivtegn(d.opref.data,ant,')');
7 9887 end;
6 9888 hægtstring(d.opref.data,ant,
6 9889 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9890 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9891 if tt='P' then <: Tilgængelig:> else
6 9892 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9893 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9894 signalch(cs_io,opref,gen_optype);
6 9895 end
5 9896 else
5 9897 if tt='Z' then
5 9898 begin
6 9899 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9900 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9901 end
5 9902 else
5 9903 begin
6 9904 <* ikke implementeret *>
6 9905 end;
5 9906 end
4 9907 else
4 9908 if d.opref.opkode extract 12 = 44 then
4 9909 begin
5 9910 tt:= d.opref.opkode shift (-12);
5 9911 ok:= true;
5 9912 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9913 begin
6 9914 <*+2*> if testbit15 and overvåget then
6 9915 disable begin
7 9916 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9917 outchar(zrl,'nl');
7 9918 end;
6 9919 <*-2*>
6 9920 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9921 setposition(z_tv_out,0,0);
6 9922 end
5 9923 else
5 9924 if tt='B' or tt='C' or tt='F' then
5 9925 begin
6 9926 <*+2*> if testbit15 and overvåget then
6 9927 disable begin
7 9928 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9929 " ",1,<<d>,d.opref.data(1));
7 9930 outchar(zrl,'nl');
7 9931 end;
6 9932 <*-2*>
6 9933 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9934 d.opref.data(1),"cr",1);
6 9935 setposition(z_tv_out,0,0);
6 9936 end
5 9937 else
5 9938 if tt='A' or tt='D' or tt='T' then
5 9939 begin
6 9940 <*+2*> if testbit15 and overvåget then
6 9941 disable begin
7 9942 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9943 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9944 outchar(zrl,'nl');
7 9945 end;
6 9946 <*-2*>
6 9947 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9948 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9949 setposition(z_tv_out,0,0);
6 9950 end
5 9951 else
5 9952 ok:= false;
5 9953 if ok then
5 9954 begin
6 9955 gemt_op:= opref;
6 9956 ventetid:= 2;
6 9957 end
5 9958 else
5 9959 begin
6 9960 d.opref.resultat:= 4;
6 9961 signalch(d.opref.retur,opref,d.opref.optype);
6 9962 end;
5 9963 end;
4 9964 end
3 9965 else
3 9966 if gemt_op<>0 then
3 9967 begin <*timeout*>
4 9968 d.gemt_op.resultat:= 0;
4 9969 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9970 gemt_op:= 0;
4 9971 ventetid:= -1;
4 9972 <*+2*> if testbit15 and overvåget then
4 9973 disable begin
5 9974 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9975 outchar(zrl,'nl');
5 9976 end;
4 9977 <*-2*>
4 9978 end;
3 9979 until false;
3 9980 tvswitch_trap:
3 9981 disable skriv_talevejsswitch(zbillede,1);
3 9982 end talevejsswitch;
2 9983
2 9983 \f
2 9983 message garage_erklæringer side 1 - 810415/hko;
2 9984
2 9984 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 9985
2 9985 procedure gar_fejl(z,s,b);
2 9986 integer s,b;
2 9987 zone z;
2 9988 begin
3 9989 disable begin
4 9990 integer array iz(1:20);
4 9991 integer i,j,k;
4 9992 integer array field iaf;
4 9993 real array field raf;
4 9994
4 9994 getzone6(z,iz);
4 9995 iaf:=raf:=2;
4 9996 getnumber(iz.raf,7,j);
4 9997
4 9997 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 9998 k:=1;
4 9999
4 9999 j:= terminal_tab.iaf.terminal_tilstand;
4 10000 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 10001 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 10002 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 10003 if s <> (1 shift 21 +2) then
4 10004 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 10005 + terminal_tab.iaf.terminal_tilstand extract 21;
4 10006 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 10007 begin
5 10008 z(1):=real <:<'?'><'em'>:>;
5 10009 b:=2;
5 10010 end;
4 10011 end; <*disable*>
3 10012 end gar_fejl;
2 10013
2 10013 integer cs_gar;
2 10014 integer array cs_garage(1:max_antal_garageterminaler);
2 10015 \f
2 10015 message procedure h_garage side 1 - 810520/hko;
2 10016
2 10016 <* hovedmodulkorutine for garageterminaler *>
2 10017 procedure h_garage;
2 10018 begin
3 10019 integer array field op_ref;
3 10020 integer k,dest_sem;
3 10021 procedure skriv_hgarage(zud,omfang);
3 10022 value omfang;
3 10023 zone zud;
3 10024 integer omfang;
3 10025 begin integer i;
4 10026
4 10026 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 10027 write(zud,"sp",26-i);
4 10028 if omfang>0 then
4 10029 disable begin
5 10030 integer x;
5 10031 trap(slut);
5 10032 write(zud,"nl",1,
5 10033 <: op_ref: :>,op_ref,"nl",1,
5 10034 <: k: :>,k,"nl",1,
5 10035 <: dest_sem: :>,dest_sem,"nl",1,
5 10036 <::>);
5 10037 skriv_coru(zud,coru_no(300));
5 10038 slut:
5 10039 end;
4 10040 end skriv_hgarage;
3 10041
3 10041 trap(hgar_trap);
3 10042 stack_claim(if cm_test then 198 else 146);
3 10043
3 10043 <*+2*>
3 10044 if testbit16 and overvåget or testbit28 then
3 10045 skriv_hgarage(out,0);
3 10046 <*-2*>
3 10047 \f
3 10047 message procedure h_garage side 2 - 811105/hko;
3 10048
3 10048 repeat
3 10049 wait_ch(cs_gar,op_ref,true,-1);
3 10050 <*+4*>
3 10051 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 10052 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 10053 <*-4*>
3 10054
3 10054 k:=d.op_ref.opkode extract 12;
3 10055 dest_sem:=
3 10056 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 10057 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 10058 else -1;
3 10059 <*+4*>
3 10060 if dest_sem=-1 then
3 10061 begin
4 10062 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 10063 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10064 end
3 10065 else
3 10066 <*-4*>
3 10067 if k=7<*inkluder*> then
3 10068 begin
4 10069 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 10070 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 10071 begin
5 10072 d.op_ref.resultat:=3;
5 10073 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 10074 dest_sem:=-2;
5 10075 end;
4 10076 end
3 10077 else
3 10078 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 10079 begin
4 10080 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 10081 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 10082 +terminal_tab.iaf.terminal_tilstand extract 21;
4 10083 end;
3 10084 if dest_sem>0 then
3 10085 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 10086 until false;
3 10087
3 10087 hgar_trap:
3 10088 disable skriv_hgarage(zbillede,1);
3 10089 end h_garage;
2 10090 \f
2 10090 message procedure garage side 1 - 830310/cl;
2 10091
2 10091 procedure garage(nr);
2 10092 value nr;
2 10093 integer nr;
2 10094 begin
3 10095 integer array field op_ref,ref;
3 10096 integer i,kode,aktion,status,opgave,retur_sem,
3 10097 pos,indeks,sep,sluttegn,vogn,ll;
3 10098
3 10098 procedure skriv_garage(zud,omfang);
3 10099 value omfang;
3 10100 zone zud;
3 10101 integer omfang;
3 10102 begin integer i;
4 10103
4 10103 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 10104 write(zud,"sp",26-i);
4 10105 if omfang > 0 then
4 10106 disable begin integer x;
5 10107 trap(slut);
5 10108 write(zud,"nl",1,
5 10109 <: op-ref: :>,op_ref,"nl",1,
5 10110 <: kode: :>,kode,"nl",1,
5 10111 <: ref: :>,ref,"nl",1,
5 10112 <: i: :>,i,"nl",1,
5 10113 <: aktion: :>,aktion,"nl",1,
5 10114 <: retur-sem: :>,retur_sem,"nl",1,
5 10115 <: vogn: :>,vogn,"nl",1,
5 10116 <: ll: :>,ll,"nl",1,
5 10117 <: status: :>,status,"nl",1,
5 10118 <: opgave: :>,opgave,"nl",1,
5 10119 <: pos: :>,pos,"nl",1,
5 10120 <: indeks: :>,indeks,"nl",1,
5 10121 <: sep: :>,sep,"nl",1,
5 10122 <: sluttegn: :>,sluttegn,"nl",1,
5 10123 <::>);
5 10124 skriv_coru(zud,coru_no(300+nr));
5 10125 slut:
5 10126 end;
4 10127 end skriv_garage;
3 10128 \f
3 10128 message procedure garage side 2 - 830310/hko;
3 10129
3 10129 trap(gar_trap);
3 10130 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 10131
3 10131 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 10132
3 10132 <*+2*>
3 10133 if testbit16 and overvåget or testbit28 then
3 10134 skriv_garage(out,0);
3 10135 <*-2*>
3 10136
3 10136 <* attention simulering
3 10137 *>
3 10138 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 10139 begin
4 10140 wait_ch(cs_att_pulje,op_ref,true,-1);
4 10141 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 10142 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 10143 end;
3 10144 <*
3 10145 *>
3 10146 \f
3 10146 message procedure garage side 3 - 830310/hko;
3 10147
3 10147 repeat
3 10148
3 10148 <*V*> wait_ch(cs_garage(nr),
3 10149 op_ref,
3 10150 true,
3 10151 -1<*timeout*>);
3 10152 <*+2*>
3 10153 if testbit17 and overvåget then
3 10154 disable begin
4 10155 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 10156 <: til garage :>,nr);
4 10157 skriv_op(out,op_ref);
4 10158 end;
3 10159 <*-2*>
3 10160
3 10160 kode:= d.op_ref.op_kode;
3 10161 retur_sem:= d.op_ref.retur;
3 10162 i:= terminal_tab.ref.terminal_tilstand;
3 10163 status:= i shift(-21);
3 10164 opgave:=
3 10165 if kode=0 then 1 <* indlæs kommando *> else
3 10166 if kode=7 then 2 <* inkluder *> else
3 10167 if kode=8 then 3 <* ekskluder *> else
3 10168 0; <* afvises *>
3 10169
3 10169 aktion:= case status +1 of(
3 10170 <* status *> <* opgave: 0 1 2 3 *>
3 10171 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 10172 <* 1 - *>(-1),<* ulovlig tilstand *>
3 10173 <* 2 - *>(-1),<* ulovlig tilstand *>
3 10174 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 10175 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 10176 <* 5 - *>(-1),<* ulovlig tilstand *>
3 10177 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 10178 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 10179 -1);
3 10180 \f
3 10180 message procedure garage side 4 - 810424/hko;
3 10181
3 10181 case aktion+6 of
3 10182 begin
4 10183 begin
5 10184 <*-5: terminal optaget *>
5 10185
5 10185 d.op_ref.resultat:= 16;
5 10186 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10187 end;
4 10188
4 10188 begin
5 10189 <*-4: operation uden virkning *>
5 10190
5 10190 afslut_operation(op_ref,-1);
5 10191 end;
4 10192
4 10192 begin
5 10193 <*-3: ulovlig operationskode *>
5 10194
5 10194 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 10195 afslut_operation(op_ref,-1);
5 10196 end;
4 10197
4 10197 begin
5 10198 <*-2: ulovligt garageterminal_nr *>
5 10199
5 10199 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 10200 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10201 end;
4 10202
4 10202 begin
5 10203 <*-1: ulovlig operatørtilstand *>
5 10204
5 10204 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 10205 afslut_operation(op_ref,-1);
5 10206 end;
4 10207
4 10207 begin
5 10208 <* 0: ikke implementeret *>
5 10209
5 10209 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 10210 afslut_operation(op_ref,-1);
5 10211 end;
4 10212
4 10212 begin
5 10213 \f
5 10213 message procedure garage side 5 - 851001/cl;
5 10214
5 10214 <* 1: indlæs kommando *>
5 10215
5 10215
5 10215 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 10216
5 10216 if d.op_ref.resultat > 3 then
5 10217 begin
6 10218 <*V*> setposition(z_gar(nr),0,0);
6 10219 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 10220 skriv_kvittering(z_gar(nr),op_ref,pos,
6 10221 d.op_ref.resultat);
6 10222 end
5 10223 else if d.op_ref.resultat>0 then
5 10224 begin <*godkendt*>
6 10225 kode:=d.op_ref.opkode;
6 10226 i:= kode extract 12;
6 10227 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 10228 else if kode=9 or kode=10 then 2
6 10229 else 0;
6 10230 if j > 0 then
6 10231 begin
7 10232 case j of
7 10233 begin
8 10234 begin
9 10235 \f
9 10235 message procedure garage side 6 - 851001/cl;
9 10236
9 10236 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 10237 integer vogn,ll;
9 10238 integer array field vtop;
9 10239
9 10239 vogn:=ia(1);
9 10240 ll:=ia(2);
9 10241 <*V*> wait_ch(cs_vt_adgang,
9 10242 vt_op,
9 10243 gen_optype,
9 10244 -1<*timeout sek*>);
9 10245 start_operation(vtop,300+nr,cs_garage(nr),
9 10246 kode);
9 10247 d.vt_op.data(1):=vogn;
9 10248 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 10249 indeks:= vt_op;
9 10250 signal_ch(cs_vt,
9 10251 vt_op,
9 10252 gen_optype or gar_optype);
9 10253
9 10253 <*V*> wait_ch(cs_garage(nr),
9 10254 vt_op,
9 10255 gar_optype,
9 10256 -1<*timeout sek*>);
9 10257 <*+2*> if testbit18 and overvåget then
9 10258 disable begin
10 10259 write(out,"nl",1,<:garage :>,<<d>,nr,
10 10260 <:: operation retur fra vt:>);
10 10261 skriv_op(out,vt_op);
10 10262 end;
9 10263 <*-2*>
9 10264 <*+4*> if vt_op<>indeks then
9 10265 fejl_reaktion(11<*fremmede op*>,op_ref,
9 10266 <:garage-kommando:>,0);
9 10267 <*-4*>
9 10268 <*V*> setposition(z_gar(nr),0,0);
9 10269 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 10270 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 10271 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 10272 else vt_op,-1,d.vt_op.resultat);
9 10273 d.vt_op.optype:=gen_optype or vtoptype;
9 10274 disable afslut_operation(vt_op,cs_vt_adgang);
9 10275 end;
8 10276
8 10276 begin
9 10277 \f
9 10277 message procedure garage side 6a - 830310/cl;
9 10278
9 10278 <* 2 vogntabel,linienr/-,busnr *>
9 10279
9 10279 d.op_ref.retur:= cs_garage(nr);
9 10280 tofrom(d.op_ref.data,ia,10);
9 10281 indeks:= op_ref;
9 10282 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 10283 wait_ch(cs_garage(nr),
9 10284 op_ref,
9 10285 gar_optype,
9 10286 -1<*timeout*>);
9 10287 <*+2*> if testbit18 and overvåget then
9 10288 disable begin
10 10289 write(out,"nl",1,<:garage operation retur fra vt:>);
10 10290 skriv_op(out,op_ref);
10 10291 end;
9 10292 <*-2*>
9 10293 <*+4*>
9 10294 if indeks <> op_ref then
9 10295 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 10296 <*-4*>
9 10297 i:= d.op_ref.resultat;
9 10298 if i = 0 or i > 3 then
9 10299 begin
10 10300 <*V*> setposition(z_gar(nr),0,0);
10 10301 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 10302 end
9 10303 else
9 10304 begin
10 10305 integer antal,fil_ref;
10 10306 antal:= d.op_ref.data(6);
10 10307 fil_ref:= d.op_ref.data(7);
10 10308 <*V*> setposition(z_gar(nr),0,0);
10 10309 write(z_gar(nr),"*",24,"sp",6,
10 10310 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 10311 <*V*> setposition(z_gar(nr),0,0);
10 10312 \f
10 10312 message procedure garage side 6c - 841213/cl;
10 10313
10 10313 pos:= 1;
10 10314 while pos <= antal do
10 10315 begin
11 10316 integer bogst,løb;
11 10317
11 10317 disable i:= læs_fil(fil_ref,pos,j);
11 10318 if i <> 0 then
11 10319 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 10320 else
11 10321 begin
12 10322 vogn:= fil(j,1) shift (-24) extract 24;
12 10323 løb:= fil(j,1) extract 24;
12 10324 if d.op_ref.opkode=9 then
12 10325 begin i:=vogn; vogn:=løb; løb:=i; end;
12 10326 ll:= løb shift (-12) extract 10;
12 10327 bogst:= løb shift (-7) extract 5;
12 10328 if bogst > 0 then bogst:= bogst +'A'-1;
12 10329 løb:= løb extract 7;
12 10330 vogn:= vogn extract 14;
12 10331 i:= d.op_ref.opkode-8;
12 10332 for i:= i,i+1 do
12 10333 begin
13 10334 j:= (i+1) extract 1;
13 10335 case j +1 of
13 10336 begin
14 10337 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 10338 false add bogst,1,"/",1,<<d__>,løb);
14 10339 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 10340 end;
13 10341 end;
12 10342 if pos mod 5 = 0 then
12 10343 begin
13 10344 write(z_gar(nr),"nl",1);
13 10345 <*V*> setposition(z_gar(nr),0,0);
13 10346 end
12 10347 else write(z_gar(nr),"sp",3);
12 10348 end;
11 10349 pos:=pos+1;
11 10350 end;
10 10351 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 10352 \f
10 10352 message procedure garage side 6d- 830310/cl;
10 10353
10 10353 d.opref.opkode:=104; <*slet-fil*>
10 10354 d.op_ref.data(4):=filref;
10 10355 indeks:=op_ref;
10 10356 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 10357 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 10358
10 10358 <*+2*> if testbit18 and overvåget then
10 10359 disable begin
11 10360 write(out,"nl",1,<:garage, slet-fil retur:>);
11 10361 skriv_op(out,op_ref);
11 10362 end;
10 10363 <*-2*>
10 10364
10 10364 <*+4*> if op_ref<>indeks then
10 10365 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10366 <*-4*>
10 10367 if d.op_ref.data(9)<>0 then
10 10368 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10369 <:garage, slet_fil:>,1);
10 10370 end;
9 10371 \f
9 10371 message procedure garage side 7 -810424/hko;
9 10372
9 10372 end;
8 10373
8 10373 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10374 <*-4*>
8 10375 end;<*case j *>
7 10376 end <* j > 0 *>
6 10377 else
6 10378 begin
7 10379 <*V*> setposition(z_gar(nr),0,0);
7 10380 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10381 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10382 4 <*kommando ukendt *>);
7 10383 end;
6 10384 end;<* godkendt *>
5 10385
5 10385 <*V*> setposition(z_gar(nr),0,0);
5 10386
5 10386 d.op_ref.opkode:=0; <*telex*>
5 10387
5 10387 disable afslut_operation(op_ref,cs_gar);
5 10388 end; <* indlæs kommando *>
4 10389
4 10389 begin
5 10390 \f
5 10390 message procedure garage side 8 - 841213/cl;
5 10391
5 10391 <* 2: inkluder *>
5 10392
5 10392 d.op_ref.resultat:=3;
5 10393 afslut_operation(op_ref,-1);
5 10394 monitor(8)reserve:(z_gar(nr),0,ia);
5 10395 terminal_tab.ref.terminal_tilstand:=
5 10396 terminal_tab.ref.terminal_tilstand extract 21;
5 10397 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10398 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10399 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10400 end;
4 10401
4 10401 begin
5 10402
5 10402 <* 3: ekskluder *>
5 10403 d.op_ref.resultat:= 3;
5 10404 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10405 terminal_tab.ref.terminal_tilstand extract 21;
5 10406 monitor(10)release:(z_gar(nr),0,ia);
5 10407 afslut_operation(op_ref,-1);
5 10408
5 10408 end;
4 10409
4 10409 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10410 <*-4*>
4 10411 end; <* case aktion+6 *>
3 10412
3 10412 until false;
3 10413 gar_trap:
3 10414 skriv_garage(zbillede,1);
3 10415 end garage;
2 10416
2 10416 \f
2 10416 message procedure radio_erklæringer side 1 - 820304/hko;
2 10417
2 10417 zone z_fr_in(14,1,rad_in_fejl),
2 10418 z_rf_in(14,1,rad_in_fejl),
2 10419 z_fr_out(14,1,rad_out_fejl),
2 10420 z_rf_out(14,1,rad_out_fejl);
2 10421
2 10421 integer array
2 10422 radiofejl,
2 10423 ss_samtale_nedlagt,
2 10424 ss_radio_aktiver(1:max_antal_kanaler),
2 10425 bs_talevej_udkoblet,
2 10426 cs_radio(1:max_antal_taleveje),
2 10427 radio_linietabel(1:max_linienr//3+1),
2 10428 radio_områdetabel(0:max_antal_områder),
2 10429 opkaldskø(opkaldskø_postlængde//2+1:
2 10430 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10431 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10432 hookoff_maske(1:(tv_maske_lgd//2)),
2 10433 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10434
2 10434 integer field
2 10435 kanal_tilstand,
2 10436 kanal_id1,
2 10437 kanal_id2,
2 10438 kanal_spec,
2 10439 kanal_alt_id1,
2 10440 kanal_alt_id2;
2 10441 integer array field
2 10442 kanal_mon_maske,
2 10443 kanal_alarm,
2 10444 opkald_meldt;
2 10445
2 10445 integer
2 10446 cs_rad,
2 10447 cs_radio_medd,
2 10448 cs_radio_adm,
2 10449 cs_radio_ind,
2 10450 cs_radio_ud,
2 10451 cs_radio_pulje,
2 10452 cs_radio_kø,
2 10453 bs_mobil_opkald,
2 10454 bs_opkaldskø_adgang,
2 10455 opkaldskø_ledige,
2 10456 nødopkald_brugt,
2 10457 første_frie_opkald,
2 10458 første_opkald,
2 10459 sidste_opkald,
2 10460 første_nødopkald,
2 10461 sidste_nødopkald,
2 10462 optaget_flag;
2 10463
2 10463 boolean
2 10464 mobil_opkald_aktiveret;
2 10465 \f
2 10465 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10466
2 10466 integer
2 10467 procedure læs_hex_ciffer(tabel,linie,op);
2 10468 value linie;
2 10469 integer array tabel;
2 10470 integer linie,op;
2 10471 begin
3 10472 integer i,j;
3 10473
3 10473 i:=(if linie>=0 then linie+6 else linie)//6;
3 10474 j:=((i-1)*6-linie)*4;
3 10475 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10476 end læs_hex_ciffer;
2 10477
2 10477 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10478
2 10478 integer
2 10479 procedure sæt_hex_ciffer(tabel,linie,op);
2 10480 value linie;
2 10481 integer array tabel;
2 10482 integer linie,op;
2 10483 begin
3 10484 integer i,j;
3 10485
3 10485 i:=(if linie>=0 then linie+6 else linie)//6;
3 10486 j:=(linie-(i-1)*6)*4;
3 10487 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10488 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10489 shift j add (tabel(i) extract j);
3 10490 end sæt_hex_ciffer;
2 10491
2 10491 message procedure hex_to_dec side 1 - 900108/cl;
2 10492
2 10492 integer procedure hex_to_dec(hex);
2 10493 value hex;
2 10494 integer hex;
2 10495 begin
3 10496 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10497 else (hex-'0');
3 10498 end;
2 10499
2 10499 message procedure dec_to_hex side 1 - 900108/cl;
2 10500
2 10500 integer procedure dec_to_hex(dec);
2 10501 value dec;
2 10502 integer dec;
2 10503 begin
3 10504 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10505 else ('A'+dec-10);
3 10506 end;
2 10507
2 10507 message procedure rad_out_fejl side 1 - 820304/hko;
2 10508
2 10508 procedure rad_out_fejl(z,s,b);
2 10509 value s;
2 10510 zone z;
2 10511 integer s,b;
2 10512 begin
3 10513 integer array field iaf;
3 10514 integer pos,tegn,max,i;
3 10515 integer array ia(1:20);
3 10516 long array field laf;
3 10517
3 10517 disable begin
4 10518 laf:= iaf:= 2;
4 10519 tegn:= 1;
4 10520 getzone6(z,ia);
4 10521 max:= ia(16)//2*3;
4 10522 if s = 1 shift 21 + 2 then
4 10523 begin
5 10524 z(1):= real<:<'em'>:>;
5 10525 b:= 2;
5 10526 end
4 10527 else
4 10528 begin
5 10529 pos:= 0;
5 10530 for i:= 1 step 1 until max_antal_kanaler do
5 10531 begin
6 10532 iaf:= (i-1)*kanalbeskr_længde;
6 10533 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10534 if pos>0 then
6 10535 begin
7 10536 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10537 signalbin(bs_mobilopkald);
7 10538 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10539 1 shift 12<*binært*> +1<*fortsæt*>);
7 10540 end;
6 10541 end;
5 10542 end;
4 10543 end;
3 10544 end;
2 10545 \f
2 10545 message procedure rad_in_fejl side 1 - 810601/hko;
2 10546
2 10546 procedure rad_in_fejl(z,s,b);
2 10547 value s;
2 10548 zone z;
2 10549 integer s,b;
2 10550 begin
3 10551 integer array field iaf;
3 10552 integer pos,tegn,max,i;
3 10553 integer array ia(1:20);
3 10554 long array field laf;
3 10555
3 10555 disable begin
4 10556 laf:= iaf:= 2;
4 10557 i:= 1;
4 10558 getzone6(z,ia);
4 10559 max:= ia(16)//2*3;
4 10560 if s shift (-21) extract 1 = 0
4 10561 and s shift(-19) extract 1 = 0 then
4 10562 begin
5 10563 if b = 0 then
5 10564 begin
6 10565 z(1):= real<:!:>;
6 10566 b:= 2;
6 10567 end;
5 10568 end;
4 10569 \f
4 10569 message procedure rad_in_fejl side 2 - 820304/hko;
4 10570
4 10570 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10571 begin
5 10572 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10573 1 shift 12<*binær*> +1<*fortsæt*>);
5 10574 end
4 10575 else
4 10576 if s shift (-19) extract 1 = 1 then
4 10577 begin
5 10578 z(1):= real<:!<'nl'>:>;
5 10579 b:= 2;
5 10580 end
4 10581 else
4 10582 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10583 begin
5 10584 <*
5 10585 if b = 0 then
5 10586 begin
5 10587 *>
5 10588 z(1):= real <:<'em'>:>;
5 10589 b:= 2;
5 10590 <*
5 10591 end
5 10592 else
5 10593 begin
5 10594 tegn:= -1;
5 10595 iaf:= 0;
5 10596 pos:= b//2*3-2;
5 10597 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10598 skriv_tegn(z.iaf,pos,'?');
5 10599 if pos<=max then
5 10600 afslut_text(z.iaf,pos);
5 10601 b:= (pos-1)//3*2;
5 10602 end;
5 10603 *>
5 10604 end;<* s=1 shift 21+2 *>
4 10605 end;
3 10606 if testbit22 and
3 10607 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10608 then
3 10609 delay(60);
3 10610 end rad_in_fejl;
2 10611 \f
2 10611 message procedure afvent_radioinput side 1 - 880901/cl;
2 10612
2 10612 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10613 value rf;
2 10614 zone z_in;
2 10615 integer array tlgr;
2 10616 boolean rf;
2 10617 begin
3 10618 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10619 long array field laf;
3 10620
3 10620 laf:= 0;
3 10621 pos:= 1;
3 10622 repeat
3 10623 i:=readchar(z_in,tegn);
3 10624 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10625 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10626 p:=pos;
3 10627 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10628 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10629 (rf and testbit39)) then
3 10630 disable begin
4 10631 write(zrl,<<zd dd dd.dd >,now,
4 10632 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10633 if tegn='em' then <:*timeout*:> else
4 10634 if pos>=80 then <:*for langt*:> else <::>);
4 10635 outchar(zrl,'nl');
4 10636 end;
3 10637 <*-2*>
3 10638 ac:= -1;
3 10639 if pos >= 80 then
3 10640 begin <* telegram for langt *>
4 10641 repeat readchar(z_in,tegn)
4 10642 until tegn='nl' or tegn='em';
4 10643 end
3 10644 else
3 10645 if pos>1 and tegn='nl' then
3 10646 begin
4 10647 lgd:= 1;
4 10648 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10649 lgd:= lgd-2;
4 10650 if lgd >= 5 then
4 10651 begin
5 10652 lgd:= lgd-2; <* se bort fra checksum *>
5 10653 i:= lgd + 1;
5 10654 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10655 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10656 i:= lgd + 1;
5 10657 skrivtegn(tlgr,i,0);
5 10658 skrivtegn(tlgr,i,0);
5 10659 i:= 1; sum:= 0;
5 10660 while i <= lgd do
5 10661 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10662 if csum >= 0 and csum <> sum then
5 10663 begin
6 10664 <*+2*> if overvåget and (testbit36 or
6 10665 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10666 disable begin
7 10667 write(zrl,<<zd dd dd.dd >,now,
7 10668 (if rf then <:rf:> else <:fr:>),
7 10669 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10670 end;
6 10671 <*-2*>
6 10672 ac:= 6 <* checksumfejl *>
6 10673 end
5 10674 else
5 10675 ac:= 0;
5 10676 end
4 10677 else ac:= 6; <* for kort telegram - retransmitter *>
4 10678 end;
3 10679 afvent_radioinput:= ac;
3 10680 end;
2 10681 \f
2 10681 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10682
2 10682 procedure skriv_kanal_tab(z);
2 10683 zone z;
2 10684 begin
3 10685 integer array field ref;
3 10686 integer i,j,t,op,id1,id2;
3 10687
3 10687 write(z,"ff",1,"nl",1,<:
3 10688 ******** kanal-beskrivelser *******
3 10689
3 10689 a k l p m b n
3 10690 l a y a o s ø
3 10691 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10692 <*
3 10693 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10694 *>
3 10695 "nl",1);
3 10696 for i:=1 step 1 until max_antal_kanaler do
3 10697 begin
4 10698 ref:=(i-1)*kanal_beskr_længde;
4 10699 t:=kanal_tab.ref.kanal_tilstand;
4 10700 id1:=kanal_tab.ref.kanal_id1;
4 10701 id2:=kanal_tab.ref.kanal_id2;
4 10702 write(z,"nl",1,"sp",4,
4 10703 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10704 for j:=11 step -1 until 2 do
4 10705 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10706 write(z,case t extract 2 +1 of
4 10707 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10708 "sp",1);
4 10709 skriv_id(z,id1,9);
4 10710 skriv_id(z,id2,9);
4 10711 t:=kanal_tab.ref.kanal_spec;
4 10712 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10713 write(z,"nl",1,"sp",14,<:mon: :>);
4 10714 for j:= max_antal_taleveje step -1 until 1 do
4 10715 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10716 else "."),1);
4 10717 write(z,"sp",25-max_antal_taleveje);
4 10718 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10719 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10720 end;
3 10721 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10722 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10723 write(z,"nl",2);
3 10724 end skriv_kanal_tab;
2 10725 \f
2 10725 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10726
2 10726 procedure skriv_opkaldskø(z);
2 10727 zone z;
2 10728 begin
3 10729 integer i,bogst,løb,j;
3 10730 integer array field ref;
3 10731 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10732 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10733 <: sig omr :>,"nl",1);
3 10734 for i:= 1 step 1 until max_antal_mobilopkald do
3 10735 begin
4 10736 ref:= i*opkaldskø_postlængde;
4 10737 j:= opkaldskø.ref(1);
4 10738 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10739 j:= opkaldskø.ref(2);
4 10740 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10741 skriv_id(z,j extract 23,9);
4 10742 j:= opkaldskø.ref(3);
4 10743 skriv_id(z,j,7);
4 10744 j:= opkaldskø.ref(4);
4 10745 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10746 << zd>,j extract 8);
4 10747 j:= j shift (-8) extract 4;
4 10748 if j = 1 or j = 2 then
4 10749 write(z,if j=1 then <: normal:> else <: nød :>)
4 10750 else write(z,<<dddd>,j,"sp",3);
4 10751 j:= opkaldskø.ref(5);
4 10752 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10753 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10754 string område_navn(j extract 8) else <:---:>);
4 10755 outchar(z,'nl');
4 10756 end;
3 10757
3 10757 write(z,"nl",1,<<z>,
3 10758 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10759 <:første_opkald=:>,første_opkald,"nl",1,
3 10760 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10761 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10762 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10763 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10764 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10765 "nl",1,<:opkaldsflag::>,"nl",1);
3 10766 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10767 write(z,"nl",2);
3 10768 end skriv_opkaldskø;
2 10769 \f
2 10769 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10770
2 10770 procedure skriv_radio_linie_tabel(z);
2 10771 zone z;
2 10772 begin
3 10773 integer i,j,k;
3 10774
3 10774 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10775 k:= 0;
3 10776 for i:= 1 step 1 until max_linienr do
3 10777 begin
4 10778 læstegn(radio_linietabel,i+1,j);
4 10779 if j > 0 then
4 10780 begin
5 10781 k:= k +1;
5 10782 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10783 "nl",if k mod 5=0 then 1 else 0);
5 10784 end;
4 10785 end;
3 10786 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10787 end skriv_radio_linietabel;
2 10788
2 10788 procedure skriv_radio_områdetabel(z);
2 10789 zone z;
2 10790 begin
3 10791 integer i;
3 10792
3 10792 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10793 for i:= 1 step 1 until max_antal_områder do
3 10794 begin
4 10795 laf:= (i-1)*4;
4 10796 if radio_områdetabel(i)<>0 then
4 10797 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10798 radio_områdetabel(i),"nl",1);
4 10799 end;
3 10800 end skriv_radio_områdetabel;
2 10801 \f
2 10801 message procedure h_radio side 1 - 810520/hko;
2 10802
2 10802 <* hovedmodulkorutine for radiokanaler *>
2 10803 procedure h_radio;
2 10804 begin
3 10805 integer array field op_ref;
3 10806 integer k,dest_sem;
3 10807 procedure skriv_hradio(z,omfang);
3 10808 value omfang;
3 10809 zone z;
3 10810 integer omfang;
3 10811 begin integer i;
4 10812 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10813 write(z,"sp",26-i);
4 10814 if omfang >0 then
4 10815 disable begin integer x;
5 10816 trap(slut);
5 10817 write(z,"nl",1,
5 10818 <: op_ref: :>,op_ref,"nl",1,
5 10819 <: k: :>,k,"nl",1,
5 10820 <: dest_sem: :>,dest_sem,"nl",1,
5 10821 <::>);
5 10822 skriv_coru(z,coru_no(400));
5 10823 slut:
5 10824 end;
4 10825 end skriv_hradio;
3 10826
3 10826 trap(hrad_trap);
3 10827 stack_claim(if cm_test then 198 else 146);
3 10828
3 10828 <*+2*> if testbit32 and overvåget or testbit28 then
3 10829 skriv_hradio(out,0);
3 10830 <*-2*>
3 10831 \f
3 10831 message procedure h_radio side 2 - 820304/hko;
3 10832
3 10832 repeat
3 10833 wait_ch(cs_rad,op_ref,true,-1);
3 10834 <*+2*>if testbit33 and overvåget then
3 10835 disable begin
4 10836 skriv_h_radio(out,0);
4 10837 write(out,<: operation modtaget:>);
4 10838 skriv_op(out,op_ref);
4 10839 end;
3 10840 <*-2*>
3 10841 <*+4*>
3 10842 if (d.op_ref.optype and
3 10843 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10844 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10845 <*-4*>
3 10846
3 10846 k:=d.op_ref.op_kode extract 12;
3 10847 dest_sem:=
3 10848 if k > 0 and k < 7
3 10849 or k=11 or k=12 or k=19
3 10850 or (72<=k and k<=74) or k = 77
3 10851 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10852 then cs_radio_adm
3 10853 else if k=41 <* radiokommando fra operatør *>
3 10854 then cs_radio(d.opref.data(1)) else -1;
3 10855 <*+4*>
3 10856 if dest_sem<1 then
3 10857 begin
4 10858 if dest_sem<0 then
4 10859 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10860 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10861 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10862 end
3 10863 else
3 10864 <*-4*>
3 10865 begin <* operationskode ok *>
4 10866 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10867 end;
3 10868 until false;
3 10869
3 10869 hrad_trap:
3 10870 disable skriv_hradio(zbillede,1);
3 10871 end h_radio;
2 10872 \f
2 10872 message procedure radio side 1 - 820301/hko;
2 10873
2 10873 procedure radio(talevej,op);
2 10874 value talevej,op;
2 10875 integer talevej,op;
2 10876 begin
3 10877 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10878 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10879 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10880 integer array felt,værdi(1:8);
3 10881 boolean byt,nød,frigiv_samtale;
3 10882 real kl;
3 10883 real field rf;
3 10884
3 10884 procedure skriv_radio(z,omfang);
3 10885 value omfang;
3 10886 zone z;
3 10887 integer omfang;
3 10888 begin integer i1;
4 10889 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10890 write(z,"sp",26-i1);
4 10891 if omfang > 0 then
4 10892 disable begin real x;
5 10893 trap(slut);
5 10894 \f
5 10894 message procedure radio side 1a- 820301/hko;
5 10895
5 10895 write(z,"nl",1,
5 10896 <: op_ref: :>,op_ref,"nl",1,
5 10897 <: opref1: :>,opref1,"nl",1,
5 10898 <: iaf: :>,iaf,"nl",1,
5 10899 <: iaf1: :>,iaf1,"nl",1,
5 10900 <: vt-op: :>,vt_op,"nl",1,
5 10901 <: rad-op: :>,rad_op,"nl",1,
5 10902 <: rf: :>,rf,"nl",1,
5 10903 <: nr: :>,nr,"nl",1,
5 10904 <: i: :>,i,"nl",1,
5 10905 <: j: :>,j,"nl",1,
5 10906 <: k: :>,k,"nl",1,
5 10907 <: operatør: :>,operatør,"nl",1,
5 10908 <: tilst: :>,tilst,"nl",1,
5 10909 <: res: :>,res,"nl",1,
5 10910 <: opgave: :>,opgave,"nl",1,
5 10911 <: type: :>,type,"nl",1,
5 10912 <: bus: :>,bus,"nl",1,
5 10913 <: ll: :>,ll,"nl",1,
5 10914 <: ttmm: :>,ttmm,"nl",1,
5 10915 <: vogn: :>,vogn,"nl",1,
5 10916 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10917 <: vtop2: :>,vtop2,"nl",1,
5 10918 <: vtop3: :>,vtop3,"nl",1,
5 10919 <: sig: :>,sig,"nl",1,
5 10920 <: omr: :>,omr,"nl",1,
5 10921 <: garage: :>,garage,"nl",1,
5 10922 <<-dddddd'-dd>,
5 10923 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10924 <:samtaleflag: :>,"nl",1);
5 10925 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10926 skriv_coru(z,coru_no(410+talevej));
5 10927 slut:
5 10928 end;<*disable*>
4 10929 end skriv_radio;
3 10930 \f
3 10930 message procedure udtag_opkald side 1 - 820301/hko;
3 10931
3 10931 integer
3 10932 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10933 value vogn, operatør;
3 10934 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10935 begin
4 10936 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10937 integer array field vt_op,ref,næste,forrige;
4 10938 integer array field iaf1;
4 10939 boolean skal_ud;
4 10940
4 10940 boolean procedure skal_udskrives(fordelt,aktuel);
4 10941 value fordelt,aktuel;
4 10942 integer fordelt,aktuel;
4 10943 begin
5 10944 boolean skal;
5 10945 integer n;
5 10946 integer array field iaf;
5 10947
5 10947 skal:= true;
5 10948 if fordelt > 0 and fordelt<>aktuel then
5 10949 begin
6 10950 for n:= 0 step 1 until 3 do
6 10951 begin
7 10952 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10953 begin
8 10954 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10955 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10956 goto returner;
8 10957 end;
7 10958 end;
6 10959 end;
5 10960 returner:
5 10961 skal_udskrives:= skal;
5 10962 end;
4 10963
4 10963 l:= b:= tm:= t:= 0;
4 10964 garage:= sig:= 0;
4 10965 res:= -1;
4 10966 <*V*> wait(bs_opkaldskø_adgang);
4 10967 ref:= første_nødopkald;
4 10968 if ref <> 0 then
4 10969 t:= 2
4 10970 else
4 10971 begin
5 10972 ref:= første_opkald;
5 10973 t:= if ref = 0 then 0 else 1;
5 10974 end;
4 10975 if t = 0 then res:= +19 <*kø er tom*> else
4 10976 if vogn=0 and omr=0 then
4 10977 begin
5 10978 while ref <> 0 and res = -1 do
5 10979 begin
6 10980 nr:= opkaldskø.ref(4) extract 8;
6 10981 if nr>64 then
6 10982 begin
7 10983 <*opk. primærfordelt til gruppe af btj.pl.*>
7 10984 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 10985 while skal_ud and i<max_antal_operatører do
7 10986 begin
8 10987 i:=i+1;
8 10988 if læsbit_ia(bpl_def.iaf1,i) then
8 10989 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 10990 end;
7 10991 end
6 10992 else
6 10993 skal_ud:= skal_udskrives(nr,operatør);
6 10994
6 10994 if skal_ud then
6 10995 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 10996 *>
6 10997 res:= 0
6 10998 else
6 10999 begin
7 11000 ref:= opkaldskø.ref(1) extract 12;
7 11001 if ref = 0 and t = 2 then
7 11002 begin
8 11003 ref:= første_opkald;
8 11004 t:= if ref = 0 then 0 else 1;
8 11005 end else if ref = 0 then t:= 0;
7 11006 end;
6 11007 end; <*while*>
5 11008 \f
5 11008 message procedure udtag_opkald side 2 - 820304/hko;
5 11009
5 11009 if ref <> 0 then
5 11010 begin
6 11011 b:= opkaldskø.ref(2);
6 11012 <*+4*> if b < 0 then
6 11013 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 11014 <:nødopkald(besvaret/ej meldt):>,1);
6 11015 <*-4*>
6 11016 garage:=b shift(-14) extract 8;
6 11017 b:= b extract 14;
6 11018 l:= opkaldskø.ref(3);
6 11019 tm:= opkaldskø.ref(4);
6 11020 o:= tm extract 8;
6 11021 tm:= tm shift(-12);
6 11022 omr:= opkaldskø.ref(5) extract 8;
6 11023 sig:= opkaldskø.ref(5) shift (-20);
6 11024 end
5 11025 else res:=19; <* kø er tom *>
5 11026 end <*vogn=0 and omr=0 *>
4 11027 else
4 11028 begin
5 11029 <* vogn<>0 or omr<>0 *>
5 11030 i:= 0; tilst:= -1;
5 11031 if vogn shift(-22) = 1 then
5 11032 begin
6 11033 i:= find_busnr(vogn,nr,garage,tilst);
6 11034 l:= vogn;
6 11035 end
5 11036 else
5 11037 if vogn<>0 and (omr=0 or omr>2) then
5 11038 begin
6 11039 o:= 0;
6 11040 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 11041 if i=(-2) then
6 11042 begin
7 11043 o:= omr;
7 11044 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 11045 end;
6 11046 nr:= vogn extract 14;
6 11047 end
5 11048 else nr:= vogn extract 14;
5 11049 if i<0 then ref:= 0;
5 11050 while ref <> 0 and res = -1 do
5 11051 begin
6 11052 i:= opkaldskø.ref(2) extract 14;
6 11053 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 11054 if nr = i and
6 11055 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 11056 else
6 11057 begin
7 11058 ref:= opkaldskø.ref(1) extract 12;
7 11059 if ref = 0 and t = 2 then
7 11060 begin
8 11061 ref:= første_opkald;
8 11062 t:= if ref = 0 then 0 else 1;
8 11063 end else if ref = 0 then t:= 0;
7 11064 end;
6 11065 end; <*while*>
5 11066 \f
5 11066 message procedure udtag_opkald side 3 - 810603/hko;
5 11067
5 11067 if ref <> 0 then
5 11068 begin
6 11069 b:= nr;
6 11070 tm:= opkaldskø.ref(4);
6 11071 o:= tm extract 8;
6 11072 tm:= tm shift(-12);
6 11073 omr:= opkaldskø.ref(5) extract 4;
6 11074 sig:= opkaldskø.ref(5) shift (-20);
6 11075
6 11075 <*+4*> if tilst <> -1 then
6 11076 fejlreaktion(3<*prg.fejl*>,tilst,
6 11077 <:vogntabel_tilstand for vogn i kø:>,1);
6 11078 <*-4*>
6 11079 end;
5 11080 end;
4 11081
4 11081 if ref <> 0 then
4 11082 begin
5 11083 næste:= opkaldskø.ref(1);
5 11084 forrige:= næste shift(-12);
5 11085 næste:= næste extract 12;
5 11086 if forrige <> 0 then
5 11087 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 11088 + næste
5 11089 else if t = 1 then første_opkald:= næste
5 11090 else <*if t = 2 then*> første_nødopkald:= næste;
5 11091
5 11091 if næste <> 0 then
5 11092 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 11093 + forrige shift 12
5 11094 else if t = 1 then sidste_opkald:= forrige
5 11095 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 11096
5 11096 opkaldskø.ref(1):=første_frie_opkald;
5 11097 første_frie_opkald:=ref;
5 11098
5 11098 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 11099 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 11100 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 11101 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 11102 else
5 11103 begin
6 11104 sætbit_ia(opkaldsflag,operatør,1);
6 11105 sætbit_ia(opkaldsflag,o,1);
6 11106 end;
5 11107 signal_bin(bs_mobil_opkald);
5 11108 end;
4 11109 \f
4 11109 message procedure udtag_opkald side 4 - 810531/hko;
4 11110
4 11110 signal_bin(bs_opkaldskø_adgang);
4 11111 bus:= b;
4 11112 type:= t;
4 11113 ll:= l;
4 11114 ttmm:= tm;
4 11115 udtag_opkald:= res;
4 11116 end udtag opkald;
3 11117 \f
3 11117 message procedure frigiv_kanal side 1 - 810603/hko;
3 11118
3 11118 procedure frigiv_kanal(nr);
3 11119 value nr;
3 11120 integer nr;
3 11121 begin
4 11122 integer id1, id2, omr, i;
4 11123 integer array field iaf, vt_op;
4 11124
4 11124 iaf:= (nr-1)*kanal_beskrlængde;
4 11125 id1:= kanal_tab.iaf.kanal_id1;
4 11126 id2:= kanal_tab.iaf.kanal_id2;
4 11127 omr:= kanal_til_omr(nr);
4 11128 if id1 <> 0 then
4 11129 wait(ss_samtale_nedlagt(nr));
4 11130 if id1 shift (-22) < 3 and omr > 2 then
4 11131 begin
5 11132 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11133 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11134 if id1 shift (-22) = 2 then 18 else 17);
5 11135 d.vt_op.data(1):= id1;
5 11136 d.vt_op.data(4):= omr;
5 11137 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11138 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11139 signalch(cs_vt_adgang,vt_op,true);
5 11140 end;
4 11141
4 11141 if id2 <> 0 and id2 shift(-20) <> 12 then
4 11142 wait(ss_samtale_nedlagt(nr));
4 11143 if id2 shift (-22) < 3 and omr > 2 then
4 11144 begin
5 11145 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11146 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11147 if id2 shift (-22) = 2 then 18 else 17);
5 11148 d.vt_op.data(1):= id2;
5 11149 d.vt_op.data(4):= omr;
5 11150 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11151 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11152 signalch(cs_vt_adgang,vt_op,true);
5 11153 end;
4 11154
4 11154 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 11155 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 11156 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 11157 shift (-10) extract 6 shift 10;
4 11158 <* repeat
4 11159 inspect(ss_samtale_nedlagt(nr),i);
4 11160 if i>0 then wait(ss_samtale_nedlagt(nr));
4 11161 until i<=0;
4 11162 *>
4 11163 end frigiv_kanal;
3 11164 \f
3 11164 message procedure hookoff side 1 - 880901/cl;
3 11165
3 11165 integer procedure hookoff(talevej,op,retursem,flash);
3 11166 value talevej,op,retursem,flash;
3 11167 integer talevej,op,retursem;
3 11168 boolean flash;
3 11169 begin
4 11170 integer array field opref;
4 11171
4 11171 opref:= op;
4 11172 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 11173 d.opref.data(1):= talevej;
4 11174 d.opref.data(2):= if flash then 2 else 1;
4 11175 signalch(cs_radio_ud,opref,rad_optype);
4 11176 <*V*> waitch(retursem,opref,rad_optype,-1);
4 11177 hookoff:= d.opref.resultat;
4 11178 end;
3 11179 \f
3 11179 message procedure hookon side 1 - 880901/cl;
3 11180
3 11180 integer procedure hookon(talevej,op,retursem);
3 11181 value talevej,op,retursem;
3 11182 integer talevej,op,retursem;
3 11183 begin
4 11184 integer i,res;
4 11185 integer array field opref;
4 11186
4 11186 if læsbit_ia(hookoff_maske,talevej) then
4 11187 begin
5 11188 inspect(bs_talevej_udkoblet(talevej),i);
5 11189 if i<=0 then
5 11190 begin
6 11191 opref:= op;
6 11192 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 11193 d.opref.data(1):= talevej;
6 11194 signalch(cs_radio_ud,opref,rad_optype);
6 11195 <*V*> waitch(retursem,opref,rad_optype,-1);
6 11196 res:= d.opref.resultat;
6 11197 end
5 11198 else
5 11199 res:= 0;
5 11200
5 11200 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 11201 end
4 11202 else
4 11203 res:= 0;
4 11204
4 11204 sætbit_ia(hookoff_maske,talevej,0);
4 11205 hookon:= res;
4 11206 end;
3 11207 \f
3 11207 message procedure radio side 2 - 820304/hko;
3 11208
3 11208 rad_op:= op;
3 11209
3 11209 trap(radio_trap);
3 11210 stack_claim((if cm_test then 200 else 150) +200);
3 11211
3 11211 <*+2*>if testbit32 and overvåget or testbit28 then
3 11212 skriv_radio(out,0);
3 11213 <*-2*>
3 11214 repeat
3 11215 waitch(cs_radio(talevej),opref,true,-1);
3 11216 <*+2*>
3 11217 if testbit33 and overvåget then
3 11218 disable begin
4 11219 skriv_radio(out,0);
4 11220 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 11221 skriv_op(out,opref);
4 11222 end;
3 11223 <*-2*>
3 11224
3 11224 k:= d.op_ref.opkode extract 12;
3 11225 opgave:= d.opref.opkode shift (-12);
3 11226 operatør:= d.op_ref.data(4);
3 11227
3 11227 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 11228 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 11229 <:radio:>,0);
3 11230 <*-4*>
3 11231 \f
3 11231 message procedure radio side 3 - 880930/cl;
3 11232 if k=41 <*radiokommando fra operatør*> then
3 11233 begin
4 11234 vogn:= d.opref.data(2);
4 11235 res:= -1;
4 11236 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 11237 sig:= 0; omr:= d.opref.data(3) extract 8;
4 11238 bus:= garage:= ll:= 0;
4 11239
4 11239 if opgave=1 or opgave=9 then
4 11240 begin <* opkald til enkelt vogn (CHF) *>
5 11241 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 11242 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 11243 <* ok at kø er tom når vogn er angivet eller VHF *>
5 11244
5 11244 d.opref.data(11):= if res=0 then
5 11245 (if ll<>0 then ll else bus) else vogn;
5 11246
5 11246 if type=2 <*nød*> then
5 11247 begin
6 11248 waitch(cs_radio_pulje,opref1,true,-1);
6 11249 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 11250 d.opref1.data(1):= if ll<>0 then ll else bus;
6 11251 systime(5,0,kl);
6 11252 d.opref1.data(2):= entier(kl/100.0);
6 11253 d.opref1.data(3):= omr;
6 11254 signalch(cs_io,opref1,gen_optype or rad_optype);
6 11255 end
5 11256 end; <* enkeltvogn (CHF) *>
4 11257
4 11257 <* check enkeltvogn for ledig *>
4 11258 if res<=0 and omr=2<*VHF*> and bus=0 and
4 11259 (opgave=1 or opgave=9) then
4 11260 begin
5 11261 for i:= 1 step 1 until max_antal_kanaler do
5 11262 if kanal_til_omr(i)=2 then nr:= i;
5 11263 iaf:= (nr-1)*kanalbeskrlængde;
5 11264 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 11265 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 11266 then res:= 52;
5 11267 end;
4 11268 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 11269 d.opref.data(3)=0 <*std. omr*>) and
4 11270 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 11271 then
4 11272 begin
5 11273 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 11274 if vogn shift (-22) = 1 then
5 11275 begin
6 11276 find_busnr(vogn,bus,garage,res);
6 11277 ll:= vogn;
6 11278 end
5 11279 else
5 11280 if vogn shift (-22) = 0 then
5 11281 begin
6 11282 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 11283 bus:= vogn;
6 11284 end
5 11285 else
5 11286 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 11287 res:= if res=(-1) then 18 <* i kø *> else
5 11288 (if res<>0 then 14 <*opt*> else 0);
5 11289 end
4 11290 else
4 11291 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 11292 opgave <= 2 then
4 11293 begin
5 11294 bus:= vogn; garage:= type:= ttmm:= 0;
5 11295 res:= 0; omr:= 0; sig:= 0;
5 11296 end
4 11297 else
4 11298 if opgave>1 and opgave<>9 then
4 11299 type:= ttmm:= res:= 0;
4 11300 \f
4 11300 message procedure radio side 4 - 880930/cl;
4 11301
4 11301 if res=0 and (opgave<=4 or opgave=9) and
4 11302 (omr<1 or 2<omr) and
4 11303 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 11304 begin <* reserver i vogntabel *>
5 11305 waitch(cs_vt_adgang,vt_op,true,-1);
5 11306 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11307 if opgave <=2 or opgave=9 then 15 else 16);
5 11308 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 11309 (if vogn=0 then garage shift 14 + bus else
5 11310 if ll<>0 then ll else garage shift 14 + bus)
5 11311 else vogn <*gruppeid*>;
5 11312 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 11313 d.opref.data(3) extract 8
5 11314 else omr extract 8;
5 11315 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 11316 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 11317
5 11317 res:= d.vt_op.resultat;
5 11318 if res=3 then res:= 0;
5 11319 vtop2:= d.vt_op.data(2);
5 11320 vtop3:= d.vt_op.data(3);
5 11321 tekn_inf:= d.vt_op.data(4);
5 11322 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 11323 end;
4 11324
4 11324 if res<>0 then
4 11325 begin
5 11326 d.opref.resultat:= res;
5 11327 signalch(d.opref.retur,opref,d.opref.optype);
5 11328 end
4 11329 else
4 11330
4 11330 if opgave <= 9 then
4 11331 begin <* opkald *>
5 11332 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 11333 opgave<>9 and d.opref.data(6)<>0);
5 11334
5 11334 if res<>0 then
5 11335 goto returner_op;
5 11336
5 11336 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 11337 begin
6 11338 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 11339 'H' shift 12 + 60);
6 11340 d.rad_op.data(1):= talevej;
6 11341 d.rad_op.data(2):= 'D';
6 11342 d.rad_op.data(3):= 6; <* rear *>
6 11343 d.rad_op.data(4):= 1; <* rear no *>
6 11344 d.rad_op.data(5):= 0; <* disconnect *>
6 11345 signalch(cs_radio_ud,rad_op,rad_optype);
6 11346 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 11347 if d.rad_op.resultat<>0 then
6 11348 begin
7 11349 res:= d.rad_op.resultat;
7 11350 goto returner_op;
7 11351 end;
6 11352 <*
6 11353 while optaget_flag shift (-1) <> 0 do
6 11354 delay(1);
6 11355 *>
6 11356 end;
5 11357 \f
5 11357 message procedure radio side 5 - 880930/cl;
5 11358
5 11358 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 11359 'B' shift 12 + 60);
5 11360 d.rad_op.data(1):= talevej;
5 11361 d.rad_op.data(2):= 'D';
5 11362 d.rad_op.data(3):= if opgave=9 then 3 else
5 11363 (2 - (opgave extract 1)); <* højttalerkode *>
5 11364
5 11364 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11365 begin
6 11366 j:= 0;
6 11367 for i:= 2 step 1 until max_antal_områder do
6 11368 begin
7 11369 if opgave > 6 or
7 11370 (d.opref.data(3) shift (-20) = 15 and
7 11371 læsbiti(d.opref.data(3),i)) or
7 11372 (d.opref.data(3) shift (-20) = 14 and
7 11373 d.opref.data(3) extract 20 = i)
7 11374 then
7 11375 begin
8 11376 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11377 begin
9 11378 j:= j+1;
9 11379 d.rad_op.data(10+(j-1)*2):=
9 11380 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11381 (if i=2<*VHF*> then 4 else k)
9 11382 shift 8 + <* signal type *>
9 11383 1; <* antal tno *>
9 11384 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11385 end;
8 11386 end;
7 11387 end;
6 11388 d.rad_op.data(4):= j;
6 11389 d.rad_op.data(5):= 0;
6 11390 end
5 11391 else
5 11392 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11393 begin
6 11394 d.rad_op.data(4):= vtop2;
6 11395 d.rad_op.data(5):= vtop3;
6 11396 end
5 11397 else
5 11398 begin <* enkeltvogn *>
6 11399 if omr=0 then
6 11400 begin
7 11401 sig:= tekn_inf shift (-23);
7 11402 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11403 else tekn_inf extract 8;
7 11404 end
6 11405 else
6 11406 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11407
6 11407 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11408 <* tvinges til alm. opkald *>
6 11409 if (opgave=9) and (type=2) and (omr<=3) then
6 11410 begin
7 11411 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11412 opgave:= 1;
7 11413 d.radop.data(3):= 1;
7 11414 end;
6 11415
6 11415 if omr=2 <*VHF*> then sig:= 4 else
6 11416 if omr=1 <*TLF*> then sig:= 7 else
6 11417 <*UHF*> sig:= sig+1;
6 11418 d.rad_op.data(4):= 1;
6 11419 d.rad_op.data(5):= 0;
6 11420 d.rad_op.data(10):=
6 11421 (område_id(omr,2) extract 12) shift 12 +
6 11422 sig shift 8 +
6 11423 1;
6 11424 d.rad_op.data(11):= bus;
6 11425 end;
5 11426 \f
5 11426 message procedure radio side 6 - 880930/cl;
5 11427
5 11427 signalch(cs_radio_ud,rad_op,rad_optype);
5 11428 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11429 res:= d.rad_op.resultat;
5 11430
5 11430 d.rad_op.data(6):= 0;
5 11431 for i:= 1 step 1 until max_antal_områder do
5 11432 if læsbiti(d.rad_op.data(7),i) then
5 11433 increase(d.rad_op.data(6));
5 11434 returner_op:
5 11435 if d.rad_op.data(6)=1 then
5 11436 begin
6 11437 for i:= 1 step 1 until max_antal_områder do
6 11438 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11439 d.opref.data(12):= 14 shift 20 + i;
6 11440 end
5 11441 else
5 11442 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11443 d.opref.data(7):= type;
5 11444 d.opref.data(8):= garage shift 14 + bus;
5 11445 d.opref.data(9):= ll;
5 11446 if res=0 then
5 11447 begin
6 11448 d.opref.resultat:= 3;
6 11449 d.opref.data(5):= d.opref.data(6);
6 11450 j:= 0;
6 11451 for i:= 1 step 1 until max_antal_kanaler do
6 11452 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11453 if j>1 then
6 11454 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11455 else
6 11456 begin
7 11457 j:= 0;
7 11458 for i:= 1 step 1 until max_antal_kanaler do
7 11459 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11460 d.opref.data(6):= 3 shift 22 + j;
7 11461 end;
6 11462 d.opref.data(7):= type;
6 11463 d.opref.data(8):= garage shift 14 + bus;
6 11464 d.opref.data(9):= ll;
6 11465 d.opref.data(10):= d.opref.data(6);
6 11466 for i:= 1 step 1 until max_antal_kanaler do
6 11467 begin
7 11468 if læsbiti(d.rad_op.data(9),i) then
7 11469 begin
8 11470 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11471 j:= pabx_id( kanal_id(i) extract 5 )
8 11472 else
8 11473 j:= radio_id( kanal_id(i) extract 5 );
8 11474 if j>0 and type=0 and operatør>0 then tæl_opkald(j,1);
8 11475
8 11475 iaf:= (i-1)*kanalbeskrlængde;
8 11476 skrivtegn(kanal_tab.iaf,1,talevej);
8 11477 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11478 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11479 kanal_tab.iaf.kanal_id1:=
8 11480 if opgave<=2 or opgave=9 then
8 11481 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11482 else
8 11483 d.opref.data(2);
8 11484 kanal_tab.iaf.kanal_alt_id1:=
8 11485 if opgave<=2 or opgave=9 then
8 11486 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11487 else
8 11488 0;
8 11489 if kanal_tab.iaf.kanal_id1=0 then
8 11490 kanal_tab.iaf.kanal_id1:= 10000;
8 11491 kanal_tab.iaf.kanal_spec:=
8 11492 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11493 end;
7 11494 end;
6 11495 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11496 sætbit_ia(kanalflag,operatør,1);
6 11497 \f
6 11497 message procedure radio side 7 - 880930/cl;
6 11498
6 11498 end
5 11499 else
5 11500 begin
6 11501 d.opref.resultat:= res;
6 11502 if res=20 or res=52 then
6 11503 begin <* tæl ej.forb og opt.kanal *>
7 11504 for i:= 1 step 1 until max_antal_områder do
7 11505 if læsbiti(d.rad_op.data(7),i) then
7 11506 tæl_opkald(i,(if res=20 then 4 else 5));
7 11507 end;
6 11508 if d.opref.data(6)=0 then
6 11509 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11510 <* frigiv fra vogntabel hvis reserveret *>
6 11511 if (opgave<=4 or opgave=9) and
6 11512 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11513 begin
7 11514 waitch(cs_vt_adgang,vt_op,true,-1);
7 11515 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11516 if opgave<=2 or opgave=9 then 17 else 18);
7 11517 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11518 (if vogn=0 then garage shift 14 + bus else
7 11519 if ll<>0 then ll else garage shift 14 + bus)
7 11520 else vogn;
7 11521 d.vt_op.data(4):= omr;
7 11522 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11523 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11524 signalch(cs_vt_adgang,vt_op,true);
7 11525 end;
6 11526 end;
5 11527 signalch(d.opref.retur,opref,d.opref.optype);
5 11528 \f
5 11528 message procedure radio side 8 - 880930/cl;
5 11529
5 11529 end <* opkald *>
4 11530 else
4 11531 if opgave = 10 <* MONITER *> then
4 11532 begin
5 11533 nr:= d.opref.data(2);
5 11534 if nr shift (-20) <> 12 then
5 11535 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11536 nr:= nr extract 20;
5 11537 iaf:= (nr-1)*kanalbeskrlængde;
5 11538 inspect(ss_samtale_nedlagt(nr),i);
5 11539 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11540 kanal_tab.iaf.kanal_id2 extract 20
5 11541 else
5 11542 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11543 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11544 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11545 (i<>0 or j<>0) then
5 11546 begin
6 11547 res:= 0;
6 11548 d.opref.data(5):= 12 shift 20 + k;
6 11549 d.opref.data(6):= 12 shift 20 + nr;
6 11550 sætbit_ia(kanalflag,operatør,1);
6 11551 goto radio_nedlæg;
6 11552 end
5 11553 else
5 11554 if i<>0 or j<>0 then
5 11555 res:= 49
5 11556 else
5 11557 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11558 res:= 49 <* ingen samtale igang *>
5 11559 else
5 11560 begin
6 11561 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11562 if res=0 then
6 11563 begin
7 11564 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11565 'B' shift 12 + 60);
7 11566 d.rad_op.data(1):= talevej;
7 11567 d.rad_op.data(2):= 'V';
7 11568 d.rad_op.data(3):= 0;
7 11569 d.rad_op.data(4):= 1;
7 11570 d.rad_op.data(5):= 0;
7 11571 d.rad_op.data(10):=
7 11572 (kanal_id(nr) shift (-5) shift 18) +
7 11573 (kanal_id(nr) extract 5 shift 12) + 0;
7 11574 signalch(cs_radio_ud,rad_op,rad_optype);
7 11575 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11576 res:= d.rad_op.resultat;
7 11577 if res=0 then
7 11578 begin
8 11579 d.opref.data(5):= 0;
8 11580 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11581 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11582 res:= 3;
8 11583 end;
7 11584 end;
6 11585 end;
5 11586 \f
5 11586 message procedure radio side 9 - 880930/cl;
5 11587 if res=3 then
5 11588 begin
6 11589 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11590 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11591 else
6 11592 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11593 d.opref.data(6):= 12 shift 20 + nr;
6 11594 i:= kanal_tab.iaf.kanal_id2;
6 11595 if i<>0 then
6 11596 begin
7 11597 if i shift (-20) = 12 then
7 11598 begin <* ident2 henviser til anden kanal *>
8 11599 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11600 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11601 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11602 else
8 11603 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11604 d.opref.data(5):= 12 shift 20 + i;
8 11605 end
7 11606 else
7 11607 d.opref.data(5):= 12 shift 20 + nr;
7 11608 end
6 11609 else
6 11610 d.opref.data(5):= 0;
6 11611 end;
5 11612
5 11612 if res<>3 then
5 11613 begin
6 11614 res:= 0;
6 11615 sætbit_ia(kanalflag,operatør,1);
6 11616 goto radio_nedlæg;
6 11617 end;
5 11618 d.opref.resultat:= res;
5 11619 signalch(d.opref.retur,opref,d.opref.optype);
5 11620 \f
5 11620 message procedure radio side 10 - 880930/cl;
5 11621
5 11621 end <* MONITERING *>
4 11622 else
4 11623 if opgave = 11 then <* GENNEMSTILLING *>
4 11624 begin
5 11625 nr:= d.opref.data(6) extract 20;
5 11626 k:= if d.opref.data(5) shift (-20) = 12 then
5 11627 d.opref.data(5) extract 20
5 11628 else
5 11629 0;
5 11630 inspect(ss_samtale_nedlagt(nr),i);
5 11631 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11632 if i<>0 and j<>0 then
5 11633 begin
6 11634 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11635 goto radio_nedlæg;
6 11636 end;
5 11637
5 11637 iaf:= (nr-1)*kanal_beskr_længde;
5 11638 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11639 begin
6 11640 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11641 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11642 then
6 11643 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11644 else
6 11645 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11646 d.opref.data(5)<>0
6 11647 then
6 11648 res:= 0
6 11649 else
6 11650 res:= 21; <* ingen at gennemstille til *>
6 11651 end
5 11652 else
5 11653 res:= 50; <* kanalnr *>
5 11654
5 11654 if res=0 then
5 11655 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11656 if res=0 then
5 11657 begin
6 11658 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11659 kanal_tab.iaf.kanal_tilstand:=
6 11660 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11661 d.opref.data(6):= 0;
6 11662 if kanal_tab.iaf.kanal_id2=0 then
6 11663 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11664
6 11664 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11665 begin <* gennemstillet til anden kanal *>
7 11666 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11667 *kanalbeskrlængde;
7 11668 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11669 kanal_tab.iaf1.kanal_tilstand:=
7 11670 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11671 if kanal_tab.iaf1.kanal_id2=0 then
7 11672 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11673 end;
6 11674 d.opref.data(5):= 0;
6 11675
6 11675 res:= 3;
6 11676 end;
5 11677
5 11677 d.opref.resultat:= res;
5 11678 signalch(d.opref.retur,opref,d.opref.optype);
5 11679 \f
5 11679 message procedure radio side 11 - 880930/cl;
5 11680
5 11680 end
4 11681 else
4 11682 if opgave = 12 then <* NEDLÆG *>
4 11683 begin
5 11684 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11685 radio_nedlæg:
5 11686 if res=0 then
5 11687 begin
6 11688 for k:= 5, 6 do
6 11689 begin
7 11690 if d.opref.data(k) shift (-20) = 12 then
7 11691 begin
8 11692 i:= d.opref.data(k) extract 20;
8 11693 iaf:= (i-1)*kanalbeskrlængde;
8 11694 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11695 frigiv_kanal(d.opref.data(k) extract 20)
8 11696 else
8 11697 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11698 end
7 11699 else
7 11700 if d.opref.data(k) shift (-20) = 13 then
7 11701 begin
8 11702 for i:= 1 step 1 until max_antal_kanaler do
8 11703 if læsbiti(d.opref.data(k),i) then
8 11704 begin
9 11705 iaf:= (i-1)*kanalbeskrlængde;
9 11706 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11707 frigiv_kanal(i)
9 11708 else
9 11709 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11710 end;
8 11711 sætbit_ia(kanalflag,operatør,1);
8 11712 end;
7 11713 end;
6 11714 d.opref.data(5):= 0;
6 11715 d.opref.data(6):= 0;
6 11716 d.opref.data(9):= 0;
6 11717 res:= if opgave=12 then 3 else 49;
6 11718 end;
5 11719 d.opref.resultat:= res;
5 11720 signalch(d.opref.retur,opref,d.opref.optype);
5 11721 end
4 11722 else
4 11723 if opgave=13 then <* R *>
4 11724 begin
5 11725 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11726 'H' shift 12 + 60);
5 11727 d.rad_op.data(1):= talevej;
5 11728 d.rad_op.data(2):= 'M';
5 11729 d.rad_op.data(3):= 0; <*tkt*>
5 11730 d.rad_op.data(4):= 0; <*tkn*>
5 11731 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11732 signalch(cs_radio_ud,rad_op,rad_optype);
5 11733 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11734 res:= d.rad_op.resultat;
5 11735 d.opref.resultat:= if res=0 then 3 else res;
5 11736 signalch(d.opref.retur,opref,d.opref.optype);
5 11737 end
4 11738 else
4 11739 if opgave=14 <* VENTEPOS *> then
4 11740 begin
5 11741 res:= 0;
5 11742 while (res<=3 and d.opref.data(2)>0) do
5 11743 begin
6 11744 nr:= d.opref.data(6) extract 20;
6 11745 k:= if d.opref.data(5) shift (-20) = 12 then
6 11746 d.opref.data(5) extract 20
6 11747 else
6 11748 0;
6 11749 inspect(ss_samtale_nedlagt(nr),i);
6 11750 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11751 if i<>0 or j<>0 then
6 11752 begin
7 11753 res:= hookon(talevej,radop,cs_radio(talevej));
7 11754 goto radio_nedlæg;
7 11755 end;
6 11756
6 11756 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11757
6 11757 if res=0 then
6 11758 begin
7 11759 i:= d.opref.data(5);
7 11760 d.opref.data(5):= d.opref.data(6);
7 11761 d.opref.data(6):= i;
7 11762 res:= 3;
7 11763 end;
6 11764
6 11764 d.opref.data(2):= d.opref.data(2)-1;
6 11765 end;
5 11766 d.opref.resultat:= res;
5 11767 signalch(d.opref.retur,opref,d.opref.optype);
5 11768 end
4 11769 else
4 11770 begin
5 11771 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11772 d.opref.resultat:= 31;
5 11773 signalch(d.opref.retur,opref,d.opref.optype);
5 11774 end;
4 11775
4 11775 end <* radiokommando fra operatør *>
3 11776 else
3 11777 begin
4 11778
4 11778 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11779
4 11779 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11780
4 11780 end;
3 11781
3 11781 until false;
3 11782 radio_trap:
3 11783 disable skriv_radio(zbillede,1);
3 11784 end radio;
2 11785 \f
2 11785 message procedure radio_ind side 1 - 810521/hko;
2 11786
2 11786 procedure radio_ind(op);
2 11787 value op;
2 11788 integer op;
2 11789 begin
3 11790 integer array field op_ref,ref,io_opref;
3 11791 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11792 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11793 integer array typ, val(1:6), answ, tlgr(1:32);
3 11794 integer array field spec;
3 11795 real field rf;
3 11796 long array field laf;
3 11797
3 11797 procedure skriv_radio_ind(zud,omfang);
3 11798 value omfang;
3 11799 zone zud;
3 11800 integer omfang;
3 11801 begin integer ii;
4 11802 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11803 if omfang > 0 then
4 11804 disable begin integer x; long array field tx;
5 11805 tx:= 0;
5 11806 trap(slut);
5 11807 write(zud,"nl",1,
5 11808 <: op-ref: :>,op_ref,"nl",1,
5 11809 <: ref: :>,ref,"nl",1,
5 11810 <: io-opref: :>,io_opref,"nl",1,
5 11811 <: ac: :>,ac,"nl",1,
5 11812 <: lgd: :>,lgd,"nl",1,
5 11813 <: ttyp: :>,ttyp,"nl",1,
5 11814 <: ptyp: :>,ptyp,"nl",1,
5 11815 <: pnum: :>,pnum,"nl",1,
5 11816 <: pos: :>,pos,"nl",1,
5 11817 <: tegn: :>,tegn,"nl",1,
5 11818 <: bs: :>,bs,"nl",1,
5 11819 <: b-pt: :>,b_pt,"nl",1,
5 11820 <: b-pn: :>,b_pn,"nl",1,
5 11821 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11822 <: antal-spec: :>,antal_spec,"nl",1,
5 11823 <: sum: :>,sum,"nl",1,
5 11824 <: csum: :>,csum,"nl",1,
5 11825 <: i: :>,i,"nl",1,
5 11826 <: j: :>,j,"nl",1,
5 11827 <: k: :>,k,"nl",1,
5 11828 <: filref :>,filref,"nl",1,
5 11829 <: zno: :>,zno,"nl",1,
5 11830 <: answ: :>,answ.tx,"nl",1,
5 11831 <: tlgr: :>,tlgr.tx,"nl",1,
5 11832 <: spec: :>,spec,"nl",1);
5 11833 trap(slut);
5 11834 slut:
5 11835 end; <*disable*>
4 11836 end skriv_radio_ind;
3 11837 \f
3 11837 message procedure indsæt_opkald side 1 - 811105/hko;
3 11838
3 11838 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11839 value bus,type,omr,sig;
3 11840 integer bus,type,omr,sig;
3 11841 begin
4 11842 integer res,tilst,ll,operatør;
4 11843 integer array field vt_op,ref,næste,forrige;
4 11844 real r;
4 11845
4 11845 res:= -1;
4 11846 begin
5 11847 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11848 if vt_op <> 0 then
5 11849 begin
6 11850 wait(bs_opkaldskø_adgang);
6 11851 if omr>2 then
6 11852 begin
7 11853 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11854 d.vt_op.data(1):= bus;
7 11855 d.vt_op.data(4):= omr;
7 11856 tilst:= vt_op;
7 11857 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11858 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11859 <*+4*> if tilst <> vt_op then
7 11860 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11861 <*-4*>
7 11862 <*+2*> if testbit34 and overvåget then
7 11863 disable begin
8 11864 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11865 skriv_op(out,vt_op);
8 11866 ud;
8 11867 end;
7 11868 end
6 11869 else
6 11870 begin
7 11871 d.vt_op.data(1):= bus;
7 11872 d.vt_op.data(2):= 0;
7 11873 d.vt_op.data(3):= bus;
7 11874 d.vt_op.data(4):= omr;
7 11875 d.vt_op.resultat:= 0;
7 11876 ref:= første_nødopkald;
7 11877 if ref<>0 then tilst:= 2
7 11878 else
7 11879 begin
8 11880 ref:= første_opkald;
8 11881 tilst:= if ref=0 then 0 else 1;
8 11882 end;
7 11883 if tilst=0 then
7 11884 d.vt_op.resultat:= 3
7 11885 else
7 11886 begin
8 11887 while ref<>0 and d.vt_op.resultat=0 do
8 11888 begin
9 11889 if opkaldskø.ref(2) extract 14 = bus and
9 11890 opkaldskø.ref(5) extract 8 = omr
9 11891 then
9 11892 d.vt_op.resultat:= 18
9 11893 else
9 11894 begin
10 11895 ref:= opkaldskø.ref(1) extract 12;
10 11896 if ref=0 and tilst=2 then
10 11897 begin
11 11898 ref:= første_opkald;
11 11899 tilst:= if ref=0 then 0 else 1;
11 11900 end
10 11901 else
10 11902 if ref=0 then tilst:= 0;
10 11903 end;
9 11904 end;
8 11905 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11906 end;
7 11907 end;
6 11908 <*-2*>
6 11909 \f
6 11909 message procedure indsæt_opkald side 1a- 820301/hko;
6 11910
6 11910 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11911 begin
7 11912 ref:=første_opkald;
7 11913 tilst:=-1;
7 11914 while ref<>0 and tilst=-1 do
7 11915 begin
8 11916 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11917 begin <* udtag normalopkald *>
9 11918 næste:=opkaldskø.ref(1);
9 11919 forrige:=næste shift(-12);
9 11920 næste:=næste extract 12;
9 11921 if forrige<>0 then
9 11922 opkaldskø.forrige(1):=
9 11923 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11924 else
9 11925 første_opkald:=næste;
9 11926 if næste<>0 then
9 11927 opkaldskø.næste(1):=
9 11928 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11929 else
9 11930 sidste_opkald:=forrige;
9 11931 opkaldskø.ref(1):=første_frie_opkald;
9 11932 første_frie_opkald:=ref;
9 11933 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11934 tilst:=0;
9 11935 end
8 11936 else
8 11937 ref:=opkaldskø.ref(1) extract 12;
8 11938 end; <*while*>
7 11939 if tilst=0 then
7 11940 d.vt_op.resultat:=3;
7 11941 end; <*nødopkald bus i kø*>
6 11942 \f
6 11942 message procedure indsæt_opkald side 2 - 820304/hko;
6 11943
6 11943 if d.vt_op.resultat = 3 then
6 11944 begin
7 11945 ll:= d.vt_op.data(2);
7 11946 tilst:= d.vt_op.data(3);
7 11947 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11948 if operatør < 0 or max_antal_operatører < operatør then
7 11949 operatør:= 0;
7 11950 if operatør=0 then
7 11951 operatør:= (tilst shift (-14) extract 8);
7 11952 if operatør=0 then
7 11953 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11954 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11955 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11956 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11957 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11958 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11959 forrige:= (if type = 1 then sidste_opkald
7 11960 else sidste_nødopkald);
7 11961 opkaldskø.ref(1):= forrige shift 12;
7 11962 if type = 1 then
7 11963 begin
8 11964 if første_opkald = 0 then første_opkald:= ref;
8 11965 sidste_opkald:= ref;
8 11966 end
7 11967 else
7 11968 begin <*type = 2*>
8 11969 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11970 sidste_nødopkald:= ref;
8 11971 end;
7 11972 if forrige <> 0 then
7 11973 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11974 shift 12 +ref;
7 11975
7 11975 opkaldskø.ref(2):= tilst extract 22 add
7 11976 (if type=2 then 1 shift 23 else 0);
7 11977 opkaldskø.ref(3):= ll;
7 11978 systime(5,0.0,r);
7 11979 ll:= round r//100;<*ttmm*>
7 11980 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 11981 opkaldskø.ref(5):= sig shift 20 + omr;
7 11982 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 11983 res:= 0;
7 11984 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 11985 opkaldskø_ledige:= opkaldskø_ledige -1;
7 11986 <*meddel opkald til berørte operatører *>
7 11987 signal_bin(bs_mobil_opkald);
7 11988 tæl_opkald(omr,type+1);
7 11989 end <* resultat = 3 *>
6 11990 else
6 11991 begin
7 11992 \f
7 11992 message procedure indsæt_opkald side 3 - 810601/hko;
7 11993
7 11993 <* d.vt_op.resultat <> 3 *>
7 11994
7 11994 res:= d.vt_op.resultat;
7 11995 if res = 10 then
7 11996 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 11997 <:er ikke i bustabel:>,1)
7 11998 else
7 11999 <*+4*> if res <> 14 and res <> 18 then
7 12000 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 12001 <*-4*>
7 12002 ;
7 12003 end;
6 12004 signalbin(bs_opkaldskø_adgang);
6 12005 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 12006 end
5 12007 else
5 12008 res:= -2; <*timeout for cs_vt_adgang*>
5 12009 end;
4 12010 indsæt_opkald:= res;
4 12011 end indsæt_opkald;
3 12012 \f
3 12012 message procedure afvent_telegram side 1 - 880901/cl;
3 12013
3 12013 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12014 integer array tlgr;
3 12015 integer lgd,ttyp,ptyp,pnum;
3 12016 begin
4 12017 integer i, pos, tegn, ac, sum, csum;
4 12018
4 12018 pos:= 1;
4 12019 lgd:= 0;
4 12020 ttyp:= 'Z';
4 12021 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 12022 if ac >= 0 then
4 12023 begin
5 12024 lgd:= 1;
5 12025 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 12026 lgd:= lgd-2;
5 12027 if lgd >= 3 then
5 12028 begin
6 12029 i:= 1;
6 12030 ttyp:= læstegn(tlgr,i,tegn);
6 12031 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 12032 pnum:= læstegn(tlgr,i,tegn) - '@';
6 12033 end
5 12034 else ac:= 6; <* for kort telegram - retransmitter *>
5 12035 end;
4 12036
4 12036 afvent_telegram:= ac;
4 12037 end;
3 12038 \f
3 12038 message procedure b_answ side 1 - 880901/cl;
3 12039
3 12039 procedure b_answ(answ,ht,spec,more,ac);
3 12040 value ht, more,ac;
3 12041 integer array answ, spec;
3 12042 boolean more;
3 12043 integer ht, ac;
3 12044 begin
4 12045 integer pos, i, sum, tegn;
4 12046
4 12046 pos:= 1;
4 12047 skrivtegn(answ,pos,'B');
4 12048 skrivtegn(answ,pos,if more then 'B' else ' ');
4 12049 skrivtegn(answ,pos,ac+'@');
4 12050 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 12051 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 12052 skrivtegn(answ,pos,'@');
4 12053 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 12054 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 12055 for i:= 1 step 1 until spec(1) extract 8 do
4 12056 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 12057 else
4 12058 begin
5 12059 skrivtegn(answ,pos,'D');
5 12060 anbringtal(answ,pos,spec(1+i),-4);
5 12061 end;
4 12062 for i:= 1 step 1 until 4 do
4 12063 skrivtegn(answ,pos,'@');
4 12064 skrivtegn(answ,pos,ht+'@');
4 12065 skrivtegn(answ,pos,'@');
4 12066
4 12066 i:= 1; sum:= 0;
4 12067 while i < pos do
4 12068 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 12069 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 12070 skrivtegn(answ,pos,sum extract 4 + '@');
4 12071 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 12072 end;
3 12073 \f
3 12073 message procedure ann_opkald side 1 - 881108/cl;
3 12074
3 12074 integer procedure ann_opkald(vogn,omr);
3 12075 value vogn,omr;
3 12076 integer vogn,omr;
3 12077 begin
4 12078 integer array field vt_op,ref,næste,forrige;
4 12079 integer res, t, i, o;
4 12080
4 12080 waitch(cs_vt_adgang,vt_op,true,-1);
4 12081 res:= -1;
4 12082 wait(bs_opkaldskø_adgang);
4 12083 ref:= første_nødopkald;
4 12084 if ref <> 0 then
4 12085 t:= 2
4 12086 else
4 12087 begin
5 12088 ref:= første_opkald;
5 12089 t:= if ref<>0 then 1 else 0;
5 12090 end;
4 12091
4 12091 if t=0 then
4 12092 res:= 19 <* kø tom *>
4 12093 else
4 12094 begin
5 12095 while ref<>0 and res=(-1) do
5 12096 begin
6 12097 if vogn=opkaldskø.ref(2) extract 14 and
6 12098 omr=opkaldskø.ref(5) extract 8
6 12099 then
6 12100 res:= 0
6 12101 else
6 12102 begin
7 12103 ref:= opkaldskø.ref(1) extract 12;
7 12104 if ref=0 and t=2 then
7 12105 begin
8 12106 ref:= første_opkald;
8 12107 t:= if ref=0 then 0 else 1;
8 12108 end;
7 12109 end;
6 12110 end; <*while*>
5 12111 \f
5 12111 message procedure ann_opkald side 2 - 881108/cl;
5 12112
5 12112 if ref<>0 then
5 12113 begin
6 12114 start_operation(vt_op,401,cs_radio_ind,17);
6 12115 d.vt_op.data(1):= vogn;
6 12116 d.vt_op.data(4):= omr;
6 12117 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 12118 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 12119
6 12119 o:= opkaldskø.ref(4) extract 8;
6 12120 næste:= opkaldskø.ref(1);
6 12121 forrige:= næste shift (-12);
6 12122 næste:= næste extract 12;
6 12123 if forrige<>0 then
6 12124 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 12125 + næste
6 12126 else
6 12127 if t=2 then første_nødopkald:= næste
6 12128 else første_opkald:= næste;
6 12129
6 12129 if næste<>0 then
6 12130 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 12131 + forrige shift 12
6 12132 else
6 12133 if t=2 then sidste_nødopkald:= forrige
6 12134 else sidste_opkald:= forrige;
6 12135
6 12135 opkaldskø.ref(1):= første_frie_opkald;
6 12136 første_frie_opkald:= ref;
6 12137 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 12138 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 12139
6 12139 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 12140 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 12141 else
6 12142 begin
7 12143 sætbit_ia(opkaldsflag,o,1);
7 12144 end;
6 12145 signalbin(bs_mobilopkald);
6 12146 end;
5 12147 end;
4 12148
4 12148 signalbin(bs_opkaldskø_adgang);
4 12149 signalch(cs_vt_adgang, vt_op, true);
4 12150 ann_opkald:= res;
4 12151 end;
3 12152 \f
3 12152 message procedure frigiv_id side 1 - 881114/cl;
3 12153
3 12153 integer procedure frigiv_id(id,omr);
3 12154 value id,omr;
3 12155 integer id,omr;
3 12156 begin
4 12157 integer array field vt_op;
4 12158
4 12158 if id shift (-22) < 3 and omr > 2 then
4 12159 begin
5 12160 waitch(cs_vt_adgang,vt_op,true,-1);
5 12161 start_operation(vt_op,401,cs_radio_ind,
5 12162 if id shift (-22) = 2 then 18 else 17);
5 12163 d.vt_op.data(1):= id;
5 12164 d.vt_op.data(4):= omr;
5 12165 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 12166 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 12167 frigiv_id:= d.vt_op.resultat;
5 12168 signalch(cs_vt_adgang,vt_op,true);
5 12169 end;
4 12170 end;
3 12171 \f
3 12171 message procedure radio_ind side 2 - 810524/hko;
3 12172 trap(radio_ind_trap);
3 12173 laf:= 0;
3 12174 stack_claim((if cm_test then 200 else 150) +135+75);
3 12175
3 12175 <*+2*>if testbit32 and overvåget or testbit28 then
3 12176 skriv_radio_ind(out,0);
3 12177 <*-2*>
3 12178 answ.laf(1):= long<:<'nl'>:>;
3 12179 io_opref:= op;
3 12180
3 12180 repeat
3 12181 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12182 pos:= 4;
3 12183 if ac = 0 then
3 12184 begin
4 12185 \f
4 12185 message procedure radio_ind side 3 - 881107/cl;
4 12186 if ttyp = 'A' then
4 12187 begin
5 12188 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12189 ac:= 1
5 12190 else
5 12191 begin
6 12192 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 12193 val(1):= ttyp;
6 12194 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 12195 val(2):= pnum;
6 12196 typ(3):= -1;
6 12197 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12198 if opref>0 then
6 12199 begin
7 12200 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 12201 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 12202 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 12203 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 12204 then
7 12205 begin
8 12206 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 12207 end
7 12208 else
7 12209 begin
8 12210 ac:= 0;
8 12211 d.opref.resultat:= 0;
8 12212 sætbit_ia(hookoff_maske,pnum,1);
8 12213 end;
7 12214 signalch(d.opref.retur,opref,d.opref.optype);
7 12215 end
6 12216 else
6 12217 ac:= 2;
6 12218 end;
5 12219 pos:= 1;
5 12220 skrivtegn(answ,pos,'A');
5 12221 skrivtegn(answ,pos,' ');
5 12222 skrivtegn(answ,pos,ac+'@');
5 12223 for i:= 1 step 1 until 5 do
5 12224 skrivtegn(answ,pos,'@');
5 12225 skrivtegn(answ,pos,'0');
5 12226 i:= 1; sum:= 0;
5 12227 while i < pos do
5 12228 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12229 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12230 skrivtegn(answ,pos,sum extract 4 + '@');
5 12231 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12232 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12233 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12234 disable begin
6 12235 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12236 outchar(zrl,'nl');
6 12237 end;
5 12238 <*-2*>
5 12239 disable setposition(z_fr_out,0,0);
5 12240 ac:= -1;
5 12241 \f
5 12241 message procedure radio_ind side 4 - 881107/cl;
5 12242 end <* ttyp=A *>
4 12243 else
4 12244 if ttyp = 'B' then
4 12245 begin
5 12246 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12247 ac:= 1
5 12248 else
5 12249 begin
6 12250 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 12251 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 12252 typ(3):= -1;
6 12253 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12254 if opref > 0 then
6 12255 begin
7 12256 <*+2*> if testbit37 and overvåget then
7 12257 disable begin
8 12258 skriv_radio_ind(out,0);
8 12259 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 12260 skriv_op(out,opref);
8 12261 end;
7 12262 <*-2*>
7 12263 læstegn(tlgr,pos,bs);
7 12264 if bs = 'V' then
7 12265 begin
8 12266 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 12267 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 12268 end;
7 12269 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 12270 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 12271 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 12272 then
7 12273 begin
8 12274 ac:= 1;
8 12275 d.opref.resultat:= 31; <* systemfejl *>
8 12276 signalch(d.opref.retur,opref,d.opref.optype);
8 12277 end
7 12278 else
7 12279 if bs='V' then
7 12280 begin
8 12281 ac:= 0;
8 12282 d.opref.resultat:= 1;
8 12283 d.opref.data(4):= 0;
8 12284 d.opref.data(7):=
8 12285 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 12286 radio_id(b_pn));
8 12287 systime(1,0.0,d.opref.tid);
8 12288 signalch(cs_radio_ind,opref,d.opref.optype);
8 12289 spec:= data+18;
8 12290 b_answ(answ,0,d.opref.spec,false,ac);
8 12291 <*+2*> if (testbit36 or testbit38) and overvåget then
8 12292 disable begin
9 12293 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 12294 outchar(zrl,'nl');
9 12295 end;
8 12296 <*-2*>
8 12297 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 12298 disable setposition(z_fr_out,0,0);
8 12299 ac:= -1;
8 12300 \f
8 12300 message procedure radio_ind side 5 - 881107/cl;
8 12301 end
7 12302 else
7 12303 begin
8 12304 integer sig_type;
8 12305
8 12305 ac:= 0;
8 12306 antal_spec:= d.opref.data(4);
8 12307 filref:= d.opref.data(5);
8 12308 spec:= d.opref.data(6);
8 12309 if antal_spec>0 then
8 12310 begin
9 12311 antal_spec:= antal_spec-1;
9 12312 if filref<>0 then
9 12313 begin
10 12314 læsfil(filref,1,zno);
10 12315 b_pt:= fil(zno).spec(1) shift (-12);
10 12316 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 12317 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 12318 antal_spec>0,ac);
10 12319 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 12320 end
9 12321 else
9 12322 begin
10 12323 b_pt:= d.opref.spec(1) shift (-12);
10 12324 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 12325 b_answ(answ,d.opref.data(3),d.opref.spec,
10 12326 antal_spec>0,ac);
10 12327 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 12328 end;
9 12329
9 12329 <* send answer *>
9 12330 <*+2*> if (testbit36 or testbit38) and overvåget then
9 12331 disable begin
10 12332 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 12333 outchar(zrl,'nl');
10 12334 end;
9 12335 <*-2*>
9 12336 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 12337 disable setposition(z_fr_out,0,0);
9 12338 if ac<>0 then
9 12339 begin
10 12340 antal_spec:= 0;
10 12341 ac:= -1;
10 12342 end
9 12343 else
9 12344 begin
10 12345 for i:= 1 step 1 until max_antal_områder do
10 12346 if område_id(i,2)=b_pt then
10 12347 begin
11 12348 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 12349 if sætbiti(d.opref.data(7),j,1)=0 then
11 12350 d.opref.resultat:= d.opref.resultat + 1;
11 12351 end;
10 12352 end;
9 12353 end;
8 12354 \f
8 12354 message procedure radio_ind side 6 - 881107/cl;
8 12355
8 12355 <* afvent nyt telegram *>
8 12356 d.opref.data(4):= antal_spec;
8 12357 d.opref.data(6):= spec;
8 12358 ac:= -1;
8 12359 systime(1,0.0,d.opref.tid);
8 12360 <*+2*> if testbit37 and overvåget then
8 12361 disable begin
9 12362 skriv_radio_ind(out,0);
9 12363 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 12364 ud;
9 12365 end;
8 12366 <*-2*>
8 12367 signalch(cs_radio_ind,opref,d.opref.optype);
8 12368 end;
7 12369 end
6 12370 else ac:= 2;
6 12371 end;
5 12372 if ac > 0 then
5 12373 begin
6 12374 for i:= 1 step 1 until 6 do val(i):= 0;
6 12375 b_answ(answ,0,val,false,ac);
6 12376 <*+2*>
6 12377 if (testbit36 or testbit38) and overvåget then
6 12378 disable begin
7 12379 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12380 outchar(zrl,'nl');
7 12381 end;
6 12382 <*-2*>
6 12383 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12384 disable setposition(z_fr_out,0,0);
6 12385 ac:= -1;
6 12386 end;
5 12387 \f
5 12387 message procedure radio_ind side 7 - 881107/cl;
5 12388 end <* ttyp = 'B' *>
4 12389 else
4 12390 if ttyp='C' or ttyp='J' then
4 12391 begin
5 12392 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12393 ac:= 1
5 12394 else
5 12395 begin
6 12396 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12397 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12398 typ(3):= -1;
6 12399 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12400 if opref > 0 then
6 12401 begin
7 12402 d.opref.resultat:= d.opref.resultat - 1;
7 12403 if ttyp = 'C' then
7 12404 begin
8 12405 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12406 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12407 j:= 0;
8 12408 for i:= 1 step 1 until max_antal_kanaler do
8 12409 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12410 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12411 d.opref.resultat:= d.opref.resultat-1;
8 12412 sætbiti(optaget_flag,j,1);
8 12413 sætbiti(d.opref.data(9),j,1);
8 12414 end
7 12415 else
7 12416 begin <* INGEN FORBINDELSE *>
8 12417 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12418 end;
7 12419 ac:= 0;
7 12420 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12421 begin
8 12422 systime(1,0,d.opref.tid);
8 12423 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12424 end
7 12425 else
7 12426 begin
8 12427 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12428 if læsbiti(d.opref.data(8),9) then 52 else
8 12429 if læsbiti(d.opref.data(8),10) then 20 else
8 12430 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12431 signalch(d.opref.retur, opref, d.opref.optype);
8 12432 end;
7 12433 end
6 12434 else
6 12435 ac:= 2;
6 12436 end;
5 12437 pos:= 1;
5 12438 skrivtegn(answ,pos,ttyp);
5 12439 skrivtegn(answ,pos,' ');
5 12440 skrivtegn(answ,pos,ac+'@');
5 12441 i:= 1; sum:= 0;
5 12442 while i < pos do
5 12443 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12444 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12445 skrivtegn(answ,pos,sum extract 4 + '@');
5 12446 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12447 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12448 disable begin
6 12449 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12450 outchar(zrl,'nl');
6 12451 end;
5 12452 <*-2*>
5 12453 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12454 disable setposition(z_fr_out,0,0);
5 12455 ac:= -1;
5 12456 \f
5 12456 message procedure radio_ind side 8 - 881107/cl;
5 12457 end <* ttyp = 'C' or 'J' *>
4 12458 else
4 12459 if ttyp = 'D' then
4 12460 begin
5 12461 if ptyp = 4 <* VDU *> then
5 12462 begin
6 12463 if pnum<1 or pnum>max_antal_taleveje then
6 12464 ac:= 1
6 12465 else
6 12466 begin
7 12467 inspect(bs_talevej_udkoblet(pnum),j);
7 12468 if j>=0 then
7 12469 begin
8 12470 sætbit_ia(samtaleflag,pnum,1);
8 12471 signal_bin(bs_mobil_opkald);
8 12472 end;
7 12473 if læsbit_ia(hookoff_maske,pnum) then
7 12474 signalbin(bs_talevej_udkoblet(pnum));
7 12475 ac:= 0;
7 12476 end
6 12477 end
5 12478 else
5 12479 if ptyp=3 or ptyp=2 then
5 12480 begin
6 12481 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12482 ptyp=2 and pnum<>2
6 12483 then
6 12484 ac:= 1
6 12485 else
6 12486 begin
7 12487 if læstegn(tlgr,5,tegn)='D' then
7 12488 begin <* teknisk nr i telegram *>
8 12489 b_pn:= 0;
8 12490 for i:= 1 step 1 until 4 do
8 12491 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12492 end
7 12493 else
7 12494 b_pn:= 0;
7 12495 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12496 i:= 0;
7 12497 for j:= 1 step 1 until max_antal_kanaler do
7 12498 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12499 if i<>0 then
7 12500 begin
8 12501 ref:= (i-1)*kanalbeskrlængde;
8 12502 inspect(ss_samtale_nedlagt(i),j);
8 12503 if j>=0 then
8 12504 begin
9 12505 sætbit_ia(samtaleflag,
9 12506 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12507 signalbin(bs_mobil_opkald);
9 12508 end;
8 12509 signal(ss_samtale_nedlagt(i));
8 12510 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12511 begin
9 12512 if kanal_tab.ref.kanal_id1<>0 and
9 12513 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12514 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12515 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12516 if kanal_tab.ref.kanal_id2<>0 and
9 12517 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12518 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12519 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12520 end;
8 12521 sætbiti(optaget_flag,i,0);
8 12522 end;
7 12523 ac:= 0;
7 12524 end;
6 12525 end
5 12526 else ac:= 1;
5 12527 if ac>=0 then
5 12528 begin
6 12529 pos:= i:= 1; sum:= 0;
6 12530 skrivtegn(answ,pos,'D');
6 12531 skrivtegn(answ,pos,' ');
6 12532 skrivtegn(answ,pos,ac+'@');
6 12533 skrivtegn(answ,pos,'@');
6 12534 while i<pos do
6 12535 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12536 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12537 skrivtegn(answ,pos, sum extract 4 + '@');
6 12538 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12539 <*+2*>
6 12540 if (testbit36 or testbit38) and overvåget then
6 12541 disable begin
7 12542 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12543 outchar(zrl,'nl');
7 12544 end;
6 12545 <*-2*>
6 12546 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12547 disable setposition(z_fr_out,0,0);
6 12548 ac:= -1;
6 12549 end;
5 12550 \f
5 12550 message procedure radio_ind side 9 - 881107/cl;
5 12551 end <* ttyp = D *>
4 12552 else
4 12553 if ttyp='H' then
4 12554 begin
5 12555 integer htyp;
5 12556
5 12556 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12557
5 12557 if htyp='A' then
5 12558 begin <*mobilopkald*>
6 12559 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12560 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12561 ac:= 1
6 12562 else
6 12563 begin
7 12564 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12565 if læstegn(tlgr,6,tegn)='D' then
7 12566 begin <*teknisk nr. i telegram*>
8 12567 b_pn:= 0;
8 12568 for i:= 1 step 1 until 4 do
8 12569 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12570 end
7 12571 else b_pn:= 0;
7 12572 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12573 <* opkaldstype *>
7 12574 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12575 if j>0 then
7 12576 begin
8 12577 if bs=10 then
8 12578 ann_opkald(b_pn,j)
8 12579 else
8 12580 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12581 ac:= 0;
8 12582 end else ac:= 1;
7 12583 end;
6 12584 \f
6 12584 message procedure radio_ind side 10 - 881107/cl;
6 12585 end
5 12586 else
5 12587 if htyp='E' then
5 12588 begin <* radiokanal status *>
6 12589 long onavn;
6 12590
6 12590 ac:= 0;
6 12591 j:= 0;
6 12592 for i:= 1 step 1 until max_antal_kanaler do
6 12593 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12594
6 12594 <* Alarmer for K12 = GLX ignoreres *>
6 12595 <* 94.06.14/CL *>
6 12596 <* Alarmer for K15 = HG ignoreres *>
6 12597 <* 95.07.31/CL *>
6 12598 <* Alarmer for K10 = FS ignoreres *>
6 12599 <* 96.05.27/CL *>
6 12600 if j>0 then
6 12601 begin
7 12602 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12603 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
7 12604 (onavn = long<:FS:>) then 0 else j);
7 12605 end;
6 12606
6 12606 læstegn(tlgr,9,tegn);
6 12607 if j<>0 and (tegn='A' or tegn='E') then
6 12608 begin
7 12609 ref:= (j-1)*kanalbeskrlængde;
7 12610 bs:= if tegn='E' then 0 else 15;
7 12611 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12612 begin
8 12613 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12614 signalbin(bs_mobil_opkald);
8 12615 end;
7 12616 end;
6 12617 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12618 begin
7 12619 waitch(cs_radio_pulje,opref,true,-1);
7 12620 startoperation(opref,401,cs_radio_pulje,23);
7 12621 i:= 1;
7 12622 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12623 if læstegn(tlgr,4,k)<>'@' then
7 12624 begin
8 12625 if k-'@' = 17 then
8 12626 hægtstring(d.opref.data,i,<: AMV:>)
8 12627 else
8 12628 if k-'@' = 18 then
8 12629 hægtstring(d.opref.data,i,<: BHV:>)
8 12630 else
8 12631 begin
9 12632 hægtstring(d.opref.data,i,<: BST:>);
9 12633 anbringtal(d.opref.data,i,k-'@',1);
9 12634 end;
8 12635 end;
7 12636 skrivtegn(d.opref.data,i,' ');
7 12637 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12638 skrivtegn(d.opref.data,i,' ');
7 12639 hægtstring(d.opref.data,i,
7 12640 string område_navn(kanal_til_omr(j)));
7 12641 if '@'<=tegn and tegn<='F' then
7 12642 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12643 <*@*> <:: ukendt fejl:>,
7 12644 <*A*> <:: compad-fejl:>,
7 12645 <*B*> <:: ladefejl:>,
7 12646 <*C*> <:: dør åben:>,
7 12647 <*D*> <:: senderfejl:>,
7 12648 <*E*> <:: compad ok:>,
7 12649 <*F*> <:: liniefejl:>,
7 12650 <::>))
7 12651 else
7 12652 begin
8 12653 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12654 skrivtegn(d.opref.data,i,tegn);
8 12655 end;
7 12656 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12657 signalch(cs_io,opref,gen_optype or rad_optype);
7 12658 ref:= (j-1)*kanalbeskrlængde;
7 12659 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12660 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12661 signalbin(bs_mobilopkald);
7 12662 end;
6 12663 \f
6 12663 message procedure radio_ind side 11 - 881107/cl;
6 12664 end
5 12665 else
5 12666 if htyp='G' then
5 12667 begin <* fjerninkludering/-ekskludering af område *>
6 12668 bs:= læstegn(tlgr,9,tegn)-'@';
6 12669 j:= 0;
6 12670 for i:= 1 step 1 until max_antal_kanaler do
6 12671 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12672 if j<>0 then
6 12673 begin
7 12674 ref:= (j-1)*kanalbeskrlængde;
7 12675 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12676 end;
6 12677 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12678 signalbin(bs_mobilopkald);
6 12679 ac:= 0;
6 12680 end
5 12681 else
5 12682 if htyp='L' then
5 12683 begin <* vogntabelændringer *>
6 12684 long field ll;
6 12685
6 12685 ll:= 10;
6 12686 ac:= 0;
6 12687 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12688 læstegn(tlgr,9,tegn);
6 12689 if (tegn='N') or (tegn='O') then
6 12690 begin
7 12691 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12692 typ(2):= -1;
7 12693 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12694 if opref>0 then
7 12695 begin
8 12696 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12697 signalch(d.opref.retur,opref,d.opref.optype);
8 12698 end;
7 12699 ac:= -1;
7 12700 end
6 12701 else
6 12702 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12703 ac:= -1
6 12704 else
6 12705 if tegn='G' then <*indkodning*>
6 12706 begin
7 12707 pos:= 10; i:= 0;
7 12708 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12709 i:= i*10 + (tegn-'0');
7 12710 i:= i mod 1000;
7 12711 b_pn:= (1 shift 22) + (i shift 12);
7 12712 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12713 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12714 pos:= 14; i:= 0;
7 12715 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12716 i:= i*10 + (tegn-'0');
7 12717 b_pn:= b_pn + i;
7 12718 pos:= 16; i:= 0;
7 12719 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12720 i:= i*10 + (tegn-'0');
7 12721 b_pt:= i;
7 12722 bs:= 11;
7 12723 \f
7 12723 message procedure radio_ind side 12 - 881107/cl;
7 12724 end
6 12725 else
6 12726 if tegn='H' then <*udkodning*>
6 12727 begin
7 12728 pos:= 10; i:= 0;
7 12729 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12730 i:= i*10 + (tegn-'0');
7 12731 b_pt:= i;
7 12732 b_pn:= 0;
7 12733 bs:= 12;
7 12734 end
6 12735 else
6 12736 if tegn='I' then <*slet tabel*>
6 12737 begin
7 12738 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12739 pos:= 10; i:= 0;
7 12740 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12741 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12742 zno:= i;
7 12743 end
6 12744 else ac:= 2;
6 12745 if ac<0 then
6 12746 ac:= 0
6 12747 else
6 12748
6 12748 if ac=0 then
6 12749 begin
7 12750 waitch(cs_vt_adgang,opref,true,-1);
7 12751 startoperation(opref,401,cs_vt_adgang,bs);
7 12752 d.opref.data(1):= b_pt;
7 12753 d.opref.data(2):= b_pn;
7 12754 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12755 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12756 end;
6 12757 end
5 12758 else
5 12759 ac:= 2;
5 12760
5 12760 pos:= 1;
5 12761 skrivtegn(answ,pos,'H');
5 12762 skrivtegn(answ,pos,' ');
5 12763 skrivtegn(answ,pos,ac+'@');
5 12764 i:= 1; sum:= 0;
5 12765 while i < pos do
5 12766 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12767 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12768 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12769 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12770 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12771 disable begin
6 12772 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12773 outchar(zrl,'nl');
6 12774 end;
5 12775 <*-2*>
5 12776 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12777 disable setposition(z_fr_out,0,0);
5 12778 ac:= -1;
5 12779 \f
5 12779 message procedure radio_ind side 13 - 881107/cl;
5 12780 end
4 12781 else
4 12782 if ttyp = 'I' then
4 12783 begin
5 12784 typ(1):= -1;
5 12785 repeat
5 12786 getch(cs_radio_ind,opref,true,typ,val);
5 12787 if opref<>0 then
5 12788 begin
6 12789 d.opref.resultat:= 31;
6 12790 signalch(d.opref.retur,opref,d.opref.op_type);
6 12791 end;
5 12792 until opref=0;
5 12793 for i:= 1 step 1 until max_antal_taleveje do
5 12794 if læsbit_ia(hookoff_maske,i) then
5 12795 begin
6 12796 signalbin(bs_talevej_udkoblet(i));
6 12797 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12798 end;
5 12799 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12800 signal_bin(bs_mobil_opkald);
5 12801 for i:= 1 step 1 until max_antal_kanaler do
5 12802 begin
6 12803 ref:= (i-1)*kanalbeskrlængde;
6 12804 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12805 begin
7 12806 if kanal_tab.ref.kanal_id2<>0 and
7 12807 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12808 then
7 12809 begin
8 12810 signal(ss_samtale_nedlagt(i));
8 12811 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12812 end;
7 12813 if kanal_tab.ref.kanal_id1<>0 then
7 12814 begin
8 12815 signal(ss_samtale_nedlagt(i));
8 12816 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12817 end;
7 12818 end;
6 12819 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12820 end;
5 12821 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12822 startoperation(opref,401,cs_radio_pulje,23);
5 12823 i:= 1;
5 12824 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12825 j:= 4;
5 12826 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12827 begin
6 12828 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12829 end;
5 12830 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12831 signalch(cs_io,opref,gen_optype or rad_optype);
5 12832 optaget_flag:= 0;
5 12833 pos:= i:= 1; sum:= 0;
5 12834 skrivtegn(answ,pos,'I');
5 12835 skrivtegn(answ,pos,' ');
5 12836 skrivtegn(answ,pos,'@');
5 12837 while i<pos do
5 12838 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12839 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12840 skrivtegn(answ,pos,sum extract 4 + '@');
5 12841 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12842 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12843 disable begin
6 12844 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12845 outchar(zrl,'nl');
6 12846 end;
5 12847 <*-2*>
5 12848 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12849 disable setposition(z_fr_out,0,0);
5 12850 ac:= -1;
5 12851 \f
5 12851 message procedure radio_ind side 14 - 881107/cl;
5 12852 end
4 12853 else
4 12854 if ttyp='L' then
4 12855 begin
5 12856 ac:= 0;
5 12857 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12858 if testbit21 then
5 12859 begin
6 12860 waitch(cs_radio_pulje,opref,true,-1);
6 12861 startoperation(opref,401,cs_radio_pulje,23);
6 12862 i:= 1;
6 12863 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12864 j:= 4;
6 12865 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12866 begin
7 12867 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12868 end;
6 12869 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12870 signalch(cs_io,opref,gen_optype or rad_optype);
6 12871 end; <*testbit21*>
5 12872 end
4 12873 else
4 12874 if ttyp='Z' then
4 12875 begin
5 12876 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12877 disable begin
6 12878 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12879 outchar(zrl,'nl');
6 12880 end;
5 12881 <*-2*>
5 12882 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12883 disable setposition(z_fr_out,0,0);
5 12884 ac:= -1;
5 12885 end
4 12886 else
4 12887 ac:= 1;
4 12888 end; <* telegram modtaget ok *>
3 12889 \f
3 12889 message procedure radio_ind side 15 - 881107/cl;
3 12890 if ac>=0 then
3 12891 begin
4 12892 pos:= i:= 1; sum:= 0;
4 12893 skrivtegn(answ,pos,ttyp);
4 12894 skrivtegn(answ,pos,' ');
4 12895 skrivtegn(answ,pos,ac+'@');
4 12896 while i<pos do
4 12897 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12898 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12899 skrivtegn(answ,pos, sum extract 4 + '@');
4 12900 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12901 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12902 disable begin
5 12903 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12904 outchar(zrl,'nl');
5 12905 end;
4 12906 <*-2*>
4 12907 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12908 disable setposition(z_fr_out,0,0);
4 12909 ac:= -1;
4 12910 end;
3 12911
3 12911 typ(1):= 0;
3 12912 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12913 rf:= 4;
3 12914 systime(1,0.0,val.rf);
3 12915 val.rf:= val.rf - 30.0;
3 12916 typ(3):= -1;
3 12917 repeat
3 12918 getch(cs_radio_ind,opref,true,typ,val);
3 12919 if opref>0 then
3 12920 begin
4 12921 d.opref.resultat:= 53; <*annuleret*>
4 12922 signalch(d.opref.retur,opref,d.opref.optype);
4 12923 end;
3 12924 until opref=0;
3 12925
3 12925 until false;
3 12926
3 12926 radio_ind_trap:
3 12927
3 12927 disable skriv_radio_ind(zbillede,1);
3 12928
3 12928 end radio_ind;
2 12929 \f
2 12929 message procedure radio_ud side 1 - 820301/hko;
2 12930
2 12930 procedure radio_ud(op);
2 12931 value op;
2 12932 integer op;
2 12933 begin
3 12934 integer array field opref,io_opref;
3 12935 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12936 integer array answ, tlgr(1:32);
3 12937 long array field laf;
3 12938
3 12938 procedure skriv_radio_ud(z,omfang);
3 12939 value omfang;
3 12940 zone z;
3 12941 integer omfang;
3 12942 begin integer i1;
4 12943 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12944 if omfang > 0 then
4 12945 disable begin real x; long array field tx;
5 12946 tx:= 0;
5 12947 trap(slut);
5 12948 write(z,"nl",1,
5 12949 <: opref: :>,opref,"nl",1,
5 12950 <: io-opref: :>,io_opref,"nl",1,
5 12951 <: opgave: :>,opgave,"nl",1,
5 12952 <: kode: :>,kode,"nl",1,
5 12953 <: pos: :>,pos,"nl",1,
5 12954 <: tegn: :>,tegn,"nl",1,
5 12955 <: i: :>,i,"nl",1,
5 12956 <: sum: :>,sum,"nl",1,
5 12957 <: rc: :>,rc,"nl",1,
5 12958 <: svar-status: :>,svar_status,"nl",1,
5 12959 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12960 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12961 <::>);
5 12962 skriv_coru(z,coru_no(402));
5 12963 slut:
5 12964 end; <*disable*>
4 12965 end skriv_radio_ud;
3 12966
3 12966 trap(radio_ud_trap);
3 12967 laf:= 0;
3 12968 stack_claim((if cm_test then 200 else 150) +35+100);
3 12969
3 12969 <*+2*>if testbit32 and overvåget or testbit28 then
3 12970 skriv_radio_ud(out,0);
3 12971 <*-2*>
3 12972
3 12972 io_opref:= op;
3 12973 \f
3 12973 message procedure radio_ud side 2 - 810529/hko;
3 12974
3 12974 repeat
3 12975
3 12975 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12976 kode:= d.op_ref.opkode;
3 12977 opgave:= kode shift(-12);
3 12978 kode:= kode extract 12;
3 12979 if opgave < 'A' or opgave > 'I' then
3 12980 begin
4 12981 d.opref.resultat:= 31;
4 12982 end
3 12983 else
3 12984 begin
4 12985 pos:= 1;
4 12986 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12987 begin
5 12988 skrivtegn(tlgr,pos,opgave);
5 12989 if d.opref.data(1) = 0 then
5 12990 begin
6 12991 skrivtegn(tlgr,pos,'G');
6 12992 skrivtegn(tlgr,pos,'A');
6 12993 end
5 12994 else
5 12995 begin
6 12996 skrivtegn(tlgr,pos,'D');
6 12997 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 12998 end;
5 12999 if opgave='A' then
5 13000 begin
6 13001 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 13002 end
5 13003 else
5 13004 if opgave='B' then
5 13005 begin
6 13006 skrivtegn(tlgr,pos,d.opref.data(2));
6 13007 if d.opref.data(2)='V' then
6 13008 begin
7 13009 skrivtegn(tlgr,pos,
7 13010 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 13011 skrivtegn(tlgr,pos,
7 13012 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 13013 end;
6 13014 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 13015 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 13016 end
5 13017 else
5 13018 if opgave='H' then
5 13019 begin
6 13020 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 13021 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 13022 hægtstring(tlgr,pos,<:@@@:>);
6 13023 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 13024 skrivtegn(tlgr,pos,'A');
6 13025 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 13026 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 13027 if d.opref.data(2)='L' then
6 13028 begin
7 13029 if d.opref.data(5)=7 then
7 13030 begin
8 13031 anbringtal(tlgr,pos,
8 13032 d.opref.data(8) shift (-12) extract 10,-4);
8 13033 anbringtal(tlgr,pos,
8 13034 d.opref.data(8) extract 7,-2);
8 13035 end
7 13036 else
7 13037 if d.opref.data(5)=8 then
7 13038 begin
8 13039 hægtstring(tlgr,pos,<:FFFFFF:>);
8 13040 end;
7 13041 if d.opref.data(5)<>9 then
7 13042 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 13043 skrivtegn(tlgr,pos,
7 13044 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 13045 skrivtegn(tlgr,pos,
7 13046 dec_to_hex(d.opref.data(6) extract 4));
7 13047 skrivtegn(tlgr,10,pos-11+'@');
7 13048 end;
6 13049 end;
5 13050 end
4 13051 else
4 13052 if opgave='I' then
4 13053 begin
5 13054 hægtstring(tlgr,pos,<:IGA:>);
5 13055 end
4 13056 else d.opref.resultat:= 31; <*systemfejl*>
4 13057 end;
3 13058 \f
3 13058 message procedure radio_ud side 3 - 881107/cl;
3 13059
3 13059 if d.opref.resultat=0 then
3 13060 begin
4 13061 if (opgave <= 'B')
4 13062 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 13063 begin
5 13064 systime(1,0,d.opref.tid);
5 13065 signalch(cs_radio_ind,opref,d.opref.optype);
5 13066 opref:= 0;
5 13067 end;
4 13068 <* beregn checksum og send *>
4 13069 i:= 1; sum:= 0;
4 13070 while i < pos do
4 13071 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 13072 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 13073 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 13074 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 13075 <**********************************************>
4 13076 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 13077
4 13077 if opgave='B' then delay(1);
4 13078
4 13078 <* 94.04.19/cl *>
4 13079 <**********************************************>
4 13080
4 13080 <*+2*> if (testbit36 or testbit39) and overvåget then
4 13081 disable begin
5 13082 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 13083 outchar(zrl,'nl');
5 13084 end;
4 13085 <*-2*>
4 13086 setposition(z_rf_in,0,0);
4 13087 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 13088 disable setposition(z_rf_out,0,0);
4 13089 rc:= 0;
4 13090
4 13090 <* afvent svar*>
4 13091 repeat
4 13092 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 13093 if svar_status=6 then
4 13094 begin
5 13095 svar_status:= -3;
5 13096 goto radio_ud_check;
5 13097 end;
4 13098 pos:= 1;
4 13099 while læstegn(answ,pos,i)<>0 do ;
4 13100 pos:= pos-2;
4 13101 if pos > 0 then
4 13102 begin
5 13103 if pos<3 then
5 13104 svar_status:= -2 <*format error*>
5 13105 else
5 13106 begin
6 13107 if læstegn(answ,3,tegn)<>'@' then
6 13108 svar_status:= tegn - '@'
6 13109 else
6 13110 begin
7 13111 pos:= 1;
7 13112 læstegn(answ,pos,tegn);
7 13113 if tegn<>opgave then
7 13114 svar_status:= -4 <*gal type*>
7 13115 else
7 13116 if læstegn(answ,pos,tegn)<>' ' then
7 13117 svar_status:= -tegn <*fejl*>
7 13118 else
7 13119 svar_status:= læstegn(answ,pos,tegn)-'@';
7 13120 end;
6 13121 end;
5 13122 end
4 13123 else
4 13124 svar_status:= -1;
4 13125 \f
4 13125 message procedure radio_ud side 5 - 881107/cl;
4 13126
4 13126 radio_ud_check:
4 13127 rc:= rc+1;
4 13128 if -3<=svar_status and svar_status< -1 then
4 13129 disable begin
5 13130 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 13131 setposition(z_rf_out,0,0);
5 13132 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13133 begin
6 13134 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 13135 outchar(zrl,'nl');
6 13136 end;
5 13137 <*-2*>
5 13138 end
4 13139 else
4 13140 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 13141 disable begin
5 13142 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 13143 setposition(z_rf_out,0,0);
5 13144 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13145 begin
6 13146 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 13147 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 13148 end;
5 13149 <*-2*>
5 13150 end
4 13151 else
4 13152 if svar_status=0 and opref<>0 then
4 13153 d.opref.resultat:= 0
4 13154 else
4 13155 if opref<>0 then
4 13156 d.opref.resultat:= 31;
4 13157 until svar_status=0 or rc>3;
4 13158 end;
3 13159 if opref<>0 then
3 13160 begin
4 13161 if svar_status<>0 and rc>3 then
4 13162 d.opref.resultat:= 53; <* annulleret *>
4 13163 signalch(d.opref.retur,opref,d.opref.optype);
4 13164 opref:= 0;
4 13165 end;
3 13166 until false;
3 13167
3 13167 radio_ud_trap:
3 13168
3 13168 disable skriv_radio_ud(zbillede,1);
3 13169
3 13169 end radio_ud;
2 13170 \f
2 13170 message procedure radio_medd_opkald side 1 - 810610/hko;
2 13171
2 13171 procedure radio_medd_opkald;
2 13172 begin
3 13173 integer array field ref,op_ref;
3 13174 integer i;
3 13175
3 13175 procedure skriv_radio_medd_opkald(z,omfang);
3 13176 value omfang;
3 13177 zone z;
3 13178 integer omfang;
3 13179 begin integer x;
4 13180 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 13181 write(z,"sp",26-x);
4 13182 if omfang > 0 then
4 13183 disable begin
5 13184 trap(slut);
5 13185 write(z,"nl",1,
5 13186 <: ref: :>,ref,"nl",1,
5 13187 <: opref: :>,op_ref,"nl",1,
5 13188 <: i: :>,i,"nl",1,
5 13189 <::>);
5 13190 skriv_coru(z,abs curr_coruno);
5 13191 slut:
5 13192 end;<*disable*>
4 13193 end skriv_radio_medd_opkald;
3 13194
3 13194 trap(radio_medd_opkald_trap);
3 13195
3 13195 stack_claim((if cm_test then 200 else 150) +1);
3 13196
3 13196 <*+2*>if testbit32 and overvåget or testbit28 then
3 13197 disable skriv_radio_medd_opkald(out,0);
3 13198 <*-2*>
3 13199 \f
3 13199 message procedure radio_medd_opkald side 2 - 820301/hko;
3 13200
3 13200 repeat
3 13201
3 13201 <*V*> wait(bs_mobil_opkald);
3 13202 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 13203 <*V*> wait(bs_opkaldskø_adgang);
3 13204
3 13204 ref:= første_nød_opkald;
3 13205 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 13206 begin
4 13207 i:= opkaldskø.ref(2);
4 13208 if i < 0 then
4 13209 begin
5 13210 <* nødopkald ikke meldt *>
5 13211
5 13211 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 13212 d.op_ref.data(1):= <* vogn_id *>
5 13213 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 13214 opkaldskø.ref(2):= i extract 22;
5 13215 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 13216 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 13217 i:= op_ref;
5 13218 <*+2*> if testbit35 and overvåget then
5 13219 disable begin
6 13220 write(out,"nl",1,<:radio nød-medd:>);
6 13221 skriv_op(out,op_ref);
6 13222 ud;
6 13223 end;
5 13224 <*-2*>
5 13225 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 13226 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 13227 <*+4*> if i <> op_ref then
5 13228 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 13229 <*-4*>
5 13230 end;<*nødopkald ikke meldt*>
4 13231
4 13231 ref:= opkaldskø.ref(1) extract 12;
4 13232 end; <* melding til io *>
3 13233 \f
3 13233 message procedure radio_medd_opkald side 3 - 820304/hko;
3 13234
3 13234 start_operation(op_ref,403,cs_radio_medd,
3 13235 40<*opdater opkaldskøbill*>);
3 13236 signal_bin(bs_opkaldskø_adgang);
3 13237 <*+2*> if testbit35 and overvåget then
3 13238 disable begin
4 13239 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 13240 skriv_op(out,op_ref);
4 13241 write(out, <:opkaldsflag: :>,"nl",1);
4 13242 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 13243 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 13244 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 13245 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 13246 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 13247 ud;
4 13248 end;
3 13249 <*-2*>
3 13250 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 13251
3 13251 until false;
3 13252
3 13252 radio_medd_opkald_trap:
3 13253
3 13253 disable skriv_radio_medd_opkald(zbillede,1);
3 13254
3 13254 end radio_medd_opkald;
2 13255 \f
2 13255 message procedure radio_adm side 1 - 820301/hko;
2 13256
2 13256 procedure radio_adm(op);
2 13257 value op;
2 13258 integer op;
2 13259 begin
3 13260 integer array field opref, rad_op, iaf;
3 13261 integer nr,i,j,k,res,opgave,tilst,operatør;
3 13262
3 13262 procedure skriv_radio_adm(z,omfang);
3 13263 value omfang;
3 13264 zone z;
3 13265 integer omfang;
3 13266 begin integer i1;
4 13267 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 13268 write(z,"sp",26-i1);
4 13269 if omfang > 0 then
4 13270 disable begin real x;
5 13271 trap(slut);
5 13272 \f
5 13272 message procedure radio_adm side 2- 820301/hko;
5 13273
5 13273 write(z,"nl",1,
5 13274 <: op_ref: :>,op_ref,"nl",1,
5 13275 <: iaf: :>,iaf,"nl",1,
5 13276 <: rad-op: :>,rad_op,"nl",1,
5 13277 <: nr: :>,nr,"nl",1,
5 13278 <: i: :>,i,"nl",1,
5 13279 <: j: :>,j,"nl",1,
5 13280 <: k: :>,k,"nl",1,
5 13281 <: tilst: :>,tilst,"nl",1,
5 13282 <: res: :>,res,"nl",1,
5 13283 <: opgave: :>,opgave,"nl",1,
5 13284 <: operatør: :>,operatør,"nl",1);
5 13285 skriv_coru(z,coru_no(404));
5 13286 slut:
5 13287 end;<*disable*>
4 13288 end skriv_radio_adm;
3 13289 \f
3 13289 message procedure radio_adm side 3 - 820304/hko;
3 13290
3 13290 rad_op:= op;
3 13291
3 13291 trap(radio_adm_trap);
3 13292 stack_claim((if cm_test then 200 else 150) +50);
3 13293
3 13293 <*+2*>if testbit32 and overvåget or testbit28 then
3 13294 skriv_radio_adm(out,0);
3 13295 <*-2*>
3 13296
3 13296 pass;
3 13297 if -,testbit22 then
3 13298 begin
4 13299 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13300 signalch(cs_radio_ud,rad_op,rad_optype);
4 13301 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13302 end;
3 13303 repeat
3 13304 waitch(cs_radio_adm,opref,true,-1);
3 13305 <*+2*>
3 13306 if testbit33 and overvåget then
3 13307 disable begin
4 13308 skriv_radio_adm(out,0);
4 13309 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 13310 skriv_op(out,opref);
4 13311 end;
3 13312 <*-2*>
3 13313
3 13313 k:= d.op_ref.opkode extract 12;
3 13314 opgave:= d.opref.opkode shift (-12);
3 13315 nr:=operatør:=d.op_ref.data(1);
3 13316
3 13316 <*+4*> if (d.op_ref.optype and
3 13317 (gen_optype or io_optype or op_optype or vt_optype))
3 13318 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 13319 <:radio_adm:>,0);
3 13320 <*-4*>
3 13321 if k = 74 <* RA,I *> then
3 13322 begin
4 13323 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13324 signalch(cs_radio_ud,rad_op,rad_optype);
4 13325 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13326 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 13327 else d.rad_op.resultat;
4 13328 signalch(d.opref.retur,opref,d.opref.optype);
4 13329 \f
4 13329 message procedure radio_adm side 4 - 820301/hko;
4 13330 end
3 13331 else
3 13332
3 13332 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 13333 k = 5<*FO,L*> or k = 6<*ST *> then
3 13334 begin
4 13335 if k = 5 or k=77 then
4 13336 begin
5 13337
5 13337 <*V*> wait(bs_opkaldskø_adgang);
5 13338 if k=5 then
5 13339 begin
6 13340 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 13341 begin
7 13342 i:= læs_fil(1035,iaf//512+1,nr);
7 13343 if i <> 0 then
7 13344 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 13345 tofrom(radio_linietabel.iaf,fil(nr),
7 13346 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 13347 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 13348 end;
6 13349
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(3) shift (-12) extract 10; <*linienr*>
7 13353 if nr>0 then
7 13354 begin
8 13355 læs_tegn(radio_linietabel,nr+1,operatør);
8 13356 if operatør>max_antal_operatører then operatør:= 0;
8 13357 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 13358 operatør;
8 13359 end;
7 13360 end;
6 13361 end
5 13362 else
5 13363 if k=77 then
5 13364 begin
6 13365 disable i:= læsfil(1034,1,nr);
6 13366 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 13367 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 13368 for i:= 1 step 1 until max_antal_mobilopkald do
6 13369 begin
7 13370 iaf:= i*opkaldskø_postlængde;
7 13371 nr:= opkaldskø.iaf(5) extract 4;
7 13372 operatør:= radio_områdetabel(nr);
7 13373 if operatør < 0 or max_antal_operatører < operatør then
7 13374 operatør:= 0;
7 13375 if opkaldskø.iaf(4) extract 8=0 and
7 13376 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13377 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13378 operatør;
7 13379 end;
6 13380 end;
5 13381
5 13381 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13382 signal_bin(bs_opkaldskø_adgang);
5 13383
5 13383 signal_bin(bs_mobil_opkald);
5 13384
5 13384 d.op_ref.resultat:= res:= 3;
5 13385 \f
5 13385 message procedure radio_adm side 5 - 820304/hko;
5 13386
5 13386 end <*k = 5 / k = 77*>
4 13387 else
4 13388 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13389 res:= 3;
5 13390 for nr:= 1 step 1 until max_antal_kanaler do
5 13391 begin
6 13392 iaf:= (nr-1)*kanal_beskr_længde;
6 13393 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13394 op_talevej(operatør) then
6 13395 begin
7 13396 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13397 if tilst <> 0 then
7 13398 res:= 16; <*skærm optaget*>
7 13399 end; <* kanal_tab(operatør) = operatør*>
6 13400 end;
5 13401 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13402 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13403 signal_bin(bs_mobil_opkald);
5 13404 d.op_ref.resultat:= res;
5 13405 end;<*k=1,2 eller 6 *>
4 13406
4 13406 <*+2*> if testbit35 and overvåget then
4 13407 disable begin
5 13408 skriv_radio_adm(out,0);
5 13409 write(out,<: sender til :>,
5 13410 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13411 else cs_op);
5 13412 skriv_op(out,op_ref);
5 13413 end;
4 13414 <*-2*>
4 13415
4 13415 if k=5 or k=6 or k=77 or res > 3 then
4 13416 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13417 else
4 13418 begin <*k = (1 eller 2) og res = 3 *>
5 13419 d.op_ref.resultat:=0;
5 13420 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13421 end;
4 13422 \f
4 13422 message procedure radio_adm side 6 - 816610/hko;
4 13423
4 13423 end <*k=1,2,5 eller 6*>
3 13424 else
3 13425 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13426 begin
4 13427 nr:= d.op_ref.data(1);
4 13428 res:= 3;
4 13429
4 13429 if nr<=3 then
4 13430 res:= 51 <* afvist *>
4 13431 else
4 13432 begin
5 13433
5 13433 <* gennemstilling af område *>
5 13434 j:= 1;
5 13435 for i:= 1 step 1 until max_antal_kanaler do
5 13436 begin
6 13437 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13438 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13439 end;
5 13440 nr:= j;
5 13441 iaf:= (nr-1)*kanalbeskrlængde;
5 13442 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13443 begin
6 13444 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13445 d.rad_op.data(1):= 0;
6 13446 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13447 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13448 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13449 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13450 signalch(cs_radio_ud,rad_op,rad_optype);
6 13451 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13452 res:= d.rad_op.resultat;
6 13453 if res=0 then res:= 3;
6 13454 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13455 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13456 end;
5 13457 end;
4 13458 d.op_ref.resultat:=res;
4 13459 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13460 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13461 signal_bin(bs_mobil_opkald);
4 13462 \f
4 13462 message procedure radio_adm side 7 - 880930/cl;
4 13463
4 13463
4 13463 end <* k=3 eller 4 *>
3 13464 else
3 13465 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13466 begin
4 13467 nr:= d.opref.data(1) extract 22;
4 13468 res:= 3;
4 13469 iaf:= (nr-1)*kanalbeskrlængde;
4 13470 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13471 d.rad_op.data(1):= 0;
4 13472 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13473 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13474 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13475 d.rad_op.data(5):= k extract 1;
4 13476 signalch(cs_radio_ud,radop,rad_optype);
4 13477 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13478 res:= d.radop.resultat;
4 13479 if res=0 then res:= 3;
4 13480 j:= if k=72 then 15 else 0;
4 13481 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13482 begin
5 13483 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13484 signalbin(bs_mobilopkald);
5 13485 end;
4 13486 d.opref.resultat:= res;
4 13487 signalch(d.opref.retur,opref,d.opref.optype);
4 13488 end
3 13489 else
3 13490 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13491 begin
4 13492 nr:= d.opref.data(1) extract 8;
4 13493 opgave:= if k=19 then 9 else (k-4);
4 13494 if nr<=3 then
4 13495 res:= 51 <*afvist*>
4 13496 else
4 13497 begin
5 13498 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13499 d.radop.data(1):= 0;
5 13500 d.radop.data(2):= 'L';
5 13501 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13502 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13503 d.radop.data(5):= opgave;
5 13504 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13505 d.radop.data(7):= d.opref.data(2);
5 13506 d.radop.data(8):= d.opref.data(3);
5 13507 signalch(cs_radio_ud,radop,rad_optype);
5 13508 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13509 res:= d.radop.resultat;
5 13510 if res=0 then res:= 3;
5 13511 end;
4 13512 d.opref.resultat:= res;
4 13513 signalch(d.opref.retur,opref,d.opref.optype);
4 13514 end
3 13515 else
3 13516
3 13516 begin
4 13517
4 13517 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13518
4 13518 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13519
4 13519 end;
3 13520
3 13520 until false;
3 13521 radio_adm_trap:
3 13522 disable skriv_radio_adm(zbillede,1);
3 13523 end radio_adm;
2 13524
2 13524 \f
2 13524 message vogntabel erklæringer side 1 - 820301/cl;
2 13525
2 13525 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13526 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13527 cs_vt_log;
2 13528 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13529 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13530 vt_log_slicelgd;
2 13531 integer array bustabel,bustabel1(0:max_antal_busser),
2 13532 linie_løb_tabel(0:max_antal_linie_løb),
2 13533 springtabel(1:max_antal_spring,1:3),
2 13534 gruppetabel(1:max_antal_grupper),
2 13535 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13536 vt_logop(1:2),
2 13537 vt_logdisc(1:4),
2 13538 vt_log_tail(1:10);
2 13539 boolean array busindeks(-1:max_antal_linie_løb),
2 13540 bustilstand(-1:max_antal_busser),
2 13541 linie_løb_indeks(-1:max_antal_busser);
2 13542 real array springtid,springstart(1:max_antal_spring);
2 13543 real vt_logstart;
2 13544 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13545 integer array field v_tekst;
2 13546 real field v_tid;
2 13547
2 13547 zone zvtlog(128,1,stderror);
2 13548
2 13548 \f
2 13548 message vogntabel erklæringer side 2 - 851001/cl;
2 13549
2 13549 procedure skriv_vt_variable(zud);
2 13550 zone zud;
2 13551 begin integer i; long array field laf;
3 13552 laf:= 0;
3 13553 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13554 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13555 <:cs-vt :>,cs_vt,"nl",1,
3 13556 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13557 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13558 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13559 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13560 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13561 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13562 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13563 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13564 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13565 <:vt-op :>,vt_op,"nl",1,
3 13566 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13567 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13568 <:sidste-bus :>,sidste_bus,"nl",1,
3 13569 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13570 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13571 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13572 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13573 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13574 <:tf-springdef :>,tf_springdef,"nl",1,
3 13575 <:vt-logskift :>,vt_logskift,"nl",1,
3 13576 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13577 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13578 <:vt-log-aktiv :>,
3 13579 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13580 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13581 <::>);
3 13582 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13583 laf:= 2;
3 13584 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13585 for i:= 6 step 1 until 10 do
3 13586 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13587 write(zud,"nl",1);
3 13588 end;
2 13589 \f
2 13589 message procedure p_vogntabel side 1 - 820301/cl;
2 13590
2 13590 procedure p_vogntabel(z);
2 13591 zone z;
2 13592 begin
3 13593 integer i,b,s,o,t,li,lb,lø,g;
3 13594 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13595 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13596 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13597 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13598
3 13598 for i:= 1 step 1 until sidste_bus do
3 13599 begin
4 13600 b:= bustabel(i) extract 14;
4 13601 g:= bustabel(i) shift (-14);
4 13602 s:= bustabel1(i) shift (-23);
4 13603 o:= bustabel1(i) extract 8;
4 13604 t:= intg(bustilstand(i));
4 13605 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13606 lø:= li extract 7;
4 13607 lb:= li shift (-7) extract 5;
4 13608 lb:= if lb=0 then 32 else lb+64;
4 13609 li:= li shift (-12) extract 10;
4 13610 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13611 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13612 if g > 0 then string bpl_navn(g) else <: :>,
4 13613 ";",1,true,4,string område_navn(o),
4 13614 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13615 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13616 end;
3 13617 end p_vogntabel;
2 13618 \f
2 13618 message procedure p_gruppetabel side 1 - 810531/cl;
2 13619
2 13619 procedure p_gruppetabel(z);
2 13620 zone z;
2 13621 begin
3 13622 integer i,nr,bogst;
3 13623 boolean spc_gr;
3 13624 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13625 <:max-antal-grupper =:>,max_antal_grupper,
3 13626 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13627 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13628 <:gruppetabel::>);
3 13629 for i:= 1 step 1 until max_antal_grupper do
3 13630 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13631 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13632 gruppetabel(i) extract 7);
3 13633 write(z,"nl",2,<:gruppeopkald::>);
3 13634 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13635 begin
4 13636 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13637 if gruppeopkald(i,1) = 0 then
4 13638 write(z,"sp",11)
4 13639 else
4 13640 begin
5 13641 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13642 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13643 else
5 13644 begin
6 13645 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13646 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13647 if bogst = '@' then bogst:= 'sp';
6 13648 end;
5 13649 if spc_gr then
5 13650 write(z,<:(G:>,<<d>,true,3,nr)
5 13651 else
5 13652 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13653 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13654 end;
4 13655 end;
3 13656 end p_gruppetabel;
2 13657 \f
2 13657 message procedure p_springtabel side 1 - 810519/cl;
2 13658
2 13658 procedure p_springtabel(z);
2 13659 zone z;
2 13660 begin
3 13661 integer li,bo,max,st,nr;
3 13662 long indeks;
3 13663 real t;
3 13664
3 13664 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13665 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13666 <:nr spring-id max status næste-tid:>,"nl",1);
3 13667 for nr:= 1 step 1 until max_antal_spring do
3 13668 begin
4 13669 write(z,<<dd>,nr);
4 13670 <* if springtabel(nr,1)<>0 then *>
4 13671 begin
5 13672 li:= springtabel(nr,1) shift (-5) extract 10;
5 13673 bo:= springtabel(nr,1) extract 5;
5 13674 if bo<>0 then bo:= bo + 'A' - 1;
5 13675 indeks:= extend springtabel(nr,2) shift 24;
5 13676 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13677 max:= springtabel(nr,3) extract 12;
5 13678 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13679 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13680 if springtid(nr)<>0.0 then
5 13681 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13682 else
5 13683 write(z,<< d.d >,0.0);
5 13684 if springstart(nr)<>0.0 then
5 13685 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13686 else
5 13687 write(z,<< d.d >,0.0);
5 13688 end
4 13689 <* else
4 13690 write(z,<: --------:>)*>;
4 13691 write(z,"nl",1);
4 13692 end;
3 13693 end p_springtabel;
2 13694 \f
2 13694 message procedure find_busnr side 1 - 820301/cl;
2 13695
2 13695 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13696 value ll_id;
2 13697 integer ll_id, busnr, garage, tilst;
2 13698 begin
3 13699 integer i,j;
3 13700
3 13700 j:= binærsøg(sidste_linie_løb,
3 13701 (linie_løb_tabel(i) - ll_id), i);
3 13702 if j<>0 then <* linie/løb findes ikke *>
3 13703 begin
4 13704 find_busnr:= -1;
4 13705 busnr:= 0;
4 13706 garage:= 0;
4 13707 tilst:= 0;
4 13708 end
3 13709 else
3 13710 begin
4 13711 busnr:= bustabel(busindeks(i) extract 12);
4 13712 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13713 garage:= busnr shift (-14);
4 13714 busnr:= busnr extract 14;
4 13715 find_busnr:= busindeks(i) extract 12;
4 13716 end;
3 13717 end find_busnr;
2 13718 \f
2 13718 message procedure søg_omr_bus side 1 - 881027/cl;
2 13719
2 13719
2 13719 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13720 value bus;
2 13721 integer bus,ll,gar,omr,sig,tilst;
2 13722 begin
3 13723 integer i,j,nr,bu,bi,bl;
3 13724
3 13724 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13725 nr:= -1;
3 13726 if j=0 then
3 13727 begin
4 13728 bl:= bu:= bi;
4 13729 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13730 while bu<sidste_bus and
4 13731 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13732
4 13732 if bl<>bu then
4 13733 begin
5 13734 <* flere busser med samme tekniske nr. omr skal passe *>
5 13735 nr:= -2;
5 13736 for bi:= bl step 1 until bu do
5 13737 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13738 end
4 13739 else
4 13740 nr:= bi;
4 13741 end;
3 13742
3 13742 if nr<0 then
3 13743 begin
4 13744 <* bus findes ikke *>
4 13745 ll:= gar:= tilst:= sig:= 0;
4 13746 end
3 13747 else
3 13748 begin
4 13749 tilst:= intg(bustilstand(nr));
4 13750 gar:= bustabel(nr) shift (-14);
4 13751 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13752 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13753 sig:= bustabel1(nr) shift (-23);
4 13754 end;
3 13755 søg_omr_bus:= nr;
3 13756 end;
2 13757 \f
2 13757 message procedure find_linie_løb side 1 - 820301/cl;
2 13758
2 13758 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13759 value busnr;
2 13760 integer busnr, linie_løb, garage, tilst;
2 13761 begin
3 13762 integer i,j;
3 13763
3 13763 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13764
3 13764 if j<>0 then <* bus findes ikke *>
3 13765 begin
4 13766 find_linie_løb:= -1;
4 13767 linie_løb:= 0;
4 13768 garage:= 0;
4 13769 tilst:= 0;
4 13770 end
3 13771 else
3 13772 begin
4 13773 tilst:= intg(bustilstand(i));
4 13774 garage:= bustabel(i) shift (-14);
4 13775 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13776 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13777 end;
3 13778 end find_linie_løb;
2 13779 \f
2 13779 message procedure h_vogntabel side 1 - 810413/cl;
2 13780
2 13780 <* hovedmodulcorutine for vogntabelmodul *>
2 13781
2 13781 procedure h_vogntabel;
2 13782 begin
3 13783 integer array field op;
3 13784 integer dest_sem,k;
3 13785
3 13785 procedure skriv_h_vogntabel(zud,omfang);
3 13786 value omfang;
3 13787 zone zud;
3 13788 integer omfang;
3 13789 begin
4 13790 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13791 if omfang<>0 then
4 13792 disable
4 13793 begin
5 13794 skriv_coru(zud,abs curr_coruno);
5 13795 write(zud,"nl",1,<<d>,
5 13796 <:cs-vt :>,cs_vt,"nl",1,
5 13797 <:op :>,op,"nl",1,
5 13798 <:dest-sem :>,dest_sem,"nl",1,
5 13799 <:k :>,k,"nl",1,
5 13800 <::>);
5 13801 end;
4 13802 end;
3 13803 \f
3 13803 message procedure h_vogntabel side 2 - 820301/cl;
3 13804
3 13804 stackclaim(if cm_test then 198 else 146);
3 13805 trap(h_vt_trap);
3 13806
3 13806 <*+2*>
3 13807 <**> disable if testbit47 and overvåget or testbit28 then
3 13808 <**> skriv_h_vogntabel(out,0);
3 13809 <*-2*>
3 13810
3 13810 repeat
3 13811 waitch(cs_vt,op,true,-1);
3 13812 <*+4*>
3 13813 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13814 (d.op.optype and vt_optype) extract 12 = 0 then
3 13815 fejlreaktion(12,op,<:vogntabel:>,0);
3 13816 <*-4*>
3 13817 disable
3 13818 begin
4 13819
4 13819 k:= d.op.opkode extract 12;
4 13820 dest_sem:=
4 13821 if k = 9 then cs_vt_rap else
4 13822 if k = 10 then cs_vt_rap else
4 13823 if k = 11 then cs_vt_opd else
4 13824 if k = 12 then cs_vt_opd else
4 13825 if k = 13 then cs_vt_opd else
4 13826 if k = 14 then cs_vt_tilst else
4 13827 if k = 15 then cs_vt_tilst else
4 13828 if k = 16 then cs_vt_tilst else
4 13829 if k = 17 then cs_vt_tilst else
4 13830 if k = 18 then cs_vt_tilst else
4 13831 if k = 19 then cs_vt_opd else
4 13832 if k = 20 then cs_vt_opd else
4 13833 if k = 21 then cs_vt_auto else
4 13834 if k = 24 then cs_vt_opd else
4 13835 if k = 25 then cs_vt_grp else
4 13836 if k = 26 then cs_vt_grp else
4 13837 if k = 27 then cs_vt_grp else
4 13838 if k = 28 then cs_vt_grp else
4 13839 if k = 30 then cs_vt_spring else
4 13840 if k = 31 then cs_vt_spring else
4 13841 if k = 32 then cs_vt_spring else
4 13842 if k = 33 then cs_vt_spring else
4 13843 if k = 34 then cs_vt_spring else
4 13844 if k = 35 then cs_vt_spring else
4 13845 -1;
4 13846 \f
4 13846 message procedure h_vogntabel side 3 - 810422/cl;
4 13847
4 13847 <*+2*>
4 13848 <**> if testbit41 and overvåget then
4 13849 <**> begin
5 13850 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13851 <**> skriv_op(out,op);
5 13852 <**> end;
4 13853 <*-2*>
4 13854 end;
3 13855
3 13855 if dest_sem = -1 then
3 13856 fejlreaktion(2,k,<:vogntabel:>,0);
3 13857 disable signalch(dest_sem,op,d.op.optype);
3 13858 until false;
3 13859 h_vt_trap:
3 13860 disable skriv_h_vogntabel(zbillede,1);
3 13861 end h_vogntabel;
2 13862 \f
2 13862 message procedure vt_opdater side 1 - 810317/cl;
2 13863
2 13863 procedure vt_opdater(op1);
2 13864 value op1;
2 13865 integer op1;
2 13866 begin
3 13867 integer array field op,radop;
3 13868 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13869 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13870 flin,slin,finx,sinx;
3 13871 integer field bn,ll;
3 13872
3 13872 procedure skriv_vt_opd(zud,omfang);
3 13873 value omfang; integer omfang;
3 13874 zone zud;
3 13875 begin
4 13876 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13877 if omfang <> 0 then
4 13878 disable
4 13879 begin
5 13880 skriv_coru(zud,abs curr_coruno);
5 13881 write(zud,"nl",1,
5 13882 <: op: :>,op,"nl",1,
5 13883 <: radop::>,radop,"nl",1,
5 13884 <: funk: :>,funk,"nl",1,
5 13885 <: res: :>,res,"nl",1,
5 13886 <::>);
5 13887 end;
4 13888 end skriv_vt_opd;
3 13889
3 13889 integer procedure opd_omr(fnk,omr,bus,ll);
3 13890 value fnk,omr,bus,ll;
3 13891 integer fnk,omr,bus,ll;
3 13892 begin
4 13893 opd_omr:= 3;
4 13894 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13895 ændringer skal ikke længere meldes til yderområder *>
4 13896 goto dummy_retur;
4 13897
4 13897 if omr extract 8 > 3 then
4 13898 begin
5 13899 startoperation(radop,501,cs_vt_opd,fnk);
5 13900 d.radop.data(1):= omr;
5 13901 d.radop.data(2):= bus;
5 13902 d.radop.data(3):= ll;
5 13903 signalch(cs_rad,radop,vt_optype);
5 13904 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13905 opd_omr:= d.radop.resultat;
5 13906 end
4 13907 else
4 13908 opd_omr:= 0;
4 13909 dummy_retur:
4 13910 end;
3 13911 message procedure vt_opdater side 1a - 920517/cl;
3 13912
3 13912 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13913 value kilde,kode,bus,ll1,ll2;
3 13914 integer kilde,kode,bus,ll1,ll2;
3 13915 begin
4 13916 integer array field op;
4 13917
4 13917 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13918
4 13918 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13919 systime(1,0.0,d.op.data.v_tid);
4 13920 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13921 d.op.data.v_bus:= bus;
4 13922 d.op.data.v_ll1:= ll1;
4 13923 d.op.data.v_ll2:= ll2;
4 13924 signalch(cs_vt_log,op,vt_optype);
4 13925 end;
3 13926
3 13926 stackclaim((if cm_test then 198 else 146)+125);
3 13927
3 13927 bn:= 4; ll:= 2;
3 13928 radop:= op1;
3 13929 trap(vt_opd_trap);
3 13930
3 13930 <*+2*>
3 13931 <**> disable if testbit47 and overvåget or testbit28 then
3 13932 <**> skriv_vt_opd(out,0);
3 13933 <*-2*>
3 13934 \f
3 13934 message procedure vt_opdater side 2 - 851001/cl;
3 13935
3 13935 vent_op:
3 13936 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13937
3 13937 <*+2*>
3 13938 <**> disable
3 13939 <**> if testbit41 and overvåget then
3 13940 <**> begin
4 13941 <**> skriv_vt_opd(out,0);
4 13942 <**> write(out,<: modtaget operation:>);
4 13943 <**> skriv_op(out,op);
4 13944 <**> end;
3 13945 <*-2*>
3 13946
3 13946 <*+4*>
3 13947 <**>if op<>vt_op then
3 13948 <**>begin
4 13949 <**> disable begin
5 13950 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13951 <**> d.op.resultat:= 31; <*systemfejl*>
5 13952 <**> signalch(d.op.retur,op,d.op.optype);
5 13953 <**> end;
4 13954 <**> goto vent_op;
4 13955 <**>end;
3 13956 <*-4*>
3 13957 disable
3 13958 begin integer opk;
4 13959
4 13959 opk:= d.op.opkode extract 12;
4 13960 funk:= if opk=11 then 1 else
4 13961 if opk=12 then 2 else
4 13962 if opk=13 then 3 else
4 13963 if opk=19 then 4 else
4 13964 if opk=20 then 5 else
4 13965 if opk=24 then 6 else
4 13966 0;
4 13967 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13968 end;
3 13969 res:= 0;
3 13970 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13971 \f
3 13971 message procedure vt_opdater side 3 - 820301/cl;
3 13972
3 13972 indsæt:
3 13973 begin
4 13974 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13975 <*+4*>
4 13976 <**> if d.op.data(1) shift (-22) <> 0 then
4 13977 <**> begin
5 13978 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13979 <**> goto slut_indsæt;
5 13980 <**> end;
4 13981 <*-4*>
4 13982 busnr:= d.op.data(1) extract 14;
4 13983 <*+4*>
4 13984 <**> if d.op.data(2) shift (-22) <> 1 then
4 13985 <**> begin
5 13986 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13987 <**> goto slut_indsæt;
5 13988 <**> end;
4 13989 <*-4*>
4 13990 ll_id:= d.op.data(2);
4 13991 s:= omr:= d.op.data(4) extract 8;
4 13992 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13993 if bi<0 then
4 13994 begin
5 13995 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13996 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13997 end
4 13998 else
4 13999 if s<>0 and s<>omr then
4 14000 res:= 58 <* ulovligt område for bus *>
4 14001 else
4 14002 if intg(bustilstand(bi)) <> 0 then
4 14003 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 14004 else 14 <* optaget *>)
4 14005 else
4 14006 begin
5 14007 if linie_løb_indeks(bi) extract 12 <> 0 then
5 14008 begin <* linie/løb allerede indsat *>
6 14009 res:= 11;
6 14010 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 14011 end
5 14012 else
5 14013 begin
6 14014 \f
6 14014 message procedure vt_opdater side 3a - 900108/cl;
6 14015
6 14015 if d.op.kilde//100 <> 4 then
6 14016 res:= opd_omr(11,gar shift 8 +
6 14017 bustabel1(bi) extract 8,busnr,ll_id);
6 14018 if res>3 then goto slut_indsæt;
6 14019 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 14020 if s=0 then <* linie/løb findes allerede *>
6 14021 begin
7 14022 sig:= busindeks(li) extract 12;
7 14023 d.op.data(3):= bustabel(sig);
7 14024 linie_løb_indeks(sig):= false;
7 14025 disable modiffil(tf_vogntabel,sig,zi);
7 14026 fil(zi).ll:= 0;
7 14027 fil(zi).bn:= bustabel(sig) extract 14 add
7 14028 (bustabel1(sig) extract 8 shift 14);
7 14029 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 14030
7 14030 linie_løb_indeks(bi):= false add li;
7 14031 busindeks(li):= false add bi;
7 14032 disable modiffil(tf_vogntabel,bi,zi);
7 14033 fil(zi).ll:= ll_id;
7 14034 fil(zi).bn:= bustabel(bi) extract 14 add
7 14035 (bustabel1(bi) extract 8 shift 14);
7 14036 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 14037 res:= 3;
7 14038 end
6 14039 else
6 14040 begin
7 14041 \f
7 14041 message procedure vt_opdater side 4 - 810527/cl;
7 14042
7 14042 if s<0 then li:= li +1;
7 14043 if sidste_linie_løb=max_antal_linie_løb then
7 14044 begin
8 14045 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 14046 res:= 31;
8 14047 end
7 14048 else
7 14049 begin
8 14050 for i:= sidste_linie_løb step -1 until li do
8 14051 begin
9 14052 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 14053 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 14054 bus_indeks(i+1):=bus_indeks(i);
9 14055 end;
8 14056 sidste_linie_løb:= sidste_linie_løb +1;
8 14057 linie_løb_tabel(li):= ll_id;
8 14058 linie_løb_indeks(bi):= false add li;
8 14059 busindeks(li):= false add bi;
8 14060 disable s:= modiffil(tf_vogntabel,bi,zi);
8 14061 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 14062 fil(zi).bn:= busnr extract 14 add
8 14063 (bustabel1(bi) extract 8 shift 14);
8 14064 fil(zi).ll:= ll_id;
8 14065 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 14066 res:= 3; <* ok *>
8 14067 end;
7 14068 end;
6 14069 end;
5 14070 end;
4 14071 slut_indsæt:
4 14072 d.op.resultat:= res;
4 14073 end;
3 14074 goto returner;
3 14075 \f
3 14075 message procedure vt_opdater side 5 - 820301/cl;
3 14076
3 14076 udtag:
3 14077 begin
4 14078 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 14079
4 14079 busnr:= ll_id:= 0;
4 14080 omr:= s:= d.op.data(2) extract 8;
4 14081 format:= d.op.data(1) shift (-22);
4 14082 if format=0 then <*busnr*>
4 14083 begin
5 14084 busnr:= d.op.data(1) extract 14;
5 14085 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 14086 if bi<0 then
5 14087 begin
6 14088 if bi=-1 then res:= 10 else
6 14089 if s<>0 then res:= 58 else res:= 57;
6 14090 goto slut_udtag;
6 14091 end;
5 14092 if bi>0 and s<>0 and s<>omr then
5 14093 begin
6 14094 res:= 58; goto slut_udtag;
6 14095 end;
5 14096 li:= linie_løb_indeks(bi) extract 12;
5 14097 busnr:= bustabel(bi);
5 14098 if li=0 or linie_løb_tabel(li)=0 then
5 14099 begin <* bus ej indsat *>
6 14100 res:= 13;
6 14101 goto slut_udtag;
6 14102 end;
5 14103 ll_id:= linie_løb_tabel(li);
5 14104 end
4 14105 else
4 14106 if format=1 then <* linie_løb *>
4 14107 begin
5 14108 ll_id:= d.op.data(1);
5 14109 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 14110 if s<>0 then
5 14111 begin <* linie/løb findes ikke *>
6 14112 res:= 9;
6 14113 goto slut_udtag;
6 14114 end;
5 14115 bi:= busindeks(li) extract 12;
5 14116 busnr:= bustabel(bi);
5 14117 end
4 14118 else <* ulovlig identifikation *>
4 14119 begin
5 14120 res:= 31;
5 14121 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 14122 goto slut_udtag;
5 14123 end;
4 14124 \f
4 14124 message procedure vt_opdater side 6 - 820301/cl;
4 14125
4 14125 tilst:= intg(bustilstand(bi));
4 14126 if tilst<>0 then
4 14127 begin
5 14128 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 14129 goto slut_udtag;
5 14130 end;
4 14131 if d.op.kilde//100 <> 4 then
4 14132 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 14133 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 14134 if res>3 then goto slut_udtag;
4 14135 linie_løb_indeks(bi):= false;
4 14136 for i:= li step 1 until sidste_linie_løb -1 do
4 14137 begin
5 14138 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 14139 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 14140 bus_indeks(i):= bus_indeks(i+1);
5 14141 end;
4 14142 linie_løb_tabel(sidste_linie_løb):= 0;
4 14143 bus_indeks(sidste_linie_løb):= false;
4 14144 sidste_linie_løb:= sidste_linie_løb -1;
4 14145 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 14146 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 14147 fil(zi).ll:= 0;
4 14148 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 14149 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 14150 res:= 3; <* ok *>
4 14151 slut_udtag:
4 14152 d.op.resultat:= res;
4 14153 d.op.data(2):= ll_id;
4 14154 d.op.data(3):= busnr;
4 14155 end;
3 14156 goto returner;
3 14157 \f
3 14157 message procedure vt_opdater side 7 - 851001/cl;
3 14158
3 14158 omkod:
3 14159 flyt:
3 14160 roker:
3 14161 begin
4 14162 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 14163
4 14163 inf1:= inf2:= 0;
4 14164 ll_id1:= d.op.data(1);
4 14165 ll_id2:= d.op.data(2);
4 14166 if ll_id1=ll_id2 then
4 14167 begin
5 14168 res:= 24; inf1:= ll_id2;
5 14169 goto slut_flyt;
5 14170 end;
4 14171 <*+4*>
4 14172 <**> for i:= 1,2 do
4 14173 <**> if d.op.data(i) shift (-22) <> 1 then
4 14174 <**> begin
5 14175 <**> res:= 31;
5 14176 <**> fejlreaktion(10,d.op.data(i),case i of (
5 14177 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 14178 <**> goto slut_flyt;
5 14179 <**> end;
4 14180 <*-4*>
4 14181
4 14181 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 14182 if s<>0 and funk=6 <* roker *> then
4 14183 begin
5 14184 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 14185 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 14186 end;
4 14187 if s<>0 then
4 14188 begin
5 14189 res:= 9; <* ukendt linie/løb *>
5 14190 goto slut_flyt;
5 14191 end;
4 14192 bi1:= busindeks(li1) extract 12;
4 14193 inf1:= bustabel(bi1);
4 14194 tilst:= intg(bustilstand(bi1));
4 14195 if tilst<>0 then <* bus ikke fri *>
4 14196 begin
5 14197 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 14198 goto slut_flyt;
5 14199 end;
4 14200 \f
4 14200 message procedure vt_opdater side 7a- 851001/cl;
4 14201 if d.op.kilde//100 <> 4 then
4 14202
4 14202 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 14203 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 14204 if res>3 then goto slut_flyt;
4 14205
4 14205 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 14206 if s=0 then
4 14207 begin <* ll_id2 er indkodet *>
5 14208 bi2:= busindeks(li2) extract 12;
5 14209 inf2:= bustabel(bi2);
5 14210 tilst:= intg(bustilstand(bi2));
5 14211 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 14212 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 14213 if res>3 then
5 14214 begin
6 14215 inf1:= inf2; inf2:= 0;
6 14216 goto slut_flyt;
6 14217 end;
5 14218
5 14218 if d.op.kilde//100 <> 4 then
5 14219 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 14220 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 14221 if res>3 then goto slut_flyt;
5 14222
5 14222 <* flyt bus *>
5 14223 if funk=6 then
5 14224 linie_løb_indeks(bi2):= false add li1
5 14225 else
5 14226 linie_løb_indeks(bi2):= false;
5 14227 linie_løb_indeks(bi1):= false add li2;
5 14228 if funk=6 then
5 14229 busindeks(li1):= false add bi2
5 14230 else
5 14231 busindeks(li1):= false;
5 14232 busindeks(li2):= false add bi1;
5 14233
5 14233 if funk<>6 then
5 14234 begin
6 14235 <* fjern ll_id1 *>
6 14236 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 14237 begin
7 14238 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 14239 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 14240 busindeks(i):= busindeks(i+1);
7 14241 end;
6 14242 linie_løb_tabel(sidste_linie_løb):= 0;
6 14243 bus_indeks(sidste_linie_løb):= false;
6 14244 sidste_linie_løb:= sidste_linie_løb-1;
6 14245 end;
5 14246
5 14246 <* opdater vogntabelfil *>
5 14247 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 14248 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14249 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 14250 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 14251 if funk=6 then
5 14252 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 14253 else
5 14254 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 14255 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14256 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14257 fil(zi).ll:= ll_id2;
5 14258 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14259 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14260 \f
5 14260 message procedure vt_opdater side 8 - 820301/cl;
5 14261
5 14261 end <* ll_id2 indkodet *>
4 14262 else
4 14263 begin
5 14264 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 14265 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 14266 pm1:= sgn(li2-li1);
5 14267 for i:= li1 step pm1 until li2-pm1 do
5 14268 begin
6 14269 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 14270 busindeks(i):= busindeks(i+pm1);
6 14271 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 14272 end;
5 14273 linie_løb_tabel(li2):= ll_id2;
5 14274 busindeks(li2):= false add bi1;
5 14275 linie_løb_indeks(bi1):= false add li2;
5 14276 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14277 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14278 fil(zi).ll:= ll_id2;
5 14279 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14280 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14281 end;
4 14282 res:= 3; <*udført*>
4 14283 slut_flyt:
4 14284 d.op.resultat:= res;
4 14285 d.op.data(3):= inf1;
4 14286 if funk=5 then d.op.data(4):= inf2;
4 14287 end;
3 14288 goto returner;
3 14289 \f
3 14289 message procedure vt_opdater side 9 - 851001/cl;
3 14290
3 14290 slet:
3 14291 begin
4 14292 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 14293 boolean test24;
4 14294
4 14294 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 14295 omr:= d.op.data(3);
4 14296
4 14296 if d.op.data(1) > d.op.data(2) then
4 14297 begin
5 14298 res:= 44; <* intervalstørrelse ulovlig *>
5 14299 goto slut_slet;
5 14300 end;
4 14301
4 14301 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 14302 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 14303
4 14303 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 14304 if s<0 then finx:= finx+1;
4 14305 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 14306 if s>0 then sinx:= sinx-1;
4 14307
4 14307 for li:= finx step 1 until sinx do
4 14308 begin
5 14309 bi:= busindeks(li) extract 12;
5 14310 gar:= bustabel(bi) shift (-14) extract 8;
5 14311 if intg(bustilstand(bi))=0 and
5 14312 (omr = 0 or (omr > 0 and omr = gar) or
5 14313 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 14314 begin
6 14315 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 14316 linie_løb_indeks(bi):= busindeks(li):= false;
6 14317 linie_løb_tabel(li):= 0;
6 14318 end;
5 14319 end;
4 14320 \f
4 14320 message procedure vt_opdater side 10 - 850820/cl;
4 14321
4 14321 sinx:= finx-1;
4 14322 for li:= finx step 1 until sidste_linie_løb do
4 14323 begin
5 14324 if linie_løb_tabel(li)<>0 then
5 14325 begin
6 14326 sinx:= sinx+1;
6 14327 if sinx<>li then
6 14328 begin
7 14329 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 14330 busindeks(sinx):= busindeks(li);
7 14331 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 14332 linie_løb_tabel(li):= 0;
7 14333 busindeks(li):= false;
7 14334 end;
6 14335 end;
5 14336 end;
4 14337 sidste_linie_løb:= sinx;
4 14338
4 14338 test24:= testbit24; testbit24:= false;
4 14339 for bi:= 1 step 1 until sidste_bus do
4 14340 disable
4 14341 begin
5 14342 s:= modiffil(tf_vogntabel,bi,finx);
5 14343 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 14344 fil(finx).bn:= bustabel(bi) extract 14 add
5 14345 (bustabel1(bi) extract 8 shift 14);
5 14346 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 14347 end;
4 14348 testbit24:= test24;
4 14349 res:= 3;
4 14350
4 14350 slut_slet:
4 14351 d.op.resultat:= res;
4 14352 end;
3 14353 goto returner;
3 14354 \f
3 14354 message procedure vt_opdater side 11 - 810409/cl;
3 14355
3 14355 returner:
3 14356 disable
3 14357 begin
4 14358
4 14358 <*+2*>
4 14359 <**> if testbit40 and overvåget then
4 14360 <**> begin
5 14361 <**> skriv_vt_opd(out,0);
5 14362 <**> write(out,<: vogntabel efter ændring:>);
5 14363 <**> p_vogntabel(out);
5 14364 <**> end;
4 14365 <**> if testbit41 and overvåget then
4 14366 <**> begin
5 14367 <**> skriv_vt_opd(out,0);
5 14368 <**> write(out,<: returner operation:>);
5 14369 <**> skriv_op(out,op);
5 14370 <**> end;
4 14371 <*-2*>
4 14372
4 14372 signalch(d.op.retur,op,d.op.optype);
4 14373 end;
3 14374 goto vent_op;
3 14375
3 14375 vt_opd_trap:
3 14376 disable skriv_vt_opd(zbillede,1);
3 14377
3 14377 end vt_opdater;
2 14378 \f
2 14378 message procedure vt_tilstand side 1 - 810424/cl;
2 14379
2 14379 procedure vt_tilstand(cs_fil,fil_opref);
2 14380 value cs_fil,fil_opref;
2 14381 integer cs_fil,fil_opref;
2 14382 begin
3 14383 integer array field op,filop;
3 14384 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14385 g_type,gr,antal,ej_res,zi,li,filref;
3 14386 integer array identer(1:max_antal_i_gruppe);
3 14387
3 14387 procedure skriv_vt_tilst(zud,omfang);
3 14388 value omfang;
3 14389 zone zud;
3 14390 integer omfang;
3 14391 begin
4 14392 real array field raf;
4 14393 raf:= 0;
4 14394 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14395 if omfang <> 0 then
4 14396 begin
5 14397 skriv_coru(zud,abs curr_coruno);
5 14398 write(zud,"nl",1,<<d>,
5 14399 <:cs-fil :>,cs_fil,"nl",1,
5 14400 <:filop :>,filop,"nl",1,
5 14401 <:op :>,op,"nl",1,
5 14402 <:funk :>,funk,"nl",1,
5 14403 <:format :>,format,"nl",1,
5 14404 <:busid :>,busid,"nl",1,
5 14405 <:res :>,res,"nl",1,
5 14406 <:bi :>,bi,"nl",1,
5 14407 <:tilst :>,tilst,"nl",1,
5 14408 <:opk :>,opk,"nl",1,
5 14409 <:opk-indeks :>,opk_indeks,"nl",1,
5 14410 <:g-type :>,g_type,"nl",1,
5 14411 <:gr :>,gr,"nl",1,
5 14412 <:antal :>,antal,"nl",1,
5 14413 <:ej-res :>,ej_res,"nl",1,
5 14414 <:zi :>,zi,"nl",1,
5 14415 <:li :>,li,"nl",1,
5 14416 <::>);
5 14417 write(zud,"nl",1,<:identer:>);
5 14418 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14419 end;
4 14420 end;
3 14421
3 14421 procedure sorter_gruppe(tab,l,u);
3 14422 value l,u;
3 14423 integer array tab;
3 14424 integer l,u;
3 14425 begin
4 14426 integer array field ii,jj;
4 14427 integer array ww, xx(1:2);
4 14428
4 14428 integer procedure sml(a,b);
4 14429 integer array a,b;
4 14430 begin
5 14431 integer res;
5 14432
5 14432 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14433 if res = 0 then
5 14434 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14435 if res = 0 then
5 14436 res:=
5 14437 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14438 if res = 0 then
5 14439 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14440 sml:= res;
5 14441 end;
4 14442
4 14442 ii:= ((l+u)//2 - 1)*4;
4 14443 tofrom(xx,tab.ii,4);
4 14444 ii:= (l-1)*4; jj:= (u-1)*4;
4 14445 repeat
4 14446 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14447 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14448 if ii <= jj then
4 14449 begin
5 14450 tofrom(ww,tab.ii,4);
5 14451 tofrom(tab.ii,tab.jj,4);
5 14452 tofrom(tab.jj,ww,4);
5 14453 ii:= ii+4;
5 14454 jj:= jj-4;
5 14455 end;
4 14456 until ii>jj;
4 14457 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14458 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14459 end;
3 14460 \f
3 14460 message procedure vt_tilstand side 2 - 820301/cl;
3 14461
3 14461 filop:= filopref;
3 14462 stackclaim(if cm_test then 550 else 500);
3 14463 trap(vt_tilst_trap);
3 14464
3 14464 <*+2*>
3 14465 <**> disable if testbit47 and overvåget or testbit28 then
3 14466 <**> skriv_vt_tilst(out,0);
3 14467 <*-2*>
3 14468
3 14468 vent_op:
3 14469 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14470 <*+2*>disable
3 14471 <**> if (testbit41 and overvåget) or
3 14472 (testbit46 and overvåget and
3 14473 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14474 then
3 14475 <**> begin
4 14476 <**> skriv_vt_tilst(out,0);
4 14477 <**> write(out,<: modtaget operation:>);
4 14478 <**> skriv_op(out,op);
4 14479 <**> end;
3 14480 <*-2*>
3 14481
3 14481 <*+4*>
3 14482 <**> if op <> vt_op then
3 14483 <**> begin
4 14484 <**> disable begin
5 14485 <**> d.op.resultat:= 31;
5 14486 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14487 <**> end;
4 14488 <**> goto returner;
4 14489 <**> end;
3 14490 <*-4*>
3 14491
3 14491 opk:= d.op.opkode extract 12;
3 14492 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14493 if opk = 15 <*bus res *> then 2 else
3 14494 if opk = 16 <*grp res *> then 4 else
3 14495 if opk = 17 <*bus fri *> then 3 else
3 14496 if opk = 18 <*grp fri *> then 5 else
3 14497 0;
3 14498 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14499 res:= 0;
3 14500 format:= d.op.data(1) shift (-22);
3 14501
3 14501 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14502 \f
3 14502 message procedure vt_tilstand side 3 - 820301/cl;
3 14503
3 14503 enkelt_bus:
3 14504 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14505 disable
3 14506 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14507 <*+4*>
4 14508 <**>if format <> 0 and format <> 1 then
4 14509 <**>begin
5 14510 <**> res:= 31;
5 14511 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14512 <**> goto slut_enkelt_bus;
5 14513 <**>end;
4 14514 <*-4*>
4 14515 <* find busnr og tilstand *>
4 14516 case format+1 of
4 14517 begin
5 14518 <* 0: budident *>
5 14519 begin
6 14520 busnr:= d.op.data(1) extract 14;
6 14521 s:= omr:= d.op.data(4) extract 8;
6 14522 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14523 if bi<0 then
6 14524 begin
7 14525 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14526 goto slut_enkelt_bus;
7 14527 end
6 14528 else
6 14529 begin
7 14530 tilst:= intg(bustilstand(bi));
7 14531 end;
6 14532 end;
5 14533
5 14533 <* 1: linie_løb_ident *>
5 14534 begin
6 14535 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14536 if bi < 0 then <* ukendt linie_løb *>
6 14537 begin
7 14538 res:= 9;
7 14539 goto slut_enkelt_bus;
7 14540 end;
6 14541 end;
5 14542 end case;
4 14543 \f
4 14543 message procedure vt_tilstand side 4 - 830310/cl;
4 14544
4 14544 if funk < 3 then
4 14545 begin
5 14546 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14547 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14548 else 0;
5 14549 d.op.data(3):= bustabel(bi);
5 14550 d.op.data(4):= bustabel1(bi);
5 14551 end;
4 14552
4 14552 <* check tilstand *>
4 14553 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14554 res:= 39 <* bus ikke reserveret *>
4 14555 else
4 14556 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14557 res:= 14 <* bus optaget *>
4 14558 else
4 14559 if funk = 1 <* i kø *> and tilst = (-1) then
4 14560 res:= 18 <* i kø *>
4 14561 else
4 14562 res:= 3; <*udført*>
4 14563
4 14563 if res = 3 then
4 14564 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14565
4 14565 slut_enkelt_bus:
4 14566 d.op.resultat:= res;
4 14567 end <*disable*>;
3 14568 goto returner;
3 14569 \f
3 14569 message procedure vt_tilstand side 5 - 810424/cl;
3 14570
3 14570 grp_res: <* reserver gruppe *>
3 14571 disable
3 14572 begin
4 14573
4 14573 <*+4*>
4 14574 <**> if format <> 2 then
4 14575 <**> begin
5 14576 <**> res:= 31;
5 14577 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14578 <**> goto slut_grp_res_1;
5 14579 <**> end;
4 14580 <*-4*>
4 14581
4 14581 <* find frit indeks i opkaldstabel *>
4 14582 opk_indeks:= 0;
4 14583 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14584 begin
5 14585 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14586 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14587 end;
4 14588 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14589 if res <> 0 then goto slut_grp_res_1;
4 14590 g_type:= d.op.data(1) shift (-21) extract 1;
4 14591 if g_type = 1 <*special gruppe*> then
4 14592 begin <*check eksistens*>
5 14593 gr:= 0;
5 14594 for i:= 1 step 1 until max_antal_grupper do
5 14595 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14596 if gr = 0 then <*gruppe ukendt*>
5 14597 begin
6 14598 res:= 8;
6 14599 goto slut_grp_res_1;
6 14600 end;
5 14601 end;
4 14602
4 14602 <* reserver i opkaldstabel *>
4 14603 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14604 \f
4 14604 message procedure vt_tilstand side 6 - 810428/cl;
4 14605
4 14605 <* tilknyt fil *>
4 14606 start_operation(filop,curr_coruid,cs_fil,101);
4 14607 d.filop.data(1):= 0; <*postantal*>
4 14608 d.filop.data(2):= 256; <*postlængde*>
4 14609 d.filop.data(3):= 1; <*segmentantal*>
4 14610 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14611 signalch(cs_opret_fil,filop,vt_optype);
4 14612
4 14612 slut_grp_res_1:
4 14613 if res <> 0 then d.op.resultat:= res;
4 14614 end;
3 14615 if res <> 0 then goto returner;
3 14616
3 14616 waitch(cs_fil,filop,vt_optype,-1);
3 14617
3 14617 <* check filsys-resultat *>
3 14618 if d.filop.data(9) <> 0 then
3 14619 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14620 filref:= d.filop.data(4);
3 14621 \f
3 14621 message procedure vt_tilstand side 7 - 820301/cl;
3 14622 disable if g_type = 0 <*linie-gruppe*> then
3 14623 begin
4 14624 integer s,i,ll_id;
4 14625 integer array field iaf1;
4 14626
4 14626 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14627 iaf1:= 2;
4 14628 s:= binærsøg(sidste_linie_løb,
4 14629 linie_løb_tabel(i) - ll_id, i);
4 14630 if s < 0 then i:= i +1;
4 14631 antal:= ej_res:= 0;
4 14632 skrivfil(filref,1,zi);
4 14633 if i <= sidste_linie_løb then
4 14634 begin
5 14635 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14636 begin
6 14637 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14638 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14639 ej_res:= ej_res+1
6 14640 else
6 14641 begin
7 14642 antal:= antal+1;
7 14643 bi:= busindeks(i) extract 12;
7 14644 fil(zi).iaf1(1):=
7 14645 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14646 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14647 fil(zi).iaf1(2):= bustabel(bi);
7 14648 iaf1:= iaf1+4;
7 14649 bustilstand(bi):= false add opk_indeks;
7 14650 end;
6 14651 i:= i +1;
6 14652 if i > sidste_linie_løb then goto slut_l_grp;
6 14653 end;
5 14654 end;
4 14655 \f
4 14655 message procedure vt_tilstand side 8 - 820301/cl;
4 14656
4 14656 slut_l_grp:
4 14657 end
3 14658 else
3 14659 begin <*special gruppe*>
4 14660 integer i,s,li,omr,gar,tilst;
4 14661 integer array field iaf1;
4 14662
4 14662 iaf1:= 2;
4 14663 antal:= ej_res:= 0;
4 14664 s:= læsfil(tf_gruppedef,gr,zi);
4 14665 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14666 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14667 s:= skrivfil(filref,1,zi);
4 14668 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14669 i:= 1;
4 14670 while identer(i) <> 0 do
4 14671 begin
5 14672 if identer(i) shift (-22) = 0 then
5 14673 begin <*busident*>
6 14674 omr:= 0;
6 14675 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14676 if bi<0 then goto næste_ident;
6 14677 li:= linie_løb_indeks(bi) extract 12;
6 14678 end
5 14679 else
5 14680 begin <*linie/løb ident*>
6 14681 s:= binærsøg(sidste_linie_løb,
6 14682 linie_løb_tabel(li) - identer(i), li);
6 14683 if s <> 0 then goto næste_ident;
6 14684 bi:= busindeks(li) extract 12;
6 14685 end;
5 14686 if (intg(bustilstand(bi))<>0) or
5 14687 (bustabel1(bi) extract 8 <> 3) then
5 14688 ej_res:= ej_res+1
5 14689 else
5 14690 begin
6 14691 antal:= antal +1;
6 14692 fil(zi).iaf1(1):=
6 14693 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14694 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14695 fil(zi).iaf1(2):= bustabel(bi);
6 14696 iaf1:= iaf1+4;
6 14697 bustilstand(bi):= false add opk_indeks;
6 14698 end;
5 14699 næste_ident:
5 14700 i:= i +1;
5 14701 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14702 end;
4 14703 slut_s_grp:
4 14704 end;
3 14705 \f
3 14705 message procedure vt_tilstand side 9 - 820301/cl;
3 14706
3 14706 if antal > 0 then <*ok*>
3 14707 disable begin
4 14708 integer array field spec,akt;
4 14709 integer a;
4 14710 integer field antal_spec;
4 14711
4 14711 antal_spec:= 2; a:= 0;
4 14712 spec:= 2; akt:= 2;
4 14713 sorter_gruppe(fil(zi).spec,1,antal);
4 14714 fil(zi).antal_spec:= 0;
4 14715 while akt//4 < antal do
4 14716 begin
5 14717 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14718 a:= 0;
5 14719 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14720 and a<15 do
5 14721 begin
6 14722 a:= a+1;
6 14723 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14724 akt:= akt+4;
6 14725 end;
5 14726 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14727 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14728 spec:= spec + 2*a + 2;
5 14729 end;
4 14730 antal:= fil(zi).antal_spec;
4 14731 gruppeopkald(opk_indeks,2):= filref;
4 14732 d.op.resultat:= 3;
4 14733 d.op.data(2):= antal;
4 14734 d.op.data(3):= filref;
4 14735 d.op.data(4):= ej_res;
4 14736 end
3 14737 else
3 14738 begin
4 14739 disable begin
5 14740 d.filop.opkode:= 104; <*slet fil*>
5 14741 signalch(cs_slet_fil,filop,vt_optype);
5 14742 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14743 d.op.resultat:= 54;
5 14744 d.op.data(2):= antal;
5 14745 d.op.data(3):= 0;
5 14746 d.op.data(4):= ej_res;
5 14747 end;
4 14748 waitch(cs_fil,filop,vt_optype,-1);
4 14749 if d.filop.data(9) <> 0 then
4 14750 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14751 end;
3 14752 goto returner;
3 14753 \f
3 14753 message procedure vt_tilstand side 10 - 820301/cl;
3 14754
3 14754 grp_fri: <* frigiv gruppe *>
3 14755 disable
3 14756 begin integer i,j,s,ll,gar,omr,tilst;
4 14757 integer array field spec;
4 14758
4 14758 <*+4*>
4 14759 <**> if format <> 2 then
4 14760 <**> begin
5 14761 <**> res:= 31;
5 14762 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14763 <**> goto slut_grp_fri;
5 14764 <**> end;
4 14765 <*-4*>
4 14766
4 14766 <* find indeks i opkaldstabel *>
4 14767 opk_indeks:= 0;
4 14768 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14769 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14770 if opk_indeks = 0 <*ikke fundet*> then
4 14771 begin
5 14772 res:= 40; <*gruppe ej reserveret*>
5 14773 goto slut_grp_fri;
5 14774 end;
4 14775 filref:= gruppeopkald(opk_indeks,2);
4 14776 start_operation(filop,curr_coruid,cs_fil,104);
4 14777 d.filop.data(4):= filref;
4 14778 hentfildim(d.filop.data);
4 14779 læsfil(filref,1,zi);
4 14780 spec:= 0;
4 14781 antal:= fil(zi).spec(1);
4 14782 spec:= spec+2;
4 14783 for i:= 1 step 1 until antal do
4 14784 begin
5 14785 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14786 begin
6 14787 busid:= fil(zi).spec(1+j) extract 14;
6 14788 omr:= 0;
6 14789 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14790 if bi>=0 then bustilstand(bi):= false;
6 14791 end;
5 14792 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14793 end;
4 14794
4 14794 slut_grp_fri:
4 14795 d.op.resultat:= res;
4 14796 end;
3 14797 if res <> 0 then goto returner;
3 14798 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14799 signalch(cs_slet_fil,filop,vt_optype);
3 14800 \f
3 14800 message procedure vt_tilstand side 11 - 810424/cl;
3 14801
3 14801 waitch(cs_fil,filop,vt_optype,-1);
3 14802
3 14802 if d.filop.data(9) <> 0 then
3 14803 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14804 d.op.resultat:= 3;
3 14805
3 14805 returner:
3 14806 disable
3 14807 begin
4 14808 <*+2*>
4 14809 <**> if testbit40 and overvåget then
4 14810 <**> begin
5 14811 <**> skriv_vt_tilst(out,0);
5 14812 <**> write(out,<: vogntabel efter ændring:>);
5 14813 <**> p_vogntabel(out);
5 14814 <**> end;
4 14815 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14816 <**> begin
5 14817 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14818 <**> p_gruppetabel(out);
5 14819 <**> end;
4 14820 <**> if (testbit41 and overvåget) or
4 14821 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14822 <**> begin
5 14823 <**> skriv_vt_tilst(out,0);
5 14824 <**> write(out,<: returner operation:>);
5 14825 <**> skriv_op(out,op);
5 14826 <**> end;
4 14827 <*-2*>
4 14828 signalch(d.op.retur,op,d.op.optype);
4 14829 end;
3 14830 goto vent_op;
3 14831
3 14831 vt_tilst_trap:
3 14832 disable skriv_vt_tilst(zbillede,1);
3 14833
3 14833 end vt_tilstand;
2 14834 \f
2 14834 message procedure vt_rapport side 1 - 810428/cl;
2 14835
2 14835 procedure vt_rapport(cs_fil,fil_opref);
2 14836 value cs_fil,fil_opref;
2 14837 integer cs_fil,fil_opref;
2 14838 begin
3 14839 integer array field op,filop;
3 14840 integer funk,filref,antal,id_ant,res;
3 14841 integer field i1,i2;
3 14842
3 14842 procedure skriv_vt_rap(z,omfang);
3 14843 value omfang;
3 14844 zone z;
3 14845 integer omfang;
3 14846 begin
4 14847 write(z,"nl",1,<:+++ vt_rapport :>);
4 14848 if omfang <> 0 then
4 14849 begin
5 14850 skriv_coru(z,abs curr_coruno);
5 14851 write(z,"nl",1,<<d>,
5 14852 <: cs_fil :>,cs_fil,"nl",1,
5 14853 <: filop :>,filop,"nl",1,
5 14854 <: op :>,op,"nl",1,
5 14855 <: funk :>,funk,"nl",1,
5 14856 <: filref :>,filref,"nl",1,
5 14857 <: antal :>,antal,"nl",1,
5 14858 <: id-ant :>,id_ant,"nl",1,
5 14859 <: res :>,res,"nl",1,
5 14860 <::>);
5 14861
5 14861 end;
4 14862 end skriv_vt_rap;
3 14863
3 14863 stackclaim(if cm_test then 198 else 146);
3 14864 filop:= fil_opref;
3 14865 i1:= 2; i2:= 4;
3 14866 trap(vt_rap_trap);
3 14867
3 14867 <*+2*>
3 14868 <**> disable if testbit47 and overvåget or testbit28 then
3 14869 <**> skriv_vt_rap(out,0);
3 14870 <*-2*>
3 14871 \f
3 14871 message procedure vt_rapport side 2 - 810505/cl;
3 14872
3 14872 vent_op:
3 14873 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14874
3 14874 <*+2*>
3 14875 <**> disable begin
4 14876 <**> if testbit41 and overvåget then
4 14877 <**> begin
5 14878 <**> skriv_vt_rap(out,0);
5 14879 <**> write(out,<: modtaget operation:>);
5 14880 <**> skriv_op(out,op);
5 14881 <**> ud;
5 14882 <**> end;
4 14883 <**> end;<*disable*>
3 14884 <*-2*>
3 14885
3 14885 disable
3 14886 begin
4 14887 integer opk;
4 14888
4 14888 opk:= d.op.opkode extract 12;
4 14889 funk:= if opk = 9 then 1 else
4 14890 if opk =10 then 2 else
4 14891 0;
4 14892 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14893
4 14893 <* opret og tilknyt fil *>
4 14894 start_operation(filop,curr_coruid,cs_fil,101);
4 14895 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14896 d.filop.data(2):= 2; <*postlængde*>
4 14897 d.filop.data(3):=10; <*segmenter*>
4 14898 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14899 signalch(cs_opretfil,filop,vt_optype);
4 14900 end;
3 14901
3 14901 waitch(cs_fil,filop,vt_optype,-1);
3 14902
3 14902 <* check resultat *>
3 14903 if d.filop.data(9) <> 0 then
3 14904 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14905 filref:= d.filop.data(4);
3 14906 antal:= 0;
3 14907 goto case funk of (l_rapport,b_rapport);
3 14908 \f
3 14908 message procedure vt_rapport side 3 - 850820/cl;
3 14909
3 14909 l_rapport:
3 14910 disable
3 14911 begin
4 14912 integer i,j,s,ll,zi;
4 14913 idant:= 0;
4 14914 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14915 <*+4*>
4 14916 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14917 <**> begin
5 14918 <**> res:= 31;
5 14919 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14920 <**> goto l_rap_slut;
5 14921 <**> end;
4 14922 <*-4*>
4 14923 ;
4 14924
4 14924 for i:= 1 step 1 until id_ant do
4 14925 begin
5 14926 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14927 s:= binærsøg(sidste_linie_løb,
5 14928 linie_løb_tabel(j) - ll, j);
5 14929 if s < 0 then j:= j +1;
5 14930
5 14930 if j<= sidste_linie_løb then
5 14931 begin <* skriv identer *>
6 14932 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14933 begin
7 14934 antal:= antal +1;
7 14935 s:= skrivfil(filref,antal,zi);
7 14936 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14937 fil(zi).i1:= linie_løb_tabel(j);
7 14938 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14939 j:= j +1;
7 14940 if j > sidste_bus then goto linie_slut;
7 14941 end;
6 14942 end;
5 14943 linie_slut:
5 14944 end;
4 14945 res:= 3;
4 14946 l_rap_slut:
4 14947 end <*disable*>;
3 14948 goto returner;
3 14949 \f
3 14949 message procedure vt_rapport side 4 - 820301/cl;
3 14950
3 14950 b_rapport:
3 14951 disable
3 14952 begin
4 14953 integer i,j,s,zi,busnr1,busnr2;
4 14954 <*+4*>
4 14955 <**> for i:= 1,2 do
4 14956 <**> if d.op.data(i) shift (-14) <> 0 then
4 14957 <**> begin
5 14958 <**> res:= 31;
5 14959 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14960 <**> goto bus_slut;
5 14961 <**> end;
4 14962 <*-4*>
4 14963
4 14963 busnr1:= d.op.data(1) extract 14;
4 14964 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14965 if busnr1 = 0 or busnr2 < busnr1 then
4 14966 begin
5 14967 res:= 7; <* fejl i busnr *>
5 14968 goto bus_slut;
5 14969 end;
4 14970
4 14970 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14971 - busnr1,j);
4 14972 if s < 0 then j:= j +1;
4 14973 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14974 if j <= sidste_bus then
4 14975 begin <* skriv identer *>
5 14976 while bustabel(j) extract 14 <= busnr2 do
5 14977 begin
6 14978 i:= linie_løb_indeks(j) extract 12;
6 14979 if i<>0 then
6 14980 begin
7 14981 antal:= antal +1;
7 14982 s:= skriv_fil(filref,antal,zi);
7 14983 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14984 fil(zi).i1:= bustabel(j);
7 14985 fil(zi).i2:= linie_løb_tabel(i);
7 14986 end;
6 14987 j:= j +1;
6 14988 if j > sidste_bus then goto bus_slut;
6 14989 end;
5 14990 end;
4 14991 bus_slut:
4 14992 end <*disable*>;
3 14993 res:= 3; <*ok*>
3 14994 \f
3 14994 message procedure vt_rapport side 5 - 810409/cl;
3 14995
3 14995 returner:
3 14996 disable
3 14997 begin
4 14998 d.op.resultat:= res;
4 14999 d.op.data(6):= antal;
4 15000 d.op.data(7):= filref;
4 15001 d.filop.data(1):= antal;
4 15002 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 15003 i:= sæt_fil_dim(d.filop.data);
4 15004 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 15005 <*+2*>
4 15006 <**> if testbit41 and overvåget then
4 15007 <**> begin
5 15008 <**> skriv_vt_rap(out,0);
5 15009 <**> write(out,<: returner operation:>);
5 15010 <**> skriv_op(out,op);
5 15011 <**> end;
4 15012 <*-2*>
4 15013 signalch(d.op.retur,op,d.op.optype);
4 15014 end;
3 15015 goto vent_op;
3 15016
3 15016 vt_rap_trap:
3 15017 disable skriv_vt_rap(zbillede,1);
3 15018
3 15018 end vt_rapport;
2 15019 \f
2 15019 message procedure vt_gruppe side 1 - 810428/cl;
2 15020
2 15020 procedure vt_gruppe(cs_fil,fil_opref);
2 15021
2 15021 value cs_fil,fil_opref;
2 15022 integer cs_fil,fil_opref;
2 15023 begin
3 15024 integer array field op, fil_op, iaf;
3 15025 integer funk, res, filref, gr, i, antal, zi, s;
3 15026 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 15027 max_antal_grupper else max_antal_i_gruppe));
3 15028
3 15028 procedure skriv_vt_gruppe(zud,omfang);
3 15029 value omfang;
3 15030 integer omfang;
3 15031 zone zud;
3 15032 begin
4 15033 integer øg;
4 15034
4 15034 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 15035 if omfang <> 0 then
4 15036 disable
4 15037 begin
5 15038 skriv_coru(zud,abs curr_coruno);
5 15039 write(zud,"nl",1,<<d>,
5 15040 <: cs_fil :>,cs_fil,"nl",1,
5 15041 <: op :>,op,"nl",1,
5 15042 <: filop :>,filop,"nl",1,
5 15043 <: funk :>,funk,"nl",1,
5 15044 <: res :>,res,"nl",1,
5 15045 <: filref :>,filref,"nl",1,
5 15046 <: gr :>,gr,"nl",1,
5 15047 <: i :>,i,"nl",1,
5 15048 <: antal :>,antal,"nl",1,
5 15049 <: zi :>,zi,"nl",1,
5 15050 <: s :>,s,"nl",1,
5 15051 <::>);
5 15052 raf:= 0;
5 15053 system(3,øg,identer);
5 15054 write(zud,"nl",1,<:identer::>);
5 15055 skriv_hele(zud,identer.raf,øg*2,2);
5 15056 end;
4 15057 end;
3 15058
3 15058 stackclaim(if cm_test then 198 else 146);
3 15059 filop:= fil_opref;
3 15060 trap(vt_grp_trap);
3 15061 iaf:= 0;
3 15062 \f
3 15062 message procedure vt_gruppe side 2 - 810409/cl;
3 15063
3 15063 <*+2*>
3 15064 <**> disable if testbit47 and overvåget or testbit28 then
3 15065 <**> skriv_vt_gruppe(out,0);
3 15066 <*-2*>
3 15067
3 15067 vent_op:
3 15068 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 15069 <*+2*>
3 15070 <**>disable
3 15071 <**>begin
4 15072 <**> if testbit41 and overvåget then
4 15073 <**> begin
5 15074 <**> skriv_vt_gruppe(out,0);
5 15075 <**> write(out,<: modtaget operation:>);
5 15076 <**> skriv_op(out,op);
5 15077 <**> ud;
5 15078 <**> end;
4 15079 <**>end;
3 15080 <*-2*>
3 15081
3 15081 disable
3 15082 begin
4 15083 integer opk;
4 15084
4 15084 opk:= d.op.opkode extract 12;
4 15085 funk:= if opk=25 then 1 else
4 15086 if opk=26 then 2 else
4 15087 if opk=27 then 3 else
4 15088 if opk=28 then 4 else
4 15089 0;
4 15090 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 15091 end;
3 15092 <*+4*>
3 15093 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 15094 <**> begin
4 15095 <**> disable begin
5 15096 <**> d.op.resultat:= 31;
5 15097 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 15098 <**> end;
4 15099 <**> goto returner;
4 15100 <**> end;
3 15101 <*-4*>
3 15102
3 15102 goto case funk of(definer,slet,vis,oversigt);
3 15103 \f
3 15103 message procedure vt_gruppe side 3 - 810505/cl;
3 15104
3 15104 definer:
3 15105 disable
3 15106 begin
4 15107 gr:= 0; res:= 0;
4 15108 for i:= max_antal_grupper step -1 until 1 do
4 15109 begin
5 15110 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 15111 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 15112 end;
4 15113 if gr=0 then res:= 32; <*ingen plads*>
4 15114 end;
3 15115 if res<>0 then goto slut_definer;
3 15116 disable
3 15117 begin <*fri plads fundet*>
4 15118 antal:= d.op.data(2);
4 15119 if antal <=0 or max_antal_i_gruppe<antal then
4 15120 res:= 33 <*fejl i gruppestørrelse*>
4 15121 else
4 15122 begin
5 15123 for i:= 1 step 1 until antal do
5 15124 begin
6 15125 s:= læsfil(d.op.data(3),i,zi);
6 15126 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 15127 identer(i):= fil(zi).iaf(1);
6 15128 end;
5 15129 s:= modif_fil(tf_gruppedef,gr,zi);
5 15130 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15131 tofrom(fil(zi).iaf,identer,antal*2);
5 15132 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 15133 fil(zi).iaf(i):= 0;
5 15134 gruppetabel(gr):= d.op.data(1);
5 15135 s:= modiffil(tf_gruppeidenter,gr,zi);
5 15136 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15137 fil(zi).iaf(1):= gruppetabel(gr);
5 15138 res:= 3;
5 15139 end;
4 15140 end;
3 15141 slut_definer:
3 15142 <*slet fil*>
3 15143 start_operation(fil_op,curr_coruid,cs_fil,104);
3 15144 d.filop.data(4):= d.op.data(3);
3 15145 signalch(cs_slet_fil,filop,vt_optype);
3 15146 waitch(cs_fil,filop,vt_optype,-1);
3 15147 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 15148 d.op.resultat:= res;
3 15149 goto returner;
3 15150 \f
3 15150 message procedure vt_gruppe side 4 - 810409/cl;
3 15151
3 15151 slet:
3 15152 disable
3 15153 begin
4 15154 gr:= 0; res:= 0;
4 15155 for i:= 1 step 1 until max_antal_grupper do
4 15156 begin
5 15157 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 15158 end;
4 15159 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 15160 else
4 15161 begin
5 15162 for i:= 1 step 1 until max_antal_gruppeopkald do
5 15163 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 15164 if res = 0 then
5 15165 begin
6 15166 gruppetabel(gr):= 0;
6 15167 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 15168 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 15169 fil(zi).iaf(1):= gruppetabel(gr);
6 15170 res:= 3;
6 15171 end;
5 15172 end;
4 15173 d.op.resultat:= res;
4 15174 end;
3 15175 goto returner;
3 15176 \f
3 15176 message procedure vt_gruppe side 5 - 810505/cl;
3 15177
3 15177 vis:
3 15178 disable
3 15179 begin
4 15180 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 15181 for i:= 1 step 1 until max_antal_grupper do
4 15182 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 15183 if gr = 0 then res:= 8
4 15184 else
4 15185 begin
5 15186 s:= læsfil(tf_gruppedef,gr,zi);
5 15187 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 15188 for i:= 1 step 1 until max_antal_i_gruppe do
5 15189 begin
6 15190 identer(i):= fil(zi).iaf(i);
6 15191 if identer(i) <> 0 then antal:= antal +1;
6 15192 end;
5 15193 start_operation(filop,curr_coruid,cs_fil,101);
5 15194 d.filop.data(1):= antal; <*postantal*>
5 15195 d.filop.data(2):= 1; <*postlængde*>
5 15196 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 15197 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 15198 d.filop.data(5):= d.filop.data(6):=
5 15199 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 15200 signalch(cs_opret_fil,filop,vt_optype);
5 15201 end;
4 15202 end;
3 15203 if res <> 0 then goto slut_vis;
3 15204 waitch(cs_fil,filop,vt_optype,-1);
3 15205 disable
3 15206 begin
4 15207 if d.filop.data(9) <> 0 then
4 15208 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 15209 filref:= d.filop.data(4);
4 15210 for i:= 1 step 1 until antal do
4 15211 begin
5 15212 s:= skrivfil(filref,i,zi);
5 15213 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 15214 fil(zi).iaf(1):= identer(i);
5 15215 end;
4 15216 res:= 3;
4 15217 end;
3 15218 slut_vis:
3 15219 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 15220 goto returner;
3 15221 \f
3 15221 message procedure vt_gruppe side 6 - 810508/cl;
3 15222
3 15222 oversigt:
3 15223 disable
3 15224 begin
4 15225 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 15226 for i:= 1 step 1 until max_antal_grupper do
4 15227 begin
5 15228 if gruppetabel(i) <> 0 then
5 15229 begin
6 15230 antal:= antal +1;
6 15231 identer(antal):= gruppetabel(i);
6 15232 end;
5 15233 end;
4 15234 start_operation(filop,curr_coruid,cs_fil,101);
4 15235 d.filop.data(1):= antal; <*postantal*>
4 15236 d.filop.data(2):= 1; <*postlængde*>
4 15237 d.filop.data(3):= if antal = 0 then 1 else
4 15238 (antal-1)//256 +1; <*segm.antal*>
4 15239 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 15240 d.filop.data(5):= d.filop.data(6):=
4 15241 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 15242 signalch(cs_opretfil,filop,vt_optype);
4 15243 end;
3 15244 waitch(cs_fil,filop,vt_optype,-1);
3 15245 disable
3 15246 begin
4 15247 if d.filop.data(9) <> 0 then
4 15248 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 15249 filref:= d.filop.data(4);
4 15250 for i:= 1 step 1 until antal do
4 15251 begin
5 15252 s:= skriv_fil(filref,i,zi);
5 15253 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 15254 fil(zi).iaf(1):= identer(i);
5 15255 end;
4 15256 d.op.resultat:= 3; <*ok*>
4 15257 d.op.data(1):= antal;
4 15258 d.op.data(2):= filref;
4 15259 end;
3 15260 \f
3 15260 message procedure vt_gruppe side 7 - 810505/cl;
3 15261
3 15261 returner:
3 15262 disable
3 15263 begin
4 15264 <*+2*>
4 15265 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 15266 <**> begin
5 15267 <**> skriv_vt_gruppe(out,0);
5 15268 <**> write(out,<: gruppetabel efter ændring:>);
5 15269 <**> p_gruppetabel(out);
5 15270 <**> end;
4 15271 <**> if testbit41 and overvåget then
4 15272 <**> begin
5 15273 <**> skriv_vt_gruppe(out,0);
5 15274 <**> write(out,<: returner operation:>);
5 15275 <**> skriv_op(out,op);
5 15276 <**> end;
4 15277 <*-2*>
4 15278 signalch(d.op.retur,op,d.op.optype);
4 15279 end;
3 15280 goto vent_op;
3 15281
3 15281 vt_grp_trap:
3 15282 disable skriv_vt_gruppe(zbillede,1);
3 15283
3 15283 end vt_gruppe;
2 15284 \f
2 15284 message procedure vt_spring side 1 - 810506/cl;
2 15285
2 15285 procedure vt_spring(cs_spring_retur,spr_opref);
2 15286 value cs_spring_retur,spr_opref;
2 15287 integer cs_spring_retur,spr_opref;
2 15288 begin
3 15289 integer array field komm_op,spr_op,iaf;
3 15290 real nu;
3 15291 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 15292
3 15292 procedure skriv_vt_spring(zud,omfang);
3 15293 value omfang;
3 15294 zone zud;
3 15295 integer omfang;
3 15296 begin
4 15297 write(zud,"nl",1,<:+++ vt_spring :>);
4 15298 if omfang <> 0 then
4 15299 begin
5 15300 skriv_coru(zud,abs curr_coruno);
5 15301 write(zud,"nl",1,<<d>,
5 15302 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 15303 <:spr-op :>,spr_op,"nl",1,
5 15304 <:komm-op :>,komm_op,"nl",1,
5 15305 <:funk :>,funk,"nl",1,
5 15306 <:interval :>,interval,"nl",1,
5 15307 <:nr :>,nr,"nl",1,
5 15308 <:i :>,i,"nl",1,
5 15309 <:s :>,s,"nl",1,
5 15310 <:id1 :>,id1,"nl",1,
5 15311 <:id2 :>,id2,"nl",1,
5 15312 <:res :>,res,"nl",1,
5 15313 <:res-inf :>,res_inf,"nl",1,
5 15314 <:medd-kode :>,medd_kode,"nl",1,
5 15315 <:zi :>,zi,"nl",1,
5 15316 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 15317 <::>);
5 15318 end;
4 15319 end;
3 15320 \f
3 15320 message procedure vt_spring side 2 - 810506/cl;
3 15321
3 15321 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 15322 value aktion,id1,id2;
3 15323 integer aktion,id1,id2,res,res_inf;
3 15324 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 15325 integer array field akt_op;
4 15326
4 15326 <* vent på adgang til vogntabel *>
4 15327 waitch(cs_vt_adgang,akt_op,true,-1);
4 15328
4 15328 <* start operation *>
4 15329 disable
4 15330 begin
5 15331 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 15332 d.akt_op.data(1):= id1;
5 15333 d.akt_op.data(2):= id2;
5 15334 signalch(cs_vt_opd,akt_op,vt_optype);
5 15335 end;
4 15336
4 15336 <* afvent svar *>
4 15337 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 15338 res:= d.akt_op.resultat;
4 15339 res_inf:= d.akt_op.data(3);
4 15340 <*+2*>
4 15341 <**> disable
4 15342 <**> if testbit45 and overvåget then
4 15343 <**> begin
5 15344 <**> real t;
5 15345 <**> skriv_vt_spring(out,0);
5 15346 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 15347 <**> skriv_id(out,springtabel(nr,1),0);
5 15348 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 15349 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 15350 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 15351 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 15352 <**> d.akt_op.resultat,"sp",2);
5 15353 <**> skriv_id(out,d.akt_op.data(1),8);
5 15354 <**> skriv_id(out,d.akt_op.data(2),8);
5 15355 <**> skriv_id(out,d.akt_op.data(3),8);
5 15356 <**> systime(4,springtid(nr),t);
5 15357 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 15358 <**> end;
4 15359 <*-2*>
4 15360
4 15360 <* åbn adgang til vogntabel *>
4 15361 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 15362 end vt_operation;
3 15363 \f
3 15363 message procedure vt_spring side 2a - 810506/cl;
3 15364
3 15364 procedure io_meddelelse(medd_no,bus,linie,springno);
3 15365 value medd_no,bus,linie,springno;
3 15366 integer medd_no,bus,linie,springno;
3 15367 begin
4 15368 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 15369 d.spr_op.data(1):= medd_no;
4 15370 d.spr_op.data(2):= bus;
4 15371 d.spr_op.data(3):= linie;
4 15372 d.spr_op.data(4):= springtabel(springno,1);
4 15373 d.spr_op.data(5):= springtabel(springno,2);
4 15374 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15375 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15376 end;
3 15377
3 15377 procedure returner_op(op,res);
3 15378 value res;
3 15379 integer array field op;
3 15380 integer res;
3 15381 begin
4 15382 <*+2*>
4 15383 <**> disable
4 15384 <**> if testbit41 and overvåget then
4 15385 <**> begin
5 15386 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15387 <**> skriv_op(out,op);
5 15388 <**> end;
4 15389 <*-2*>
4 15390 d.op.resultat:= res;
4 15391 signalch(d.op.retur,op,d.op.optype);
4 15392 end;
3 15393 \f
3 15393 message procedure vt_spring side 3 - 810603/cl;
3 15394
3 15394 iaf:= 0;
3 15395 spr_op:= spr_opref;
3 15396 stack_claim((if cm_test then 198 else 146) + 24);
3 15397
3 15397 trap(vt_spring_trap);
3 15398
3 15398 for i:= 1 step 1 until max_antal_spring do
3 15399 begin
4 15400 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15401 springtid(i):= springstart(i):= 0.0;
4 15402 end;
3 15403
3 15403 <*+2*>
3 15404 <**> disable
3 15405 <**> if testbit44 and overvåget then
3 15406 <**> begin
4 15407 <**> skriv_vt_spring(out,0);
4 15408 <**> write(out,<: springtabel efter initialisering:>);
4 15409 <**> p_springtabel(out); ud;
4 15410 <**> end;
3 15411 <*-2*>
3 15412
3 15412 <*+2*>
3 15413 <**> disable if testbit47 and overvåget or testbit28 then
3 15414 <**> skriv_vt_spring(out,0);
3 15415 <*-2*>
3 15416 \f
3 15416 message procedure vt_spring side 4 - 810609/cl;
3 15417
3 15417 næste_tid: <* find næste tid *>
3 15418 disable
3 15419 begin
4 15420 interval:= -1; <*vent uendeligt*>
4 15421 systime(1,0.0,nu);
4 15422 for i:= 1 step 1 until max_antal_spring do
4 15423 if springtabel(i,3) < 0 then
4 15424 interval:= 5
4 15425 else
4 15426 if springtid(i) <> 0.0 and
4 15427 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15428 interval:= (if springtid(i) <= nu then 0 else
4 15429 round(springtid(i) -nu));
4 15430 if interval=0 then interval:= 1;
4 15431 end;
3 15432 \f
3 15432 message procedure vt_spring side 4a - 810525/cl;
3 15433
3 15433 <* afvent operation eller timeout *>
3 15434 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15435 if komm_op <> 0 then goto afkod_operation;
3 15436
3 15436 <* timeout *>
3 15437 systime(1,0.0,nu);
3 15438 nr:= 1;
3 15439 næste_sekv:
3 15440 if nr > max_antal_spring then goto næste_tid;
3 15441 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15442 begin
4 15443 nr:= nr +1;
4 15444 goto næste_sekv;
4 15445 end;
3 15446 disable s:= modif_fil(tf_springdef,nr,zi);
3 15447 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15448 if springtabel(nr,3) < 0 then
3 15449 begin <* hængende spring *>
4 15450 if springtid(nr) <= nu then
4 15451 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15452 <* find frit løb *>
5 15453 disable
5 15454 begin
6 15455 id2:= 0;
6 15456 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15457 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15458 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15459 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15460 end;
5 15461 <* send meddelelse til io *>
5 15462 io_meddelelse(5,0,id2,nr);
5 15463
5 15463 <* annuler spring*>
5 15464 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15465 springtid(nr):= springstart(nr):= 0.0;
5 15466 end
4 15467 else
4 15468 begin <* forsøg igen *>
5 15469 \f
5 15469 message procedure vt_spring side 5 - 810525/cl;
5 15470
5 15470 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15471 if i = 2 <* første spring ej udført *> then
5 15472 begin
6 15473 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15474 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15475 id2:= id1;
6 15476 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15477 end
5 15478 else
5 15479 begin
6 15480 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15481 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15482 id2:= id1 shift (-7) shift 7
6 15483 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15484 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15485 end;
5 15486
5 15486 <* check resultat *>
5 15487 medd_kode:= if res = 3 and i = 2 then 7 else
5 15488 if res = 3 and i > 2 then 8 else
5 15489 <* if res = 9 then 1 else
5 15490 if res =12 then 2 else
5 15491 if res =14 then 4 else
5 15492 if res =18 then 3 else *>
5 15493 0;
5 15494 if medd_kode > 0 then
5 15495 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15496 id2 else id1,nr);
5 15497 if res = 3 then
5 15498 begin <* spring udført *>
6 15499 disable s:= modiffil(tf_springdef,nr,zi);
6 15500 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15501 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15502 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15503 if i > 2 then fil(zi).iaf(2+i-2):=
6 15504 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15505 end;
5 15506 end;
4 15507 end <* hængende spring *>
3 15508 else
3 15509 begin
4 15510 i:= spring_tabel(nr,3) shift (-12);
4 15511 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15512 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15513 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15514 + id1 shift (-7) shift 7;
4 15515 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15516 \f
4 15516 message procedure vt_spring side 6 - 820304/cl;
4 15517
4 15517 <* check resultat *>
4 15518 medd_kode:= if res = 3 then 8 else
4 15519 if res = 9 then 1 else
4 15520 if res =12 then 2 else
4 15521 if res =14 then 4 else
4 15522 if res =18 then 3 else
4 15523 if res =60 then 9 else 0;
4 15524 if medd_kode > 0 then
4 15525 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15526
4 15526 <* opdater springtabel *>
4 15527 disable s:= modiffil(tf_springdef,nr,zi);
4 15528 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15529 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15530 begin
5 15531 io_meddelelse(if res=3 then 6 else 5,0,
5 15532 if res=3 then id1 else id2,nr);
5 15533 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15534 springtid(nr):= springstart(nr):= 0.0;
5 15535 end
4 15536 else
4 15537 begin
5 15538 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15539 if res = 3 then
5 15540 begin
6 15541 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15542 (fil(zi).iaf(2+i-1) extract 22);
6 15543 fil(zi).iaf(2+i) := (1 shift 22) add
6 15544 (fil(zi).iaf(2+i) extract 22);
6 15545 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15546 end
5 15547 else
5 15548 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15549 end;
4 15550 end;
3 15551 <*+2*>
3 15552 <**> disable
3 15553 <**> if testbit44 and overvåget then
3 15554 <**> begin
4 15555 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15556 <**> p_springtabel(out); ud;
4 15557 <**> end;
3 15558 <*-2*>
3 15559
3 15559 nr:= nr +1;
3 15560 goto næste_sekv;
3 15561 \f
3 15561 message procedure vt_spring side 7 - 810506/cl;
3 15562
3 15562 afkod_operation:
3 15563 <*+2*>
3 15564 <**> disable
3 15565 <**> if testbit41 and overvåget then
3 15566 <**> begin
4 15567 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15568 <**> skriv_op(out,komm_op);
4 15569 <**> end;
3 15570 <*-2*>
3 15571
3 15571 disable
3 15572 begin integer opk;
4 15573
4 15573 opk:= d.komm_op.opkode extract 12;
4 15574 funk:= if opk = 30 <*sp,d*> then 5 else
4 15575 if opk = 31 <*sp. *> then 1 else
4 15576 if opk = 32 <*sp,v*> then 4 else
4 15577 if opk = 33 <*sp,o*> then 6 else
4 15578 if opk = 34 <*sp,r*> then 2 else
4 15579 if opk = 35 <*sp,a*> then 3 else
4 15580 0;
4 15581 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15582
4 15582 if funk <> 6 <*sp,o*> then
4 15583 begin <* find nr i springtabel *>
5 15584 nr:= 0;
5 15585 for i:= 1 step 1 until max_antal_spring do
5 15586 if springtabel(i,1) = d.komm_op.data(1) and
5 15587 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15588 end;
4 15589 end;
3 15590 if funk = 6 then goto oversigt;
3 15591 if funk = 5 then goto definer;
3 15592
3 15592 if nr = 0 then
3 15593 begin
4 15594 returner_op(komm_op,37<*spring ukendt*>);
4 15595 goto næste_tid;
4 15596 end;
3 15597
3 15597 goto case funk of(start,indsæt,annuler,vis);
3 15598 \f
3 15598 message procedure vt_spring side 8 - 810525/cl;
3 15599
3 15599 start:
3 15600 if springtabel(nr,3) shift (-12) <> 0 then
3 15601 begin returner_op(komm_op,38); goto næste_tid; end;
3 15602 disable
3 15603 begin <* find linie_løb_og_udtag *>
4 15604 s:= modif_fil(tf_springdef,nr,zi);
4 15605 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15606 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15607 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15608 id2:= 0;
4 15609 end;
3 15610 vt_operation(12,id1,id2,res,res_inf);
3 15611
3 15611 disable <* check resultat *>
3 15612 medd_kode:= if res = 3 <*ok*> then 7 else
3 15613 if res = 9 <*linie/løb ukendt*> then 1 else
3 15614 if res =14 <*optaget*> then 4 else
3 15615 if res =18 <*i kø*> then 3 else 0;
3 15616 returner_op(komm_op,3);
3 15617 if medd_kode = 0 then goto næste_tid;
3 15618
3 15618 <* send spring-meddelelse til io *>
3 15619 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15620
3 15620 <* opdater springtabel *>
3 15621 disable
3 15622 begin
4 15623 s:= modif_fil(tf_springdef,nr,zi);
4 15624 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15625 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15626 add (springtabel(nr,3) extract 12);
4 15627 systime(1,0.0,nu);
4 15628 springstart(nr):= nu;
4 15629 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15630 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15631 end;
3 15632 <*+2*>
3 15633 <**> disable
3 15634 <**> if testbit44 and overvåget then
3 15635 <**> begin
4 15636 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15637 <**> p_springtabel(out); ud;
4 15638 <**> end;
3 15639 <*-2*>
3 15640
3 15640 goto næste_tid;
3 15641 \f
3 15641 message procedure vt_spring side 9 - 810506/cl;
3 15642
3 15642 indsæt:
3 15643 if springtabel(nr,3) shift (-12) = 0 then
3 15644 begin <* ikke igangsat *>
4 15645 returner_op(komm_op,41);
4 15646 goto næste_tid;
4 15647 end;
3 15648 <* find frie linie/løb *>
3 15649 disable
3 15650 begin
4 15651 s:= læs_fil(tf_springdef,nr,zi);
4 15652 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15653 id2:= 0;
4 15654 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15655 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15656 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15657 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15658 id1:= d.komm_op.data(3);
4 15659 end;
3 15660
3 15660 if id2<>0 then
3 15661 vt_operation(11,id1,id2,res,res_inf)
3 15662 else
3 15663 res:= 42;
3 15664
3 15664 disable <* check resultat *>
3 15665 medd_kode:= if res = 3 <*ok*> then 8 else
3 15666 if res =10 <*bus ukendt*> then 0 else
3 15667 if res =11 <*bus allerede indsat*> then 0 else
3 15668 if res =12 <*linie/løb allerede besat*> then 2 else
3 15669 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15670 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15671 returner_op(komm_op,res);
3 15672 if medd_kode = 0 then goto næste_tid;
3 15673
3 15673 <* send springmeddelelse til io *>
3 15674 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15675 io_meddelelse(5,0,0,nr);
3 15676 \f
3 15676 message procedure vt_spring side 9a - 810525/cl;
3 15677
3 15677 <* annuler springtabel *>
3 15678 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15679 springtid(nr):= springstart(nr):= 0.0;
3 15680 <*+2*>
3 15681 <**> disable
3 15682 <**> if testbit44 and overvåget then
3 15683 <**> begin
4 15684 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15685 <**> p_springtabel(out); ud;
4 15686 <**> end;
3 15687 <*-2*>
3 15688
3 15688 goto næste_tid;
3 15689 \f
3 15689 message procedure vt_spring side 10 - 810525/cl;
3 15690
3 15690 annuler:
3 15691 disable
3 15692 begin <* find evt. frit linie/løb *>
4 15693 s:= læs_fil(tf_springdef,nr,zi);
4 15694 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15695 id1:= id2:= 0;
4 15696 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15697 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15698 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15699 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15700 returner_op(komm_op,3);
4 15701 end;
3 15702
3 15702 <* send springmeddelelse til io *>
3 15703 io_meddelelse(5,id1,id2,nr);
3 15704
3 15704 <* annuler springtabel *>
3 15705 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15706 springtid(nr):= springstart(nr):= 0.0;
3 15707 <*+2*>
3 15708 <**> disable
3 15709 <**> if testbit44 and overvåget then
3 15710 <**> begin
4 15711 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15712 <**> p_springtabel(out); ud;
4 15713 <**> end;
3 15714 <*-2*>
3 15715
3 15715 goto næste_tid;
3 15716
3 15716 definer:
3 15717 if nr <> 0 then <* allerede defineret *>
3 15718 begin
4 15719 res:= 36;
4 15720 goto slut_definer;
4 15721 end;
3 15722
3 15722 <* find frit nr *>
3 15723 i:= 0;
3 15724 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15725 if springtabel(i,1) = 0 then nr:= i;
3 15726 if nr = 0 then
3 15727 begin
4 15728 res:= 32; <* ingen fri plads *>
4 15729 goto slut_definer;
4 15730 end;
3 15731 \f
3 15731 message procedure vt_spring side 11 - 810525/cl;
3 15732
3 15732 disable
3 15733 begin integer array fdim(1:8),ia(1:32);
4 15734 <* læs sekvens *>
4 15735 fdim(4):= d.komm_op.data(3);
4 15736 s:= hent_fil_dim(fdim);
4 15737 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15738 if fdim(1) > 30 then
4 15739 res:= 35 <* springsekvens for stor *>
4 15740 else
4 15741 begin
5 15742 for i:= 1 step 1 until fdim(1) do
5 15743 begin
6 15744 s:= læs_fil(fdim(4),i,zi);
6 15745 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15746 ia(i):= fil(zi).iaf(1) shift 12;
6 15747 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15748 end;
5 15749 s:= modif_fil(tf_springdef,nr,zi);
5 15750 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15751 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15752 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15753 iaf:= 4;
5 15754 tofrom(fil(zi).iaf,ia,60);
5 15755 iaf:= 0;
5 15756 springtabel(nr,3):= fdim(1);
5 15757 springtid(nr):= springstart(nr):= 0.0;
5 15758 res:= 3;
5 15759 end;
4 15760 end;
3 15761 \f
3 15761 message procedure vt_spring side 11a - 81-525/cl;
3 15762
3 15762 slut_definer:
3 15763
3 15763 <* slet fil *>
3 15764 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15765 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15766 signalch(cs_slet_fil,spr_op,vt_optype);
3 15767 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15768 if d.spr_op.data(9) <> 0 then
3 15769 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15770 returner_op(komm_op,res);
3 15771 <*+2*>
3 15772 <**> disable
3 15773 <**> if testbit44 and overvåget then
3 15774 <**> begin
4 15775 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15776 <**> p_springtabel(out); ud;
4 15777 <**> end;
3 15778 <*-2*>
3 15779 goto næste_tid;
3 15780 \f
3 15780 message procedure vt_spring side 12 - 810525/cl;
3 15781
3 15781 vis:
3 15782 disable
3 15783 begin
4 15784 <* tilknyt fil *>
4 15785 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15786 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15787 d.spr_op.data(2):= 1;
4 15788 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15789 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15790 signalch(cs_opret_fil,spr_op,vt_optype);
4 15791 end;
3 15792
3 15792 <* afvent svar *>
3 15793 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15794 if d.spr_op.data(9) <> 0 then
3 15795 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15796 disable
3 15797 begin integer array ia(1:30);
4 15798 s:= læs_fil(tf_springdef,nr,zi);
4 15799 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15800 iaf:= 4;
4 15801 tofrom(ia,fil(zi).iaf,60);
4 15802 iaf:= 0;
4 15803 for i:= 1 step 1 until d.spr_op.data(1) do
4 15804 begin
5 15805 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15806 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15807 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15808 ia(i) shift (-12) extract 7
5 15809 else -(ia(i) shift (-12) extract 7);
5 15810 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15811 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15812 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15813 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15814 else ia(i) extract 12)
5 15815 else 0;
5 15816 end;
4 15817 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15818 sæt_fil_dim(d.spr_op.data);
4 15819 d.komm_op.data(3):= d.spr_op.data(1);
4 15820 d.komm_op.data(4):= d.spr_op.data(4);
4 15821 raf:= data+8;
4 15822 d.komm_op.raf(1):= springstart(nr);
4 15823 returner_op(komm_op,3);
4 15824 end;
3 15825 goto næste_tid;
3 15826 \f
3 15826 message procedure vt_spring side 13 - 810525/cl;
3 15827
3 15827 oversigt:
3 15828 disable
3 15829 begin
4 15830 <* opret fil *>
4 15831 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15832 d.spr_op.data(1):= max_antal_spring;
4 15833 d.spr_op.data(2):= 4;
4 15834 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15835 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15836 signalch(cs_opret_fil,spr_op,vt_optype);
4 15837 end;
3 15838
3 15838 <* afvent svar *>
3 15839 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15840 if d.spr_op.data(9) <> 0 then
3 15841 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15842 disable
3 15843 begin
4 15844 nr:= 0;
4 15845 for i:= 1 step 1 until max_antal_spring do
4 15846 begin
5 15847 if springtabel(i,1) <> 0 then
5 15848 begin
6 15849 nr:= nr +1;
6 15850 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15851 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15852 fil(zi).iaf(1):= springtabel(i,1);
6 15853 fil(zi).iaf(2):= springtabel(i,2);
6 15854 fil(zi,2):= springstart(i);
6 15855 end;
5 15856 end;
4 15857 d.spr_op.data(1):= nr;
4 15858 s:= sæt_fil_dim(d.spr_op.data);
4 15859 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15860 d.komm_op.data(1):= nr;
4 15861 d.komm_op.data(2):= d.spr_op.data(4);
4 15862 returner_op(komm_op,3);
4 15863 end;
3 15864 goto næste_tid;
3 15865
3 15865 vt_spring_trap:
3 15866 disable skriv_vt_spring(zbillede,1);
3 15867
3 15867 end vt_spring;
2 15868 \f
2 15868 message procedure vt_auto side 1 - 810505/cl;
2 15869
2 15869 procedure vt_auto(cs_auto_retur,auto_opref);
2 15870 value cs_auto_retur,auto_opref;
2 15871 integer cs_auto_retur,auto_opref;
2 15872 begin
3 15873 integer array field op,auto_op,iaf;
3 15874 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15875 res_inf,i,s,zi,kl,døgnstart;
3 15876 real t,nu,næste_tid;
3 15877 boolean optaget;
3 15878 integer array filnavn,nytnavn(1:4);
3 15879
3 15879 procedure skriv_vt_auto(zud,omfang);
3 15880 value omfang;
3 15881 zone zud;
3 15882 integer omfang;
3 15883 begin
4 15884 long array field laf;
4 15885
4 15885 laf:= 0;
4 15886 write(zud,"nl",1,<:+++ vt_auto :>);
4 15887 if omfang<>0 then
4 15888 begin
5 15889 skriv_coru(zud,abs curr_coruno);
5 15890 write(zud,"nl",1,<<d>,
5 15891 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15892 <:op :>,op,"nl",1,
5 15893 <:auto-op :>,auto_op,"nl",1,
5 15894 <:filref :>,filref,"nl",1,
5 15895 <:id1 :>,id1,"nl",1,
5 15896 <:id2 :>,id2,"nl",1,
5 15897 <:aktion :>,aktion,"nl",1,
5 15898 <:postnr :>,postnr,"nl",1,
5 15899 <:sidste-post :>,sidste_post,"nl",1,
5 15900 <:interval :>,interval,"nl",1,
5 15901 <:res :>,res,"nl",1,
5 15902 <:res-inf :>,res_inf,"nl",1,
5 15903 <:i :>,i,"nl",1,
5 15904 <:s :>,s,"nl",1,
5 15905 <:zi :>,zi,"nl",1,
5 15906 <:kl :>,kl,"nl",1,
5 15907 <:døgnstart :>,døgnstart,"nl",1,
5 15908 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15909 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15910 <:nu :>,nu,"nl",1,
5 15911 <:næste-tid :>,næste_tid,"nl",1,
5 15912 <:filnavn :>,filnavn.laf,"nl",1,
5 15913 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15914 <::>);
5 15915 end;
4 15916 end skriv_vt_auto;
3 15917 \f
3 15917 message procedure vt_auto side 2 - 810507/cl;
3 15918
3 15918 iaf:= 0;
3 15919 auto_op:= auto_opref;
3 15920 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15921 optaget:= false;
3 15922 næste_tid:= 0.0;
3 15923 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15924 stack_claim(if cm_test then 298 else 246);
3 15925 trap(vt_auto_trap);
3 15926
3 15926 <*+2*>
3 15927 <**> disable if testbit47 and overvåget or testbit28 then
3 15928 <**> skriv_vt_auto(out,0);
3 15929 <*-2*>
3 15930
3 15930 vent:
3 15931
3 15931 systime(1,0.0,nu);
3 15932 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15933 if næste_tid > nu then round(næste_tid-nu) else
3 15934 if optaget then 5 else 0;
3 15935 if interval=0 then interval:= 1;
3 15936
3 15936 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15937
3 15937 if op<>0 then goto filskift;
3 15938
3 15938 <* vent på adgang til vogntabel *>
3 15939 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15940
3 15940 <* afsend relevant operation til opdatering af vogntabel *>
3 15941 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15942 d.op.data(1):= id1;
3 15943 d.op.data(2):= id2;
3 15944 signalch(cs_vt_opd,op,vt_optype);
3 15945 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15946 res:= d.op.resultat;
3 15947 id2:= d.op.data(2);
3 15948 res_inf:= d.op.data(3);
3 15949
3 15949 <* åbn for vogntabel *>
3 15950 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15951 \f
3 15951 message procedure vt_auto side 3 - 810507/cl;
3 15952
3 15952 <* behandl svar fra opdatering *>
3 15953 <*+2*>
3 15954 <**> disable
3 15955 <**> if testbit45 and overvåget then
3 15956 <**> begin
4 15957 <**> integer li,lø,bo;
4 15958 <**> skriv_vt_auto(out,0);
4 15959 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15960 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15961 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15962 <**> for i:= 1,2 do
4 15963 <**> begin
5 15964 <**> li:= d.op.data(i);
5 15965 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15966 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15967 <**> li:= li shift (-12) extract 10;
5 15968 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15969 <**> end;
4 15970 <**> systime(4,næste_tid,t);
4 15971 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15972 <**> << zd.dd>,t/10000,"nl",1);
4 15973 <**> end;
3 15974 <*-2*>
3 15975 if res=31 then
3 15976 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15977 else
3 15978 if res<>3 then
3 15979 begin
4 15980 if -, optaget then
4 15981 begin
5 15982 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15983 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15984 if res=18 then 3 else if res=60 then 9 else 4;
5 15985 d.auto_op.data(2):= res_inf;
5 15986 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15987 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15988 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15989 end;
4 15990 if res=14 or res=18 then <* i kø eller optaget *>
4 15991 begin
5 15992 optaget:= true;
5 15993 goto vent;
5 15994 end;
4 15995 end;
3 15996 optaget:= false;
3 15997 \f
3 15997 message procedure vt_auto side 4 - 810507/cl;
3 15998
3 15998 <* find næste post *>
3 15999 disable
3 16000 begin
4 16001 if postnr=sidste_post then
4 16002 begin <* døgnskift *>
5 16003 postnr:= 1;
5 16004 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16005 end
4 16006 else postnr:= postnr+1;
4 16007 s:= læsfil(filref,postnr,zi);
4 16008 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 16009 aktion:= fil(zi).iaf(1);
4 16010 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 16011 id1:= fil(zi).iaf(3);
4 16012 id2:= fil(zi).iaf(4);
4 16013 end;
3 16014 goto vent;
3 16015 \f
3 16015 message procedure vt_auto side 5 - 810507/cl;
3 16016
3 16016 filskift:
3 16017
3 16017 <*+2*>
3 16018 <**> disable
3 16019 <**> if testbit41 and overvåget then
3 16020 <**> begin
4 16021 <**> skriv_vt_auto(out,0);
4 16022 <**> write(out,<: modtaget operation::>);
4 16023 <**> skriv_op(out,op);
4 16024 <**> end;
3 16025 <*-2*>
3 16026 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 16027 res:= 46;
3 16028 if d.op.opkode extract 12 <> 21 then
3 16029 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 16030 if filref = 0 then goto knyt;
3 16031
3 16031 <* gem filnavn til io-meddelelse *>
3 16032 disable begin
4 16033 integer array fdim(1:8);
4 16034 integer array field navn;
4 16035 fdim(4):= filref;
4 16036 hentfildim(fdim);
4 16037 navn:= 8;
4 16038 tofrom(filnavn,fdim.navn,8);
4 16039 end;
3 16040
3 16040 <* frivgiv tilknyttet autofil *>
3 16041 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 16042 d.auto_op.data(4):= filref;
3 16043 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 16044 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 16045 if d.auto_op.data(9) <> 0 then
3 16046 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 16047 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 16048 optaget:= false;
3 16049 næste_tid:= 0.0;
3 16050 res:= 3;
3 16051 \f
3 16051 message procedure vt_auto side 6 - 810507/cl;
3 16052
3 16052 <* tilknyt evt. ny autofil *>
3 16053 knyt:
3 16054 if d.op.data(1)<>0 then
3 16055 begin
4 16056 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 16057 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 16058 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 16059 disable
4 16060 begin integer pos1,pos2;
5 16061 pos1:= pos2:= 13;
5 16062 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 16063 begin
6 16064 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 16065 skrivtegn(d.auto_op.data,pos2,i);
6 16066 end;
5 16067 end;
4 16068 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 16069 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 16070 s:= d.auto_op.data(9);
4 16071 if s=0 then res:= 3 <* ok *> else
4 16072 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 16073 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 16074 if s=6 then res:= 48 <* i brug *> else
4 16075 fejlreaktion(14,2,<:auto,filskift:>,0);
4 16076 if res<>3 then goto returner;
4 16077
4 16077 tofrom(nytnavn,d.op.data,8);
4 16078
4 16078 <* find første post *>
4 16079 disable
4 16080 begin
5 16081 døgnstart:= systime(5,0.0,t);
5 16082 kl:= round t;
5 16083 filref:= d.auto_op.data(4);
5 16084 sidste_post:= d.auto_op.data(1);
5 16085 postnr:= 0;
5 16086 for postnr:= postnr+1 while postnr <= sidste_post do
5 16087 begin
6 16088 s:= læsfil(filref,postnr,zi);
6 16089 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 16090 if fil(zi).iaf(2) > kl then goto post_fundet;
6 16091 end;
5 16092 postnr:= 1;
5 16093 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16094 \f
5 16094 message procedure vt_auto side 7 - 810507/cl;
5 16095
5 16095 post_fundet:
5 16096 s:= læsfil(filref,postnr,zi);
5 16097 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 16098 aktion:= fil(zi).iaf(1);
5 16099 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 16100 id1:= fil(zi).iaf(3);
5 16101 id2:= fil(zi).iaf(4);
5 16102 res:= 3;
5 16103 end;
4 16104 end ny fil;
3 16105
3 16105 returner:
3 16106 d.op.resultat:= res;
3 16107 <*+2*>
3 16108 <**> disable
3 16109 <**> if testbit41 and overvåget then
3 16110 <**> begin
4 16111 <**> skriv_vt_auto(out,0);
4 16112 <**> write(out,<: returner operation::>);
4 16113 <**> skriv_op(out,op);
4 16114 <**> end;
3 16115 <*-2*>
3 16116 signalch(d.op.retur,op,d.op.optype);
3 16117
3 16117 if vt_log_aktiv then
3 16118 begin
4 16119 waitch(cs_vt_logpool,op,vt_optype,-1);
4 16120 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 16121 if nytnavn(1)=0 then
4 16122 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 16123 else
4 16124 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 16125 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 16126 systime(1,0.0,d.op.data.v_tid);
4 16127 signalch(cs_vt_log,op,vt_optype);
4 16128 end;
3 16129
3 16129 if filnavn(1)<>0 then
3 16130 begin <* meddelelse til io om annulering *>
4 16131 disable begin
5 16132 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 16133 i:= 1;
5 16134 hægtstring(d.auto_op.data,i,<:auto :>);
5 16135 skriv_text(d.auto_op.data,i,filnavn);
5 16136 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 16137 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 16138 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16139 end;
4 16140 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 16141 end;
3 16142 goto vent;
3 16143
3 16143 vt_auto_trap:
3 16144 disable skriv_vt_auto(zbillede,1);
3 16145
3 16145 end vt_auto;
2 16146 message procedure vt_log side 1 - 920517/cl;
2 16147
2 16147 procedure vt_log;
2 16148 begin
3 16149 integer i,j,ventetid;
3 16150 real dg,t,nu,skiftetid;
3 16151 boolean fil_åben;
3 16152 integer array ia(1:10),dp,dp1(1:8);
3 16153 integer array field op, iaf;
3 16154
3 16154 procedure skriv_vt_log(zud,omfang);
3 16155 value omfang;
3 16156 zone zud;
3 16157 integer omfang;
3 16158 begin
4 16159 write(zud,"nl",1,<:+++ vt-log :>);
4 16160 if omfang<>0 then
4 16161 begin
5 16162 skriv_coru(zud, abs curr_coruno);
5 16163 write(zud,"nl",1,<<d>,
5 16164 <:i :>,i,"nl",1,
5 16165 <:j :>,j,"nl",1,
5 16166 <:ventetid :>,ventetid,"nl",1,
5 16167 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 16168 <:t :>,t,"nl",1,
5 16169 <:nu :>,nu,"nl",1,
5 16170 <:skiftetid :>,skiftetid,"nl",1,
5 16171 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 16172 <:op :>,<<d>,op,"nl",1,
5 16173 <::>);
5 16174 raf:= 0;
5 16175 write(zud,"nl",1,<:ia::>);
5 16176 skrivhele(zud,ia.raf,20,2);
5 16177 write(zud,"nl",2,<:dp::>);
5 16178 skrivhele(zud,dp.raf,16,2);
5 16179 write(zud,"nl",2,<:dp1::>);
5 16180 skrivhele(zud,dp1.raf,16,2);
5 16181 end;
4 16182 end;
3 16183
3 16183 message procedure vt_log side 2 - 920517/cl;
3 16184
3 16184 procedure slet_fil;
3 16185 begin
4 16186 integer segm,res;
4 16187 integer array tail(1:10);
4 16188
4 16188 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 16189 if res=0 then
4 16190 begin
5 16191 segm:= tail(10);
5 16192 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 16193 if res=0 then
5 16194 begin
6 16195 close(zvtlog,true);
6 16196 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 16197 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16198 if res=0 then
6 16199 begin
7 16200 tail(1):= tail(1)+segm;
7 16201 monitor(44)change_entry:(zvtlog,0,tail);
7 16202 end;
6 16203 end;
5 16204 end;
4 16205 end;
3 16206
3 16206 boolean procedure udvid_fil;
3 16207 begin
4 16208 integer res,spos;
4 16209 integer array tail(1:10);
4 16210 zone z(1,1,stderror);
4 16211
4 16211 udvid_fil:= false;
4 16212 open(z,0,<:vtlogpool:>,0); close(z,true);
4 16213 res:= monitor(42)lookup_entry:(z,0,tail);
4 16214 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 16215 begin
5 16216 tail(1):=tail(1) - vt_log_slicelgd;
5 16217 res:=monitor(44)change_entry:(z,0,tail);
5 16218 if res=0 then
5 16219 begin
6 16220 spos:= vt_logtail(1);
6 16221 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 16222 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 16223 if res<>0 then
6 16224 begin
7 16225 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 16226 tail(1):= tail(1) + vt_log_slicelgd;
7 16227 monitor(44)change_entry:(z,0,tail);
7 16228 end
6 16229 else
6 16230 begin
7 16231 setposition(zvtlog,0,spos);
7 16232 udvid_fil:= true;
7 16233 end;
6 16234 end;
5 16235 end;
4 16236 end;
3 16237
3 16237 message procedure vt_log side 3 - 920517/cl;
3 16238
3 16238 boolean procedure ny_fil;
3 16239 begin
4 16240 integer res,i,j;
4 16241 integer array nyt(1:4), ia,tail(1:10);
4 16242 long array field navn;
4 16243 real t;
4 16244
4 16244 navn:=0;
4 16245 if fil_åben then
4 16246 begin
5 16247 close(zvtlog,true);
5 16248 fil_åben:= false;
5 16249 nyt.navn(1):= long<:vtlo:>;
5 16250 nyt.navn(2):= long<::>;
5 16251 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 16252 j:= 'a' - 1;
5 16253 repeat
5 16254 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 16255 if res=3 then
5 16256 begin
6 16257 j:= j+1;
6 16258 if j <= 'å' then skrivtegn(nyt,11,j);
6 16259 end;
5 16260 until (res<>3) or (j > 'å');
5 16261
5 16261 if res=0 then
5 16262 begin
6 16263 open(zvtlog,4,<:vtlogklar:>,0);
6 16264 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16265 if res=0 then
6 16266 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 16267 if res=0 then
6 16268 begin
7 16269 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 16270 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 16271 end;
6 16272
6 16272 if res=0 then
6 16273 begin
7 16274 setposition(zvtlog,0,tail(10)//64);
7 16275 navn:= (tail(10) mod 64)*8;
7 16276 if (tail(1) <= tail(10)//64) then
7 16277 outrec6(zvtlog,512)
7 16278 else
7 16279 swoprec6(zvtlog,512);
7 16280 tofrom(zvtlog.navn,nyt,8);
7 16281 tail(10):= tail(10)+1;
7 16282 setposition(zvtlog,0,tail(10)//64);
7 16283 monitor(44)change_entry:(zvtlog,0,tail);
7 16284 close(zvtlog,true);
7 16285 end
6 16286 else
6 16287 begin
7 16288 navn:= 0;
7 16289 close(zvtlog,true);
7 16290 open(zvtlog,4,<:vtlog:>,0);
7 16291 slet_fil;
7 16292 end;
6 16293 end
5 16294 else
5 16295 slet_fil;
5 16296 end;
4 16297
4 16297 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 16298 <* eller den er blevet slettet. *>
4 16299
4 16299 open(zvtlog,4,<:vtlog:>,0);
4 16300 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 16301 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 16302 vt_logtail(6):= systime(7,0,t);
4 16303
4 16303 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 16304 if res=0 then
4 16305 begin
5 16306 monitor(50)permanent_entry:(zvtlog,3,ia);
5 16307 if res<>0 then
5 16308 monitor(48)remove_entry:(zvtlog,0,ia);
5 16309 end;
4 16310
4 16310 if res=0 then fil_åben:= true;
4 16311
4 16311 ny_fil:= fil_åben;
4 16312 end ny_fil;
3 16313
3 16313 message procedure vt_log side 4 - 920517/cl;
3 16314
3 16314 procedure skriv_post(logpost);
3 16315 integer array logpost;
3 16316 begin
4 16317 integer array field post;
4 16318 real t;
4 16319
4 16319 if vt_logtail(10)//32 < vt_logtail(1) then
4 16320 begin
5 16321 outrec6(zvtlog,512);
5 16322 post:= (vt_logtail(10) mod 32)*16;
5 16323 tofrom(zvtlog.post,logpost,16);
5 16324 vt_logtail(10):= vt_logtail(10)+1;
5 16325 setposition(zvtlog,0,vt_logtail(10)//32);
5 16326 vt_logtail(6):= systime(7,0,t);
5 16327 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 16328 end;
4 16329 end;
3 16330
3 16330 procedure sletsendte;
3 16331 begin
4 16332 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 16333 integer array pooltail,tail,ia(1:10);
4 16334 integer i,res;
4 16335
4 16335 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 16336 res:=monitor(42,zpool,0,pooltail);
4 16337
4 16337 open(z,4,<:vtlogslet:>,0);
4 16338 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 16339 begin
5 16340 if monitor(52,z,0,tail)=0 then
5 16341 begin
6 16342 if monitor(8,z,0,tail)=0 then
6 16343 begin
7 16344 for i:=1 step 1 until tail(10) do
7 16345 begin
8 16346 inrec6(z,8);
8 16347 open(zlog,0,z,0); close(zlog,true);
8 16348 if monitor(42,zlog,0,ia)=0 then
8 16349 begin
9 16350 if monitor(48,zlog,0,ia)=0 then
9 16351 begin
10 16352 pooltail(1):=pooltail(1)+ia(1);
10 16353 end;
9 16354 end;
8 16355 end;
7 16356 tail(10):=0;
7 16357 monitor(44,z,0,tail);
7 16358 end
6 16359 else
6 16360 monitor(64,z,0,tail);
6 16361 end;
5 16362 if res=0 then monitor(44,zpool,0,pooltail);
5 16363 end;
4 16364 close(z,true);
4 16365 end;
3 16366
3 16366 message procedure vt_log side 5 - 920517/cl;
3 16367
3 16367 trap(vt_log_trap);
3 16368 stack_claim(200);
3 16369
3 16369 fil_åben:= false;
3 16370 if -, vt_log_aktiv then goto init_slut;
3 16371 open(zvtlog,4,<:vtlog:>,0);
3 16372 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16373 if i=0 then
3 16374 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16375 if i=0 then
3 16376 begin
4 16377 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16378 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16379 end;
3 16380
3 16380 if (i=0) and (vt_logtail(1)=0) then
3 16381 begin
4 16382 close(zvtlog,true);
4 16383 monitor(48)remove_entry:(zvtlog,0,ia);
4 16384 i:= 1;
4 16385 end;
3 16386
3 16386 disable
3 16387 if i=0 then
3 16388 begin
4 16389 fil_åben:= true;
4 16390 inrec6(zvtlog,512);
4 16391 vt_logstart:= zvtlog.v_tid;
4 16392 systime(1,0.0,nu);
4 16393 if (nu - vt_logstart) < 24*60*60.0 then
4 16394 begin
5 16395 setposition(zvtlog,0,vt_logtail(10)//32);
5 16396 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16397 begin
6 16398 inrec6(zvtlog,512);
6 16399 setposition(zvtlog,0,vt_logtail(10)//32);
6 16400 end;
5 16401 end
4 16402 else
4 16403 begin
5 16404 if ny_fil then
5 16405 begin
6 16406 if udvid_fil then
6 16407 begin
7 16408 systime(1,0.0,dp.v_tid);
7 16409 vt_logstart:= dp.v_tid;
7 16410 dp.v_kode:=0;
7 16411 skriv_post(dp);
7 16412 end
6 16413 else
6 16414 begin
7 16415 close(zvtlog,true);
7 16416 monitor(48)remove_entry:(zvtlog,0,ia);
7 16417 fil_åben:= false;
7 16418 end;
6 16419 end;
5 16420 end;
4 16421 end
3 16422 else
3 16423 begin
4 16424 close(zvtlog,true);
4 16425 if ny_fil then
4 16426 begin
5 16427 if udvid_fil then
5 16428 begin
6 16429 systime(1,0.0,dp.v_tid);
6 16430 vt_logstart:= dp.v_tid;
6 16431 dp.v_kode:=0;
6 16432 skriv_post(dp);
6 16433 end
5 16434 else
5 16435 begin
6 16436 close(zvtlog,true);
6 16437 monitor(48)remove_entry:(zvtlog,0,ia);
6 16438 fil_åben:= false;
6 16439 end;
5 16440 end;
4 16441 end;
3 16442
3 16442 init_slut:
3 16443
3 16443 dg:= systime(5,0,t);
3 16444 if t < vt_logskift then
3 16445 skiftetid:= systid(dg,vt_logskift)
3 16446 else
3 16447 skiftetid:= systid(dg+1,vt_logskift);
3 16448
3 16448 message procedure vt_log side 6 - 920517/cl;
3 16449
3 16449 vent:
3 16450
3 16450 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16451 ventetid:= round(skiftetid - nu);
3 16452 if ventetid < 1 then ventetid:= 1;
3 16453
3 16453 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16454
3 16454 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16455 if op <> 0 then
3 16456 begin
4 16457 tofrom(dp,d.op.data,16);
4 16458 signalch(cs_vt_logpool,op,vt_optype);
4 16459 end;
3 16460
3 16460 if -, vt_log_aktiv then goto vent;
3 16461
3 16461 disable if (op=0) or (nu > skiftetid) then
3 16462 begin
4 16463 if fil_åben then
4 16464 begin
5 16465 dp1.v_tid:= systid(dg,vt_logskift);
5 16466 dp1.v_kode:= 1;
5 16467 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16468 begin
6 16469 if udvid_fil then
6 16470 skriv_post(dp1);
6 16471 end
5 16472 else
5 16473 skriv_post(dp1);
5 16474 end;
4 16475
4 16475 if (op=0) or (nu > skiftetid) then
4 16476 skiftetid:= skiftetid + 24*60*60.0;
4 16477
4 16477 sletsendte;
4 16478
4 16478 if ny_fil then
4 16479 begin
5 16480 if udvid_fil then
5 16481 begin
6 16482 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16483 dp1.v_kode:= 0;
6 16484 skriv_post(dp1);
6 16485 end
5 16486 else
5 16487 begin
6 16488 close(zvtlog,true);
6 16489 monitor(48)remove_entry:(zvtlog,0,ia);
6 16490 fil_åben:= false;
6 16491 end;
5 16492 end;
4 16493 end;
3 16494
3 16494 disable if op<>0 and fil_åben then
3 16495 begin
4 16496 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16497 begin
5 16498 if -, udvid_fil then
5 16499 begin
6 16500 if ny_fil then
6 16501 begin
7 16502 if udvid_fil then
7 16503 begin
8 16504 systime(1,0.0,dp1.v_tid);
8 16505 vt_logstart:= dp1.v_tid;
8 16506 dp1.v_kode:= 0;
8 16507 skriv_post(dp1);
8 16508 end
7 16509 else
7 16510 begin
8 16511 close(zvtlog,true);
8 16512 monitor(48)remove_entry:(zvtlog,0,ia);
8 16513 fil_åben:= false;
8 16514 end;
7 16515 end;
6 16516 end;
5 16517 end;
4 16518
4 16518 if fil_åben then skriv_post(dp);
4 16519 end;
3 16520
3 16520 goto vent;
3 16521
3 16521 vt_log_trap:
3 16522 disable skriv_vt_log(zbillede,1);
3 16523 end vt_log;
2 16524 \f
2 16524
2 16524 algol list.off;
2 16525 message coroutinemonitor - 11 ;
2 16526
2 16526
2 16526 <*************** coroutine monitor procedures ***************>
2 16527
2 16527
2 16527 <***** delay *****
2 16528
2 16528 this procedure links the calling coroutine into the timerqueue and sets
2 16529 the timeout value to 'timeout'. *>
2 16530
2 16530
2 16530 procedure delay (timeout);
2 16531 value timeout;
2 16532 integer timeout;
2 16533 begin
3 16534 link(current, idlequeue);
3 16535 link(current + corutimerchain, timerqueue);
3 16536 d.current.corutimer:= timeout;
3 16537
3 16537
3 16537 passivate;
3 16538 d.current.corutimer:= 0;
3 16539 end;
2 16540 \f
2 16540
2 16540 message coroutinemonitor - 12 ;
2 16541
2 16541
2 16541 <***** pass *****
2 16542
2 16542 this procedure moves the calling coroutine from the head of the ready
2 16543 queue down below all coroutines of lower or equal priority. *>
2 16544
2 16544
2 16544 procedure pass;
2 16545 begin
3 16546 linkprio(current, readyqueue);
3 16547
3 16547
3 16547 passivate;
3 16548 end;
2 16549
2 16549
2 16549 <***** signal ****
2 16550
2 16550 this procedure increases the value af 'semaphore' by 1.
2 16551 in case some coroutine is already waiting, it is linked into the ready
2 16552 queue for activation. the calling coroutine continues execution. *>
2 16553
2 16553
2 16553 procedure signal (semaphore);
2 16554 value semaphore;
2 16555 integer semaphore;
2 16556 begin
3 16557 integer array field sem;
3 16558 sem:= semaphore;
3 16559 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16560 d.sem.simvalue:= d.sem.simvalue + 1;
3 16561
3 16561
3 16561 end;
2 16562 \f
2 16562
2 16562 message coroutinemonitor - 13 ;
2 16563
2 16563
2 16563 <***** wait *****
2 16564
2 16564 this procedure decreases the value of 'semaphore' by 1.
2 16565 in case the value of the semaphore is negative after the decrease, the
2 16566 calling coroutine is linked into the semaphore queue waiting for a
2 16567 coroutine to signal this semaphore. *>
2 16568
2 16568
2 16568 procedure wait (semaphore);
2 16569 value semaphore;
2 16570 integer semaphore;
2 16571 begin
3 16572 integer array field sem;
3 16573 sem:= semaphore;
3 16574 d.sem.simvalue:= d.sem.simvalue - 1;
3 16575
3 16575
3 16575 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16576 passivate;
3 16577 end;
2 16578 \f
2 16578
2 16578 message coroutinemonitor - 14 ;
2 16579
2 16579
2 16579 <***** inspect *****
2 16580
2 16580 this procedure inspects the value of the semaphore and returns it in
2 16581 'elements'.
2 16582 the semaphore is left unchanged. *>
2 16583
2 16583
2 16583 procedure inspect (semaphore, elements);
2 16584 value semaphore;
2 16585 integer semaphore, elements;
2 16586 begin
3 16587 integer array field sem;
3 16588 sem:= semaphore;
3 16589 elements:= d.sem.simvalue;
3 16590
3 16590
3 16590 end;
2 16591 \f
2 16591
2 16591 message coroutinemonitor - 15 ;
2 16592
2 16592
2 16592 <***** signalch *****
2 16593
2 16593 this procedure delivers an operation at 'semaphore'.
2 16594 in case another coroutine is already waiting for an operation of the
2 16595 kind 'operationtype' this coroutine will get the operation and it will
2 16596 be put into the ready queue for activation.
2 16597 in case no coroutine is waiting for the actial kind of operation it is
2 16598 linked into the semaphore queue, at the end of the queue
2 16599 if operation is positive and at the beginning if operation is negative.
2 16600 the calling coroutine continues execution. *>
2 16601
2 16601
2 16601 procedure signalch (semaphore, operation, operationtype);
2 16602 value semaphore, operation, operationtype;
2 16603 integer semaphore, operation;
2 16604 boolean operationtype;
2 16605 begin
3 16606 integer array field firstcoru, currcoru, op,currop;
3 16607 op:= abs operation;
3 16608 d.op.optype:= operationtype;
3 16609 firstcoru:= semaphore + semcoru;
3 16610 currcoru:= d.firstcoru.next;
3 16611 while currcoru <> firstcoru do
3 16612 begin
4 16613 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16614 begin
5 16615 link(operation, 0);
5 16616 d.currcoru.coruop:= operation;
5 16617 linkprio(currcoru, readyqueue);
5 16618 link(currcoru + corutimerchain, idlequeue);
5 16619 goto exit;
5 16620 end else currcoru:= d.currcoru.next;
4 16621 end;
3 16622 currop:=semaphore + semop;
3 16623 if operation < 0 then currop:=d.currop.next;
3 16624 link(op, currop);
3 16625 exit:
3 16626
3 16626
3 16626 end;
2 16627 \f
2 16627
2 16627 message coroutinemonitor - 16 ;
2 16628
2 16628
2 16628 <***** waitch *****
2 16629
2 16629 this procedure fetches an operation from a semaphore.
2 16630 in case an operation matching 'operationtypeset' is already waiting at
2 16631 'semaphore' it is handed over to the calling coroutine.
2 16632 in case no matching operation is waiting, the calling coroutine is
2 16633 linked to the semaphore.
2 16634 in any case the calling coroutine will be stopped and all corouti-
2 16635 nes are rescheduled. *>
2 16636
2 16636
2 16636 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16637 value semaphore, operationtypeset, timeout;
2 16638 integer semaphore, operation, timeout;
2 16639 boolean operationtypeset;
2 16640 begin
3 16641 integer array field firstop, currop;
3 16642 firstop:= semaphore + semop;
3 16643 currop:= d.firstop.next;
3 16644
3 16644
3 16644 while currop <> firstop do
3 16645 begin
4 16646 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16647 begin
5 16648 link(currop, 0);
5 16649 d.current.coruop:= currop;
5 16650 operation:= currop;
5 16651 \f
5 16651
5 16651 message coroutinemonitor - 17 ;
5 16652
5 16652 linkprio(current, readyqueue);
5 16653 passivate;
5 16654 goto exit;
5 16655 end else currop:= d.currop.next;
4 16656 end;
3 16657 linkprio(current, semaphore + semcoru);
3 16658 if timeout > 0 then
3 16659 begin
4 16660 link(current + corutimerchain, timerqueue);
4 16661 d.current.corutimer:= timeout;
4 16662 end else d.current.corutimer:= 0;
3 16663 d.current.corutypeset:= operationtypeset;
3 16664 passivate;
3 16665 if d.current.corutimer < 0 then operation:= 0
3 16666 else operation:= d.current.coruop;
3 16667 d.current.corutimer:= 0;
3 16668 currop:= operation;
3 16669 d.current.coruop:= currop;
3 16670 link(current+corutimerchain, idlequeue);
3 16671 exit:
3 16672
3 16672
3 16672 end;
2 16673 \f
2 16673
2 16673 message coroutinemonitor - 18 ;
2 16674
2 16674
2 16674 <***** inspectch *****
2 16675
2 16675 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16676 the number of matching operations are counted and delivered in 'elements'.
2 16677 if no operations are found the number of coroutines waiting
2 16678 for operations of the typeset are counted and delivered as
2 16679 negative value in 'elements'.
2 16680 the semaphore is left unchanged. *>
2 16681
2 16681
2 16681 procedure inspectch (semaphore, operationtypeset, elements);
2 16682 value semaphore, operationtypeset;
2 16683 integer semaphore, elements;
2 16684 boolean operationtypeset;
2 16685 begin
3 16686 integer array field firstop, currop,firstcoru,currcoru;
3 16687 integer counter;
3 16688 counter:= 0;
3 16689 firstop:= semaphore + semop;
3 16690 currop:= d.firstop.next;
3 16691 while currop <> firstop do
3 16692 begin
4 16693 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16694 counter:= counter + 1;
4 16695 currop:= d.currop.next;
4 16696 end;
3 16697 if counter=0 then
3 16698 begin
4 16699 firstcoru:=semaphore + sem_coru;
4 16700 curr_coru:=d.firstcoru.next;
4 16701 while curr_coru<>first_coru do
4 16702 begin
5 16703 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16704 counter:=counter - 1;
5 16705 curr_coru:=d.curr_coru.next;
5 16706 end;
4 16707 end;
3 16708 elements:= counter;
3 16709
3 16709
3 16709 end;
2 16710 \f
2 16710
2 16710 message coroutinemonitor - 19 ;
2 16711
2 16711
2 16711 <***** csendmessage *****
2 16712
2 16712 this procedure sends the message in 'mess' to the process defined by the name
2 16713 in 'receiver', and returns an identification of the message extension used
2 16714 for sending the message (this identification is to be used for calling 'cwait-
2 16715 answer' or 'cregretmessage'. *>
2 16716
2 16716
2 16716 procedure csendmessage (receiver, mess, messextension);
2 16717 real array receiver;
2 16718 integer array mess;
2 16719 integer messextension;
2 16720 begin
3 16721 integer bufref, messext;
3 16722 messref(maxmessext):= 0;
3 16723 messext:= 1;
3 16724 while messref(messext) <> 0 do messext:= messext + 1;
3 16725 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16726 begin
4 16727 messcode(messext):= 1 shift 12 add 2;
4 16728 mon(16) send message :(0, mess, 0, receiver);
4 16729 messref(messext):= monw2;
4 16730 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16731 end;
3 16732
3 16732
3 16732 end;
2 16733 \f
2 16733
2 16733 message coroutinemonitor - 20 ;
2 16734
2 16734
2 16734 <***** cwaitanswer *****
2 16735
2 16735 this procedure asks the coroutine monitor to get an answer to the message
2 16736 corresponding to 'messextension'. in case the answer has already arrived
2 16737 it stays in the eventqueue until 'cwaitanswer' is called.
2 16738 in case 'timeout' is positive, the coroutine is linked into the timer
2 16739 queue, and in case the answer does not arrive within 'timout' seconds the
2 16740 coroutine is restarted with result = 0. *>
2 16741
2 16741
2 16741 procedure cwaitanswer (messextension, answer, result, timeout);
2 16742 value messextension, timeout;
2 16743 integer messextension, result, timeout;
2 16744 integer array answer;
2 16745 begin
3 16746 integer messext;
3 16747 messext:= messextension;
3 16748 messcode(messext):= messcode(messext) extract 12;
3 16749 link(current, idlequeue);
3 16750 messop(messext):= current;
3 16751 if timeout > 0 then
3 16752 begin
4 16753 link(current + corutimerchain, timerqueue);
4 16754 d.current.corutimer:= timeout;
4 16755 end else d.current.corutimer:= 0;
3 16756
3 16756
3 16756 passivate;
3 16757 if d.current.corutimer < 0 then result:= 0 else
3 16758 begin
4 16759 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16760 result:= monw0;
4 16761 baseevent:= 0;
4 16762 messref(messextension):= 0;
4 16763 end;
3 16764 d.current.corutimer:= 0;
3 16765 link(current+corutimerchain, idlequeue);
3 16766 end;
2 16767 \f
2 16767
2 16767 message coroutinemonitor - 21 ;
2 16768
2 16768
2 16768 <***** cwaitmessage *****
2 16769
2 16769 this procedure asks the coroutine monitor to give it a message, when some-
2 16770 one arrives. in case a message has arrived already it stays at the event queue
2 16771 until 'cwaitmessage' is called.
2 16772 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16773 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16774 with messbufferref = 0. *>
2 16775
2 16775
2 16775 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16776 value timeout, processextension;
2 16777 integer processextension, messbufferref, timeout;
2 16778 integer array mess;
2 16779 begin
3 16780 integer i;
3 16781 integer array field messbuf;
3 16782 proccode(processextension):= 2;
3 16783 procop(processextension):= current;
3 16784 link(current, idlequeue);
3 16785 if timeout > 0 then
3 16786 begin
4 16787 link(current + corutimerchain, timerqueue);
4 16788 d.current.corutimer:= timeout;
4 16789 end else d.current.corutimer:= 0;
3 16790
3 16790
3 16790 passivate;
3 16791 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16792 begin
4 16793 messbuf:= procop(processextension);
4 16794 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16795 proccode(procext):= 1 shift 12;
4 16796 messbufferref:= messbuf;
4 16797 baseevent:= 0;
4 16798 end;
3 16799 d.current.corutimer:= 0;
3 16800 link(current+corutimerchain, idlequeue);
3 16801 end;
2 16802 \f
2 16802
2 16802 message coroutinemonitor - 22 ;
2 16803
2 16803
2 16803 <***** cregretmessage *****
2 16804
2 16804 this procedure regrets the message corresponding to messageexten-
2 16805 sion, to release message buffer and message extension.
2 16806 i/o messages are not regretable. *>
2 16807
2 16807
2 16807
2 16807 procedure cregretmessage (messageextension);
2 16808 value messageextension;
2 16809 integer messageextension;
2 16810 begin
3 16811 integer array field messbuf;
3 16812 messbuf:= messref(messageextension);
3 16813 mon(82) regret message :(0, 0, messbuf, 0);
3 16814 messref(messageextension):= 0;
3 16815
3 16815
3 16815 end;
2 16816 \f
2 16816
2 16816 message coroutinemonitor - 23 ;
2 16817
2 16817
2 16817 <***** semsendmessage *****
2 16818
2 16818 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16819 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16820 by the monitor, when the answer arrives.
2 16821 in case there are too few resources to send the message, the operation is
2 16822 returned immediately with the result field set to zero. *>
2 16823
2 16823
2 16823 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16824 value semaphore, operation, operationtype;
2 16825 real array receiver;
2 16826 integer array mess;
2 16827 integer semaphore, operation;
2 16828 boolean operationtype;
2 16829 begin
3 16830 integer array field op;
3 16831 integer messext;
3 16832 op:= operation;
3 16833 messref(maxmessext):= 0;
3 16834 messext:= 1;
3 16835 while messref(messext) <> 0 do messext:= messext + 1;
3 16836 if messext < maxmessext then
3 16837 begin
4 16838 messop(messext):= op;
4 16839 messcode(messext):=1;
4 16840 d.op(1):= semaphore;
4 16841 d.op.optype:= operationtype;
4 16842 mon(16) send message :(0, mess, 0, receiver);
4 16843 messref(messext):= monw2;
4 16844 end;
3 16845
3 16845
3 16845 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16846 begin <* return the operation immediately with result = 0 *>
4 16847 d.op(9):= 0;
4 16848 signalch(semaphore, op, operationtype);
4 16849 end;
3 16850 end;
2 16851 \f
2 16851
2 16851 message coroutinemonitor - 24 ;
2 16852
2 16852
2 16852 <***** semwaitmessage *****
2 16853
2 16853 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16854 be performed by the coroutine monitor when a message arrives to the process
2 16855 corresponding to 'processextension'. *>
2 16856
2 16856
2 16856 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16857 value processextension, semaphore, operation, operationtype;
2 16858 integer processextension, semaphore, operation;
2 16859 boolean operationtype;
2 16860 begin
3 16861 integer array field op;
3 16862 op:= operation;
3 16863 procop(processextension):= operation;
3 16864 d.op(1):= semaphore;
3 16865 d.op.optype:= operationtype;
3 16866 proccode(processextension):= 1;
3 16867
3 16867
3 16867 end;
2 16868 \f
2 16868
2 16868 message coroutinemonitor - 25 ;
2 16869
2 16869
2 16869 <***** semregretmessage *****
2 16870
2 16870 this procedure regrets a message sent by semsendmessage.
2 16871 the message is identified by the operation in which the answer should be
2 16872 returned.
2 16873 the procedure sets the result field of the operation to zero, and then
2 16874 returns it by performing a signalch. *>
2 16875
2 16875
2 16875 procedure semregretmessage (operation);
2 16876 value operation;
2 16877 integer operation;
2 16878 begin
3 16879 integer i, j;
3 16880 integer array field op, sem;
3 16881 op:= operation;
3 16882 i:= 1;
3 16883 while i < maxmessext do
3 16884 begin
4 16885 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16886 begin
5 16887 mon(82) regret message :(0, 0, messref(i), 0);
5 16888 messref(i):= 0;
5 16889 sem:= d.op(1);
5 16890 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16891 signalch(sem, op, d.op.optype);
5 16892 i:= maxmessext;
5 16893 end;
4 16894 i:= i + 1;
4 16895 end;
3 16896
3 16896
3 16896 end;
2 16897 \f
2 16897
2 16897 message coroutinemonitor - 26 ;
2 16898
2 16898
2 16898 <***** link *****
2 16899
2 16899 this procedure links an object (allocated in the descriptor array 'd') into
2 16900 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16901 are all double chained, and the chainhead is of the same format as the chain
2 16902 fields of the objects.
2 16903 the procedure links the object immediately after the head. *>
2 16904
2 16904
2 16904 procedure link (object, chainhead);
2 16905 value object, chainhead;
2 16906 integer object, chainhead;
2 16907 begin
3 16908 integer array field prevelement, nextelement, chead, obj;
3 16909 obj:= object;
3 16910 chead:= chainhead;
3 16911 prevelement:= d.obj.prev;
3 16912 nextelement:= d.obj.next;
3 16913 d.prevelement.next:= nextelement;
3 16914 d.nextelement.prev:= prevelement;
3 16915 if chead > 0 then <* link into queue *>
3 16916 begin
4 16917 prevelement:= d.chead.prev;
4 16918 d.obj.prev:= prevelement;
4 16919 d.prevelement.next:= obj;
4 16920 d.obj.next:= chead;
4 16921 d.chead.prev:= obj;
4 16922 end else
3 16923 begin <* link onto itself *>
4 16924 d.obj.prev:= obj;
4 16925 d.obj.next:= obj;
4 16926 end;
3 16927 end;
2 16928 \f
2 16928
2 16928 message coroutinemonitor - 27 ;
2 16929
2 16929
2 16929 <***** linkprio *****
2 16930
2 16930 this procedure is used to link coroutines into queues corresponding to
2 16931 the priorities of the actual coroutine and the queue elements.
2 16932 the object is linked immediately before the first coroutine of lower prio-
2 16933 rity. *>
2 16934
2 16934
2 16934 procedure linkprio (object, chainhead);
2 16935 value object, chainhead;
2 16936 integer object, chainhead;
2 16937 begin
3 16938 integer array field currelement, chead, obj;
3 16939 obj:= object;
3 16940 chead:= chainhead;
3 16941 currelement:= d.chead.next;
3 16942 while currelement <> chead
3 16943 and d.currelement.corupriority <= d.obj.corupriority
3 16944 do currelement:= d.currelement.next;
3 16945 link(obj, currelement);
3 16946 end;
2 16947 \f
2 16947
2 16947 message coroutinemonitor - 28 ;
2 16948
2 16948 \f
2 16948
2 16948 message coroutinemonitor - 30a ;
2 16949
2 16949
2 16949 <*************** extention to coroutine monitor procedures **********>
2 16950
2 16950 <***** signalbin *****
2 16951
2 16951 this procedure simulates a binary semaphore on a simple semaphore
2 16952 by testing the value of the semaphore before signaling the
2 16953 semaphore. if the value of the semaphore is one (=open) nothing is
2 16954 done, otherwise a normal signal is carried out. *>
2 16955
2 16955
2 16955 procedure signalbin(semaphore);
2 16956 value semaphore;
2 16957 integer semaphore;
2 16958 begin
3 16959 integer array field sem;
3 16960 integer val;
3 16961 sem:= semaphore;
3 16962 inspect(sem,val);
3 16963 if val<1 then signal(sem);
3 16964 end;
2 16965 \f
2 16965
2 16965 message coroutinemonitor - 30b ;
2 16966
2 16966 <***** coruno *****
2 16967
2 16967 delivers the coroutinenumber for a give coroutine id.
2 16968 if the coroutine does not exists the value 0 is delivered *>
2 16969
2 16969 integer procedure coru_no(coru_id);
2 16970 value coru_id;
2 16971 integer coru_id;
2 16972 begin
3 16973 integer array field cor;
3 16974
3 16974 coru_no:= 0;
3 16975 for cor:= firstcoru step corusize until (coruref-1) do
3 16976 if d.cor.coruident//1000 = coru_id then
3 16977 coru_no:= d.cor.coruident mod 1000;
3 16978 end;
2 16979 \f
2 16979
2 16979 message coroutinemonitor - 30c ;
2 16980
2 16980 <***** coroutine *****
2 16981
2 16981 delivers the referencebyte for the coroutinedescriptor for
2 16982 a coroutine identified by coroutinenumber *>
2 16983
2 16983 integer procedure coroutine(cor_no);
2 16984 value cor_no;
2 16985 integer cor_no;
2 16986 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16987 firstcoru + (cor_no-1)*corusize;
2 16988 \f
2 16988
2 16988 message coroutinemonitor - 30d ;
2 16989
2 16989 <***** curr_coruno *****
2 16990
2 16990 delivers number of calling coroutine
2 16991 curr_coruno:
2 16992 < 0 = -current_coroutine_number in disabled mode
2 16993 = 0 = procedure not called from coroutine
2 16994 > 0 = current_coroutine_number in enabled mode *>
2 16995
2 16995 integer procedure curr_coruno;
2 16996 begin
3 16997 integer i;
3 16998 integer array ia(1:12);
3 16999
3 16999 i:= system(12,0,ia);
3 17000 if i > 0 then
3 17001 begin
4 17002 i:= system(12,1,ia);
4 17003 curr_coruno:= ia(3);
4 17004 end else curr_coruno:= 0;
3 17005 end curr_coruno;
2 17006 \f
2 17006
2 17006 message coroutinemonitor - 30e ;
2 17007
2 17007 <***** curr_coruid *****
2 17008
2 17008 delivers coruident of calling coroutine :
2 17009
2 17009 curr_coruid:
2 17010 > 0 = coruident of calling coroutine
2 17011 = 0 = procedure not called from coroutine *>
2 17012
2 17012 integer procedure curr_coruid;
2 17013 begin
3 17014 integer cor_no;
3 17015 integer array field cor;
3 17016
3 17016 cor_no:= abs curr_coruno;
3 17017 if cor_no <> 0 then
3 17018 begin
4 17019 cor:= coroutine(cor_no);
4 17020 curr_coruid:= d.cor.coruident // 1000;
4 17021 end
3 17022 else curr_coruid:= 0;
3 17023 end curr_coruid;
2 17024 \f
2 17024 message coroutinemonitor - 30f.1 ;
2 17025
2 17025 <**** getch *****
2 17026
2 17026 this procedure searches the queue of operations waiting at 'semaphore'
2 17027 to find an operation that matches the operationstypeset and a set of
2 17028 select-values. each select value is specified by type and fieldvalue
2 17029 in integer array 'type' and by the value in integer array 'val'.
2 17030
2 17030 0: eq 0: not used
2 17031 1: lt 1: boolean
2 17032 2: le 2: integer
2 17033 3: gt 3: long
2 17034 4: ge 4: real
2 17035 5: ne
2 17036 *>
2 17037
2 17037 procedure getch(semaphore,operation,operationtypeset,type,val);
2 17038 value semaphore,operationtypeset;
2 17039 integer semaphore,operation;
2 17040 boolean operationtypeset;
2 17041 integer array type,val;
2 17042 begin
3 17043 integer array field firstop,currop;
3 17044 integer ø,n,i,f,t,rel,i1,i2;
3 17045 boolean field bf,bfval;
3 17046 integer field intf;
3 17047 long field lf,lfval; long l1,l2;
3 17048 real field rf,rfval; real r1,r2;
3 17049
3 17049 boolean match;
3 17050
3 17050 operation:= 0;
3 17051 n:= system(3,ø,type);
3 17052 match:= false;
3 17053 firstop:= semaphore + semop;
3 17054 currop:= d.firstop.next;
3 17055 while currop <> firstop and -,match do
3 17056 begin
4 17057 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 17058 begin
5 17059 i:= n;
5 17060 match:= true;
5 17061 \f
5 17061 message coroutinemonitor - 30f.2 ;
5 17062
5 17062 while match and (if i <= ø then type(i) >= 0 else false) do
5 17063 begin
6 17064 rel:= type(i) shift(-18);
6 17065 t:= type(i) shift(-12) extract 6;
6 17066 f:= type(i) extract 12;
6 17067 if f > 2047 then f:= f -4096;
6 17068 case t+1 of
6 17069 begin
7 17070 ; <* not used *>
7 17071
7 17071 begin <*boolean or signed short integer*>
8 17072 bf:= f;
8 17073 bfval:= 2*i;
8 17074 i1:= d.currop.bf extract 12;
8 17075 if i1 > 2047 then i1:= i1-4096;
8 17076 i2:= val.bfval extract 12;
8 17077 if i2 > 2047 then i2:= i2-4096;
8 17078 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17079 end;
7 17080
7 17080 begin <*integer*>
8 17081 intf:= f;
8 17082 i1:= d.currop.intf;
8 17083 i2:= val(i);
8 17084 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17085 end;
7 17086
7 17086 begin <*long*>
8 17087 lf:= f;
8 17088 lfval:= i*2;
8 17089 l1:= d.currop.lf;
8 17090 l2:= val.lfval;
8 17091 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 17092 end;
7 17093
7 17093 begin <*real*>
8 17094 rf:= f;
8 17095 rfval:= i*2;
8 17096 r1:= d.currop.rf;
8 17097 r2:= val.rfval;
8 17098 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 17099 end;
7 17100
7 17100 end;<*case t+1*>
6 17101
6 17101 i:= i+1;
6 17102 end; <*while match and i<=ø and t>=0 *>
5 17103 \f
5 17103 message coroutinemonitor - 30f.3 ;
5 17104
5 17104 end; <* if operationtypeset and ---*>
4 17105 if -,match then currop:= d.currop.next;
4 17106 end; <*while currop <> firstop and -,match*>
3 17107
3 17107 if match then
3 17108 begin
4 17109 link(currop,0);
4 17110 d.current.coruop:= currop;
4 17111 operation:= currop;
4 17112 end;
3 17113 end getch;
2 17114 \f
2 17114
2 17114 message coroutinemonitor - 31 ;
2 17115
2 17115 activity(maxcoru);
2 17116
2 17116 goto initialization;
2 17117
2 17117
2 17117
2 17117 <*************** event handling ***************>
2 17118
2 17118
2 17118
2 17118 takeexternal:
2 17119 currevent:= baseevent;
2 17120 eventqueueempty:= false;
2 17121 repeat
2 17122 current:= 0;
2 17123 prevevent:= currevent;
2 17124 mon(66) test event :(0, 0, currevent, 0);
2 17125 currevent:= monw2;
2 17126 if monw0 < 0 <* no event *> then goto takeinternal;
2 17127 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 17128 cmi:= monw1
2 17129 else
2 17130 cmi:= - monw0;
2 17131
2 17131 if cmi > 0 then
2 17132 begin <* answer to activity zone *>
3 17133 current:= firstcoru + (cmi - 1) * corusize;
3 17134 linkprio(current, readyqueue);
3 17135 baseevent:= 0;
3 17136 end else
2 17137
2 17137 if cmi = 0 then
2 17138 begin <* message arrived *>
3 17139 \f
3 17139
3 17139 message coroutinemonitor - 32 ;
3 17140
3 17140 receiver:= core.currevent(3);
3 17141 if receiver < 0 then receiver:= - receiver;
3 17142 procref(maxprocext):= receiver;
3 17143 procext:= 1;
3 17144 while procref(procext) <> receiver do procext:= procext + 1;
3 17145 if procext = maxprocext then
3 17146 begin <* receiver unknown *>
4 17147 <* leave the message unchanged *>
4 17148 end else
3 17149 if proccode(procext) shift (-12) = 0 then
3 17150 begin <* the receiver is ready for accepting messages *>
4 17151 mon(26) get event :(0, 0, currevent, 0);
4 17152 case proccode(procext) of
4 17153 begin
5 17154 begin <* message received by semwaitmessage *>
6 17155 op:= procop(procext);
6 17156 sem:= d.op(1);
6 17157 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 17158 d.op(9):= currevent;
6 17159 signalch(sem, op, d.op.optype);
6 17160 proccode(procext):= 1 shift 12;
6 17161 end;
5 17162 begin <* message received by cwaitmessage *>
6 17163 current:= procop(procext);
6 17164 procop(procext):= currevent;
6 17165 linkprio(current, readyqueue);
6 17166 link(current + corutimerchain, idlequeue);
6 17167
6 17167
6 17167 end;
5 17168 end; <* case *>
4 17169 currevent:= baseevent;
4 17170 proccode(procext):= 1 shift 12;
4 17171 end;
3 17172 end <* message *> else
2 17173
2 17173 if cmi = -1 then
2 17174 begin <* answer arrived *>
3 17175 \f
3 17175
3 17175 message coroutinemonitor - 33 ;
3 17176
3 17176 if currevent = timermessage then
3 17177 begin
4 17178 mon(26) get event :(0, 0, currevent, 0);
4 17179 coru:= d.timerqueue.next;
4 17180 while coru <> timerqueue do
4 17181 begin
5 17182 current:= coru - corutimerchain;
5 17183 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 17184 coru:= d.coru.next;
5 17185 if d.current.corutimer <= 0 then
5 17186 begin <* timer perion expired *>
6 17187 d.current.corutimer:= -1;
6 17188 linkprio(current, readyqueue);
6 17189 link(current + corutimerchain, idlequeue);
6 17190 end;
5 17191 end;
4 17192 mon(16) send message :(0, clockmess, 0, clock);
4 17193 timermessage:= monw2;
4 17194 currevent:= baseevent;
4 17195 end <* timer answer *> else
3 17196 begin
4 17197 messref(maxmessext):= currevent;
4 17198 messext:= 1;
4 17199 while messref(messext) <> currevent do messext:= messext + 1;
4 17200 if messext = maxmessext then
4 17201 begin <* the answer is unknown *>
5 17202 <* leave the answer unchanged - it may belong to an activity *>
5 17203 end else
4 17204 if messcode(messext) shift (-12) = 0 then
4 17205 begin
5 17206 case messcode(messext) extract 12 of
5 17207 begin
6 17208 \f
6 17208
6 17208 message coroutinemonitor - 34 ;
6 17209 begin <* answer arrived after semsendmessage *>
7 17210 op:= messop(messext);
7 17211 sem:= d.op(1);
7 17212 mon(18) wait answer :(0, d.op, currevent, 0);
7 17213 d.op(9):= monw0;
7 17214 signalch(sem, op, d.op.optype);
7 17215 messref(messext):= 0;
7 17216 baseevent:= 0;
7 17217 end;
6 17218 begin <* answer arrived after csendmessage *>
7 17219 current:= messop(messext);
7 17220 linkprio(current, readyqueue);
7 17221 link(current + corutimerchain, idlequeue);
7 17222
7 17222
7 17222 end;
6 17223 end;
5 17224 end else baseevent:= currevent;
4 17225 end;
3 17226 end;
2 17227 until eventqueueempty;
2 17228 \f
2 17228
2 17228 message coroutinemonitor - 35 ;
2 17229
2 17229
2 17229
2 17229 <*************** coroutine activation ***************>
2 17230
2 17230 takeinternal:
2 17231
2 17231 current:= d.readyqueue.next;
2 17232 if current = readyqueue then
2 17233 begin
3 17234 mon(24) wait event :(0, 0, prevevent, 0);
3 17235 goto takeexternal;
3 17236 end;
2 17237
2 17237 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17238 <**> begin
3 17239 <**> systime(5,0,r);
3 17240 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17241 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17242 <**> d.current.coruident//1000,<: aktiveres:>);
3 17243 <**> end;
2 17244 <*-2*>
2 17245
2 17245 corustate:= activate(d.current.coruident mod 1000);
2 17246 cmi:= corustate extract 24;
2 17247 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17248 <**> begin
3 17249 <**> systime(5,0,r);
3 17250 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17251 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17252 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 17253 <**> end;
2 17254 <*-2*>
2 17255
2 17255 if cmi = 1 then
2 17256 begin <* programmed passivate *>
3 17257 goto takeexternal;
3 17258 end;
2 17259
2 17259 if cmi = 2 then
2 17260 begin <* implicit passivate in activity *>
3 17261
3 17261
3 17261 link(current, idlequeue);
3 17262 goto takeexternal;
3 17263 end;
2 17264 \f
2 17264
2 17264 message coroutinemonitor - 36 ;
2 17265
2 17265 <* coroutine termination (normal or abnormal) *>
2 17266
2 17266 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 17267 coru_term:
2 17268
2 17268 begin
3 17269 if false and alarmcause extract 24 = (-9) <* break *> and
3 17270 alarmcause shift (-24) extract 24 = 0 then
3 17271 begin
4 17272 endaction:= 2;
4 17273 goto program_slut;
4 17274 end;
3 17275 if alarmcause extract 24 = (-9) <* break *> and
3 17276 alarmcause shift (-24) = 8 <* parent *>
3 17277 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 17278 if alarmcause shift (-24) extract 24 <> -2 or
3 17279 alarmcause extract 24 <> -13 then
3 17280 begin
4 17281 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 17282 alarmcause shift (-24),<:,:>,
4 17283 alarmcause extract 24);
4 17284 for i:=1 step 1 until max_coru do
4 17285 j:=activate(-i); <* kill *>
4 17286 <* skriv billede *>
4 17287 end
3 17288 else
3 17289 begin
4 17290 errorbits:= 0; <* ok.yes warning.no *>
4 17291 goto finale;
4 17292 end;
3 17293 end;
2 17294
2 17294 goto dump;
2 17295
2 17295 link(current, idlequeue);
2 17296 goto takeexternal;
2 17297 \f
2 17297
2 17297 message coroutinemonitor - 37 ;
2 17298
2 17298
2 17298
2 17298 initialization:
2 17299
2 17299
2 17299 <*************** initialization ***************>
2 17300
2 17300 <* chain head *>
2 17301
2 17301 prev:= -2; <* -2 prev *>
2 17302 next:= 0; <* +0 next *>
2 17303
2 17303 <* corutine descriptor *>
2 17304
2 17304 <* -2 prev *>
2 17305 <* +0 next *>
2 17306 <* +2 (link field) *>
2 17307 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 17308 <* +6 (link field) *>
2 17309 coruop:= corutimerchain + 4; <* +8 coruop *>
2 17310 corutimer:= coruop + 2; <*+10 corutimer *>
2 17311 coruident:= corutimer + 2; <*+12 coruident *>
2 17312 corupriority:= coruident + 2; <*+14 corupriority *>
2 17313 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 17314 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 17315
2 17315 <* simple semaphore *>
2 17316
2 17316 <* -2 (link field) *>
2 17317 simcoru:= next; <* +0 simcoru *>
2 17318 simvalue:= simcoru + 2; <* +2 simvalue *>
2 17319
2 17319 <* chained semaphore *>
2 17320
2 17320 <* -2 (link field) *>
2 17321 semcoru:= next; <* +0 semcoru *>
2 17322 <* +2 (link field) *>
2 17323 semop:= semcoru + 4; <* +4 semop *>
2 17324 \f
2 17324
2 17324 message coroutinemonitor - 38 ;
2 17325
2 17325 <* operation *>
2 17326
2 17326 opsize:= next - 6; <* -6 opsize *>
2 17327 optype:= opsize + 1; <* -5 optype *>
2 17328 <* -2 prev *>
2 17329 <* +0 next *>
2 17330 <* +2 operation(1) *>
2 17331 <* +4 operation(2) *>
2 17332 <* +6 - *>
2 17333 <* . - *>
2 17334 <* . - *>
2 17335
2 17335 \f
2 17335
2 17335 message coroutinemonitor - 39 ;
2 17336
2 17336 trap(dump);
2 17337 systime(1, 0, starttime);
2 17338 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 17339 clockmess(1):= 0;
2 17340 clockmess(2):= timeinterval;
2 17341 clock(1):= real <:clock:>;
2 17342 clock(2):= real <::>;
2 17343 mon(16) send message :(0, clockmess, 0, clock);
2 17344 timermessage:= monw2;
2 17345 readyqueue:= 4;
2 17346 initchain(readyqueue);
2 17347 idlequeue:= readyqueue + 4;
2 17348 initchain(idlequeue);
2 17349 timerqueue:= idlequeue + 4;
2 17350 initchain(timerqueue);
2 17351 current:= 0;
2 17352 corucount:= 0;
2 17353 proccount:= 0;
2 17354 baseevent:= 0;
2 17355 coruref:= timerqueue + 4;
2 17356 firstcoru:= coruref;
2 17357 simref:= coruref + maxcoru * corusize;
2 17358 firstsim:= simref;
2 17359 semref:= simref + maxsem * simsize;
2 17360 firstsem:= semref;
2 17361 opref:= semref + maxsemch * semsize + 4;
2 17362 firstop:= opref;
2 17363 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 17364 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 17365 reflectcore(core);
2 17366
2 17366 algol list.on;
2 17367
2 17367 \f
2 17367 message sys_initialisering side 1 - 810601/hko;
2 17368
2 17368 trapmode:= 1 shift 15;
2 17369 errorbits:= 1; <* warning.no ok.no *>
2 17370 trap(coru_term);
2 17371
2 17371 open(zbillede,4,<:billede:>,0);
2 17372 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17373 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17374 system(2,0,ia);
2 17375 open(zdummy,4,ia,0); close(zdummy,false);
2 17376 monitor(42,zdummy,0,ia);
2 17377 laf:= 0;
2 17378 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17379 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17380 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17381
2 17381 open(zrl,4,<:radiolog:>,0);
2 17382 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17383 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17384 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17385 begin
3 17386 ia(1):=1; ia(2):= 3;
3 17387 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17388 monitor(40)create_area:(zrl,0,ia);
3 17389 end;
2 17390
2 17390 for i:=1 step 1 until max_antal_fejltekster do
2 17391 fejltekst(i):= real (case i of (
2 17392 <* 1*><:filsystem:>,
2 17393 <* 2*><:operationskode:>,
2 17394 <* 3*><:programfejl:>,
2 17395 <* 4*><:monitor<'_'>resultat=:>,
2 17396 <* 5*><:læs<'_'>fil:>,
2 17397 <* 6*><:skriv<'_'>fil:>,
2 17398 <* 7*><:modif<'_'>fil:>,
2 17399 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17400 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17401 <*10*><:vogntabel:>,
2 17402 <*11*><:fremmed operation:>,
2 17403 <*12*><:operationstype:>,
2 17404 <*13*><:opret<'_'>fil:>,
2 17405 <*14*><:tilknyt<'_'>fil:>,
2 17406 <*15*><:frigiv<'_'>fil:>,
2 17407 <*16*><:slet<'_'>fil:>,
2 17408 <*17*><:ydre enhed, status=:>,
2 17409 <*18*><:tabelfil:>,
2 17410 <*19*><:radio:>,
2 17411 <*20*><:mobilopkald, bus:>,
2 17412 <*21*><:talevejsswitch:>,
2 17413 <*99*><:ftslut:>));
2 17414
2 17414 for i:= 1 step 1 until max_antal_områder do
2 17415 begin
3 17416 område_navn(i):= long (case i of
3 17417 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17418 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17419 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17420 område_id(i,2):=
3 17421 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17422 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17423 end;
2 17424
2 17424 pabx_id(1):= -1;
2 17425 pabx_id(2):= 1;
2 17426
2 17426 for i:= 1 step 1 until max_antal_radiokanaler do
2 17427 begin
3 17428 radio_id(i):=
3 17429 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17430 end;
2 17431
2 17431 for i:=1 step 1 until max_antal_kanaler do
2 17432 begin
3 17433 kanal_navn(i):= long (case i of (
3 17434 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17435 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17436 kanal_id(i):=
3 17437 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17438 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17439 end;
2 17440
2 17440 for i:= 1 step 1 until op_maske_lgd//2 do
2 17441 ingen_operatører(i):= alle_operatører(i):= 0;
2 17442 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17443 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17444
2 17444 begin
3 17445 long array navn(1:2);
3 17446 long array field doc, ref;
3 17447
3 17447 doc:= 2; iaf:= 0;
3 17448 movestring(navn,1,<:terminal0:>);
3 17449 for i:= 1 step 1 until max_antal_operatører do
3 17450 begin
4 17451 ref:=(i-1)*8; k:=9;
4 17452 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17453 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17454 open(zdummy,8,navn,0); close(zdummy,true);
4 17455 k:= monitor(42,zdummy,0,ia);
4 17456 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17457 else tofrom(terminal_navn.ref,navn,8);
4 17458 operatør_auto_include(i):= false;
4 17459 sætbit_ia(alle_operatører,i,1);
4 17460 end;
3 17461
3 17461 movestring(navn,1,<:garage0:>);
3 17462 for i:= 1 step 1 until max_antal_garageterminaler do
3 17463 begin
4 17464 ref:=(i-1)*8; k:=7;
4 17465 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17466 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17467 open(zdummy,8,navn,0); close(zdummy,true);
4 17468 k:= monitor(42,zdummy,0,ia);
4 17469 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17470 else tofrom(garage_terminal_navn.ref,navn,8);
4 17471 garage_auto_include(i):= false;
4 17472 end;
3 17473 end;
2 17474
2 17474 for i:= 1 step 1 until max_antal_taleveje do
2 17475 sætbit_ia(alle_taleveje,i,1);
2 17476 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17477 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17478 operatør_auto_include(ia(i)):= true;
2 17479 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17480 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17481 garage_auto_include(ia(i)):= true;
2 17482
2 17482
2 17482 \f
2 17482 message fil_init side 1 - 801030/jg;
2 17483
2 17483 begin integer i,antz,tz,s;
3 17484 real array field raf;
3 17485
3 17485 filskrevet:=fillæst:=0; <*fil*>
3 17486 dbsegmax:= 2**18-1;
3 17487
3 17487 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17488 for i:=1 step 1 until dbantez do
3 17489 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17490 for i:=dbantez+1 step 1 until tz do
3 17491 open(fil(i),4,dbsnavn,0);
3 17492 for i:=tz+1 step 1 until antz do
3 17493 open(fil(i),4,dbtnavn,0);
3 17494
3 17494 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17495 dbkatz(i,1):=dbkatz(i,2):=0;
3 17496 for i:=dbantez+1 step 1 until tz do
3 17497 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17498 for i:=tz+1 step 1 until antz do
3 17499 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17500 dbkatz(antz,2):=tz+1;
3 17501 dbsidstetz:=antz;
3 17502 dbsidstesz:=tz;
3 17503
3 17503 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17504 begin integer j;
4 17505 for j:=1,3 step 1 until 6 do
4 17506 dbkate(i,j):=0;
4 17507 dbkate(i,2):=i+1;
4 17508 end;
3 17509 dbkate(dbmaxef,2):=0;
3 17510 dbkatefri:=1;
3 17511 dbantef:=0;
3 17512 \f
3 17512 message fil_init side 2 - 801030/jg;
3 17513
3 17513
3 17513 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17514 begin
4 17515 dbkats(i,1):=0;
4 17516 dbkats(i,2):=i+1;
4 17517 end;
3 17518 dbkats(dbmaxsf,2):=0;
3 17519 dbkatsfri:=1;
3 17520 dbantsf:=0;
3 17521
3 17521 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17522 dbkatb(i):=false add (i+1);
3 17523 dbkatb(dbmaxb):=false;
3 17524 dbkatbfri:=1;
3 17525 dbantb:=0;
3 17526 raf:=4;
3 17527 for i:=1 step 1 until dbmaxtf do
3 17528 begin
4 17529 inrec6(fil(antz),4);
4 17530 dbkatt.raf(i):=fil(antz,1);
4 17531 end;
3 17532 inrec6(fil(antz),4);
3 17533 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17534 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17535 setposition(fil(antz),0,0);
3 17536
3 17536 end filsystem;
2 17537 \f
2 17537 message fil_init side 3 - 810209/cl;
2 17538
2 17538 bs_kats_fri:= nextsem;
2 17539 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17540 <*-3*>
2 17541 bs_kate_fri:= nextsem;
2 17542 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17543 <*-3*>
2 17544 cs_opret_fil:= nextsemch;
2 17545 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17546 <*-3*>
2 17547 cs_tilknyt_fil:= nextsemch;
2 17548 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17549 <*-3*>
2 17550 cs_frigiv_fil:= nextsemch;
2 17551 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17552 <*-3*>
2 17553 cs_slet_fil:= nextsemch;
2 17554 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17555 <*-3*>
2 17556 cs_opret_spoolfil:= nextsemch;
2 17557 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17558 <*-3*>
2 17559 cs_opret_eksternfil:= nextsemch;
2 17560 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17561 <*-3*>
2 17562 \f
2 17562 message fil_init side 4 810209/cl;
2 17563
2 17563
2 17563 <* initialisering af filsystemcoroutiner *>
2 17564
2 17564 i:= nextcoru(001,10,true);
2 17565 j:= newactivity(i,0,opretfil);
2 17566 <*+3*> skriv_newactivity(out,i,j);
2 17567 <*-3*>
2 17568
2 17568 i:= nextcoru(002,10,true);
2 17569 j:= newactivity(i,0,tilknytfil);
2 17570 <*+3*> skriv_newactivity(out,i,j);
2 17571 <*-3*>
2 17572
2 17572 i:= nextcoru(003,10,true);
2 17573 j:= newactivity(i,0,frigivfil);
2 17574 <*+3*> skriv_newactivity(out,i,j);
2 17575 <*-3*>
2 17576
2 17576 i:= nextcoru(004,10,true);
2 17577 j:= newactivity(i,0,sletfil);
2 17578 <*+3*> skriv_newactivity(out,i,j);
2 17579 <*-3*>
2 17580
2 17580 i:= nextcoru(005,10,true);
2 17581 j:= newactivity(i,0,opretspoolfil);
2 17582 <*+3*> skriv_newactivity(out,i,j);
2 17583 <*-3*>
2 17584
2 17584 i:= nextcoru(006,10,true);
2 17585 j:= newactivity(i,0,opreteksternfil);
2 17586 <*+3*> skriv_newactivity(out,i,j);
2 17587 <*-3*>
2 17588 \f
2 17588 message attention_initialisering side 1 - 850820/cl;
2 17589
2 17589 tf_kommandotabel:= 1 shift 10 + 1;
2 17590
2 17590 begin
3 17591 integer i, s, zno;
3 17592 zone z(128,1,stderror);
3 17593 integer array fdim(1:8);
3 17594
3 17594 fdim(4):= tf_kommandotabel;
3 17595 hentfildim(fdim);
3 17596
3 17596 open(z,4,<:htkommando:>,0);
3 17597 for i:= 1 step 1 until fdim(3) do
3 17598 begin
4 17599 inrec6(z,512);
4 17600 s:= skrivfil(tf_kommandotabel,i,zno);
4 17601 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17602 tofrom(fil(zno),z,512);
4 17603 end;
3 17604 close(z,true);
3 17605 end;
2 17606 \f
2 17606 message attention_initialisering side 1a - 810428/hko;
2 17607
2 17607 for j:= system(3,i,terminal_tab) step 1 until i do
2 17608 terminal_tab(j):= 0;
2 17609
2 17609 cs_att_pulje:=next_semch;
2 17610 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17611 <*-3*>
2 17612
2 17612 bs_fortsæt_adgang:= nextsem;
2 17613 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17614 <*-3*>
2 17615 signalbin(bs_fortsæt_adgang);
2 17616
2 17616 for i:= 1,
2 17617 1 step 1 until max_antal_operatører,
2 17618 1 step 1 until max_antal_garageterminaler do
2 17619
2 17619 <* initialisering af pulje med attention_operationer *>
2 17620
2 17620 signalch(cs_att_pulje, <* pulje_semafor *>
2 17621 nextop(data+att_op_længde), <* næste_operation *>
2 17622 gen_optype);
2 17623
2 17623 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17624
2 17624 i:=next_coru(010,<*ident*>
2 17625 2,<*prioritet*>
2 17626 true<*test_maske*>);
2 17627 j:=newactivity( i, <*activityno *>
2 17628 0, <*ikke virtual *>
2 17629 attention);<*ingen parametre*>
2 17630
2 17630 <*+3*>skriv_newactivity(out,i,j);
2 17631 <*-3*>
2 17632
2 17632 \f
2 17632 message io_initialisering side 1 - 810507/hko;
2 17633
2 17633 io_spoolfil:= 1028;
2 17634 begin
3 17635 integer array fdim(1:8);
3 17636 fdim(4):= io_spoolfil;
3 17637 hent_fildim(fdim);
3 17638 io_spool_postantal:= fdim(1);
3 17639 io_spool_postlængde:= fdim(2);
3 17640 end;
2 17641
2 17641 io_spool_post:= 4;
2 17642
2 17642 cs_io:= next_semch;
2 17643 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17644 <*-3*>
2 17645
2 17645 i:= next_coru(100,<*ident *>
2 17646 5,<*prioritet *>
2 17647 true<*test_maske*>);
2 17648
2 17648 j:= new_activity( i,
2 17649 0,
2 17650 h_io);
2 17651
2 17651 <*+3*>skriv_newactivity(out,i,j);
2 17652 <*-3*>
2 17653 cs_io_komm:= next_semch;
2 17654 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17655 <*-3*>
2 17656
2 17656 i:= next_coru(101,<*ident*>
2 17657 10,<*prioritet*>
2 17658 true <*testmaske*>);
2 17659 j:= new_activity( i,
2 17660 0,
2 17661 io_komm);<*ingen parametre*>
2 17662
2 17662 <*+3*>skriv_newactivity(out,i,j);
2 17663 <*-3*>
2 17664 \f
2 17664 message io_initialisering side 2 - 810520/hko/cl;
2 17665
2 17665 bs_zio_adgang:= next_sem;
2 17666 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17667 <*-3*>
2 17668 signal_bin(bs_zio_adgang);
2 17669
2 17669 cs_io_spool:= next_semch;
2 17670 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17671 <*-3*>
2 17672
2 17672 cs_io_fil:=next_semch;
2 17673 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17674 <*-3*>
2 17675 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17676
2 17676 ss_io_spool_fulde:= next_sem;
2 17677 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17678 <*-3*>
2 17679
2 17679 ss_io_spool_tomme:= next_sem;
2 17680 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17681 <*-3*>
2 17682 for i:= 1 step 1 until io_spool_postantal do
2 17683 signal(ss_io_spool_tomme);
2 17684 \f
2 17684 message io_initialisering side 3 - 880901/cl;
2 17685
2 17685 i:= next_coru(102,
2 17686 5,
2 17687 true);
2 17688 j:= new_activity(i,0,io_spool);
2 17689
2 17689 <*+3*>skriv_newactivity(out,i,j);
2 17690 <*-3*>
2 17691
2 17691 i:= next_coru(103,
2 17692 10,
2 17693 true);
2 17694 j:= new_activity(i,0,io_spon);
2 17695
2 17695 <*+3*>skriv_newactivity(out,i,j);
2 17696 <*-3*>
2 17697
2 17697 cs_io_medd:= next_semch;
2 17698 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17699 <*-3*>
2 17700
2 17700 i:= next_coru(104,<*ident *>
2 17701 10,<*prioritet *>
2 17702 true<*test_maske*>);
2 17703
2 17703 j:= new_activity( i,
2 17704 0,
2 17705 io_medd);
2 17706
2 17706 <*+3*>skriv_newactivity(out,i,j);
2 17707 <*-3*>
2 17708
2 17708 cs_io_nulstil:= next_semch;
2 17709 <*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
2 17710 <*-3*>
2 17711
2 17711 i:= next_coru(105,<*ident *>
2 17712 10,<*prioritet *>
2 17713 true<*test_maske*>);
2 17714
2 17714 j:= new_activity( i,
2 17715 0,
2 17716 io_nulstil_tællere);
2 17717
2 17717 <*+3*>skriv_newactivity(out,i,j);
2 17718 <*-3*>
2 17719
2 17719 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17720 i:= monitor(8)reserve process:(z_io,0,ia);
2 17721 if i <> 0 then
2 17722 begin
3 17723 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17724 end
2 17725 else
2 17726 begin
3 17727 ref:= 0;
3 17728 terminal_tab.ref.terminal_tilstand:= 0;
3 17729 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17730 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17731 "sp",1,"*",15,"nl",1);
3 17732 setposition(z_io,0,0);
3 17733 end;
2 17734 \f
2 17734 message operatør_initialisering side 1 - 810520/hko;
2 17735
2 17735 top_bpl_gruppe:= 64;
2 17736
2 17736 bpl_navn(0):= long<::>;
2 17737 for i:= 1 step 1 until 127 do
2 17738 begin
3 17739 k:= læsfil(tf_bpl_navne,i,j);
3 17740 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17741 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17742 if i<=max_antal_operatører then
3 17743 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17744 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17745 top_bpl_gruppe:= i;
3 17746 end;
2 17747
2 17747 for i:= 0 step 1 until 64 do
2 17748 begin
3 17749 iaf:= i*op_maske_lgd;
3 17750 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17751 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17752 if 1<=i and i<= max_antal_operatører then
3 17753 begin
4 17754 bpl_tilst(i,2):= 1;
4 17755 sætbit_ia(bpl_def.iaf,i,1);
4 17756 end;
3 17757 end;
2 17758 for i:= 65 step 1 until 127 do
2 17759 begin
3 17760 k:= læsfil(tf_bpl_def,i-64,j);
3 17761 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17762 iaf:= i*op_maske_lgd;
3 17763 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17764 bpl_tilst(i,1):= 0;
3 17765 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17766 end;
2 17767
2 17767 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17768 iaf:= 0;
2 17769 for i:= 1 step 1 until max_antal_operatører do
2 17770 begin
3 17771 k:= læsfil(tf_stoptabel,i,j);
3 17772 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17773 operatør_stop(i,0):= i;
3 17774 for k:= 1,2,3 do
3 17775 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17776 ant_i_opkø(i):= 0;
3 17777 end;
2 17778
2 17778 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17779 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17780 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17781 sidste_tv_brugt:= max_antal_taleveje;
2 17782
2 17782 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17783 opk_alarm(i):= 0;
2 17784 for i:= 1 step 1 until max_antal_operatører do
2 17785 begin
3 17786 integer array field tab;
3 17787
3 17787 k:= læsfil(tf_alarmlgd,i,j);
3 17788 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17789 tab:= (i-1)*opk_alarm_tab_lgd;
3 17790 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17791 opk_alarm.tab.alarm_start:= 0.0;
3 17792 end;
2 17793
2 17793 op_spool_kilde:= 2;
2 17794 op_spool_tid := 6;
2 17795 op_spool_text := 6;
2 17796 begin
3 17797 long array field laf1, laf2;
3 17798 laf2:= 4; laf1:= 0;
3 17799 op_spool_buf.laf1(1):= long<::>;
3 17800 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17801 op_spool_postantal*op_spool_postlgd-4);
3 17802 end;
2 17803
2 17803 k:=læsfil(1033,1,j);
2 17804 systime(1,0.0,r);
2 17805 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17806 for i:= 1 step 1 until max_cqf do
2 17807 begin
3 17808 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17809 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17810 cqf_tabel.ref.cqf_næste_tid:=
3 17811 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17812 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17813 end;
2 17814 op_cqf_tab_ændret:= true;
2 17815
2 17815 laf:= raf:= 0;
2 17816 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17817 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17818 j:= 1;
2 17819 if i<>0 then
2 17820 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17821 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17822 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17823 j:= 1;
2 17824 if i<>0 then
2 17825 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17826
2 17826 ia(1):= 3; <*canonical*>
2 17827 ia(2):= 0; <*no echo*>
2 17828 ia(3):= 0; <*prompt*>
2 17829 ia(4):= 2; <*timeout*>
2 17830 setcspterm(taleswitch_in_navn.laf,ia);
2 17831 setcspterm(taleswitch_out_navn.laf,ia);
2 17832
2 17832 cs_op:= next_semch;
2 17833
2 17833 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17834 <*-3*>
2 17835
2 17835 cs_op_retur:= next_semch;
2 17836
2 17836 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17837 <*-3*>
2 17838
2 17838 i:= nextcoru(200,<*ident*>
2 17839 10,<*prioitet*>
2 17840 true<*test_maske*>);
2 17841
2 17841 j:= new_activity( i,
2 17842 0,
2 17843 h_operatør);
2 17844
2 17844 <*+3*>skriv_newactivity(out,i,j);
2 17845 <*-3*>
2 17846 \f
2 17846 message operatør_initialisering side 2 - 810520/hko;
2 17847
2 17847 for k:= 1 step 1 until max_antal_operatører do
2 17848 begin
3 17849 ref:= (k-1)*8;
3 17850 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17851 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17852 ref:=k*terminal_beskr_længde;
3 17853 if i = 0 then
3 17854 begin
4 17855 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17856 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17857 end
3 17858 else
3 17859 begin
4 17860 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17861 end;
3 17862
3 17862 cs_operatør(k):= next_semch;
3 17863 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17864 <*-3*>
3 17865
3 17865 cs_op_fil(k):= nextsemch;
3 17866 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17867 <*-3*>
3 17868 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17869
3 17869 i:= next_coru(200+k,<*ident*>
3 17870 10,<*prioitet*>
3 17871 true<*testmaske*>);
3 17872 j:= new_activity( i,
3 17873 0,
3 17874 operatør,k);
3 17875
3 17875 <*+3*>skriv_newactivity(out,i,j);
3 17876 <*-3*>
3 17877 end;
2 17878
2 17878 cs_cqf:= next_semch;
2 17879 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17880 <*-3*>
2 17881
2 17881 signalch(cs_cqf,nextop(60),true);
2 17882
2 17882 i:= next_coru(292, <*ident*>
2 17883 10, <*prioritet*>
2 17884 true <*testmaske*>);
2 17885 j:= new_activity( i,
2 17886 0,
2 17887 op_cqftest);
2 17888 <*+3*>skriv_new_activity(out,i,j);
2 17889 <*-3*>
2 17890
2 17890 cs_op_spool:= next_semch;
2 17891 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17892 <*-3*>
2 17893
2 17893 cs_op_medd:= next_semch;
2 17894 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17895 <*-3*>
2 17896
2 17896 ss_op_spool_tomme:= next_sem;
2 17897 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17898 <*-3*>
2 17899 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17900
2 17900 ss_op_spool_fulde:= next_sem;
2 17901 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17902 <*-3*>
2 17903
2 17903 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17904
2 17904 i:= next_coru(293, <*ident*>
2 17905 10, <*prioritet*>
2 17906 true <*testmaske*>);
2 17907 j:= new_activity( i,
2 17908 0,
2 17909 op_spool);
2 17910 <*+3*>skriv_new_activity(out,i,j);
2 17911 <*-3*>
2 17912
2 17912 i:= next_coru(294, <*ident*>
2 17913 10, <*prioritet*>
2 17914 true <*testmaske*>);
2 17915 j:= new_activity( i,
2 17916 0,
2 17917 op_medd);
2 17918 <*+3*>skriv_new_activity(out,i,j);
2 17919 <*-3*>
2 17920
2 17920 cs_op_iomedd:= next_semch;
2 17921 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17922 <*-3*>
2 17923
2 17923 bs_opk_alarm:= next_sem;
2 17924 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17925 <*-3*>
2 17926
2 17926 cs_opk_alarm:= next_semch;
2 17927 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17928 <*-3*>
2 17929
2 17929 cs_opk_alarm_ur:= next_semch;
2 17930 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17931 <*-3*>
2 17932
2 17932 cs_opk_alarm_ur_ret:= next_semch;
2 17933 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17934 <*-3*>
2 17935
2 17935 cs_tvswitch_adgang:= next_semch;
2 17936 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17937 <*-3*>
2 17938
2 17938 cs_tv_switch_input:= next_semch;
2 17939 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17940 <*-3*>
2 17941
2 17941 cs_tv_switch_adm:= next_semch;
2 17942 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17943 <*-3*>
2 17944
2 17944 cs_talevejsswitch:= next_semch;
2 17945 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17946 <*-3*>
2 17947
2 17947 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17948
2 17948 iaf:= nextop(data+128);
2 17949 if testbit22 then
2 17950 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17951 else
2 17952 begin
3 17953 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17954 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17955 end;
2 17956
2 17956 i:= next_coru(295, <*ident*>
2 17957 8, <*prioritet*>
2 17958 true <*testmaske*>);
2 17959 j:= new_activity( i,
2 17960 0,
2 17961 alarmur);
2 17962 <*+3*>skriv_new_activity(out,i,j);
2 17963 <*-3*>
2 17964
2 17964 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17965
2 17965 i:= next_coru(296, <*ident*>
2 17966 8, <*prioritet*>
2 17967 true <*testmaske*>);
2 17968 j:= new_activity( i,
2 17969 0,
2 17970 opkaldsalarmer);
2 17971 <*+3*>skriv_new_activity(out,i,j);
2 17972 <*-3*>
2 17973
2 17973 i:= next_coru(297, <*ident*>
2 17974 3, <*prioritet*>
2 17975 true <*testmaske*>);
2 17976 j:= new_activity( i,
2 17977 0,
2 17978 tv_switch_input);
2 17979 <*+3*>skriv_new_activity(out,i,j);
2 17980 <*-3*>
2 17981
2 17981 for i:= 1,2 do
2 17982 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17983
2 17983 i:= next_coru(298, <*ident*>
2 17984 20, <*prioritet*>
2 17985 true <*testmaske*>);
2 17986 j:= new_activity( i,
2 17987 0,
2 17988 tv_switch_adm);
2 17989 <*+3*>skriv_new_activity(out,i,j);
2 17990 <*-3*>
2 17991
2 17991 i:= next_coru(299, <*ident*>
2 17992 3, <*prioritet*>
2 17993 true <*testmaske*>);
2 17994 j:= new_activity( i,
2 17995 0,
2 17996 talevejsswitch);
2 17997 <*+3*>skriv_new_activity(out,i,j);
2 17998 <*-3*>
2 17999 \f
2 17999 message garage_initialisering side 1 - 810521/hko;
2 18000
2 18000 cs_gar:= next_semch;
2 18001 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 18002 <*-3*>
2 18003
2 18003 i:= next_coru(300,<*ident*>
2 18004 10,<*prioritet*>
2 18005 true<*test_maske*>);
2 18006
2 18006 j:= new_activity( i,
2 18007 0,
2 18008 h_garage);
2 18009
2 18009 <*+3*>skriv_newactivity(out,i,j);
2 18010 <*-3*>
2 18011
2 18011 for k:= 1 step 1 until max_antal_garageterminaler do
2 18012 begin
3 18013 ref:= (k-1)*8;
3 18014 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 18015 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 18016 i:=monitor(4)process address:(z_gar(k),0,ia);
3 18017 if i = 0 then
3 18018 begin
4 18019 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 18020 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 18021 end
3 18022 else
3 18023 begin
4 18024 terminal_tab.ref.terminal_tilstand:=
4 18025 if garage_auto_include(k) then 0 else 7 shift 21;
4 18026 if garage_auto_include(k) then
4 18027 monitor(8)reserve:(z_gar(k),0,ia);
4 18028 end;
3 18029 cs_garage(k):= next_semch;
3 18030 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 18031 <*-3*>
3 18032 i:= next_coru(300+k,<*ident*>
3 18033 10,<*prioritet*>
3 18034 true <*testmaske*>);
3 18035 j:= new_activity( i,
3 18036 0,
3 18037 garage,k);
3 18038
3 18038 <*+3*>skriv_newactivity(out,i,j);
3 18039 <*-3*>
3 18040
3 18040 end;
2 18041 \f
2 18041 message radio_initialisering side 1 - 820301/hko;
2 18042
2 18042 cs_rad:= next_semch;
2 18043 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 18044 <*-3*>
2 18045
2 18045 i:= next_coru(400,<*ident*>
2 18046 10,<*prioritet*>
2 18047 true<*test_maske*>);
2 18048 j:= new_activity( i,
2 18049 0,
2 18050 h_radio);
2 18051 <*+3*>skriv_newactivity(out,i,j);
2 18052 <*-3*>
2 18053
2 18053 opkalds_kø_ledige:= max_antal_mobilopkald;
2 18054 nødopkald_brugt:= 0;
2 18055 læsfil(1034,1,i);
2 18056 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 18057
2 18057 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 18058 for i:= system(3,j,opkaldskø) step 1 until j do
2 18059 opkaldskø(i):= 0;
2 18060 første_frie_opkald:=opkaldskø_postlængde;
2 18061 første_opkald:=sidste_opkald:=
2 18062 første_nødopkald:=sidste_nødopkald:=j:=0;
2 18063
2 18063 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 18064 begin
3 18065 ref:=i*opkaldskø_postlængde;
3 18066 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 18067 end;
2 18068 ref:=ref+opkaldskø_postlængde;
2 18069 opkaldskø.ref(1):=j shift 12;
2 18070
2 18070 for ref:= 0 step 512 until (max_linienr//768*512) do
2 18071 begin
3 18072 i:= læs_fil(1035,ref//512+1,j);
3 18073 if i <> 0 then
3 18074 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 18075 tofrom(radio_linietabel.ref,fil(j),
3 18076 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 18077 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 18078 end;
2 18079
2 18079 for i:= system(3,j,kanal_tab) step 1 until j do
2 18080 kanal_tab(i):= 0;
2 18081 kanal_tilstand:= 2;
2 18082 kanal_id1:= 4;
2 18083 kanal_id2:= 6;
2 18084 kanal_spec:= 8;
2 18085 kanal_alt_id1:= 10;
2 18086 kanal_alt_id2:= 12;
2 18087 kanal_mon_maske:= 12;
2 18088 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 18089
2 18089 for i:= 1 step 1 until max_antal_kanaler do
2 18090 begin
3 18091 ref:= (i-1)*kanalbeskrlængde;
3 18092 sæthexciffer(kanal_tab.ref,3,15);
3 18093 if kanal_id(i) shift (-5) extract 3 = 2 or
3 18094 kanal_id(i) shift (-5) extract 3 = 3 and
3 18095 radio_id(kanal_id(i) extract 5)<=3
3 18096 then
3 18097 begin
4 18098 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 18099 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 18100 end;
3 18101 end;
2 18102 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 18103 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 18104 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 18105 optaget_flag:= 0;
2 18106 \f
2 18106 message radio_initialisering side 2 - 810524/hko;
2 18107
2 18107 bs_mobil_opkald:= next_sem;
2 18108
2 18108 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 18109 <*-3*>
2 18110
2 18110 bs_opkaldskø_adgang:= next_sem;
2 18111 signal_bin(bs_opkaldskø_adgang);
2 18112
2 18112 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 18113 <*-3*>
2 18114
2 18114 cs_radio_medd:=next_semch;
2 18115 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 18116
2 18116 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 18117 <*-3*>
2 18118
2 18118 i:= next_coru(403,
2 18119 5,<*prioritet*>
2 18120 true<*testmaske*>);
2 18121
2 18121 j:= new_activity( i,
2 18122 0,
2 18123 radio_medd_opkald);
2 18124
2 18124 <*+3*>skriv_newactivity(out,i,j);
2 18125 <*-3*>
2 18126
2 18126 cs_radio_adm:= nextsemch;
2 18127 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 18128 <*-3*>
2 18129
2 18129 i:= next_coru(404,
2 18130 10,
2 18131 true);
2 18132 j:= new_activity(i,
2 18133 0,
2 18134 radio_adm,next_op(data+radio_op_længde));
2 18135 <*+3*>skriv_new_activity(out,i,j);
2 18136 <*-3*>
2 18137 \f
2 18137 message radio_initialisering side 3 - 810526/hko;
2 18138 for k:= 1 step 1 until max_antal_taleveje do
2 18139 begin
3 18140
3 18140 cs_radio(k):=next_semch;
3 18141
3 18141 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 18142 <*-3*>
3 18143
3 18143 bs_talevej_udkoblet(k):= nextsem;
3 18144 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 18145 <*-3*>
3 18146
3 18146 i:=next_coru(410+k,
3 18147 10,
3 18148 true);
3 18149
3 18149 j:=new_activity( i,
3 18150 0,
3 18151 radio,k,next_op(data + radio_op_længde));
3 18152
3 18152 <*+3*>skriv_newactivity(out,i,j);
3 18153 <*-3*>
3 18154 end;
2 18155
2 18155 cs_radio_pulje:=next_semch;
2 18156
2 18156 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 18157 <*-3*>
2 18158
2 18158 for i:= 1 step 1 until radiopulje_størrelse do
2 18159 signal_ch(cs_radio_pulje,
2 18160 next_op(60),
2 18161 gen_optype or rad_optype);
2 18162
2 18162 cs_radio_kø:= next_semch;
2 18163
2 18163 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 18164 <*-3*>
2 18165
2 18165 mobil_opkald_aktiveret:= true;
2 18166 \f
2 18166 message radio_initialisering side 4 - 810522/hko;
2 18167
2 18167 laf:=raf:=0;
2 18168
2 18168 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 18169 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 18170 j:=1;
2 18171 if i <> 0 then
2 18172 fejlreaktion(4<*monitor resultat*>,i,
2 18173 string radio_fr_navn.raf(increase(j)),1);
2 18174 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 18175 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 18176 j:=1;
2 18177 if i <> 0 then
2 18178 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 18179 ia(1):= 3 <*canonical*>;
2 18180 ia(2):= 0 <*no echo*>;
2 18181 ia(3):= 0 <*prompt*>;
2 18182 ia(4):= 5 <*timeout*>;
2 18183 setcspterm(radio_fr_navn.laf,ia);
2 18184
2 18184 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 18185 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 18186 j:= 1;
2 18187 if i <> 0 then
2 18188 fejlreaktion(4<*monitor resultat*>,i,
2 18189 string radio_rf_navn.raf(increase(j)),1);
2 18190 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 18191 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 18192 j:= 1;
2 18193 if i <> 0 then
2 18194 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 18195 ia(1):= 3 <*canonical*>;
2 18196 ia(2):= 0 <*no echo*>;
2 18197 ia(3):= 0 <*prompt*>;
2 18198 ia(4):= 5 <*timeout*>;
2 18199 setcspterm(radio_rf_navn.laf,ia);
2 18200 \f
2 18200 message radio_initialisering side 5 - 810521/hko;
2 18201 for k:= 1 step 1 until max_antal_kanaler do
2 18202 begin
3 18203
3 18203 ss_radio_aktiver(k):=next_sem;
3 18204 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 18205 <*-3*>
3 18206
3 18206 ss_samtale_nedlagt(k):=next_sem;
3 18207 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 18208 <*-3*>
3 18209 end;
2 18210
2 18210 cs_radio_ind:= next_semch;
2 18211 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 18212 <*-3*>
2 18213
2 18213 i:= next_coru(401,<*ident radio_ind*>
2 18214 3, <*prioritet*>
2 18215 true <*testmaske*>);
2 18216 j:= new_activity( i,
2 18217 0,
2 18218 radio_ind,next_op(data + 64));
2 18219
2 18219 <*+3*>skriv_newactivity(out,i,j);
2 18220 <*-3*>
2 18221
2 18221 cs_radio_ud:=next_semch;
2 18222 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 18223 <*-3*>
2 18224
2 18224 i:= next_coru(402,<*ident radio_out*>
2 18225 10,<*prioritet*>
2 18226 true <*testmaske*>);
2 18227 j:= new_activity( i,
2 18228 0,
2 18229 radio_ud,next_op(data + 64));
2 18230
2 18230 <*+3*>skriv_newactivity(out,i,j);
2 18231 <*-3*>
2 18232 \f
2 18232 message vogntabel initialisering side 1 - 820301;
2 18233
2 18233 sidste_bus:= sidste_linie_løb:= 0;
2 18234
2 18234 tf_vogntabel:= 1 shift 10 + 2;
2 18235 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 18236 tf_gruppeidenter:= 1 shift 10 +6;
2 18237 tf_springdef:= 1 shift 10 +7;
2 18238 hent_fil_dim(ia);
2 18239 max_antal_i_gruppe:= ia(2);
2 18240 if ia(1) < max_antal_grupper then
2 18241 max_antal_grupper:= ia(1);
2 18242
2 18242 <* initialisering af interne vogntabeller *>
2 18243 begin
3 18244 long array field laf1,laf2;
3 18245 integer array fdim(1:8);
3 18246 zone z(128,1,stderror);
3 18247 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 18248 long omr,garageid;
3 18249 integer field ll, bn;
3 18250 boolean binær, test24;
3 18251
3 18251 ll:= 2; bn:= 4;
3 18252
3 18252 <* nulstil tabellerne *>
3 18253 laf1:= -2;
3 18254 laf2:= 2;
3 18255 bustabel1.laf2(0):=
3 18256 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 18257 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 18258 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 18259 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 18260 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 18261 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 18262 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 18263 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 18264 \f
3 18264 message vogntabel initialisering side 1a - 810505/cl;
3 18265
3 18265
3 18265 <* initialisering af intern busnummertabel *>
3 18266 open(z,4,<:busnumre:>,0);
3 18267 busnr:= -1;
3 18268 read(z,busnr);
3 18269 while busnr > 0 do
3 18270 begin
4 18271 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 18272 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 18273 sidste_bus:= sidste_bus+1;
4 18274 if sidste_bus > max_antal_busser then
4 18275 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 18276 repeatchar(z); readchar(z,tegn);
4 18277 garageid:= extend 0; binær:= false; omr:= extend 0;
4 18278 g_nr:= o_nr:= 0;
4 18279 if tegn='!' then
4 18280 begin
5 18281 binær:= true;
5 18282 readchar(z,tegn);
5 18283 end;
4 18284 if tegn='/' then <*garageid*>
4 18285 begin
5 18286 readchar(z,tegn); repeatchar(z);
5 18287 if '0'<=tegn and tegn<='9' then
5 18288 begin
6 18289 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 18290 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 18291 if g_nr<>0 and garageid=long<::> then
6 18292 begin
7 18293 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 18294 g_nr:= 0;
7 18295 end;
6 18296 end
5 18297 else
5 18298 begin
6 18299 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 18300 begin
7 18301 garageid:= garageid shift 8 + tegn;
7 18302 readchar(z,tegn);
7 18303 end;
6 18304 while garageid shift (-40) extract 8 = 0 do
6 18305 garageid:= garageid shift 8;
6 18306 g_nr:= find_bpl(garageid);
6 18307 if g_nr=0 then
6 18308 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 18309 end;
5 18310 repeatchar(z); readchar(z,tegn);
5 18311 end;
4 18312 if tegn=';' then
4 18313 begin
5 18314 readchar(z,tegn); repeatchar(z);
5 18315 if '0'<=tegn and tegn<='9' then
5 18316 begin
6 18317 read(z,o_nr);
6 18318 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 18319 if o_nr<>0 then omr:= område_navn(o_nr);
6 18320 if o_nr<>0 and omr=long<::> then
6 18321 begin
7 18322 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 18323 o_nr:= 0;
7 18324 end;
6 18325 end
5 18326 else
5 18327 begin
6 18328 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 18329 begin
7 18330 omr:= omr shift 8 + tegn;
7 18331 readchar(z,tegn);
7 18332 end;
6 18333 while omr shift (-40) extract 8 = 0 do
6 18334 omr:= omr shift 8;
6 18335 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 18336 i:= 1;
6 18337 while i<=max_antal_områder and o_nr=0 do
6 18338 begin
7 18339 if omr=område_navn(i) then o_nr:= i;
7 18340 i:= i+1;
7 18341 end;
6 18342 if o_nr=0 then
6 18343 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 18344 end;
5 18345 repeatchar(z); readchar(z,tegn);
5 18346 end;
4 18347 if o_nr=0 then o_nr:= 3;
4 18348 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 18349 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 18350
4 18350 busnr:= -1;
4 18351 read(z,busnr);
4 18352 end;
3 18353 close(z,true);
3 18354 \f
3 18354 message vogntabel initialisering side 2 - 820301/cl;
3 18355
3 18355 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 18356 test24:= testbit24;
3 18357 testbit24:= false;
3 18358 i:= 1;
3 18359 s:= læsfil(tf_vogntabel,i,zi);
3 18360 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 18361 while fil(zi).bn<>0 do
3 18362 begin
4 18363 if fil(zi).ll <> 0 then
4 18364 begin <* indsæt linie/løb *>
5 18365 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 18366 fil(zi).ll,j);
5 18367 if res < 0 then j:= j+1;
5 18368 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 18369 <:dobbeltregistrering i vogntabel:>,1)
5 18370 else
5 18371 begin
6 18372 o_nr:= fil(zi).bn shift (-14) extract 8;
6 18373 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 18374 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 18375 <:ukendt bus i vogntabel:>,1)
6 18376 else
6 18377 begin
7 18378 if sidste_linie_løb >= max_antal_linie_løb then
7 18379 fejlreaktion(10,fil(zi).bn extract 14,
7 18380 <:for mange linie/løb i vogntabel:>,0);
7 18381 for ll_nr:= sidste_linie_løb step (-1) until j do
7 18382 begin
8 18383 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18384 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18385 end;
7 18386 linie_løb_tabel(j):= fil(zi).ll;
7 18387 bus_indeks(j):= false add b_nr;
7 18388 sidste_linie_løb:= sidste_linie_løb + 1;
7 18389 end;
6 18390 end;
5 18391 end;
4 18392 i:= i+1;
4 18393 s:= læsfil(tf_vogntabel,i,zi);
4 18394 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18395 end;
3 18396 \f
3 18396 message vogntabel initialisering side 3 - 810428/cl;
3 18397
3 18397 <* initialisering af intern linie/løb-indekstabel *>
3 18398 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18399 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18400
3 18400 <* gem ny vogntabel i tabelfil *>
3 18401 for i:= 1 step 1 until sidste_bus do
3 18402 begin
4 18403 s:= skriv_fil(tf_vogntabel,i,zi);
4 18404 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18405 fil(zi).bn:= bustabel(i) extract 14 add
4 18406 (bustabel1(i) extract 8 shift 14);
4 18407 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18408 end;
3 18409 fdim(4):= tf_vogntabel;
3 18410 hent_fil_dim(fdim);
3 18411 pant:= fdim(3) * (256//fdim(2));
3 18412 for i:= sidste_bus+1 step 1 until pant do
3 18413 begin
4 18414 s:= skriv_fil(tf_vogntabel,i,zi);
4 18415 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18416 fil(zi).ll:= fil(zi).bn:= 0;
4 18417 end;
3 18418
3 18418 <* initialisering/nulstilling af gruppetabeller *>
3 18419 for i:= 1 step 1 until max_antal_grupper do
3 18420 begin
4 18421 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18422 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18423 gruppetabel(i):= fil(zi).ll;
4 18424 end;
3 18425 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18426 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18427 testbit24:= test24;
3 18428 end;
2 18429
2 18429
2 18429 <*+2*>
2 18430 <**> if testbit40 then p_vogntabel(out);
2 18431 <**> if testbit43 then p_gruppetabel(out);
2 18432 <*-2*>
2 18433
2 18433 message vogntabel initialisering side 3a -920517/cl;
2 18434
2 18434 <* initialisering for vt_log *>
2 18435
2 18435 v_tid:= 4;
2 18436 v_kode:= 6;
2 18437 v_bus:= 8;
2 18438 v_ll1:= 10;
2 18439 v_ll2:= 12;
2 18440 v_tekst:= 6;
2 18441 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18442 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18443 if vt_log_aktiv then
2 18444 begin
3 18445 integer i;
3 18446 real t;
3 18447 integer array field iaf;
3 18448 integer array
3 18449 tail(1:10),ia(1:10),chead(1:20);
3 18450
3 18450 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18451 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18452 if i=0 then
3 18453 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18454 if i=0 then
3 18455 begin
4 18456 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18457 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18458 end;
3 18459
3 18459 if i=0 then
3 18460 begin
4 18461 iaf:= 2;
4 18462 tofrom(vt_logdisc,tail.iaf,8);
4 18463 i:=slices(vt_logdisc,0,tail,chead);
4 18464 if i > (-2048) then
4 18465 begin
5 18466 vt_log_slicelgd:= chead(15);
5 18467 i:= 0;
5 18468 end;
4 18469 end;
3 18470
3 18470 if i=0 then
3 18471 begin
4 18472 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18473 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18474 if i=0 then
4 18475 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18476 if i=0 then
4 18477 begin
5 18478 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18479 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18480 end;
4 18481
4 18481 if i<>0 then
4 18482 begin
5 18483 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18484 tail(1):= 1;
5 18485 iaf:= 2;
5 18486 tofrom(tail.iaf,vt_logdisc,8);
5 18487 tail(6):=systime(7,0,t);
5 18488 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18489 if i=0 then
5 18490 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18491 end;
4 18492 end;
3 18493
3 18493 if i<>0 then vt_log_aktiv:= false;
3 18494 end;
2 18495
2 18495
2 18495 \f
2 18495 message vogntabel initialisering side 4 - 810520/cl;
2 18496
2 18496 cs_vt:= nextsemch;
2 18497 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18498 <*-3*>
2 18499
2 18499 cs_vt_adgang:= nextsemch;
2 18500 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18501 <*-3*>
2 18502
2 18502 cs_vt_opd:= nextsemch;
2 18503 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18504 <*-3*>
2 18505
2 18505 cs_vt_rap:= nextsemch;
2 18506 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18507 <*-3*>
2 18508
2 18508 cs_vt_tilst:= nextsemch;
2 18509 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18510 <*-3*>
2 18511
2 18511 cs_vt_auto:= nextsemch;
2 18512 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18513 <*-3*>
2 18514
2 18514 cs_vt_grp:= nextsemch;
2 18515 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18516 <*-3*>
2 18517
2 18517 cs_vt_spring:= nextsemch;
2 18518 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18519 <*-3*>
2 18520
2 18520 cs_vt_log:= nextsemch;
2 18521 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18522 <*-3*>
2 18523
2 18523 cs_vt_logpool:= nextsemch;
2 18524 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18525 <*-3*>
2 18526
2 18526 vt_op:= nextop(vt_op_længde);
2 18527 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18528
2 18528 vt_logop(1):= nextop(vt_op_længde);
2 18529 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18530 vt_logop(2):= nextop(vt_op_længde);
2 18531 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18532
2 18532 \f
2 18532 message vogntabel initialisering side 5 - 81-520/cl;
2 18533
2 18533 i:= nextcoru(500, <*ident*>
2 18534 10, <*prioitet*>
2 18535 true <*testmaske*>);
2 18536 j:= new_activity( i,
2 18537 0,
2 18538 h_vogntabel);
2 18539 <*+3*> skriv_newactivity(out,i,j);
2 18540 <*-3*>
2 18541
2 18541 i:= nextcoru(501, <*ident*>
2 18542 10, <*prioritet*>
2 18543 true <*testmaske*>);
2 18544 iaf:= nextop(filop_længde);
2 18545 j:= new_activity(i,
2 18546 0,
2 18547 vt_opdater,iaf);
2 18548 <*+3*> skriv_newactivity(out,i,j);
2 18549 <*-3*>
2 18550
2 18550 i:= nextcoru(502, <*ident*>
2 18551 10, <*prioritet*>
2 18552 true <*testmaske*>);
2 18553 k:= nextsemch;
2 18554 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18555 <*-3*>
2 18556 iaf:= nextop(fil_op_længde);
2 18557 j:= newactivity(i,
2 18558 0,
2 18559 vt_tilstand,
2 18560 k,
2 18561 iaf);
2 18562 <*+3*> skriv_newactivity(out,i,j);
2 18563 <*-3*>
2 18564 \f
2 18564 message vogntabel initialisering side 6 - 810520/cl;
2 18565
2 18565 i:= nextcoru(503, <*ident*>
2 18566 10, <*prioritet*>
2 18567 true <*testmaske*>);
2 18568 k:= nextsemch;
2 18569 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18570 <*-3*>
2 18571 iaf:= nextop(fil_op_længde);
2 18572 j:= newactivity(i,
2 18573 0,
2 18574 vt_rapport,
2 18575 k,
2 18576 iaf);
2 18577 <*+3*> skriv_newactivity(out,i,j);
2 18578 <*-3*>
2 18579
2 18579 i:= nextcoru(504, <*ident*>
2 18580 10, <*prioritet*>
2 18581 true <*testmaske*>);
2 18582 k:= nextsemch;
2 18583 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18584 <*-3*>
2 18585 iaf:= nextop(fil_op_længde);
2 18586 j:= new_activity(i,
2 18587 0,
2 18588 vt_gruppe,
2 18589 k,
2 18590 iaf);
2 18591 <*+3*> skriv_newactivity(out,i,j);
2 18592 <*-3*>
2 18593 \f
2 18593 message vogntabel initialisering side 7 - 810520/cl;
2 18594
2 18594 i:= nextcoru(505, <*ident*>
2 18595 10, <*prioritet*>
2 18596 true <*testmaske*>);
2 18597 k:= nextsemch;
2 18598 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18599 <*-3*>
2 18600 iaf:= nextop(fil_op_længde);
2 18601 j:= newactivity(i,
2 18602 0,
2 18603 vt_spring,
2 18604 k,
2 18605 iaf);
2 18606 <*+3*> skriv_newactivity(out,i,j);
2 18607 <*-3*>
2 18608
2 18608 i:= nextcoru(506, <*ident*>
2 18609 10,
2 18610 true <*testmaske*>);
2 18611 k:= nextsemch;
2 18612 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18613 <*-3*>
2 18614 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18615 j:= newactivity(i,
2 18616 0,
2 18617 vt_auto,
2 18618 k,
2 18619 iaf);
2 18620 <*+3*> skriv_newactivity(out,i,j);
2 18621 <*-3*>
2 18622
2 18622 i:=nextcoru(507, <*ident*>
2 18623 10, <*prioritet*>
2 18624 true <*testmaske*>);
2 18625 j:=newactivity(i,
2 18626 0,
2 18627 vt_log);
2 18628 <*+3*> skriv_newactivity(out,i,j);
2 18629 <*-3*>
2 18630
2 18630 <*+2*>
2 18631 <**> if testbit42 then skriv_vt_variable(out);
2 18632 <*-2*>
2 18633 \f
2 18633 message sysslut initialisering side 1 - 810406/cl;
2 18634 begin
3 18635 zone z(128,1,stderror);
3 18636 integer i,coruid,j,k;
3 18637 integer array field cor;
3 18638
3 18638 open(z,4,<:overvågede:>,0);
3 18639 for i:= read(z,coruid) while i > 0 do
3 18640 begin
4 18641 if coruid = 0 then
4 18642 begin
5 18643 for coruid:= 1 step 1 until maxcoru do
5 18644 begin
6 18645 cor:= coroutine(coruid);
6 18646 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18647 end
5 18648 end
4 18649 else
4 18650 begin
5 18651 cor:= coroutine(coru_no(abs coruid));
5 18652 if cor > 0 then
5 18653 begin
6 18654 d.cor.corutestmask:=
6 18655 (d.cor.corutestmask shift 1 shift (-1)) add
6 18656 ((coruid > 0) extract 1 shift 11);
6 18657 end;
5 18658 end;
4 18659 end;
3 18660 close(z,true);
3 18661
3 18661 læsfil(tf_systællere,1,k);
3 18662 rf:=iaf:= 4;
3 18663 systællere_nulstillet:= fil(k).rf;
3 18664 nulstil_systællere:= fil(k).iaf(1);
3 18665 if systællere_nulstillet=real<::> then
3 18666 begin
4 18667 systællere_nulstillet:= 0.0;
4 18668 nulstil_systællere:= -1;
4 18669 end;
3 18670 iaf:= 32;
3 18671 tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*10);
3 18672 iaf:= 192;
3 18673 tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*10);
3 18674
3 18674 end;
2 18675 \f
2 18675 message sysslut initialisering side 2 - 810603/cl;
2 18676
2 18676
2 18676 if låsning > 0 then
2 18677 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18678
2 18678 if låsning > 1 then
2 18679 <* låsning 2 : *> lock(readchar,1,write,2);
2 18680
2 18680 if låsning > 2 then
2 18681 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18682
2 18682
2 18682
2 18682
2 18682 if låsning > 0 then
2 18683 begin
3 18684 i:= locked(ia);
3 18685 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18686 end;
2 18687 \f
2 18687 message sysslut initialisering side 3 - 810406/cl;
2 18688
2 18688 write(z_io,"nl",2,<:initialisering slut:>);
2 18689 system(2)free core:(i,ra);
2 18690 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18691 setposition(z_io,0,0);
2 18692 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18693 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18694 "nl",1);
2 18695 errorbits:= 3; <* ok.no warning.yes *>
2 18696 \f
2 18696
2 18696 algol list.off;
2 18697 message coroutinemonitor - 40 ;
2 18698
2 18698 if simref <> firstsem then initerror(1, false);
2 18699 if semref <> firstop - 4 then initerror(2, false);
2 18700 if coruref <> firstsim then initerror(3, false);
2 18701 if opref <> optop + 6 then initerror(4, false);
2 18702 if proccount <> maxprocext -1 then initerror(5, false);
2 18703 goto takeexternal;
2 18704
2 18704 dump:
2 18705 op:= op;
2 18706 \f
2 18706 message sys trapaktion side 1 - 810521/hko/cl;
2 18707 trap(finale);
2 18708 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18709 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18710 begin
3 18711 k:= 0;
3 18712 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18713 <:timerqueue->:>));
3 18714 iaf:= i;
3 18715 for iaf:= d.iaf.next while iaf<>i do
3 18716 begin
4 18717 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18718 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18719 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18720 end;
3 18721 end;
2 18722 outchar(zbillede,'nl');
2 18723
2 18723 skriv_opkaldstællere(zbillede);
2 18724
2 18724
2 18724 pfilsystem(zbillede);
2 18725
2 18725
2 18725 write(zbillede,"nl",2,"=",20,<: attentionmodul :>,"=",20,"nl",1);
2 18726
2 18726 write(zbillede,"nl",1,<:attention-flag: :>,"nl",1);
2 18727 outintbits_ia(zbillede,att_flag,1,att_maske_lgd//2);
2 18728
2 18728 write(zbillede,"nl",1,<:attention-signal: :>,"nl",1);
2 18729 outintbits_ia(zbillede,att_signal,1,att_maske_lgd//2);
2 18730 \f
2 18730 message operatør trapaktion1 side 1 - 810521/hko;
2 18731 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18732
2 18732 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18733 for i:= 1 step 1 until max_antal_operatører do
2 18734 begin
3 18735 laf:= (i-1)*8;
3 18736 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18737 case operatør_auto_include(i) extract 2 + 1 of (
3 18738 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18739 terminal_navn.laf,"nl",1);
3 18740 end;
2 18741 write(zbillede,"nl",1);
2 18742
2 18742 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18743 <:betjeningspladsgrupper::>,"nl",1);
2 18744 for i:= 1 step 1 until 127 do
2 18745 if bpl_navn(i)<>long<::> then
2 18746 begin
3 18747 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18748 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18749 write(zbillede,"sp",16-k,<:= :>);
3 18750 iaf:= i*op_maske_lgd; j:=0;
3 18751 for k:= 1 step 1 until max_antal_operatører do
3 18752 begin
4 18753 if læsbit_ia(bpl_def.iaf,k) then
4 18754 begin
5 18755 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18756 write(zbillede,true,6,string bpl_navn(k));
5 18757 j:= j+1;
5 18758 end;
4 18759 end;
3 18760 write(zbillede,"nl",1);
3 18761 end;
2 18762
2 18762 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18763 for i:= 1 step 1 until max_antal_operatører do
2 18764 begin
3 18765 write(zbillede,<<dd >,i);
3 18766 for j:= 0 step 1 until 3 do
3 18767 begin
4 18768 k:= operatør_stop(i,j);
4 18769 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18770 else string bpl_navn(k));
4 18771 end;
3 18772 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18773 end;
2 18774
2 18774 skriv_terminal_tab(zbillede);
2 18775 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18776 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18777 skriv_opk_alarm_tab(zbillede);
2 18778 skriv_talevejs_tab(zbillede);
2 18779 skriv_op_spool_buf(zbillede);
2 18780 skriv_cqf_tabel(zbillede,true);
2 18781 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18782
2 18782 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18783 for i:= 1 step 1 until max_antal_garageterminaler do
2 18784 begin
3 18785 laf:= (i-1)*8;
3 18786 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18787 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18788 end;
2 18789 \f
2 18789 message radio trapaktion side 1 - 820301/hko;
2 18790 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18791 skriv_kanal_tab(zbillede);
2 18792 skriv_opkaldskø(zbillede);
2 18793 skriv_radio_linietabel(zbillede);
2 18794 skriv_radio_områdetabel(zbillede);
2 18795
2 18795 \f
2 18795 message vogntabel trapaktion side 1 - 810520/cl;
2 18796 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18797 skriv_vt_variable(zbillede);
2 18798 p_vogntabel(zbillede);
2 18799 p_gruppetabel(zbillede);
2 18800 p_springtabel(zbillede);
2 18801 \f
2 18801 message sysslut trapaktion side 1 - 810519/cl;
2 18802 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18803 corutable(zbillede);
2 18804 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18805 <: ref værdi prev next:>,"nl",1);
2 18806 iaf:= firstsim;
2 18807 repeat
2 18808 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18809 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18810 iaf:= iaf + simsize;
2 18811 until iaf>=simref;
2 18812 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18813 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18814 iaf:= firstsem;
2 18815 repeat
2 18816 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18817 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18818 iaf:= iaf+semsize;
2 18819 until iaf>=semref;
2 18820 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18821 iaf:= firstop;
2 18822 repeat
2 18823 skriv_op(zbillede,iaf);
2 18824 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18825 until iaf>=optop;
2 18826 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18827 <: messref messcode messop:>,"nl",1);
2 18828 for i:= 1 step 1 until maxmessext do
2 18829 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18830 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18831 <: procref proccode procop:>,"nl",1);
2 18832 for i:= 1 step 1 until maxprocext do
2 18833 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18834
2 18834
2 18834 \f
2 18834 message sys_finale side 1 - 810428/hko;
2 18835
2 18835 finale:
2 18836 trap(slut_finale);
2 18837 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18838 endaction:=0;
2 18839 \f
2 18839 message filsystem finale side 1 - 810428/cl;
2 18840
2 18840 <* lukning af zoner *>
2 18841 write(out,<:lukker filsystem:>); ud;
2 18842 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18843 close(fil(i),true);
2 18844 \f
2 18844 message operatør_finale side 1 - 810428/hko;
2 18845
2 18845 goto op_trap2_slut;
2 18846
2 18846 write(out,<:lukker operatører:>); ud;
2 18847 for k:= 1 step 1 until max_antal_operatører do
2 18848 begin
3 18849 close(z_op(k),true);
3 18850 end;
2 18851 op_trap2_slut:
2 18852 k:=k;
2 18853
2 18853 \f
2 18853 message garage_finale side 1 - 810428/hko;
2 18854
2 18854 write(out,<:lukker garager:>); ud;
2 18855 for k:= 1 step 1 until max_antal_garageterminaler do
2 18856 begin
3 18857 close(z_gar(k),true);
3 18858 end;
2 18859 \f
2 18859 message radio_finale side 1 - 810525/hko;
2 18860 write(out,<:lukker radio:>); ud;
2 18861 close(z_fr_in,true);
2 18862 close(z_fr_out,true);
2 18863 close(z_rf_in,true);
2 18864 close(z_rf_out,true);
2 18865 \f
2 18865 message sysslut finale side 1 - 810530/cl;
2 18866
2 18866 slut_finale:
2 18867
2 18867 trap(exit_finale);
2 18868
2 18868 outchar(zrl,'em');
2 18869 close(zrl,true);
2 18870
2 18870 write(zbillede,
2 18871 "nl",2,<:blocksread=:>,blocksread,
2 18872 "nl",1,<:blocksout= :>,blocksout,
2 18873 "nl",1,<:fillæst= :>,fillæst,
2 18874 "nl",1,<:filskrevet=:>,filskrevet,
2 18875 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18876 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18877 close(zbillede,true);
2 18878 monitor(42,zbillede,0,ia);
2 18879 ia(6):= systime(7,0,0.0);
2 18880 monitor(44,zbillede,0,ia);
2 18881 setposition(z_io,0,0);
2 18882 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18883 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18884 close(z_io,true);
2 18885 exit_finale: trapmode:= 1 shift 10;
2 18886
2 18886 end;
1 18887
1 18887
1 18887 algol list.on;
1 18888 message programslut;
1 18889 program_slut:
1 18890 end
\f
1. 7174606 3014035 611 0 0
2. 14246163 217984 350 0 0
3. 2074693 4935822 419 368 0
4. 7439386 4502864 428 1653 742
5. 13190438 14155789 583 29935 605
6. 13485989 15897506 584 0 0
7. 14086591 11128880 633 0 0
8. 18880 18874 18861 18843 18830 18822 18812 18804 18793 18782
18775 18762 18748 18739 18731 18725 18713 18700 18691 18681
18668 18639 18614 18596 18572 18553 18531 18518 18503 18487
18472 18451 18425 18411 18394 18374 18365 18343 18318 18293
18275 18262 18258 18230 18215 18199 18188 18175 18160 18144
18131 18115 18099 18077 18059 18043 18025 18008 17985 17966
17947 17935 17921 17901 17887 17868 17855 17836 17825 17812
17802 17785 17772 17761 17743 17730 17717 17697 17679 17666
17643 17623 17607 17594 17577 17565 17550 17535 17516 17495
17481 17471 17466 17456 17448 17429 17408 17388 17380 17373
17363 17318 17273 17245 17232 17199 17172 17149 17109 17084
17055 16999 16944 16891 16862 16829 16787 16755 16720 16664
16626 16586 16538 16505 16480 16457 16437 16409 16390 16371
16348 16337 16326 16306 16289 16274 16258 16231 16212 16196
16178 16169 16162 16137 16129 16119 16099 16088 16069 16058
16041 16026 16008 15983 15970 15959 15942 15924 15910 15903
15895 15886 15858 15841 15824 15811 15803 15794 15775 15764
15750 15738 15711 15696 15678 15656 15636 15623 15604 15581
15555 15534 15523 15501 15481 15459 15441 15413 15392 15374
15361 15353 15346 15331 15312 15305 15288 15268 15248 15234
15209 15194 15173 15147 15135 15126 15097 15075 15055 15045
15034 15009 14988 14968 14938 14919 14900 14880 14859 14851
14825 14812 14795 14776 14750 14731 14714 14687 14667 14645
14628 14608 14577 14546 14511 14484 14463 14450 14439 14418
14410 14401 14382 14362 14339 14312 14295 14277 14264 14254
14243 14219 14195 14176 14146 14133 14100 14065 14050 14029
14017 13991 13970 13950 13926 13915 13885 13866 13843 13813
13797 13774 13747 13712 13685 13678 13664 13643 13631 13617
13609 13594 13580 13573 13566 13559 13551 13518 13503 13483
13470 13452 13438 13410 13383 13365 13344 13326 13309 13292
13280 13270 13246 13240 13225 13205 13189 13172 13147 13134
13099 13082 13065 13042 13026 13014 12996 12969 12958 12950
12927 12908 12899 12882 12867 12849 12840 12828 12819 12801
12785 12770 12759 12740 12712 12691 12670 12654 12640 12633
12621 12604 12572 12554 12538 12521 12505 12474 12450 12440
12427 12412 12396 12378 12360 12336 12325 12309 12292 12276
12259 12235 12228 12210 12183 12165 12140 12115 12071 12060
12049 12021 11988 11958 11931 11889 11862 11841 11828 11820
11812 11802 11773 11756 11735 11720 11700 11677 11655 11631
11603 11581 11564 11539 11522 11506 11483 11468 11449 11430
11406 11371 11345 11327 11308 11287 11259 11242 11220 11206
11183 11155 11142 11129 11100 11062 11031 10988 10954 10923
10916 10908 10900 10889 10860 10837 10822 10812 10792 10774
10761 10752 10740 10731 10716 10708 10696 10667 10645 10627
10573 10538 10504 10471 10412 10396 10379 10360 10347 10334
10313 10301 10283 10270 10257 10230 10211 10194 10157 10141
10122 10114 10104 10073 10054 10037 10026 9996 9973 9948
9935 9926 9912 9888 9881 9871 9854 9835 9821 9802
9790 9774 9763 9752 9727 9710 9688 9670 9652 9632
9619 9599 9588 9562 9543 9524 9510 9500 9472 9454
9446 9422 9410 9398 9374 9356 9340 9329 9301 9284
9280 9263 9254 9247 9236 9222 9206 9189 9177 9165
9146 9136 9128 9101 9085 9078 9065 9051 9034 9026
9010 9001 8982 8945 8936 8911 8899 8885 8861 8841
8821 8799 8759 8741 8726 8714 8696 8687 8680 8668
8653 8642 8631 8617 8608 8587 8582 8571 8560 8544
8536 8526 8505 8493 8481 8461 8452 8438 8428 8414
8393 8378 8361 8351 8335 8322 8315 8298 8276 8257
8236 8222 8205 8187 8171 8154 8143 8129 8114 8068
8049 8012 7989 7966 7952 7931 7915 7886 7872 7850
7831 7800 7785 7773 7754 7741 7725 7706 7695 7680
7664 7652 7634 7604 7583 7562 7539 7516 7499 7483
7460 7443 7425 7388 7365 7358 7333 7321 7298 7284
7275 7256 7244 7227 7215 7194 7182 7164 7146 7124
7102 7094 7086 7079 7053 7026 7008 6988 6970 6954
6942 6922 6913 6896 6879 6868 6857 6846 6836 6831
6819 6809 6790 6777 6750 6739 6723 6715 6697 6681
6670 6634 6618 6604 6572 6545 6533 6523 6510 6497
6488 6472 6459 6440 6425 6418 6411 6401 6381 6373
6357 6349 6325 6310 6299 6288 6274 6258 6237 6224
6200 6187 6160 6131 6118 6090 6065 6049 6038 6022
6006 5989 5977 5955 5943 5934 5920 5907 5885 5854
5839 5824 5800 5773 5760 5752 5740 5726 5715 5703
5687 5673 5655 5636 5610 5593 5566 5552 5541 5519
5501 5479 5467 5449 5433 5417 5401 5382 5375 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
14086591 11128880 971 506071 31003
9. 16 310 16 4 960614 001931 buskom1
7 3 1995 306 algftnrts
0 1 0 2 *version
984 400 984 4 flushout
984 44 984 4 911004 101112 sendmessage
985 106 985 12 910308 134214 copyout
986 244 986 12 890821 163833 getzone6
0 410 0 0 out
987 178 987 12 940411 220029 testbit
990 414 990 18 940411 222629 findfpparam
993 46 993 18 890821 163814 system
996 238 996 18 movestring
996 56 996 18 890821 163907 outdate
997 124 997 18 isotable
998 176 997 18 890821 163656 write
1003 310 1003 152 intable
1004 34 1003 152 890821 163503 read
1008 24 1008 340 890821 163714 tofrom
995 420 993 18 stderror
1010 80 1010 340 890821 163740 open
1014 112 1014 340 890821 163754 monitor
1011 344 1010 340 close
1012 22 1010 340 setposition
995 378 993 18 increase
1002 50 997 18 outchar
997 26 997 18 replacechar
1017 98 1017 340 951214 094619 systime
0 1700 0 0 trapmode
1018 302 1018 340 trap
1018 112 1018 340 890821 163915 initzones
1019 268 1019 340 940411 222959 læsbitia
1020 22 1020 340 sign
1020 28 1020 340 890821 163648 ln
1021 432 1021 340 810409 111908 skrivhele
986 320 986 12 setzone6
1029 52 1029 340 inrec6
1029 28 1029 340 890821 163732 changerec6
1030 228 1030 340 940411 222949 sætbitia
1004 36 1003 152 readchar
1031 348 1031 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1032 278 1032 340 940411 222636 skrivtegn
1033 384 1033 340 940411 222639 afsluttext
1034 394 1034 340 940411 222952 læsbiti
1035 498 1035 340 960610 222201 systid
1037 28 1037 340 getnumber
1037 18 1037 340 900925 171358 putnumber
1 656 0 0 errorbits
1044 60 1044 342 940411 222943 sætbiti
1045 354 1045 342 940411 222801 openbs
1047 228 1047 342 940411 222742 hægttekst
1029 54 1029 340 outrec6
0 1704 0 0 alarmcause
1048 332 1048 342 940411 222745 hægtstring
1049 254 1049 342 940411 222749 anbringtal
1003 288 1003 152 repeatchar
1050 444 1050 342 940411 223002 intg
1051 350 1051 342 940411 222739 binærsøg
1020 20 1020 340 sgn
1052 380 1052 342 940411 222646 skrivtext
1029 56 1029 340 swoprec6
1056 56 1053 342 passivate
1053 40 1053 342 890821 163947 activity
1058 78 1058 350 260479 150000 mon
1 1043 1058 350 monw2
1 1039 1058 350 monw0
1 1041 1058 350 monw1
1055 56 1053 342 activate
0 1588 0 0 endaction
1058 320 1058 350 reflectcore
1054 50 1053 342 newactivity
1059 372 1059 358 940327 154135 setcspterm
1061 428 1061 358 941030 233200 slices
1065 52 1065 358 890821 163933 lock
1065 258 1065 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1066 162 1066 358 940411 222622 fpparam
1 1049 1067 358 nl
1 1047 1067 358 220978 131500 bel
1068 330 1068 446 940411 222722 ud
1069 252 1069 446 940411 222656 taltekst
1 1045 1058 350 monw3
986 296 986 12 getshare6
986 398 986 12 setshare6
70 480 1072 446 0
algol end 1072
*if ok.no
*if warning.yes
*o c
▶EOF◀