|
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: 994560 (0xf2d00)
Types: TextFile
Names: »buskomudx00 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomudx00 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.15464443.0334
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 integer array ialt(1:5);
3 810 real r;
3 811
3 811 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
3 812 write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
3 813 <:omr ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 814 for omr:= 1 step 1 until max_antal_områder do
3 815 begin
4 816 write(z,true,6,string område_navn(omr),":",1);
4 817 for typ:= 1 step 1 until 5 do
4 818 begin
5 819 write(z,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
5 820 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
5 821 end;
4 822 outchar(z,'nl');
4 823 end;
3 824 write(z,"-",47,"nl",1,<:I ALT ::>);
3 825 for typ:= 1 step 1 until 5 do
3 826 write(z,<< ddddddd>,ialt(typ));
3 827 outchar(z,'nl');
3 828
3 828 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
3 829 write(z,"nl",1,
3 830 <:oper. ud ind-alm ind-nød ej.forb optaget:>,"nl",1);
3 831 for omr:= 1 step 1 until max_antal_operatører do
3 832 begin
4 833 if bpl_navn(omr)=long<::> then
4 834 write(z,"sp",6-write(z,<:op:>,<<d>,omr),":",1)
4 835 else
4 836 write(z,true,6,string bpl_navn(omr),":",1);
4 837 for typ:= 1 step 1 until 5 do
4 838 begin
5 839 write(z,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
5 840 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
5 841 end;
4 842 outchar(z,'nl');
4 843 end;
3 844 write(z,"-",47,"nl",1,<:I ALT ::>);
3 845 for typ:= 1 step 1 until 5 do
3 846 write(z,<< ddddddd>,ialt(typ));
3 847 outchar(z,'nl');
3 848
3 848 rpc:= replace_char(1,':');
3 849 write(z,"nl",1,<:nulstilles :>);
3 850 if nulstil_systællere = (-1) then write(z,<:ikke automatisk:>,"nl",1)
3 851 else write(z,<:automatisk kl. :>,<<zd dd dd>,nulstil_systællere,"nl",1);
3 852 replace_char(1,'.');
3 853 write(z,<:nulstillet d. :>,<<zd dd dd>,
3 854 systime(4,systællere_nulstillet,r)," ",1);
3 855 replace_char(1,':');
3 856 write(z,<<zd dd dd>,r,"nl",1);
3 857 replace_char(1,rpc);
3 858 end;
2 859 \f
2 859 message procedure start_operation side 1 - 810521/hko;
2 860
2 860 procedure start_operation(op_ref,kor,ret_sem,kode);
2 861 value kor,ret_sem,kode;
2 862 integer array field op_ref;
2 863 integer kor,ret_sem,kode;
2 864 <*
2 865 op_ref: kald, reference til operation
2 866
2 866 kor: kald, kilde= hovedmodulnr*100 +løbenr
2 867 = korutineident.
2 868 ret_sem: kald, retursemafor
2 869
2 869 kode: kald, suppl shift 12 + operationskode
2 870
2 870 proceduren initialiserer en operations hoved med
2 871 parameterværdierne samt tidfeltet med aktueltid.
2 872 resultatfelt og datafelter nulstilles.
2 873
2 873 *>
2 874 begin
3 875 integer i;
3 876 d.op_ref.kilde:= kor;
3 877 systime(1,0,d.op_ref.tid);
3 878 d.op_ref.retur:=ret_sem;
3 879 d.op_ref.op_kode:=kode;
3 880 d.op_ref.resultat:=0;
3 881 for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
3 882 d.op_ref.data(i):=0;
3 883 end start_operation;
2 884 \f
2 884 message procedure afslut_operation side 1 - 810331/hko;
2 885
2 885 procedure afslut_operation(op_ref,sem);
2 886 value op_ref,sem;
2 887 integer op_ref,sem;
2 888 begin
3 889 integer array field op;
3 890 op:=op_ref;
3 891 if sem>0 then signal_ch(sem,op,d.op.optype) else
3 892 if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
3 893 ;
3 894 end afslut_operation;
2 895 \f
2 895 message procedure fejlreaktion - side 1 - 810424/cl,hko;
2 896
2 896 procedure fejlreaktion(nr,værdi,str,måde);
2 897 value nr,værdi,måde;
2 898 integer nr,værdi,måde;
2 899 string str;
2 900 begin
3 901 disable begin
4 902 write(out,<:<10>!!! :>);
4 903 if nr>0 and nr <=max_antal_fejltekster then
4 904 write(out,string fejltekst(nr))
4 905 else write(out,<:fejl nr.:>,nr);
4 906 outchar(out,'sp');
4 907 if måde shift (-12) extract 2=1 then
4 908 outintbits(out,værdi)
4 909 else
4 910 if måde shift (-12) extract 2=2 then
4 911 write(out,<:":>,false add værdi,1,<:":>)
4 912 else
4 913 write(out,værdi);
4 914 write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
4 915 <: korutine nr=:>,<<d>, abs curr_coruno,
4 916 <: ident=:>,curr_coruid,"nl",0);
4 917 if testbit27 and måde extract 12=1 then
4 918 trace(1);
4 919 ud;
4 920 end;<*disable*>
3 921 if måde extract 12 =2 then trapmode:=1 shift 13;
3 922 if måde extract 12= 0 then trap(-1)
3 923 else if måde extract 12 = 2 then trap(-2);
3 924 end fejlreaktion;
2 925
2 925 procedure trace(n);
2 926 value n;
2 927 integer n;
2 928 begin
3 929 trap(finis);
3 930 trap(n);
3 931 finis:
3 932 end trace;
2 933 \f
2 933 message procedure overvåget side 1 - 810413/cl;
2 934
2 934 boolean procedure overvåget;
2 935 begin
3 936 disable begin
4 937 integer i,måde;
4 938 integer array field cor;
4 939 integer array ia(1:12);
4 940
4 940 i:= system(12,0,ia);
4 941 if i > 0 then
4 942 begin
5 943 i:= system(12,1,ia);
5 944 måde:= ia(3);
5 945 end
4 946 else måde:= 0;
4 947
4 947 if måde<>0 then
4 948 begin
5 949 cor:= coroutine(abs ia(3));
5 950 overvåget:= d.cor.corutestmask shift (-11);
5 951 end
4 952 else overvåget:= cl_overvåget;
4 953 end;
3 954 end;
2 955 \f
2 955 message procedure antal_bits_ia side 1 - 940424/cl;
2 956
2 956 integer procedure antal_bits_ia(ia,n,ø);
2 957 value n,ø;
2 958 integer array ia;
2 959 integer n,ø;
2 960 begin
3 961 integer i, ant;
3 962
3 962 ant:= 0;
3 963 for i:= n step 1 until ø do
3 964 if læsbit_ia(ia,i) then ant:= ant+1;
3 965 end;
2 966
2 966 message procedure trunk_til_omr side 1 - 881006/cl;
2 967
2 967 integer procedure trunk_til_omr(trunk);
2 968 value trunk; integer trunk;
2 969 begin
3 970 integer i,j;
3 971
3 971 j:=0;
3 972 for i:= 1 step 1 until max_antal_områder do
3 973 if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
3 974 trunk_til_omr:=j;
3 975 end;
2 976
2 976 integer procedure omr_til_trunk(omr);
2 977 value omr; integer omr;
2 978 begin
3 979 omr_til_trunk:= område_id(omr,2) extract 12;
3 980 end;
2 981
2 981 integer procedure port_til_omr(port);
2 982 value port; integer port;
2 983 begin
3 984 if port shift (-6) extract 6 = 2 then
3 985 port_til_omr:= pabx_id(port extract 6)
3 986 else
3 987 if port shift (-6) extract 6 = 3 then
3 988 port_til_omr:= radio_id(port extract 6)
3 989 else
3 990 port_til_omr:= 0;
3 991 end;
2 992
2 992 integer procedure kanal_til_port(kanal);
2 993 value kanal; integer kanal;
2 994 begin
3 995 kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
3 996 kanal_id(kanal) extract 5;
3 997 end;
2 998
2 998 integer procedure port_til_kanal(port);
2 999 value port; integer port;
2 1000 begin
3 1001 integer i,j;
3 1002
3 1002 j:=0;
3 1003 for i:= 1 step 1 until max_antal_kanaler do
3 1004 if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
3 1005 port_til_kanal:= j;
3 1006 end;
2 1007
2 1007 integer procedure kanal_til_omr(kanal);
2 1008 value kanal; integer kanal;
2 1009 begin
3 1010 kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
3 1011 end;
2 1012
2 1012 \f
2 1012 message procedure out_xxx_bits side 1 - 810406/cl;
2 1013
2 1013 procedure outboolbits(zud,b);
2 1014 value b;
2 1015 zone zud;
2 1016 boolean b;
2 1017 begin
3 1018 integer i;
3 1019
3 1019 for i:= -11 step 1 until 0 do
3 1020 outchar(zud,if b shift i then '1' else '.');
3 1021 end;
2 1022
2 1022 procedure outintbits(zud,j);
2 1023 value j;
2 1024 zone zud;
2 1025 integer j;
2 1026 begin
3 1027 integer i;
3 1028
3 1028 for i:= -23 step 1 until 0 do
3 1029 begin
4 1030 outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
4 1031 if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
4 1032 end;
3 1033 end;
2 1034
2 1034 procedure outintbits_ia(zud,ia,n,ø);
2 1035 value n,ø;
2 1036 zone zud;
2 1037 integer array ia;
2 1038 integer n,ø;
2 1039 begin
3 1040 integer i;
3 1041
3 1041 for i:= n step 1 until ø do
3 1042 begin
4 1043 outintbits(zud,ia(i));
4 1044 outchar(zud,'nl');
4 1045 end;
3 1046 end;
2 1047
2 1047 real procedure now;
2 1048 begin
3 1049 real f,r,r1; long l;
3 1050
3 1050 systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
3 1051 systime(4,r,r1);
3 1052 now:= r1+f;
3 1053 end;
2 1054 \f
2 1054 message procedure skriv_id side 1 - 820301/cl;
2 1055
2 1055 procedure skriv_id(z,id,lgd);
2 1056 value id,lgd;
2 1057 integer id,lgd;
2 1058 zone z;
2 1059 begin
3 1060 integer type,p,li,lø,bo;
3 1061
3 1061 type:= id shift (-22);
3 1062 case type+1 of
3 1063 begin
4 1064 <* 1: bus *>
4 1065 begin
5 1066 p:= write(z,<<d>,id extract 14);
5 1067 if id shift (-14) <> 0 then
5 1068 p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
5 1069 end;
4 1070
4 1070 <* 2: linie/løb *>
4 1071 begin
5 1072 li:= id shift (-12) extract 10;
5 1073 bo:= id shift (-7) extract 5;
5 1074 if bo<>0 then bo:= bo + 'A' - 1;
5 1075 lø:= id extract 7;
5 1076 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
5 1077 end;
4 1078
4 1078 <* 3: gruppe *>
4 1079 begin
5 1080 if id shift (-21) = 4 <* linie-gruppe *> then
5 1081 begin
6 1082 li:= id shift (-5) extract 10;
6 1083 bo:= id extract 5;
6 1084 if bo<>0 then bo:= bo + 'A' - 1;
6 1085 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
6 1086 end
5 1087 else <* special-gruppe *>
5 1088 p:= write(z,"G",1,<<d>,id extract 7);
5 1089 end;
4 1090
4 1090 <* 4: telefon *>
4 1091 begin
5 1092 bo:= id shift (-20) extract 2;
5 1093 li:= id extract 20;
5 1094 case bo+1 of
5 1095 begin
6 1096 p:= write(z,string kanalnavn(li));
6 1097 p:= write(z,<:K*:>);
6 1098 p:= write(z,<:OMR :>,string områdenavn(li));
6 1099 p:= write(z,<:OMR*:>);
6 1100 end;
5 1101 end;
4 1102 end case;
3 1103 write(z,"sp",lgd-p);
3 1104 end skriv_id;
2 1105 <*+3*>
2 1106 \f
2 1106 message skriv_new_sem side 1 - 810520/cl;
2 1107
2 1107 procedure skriv_new_sem(z,type,ref,navn);
2 1108 value type,ref;
2 1109 zone z;
2 1110 integer type,ref;
2 1111 string navn;
2 1112 <* skriver en identifikation af en semafor 'ref' i zonen z.
2 1113
2 1113 type: 1=binær sem
2 1114 2=simpel sem
2 1115 3=kædet sem
2 1116
2 1116 ref: semaforreference
2 1117
2 1117 navn: semafornavn, max 18 tegn
2 1118 *>
2 1119 begin
3 1120 disable if testbit29 then
3 1121 write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
3 1122 true,5,<<zddd>,ref,true,19,navn);
3 1123 end;
2 1124 \f
2 1124 message procedure skriv_newactivity side 1 - 810520/hko/cl;
2 1125
2 1125 <**> procedure skriv_newactivity(zud,actno,cause);
2 1126 <**> value actno,cause;
2 1127 <**> zone zud;
2 1128 <**> integer actno,cause;
2 1129 <**> begin
3 1130 <*+2*>
3 1131 <**> if testbit28 then
3 1132 <**> begin integer array field cor;
4 1133 <**> cor:= coroutine(actno);
4 1134 <**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
4 1135 <**> << zdd>,d.cor.coruident//1000);
4 1136 <**> end;
3 1137 <**> if -, testbit23 then goto skriv_newact_slut;
3 1138 <*-2*>
3 1139 <**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
3 1140 <**> <:) cause=:>,<<-d>,cause);
3 1141 <**> if cause<1 then write(zud,<: !!!:>);
3 1142 <**> skriv_coru(zud,actno);
3 1143 <**> skriv_newact_slut:
3 1144 <**> end skriv_newactivity;
2 1145 <*-3*>
2 1146 <*+99*>
2 1147 \f
2 1147 message procedure skriv_activity side 1 - 810313/hko;
2 1148
2 1148 <**> procedure skriv_activity(zud,actno);
2 1149 <**> value actno;
2 1150 <**> zone zud;
2 1151 <**> integer actno;
2 1152 <**> begin
3 1153 <**> integer i;
3 1154 <**> integer array iact(1:12);
3 1155 <**>
3 1156 <**> i:=system(12,actno,iact);
3 1157 <**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
3 1158 <**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
3 1159 <**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
3 1160 <**> if i>0 and actno>0 and actno<=i then
3 1161 <**> begin
4 1162 <**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
4 1163 <**> (<:tom:>,<:passivate:>,
4 1164 <**> <:implicit passivate:>,<:activate:>));
4 1165 <**> if iact(1)<>0 then
4 1166 <**> write(zud,<: ventende på message:>,iact(1));
4 1167 <**> if iact(7)>0 then
4 1168 <**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
4 1169 <**> <:hovedlager stak benyttes af activity(:>,<<d>,
4 1170 <**> iact(2));
4 1171 <**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
4 1172 <**> iact(4),iact(5),iact(6),iact(10),iact(11));
4 1173 <**> if iact(9)<> 1 shift 22 then
4 1174 <**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
4 1175 <**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
4 1176 <**> end;
3 1177 <**> end skriv_activity
2 1178 <*-99*>
2 1179 <*+98*>
2 1180 \f
2 1180 message procedure identificer side 1 - 810520/cl;
2 1181
2 1181 procedure identificer(z);
2 1182 zone z;
2 1183 begin
3 1184 disable write(z,<:coroutine::>,<< dd>,curr_coruno,
3 1185 <: ident::>,<< zdd >,curr_coruid);
3 1186 end;
2 1187 \f
2 1187 message procedure skriv_coru side 1 - 810317/cl;
2 1188
2 1188 <**> procedure skriv_coru(zud,cor_no);
2 1189 <**> value cor_no;
2 1190 <**> zone zud;
2 1191 <**> integer cor_no;
2 1192 <**> begin
3 1193 <**> integer i;
3 1194 <**> integer array field cor;
3 1195 <**>
3 1196 <**>
3 1197 <**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
3 1198 <**>
3 1199 <**> cor:= coroutine(cor_no);
3 1200 <**> if cor = -1 then
3 1201 <**> write(zud,<: eksisterer ikke !!!:>)
3 1202 <**> else
3 1203 <**> begin
4 1204 <**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
4 1205 <**> <: refbyte: :>,<<d>,cor,"nl",1,
4 1206 <**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
4 1207 <**> <: next: :>,d.cor.next,"nl",1,
4 1208 <**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
4 1209 <**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
4 1210 <**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
4 1211 <**> <: opchain.next: :>,d.cor.coruop,"nl",1,
4 1212 <**> <: timer: :>,d.cor.corutimer,"nl",1,
4 1213 <**> <: priority: :>,d.cor.corupriority,"nl",1,
4 1214 <**> <: typeset: :>);
4 1215 <**> for i:= -11 step 1 until 0 do
4 1216 <**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
4 1217 <**> write(zud,"nl",1,<: testmask: :>);
4 1218 <**> for i:= -11 step 1 until 0 do
4 1219 <**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
4 1220 <*+99*>
4 1221 <**> skriv_activity(zud,cor_no);
4 1222 <*-99*>
4 1223 <**> end;
3 1224 <**> end skriv_coru;
2 1225 <*-98*>
2 1226 <*+98*>
2 1227 \f
2 1227 message procedure skriv_op side 1 - 810409/cl;
2 1228
2 1228 <**> procedure skriv_op(zud,opref);
2 1229 <**> value opref;
2 1230 <**> integer opref;
2 1231 <**> zone zud;
2 1232 <**> begin
3 1233 <**> integer array field op;
3 1234 <**> real array field raf;
3 1235 <**> integer lgd,i;
3 1236 <**> real t;
3 1237 <**>
3 1238 <**> raf:= data;
3 1239 <**> op:= opref;
3 1240 <**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
3 1241 <**> if opref<first_op ! optop<=opref then
3 1242 <**> begin
4 1243 <**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
4 1244 <**> goto slut_skriv_op;
4 1245 <**> end;
3 1246 <**>
3 1247 <**> lgd:= d.op.opsize;
3 1248 <**> write(zud,"nl",1,<<d>,
3 1249 <**> <: opsize :>,d.op.opsize,"nl",1,
3 1250 <**> <: optype :>);
3 1251 <**> for i:= -11 step 1 until 0 do
3 1252 <**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
3 1253 <**> write(zud,"nl",1,<<d>,
3 1254 <**> <: prev :>,d.op.prev,"nl",1,
3 1255 <**> <: next :>,d.op.next);
3 1256 <**> if lgd=0 then goto slut_skriv_op;
3 1257 <**> write(zud,"nl",1,<<d>,
3 1258 <**> <: kilde :>,d.op.kilde extract 10,"nl",1,
3 1259 <**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
3 1260 <**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
3 1261 d.op.retur,"nl",1,
3 1262 <**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
3 1263 <**> d.op.opkode extract 12,"nl",1,
3 1264 <**> <: resultat :>,d.op.resultat,"nl",2,
3 1265 <**> <:data::>);
3 1266 <**> skriv_hele(zud,d.op.raf,lgd-data,1278);
3 1267 <**>slut_skriv_op:
3 1268 <**> end skriv_op;
2 1269 <*-98*>
2 1270 \f
2 1270 message procedure corutable side 1 - 810406/cl;
2 1271
2 1271 procedure corutable(zud);
2 1272 zone zud;
2 1273 begin
3 1274 integer i;
3 1275 integer array field cor;
3 1276
3 1276 write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
3 1277 <:no id ref chain timerch opchain timer pr:>,
3 1278 <: typeset testmask:>,"nl",2);
3 1279 for i:= 1 step 1 until maxcoru do
3 1280 begin
4 1281 cor:= coroutine(i);
4 1282 write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
4 1283 d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
4 1284 d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
4 1285 d.cor.corutimer,<< dd>,d.cor.corupriority);
4 1286 outchar(zud,'sp');
4 1287 outboolbits(zud,d.cor.corutypeset);
4 1288 outchar(zud,'sp');
4 1289 outboolbits(zud,d.cor.corutestmask);
4 1290 outchar(zud,'nl');
4 1291 end;
3 1292 end;
2 1293 \f
2 1293 message filglobal side 1 - 790302/jg;
2 1294
2 1294 integer
2 1295 dbantsf,dbkatsfri,
2 1296 dbantb,dbkatbfri,
2 1297 dbantef,dbkatefri,
2 1298 dbsidstesz,dbsidstetz,
2 1299 dbsegmax,
2 1300 filskrevet,fillæst;
2 1301 integer
2 1302 bs_kats_fri, bs_kate_fri,
2 1303 cs_opret_fil, cs_tilknyt_fil,
2 1304 cs_frigiv_fil, cs_slet_fil,
2 1305 cs_opret_spoolfil, cs_opret_eksternfil;
2 1306 integer array
2 1307 dbkatt(1:dbmaxtf,1:2),
2 1308 dbkats(1:dbmaxsf,1:2),
2 1309 dbkate(1:dbmaxef,1:6),
2 1310 dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
2 1311 boolean array
2 1312 dbkatb(1:dbmaxb);
2 1313 zone array
2 1314 fil(dbantez+dbantsz+dbanttz,128,1,stderror);
2 1315 \f
2 1315 message hentfildim side 1 - 781120/jg;
2 1316
2 1316
2 1316 integer procedure hentfildim(fdim);
2 1317 integer array fdim;
2 1318 <*inddata filref i fdim(4),uddata fdim(1:8)*>
2 1319
2 1319 begin integer ftype,fno,katf,i,s;
3 1320 ftype:=fdim(4) shift (-10);
3 1321 fno:=fdim(4) extract 10;
3 1322 if ftype>3 or ftype=0 or fno=0 then
3 1323 begin s:=1; goto udgang; end;
3 1324 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
3 1325 begin s:=1; goto udgang end; <*paramfejl*>
3 1326 katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
3 1327 if katf extract 9 = 0 then
3 1328 begin s:=2; goto udgang end; <*tom indgang*>
3 1329
3 1329 fdim(1):=katf shift (-9); <*post antal*>
3 1330 fdim(2):=katf extract 9; <*post længde*>
3 1331 fdim(3):=case ftype of( <*seg antal*>
3 1332 dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
3 1333 extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
3 1334 dbkate(fno,2) extract 18);
3 1335 for i:=5 step 1 until 8 do <*externt filnavn*>
3 1336 fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
3 1337 s:=0;
3 1338 udgang:
3 1339 hentfildim:=s;
3 1340 <*+2*>
3 1341 <*tz*> if testbit24 and overvåget then <*zt*>
3 1342 <*tz*> begin <*zt*>
4 1343 <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
4 1344 <*tz*> pfdim(fdim); <*zt*>
4 1345 <*tz*> ud; <*zt*>
4 1346 <*tz*> end; <*zt*>
3 1347 <*-2*>
3 1348 end hentfildim;
2 1349 \f
2 1349 message sætfildim side 1 - 780916/jg;
2 1350
2 1350 integer procedure sætfildim(fdim);
2 1351 integer array fdim;
2 1352 <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
2 1353
2 1353 begin
3 1354 integer ftype,fno,katf,s,pl;
3 1355 integer array gdim(1:8);
3 1356 gdim(4):=fdim(4);
3 1357 s:=hentfildim(gdim);
3 1358 if s>0 then
3 1359 goto udgang;
3 1360 fno:=fdim(4) extract 10;
3 1361 ftype:=fdim(4) shift (-10);
3 1362 pl:= fdim(2) extract 12;
3 1363 if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
3 1364 begin
4 1365 s:=1; <*parameter fejl*>
4 1366 goto udgang
4 1367 end;
3 1368 if fdim(1)>256//pl*fdim(3) then
3 1369 begin
4 1370 s:=1;
4 1371 goto udgang;
4 1372 end;
3 1373
3 1373 <*segant*>
3 1374 if ftype=3 then
3 1375 begin integer segant;
4 1376 segant:= fdim(3);
4 1377 if segant > dbsegmax then
4 1378 begin
5 1379 s:=4; <*ingen plads*>
5 1380 goto udgang
5 1381 end;
4 1382 \f
4 1382 message sætfildim side 2 - 780916/jg;
4 1383
4 1383
4 1383 if segant<>gdim(3) then
4 1384 begin integer i,z,s; array field enavn; integer array tail(1:10);
5 1385 z:=dbkate(fno,2) shift (-19); if z>0 then begin
6 1386 if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
6 1387 begin integer array zd(1:20);
7 1388 getzone6(fil(z),zd);
7 1389 if zd(13)>5 and zd(9)>=segant then
7 1390 begin <*dødt segment skal ikke udskrives*>
8 1391 zd(13):=5;
8 1392 setzone6(fil(z),zd)
8 1393 end
7 1394 end end;
5 1395 \f
5 1395 message sætfildim side 3 - 801031/jg;
5 1396
5 1396
5 1396 enavn:=8; <*ændr fil størrelse*>
5 1397 i:=1;
5 1398 open(zdummy,0,string gdim.enavn(increase(i)),0);
5 1399 s:=monitor(42,zdummy,0,tail); <*lookup*>
5 1400 if s>0 then
5 1401 fejlreaktion(1,s,<:lookup entry:>,0);
5 1402 tail(1):=segant;
5 1403 s:=monitor(44,zdummy,0,tail); <*change entry*>
5 1404 close(zdummy,false);
5 1405 if s<>0 then
5 1406 begin
6 1407 if s=6 then
6 1408 begin <*ingen plads*>
7 1409 s:=4; goto udgang
7 1410 end
6 1411 else fejlreaktion(1,s,<:change entry:>,0);
6 1412 end;
5 1413 dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
5 1414 add segant;
5 1415 \f
5 1415 message sætfildim side 4 - 801013/jg;
5 1416
5 1416
5 1416 end;
4 1417 fdim(3):=segant
4 1418 end
3 1419 else
3 1420 if fdim(3)>gdim(3) then
3 1421 begin
4 1422 s:=4; <*altid ingen plads*>
4 1423 goto udgang
4 1424 end
3 1425 else fdim(3):=gdim(3); <*samme længde*>
3 1426 <*postantal,postlængde*>
3 1427 katf:=fdim(1) shift 9 add pl;
3 1428 case ftype of begin
4 1429 dbkatt(fno,1):=katf;
4 1430 dbkats(fno,1):=katf;
4 1431 dbkate(fno,1):=katf end;
3 1432 udgang:
3 1433 sætfildim:=s;
3 1434 <*+2*>
3 1435 <*tz*> if testbit24 and overvåget then <*zt*>
3 1436 <*tz*> begin integer i; <*zt*>
4 1437 <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
4 1438 <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
4 1439 <*tz*> pfdim(gdim); <*zt*>
4 1440 <*tz*> ud; <*zt*>
4 1441 <*tz*> end; <*zt*>
3 1442 <*-2*>
3 1443 end sætfildim;
2 1444 \f
2 1444 message findfilenavn side 1 - 780916/jg;
2 1445
2 1445 integer procedure findfilenavn(navn);
2 1446 real array navn;
2 1447
2 1447 begin
3 1448 integer fno; array field enavn;
3 1449 for fno:=1 step 1 until dbmaxef do
3 1450 if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
3 1451 begin
4 1452 enavn:=fno*12+4;
4 1453 if navn(1)=dbkate.enavn(1) and
4 1454 navn(2)=dbkate.enavn(2) then
4 1455 begin
5 1456 findfilenavn:=fno;
5 1457 goto udgang
5 1458 end
4 1459 end;
3 1460 findfilenavn:=0;
3 1461 udgang:
3 1462 end findfilenavn;
2 1463 \f
2 1463 message læsfil side 1 - 781120/jg;
2 1464
2 1464 integer procedure læsfil(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 læsfil:=tilgangfil(filref,postindex,zoneno,5);
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>læsfil::>,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 skrivfil side 1 - 781120/jg;
2 1481
2 1481 integer procedure skrivfil(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 skrivfil:=tilgangfil(filref,postindex,zoneno,6);
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>skrivfil::>,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 modiffil side 1 - 781120/jg;
2 1498
2 1498 integer procedure modiffil(filref,postindex,zoneno);
2 1499 value filref,postindex;
2 1500 integer filref,postindex,zoneno;
2 1501 <*+2*>
2 1502 <*tz*> begin integer i,o,s; <*zt*>
3 1503 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1504 <*-2*>
3 1505
3 1505 modiffil:=tilgangfil(filref,postindex,zoneno,7);
3 1506
3 1506 <*+2*>
3 1507 <*tz*> if testbit24 and overvåget then <*zt*>
3 1508 <*tz*> begin <*zt*>
4 1509 <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
4 1510 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1511 <*tz*> end; <*zt*>
3 1512 <*tz*> end procedure; <*zt*>
2 1513 <*-2*>
2 1514 \f
2 1514 message tilgangfil side 1 - 781003/jg;
2 1515
2 1515 integer procedure tilgangfil(filref,postindex,zoneno,operation);
2 1516 value filref,postindex,operation;
2 1517 integer filref,postindex,zoneno,operation;
2 1518 <*proceduren kaldes fra læsfil,skrivfil og modiffil*>
2 1519
2 1519 begin
3 1520 integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
3 1521 integer array zd(1:20),fdim(1:8);
3 1522
3 1522
3 1522
3 1522 <*hent katalog*>
3 1523
3 1523 fdim(4):=filref;
3 1524 st:=hentfildim(fdim);
3 1525 if st<>0 then
3 1526 goto udgang; <*parameter fejl eller fil findes ikke*>
3 1527 fno:=filref extract 10;
3 1528 ftype:=filref shift (-10);
3 1529 pl:=fdim(2);
3 1530 katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
3 1531 \f
3 1531 message tilgangfil side 2 - 781003/jg;
3 1532
3 1532
3 1532
3 1532 <*find segment adr og check postindex*>
3 1533
3 1533 pps:=256//pl; <*poster pr segment*>
3 1534 seg:=(postindex-1)//pps; <*relativt segment*>
3 1535 pr:=(postindex-1) mod pps; <*post relativ til seg*>
3 1536 if postindex <1 then
3 1537 begin <*parameter fejl*>
4 1538 st:=1;
4 1539 goto udgang
4 1540 end;
3 1541 if seg>=fdim(3) then
3 1542 begin <*post findes ikke*>
4 1543 st:=3;
4 1544 goto udgang
4 1545 end;
3 1546 case ftype of
3 1547 begin <*find absolut segment*>
4 1548
4 1548 <*tabelfil*>
4 1549 seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
4 1550
4 1550 begin <*spoolfil*>
5 1551 integer i,bidno;
5 1552 bidno:=katf extract 12;
5 1553 for i:=seg//dbbidlængde step -1 until 1 do
5 1554 bidno:=dbkatb(bidno) extract 12;
5 1555 seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
5 1556 end;
4 1557
4 1557 <*extern fil,seg ok*>
4 1558
4 1558 end case find abs seg;
3 1559 \f
3 1559 message tilgangfil side 3 - 801030/jg;
3 1560
3 1560 <*alloker zone*>
3 1561
3 1561 zno:=katf shift(-19);
3 1562 case ftype of begin
4 1563
4 1563 begin <*tabelfil*>
5 1564 integer førstetz;
5 1565 førstetz:=dbkatz(dbsidstetz,2);
5 1566 if zno=0 then
5 1567 zno:=førstetz
5 1568 else if dbkatz(zno,1)<>filref then
5 1569 zno:=førstetz
5 1570 else if zno <> førstetz and zno <> dbsidstetz then
5 1571 begin integer z;
6 1572 for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
6 1573 dbkatz(z,2):=dbkatz(zno,2);
6 1574 dbkatz(zno,2):=førstetz;
6 1575 dbkatz(dbsidstetz,2):=zno;
6 1576 end;
5 1577 dbsidstetz:=zno
5 1578 end;
4 1579 \f
4 1579 message tilgangfil side 4 - 801030/jg;
4 1580
4 1580
4 1580 begin <*spoolfil*>
5 1581 integer p,zslut,z;
5 1582 if zno>0 then begin if dbkatz(zno,1) =filref then
6 1583 goto udgangs end; <*strategi 1*>
5 1584 p:=0;
5 1585 zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
5 1586 zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
5 1587 for z:=dbantez+dbantsz step -1 until zslut do
5 1588 begin integer zfref;
6 1589 zfref:=dbkatz(z,1);
6 1590 if zfref extract 10=0 then <*fri zone*>
6 1591 begin <*strategi 2*>
7 1592 zno:=z;
7 1593 goto udgangs
7 1594 end
6 1595 else
6 1596 if zfref shift (-10)=2 then
6 1597 begin <*zone tilknyttet spoolfil*>
7 1598 integer q;
7 1599 q:=dbkatz(z,2); <*prioritet*>
7 1600 if q>p then
7 1601 begin <*strategi 3*>
8 1602 p:=q;
8 1603 zno:=z
8 1604 end
7 1605 end;
6 1606 end z;
5 1607 udgangs:
5 1608 if zno> dbantez then dbsidstesz:=zno;
5 1609 end;
4 1610 \f
4 1610 message tilgangfil side 5 - 780916/jg;
4 1611
4 1611 begin <*extern fil*>
5 1612 integer z;
5 1613 if zno=0 then
5 1614 zno:=1
5 1615 else if dbkatz(zno,1) = filref then
5 1616 goto udgange; <*strategi 1*>
5 1617 for z:=1 step 1 until dbantez do
5 1618 begin integer zfref;
6 1619 zfref:=dbkatz(z,1);
6 1620 if zfref=0 then <*zone fri*>
6 1621 begin zno:=z; goto udgange end <*strategi 2*>
6 1622 else if zfref shift (-10) =2 then <*spoolfil*>
6 1623 zno:=z; <*strategi 3*> <*else strategi 4-5*>
6 1624 end z;
5 1625 udgange:
5 1626 end
4 1627 end case alloker zone;
3 1628
3 1628
3 1628
3 1628 <*åbn zone*>
3 1629
3 1629 if zno<=dbantez then
3 1630 begin <*extern zone;spool og tabel zoner altid åbne*>
4 1631 integer zfref;
4 1632 zfref:=dbkatz(zno,1);
4 1633 if zfref<>0 and zfref<>filref and ftype=3 then
4 1634 begin <*luk hvis ny extern fil*>
5 1635 getzone6(fil(zno),zd);
5 1636 if zd(13)>5 then filskrevet:=filskrevet+1;
5 1637 zfref:=0;
5 1638 close(fil(zno),false);
5 1639 end;
4 1640 if zfref=0 then
4 1641 begin <*åbn zone*>
5 1642 array field enavn; integer i;
5 1643 enavn:=4*2; i:=1;
5 1644 open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
5 1645 string fdim.enavn(increase(i))),0)
5 1646 end
4 1647 end;
3 1648 \f
3 1648 message tilgangfil side 6 - 780916/jg;
3 1649
3 1649
3 1649
3 1649 <*hent segment og sæt zone descriptor*>
3 1650
3 1650 getzone6(fil(zno),zd);
3 1651 zstate:=zd(13);
3 1652 if zstate=0 or zd(9)<>seg then
3 1653 begin <*positioner*>
4 1654 if zstate>5 then
4 1655 filskrevet:=filskrevet+1;
4 1656 setposition(fil(zno),0,seg);
4 1657 if -,(operation=6 and pr=0) then
4 1658 begin <*læs seg medmindre op er skriv første post*>
5 1659 inrec6(fil(zno),512);
5 1660 fillæst:=fillæst+1
5 1661 end;
4 1662 zstate:=operation
4 1663 end
3 1664 else <*zstate:=max(operation,zone state)*>
3 1665 if operation>zstate then
3 1666 zstate:=operation;
3 1667 zd(9):=seg;
3 1668 zd(13):=zstate;
3 1669 zd(16):=pl shift 1;
3 1670 zd(14):=zd(19)+pr*zd(16);
3 1671 setzone6(fil(zno),zd);
3 1672 \f
3 1672 message tilgangfil side 7 - 780916/jg;
3 1673
3 1673
3 1673
3 1673 <*opdater kataloger*>
3 1674
3 1674 katf:=zno shift 19 add (katf extract 19);
3 1675 case ftype of
3 1676 begin
4 1677 dbkatt(fno,2):=katf;
4 1678 dbkats(fno,2):=katf;
4 1679 dbkate(fno,2):=katf
4 1680 end;
3 1681 dbkatz(zno,1):= filref;
3 1682 if ftype=3 then dbkatz(zno,2):=0 else
3 1683 <*if ftype=1 then allerede opd under zoneallokering*>
3 1684 if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
3 1685 if zstate=5 then (if pr=pps-1 then 2 else 1)
3 1686 else if zstate=6 and pr=pps-1 then 3 else 0;
3 1687
3 1687
3 1687
3 1687 <*udgang*>
3 1688
3 1688 udgang:
3 1689 if st=0 then
3 1690 zoneno:=zno
3 1691 else zoneno:=0; <*fejl*>
3 1692 tilgangfil:=st;
3 1693 end tilgangfil;
2 1694 \f
2 1694
2 1694 message pfilsystem side 1 - 781003/jg;
2 1695
2 1695 procedure pfilparm(z);
2 1696 zone z;
2 1697 write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
2 1698 dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
2 1699 <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
2 1700 dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
2 1701
2 1701 procedure pfilglobal(z);
2 1702 zone z;
2 1703 write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
2 1704 <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
2 1705 <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
2 1706 <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
2 1707 <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
2 1708 <:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
2 1709
2 1709
2 1709 procedure pdbkate(z,i);
2 1710 value i; integer i;
2 1711 zone z;
2 1712 begin integer j; array field navn;
3 1713 navn:=i*12+4; j:=1;
3 1714 write(z,<:<10>dbkate(:>,i,<:)=:>,
3 1715 dbkate(i,1) shift (-9),
3 1716 dbkate(i,1) extract 9,
3 1717 dbkate(i,2) shift (-19),
3 1718 dbkate(i,2) shift (-18) extract 1,
3 1719 dbkate(i,2) extract 18,
3 1720 <: :>,string dbkate.navn(increase(j)));
3 1721 end;
2 1722 \f
2 1722 message pfilsystem side 2 - 781003/jg;
2 1723
2 1723
2 1723
2 1723 procedure pdbkats(z,i);
2 1724 value i; integer i;
2 1725 zone z;
2 1726 write(z,<:<10>dbkats(:>,i,<:)=:>,
2 1727 dbkats(i,1) shift (-9),
2 1728 dbkats(i,1) extract 9,
2 1729 dbkats(i,2) shift (-19),
2 1730 dbkats(i,2) shift (-18) extract 1,
2 1731 dbkats(i,2) shift (-12) extract 6,
2 1732 dbkats(i,2) extract 12);
2 1733
2 1733 procedure pdbkatb(z,i);
2 1734 value i;integer i;
2 1735 zone z;
2 1736 write(z,<:<10>dbkatb(:>,i,<:)=:>,
2 1737 dbkatb(i) extract 12);
2 1738
2 1738 procedure pdbkatt(z,i);
2 1739 value i; integer i;
2 1740 zone z;
2 1741 write(z,<:<10>dbkatt(:>,i,<:)=:>,
2 1742 dbkatt(i,1) shift (-9),
2 1743 dbkatt(i,1) extract 9,
2 1744 dbkatt(i,2) shift (-19),
2 1745 dbkatt(i,2) shift (-18) extract 1,
2 1746 dbkatt(i,2) extract 18);
2 1747
2 1747 procedure pdbkatz(z,i);
2 1748 value i; integer i;
2 1749 zone z;
2 1750 write(z,<:<10>dbkatz(:>,i,<:)=:>,
2 1751 dbkatz(i,1),dbkatz(i,2));
2 1752 \f
2 1752 message pfilsystem side 3 - 781003/jg;
2 1753
2 1753
2 1753
2 1753 procedure pfil(z,i);
2 1754 value i; integer i;
2 1755 zone z;
2 1756 begin integer j,k; array field navn; integer array zd(1:20);
3 1757 navn:=2; k:=1;
3 1758 getzone6(fil(i),zd);
3 1759 write(z,<:<10>fil(:>,i,<:)=:>,
3 1760 zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
3 1761 string zd.navn(increase(k)));
3 1762 for j:=6 step 1 until 10 do write(z,zd(j));
3 1763 write(z,<:<10>:>);
3 1764 for j:=11 step 1 until 20 do write(z,zd(j));
3 1765 end;
2 1766
2 1766 procedure pfilsystem(z);
2 1767 zone z;
2 1768 begin integer i;
3 1769
3 1769 write(z,<:<12>udskrift af variable i filsystem:>);
3 1770 write(z,<:<10><10>filparm::>);
3 1771 pfilparm(z);
3 1772 write(z,<:<10><10>filglobal::>);
3 1773 pfilglobal(z);
3 1774 write(z,<:<10><10>fil: zone descriptor:>);
3 1775 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
3 1776 write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
3 1777 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
3 1778 write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
3 1779 for i :=1 step 1 until dbmaxef do pdbkate(z,i);
3 1780 write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
3 1781 for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
3 1782 write(z,<:<10><10>dbkatb: katbref:>);
3 1783 for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
3 1784 write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
3 1785 for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
3 1786 end pfilsystem;
2 1787 \f
2 1787 message pfilsystem side 4 - 781003/jg;
2 1788
2 1788
2 1788
2 1788 procedure pfdim(fdim);
2 1789 integer array fdim;
2 1790 begin
3 1791 integer i;
3 1792 array field navn;
3 1793 i:=1;navn:=8;
3 1794 write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
3 1795 string fdim.navn(increase(i)));
3 1796 end pfdim;
2 1797 \f
2 1797 message opretfil side 0 - 810529/cl;
2 1798
2 1798 procedure opretfil;
2 1799 <* checker parametre og vidresender operation
2 1800 til opret_spoolfil eller opret_eksternfil *>
2 1801
2 1801 begin
3 1802 integer array field op;
3 1803 integer status,pant,pl,segant,p_nøgle,fno,ftype;
3 1804
3 1804 procedure skriv_opret_fil(z,omfang);
3 1805 value omfang;
3 1806 zone z;
3 1807 integer omfang;
3 1808 begin
4 1809 write(z,"nl",1,<:+++ opret fil :>);
4 1810 if omfang > 0 then
4 1811 disable
4 1812 begin
5 1813 skriv_coru(z,abs curr_coruno);
5 1814 write(z,"nl",1,<<d>,
5 1815 <:op :>,op,"nl",1,
5 1816 <:status :>,status,"nl",1,
5 1817 <:pant :>,pant,"nl",1,
5 1818 <:pl :>,pl,"nl",1,
5 1819 <:segant :>,segant,"nl",1,
5 1820 <:p-nøgle:>,p_nøgle,"nl",1,
5 1821 <:fno :>,fno,"nl",1,
5 1822 <:ftype :>,ftype,"nl",1,
5 1823 <::>);
5 1824 end;
4 1825 end skriv_opret_fil;
3 1826 \f
3 1826 message opretfil side 1 - 810526/cl;
3 1827
3 1827 trap(opretfil_trap);
3 1828 <*+2*>
3 1829 <**> disable if testbit28 then
3 1830 <**> skriv_opret_fil(out,0);
3 1831 <*-2*>
3 1832
3 1832 stack_claim(if cm_test then 200 else 150);
3 1833
3 1833 <*+2*>
3 1834 <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
3 1835 <*-2*>
3 1836
3 1836 trin1:
3 1837 waitch(cs_opret_fil,op,true,-1);
3 1838
3 1838 trin2: <* check parametre *>
3 1839 disable begin
4 1840
4 1840 ftype:= d.op.data(4) shift (-10);
4 1841 fno:= d.op.data(4) extract 10;
4 1842 if ftype<2 or ftype>3 or fno<>0 then
4 1843 begin
5 1844 status:= 1; <*parameterfejl*>
5 1845 goto returner;
5 1846 end;
4 1847
4 1847 pant:= d.op.data(1);
4 1848 pl:= d.op.data(2);
4 1849 segant:= d.op.data(3);
4 1850 p_nøgle:= d.op.opkode shift (-12);
4 1851 if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
4 1852 or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
4 1853 status:= 1 <*parameterfejl *>
4 1854 else
4 1855 if pant>256//pl*segant then status:= 1 else
4 1856 if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
4 1857 status:= 4 <*ingen plads*>
4 1858 else
4 1859 status:=0;
4 1860 \f
4 1860 message opretfil side 2 - 810526/cl;
4 1861
4 1861
4 1861 returner:
4 1862
4 1862 d.op.data(9):= status;
4 1863
4 1863 <*+2*>
4 1864 <*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
4 1865 <*tz*> begin <*zt*>
5 1866 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 1867 <*tz*> pfdim(d.op.data); <*zt*>
5 1868 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1869 <*tz*> end; <*zt*>
4 1870 <*-2*>
4 1871
4 1871 <*returner eller vidresend operation*>
4 1872 signalch(if status>0 then d.op.retur else
4 1873 case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
4 1874 op,d.op.optype);
4 1875 end;
3 1876 goto trin1;
3 1877 opretfil_trap:
3 1878 disable skriv_opret_fil(zbillede,1);
3 1879
3 1879 end opretfil;
2 1880 \f
2 1880 message tilknytfil side 0 - 810526/cl;
2 1881
2 1881 procedure tilknytfil;
2 1882 <* tilknytter ekstern fil og returnerer intern filid *>
2 1883
2 1883 begin
3 1884 integer array field op;
3 1885 integer status,i,fno,segant,pa,pl,sliceant,s;
3 1886 array field enavn;
3 1887 integer array tail(1:10);
3 1888
3 1888 procedure skriv_tilknyt_fil(z,omfang);
3 1889 value omfang;
3 1890 zone z;
3 1891 integer omfang;
3 1892 begin
4 1893 write(z,"nl",1,<:+++ tilknyt fil :>);
4 1894 if omfang > 0 then
4 1895 disable
4 1896 begin real array field raf;
5 1897 skriv_coru(z,abs curr_coruno);
5 1898 write(z,"nl",1,<<d>,
5 1899 <:op :>,op,"nl",1,
5 1900 <:status :>,status,"nl",1,
5 1901 <:i :>,i,"nl",1,
5 1902 <:fno :>,fno,"nl",1,
5 1903 <:segant :>,segant,"nl",1,
5 1904 <:pa :>,pa,"nl",1,
5 1905 <:pl :>,pl,"nl",1,
5 1906 <:sliceant:>,sliceant,"nl",1,
5 1907 <:s :>,s,"nl",1,
5 1908 <::>);
5 1909 raf:= 0;
5 1910 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 1911 write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
5 1912 end;
4 1913 end skriv_tilknyt_fil;
3 1914 \f
3 1914 message tilknytfil side 1 - 810529/cl;
3 1915
3 1915 stack_claim(if cm_test then 200 else 150);
3 1916 trap(tilknytfil_trap);
3 1917
3 1917 <*+2*>
3 1918 <**> if testbit28 then
3 1919 <**> skriv_tilknyt_fil(out,0);
3 1920 <*-2*>
3 1921
3 1921 trin1:
3 1922 waitch(cs_tilknyt_fil,op,true,-1);
3 1923
3 1923 trin2:
3 1924 wait(bs_kate_fri);
3 1925
3 1925 trin3:
3 1926 disable begin
4 1927
4 1927 <* find ekstern rapportfil *>
4 1928 enavn:= 8;
4 1929 if find_fil_enavn(d.op.data.enavn)>0 then
4 1930 begin
5 1931 status:= 6; <* fil i brug *>
5 1932 goto returner;
5 1933 end;
4 1934 open(zdummy,0,d.op.data.enavn,0);
4 1935 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 1936 if s<>0 then
4 1937 begin
5 1938 if s=3 then status:= 2 <* fil findes ikke *>
5 1939 else if s=6 then status:= 1 <* parameterfejl, navn *>
5 1940 else fejlreaktion(1,s,<:lookup entry:>,0);
5 1941 goto returner;
5 1942 end;
4 1943 if tail(9)<>d.op.data(4) <* contentskey,subno *> then
4 1944 begin
5 1945 status:= 5; <* forkert indhold *> goto returner;
5 1946 end;
4 1947 segant:= tail(1);
4 1948 if segant>db_seg_max then
4 1949 segant:= db_seg_max;
4 1950 pa:= tail(10);
4 1951 pl:= tail(7) extract 12;
4 1952 if pl < 1 or pl > 256 then
4 1953 begin status:= 7; goto returner; end;
4 1954 \f
4 1954 message tilknytfil side 2 - 810529/cl;
4 1955 if pa>256//pl*segant then
4 1956 begin status:= 7; goto returner; end;
4 1957
4 1957 <* reserver *>
4 1958 s:= monitor(52)create area:(zdummy,0,ia);
4 1959 if s<>0 then
4 1960 begin
5 1961 if s=3 then status:= 2 <* fil findes ikke *>
5 1962 else if s=1 <* areaclaims exeeded *> then
5 1963 begin
6 1964 status:= 4;
6 1965 fejlreaktion(1,s,<:create area:>,1);
6 1966 end
5 1967 else fejlreaktion(1,s,<:create area:>,0);
5 1968 goto returner;
5 1969 end;
4 1970
4 1970 s:= monitor(8)reserve:(zdummy,0,ia);
4 1971 if s<>0 then
4 1972 begin
5 1973 if s<3 then status:= 6 <* i brug *>
5 1974 else fejlreaktion(1,s,<:reserve:>,0);
5 1975 monitor(64)remove area:(zdummy,0,ia);
5 1976 goto returner;
5 1977 end;
4 1978
4 1978 tail(7):= 1 shift 12 +pl; <* tilknyttet *>
4 1979 s:= monitor(44)change entry:(zdummy,0,tail);
4 1980 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 1981
4 1981 <* opdater katalog *>
4 1982 dbantef:= dbantef+1;
4 1983 fno:= dbkatefri;
4 1984 dbkatefri:= dbkate(fno,2);
4 1985 dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
4 1986 dbkate(fno,2):= segant;
4 1987 for i:= 5 step 1 until 8 do
4 1988 dbkate(fno,i-2):= d.op.data(i);
4 1989
4 1989 <* returparametre *>
4 1990 d.op.data(1):= pa;
4 1991 d.op.data(2):= pl;
4 1992 d.op.data(3):= segant;
4 1993 d.op.data(4):= 3 shift 10 +fno;
4 1994 status:= 0;
4 1995 \f
4 1995 message tilknytfil side 3 - 810526/cl;
4 1996
4 1996
4 1996 returner:
4 1997 close(zdummy,false);
4 1998 d.op.data(9):= status;
4 1999
4 1999
4 1999 <*+2*>
4 2000 <*tz*> if testbit24 and overvåget then <*zt*>
4 2001 <*tz*> begin <*zt*>
5 2002 <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
5 2003 <*tz*> pfdim(d.op.data); <*zt*>
5 2004 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2005 <*tz*> end; <*zt*>
4 2006 <*-2*>
4 2007
4 2007 signalch(d.op.retur,op,d.op.optype);
4 2008 if dbantef < dbmaxef then
4 2009 signalbin(bs_kate_fri);
4 2010 end;
3 2011 goto trin1;
3 2012 tilknytfil_trap:
3 2013 disable skriv_tilknyt_fil(zbillede,1);
3 2014 end tilknyt_fil;
2 2015 \f
2 2015 message frigivfil side 0 - 810529/cl;
2 2016
2 2016 procedure frigivfil;
2 2017 <* frigiver en tilknyttet ekstern fil *>
2 2018
2 2018 begin
3 2019 integer array field op;
3 2020 integer status,fref,ftype,fno,s,i,z;
3 2021 array field enavn;
3 2022 integer array tail(1:10);
3 2023
3 2023 procedure skriv_frigiv_fil(zud,omfang);
3 2024 value omfang;
3 2025 zone zud;
3 2026 integer omfang;
3 2027 begin
4 2028 write(zud,"nl",1,<:+++ frigiv fil :>);
4 2029 if omfang > 0 then
4 2030 disable
4 2031 begin real array field raf;
5 2032 skriv_coru(zud,abs curr_coruno);
5 2033 write(zud,"nl",1,<<d>,
5 2034 <:op :>,op,"nl",1,
5 2035 <:status:>,status,"nl",1,
5 2036 <:fref :>,fref,"nl",1,
5 2037 <:ftype :>,ftype,"nl",1,
5 2038 <:fno :>,fno,"nl",1,
5 2039 <:s :>,s,"nl",1,
5 2040 <:i :>,i,"nl",1,
5 2041 <:z :>,z,"nl",1,
5 2042 <::>);
5 2043 raf:= 0;
5 2044 write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
5 2045 end;
4 2046 end skriv_frigiv_fil;
3 2047 \f
3 2047 message frigivfil side 1 - 810526/cl;
3 2048
3 2048
3 2048 stack_claim(if cm_test then 200 else 150);
3 2049 trap(frigivfil_trap);
3 2050
3 2050 <*+2*>
3 2051 <**> disable if testbit28 then
3 2052 <**> skriv_frigiv_fil(out,0);
3 2053 <*-2*>
3 2054
3 2054 trin1:
3 2055 waitch(cs_frigiv_fil,op,true,-1);
3 2056
3 2056 trin2:
3 2057 disable begin
4 2058
4 2058 <* find fil *>
4 2059 fref:= d.op.data(4);
4 2060 ftype:= fref shift (-10);
4 2061 fno:= fref extract 10;
4 2062 if ftype=0 or ftype>3 or fno=0 then
4 2063 begin status:= 1; goto returner; end;
4 2064 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2065 begin status:= 1; goto returner; end;
4 2066 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2067 extract 9 = 0 then
4 2068 begin
5 2069 status:= 2; <* fil findes ikke *>
5 2070 goto returner;
5 2071 end;
4 2072 if ftype <> 3 then
4 2073 begin status:= 5; goto returner; end;
4 2074
4 2074 <* frigiv evt. tilknyttet zone og areaprocess *>
4 2075 z:= dbkate(fno,2) shift (-19);
4 2076 if z > 0 then
4 2077 begin
5 2078 if dbkatz(z,1)=fref then
5 2079 begin integer array zd(1:20);
6 2080 getzone6(fil(z),zd);
6 2081 if zd(13)>5 then filskrevet:= filskrevet +1;
6 2082 close(fil(z),true);
6 2083 dbkatz(z,1):= 0;
6 2084 end;
5 2085 end;
4 2086 \f
4 2086 message frigivfil side 2 - 810526/cl;
4 2087
4 2087 <* opdater tail *>
4 2088 enavn:= fno*12+4;
4 2089 open(zdummy,0,dbkate.enavn,0);
4 2090 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 2091 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
4 2092 tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
4 2093 tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
4 2094 s:= monitor(44)change entry:(zdummy,0,tail);
4 2095 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 2096 monitor(64)remove process:(zdummy,0,tail);
4 2097 close(zdummy,true);
4 2098
4 2098 <* frigiv indgang *>
4 2099 for i:= 1, 3 step 1 until 6 do
4 2100 dbkate(fno,1):= 0;
4 2101 dbkate(fno,2):= dbkatefri;
4 2102 dbkatefri:= fno;
4 2103 dbantef:= dbantef -1;
4 2104 signalbin(bs_kate_fri);
4 2105 d.op.data(4):= 0; <* filref null *>
4 2106 status:= 0;
4 2107
4 2107 returner:
4 2108 d.op.data(9):= status;
4 2109 <*+2*>
4 2110 <*tz*> if testbit24 and overvåget then <*zt*>
4 2111 <*tz*> begin <*zt*>
5 2112 <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
5 2113 <*tz*> pfdim(d.op.data); <*zt*>
5 2114 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2115 <*tz*> end; <*zt*>
4 2116 <*-2*>
4 2117
4 2117 signalch(d.op.retur,op,d.op.optype);
4 2118 end;
3 2119 goto trin1;
3 2120 frigiv_fil_trap:
3 2121 disable skriv_frigiv_fil(zbillede,1);
3 2122 end frigivfil;
2 2123 \f
2 2123 message sletfil side 0 - 810526/cl;
2 2124
2 2124 procedure sletfil;
2 2125 <* sletter en spool- eller ekstern fil *>
2 2126
2 2126 begin
3 2127 integer array field op;
3 2128 integer fref,fno,ftype,status;
3 2129
3 2129 procedure skriv_slet_fil(z,omfang);
3 2130 value omfang;
3 2131 zone z;
3 2132 integer omfang;
3 2133 begin
4 2134 write(z,"nl",1,<:+++ slet fil :>);
4 2135 if omfang > 0 then
4 2136 disable
4 2137 begin
5 2138 skriv_coru(z,abs curr_coruno);
5 2139 write(z,"nl",1,<<d>,
5 2140 <:op :>,op,"nl",1,
5 2141 <:fref :>,fref,"nl",1,
5 2142 <:fno :>,fno,"nl",1,
5 2143 <:ftype :>,ftype,"nl",1,
5 2144 <:status:>,status,"nl",1,
5 2145 <::>);
5 2146 end;
4 2147 end skriv_slet_fil;
3 2148 \f
3 2148 message sletfil side 1 - 810526/cl;
3 2149
3 2149 stack_claim(if cm_test then 200 else 150);
3 2150
3 2150 trap(sletfil_trap);
3 2151 <*+2*>
3 2152 <**> disable if testbit28 then
3 2153 <**> skriv_slet_fil(out,0);
3 2154 <*-2*>
3 2155
3 2155 trin1:
3 2156 waitch(cs_slet_fil,op,true,-1);
3 2157
3 2157 trin2:
3 2158 disable begin
4 2159
4 2159 <* find fil *>
4 2160 fref:= d.op.data(4);
4 2161 ftype:= fref shift (-10);
4 2162 fno:= fref extract 10;
4 2163 if ftype=0 or ftype>3 or fno=0 then
4 2164 begin status:= 1; goto returner; end;
4 2165 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2166 begin status:= 1; goto returner; end;
4 2167 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2168 extract 9 = 0 then
4 2169 begin
5 2170 status:= 2; <* fil findes ikke *>
5 2171 goto returner;
5 2172 end;
4 2173
4 2173
4 2173 <* slet spool- eller ekstern fil *>
4 2174 case ftype of
4 2175 begin
5 2176
5 2176 <* tabelfil - ingen aktion *>
5 2177 ;
5 2178 \f
5 2178 message sletfil side 2 - 810203/cl;
5 2179
5 2179 <* spoolfil *>
5 2180 begin
6 2181 integer z,bidno,bf,bidant,i;
6 2182
6 2182 <* hvis tilknyttet så frigiv *>
6 2183 z:= dbkats(fno,2) shift (-19);
6 2184 if z>0 then
6 2185 begin
7 2186 if dbkatz(z,1)=fref then
7 2187 begin integer array zd(1:20);
8 2188 dbkatz(z,1):= 2 shift 10;
8 2189 getzone6(fil(z),zd); <*annuler evt. udskrivning*>
8 2190 if zd(13)>5 then
8 2191 begin zd(13):= 0; setzone6(fil(z),zd); end;
8 2192 end;
7 2193 end;
6 2194
6 2194 <* frigiv bidder *>
6 2195 bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
6 2196 bidant:= dbkats(fno,2) shift (-12) extract 6;
6 2197 for i:= bidant -1 step -1 until 1 do
6 2198 bidno:= dbkatb(bidno) extract 12;
6 2199 dbkatb(bidno):= false add dbkatbfri;
6 2200 dbkatbfri:= bf;
6 2201 dbantb:= dbantb-bidant;
6 2202
6 2202 <* frigiv indgang *>
6 2203 dbkats(fno,1):= 0;
6 2204 dbkats(fno,2):= dbkatsfri;
6 2205 dbkatsfri:= fno;
6 2206 dbantsf:= dbantsf -1;
6 2207 signalbin(bs_kats_fri);
6 2208 end spoolfil;
5 2209 \f
5 2209 message sletfil side 3 - 810203/cl;
5 2210
5 2210 <* extern fil *>
5 2211 begin
6 2212 integer i,s,z;
6 2213 real array field enavn;
6 2214 integer array tail(1:10);
6 2215
6 2215 <* find head and tail *>
6 2216 enavn:= fno*12+4;
6 2217 open(zdummy,0,dbkate.enavn,0);
6 2218 s:= monitor(42)lookup entry:(zdummy,0,tail);
6 2219 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
6 2220
6 2220 <*frigiv evt. tilknyttet zone og areaprocess*>
6 2221 z:=dbkate(fno,2) shift (-19);
6 2222 if z>0 then
6 2223 begin
7 2224 if dbkatz(z,1)=fref then
7 2225 begin integer array zd(1:20);
8 2226 getzone6(fil(z),zd);
8 2227 if zd(13)>5 then <* udskrivning *>
8 2228 begin <*annuler*>
9 2229 zd(13):= 0;
9 2230 setzone6(fil(z),zd);
9 2231 end;
8 2232 close(fil(z),true);
8 2233 dbkatz(z,1):= 0;
8 2234 end;
7 2235 end;
6 2236
6 2236 <* fjern entry *>
6 2237 s:= monitor(48)remove entry:(zdummy,0,tail);
6 2238 if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
6 2239 close(zdummy,true);
6 2240
6 2240 <* frigiv indgang *>
6 2241 for i:=1, 3 step 1 until 6 do
6 2242 dbkate(fno,i):= 0;
6 2243 dbkate(fno,2):= dbkatefri;
6 2244 dbkatefri:= fno;
6 2245 dbantef:= dbantef -1;
6 2246 signalbin(bs_kate_fri);
6 2247 end eksternfil;
5 2248
5 2248 end ftype;
4 2249 \f
4 2249 message sletfil side 4 - 810526/cl;
4 2250
4 2250
4 2250 status:= 0;
4 2251 if ftype > 1 then
4 2252 d.op.data(4):= 0; <*filref null*>
4 2253
4 2253 returner:
4 2254 d.op.data(9):= status;
4 2255
4 2255 <*+2*>
4 2256 <*tz*> if testbit24 and overvåget then <*zt*>
4 2257 <*tz*> begin <*zt*>
5 2258 <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
5 2259 <*tz*> pfdim(d.op.data); <*zt*>
5 2260 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2261 <*tz*> end; <*zt*>
4 2262 <*-2*>
4 2263
4 2263 signalch(d.op.retur,op,d.op.optype);
4 2264 end;
3 2265 goto trin1;
3 2266 sletfil_trap:
3 2267 disable skriv_slet_fil(zbillede,1);
3 2268 end sletfil;
2 2269 \f
2 2269 message opretspoolfil side 0 - 810526/cl;
2 2270
2 2270 procedure opretspoolfil;
2 2271 <* opretter en spoolfil og returnerer intern filid *>
2 2272
2 2272 begin
3 2273 integer array field op;
3 2274 integer bidantal,fno,i,bs,bidstart;
3 2275
3 2275 procedure skriv_opret_spoolfil(z,omfang);
3 2276 value omfang;
3 2277 zone z;
3 2278 integer omfang;
3 2279 begin
4 2280 write(z,"nl",1,<:+++ opret spoolfil :>);
4 2281 if omfang > 0 then
4 2282 disable
4 2283 begin
5 2284 skriv_coru(z,abs curr_coruno);
5 2285 write(z,"nl",1,<<d>,
5 2286 <:op :>,op,"nl",1,
5 2287 <:bidantal:>,bidantal,"nl",1,
5 2288 <:fno :>,fno,"nl",1,
5 2289 <:i :>,i,"nl",1,
5 2290 <:bs :>,bs,"nl",1,
5 2291 <:bidstart:>,bidstart,"nl",1,
5 2292 <::>);
5 2293 end;
4 2294 end skriv_opret_spoolfil;
3 2295 \f
3 2295 message opretspoolfil side 1 - 810526/cl;
3 2296
3 2296 stack_claim(if cm_test then 200 else 150);
3 2297
3 2297 signalbin(bs_kats_fri); <*initialiseres til åben*>
3 2298
3 2298 trap(opretspool_trap);
3 2299 <*+2*>
3 2300 <**> disable if testbit28 then
3 2301 <**> skriv_opret_spoolfil(out,0);
3 2302 <*-2*>
3 2303 trin1:
3 2304 waitch(cs_opret_spoolfil,op,true,-1);
3 2305
3 2305 trin2:
3 2306 bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
3 2307 wait(bs_kats_fri);
3 2308
3 2308 trin3:
3 2309 if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
3 2310 begin
4 2311 wait(bs_kats_fri);
4 2312 goto trin3;
4 2313 end;
3 2314 disable begin
4 2315
4 2315 <*alloker bidder*>
4 2316 bs:= bidstart:= dbkatbfri;
4 2317 for i:= bidantal-1 step -1 until 1 do
4 2318 bs:= dbkatb(bs) extract 12;
4 2319 dbkatbfri:= dbkatb(bs) extract 12;
4 2320 dbkatb(bs):= false; <*sidste ref null*>
4 2321 dbantb:= dbantb+bidantal;
4 2322
4 2322 <*alloker indgang*>
4 2323 fno:= dbkatsfri;
4 2324 dbkatsfri:= dbkats(fno,2);
4 2325 dbantsf:= dbantsf +1;
4 2326 dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
4 2327 d.op.data(2) extract 9; <*postlængde*>
4 2328 dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
4 2329 \f
4 2329 message opretspoolfil side 2 - 810526/cl;
4 2330
4 2330 <*returner*>
4 2331 d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
4 2332 d.op.data(4):= 2 shift 10 add fno; <*filref*>
4 2333 for i:= 5 step 1 until 8 do <*filnavn null*>
4 2334 d.op.data(i):= 0;
4 2335 d.op.data(9):= 0; <*status ok*>
4 2336
4 2336 <*+2*>
4 2337 <*tz*> if testbit24 and overvåget then <*zt*>
4 2338 <*tz*> begin <*zt*>
5 2339 <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
5 2340 <*tz*> pfdim(d.op.data); <*zt*>
5 2341 <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
5 2342 <*tz*> end; <*zt*>
4 2343 <*-2*>
4 2344
4 2344 signalch(d.op.retur,op,d.op.optype);
4 2345 if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
4 2346 end;
3 2347 goto trin1;
3 2348
3 2348 opretspool_trap:
3 2349 disable skriv_opret_spoolfil(zbillede,1);
3 2350
3 2350 end opretspoolfil;
2 2351 \f
2 2351 message opreteksternfil side 0 - 810526/cl;
2 2352
2 2352 procedure opreteksternfil;
2 2353 <* opretter og knytter en ekstern fil *>
2 2354
2 2354 begin
3 2355 integer array field op;
3 2356 integer status,s,i,fno,p_nøgle;
3 2357 integer array tail(1:10),zd(1:20);
3 2358 real r;
3 2359 real array field enavn;
3 2360
3 2360 procedure skriv_opret_ekstfil(z,omfang);
3 2361 value omfang;
3 2362 zone z;
3 2363 integer omfang;
3 2364 begin
4 2365 write(z,"nl",1,<:+++ opret ekstern fil :>);
4 2366 if omfang > 0 then
4 2367 disable
4 2368 begin real array field raf;
5 2369 skriv_coru(z,abs curr_coruno);
5 2370 write(z,"nl",1,<<d>,
5 2371 <:op :>,op,"nl",1,
5 2372 <:status :>,status,"nl",1,
5 2373 <:s :>,s,"nl",1,
5 2374 <:i :>,i,"nl",1,
5 2375 <:fno :>,fno,"nl",1,
5 2376 <:p-nøgle:>,p_nøgle,"nl",1,
5 2377 <::>);
5 2378 raf:= 0;
5 2379 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 2380 write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
5 2381 end;
4 2382 end skriv_opret_ekstfil;
3 2383 \f
3 2383 message opreteksternfil side 1 - 810526/cl;
3 2384
3 2384 stack_claim(if cm_test then 200 else 150);
3 2385
3 2385 signalbin(bs_kate_fri); <*initialiseres til åben*>
3 2386
3 2386 trap(opretekst_trap);
3 2387 <*+2*>
3 2388 <**> disable if testbit28 then
3 2389 <**> skriv_opret_ekstfil(out,0);
3 2390 <*-2*>
3 2391 trin1:
3 2392 waitch(cs_opret_eksternfil,op,true,-1);
3 2393
3 2393 trin2:
3 2394 wait(bs_kate_fri);
3 2395
3 2395 trin3:
3 2396 <*opret temporær fil og tilknyt den*>
3 2397 disable begin
4 2398
4 2398 enavn:= 8;
4 2399 <*opret*>
4 2400 open(zdummy,0,d.op.data.enavn,0);
4 2401 tail(1):= d.op.data(3); <*segant*>
4 2402 tail(2):= 1;
4 2403 tail(6):= systime(7,0,r); <*shortclock*>
4 2404 tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
4 2405 tail(8):= 0;
4 2406 tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
4 2407 tail(10):= d.op.data(1); <*postantal*>
4 2408 s:= monitor(40)create entry:(zdummy,0,tail);
4 2409 if s<>0 then
4 2410 begin
5 2411 if s=4 <*claims exeeded*> then
5 2412 begin
6 2413 status:= 4;
6 2414 fejlreaktion(1,s,<:create entry:>,1);
6 2415 goto returner;
6 2416 end;
5 2417 if s=3 <*navn ikke unikt*> then
5 2418 begin status:= 6; goto returner; end;
5 2419 fejlreaktion(1,s,<:create entry:>,0);
5 2420 end;
4 2421 \f
4 2421 message opreteksternfil side 2 - 810203/cl;
4 2422
4 2422 p_nøgle:= d.op.opkode shift (-12);
4 2423 s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
4 2424 if s<>0 then
4 2425 begin
5 2426 if s=6 then
5 2427 begin <*claims exeeded*>
6 2428 status:= 4;
6 2429 fejlreaktion(1,s,<:permanent entry:>,1);
6 2430 monitor(48)remove entry:(zdummy,0,tail);
6 2431 goto returner;
6 2432 end
5 2433 else fejlreaktion(1,s,<:permanent entry:>,0);
5 2434 end;
4 2435
4 2435 <*reserver*>
4 2436 s:= monitor(52)create areaprocess:(zdummy,0,zd);
4 2437 if s<>0 then
4 2438 begin
5 2439 fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
5 2440 status:= 4;
5 2441 monitor(48)remove entry:(zdummy,0,zd);
5 2442 goto returner;
5 2443 end;
4 2444
4 2444 s:= monitor(8)reserve:(zdummy,0,zd);
4 2445 if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
4 2446
4 2446 <*tilknyt*>
4 2447 dbantef:= dbantef +1;
4 2448 fno:= dbkatefri;
4 2449 dbkatefri:= dbkate(fno,2);
4 2450 dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
4 2451 dbkate(fno,2):= tail(1);
4 2452 getzone6(zdummy,zd);
4 2453 for i:= 2 step 1 until 5 do
4 2454 dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
4 2455 d.op.data(3):= tail(1);
4 2456 d.op.data(4):= 3 shift 10 +fno;
4 2457 status:= 0;
4 2458 \f
4 2458 message opreteksternfil side 3 - 810526/cl;
4 2459
4 2459 returner:
4 2460
4 2460 close(zdummy,false);
4 2461 d.op.data(9):= status;
4 2462
4 2462 <*+2*>
4 2463 <*tz*> if testbit24 and overvåget then <*zt*>
4 2464 <*tz*> begin <*zt*>
5 2465 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 2466 <*tz*> pfdim(d.op.data); <*zt*>
5 2467 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2468 <*tz*> end; <*zt*>
4 2469 <*-2*>
4 2470
4 2470 signalch(d.op.retur,op,d.op.optype);
4 2471 if dbantef<dbmaxef then signalbin(bs_kate_fri);
4 2472 end;
3 2473 goto trin1;
3 2474
3 2474 opretekst_trap:
3 2475 disable skriv_opret_ekstfil(zbillede,1);
3 2476
3 2476 end opreteksternfil;
2 2477
2 2477 \f
2 2477 message attention_erklæringer side 1 - 850820/cl;
2 2478
2 2478 integer
2 2479 tf_kommandotabel,
2 2480 cs_att_pulje,
2 2481 bs_fortsæt_adgang,
2 2482 att_proc_ref;
2 2483
2 2483 integer array
2 2484 att_flag,
2 2485 att_signal(1:att_maske_lgd//2);
2 2486
2 2486 integer array
2 2487 terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
2 2488 max_antal_operatører+max_antal_garageterminaler)),
2 2489 fortsæt(1:32);
2 2490 \f
2 2490 message procedure afslut_kommando side 1 - 810507/hko;
2 2491
2 2491 procedure afslut_kommando(op_ref);
2 2492 integer array field op_ref;
2 2493 begin integer nr,i,sem;
3 2494 i:= d.op_ref.kilde;
3 2495 nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
3 2496 else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
3 2497 sætbit_ia(att_flag,nr,0);
3 2498 d.op_ref.optype:=gen_optype;
3 2499 <* "husket" attention disabled ****************
3 2500 if sætbit_ia(att_signal,nr,0)=1 then
3 2501 begin
3 2502 sem:=if i=299 then cs_talevejsswitch else
3 2503 case i//100 of (cs_io_komm,cs_operatør(i mod 100),
3 2504 cs_garage(i mod 100));
3 2505 afslut_operation(op_ref,0);
3 2506 start_operation(op_ref,i,cs_att_pulje,0);
3 2507 signal_ch(sem,op_ref,gen_optype);
3 2508 end
3 2509 else
3 2510 ********************* disable "husket" attention *>
3 2511 afslut_operation(op_ref,cs_att_pulje);
3 2512 end;
2 2513 \f
2 2513 message procedure læs_store side 1 - 880919/cl;
2 2514
2 2514 integer procedure læs_store(z,c);
2 2515 zone z;
2 2516 integer c;
2 2517 begin
3 2518 læs_store:= readchar(z,c);
3 2519 if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
3 2520 end;
2 2521 \f
2 2521 message procedure param side 1 - 810226/cl;
2 2522
2 2522
2 2522
2 2522 integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
2 2523 value tabel_id;
2 2524 integer pos, tabel_id, type, sep;
2 2525 integer array txt, spec, værdi;
2 2526
2 2526
2 2526
2 2526 <*************************************>
2 2527 <* *>
2 2528 <* CLAUS LARSEN: 15.07.77 *>
2 2529 <* *>
2 2530 <*************************************>
2 2531
2 2531
2 2531
2 2531
2 2531 <* param syntax-analyserer en parameterliste, og *>
2 2532 <* bestemmer næste parameter og den separator der *>
2 2533 <* afslutter parameteren *>
2 2534
2 2534
2 2534
2 2534 begin
3 2535 integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
3 2536 real array indgang(1:2);
3 2537 integer i, j, tegn, tegn_pos, tal, hashnøgle,
3 2538 zone_nr, top, max_segm, start_segm, lpos;
3 2539 boolean minus, separator;
3 2540 lpos := pos;
3 2541 type:=-1;
3 2542 for i:=1 step 1 until 4 do værdi(i):=0;
3 2543 \f
3 2543 message procedure param side 2 - 810428/cl,hko;
3 2544
3 2544
3 2544
3 2544 <* grænsecheck for pos *>
3 2545 begin
4 2546 integer nedre, øvre;
4 2547
4 2547 nedre := system(3,øvre,txt);
4 2548 nedre := nedre * 3 - 2;
4 2549 øvre := øvre * 3;
4 2550 if lpos < (nedre - 1) or øvre < lpos then
4 2551 begin
5 2552 sep:= -1;
5 2553 param:= 5;
5 2554 goto slut;
5 2555 end;
4 2556
4 2556 <* er parameterlisten slut *>
4 2557 lpos:= lpos+1;
4 2558 læs_tegn(txt,lpos,tegn);
4 2559 if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
4 2560 begin
5 2561 lpos := lpos - 2;
5 2562 sep := tegn;
5 2563 param := 5;
5 2564
5 2564 goto slut;
5 2565 end else lpos:= lpos-1;
4 2566 end;
3 2567 \f
3 2567 message procedure param side 3 - 810428/cl;
3 2568
3 2568
3 2568 <* initialisering *>
3 2569 for i := 1 step 1 until 4 do
3 2570 aktuel_param(i) := 0;
3 2571 minus := separator := false;
3 2572
3 2572 <* initialiser klassetabel *>
3 2573 for i := 65 step 1 until 93,
3 2574 97 step 1 until 125 do klasse(i) := 1;
3 2575 for i := 48 step 1 until 57 do klasse(i) := 2;
3 2576 for i := 0 step 1 until 47, 58 step 1 until 64,
3 2577 94, 95, 96, 126, 127 do klasse(i) := 4;
3 2578
3 2578
3 2578 <* sæt specialtegn *>
3 2579 i := 1;
3 2580 læs_tegn(spec,i,tegn);
3 2581 while tegn <> 0 do
3 2582 begin
4 2583 if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
4 2584 klasse(tegn) := 3;
4 2585 læs_tegn(spec,i,tegn);
4 2586 end;
3 2587 \f
3 2587 message procedure param side 4 - 810226/cl;
3 2588
3 2588
3 2588 <* læs første tegn i ny parameter og bestem typen *>
3 2589 læs_tegn(txt,lpos,tegn);
3 2590
3 2590 case klasse(tegn) of
3 2591 begin
4 2592
4 2592 <* case 1 - bogstav *>
4 2593 begin
5 2594 type := 0;
5 2595 param := 0;
5 2596 tegn_pos := 1;
5 2597 hashnøgle := 0;
5 2598
5 2598 <* læs parameter *>
5 2599 while tegn_pos < 12 and klasse(tegn) <> 4 do
5 2600 begin
6 2601 hashnøgle := hashnøgle + tegn;
6 2602 skriv_tegn(aktuel_param,tegn_pos,tegn);
6 2603 læs_tegn(txt,lpos,tegn);
6 2604 end;
5 2605
5 2605 <* find separator *>
5 2606 while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
5 2607 sep := tegn;
5 2608 \f
5 2608 message procedure param side 5 - 810226/cl;
5 2609
5 2609 <* tabelopslag *>
5 2610 if tabel_id <> 0 then
5 2611 begin
6 2612 <* hent max_segm *>
6 2613
6 2613 fdim(4) := tabel_id;
6 2614 j := hent_fil_dim(fdim);
6 2615 if j > 0 then
6 2616 begin
7 2617 param := 4;
7 2618 for i := 1 step 1 until 4 do
7 2619 værdi(i) := aktuel_param(i);
7 2620 goto slut;
7 2621 end;
6 2622 max_segm := fdim(3);
6 2623
6 2623 <* forbered opslag *>
6 2624 start_segm := (hashnøgle mod max_segm) + 1;
6 2625 indgang(1) := 0.0 shift 48 add aktuel_param(1)
6 2626 shift 24 add aktuel_param(2);
6 2627 indgang(2) := 0.0 shift 48 add aktuel_param(3)
6 2628 shift 24 add aktuel_param(4);
6 2629 hashnøgle := start_segm;
6 2630 \f
6 2630 message procedure param side 6 - 810226/cl;
6 2631
6 2631 <* søg navn *>
6 2632 repeat
6 2633 <* læs segment *>
6 2634 læs_fil(tabel_id,hashnøgle,zone_nr);
6 2635
6 2635 <* beregn sidste element *>
6 2636 top := fil(zone_nr,1) extract 24;
6 2637 top := (top - 1) * 4 + 2;
6 2638
6 2638 <* søg *>
6 2639 for i := 2 step 4 until top do
6 2640 if fil(zone_nr,i) = indgang(1) and
6 2641 fil(zone_nr,i+1) = indgang(2) then
6 2642 begin
7 2643 <* fundet *>
7 2644 værdi(1) := fil(zone_nr,i+2) shift (-24)
7 2645 extract 24;
7 2646 værdi(2) := fil(zone_nr,i+2) extract 24;
7 2647 værdi(3) := fil(zone_nr,i+3) shift (-24)
7 2648 extract 24;
7 2649 værdi(4) := fil(zone_nr,i+3) extract 24;
7 2650 goto fundet;
7 2651 end;
6 2652
6 2652 if top = 122 then <*overløb *>
6 2653 hashnøgle := (hashnøgle mod max_segm) + 1;
6 2654 until top < 122 or hashnøgle = start_segm;
6 2655
6 2655 <* navn findes ikke *>
6 2656 param := 2;
6 2657 for j := 1 step 1 until 4 do
6 2658 værdi(j) := aktuel_param(j);
6 2659 fundet: ;
6 2660 end <*tabel_id <> 0 *>
5 2661 else
5 2662 for i := 1 step 1 until 4 do
5 2663 værdi(i) := aktuel_param(i);
5 2664 end <* case 1 *>;
4 2665 \f
4 2665 message procedure param side 7 - 810310/cl,hko;
4 2666
4 2666 <* case 2 - ciffer *>
4 2667 cif: begin
5 2668 type:=tal := 0;
5 2669 while klasse(tegn) = 2 do
5 2670 begin
6 2671 type:=type+1;
6 2672 tal := tal * 10 + (tegn - 48);
6 2673 læs_tegn(txt,lpos,tegn);
6 2674 end;
5 2675 if minus then tal := -tal;
5 2676 værdi(1) := tal;
5 2677 sep := tegn;
5 2678 param := 0;
5 2679 end <* case 2 *>;
4 2680 \f
4 2680 message procedure param side 8 - 810428/cl;
4 2681
4 2681 <* case 3 - specialtegn *>
4 2682 spc: begin
5 2683 if tegn = '-' then
5 2684 begin
6 2685 læs_tegn(txt,lpos,tegn);
6 2686 if klasse(tegn) = 2 then
6 2687 begin
7 2688 minus := true;
7 2689 goto cif;
7 2690 end
6 2691 else
6 2692 begin
7 2693 tegn := '-';
7 2694 lpos := lpos - 1;
7 2695 end;
6 2696 end;
5 2697 <* syntaxfejl *>
5 2698 param := if separator then 1 else 3;
5 2699 sep := tegn;
5 2700 end <* case 3 *>;
4 2701
4 2701 <* case 4 - separator *>
4 2702 begin
5 2703 separator := true;
5 2704 goto spc;
5 2705 end <* case 4 *>;
4 2706
4 2706 end <* case *>;
3 2707
3 2707 lpos := lpos - 1;
3 2708 slut:
3 2709 pos := lpos;
3 2710 end;
2 2711 \f
2 2711 message procedure læs_param_sæt side 1 - 830310/cl;
2 2712
2 2712 integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
2 2713 integer array tekst, parm;
2 2714 integer pos,ant, term,res;
2 2715
2 2715 <* proceduren læser et sammenhørende sæt parametre
2 2716 afsluttet med (sp),(nl),(;),(,) eller (nul)
2 2717
2 2717 læs_param_sæt returstatus eller 'typen' af det læste parametersæt
2 2718 (retur,int)
2 2719 type ant parm indeholder:
2 2720 <0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
2 2721 0: 0 (ingenting) 'rest kommando er tom'
2 2722 1: 1 (tekst) 'indtil 11 tegn'
2 2723 2: 1 (pos.tal)
2 2724 3: 1 (neg.tal)
2 2725 4: 1 (pos.tal<1000)(bogstav) 'linienummer'
2 2726 5: 1 G(pos.tal<100) 'gruppe_ident'
2 2727 6: 2 (linie)/(løb) 'vogn_ident'
2 2728 7: 3 (bus)/(linie)/(løb)
2 2729 8: 3 (linie).(indeks):(løb)
2 2730 9: 2 (linie).(indeks)
2 2731 10: 2 (pos.tal).(pos.tal)
2 2732 11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
2 2733 12: 3 D.(dato).(tid)
2 2734
2 2734 tekst indeholder teksten hvori parametersættet
2 2735 (kald,int.arr.) skal søges.
2 2736
2 2736 pos
2 2737 (kald/retur,int.) position efter hvilken søgningen starter, og
2 2738 ved retur positionen for afsluttende tegn.
2 2739 (ikke ændret ved fejl)
2 2740
2 2740 ant hvis kaldeværdien er >0 skal parametersættet
2 2741 (kald/retur,int) indeholde det angivne antal enkeltparametre,
2 2742 i modsat fald returneres med fejltype -26
2 2743 (skilletegn) eller -25 (parameter mangler).
2 2744 ellers læses op til 3 enkeltparametre. retur-
2 2745 værdien afhænger af det læste parametersæts
2 2746 type, se ovenfor under læs_param_sæt.
2 2747 \f
2 2747 message procedure læs_param_sæt side 2 - 810428/hko;
2 2748
2 2748 parm skal omfatte elementerne 1 til 4.
2 2749 (retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
2 2750 terne værdien 0.
2 2751
2 2751 type (element,indhold)
2 2752 1: 1-4,teksten
2 2753 2-3: 1, talværdien
2 2754 4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
2 2755 5: 1, talværdi (uden G)
2 2756 6: 1, (som'4') shift 7 + løb
2 2757 7: 1, bus
2 2758 2, linie/løb som '6'
2 2759 8: 1, tal shift 5 eller som '4'
2 2760 2, tekst (1-3 bogstaver)
2 2761 3, løb
2 2762 9: 1 og 2, som '8'
2 2763 10: 1, talværdi
2 2764 2, talværdi
2 2765 11: 1, som '5'
2 2766 2, vogn (bus eller linie/løb)
2 2767 12: 1, dato
2 2768 2, tid
2 2769
2 2769 term iso-tegnværdien for tegnet der afslutter
2 2770 (retur,int) parameter_sættet.
2 2771
2 2771 res som læs_param_sæt.
2 2772 (retur,int)
2 2773
2 2773 *>
2 2774 \f
2 2774 message procedure læs_param_sæt side 3 - 810310/hko;
2 2775
2 2775 begin
3 2776 integer max_ant;
3 2777
3 2777 max_ant:= 3;
3 2778
3 2778 begin
4 2779 integer
4 2780 i,j,k, <* hjælpe variable *>
4 2781 nr, <* nummer på parameter i sættet *>
4 2782 apos, <* aktuel tegnposition *>
4 2783 cifre, <* parametertype (param: 0=tekst, >1=tal) *>
4 2784 sep; <* afsluttende skilletegn ved param *>
4 2785
4 2785 integer array field
4 2786 iaf; <* hjælpe variabel *>
4 2787
4 2787 integer array
4 2788 par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
4 2789 s, <* 1 element med separator for hver parameter *>
4 2790 t(1:max_ant), <* 1 element med typen for hver parameter *>
4 2791 værdi(1:4), <* værdi af aktuel parameter jvf. param *>
4 2792 spec(1:1); <* specialtegn i navne jvf. param *>
4 2793
4 2793 <* de interne typer af enkeltparametre er
4 2794
4 2794 type parameter
4 2795
4 2795 1: 1-3 tegn tekst (1 ord)
4 2796 2: 4-6 tegn (2 ord)
4 2797 3: 7-9 tegn (3 ord)
4 2798 4:10-11 tegn (4 ord)
4 2799 5: positivt heltal
4 2800 6: negativt heltal
4 2801 7: positivt heltal<1000 efterfulgt af stort bogstav
4 2802 8: G efterfulgt af positivt heltal<100
4 2803
4 2803 *>
4 2804 \f
4 2804 message procedure læs_param_sæt side 4 - 810408/hko;
4 2805
4 2805 nr:= 0;
4 2806 res:= -1;
4 2807 spec(1):= 0; <* ingen specialtegn *>
4 2808 apos:= pos;
4 2809 for i:= 1 step 1 until 4 do parm(i):= 0;
4 2810 for i:= 1 step 1 until max_ant do
4 2811 begin
5 2812 s(i):= t(i):= 0;
5 2813 for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
5 2814 end;
4 2815 repeat
4 2816 <* skip foranstillede sp-tegn *>
4 2817 for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
4 2818 while i=1 and sep='sp' do;
4 2819 <*+2*>
4 2820 begin
5 2821 if testbit25 and testbit26 then
5 2822 disable begin
6 2823 write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
6 2824 i,apos,cifre,sep);
6 2825 laf:=0;
6 2826 if cifre<>0 then
6 2827 write(out,<: værdi(1-4)::>,
6 2828 << -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
6 2829 else write(out,<: værdi::>,værdi.laf);
6 2830 ud;
6 2831 end;
5 2832 end;
4 2833 <*-2*>
4 2834 ;
4 2835 if i<>0 then <* ikke ok *>
4 2836 begin
5 2837 if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
5 2838 begin
6 2839 apos:= apos -1;
6 2840 res:= 0;
6 2841 end
5 2842 else if i=1 then res:=-26 <* skilletegn *>
5 2843 else <* i=5 *> res:= -25 <* parameter mangler *>
5 2844 end
4 2845 else <* i=0 *>
4 2846 begin
5 2847 if sep=',' or sep=';' then apos:=apos-1;
5 2848 iaf:= nr*8;
5 2849 nr:= nr +1;
5 2850 \f
5 2850 message procedure læs_param_sæt side 5 - 810520/hko/cl;
5 2851
5 2851 if cifre=0 <* navne_parameter *> then
5 2852 begin
6 2853 if værdi(2)=0
6 2854 and læstegn(værdi,1,i)='G'
6 2855 and læstegn(værdi,2,j)>'0' and j<='9'
6 2856 and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
6 2857 then
6 2858 begin <* gruppenavn, repræsenteres som tal *>
7 2859 t(nr):= 8;
7 2860 j:= j -'0';
7 2861 par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
7 2862 s(nr):= sep;
7 2863 end
6 2864 else
6 2865 begin <* generel tekst *>
7 2866 i:= 0;
7 2867 for i:= i +1 while i<=4 do
7 2868 begin
8 2869 if værdi(i)<>0 then
8 2870 begin
9 2871 t(nr):= i;
9 2872 par.iaf(i):= værdi(i);
9 2873 end
8 2874 else i:= 4;
8 2875 end;
7 2876 s(nr):= sep;
7 2877 end <* generel tekst *>
6 2878 end <* navne_parameter *>
5 2879 else
5 2880 begin <* talparameter *>
6 2881 i:= if værdi(1)<0 then 6 <* neg.tal *>
6 2882 else if værdi(1)>0 and værdi(1)<1000
6 2883 and sep>='A' and sep<='Å' then 7
6 2884 else 5 <* positivt tal *>;
6 2885 t(nr):= i;
6 2886 par.iaf(1):= if i<>7 then værdi(1)
6 2887 else værdi(1) shift 5 +(sep+1-'A');
6 2888 par.iaf(2):= cifre;
6 2889 apos:= apos+1;
6 2890 s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
6 2891 apos:= apos-1;
6 2892 end;
5 2893 end;<* i=0 *>
4 2894 until (ant>0 and nr=ant)
4 2895 or nr=max_ant
4 2896 or res<> -1
4 2897 or sep='sp' or sep=';' or sep='em'
4 2898 or sep=',' or sep='nl' or sep='nul';
4 2899 \f
4 2899 message procedure læs_param_sæt side 6 - 810508/hko;
4 2900
4 2900 if ant>nr then res:= -25 <*parameter mangler*>
4 2901 else
4 2902 if nr=0 or t(1)=0 then
4 2903 begin <* ingen parameter før skilletegn *>
5 2904 if res=-25 then res:= 0;
5 2905 end
4 2906 else if sep<>'sp' and sep<>'nl' and sep <> 'em'
4 2907 and sep<>';' and sep<>',' then
4 2908 begin <* ulovligt afsluttende skilletegn *>
5 2909 res:= -26;
5 2910 end
4 2911 else
4 2912 begin <* en eller flere lovligt afsluttede parametre *>
5 2913 if t(1)<5 and nr=1 then
5 2914
5 2914 <* 1 navne_parameter *>
5 2915
5 2915 begin
6 2916 res:= 1;
6 2917 tofrom(parm,par,8);
6 2918 end
5 2919 else if <*t(1)<9 and *> nr=1 then
5 2920
5 2920 <* 1 parameter af anden type *>
5 2921
5 2921 begin <*tal,linie eller gruppe *>
6 2922 res:= t(1) -3;
6 2923 parm(1):= par(1);
6 2924 end
5 2925 else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
5 2926
5 2926 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
5 2927
5 2927 begin
6 2928 i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
6 2929 j:= par(5); <* internt *>
6 2930 k:= par(9); <* *>
6 2931 if nr=2 then
6 2932 <* 2 parametre i sættet *>
6 2933 begin
7 2934 res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
7 2935 else if s(1)='.' and t(2)=1 then 9
7 2936 else if s(1)='-' and t(1)=5 and t(2)=5 then 10
7 2937 else if s(1)<>'/' and s(1)<>'.'
7 2938 and s(1)<>'-' then -26 <* skilletegn *>
7 2939 else -27;<* parametertype*>
7 2940 \f
7 2940 message procedure læs_param_sæt side 7 - 810501/hko;
7 2941
7 2941 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2942
7 2942 <* 2 parametre i sættet *>
7 2943 if res=6 then
7 2944 begin
8 2945 if (i<1 or i>999) and t(1)=5 then
8 2946 res:= -5 <* ulovligt linienr *>
8 2947 else if (j<1 or j>99) then
8 2948 res:= -6 <* ulovligt løbsnr *>
8 2949 else
8 2950 begin
9 2951 if t(1)=5 then i:= i shift 5;
9 2952 parm(1):= i shift 7 +j;
9 2953 end;
8 2954 end <* res=6 *>
7 2955 else if res=9 then
7 2956 begin
8 2957 if t(1)=5 and (i<1 or 999<i) then
8 2958 res:= -5 <*ulovligt linienr*>
8 2959 else
8 2960 begin
9 2961 if t(1)=5 then i:=i shift 5;
9 2962 parm(1):= i;
9 2963 parm(2):= j;
9 2964 end;
8 2965 end <* res=9 *>
7 2966 else if res=10 then
7 2967 begin
8 2968 begin
9 2969 parm(1):= i;
9 2970 parm(2):= j;
9 2971 end;
8 2972 end; <* res=10 *>
7 2973 end <* nr=2 *>
6 2974 else
6 2975 if nr=3 then
6 2976 <* 3 paramtre i sættet *>
6 2977 begin
7 2978 res:= if (s(1)='/' or s(1)='.') and
7 2979 (s(2)='/' or s(2)='.') then 7
7 2980 else if s(1)='.' and s(2)=':' then 8
7 2981 else -26; <* skilletegn *>
7 2982 \f
7 2982 message procedure læs_param_sæt side 8 - 810501/hko;
7 2983
7 2983 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2984 <* 3 parametre i sættet *>
7 2985 if res=7 then
7 2986 begin
8 2987 if t(1)<>5 or (t(2)<>5 and t(2)<>7)
8 2988 or t(3)<>5 then
8 2989 res:= -27 <* parametertype *>
8 2990 else
8 2991 if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
8 2992 else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
8 2993 else if k<1 or k>99 then res:= -6 <* løb *>
8 2994 else
8 2995 begin <* ok *>
9 2996 parm(1):= i;
9 2997 if t(2)=5 then j:= j shift 5;
9 2998 parm(2):= j shift 7 +k;
9 2999 end;
8 3000 end
7 3001 else if res=8 then
7 3002 begin
8 3003 if t(2)<>1 or t(3)<>5 then res:= -27
8 3004 else if t(1)=5 and (i<1 or i>999) then res:= -5
8 3005 else if k<1 or k>99 then res:= -6
8 3006 else
8 3007 begin
9 3008 if t(1)=5 then i:= i shift 5;
9 3009 parm(1):= i;
9 3010 parm(2):= j;
9 3011 parm(3):= k;
9 3012 end;
8 3013 end;
7 3014 end <* nr=3 *>
6 3015 else res:=-24; <* syntaks *>
6 3016 \f
6 3016 message procedure læs_param_sæt side 9 - 810428/hko;
6 3017
6 3017 end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
5 3018 else if t(1)=8 <* gruppe_id *> then
5 3019 begin
6 3020 <* mere end 1 parameter , hvoraf den første
6 3021 er en gruppe_identifikation ved navn.
6 3022 lovlige parametre er alle internt repræsenteret i et ord *>
6 3023
6 3023 i:=par(1);
6 3024 j:=par(5);
6 3025 k:=par(9);
6 3026
6 3026 if nr=2 then
6 3027 <* 2 parametre *>
6 3028 begin
7 3029 res:=if s(1)=':' and t(2)=5 then 11
7 3030 else if s(1)<>':' then -26 <* skilletegn *>
7 3031 else -27; <*param.type *>
7 3032 if res=11 then
7 3033 begin
8 3034 if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
8 3035 else
8 3036 begin
9 3037 parm(1):=i;
9 3038 parm(2):=j;
9 3039 end;
8 3040 end;
7 3041 \f
7 3041 message procedure læs_param_sæt side 10 - 810428/hko;
7 3042
7 3042 <* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
7 3043
7 3043 end <*nr=2*>
6 3044 else if nr=3 then
6 3045 <* 3 parametre *>
6 3046 begin
7 3047 res:=if s(1)=':' and s(2)='/' then 11
7 3048 else -26; <* skilletegn *>
7 3049 if res=11 then
7 3050 begin
8 3051 if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
8 3052 else
8 3053 begin
9 3054 if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
9 3055 else
9 3056 begin
10 3057 parm(1):=i;
10 3058 if t(2)=5 then j:=j shift 5;
10 3059 parm(2):= 1 shift 22 +j shift 7 +k;
10 3060 end;
9 3061 end;
8 3062 end;
7 3063 end <* nr=3 *>
6 3064 else res:=-24; <* syntaks *>
6 3065 \f
6 3065 message procedure læs_param_sæt side 11 - 810501/hko;
6 3066
6 3066 end <* t(1)=8 *>
5 3067 else if t(1)=1 and par(1)= 'D' shift 16 then
5 3068 begin
6 3069 <* mere end 1 parameter i sættet og 1. parameter er et 'D'.
6 3070 lovlige parametre er alle internt repræsenteret i et ord. *>
6 3071 i:=par(1);
6 3072 j:=par(5);
6 3073 k:=par(9);
6 3074
6 3074 if nr=3 then
6 3075 begin
7 3076 res:=if s(1)='.' and s(2)='.' then 12
7 3077 else -26; <* skilletegn *>
7 3078 if res=12 then
7 3079 begin
8 3080 if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
8 3081 else
8 3082 begin
9 3083 integer år,md,dg,tt,mm,ss;
9 3084 real dato,tid;
9 3085 år:=j//10000;
9 3086 md:=(j//100) mod 100;
9 3087 dg:=j mod 100;
9 3088 cifre:= par(10);
9 3089 tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
9 3090 else k;
9 3091 mm:=if cifre>4 then (k//100) mod 100
9 3092 else if cifre>2 then k mod 100 else 0;
9 3093 ss:=if cifre>4 then k mod 100 else 0;
9 3094 \f
9 3094 message procedure læs_param_sæt side 12 - 810501/hko;
9 3095
9 3095 dato:=systime(5,0.0,tid);
9 3096 if j=0 then dg:=round dato mod 100;
9 3097 if år=0 and md=0 then md:=(round dato//100) mod 100;
9 3098 if år=0 then år:=round dato//10000;
9 3099 if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
9 3100 res:=-24 <* syntaks *>
9 3101 else if dg<1 or dg > (case md of (
9 3102 31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
9 3103 31,31,30, 31,30,31)) then res:=-24
9 3104 else
9 3105 begin
10 3106 parm(1):=år*10000+md*100+dg;
10 3107 parm(2):=tt*10000+mm*100+ss;
10 3108 end;
9 3109 end;
8 3110
8 3110 end; <* res=12 *>
7 3111 end <* nr=3 *>
6 3112 else res:=-24; <*syntaks*>
6 3113 end <* t(1)=1 and par(1)='D' shift 16 *>
5 3114
5 3114 else res:=-27;<*parametertype*>
5 3115 end; <* en eller flere parametre *>
4 3116
4 3116 læs_param_sæt:= res;
4 3117 term:= sep;
4 3118 if res>= 0 then pos:= apos;
4 3119 end;
3 3120 end læs_param_sæt;
2 3121 \f
2 3121 message procedure læs_kommando side 1 - 810428/hko;
2 3122
2 3122 integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
2 3123 value kilde;
2 3124 zone z;
2 3125 integer kilde, pos,indeks,sep,slut_tegn;
2 3126 integer array field op_ref;
2 3127
2 3127 <* proceduren indlæser er kommmando fra en terminal (telex,
2 3128 skærm eller skrivemaskine). ved indlæsning fra skærm eller
2 3129 skrivemaskine inviteres først ved udskrivning af '>'-tegn.
2 3130 for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
2 3131 23'ende linie inden invitation.
2 3132 *>
2 3133 \f
2 3133 message procedure læs_kommando side 2 - 810428/hko;
2 3134
2 3134 begin
3 3135 integer
3 3136 a_pos,
3 3137 a_res,res,
3 3138 i,j,k;
3 3139 boolean
3 3140 skip;
3 3141
3 3141 <*V*>setposition(z,0,0);
3 3142
3 3142 case kilde//100 of
3 3143 begin
4 3144 begin <* io *>
5 3145 write(z,"nl",1,">",1);
5 3146 end;
4 3147
4 3147 begin <* operatør *>
5 3148 cursor(z,24,1);
5 3149 write(z,"esc" add 128,1,<:ÆK:>);
5 3150 cursor(z,23,1);
5 3151 write(z,"esc" add 128,1,<:ÆK:>);
5 3152 outchar(z,'>');
5 3153 end;
4 3154
4 3154 begin <* garageterminal *> ;
5 3155 outchar(z,'nl');
5 3156 end
4 3157 end;
3 3158
3 3158 <*V*>setposition(z,0,0);
3 3159 \f
3 3159 message procedure læs_kommando side 3 - 810921/hko,cl;
3 3160
3 3160 res:=0;
3 3161 skip:= false;
3 3162 <*V*>
3 3163 k:=læs_store(z,i);
3 3164
3 3164 apos:= 1;
3 3165 while k<=6 <*klasse=bogstav*> do
3 3166 begin
4 3167 if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
4 3168 <*V*> k:= læs_store(z,i);
4 3169 end;
3 3170
3 3170 skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
3 3171
3 3171 if i=',' and a_pos>1 then
3 3172 begin
4 3173 skrivtegn(d.op_ref.data,a_pos,i);
4 3174 repeat
4 3175 <*V*> k:= læs_store(z,i);
4 3176 if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
4 3177 until k>=7;
4 3178 end;
3 3179
3 3179 pos:=a_pos;
3 3180 while k<8 do
3 3181 begin
4 3182 if a_pos< (att_op_længde//2*3-2) then
4 3183 skriv_tegn(d.op_ref.data,a_pos,i);
4 3184 skip:= skip or i='?';
4 3185 <*V*> k:= læs_store(z,i);
4 3186 pos:=pos+1;
4 3187 end;
3 3188
3 3188 skip:= skip or i='?' or i='esc';
3 3189 slut_tegn:= i;
3 3190 skrivtegn(d.op_ref.data,apos,'em');
3 3191 afslut_text(d.op_ref.data,apos);
3 3192 \f
3 3192 message procedure læs_kommando side 4 - 820301/hko/cl;
3 3193
3 3193 disable
3 3194 begin
4 3195 integer
4 3196 i1,
4 3197 nr,
4 3198 partype,
4 3199 cifre;
4 3200 integer array
4 3201 spec(1:1),
4 3202 værdi(1:4);
4 3203
4 3203 <*+2*>
4 3204 if testbit25 and overvåget then
4 3205 disable begin
5 3206 real array field raf;
5 3207 write(out,"nl",1,<:kommando læst::>);
5 3208 laf:=data;
5 3209 write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
5 3210 <: skip=:>,if skip then <:true:> else <:false:>);
5 3211 ud;
5 3212 end;
4 3213 <*-2*>
4 3214
4 3214 for i:=1 step 1 until 32 do ia(i):=0;
4 3215
4 3215 if skip then
4 3216 begin
5 3217 res:=53; <*annulleret*>
5 3218 pos:= -1;
5 3219 goto slut_læskommando;
5 3220 end;
4 3221 \f
4 3221 message procedure læs_kommando side 5 - 850820/cl;
4 3222
4 3222 i:= kilde//100; <* hovedmodul *>
4 3223 k:= kilde mod 100; <* løbenr *>
4 3224 <* if pos>79 then linieoverløb; *>
4 3225 pos:=a_pos:=0;
4 3226 spec(1):= ',' shift 16;
4 3227
4 3227 <*+4*>
4 3228 if k<1 or k>(case i of (1,max_antal_operatører,
4 3229 max_antal_garageterminaler)) then
4 3230 begin
5 3231 fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
5 3232 res:=31;
5 3233 end
4 3234 else
4 3235 <*-4*>
4 3236 if i>0 and i<4 then <* io, operatør eller garageterminal *>
4 3237 begin
5 3238 <* læs operationskode *>
5 3239 j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
5 3240
5 3240 res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
5 3241 else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
5 3242 else if j=2 then 4 <*ukendt kommando*>
5 3243 else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
5 3244 else if sep<>'sp' and sep<>','
5 3245 and sep<>'nl' and sep<>';'
5 3246 and sep<>'nul' and sep<>'em' then 26
5 3247 <*skilletegn*>
5 3248 else if -, læsbit_i(værdi(4),i-1) then 4
5 3249 <* logand(extend 0 add værdi(4)
5 3250 extend 1 shift (case i of (0,k,8+k)))=0 then 4
5 3251 *> <*ukendt kommando*>
5 3252 else 1;
5 3253 \f
5 3253 message procedure læs_kommando side 5a- 810409/hko;
5 3254
5 3254 <*+2*>if testbit25 and overvåget then
5 3255 begin
6 3256 write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
6 3257 << -dddd>,j,apos,cifre,sep,res,
6 3258 <: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
6 3259 "nl",0);
6 3260 if j<>0 then skriv_op(out,op_ref);
6 3261 ud;
6 3262 end;
5 3263 <*-2*>
5 3264
5 3264 if res=31 then fejlreaktion(18<*tabelfil*>,j,
5 3265 <:=res, filnr 1025, læskommando:>,0);
5 3266
5 3266 if res=1 then <* operationskode ok *>
5 3267 begin
6 3268 if sep<>'sp' then apos:=apos-1;
6 3269 d.op_ref.opkode:=værdi(1);
6 3270 indeks:=værdi(2);
6 3271 partype:= værdi(3);
6 3272 nr:= 0;
6 3273 pos:= apos;
6 3274 \f
6 3274 message procedure læs_kommando side 6 - 810409/hko;
6 3275
6 3275 while res=1 do
6 3276 begin
7 3277 læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
7 3278 værdi,sep,a_res);
7 3279 nr:= nr +1;
7 3280 i1:= værdi(1);
7 3281 <*+2*> if testbit25 and overvåget then
7 3282 begin
8 3283 write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
8 3284 apos,sep,ares,<: værdi(1-4)::>,
8 3285 værdi(1),værdi(2),værdi(3),værdi(4),
8 3286 "nl",0);
8 3287 ud;
8 3288 end;
7 3289 <*-2*>
7 3290 case par_type of
7 3291 begin
8 3292
8 3292 <*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
8 3293
8 3293 begin
9 3294 if nr=1 then
9 3295 begin
10 3296 if a_res=0 then res:=2 <*godkendt*>
10 3297 else if a_res=2 and (i1<1 or i1>9999)
10 3298 then res:=7 <*busnr ulovligt*>
10 3299 else if a_res=2 or a_res=6 then
10 3300 begin
11 3301 ia(1):= if a_res=2 then i1
11 3302 else 1 shift 22 +i1;
11 3303 end
10 3304 else res:= 27; <*parametertype*>
10 3305 if res<4 then pos:= apos;
10 3306 end <*nr=1*>
9 3307 else
9 3308 if nr=2 then
9 3309 begin
10 3310 if ares=0 then res:= 2 <*godkendt*>
10 3311 else if ares=1 then
10 3312 begin
11 3313 ia(2):= find_område(i1);
11 3314 if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
11 3315 end
10 3316 else res:= 27; <* syntaks, parametertype *>
10 3317 end
9 3318 else
9 3319 if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
9 3320 end;
8 3321 \f
8 3321 message procedure læs_kommando side 7 - 810226/hko;
8 3322
8 3322 <*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
8 3323
8 3323 begin
9 3324 if nr=1 then
9 3325 begin
10 3326 if a_res=0 then res:=25 <*parameter mangler*>
10 3327 else if a_res=2 and (i1<1 or i1>9999)
10 3328 then res:=7 <*busnr ulovligt*>
10 3329 else if a_res=2 or a_res=6 then
10 3330 begin
11 3331 ia(1):=if a_res=2 then i1
11 3332 else 1 shift 22 +i1;
11 3333 end
10 3334 else res:= 27; <*parametertype*>
10 3335 if res<4 then pos:=a_pos;
10 3336 end
9 3337 else
9 3338 if nr=2 then
9 3339 begin
10 3340 if ares=0 then res:= 2 <*godkendt*> else
10 3341 if ares=1 and ia(1) shift (-21) = 0 then
10 3342 begin
11 3343 ia(2):= findområde(i1);
11 3344 if ia(2)=0 then res:= 56; <*område ukendt*>
11 3345 end
10 3346 else res:= 27;
10 3347 if res<4 then pos:= apos;
10 3348 end
9 3349 else
9 3350 if ares=0 then res:= 2 else res:= 24<*syntaks*>;
9 3351 end;
8 3352 \f
8 3352 message procedure læs_kommando side 8 - 810223/hko;
8 3353
8 3353 <*3: (<linie>!G<nr>) *>
8 3354
8 3354 begin
9 3355 if nr=1 then
9 3356 begin
10 3357 if a_res=0 then res:=25 <*parameter mangler*>
10 3358 else if a_res=2 and (i1<1 or i1>999) then res:=5
10 3359 <*linienr ulovligt*>
10 3360 else if a_res=2 or a_res=4 or a_res=5 then
10 3361 begin
11 3362 ia(1):=
11 3363 if a_res=2 then 4 shift 21 +i1 shift 5
11 3364 else if a_res=4 then 4 shift 21 +i1
11 3365 else <* a_res=5 *> 5 shift 21 +i1;
11 3366 end
10 3367 else res:=27; <* parametertype *>
10 3368 if res<4 then pos:= a_pos;
10 3369 end
9 3370 else
9 3371 res:= if nr=2 and a_res<>0 then 24<*syntaks*>
9 3372 else 2;<*godkendt*>
9 3373 end;
8 3374
8 3374 <*4: <ingenting> *>
8 3375
8 3375 begin
9 3376 res:= if a_res<>0 then 24<*syntaks*>
9 3377 else 2;<*godkendt*>
9 3378 end;
8 3379 \f
8 3379 message procedure læs_kommando side 9 - 810226/hko;
8 3380
8 3380 <*5: (<kanalnr>) *>
8 3381
8 3381 begin
9 3382 long field lf;
9 3383
9 3383 if nr=1 then
9 3384 begin
10 3385 if a_res=0 then res:= 25
10 3386 else if a_res<>1 then res:=27<*parametertype*>
10 3387 else
10 3388 begin
11 3389 j:= 0; lf:= 4;
11 3390 for i:= 1 step 1 until max_antal_kanaler do
11 3391 if kanal_navn(i)=værdi.lf then j:= i;
11 3392 if j<>0 then
11 3393 begin
12 3394 ia(1):= 3 shift 22 + j;
12 3395 res:= 2;
12 3396 end
11 3397 else
11 3398 res:= 17; <* kanal ukendt *>
11 3399 end;
10 3400 if res<4 then pos:= a_pos;
10 3401 end
9 3402 else
9 3403 res:=if nr=2 and a_res<>0 then 24<*syntaks*>
9 3404 else 2;<*godkendt*>
9 3405 end;
8 3406 \f
8 3406 message procedure læs_kommando side 10 - 810415/hko;
8 3407
8 3407 <*6: <busnr>/<linie>/<løb> (<område>) *>
8 3408
8 3408 begin
9 3409 if nr=1 then
9 3410 begin
10 3411 if a_res=0 then res:=25<*parameter mangler*>
10 3412 else if a_res=7 then
10 3413 begin
11 3414 ia(1):= i1;
11 3415 ia(2):= 1 shift 22 + værdi(2);
11 3416 end
10 3417 else res:=27;<*parametertype*>
10 3418 if res<4 then pos:= apos;
10 3419 end
9 3420 else
9 3421 if nr=2 then
9 3422 begin
10 3423 if ares=0 then res:= 2 <*godkendt*> else
10 3424 if ares=1 then
10 3425 begin
11 3426 ia(3):= findområde(i1);
11 3427 if ia(3)=0 then res:= 56; <* område ukendt *>
11 3428 end
10 3429 else res:= 27; <*parametertype*>
10 3430 if res<4 then pos:= apos;
10 3431 end
9 3432 else
9 3433 if ares=0 then res:= 2 else res:= 24;
9 3434 end;
8 3435 \f
8 3435 message procedure læs_kommando side 11 - 810512/hko/cl;
8 3436
8 3436
8 3436 <* att_op_længde//2-2 *>
8 3437 <*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
8 3438 <* 1 *>
8 3439
8 3439 begin
9 3440 if nr=1 then
9 3441 begin
10 3442 if a_res=0 then res:=25 <*parameter mangler*>
10 3443 else if a_res=8 then
10 3444 begin
11 3445 ia(1):= 4 shift 21 + i1;
11 3446 ia(2):= værdi(2);
11 3447 ia(3):= værdi(3);
11 3448 indeks:= 3;
11 3449 end
10 3450 else res:=27;<*parametertype*>
10 3451 end
9 3452 else if nr<=att_op_længde//2-2 then
9 3453 begin
10 3454 if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
10 3455 else if a_res=0 then res:=25 <* parameter mangler *>
10 3456 else if a_res=10 then
10 3457 begin
11 3458 if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
11 3459 begin
12 3460 ia(nr+2):= i1 shift 12 + værdi(2);
12 3461 indeks:= nr +2;
12 3462 end
11 3463 else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
11 3464 else res:=6; <*løb-nr ulovligt*>
11 3465 end
10 3466 else res:=27;<*parametertype*>
10 3467 end
9 3468 else
9 3469 res:= if a_res=0 then 2 else 24;<* syntaks *>
9 3470 if res<4 then pos:=a_pos;
9 3471 end;
8 3472 \f
8 3472 message procedure læs_kommando side 12 - 810306/hko;
8 3473
8 3473 <*8: (<operatør>!<radiokanal>!<garageterminal>) *>
8 3474
8 3474 begin
9 3475 if nr=1 then
9 3476 begin
10 3477 if a_res=0 then res:=25 <* parameter mangler *>
10 3478 else if a_res=2 then
10 3479 begin
11 3480 j:=d.op_ref.opkode;
11 3481 ia(1):=i1;
11 3482 k:=(j+1)//2;
11 3483 if k<1 or k=3 or k>4 then
11 3484 fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
11 3485 else
11 3486 begin
12 3487 if k=4 then k:=3;
12 3488 if i1<1 or i1> (case k of
12 3489 (max_antal_operatører,max_antal_radiokanaler,
12 3490 max_antal_garageterminaler))
12 3491 then res:=case k of (28,29,17);
12 3492 end;
11 3493 end
10 3494 else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
10 3495 begin
11 3496 laf:= 0;
11 3497 ia(1):= find_bpl(værdi.laf(1));
11 3498 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3499 end
10 3500 else res:=27; <*parametertype*>
10 3501 end
9 3502 else
9 3503 if nr=2 and d.opref.opkode=1 then
9 3504 begin
10 3505 <* åbningstilstand for operatørplads *>
10 3506 if a_res=0 then res:= 2 <*godkendt*>
10 3507 else if a_res<>1 then res:= 27 <*parametertype*>
10 3508 else begin
11 3509 res:= 2<*godkendt*>;
11 3510 j:= værdi(1) shift (-16);
11 3511 if j='S' then ia(2):= 3 else
11 3512 if j<>'Å' then res:= 24; <*syntaks*>
11 3513 end;
10 3514 end
9 3515 else
9 3516 begin
10 3517 res:=if a_res=0 then 2 <* godkendt *>
10 3518 else 24;<* syntaks *>
10 3519 end;
9 3520 if res<4 then pos:=a_pos;
9 3521 end; <* partype 8 *>
8 3522 \f
8 3522 message procedure læs_kommando side 13 - 810306/hko;
8 3523
8 3523
8 3523 <* att_op_længde//2 *>
8 3524 <*9: <operatør>((+!-)<linienr>) *>
8 3525 <* 1 *>
8 3526
8 3526 begin
9 3527 if nr=1 then
9 3528 begin
10 3529 if a_res=0 then res:=25 <* parameter mangler *>
10 3530 else if a_res=2 then
10 3531 begin
11 3532 ia(1):=i1;
11 3533 if i1<1 or i1>max_antal_operatører then res:=28;
11 3534 end
10 3535 else if a_res=1 then
10 3536 begin
11 3537 laf:= 0;
11 3538 ia(1):= find_bpl(værdi.laf(1));
11 3539 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3540 end
10 3541 else res:=27; <* parametertype *>
10 3542 end
9 3543 else if nr<=att_op_længde//2 then
9 3544 begin <* nr>1 *>
10 3545 if a_res=0 then res:=(if nr>2 then 2 else 25)
10 3546 else if a_res=2 or a_res=3 then
10 3547 begin
11 3548 ia(nr):=i1; indeks:= nr;
11 3549 if i1=0 or abs(i1)>999 then res:=5;
11 3550 end
10 3551 else res:=27; <* parametertype *>
10 3552 if res<4 then pos:=a_pos;
10 3553 end
9 3554 else
9 3555 res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
9 3556 else 2;
9 3557 end; <* partype 9 *>
8 3558 \f
8 3558 message procedure læs_kommando side 14 - 810428/hko;
8 3559
8 3559 <* 2 *>
8 3560 <*10: (bus) *>
8 3561 <* 1 *>
8 3562
8 3562 begin
9 3563 if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
9 3564 else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
9 3565 else if a_res=0 then res:=2 <* godkendt *>
9 3566 else if a_res<>2 then res:=27 <* parametertype *>
9 3567 else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
9 3568 else
9 3569 ia(nr):=i1;
9 3570 end;
8 3571
8 3571 <* 5 *>
8 3572 <*11: (<linie>) *>
8 3573 <* 1 *>
8 3574
8 3574 begin
9 3575 if a_res=0 and nr=1 then res:=25
9 3576 else if a_res<>0 and nr>5 then res:=24
9 3577 else if a_res=0 then res:=2
9 3578 else if a_res<>2 and a_res<>4 then res:=27
9 3579 else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
9 3580 else
9 3581 ia(nr):=
9 3582 (if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
9 3583 end;
8 3584 \f
8 3584 message procedure læs_kommando side 15 - 810306/hko;
8 3585
8 3585 <*12: (<ingenting>!<navn>) *>
8 3586
8 3586 begin
9 3587 if nr=1 then
9 3588 begin
10 3589 if a_res=0 then res:=2 <*godkendt*>
10 3590 else if a_res=1 then
10 3591 tofrom(ia,værdi,8)
10 3592 else res:=27; <* parametertype *>
10 3593 end
9 3594 else
9 3595 res:=if a_res<>0 then 24 <* syntaks (for mange) *>
9 3596 else 2;
9 3597 end; <* partype 12 *>
8 3598 \f
8 3598 message procedure læs_kommando side 16 - 810512/hko/cl;
8 3599
8 3599 <* 15 *>
8 3600 <*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
8 3601 <* 1 *>
8 3602
8 3602 begin
9 3603 if nr=1 then
9 3604 begin
10 3605 if a_res=0 then res:=25 <* parameter mangler *>
10 3606 else
10 3607 if a_res=11 then
10 3608 begin
11 3609 ia(1):= 5 shift 21 + i1;
11 3610 ia(2):=værdi(2);
11 3611 indeks:= 2;
11 3612 end
10 3613 else res:=27; <* parametertype *>
10 3614 end
9 3615 else if nr<= att_op_længde//2-1 then
9 3616 begin
10 3617 if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
10 3618 else if a_res=0 then res:=25 <* parameter mangler *>
10 3619 else if ares=2 and (i1<1 or i1>9999) then
10 3620 res:= 7 <*busnr ulovligt*>
10 3621 else if a_res=2 or a_res=6 then
10 3622 begin
11 3623 ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
11 3624 indeks:= nr+1;
11 3625 end
10 3626 else res:=27; <* parametertype *>
10 3627 end
9 3628 else
9 3629 res:=if a_res=0 then 2 <*godkendt *>
9 3630 else 24;<* syntaks *>
9 3631 if res<4 then pos:=a_pos;
9 3632 end; <* partype 13 *>
8 3633 \f
8 3633 message procedure læs_kommando side 17 - 810311/hko;
8 3634
8 3634 <*14: <linie>.<indeks> *>
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 <* nr>1 *>
9 3647 res:= if a_res=0 then 2 <* godkendt *>
9 3648 else 24;<* syntaks *>
9 3649 end; <* partype 14 *>
8 3650 \f
8 3650 message procedure læs_kommando side 18 - 810313/hko;
8 3651
8 3651 <*15: <linie>.<indeks> <bus> *>
8 3652
8 3652 begin
9 3653 if nr=1 then
9 3654 begin
10 3655 if a_res=0 then res:= 25 <* parameter mangler *>
10 3656 else if a_res=9 then
10 3657 begin
11 3658 ia(1):= 1 shift 23 +i1;
11 3659 ia(2):= værdi(2);
11 3660 end
10 3661 else res:=27; <* parametertype *>
10 3662 end
9 3663 else if nr=2 then
9 3664 begin
10 3665 if a_res=0 then res:=25
10 3666 else if a_res=2 then
10 3667 begin
11 3668 if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
11 3669 else ia(3):= i1;
11 3670 end
10 3671 else res:=27; <*parametertype *>
10 3672 end
9 3673 else
9 3674 res:=if a_res=0 then 2 <* godkendt *>
9 3675 else 24;<* syntaks *>
9 3676 if res<4 then pos:=a_pos;
9 3677 end; <* partype 15 *>
8 3678 \f
8 3678 message procedure læs_kommando side 19 - 810311/hko;
8 3679
8 3679 <*16: (<ingenting>!D.<dato>.<klokkeslet> *>
8 3680
8 3680 begin
9 3681 if nr=1 then
9 3682 begin
10 3683 if a_res=0 then res:=2 <* godkendt *>
10 3684 else if a_res=12 then
10 3685 begin
11 3686 raf:=0;
11 3687 ia.raf(1):= systid(i1,værdi(2));
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 if res<4 then pos:=a_pos;
9 3695 end; <* partype 16 *>
8 3696 \f
8 3696 message procedure læs_kommando side 20 - 810511/hko;
8 3697
8 3697 <*17: G<grp.nr> *>
8 3698
8 3698 begin
9 3699 if nr=1 then
9 3700 begin
10 3701 if a_res=0 then res:=25 <*parameter mangler *>
10 3702 else if a_res=5 then
10 3703 begin
11 3704 ia(1):= 5 shift 21 +i1;
11 3705 end
10 3706 else res:=27; <* parametertype *>
10 3707 end
9 3708 else
9 3709 res:= if a_res=0 then 2 <* godkendt *>
9 3710 else 24;<* syntaks *>
9 3711 end; <* partype 17 *>
8 3712
8 3712 <* att_op_længde//2 *>
8 3713 <*18: (<heltal>) *>
8 3714 <* 1 *>
8 3715
8 3715 begin
9 3716 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3717 else
9 3718 if nr<=att_op_længde//2 then
9 3719 begin
10 3720 if a_res=2 or a_res=3 <* pos/neg heltal *> then
10 3721 begin
11 3722 ia(nr):= i1; indeks:= nr;
11 3723 end
10 3724 else if a_res=0 then res:= 2
10 3725 else res:= 27; <*parametertype*>
10 3726 end
9 3727 else
9 3728 res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
9 3729 end;
8 3730 \f
8 3730 message procedure læs_kommando side 21 - 820302/cl;
8 3731
8 3731 <*19: <linie>/<løb> <linie>/<løb> *>
8 3732
8 3732 begin
9 3733 if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3734 else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
9 3735 else if nr<3 then
9 3736 begin
10 3737 ia(nr):=i1 + 1 shift 22;
10 3738 end
9 3739 else
9 3740 res:= if a_res=0 then 2 <*godkendt*>
9 3741 else 24;<*syntaks (for mange)*>
9 3742 if res<4 then pos:= a_pos;
9 3743 end; <* partype 19 *>
8 3744
8 3744 <*20: <busnr> <kortnavn> *>
8 3745 begin
9 3746 if nr=1 then
9 3747 begin
10 3748 if ares=0 then res:= 25 else
10 3749 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3750 if ares<>2 then res:= 27 else ia(1):= i1;
10 3751 end
9 3752 else
9 3753 if nr=2 then
9 3754 begin
10 3755 if ares=1 and værdi(2) extract 8 = 0 then
10 3756 begin
11 3757 ia(2):= værdi(1); ia(3):= værdi(2);
11 3758 end
10 3759 else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
10 3760 end
9 3761 else
9 3762 if ares=0 then res:= 2 else res:= 24;
9 3763 end; <* partype 20 *>
8 3764 \f
8 3764 message procedure læs_kommando side 22 - 851001/cl;
8 3765
8 3765 <* 2 *>
8 3766 <*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
8 3767 <* 0 *>
8 3768
8 3768 begin
9 3769 laf:= 0;
9 3770 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3771 else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
9 3772 else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
9 3773 else if a_res=0 then res:= 2 <*godkendt*>
9 3774 else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
9 3775 else if (a_res=2 or a_res=4) and nr<=2 then
9 3776 begin
10 3777 if ia(3)<>0 then res:= 27 else
10 3778 ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
10 3779 end
9 3780 else
9 3781 if ares=1 then
9 3782 begin
10 3783 if nr=1 then
10 3784 begin
11 3785 ia(1):= (4 shift 21) + (1 shift 5);
11 3786 ia(2):= (4 shift 21) + (999 shift 5);
11 3787 end;
10 3788 if ia(3)=-2 then
10 3789 begin
11 3790 if i1=long<:ALL:> shift (-24) extract 24 then
11 3791 ia(3):= -1
11 3792 else
11 3793 begin
12 3794 ia(3):= findområde(i1);
12 3795 if ia(3)=0 then res:= 56 else
12 3796 ia(3):= 14 shift 20 + ia(3);
12 3797 end;
11 3798 end
10 3799 else
10 3800 if ia(3) = 0 then
10 3801 begin
11 3802 if i1 = long<:OMR:> shift (-24) extract (24) then
11 3803 ia(3):= -2
11 3804 else
11 3805 ia(3):= find_bpl(værdi.laf(1));
11 3806 if ia(3)=0 then res:= 55;
11 3807 end
10 3808 else res:= 24;
10 3809 end
9 3810 else res:= 27; <*parametertype*>
9 3811 if res<4 then pos:= apos;
9 3812 end;
8 3813
8 3813 <*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
8 3814
8 3814 begin
9 3815 if nr=1 then
9 3816 begin
10 3817 if ares=0 then res:= 25 <*parameter mangler*>
10 3818 else if ares=2 and (i1<1 or i1>9999)
10 3819 then res:= 7 <* busnr ulovligt *>
10 3820 else if ares=2 or ares=6 then
10 3821 begin
11 3822 ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
11 3823 end
10 3824 else res:= 27 <* parametertype *>
10 3825 end
9 3826 else
9 3827 if nr=2 then
9 3828 begin
10 3829 if ares=0 then res:= 2 <* godkendt *>
10 3830 else if ares=1 then
10 3831 begin
11 3832 ia(2):= findområde(i1);
11 3833 if ia(2)=0 then res:= 17 <*kanal ukendt*>
11 3834 end
10 3835 else
10 3836 res:= 27; <* parametertype *>
10 3837 end
9 3838 else if ares=0 then res:= 2 <*godkendt*>
9 3839 else res:= 24; <*syntaks*>
9 3840 if res < 4 then pos:= apos;
9 3841 end;
8 3842
8 3842 <*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
8 3843
8 3843 begin
9 3844 if nr=1 then
9 3845 begin
10 3846 if ares=0 then res:= 25 else
10 3847 if ares=2 and (i1<1 or i1>999) then res:= 5 else
10 3848 if ares=2 or ares=4 or ares=5 then
10 3849 begin
11 3850 ia(1):=
11 3851 if ares=2 then 4 shift 21 + i1 shift 5 else
11 3852 if ares=4 then 4 shift 21 + i1 else
11 3853 5 shift 21 + i1;
11 3854 end
10 3855 else res:= 27;
10 3856 if res < 4 then pos:= apos;
10 3857 end
9 3858 else
9 3859 if nr=2 then
9 3860 begin
10 3861 if ares=0 then res:= 2 else
10 3862 if ares=1 then
10 3863 begin
11 3864 ia(2):= findområde(i1);
11 3865 if ia(2)=0 then res:= 17;
11 3866 end
10 3867 else res:= 27;
10 3868 end
9 3869 else
9 3870 if ares=0 then res:= 2 else res:= 24;
9 3871 end;
8 3872
8 3872 <*24: ( <ingenting> ! <område> ! * ) *>
8 3873
8 3873 begin
9 3874 if nr=1 then
9 3875 begin
10 3876 if ares=0 then res:= 2 else
10 3877 if ares=1 then
10 3878 begin
11 3879 if i1=long<:ALL:> shift (-24) extract 24 then
11 3880 ia(1):= (-1) shift (-3) shift 3
11 3881 else
11 3882 begin
12 3883 k:= findområde(i1);
12 3884 if k=0 then res:= 17 else
12 3885 ia(1):= 14 shift 20 + k;
12 3886 end;
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 <*25: <område> *>
8 3895
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=1 then
10 3900 begin
11 3901 if i1 = '*' shift 16 then ia(1):= -1 else
11 3902 ia(1):= findområde(i1);
11 3903 if ia(1)=0 then res:= 17;
11 3904 end
10 3905 else res:= 27;
10 3906 end
9 3907 else
9 3908 if ares=0 then res:= 2 else res:= 24;
9 3909 if res < 4 then pos:= apos;
9 3910 end;
8 3911
8 3911 <*26: <busnr> *>
8 3912 begin
9 3913 if nr=1 then
9 3914 begin
10 3915 if ares=0 then res:= 25 else
10 3916 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3917 if ares<>2 then res:= 27 else ia(1):= i1;
10 3918 end
9 3919 else
9 3920 if ares=0 then res:= 2 else res:= 24;
9 3921 end;
8 3922
8 3922 <* 8 *>
8 3923 <*27: <operatørnr> (<område>) *>
8 3924 <* 1 *>
8 3925 begin
9 3926 if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3927 else if nr=1 then
9 3928 begin
10 3929 if a_res=2 then
10 3930 begin
11 3931 ia(1):= i1;
11 3932 if i1 < 0 or max_antal_operatører < i1 then res:= 28;
11 3933 end
10 3934 else if a_res=1 then
10 3935 begin
11 3936 laf:= 0;
11 3937 ia(1):= find_bpl(værdi.laf(1));
11 3938 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3939 end
10 3940 else res:= 27; <*parametertype*>
10 3941 end
9 3942 else
9 3943 begin
10 3944 if a_res=0 then res:= (if nr > 2 then 2 else 25)
10 3945 else if nr > 9 then res:= 24
10 3946 else if a_res=1 then
10 3947 begin
11 3948 ia(nr):= find_område(i1);
11 3949 indeks:= nr;
11 3950 if ia(nr)=0 then res:= 56;
11 3951 end
10 3952 else res:= 27;
10 3953 end;
9 3954 if res < 4 then pos:= a_pos;
9 3955 end <* partype 27 *>;
8 3956
8 3956 <*28: (<ingenting>!<kanalnr>) *>
8 3957 begin
9 3958 long field lf;
9 3959
9 3959 if nr=1 then
9 3960 begin
10 3961 if ares=0 then res:= 2 else
10 3962 if ares=1 then
10 3963 begin
11 3964 j:= 0; lf:= 4;
11 3965 for i:= 1 step 1 until max_antal_kanaler do
11 3966 if kanal_navn(i)=værdi.lf then j:= i;
11 3967 if j<>0 then
11 3968 begin
12 3969 ia(1):= 3 shift 22 + j;
12 3970 res:= 2;
12 3971 end
11 3972 else
11 3973 res:= 17; <*kanal ukendt*>
11 3974 end
10 3975 else
10 3976 res:= 27; <*parametertype*>
10 3977 if res < 4 then pos:= apos;
10 3978 end
9 3979 else
9 3980 res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
9 3981 end;
8 3982
8 3982 <* n *>
8 3983 <*29: <btj.pl.navn> ( <operatørnavn>) *>
8 3984 <* 0 *>
8 3985 begin
9 3986 laf:= 0;
9 3987 if nr=1 then
9 3988 begin
10 3989 if a_res=0 then res:= 25 <*parameter mangler*>
10 3990 else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
10 3991 else begin
11 3992 indeks:= 2;
11 3993 ia(1):= værdi(1); ia(2):= værdi(2);
11 3994 j:= find_bpl(værdi.laf(1));
11 3995 if 0<j and j<=max_antal_operatører then
11 3996 res:= 62; <*ulovligt navn*>
11 3997 end;
10 3998 end
9 3999 else
9 4000 begin
10 4001 if a_res=0 then res:= 2 <*godkendt*>
10 4002 else if a_res<>1 then res:= 27 <*parametertype*>
10 4003 else begin
11 4004 indeks:= indeks+1;
11 4005 ia(indeks):= find_bpl(værdi.laf(1));
11 4006 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 4007 res:= 28; <*ukendt operatør*>
11 4008 end;
10 4009 end;
9 4010 if res<4 then pos:= a_pos;
9 4011 end;
8 4012
8 4012 <* 3 *>
8 4013 <*30: (<operatørnavn>) ( <btj.pl.navn>) *>
8 4014 <* io 0 *>
8 4015
8 4015 begin
9 4016 boolean io;
9 4017
9 4017 io:= (kilde//100 = 1);
9 4018 laf:= 0;
9 4019 if -,io and nr=1 then
9 4020 begin
10 4021 indeks:= 1;
10 4022 ia(1):= kilde mod 100; <*egen operatørplads*>
10 4023 end;
9 4024
9 4024 if io and nr=1 then
9 4025 begin
10 4026 if a_res=0 then res:= 25 <*parameter mangler*>
10 4027 else if a_res<>1 then res:= 27 <*parametertype*>
10 4028 else begin
11 4029 indeks:= nr;
11 4030 ia(indeks):= find_bpl(værdi.laf(1));
11 4031 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 4032 res:= 28; <*ukendt operatør*>
11 4033 end;
10 4034 end
9 4035 else
9 4036 begin
10 4037 if a_res=0 then res:= 2<*godkendt*>
10 4038 else if indeks=4 then res:= 24 <*syntaks, for mange*>
10 4039 else if a_res<>1 then res:= 27 <*parametertype*>
10 4040 else begin
11 4041 indeks:= indeks+1;
11 4042 ia(indeks):= find_bpl(værdi.laf(1));
11 4043 if ia(indeks)=0 then res:= 46 <*navn ukendt*>
11 4044 else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
11 4045 end;
10 4046 end;
9 4047 if res<4 then pos:= a_pos;
9 4048 end;
8 4049
8 4049 <* *>
8 4050 <*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
8 4051 <* *>
8 4052
8 4052 begin
9 4053 laf:= 0;
9 4054 if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
9 4055 else
9 4056 if nr=1 then
9 4057 begin
10 4058 if a_res=2 then
10 4059 begin
11 4060 ia(1):= i1;
11 4061 if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
11 4062 end else res:= 27; <*parametertype*>
10 4063 end
9 4064 else
9 4065 if nr=2 then
9 4066 begin
10 4067 if a_res=1 and værdi(2) extract 8 = 0 then
10 4068 begin
11 4069 ia(2):= værdi(1); ia(3):= værdi(2);
11 4070 j:= find_bpl(værdi.laf(1));
11 4071 if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
11 4072 end
10 4073 else res:= if a_res=0 then 2 <*godkendt*>
10 4074 else 27 <*parametertype*>;
10 4075 end
9 4076 else
9 4077 if nr=3 then
9 4078 begin
10 4079 if a_res=0 then res:=2 <*godkendt*>
10 4080 else if a_res<>1 then res:= 27 <*parametertype*>
10 4081 else begin
11 4082 j:= værdi(1) shift (-16);
11 4083 if j='Å' then ia(4):= 1 else
11 4084 if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
11 4085 end;
10 4086 end
9 4087 else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
9 4088 if res<4 then pos:= a_pos;
9 4089 end;
8 4090
8 4090 <* 1 *>
8 4091 <*32: (heltal) *>
8 4092 <* 0 *>
8 4093 begin
9 4094 if nr=1 then
9 4095 begin
10 4096 if ares=0 then
10 4097 begin
11 4098 indeks:= 0; res:= 2;
11 4099 end
10 4100 else
10 4101 if ares=2 or ares=3 then
10 4102 begin
11 4103 ia(nr):= i1; indeks:= nr;
11 4104 end
10 4105 else res:=27; <*parametertype*>
10 4106 end
9 4107 else
9 4108 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4109 if res < 4 then pos:= a_pos;
9 4110 end;
8 4111
8 4111 <*33 generel tekst*>
8 4112 begin
9 4113 integer p,p1,ch,lgd;
9 4114
9 4114 if nr=1 and a_res<>0 then
9 4115 begin
10 4116 p:=pos; p1:=1;
10 4117 lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
10 4118 if 95<lgd then lgd:=95;
10 4119 repeat læstegn(d.opref.data,p,ch) until ch<>' ';
10 4120 while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
10 4121 begin
11 4122 skrivtegn(ia,p1,ch);
11 4123 læstegn(d.opref.data,p,ch);
11 4124 end;
10 4125 if p1=1 then res:= 25 else res:= 2;
10 4126 repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
10 4127 end
9 4128 else
9 4129 if a_res=0 then res:= 25 else res:= 24;
9 4130 end;
8 4131
8 4131 <*34: (heltal) *>
8 4132 begin
9 4133 if nr=1 then
9 4134 begin
10 4135 if ares=0 then res:= 25 else
10 4136 if ares=2 or ares=3 then
10 4137 begin
11 4138 ia(nr):= i1; indeks:= nr;
11 4139 end
10 4140 else res:=27; <*parametertype*>
10 4141 end
9 4142 else
9 4143 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4144 if res < 4 then pos:= a_pos;
9 4145 end;
8 4146
8 4146 <*+4*> begin
9 4147 fejlreaktion(4<*systemfejl*>,partype,
9 4148 <:parametertype fejl i kommandofil:>,1);
9 4149 res:=31;
9 4150 end
8 4151 <*-4*>
8 4152 end;<*case partype*>
7 4153 end;<* while læs_param_sæt *>
6 4154 end; <* operationskode ok *>
5 4155 end
4 4156 else
4 4157 begin
5 4158 fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
5 4159 end;
4 4160
4 4160 if a_res<0 then res:= -a_res;
4 4161 slut_læskommando:
4 4162
4 4162 læs_kommando:=d.op_ref.resultat:= res;
4 4163 end;<* disable-blok*>
3 4164 end læs_kommando;
2 4165 \f
2 4165 message procedure skriv_kvittering side 1 - 820301/hko/cl;
2 4166
2 4166 procedure skriv_kvittering(z,ref,pos,res);
2 4167 value ref,pos,res;
2 4168 zone z;
2 4169 integer ref,pos,res;
2 4170 begin
3 4171 integer array field op;
3 4172 integer pos1,tegn;
3 4173 op:=ref;
3 4174 if res<1 or res>3 then write(z,<:*** :>);
3 4175 write(z,case res+1 of (
3 4176 <* 0*><:ubehandlet:>,
3 4177 <* 1*><:ok:>,
3 4178 <* 2*><:godkendt:>,
3 4179 <* 3*><:udført:>,
3 4180 <* 4*><:kommando ukendt:>,
3 4181
3 4181 <* 5*><:linie-nr ulovligt:>,
3 4182 <* 6*><:løb-nr ulovligt:>,
3 4183 <* 7*><:bus-nr ulovligt:>,
3 4184 <* 8*><:gruppe ukendt:>,
3 4185 <* 9*><:linie/løb ukendt:>,
3 4186
3 4186 <*10*><:bus-nr ukendt:>,
3 4187 <*11*><:bus allerede indsat på :>,
3 4188 <*12*><:linie/løb allerede besat af :>,
3 4189 <*13*><:bus ikke indsat:>,
3 4190 <*14*><:bus optaget:>,
3 4191
3 4191 <*15*><:gruppe optaget:>,
3 4192 <*16*><:skærm optaget:>,
3 4193 <*17*><:kanal ukendt:>,
3 4194 <*18*><:bus i kø:>,
3 4195 <*19*><:kø er tom:>,
3 4196
3 4196 <*20*><:ej forbindelse :>,
3 4197 <*21*><:ingen at gennemstille til:>,
3 4198 <*22*><:ingen samtale at nedlægge:>,
3 4199 <*23*><:ingen samtale at monitere:>,
3 4200 <*24*><:syntaks:>,
3 4201
3 4201 <*25*><:syntaks, parameter mangler:>,
3 4202 <*26*><:syntaks, skilletegn:>,
3 4203 <*27*><:syntaks, parametertype:>,
3 4204 <*28*><:operatør ukendt:>,
3 4205 <*29*><:garageterminal ukendt:>,
3 4206 \f
3 4206
3 4206 <*30*><:rapport kan ikke dannes:>,
3 4207 <*31*><:systemfejl:>,
3 4208 <*32*><:ingen fri plads:>,
3 4209 <*33*><:gruppe for stor:>,
3 4210 <*34*><:gruppe allerede defineret:>,
3 4211
3 4211 <*35*><:springsekvens for stor:>,
3 4212 <*36*><:spring allerede defineret:>,
3 4213 <*37*><:spring ukendt:>,
3 4214 <*38*><:spring allerede igangsat:>,
3 4215 <*39*><:bus ikke reserveret:>,
3 4216
3 4216 <*40*><:gruppe ikke reserveret:>,
3 4217 <*41*><:spring ikke igangsat:>,
3 4218 <*42*><:intet frit linie/løb:>,
3 4219 <*43*><:ændring af dato/tid ikke lovlig:>,
3 4220 <*44*><:interval-størrelse ulovlig:>,
3 4221
3 4221 <*45*><:ikke implementeret:>,
3 4222 <*46*><:navn ukendt:>,
3 4223 <*47*><:forkert indhold:>,
3 4224 <*48*><:i brug:>,
3 4225 <*49*><:ingen samtale igang:>,
3 4226
3 4226 <*50*><:kanal:>,
3 4227 <*51*><:afvist:>,
3 4228 <*52*><:kanal optaget :>,
3 4229 <*53*><:annulleret:>,
3 4230 <*54*><:ingen busser at kalde op:>,
3 4231
3 4231 <*55*><:garagenavn ukendt:>,
3 4232 <*56*><:område ukendt:>,
3 4233 <*57*><:område nødvendigt:>,
3 4234 <*58*><:ulovligt område for bus:>,
3 4235 <*59*><:radiofejl :>,
3 4236
3 4236 <*60*><:område kan ikke opdateres:>,
3 4237 <*61*><:ingen talevej:>,
3 4238 <*62*><:ulovligt navn:>,
3 4239 <*63*><:alarmlængde: :>,
3 4240 <*64*><:ulovligt tal:>,
3 4241
3 4241 <*99*><:- <'?'> -:>));
3 4242 \f
3 4242 message procedure skriv_kvittering side 3 - 820301/hko;
3 4243 if res=3 and op<>0 then
3 4244 begin
4 4245 if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
4 4246 begin
5 4247 i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
5 4248 if i<>0 then write(z,i,<: udtaget:>);
5 4249 end;
4 4250 end;
3 4251 if res = 11 or res = 12 then
3 4252 i:=ref;
3 4253 if res=11 then write(z,i shift(-12) extract 10,
3 4254 if i shift(-7) extract 5 =0 then false
3 4255 else "A" add (i shift(-7) extract 5 -1),1,
3 4256 <:/:>,<<d>,i extract 7) else
3 4257 if res=12 then write(z,i extract 14) else
3 4258 if res = 20 or res = 52 or res = 59 then
3 4259 begin
4 4260 i:= d.op.data(12);
4 4261 if i <> 0 then skriv_id(z,i,8);
4 4262 i:=d.op.data(2);
4 4263 if i=0 then i:=d.op.data(9);
4 4264 if i=0 then i:=d.op.data(8);
4 4265 skriv_id(z,i,8);
4 4266 end;
3 4267 if res=63 then
3 4268 begin
4 4269 i:= ref;
4 4270 if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
4 4271 end;
3 4272
3 4272 if pos>=0 then
3 4273 begin
4 4274 pos:=pos+1;
4 4275 outchar(z,':');
4 4276 tegn:=-1;
4 4277 while tegn<>10 and tegn<>0 do
4 4278 outchar(z,læs_tegn(d.op.data,pos,tegn));
4 4279 end;
3 4280 <*V*>setposition(z,0,0);
3 4281 end skriv_kvittering;
2 4282 \f
2 4282 message procedure cursor, side 1 - 810213/hko;
2 4283
2 4283 procedure cursor(z,linie,pos);
2 4284 value linie,pos;
2 4285 zone z;
2 4286 integer linie,pos;
2 4287 begin
3 4288 if linie>0 and linie<25
3 4289 and pos>0 and pos<81 then
3 4290 begin
4 4291 write(z,"esc" add 128,1,<:Æ:>,
4 4292 <<d>,linie,<:;:>,pos,<:H:>);
4 4293 end;
3 4294 end cursor;
2 4295 \f
2 4295 message procedure attention side 1 - 810529/hko;
2 4296
2 4296 procedure attention;
2 4297 begin
3 4298 integer i, j, k;
3 4299 integer array field op_ref,mess_ref;
3 4300 integer array att_message(1:9);
3 4301 long array field laf1, laf2;
3 4302 boolean optaget;
3 4303 procedure skriv_attention(zud,omfang);
3 4304 integer omfang;
3 4305 zone zud;
3 4306 begin
4 4307 write(zud,"nl",1,<:+++ attention :>);
4 4308 if omfang <> 0 then
4 4309 disable begin integer x;
5 4310 trap(slut);
5 4311 write(zud,"nl",1,
5 4312 <: i: :>,i,"nl",1,
5 4313 <: j: :>,j,"nl",1,
5 4314 <: k: :>,k,"nl",1,
5 4315 <: op-ref: :>,op_ref,"nl",1,
5 4316 <: mess-ref: :>,mess_ref,"nl",1,
5 4317 <: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
5 4318 <: laf2 :>,laf2,"nl",1,
5 4319 <: att-message::>,"nl",1,
5 4320 <::>);
5 4321 raf:= 0;
5 4322 skriv_hele(zud,att_message.raf,18,127);
5 4323 skriv_coru(zud,coru_no(010));
5 4324 slut:
5 4325 end;
4 4326 end skriv_attention;
3 4327
3 4327 integer procedure udtag_tal(tekst,pos);
3 4328 long array tekst;
3 4329 integer pos;
3 4330 begin
4 4331 integer i;
4 4332
4 4332 if getnumber(tekst,pos,i) >= 0 then
4 4333 udtag_tal:= i
4 4334 else
4 4335 udtag_tal:= 0;
4 4336 end;
3 4337
3 4337 for i:= 1 step 1 until att_maske_lgd//2 do
3 4338 att_signal(i):=att_flag(i):=0;
3 4339 trap(att_trap);
3 4340 stack_claim((if cm_test then 198 else 146)+50);
3 4341 <*+2*>
3 4342 if testbit26 and overvåget or testbit28 then
3 4343 skriv_attention(out,0);
3 4344 <*-2*>
3 4345 \f
3 4345 message procedure attention side 2 - 810406/hko;
3 4346
3 4346 repeat
3 4347
3 4347 wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
3 4348
3 4348 repeat
3 4349 <*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
3 4350 raf:= laf1:= 0;
3 4351 laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
3 4352
3 4352 <*+2*>if testbit7 and overvåget then
3 4353 disable begin
4 4354 laf2:= abs(laf);
4 4355 write(out,"nl",1,<:attention - :>);
4 4356 if laf<=0 then write(out,<:Regrettet :>);
4 4357 write(out,<:Message modtaget fra :>);
4 4358 if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
4 4359 skriv_hele(out,att_message.raf,16,127);
4 4360 ud;
4 4361 end;
3 4362 <*-2*>
3 4363 \f
3 4363 message procedure attention side 3 - 830310/cl;
3 4364
3 4364 if laf <= 0 then
3 4365 i:= -1
3 4366 else
3 4367 if core.laf(1)=konsol_navn.laf1(1)
3 4368 and core.laf(2)=konsol_navn.laf1(2) then
3 4369 i:= 101
3 4370 else
3 4371 begin
4 4372 i:= -1; j:= 1;
4 4373 while i=(-1) and (j <= max_antal_operatører) do
4 4374 begin
5 4375 laf2:= (j-1)*8;
5 4376 if core.laf(1) = terminal_navn.laf2(1)
5 4377 and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
5 4378 j:= j+1;
5 4379 end;
4 4380 j:= 1;
4 4381 while i=(-1) and (j<=max_antal_garageterminaler) do
4 4382 begin
5 4383 laf2:= (j-1)*8;
5 4384 if core.laf(1) = garage_terminal_navn.laf2(1)
5 4385 and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
5 4386 j:= j+1;
5 4387 end;
4 4388 end;
3 4389
3 4389 if i=101 or (201<=i and i<=200+max_antal_operatører)
3 4390 <* or (301<=i and i<=300+max_antal_garageterminaler) *>
3 4391 then
3 4392 begin
4 4393
4 4393 j:= if i=101 then 0
4 4394 else max_antal_operatører*(i//100-2)+i mod 100;
4 4395
4 4395 ref:=j*terminal_beskr_længde;
4 4396 att_message(9):=
4 4397 if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
4 4398 else 4 <*disconnected*>;
4 4399 optaget:=læsbit_ia(att_flag,j);
4 4400 if optaget and att_message(9)=1 then
4 4401 sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
4 4402 else optaget:=optaget or att_message(9)<>1;
4 4403 if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
4 4404 begin <* att fra ekskluderet operatør - inkluder *>
5 4405 start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
5 4406 d.op_ref.data(1):= i mod 100;
5 4407 signalch(cs_rad,op_ref,gen_optype);
5 4408 waitch(cs_att_pulje,op_ref,true,-1);
5 4409 end;
4 4410 end
3 4411 else
3 4412 begin
4 4413 optaget:= true;
4 4414 att_message(9):= 2 <*rejected*>;
4 4415 end;
3 4416
3 4416 monitor(22)send_answer:(zdummy,mess_ref,att_message);
3 4417
3 4417 until -,optaget;
3 4418 \f
3 4418 message procedure attention side 4 - 810424/hko;
3 4419
3 4419 sætbit_ia(att_flag,j,1);
3 4420
3 4420 start_operation(op_ref,i,cs_att_pulje,0);
3 4421
3 4421 signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
3 4422
3 4422 until false;
3 4423
3 4423 att_trap:
3 4424
3 4424 skriv_attention(zbillede,1);
3 4425
3 4425
3 4425 end attention;
2 4426
2 4426 \f
2 4426 message io_erklæringer side 1 - 810421/hko;
2 4427
2 4427 integer
2 4428 cs_io,
2 4429 cs_io_komm,
2 4430 cs_io_fil,
2 4431 cs_io_spool,
2 4432 cs_io_medd,
2 4433 cs_io_nulstil,
2 4434 ss_io_spool_tomme,
2 4435 ss_io_spool_fulde,
2 4436 bs_zio_adgang,
2 4437 io_spool_fil,
2 4438 io_spool_postantal,
2 4439 io_spool_postlængde;
2 4440
2 4440 integer array field
2 4441 io_spool_post;
2 4442
2 4442 zone z_io(32,1,io_fejl);
2 4443
2 4443 procedure io_fejl(z,s,b);
2 4444 integer s,b;
2 4445 zone z;
2 4446 begin
3 4447 disable begin
4 4448 integer array iz(1:20);
4 4449 integer i,j,k;
4 4450 integer array field iaf;
4 4451 real array field raf;
4 4452 if s<>(1 shift 21 + 2) then
4 4453 begin
5 4454 getzone6(z,iz);
5 4455 raf:=2;
5 4456 iaf:=0;
5 4457 k:=1;
5 4458
5 4458 j:= terminal_tab.iaf.terminal_tilstand;
5 4459 if j shift(-21)<>6 then
5 4460 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
5 4461 1 shift 12 <*binært*> +1 <*fortsæt*>);
5 4462 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
5 4463 + terminal_tab.iaf.terminal_tilstand extract 21;
5 4464 end;
4 4465 z(1):=real <:<'?'><'?'><'em'>:>;
4 4466 b:=2;
4 4467 end; <*disable*>
3 4468 end io_fejl;
2 4469 \f
2 4469 message procedure skriv_auto_spring_medd side 1 - 820301/hko;
2 4470
2 4470 procedure skriv_auto_spring_medd(z,medd,tid);
2 4471 value tid;
2 4472 zone z;
2 4473 real tid;
2 4474 integer array medd;
2 4475 begin
3 4476 disable begin
4 4477 real t;
4 4478 integer kode,bus,linie,bogst,løb,dato,kl;
4 4479 long array indeks(1:1);
4 4480 kode:= medd(1);
4 4481 indeks(1):= extend medd(5) shift 24;
4 4482 if kode > 0 and kode < 10 then
4 4483 begin
5 4484 write(z,"nl",0,<:-<'>'>:>,case kode of(
5 4485 <*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
5 4486 <*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
5 4487 <*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
5 4488 <*4*><:vogn optaget:>, <* - i - - / - *>
5 4489 <*5*><:spring annulleret:>, <*udløb af ventetid *>
5 4490 <*6*><::>, <* - af springliste *>
5 4491 <*7*><::>, <*start af springsekvens *>
5 4492 <*8*><::>, <*afvikling af springsekvens *>
5 4493 <*9*><:område kan ikke opdateres:>,<*vt-ændring*>
5 4494 <::>));
5 4495 <* if kode = 5 then
5 4496 begin
5 4497 bogst:= medd(4);
5 4498 linie:= bogst shift(-5) extract 10;
5 4499 bogst:= bogst extract 5;
5 4500 if bogst > 0 then bogst:= bogst +'A'-1;
5 4501 write(z,"sp",1,<<z>,linie,false add bogst,1,
5 4502 ".",1,indeks);
5 4503 end;
5 4504 *>
5 4505 outchar(z,'sp');
5 4506 bus:= medd(2) extract 14;
5 4507 if bus > 0 then
5 4508 write(z,<<z>,bus,"/",1);
5 4509 løb:= medd(3);
5 4510 <*+4*> if løb shift(-22) <> 1 and løb <> 0 then
5 4511 fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
5 4512 <*-4*>
5 4513 \f
5 4513 message procedure skriv_auto_spring_medd side 2 - 810507/hko;
5 4514
5 4514 linie:= løb shift(-12) extract 10;
5 4515 bogst:= løb shift(-7) extract 5;
5 4516 if bogst > 0 then bogst:= bogst +'A'-1;
5 4517 løb:= løb extract 7;
5 4518 if medd(3) <> 0 or kode <> 5 then
5 4519 begin
6 4520 write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
6 4521 if kode = 5 or kode = 6 then write(z,<:er frit :>);
6 4522 end;
5 4523 if kode = 7 or kode = 8 then
5 4524 write(z,<*indeks,"sp",1,*>
5 4525 if kode=7 then <:udtaget :> else <:indsat :>);
5 4526
5 4526 dato:= systime(4,tid,t);
5 4527 kl:= t/100.0;
5 4528 løb:= replace_char(1<*space in number*>,'.');
5 4529 write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
5 4530 replace_char(1,løb);
5 4531 end
4 4532 else <*kode < 1 or kode > 8*>
4 4533 fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
4 4534 end; <*disable*>
3 4535 end skriv_auto_spring_medd;
2 4536 \f
2 4536 message procedure h_io side 1 - 810507/hko;
2 4537
2 4537 <* hovedmodulkorutine for io *>
2 4538 procedure h_io;
2 4539 begin
3 4540 integer array field op_ref;
3 4541 integer k,dest_sem;
3 4542 procedure skriv_hio(zud,omfang);
3 4543 value omfang;
3 4544 zone zud;
3 4545 integer omfang;
3 4546 begin
4 4547
4 4547 write(zud,"nl",1,<:+++ hovedmodul io :>);
4 4548 if omfang>0 then
4 4549 disable begin integer x;
5 4550 trap(slut);
5 4551 write(zud,"nl",1,
5 4552 <: op_ref: :>,op_ref,"nl",1,
5 4553 <: k: :>,k,"nl",1,
5 4554 <: dest_sem: :>,dest_sem,"nl",1,
5 4555 <::>);
5 4556 skriv_coru(zud,coru_no(100));
5 4557 slut:
5 4558 end;
4 4559 end skriv_hio;
3 4560
3 4560 trap(hio_trap);
3 4561 stack_claim(if cm_test then 198 else 146);
3 4562
3 4562 <*+2*>
3 4563 if testbit0 and overvåget or testbit28 then
3 4564 skriv_hio(out,0);
3 4565 <*-2*>
3 4566 \f
3 4566 message procedure h_io side 2 - 810507/hko;
3 4567
3 4567 repeat
3 4568 wait_ch(cs_io,op_ref,true,-1);
3 4569 <*+4*>
3 4570 if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
3 4571 then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
3 4572 <*-4*>
3 4573
3 4573 k:=d.op_ref.opkode extract 12;
3 4574 dest_sem:=
3 4575 if k = 0 <*attention*> then cs_io_komm else
3 4576
3 4576 if k = 22 <*auto vt opdatering*>
3 4577 or k = 23 <*generel meddelelse*>
3 4578 or k = 36 <*spring meddelelse*>
3 4579 or k = 44 <*udeladt i gruppeopkald*>
3 4580 or k = 45 <*nødopkald modtaget*>
3 4581 or k = 46 <*nødopkald besvaret*> then cs_io_spool else
3 4582
3 4582 if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
3 4583 0;
3 4584 <*+4*>
3 4585 if dest_sem = 0 then
3 4586 begin
4 4587 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
4 4588 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 4589 end
3 4590 else
3 4591 <*-4*>
3 4592 begin
4 4593 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 4594 end;
3 4595 until false;
3 4596
3 4596 hio_trap:
3 4597 disable skriv_hio(zbillede,1);
3 4598 end h_io;
2 4599 \f
2 4599 message procedure io_komm side 1 - 810507/hko;
2 4600
2 4600 procedure io_komm;
2 4601 begin
3 4602 integer array field op_ref,ref,vt_op,iaf;
3 4603 integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
3 4604 pos,indeks,sep,sluttegn,operatør,i,j,k;
3 4605 long navn;
3 4606
3 4606 procedure skriv_io_komm(zud,omfang);
3 4607 value omfang;
3 4608 zone zud;
3 4609 integer omfang;
3 4610 begin
4 4611
4 4611 disable
4 4612
4 4612 write(zud,"nl",1,<:+++ io_komm :>);
4 4613 if omfang > 0 then
4 4614 disable begin integer x;
5 4615 trap(slut);
5 4616 write(zud,"nl",1,
5 4617 <: op-ref: :>,op_ref,"nl",1,
5 4618 <: kode: :>,kode,"nl",1,
5 4619 <: aktion: :>,aktion,"nl",1,
5 4620 <: ref: :>,ref,"nl",1,
5 4621 <: vt_op: :>,vt_op,"nl",1,
5 4622 <: status: :>,status,"nl",1,
5 4623 <: opgave: :>,opgave,"nl",1,
5 4624 <: dest-sem: :>,dest_sem,"nl",1,
5 4625 <: iaf: :>,iaf,"nl",1,
5 4626 <: i: :>,i,"nl",1,
5 4627 <: j: :>,j,"nl",1,
5 4628 <: k: :>,k,"nl",1,
5 4629 <: navn: :>,string navn,"nl",1,
5 4630 <: pos: :>,pos,"nl",1,
5 4631 <: indeks: :>,indeks,"nl",1,
5 4632 <: sep: :>,sep,"nl",1,
5 4633 <: sluttegn: :>,sluttegn,"nl",1,
5 4634 <: vogn: :>,vogn,"nl",1,
5 4635 <: ll: :>,ll,"nl",1,
5 4636 <: omr: :>,omr,"nl",1,
5 4637 <: operatør: :>,operatør,"nl",1,
5 4638 <::>);
5 4639 skriv_coru(zud,coru_no(101));
5 4640 slut:
5 4641 end;
4 4642 end skriv_io_komm;
3 4643 \f
3 4643 message procedure io_komm side 2 - 810424/hko;
3 4644
3 4644 trap(io_komm_trap);
3 4645 stack_claim((if cm_test then 200 else 146)+24+200);
3 4646
3 4646 ref:=0;
3 4647 navn:= long<::>;
3 4648
3 4648 <*+2*>
3 4649 if testbit0 and overvåget or testbit28 then
3 4650 skriv_io_komm(out,0);
3 4651 <*-2*>
3 4652
3 4652 repeat
3 4653
3 4653 <*V*> wait_ch(cs_io_komm,
3 4654 op_ref,
3 4655 true,
3 4656 -1<*timeout*>);
3 4657 <*+2*>
3 4658 if testbit1 and overvåget then
3 4659 disable begin
4 4660 skriv_io_komm(out,0);
4 4661 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
4 4662 <: til io :>);
4 4663 skriv_op(out,op_ref);
4 4664 end;
3 4665 <*-2*>
3 4666
3 4666 kode:= d.op_ref.op_kode;
3 4667 i:= terminal_tab.ref.terminal_tilstand;
3 4668 status:= i shift(-21);
3 4669 opgave:=
3 4670 if kode=0 then 1 <* indlæs kommando *> else
3 4671 0; <* afvises *>
3 4672
3 4672 aktion:= if opgave = 0 then 0 else
3 4673 (case status +1 of(
3 4674 <* status *>
3 4675 <* 0 klar *>(1),
3 4676 <* 1 - *>(-1),<* ulovlig tilstand *>
3 4677 <* 2 - *>(-1),<* ulovlig tilstand *>
3 4678 <* 3 stoppet *>(2),
3 4679 <* 4 noneksist *>(-1),<* ulovlig tilstand *>
3 4680 <* 5 - *>(-1),<* ulovlig tilstand *>
3 4681 <* 6 - *>(-1),<* ulovlig tilstand *>
3 4682 <* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
3 4683 -1));
3 4684 \f
3 4684 message procedure io_komm side 3 - 810428/hko;
3 4685
3 4685 case aktion+6 of
3 4686 begin
4 4687 begin
5 4688 <*-5: terminal optaget *>
5 4689
5 4689 d.op_ref.resultat:= 16;
5 4690 afslut_operation(op_ref,-1);
5 4691 end;
4 4692
4 4692 begin
5 4693 <*-4: operation uden virkning *>
5 4694
5 4694 afslut_operation(op_ref,-1);
5 4695 end;
4 4696
4 4696 begin
5 4697 <*-3: ulovlig operationskode *>
5 4698
5 4698 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 4699 afslut_operation(op_ref,-1);
5 4700 end;
4 4701
4 4701 begin
5 4702 <*-2: ulovlig aktion *>
5 4703
5 4703 fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
5 4704 afslut_operation(op_ref,-1);
5 4705 end;
4 4706
4 4706 begin
5 4707 <*-1: ulovlig io_tilstand *>
5 4708
5 4708 fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
5 4709 afslut_operation(op_ref,-1);
5 4710 end;
4 4711
4 4711 begin
5 4712 <* 0: ikke implementeret *>
5 4713
5 4713 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 4714 afslut_operation(op_ref,-1);
5 4715 end;
4 4716
4 4716 begin
5 4717 \f
5 4717 message procedure io_komm side 4 - 851001/cl;
5 4718
5 4718 <* 1: indlæs kommando *>
5 4719 <*V*> wait(bs_zio_adgang);
5 4720
5 4720 <*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
5 4721
5 4721 if d.op_ref.resultat > 3 then
5 4722 begin
6 4723 <*V*> setposition(z_io,0,0);
6 4724 if sluttegn<>'nl' then outchar(z_io,'nl');
6 4725 skriv_kvittering(z_io,op_ref,pos,
6 4726 d.op_ref.resultat);
6 4727 end
5 4728 else if d.op_ref.resultat>0 then
5 4729 begin <*godkendt*>
6 4730 kode:=d.op_ref.opkode;
6 4731 i:= kode extract 12;
6 4732 j:= if kode < 5 or
6 4733 kode=7 or kode=8 or
6 4734 kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
6 4735 if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
6 4736 if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
6 4737 if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
6 4738 kode=20 or kode=24 then 4<*VO,F/VO,R*>else
6 4739 if kode =21 then 5 <*AU*> else
6 4740 if kode =25 then 6 <*GR,D*> else
6 4741 if kode =26 then 5 <*GR,S*> else
6 4742 if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
6 4743 if kode =30 then 10 <*SP,D*> else
6 4744 if kode =31 then 5 <*SP*> else
6 4745 if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
6 4746 if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
6 4747 if kode=71 then 11 <*FO,V*> else
6 4748 if kode =75 then 12 <*TÆ,V *>else
6 4749 if kode =76 then 12 <*TÆ,N *>else
6 4750 if kode =65 then 13 <*BE,N *>else
6 4751 if kode =66 then 14 <*BE,G *>else
6 4752 if kode =67 then 15 <*BE,V *>else
6 4753 if kode =68 then 16 <*ST,D *>else
6 4754 if kode =69 then 17 <*ST,V *>else
6 4755 if kode =36 then 18 <*AL *>else
6 4756 if kode =37 then 19 <*CC *>else
6 4757 if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
6 4758 if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
6 4759 0;
6 4760 if j > 0 then
6 4761 begin
7 4762 case j of
7 4763 begin
8 4764 begin
9 4765 \f
9 4765 message procedure io_komm side 5 - 810424/hko;
9 4766
9 4766 <* 1: inkluder/ekskluder ydre enhed *>
9 4767
9 4767 d.op_ref.retur:= cs_io_komm;
9 4768 if kode=1 then d.opref.opkode:=
9 4769 ia(2) shift 12 + d.opref.opkode extract 12;
9 4770 d.op_ref.data(1):= ia(1);
9 4771 signal_ch(if kode < 5 or kode>=72 then cs_rad
9 4772 else cs_gar,
9 4773 op_ref,gen_optype or io_optype);
9 4774 indeks:= op_ref;
9 4775 wait_ch(cs_io_komm,
9 4776 op_ref,
9 4777 true,
9 4778 -1<*timeout*>);
9 4779 <*+4*> if op_ref <> indeks then
9 4780 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4781 <*-4*>
9 4782 <*V*> setposition(z_io,0,0);
9 4783 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4784 skriv_kvittering(z_io,op_ref,-1,
9 4785 d.op_ref.resultat);
9 4786 end;
8 4787
8 4787 begin
9 4788 \f
9 4788 message procedure io_komm side 6 - 810501/hko;
9 4789
9 4789 <* 2: tid/attention,ja/attention,nej
9 4790 slut/slut med billede *>
9 4791
9 4791 case d.op_ref.opkode -79 of
9 4792 begin
10 4793
10 4793 <* 80: TI *> begin
11 4794 setposition(z_io,0,0);
11 4795 if sluttegn<>'nl' then outchar(z_io,'nl');
11 4796 if ia(1) <> 0 or ia(2) <> 0 then
11 4797 begin real field rf;
12 4798 rf:= 4;
12 4799 trap(forbudt);
12 4800 <*V*> setposition(z_io,0,0);
12 4801 systime(3,ia.rf,0.0);
12 4802 if false then
12 4803 begin
13 4804 forbudt: skriv_kvittering(z_io,0,-1,
13 4805 43<*ændring af dato/tid ikke lovlig*>);
13 4806 end
12 4807 else
12 4808 skriv_kvittering(z_io,0,-1,3);
12 4809 end
11 4810 else
11 4811 begin
12 4812 setposition(z_io,0,0);
12 4813 write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
12 4814 end;
11 4815 end TI;
10 4816 \f
10 4816 message procedure io_komm side 7 - 810424/hko;
10 4817
10 4817 <*81: AT,J*> begin
11 4818 <*V*> setposition(z_io,0,0);
11 4819 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4820 monitor(10)release process:(z_io,0,ia);
11 4821 skriv_kvittering(z_io,0,-1,3);
11 4822 end;
10 4823
10 4823 <* 82: AT,N*> begin
11 4824 i:= monitor(8)reserve process:(z_io,0,ia);
11 4825 <*V*> setposition(z_io,0,0);
11 4826 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4827 skriv_kvittering(z_io,0,-1,
11 4828 if i = 0 then 3 else 0);
11 4829 end;
10 4830
10 4830 <* 83: SL *> begin
11 4831 errorbits:=0; <* warning.no ok.yes *>
11 4832 trapmode:= 1 shift 13;
11 4833 trap(-2);
11 4834 end;
10 4835
10 4835 <* 84: SL,B *>begin
11 4836 errorbits:=1; <* warning.no ok.no *>
11 4837 trap(-3);
11 4838 end;
10 4839 <* 85: SL,K *>begin
11 4840 errorbits:=1; <* warning.no ok.no *>
11 4841 disable sæt_bit_i(trapmode,15,0);
11 4842 trap(-3);
11 4843 end;
10 4844 \f
10 4844 message procedure io_komm side 7a - 810511/cl;
10 4845
10 4845 <* 86: TE,J *>begin
11 4846 setposition(z_io,0,0);
11 4847 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4848 for i:= 1 step 1 until indeks do
11 4849 if 0<=ia(i) and ia(i)<=47 then
11 4850 begin
12 4851 case (ia(i)+1) of
12 4852 begin
13 4853 testbit0 := true;testbit1 := true;testbit2 := true;
13 4854 testbit3 := true;testbit4 := true;testbit5 := true;
13 4855 testbit6 := true;testbit7 := true;testbit8 := true;
13 4856 testbit9 := true;testbit10:= true;testbit11:= true;
13 4857 testbit12:= true;testbit13:= true;testbit14:= true;
13 4858 testbit15:= true;testbit16:= true;testbit17:= true;
13 4859 testbit18:= true;testbit19:= true;testbit20:= true;
13 4860 testbit21:= true;testbit22:= true;testbit23:= true;
13 4861 testbit24:= true;testbit25:= true;testbit26:= true;
13 4862 testbit27:= true;testbit28:= true;testbit29:= true;
13 4863 testbit30:= true;testbit31:= true;testbit32:= true;
13 4864 testbit33:= true;testbit34:= true;testbit35:= true;
13 4865 testbit36:= true;testbit37:= true;testbit38:= true;
13 4866 testbit39:= true;testbit40:= true;testbit41:= true;
13 4867 testbit42:= true;testbit43:= true;testbit44:= true;
13 4868 testbit45:= true;testbit46:= true;testbit47:= true;
13 4869 end;
12 4870 end;
11 4871 skriv_kvittering(z_io,0,-1,3);
11 4872 end;
10 4873 \f
10 4873 message procedure io_komm side 7b - 810511/cl;
10 4874
10 4874 <* 87: TE,N *>begin
11 4875 setposition(z_io,0,0);
11 4876 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4877 for i:= 1 step 1 until indeks do
11 4878 if 0<=ia(i) and ia(i)<=47 then
11 4879 begin
12 4880 case (ia(i)+1) of
12 4881 begin
13 4882 testbit0 := false;testbit1 := false;testbit2 := false;
13 4883 testbit3 := false;testbit4 := false;testbit5 := false;
13 4884 testbit6 := false;testbit7 := false;testbit8 := false;
13 4885 testbit9 := false;testbit10:= false;testbit11:= false;
13 4886 testbit12:= false;testbit13:= false;testbit14:= false;
13 4887 testbit15:= false;testbit16:= false;testbit17:= false;
13 4888 testbit18:= false;testbit19:= false;testbit20:= false;
13 4889 testbit21:= false;testbit22:= false;testbit23:= false;
13 4890 testbit24:= false;testbit25:= false;testbit26:= false;
13 4891 testbit27:= false;testbit28:= false;testbit29:= false;
13 4892 testbit30:= false;testbit31:= false;testbit32:= false;
13 4893 testbit33:= false;testbit34:= false;testbit35:= false;
13 4894 testbit36:= false;testbit37:= false;testbit38:= false;
13 4895 testbit39:= false;testbit40:= false;testbit41:= false;
13 4896 testbit42:= false;testbit43:= false;testbit44:= false;
13 4897 testbit45:= false;testbit46:= false;testbit47:= false;
13 4898 end;
12 4899 end;
11 4900 skriv_kvittering(z_io,0,-1,3);
11 4901 end;
10 4902
10 4902 <* 88: O *> begin
11 4903 integer array odescr,zdescr(1:20);
11 4904 long array field laf;
11 4905 integer res, i, j;
11 4906
11 4906 i:= j:= 1;
11 4907 while læstegn(ia,i,res)<>0 do
11 4908 begin
12 4909 if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
12 4910 skrivtegn(ia,j,res);
12 4911 end;
11 4912
11 4912 laf:= 2;
11 4913 getzone6(out,odescr);
11 4914 getzone6(z_io,zdescr);
11 4915 close(out,zdescr.laf(1)<>odescr.laf(1) or
11 4916 zdescr.laf(2)<>odescr.laf(2));
11 4917 laf:= 0;
11 4918
11 4918 if ia(1)=0 then
11 4919 begin
12 4920 res:= 3;
12 4921 j:= 0;
12 4922 end
11 4923 else
11 4924 begin
12 4925 j:= res:= openbs(out,j,ia,0);
12 4926 if res<>0 then
12 4927 res:= 46;
12 4928 end;
11 4929 if res<>0 then
11 4930 begin
12 4931 open(out,8,konsol_navn,0);
12 4932 if j<>0 then
12 4933 begin
13 4934 i:= 1;
13 4935 fejlreaktion(4,j,string ia.laf(increase(i)),1);
13 4936 end;
12 4937 end
11 4938 else res:= 3;
11 4939 setposition(z_io,0,0);
11 4940 skriv_kvittering(z_io,0,-1,res);
11 4941 end;
10 4942 end;<*case d.op_ref.opkode -79*>
9 4943 end;<*case 2*>
8 4944 begin
9 4945 \f
9 4945 message procedure io_komm side 8 - 810424/hko;
9 4946
9 4946 <* 3: vogntabel,linienr/-,busnr*>
9 4947
9 4947 d.op_ref.retur:= cs_io_komm;
9 4948 tofrom(d.op_ref.data,ia,10);
9 4949 indeks:= op_ref;
9 4950 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 4951 wait_ch(cs_io_komm,
9 4952 op_ref,
9 4953 io_optype,
9 4954 -1<*timeout*>);
9 4955 <*+2*> if testbit2 and overvåget then
9 4956 disable begin
10 4957 skriv_io_komm(out,0);
10 4958 write(out,"nl",1,<:io operation retur fra vt:>);
10 4959 skriv_op(out,op_ref);
10 4960 end;
9 4961 <*-2*>
9 4962 <*+4*> if indeks <> op_ref then
9 4963 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4964 <*-4*>
9 4965
9 4965 i:=d.op_ref.resultat;
9 4966 if i<1 or i>3 then
9 4967 begin
10 4968 <*V*> setposition(z_io,0,0);
10 4969 if sluttegn<>'nl' then outchar(z_io,'nl');
10 4970 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 4971 end
9 4972 else
9 4973 begin
10 4974 \f
10 4974 message procedure io_komm side 9 - 820301/hko,cl;
10 4975
10 4975 integer antal,filref;
10 4976
10 4976 antal:= d.op_ref.data(6);
10 4977 fil_ref:= d.op_ref.data(7);
10 4978 pos:= 0;
10 4979 <*V*> setposition(zio,0,0);
10 4980 if sluttegn <> 'nl' then outchar(z_io,'nl');
10 4981 for pos:= pos +1 while pos <= antal do
10 4982 begin
11 4983 integer bogst,løb;
11 4984
11 4984 disable i:= læsfil(fil_ref,pos,j);
11 4985 if i <> 0 then
11 4986 fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
11 4987 vogn:= fil(j,1) shift (-24) extract 24;
11 4988 løb:= fil(j,1) extract 24;
11 4989 if d.op_ref.opkode=9 then
11 4990 begin i:=vogn; vogn:=løb; løb:=i; end;
11 4991 ll:= løb shift(-12) extract 10;
11 4992 bogst:= løb shift(-7) extract 5;
11 4993 if bogst > 0 then bogst:= bogst+'A'-1;
11 4994 løb:= løb extract 7;
11 4995 vogn:= vogn extract 14;
11 4996 i:= d.op_ref.opkode -8;
11 4997 for i:= i,i +1 do
11 4998 begin
12 4999 j:= (i+1) extract 1;
12 5000 case j+1 of
12 5001 begin
13 5002 write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5003 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5004 write(zio,<<dddd>,vogn,"sp",1);
13 5005 end;
12 5006 end;
11 5007 if pos mod 5 = 0 then
11 5008 begin
12 5009 outchar(zio,'nl');
12 5010 <*V*> setposition(zio,0,0);
12 5011 end
11 5012 else write(zio,"sp",3);
11 5013 end;
10 5014 write(zio,"*",1);
10 5015 \f
10 5015 message procedure io_komm side 9a - 810505/hko;
10 5016
10 5016 d.op_ref.opkode:=104;<*slet fil*>
10 5017 d.op_ref.data(4):=filref;
10 5018 indeks:=op_ref;
10 5019 signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
10 5020 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
10 5021
10 5021 <*+2*> if testbit2 and overvåget then
10 5022 disable begin
11 5023 skriv_io_komm(out,0);
11 5024 write(out,"nl",1,<:io operation retur fra sletfil:>);
11 5025 skriv_op(out,op_ref);
11 5026 end;
10 5027 <*-2*>
10 5028
10 5028 <*+4*> if op_ref<>indeks then
10 5029 fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
10 5030 <*-4*>
10 5031 if d.op_ref.data(9)<>0 then
10 5032 fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 5033 <:io-komm, sletfil:>,1);
10 5034 end;
9 5035 end;
8 5036
8 5036 begin
9 5037 \f
9 5037 message procedure io_komm side 10 - 820301/hko;
9 5038
9 5038 <* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
9 5039
9 5039 vogn:=ia(1);
9 5040 ll:=ia(2);
9 5041 omr:= if kode=11 or kode=19 then ia(3) else
9 5042 if kode=12 then ia(2) else 0;
9 5043 if kode=19 and omr<=0 then
9 5044 begin
10 5045 if omr=-1 then omr:= 0
10 5046 else omr:= 14 shift 20 + 3; <*OMR TCT*>
10 5047 end;
9 5048 <*V*> wait_ch(cs_vt_adgang,
9 5049 vt_op,
9 5050 gen_optype,
9 5051 -1<*timeout sek*>);
9 5052 start_operation(vtop,101,cs_io_komm,
9 5053 kode);
9 5054 d.vt_op.data(1):=vogn;
9 5055 d.vt_op.data(2):=ll;
9 5056 d.vt_op.data(if kode=19 then 3 else 4):= omr;
9 5057 indeks:= vt_op;
9 5058 signal_ch(cs_vt,
9 5059 vt_op,
9 5060 gen_optype or io_optype);
9 5061
9 5061 <*V*> wait_ch(cs_io_komm,
9 5062 vt_op,
9 5063 io_optype,
9 5064 -1<*timeout sek*>);
9 5065 <*+2*> if testbit2 and overvåget then
9 5066 disable begin
10 5067 skriv_io_komm(out,0);
10 5068 write(out,"nl",1,
10 5069 <:iooperation retur fra vt:>);
10 5070 skriv_op(out,vt_op);
10 5071 end;
9 5072 <*-2*>
9 5073 <*+4*> if vt_op<>indeks then
9 5074 fejl_reaktion(11<*fremmede op*>,op_ref,
9 5075 <:io-kommando:>,0);
9 5076 <*-4*>
9 5077 <*V*> setposition(z_io,0,0);
9 5078 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5079 skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
9 5080 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 5081 else vt_op,-1,d.vt_op.resultat);
9 5082 d.vt_op.optype:= genoptype or vt_optype;
9 5083 disable afslut_operation(vt_op,cs_vt_adgang);
9 5084 end;
8 5085
8 5085 begin
9 5086 \f
9 5086 message procedure io_komm side 11 - 810428/hko;
9 5087
9 5087 <* 5 autofil-skift
9 5088 gruppe,slet
9 5089 spring (igangsæt)
9 5090 spring,annuler
9 5091 spring,reserve *>
9 5092
9 5092 tofrom(d.op_ref.data,ia,8);
9 5093 d.op_ref.retur:=cs_io_komm;
9 5094 indeks:=op_ref;
9 5095 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5096 <*V*> wait_ch(cs_io_komm,
9 5097 op_ref,
9 5098 io_optype,
9 5099 -1<*timeout*>);
9 5100 <*+2*> if testbit2 and overvåget then
9 5101 disable begin
10 5102 skriv_io_komm(out,0);
10 5103 write(out,"nl",1,<:io operation retur fra vt:>);
10 5104 skriv_op(out,op_ref);
10 5105 end;
9 5106 <*-2*>
9 5107 <*+4*> if indeks<>op_ref then
9 5108 fejlreaktion(11<*fremmed post*>,op_ref,
9 5109 <:io-kommando(autofil):>,0);
9 5110 <*-4*>
9 5111
9 5111 <*V*> setposition(z_io,0,0);
9 5112 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5113 skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
9 5114 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 5115 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 5116 end;
8 5117
8 5117 begin
9 5118 \f
9 5118 message procedure io_komm side 12 - 820301/hko/cl;
9 5119
9 5119 <* 6 gruppedefinition *>
9 5120
9 5120 tofrom(d.op_ref.data,ia,indeks*2);
9 5121 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5122 start_operation(vt_op,101,cs_io_komm,
9 5123 101<*opret fil*>);
9 5124 d.vt_op.data(1):=256;<*postantal*>
9 5125 d.vt_op.data(2):=1; <*postlængde*>
9 5126 d.vt_op.data(3):=1; <*segmentantal*>
9 5127 d.vt_op.data(4):=
9 5128 2 shift 10; <*spool fil*>
9 5129 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5130 pos:=vt_op;<*variabel lånes*>
9 5131 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5132 <*+4*> if vt_op<>pos then
9 5133 fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
9 5134 if d.vt_op.data(9)<>0 then
9 5135 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5136 <:io-kommando(gruppedefinition):>,0);
9 5137 <*-4*>
9 5138 iaf:=0;
9 5139 for i:=1 step 1 until indeks-1 do
9 5140 begin
10 5141 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5142 if k<>0 then
10 5143 fejlreaktion(7<*modif-fil*>,k,
10 5144 <:io kommando(gruppe-def):>,0);
10 5145 fil(j).iaf(1):=d.op_ref.data(i+1);
10 5146 end;
9 5147 while sep = ',' do
9 5148 begin
10 5149 wait(bs_fortsæt_adgang);
10 5150 pos:= 1; j:= 0;
10 5151 while læs_store(z_io,i) < 8 do
10 5152 begin
11 5153 skrivtegn(fortsæt,pos,i);
11 5154 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5155 end;
10 5156 skrivtegn(fortsæt,pos,'em');
10 5157 afsluttext(fortsæt,pos);
10 5158 sluttegn:= i;
10 5159 if j<>0 then
10 5160 begin
11 5161 setposition(z_io,0,0);
11 5162 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5163 skriv_kvittering(zio,opref,-1,53);<*annulleret*>
11 5164 goto gr_ann;
11 5165 end;
10 5166 \f
10 5166 message procedure io_komm side 13 - 810512/hko/cl;
10 5167
10 5167 disable begin
11 5168 integer array værdi(1:4);
11 5169 integer a_pos,res;
11 5170 pos:= 0;
11 5171 repeat
11 5172 apos:= pos;
11 5173 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5174 if res >= 0 then
11 5175 begin
12 5176 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5177 else if res=0 then res:= -25 <*parameter mangler*>
12 5178 else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
12 5179 res:= -7 <*busnr ulovligt*>
12 5180 else if res=2 or res=6 then
12 5181 begin
13 5182 k:=modiffil(d.vt_op.data(4),indeks,j);
13 5183 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5184 <:io kommando(gruppe-def):>,0);
13 5185 iaf:= 0;
13 5186 fil(j).iaf(1):= værdi(1) +
13 5187 (if res=6 then 1 shift 22 else 0);
13 5188 indeks:= indeks+1;
13 5189 if sep = ',' then res:= 0;
13 5190 end
12 5191 else res:= -27; <*parametertype*>
12 5192 end;
11 5193 if res>0 then pos:= a_pos;
11 5194 until sep<>'sp' or res<=0;
11 5195
11 5195 if res<0 then
11 5196 begin
12 5197 d.op_ref.resultat:= -res;
12 5198 i:=1;
12 5199 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5200 afsluttext(d.op_ref.data,i);
12 5201 end;
11 5202 end;
10 5203 \f
10 5203 message procedure io_komm side 13a - 810512/hko/cl;
10 5204
10 5204 if d.op_ref.resultat > 3 then
10 5205 begin
11 5206 setposition(z_io,0,0);
11 5207 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5208 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5209 goto gr_ann;
11 5210 end;
10 5211 signalbin(bs_fortsæt_adgang);
10 5212 end while sep = ',';
9 5213 d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
9 5214 k:= sætfildim(d.vt_op.data);
9 5215 if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
9 5216 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5217 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5218 d.op_ref.retur:=cs_io_komm;
9 5219 pos:=op_ref;
9 5220 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5221 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5222 <*+4*> if pos<>op_ref then
9 5223 fejlreaktion(11<*fremmed post*>,op_ref,
9 5224 <:io kommando(gruppedef retur fra vt):>,0);
9 5225 <*-4*>
9 5226
9 5226 <*V*> setposition(z_io,0,0);
9 5227 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5228 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5229
9 5229 if false then
9 5230 begin
10 5231 gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5232 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5233 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5234 end;
9 5235
9 5235 end;
8 5236
8 5236 begin
9 5237 \f
9 5237 message procedure io_komm side 14 - 810525/hko/cl;
9 5238
9 5238 <* 7 gruppe(-oversigts-)rapport *>
9 5239
9 5239 d.op_ref.retur:=cs_io_komm;
9 5240 d.op_ref.data(1):=ia(1);
9 5241 indeks:=op_ref;
9 5242 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5243 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5244
9 5244 <*+4*> if op_ref<>indeks then
9 5245 fejlreaktion(11<*fremmed post*>,op_ref,
9 5246 <:io-kommando(gruppe-rapport):>,0);
9 5247 <*-4*>
9 5248
9 5248 <*V*> setposition(z_io,0,0);
9 5249 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5250 if d.op_ref.resultat<>3 then
9 5251 begin
10 5252 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5253 end
9 5254 else
9 5255 begin
10 5256 integer bogst,løb;
10 5257
10 5257 if kode = 27 then <* gruppe,vis *>
10 5258 begin
11 5259 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
11 5260 "G",1,<<z>,d.op_ref.data(1) extract 7,
11 5261 "sp",2,"-",5,"nl",1);
11 5262 \f
11 5262 message procedure io_komm side 15 - 820301/hko;
11 5263
11 5263 for pos:=1 step 1 until d.op_ref.data(2) do
11 5264 begin
12 5265 disable i:=læsfil(d.op_ref.data(3),pos,j);
12 5266 if i<>0 then
12 5267 fejlreaktion(5<*læsfil*>,i,
12 5268 <:io_kommando(gruppe,vis):>,0);
12 5269 iaf:=0;
12 5270 vogn:=fil(j).iaf(1);
12 5271 if vogn shift(-22) =0 then
12 5272 write(z_io,<<ddddddd>,vogn extract 14)
12 5273 else
12 5274 begin
13 5275 løb:=vogn extract 7;
13 5276 bogst:=vogn shift(-7) extract 5;
13 5277 if bogst>0 then bogst:=bogst+'A'-1;
13 5278 ll:=vogn shift(-12) extract 10;
13 5279 write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5280 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5281 end;
12 5282 if pos mod 8 =0 then outchar(z_io,'nl')
12 5283 else write(z_io,"sp",2);
12 5284 end;
11 5285 write(z_io,"*",1);
11 5286 \f
11 5286 message procedure io_komm side 16 - 810512/hko/cl;
11 5287
11 5287 end
10 5288 else if kode=28 then <* gruppe,oversigt *>
10 5289 begin
11 5290 write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
11 5291 "sp",2,"-",5,"nl",2);
11 5292 for pos:=1 step 1 until d.op_ref.data(1) do
11 5293 begin
12 5294 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5295 if i<>0 then
12 5296 fejlreaktion(5<*læsfil*>,i,
12 5297 <:io-kommando(gruppe-oversigt):>,0);
12 5298 iaf:=0;
12 5299 ll:=fil(j).iaf(1);
12 5300 write(z_io,"G",1,<<z>,true,3,ll extract 7);
12 5301 if pos mod 10 =0 then outchar(z_io,'nl')
12 5302 else write(z_io,"sp",3);
12 5303 end;
11 5304 write(z_io,"*",1);
11 5305 end;
10 5306 <* slet fil *>
10 5307 d.op_ref.opkode:= 104;
10 5308 d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
10 5309 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5310 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5311 end; <* resultat=3 *>
9 5312
9 5312 end;
8 5313
8 5313 begin
9 5314 \f
9 5314 message procedure io_komm side 17 - 810525/cl;
9 5315
9 5315 <* 8 spring(-oversigts-)rapport *>
9 5316
9 5316 d.op_ref.retur:=cs_io_komm;
9 5317 tofrom(d.op_ref.data,ia,4);
9 5318 indeks:=op_ref;
9 5319 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5320 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5321
9 5321 <*+4*> if op_ref<>indeks then
9 5322 fejlreaktion(11<*fremmed post*>,op_ref,
9 5323 <:io-kommando(spring-rapport):>,0);
9 5324 <*-4*>
9 5325
9 5325 <*V*> setposition(z_io,0,0);
9 5326 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5327 if d.op_ref.resultat<>3 then
9 5328 begin
10 5329 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5330 end
9 5331 else
9 5332 begin
10 5333 boolean p_skrevet;
10 5334 integer bogst,løb;
10 5335
10 5335 if kode = 32 then <* spring,vis *>
10 5336 begin
11 5337 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 5338 bogst:= d.op_ref.data(1) extract 5;
11 5339 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 5340 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
11 5341 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 5342 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 5343 raf:= data+8;
11 5344 if d.op_ref.raf(1)<>0.0 then
11 5345 write(z_io,<:, startet :>,<<zddddd>,round
11 5346 systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 5347 else
11 5348 write(z_io,<:, ikke startet:>);
11 5349 write(z_io,"sp",2,"-",5,"nl",1);
11 5350 \f
11 5350 message procedure io_komm side 18 - 810518/cl;
11 5351
11 5351 p_skrevet:= false;
11 5352 for pos:=1 step 1 until d.op_ref.data(3) do
11 5353 begin
12 5354 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 5355 if i<>0 then
12 5356 fejlreaktion(5<*læsfil*>,i,
12 5357 <:io_kommando(spring,vis):>,0);
12 5358 iaf:=0;
12 5359 i:= fil(j).iaf(1);
12 5360 if i < 0 and -, p_skrevet then
12 5361 begin
13 5362 outchar(z_io,'('); p_skrevet:= true;
13 5363 end;
12 5364 if i > 0 and p_skrevet then
12 5365 begin
13 5366 outchar(z_io,')'); p_skrevet:= false;
13 5367 end;
12 5368 if pos mod 2 = 0 then
12 5369 write(z_io,<< dd>,abs i,<:.:>)
12 5370 else
12 5371 write(z_io,true,3,<<d>,abs i);
12 5372 if pos mod 21 = 0 then outchar(z_io,'nl');
12 5373 end;
11 5374 write(z_io,"*",1);
11 5375 \f
11 5375 message procedure io_komm side 19 - 810525/cl;
11 5376
11 5376 end
10 5377 else if kode=33 then <* spring,oversigt *>
10 5378 begin
11 5379 write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
11 5380 "sp",2,"-",5,"nl",2);
11 5381 for pos:=1 step 1 until d.op_ref.data(1) do
11 5382 begin
12 5383 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5384 if i<>0 then
12 5385 fejlreaktion(5<*læsfil*>,i,
12 5386 <:io-kommando(spring-oversigt):>,0);
12 5387 iaf:=0;
12 5388 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 5389 bogst:=fil(j).iaf(1) extract 5;
12 5390 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 5391 write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 5392 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 5393 string (extend fil(j).iaf(2) shift 24));
12 5394 if fil(j,2)<>0.0 then
12 5395 write(z_io,<:startet :>,<<zddddd>,
12 5396 round systime(4,fil(j,2),r),<:.:>,round r);
12 5397 outchar(z_io,'nl');
12 5398 end;
11 5399 write(z_io,"*",1);
11 5400 end;
10 5401 <* slet fil *>
10 5402 d.op_ref.opkode:= 104;
10 5403 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 5404 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5405 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5406 end; <* resultat=3 *>
9 5407
9 5407 end;
8 5408
8 5408 begin
9 5409 \f
9 5409 message procedure io_komm side 20 - 820302/hko;
9 5410
9 5410 <* 9 fordeling af linier/områder på operatører *>
9 5411
9 5411 d.op_ref.retur:=cs_io_komm;
9 5412 disable
9 5413 if kode=5 then
9 5414 begin
10 5415 integer array io_linietabel(1:max_linienr//3+1);
10 5416
10 5416 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5417 begin
11 5418 i:= læs_fil(1035,ref//512+1,j);
11 5419 if i <> 0 then
11 5420 fejlreaktion(5,i,<:liniefordelingstabel:>,0);
11 5421 tofrom(io_linietabel.ref,fil(j),
11 5422 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
11 5423 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
11 5424 end;
10 5425 ref:=0;
10 5426 operatør:=ia(1);
10 5427 for j:=2 step 1 until indeks do
10 5428 begin
11 5429 ll:=ia(j);
11 5430 if ll<>0 then
11 5431 skrivtegn(io_linietabel,abs(ll)+1,
11 5432 if ll>0 then operatør else 0);
11 5433 end;
10 5434 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5435 begin
11 5436 i:= skriv_fil(1035,ref//512+1,j);
11 5437 if i <> 0 then
11 5438 fejlreaktion(6,i,<:liniefordelingstabel:>,0);
11 5439 tofrom(fil(j),io_linietabel.ref,
11 5440 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
11 5441 then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
11 5442 );
11 5443 end;
10 5444 ref:=0;
10 5445 end
9 5446 else
9 5447 begin
10 5448 modiffil(1034,1,i);
10 5449 ref:=0;
10 5450 operatør:=ia(1);
10 5451 for j:=2 step 1 until indeks do
10 5452 begin
11 5453 ll:=ia(j);
11 5454 fil(i).ref(ll):= if ll>0 then operatør else 0;
11 5455 end;
10 5456 end;
9 5457 indeks:=op_ref;
9 5458 signal_ch(cs_rad,op_ref,gen_optype or io_optype);
9 5459 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
9 5460
9 5460 <*+4*> if op_ref<>indeks then
9 5461 fejlreaktion(11<*fr.post*>,op_ref,
9 5462 <:io-komm,liniefordeling retur fra rad:>,0);
9 5463 <*-4*>
9 5464
9 5464 <*V*> setposition(z_io,0,0);
9 5465 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5466 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5467
9 5467 end;
8 5468
8 5468 begin
9 5469 \f
9 5469 message procedure io_komm side 21 - 820301/cl;
9 5470
9 5470 <* 10 springdefinition *>
9 5471
9 5471 tofrom(d.op_ref.data,ia,indeks*2);
9 5472 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5473 start_operation(vt_op,101,cs_io_komm,
9 5474 101<*opret fil*>);
9 5475 d.vt_op.data(1):=128;<*postantal*>
9 5476 d.vt_op.data(2):=2; <*postlængde*>
9 5477 d.vt_op.data(3):=1; <*segmentantal*>
9 5478 d.vt_op.data(4):=
9 5479 2 shift 10; <*spool fil*>
9 5480 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5481 pos:=vt_op;<*variabel lånes*>
9 5482 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5483 <*+4*> if vt_op<>pos then
9 5484 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 5485 if d.vt_op.data(9)<>0 then
9 5486 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5487 <:io-kommando(springdefinition):>,0);
9 5488 <*-4*>
9 5489 iaf:=0;
9 5490 for i:=1 step 1 until indeks-2 do
9 5491 begin
10 5492 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5493 if k<>0 then
10 5494 fejlreaktion(7<*modif-fil*>,k,
10 5495 <:io kommando(spring-def):>,0);
10 5496 fil(j).iaf(1):=d.op_ref.data(i+2);
10 5497 end;
9 5498 while sep = ',' do
9 5499 begin
10 5500 wait(bs_fortsæt_adgang);
10 5501 pos:= 1; j:= 0;
10 5502 while læs_store(z_io,i) < 8 do
10 5503 begin
11 5504 skrivtegn(fortsæt,pos,i);
11 5505 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5506 end;
10 5507 skrivtegn(fortsæt,pos,'em');
10 5508 afsluttext(fortsæt,pos);
10 5509 sluttegn:= i;
10 5510 if j<>0 then
10 5511 begin
11 5512 setposition(z_io,0,0);
11 5513 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5514 skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
11 5515 goto sp_ann;
11 5516 end;
10 5517 \f
10 5517 message procedure io_komm side 22 - 810519/cl;
10 5518
10 5518 disable begin
11 5519 integer array værdi(1:4);
11 5520 integer a_pos,res;
11 5521 pos:= 0;
11 5522 repeat
11 5523 apos:= pos;
11 5524 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5525 if res >= 0 then
11 5526 begin
12 5527 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5528 else if res=0 then res:= -25 <*parameter mangler*>
12 5529 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 5530 res:= -44 <*intervalstørrelse ulovlig*>
12 5531 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 5532 res:= -6 <*løbnr ulovligt*>
12 5533 else if res=10 then
12 5534 begin
13 5535 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 5536 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5537 <:io kommando(spring-def):>,0);
13 5538 iaf:= 0;
13 5539 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 5540 indeks:= indeks+1;
13 5541 if sep = ',' then res:= 0;
13 5542 end
12 5543 else res:= -27; <*parametertype*>
12 5544 end;
11 5545 if res>0 then pos:= a_pos;
11 5546 until sep<>'sp' or res<=0;
11 5547
11 5547 if res<0 then
11 5548 begin
12 5549 d.op_ref.resultat:= -res;
12 5550 i:=1;
12 5551 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5552 afsluttext(d.op_ref.data,i);
12 5553 end;
11 5554 end;
10 5555 \f
10 5555 message procedure io_komm side 23 - 810519/cl;
10 5556
10 5556 if d.op_ref.resultat > 3 then
10 5557 begin
11 5558 setposition(z_io,0,0);
11 5559 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5560 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5561 goto sp_ann;
11 5562 end;
10 5563 signalbin(bs_fortsæt_adgang);
10 5564 end while sep = ',';
9 5565 d.vt_op.data(1):= indeks-2;
9 5566 k:= sætfildim(d.vt_op.data);
9 5567 if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
9 5568 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5569 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5570 d.op_ref.retur:=cs_io_komm;
9 5571 pos:=op_ref;
9 5572 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5573 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5574 <*+4*> if pos<>op_ref then
9 5575 fejlreaktion(11<*fremmed post*>,op_ref,
9 5576 <:io kommando(springdef retur fra vt):>,0);
9 5577 <*-4*>
9 5578
9 5578 <*V*> setposition(z_io,0,0);
9 5579 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5580 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5581
9 5581 if false then
9 5582 begin
10 5583 sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5584 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5585 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5586 signalbin(bs_fortsæt_adgang);
10 5587 end;
9 5588
9 5588 end;
8 5589 begin
9 5590 integer i,j,k,opr,lin,max_lin;
9 5591 boolean o_ud, t_ud;
9 5592 \f
9 5592 message procedure io_komm side 23a - 820301/cl;
9 5593
9 5593 <* 11 fordelingsrapport *>
9 5594
9 5594 <*V*> setposition(z_io,0,0);
9 5595 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5596
9 5596 max_lin:= max_linienr;
9 5597 for opr:= 1 step 1 until max_antal_operatører, 0 do
9 5598 begin
10 5599 o_ud:= t_ud:= false;
10 5600 k:= 0;
10 5601
10 5601 if opr<>0 then
10 5602 begin
11 5603 j:= k:= 0;
11 5604 for lin:= 1 step 1 until max_lin do
11 5605 begin
12 5606 læs_tegn(radio_linietabel,lin+1,i);
12 5607 if i<>0 then j:= lin;
12 5608 if opr=i and opr<>0 then
12 5609 begin
13 5610 if -, o_ud then
13 5611 begin
14 5612 o_ud:= true;
14 5613 if opr<>0 then
14 5614 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
14 5615 "sp",2,string bpl_navn(opr))
14 5616 else
14 5617 write(z_io,"nl",1,<:ikke fordelte:>);
14 5618 end;
13 5619 if -, t_ud then
13 5620 begin
14 5621 write(z_io,<:<'nl'> linier: :>);
14 5622 t_ud:= true;
14 5623 end;
13 5624 k:=k+1;
13 5625 if k>1 and k mod 10 = 1 then
13 5626 write(z_io,"nl",1,"sp",13);
13 5627 write(z_io,<<ddd >,lin);
13 5628 end;
12 5629 if lin=max_lin then max_lin:= j;
12 5630 end;
11 5631 end;
10 5632
10 5632 k:= 0; t_ud:= false;
10 5633 for i:= 1 step 1 until max_antal_områder do
10 5634 begin
11 5635 if radio_områdetabel(i)= opr then
11 5636 begin
12 5637 if -, o_ud then
12 5638 begin
13 5639 o_ud:= true;
13 5640 if opr<>0 then
13 5641 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
13 5642 "sp",2,string bpl_navn(opr))
13 5643 else
13 5644 write(z_io,"nl",1,<:ikke fordelte:>);
13 5645 end;
12 5646 if -, t_ud then
12 5647 begin
13 5648 write(z_io,<:<'nl'> områder: :>);
13 5649 t_ud:= true;
13 5650 end;
12 5651 k:= k+1;
12 5652 if k>1 and k mod 10 = 1 then
12 5653 write(z_io,"nl",1,"sp",13);
12 5654 write(z_io,true,4,string område_navn(i));
12 5655 end;
11 5656 end;
10 5657 if o_ud then write(z_io,"nl",1);
10 5658 end;
9 5659 write(z_io,"*",1);
9 5660 end;
8 5661
8 5661 begin
9 5662 integer omr,typ,sum;
9 5663 integer array ialt(1:5);
9 5664 real r;
9 5665 \f
9 5665 message procedure io_komm side 24 - 810501/hko;
9 5666
9 5666 <* 12 vis/nulstil opkaldstællere *>
9 5667
9 5667
9 5667 if kode=76 and indeks=1 then
9 5668 begin <* TÆ,N <tid> *>
10 5669 if ia(1)<(-1) or 2400<ia(1) then
10 5670 begin
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,64);
11 5674 end
10 5675 else
10 5676 begin
11 5677 if ia(1)=(-1) then nulstil_systællere:= -1
11 5678 else nulstil_systællere:= (ia(1) mod 2400)*100;
11 5679 opdater_tf_systællere;
11 5680 typ:= opref; <* typ lånes til gemmevariabel *>
11 5681 d.opref.retur:= cs_io_komm;
11 5682 signal_ch(cs_io_nulstil,opref,io_optype);
11 5683 <*V*> wait_ch(cs_io_komm,opref,io_optype,-1);
11 5684 <*+4*> if opref <> typ then
11 5685 fejlreaktion(11<*fremmed post*>,opref,
11 5686 <:io_kommando:>,0);
11 5687 <*-4*>
11 5688 setposition(z_io,0,0);
11 5689 if sluttegn<>'nl' then outchar(z_io,'nl');
11 5690 skriv_kvittering(z_io,opref,-1,3);
11 5691 end;
10 5692 end
9 5693 else
9 5694 begin
10 5695 setposition(z_io,0,0);
10 5696 if sluttegn<>'nl' then outchar(z_io,'nl');
10 5697 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5698
10 5698 write(z_io,
10 5699 <:område udgående alm.ind nød ind:>,
10 5700 <: ind-ialt total ej forb. optaget:>,"nl",1);
10 5701 for omr := 1 step 1 until max_antal_områder do
10 5702 begin
11 5703 sum:= 0;
11 5704 write(z_io,true,6,string område_navn(omr),":",1);
11 5705 for typ:= 1 step 1 until 3 do
11 5706 begin
12 5707 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5708 sum:= sum + opkalds_tællere((omr-1)*5+typ);
12 5709 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5710 end;
11 5711 write(z_io,<< ddddddd>,
11 5712 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
11 5713 for typ:= 4 step 1 until 5 do
11 5714 begin
12 5715 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
12 5716 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
12 5717 end;
11 5718 write(z_io,"nl",1);
11 5719 end;
10 5720 sum:= 0;
10 5721 write(z_io,"nl",1,<:ialt ::>);
10 5722 for typ:= 1 step 1 until 3 do
10 5723 begin
11 5724 write(z_io,<< ddddddd>,ialt(typ));
11 5725 sum:= sum+ialt(typ);
11 5726 end;
10 5727 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5728 ialt(4), ialt(5), "nl",3);
10 5729
10 5729 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
10 5730 write(z_io,
10 5731 <:oper. udgående alm.ind nød ind:>,
10 5732 <: ind-ialt total ej forb. optaget:>,"nl",1);
10 5733 for omr := 1 step 1 until max_antal_operatører do
10 5734 begin
11 5735 sum:= 0;
11 5736 if bpl_navn(omr)=long<::> then
11 5737 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
11 5738 else
11 5739 write(z_io,true,6,string bpl_navn(omr),":",1);
11 5740 for typ:= 1 step 1 until 3 do
11 5741 begin
12 5742 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*4+typ));
12 5743 sum:= sum + operatør_tællere((omr-1)*5+typ);
12 5744 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5745 end;
11 5746 write(z_io,<< ddddddd>,
11 5747 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
11 5748 for typ:= 4 step 1 until 5 do
11 5749 begin
12 5750 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
12 5751 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
12 5752 end;
11 5753 write(z_io,"nl",1);
11 5754 end;
10 5755 sum:= 0;
10 5756 write(z_io,"nl",1,<:ialt ::>);
10 5757 for typ:= 1 step 1 until 3 do
10 5758 begin
11 5759 write(z_io,<< ddddddd>,ialt(typ));
11 5760 sum:= sum+ialt(typ);
11 5761 end;
10 5762 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
10 5763 ialt(4),ialt(5),"nl",2);
10 5764
10 5764 typ:= replacechar(1,':');
10 5765 write(z_io,<:tællere nulstilles :>);
10 5766 if nulstil_systællere=(-1) then
10 5767 write(z_io,<:ikke automatisk:>,"nl",1)
10 5768 else
10 5769 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
10 5770 nulstil_systællere,"nl",1);
10 5771 replacechar(1,'.');
10 5772 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
10 5773 systime(4,systællere_nulstillet,r));
10 5774 replacechar(1,':');
10 5775 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
10 5776 replacechar(1,typ);
10 5777 write(z_io,"*",1,"nl",1);
10 5778 setposition(z_io,0,0);
10 5779
10 5779 if kode = 76 <* nulstil tællere *> then
10 5780 disable begin
11 5781 for omr:= 1 step 1 until max_antal_områder*5 do
11 5782 opkalds_tællere(omr):= 0;
11 5783 for omr:= 1 step 1 until max_antal_operatører*5 do
11 5784 operatør_tællere(omr):= 0;
11 5785 systime(1,0.0,systællere_nulstillet);
11 5786 opdater_tf_systællere;
11 5787 typ:= replacechar(1,'.');
11 5788 write(z_io,<:!!! tællere nulstillet d. :>,<<zd dd dd>,
11 5789 systime(4,systællere_nulstillet,r));
11 5790 replacechar(1,':');
11 5791 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
11 5792 replacechar(1,typ);
11 5793 setposition(z_io,0,0);
11 5794 end;
10 5795 end;
9 5796 end;
8 5797
8 5797 begin
9 5798 \f
9 5798 message procedure io_komm side 25 - 940522/cl;
9 5799
9 5799 <* 13 navngiv betjeningsplads *>
9 5800 boolean incl;
9 5801 long field lf;
9 5802
9 5802 lf:=6;
9 5803 operatør:= ia(1);
9 5804 navn:= ia.lf;
9 5805 incl:= false add (ia(4) extract 8);
9 5806
9 5806 if navn=long<::> then
9 5807 begin
10 5808 <* nedlæg navn - check for i brug *>
10 5809 iaf:= operatør*terminal_beskr_længde;
10 5810 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5811 d.opref.resultat:= 48 <*i brug*>
10 5812 else
10 5813 begin
11 5814 for i:= 65 step 1 until top_bpl_gruppe do
11 5815 begin
12 5816 iaf:= i*op_maske_lgd;
12 5817 if læsbit_ia(bpl_def.iaf,operatør) then
12 5818 d.opref.resultat:= 48<*i brug*>;
12 5819 end;
11 5820 end;
10 5821 if d.opref.resultat <= 3 then
10 5822 begin
11 5823 for i:= 1 step 1 until sidste_bus do
11 5824 if bustabel(i) shift (-14) extract 8 = operatør then
11 5825 d.opref.resultat:= 48<*i brug*>;
11 5826 end;
10 5827 end
9 5828 else
9 5829 begin
10 5830 <* opret/omdøb *>
10 5831 i:= find_bpl(navn);
10 5832 if i<>0 and i<>operatør then
10 5833 d.opref.resultat:= 48 <*i brug*>;
10 5834 end;
9 5835 if d.opref.resultat<=3 then
9 5836 begin
10 5837 bpl_navn(operatør):= navn;
10 5838 operatør_auto_include(operatør):= incl;
10 5839 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5840 if k<>0 then
10 5841 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5842 lf:= 4;
10 5843 fil(ll).lf:= navn add (incl extract 8);
10 5844 setposition(fil(ll),0,0);
10 5845
10 5845 <* skriv bplnavne *>
10 5846 disable begin
11 5847 zone z(128,1,stderror);
11 5848 long array field laf;
11 5849 integer array ia(1:10);
11 5850
11 5850 open(z,4,<:bplnavne:>,0);
11 5851 laf:= 0;
11 5852 outrec6(z,512);
11 5853 for i:= 1 step 1 until 127 do
11 5854 z.laf(i):= bpl_navn(i);
11 5855 close(z,true);
11 5856 monitor(42,z,0,ia);
11 5857 ia(6):= systime(7,0,0.0);
11 5858 monitor(44,z,0,ia);
11 5859 end;
10 5860 d.opref.resultat:= 3;<*udført*>
10 5861 end;
9 5862
9 5862 setposition(z_io,0,0);
9 5863 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5864 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5865 end;
8 5866
8 5866 begin
9 5867 \f
9 5867 message procedure io_komm side 26 - 940522/cl;
9 5868
9 5868 <* 14 betjeningsplads - gruppe *>
9 5869 integer ant_i_gruppe;
9 5870 long field lf;
9 5871 integer array maske(1:op_maske_lgd//2);
9 5872
9 5872 lf:= 4; ant_i_gruppe:= 0;
9 5873 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5874 navn:= ia.lf;
9 5875 operatør:= find_bpl(navn);
9 5876 for i:= 3 step 1 until indeks do
9 5877 if sætbit_ia(maske,ia(i),1)=0 then
9 5878 ant_i_gruppe:= ant_i_gruppe+1;
9 5879 if ant_i_gruppe=0 then
9 5880 begin
10 5881 <* slet gruppe *>
10 5882 if operatør<=64 then
10 5883 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5884 else 62<*navn ulovligt*>)
10 5885 else
10 5886 begin
11 5887 for i:= 1 step 1 until max_antal_operatører do
11 5888 for j:= 1 step 1 until 3 do
11 5889 if operatør_stop(i,j)=operatør then
11 5890 d.opref.resultat:= 48<*i brug*>;
11 5891 end;
10 5892 navn:= long<::>;
10 5893 end
9 5894 else
9 5895 begin
10 5896 if 1<=operatør and operatør<=64 then
10 5897 d.opref.resultat:= 62<*navn ulovligt*>
10 5898 else
10 5899 if operatør=0 then
10 5900 begin
11 5901 i:=65;
11 5902 while i<=127 and operatør=0 do
11 5903 begin
12 5904 if bpl_navn(i)=long<::> then operatør:=i;
12 5905 i:= i+1;
12 5906 end;
11 5907 if operatør=0 then
11 5908 d.opref.resultat:= 32<*ikke plads*>
11 5909 else if operatør>top_bpl_gruppe then
11 5910 top_bpl_gruppe:= operatør;
11 5911 end;
10 5912 end;
9 5913 if d.opref.resultat<=3 then
9 5914 begin
10 5915 bpl_navn(operatør):= navn;
10 5916 iaf:= operatør*op_maske_lgd;
10 5917 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5918 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5919 for i:= 1 step 1 until max_antal_operatører do
10 5920 begin
11 5921 if læsbit_ia(maske,i) then
11 5922 begin
12 5923 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5924 if læsbit_ia(operatør_maske,i) then
12 5925 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5926 end;
11 5927 end;
10 5928 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5929 if k<>0 then
10 5930 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5931 lf:= 4;
10 5932 fil(ll).lf:= navn;
10 5933 setposition(fil(ll),0,0);
10 5934 iaf:= 0;
10 5935 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5936 if k<>0 then
10 5937 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5938 for i:= 1 step 1 until op_maske_lgd//2 do
10 5939 fil(ll).iaf(i):= maske(i);
10 5940 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5941 setposition(fil(ll),0,0);
10 5942 d.opref.resultat:= 3;
10 5943 end;
9 5944
9 5944 setposition(z_io,0,0);
9 5945 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5946 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5947 end;
8 5948
8 5948 begin
9 5949 \f
9 5949 message procedure io_komm side 27 - 940522/cl;
9 5950
9 5950 <* 15 vis betjeningspladsdefinitioner *>
9 5951
9 5951 setposition(z_io,0,0);
9 5952 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5953 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5954 for i:= 1 step 1 until max_antal_operatører do
9 5955 begin
10 5956 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5957 case operatør_auto_include(i) extract 2 + 1 of(
10 5958 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5959 if i mod 4 = 0 then write(z_io,"nl",1)
10 5960 else write(z_io,"sp",5);
10 5961 end;
9 5962 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5963 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5964 for i:= 65 step 1 until top_bpl_gruppe do
9 5965 begin
10 5966 ll:=0; iaf:= i*op_maske_lgd;
10 5967 if bpl_navn(i)<>long<::> then
10 5968 begin
11 5969 write(z_io,true,6,string bpl_navn(i),":",1);
11 5970 for j:= 1 step 1 until max_antal_operatører do
11 5971 begin
12 5972 if læsbit_ia(bpl_def.iaf,j) then
12 5973 begin
13 5974 if ll mod 8 = 0 and ll<>0 then
13 5975 write(z_io,"nl",1,"sp",7);
13 5976 write(z_io,"sp",2,string bpl_navn(j));
13 5977 ll:=ll+1;
13 5978 end;
12 5979 end;
11 5980 write(z_io,"nl",1);
11 5981 end;
10 5982 end;
9 5983 write(z_io,"*",1);
9 5984 end;
8 5985
8 5985 begin
9 5986 \f
9 5986 message procedure io_komm side 28 - 940522/cl;
9 5987
9 5987 <* 16 stopniveau,definer *>
9 5988
9 5988 operatør:= ia(1);
9 5989 iaf:= operatør*terminal_beskr_længde;
9 5990 for i:= 1 step 1 until 3 do
9 5991 operatør_stop(operatør,i):= ia(i+1);
9 5992 if -,læsbit_ia(operatørmaske,operatør) then
9 5993 begin
10 5994 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5995 signal_bin(bs_mobilopkald);
10 5996 end;
9 5997 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5998 if k<>0 then
9 5999 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 6000 iaf:= 0;
9 6001 for i:= 0 step 1 until 3 do
9 6002 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 6003 setposition(fil(ll),0,0);
9 6004 setposition(z_io,0,0);
9 6005 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6006 skriv_kvittering(z_io,0,-1,3);
9 6007 end;
8 6008
8 6008 begin
9 6009 \f
9 6009 message procedure io_komm side 29 - 940522/cl;
9 6010
9 6010 <* 17 stopniveauer,vis *>
9 6011
9 6011 setposition(z_io,0,0);
9 6012 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6013
9 6013 for operatør:= 1 step 1 until max_antal_operatører do
9 6014 begin
10 6015 iaf:=operatør*terminal_beskr_længde;
10 6016 ll:=0;
10 6017 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6018 string bpl_navn(operatør),<:(:>,
10 6019 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 6020 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 6021 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 6022 for i:= 1 step 1 until 3 do
10 6023 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 6024 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 6025 else string bpl_navn(operatør_stop(operatør,i)));
10 6026 if operatør mod 2 = 1 then
10 6027 write(z_io,"sp",40-ll)
10 6028 else
10 6029 write(z_io,"nl",1);
10 6030 end;
9 6031 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6032 write(z_io,"*",1);
9 6033 end;
8 6034
8 6034 begin
9 6035 \f
9 6035 message procedure io_komm side 30 - 941007/cl;
9 6036
9 6036 <* 18 alarmlængder *>
9 6037
9 6037 setposition(z_io,0,0);
9 6038 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6039
9 6039 for operatør:= 1 step 1 until max_antal_operatører do
9 6040 begin
10 6041 ll:=0;
10 6042 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 6043 string bpl_navn(operatør));
10 6044 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 6045 if opk_alarm.iaf.alarm_lgd < 0 then
10 6046 ll:= ll+write(z_io,<:uendelig:>)
10 6047 else
10 6048 ll:= ll+write(z_io,<<ddddddd>,
10 6049 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 6050
10 6050 if operatør mod 2 = 1 then
10 6051 write(z_io,"sp",40-ll)
10 6052 else
10 6053 write(z_io,"nl",1);
10 6054 end;
9 6055 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 6056 write(z_io,"*",1);
9 6057 end;
8 6058
8 6058 begin
9 6059 <* 19 CC *>
9 6060 integer i, c;
9 6061
9 6061 i:= 1;
9 6062 while læstegn(ia,i+0,c)<>0 and
9 6063 i<(op_spool_postlgd-op_spool_text)//2*3
9 6064 do skrivtegn(d.opref.data,i,c);
9 6065 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 6066
9 6066 d.opref.retur:= cs_io_komm;
9 6067 signalch(cs_op,opref,io_optype or gen_optype);
9 6068 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 6069
9 6069 setposition(z_io,0,0);
9 6070 if sluttegn<>'nl' then outchar(z_io,'nl');
9 6071 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 6072 end;
8 6073
8 6073 begin
9 6074 <* 20: CQF,I CQF,U CQF,V *>
9 6075 integer kode, res, i, j;
9 6076 integer array field iaf, iaf1;
9 6077 long field navn;
9 6078
9 6078 kode:= d.opref.opkode extract 12;
9 6079 navn:= 6; res:= 0;
9 6080 if kode=90 <*CQF,I*> then
9 6081 begin
10 6082 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 6083 res:= 10 <*busnr ukendt*>
10 6084 else
10 6085 begin
11 6086 j:= -1;
11 6087 for i:= 1 step 1 until max_cqf do
11 6088 begin
12 6089 iaf:= (i-1)*cqf_lgd;
12 6090 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 6091 ia.navn = cqf_tabel.iaf.cqf_id
12 6092 then res:= 48; <*i brug*>
12 6093 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 6094 end;
11 6095 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 6096 if res=0 then
11 6097 begin
12 6098 iaf:= (j-1)*cqf_lgd;
12 6099 cqf_tabel.iaf.cqf_bus:= ia(1);
12 6100 cqf_tabel.iaf.cqf_fejl:= 0;
12 6101 cqf_tabel.iaf.cqf_id:= ia.navn;
12 6102 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 6103 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 6104 res:= 3;
12 6105 end;
11 6106 end;
10 6107 setposition(z_io,0,0);
10 6108 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6109 skriv_kvittering(z_io,opref,-1,res);
10 6110 end
9 6111 else
9 6112 if kode=91 <*CQF,U*> then
9 6113 begin
10 6114 j:= -1;
10 6115 for i:= 1 step 1 until max_cqf do
10 6116 begin
11 6117 iaf:= (i-1)*cqf_lgd;
11 6118 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 6119 end;
10 6120 if j>=0 then
10 6121 begin
11 6122 iaf:= (j-1)*cqf_lgd;
11 6123 for i:= 1 step 1 until cqf_lgd//2 do
11 6124 cqf_tabel.iaf(i):= 0;
11 6125 res:= 3;
11 6126 end
10 6127 else res:= 13; <*bus ikke indsat*>
10 6128 setposition(z_io,0,0);
10 6129 if sluttegn<>'nl' then outchar(z_io,'nl');
10 6130 skriv_kvittering(z_io,opref,-1,res);
10 6131 end
9 6132 else
9 6133 begin
10 6134 setposition(z_io,0,0);
10 6135 skriv_cqf_tabel(z_io,false);
10 6136 outchar(z_io,'*');
10 6137 setposition(z_io,0,0);
10 6138 end;
9 6139
9 6139 if kode=90 or kode=91 then
9 6140 begin
10 6141 j:= skrivfil(1033,1,i);
10 6142 if j<>0 then
10 6143 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 6144 for k:= 1 step 1 until max_cqf do
10 6145 begin
11 6146 iaf1:= (k-1)*cqf_lgd;
11 6147 iaf := (k-1)*cqf_id;
11 6148 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 6149 end;
10 6150 op_cqf_tab_ændret:= true;
10 6151 end;
9 6152 end;<*CQF*>
8 6153
8 6153
8 6153 begin
9 6154 \f
9 6154 message procedure io_komm side xx - 940522/cl;
9 6155
9 6155
9 6155
9 6155 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 6156 <*-3*>
9 6157 end
8 6158 end;<*case j *>
7 6159 end <* j > 0 *>
6 6160 else
6 6161 begin
7 6162 <*V*> setposition(z_io,0,0);
7 6163 if sluttegn<>'nl' then outchar(z_io,'nl');
7 6164 skriv_kvittering(z_io,op_ref,-1,
7 6165 45 <* ikke implementeret *>);
7 6166 end;
6 6167 end;<* godkendt *>
5 6168
5 6168 <*V*> setposition(z_io,0,0);
5 6169 signal_bin(bs_zio_adgang);
5 6170 d.op_ref.retur:=cs_att_pulje;
5 6171 disable afslut_kommando(op_ref);
5 6172 end; <* indlæs kommando *>
4 6173
4 6173 begin
5 6174 \f
5 6174 message procedure io_komm side xx+1 - 810428/hko;
5 6175
5 6175 <* 2: aktiver efter stop *>
5 6176 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 6177 terminal_tab.ref.terminal_tilstand extract 21;
5 6178 afslut_operation(op_ref,-1);
5 6179 signal_bin(bs_zio_adgang);
5 6180 end;
4 6181
4 6181 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6182 <*-3*>
4 6183 end; <* case aktion+6 *>
3 6184
3 6184 until false;
3 6185 io_komm_trap:
3 6186 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6187 alarmcause extract 24 = (-13)) then
3 6188 disable skriv_io_komm(zbillede,1);
3 6189 end io_komm;
2 6190 \f
2 6190 message procedure io_spool side 1 - 810507/hko;
2 6191
2 6191 procedure io_spool;
2 6192 begin
3 6193 integer
3 6194 næste_tomme,nr;
3 6195 integer array field
3 6196 op_ref;
3 6197
3 6197 procedure skriv_io_spool(zud,omfang);
3 6198 value omfang;
3 6199 zone zud;
3 6200 integer omfang;
3 6201 begin
4 6202 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6203 if omfang > 0 then
4 6204 disable begin integer x;
5 6205 trap(slut);
5 6206 write(zud,"nl",1,
5 6207 <: opref: :>,op_ref,"nl",1,
5 6208 <: næstetomme::>,næste_tomme,"nl",1,
5 6209 <: nr :>,nr,"nl",1,
5 6210 <::>);
5 6211 skriv_coru(zud,coru_no(102));
5 6212 slut:
5 6213 end;<*disable*>
4 6214 end skriv_io_spool;
3 6215
3 6215 trap(io_spool_trap);
3 6216 næste_tomme:= 1;
3 6217 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6218 <*+2*>
3 6219 if testbit0 and overvåget or testbit28 then
3 6220 skriv_io_spool(out,0);
3 6221 <*-2*>
3 6222 \f
3 6222 message procedure io_spool side 2 - 810602/hko;
3 6223
3 6223 repeat
3 6224
3 6224 wait_ch(cs_io_spool,
3 6225 op_ref,
3 6226 true,
3 6227 -1<*timeout*>);
3 6228
3 6228 i:= d.op_ref.opkode;
3 6229 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6230 begin
4 6231 wait(ss_io_spool_tomme);
4 6232 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6233 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6234
4 6234 i:= d.op_ref.opsize;
4 6235 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6236 begin
5 6237 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6238 i:= io_spool_postlængde*2 -io_spool_post;
5 6239 end;
4 6240 <*-4*>
4 6241 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6242 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6243 signal(ss_io_spool_fulde);
4 6244 d.op_ref.resultat:= 1;
4 6245 end
3 6246 else
3 6247 begin
4 6248 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6249 <:io_spool_korutine:>,1);
4 6250 end;
3 6251
3 6251 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6252
3 6252 until false;
3 6253
3 6253 io_spool_trap:
3 6254
3 6254 disable skriv_io_spool(zbillede,1);
3 6255 end io_spool;
2 6256 \f
2 6256 message procedure io_spon side 1 - 810507/hko;
2 6257
2 6257 procedure io_spon;
2 6258 begin
3 6259 integer
3 6260 næste_fulde,nr,i,dato,kl;
3 6261 real t;
3 6262
3 6262 procedure skriv_io_spon(zud,omfang);
3 6263 value omfang;
3 6264 zone zud;
3 6265 integer omfang;
3 6266 begin
4 6267 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6268 if omfang > 0 then
4 6269 disable begin integer x;
5 6270 trap(slut);
5 6271 write(zud,"nl",1,
5 6272 <: næste-fulde::>,næste_fulde,"nl",1,
5 6273 <: nr :>,nr,"nl",1,
5 6274 <::>);
5 6275 skriv_coru(zud,coru_no(103));
5 6276 slut:
5 6277 end;<*disable*>
4 6278 end skriv_io_spon;
3 6279
3 6279 trap(io_spon_trap);
3 6280 næste_fulde:= 1;
3 6281 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6282 <*+2*>
3 6283 if testbit0 and overvåget or testbit28 then
3 6284 skriv_io_spon(out,0);
3 6285 <*-2*>
3 6286 \f
3 6286 message procedure io_spon side 2 - 810602/hko/cl;
3 6287
3 6287 repeat
3 6288
3 6288 <*V*> wait(ss_io_spool_fulde);
3 6289 <*V*> wait(bs_zio_adgang);
3 6290
3 6290 <*V*> setposition(zio,0,0);
3 6291
3 6291 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6292 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6293
3 6293 laf:=data;
3 6294 k:= fil(nr).io_spool_post.opkode;
3 6295 if k = 22 or k = 36 then
3 6296 disable begin
4 6297 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6298 if k=36 then
4 6299 begin
5 6300 i:= fil(nr).io_spool_post.data(4);
5 6301 j:= i extract 5;
5 6302 if j<>0 then j:=j+'A'-1;
5 6303 i:= i shift (-5) extract 10;
5 6304 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6305 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6306 end;
4 6307 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6308 fil(nr).io_spool_post.tid)
4 6309 end
3 6310 else if k = 23 then
3 6311 disable
3 6312 begin
4 6313 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6314 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6315 kl:= round t;
4 6316 i:= replace_char(1<*space in number*>,'.');
4 6317 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6318 replace_char(1,i);
4 6319 end
3 6320 else if k = 45 or k = 46 then
3 6321 disable begin
4 6322 integer vogn,linie,bogst,løb,t;
4 6323
4 6323 t:=fil(nr).io_spool_post.data(2);
4 6324 outchar(z_io,'nl');
4 6325 if k = 45 then
4 6326 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6327
4 6327 write(zio,<:nødopkald fra :>);
4 6328 vogn:= fil(nr).io_spool_post.data(1);
4 6329 i:= vogn shift (-22);
4 6330 if i < 2 then
4 6331 skrivid(zio,vogn,9)
4 6332 else
4 6333 begin
5 6334 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6335 write(zio,<:!!!:>,vogn);
5 6336 end;
4 6337 \f
4 6337 message procedure io_spon side 3 - 810507/hko;
4 6338
4 6338 if fil(nr).io_spool_post.data(3)<>0 then
4 6339 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6340
4 6340 if k = 46 then
4 6341 begin
5 6342 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6343 end;
4 6344 end <*disable*>
3 6345 else
3 6346 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6347
3 6347 fil(nr,1):= fil(nr,1) add 1;
3 6348
3 6348 <*V*> setposition(zio,0,0);
3 6349
3 6349 signal_bin(bs_zio_adgang);
3 6350
3 6350 signal(ss_io_spool_tomme);
3 6351
3 6351 until false;
3 6352
3 6352 io_spon_trap:
3 6353 skriv_io_spon(zbillede,1);
3 6354
3 6354 end io_spon;
2 6355 \f
2 6355 message procedure io_medd side 1;
2 6356
2 6356 procedure io_medd;
2 6357 begin
3 6358 integer array field opref;
3 6359 integer afs, kl, i;
3 6360 real dato, t;
3 6361
3 6361
3 6361 procedure skriv_io_medd(zud,omfang);
3 6362 value omfang;
3 6363 zone zud;
3 6364 integer omfang;
3 6365 begin
4 6366 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6367 if omfang > 0 then
4 6368 disable begin integer x;
5 6369 trap(slut);
5 6370 write(zud,"nl",1,
5 6371 <: opref: :>,opref,"nl",1,
5 6372 <: afs: :>,afs,"nl",1,
5 6373 <: kl: :>,kl,"nl",1,
5 6374 <: i: :>,i,"nl",1,
5 6375 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6376 <: t: :>,t,"nl",1,
5 6377 <::>);
5 6378 skriv_coru(zud,coru_no(104));
5 6379 slut:
5 6380 end;<*disable*>
4 6381 end skriv_io_medd;
3 6382
3 6382 trap(io_medd_trap);
3 6383 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6384 <*+2*>
3 6385 if testbit0 and overvåget or testbit28 then
3 6386 skriv_io_medd(out,0);
3 6387 <*-2*>
3 6388 \f
3 6388 message procedure io_medd side 2;
3 6389
3 6389 repeat
3 6390 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6391 <*V*> wait(bs_zio_adgang);
3 6392
3 6392 afs:= d.opref.data.op_spool_kilde;
3 6393 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6394 kl:= round t;
3 6395 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6396 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6397 i:= replacechar(1,'.');
3 6398 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6399 replacechar(1,i);
3 6400 write(z_io,d.opref.data.op_spool_text);
3 6401 setposition(z_io,0,0);
3 6402
3 6402 signalbin(bs_zio_adgang);
3 6403 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6404 until false;
3 6405
3 6405 io_medd_trap:
3 6406 skriv_io_medd(zbillede,1);
3 6407
3 6407 end io_medd;
2 6408
2 6408 procedure io_nulstil_tællere;
2 6409 begin
3 6410 real nu, dato, kl, forr, næste, et_døgn, r;
3 6411 integer array field opref;
3 6412 integer ventetid, omr, typ, sum;
3 6413 integer array ialt(1:5);
3 6414
3 6414 procedure skriv_io_null(zud,omfang);
3 6415 value omfang;
3 6416 zone zud;
3 6417 integer omfang;
3 6418 begin
4 6419 disable write(zud,"nl",1,<:+++ io_nulstil_tællere :>);
4 6420 if omfang > 0 then
4 6421 disable begin real t; real array field raf;
5 6422 raf:=0;
5 6423 trap(slut);
5 6424 write(zud,"nl",1,
5 6425 <: opref: :>,opref,"nl",1,
5 6426 <: ventetid: :>,ventetid,"nl",1,
5 6427 <: omr: :>,omr,"nl",1,
5 6428 <: typ: :>,typ,"nl",1,
5 6429 <: sum: :>,sum,"nl",1);
5 6430 write(zud,
5 6431 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1);
5 6432 write(zud,
5 6433 <: forr: :>,<< zddddd>,systime(4,forr,t),t,"nl",1);
5 6434 write(zud,
5 6435 <: næste: :>,<< zddddd>,systime(4,næste,t),t,"nl",1);
5 6436 write(zud,
5 6437 <: r: :>,<< zddddd>,systime(4,r,t),t,"nl",1,
5 6438 <: dato: :>,dato,"nl",1,
5 6439 <: kl: :>,kl,"nl",1,
5 6440 <: et-døgn: :>,<< dddddd>,et_døgn,"nl",1,
5 6441 <::>);
5 6442 write(zud,"nl",1,<:ialt: :>);
5 6443 skriv_hele(zud,ialt.raf,10,2);
5 6444 skriv_coru(zud,coru_no(105));
5 6445 slut:
5 6446 end;<*disable*>
4 6447 end skriv_io_null;
3 6448
3 6448 trap(io_null_trap);
3 6449 et_døgn:= 24*60*60.0;
3 6450 stack_claim(500);
3 6451 <*+2*>
3 6452 if testbit0 and overvåget or testbit28 then
3 6453 skriv_io_null(out,0);
3 6454 <*-2*>
3 6455 pass;
3 6456
3 6456 systime(1,0.0,nu);
3 6457 dato:= systime(4,nu,kl);
3 6458 if nulstil_systællere >= 0 then
3 6459 begin
4 6460 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6461 + et_døgn
4 6462 else næste:= systid(dato,nulstil_systællere);
4 6463 forr:= næste - et_døgn;
4 6464 if (forr - systællere_nulstillet) > et_døgn then
4 6465 næste:= nu;
4 6466 end;
3 6467
3 6467 repeat
3 6468 ventetid:= (if nulstil_systællere < 0 then (-1) else (næste - nu));
3 6469 <*V*> waitch(cs_io_nulstil,opref,io_optype,ventetid);
3 6470
3 6470 if opref <= 0 then
3 6471 begin
4 6472 <* nulstil opkaldstællere *>
4 6473 wait(bs_zio_adgang);
4 6474 setposition(z_io,0,0);
4 6475
4 6475 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6476
4 6476 write(z_io,"nl",1,<:!TÆ,N (automatisk):>,"nl",2,
4 6477 <:område udgående alm.ind nød ind:>,
4 6478 <: ind-ialt total ej forb. optaget:>,"nl",1);
4 6479 for omr := 1 step 1 until max_antal_områder do
4 6480 begin
5 6481 sum:= 0;
5 6482 write(z_io,true,6,string område_navn(omr),":",1);
5 6483 for typ:= 1 step 1 until 3 do
5 6484 begin
6 6485 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6486 sum:= sum + opkalds_tællere((omr-1)*5+typ);
6 6487 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6488 end;
5 6489 write(z_io,<< ddddddd>,
5 6490 sum-opkalds_tællere((omr-1)*5+1),sum,"sp",2);
5 6491 for typ:= 4 step 1 until 5 do
5 6492 begin
6 6493 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*5+typ));
6 6494 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*5+typ);
6 6495 end;
5 6496 write(z_io,"nl",1);
5 6497 end;
4 6498 sum:= 0;
4 6499 write(z_io,"nl",1,<:ialt ::>);
4 6500 for typ:= 1 step 1 until 3 do
4 6501 begin
5 6502 write(z_io,<< ddddddd>,ialt(typ));
5 6503 sum:= sum+ialt(typ);
5 6504 end;
4 6505 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6506 ialt(4), ialt(5), "nl",3);
4 6507
4 6507 for typ:= 1 step 1 until 5 do ialt(typ):= 0;
4 6508 write(z_io,<:oper. udgående alm.ind nød ind:>,
4 6509 <: ind-ialt total ej forb. optaget:>,"nl",1);
4 6510 for omr := 1 step 1 until max_antal_operatører do
4 6511 begin
5 6512 sum:= 0;
5 6513 if bpl_navn(omr)=long<::> then
5 6514 write(z_io,"sp",6-write(z_io,<:op:>,<<d>,omr),":",1)
5 6515 else
5 6516 write(z_io,true,6,string bpl_navn(omr),":",1);
5 6517 for typ:= 1 step 1 until 3 do
5 6518 begin
6 6519 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
6 6520 sum:= sum + operatør_tællere((omr-1)*5+typ);
6 6521 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6522 end;
5 6523 write(z_io,<< ddddddd>,
5 6524 sum-operatør_tællere((omr-1)*5+1),sum,"sp",2);
5 6525 for typ:= 4 step 1 until 5 do
5 6526 begin
6 6527 write(z_io,<< ddddddd>,operatør_tællere((omr-1)*5+typ));
6 6528 ialt(typ):= ialt(typ)+operatør_tællere((omr-1)*5+typ);
6 6529 end;
5 6530 write(z_io,"nl",1);
5 6531 end;
4 6532 sum:= 0;
4 6533 write(z_io,"nl",1,<:ialt ::>);
4 6534 for typ:= 1 step 1 until 3 do
4 6535 begin
5 6536 write(z_io,<< ddddddd>,ialt(typ));
5 6537 sum:= sum+ialt(typ);
5 6538 end;
4 6539 write(z_io,<< ddddddd>,sum-ialt(1),sum,"sp",2,
4 6540 ialt(4),ialt(5),"nl",2);
4 6541
4 6541 typ:= replacechar(1,':');
4 6542 write(z_io,<:tællere nulstilles :>);
4 6543 if nulstil_systællere=(-1) then
4 6544 write(z_io,<:ikke automatisk:>,"nl",1)
4 6545 else
4 6546 write(z_io,<:automatisk kl. :>,<<zd dd dd>,
4 6547 nulstil_systællere,"nl",1);
4 6548 replacechar(1,'.');
4 6549 write(z_io,<:sidst nulstillet d. :>,<<zd dd dd>,
4 6550 systime(4,systællere_nulstillet,r));
4 6551 replacechar(1,':');
4 6552 write(z_io,<: kl. :>,<<zd dd dd>,r,"nl",1);
4 6553 replacechar(1,typ);
4 6554 write(z_io,"*",1,"nl",1);
4 6555 setposition(z_io,0,0);
4 6556 signal_bin(bs_zio_adgang);
4 6557
4 6557 for omr:= 1 step 1 until max_antal_områder*5 do
4 6558 opkalds_tællere(omr):= 0;
4 6559 for omr:= 1 step 1 until max_antal_operatører*5 do
4 6560 operatør_tællere(omr):= 0;
4 6561 systællere_nulstillet:= næste;
4 6562 opdater_tf_systællere;
4 6563 end
3 6564 else
3 6565 signalch(d.opref.retur,opref,d.opref.optype);
3 6566
3 6566 systime(1,0.0,nu);
3 6567 dato:= systime(4,nu,kl);
3 6568 if nulstil_systællere >= 0 then
3 6569 begin
4 6570 if kl>nulstil_systællere then næste:= systid(dato,nulstil_systællere)
4 6571 + et_døgn
4 6572 else næste:= systid(dato,nulstil_systællere);
4 6573 forr:= næste - et_døgn;
4 6574 end;
3 6575 until false;
3 6576
3 6576 io_null_trap:
3 6577 skriv_io_null(zbillede,1);
3 6578 end io_nulstil_tællere;
2 6579
2 6579 \f
2 6579 message operatør_erklæringer side 1 - 810602/hko;
2 6580 integer
2 6581 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6582 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6583 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6584 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6585 integer array
2 6586 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6587 operatørmaske(1:op_maske_lgd//2),
2 6588 op_talevej(0:max_antal_operatører),
2 6589 tv_operatør(0:max_antal_taleveje),
2 6590 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6591 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6592 ant_i_opkø,
2 6593 cs_operatør,
2 6594 cs_op_fil(1:max_antal_operatører);
2 6595 boolean
2 6596 op_cqf_tab_ændret;
2 6597 integer field
2 6598 op_spool_kilde;
2 6599 real field
2 6600 op_spool_tid;
2 6601 long array field
2 6602 op_spool_text;
2 6603 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6604 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6605 \f
2 6605 message procedure op_fejl side 1 - 830310/hko;
2 6606
2 6606 procedure op_fejl(z,s,b);
2 6607 integer s,b;
2 6608 zone z;
2 6609 begin
3 6610 disable begin
4 6611 integer array iz(1:20);
4 6612 integer i,j,k,n;
4 6613 integer array field iaf,iaf1,msk;
4 6614 boolean input;
4 6615 real array field laf,laf1;
4 6616
4 6616 getzone6(z,iz);
4 6617 iaf:=laf:=2;
4 6618 input:= iz(13) = 1;
4 6619 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6620 if iz.laf(1)=terminal_navn.laf1(1) and
4 6621 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6622
4 6622 <*+2*> if testbit31 then
4 6623 <**> begin
5 6624 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6625 <**> <:s=:>); outintbits(out,s);
5 6626 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6627 <**> else <:output:>,"nl",1);
5 6628 <**> setposition(out,0,0);
5 6629 <**> end;
4 6630 <*-2*>
4 6631 iaf:=j*terminal_beskr_længde;
4 6632 k:=1;
4 6633
4 6633 i:= terminal_tab.iaf.terminal_tilstand;
4 6634 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6635 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6636 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6637 if s <> (1 shift 21 +2) then
4 6638 begin
5 6639 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6640 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6641 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6642 sæt_bit_ia(opkaldsflag,j,0);
5 6643 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6644 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6645 begin
6 6646 msk:= k*op_maske_lgd;
6 6647 if læsbit_ia(bpl_def.msk,j) then
6 6648 <**> begin
7 6649 n:= 0;
7 6650 for i:= 1 step 1 until max_antal_operatører do
7 6651 if læsbit_ia(bpl_def.msk,i) then
7 6652 begin
8 6653 iaf1:= i*terminal_beskr_længde;
8 6654 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6655 n:= n+1;
8 6656 end;
7 6657 bpl_tilst(j,1):= n;
7 6658 end;
6 6659 <**> <*
6 6660 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6661 *> end;
5 6662 signal_bin(bs_mobil_opkald);
5 6663 end;
4 6664
4 6664 if input or -,input then
4 6665 begin
5 6666 z(1):=real <:<'?'><'?'><'em'>:>;
5 6667 b:=2;
5 6668 end;
4 6669 end; <*disable*>
3 6670 end op_fejl;
2 6671 \f
2 6671 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6672
2 6672 procedure tvswitch_fejl(z,s,b);
2 6673 integer s,b;
2 6674 zone z;
2 6675 begin
3 6676 disable begin
4 6677 integer array iz(1:20);
4 6678 integer i,j,k;
4 6679 integer array field iaf;
4 6680 boolean input;
4 6681 real array field raf;
4 6682
4 6682 getzone6(z,iz);
4 6683 iaf:=raf:=2;
4 6684 input:= iz(13) = 1;
4 6685 <*+2*> if testbit31 then
4 6686 <**> begin
5 6687 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6688 <**> <:s=:>); outintbits(out,s);
5 6689 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6690 <**> else <:output:>,"nl",1);
5 6691 <**> skrivhele(out,z,b,5);
5 6692 <**> setposition(out,0,0);
5 6693 <**> end;
4 6694 <*-2*>
4 6695 k:=1;
4 6696 if s <> (1 shift 21 +2) then
4 6697 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6698 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6699
4 6699 if input or -,input then
4 6700 begin
5 6701 z(1):=real <:<'em'>:>;
5 6702 b:=2;
5 6703 end;
4 6704 end; <*disable*>
3 6705 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6706 end tvswitch_fejl;
2 6707
2 6707 procedure skriv_talevejs_tab(z);
2 6708 zone z;
2 6709 begin
3 6710 write(z,"nl",2,<:talevejsswitch::>);
3 6711 write(z,"nl",1,<: operatører::>,"nl",1);
3 6712 for i:= 1 step 1 until max_antal_operatører do
3 6713 begin
4 6714 write(z,<< dd>,i,":",1,op_talevej(i));
4 6715 if i mod 8=0 then outchar(z,'nl');
4 6716 end;
3 6717 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6718 for i:= 1 step 1 until max_antal_taleveje do
3 6719 begin
4 6720 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6721 if i mod 8=0 then outchar(z,'nl');
4 6722 end;
3 6723 write(z,"nl",3);
3 6724 end;
2 6725 \f
2 6725 message procedure skriv_opk_alarm_tab side 1;
2 6726
2 6726 procedure skriv_opk_alarm_tab(z);
2 6727 zone z;
2 6728 begin
3 6729 integer nr;
3 6730 integer array field tab;
3 6731 real t;
3 6732
3 6732 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6733 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6734 for nr:=1 step 1 until max_antal_operatører do
3 6735 begin
4 6736 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6737 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6738 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6739 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6740 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6741 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6742 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6743 "nl",1);
4 6744 end;
3 6745 end;
2 6746 \f
2 6746 message procedure skriv_op_spool_buf side 1;
2 6747
2 6747 procedure skriv_op_spool_buf(z);
2 6748 zone z;
2 6749 begin
3 6750 integer array field ref;
3 6751 integer nr, kilde;
3 6752 real dato, kl;
3 6753
3 6753 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6754 for nr:= 1 step 1 until op_spool_postantal do
3 6755 begin
4 6756 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6757 ref:= (nr-1)*op_spool_postlgd;
4 6758 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6759 begin
5 6760 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6761 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6762 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6763 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6764 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6765 op_spool_buf.ref.op_spool_text);
5 6766 end;
4 6767 outchar(z,'nl');
4 6768 end;
3 6769 end;
2 6770
2 6770 procedure skriv_cqf_tabel(z,lang);
2 6771 value lang;
2 6772 zone z;
2 6773 boolean lang;
2 6774 begin
3 6775 integer array field ref;
3 6776 integer i,ant;
3 6777 real dato, kl;
3 6778
3 6778 ant:= 0;
3 6779 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6780 if -,lang then
3 6781 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6782 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6783 else
3 6784 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6785 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6786 for i:= 1 step 1 until max_cqf do
3 6787 begin
4 6788 ref:= (i-1)*cqf_lgd;
4 6789 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6790 begin
5 6791 ant:= ant+1;
5 6792 if lang then
5 6793 write(z,<<dd>,i,":",1);
5 6794 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6795 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6796 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6797 begin
6 6798 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6799 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6800 end
5 6801 else
5 6802 write(z,"sp",14,"?",1);
5 6803 if lang then
5 6804 begin
6 6805 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6806 begin
7 6807 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6808 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6809 end
6 6810 else
6 6811 write(z,"sp",14,"?",1);
6 6812 end
5 6813 else
5 6814 write(z,"sp",2);
5 6815 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6816 end;
4 6817 end;
3 6818 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6819 end;
2 6820
2 6820 procedure sorter_cqftab(l,u);
2 6821 value l,u;
2 6822 integer l,u;
2 6823 begin
3 6824 integer array field ii,jj;
3 6825 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6826
3 6826 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6827 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6828 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6829 repeat
3 6830 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6831 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6832 if ii <= jj then
3 6833 begin
4 6834 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6835 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6836 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6837 ii:= ii+cqf_lgd;
4 6838 jj:= jj-cqf_lgd;
4 6839 end;
3 6840 until ii>jj;
3 6841 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6842 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6843 end;
2 6844 \f
2 6844 message procedure ht_symbol side 1 - 851001/cl;
2 6845
2 6845 procedure ht_symbol(z);
2 6846 zone z;
2 6847 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6848
2 6848
2 6848
2 6848
2 6848 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6848 @@ @@ @@
2 6848 @@ @@ @@
2 6848 @@ @@ @@
2 6848 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6848 @@ @@
2 6848 @@ @@
2 6848 @@ @@
2 6848 @@ @@@@@@@@@@@@@ @@
2 6848 @@ @@ @@ @@
2 6848 @@ @@ @@ @@
2 6848 @@ @@ @@ @@
2 6848 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6848 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6849 \f
2 6849 message procedure definer_taster side 1 - 891214,cl;
2 6850
2 6850 procedure definer_taster(nr);
2 6851 value nr;
2 6852 integer nr;
2 6853 begin
3 6854
3 6854 setposition(z_op(nr),0,0);
3 6855 write(z_op(nr),
3 6856 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6857 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6858 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6859 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6860 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6861 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6862 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6863 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6864 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6865 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6866 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6867 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6868 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6869 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6870 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6871 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6872 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6873 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6874 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6875 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6876 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6877 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6878 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6879 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6880 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6881 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6882 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6883 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6884 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6885 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6886 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6887 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6888 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6889 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6890 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6891 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6892 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6893 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6894 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6895 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6896 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6897 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6898 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6899 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6900 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6901 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6902 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6903 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6904 <::>);
3 6905 end;
2 6906 \f
2 6906 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6907
2 6907 procedure skriv_terminal_tab(z);
2 6908 zone z;
2 6909 begin
3 6910 integer array field ref;
3 6911 integer t1,i,j,id,k;
3 6912
3 6912 write(z,"ff",1,<:
3 6913 ******* terminalbeskrivelser ********
3 6914
3 6914 # a k l p m m n o
3 6915 1 l a y a o o ø p
3 6916 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6917 <*
3 6918 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6919 *>
3 6920 for i:=1 step 1 until max_antal_operatører do
3 6921 begin
4 6922 ref:=i*terminal_beskr_længde;
4 6923 t1:=terminal_tab.ref(1);
4 6924 id:=terminal_tab.ref(2);
4 6925 k:=terminal_tab.ref(3);
4 6926 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6927 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6928 "sp",1);
4 6929 for j:=11 step -1 until 2 do
4 6930 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6931 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6932 "sp",1);
4 6933 skriv_id(z,id,9);
4 6934 skriv_id(z,k,9);
4 6935 end;
3 6936 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6937 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6938 write(z,"nl",1);
3 6939 end skriv_terminal_tab;
2 6940 \f
2 6940 message procedure h_operatør side 1 - 810520/hko;
2 6941
2 6941 <* hovedmodulkorutine for operatørterminaler *>
2 6942 procedure h_operatør;
2 6943 begin
3 6944 integer array field op_ref;
3 6945 integer k,nr,ant,ref,dest_sem;
3 6946 procedure skriv_hoperatør(zud,omfang);
3 6947 value omfang;
3 6948 zone zud;
3 6949 integer omfang;
3 6950 begin
4 6951
4 6951 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6952 if omfang>0 then
4 6953 disable begin integer x;
5 6954 trap(slut);
5 6955 write(zud,"nl",1,
5 6956 <: op_ref: :>,op_ref,"nl",1,
5 6957 <: nr: :>,nr,"nl",1,
5 6958 <: ant: :>,ant,"nl",1,
5 6959 <: ref: :>,ref,"nl",1,
5 6960 <: k: :>,k,"nl",1,
5 6961 <: dest_sem: :>,dest_sem,"nl",1,
5 6962 <::>);
5 6963 skriv_coru(zud,coru_no(200));
5 6964 slut:
5 6965 end;
4 6966 end skriv_hoperatør;
3 6967
3 6967 trap(hop_trap);
3 6968 stack_claim(if cm_test then 198 else 146);
3 6969
3 6969 <*+2*>
3 6970 if testbit8 and overvåget or testbit28 then
3 6971 skriv_hoperatør(out,0);
3 6972 <*-2*>
3 6973 \f
3 6973 message procedure h_operatør side 2 - 820304/hko;
3 6974
3 6974 repeat
3 6975 wait_ch(cs_op,op_ref,true,-1);
3 6976 <*+4*>
3 6977 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6978 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6979 <*-4*>
3 6980
3 6980 k:=d.op_ref.opkode extract 12;
3 6981 dest_sem:=
3 6982 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6983 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6984 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6985 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6986 if k=37 then cs_op_spool else
3 6987 if k=40 or k=38 then 0
3 6988 else -1;
3 6989 <*+4*>
3 6990 if dest_sem=-1 then
3 6991 begin
4 6992 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6993 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6994 end
3 6995 else
3 6996 <*-4*>
3 6997 if k=40 then
3 6998 begin
4 6999 dest_sem:= d.op_ref.retur;
4 7000 d.op_ref.retur:= cs_op_retur;
4 7001 for nr:= 1 step 1 until max_antal_operatører do
4 7002 begin
5 7003 inspect_ch(cs_operatør(nr),genoptype,ant);
5 7004 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 7005 or læsbit_ia(samtaleflag,nr))
5 7006 and læsbit_ia(operatørmaske,nr) then
5 7007 begin
6 7008 ref:= op_ref;
6 7009 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 7010 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 7011 <*+4*> if op_ref <> ref then
6 7012 fejlreaktion(11<*fr.post*>,op_ref,
6 7013 <:opdater opkaldskø,retur:>,0);
6 7014 <*-4*>
6 7015 end;
5 7016 end;
4 7017 d.op_ref.retur:= dest_sem;
4 7018 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7019 end
3 7020 else
3 7021 if k=38 then
3 7022 begin
4 7023 dest_sem:= d.opref.retur;
4 7024 d.op_ref.retur:= cs_op_retur;
4 7025 for nr:= 1 step 1 until max_antal_operatører do
4 7026 begin
5 7027 if d.opref.data.op_spool_kilde <> nr then
5 7028 begin
6 7029 ref:= op_ref;
6 7030 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 7031 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 7032 <*+4*> if op_ref <> ref then
6 7033 fejlreaktion(11<*fr.post*>,op_ref,
6 7034 <:opdater opkaldskø,retur:>,0);
6 7035 <*-4*>
6 7036 end;
5 7037 end;
4 7038 if d.opref.data.op_spool_kilde<>0 then
4 7039 begin
5 7040 ref:= op_ref;
5 7041 nr:= d.opref.data.op_spool_kilde;
5 7042 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 7043 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 7044 <*+4*> if op_ref <> ref then
5 7045 fejlreaktion(11<*fr.post*>,op_ref,
5 7046 <:operatørmedddelelse, retur:>,0);
5 7047 <*-4*>
5 7048 d.op_ref.retur:= dest_sem;
5 7049 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 7050 end
4 7051 else
4 7052 begin
5 7053 d.op_ref.retur:= dest_sem;
5 7054 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 7055 end;
4 7056 end
3 7057 else
3 7058 begin
4 7059 \f
4 7059 message procedure h_operatør side 3 - 810601/hko;
4 7060
4 7060 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 7061 begin
5 7062 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 7063 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 7064 +terminal_tab.iaf.terminal_tilstand extract 21;
5 7065 end;
4 7066 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 7067 end;
3 7068 until false;
3 7069
3 7069 hop_trap:
3 7070 disable skriv_hoperatør(zbillede,1);
3 7071 end h_operatør;
2 7072 \f
2 7072 message procedure operatør side 1 - 820304/hko;
2 7073
2 7073 procedure operatør(nr);
2 7074 value nr;
2 7075 integer nr;
2 7076 begin
3 7077 integer array field op_ref,ref,vt_op,iaf,tab;
3 7078 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 7079 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 7080 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 7081 real kommstart,kommslut;
3 7082 \f
3 7082 message procedure operatør side 1a - 820301/hko;
3 7083
3 7083 procedure skriv_operatør(zud,omfang);
3 7084 value omfang;
3 7085 zone zud;
3 7086 integer omfang;
3 7087 begin integer i;
4 7088
4 7088 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 7089 write(zud,"sp",26-i);
4 7090 if omfang > 0 then
4 7091 disable begin
5 7092 integer x;
5 7093 trap(slut);
5 7094 write(zud,"nl",1,
5 7095 <: op-ref: :>,op_ref,"nl",1,
5 7096 <: kode: :>,kode,"nl",1,
5 7097 <: aktion: :>,aktion,"nl",1,
5 7098 <: ref: :>,ref,"nl",1,
5 7099 <: vt_op: :>,vt_op,"nl",1,
5 7100 <: iaf: :>,iaf,"nl",1,
5 7101 <: status: :>,status,"nl",1,
5 7102 <: tilstand: :>,tilstand,"nl",1,
5 7103 <: bv: :>,bv,"nl",1,
5 7104 <: bs: :>,bs,"nl",1,
5 7105 <: bs-tilst: :>,bs_tilst,"nl",1,
5 7106 <: kanal: :>,kanal,"nl",1,
5 7107 <: opgave: :>,opgave,"nl",1,
5 7108 <: pos: :>,pos,"nl",1,
5 7109 <: indeks: :>,indeks,"nl",1,
5 7110 <: sep: :>,sep,"nl",1,
5 7111 <: sluttegn: :>,sluttegn,"nl",1,
5 7112 <: vogn: :>,vogn,"nl",1,
5 7113 <: ll: :>,ll,"nl",1,
5 7114 <: garage: :>,garage,"nl",1,
5 7115 <: skærmmåde: :>,skærmmåde,"nl",1,
5 7116 <: res: :>,res,"nl",1,
5 7117 <: tab: :>,tab,"nl",1,
5 7118 <: rkom: :>,rkom,"nl",1,
5 7119 <: par1: :>,par1,"nl",1,
5 7120 <: par2: :>,par2,"nl",1,
5 7121 <::>);
5 7122 skriv_coru(zud,coru_no(200+nr));
5 7123 slut:
5 7124 end;
4 7125 end skriv_operatør;
3 7126 \f
3 7126 message procedure skærmstatus side 1 - 810518/hko;
3 7127
3 7127 integer
3 7128 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 7129 integer tilstand,b_v,b_s,b_s_tilst;
3 7130 begin
4 7131 integer i,j;
4 7132
4 7132 i:= terminal_tab.ref(1);
4 7133 b_s:= terminal_tab.ref(2);
4 7134 b_s_tilst:= i extract 12;
4 7135 j:= b_s_tilst extract 3;
4 7136 b_v:= i shift (-12) extract 4;
4 7137 tilstand:= i shift (-21);
4 7138
4 7138 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 7139 if b_v = 0 and j = 1<*opkald*> then 1 else
4 7140 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 7141 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 7142 end skærmstatus;
3 7143 \f
3 7143 message procedure skriv_skærm side 1 - 810522/hko;
3 7144
3 7144 procedure skriv_skærm(nr);
3 7145 value nr;
3 7146 integer nr;
3 7147 begin
4 7148 integer i;
4 7149
4 7149 disable definer_taster(nr);
4 7150
4 7150 skriv_skærm_maske(nr);
4 7151 skriv_skærm_opkaldskø(nr);
4 7152 skriv_skærm_b_v_s(nr);
4 7153 for i:= 1 step 1 until max_antal_kanaler do
4 7154 skriv_skærm_kanal(nr,i);
4 7155 cursor(z_op(nr),1,1);
4 7156 <*V*> setposition(z_op(nr),0,0);
4 7157 end skriv_skærm;
3 7158 \f
3 7158 message procedure skriv_skærm_id side 1 - 830310/hko;
3 7159
3 7159 procedure skriv_skærm_id(nr,id,nød);
3 7160 value nr,id,nød;
3 7161 integer nr,id;
3 7162 boolean nød;
3 7163 begin
4 7164 integer linie,løb,bogst,i,p;
4 7165
4 7165 i:= id shift (-22);
4 7166
4 7166 case i+1 of
4 7167 begin
5 7168 begin <* busnr *>
6 7169 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 7170 (id extract 14) mod 10000);
6 7171 if id shift (-14) extract 8 > 0 then
6 7172 p:= p+write(z_op(nr),".",1,
6 7173 string bpl_navn(id shift (-14) extract 8));
6 7174 write(z_op(nr),"sp",11-p);
6 7175 end;
5 7176
5 7176 begin <*linie/løb*>
6 7177 linie:= id shift (-12) extract 10;
6 7178 bogst:= id shift (-7) extract 5;
6 7179 if bogst > 0 then bogst:= bogst +'A'-1;
6 7180 løb:= id extract 7;
6 7181 write(z_op(nr),if nød then "*" else "sp",1,
6 7182 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 7183 false add bogst,1,"/",1,løb,
6 7184 "sp",if løb > 9 then 3 else 4);
6 7185 end;
5 7186
5 7186 begin <*gruppe*>
6 7187 write(z_op(nr),<:GRP :>);
6 7188 if id shift (-21) extract 1 = 1 then
6 7189 begin <*specialgruppe*>
7 7190 løb:= id extract 7;
7 7191 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 7192 <<d>,løb,"sp",2);
7 7193 end
6 7194 else
6 7195 begin
7 7196 linie:= id shift (-5) extract 10;
7 7197 bogst:= id extract 5;
7 7198 if bogst > 0 then bogst:= bogst +'A'-1;
7 7199 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 7200 false add bogst,1,"sp",2);
7 7201 end;
6 7202 end;
5 7203
5 7203 <* kanal eller område *>
5 7204 begin
6 7205 linie:= (id shift (-20) extract 2) + 1;
6 7206 case linie of
6 7207 begin
7 7208 write(z_op(nr),"sp",11-write(z_op(nr),
7 7209 string kanal_navn(id extract 20)));
7 7210 write(z_op(nr),<:K*:>,"sp",9);
7 7211 write(z_op(nr),"sp",11-write(z_op(nr),
7 7212 <:OMR :>,string område_navn(id extract 20)));
7 7213 write(z_op(nr),<:ALLE:>,"sp",7);
7 7214 end;
6 7215 end;
5 7216
5 7216 end <* case i *>
4 7217 end skriv_skærm_id;
3 7218 \f
3 7218 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 7219
3 7219 procedure skriv_skærm_kanal(nr,kanal);
3 7220 value nr,kanal;
3 7221 integer nr,kanal;
3 7222 begin
4 7223 integer i,j,k,t,omr;
4 7224 integer array field tref,kref;
4 7225 boolean nød;
4 7226
4 7226 tref:= nr*terminal_beskr_længde;
4 7227 kref:= (kanal-1)*kanal_beskr_længde;
4 7228 t:= kanaltab.kref.kanal_tilstand;
4 7229 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 7230 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 7231 cursor(z_op(nr),kanal+2,28);
4 7232 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 7233 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 7234 " ",1," ",1);
4 7235 write(z_op(nr),true,6,string kanal_navn(kanal));
4 7236 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 7237 pabx_id(kanal_id(kanal) extract 5)
4 7238 else
4 7239 radio_id(kanal_id(kanal) extract 5);
4 7240 for i:= -2 step 1 until 0 do
4 7241 begin
5 7242 write(z_op(nr),
5 7243 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 7244 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 7245 end;
4 7246 write(z_op(nr),<:: :>);
4 7247 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 7248 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 7249 begin
5 7250 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 7251 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 7252 end
4 7253 else
4 7254 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 7255 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 7256 else
4 7257 if i > 0 and
4 7258 ( true <* i <> nr *> <* OPT også ud på egen skærm 960527/CL *> or
4 7259 j = kanal <* kanal = kanalnr for ventepos *> or
4 7260 (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 7261 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 7262 begin
5 7263 write(z_op(nr),<:OPT :>);
5 7264 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 7265 else write(z_op(nr),string bpl_navn(i));
5 7266 end
4 7267 else
4 7268 if false then
4 7269 begin
5 7270 i:= kanaltab.kref.kanal_id1;
5 7271 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 7272 skriv_skærm_id(nr,i,nød);
5 7273 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 7274 i:= kanaltab.kref.kanal_id2;
5 7275 if i<>0 then skriv_skærm_id(nr,i,false);
5 7276 end;
4 7277 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7278 end skriv_skærm_kanal;
3 7279 \f
3 7279 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 7280
3 7280 procedure skriv_skærm_b_v_s(nr);
3 7281 value nr;
3 7282 integer nr;
3 7283 begin
4 7284 integer i,j,k,kv,ks,t;
4 7285 integer array field tref,kref;
4 7286
4 7286 tref:= nr*terminal_beskr_længde;
4 7287 i:= terminal_tab.tref.terminal_tilstand;
4 7288 kv:= i shift (-12) extract 4;
4 7289 ks:= terminaltab.tref(2) extract 20;
4 7290 <*V*> setposition(z_op(nr),0,0);
4 7291 cursor(z_op(nr),18,28);
4 7292 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7293 cursor(z_op(nr),20,28);
4 7294 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7295 cursor(z_op(nr),21,28);
4 7296 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 7297 cursor(z_op(nr),20,28);
4 7298 if op_talevej(nr)<>0 then
4 7299 begin
5 7300 cursor(z_op(nr),18,28);
5 7301 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 7302 end;
4 7303 if kv <> 0 then
4 7304 begin
5 7305 kref:= (kv-1)*kanal_beskr_længde;
5 7306 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 7307 else kanaltab.kref.kanal_id2;
5 7308 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 7309 else kanaltab.kref.kanal_alt_id2;
5 7310 write(z_op(nr),true,6,string kanal_navn(kv));
5 7311 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 7312 skriv_skærm_id(nr,k,false);
5 7313 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 7314 end;
4 7315
4 7315 cursor(z_op(nr),21,28);
4 7316 j:= terminal_tab.tref(2);
4 7317 if i shift (-21) <> 0 <*ikke ledig*> then
4 7318 begin
5 7319 \f
5 7319 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 7320
5 7320 if i shift (-21) = 1 <*samtale*> then
5 7321 begin
6 7322 if j shift (-20) = 12 then
6 7323 begin
7 7324 write(z_op(nr),true,6,string kanal_navn(ks));
7 7325 end
6 7326 else
6 7327 begin
7 7328 write(z_op(nr),true,6,<:K*:>);
7 7329 k:= 0;
7 7330 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 7331 k:= k+1;
7 7332 ks:= k;
7 7333 end;
6 7334 kref:= (ks-1)*kanal_beskr_længde;
6 7335 t:= kanaltab.kref.kanaltilstand;
6 7336 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 7337 t shift (-3) extract 1 = 1);
6 7338 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 7339 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 7340 if t shift (-5) extract 1 = 1 then <:MON :> else
6 7341 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 7342 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 7343 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 7344 if t shift (-9) extract 1 = 1 then
6 7345 write(z_op(nr),<:ALLE :>);
6 7346 if t shift (-8) extract 1 = 1 then
6 7347 write(z_op(nr),<:KATASTROFE :>);
6 7348 k:= kanaltab.kref.kanal_spec;
6 7349 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7350 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7351 end
5 7352 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7353 begin
6 7354 write(z_op(nr),<:K-:>,"sp",3);
6 7355 if j <> 0 then
6 7356 skriv_skærm_id(nr,j,false)
6 7357 else
6 7358 begin
7 7359 j:=terminal_tab.tref(3);
7 7360 skriv_skærm_id(nr,j,
7 7361 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7362 else 0));
7 7363 end;
6 7364 write(z_op(nr),<:OPT:>);
6 7365 end;
5 7366 end;
4 7367 <*V*> setposition(z_op(nr),0,0);
4 7368 end skriv_skærm_b_v_s;
3 7369 \f
3 7369 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7370
3 7370 procedure skriv_skærm_maske(nr);
3 7371 value nr;
3 7372 integer nr;
3 7373 begin
4 7374 integer i;
4 7375 <*V*> setposition(z_op(nr),0,0);
4 7376 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7377 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7378 "sp",1,"*",5,"nl",1,"-",80);
4 7379
4 7379 for i:= 3 step 1 until 21 do
4 7380 begin
5 7381 cursor(z_op(nr),i,26);
5 7382 outchar(z_op(nr),'!');
5 7383 end;
4 7384 cursor(z_op(nr),22,1);
4 7385 write(z_op(nr),"-",80);
4 7386 cursor(z_op(nr),1,1);
4 7387 <*V*> setposition(z_op(nr),0,0);
4 7388 end skriv_skærm_maske;
3 7389 \f
3 7389 message procedure skal_udskrives side 1 - 940522/cl;
3 7390
3 7390 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7391 value fordelt_til,aktuel_skærm;
3 7392 integer fordelt_til,aktuel_skærm;
3 7393 begin
4 7394 boolean skal_ud;
4 7395 integer n;
4 7396 integer array field iaf;
4 7397
4 7397 skal_ud:= true;
4 7398 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7399 begin
5 7400 for n:= 0 step 1 until 3 do
5 7401 begin
6 7402 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7403 begin
7 7404 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7405 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7406 goto returner;
7 7407 end;
6 7408 end;
5 7409 end;
4 7410 returner:
4 7411 skal_udskrives:= skal_ud;
4 7412 end;
3 7413
3 7413 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7414
3 7414 procedure skriv_skærm_opkaldskø(nr);
3 7415 value nr;
3 7416 integer nr;
3 7417 begin
4 7418 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7419 integer array field ref,iaf,tab;
4 7420 boolean skal_ud;
4 7421
4 7421 <*V*> wait(bs_opkaldskø_adgang);
4 7422 setposition(z_op(nr),0,0);
4 7423 ant:= 0; kmdo:= 0;
4 7424 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7425 ref:= første_nødopkald;
4 7426 if ref=0 then ref:=første_opkald;
4 7427 while ref <> 0 do
4 7428 begin
5 7429 i:= opkaldskø.ref(4);
5 7430 operatør:= i extract 8;
5 7431 type:=i shift (-8) extract 4;
5 7432
5 7432 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7433 *>
5 7434 if operatør > 64 then
5 7435 begin
6 7436 <* fordelt til gruppe af betjeningspladser *>
6 7437 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7438 while skal_ud and i<max_antal_operatører do
6 7439 begin
7 7440 i:=i+1;
7 7441 if læsbit_ia(bpl_def.iaf,i) then
7 7442 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7443 end;
6 7444 end
5 7445 else
5 7446 skal_ud:= skal_udskrives(operatør,nr);
5 7447 if skal_ud then
5 7448 begin
6 7449 ant:= ant +1;
6 7450 if ant < 6 then
6 7451 begin
7 7452 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7453 ttmm:= i shift (-12);
7 7454 vogn:= opkaldskø.ref(3);
7 7455 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7456 skriv_skærm_id(nr,vogn,type=2);
7 7457 write(z_op(nr),true,4,
7 7458 string område_navn(opkaldskø.ref(5) extract 4),
7 7459 <<zd.dd>,ttmm/100.0);
7 7460 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7461 begin
8 7462 if opkaldskø.ref(5) extract 4 <= 2 or
8 7463 opk_alarm.tab.alarm_lgd = 0 then
8 7464 begin
9 7465 if type=2 then
9 7466 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7467 else
9 7468 write(z_op(nr),"bel",1);
9 7469 end
8 7470 else if type>kmdo then kmdo:= type;
8 7471 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7472 end;
7 7473 end;<* ant < 6 *>
6 7474 end;<* operatør ok *>
5 7475
5 7475 ref:= opkaldskø.ref(1) extract 12;
5 7476 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7477 end;
4 7478 \f
4 7478 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7479
4 7479 signal_bin(bs_opkaldskø_adgang);
4 7480 if kmdo > opk_alarm.tab.alarm_tilst and
4 7481 kmdo > opk_alarm.tab.alarm_kmdo then
4 7482 begin
5 7483 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7484 signal_bin(bs_opk_alarm);
5 7485 end;
4 7486 if ant > 5 then
4 7487 begin
5 7488 cursor(z_op(nr),13,9);
5 7489 write(z_op(nr),<<+ddd>,ant-5);
5 7490 end
4 7491 else
4 7492 begin
5 7493 for i:= ant +1 step 1 until 6 do
5 7494 begin
6 7495 cursor(z_op(nr),i*2+1,1);
6 7496 write(z_op(nr),"sp",25);
6 7497 end;
5 7498 end;
4 7499 ant_i_opkø(nr):= ant;
4 7500 cursor(z_op(nr),1,1);
4 7501 <*V*> setposition(z_op(nr),0,0);
4 7502 end skriv_skærm_opkaldskø;
3 7503 \f
3 7503 message procedure operatør side 2 - 810522/hko;
3 7504
3 7504 trap(op_trap);
3 7505 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7506
3 7506 ref:= nr*terminal_beskr_længde;
3 7507 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7508 skærmmåde:= 0; <*normal*>
3 7509
3 7509 if operatør_auto_include(nr) then
3 7510 begin
4 7511 waitch(cs_att_pulje,opref,true,-1);
4 7512 i:= operatør_auto_include(nr) extract 2;
4 7513 if i<>3 then i:= 0;
4 7514 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7515 d.opref.data(1):= nr;
4 7516 signalch(cs_rad,opref,gen_optype or io_optype);
4 7517 end;
3 7518
3 7518 <*+2*>
3 7519 if testbit8 and overvåget or testbit28 then
3 7520 skriv_operatør(out,0);
3 7521 <*-2*>
3 7522 \f
3 7522 message procedure operatør side 3 - 810602/hko;
3 7523
3 7523 repeat
3 7524
3 7524 <*V*> wait_ch(cs_operatør(nr),
3 7525 op_ref,
3 7526 true,
3 7527 -1<*timeout*>);
3 7528 <*+2*>
3 7529 if testbit9 and overvåget then
3 7530 disable begin
4 7531 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7532 <: til operatør :>,nr);
4 7533 skriv_op(out,op_ref);
4 7534 end;
3 7535 <*-2*>
3 7536 monitor(8)reserve process:(z_op(nr),0,ia);
3 7537 kode:= d.op_ref.op_kode extract 12;
3 7538 i:= terminal_tab.ref.terminal_tilstand;
3 7539 status:= i shift(-21);
3 7540 opgave:=
3 7541 if kode=0 then 1 <* indlæs kommando *> else
3 7542 if kode=1 then 2 <* inkluder *> else
3 7543 if kode=2 then 3 <* ekskluder *> else
3 7544 if kode=40 then 4 <* opdater skærm *> else
3 7545 if kode=43 then 5 <* opkald etableret *> else
3 7546 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7547 if kode=38 then 7 <* operatør meddelelse *> else
3 7548 0; <* afvises *>
3 7549
3 7549 aktion:= case status +1 of(
3 7550 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7551 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7552 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7553 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7554 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7555 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7556 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7557 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7558 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7559 -1);
3 7560 \f
3 7560 message procedure operatør side 4 - 810424/hko;
3 7561
3 7561 case aktion+6 of
3 7562 begin
4 7563 begin
5 7564 <*-5: terminal optaget *>
5 7565
5 7565 d.op_ref.resultat:= 16;
5 7566 afslut_operation(op_ref,-1);
5 7567 end;
4 7568
4 7568 begin
5 7569 <*-4: operation uden virkning *>
5 7570
5 7570 afslut_operation(op_ref,-1);
5 7571 end;
4 7572
4 7572 begin
5 7573 <*-3: ulovlig operationskode *>
5 7574
5 7574 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7575 afslut_operation(op_ref,-1);
5 7576 end;
4 7577
4 7577 begin
5 7578 <*-2: ulovligt operatørterminal_nr *>
5 7579
5 7579 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7580 afslut_operation(op_ref,-1);
5 7581 end;
4 7582
4 7582 begin
5 7583 <*-1: ulovlig operatørtilstand *>
5 7584
5 7584 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7585 afslut_operation(op_ref,-1);
5 7586 end;
4 7587
4 7587 begin
5 7588 <* 0: ikke implementeret *>
5 7589
5 7589 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7590 afslut_operation(op_ref,-1);
5 7591 end;
4 7592
4 7592 begin
5 7593 \f
5 7593 message procedure operatør side 5 - 851001/cl;
5 7594
5 7594 <* 1: indlæs kommando *>
5 7595
5 7595
5 7595 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7596 if opk_alarm.tab.alarm_tilst > 0 then
5 7597 begin
6 7598 opk_alarm.tab.alarm_kmdo:= 3;
6 7599 signal_bin(bs_opk_alarm);
6 7600 pass;
6 7601 end;
5 7602 if d.op_ref.resultat > 3 then
5 7603 begin
6 7604 <*V*> setposition(z_op(nr),0,0);
6 7605 cursor(z_op(nr),24,1);
6 7606 skriv_kvittering(z_op(nr),op_ref,pos,
6 7607 d.op_ref.resultat);
6 7608 end
5 7609 else if d.op_ref.resultat = -1 then
5 7610 begin
6 7611 skærmmåde:= 0;
6 7612 skrivskærm(nr);
6 7613 end
5 7614 else if d.op_ref.resultat>0 then
5 7615 begin <*godkendt*>
6 7616 kode:=d.op_ref.opkode;
6 7617 i:= kode extract 12;
6 7618 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7619 if kode = 19 then 1 <*VO,S *> else
6 7620 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7621 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7622 if kode = 6 then 4 <*STop*> else
6 7623 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7624 if kode = 30 then 5 <*SP,D*> else
6 7625 if kode = 31 then 6 <*SP*> else
6 7626 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7627 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7628 if kode = 83 then 8 <*SL*> else
6 7629 if kode = 68 then 9 <*ST,D*> else
6 7630 if kode = 69 then 10 <*ST,V*> else
6 7631 if kode = 36 then 11 <*AL*> else
6 7632 if kode = 37 then 12 <*CC*> else
6 7633 if kode = 2 then 13 <*EX*> else
6 7634 if kode = 92 then 14 <*CQF,V*> else
6 7635 if kode = 38 then 15 <*AL,T*> else
6 7636 0;
6 7637 if j > 0 then
6 7638 begin
7 7639 case j of
7 7640 begin
8 7641 begin
9 7642 \f
9 7642 message procedure operatør side 6 - 851001/cl;
9 7643
9 7643 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7644
9 7644 vogn:=ia(1);
9 7645 ll:=ia(2);
9 7646 kanal:= if kode=11 or kode=19 then ia(3) else
9 7647 if kode=12 then ia(2) else 0;
9 7648 <*V*> wait_ch(cs_vt_adgang,
9 7649 vt_op,
9 7650 gen_optype,
9 7651 -1<*timeout sek*>);
9 7652 start_operation(vtop,200+nr,cs_operatør(nr),
9 7653 kode);
9 7654 d.vt_op.data(1):=vogn;
9 7655 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7656 d.vt_op.data(2):=ll;
9 7657 if kode=19 then d.vt_op.data(3):= kanal else
9 7658 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7659 indeks:= vt_op;
9 7660 signal_ch(cs_vt,
9 7661 vt_op,
9 7662 gen_optype or op_optype);
9 7663
9 7663 <*V*> wait_ch(cs_operatør(nr),
9 7664 vt_op,
9 7665 op_optype,
9 7666 -1<*timeout sek*>);
9 7667 <*+2*> if testbit10 and overvåget then
9 7668 disable begin
10 7669 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7670 <:: operation retur fra vt:>);
10 7671 skriv_op(out,vt_op);
10 7672 end;
9 7673 <*-2*>
9 7674 <*+4*> if vt_op<>indeks then
9 7675 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7676 <:operatør-kommando:>,0);
9 7677 <*-4*>
9 7678 <*V*> setposition(z_op(nr),0,0);
9 7679 cursor(z_op(nr),24,1);
9 7680 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7681 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7682 else vt_op,-1,d.vt_op.resultat);
9 7683 d.vt_op.optype:= gen_optype or vt_optype;
9 7684 disable afslut_operation(vt_op,cs_vt_adgang);
9 7685 end;
8 7686 begin
9 7687 \f
9 7687 message procedure operatør side 7 - 810921/hko,cl;
9 7688
9 7688 <* 2 vogntabel,linienr/-,busnr *>
9 7689
9 7689 d.op_ref.retur:= cs_operatør(nr);
9 7690 tofrom(d.op_ref.data,ia,10);
9 7691 indeks:= op_ref;
9 7692 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7693 wait_ch(cs_operatør(nr),
9 7694 op_ref,
9 7695 op_optype,
9 7696 -1<*timeout*>);
9 7697 <*+2*> if testbit10 and overvåget then
9 7698 disable begin
10 7699 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7700 skriv_op(out,op_ref);
10 7701 end;
9 7702 <*-2*>
9 7703 <*+4*>
9 7704 if indeks <> op_ref then
9 7705 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7706 <*-4*>
9 7707 i:= d.op_ref.resultat;
9 7708 if i = 0 or i > 3 then
9 7709 begin
10 7710 <*V*> setposition(z_op(nr),0,0);
10 7711 cursor(z_op(nr),24,1);
10 7712 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7713 end
9 7714 else
9 7715 begin
10 7716 integer antal,fil_ref;
10 7717
10 7717 skærm_måde:= 1;
10 7718 antal:= d.op_ref.data(6);
10 7719 fil_ref:= d.op_ref.data(7);
10 7720 <*V*> setposition(z_op(nr),0,0);
10 7721 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7722 "sp",14,"*",10,"sp",6,
10 7723 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7724 <*V*> setposition(z_op(nr),0,0);
10 7725 \f
10 7725 message procedure operatør side 8 - 841213/cl;
10 7726
10 7726 pos:= 1;
10 7727 while pos <= antal do
10 7728 begin
11 7729 integer bogst,løb;
11 7730
11 7730 disable i:= læs_fil(fil_ref,pos,j);
11 7731 if i <> 0 then
11 7732 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7733 else
11 7734 begin
12 7735 vogn:= fil(j,1) shift (-24) extract 24;
12 7736 løb:= fil(j,1) extract 24;
12 7737 if d.op_ref.opkode=9 then
12 7738 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7739 ll:= løb shift (-12) extract 10;
12 7740 bogst:= løb shift (-7) extract 5;
12 7741 if bogst > 0 then bogst:= bogst +'A'-1;
12 7742 løb:= løb extract 7;
12 7743 vogn:= vogn extract 14;
12 7744 i:= d.op_ref.opkode-8;
12 7745 for i:= i,i+1 do
12 7746 begin
13 7747 j:= (i+1) extract 1;
13 7748 case j +1 of
13 7749 begin
14 7750 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7751 false add bogst,1,"/",1,<<d__>,løb);
14 7752 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7753 end;
13 7754 end;
12 7755 if pos mod 5 = 0 then
12 7756 begin
13 7757 outchar(z_op(nr),'nl');
13 7758 <*V*> setposition(z_op(nr),0,0);
13 7759 end
12 7760 else write(z_op(nr),"sp",3);
12 7761 end;
11 7762 pos:=pos+1;
11 7763 end;
10 7764 write(z_op(nr),"*",1,"nl",1);
10 7765 \f
10 7765 message procedure operatør side 8a- 810507/hko;
10 7766
10 7766 d.opref.opkode:=104; <*slet-fil*>
10 7767 d.op_ref.data(4):=filref;
10 7768 indeks:=op_ref;
10 7769 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7770 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7771
10 7771 <*+2*> if testbit10 and overvåget then
10 7772 disable begin
11 7773 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7774 skriv_op(out,op_ref);
11 7775 end;
10 7776 <*-2*>
10 7777
10 7777 <*+4*> if op_ref<>indeks then
10 7778 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7779 <*-4*>
10 7780 if d.op_ref.data(9)<>0 then
10 7781 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7782 <:operatør, slet_fil:>,1);
10 7783 end;
9 7784 end;
8 7785
8 7785 begin
9 7786 \f
9 7786 message procedure operatør side 9 - 830310/hko;
9 7787
9 7787 <* 3 radio_kommandoer *>
9 7788
9 7788 kode:= d.op_ref.opkode;
9 7789 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7790 disable if testbit14 then
9 7791 begin
10 7792 integer i; <*lav en trap-bar blok*>
10 7793
10 7793 trap(test14_trap);
10 7794 systime(1,0,kommstart);
10 7795 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7796 string bpl_navn(nr),<: start :>,case rkom of (
10 7797 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7798 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7799 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7800 <:GE,T:>),<: :>);
10 7801 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7802 rkom=16 or rkom=17 or rkom=19)
10 7803 then
10 7804 begin
11 7805 if par1<>0 then skriv_id(zrl,par1,0);
11 7806 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7807 write(zrl,"sp",1,string områdenavn(par2));
11 7808 end
10 7809 else
10 7810 if rkom=10 and par1<>0 then
10 7811 write(zrl,string kanalnavn(par1 extract 20))
10 7812 else
10 7813 if rkom=5 or rkom=6 then
10 7814 begin
11 7815 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7816 if par1 shift (-20)=14 then
11 7817 write(zrl,string områdenavn(par1 extract 20));
11 7818 end;
10 7819 test14_trap: outchar(zrl,'nl');
10 7820 end;
9 7821 d.op_ref.data(4):= nr; <*operatør*>
9 7822 opgave:=
9 7823 if kode = 45 <*OP *> then 1 else
9 7824 if kode = 46 <*ME *> then 2 else
9 7825 if kode = 47 <*OP,G*> then 3 else
9 7826 if kode = 48 <*ME,G*> then 4 else
9 7827 if kode = 49 <*OP,A*> then 5 else
9 7828 if kode = 50 <*ME,A*> then 6 else
9 7829 if kode = 51 <*KA,C*> then 7 else
9 7830 if kode = 52 <*KA,P*> then 8 else
9 7831 if kode = 53 <*OP,L*> then 9 else
9 7832 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7833 if kode = 55 <*VE *> then 14 else
9 7834 if kode = 56 <*NE *> then 12 else
9 7835 if kode = 57 <*OP,V*> then 1 else
9 7836 if kode = 58 <*OP,T*> then 1 else
9 7837 if kode = 59 <*R *> then 13 else
9 7838 if kode = 60 <*GE *> then 15 else
9 7839 if kode = 61 <*GE,G*> then 16 else
9 7840 if kode = 62 <*GE,V*> then 15 else
9 7841 if kode = 63 <*GE,T*> then 15 else
9 7842 -1;
9 7843 <*+4*> if opgave < 0 then
9 7844 fejlreaktion(2<*operationskode*>,kode,
9 7845 <:operatør, radio-kommando :>,0);
9 7846 <*-4*>
9 7847 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7848 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7849 if 5<=opgave and opgave<=8 then
9 7850 d.opref.data(2):= -1;
9 7851 if opgave=13 then d.opref.data(2):=
9 7852 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7853 then 0 else 1);
9 7854 if opgave = 14 then d.opref.data(2):= 1;
9 7855 if opgave=7 or opgave=8 then
9 7856 d.opref.data(3):= -1
9 7857 else
9 7858 if opgave=5 or opgave=6 then
9 7859 begin
10 7860 if ia(1) shift (-20) = 15 then
10 7861 begin
11 7862 d.opref.data(3):= 15 shift 20;
11 7863 for j:= 1 step 1 until max_antal_kanaler do
11 7864 begin
12 7865 iaf:= (j-1)*kanalbeskrlængde;
12 7866 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7867 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7868 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7869 end;
11 7870 end
10 7871 else
10 7872 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7873 else ia(1);
10 7874 end
9 7875 else
9 7876 if kode = 57 then d.opref.data(3):= 2 else
9 7877 if kode = 58 then d.opref.data(3):= 1 else
9 7878 if kode = 62 then d.opref.data(3):= 2 else
9 7879 if kode = 63 then d.opref.data(3):= 1 else
9 7880 d.opref.data(3):= ia(2);
9 7881
9 7881 <* !!! i første if-sætning nedenfor er 'status>1'
9 7882 rettet til 'status>0' for at forhindre
9 7883 at opkald nr. 2 kan udføres med et allerede
9 7884 etableret opkald i skærmens s-felt,
9 7885 jvf. ulykke d. 7/2-1995
9 7886 !!! *>
9 7887 res:=
9 7888 if (opgave=1 or opgave=3) and status>0
9 7889 then 16 <*skærm optaget*> else
9 7890 if (opgave=15 or opgave=16) and
9 7891 status>1 then 16 <*skærm optaget*> else
9 7892 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7893 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7894 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7895 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7896 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7897 then 52 else 1) else
9 7898 if opgave<11 and status>0 then 16 else
9 7899 if opgave=11 and status<2 then 21 else
9 7900 if opgave=12 and status=0 then 22 else
9 7901 if opgave=13 and status=0 then 49 else
9 7902 if opgave=14 and status<>3 then 21 else 1;
9 7903 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7904 begin <* specialbetingelser for TLF og VHF *>
10 7905 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7906 end;
9 7907 if skærmmåde<>0 then
9 7908 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7909 kode:= opgave;
9 7910 if opgave = 15 then opgave:= 1 else
9 7911 if opgave = 16 then opgave:= 3;
9 7912 \f
9 7912 message procedure operatør side 10 - 810616/hko;
9 7913
9 7913 <* tilknyt talevej (om nødvendigt) *>
9 7914 if res = 1 and op_talevej(nr)=0 then
9 7915 begin
10 7916 i:= sidste_tv_brugt;
10 7917 repeat
10 7918 i:= (i mod max_antal_taleveje)+1;
10 7919 if tv_operatør(i)=0 then
10 7920 begin
11 7921 tv_operatør(i):= nr;
11 7922 op_talevej(nr):= i;
11 7923 end;
10 7924 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7925 if op_talevej(nr)=0 then
10 7926 res:=61
10 7927 else
10 7928 begin
11 7929 sidste_tv_brugt:=
11 7930 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7931
11 7931 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7932 start_operation(iaf,200+nr,cs_operatør(nr),
11 7933 'A' shift 12 + 44);
11 7934 d.iaf.data(1):= op_talevej(nr);
11 7935 d.iaf.data(2):= nr+16;
11 7936 ll:= 0;
11 7937 repeat
11 7938 signalch(cs_talevejsswitch,iaf,op_optype);
11 7939 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7940 ll:= ll+1;
11 7941 until ll=3 or d.iaf.resultat=3;
11 7942 res:= if d.iaf.resultat=3 then 1 else 61;
11 7943 <* ********* *>
11 7944 delay(1);
11 7945 start_operation(iaf,200+nr,cs_operatør(nr),
11 7946 'R' shift 12 + 44);
11 7947 ll:= 0;
11 7948 repeat
11 7949 signalch(cs_talevejsswitch,iaf,op_optype);
11 7950 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7951 ll:= ll+1;
11 7952 until ll=3 or d.iaf.resultat=3;
11 7953 <* ********* *>
11 7954 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7955 if res<>1 then
11 7956 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7957 end;
10 7958 end;
9 7959 if op_talevej(nr)=0 then res:= 61;
9 7960 d.op_ref.data(1):= op_talevej(nr);
9 7961
9 7961 if res <= 1 then
9 7962 begin
10 7963 til_radio: <* send operation til radiomodul *>
10 7964 d.op_ref.opkode:= opgave shift 12 + 41;
10 7965 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7966 else 0;
10 7967 d.op_ref.data(6):= b_s;
10 7968 d.op_ref.resultat:=0;
10 7969 d.op_ref.retur:= cs_operatør(nr);
10 7970 indeks:= op_ref;
10 7971 <*+2*> if testbit11 and overvåget then
10 7972 disable begin
11 7973 skriv_operatør(out,0);
11 7974 write(out,<: operation til radio:>);
11 7975 skriv_op(out,op_ref); ud;
11 7976 end;
10 7977 <*-2*>
10 7978 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7979 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7980
10 7980 <*+2*> if testbit12 and overvåget then
10 7981 disable begin
11 7982 skriv_operatør(out,0);
11 7983 write(out,<: operation retur fra radio:>);
11 7984 skriv_op(out,op_ref); ud;
11 7985 end;
10 7986 <*-2*>
10 7987 <*+4*> if op_ref <> indeks then
10 7988 fejlreaktion(11<*fr.post*>,op_ref,
10 7989 <:operatør, retur fra radio:>,0);
10 7990 <*-4*>
10 7991 \f
10 7991 message procedure operatør side 11 - 810529/hko;
10 7992
10 7992 res:= d.op_ref.resultat;
10 7993 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7994 begin
11 7995 <*+4*> if res < 2 then
11 7996 fejlreaktion(3<*prg.fejl*>,res,
11 7997 <: operatør,radio_op,resultat:>,1);
11 7998 <*-4*>
11 7999 if res = 1 then res:= 0;
11 8000 if (opgave < 10) and (res=20 or res=52) then
11 8001 disable tæl_opkald_pr_operatør(nr,
11 8002 (if res=20 then 4 else 5));
11 8003 end
10 8004 else
10 8005 begin <* res = 2 eller 3 *>
11 8006 s_kanal:= v_kanal:= 0;
11 8007 opgave:= d.opref.opkode shift (-12);
11 8008 bv:= d.op_ref.data(5) extract 4;
11 8009 bs:= d.op_ref.data(6);
11 8010 if opgave < 10 then
11 8011 begin
12 8012 j:= d.op_ref.data(7) <*type*>;
12 8013 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 8014 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 8015 terminal_tab.ref(1):= i
12 8016 +(if res=2 then 4 <*optaget*> else 0)
12 8017 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 8018 then 8 <*nød*> else 0)
12 8019 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 8020 then 16 else 0)
12 8021 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 8022 + (if opgave=9 then 128 else
12 8023 if opgave>=7 then 256 else
12 8024 if opgave>=5 then 512 else 0)
12 8025 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 8026 else if b_s = 0 then 0 <*tilstand = ledig *>
12 8027 else 1 shift 21 <*tilstand = samtale*>);
12 8028 if (res=3 and 0<=j and j<3) then
12 8029 disable tæl_opkald_pr_operatør(nr,j+1);
12 8030 end
11 8031 else if opgave=10 <*monitering*> or
11 8032 opgave=14 <*ventepos *> then
11 8033 begin
12 8034 <*+4*> if res = 2 then
12 8035 fejlreaktion(3<*prg.fejl*>,res,
12 8036 <: operatør,moniter,res:>,1);
12 8037 <*-4*>
12 8038 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 8039 i:= if bs<0 then
12 8040 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 8041 terminal_tab.ref(1):= i +
12 8042 (if bs < 0 then (1 shift 21) else 0);
12 8043 if opgave=10 then
12 8044 begin
13 8045 s_kanal:= bs;
13 8046 v_kanal:= d.opref.data(5);
13 8047 end;
12 8048 \f
12 8048 message procedure operatør side 12 - 810603/hko;
12 8049 end
11 8050 else if opgave=11 or opgave=12 then
11 8051 begin
12 8052 <*+4*> if res = 2 then
12 8053 fejlreaktion(3<*prg.fejl*>,res,
12 8054 <: operatør,ge/ne,res:>,1);
12 8055 <*-4*>
12 8056 if opgave=11 <*GE*> and res<>49 then
12 8057 begin
13 8058 s_kanal:= terminal_tab.ref(2);
13 8059 v_kanal:= 12 shift 20 +
13 8060 (terminal_tab.ref(1) shift (-12) extract 4);
13 8061 end;
12 8062 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 8063 end
11 8064 else
11 8065 if opgave=13 then
11 8066 begin
12 8067 if res=2 then
12 8068 fejlreaktion(3<*prg.fejl*>,res,
12 8069 <:operatør,R,res:>,1);
12 8070 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 8071 d.opref.data(2));
12 8072 end
11 8073 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 8074 <*-4*>
11 8075 ;
11 8076 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 8077
11 8077 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 8078 terminal_tab.ref(2):= b_s;
11 8079 terminal_tab.ref(3):= d.op_ref.data(11);
11 8080 if (opgave<10 or opgave=14) and res=3 then
11 8081 <*så henviser b_s til radiokanal*>
11 8082 begin
12 8083 if bs shift (-20) = 12 then
12 8084 begin
13 8085 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 8086 kanaltab.iaf.kanal_tilstand:=
13 8087 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 8088 +terminal_tab.ref(1) extract 10;
13 8089 end
12 8090 else
12 8091 begin
13 8092 for i:= 1 step 1 until max_antal_kanaler do
13 8093 begin
14 8094 if læsbit_i(bs,i) then
14 8095 begin
15 8096 iaf:= (i-1)*kanal_beskr_længde;
15 8097 kanaltab.iaf.kanaltilstand:=
15 8098 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 8099 + terminal_tab.ref(1) extract 10;
15 8100 end;
14 8101 end;
13 8102 end;
12 8103 end;
11 8104 if kode=15 or kode=16 then
11 8105 begin
12 8106 if opgave<10 then
12 8107 begin
13 8108 opgave:= 11;
13 8109 kanal:= (12 shift 20) +
13 8110 d.opref.data(6) extract 20;
13 8111 goto til_radio;
13 8112 end
12 8113 else
12 8114 if opgave=11 then
12 8115 begin
13 8116 opgave:= 10;
13 8117 d.opref.data(2):= kanal;
13 8118 goto til_radio;
13 8119 end;
12 8120 end
11 8121 else
11 8122 if (kode=1 or kode=3) then
11 8123 begin
12 8124 if opgave<10 and bv<>0 then
12 8125 begin
13 8126 opgave:= 14;
13 8127 d.opref.data(2):= 2;
13 8128 goto til_radio;
13 8129 end;
12 8130 end;
11 8131 <*V*> skriv_skærm_b_v_s(nr);
11 8132 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 8133 skriv_skærm_opkaldskø(nr);
11 8134 for i:= s_kanal, v_kanal do
11 8135 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 8136 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 8137 signalbin(bs_mobilopkald);
11 8138 <*V*> setposition(z_op(nr),0,0);
11 8139 end; <* res = 2 eller 3 *>
10 8140 end; <* res <= 1 *>
9 8141 <* frigiv talevej (om nødvendigt) *>
9 8142 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 8143 and terminal_tab.ref(2)=0 <*b_s*>
9 8144 and op_talevej(nr)<>0
9 8145 then
9 8146 begin
10 8147 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 8148 start_operation(iaf,200+nr,cs_operatør(nr),
10 8149 'D' shift 12 + 44);
10 8150 d.iaf.data(1):= op_talevej(nr);
10 8151 d.iaf.data(2):= nr+16;
10 8152 ll:= 0;
10 8153 repeat
10 8154 signalch(cs_talevejsswitch,iaf,op_optype);
10 8155 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 8156 ll:= ll+1;
10 8157 until ll=3 or d.iaf.resultat=3;
10 8158 ll:= d.iaf.resultat;
10 8159 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 8160 if ll<>3 then
10 8161 fejlreaktion(21,op_talevej(nr)*100+nr,
10 8162 <:frigiv operatør fejlet:>,1)
10 8163 else
10 8164 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 8165 skriv_skærm_b_v_s(nr);
10 8166 end;
9 8167 disable if testbit14 then
9 8168 begin
10 8169 integer t; <*lav en trap-bar blok*>
10 8170
10 8170 trap(test14_trap);
10 8171 systime(1,0,kommslut);
10 8172 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 8173 string bpl_navn(nr),<: slut :>,case rkom of (
10 8174 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 8175 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 8176 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 8177 <:GE,T:>),<: :>);
10 8178 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 8179 rkom=16 or rkom=17 or rkom=19)
10 8180 then
10 8181 begin
11 8182 if d.opref.data(7)=2 then outchar(zrl,'*');
11 8183 if d.opref.data(9)<>0 then
11 8184 begin
12 8185 skriv_id(zrl,d.opref.data(9),0);
12 8186 outchar(zrl,' ');
12 8187 end;
11 8188 if d.opref.data(8)<>0 then
11 8189 begin
12 8190 skriv_id(zrl,d.opref.data(8),0);
12 8191 outchar(zrl,' ');
12 8192 end;
11 8193 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 8194 d.opref.data(2)<>0 then
11 8195 begin
12 8196 skriv_id(zrl,d.opref.data(2),0);
12 8197 outchar(zrl,' ');
12 8198 end;
11 8199 if d.opref.data(12)<>0 then
11 8200 begin
12 8201 if d.opref.data(12) shift (-20) = 15 then
12 8202 write(zrl,<:OMR*:>)
12 8203 else
12 8204 if d.opref.data(12) shift (-20) = 14 then
12 8205 write(zrl,
12 8206 string områdenavn(d.opref.data(12) extract 20))
12 8207 else
12 8208 skriv_id(zrl,d.opref.data(12),0);
12 8209 outchar(zrl,' ');
12 8210 end;
11 8211 t:= terminal_tab.ref.terminaltilstand extract 10;
11 8212 if res=3 and rkom=1 and
11 8213 (t shift (-4) extract 1 = 1) and
11 8214 (t extract 2 <> 3)
11 8215 then
11 8216 begin
12 8217 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 8218 kanal_beskr_længde;
12 8219 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 8220 extract 12)/100," ",1);
12 8221 end;
11 8222 if d.opref.data(10)<>0 then
11 8223 begin
12 8224 skriv_id(zrl,d.opref.data(10),0);
12 8225 outchar(zrl,' ');
12 8226 end;
11 8227 end
10 8228 else
10 8229 if rkom=10 and par1<>0 then
10 8230 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 8231 else
10 8232 if rkom=5 or rkom=6 then
10 8233 begin
11 8234 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 8235 if par1 shift (-20)=14 then
11 8236 write(zrl,string områdenavn(par1 extract 20));
11 8237 outchar(zrl,' ');
11 8238 end;
10 8239 if op_talevej(nr) > 0 then
10 8240 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 8241 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 8242 <<dd.dd>,kommslut-kommstart);
10 8243 test14_trap: outchar(zrl,'nl');
10 8244 end;
9 8245
9 8245 <*V*> setposition(z_op(nr),0,0);
9 8246 cursor(z_op(nr),24,1);
9 8247 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 8248 end; <* radio-kommando *>
8 8249 begin
9 8250 \f
9 8250 message procedure operatør side 13 - 810518/hko;
9 8251
9 8251 <* 4 stop kommando *>
9 8252
9 8252 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 8253 if tilstand <> 0 then
9 8254 begin
10 8255 d.op_ref.resultat:= 16; <*skærm optaget*>
10 8256 end
9 8257 else
9 8258 begin
10 8259 d.op_ref.retur:= cs_operatør(nr);
10 8260 d.op_ref.resultat:= 0;
10 8261 d.op_ref.data(1):= nr;
10 8262 indeks:= op_ref;
10 8263 <*+2*> if testbit11 and overvåget then
10 8264 disable begin
11 8265 skriv_operatør(out,0);
11 8266 write(out,<: stop_operation til radio:>);
11 8267 skriv_op(out,op_ref); ud;
11 8268 end;
10 8269 <*-2*>
10 8270 if opk_alarm.tab.alarm_tilst > 0 then
10 8271 begin
11 8272 opk_alarm.tab.alarm_kmdo:= 3;
11 8273 signal_bin(bs_opk_alarm);
11 8274 end;
10 8275
10 8275 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 8276 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 8277 <*+2*> if testbit12 and overvåget then
10 8278 disable begin
11 8279 skriv_operatør(out,0);
11 8280 write(out,<: operation retur fra radio:>);
11 8281 skriv_op(out,op_ref); ud;
11 8282 end;
10 8283 <*-2*>
10 8284 <*+4*> if indeks <> op_ref then
10 8285 fejlreaktion(11<*fr.post*>,op_ref,
10 8286 <: operatør, retur fra radio:>,0);
10 8287 <*-4*>
10 8288 \f
10 8288 message procedure operatør side 14 - 810527/hko;
10 8289
10 8289 if d.op_ref.resultat = 3 then
10 8290 begin
11 8291 integer k,n;
11 8292 integer array field msk,iaf1;
11 8293
11 8293 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 8294 +terminal_tab.ref.terminal_tilstand extract 21;
11 8295 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 8296 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 8297 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 8298 begin
12 8299 msk:= k*op_maske_lgd;
12 8300 if læsbit_ia(bpl_def.msk,nr) then
12 8301 <**> begin
13 8302 n:= 0;
13 8303 for i:= 1 step 1 until max_antal_operatører do
13 8304 if læsbit_ia(bpl_def.msk,i) then
13 8305 begin
14 8306 iaf1:= i*terminal_beskr_længde;
14 8307 if terminal_tab.iaf1.terminal_tilstand
14 8308 shift (-21) < 3 then
14 8309 n:= n+1;
14 8310 end;
13 8311 bpl_tilst(k,1):= n;
13 8312 end;
12 8313 <**> <*
12 8314 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 8315 *> end;
11 8316 signal_bin(bs_mobil_opkald);
11 8317 <*V*> setposition(z_op(nr),0,0);
11 8318 ht_symbol(z_op(nr));
11 8319 end;
10 8320 end;
9 8321 <*V*> setposition(z_op(nr),0,0);
9 8322 cursor(z_op(nr),24,1);
9 8323 if d.op_ref.resultat<> 3 then
9 8324 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8325 end;
8 8326 begin
9 8327 boolean l22;
9 8328 \f
9 8328 message procedure operatør side 15 - 810521/cl;
9 8329
9 8329 <* 5 springdefinition *>
9 8330 l22:= false;
9 8331 if sep=',' then
9 8332 disable begin
10 8333 setposition(z_op(nr),0,0);
10 8334 cursor(z_op(nr),22,1);
10 8335 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 8336 l22:= true; pos:= 1;
10 8337 while læstegn(d.op_ref.data,pos,i)<>0 do
10 8338 outchar(z_op(nr),i);
10 8339 end;
9 8340
9 8340 tofrom(d.op_ref.data,ia,indeks*2);
9 8341 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 8342 start_operation(vt_op,200+nr,cs_operatør(nr),
9 8343 101<*opret fil*>);
9 8344 d.vt_op.data(1):=128;<*postantal*>
9 8345 d.vt_op.data(2):=2; <*postlængde*>
9 8346 d.vt_op.data(3):=1; <*segmentantal*>
9 8347 d.vt_op.data(4):=
9 8348 2 shift 10; <*spool fil*>
9 8349 signal_ch(cs_opret_fil,vt_op,op_optype);
9 8350 pos:=vt_op;<*variabel lånes*>
9 8351 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 8352 <*+4*> if vt_op<>pos then
9 8353 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 8354 if d.vt_op.data(9)<>0 then
9 8355 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8356 <:op kommando(springdefinition):>,0);
9 8357 <*-4*>
9 8358 iaf:=0;
9 8359 for i:=1 step 1 until indeks-2 do
9 8360 begin
10 8361 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8362 if k<>0 then
10 8363 fejlreaktion(7<*modif-fil*>,k,
10 8364 <:op kommando(spring-def):>,0);
10 8365 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8366 end;
9 8367 \f
9 8367 message procedure operatør side 15a - 820301/cl;
9 8368
9 8368 while sep = ',' do
9 8369 begin
10 8370 setposition(z_op(nr),0,0);
10 8371 cursor(z_op(nr),23,1);
10 8372 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8373 setposition(z_op(nr),0,0);
10 8374 wait(bs_fortsæt_adgang);
10 8375 pos:= 1; j:= 0;
10 8376 while læs_store(z_op(nr),i) < 8 do
10 8377 begin
11 8378 skrivtegn(fortsæt,pos,i);
11 8379 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8380 end;
10 8381 skrivtegn(fortsæt,pos,'em');
10 8382 afsluttext(fortsæt,pos);
10 8383 sluttegn:= i;
10 8384 if j<>0 then
10 8385 begin
11 8386 setposition(z_op(nr),0,0);
11 8387 cursor(z_op(nr),24,1);
11 8388 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8389 cursor(z_op(nr),1,1);
11 8390 goto sp_ann;
11 8391 end;
10 8392 \f
10 8392 message procedure operatør side 16 - 810521/cl;
10 8393
10 8393 disable begin
11 8394 integer array værdi(1:4);
11 8395 integer a_pos,res;
11 8396 pos:= 0;
11 8397 repeat
11 8398 apos:= pos;
11 8399 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8400 if res >= 0 then
11 8401 begin
12 8402 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8403 else if res=0 then res:= -25 <*parameter mangler*>
12 8404 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8405 res:= -44 <*intervalstørrelse ulovlig*>
12 8406 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8407 res:= -6 <*løbnr ulovligt*>
12 8408 else if res=10 then
12 8409 begin
13 8410 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8411 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8412 <:op kommando(spring-def):>,0);
13 8413 iaf:= 0;
13 8414 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8415 indeks:= indeks+1;
13 8416 if sep = ',' then res:= 0;
13 8417 end
12 8418 else res:= -27; <*parametertype*>
12 8419 end;
11 8420 if res>0 then pos:= a_pos;
11 8421 until sep<>'sp' or res<=0;
11 8422
11 8422 if res<0 then
11 8423 begin
12 8424 d.op_ref.resultat:= -res;
12 8425 i:=1; j:= 1;
12 8426 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8427 afsluttext(d.op_ref.data,i);
12 8428 end;
11 8429 end;
10 8430 \f
10 8430 message procedure operatør side 17 - 810521/cl;
10 8431
10 8431 if d.op_ref.resultat > 3 then
10 8432 begin
11 8433 setposition(z_op(nr),0,0);
11 8434 if l22 then
11 8435 begin
12 8436 cursor(z_op(nr),22,1); l22:= false;
12 8437 write(z_op(nr),"-",80);
12 8438 end;
11 8439 cursor(z_op(nr),24,1);
11 8440 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8441 goto sp_ann;
11 8442 end;
10 8443 if sep=',' then
10 8444 begin
11 8445 setposition(z_op(nr),0,0);
11 8446 cursor(z_op(nr),22,1);
11 8447 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8448 pos:= 1; l22:= true;
11 8449 while læstegn(fortsæt,pos,i)<>0 do
11 8450 outchar(z_op(nr),i);
11 8451 end;
10 8452 signalbin(bs_fortsæt_adgang);
10 8453 end while sep = ',';
9 8454 d.vt_op.data(1):= indeks-2;
9 8455 k:= sætfildim(d.vt_op.data);
9 8456 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8457 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8458 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8459 d.op_ref.retur:=cs_operatør(nr);
9 8460 pos:=op_ref;
9 8461 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8462 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8463 <*+4*> if pos<>op_ref then
9 8464 fejlreaktion(11<*fremmed post*>,op_ref,
9 8465 <:op kommando(springdef retur fra vt):>,0);
9 8466 <*-4*>
9 8467 \f
9 8467 message procedure operatør side 18 - 810521/cl;
9 8468
9 8468 <*V*> setposition(z_op(nr),0,0);
9 8469 if l22 then
9 8470 begin
10 8471 cursor(z_op(nr),22,1);
10 8472 write(z_op(nr),"-",80);
10 8473 end;
9 8474 cursor(z_op(nr),24,1);
9 8475 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8476
9 8476 if false then
9 8477 begin
10 8478 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8479 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8480 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8481 signalbin(bs_fortsæt_adgang);
10 8482 end;
9 8483
9 8483 end;
8 8484
8 8484 begin
9 8485 \f
9 8485 message procedure operatør side 19 - 810522/cl;
9 8486
9 8486 <* 6 spring (igangsæt)
9 8487 spring,annuler
9 8488 spring,reserve *>
9 8489
9 8489 tofrom(d.op_ref.data,ia,6);
9 8490 d.op_ref.retur:=cs_operatør(nr);
9 8491 indeks:=op_ref;
9 8492 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8493 <*V*> wait_ch(cs_operatør(nr),
9 8494 op_ref,
9 8495 op_optype,
9 8496 -1<*timeout*>);
9 8497 <*+2*> if testbit10 and overvåget then
9 8498 disable begin
10 8499 skriv_operatør(out,0);
10 8500 write(out,"nl",1,<:op operation retur fra vt:>);
10 8501 skriv_op(out,op_ref);
10 8502 end;
9 8503 <*-2*>
9 8504 <*+4*> if indeks<>op_ref then
9 8505 fejlreaktion(11<*fremmed post*>,op_ref,
9 8506 <:op kommando(spring):>,0);
9 8507 <*-4*>
9 8508
9 8508 <*V*> setposition(z_op(nr),0,0);
9 8509 cursor(z_op(nr),24,1);
9 8510 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8511 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8512 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8513 end;
8 8514
8 8514 begin
9 8515 \f
9 8515 message procedure operatør side 20 - 810525/cl;
9 8516
9 8516 <* 7 spring(-oversigts-)rapport *>
9 8517
9 8517 d.op_ref.retur:=cs_operatør(nr);
9 8518 tofrom(d.op_ref.data,ia,4);
9 8519 indeks:=op_ref;
9 8520 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8521 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8522 <*+2*> disable if testbit10 and overvåget then
9 8523 begin
10 8524 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8525 skriv_op(out,op_ref);
10 8526 end;
9 8527 <*-2*>
9 8528
9 8528 <*+4*> if op_ref<>indeks then
9 8529 fejlreaktion(11<*fremmed post*>,op_ref,
9 8530 <:op kommando(spring-rapport):>,0);
9 8531 <*-4*>
9 8532
9 8532 <*V*> setposition(z_op(nr),0,0);
9 8533 if d.op_ref.resultat<>3 then
9 8534 begin
10 8535 cursor(z_op(nr),24,1);
10 8536 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8537 end
9 8538 else
9 8539 begin
10 8540 boolean p_skrevet;
10 8541 integer bogst,løb;
10 8542
10 8542 skærmmåde:= 1;
10 8543
10 8543 if kode = 32 then <* spring,vis *>
10 8544 begin
11 8545 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8546 bogst:= d.op_ref.data(1) extract 5;
11 8547 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8548 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8549 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8550 <:spring: :>,
11 8551 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8552 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8553 raf:= data+8;
11 8554 if d.op_ref.raf(1)<>0.0 then
11 8555 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8556 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8557 else write(z_op(nr),<:, ikke startet:>);
11 8558 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8559 \f
11 8559 message procedure operatør side 21 - 810522/cl;
11 8560
11 8560 p_skrevet:= false;
11 8561 for pos:=1 step 1 until d.op_ref.data(3) do
11 8562 begin
12 8563 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8564 if i<>0 then
12 8565 fejlreaktion(5<*læsfil*>,i,
12 8566 <:op kommando(spring,vis):>,0);
12 8567 iaf:=0;
12 8568 i:= fil(j).iaf(1);
12 8569 if i < 0 and -, p_skrevet then
12 8570 begin
13 8571 outchar(z_op(nr),'('); p_skrevet:= true;
13 8572 end;
12 8573 if i > 0 and p_skrevet then
12 8574 begin
13 8575 outchar(z_op(nr),')'); p_skrevet:= false;
13 8576 end;
12 8577 if pos mod 2 = 0 then
12 8578 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8579 else
12 8580 write(z_op(nr),true,3,<<d>,abs i);
12 8581 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8582 end;
11 8583 write(z_op(nr),"*",1);
11 8584 \f
11 8584 message procedure operatør side 22 - 810522/cl;
11 8585
11 8585 end
10 8586 else if kode=33 then <* spring,oversigt *>
10 8587 begin
11 8588 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8589 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8590 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8591
11 8591 for pos:=1 step 1 until d.op_ref.data(1) do
11 8592 begin
12 8593 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8594 if i<>0 then
12 8595 fejlreaktion(5<*læsfil*>,i,
12 8596 <:op kommando(spring-oversigt):>,0);
12 8597 iaf:=0;
12 8598 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8599 bogst:=fil(j).iaf(1) extract 5;
12 8600 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8601 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8602 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8603 string (extend fil(j).iaf(2) shift 24));
12 8604 if fil(j,2)<>0.0 then
12 8605 write(z_op(nr),<:startet :>,<<zddddd>,
12 8606 round systime(4,fil(j,2),r),<:.:>,round r);
12 8607 outchar(z_op(nr),'nl');
12 8608 end;
11 8609 write(z_op(nr),"*",1);
11 8610 end;
10 8611 <* slet fil *>
10 8612 d.op_ref.opkode:= 104;
10 8613 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8614 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8615 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8616 end; <* resultat=3 *>
9 8617
9 8617 end;
8 8618
8 8618 begin
9 8619 \f
9 8619 message procedure operatør side 23 - 940522/cl;
9 8620
9 8620
9 8620 <* 8 SLUT *>
9 8621 trapmode:= 1 shift 13;
9 8622 trap(-2);
9 8623 end;
8 8624
8 8624 begin
9 8625 <* 9 stopniveauer,definer *>
9 8626 integer fno;
9 8627
9 8627 for i:= 1 step 1 until 3 do
9 8628 operatør_stop(nr,i):= ia(i+1);
9 8629 i:= modif_fil(tf_stoptabel,nr,fno);
9 8630 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8631 iaf:=0;
9 8632 for i:= 0,1,2,3 do
9 8633 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8634 setposition(fil(fno),0,0);
9 8635 setposition(z_op(nr),0,0);
9 8636 cursor(z_op(nr),24,1);
9 8637 skriv_kvittering(z_op(nr),0,-1,3);
9 8638 end;
8 8639
8 8639 begin
9 8640 \f
9 8640 message procedure operatør side 24 - 940522/cl;
9 8641
9 8641 <* 10 stopniveauer,vis *>
9 8642 integer bpl,j,k;
9 8643
9 8643 skærm_måde:= 1;
9 8644 setposition(z_op(nr),0,0);
9 8645 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8646 <:stopniveauer: :>);
9 8647 for i:= 0 step 1 until 3 do
9 8648 begin
10 8649 bpl:= operatør_stop(nr,i);
10 8650 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8651 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8652 end;
9 8653 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8654 j:=0;
9 8655 for bpl:= 1 step 1 until max_antal_operatører do
9 8656 if bpl_navn(bpl)<>long<::> then
9 8657 begin
10 8658 if j mod 8 = 0 and j > 0 then
10 8659 write(z_op(nr),"nl",1,"sp",18);
10 8660 iaf:= bpl*terminal_beskr_længde;
10 8661 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8662 true,6,string bpl_navn(bpl));
10 8663 j:=j+1;
10 8664 end;
9 8665 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8666 j:=0;
9 8667 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8668 if bpl_navn(bpl)<>long<::> then
9 8669 begin
10 8670 if j mod 8 = 0 and j > 0 then
10 8671 write(z_op(nr),"nl",1,"sp",19);
10 8672 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8673 j:=j+1;
10 8674 end;
9 8675 write(z_op(nr),"nl",1,"*",1);
9 8676 end;
8 8677
8 8677 begin
9 8678 <* 11 alarmlængde *>
9 8679 integer fno;
9 8680
9 8680 if indeks > 0 then
9 8681 begin
10 8682 opk_alarm.tab.alarm_lgd:= ia(1);
10 8683 i:= modiffil(tf_alarmlgd,nr,fno);
10 8684 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8685 iaf:= 0;
10 8686 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8687 setposition(fil(fno),0,0);
10 8688 end;
9 8689
9 8689 setposition(z_op(nr),0,0);
9 8690 cursor(z_op(nr),24,1);
9 8691 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8692 end;
8 8693
8 8693 begin
9 8694 <* 12 CC *>
9 8695 integer i, c;
9 8696
9 8696 i:= 1;
9 8697 while læstegn(ia,i+0,c)<>0 and
9 8698 i<(op_spool_postlgd-op_spool_text)//2*3
9 8699 do skrivtegn(d.opref.data,i,c);
9 8700 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8701
9 8701 d.opref.retur:= cs_operatør(nr);
9 8702 signalch(cs_op_spool,opref,op_optype);
9 8703 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8704
9 8704 setposition(z_op(nr),0,0);
9 8705 cursor(z_op(nr),24,1);
9 8706 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8707 end;
8 8708
8 8708 <* 13 EXkluder skærmen *>
8 8709 begin
9 8710 d.opref.resultat:= 2;
9 8711 setposition(z_op(nr),0,0);
9 8712 cursor(z_op(nr),24,1);
9 8713 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8714
9 8714 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8715 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8716 d.vt_op.data(1):= nr;
9 8717 signalch(cs_rad,vt_op,gen_optype);
9 8718 end;
8 8719
8 8719 begin
9 8720 <* 14 CQF-tabel,vis *>
9 8721
9 8721 skærm_måde:= 1;
9 8722 setposition(z_op(nr),0,0);
9 8723 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8724 "esc" add 128,1,<:ÆJ:>);
9 8725 skriv_cqf_tabel(z_op(nr),false);
9 8726 write(z_op(nr),"*",1);
9 8727 end;
8 8728
8 8728 begin
9 8729 <* 15 ALarmlyd,Test *>
9 8730 integer array field tab;
9 8731 integer res;
9 8732
9 8732 tab:= (nr-1)*opk_alarm_tab_lgd;
9 8733 setposition(z_op(nr),0,0);
9 8734 if ia(1)<1 or ia(1)>2 then
9 8735 res:= 64 <* ulovligt tal *>
9 8736 else if opk_alarm.tab.alarm_lgd = 0 then
9 8737 begin
10 8738 if ia(1)=2 then
10 8739 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
10 8740 else
10 8741 write(z_op(nr),"bel",1);
10 8742 res:= 3;
10 8743 end
9 8744 else if ia(1) > opk_alarm.tab.alarm_tilst and
9 8745 ia(1) > opk_alarm.tab.alarm_kmdo then
9 8746 begin
10 8747 opk_alarm.tab.alarm_kmdo:= ia(1);
10 8748 signal_bin(bs_opk_alarm);
10 8749 res:= 3;
10 8750 end
9 8751 else
9 8752 res:= 48; <* i brug *>
9 8753
9 8753 cursor(z_op(nr),24,1);
9 8754 skriv_kvittering(z_op(nr),opref,-1,res);
9 8755 end;
8 8756
8 8756 begin
9 8757 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8758 setposition(z_op(nr),0,0);
9 8759 cursor(z_op(nr),24,1);
9 8760 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8761 end;
8 8762 \f
8 8762 message procedure operatør side x - 810522/hko;
8 8763
8 8763 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8764 <*-4*>
8 8765 end;<*case j *>
7 8766 end <* j > 0 *>
6 8767 else
6 8768 begin
7 8769 <*V*> setposition(z_op(nr),0,0);
7 8770 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8771 skriv_kvittering(z_op(nr),op_ref,-1,
7 8772 45 <*ikke implementeret *>);
7 8773 end;
6 8774 end;<* godkendt *>
5 8775
5 8775 <*V*> setposition(z_op(nr),0,0);
5 8776 <*???*>
5 8777 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8778 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8779 skærmmåde = 0 do
5 8780 begin
6 8781 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8782 begin
7 8783 skriv_skærm_bvs(nr);
7 8784 <*940920 if op_talevej(nr)=0 then status:= 0
7 8785 else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8786 if status>0 then
7 8787 begin
7 8788 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8789 terminaltab.ref(ll):= 0;
7 8790 skriv_skærm_bvs(nr);
7 8791 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8792 end;
7 8793 for i:= 1 step 1 until max_antal_kanaler do
7 8794 begin
7 8795 iaf:= (i-1)*kanalbeskrlængde;
7 8796 inspect(ss_samtale_nedlagt(i),status);
7 8797 if status>0 and
7 8798 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8799 begin
7 8800 kanaltab.iaf.kanal_tilstand:=
7 8801 kanaltab.iaf(1) shift (-10) extract 6 shift 10;
7 8802 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8803 kanaltab.iaf(ll):= 0;
7 8804 skriv_skærm_kanal(nr,i);
7 8805 repeat
7 8806 wait(ss_samtale_nedlagt(i));
7 8807 inspect(ss_samtale_nedlagt(i),status);
7 8808 until status=0;
7 8809 end;
7 8810 end;
7 8811 940920*> cursor(z_op(nr),1,1);
7 8812 setposition(z_op(nr),0,0);
7 8813 end;
6 8814 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8815 and skærmmåde = 0
6 8816 and læsbit_ia(operatørmaske,nr) then
6 8817 begin
7 8818 if sætbit_ia(opkaldsflag,nr,0) = 1 then
7 8819 skriv_skærm_opkaldskø(nr);
7 8820 if sætbit_ia(kanalflag,nr,0) = 1 then
7 8821 begin
8 8822 for i:= 1 step 1 until max_antal_kanaler do
8 8823 skriv_skærm_kanal(nr,i);
8 8824 end;
7 8825 cursor(z_op(nr),1,1);
7 8826 <*V*> setposition(z_op(nr),0,0);
7 8827 end;
6 8828 end;
5 8829 d.op_ref.retur:=cs_att_pulje;
5 8830 disable afslut_kommando(op_ref);
5 8831 end; <* indlæs kommando *>
4 8832
4 8832 begin
5 8833 \f
5 8833 message procedure operatør side x+1 - 810617/hko;
5 8834
5 8834 <* 2: inkluder *>
5 8835 integer k,n;
5 8836 integer array field msk,iaf1;
5 8837
5 8837 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8838 if i=0 then
5 8839 begin
6 8840 fejlreaktion(3<*programfejl*>,nr,
6 8841 <:operatør(nr) eksisterer ikke:>,1);
6 8842 d.op_ref.resultat:=28;
6 8843 end
5 8844 else
5 8845 begin
6 8846 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8847 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8848 else if d.op_ref.opkode = 0 then 0
6 8849 else 3;<*udført*>
6 8850 if i > 0 then
6 8851 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8852 <:operatørskærm reservation:>,1)
6 8853 else
6 8854 begin
7 8855 i:=terminal_tab.ref.terminal_tilstand;
7 8856 <*940418/cl inkluderet sættes i stop - start *>
7 8857 kode:= d.opref.opkode extract 12;
7 8858 if kode <> 0 then
7 8859 terminal_tab.ref.terminal_tilstand:=
7 8860 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8861 else
7 8862 <*940418/cl inkluderet sættes i stop - slut *>
7 8863 terminal_tab.ref.terminal_tilstand:= i extract
7 8864 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8865 for i:= 1 step 1 until max_antal_kanaler do
7 8866 begin
8 8867 iaf:= (i-1)*kanalbeskrlængde;
8 8868 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8869 end;
7 8870 skærm_måde:= 0;
7 8871 sætbit_ia(operatørmaske,nr,
7 8872 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8873 then 0 else 1));
7 8874 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8875 begin
8 8876 msk:= k*op_maske_lgd;
8 8877 if læsbit_ia(bpl_def.msk,nr) then
8 8878 <**> begin
9 8879 n:= 0;
9 8880 for i:= 1 step 1 until max_antal_operatører do
9 8881 if læsbit_ia(bpl_def.msk,i) then
9 8882 begin
10 8883 iaf1:= i*terminal_beskr_længde;
10 8884 if terminal_tab.iaf1.terminal_tilstand
10 8885 shift (-21) < 3 then
10 8886 n:= n+1;
10 8887 end;
9 8888 bpl_tilst(k,1):= n;
9 8889 end;
8 8890 <**> <*
8 8891 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8892 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8893 *> end;
7 8894 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8895 sætbit_ia(opkaldsflag,nr,0);
7 8896 signal_bin(bs_mobil_opkald);
7 8897 <*940418/cl inkluderet sættes i stop - start *>
7 8898 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8899 <*V*> ht_symbol(z_op(nr))
7 8900 else
7 8901 <*940418/cl inkluderet sættes i stop - slut *>
7 8902 <*V*> skriv_skærm(nr);
7 8903 cursor(z_op(nr),24,1);
7 8904 <*V*> setposition(z_op(nr),0,0);
7 8905 end;
6 8906 end;
5 8907 if d.op_ref.opkode = 0 then
5 8908 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8909 else
5 8910 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8911 end;
4 8912
4 8912 begin
5 8913 \f
5 8913 message procedure operatør side x+2 - 820304/hko;
5 8914
5 8914 <* 3: ekskluder *>
5 8915 integer k,n;
5 8916 integer array field iaf1,msk;
5 8917
5 8917 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8918 <*V*> setposition(z_op(nr),0,0);
5 8919 monitor(10) release process:(z_op(nr),0,ia);
5 8920 d.op_ref.resultat:=3;
5 8921 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8922 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8923 terminal_tab.ref.terminal_tilstand extract 21;
5 8924 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8925 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8926 begin
6 8927 msk:= k*op_maske_lgd;
6 8928 if læsbit_ia(bpl_def.msk,nr) then
6 8929 <**> begin
7 8930 n:= 0;
7 8931 for i:= 1 step 1 until max_antal_operatører do
7 8932 if læsbit_ia(bpl_def.msk,i) then
7 8933 begin
8 8934 iaf1:= i*terminal_beskr_længde;
8 8935 if terminal_tab.iaf1.terminal_tilstand
8 8936 shift (-21) < 3 then
8 8937 n:= n+1;
8 8938 end;
7 8939 bpl_tilst(k,1):= n;
7 8940 end;
6 8941 <**> <*
6 8942 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8943 *> end;
5 8944 signal_bin(bs_mobil_opkald);
5 8945 if opk_alarm.tab.alarm_tilst > 0 then
5 8946 begin
6 8947 opk_alarm.tab.alarm_kmdo:= 3;
6 8948 signal_bin(bs_opk_alarm);
6 8949 end;
5 8950 end;
4 8951 begin
5 8952
5 8952 <* 4: opdater skærm *>
5 8953
5 8953 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8954 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8955 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8956 skærmmåde=0 do
5 8957 begin
6 8958
6 8958 <*+2*> if testbit13 and overvåget then
6 8959 disable begin
7 8960 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8961 <:) opkaldsflag::>,"nl",1);
7 8962 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8963 write(out,<: operatørmaske::>,"nl",1);
7 8964 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8965 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8966 ud;
7 8967 end;
6 8968 <*-2*>
6 8969 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8970 begin
7 8971 skriv_skærm_bvs(nr);
7 8972 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8973 if status>0 then
7 8974 begin
7 8975 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8976 terminaltab.ref(ll):= 0;
7 8977 skriv_skærm_bvs(nr);
7 8978 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8979 end;
7 8980 for i:= 1 step 1 until max_antal_kanaler do
7 8981 begin
7 8982 iaf:= (i-1)*kanalbeskrlængde;
7 8983 inspect(ss_samtale_nedlagt(i),status);
7 8984 if status>0 and
7 8985 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8986 begin
7 8987 kanaltab.iaf.kanal_tilstand:=
7 8988 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8989 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8990 kanaltab.iaf(ll):= 0;
7 8991 skriv_skærm_kanal(nr,i);
7 8992 repeat
7 8993 wait(ss_samtale_nedlagt(i));
7 8994 inspect(ss_samtale_nedlagt(i),status);
7 8995 until status=0;
7 8996 end;
7 8997 end;
7 8998 940920*> cursor(z_op(nr),1,1);
7 8999 setposition(z_op(nr),0,0);
7 9000 end;
6 9001 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 9002 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9003 begin
7 9004 <*V*> setposition(z_op(nr),0,0);
7 9005 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 9006 skriv_skærm_opkaldskø(nr);
7 9007 if sætbit_ia(kanalflag,nr,0) =1 then
7 9008 begin
8 9009 for i:=1 step 1 until max_antal_kanaler do
8 9010 skriv_skærm_kanal(nr,i);
8 9011 end;
7 9012 cursor(z_op(nr),1,1);
7 9013 <*V*> setposition(z_op(nr),0,0);
7 9014 end;
6 9015 end;
5 9016 end;
4 9017 begin
5 9018 \f
5 9018 message procedure operatør side x+3 - 830310/hko;
5 9019
5 9019 <* 5: samtale etableret *>
5 9020
5 9020 res:= d.op_ref.resultat;
5 9021 b_v:= d.op_ref.data(3) extract 4;
5 9022 b_s:= d.op_ref.data(4);
5 9023 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9024 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 9025 begin
6 9026 sætbit_i(terminal_tab.ref(1),21,1);
6 9027 sætbit_i(terminal_tab.ref(1),22,0);
6 9028 sætbit_i(terminal_tab.ref(1),2,0);
6 9029 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9030 terminal_tab.ref(2):= b_s;
6 9031 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 9032 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 9033 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 9034 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 9035
6 9035 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9036 begin
7 9037 <*V*> setposition(z_op(nr),0,0);
7 9038 skriv_skærm_b_v_s(nr);
7 9039 <*V*> setposition(z_op(nr),0,0);
7 9040 end;
6 9041 end
5 9042 else
5 9043 if terminal_tab.ref(1) shift(-21) = 2 then
5 9044 begin
6 9045 sætbit_i(terminal_tab.ref(1),22,0);
6 9046 sætbit_i(terminal_tab.ref(1),2,0);
6 9047 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 9048 terminal_tab.ref(2):= 0;
6 9049 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 9050 begin
7 9051 <*V*> setposition(z_op(nr),0,0);
7 9052 cursor(z_op(nr),21,17);
7 9053 write(z_op(nr),<:EJ FORB:>);
7 9054 <*V*> setposition(z_op(nr),0,0);
7 9055 end;
6 9056 end
5 9057 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 9058 <:terminal tilstand:>,1);
5 9059 end;
4 9060
4 9060 begin
5 9061 \f
5 9061 message procedure operatør side x+4 - 810602/hko;
5 9062
5 9062 <* 6: radiokanal ekskluderet *>
5 9063
5 9063 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 9064 pos:= d.op_ref.data(1);
5 9065 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9066 indeks:= terminal_tab.ref(2);
5 9067 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 9068 then indeks extract 4 else 0;
5 9069 if b_v = pos then
5 9070 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 9071 if b_s = pos then
5 9072 begin
6 9073 terminal_tab.ref(2):= 0;
6 9074 sætbit_i(terminal_tab.ref(1),21,0);
6 9075 sætbit_i(terminal_tab.ref(1),22,0);
6 9076 sætbit_i(terminal_tab.ref(1),2,0);
6 9077 end;
5 9078 if skærmmåde=0 then
5 9079 begin
6 9080 if b_v = pos or b_s = pos then
6 9081 <*V*> skriv_skærm_b_v_s(nr);
6 9082 <*V*> skriv_skærm_kanal(nr,pos);
6 9083 cursor(z_op(nr),1,1);
6 9084 setposition(z_op(nr),0,0);
6 9085 end;
5 9086 end;
4 9087
4 9087 begin
5 9088 \f
5 9088 message procedure operatør side x+5 - 950118/cl;
5 9089
5 9089 <* 7: operatørmeddelelse *>
5 9090 integer afs, kl, i;
5 9091 real dato, t;
5 9092
5 9092 cursor(z_op(nr),24,1);
5 9093 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9094 cursor(z_op(nr),23,1);
5 9095 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 9096
5 9096 afs:= d.opref.data.op_spool_kilde;
5 9097 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 9098 kl:= round t;
5 9099 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 9100 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 9101 i:= replacechar(1,'.');
5 9102 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 9103 replacechar(1,i);
5 9104 write(z_op(nr),d.opref.data.op_spool_text);
5 9105
5 9105 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 9106 begin
6 9107 if opk_alarm.tab.alarm_lgd > 0 and
6 9108 opk_alarm.tab.alarm_tilst < 1 and
6 9109 opk_alarm.tab.alarm_kmdo < 1
6 9110 then
6 9111 begin
7 9112 opk_alarm.tab.alarm_kmdo := 1;
7 9113 signalbin(bs_opk_alarm);
7 9114 end
6 9115 else
6 9116 if opk_alarm.tab.alarm_lgd = 0 then
6 9117 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 9118 end;
5 9119
5 9119 setposition(z_op(nr),0,0);
5 9120
5 9120 signalch(d.opref.retur,opref,d.opref.optype);
5 9121 end;
4 9122
4 9122 begin
5 9123
5 9123 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 9124 <*-4*>
5 9125 end
4 9126 end; <* case aktion+6 *>
3 9127
3 9127 until false;
3 9128 op_trap:
3 9129 skriv_operatør(zbillede,1);
3 9130 end operatør;
2 9131
2 9131 \f
2 9131 message procedure op_cqftest side 1;
2 9132
2 9132 procedure op_cqftest;
2 9133 begin
3 9134 integer array field opref, ref, ref1;
3 9135 integer i, j, tv, cqf, res, pausetid;
3 9136 real nu, næstetid, kommstart, kommslut;
3 9137
3 9137 procedure skriv_op_cqftest(zud,omfang);
3 9138 value omfang;
3 9139 zone zud;
3 9140 integer omfang;
3 9141 begin
4 9142 write(zud,"nl",1,<:+++ op-cqftest:>);
4 9143 if omfang > 0 then
4 9144 disable begin
5 9145 real t;
5 9146
5 9146 trap(slut);
5 9147 write(zud,"nl",1,
5 9148 <: opref: :>,opref,"nl",1,
5 9149 <: ref: :>,ref,"nl",1,
5 9150 <: i: :>,i,"nl",1,
5 9151 <: tv: :>,tv,"nl",1,
5 9152 <: cqf: :>,cqf,"nl",1,
5 9153 <: res: :>,res,"nl",1,
5 9154 <: pausetid: :>,pausetid,"nl",1,
5 9155 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 9156 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 9157 <::>);
5 9158 skriv_coru(zud,coru_no(292));
5 9159 slut:
5 9160 end;
4 9161 end skriv_op_cqftest;
3 9162
3 9162 trap(op_cqf_trap);
3 9163 stackclaim(1000);
3 9164
3 9164
3 9164 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9165 skriv_op_cqftest(out,0);
3 9166 <*-4*>
3 9167
3 9167 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 9168 repeat
3 9169 i:= sidste_tv_brugt; tv:= 0;
3 9170 repeat
3 9171 i:= (i mod max_antal_taleveje) + 1;
3 9172 if tv_operatør(i) = 0 then tv:= i;
3 9173 until (tv<>0) or (i=sidste_tv_brugt);
3 9174
3 9174 if tv<>0 then
3 9175 begin
4 9176 tv_operatør(tv):= -1;
4 9177 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 9178 for cqf:= 1 step 1 until max_cqf do
4 9179 begin
5 9180 ref:= (cqf-1)*cqf_lgd;
5 9181 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 9182 begin
6 9183 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 9184 d.opref.data(1):= tv;
6 9185 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 9186 disable if testbit19 then
6 9187 begin
7 9188 integer i; <*lav en trap-bar blok*>
7 9189
7 9189 trap(test19_trap);
7 9190 systime(1,0,kommstart);
7 9191 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 9192 skriv_id(zrl,d.opref.data(2),0);
7 9193 test19_trap: outchar(zrl,'nl');
7 9194 end;
6 9195 signalch(cs_rad,opref,op_optype or gen_optype);
6 9196 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 9197 res:= d.opref.resultat;
6 9198 <*+2*>
6 9199 disable if testbit19 then
6 9200 begin
7 9201 integer i; <*lav en trap-bar blok*>
7 9202
7 9202 trap(test19_trap);
7 9203 systime(1,0,kommslut);
7 9204 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 9205 if d.opref.data(7)=2 then outchar(zrl,'*');
7 9206 if d.opref.data(9)<>0 then
7 9207 begin
8 9208 skriv_id(zrl,d.opref.data(9),0);
8 9209 outchar(zrl,' ');
8 9210 end;
7 9211 if d.opref.data(8)<>0 then
7 9212 begin
8 9213 skriv_id(zrl,d.opref.data(8),0);
8 9214 outchar(zrl,' ');
8 9215 end;
7 9216 if d.opref.data(12)<>0 then
7 9217 begin
8 9218 if d.opref.data(12) shift (-20) = 15 then
8 9219 write(zrl,<:OMR*:>)
8 9220 else
8 9221 if d.opref.data(12) shift (-20) = 14 then
8 9222 write(zrl,
8 9223 string områdenavn(d.opref.data(12) extract 20))
8 9224 else
8 9225 skriv_id(zrl,d.opref.data(12),0);
8 9226 outchar(zrl,' ');
8 9227 end;
7 9228 if d.opref.data(10)<>0 then
7 9229 begin
8 9230 skriv_id(zrl,d.opref.data(10),0);
8 9231 outchar(zrl,' ');
8 9232 end;
7 9233 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 9234 <<dd.dd>,kommslut-kommstart);
7 9235 test19_trap: outchar(zrl,'nl');
7 9236 end;
6 9237 <*-2*>
6 9238 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 9239 begin
7 9240 delay(3);
7 9241 d.opref.opkode:= 12 shift 12 + 41;
7 9242 d.opref.resultat:= 0;
7 9243 disable if testbit19 then
7 9244 begin
8 9245 integer i; <*lav en trap-bar blok*>
8 9246
8 9246 trap(test19_trap);
8 9247 systime(1,0,kommstart);
8 9248 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 9249 test19_trap: outchar(zrl,'nl');
8 9250 end;
7 9251 signalch(cs_rad,opref,op_optype or gen_optype);
7 9252 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 9253 <*+2*>
7 9254 disable if testbit19 then
7 9255 begin
8 9256 integer i; <*lav en trap-bar blok*>
8 9257
8 9257 trap(test19_trap);
8 9258 systime(1,0,kommslut);
8 9259 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 9260 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 9261 <<dd.dd>,kommslut-kommstart);
8 9262 test19_trap: outchar(zrl,'nl');
8 9263 end;
7 9264 <*-2*>
7 9265 if d.opref.resultat <> 3 then
7 9266 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 9267 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 9268 begin
8 9269 startoperation(opref,292,cs_cqf,23);
8 9270 i:= 1;
8 9271 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9272 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9273 skriv_tegn(d.opref.data,i,' ');
8 9274 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9275 hægtstring(d.opref.data,i,<: ok!:>);
8 9276 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9277 signalch(cs_io,opref,gen_optype);
8 9278 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9279 end;
7 9280 if cqf_tabel.ref.cqf_bus > 0 then
7 9281 begin
8 9282 cqf_tabel.ref.cqf_fejl:= 0;
8 9283 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 9284 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 9285 end;
7 9286 end <*res=3*>
6 9287 else
6 9288 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 9289 cqf_tabel.ref.cqf_bus > 0
6 9290 then
6 9291 begin
7 9292 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 9293 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 9294 if cqf_tabel.ref.cqf_fejl >= 2 then
7 9295 begin
8 9296 startoperation(opref,292,cs_cqf,23);
8 9297 i:= 1;
8 9298 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9299 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9300 skriv_tegn(d.opref.data,i,' ');
8 9301 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9302 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 9303 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9304 signalch(cs_io,opref,gen_optype);
8 9305 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9306 end;
7 9307 end;
6 9308 delay(10);
6 9309 end;
5 9310 if cqf_tabel.ref.cqf_bus > 0 and
5 9311 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 9312 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 9313 end; <*for cqf*>
4 9314
4 9314 tv_operatør(tv):= 0; tv:= 0;
4 9315 if op_cqf_tab_ændret then
4 9316 begin
5 9317 j:= skrivfil(1033,1,i);
5 9318 if j<>0 then
5 9319 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 9320 sorter_cqftab(1,max_cqf);
5 9321 for cqf:= 1 step 1 until max_cqf do
5 9322 begin
6 9323 ref:= (cqf-1)*cqf_lgd;
6 9324 ref1:= (cqf-1)*cqf_id;
6 9325 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 9326 end;
5 9327 op_cqf_tab_ændret:= false;
5 9328 end;
4 9329 end; <*tv*>
3 9330
3 9330 systime(1,0.0,nu);
3 9331 pausetid:= round(næste_tid - nu);
3 9332 if pausetid < 30 then pausetid:= 30;
3 9333
3 9333 <*V*> delay(pausetid);
3 9334
3 9334 until false;
3 9335
3 9335 op_cqf_trap:
3 9336 disable skriv_op_cqftest(zbillede,1);
3 9337 end op_cqftest;
2 9338 \f
2 9338 message procedure op_spool side 1;
2 9339
2 9339 procedure op_spool;
2 9340 begin
3 9341 integer array field opref, ref;
3 9342 integer næste_tomme, i;
3 9343
3 9343 procedure skriv_op_spool(zud,omfang);
3 9344 value omfang;
3 9345 zone zud;
3 9346 integer omfang;
3 9347 begin
4 9348 write(zud,"nl",1,<:+++ op-spool:>);
4 9349 if omfang > 0 then
4 9350 disable begin
5 9351 real t;
5 9352
5 9352 trap(slut);
5 9353 write(zud,"nl",1,
5 9354 <: opref: :>,opref,"nl",1,
5 9355 <: næste-tomme: :>,næste_tomme,"nl",1,
5 9356 <: ref: :>,ref,"nl",1,
5 9357 <: i: :>,i,"nl",1,
5 9358 <::>);
5 9359 skriv_coru(zud,coru_no(293));
5 9360 slut:
5 9361 end;
4 9362 end skriv_op_spool;
3 9363
3 9363 trap(op_spool_trap);
3 9364 stackclaim(400);
3 9365
3 9365 næste_tomme:= 0;
3 9366
3 9366 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9367 skriv_op_spool(out,0);
3 9368 <*-4*>
3 9369
3 9369 repeat
3 9370 <*V*> waitch(cs_op_spool,opref,true,-1);
3 9371 inspect(ss_op_spool_tomme,i);
3 9372
3 9372 if d.opref.opkode extract 12 <> 37 then
3 9373 begin
4 9374 d.opref.resultat:= 31;
4 9375 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 9376 end
3 9377 else
3 9378 if i<=0 then
3 9379 d.opref.resultat:= 32 <*ingen fri plads*>
3 9380 else
3 9381 begin
4 9382 <*V*> wait(ss_op_spool_tomme);
4 9383 ref:= næste_tomme*op_spool_postlgd;
4 9384 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9385 i:= d.opref.opsize - data;
4 9386 if i > (op_spool_postlgd - op_spool_text) then
4 9387 i:= (op_spool_postlgd - op_spool_text);
4 9388 op_spool_buf.ref.op_spool_kilde:=
4 9389 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9390 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9391 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9392 op_spool_buf.ref(op_spool_postlgd//2):=
4 9393 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9394 d.opref.resultat:= 3;
4 9395
4 9395 signal(ss_op_spool_fulde);
4 9396 end;
3 9397
3 9397 signalch(d.opref.retur,opref,d.opref.optype);
3 9398 until false;
3 9399
3 9399 op_spool_trap:
3 9400 disable skriv_op_spool(zbillede,1);
3 9401 end op_spool;
2 9402 \f
2 9402 message procedure op_medd side 1;
2 9403
2 9403 procedure op_medd;
2 9404 begin
3 9405 integer array field opref, ref;
3 9406 integer næste_fulde, i;
3 9407
3 9407 procedure skriv_op_medd(zud,omfang);
3 9408 value omfang;
3 9409 zone zud;
3 9410 integer omfang;
3 9411 begin
4 9412 write(zud,"nl",1,<:+++ op-medd:>);
4 9413 if omfang > 0 then
4 9414 disable begin
5 9415 real t;
5 9416
5 9416 trap(slut);
5 9417 write(zud,"nl",1,
5 9418 <: opref: :>,opref,"nl",1,
5 9419 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9420 <: ref: :>,ref,"nl",1,
5 9421 <: i: :>,i,"nl",1,
5 9422 <::>);
5 9423 skriv_coru(zud,coru_no(294));
5 9424 slut:
5 9425 end;
4 9426 end skriv_op_medd;
3 9427
3 9427 trap(op_medd_trap);
3 9428 næste_fulde:= 0;
3 9429 stackclaim(400);
3 9430
3 9430 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9431 skriv_op_medd(out,0);
3 9432 <*-4*>
3 9433
3 9433 repeat
3 9434 <*V*> wait(ss_op_spool_fulde);
3 9435 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9436
3 9436 ref:= næste_fulde*op_spool_postlgd;
3 9437 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9438
3 9438 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9439 d.opref.resultat:= 0;
3 9440 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9441 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9442 opref,gen_optype);
3 9443 signal(ss_op_spool_tomme);
3 9444 until false;
3 9445
3 9445 op_medd_trap:
3 9446 disable skriv_op_medd(zbillede,1);
3 9447 end op_medd;
2 9448 \f
2 9448 message procedure alarmur side 1;
2 9449
2 9449 procedure alarmur;
2 9450 begin
3 9451 integer ventetid, nr;
3 9452 integer array field opref, tab;
3 9453 real nu;
3 9454
3 9454 procedure skriv_alarmur(zud,omfang);
3 9455 value omfang;
3 9456 zone zud;
3 9457 integer omfang;
3 9458 begin
4 9459 write(zud,"nl",1,<:+++ alarmur:>);
4 9460 if omfang > 0 then
4 9461 disable begin
5 9462 real t;
5 9463
5 9463 trap(slut);
5 9464 write(zud,"nl",1,
5 9465 <: ventetid: :>,ventetid,"nl",1,
5 9466 <: nr: :>,nr,"nl",1,
5 9467 <: opref: :>,opref,"nl",1,
5 9468 <: tab: :>,tab,"nl",1,
5 9469 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9470 <::>);
5 9471 skriv_coru(zud,coru_no(295));
5 9472 slut:
5 9473 end;
4 9474 end skriv_alarmur;
3 9475
3 9475 trap(alarmur_trap);
3 9476 stackclaim(400);
3 9477
3 9477 systime(1,0.0,nu);
3 9478 ventetid:= -1;
3 9479 repeat
3 9480 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9481 if opref > 0 then
3 9482 signalch(d.opref.retur,opref,op_optype);
3 9483
3 9483 ventetid:= -1;
3 9484 systime(1,0.0,nu);
3 9485 for nr:= 1 step 1 until max_antal_operatører do
3 9486 begin
4 9487 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9488 if opk_alarm.tab.alarm_tilst > 0 and
4 9489 opk_alarm.tab.alarm_lgd >= 0 then
4 9490 begin
5 9491 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9492 begin
6 9493 opk_alarm.tab.alarm_kmdo:= 3;
6 9494 signalbin(bs_opk_alarm);
6 9495 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9496 end
5 9497 else
5 9498 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9499 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9500 end;
4 9501 end;
3 9502 if ventetid=0 then ventetid:= 1;
3 9503 until false;
3 9504
3 9504 alarmur_trap:
3 9505 disable skriv_alarmur(zbillede,1);
3 9506 end alarmur;
2 9507 \f
2 9507 message procedure opkaldsalarmer side 1;
2 9508
2 9508 procedure opkaldsalarmer;
2 9509 begin
3 9510 integer nr, ny_kommando, tilst, aktion, tt;
3 9511 integer array field tab, opref, alarmop;
3 9512
3 9512 procedure skriv_opkaldsalarmer(zud,omfang);
3 9513 value omfang;
3 9514 zone zud;
3 9515 integer omfang;
3 9516 begin
4 9517 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9518 if omfang>0 then
4 9519 disable begin
5 9520 real array field raf;
5 9521 trap(slut);
5 9522 raf:=0;
5 9523 write(zud,"nl",1,
5 9524 <: nr: :>,nr,"nl",1,
5 9525 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9526 <: tilst: :>,tilst,"nl",1,
5 9527 <: aktion: :>,aktion,"nl",1,
5 9528 <: tt: :>,false add tt,1,"nl",1,
5 9529 <: tab: :>,tab,"nl",1,
5 9530 <: opref: :>,opref,"nl",1,
5 9531 <: alarmop: :>,alarmop,"nl",1,
5 9532 <::>);
5 9533 skriv_coru(zud,coru_no(296));
5 9534 slut:
5 9535 end;
4 9536 end skriv_opkaldsalarmer;
3 9537
3 9537 trap(opk_alarm_trap);
3 9538 stackclaim(400);
3 9539
3 9539 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9540 skriv_opkaldsalarmer(out,0);
3 9541 <*-2*>
3 9542
3 9542 repeat
3 9543 wait(bs_opk_alarm);
3 9544 alarmop:= 0;
3 9545 for nr:= 1 step 1 until max_antal_operatører do
3 9546 begin
4 9547 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9548 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9549 tilst:= opk_alarm.tab.alarm_tilst;
4 9550 aktion:= case ny_kommando+1 of (
4 9551 <*ingenting*> case tilst+1 of (4,4,4),
4 9552 <*normal *> case tilst+1 of (1,4,4),
4 9553 <*nød *> case tilst+1 of (2,2,4),
4 9554 <*sluk *> case tilst+1 of (4,3,3));
4 9555 tt:= case aktion of ('B','C','F','-');
4 9556 if tt<>'-' then
4 9557 begin
5 9558 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9559 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9560 d.opref.data(1):= nr+16;
5 9561 signalch(cs_talevejsswitch,opref,op_optype);
5 9562 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9563 if d.opref.resultat = 3 then
5 9564 begin
6 9565 opk_alarm.tab.alarm_kmdo:= 0;
6 9566 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9567 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9568 if aktion < 3 then
6 9569 begin
7 9570 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9571 if alarmop = 0 then
7 9572 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9573 end;
6 9574 end;
5 9575 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9576 end;
4 9577 end;
3 9578 if alarmop<>0 then
3 9579 begin
4 9580 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9581 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9582 end;
3 9583 until false;
3 9584
3 9584 opk_alarm_trap:
3 9585 disable skriv_opkaldsalarmer(zbillede,1);
3 9586 end;
2 9587
2 9587 \f
2 9587 message procedure tvswitch_input side 1 - 940810/cl;
2 9588
2 9588 procedure tv_switch_input;
2 9589 begin
3 9590 integer array field opref;
3 9591 integer tt,ant;
3 9592 boolean ok;
3 9593 integer array ia(1:128);
3 9594
3 9594 procedure skriv_tvswitch_input(zud,omfang);
3 9595 value omfang;
3 9596 zone zud;
3 9597 integer omfang;
3 9598 begin
4 9599 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9600 if omfang>0 then
4 9601 disable begin
5 9602 real array field raf;
5 9603 trap(slut);
5 9604 raf:=0;
5 9605 write(zud,"nl",1,
5 9606 <: opref: :>,opref,"nl",1,
5 9607 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9608 <: ant: :>,ant,"nl",1,
5 9609 <: tt: :>,tt,"nl",1,
5 9610 <::>);
5 9611 write(zud,"nl",1,<:ia: :>);
5 9612 skrivhele(zud,ia.raf,256,2);
5 9613 skriv_coru(zud,coru_no(297));
5 9614 slut:
5 9615 end;
4 9616 end skriv_tvswitch_input;
3 9617 \f
3 9617 boolean procedure læs_tlgr;
3 9618 begin
4 9619 integer kl,ch,i,pos,p;
4 9620 long field lf;
4 9621 boolean ok;
4 9622
4 9622 integer procedure readch(z,c);
4 9623 zone z; integer c;
4 9624 begin
5 9625 readch:= readchar(z,c);
5 9626 <*+2*> if testbit15 and overvåget then
5 9627 disable begin
6 9628 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9629 else write(zrl,"<",1,<<d>,c,">",1);
6 9630 if c='em' then write(zrl,<: *timeout*:>);
6 9631 end;
5 9632 <*-2*>
5 9633 end;
4 9634
4 9634 ok:= false; tt:=' ';
4 9635 repeat
4 9636 readchar(z_tv_in,ch);
4 9637 until ch<>'em';
4 9638 repeatchar(z_tv_in);
4 9639
4 9639 <*+2*>if testbit15 and overvåget then
4 9640 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9641 <*-2*>
4 9642
4 9642 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9643 if ch='%' then
4 9644 begin
5 9645 ant:= 0; pos:= 1; lf:= 4;
5 9646 ok:= true;
5 9647 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9648
5 9648 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9649 skrivtegn(ia,pos,ch);
5 9650
5 9650 p:=pos;
5 9651 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9652
5 9652 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9653 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9654 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9655
5 9655 if ok and ch=' ' then
5 9656 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9657
5 9657 while kl = 2 do
5 9658 begin
6 9659 i:= ch - '0';
6 9660 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9661 if ant < 128 then
6 9662 begin
7 9663 ant:= ant+1;
7 9664 ia(ant):= i;
7 9665 end
6 9666 else
6 9667 ok:= false;
6 9668 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9669 end;
5 9670 if ch<>'nl' then ok:= false;
5 9671 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9672 <* !! setposition(z_tv_in,0,0); !! *>
5 9673 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9674 <*-2*>
5 9675
5 9675 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9676 ok:= ok
5 9677 else if tt='C' or tt='N' or
5 9678 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9679 ok:= ok and ant=1
5 9680 else if tt='X' or tt='Y' then
5 9681 ok:= ok and ant=2
5 9682 else if tt='T' or tt='W' then
5 9683 ok:= ok and ant=64
5 9684 else if tt='R' then
5 9685 ok:= ok and ant extract 1 = 0
5 9686 else
5 9687 begin
6 9688 ok:= false;
6 9689 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9690 end;
5 9691
5 9691 end; <* if ch='%' *>
4 9692 læs_tlgr:= ok;
4 9693 end læs_tlgr;
3 9694 \f
3 9694 trap(tvswitch_input_trap);
3 9695 stackclaim(400);
3 9696 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9697
3 9697 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9698 skriv_tvswitch_input(out,0);
3 9699 <*-2*>
3 9700
3 9700 repeat
3 9701 ok:= læs_tlgr;
3 9702 if ok then
3 9703 begin
4 9704 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9705 start_operation(opref,297,cs_tvswitch_input,0);
4 9706 d.opref.resultat:= tt shift 12 + ant;
4 9707 tofrom(d.opref.data,ia,ant*2);
4 9708 signalch(cs_talevejsswitch,opref,op_optype);
4 9709 end;
3 9710 until false;
3 9711
3 9711 tvswitch_input_trap:
3 9712
3 9712 disable skriv_tvswitch_input(zbillede,1);
3 9713
3 9713 end tvswitch_input;
2 9714 \f
2 9714 message procedure tv_switch_adm side 1 - 940502/cl;
2 9715
2 9715 procedure tv_switch_adm;
2 9716 begin
3 9717 integer array field opref;
3 9718 integer rc;
3 9719
3 9719 procedure skriv_tv_switch_adm(zud,omfang);
3 9720 value omfang;
3 9721 zone zud;
3 9722 integer omfang;
3 9723 begin
4 9724 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9725 if omfang>0 then
4 9726 disable begin
5 9727 trap(slut);
5 9728 write(zud,"nl",1,
5 9729 <: opref: :>,opref,"nl",1,
5 9730 <: rc: :>,rc,"nl",1,
5 9731 <::>);
5 9732 skriv_coru(zud,coru_no(298));
5 9733 slut:
5 9734 end;
4 9735 end skriv_tv_switch_adm;
3 9736
3 9736 trap(tv_switch_adm_trap);
3 9737 stackclaim(400);
3 9738
3 9738 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9739 disable skriv_tv_switch_adm(out,0);
3 9740 <*-2*>
3 9741
3 9741
3 9741
3 9741 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9742 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9743 *>
3 9744
3 9744 repeat
3 9745 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9746 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9747 rc:= 0;
3 9748 repeat
3 9749 signalch(cs_talevejsswitch,opref,op_optype);
3 9750 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9751 rc:= rc+1;
3 9752 until rc=3 or d.opref.resultat=3;
3 9753
3 9753 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9754
3 9754 <*V*> delay(15*60);
3 9755 until false;
3 9756 tv_switch_adm_trap:
3 9757 disable skriv_tv_switch_adm(zbillede,1);
3 9758 end;
2 9759 \f
2 9759 message procedure talevejsswitch side 1 -940426/cl;
2 9760
2 9760 procedure talevejsswitch;
2 9761 begin
3 9762 integer tt, ant, ventetid;
3 9763 integer array field opref, gemt_op, tab;
3 9764 boolean ok;
3 9765 integer array ia(1:128);
3 9766
3 9766 procedure skriv_talevejsswitch(zud,omfang);
3 9767 value omfang;
3 9768 zone zud;
3 9769 integer omfang;
3 9770 begin
4 9771 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9772 if omfang>0 then
4 9773 disable begin
5 9774 real array field raf;
5 9775 trap(slut);
5 9776 raf:= 0;
5 9777 write(zud,"nl",1,
5 9778 <: tt: :>,tt,"nl",1,
5 9779 <: ant: :>,ant,"nl",1,
5 9780 <: ventetid: :>,ventetid,"nl",1,
5 9781 <: opref: :>,opref,"nl",1,
5 9782 <: gemt-op: :>,gemt_op,"nl",1,
5 9783 <: tab: :>,tab,"nl",1,
5 9784 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9785 <::>);
5 9786 write(zud,"nl",1,<:ia: :>);
5 9787 skriv_hele(zud,ia.raf,256,2);
5 9788 skriv_coru(zud,coru_no(299));
5 9789 slut:
5 9790 end;
4 9791 end skriv_talevejsswitch;
3 9792 \f
3 9792 trap(tvswitch_trap);
3 9793 stackclaim(400);
3 9794 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9795
3 9795 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9796 skriv_talevejsswitch(out,0);
3 9797 <*-2*>
3 9798
3 9798 ventetid:= -1; ant:= 0; tt:= ' ';
3 9799 repeat
3 9800 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9801 if opref > 0 then
3 9802 begin
4 9803 if d.opref.opkode extract 12 = 0 then
4 9804 begin <*input fra talevejsswitchen *>
5 9805 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9806 tt:= d.opref.resultat shift (-12) extract 12;
5 9807 ant:= d.opref.resultat extract 12;
5 9808 tofrom(ia,d.opref.data,ant*2);
5 9809 signalch(d.opref.retur,opref,d.opref.optype);
5 9810
5 9810 if tt<>'+' and tt<>'-' then
5 9811 begin
6 9812 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9813 setposition(z_tv_out,0,0);
6 9814 <*+2*> if testbit15 and overvåget then
6 9815 disable begin
7 9816 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9817 outchar(zrl,'nl');
7 9818 end;
6 9819 <*-2*>
6 9820 end;
5 9821 if (tt='+' or tt='-') and gemt_op<>0 then
5 9822 begin
6 9823 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9824 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9825 gemt_op:= 0;
6 9826 ventetid:= -1;
6 9827 end
5 9828 else
5 9829 if tt='R' then
5 9830 begin
6 9831 for i:= 1 step 2 until ant do
6 9832 begin
7 9833 if ia(i) <= max_antal_taleveje and
7 9834 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9835 then
7 9836 begin
8 9837 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9838 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9839 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9840 op_talevej(tv_operatør(ia(i))):= 0;
8 9841 tv_operatør(ia(i)):= ia(i+1)-16;
8 9842 op_talevej(ia(i+1)-16):= ia(i);
8 9843 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9844 end
7 9845 else
7 9846 if ia(i+1) <= max_antal_taleveje and
7 9847 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9848 then
7 9849 begin
8 9850 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9851 tv_operatør(op_talevej(ia(i))):= 0;
8 9852 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9853 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9854 tv_operatør(ia(i+1)):= ia(i)-16;
8 9855 op_talevej(ia(i)-16):= ia(i+1);
8 9856 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9857 end;
7 9858 end;
6 9859 signal_bin(bs_mobil_opkald);
6 9860 <*+2*> if testbit15 and testbit16 and overvåget then
6 9861 disable begin
7 9862 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9863 end;
6 9864 <*-2*>
6 9865 end <* tt='R' and ant>0 *>
5 9866 else
5 9867 if tt='Y' then
5 9868 begin
6 9869 if ia(1) <= max_antal_taleveje and
6 9870 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9871 then
6 9872 begin
7 9873 if tv_operatør(ia(1))=ia(2)-16 and
7 9874 op_talevej(ia(2)-16)=ia(1)
7 9875 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9876 end
6 9877 else
6 9878 if ia(2) <= max_antal_taleveje and
6 9879 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9880 then
6 9881 begin
7 9882 if tv_operatør(ia(2))=ia(1)-16 and
7 9883 op_talevej(ia(1)-16)=ia(2)
7 9884 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9885 end;
6 9886 end
5 9887 else
5 9888 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9889 begin
6 9890 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9891 startoperation(opref,299,cs_op_iomedd,23);
6 9892 ant:= 1;
6 9893 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9894 anbringtal(d.opref.data,ant,ia(1),2);
6 9895 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9896 begin
7 9897 hægtstring(d.opref.data,ant,<: (:>);
7 9898 if bpl_navn(ia(1)-16)=long<::> then
7 9899 begin
8 9900 hægtstring(d.opref.data,ant,<:op:>);
8 9901 anbringtal(d.opref.data,ant,ia(1)-16,
8 9902 if ia(1)-16 > 9 then 2 else 1);
8 9903 end
7 9904 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9905 skrivtegn(d.opref.data,ant,')');
7 9906 end;
6 9907 hægtstring(d.opref.data,ant,
6 9908 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9909 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9910 if tt='P' then <: Tilgængelig:> else
6 9911 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9912 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9913 signalch(cs_io,opref,gen_optype);
6 9914 end
5 9915 else
5 9916 if tt='Z' then
5 9917 begin
6 9918 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9919 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9920 end
5 9921 else
5 9922 begin
6 9923 <* ikke implementeret *>
6 9924 end;
5 9925 end
4 9926 else
4 9927 if d.opref.opkode extract 12 = 44 then
4 9928 begin
5 9929 tt:= d.opref.opkode shift (-12);
5 9930 ok:= true;
5 9931 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9932 begin
6 9933 <*+2*> if testbit15 and overvåget then
6 9934 disable begin
7 9935 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9936 outchar(zrl,'nl');
7 9937 end;
6 9938 <*-2*>
6 9939 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9940 setposition(z_tv_out,0,0);
6 9941 end
5 9942 else
5 9943 if tt='B' or tt='C' or tt='F' then
5 9944 begin
6 9945 <*+2*> if testbit15 and overvåget then
6 9946 disable begin
7 9947 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9948 " ",1,<<d>,d.opref.data(1));
7 9949 outchar(zrl,'nl');
7 9950 end;
6 9951 <*-2*>
6 9952 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9953 d.opref.data(1),"cr",1);
6 9954 setposition(z_tv_out,0,0);
6 9955 end
5 9956 else
5 9957 if tt='A' or tt='D' or tt='T' then
5 9958 begin
6 9959 <*+2*> if testbit15 and overvåget then
6 9960 disable begin
7 9961 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9962 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9963 outchar(zrl,'nl');
7 9964 end;
6 9965 <*-2*>
6 9966 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9967 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9968 setposition(z_tv_out,0,0);
6 9969 end
5 9970 else
5 9971 ok:= false;
5 9972 if ok then
5 9973 begin
6 9974 gemt_op:= opref;
6 9975 ventetid:= 2;
6 9976 end
5 9977 else
5 9978 begin
6 9979 d.opref.resultat:= 4;
6 9980 signalch(d.opref.retur,opref,d.opref.optype);
6 9981 end;
5 9982 end;
4 9983 end
3 9984 else
3 9985 if gemt_op<>0 then
3 9986 begin <*timeout*>
4 9987 d.gemt_op.resultat:= 0;
4 9988 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9989 gemt_op:= 0;
4 9990 ventetid:= -1;
4 9991 <*+2*> if testbit15 and overvåget then
4 9992 disable begin
5 9993 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9994 outchar(zrl,'nl');
5 9995 end;
4 9996 <*-2*>
4 9997 end;
3 9998 until false;
3 9999 tvswitch_trap:
3 10000 disable skriv_talevejsswitch(zbillede,1);
3 10001 end talevejsswitch;
2 10002
2 10002 \f
2 10002 message garage_erklæringer side 1 - 810415/hko;
2 10003
2 10003 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 10004
2 10004 procedure gar_fejl(z,s,b);
2 10005 integer s,b;
2 10006 zone z;
2 10007 begin
3 10008 disable begin
4 10009 integer array iz(1:20);
4 10010 integer i,j,k;
4 10011 integer array field iaf;
4 10012 real array field raf;
4 10013
4 10013 getzone6(z,iz);
4 10014 iaf:=raf:=2;
4 10015 getnumber(iz.raf,7,j);
4 10016
4 10016 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 10017 k:=1;
4 10018
4 10018 j:= terminal_tab.iaf.terminal_tilstand;
4 10019 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 10020 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 10021 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 10022 if s <> (1 shift 21 +2) then
4 10023 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 10024 + terminal_tab.iaf.terminal_tilstand extract 21;
4 10025 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 10026 begin
5 10027 z(1):=real <:<'?'><'em'>:>;
5 10028 b:=2;
5 10029 end;
4 10030 end; <*disable*>
3 10031 end gar_fejl;
2 10032
2 10032 integer cs_gar;
2 10033 integer array cs_garage(1:max_antal_garageterminaler);
2 10034 \f
2 10034 message procedure h_garage side 1 - 810520/hko;
2 10035
2 10035 <* hovedmodulkorutine for garageterminaler *>
2 10036 procedure h_garage;
2 10037 begin
3 10038 integer array field op_ref;
3 10039 integer k,dest_sem;
3 10040 procedure skriv_hgarage(zud,omfang);
3 10041 value omfang;
3 10042 zone zud;
3 10043 integer omfang;
3 10044 begin integer i;
4 10045
4 10045 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 10046 write(zud,"sp",26-i);
4 10047 if omfang>0 then
4 10048 disable begin
5 10049 integer x;
5 10050 trap(slut);
5 10051 write(zud,"nl",1,
5 10052 <: op_ref: :>,op_ref,"nl",1,
5 10053 <: k: :>,k,"nl",1,
5 10054 <: dest_sem: :>,dest_sem,"nl",1,
5 10055 <::>);
5 10056 skriv_coru(zud,coru_no(300));
5 10057 slut:
5 10058 end;
4 10059 end skriv_hgarage;
3 10060
3 10060 trap(hgar_trap);
3 10061 stack_claim(if cm_test then 198 else 146);
3 10062
3 10062 <*+2*>
3 10063 if testbit16 and overvåget or testbit28 then
3 10064 skriv_hgarage(out,0);
3 10065 <*-2*>
3 10066 \f
3 10066 message procedure h_garage side 2 - 811105/hko;
3 10067
3 10067 repeat
3 10068 wait_ch(cs_gar,op_ref,true,-1);
3 10069 <*+4*>
3 10070 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 10071 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 10072 <*-4*>
3 10073
3 10073 k:=d.op_ref.opkode extract 12;
3 10074 dest_sem:=
3 10075 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 10076 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 10077 else -1;
3 10078 <*+4*>
3 10079 if dest_sem=-1 then
3 10080 begin
4 10081 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 10082 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10083 end
3 10084 else
3 10085 <*-4*>
3 10086 if k=7<*inkluder*> then
3 10087 begin
4 10088 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 10089 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 10090 begin
5 10091 d.op_ref.resultat:=3;
5 10092 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 10093 dest_sem:=-2;
5 10094 end;
4 10095 end
3 10096 else
3 10097 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 10098 begin
4 10099 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 10100 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 10101 +terminal_tab.iaf.terminal_tilstand extract 21;
4 10102 end;
3 10103 if dest_sem>0 then
3 10104 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 10105 until false;
3 10106
3 10106 hgar_trap:
3 10107 disable skriv_hgarage(zbillede,1);
3 10108 end h_garage;
2 10109 \f
2 10109 message procedure garage side 1 - 830310/cl;
2 10110
2 10110 procedure garage(nr);
2 10111 value nr;
2 10112 integer nr;
2 10113 begin
3 10114 integer array field op_ref,ref;
3 10115 integer i,kode,aktion,status,opgave,retur_sem,
3 10116 pos,indeks,sep,sluttegn,vogn,ll;
3 10117
3 10117 procedure skriv_garage(zud,omfang);
3 10118 value omfang;
3 10119 zone zud;
3 10120 integer omfang;
3 10121 begin integer i;
4 10122
4 10122 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 10123 write(zud,"sp",26-i);
4 10124 if omfang > 0 then
4 10125 disable begin integer x;
5 10126 trap(slut);
5 10127 write(zud,"nl",1,
5 10128 <: op-ref: :>,op_ref,"nl",1,
5 10129 <: kode: :>,kode,"nl",1,
5 10130 <: ref: :>,ref,"nl",1,
5 10131 <: i: :>,i,"nl",1,
5 10132 <: aktion: :>,aktion,"nl",1,
5 10133 <: retur-sem: :>,retur_sem,"nl",1,
5 10134 <: vogn: :>,vogn,"nl",1,
5 10135 <: ll: :>,ll,"nl",1,
5 10136 <: status: :>,status,"nl",1,
5 10137 <: opgave: :>,opgave,"nl",1,
5 10138 <: pos: :>,pos,"nl",1,
5 10139 <: indeks: :>,indeks,"nl",1,
5 10140 <: sep: :>,sep,"nl",1,
5 10141 <: sluttegn: :>,sluttegn,"nl",1,
5 10142 <::>);
5 10143 skriv_coru(zud,coru_no(300+nr));
5 10144 slut:
5 10145 end;
4 10146 end skriv_garage;
3 10147 \f
3 10147 message procedure garage side 2 - 830310/hko;
3 10148
3 10148 trap(gar_trap);
3 10149 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 10150
3 10150 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 10151
3 10151 <*+2*>
3 10152 if testbit16 and overvåget or testbit28 then
3 10153 skriv_garage(out,0);
3 10154 <*-2*>
3 10155
3 10155 <* attention simulering
3 10156 *>
3 10157 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 10158 begin
4 10159 wait_ch(cs_att_pulje,op_ref,true,-1);
4 10160 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 10161 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 10162 end;
3 10163 <*
3 10164 *>
3 10165 \f
3 10165 message procedure garage side 3 - 830310/hko;
3 10166
3 10166 repeat
3 10167
3 10167 <*V*> wait_ch(cs_garage(nr),
3 10168 op_ref,
3 10169 true,
3 10170 -1<*timeout*>);
3 10171 <*+2*>
3 10172 if testbit17 and overvåget then
3 10173 disable begin
4 10174 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 10175 <: til garage :>,nr);
4 10176 skriv_op(out,op_ref);
4 10177 end;
3 10178 <*-2*>
3 10179
3 10179 kode:= d.op_ref.op_kode;
3 10180 retur_sem:= d.op_ref.retur;
3 10181 i:= terminal_tab.ref.terminal_tilstand;
3 10182 status:= i shift(-21);
3 10183 opgave:=
3 10184 if kode=0 then 1 <* indlæs kommando *> else
3 10185 if kode=7 then 2 <* inkluder *> else
3 10186 if kode=8 then 3 <* ekskluder *> else
3 10187 0; <* afvises *>
3 10188
3 10188 aktion:= case status +1 of(
3 10189 <* status *> <* opgave: 0 1 2 3 *>
3 10190 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 10191 <* 1 - *>(-1),<* ulovlig tilstand *>
3 10192 <* 2 - *>(-1),<* ulovlig tilstand *>
3 10193 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 10194 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 10195 <* 5 - *>(-1),<* ulovlig tilstand *>
3 10196 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 10197 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 10198 -1);
3 10199 \f
3 10199 message procedure garage side 4 - 810424/hko;
3 10200
3 10200 case aktion+6 of
3 10201 begin
4 10202 begin
5 10203 <*-5: terminal optaget *>
5 10204
5 10204 d.op_ref.resultat:= 16;
5 10205 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10206 end;
4 10207
4 10207 begin
5 10208 <*-4: operation uden virkning *>
5 10209
5 10209 afslut_operation(op_ref,-1);
5 10210 end;
4 10211
4 10211 begin
5 10212 <*-3: ulovlig operationskode *>
5 10213
5 10213 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 10214 afslut_operation(op_ref,-1);
5 10215 end;
4 10216
4 10216 begin
5 10217 <*-2: ulovligt garageterminal_nr *>
5 10218
5 10218 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 10219 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10220 end;
4 10221
4 10221 begin
5 10222 <*-1: ulovlig operatørtilstand *>
5 10223
5 10223 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 10224 afslut_operation(op_ref,-1);
5 10225 end;
4 10226
4 10226 begin
5 10227 <* 0: ikke implementeret *>
5 10228
5 10228 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 10229 afslut_operation(op_ref,-1);
5 10230 end;
4 10231
4 10231 begin
5 10232 \f
5 10232 message procedure garage side 5 - 851001/cl;
5 10233
5 10233 <* 1: indlæs kommando *>
5 10234
5 10234
5 10234 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 10235
5 10235 if d.op_ref.resultat > 3 then
5 10236 begin
6 10237 <*V*> setposition(z_gar(nr),0,0);
6 10238 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 10239 skriv_kvittering(z_gar(nr),op_ref,pos,
6 10240 d.op_ref.resultat);
6 10241 end
5 10242 else if d.op_ref.resultat>0 then
5 10243 begin <*godkendt*>
6 10244 kode:=d.op_ref.opkode;
6 10245 i:= kode extract 12;
6 10246 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 10247 else if kode=9 or kode=10 then 2
6 10248 else 0;
6 10249 if j > 0 then
6 10250 begin
7 10251 case j of
7 10252 begin
8 10253 begin
9 10254 \f
9 10254 message procedure garage side 6 - 851001/cl;
9 10255
9 10255 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 10256 integer vogn,ll;
9 10257 integer array field vtop;
9 10258
9 10258 vogn:=ia(1);
9 10259 ll:=ia(2);
9 10260 <*V*> wait_ch(cs_vt_adgang,
9 10261 vt_op,
9 10262 gen_optype,
9 10263 -1<*timeout sek*>);
9 10264 start_operation(vtop,300+nr,cs_garage(nr),
9 10265 kode);
9 10266 d.vt_op.data(1):=vogn;
9 10267 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 10268 indeks:= vt_op;
9 10269 signal_ch(cs_vt,
9 10270 vt_op,
9 10271 gen_optype or gar_optype);
9 10272
9 10272 <*V*> wait_ch(cs_garage(nr),
9 10273 vt_op,
9 10274 gar_optype,
9 10275 -1<*timeout sek*>);
9 10276 <*+2*> if testbit18 and overvåget then
9 10277 disable begin
10 10278 write(out,"nl",1,<:garage :>,<<d>,nr,
10 10279 <:: operation retur fra vt:>);
10 10280 skriv_op(out,vt_op);
10 10281 end;
9 10282 <*-2*>
9 10283 <*+4*> if vt_op<>indeks then
9 10284 fejl_reaktion(11<*fremmede op*>,op_ref,
9 10285 <:garage-kommando:>,0);
9 10286 <*-4*>
9 10287 <*V*> setposition(z_gar(nr),0,0);
9 10288 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 10289 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 10290 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 10291 else vt_op,-1,d.vt_op.resultat);
9 10292 d.vt_op.optype:=gen_optype or vtoptype;
9 10293 disable afslut_operation(vt_op,cs_vt_adgang);
9 10294 end;
8 10295
8 10295 begin
9 10296 \f
9 10296 message procedure garage side 6a - 830310/cl;
9 10297
9 10297 <* 2 vogntabel,linienr/-,busnr *>
9 10298
9 10298 d.op_ref.retur:= cs_garage(nr);
9 10299 tofrom(d.op_ref.data,ia,10);
9 10300 indeks:= op_ref;
9 10301 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 10302 wait_ch(cs_garage(nr),
9 10303 op_ref,
9 10304 gar_optype,
9 10305 -1<*timeout*>);
9 10306 <*+2*> if testbit18 and overvåget then
9 10307 disable begin
10 10308 write(out,"nl",1,<:garage operation retur fra vt:>);
10 10309 skriv_op(out,op_ref);
10 10310 end;
9 10311 <*-2*>
9 10312 <*+4*>
9 10313 if indeks <> op_ref then
9 10314 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 10315 <*-4*>
9 10316 i:= d.op_ref.resultat;
9 10317 if i = 0 or i > 3 then
9 10318 begin
10 10319 <*V*> setposition(z_gar(nr),0,0);
10 10320 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 10321 end
9 10322 else
9 10323 begin
10 10324 integer antal,fil_ref;
10 10325 antal:= d.op_ref.data(6);
10 10326 fil_ref:= d.op_ref.data(7);
10 10327 <*V*> setposition(z_gar(nr),0,0);
10 10328 write(z_gar(nr),"*",24,"sp",6,
10 10329 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 10330 <*V*> setposition(z_gar(nr),0,0);
10 10331 \f
10 10331 message procedure garage side 6c - 841213/cl;
10 10332
10 10332 pos:= 1;
10 10333 while pos <= antal do
10 10334 begin
11 10335 integer bogst,løb;
11 10336
11 10336 disable i:= læs_fil(fil_ref,pos,j);
11 10337 if i <> 0 then
11 10338 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 10339 else
11 10340 begin
12 10341 vogn:= fil(j,1) shift (-24) extract 24;
12 10342 løb:= fil(j,1) extract 24;
12 10343 if d.op_ref.opkode=9 then
12 10344 begin i:=vogn; vogn:=løb; løb:=i; end;
12 10345 ll:= løb shift (-12) extract 10;
12 10346 bogst:= løb shift (-7) extract 5;
12 10347 if bogst > 0 then bogst:= bogst +'A'-1;
12 10348 løb:= løb extract 7;
12 10349 vogn:= vogn extract 14;
12 10350 i:= d.op_ref.opkode-8;
12 10351 for i:= i,i+1 do
12 10352 begin
13 10353 j:= (i+1) extract 1;
13 10354 case j +1 of
13 10355 begin
14 10356 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 10357 false add bogst,1,"/",1,<<d__>,løb);
14 10358 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 10359 end;
13 10360 end;
12 10361 if pos mod 5 = 0 then
12 10362 begin
13 10363 write(z_gar(nr),"nl",1);
13 10364 <*V*> setposition(z_gar(nr),0,0);
13 10365 end
12 10366 else write(z_gar(nr),"sp",3);
12 10367 end;
11 10368 pos:=pos+1;
11 10369 end;
10 10370 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 10371 \f
10 10371 message procedure garage side 6d- 830310/cl;
10 10372
10 10372 d.opref.opkode:=104; <*slet-fil*>
10 10373 d.op_ref.data(4):=filref;
10 10374 indeks:=op_ref;
10 10375 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 10376 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 10377
10 10377 <*+2*> if testbit18 and overvåget then
10 10378 disable begin
11 10379 write(out,"nl",1,<:garage, slet-fil retur:>);
11 10380 skriv_op(out,op_ref);
11 10381 end;
10 10382 <*-2*>
10 10383
10 10383 <*+4*> if op_ref<>indeks then
10 10384 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10385 <*-4*>
10 10386 if d.op_ref.data(9)<>0 then
10 10387 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10388 <:garage, slet_fil:>,1);
10 10389 end;
9 10390 \f
9 10390 message procedure garage side 7 -810424/hko;
9 10391
9 10391 end;
8 10392
8 10392 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10393 <*-4*>
8 10394 end;<*case j *>
7 10395 end <* j > 0 *>
6 10396 else
6 10397 begin
7 10398 <*V*> setposition(z_gar(nr),0,0);
7 10399 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10400 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10401 4 <*kommando ukendt *>);
7 10402 end;
6 10403 end;<* godkendt *>
5 10404
5 10404 <*V*> setposition(z_gar(nr),0,0);
5 10405
5 10405 d.op_ref.opkode:=0; <*telex*>
5 10406
5 10406 disable afslut_operation(op_ref,cs_gar);
5 10407 end; <* indlæs kommando *>
4 10408
4 10408 begin
5 10409 \f
5 10409 message procedure garage side 8 - 841213/cl;
5 10410
5 10410 <* 2: inkluder *>
5 10411
5 10411 d.op_ref.resultat:=3;
5 10412 afslut_operation(op_ref,-1);
5 10413 monitor(8)reserve:(z_gar(nr),0,ia);
5 10414 terminal_tab.ref.terminal_tilstand:=
5 10415 terminal_tab.ref.terminal_tilstand extract 21;
5 10416 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10417 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10418 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10419 end;
4 10420
4 10420 begin
5 10421
5 10421 <* 3: ekskluder *>
5 10422 d.op_ref.resultat:= 3;
5 10423 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10424 terminal_tab.ref.terminal_tilstand extract 21;
5 10425 monitor(10)release:(z_gar(nr),0,ia);
5 10426 afslut_operation(op_ref,-1);
5 10427
5 10427 end;
4 10428
4 10428 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10429 <*-4*>
4 10430 end; <* case aktion+6 *>
3 10431
3 10431 until false;
3 10432 gar_trap:
3 10433 skriv_garage(zbillede,1);
3 10434 end garage;
2 10435
2 10435 \f
2 10435 message procedure radio_erklæringer side 1 - 820304/hko;
2 10436
2 10436 zone z_fr_in(14,1,rad_in_fejl),
2 10437 z_rf_in(14,1,rad_in_fejl),
2 10438 z_fr_out(14,1,rad_out_fejl),
2 10439 z_rf_out(14,1,rad_out_fejl);
2 10440
2 10440 integer array
2 10441 radiofejl,
2 10442 ss_samtale_nedlagt,
2 10443 ss_radio_aktiver(1:max_antal_kanaler),
2 10444 bs_talevej_udkoblet,
2 10445 cs_radio(1:max_antal_taleveje),
2 10446 radio_linietabel(1:max_linienr//3+1),
2 10447 radio_områdetabel(0:max_antal_områder),
2 10448 opkaldskø(opkaldskø_postlængde//2+1:
2 10449 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10450 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10451 hookoff_maske(1:(tv_maske_lgd//2)),
2 10452 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10453
2 10453 integer field
2 10454 kanal_tilstand,
2 10455 kanal_id1,
2 10456 kanal_id2,
2 10457 kanal_spec,
2 10458 kanal_alt_id1,
2 10459 kanal_alt_id2;
2 10460 integer array field
2 10461 kanal_mon_maske,
2 10462 kanal_alarm,
2 10463 opkald_meldt;
2 10464
2 10464 integer
2 10465 cs_rad,
2 10466 cs_radio_medd,
2 10467 cs_radio_adm,
2 10468 cs_radio_ind,
2 10469 cs_radio_ud,
2 10470 cs_radio_pulje,
2 10471 cs_radio_kø,
2 10472 bs_mobil_opkald,
2 10473 bs_opkaldskø_adgang,
2 10474 opkaldskø_ledige,
2 10475 nødopkald_brugt,
2 10476 første_frie_opkald,
2 10477 første_opkald,
2 10478 sidste_opkald,
2 10479 første_nødopkald,
2 10480 sidste_nødopkald,
2 10481 optaget_flag;
2 10482
2 10482 boolean
2 10483 mobil_opkald_aktiveret;
2 10484 \f
2 10484 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10485
2 10485 integer
2 10486 procedure læs_hex_ciffer(tabel,linie,op);
2 10487 value linie;
2 10488 integer array tabel;
2 10489 integer linie,op;
2 10490 begin
3 10491 integer i,j;
3 10492
3 10492 i:=(if linie>=0 then linie+6 else linie)//6;
3 10493 j:=((i-1)*6-linie)*4;
3 10494 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10495 end læs_hex_ciffer;
2 10496
2 10496 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10497
2 10497 integer
2 10498 procedure sæt_hex_ciffer(tabel,linie,op);
2 10499 value linie;
2 10500 integer array tabel;
2 10501 integer linie,op;
2 10502 begin
3 10503 integer i,j;
3 10504
3 10504 i:=(if linie>=0 then linie+6 else linie)//6;
3 10505 j:=(linie-(i-1)*6)*4;
3 10506 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10507 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10508 shift j add (tabel(i) extract j);
3 10509 end sæt_hex_ciffer;
2 10510
2 10510 message procedure hex_to_dec side 1 - 900108/cl;
2 10511
2 10511 integer procedure hex_to_dec(hex);
2 10512 value hex;
2 10513 integer hex;
2 10514 begin
3 10515 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10516 else (hex-'0');
3 10517 end;
2 10518
2 10518 message procedure dec_to_hex side 1 - 900108/cl;
2 10519
2 10519 integer procedure dec_to_hex(dec);
2 10520 value dec;
2 10521 integer dec;
2 10522 begin
3 10523 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10524 else ('A'+dec-10);
3 10525 end;
2 10526
2 10526 message procedure rad_out_fejl side 1 - 820304/hko;
2 10527
2 10527 procedure rad_out_fejl(z,s,b);
2 10528 value s;
2 10529 zone z;
2 10530 integer s,b;
2 10531 begin
3 10532 integer array field iaf;
3 10533 integer pos,tegn,max,i;
3 10534 integer array ia(1:20);
3 10535 long array field laf;
3 10536
3 10536 disable begin
4 10537 laf:= iaf:= 2;
4 10538 tegn:= 1;
4 10539 getzone6(z,ia);
4 10540 max:= ia(16)//2*3;
4 10541 if s = 1 shift 21 + 2 then
4 10542 begin
5 10543 z(1):= real<:<'em'>:>;
5 10544 b:= 2;
5 10545 end
4 10546 else
4 10547 begin
5 10548 pos:= 0;
5 10549 for i:= 1 step 1 until max_antal_kanaler do
5 10550 begin
6 10551 iaf:= (i-1)*kanalbeskr_længde;
6 10552 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10553 if pos>0 then
6 10554 begin
7 10555 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10556 signalbin(bs_mobilopkald);
7 10557 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10558 1 shift 12<*binært*> +1<*fortsæt*>);
7 10559 end;
6 10560 end;
5 10561 end;
4 10562 end;
3 10563 end;
2 10564 \f
2 10564 message procedure rad_in_fejl side 1 - 810601/hko;
2 10565
2 10565 procedure rad_in_fejl(z,s,b);
2 10566 value s;
2 10567 zone z;
2 10568 integer s,b;
2 10569 begin
3 10570 integer array field iaf;
3 10571 integer pos,tegn,max,i;
3 10572 integer array ia(1:20);
3 10573 long array field laf;
3 10574
3 10574 disable begin
4 10575 laf:= iaf:= 2;
4 10576 i:= 1;
4 10577 getzone6(z,ia);
4 10578 max:= ia(16)//2*3;
4 10579 if s shift (-21) extract 1 = 0
4 10580 and s shift(-19) extract 1 = 0 then
4 10581 begin
5 10582 if b = 0 then
5 10583 begin
6 10584 z(1):= real<:!:>;
6 10585 b:= 2;
6 10586 end;
5 10587 end;
4 10588 \f
4 10588 message procedure rad_in_fejl side 2 - 820304/hko;
4 10589
4 10589 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10590 begin
5 10591 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10592 1 shift 12<*binær*> +1<*fortsæt*>);
5 10593 end
4 10594 else
4 10595 if s shift (-19) extract 1 = 1 then
4 10596 begin
5 10597 z(1):= real<:!<'nl'>:>;
5 10598 b:= 2;
5 10599 end
4 10600 else
4 10601 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10602 begin
5 10603 <*
5 10604 if b = 0 then
5 10605 begin
5 10606 *>
5 10607 z(1):= real <:<'em'>:>;
5 10608 b:= 2;
5 10609 <*
5 10610 end
5 10611 else
5 10612 begin
5 10613 tegn:= -1;
5 10614 iaf:= 0;
5 10615 pos:= b//2*3-2;
5 10616 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10617 skriv_tegn(z.iaf,pos,'?');
5 10618 if pos<=max then
5 10619 afslut_text(z.iaf,pos);
5 10620 b:= (pos-1)//3*2;
5 10621 end;
5 10622 *>
5 10623 end;<* s=1 shift 21+2 *>
4 10624 end;
3 10625 if testbit22 and
3 10626 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10627 then
3 10628 delay(60);
3 10629 end rad_in_fejl;
2 10630 \f
2 10630 message procedure afvent_radioinput side 1 - 880901/cl;
2 10631
2 10631 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10632 value rf;
2 10633 zone z_in;
2 10634 integer array tlgr;
2 10635 boolean rf;
2 10636 begin
3 10637 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10638 long array field laf;
3 10639
3 10639 laf:= 0;
3 10640 pos:= 1;
3 10641 repeat
3 10642 i:=readchar(z_in,tegn);
3 10643 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10644 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10645 p:=pos;
3 10646 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10647 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10648 (rf and testbit39)) then
3 10649 disable begin
4 10650 write(zrl,<<zd dd dd.dd >,now,
4 10651 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10652 if tegn='em' then <:*timeout*:> else
4 10653 if pos>=80 then <:*for langt*:> else <::>);
4 10654 outchar(zrl,'nl');
4 10655 end;
3 10656 <*-2*>
3 10657 ac:= -1;
3 10658 if pos >= 80 then
3 10659 begin <* telegram for langt *>
4 10660 repeat readchar(z_in,tegn)
4 10661 until tegn='nl' or tegn='em';
4 10662 end
3 10663 else
3 10664 if pos>1 and tegn='nl' then
3 10665 begin
4 10666 lgd:= 1;
4 10667 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10668 lgd:= lgd-2;
4 10669 if lgd >= 5 then
4 10670 begin
5 10671 lgd:= lgd-2; <* se bort fra checksum *>
5 10672 i:= lgd + 1;
5 10673 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10674 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10675 i:= lgd + 1;
5 10676 skrivtegn(tlgr,i,0);
5 10677 skrivtegn(tlgr,i,0);
5 10678 i:= 1; sum:= 0;
5 10679 while i <= lgd do
5 10680 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10681 if csum >= 0 and csum <> sum then
5 10682 begin
6 10683 <*+2*> if overvåget and (testbit36 or
6 10684 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10685 disable begin
7 10686 write(zrl,<<zd dd dd.dd >,now,
7 10687 (if rf then <:rf:> else <:fr:>),
7 10688 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10689 end;
6 10690 <*-2*>
6 10691 ac:= 6 <* checksumfejl *>
6 10692 end
5 10693 else
5 10694 ac:= 0;
5 10695 end
4 10696 else ac:= 6; <* for kort telegram - retransmitter *>
4 10697 end;
3 10698 afvent_radioinput:= ac;
3 10699 end;
2 10700 \f
2 10700 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10701
2 10701 procedure skriv_kanal_tab(z);
2 10702 zone z;
2 10703 begin
3 10704 integer array field ref;
3 10705 integer i,j,t,op,id1,id2;
3 10706
3 10706 write(z,"ff",1,"nl",1,<:
3 10707 ******** kanal-beskrivelser *******
3 10708
3 10708 a k l p m b n
3 10709 l a y a o s ø
3 10710 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10711 <*
3 10712 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10713 *>
3 10714 "nl",1);
3 10715 for i:=1 step 1 until max_antal_kanaler do
3 10716 begin
4 10717 ref:=(i-1)*kanal_beskr_længde;
4 10718 t:=kanal_tab.ref.kanal_tilstand;
4 10719 id1:=kanal_tab.ref.kanal_id1;
4 10720 id2:=kanal_tab.ref.kanal_id2;
4 10721 write(z,"nl",1,"sp",4,
4 10722 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10723 for j:=11 step -1 until 2 do
4 10724 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10725 write(z,case t extract 2 +1 of
4 10726 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10727 "sp",1);
4 10728 skriv_id(z,id1,9);
4 10729 skriv_id(z,id2,9);
4 10730 t:=kanal_tab.ref.kanal_spec;
4 10731 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10732 write(z,"nl",1,"sp",14,<:mon: :>);
4 10733 for j:= max_antal_taleveje step -1 until 1 do
4 10734 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10735 else "."),1);
4 10736 write(z,"sp",25-max_antal_taleveje);
4 10737 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10738 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10739 end;
3 10740 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10741 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10742 write(z,"nl",2);
3 10743 end skriv_kanal_tab;
2 10744 \f
2 10744 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10745
2 10745 procedure skriv_opkaldskø(z);
2 10746 zone z;
2 10747 begin
3 10748 integer i,bogst,løb,j;
3 10749 integer array field ref;
3 10750 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10751 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10752 <: sig omr :>,"nl",1);
3 10753 for i:= 1 step 1 until max_antal_mobilopkald do
3 10754 begin
4 10755 ref:= i*opkaldskø_postlængde;
4 10756 j:= opkaldskø.ref(1);
4 10757 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10758 j:= opkaldskø.ref(2);
4 10759 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10760 skriv_id(z,j extract 23,9);
4 10761 j:= opkaldskø.ref(3);
4 10762 skriv_id(z,j,7);
4 10763 j:= opkaldskø.ref(4);
4 10764 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10765 << zd>,j extract 8);
4 10766 j:= j shift (-8) extract 4;
4 10767 if j = 1 or j = 2 then
4 10768 write(z,if j=1 then <: normal:> else <: nød :>)
4 10769 else write(z,<<dddd>,j,"sp",3);
4 10770 j:= opkaldskø.ref(5);
4 10771 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10772 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10773 string område_navn(j extract 8) else <:---:>);
4 10774 outchar(z,'nl');
4 10775 end;
3 10776
3 10776 write(z,"nl",1,<<z>,
3 10777 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10778 <:første_opkald=:>,første_opkald,"nl",1,
3 10779 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10780 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10781 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10782 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10783 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10784 "nl",1,<:opkaldsflag::>,"nl",1);
3 10785 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10786 write(z,"nl",2);
3 10787 end skriv_opkaldskø;
2 10788 \f
2 10788 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10789
2 10789 procedure skriv_radio_linie_tabel(z);
2 10790 zone z;
2 10791 begin
3 10792 integer i,j,k;
3 10793
3 10793 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10794 k:= 0;
3 10795 for i:= 1 step 1 until max_linienr do
3 10796 begin
4 10797 læstegn(radio_linietabel,i+1,j);
4 10798 if j > 0 then
4 10799 begin
5 10800 k:= k +1;
5 10801 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10802 "nl",if k mod 5=0 then 1 else 0);
5 10803 end;
4 10804 end;
3 10805 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10806 end skriv_radio_linietabel;
2 10807
2 10807 procedure skriv_radio_områdetabel(z);
2 10808 zone z;
2 10809 begin
3 10810 integer i;
3 10811
3 10811 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10812 for i:= 1 step 1 until max_antal_områder do
3 10813 begin
4 10814 laf:= (i-1)*4;
4 10815 if radio_områdetabel(i)<>0 then
4 10816 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10817 radio_områdetabel(i),"nl",1);
4 10818 end;
3 10819 end skriv_radio_områdetabel;
2 10820 \f
2 10820 message procedure h_radio side 1 - 810520/hko;
2 10821
2 10821 <* hovedmodulkorutine for radiokanaler *>
2 10822 procedure h_radio;
2 10823 begin
3 10824 integer array field op_ref;
3 10825 integer k,dest_sem;
3 10826 procedure skriv_hradio(z,omfang);
3 10827 value omfang;
3 10828 zone z;
3 10829 integer omfang;
3 10830 begin integer i;
4 10831 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10832 write(z,"sp",26-i);
4 10833 if omfang >0 then
4 10834 disable begin integer x;
5 10835 trap(slut);
5 10836 write(z,"nl",1,
5 10837 <: op_ref: :>,op_ref,"nl",1,
5 10838 <: k: :>,k,"nl",1,
5 10839 <: dest_sem: :>,dest_sem,"nl",1,
5 10840 <::>);
5 10841 skriv_coru(z,coru_no(400));
5 10842 slut:
5 10843 end;
4 10844 end skriv_hradio;
3 10845
3 10845 trap(hrad_trap);
3 10846 stack_claim(if cm_test then 198 else 146);
3 10847
3 10847 <*+2*> if testbit32 and overvåget or testbit28 then
3 10848 skriv_hradio(out,0);
3 10849 <*-2*>
3 10850 \f
3 10850 message procedure h_radio side 2 - 820304/hko;
3 10851
3 10851 repeat
3 10852 wait_ch(cs_rad,op_ref,true,-1);
3 10853 <*+2*>if testbit33 and overvåget then
3 10854 disable begin
4 10855 skriv_h_radio(out,0);
4 10856 write(out,<: operation modtaget:>);
4 10857 skriv_op(out,op_ref);
4 10858 end;
3 10859 <*-2*>
3 10860 <*+4*>
3 10861 if (d.op_ref.optype and
3 10862 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10863 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10864 <*-4*>
3 10865
3 10865 k:=d.op_ref.op_kode extract 12;
3 10866 dest_sem:=
3 10867 if k > 0 and k < 7
3 10868 or k=11 or k=12 or k=19
3 10869 or (72<=k and k<=74) or k = 77
3 10870 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10871 then cs_radio_adm
3 10872 else if k=41 <* radiokommando fra operatør *>
3 10873 then cs_radio(d.opref.data(1)) else -1;
3 10874 <*+4*>
3 10875 if dest_sem<1 then
3 10876 begin
4 10877 if dest_sem<0 then
4 10878 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10879 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10880 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10881 end
3 10882 else
3 10883 <*-4*>
3 10884 begin <* operationskode ok *>
4 10885 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10886 end;
3 10887 until false;
3 10888
3 10888 hrad_trap:
3 10889 disable skriv_hradio(zbillede,1);
3 10890 end h_radio;
2 10891 \f
2 10891 message procedure radio side 1 - 820301/hko;
2 10892
2 10892 procedure radio(talevej,op);
2 10893 value talevej,op;
2 10894 integer talevej,op;
2 10895 begin
3 10896 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10897 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10898 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10899 integer array felt,værdi(1:8);
3 10900 boolean byt,nød,frigiv_samtale;
3 10901 real kl;
3 10902 real field rf;
3 10903
3 10903 procedure skriv_radio(z,omfang);
3 10904 value omfang;
3 10905 zone z;
3 10906 integer omfang;
3 10907 begin integer i1;
4 10908 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10909 write(z,"sp",26-i1);
4 10910 if omfang > 0 then
4 10911 disable begin real x;
5 10912 trap(slut);
5 10913 \f
5 10913 message procedure radio side 1a- 820301/hko;
5 10914
5 10914 write(z,"nl",1,
5 10915 <: op_ref: :>,op_ref,"nl",1,
5 10916 <: opref1: :>,opref1,"nl",1,
5 10917 <: iaf: :>,iaf,"nl",1,
5 10918 <: iaf1: :>,iaf1,"nl",1,
5 10919 <: vt-op: :>,vt_op,"nl",1,
5 10920 <: rad-op: :>,rad_op,"nl",1,
5 10921 <: rf: :>,rf,"nl",1,
5 10922 <: nr: :>,nr,"nl",1,
5 10923 <: i: :>,i,"nl",1,
5 10924 <: j: :>,j,"nl",1,
5 10925 <: k: :>,k,"nl",1,
5 10926 <: operatør: :>,operatør,"nl",1,
5 10927 <: tilst: :>,tilst,"nl",1,
5 10928 <: res: :>,res,"nl",1,
5 10929 <: opgave: :>,opgave,"nl",1,
5 10930 <: type: :>,type,"nl",1,
5 10931 <: bus: :>,bus,"nl",1,
5 10932 <: ll: :>,ll,"nl",1,
5 10933 <: ttmm: :>,ttmm,"nl",1,
5 10934 <: vogn: :>,vogn,"nl",1,
5 10935 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10936 <: vtop2: :>,vtop2,"nl",1,
5 10937 <: vtop3: :>,vtop3,"nl",1,
5 10938 <: sig: :>,sig,"nl",1,
5 10939 <: omr: :>,omr,"nl",1,
5 10940 <: garage: :>,garage,"nl",1,
5 10941 <<-dddddd'-dd>,
5 10942 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10943 <:samtaleflag: :>,"nl",1);
5 10944 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10945 skriv_coru(z,coru_no(410+talevej));
5 10946 slut:
5 10947 end;<*disable*>
4 10948 end skriv_radio;
3 10949 \f
3 10949 message procedure udtag_opkald side 1 - 820301/hko;
3 10950
3 10950 integer
3 10951 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10952 value vogn, operatør;
3 10953 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10954 begin
4 10955 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10956 integer array field vt_op,ref,næste,forrige;
4 10957 integer array field iaf1;
4 10958 boolean skal_ud;
4 10959
4 10959 boolean procedure skal_udskrives(fordelt,aktuel);
4 10960 value fordelt,aktuel;
4 10961 integer fordelt,aktuel;
4 10962 begin
5 10963 boolean skal;
5 10964 integer n;
5 10965 integer array field iaf;
5 10966
5 10966 skal:= true;
5 10967 if fordelt > 0 and fordelt<>aktuel then
5 10968 begin
6 10969 for n:= 0 step 1 until 3 do
6 10970 begin
7 10971 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10972 begin
8 10973 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10974 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10975 goto returner;
8 10976 end;
7 10977 end;
6 10978 end;
5 10979 returner:
5 10980 skal_udskrives:= skal;
5 10981 end;
4 10982
4 10982 l:= b:= tm:= t:= 0;
4 10983 garage:= sig:= 0;
4 10984 res:= -1;
4 10985 <*V*> wait(bs_opkaldskø_adgang);
4 10986 ref:= første_nødopkald;
4 10987 if ref <> 0 then
4 10988 t:= 2
4 10989 else
4 10990 begin
5 10991 ref:= første_opkald;
5 10992 t:= if ref = 0 then 0 else 1;
5 10993 end;
4 10994 if t = 0 then res:= +19 <*kø er tom*> else
4 10995 if vogn=0 and omr=0 then
4 10996 begin
5 10997 while ref <> 0 and res = -1 do
5 10998 begin
6 10999 nr:= opkaldskø.ref(4) extract 8;
6 11000 if nr>64 then
6 11001 begin
7 11002 <*opk. primærfordelt til gruppe af btj.pl.*>
7 11003 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 11004 while skal_ud and i<max_antal_operatører do
7 11005 begin
8 11006 i:=i+1;
8 11007 if læsbit_ia(bpl_def.iaf1,i) then
8 11008 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 11009 end;
7 11010 end
6 11011 else
6 11012 skal_ud:= skal_udskrives(nr,operatør);
6 11013
6 11013 if skal_ud then
6 11014 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 11015 *>
6 11016 res:= 0
6 11017 else
6 11018 begin
7 11019 ref:= opkaldskø.ref(1) extract 12;
7 11020 if ref = 0 and t = 2 then
7 11021 begin
8 11022 ref:= første_opkald;
8 11023 t:= if ref = 0 then 0 else 1;
8 11024 end else if ref = 0 then t:= 0;
7 11025 end;
6 11026 end; <*while*>
5 11027 \f
5 11027 message procedure udtag_opkald side 2 - 820304/hko;
5 11028
5 11028 if ref <> 0 then
5 11029 begin
6 11030 b:= opkaldskø.ref(2);
6 11031 <*+4*> if b < 0 then
6 11032 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 11033 <:nødopkald(besvaret/ej meldt):>,1);
6 11034 <*-4*>
6 11035 garage:=b shift(-14) extract 8;
6 11036 b:= b extract 14;
6 11037 l:= opkaldskø.ref(3);
6 11038 tm:= opkaldskø.ref(4);
6 11039 o:= tm extract 8;
6 11040 tm:= tm shift(-12);
6 11041 omr:= opkaldskø.ref(5) extract 8;
6 11042 sig:= opkaldskø.ref(5) shift (-20);
6 11043 end
5 11044 else res:=19; <* kø er tom *>
5 11045 end <*vogn=0 and omr=0 *>
4 11046 else
4 11047 begin
5 11048 <* vogn<>0 or omr<>0 *>
5 11049 i:= 0; tilst:= -1;
5 11050 if vogn shift(-22) = 1 then
5 11051 begin
6 11052 i:= find_busnr(vogn,nr,garage,tilst);
6 11053 l:= vogn;
6 11054 end
5 11055 else
5 11056 if vogn<>0 and (omr=0 or omr>2) then
5 11057 begin
6 11058 o:= 0;
6 11059 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 11060 if i=(-2) then
6 11061 begin
7 11062 o:= omr;
7 11063 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 11064 end;
6 11065 nr:= vogn extract 14;
6 11066 end
5 11067 else nr:= vogn extract 14;
5 11068 if i<0 then ref:= 0;
5 11069 while ref <> 0 and res = -1 do
5 11070 begin
6 11071 i:= opkaldskø.ref(2) extract 14;
6 11072 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 11073 if nr = i and
6 11074 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 11075 else
6 11076 begin
7 11077 ref:= opkaldskø.ref(1) extract 12;
7 11078 if ref = 0 and t = 2 then
7 11079 begin
8 11080 ref:= første_opkald;
8 11081 t:= if ref = 0 then 0 else 1;
8 11082 end else if ref = 0 then t:= 0;
7 11083 end;
6 11084 end; <*while*>
5 11085 \f
5 11085 message procedure udtag_opkald side 3 - 810603/hko;
5 11086
5 11086 if ref <> 0 then
5 11087 begin
6 11088 b:= nr;
6 11089 tm:= opkaldskø.ref(4);
6 11090 o:= tm extract 8;
6 11091 tm:= tm shift(-12);
6 11092 omr:= opkaldskø.ref(5) extract 4;
6 11093 sig:= opkaldskø.ref(5) shift (-20);
6 11094
6 11094 <*+4*> if tilst <> -1 then
6 11095 fejlreaktion(3<*prg.fejl*>,tilst,
6 11096 <:vogntabel_tilstand for vogn i kø:>,1);
6 11097 <*-4*>
6 11098 end;
5 11099 end;
4 11100
4 11100 if ref <> 0 then
4 11101 begin
5 11102 næste:= opkaldskø.ref(1);
5 11103 forrige:= næste shift(-12);
5 11104 næste:= næste extract 12;
5 11105 if forrige <> 0 then
5 11106 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 11107 + næste
5 11108 else if t = 1 then første_opkald:= næste
5 11109 else <*if t = 2 then*> første_nødopkald:= næste;
5 11110
5 11110 if næste <> 0 then
5 11111 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 11112 + forrige shift 12
5 11113 else if t = 1 then sidste_opkald:= forrige
5 11114 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 11115
5 11115 opkaldskø.ref(1):=første_frie_opkald;
5 11116 første_frie_opkald:=ref;
5 11117
5 11117 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 11118 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 11119 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 11120 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 11121 else
5 11122 begin
6 11123 sætbit_ia(opkaldsflag,operatør,1);
6 11124 sætbit_ia(opkaldsflag,o,1);
6 11125 end;
5 11126 signal_bin(bs_mobil_opkald);
5 11127 end;
4 11128 \f
4 11128 message procedure udtag_opkald side 4 - 810531/hko;
4 11129
4 11129 signal_bin(bs_opkaldskø_adgang);
4 11130 bus:= b;
4 11131 type:= t;
4 11132 ll:= l;
4 11133 ttmm:= tm;
4 11134 udtag_opkald:= res;
4 11135 end udtag opkald;
3 11136 \f
3 11136 message procedure frigiv_kanal side 1 - 810603/hko;
3 11137
3 11137 procedure frigiv_kanal(nr);
3 11138 value nr;
3 11139 integer nr;
3 11140 begin
4 11141 integer id1, id2, omr, i;
4 11142 integer array field iaf, vt_op;
4 11143
4 11143 iaf:= (nr-1)*kanal_beskrlængde;
4 11144 id1:= kanal_tab.iaf.kanal_id1;
4 11145 id2:= kanal_tab.iaf.kanal_id2;
4 11146 omr:= kanal_til_omr(nr);
4 11147 if id1 <> 0 then
4 11148 wait(ss_samtale_nedlagt(nr));
4 11149 if id1 shift (-22) < 3 and omr > 2 then
4 11150 begin
5 11151 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11152 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11153 if id1 shift (-22) = 2 then 18 else 17);
5 11154 d.vt_op.data(1):= id1;
5 11155 d.vt_op.data(4):= omr;
5 11156 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11157 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11158 signalch(cs_vt_adgang,vt_op,true);
5 11159 end;
4 11160
4 11160 if id2 <> 0 and id2 shift(-20) <> 12 then
4 11161 wait(ss_samtale_nedlagt(nr));
4 11162 if id2 shift (-22) < 3 and omr > 2 then
4 11163 begin
5 11164 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11165 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11166 if id2 shift (-22) = 2 then 18 else 17);
5 11167 d.vt_op.data(1):= id2;
5 11168 d.vt_op.data(4):= omr;
5 11169 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11170 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11171 signalch(cs_vt_adgang,vt_op,true);
5 11172 end;
4 11173
4 11173 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 11174 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 11175 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 11176 shift (-10) extract 6 shift 10;
4 11177 <* repeat
4 11178 inspect(ss_samtale_nedlagt(nr),i);
4 11179 if i>0 then wait(ss_samtale_nedlagt(nr));
4 11180 until i<=0;
4 11181 *>
4 11182 end frigiv_kanal;
3 11183 \f
3 11183 message procedure hookoff side 1 - 880901/cl;
3 11184
3 11184 integer procedure hookoff(talevej,op,retursem,flash);
3 11185 value talevej,op,retursem,flash;
3 11186 integer talevej,op,retursem;
3 11187 boolean flash;
3 11188 begin
4 11189 integer array field opref;
4 11190
4 11190 opref:= op;
4 11191 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 11192 d.opref.data(1):= talevej;
4 11193 d.opref.data(2):= if flash then 2 else 1;
4 11194 signalch(cs_radio_ud,opref,rad_optype);
4 11195 <*V*> waitch(retursem,opref,rad_optype,-1);
4 11196 hookoff:= d.opref.resultat;
4 11197 end;
3 11198 \f
3 11198 message procedure hookon side 1 - 880901/cl;
3 11199
3 11199 integer procedure hookon(talevej,op,retursem);
3 11200 value talevej,op,retursem;
3 11201 integer talevej,op,retursem;
3 11202 begin
4 11203 integer i,res;
4 11204 integer array field opref;
4 11205
4 11205 if læsbit_ia(hookoff_maske,talevej) then
4 11206 begin
5 11207 inspect(bs_talevej_udkoblet(talevej),i);
5 11208 if i<=0 then
5 11209 begin
6 11210 opref:= op;
6 11211 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 11212 d.opref.data(1):= talevej;
6 11213 signalch(cs_radio_ud,opref,rad_optype);
6 11214 <*V*> waitch(retursem,opref,rad_optype,-1);
6 11215 res:= d.opref.resultat;
6 11216 end
5 11217 else
5 11218 res:= 0;
5 11219
5 11219 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 11220 end
4 11221 else
4 11222 res:= 0;
4 11223
4 11223 sætbit_ia(hookoff_maske,talevej,0);
4 11224 hookon:= res;
4 11225 end;
3 11226 \f
3 11226 message procedure radio side 2 - 820304/hko;
3 11227
3 11227 rad_op:= op;
3 11228
3 11228 trap(radio_trap);
3 11229 stack_claim((if cm_test then 200 else 150) +200);
3 11230
3 11230 <*+2*>if testbit32 and overvåget or testbit28 then
3 11231 skriv_radio(out,0);
3 11232 <*-2*>
3 11233 repeat
3 11234 waitch(cs_radio(talevej),opref,true,-1);
3 11235 <*+2*>
3 11236 if testbit33 and overvåget then
3 11237 disable begin
4 11238 skriv_radio(out,0);
4 11239 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 11240 skriv_op(out,opref);
4 11241 end;
3 11242 <*-2*>
3 11243
3 11243 k:= d.op_ref.opkode extract 12;
3 11244 opgave:= d.opref.opkode shift (-12);
3 11245 operatør:= d.op_ref.data(4);
3 11246
3 11246 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 11247 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 11248 <:radio:>,0);
3 11249 <*-4*>
3 11250 \f
3 11250 message procedure radio side 3 - 880930/cl;
3 11251 if k=41 <*radiokommando fra operatør*> then
3 11252 begin
4 11253 vogn:= d.opref.data(2);
4 11254 res:= -1;
4 11255 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 11256 sig:= 0; omr:= d.opref.data(3) extract 8;
4 11257 bus:= garage:= ll:= 0;
4 11258
4 11258 if opgave=1 or opgave=9 then
4 11259 begin <* opkald til enkelt vogn (CHF) *>
5 11260 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 11261 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 11262 <* ok at kø er tom når vogn er angivet eller VHF *>
5 11263
5 11263 d.opref.data(11):= if res=0 then
5 11264 (if ll<>0 then ll else bus) else vogn;
5 11265
5 11265 if type=2 <*nød*> then
5 11266 begin
6 11267 waitch(cs_radio_pulje,opref1,true,-1);
6 11268 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 11269 d.opref1.data(1):= if ll<>0 then ll else bus;
6 11270 systime(5,0,kl);
6 11271 d.opref1.data(2):= entier(kl/100.0);
6 11272 d.opref1.data(3):= omr;
6 11273 signalch(cs_io,opref1,gen_optype or rad_optype);
6 11274 end
5 11275 end; <* enkeltvogn (CHF) *>
4 11276
4 11276 <* check enkeltvogn for ledig *>
4 11277 if res<=0 and omr=2<*VHF*> and bus=0 and
4 11278 (opgave=1 or opgave=9) then
4 11279 begin
5 11280 for i:= 1 step 1 until max_antal_kanaler do
5 11281 if kanal_til_omr(i)=2 then nr:= i;
5 11282 iaf:= (nr-1)*kanalbeskrlængde;
5 11283 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 11284 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 11285 then res:= 52;
5 11286 end;
4 11287 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 11288 d.opref.data(3)=0 <*std. omr*>) and
4 11289 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 11290 then
4 11291 begin
5 11292 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 11293 if vogn shift (-22) = 1 then
5 11294 begin
6 11295 find_busnr(vogn,bus,garage,res);
6 11296 ll:= vogn;
6 11297 end
5 11298 else
5 11299 if vogn shift (-22) = 0 then
5 11300 begin
6 11301 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 11302 bus:= vogn;
6 11303 end
5 11304 else
5 11305 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 11306 res:= if res=(-1) then 18 <* i kø *> else
5 11307 (if res<>0 then 14 <*opt*> else 0);
5 11308 end
4 11309 else
4 11310 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 11311 opgave <= 2 then
4 11312 begin
5 11313 bus:= vogn; garage:= type:= ttmm:= 0;
5 11314 res:= 0; omr:= 0; sig:= 0;
5 11315 end
4 11316 else
4 11317 if opgave>1 and opgave<>9 then
4 11318 type:= ttmm:= res:= 0;
4 11319 \f
4 11319 message procedure radio side 4 - 880930/cl;
4 11320
4 11320 if res=0 and (opgave<=4 or opgave=9) and
4 11321 (omr<1 or 2<omr) and
4 11322 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 11323 begin <* reserver i vogntabel *>
5 11324 waitch(cs_vt_adgang,vt_op,true,-1);
5 11325 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11326 if opgave <=2 or opgave=9 then 15 else 16);
5 11327 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 11328 (if vogn=0 then garage shift 14 + bus else
5 11329 if ll<>0 then ll else garage shift 14 + bus)
5 11330 else vogn <*gruppeid*>;
5 11331 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 11332 d.opref.data(3) extract 8
5 11333 else omr extract 8;
5 11334 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 11335 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 11336
5 11336 res:= d.vt_op.resultat;
5 11337 if res=3 then res:= 0;
5 11338 vtop2:= d.vt_op.data(2);
5 11339 vtop3:= d.vt_op.data(3);
5 11340 tekn_inf:= d.vt_op.data(4);
5 11341 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 11342 end;
4 11343
4 11343 if res<>0 then
4 11344 begin
5 11345 d.opref.resultat:= res;
5 11346 signalch(d.opref.retur,opref,d.opref.optype);
5 11347 end
4 11348 else
4 11349
4 11349 if opgave <= 9 then
4 11350 begin <* opkald *>
5 11351 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 11352 opgave<>9 and d.opref.data(6)<>0);
5 11353
5 11353 if res<>0 then
5 11354 goto returner_op;
5 11355
5 11355 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 11356 begin
6 11357 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 11358 'H' shift 12 + 60);
6 11359 d.rad_op.data(1):= talevej;
6 11360 d.rad_op.data(2):= 'D';
6 11361 d.rad_op.data(3):= 6; <* rear *>
6 11362 d.rad_op.data(4):= 1; <* rear no *>
6 11363 d.rad_op.data(5):= 0; <* disconnect *>
6 11364 signalch(cs_radio_ud,rad_op,rad_optype);
6 11365 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 11366 if d.rad_op.resultat<>0 then
6 11367 begin
7 11368 res:= d.rad_op.resultat;
7 11369 goto returner_op;
7 11370 end;
6 11371 <*
6 11372 while optaget_flag shift (-1) <> 0 do
6 11373 delay(1);
6 11374 *>
6 11375 end;
5 11376 \f
5 11376 message procedure radio side 5 - 880930/cl;
5 11377
5 11377 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 11378 'B' shift 12 + 60);
5 11379 d.rad_op.data(1):= talevej;
5 11380 d.rad_op.data(2):= 'D';
5 11381 d.rad_op.data(3):= if opgave=9 then 3 else
5 11382 (2 - (opgave extract 1)); <* højttalerkode *>
5 11383
5 11383 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11384 begin
6 11385 j:= 0;
6 11386 for i:= 2 step 1 until max_antal_områder do
6 11387 begin
7 11388 if opgave > 6 or
7 11389 (d.opref.data(3) shift (-20) = 15 and
7 11390 læsbiti(d.opref.data(3),i)) or
7 11391 (d.opref.data(3) shift (-20) = 14 and
7 11392 d.opref.data(3) extract 20 = i)
7 11393 then
7 11394 begin
8 11395 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11396 begin
9 11397 j:= j+1;
9 11398 d.rad_op.data(10+(j-1)*2):=
9 11399 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11400 (if i=2<*VHF*> then 4 else k)
9 11401 shift 8 + <* signal type *>
9 11402 1; <* antal tno *>
9 11403 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11404 end;
8 11405 end;
7 11406 end;
6 11407 d.rad_op.data(4):= j;
6 11408 d.rad_op.data(5):= 0;
6 11409 end
5 11410 else
5 11411 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11412 begin
6 11413 d.rad_op.data(4):= vtop2;
6 11414 d.rad_op.data(5):= vtop3;
6 11415 end
5 11416 else
5 11417 begin <* enkeltvogn *>
6 11418 if omr=0 then
6 11419 begin
7 11420 sig:= tekn_inf shift (-23);
7 11421 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11422 else tekn_inf extract 8;
7 11423 end
6 11424 else
6 11425 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11426
6 11426 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11427 <* tvinges til alm. opkald *>
6 11428 if (opgave=9) and (type=2) and (omr<=3) then
6 11429 begin
7 11430 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11431 opgave:= 1;
7 11432 d.radop.data(3):= 1;
7 11433 end;
6 11434
6 11434 if omr=2 <*VHF*> then sig:= 4 else
6 11435 if omr=1 <*TLF*> then sig:= 7 else
6 11436 <*UHF*> sig:= sig+1;
6 11437 d.rad_op.data(4):= 1;
6 11438 d.rad_op.data(5):= 0;
6 11439 d.rad_op.data(10):=
6 11440 (område_id(omr,2) extract 12) shift 12 +
6 11441 sig shift 8 +
6 11442 1;
6 11443 d.rad_op.data(11):= bus;
6 11444 end;
5 11445 \f
5 11445 message procedure radio side 6 - 880930/cl;
5 11446
5 11446 signalch(cs_radio_ud,rad_op,rad_optype);
5 11447 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11448 res:= d.rad_op.resultat;
5 11449
5 11449 d.rad_op.data(6):= 0;
5 11450 for i:= 1 step 1 until max_antal_områder do
5 11451 if læsbiti(d.rad_op.data(7),i) then
5 11452 increase(d.rad_op.data(6));
5 11453 returner_op:
5 11454 if d.rad_op.data(6)=1 then
5 11455 begin
6 11456 for i:= 1 step 1 until max_antal_områder do
6 11457 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11458 d.opref.data(12):= 14 shift 20 + i;
6 11459 end
5 11460 else
5 11461 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11462 d.opref.data(7):= type;
5 11463 d.opref.data(8):= garage shift 14 + bus;
5 11464 d.opref.data(9):= ll;
5 11465 if res=0 then
5 11466 begin
6 11467 d.opref.resultat:= 3;
6 11468 d.opref.data(5):= d.opref.data(6);
6 11469 j:= 0;
6 11470 for i:= 1 step 1 until max_antal_kanaler do
6 11471 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11472 if j>1 then
6 11473 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11474 else
6 11475 begin
7 11476 j:= 0;
7 11477 for i:= 1 step 1 until max_antal_kanaler do
7 11478 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11479 d.opref.data(6):= 3 shift 22 + j;
7 11480 end;
6 11481 d.opref.data(7):= type;
6 11482 d.opref.data(8):= garage shift 14 + bus;
6 11483 d.opref.data(9):= ll;
6 11484 d.opref.data(10):= d.opref.data(6);
6 11485 for i:= 1 step 1 until max_antal_kanaler do
6 11486 begin
7 11487 if læsbiti(d.rad_op.data(9),i) then
7 11488 begin
8 11489 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11490 j:= pabx_id( kanal_id(i) extract 5 )
8 11491 else
8 11492 j:= radio_id( kanal_id(i) extract 5 );
8 11493 if j>0 and type=0 and operatør>0 then tæl_opkald(j,1);
8 11494
8 11494 iaf:= (i-1)*kanalbeskrlængde;
8 11495 skrivtegn(kanal_tab.iaf,1,talevej);
8 11496 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11497 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11498 kanal_tab.iaf.kanal_id1:=
8 11499 if opgave<=2 or opgave=9 then
8 11500 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11501 else
8 11502 d.opref.data(2);
8 11503 kanal_tab.iaf.kanal_alt_id1:=
8 11504 if opgave<=2 or opgave=9 then
8 11505 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11506 else
8 11507 0;
8 11508 if kanal_tab.iaf.kanal_id1=0 then
8 11509 kanal_tab.iaf.kanal_id1:= 10000;
8 11510 kanal_tab.iaf.kanal_spec:=
8 11511 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11512 end;
7 11513 end;
6 11514 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11515 sætbit_ia(kanalflag,operatør,1);
6 11516 \f
6 11516 message procedure radio side 7 - 880930/cl;
6 11517
6 11517 end
5 11518 else
5 11519 begin
6 11520 d.opref.resultat:= res;
6 11521 if res=20 or res=52 then
6 11522 begin <* tæl ej.forb og opt.kanal *>
7 11523 for i:= 1 step 1 until max_antal_områder do
7 11524 if læsbiti(d.rad_op.data(7),i) then
7 11525 tæl_opkald(i,(if res=20 then 4 else 5));
7 11526 end;
6 11527 if d.opref.data(6)=0 then
6 11528 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11529 <* frigiv fra vogntabel hvis reserveret *>
6 11530 if (opgave<=4 or opgave=9) and
6 11531 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11532 begin
7 11533 waitch(cs_vt_adgang,vt_op,true,-1);
7 11534 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11535 if opgave<=2 or opgave=9 then 17 else 18);
7 11536 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11537 (if vogn=0 then garage shift 14 + bus else
7 11538 if ll<>0 then ll else garage shift 14 + bus)
7 11539 else vogn;
7 11540 d.vt_op.data(4):= omr;
7 11541 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11542 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11543 signalch(cs_vt_adgang,vt_op,true);
7 11544 end;
6 11545 end;
5 11546 signalch(d.opref.retur,opref,d.opref.optype);
5 11547 \f
5 11547 message procedure radio side 8 - 880930/cl;
5 11548
5 11548 end <* opkald *>
4 11549 else
4 11550 if opgave = 10 <* MONITER *> then
4 11551 begin
5 11552 nr:= d.opref.data(2);
5 11553 if nr shift (-20) <> 12 then
5 11554 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11555 nr:= nr extract 20;
5 11556 iaf:= (nr-1)*kanalbeskrlængde;
5 11557 inspect(ss_samtale_nedlagt(nr),i);
5 11558 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11559 kanal_tab.iaf.kanal_id2 extract 20
5 11560 else
5 11561 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11562 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11563 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11564 (i<>0 or j<>0) then
5 11565 begin
6 11566 res:= 0;
6 11567 d.opref.data(5):= 12 shift 20 + k;
6 11568 d.opref.data(6):= 12 shift 20 + nr;
6 11569 sætbit_ia(kanalflag,operatør,1);
6 11570 goto radio_nedlæg;
6 11571 end
5 11572 else
5 11573 if i<>0 or j<>0 then
5 11574 res:= 49
5 11575 else
5 11576 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11577 res:= 49 <* ingen samtale igang *>
5 11578 else
5 11579 begin
6 11580 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11581 if res=0 then
6 11582 begin
7 11583 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11584 'B' shift 12 + 60);
7 11585 d.rad_op.data(1):= talevej;
7 11586 d.rad_op.data(2):= 'V';
7 11587 d.rad_op.data(3):= 0;
7 11588 d.rad_op.data(4):= 1;
7 11589 d.rad_op.data(5):= 0;
7 11590 d.rad_op.data(10):=
7 11591 (kanal_id(nr) shift (-5) shift 18) +
7 11592 (kanal_id(nr) extract 5 shift 12) + 0;
7 11593 signalch(cs_radio_ud,rad_op,rad_optype);
7 11594 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11595 res:= d.rad_op.resultat;
7 11596 if res=0 then
7 11597 begin
8 11598 d.opref.data(5):= 0;
8 11599 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11600 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11601 res:= 3;
8 11602 end;
7 11603 end;
6 11604 end;
5 11605 \f
5 11605 message procedure radio side 9 - 880930/cl;
5 11606 if res=3 then
5 11607 begin
6 11608 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11609 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11610 else
6 11611 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11612 d.opref.data(6):= 12 shift 20 + nr;
6 11613 i:= kanal_tab.iaf.kanal_id2;
6 11614 if i<>0 then
6 11615 begin
7 11616 if i shift (-20) = 12 then
7 11617 begin <* ident2 henviser til anden kanal *>
8 11618 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11619 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11620 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11621 else
8 11622 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11623 d.opref.data(5):= 12 shift 20 + i;
8 11624 end
7 11625 else
7 11626 d.opref.data(5):= 12 shift 20 + nr;
7 11627 end
6 11628 else
6 11629 d.opref.data(5):= 0;
6 11630 end;
5 11631
5 11631 if res<>3 then
5 11632 begin
6 11633 res:= 0;
6 11634 sætbit_ia(kanalflag,operatør,1);
6 11635 goto radio_nedlæg;
6 11636 end;
5 11637 d.opref.resultat:= res;
5 11638 signalch(d.opref.retur,opref,d.opref.optype);
5 11639 \f
5 11639 message procedure radio side 10 - 880930/cl;
5 11640
5 11640 end <* MONITERING *>
4 11641 else
4 11642 if opgave = 11 then <* GENNEMSTILLING *>
4 11643 begin
5 11644 nr:= d.opref.data(6) extract 20;
5 11645 k:= if d.opref.data(5) shift (-20) = 12 then
5 11646 d.opref.data(5) extract 20
5 11647 else
5 11648 0;
5 11649 inspect(ss_samtale_nedlagt(nr),i);
5 11650 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11651 if i<>0 and j<>0 then
5 11652 begin
6 11653 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11654 goto radio_nedlæg;
6 11655 end;
5 11656
5 11656 iaf:= (nr-1)*kanal_beskr_længde;
5 11657 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11658 begin
6 11659 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11660 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11661 then
6 11662 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11663 else
6 11664 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11665 d.opref.data(5)<>0
6 11666 then
6 11667 res:= 0
6 11668 else
6 11669 res:= 21; <* ingen at gennemstille til *>
6 11670 end
5 11671 else
5 11672 res:= 50; <* kanalnr *>
5 11673
5 11673 if res=0 then
5 11674 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11675 if res=0 then
5 11676 begin
6 11677 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11678 kanal_tab.iaf.kanal_tilstand:=
6 11679 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11680 d.opref.data(6):= 0;
6 11681 if kanal_tab.iaf.kanal_id2=0 then
6 11682 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11683
6 11683 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11684 begin <* gennemstillet til anden kanal *>
7 11685 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11686 *kanalbeskrlængde;
7 11687 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11688 kanal_tab.iaf1.kanal_tilstand:=
7 11689 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11690 if kanal_tab.iaf1.kanal_id2=0 then
7 11691 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11692 end;
6 11693 d.opref.data(5):= 0;
6 11694
6 11694 res:= 3;
6 11695 end;
5 11696
5 11696 d.opref.resultat:= res;
5 11697 signalch(d.opref.retur,opref,d.opref.optype);
5 11698 \f
5 11698 message procedure radio side 11 - 880930/cl;
5 11699
5 11699 end
4 11700 else
4 11701 if opgave = 12 then <* NEDLÆG *>
4 11702 begin
5 11703 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11704 radio_nedlæg:
5 11705 if res=0 then
5 11706 begin
6 11707 for k:= 5, 6 do
6 11708 begin
7 11709 if d.opref.data(k) shift (-20) = 12 then
7 11710 begin
8 11711 i:= d.opref.data(k) extract 20;
8 11712 iaf:= (i-1)*kanalbeskrlængde;
8 11713 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11714 frigiv_kanal(d.opref.data(k) extract 20)
8 11715 else
8 11716 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11717 end
7 11718 else
7 11719 if d.opref.data(k) shift (-20) = 13 then
7 11720 begin
8 11721 for i:= 1 step 1 until max_antal_kanaler do
8 11722 if læsbiti(d.opref.data(k),i) then
8 11723 begin
9 11724 iaf:= (i-1)*kanalbeskrlængde;
9 11725 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11726 frigiv_kanal(i)
9 11727 else
9 11728 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11729 end;
8 11730 sætbit_ia(kanalflag,operatør,1);
8 11731 end;
7 11732 end;
6 11733 d.opref.data(5):= 0;
6 11734 d.opref.data(6):= 0;
6 11735 d.opref.data(9):= 0;
6 11736 res:= if opgave=12 then 3 else 49;
6 11737 end;
5 11738 d.opref.resultat:= res;
5 11739 signalch(d.opref.retur,opref,d.opref.optype);
5 11740 end
4 11741 else
4 11742 if opgave=13 then <* R *>
4 11743 begin
5 11744 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11745 'H' shift 12 + 60);
5 11746 d.rad_op.data(1):= talevej;
5 11747 d.rad_op.data(2):= 'M';
5 11748 d.rad_op.data(3):= 0; <*tkt*>
5 11749 d.rad_op.data(4):= 0; <*tkn*>
5 11750 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11751 signalch(cs_radio_ud,rad_op,rad_optype);
5 11752 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11753 res:= d.rad_op.resultat;
5 11754 d.opref.resultat:= if res=0 then 3 else res;
5 11755 signalch(d.opref.retur,opref,d.opref.optype);
5 11756 end
4 11757 else
4 11758 if opgave=14 <* VENTEPOS *> then
4 11759 begin
5 11760 res:= 0;
5 11761 while (res<=3 and d.opref.data(2)>0) do
5 11762 begin
6 11763 nr:= d.opref.data(6) extract 20;
6 11764 k:= if d.opref.data(5) shift (-20) = 12 then
6 11765 d.opref.data(5) extract 20
6 11766 else
6 11767 0;
6 11768 inspect(ss_samtale_nedlagt(nr),i);
6 11769 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11770 if i<>0 or j<>0 then
6 11771 begin
7 11772 res:= hookon(talevej,radop,cs_radio(talevej));
7 11773 goto radio_nedlæg;
7 11774 end;
6 11775
6 11775 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11776
6 11776 if res=0 then
6 11777 begin
7 11778 i:= d.opref.data(5);
7 11779 d.opref.data(5):= d.opref.data(6);
7 11780 d.opref.data(6):= i;
7 11781 res:= 3;
7 11782 end;
6 11783
6 11783 d.opref.data(2):= d.opref.data(2)-1;
6 11784 end;
5 11785 d.opref.resultat:= res;
5 11786 signalch(d.opref.retur,opref,d.opref.optype);
5 11787 end
4 11788 else
4 11789 begin
5 11790 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11791 d.opref.resultat:= 31;
5 11792 signalch(d.opref.retur,opref,d.opref.optype);
5 11793 end;
4 11794
4 11794 end <* radiokommando fra operatør *>
3 11795 else
3 11796 begin
4 11797
4 11797 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11798
4 11798 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11799
4 11799 end;
3 11800
3 11800 until false;
3 11801 radio_trap:
3 11802 disable skriv_radio(zbillede,1);
3 11803 end radio;
2 11804 \f
2 11804 message procedure radio_ind side 1 - 810521/hko;
2 11805
2 11805 procedure radio_ind(op);
2 11806 value op;
2 11807 integer op;
2 11808 begin
3 11809 integer array field op_ref,ref,io_opref;
3 11810 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11811 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11812 integer array typ, val(1:6), answ, tlgr(1:32);
3 11813 integer array field spec;
3 11814 real field rf;
3 11815 long array field laf;
3 11816
3 11816 procedure skriv_radio_ind(zud,omfang);
3 11817 value omfang;
3 11818 zone zud;
3 11819 integer omfang;
3 11820 begin integer ii;
4 11821 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11822 if omfang > 0 then
4 11823 disable begin integer x; long array field tx;
5 11824 tx:= 0;
5 11825 trap(slut);
5 11826 write(zud,"nl",1,
5 11827 <: op-ref: :>,op_ref,"nl",1,
5 11828 <: ref: :>,ref,"nl",1,
5 11829 <: io-opref: :>,io_opref,"nl",1,
5 11830 <: ac: :>,ac,"nl",1,
5 11831 <: lgd: :>,lgd,"nl",1,
5 11832 <: ttyp: :>,ttyp,"nl",1,
5 11833 <: ptyp: :>,ptyp,"nl",1,
5 11834 <: pnum: :>,pnum,"nl",1,
5 11835 <: pos: :>,pos,"nl",1,
5 11836 <: tegn: :>,tegn,"nl",1,
5 11837 <: bs: :>,bs,"nl",1,
5 11838 <: b-pt: :>,b_pt,"nl",1,
5 11839 <: b-pn: :>,b_pn,"nl",1,
5 11840 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11841 <: antal-spec: :>,antal_spec,"nl",1,
5 11842 <: sum: :>,sum,"nl",1,
5 11843 <: csum: :>,csum,"nl",1,
5 11844 <: i: :>,i,"nl",1,
5 11845 <: j: :>,j,"nl",1,
5 11846 <: k: :>,k,"nl",1,
5 11847 <: filref :>,filref,"nl",1,
5 11848 <: zno: :>,zno,"nl",1,
5 11849 <: answ: :>,answ.tx,"nl",1,
5 11850 <: tlgr: :>,tlgr.tx,"nl",1,
5 11851 <: spec: :>,spec,"nl",1);
5 11852 trap(slut);
5 11853 slut:
5 11854 end; <*disable*>
4 11855 end skriv_radio_ind;
3 11856 \f
3 11856 message procedure indsæt_opkald side 1 - 811105/hko;
3 11857
3 11857 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11858 value bus,type,omr,sig;
3 11859 integer bus,type,omr,sig;
3 11860 begin
4 11861 integer res,tilst,ll,operatør;
4 11862 integer array field vt_op,ref,næste,forrige;
4 11863 real r;
4 11864
4 11864 res:= -1;
4 11865 begin
5 11866 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11867 if vt_op <> 0 then
5 11868 begin
6 11869 wait(bs_opkaldskø_adgang);
6 11870 if omr>2 then
6 11871 begin
7 11872 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11873 d.vt_op.data(1):= bus;
7 11874 d.vt_op.data(4):= omr;
7 11875 tilst:= vt_op;
7 11876 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11877 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11878 <*+4*> if tilst <> vt_op then
7 11879 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11880 <*-4*>
7 11881 <*+2*> if testbit34 and overvåget then
7 11882 disable begin
8 11883 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11884 skriv_op(out,vt_op);
8 11885 ud;
8 11886 end;
7 11887 end
6 11888 else
6 11889 begin
7 11890 d.vt_op.data(1):= bus;
7 11891 d.vt_op.data(2):= 0;
7 11892 d.vt_op.data(3):= bus;
7 11893 d.vt_op.data(4):= omr;
7 11894 d.vt_op.resultat:= 0;
7 11895 ref:= første_nødopkald;
7 11896 if ref<>0 then tilst:= 2
7 11897 else
7 11898 begin
8 11899 ref:= første_opkald;
8 11900 tilst:= if ref=0 then 0 else 1;
8 11901 end;
7 11902 if tilst=0 then
7 11903 d.vt_op.resultat:= 3
7 11904 else
7 11905 begin
8 11906 while ref<>0 and d.vt_op.resultat=0 do
8 11907 begin
9 11908 if opkaldskø.ref(2) extract 14 = bus and
9 11909 opkaldskø.ref(5) extract 8 = omr
9 11910 then
9 11911 d.vt_op.resultat:= 18
9 11912 else
9 11913 begin
10 11914 ref:= opkaldskø.ref(1) extract 12;
10 11915 if ref=0 and tilst=2 then
10 11916 begin
11 11917 ref:= første_opkald;
11 11918 tilst:= if ref=0 then 0 else 1;
11 11919 end
10 11920 else
10 11921 if ref=0 then tilst:= 0;
10 11922 end;
9 11923 end;
8 11924 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11925 end;
7 11926 end;
6 11927 <*-2*>
6 11928 \f
6 11928 message procedure indsæt_opkald side 1a- 820301/hko;
6 11929
6 11929 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11930 begin
7 11931 ref:=første_opkald;
7 11932 tilst:=-1;
7 11933 while ref<>0 and tilst=-1 do
7 11934 begin
8 11935 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11936 begin <* udtag normalopkald *>
9 11937 næste:=opkaldskø.ref(1);
9 11938 forrige:=næste shift(-12);
9 11939 næste:=næste extract 12;
9 11940 if forrige<>0 then
9 11941 opkaldskø.forrige(1):=
9 11942 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11943 else
9 11944 første_opkald:=næste;
9 11945 if næste<>0 then
9 11946 opkaldskø.næste(1):=
9 11947 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11948 else
9 11949 sidste_opkald:=forrige;
9 11950 opkaldskø.ref(1):=første_frie_opkald;
9 11951 første_frie_opkald:=ref;
9 11952 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11953 tilst:=0;
9 11954 end
8 11955 else
8 11956 ref:=opkaldskø.ref(1) extract 12;
8 11957 end; <*while*>
7 11958 if tilst=0 then
7 11959 d.vt_op.resultat:=3;
7 11960 end; <*nødopkald bus i kø*>
6 11961 \f
6 11961 message procedure indsæt_opkald side 2 - 820304/hko;
6 11962
6 11962 if d.vt_op.resultat = 3 then
6 11963 begin
7 11964 ll:= d.vt_op.data(2);
7 11965 tilst:= d.vt_op.data(3);
7 11966 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11967 if operatør < 0 or max_antal_operatører < operatør then
7 11968 operatør:= 0;
7 11969 if operatør=0 then
7 11970 operatør:= (tilst shift (-14) extract 8);
7 11971 if operatør=0 then
7 11972 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11973 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11974 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11975 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11976 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11977 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11978 forrige:= (if type = 1 then sidste_opkald
7 11979 else sidste_nødopkald);
7 11980 opkaldskø.ref(1):= forrige shift 12;
7 11981 if type = 1 then
7 11982 begin
8 11983 if første_opkald = 0 then første_opkald:= ref;
8 11984 sidste_opkald:= ref;
8 11985 end
7 11986 else
7 11987 begin <*type = 2*>
8 11988 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11989 sidste_nødopkald:= ref;
8 11990 end;
7 11991 if forrige <> 0 then
7 11992 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11993 shift 12 +ref;
7 11994
7 11994 opkaldskø.ref(2):= tilst extract 22 add
7 11995 (if type=2 then 1 shift 23 else 0);
7 11996 opkaldskø.ref(3):= ll;
7 11997 systime(5,0.0,r);
7 11998 ll:= round r//100;<*ttmm*>
7 11999 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 12000 opkaldskø.ref(5):= sig shift 20 + omr;
7 12001 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 12002 res:= 0;
7 12003 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 12004 opkaldskø_ledige:= opkaldskø_ledige -1;
7 12005 <*meddel opkald til berørte operatører *>
7 12006 signal_bin(bs_mobil_opkald);
7 12007 tæl_opkald(omr,type+1);
7 12008 end <* resultat = 3 *>
6 12009 else
6 12010 begin
7 12011 \f
7 12011 message procedure indsæt_opkald side 3 - 810601/hko;
7 12012
7 12012 <* d.vt_op.resultat <> 3 *>
7 12013
7 12013 res:= d.vt_op.resultat;
7 12014 if res = 10 then
7 12015 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 12016 <:er ikke i bustabel:>,1)
7 12017 else
7 12018 <*+4*> if res <> 14 and res <> 18 then
7 12019 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 12020 <*-4*>
7 12021 ;
7 12022 end;
6 12023 signalbin(bs_opkaldskø_adgang);
6 12024 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 12025 end
5 12026 else
5 12027 res:= -2; <*timeout for cs_vt_adgang*>
5 12028 end;
4 12029 indsæt_opkald:= res;
4 12030 end indsæt_opkald;
3 12031 \f
3 12031 message procedure afvent_telegram side 1 - 880901/cl;
3 12032
3 12032 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12033 integer array tlgr;
3 12034 integer lgd,ttyp,ptyp,pnum;
3 12035 begin
4 12036 integer i, pos, tegn, ac, sum, csum;
4 12037
4 12037 pos:= 1;
4 12038 lgd:= 0;
4 12039 ttyp:= 'Z';
4 12040 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 12041 if ac >= 0 then
4 12042 begin
5 12043 lgd:= 1;
5 12044 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 12045 lgd:= lgd-2;
5 12046 if lgd >= 3 then
5 12047 begin
6 12048 i:= 1;
6 12049 ttyp:= læstegn(tlgr,i,tegn);
6 12050 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 12051 pnum:= læstegn(tlgr,i,tegn) - '@';
6 12052 end
5 12053 else ac:= 6; <* for kort telegram - retransmitter *>
5 12054 end;
4 12055
4 12055 afvent_telegram:= ac;
4 12056 end;
3 12057 \f
3 12057 message procedure b_answ side 1 - 880901/cl;
3 12058
3 12058 procedure b_answ(answ,ht,spec,more,ac);
3 12059 value ht, more,ac;
3 12060 integer array answ, spec;
3 12061 boolean more;
3 12062 integer ht, ac;
3 12063 begin
4 12064 integer pos, i, sum, tegn;
4 12065
4 12065 pos:= 1;
4 12066 skrivtegn(answ,pos,'B');
4 12067 skrivtegn(answ,pos,if more then 'B' else ' ');
4 12068 skrivtegn(answ,pos,ac+'@');
4 12069 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 12070 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 12071 skrivtegn(answ,pos,'@');
4 12072 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 12073 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 12074 for i:= 1 step 1 until spec(1) extract 8 do
4 12075 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 12076 else
4 12077 begin
5 12078 skrivtegn(answ,pos,'D');
5 12079 anbringtal(answ,pos,spec(1+i),-4);
5 12080 end;
4 12081 for i:= 1 step 1 until 4 do
4 12082 skrivtegn(answ,pos,'@');
4 12083 skrivtegn(answ,pos,ht+'@');
4 12084 skrivtegn(answ,pos,'@');
4 12085
4 12085 i:= 1; sum:= 0;
4 12086 while i < pos do
4 12087 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 12088 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 12089 skrivtegn(answ,pos,sum extract 4 + '@');
4 12090 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 12091 end;
3 12092 \f
3 12092 message procedure ann_opkald side 1 - 881108/cl;
3 12093
3 12093 integer procedure ann_opkald(vogn,omr);
3 12094 value vogn,omr;
3 12095 integer vogn,omr;
3 12096 begin
4 12097 integer array field vt_op,ref,næste,forrige;
4 12098 integer res, t, i, o;
4 12099
4 12099 waitch(cs_vt_adgang,vt_op,true,-1);
4 12100 res:= -1;
4 12101 wait(bs_opkaldskø_adgang);
4 12102 ref:= første_nødopkald;
4 12103 if ref <> 0 then
4 12104 t:= 2
4 12105 else
4 12106 begin
5 12107 ref:= første_opkald;
5 12108 t:= if ref<>0 then 1 else 0;
5 12109 end;
4 12110
4 12110 if t=0 then
4 12111 res:= 19 <* kø tom *>
4 12112 else
4 12113 begin
5 12114 while ref<>0 and res=(-1) do
5 12115 begin
6 12116 if vogn=opkaldskø.ref(2) extract 14 and
6 12117 omr=opkaldskø.ref(5) extract 8
6 12118 then
6 12119 res:= 0
6 12120 else
6 12121 begin
7 12122 ref:= opkaldskø.ref(1) extract 12;
7 12123 if ref=0 and t=2 then
7 12124 begin
8 12125 ref:= første_opkald;
8 12126 t:= if ref=0 then 0 else 1;
8 12127 end;
7 12128 end;
6 12129 end; <*while*>
5 12130 \f
5 12130 message procedure ann_opkald side 2 - 881108/cl;
5 12131
5 12131 if ref<>0 then
5 12132 begin
6 12133 start_operation(vt_op,401,cs_radio_ind,17);
6 12134 d.vt_op.data(1):= vogn;
6 12135 d.vt_op.data(4):= omr;
6 12136 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 12137 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 12138
6 12138 o:= opkaldskø.ref(4) extract 8;
6 12139 næste:= opkaldskø.ref(1);
6 12140 forrige:= næste shift (-12);
6 12141 næste:= næste extract 12;
6 12142 if forrige<>0 then
6 12143 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 12144 + næste
6 12145 else
6 12146 if t=2 then første_nødopkald:= næste
6 12147 else første_opkald:= næste;
6 12148
6 12148 if næste<>0 then
6 12149 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 12150 + forrige shift 12
6 12151 else
6 12152 if t=2 then sidste_nødopkald:= forrige
6 12153 else sidste_opkald:= forrige;
6 12154
6 12154 opkaldskø.ref(1):= første_frie_opkald;
6 12155 første_frie_opkald:= ref;
6 12156 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 12157 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 12158
6 12158 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 12159 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 12160 else
6 12161 begin
7 12162 sætbit_ia(opkaldsflag,o,1);
7 12163 end;
6 12164 signalbin(bs_mobilopkald);
6 12165 end;
5 12166 end;
4 12167
4 12167 signalbin(bs_opkaldskø_adgang);
4 12168 signalch(cs_vt_adgang, vt_op, true);
4 12169 ann_opkald:= res;
4 12170 end;
3 12171 \f
3 12171 message procedure frigiv_id side 1 - 881114/cl;
3 12172
3 12172 integer procedure frigiv_id(id,omr);
3 12173 value id,omr;
3 12174 integer id,omr;
3 12175 begin
4 12176 integer array field vt_op;
4 12177
4 12177 if id shift (-22) < 3 and omr > 2 then
4 12178 begin
5 12179 waitch(cs_vt_adgang,vt_op,true,-1);
5 12180 start_operation(vt_op,401,cs_radio_ind,
5 12181 if id shift (-22) = 2 then 18 else 17);
5 12182 d.vt_op.data(1):= id;
5 12183 d.vt_op.data(4):= omr;
5 12184 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 12185 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 12186 frigiv_id:= d.vt_op.resultat;
5 12187 signalch(cs_vt_adgang,vt_op,true);
5 12188 end;
4 12189 end;
3 12190 \f
3 12190 message procedure radio_ind side 2 - 810524/hko;
3 12191 trap(radio_ind_trap);
3 12192 laf:= 0;
3 12193 stack_claim((if cm_test then 200 else 150) +135+75);
3 12194
3 12194 <*+2*>if testbit32 and overvåget or testbit28 then
3 12195 skriv_radio_ind(out,0);
3 12196 <*-2*>
3 12197 answ.laf(1):= long<:<'nl'>:>;
3 12198 io_opref:= op;
3 12199
3 12199 repeat
3 12200 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12201 pos:= 4;
3 12202 if ac = 0 then
3 12203 begin
4 12204 \f
4 12204 message procedure radio_ind side 3 - 881107/cl;
4 12205 if ttyp = 'A' then
4 12206 begin
5 12207 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12208 ac:= 1
5 12209 else
5 12210 begin
6 12211 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 12212 val(1):= ttyp;
6 12213 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 12214 val(2):= pnum;
6 12215 typ(3):= -1;
6 12216 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12217 if opref>0 then
6 12218 begin
7 12219 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 12220 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 12221 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 12222 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 12223 then
7 12224 begin
8 12225 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 12226 end
7 12227 else
7 12228 begin
8 12229 ac:= 0;
8 12230 d.opref.resultat:= 0;
8 12231 sætbit_ia(hookoff_maske,pnum,1);
8 12232 end;
7 12233 signalch(d.opref.retur,opref,d.opref.optype);
7 12234 end
6 12235 else
6 12236 ac:= 2;
6 12237 end;
5 12238 pos:= 1;
5 12239 skrivtegn(answ,pos,'A');
5 12240 skrivtegn(answ,pos,' ');
5 12241 skrivtegn(answ,pos,ac+'@');
5 12242 for i:= 1 step 1 until 5 do
5 12243 skrivtegn(answ,pos,'@');
5 12244 skrivtegn(answ,pos,'0');
5 12245 i:= 1; sum:= 0;
5 12246 while i < pos do
5 12247 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12248 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12249 skrivtegn(answ,pos,sum extract 4 + '@');
5 12250 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12251 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12252 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12253 disable begin
6 12254 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12255 outchar(zrl,'nl');
6 12256 end;
5 12257 <*-2*>
5 12258 disable setposition(z_fr_out,0,0);
5 12259 ac:= -1;
5 12260 \f
5 12260 message procedure radio_ind side 4 - 881107/cl;
5 12261 end <* ttyp=A *>
4 12262 else
4 12263 if ttyp = 'B' then
4 12264 begin
5 12265 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12266 ac:= 1
5 12267 else
5 12268 begin
6 12269 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 12270 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 12271 typ(3):= -1;
6 12272 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12273 if opref > 0 then
6 12274 begin
7 12275 <*+2*> if testbit37 and overvåget then
7 12276 disable begin
8 12277 skriv_radio_ind(out,0);
8 12278 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 12279 skriv_op(out,opref);
8 12280 end;
7 12281 <*-2*>
7 12282 læstegn(tlgr,pos,bs);
7 12283 if bs = 'V' then
7 12284 begin
8 12285 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 12286 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 12287 end;
7 12288 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 12289 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 12290 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 12291 then
7 12292 begin
8 12293 ac:= 1;
8 12294 d.opref.resultat:= 31; <* systemfejl *>
8 12295 signalch(d.opref.retur,opref,d.opref.optype);
8 12296 end
7 12297 else
7 12298 if bs='V' then
7 12299 begin
8 12300 ac:= 0;
8 12301 d.opref.resultat:= 1;
8 12302 d.opref.data(4):= 0;
8 12303 d.opref.data(7):=
8 12304 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 12305 radio_id(b_pn));
8 12306 systime(1,0.0,d.opref.tid);
8 12307 signalch(cs_radio_ind,opref,d.opref.optype);
8 12308 spec:= data+18;
8 12309 b_answ(answ,0,d.opref.spec,false,ac);
8 12310 <*+2*> if (testbit36 or testbit38) and overvåget then
8 12311 disable begin
9 12312 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 12313 outchar(zrl,'nl');
9 12314 end;
8 12315 <*-2*>
8 12316 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 12317 disable setposition(z_fr_out,0,0);
8 12318 ac:= -1;
8 12319 \f
8 12319 message procedure radio_ind side 5 - 881107/cl;
8 12320 end
7 12321 else
7 12322 begin
8 12323 integer sig_type;
8 12324
8 12324 ac:= 0;
8 12325 antal_spec:= d.opref.data(4);
8 12326 filref:= d.opref.data(5);
8 12327 spec:= d.opref.data(6);
8 12328 if antal_spec>0 then
8 12329 begin
9 12330 antal_spec:= antal_spec-1;
9 12331 if filref<>0 then
9 12332 begin
10 12333 læsfil(filref,1,zno);
10 12334 b_pt:= fil(zno).spec(1) shift (-12);
10 12335 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 12336 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 12337 antal_spec>0,ac);
10 12338 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 12339 end
9 12340 else
9 12341 begin
10 12342 b_pt:= d.opref.spec(1) shift (-12);
10 12343 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 12344 b_answ(answ,d.opref.data(3),d.opref.spec,
10 12345 antal_spec>0,ac);
10 12346 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 12347 end;
9 12348
9 12348 <* send answer *>
9 12349 <*+2*> if (testbit36 or testbit38) and overvåget then
9 12350 disable begin
10 12351 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 12352 outchar(zrl,'nl');
10 12353 end;
9 12354 <*-2*>
9 12355 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 12356 disable setposition(z_fr_out,0,0);
9 12357 if ac<>0 then
9 12358 begin
10 12359 antal_spec:= 0;
10 12360 ac:= -1;
10 12361 end
9 12362 else
9 12363 begin
10 12364 for i:= 1 step 1 until max_antal_områder do
10 12365 if område_id(i,2)=b_pt then
10 12366 begin
11 12367 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 12368 if sætbiti(d.opref.data(7),j,1)=0 then
11 12369 d.opref.resultat:= d.opref.resultat + 1;
11 12370 end;
10 12371 end;
9 12372 end;
8 12373 \f
8 12373 message procedure radio_ind side 6 - 881107/cl;
8 12374
8 12374 <* afvent nyt telegram *>
8 12375 d.opref.data(4):= antal_spec;
8 12376 d.opref.data(6):= spec;
8 12377 ac:= -1;
8 12378 systime(1,0.0,d.opref.tid);
8 12379 <*+2*> if testbit37 and overvåget then
8 12380 disable begin
9 12381 skriv_radio_ind(out,0);
9 12382 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 12383 ud;
9 12384 end;
8 12385 <*-2*>
8 12386 signalch(cs_radio_ind,opref,d.opref.optype);
8 12387 end;
7 12388 end
6 12389 else ac:= 2;
6 12390 end;
5 12391 if ac > 0 then
5 12392 begin
6 12393 for i:= 1 step 1 until 6 do val(i):= 0;
6 12394 b_answ(answ,0,val,false,ac);
6 12395 <*+2*>
6 12396 if (testbit36 or testbit38) and overvåget then
6 12397 disable begin
7 12398 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12399 outchar(zrl,'nl');
7 12400 end;
6 12401 <*-2*>
6 12402 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12403 disable setposition(z_fr_out,0,0);
6 12404 ac:= -1;
6 12405 end;
5 12406 \f
5 12406 message procedure radio_ind side 7 - 881107/cl;
5 12407 end <* ttyp = 'B' *>
4 12408 else
4 12409 if ttyp='C' or ttyp='J' then
4 12410 begin
5 12411 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12412 ac:= 1
5 12413 else
5 12414 begin
6 12415 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12416 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12417 typ(3):= -1;
6 12418 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12419 if opref > 0 then
6 12420 begin
7 12421 d.opref.resultat:= d.opref.resultat - 1;
7 12422 if ttyp = 'C' then
7 12423 begin
8 12424 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12425 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12426 j:= 0;
8 12427 for i:= 1 step 1 until max_antal_kanaler do
8 12428 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12429 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12430 d.opref.resultat:= d.opref.resultat-1;
8 12431 sætbiti(optaget_flag,j,1);
8 12432 sætbiti(d.opref.data(9),j,1);
8 12433 end
7 12434 else
7 12435 begin <* INGEN FORBINDELSE *>
8 12436 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12437 end;
7 12438 ac:= 0;
7 12439 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12440 begin
8 12441 systime(1,0,d.opref.tid);
8 12442 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12443 end
7 12444 else
7 12445 begin
8 12446 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12447 if læsbiti(d.opref.data(8),9) then 52 else
8 12448 if læsbiti(d.opref.data(8),10) then 20 else
8 12449 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12450 signalch(d.opref.retur, opref, d.opref.optype);
8 12451 end;
7 12452 end
6 12453 else
6 12454 ac:= 2;
6 12455 end;
5 12456 pos:= 1;
5 12457 skrivtegn(answ,pos,ttyp);
5 12458 skrivtegn(answ,pos,' ');
5 12459 skrivtegn(answ,pos,ac+'@');
5 12460 i:= 1; sum:= 0;
5 12461 while i < pos do
5 12462 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12463 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12464 skrivtegn(answ,pos,sum extract 4 + '@');
5 12465 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12466 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12467 disable begin
6 12468 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12469 outchar(zrl,'nl');
6 12470 end;
5 12471 <*-2*>
5 12472 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12473 disable setposition(z_fr_out,0,0);
5 12474 ac:= -1;
5 12475 \f
5 12475 message procedure radio_ind side 8 - 881107/cl;
5 12476 end <* ttyp = 'C' or 'J' *>
4 12477 else
4 12478 if ttyp = 'D' then
4 12479 begin
5 12480 if ptyp = 4 <* VDU *> then
5 12481 begin
6 12482 if pnum<1 or pnum>max_antal_taleveje then
6 12483 ac:= 1
6 12484 else
6 12485 begin
7 12486 inspect(bs_talevej_udkoblet(pnum),j);
7 12487 if j>=0 then
7 12488 begin
8 12489 sætbit_ia(samtaleflag,pnum,1);
8 12490 signal_bin(bs_mobil_opkald);
8 12491 end;
7 12492 if læsbit_ia(hookoff_maske,pnum) then
7 12493 signalbin(bs_talevej_udkoblet(pnum));
7 12494 ac:= 0;
7 12495 end
6 12496 end
5 12497 else
5 12498 if ptyp=3 or ptyp=2 then
5 12499 begin
6 12500 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12501 ptyp=2 and pnum<>2
6 12502 then
6 12503 ac:= 1
6 12504 else
6 12505 begin
7 12506 if læstegn(tlgr,5,tegn)='D' then
7 12507 begin <* teknisk nr i telegram *>
8 12508 b_pn:= 0;
8 12509 for i:= 1 step 1 until 4 do
8 12510 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12511 end
7 12512 else
7 12513 b_pn:= 0;
7 12514 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12515 i:= 0;
7 12516 for j:= 1 step 1 until max_antal_kanaler do
7 12517 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12518 if i<>0 then
7 12519 begin
8 12520 ref:= (i-1)*kanalbeskrlængde;
8 12521 inspect(ss_samtale_nedlagt(i),j);
8 12522 if j>=0 then
8 12523 begin
9 12524 sætbit_ia(samtaleflag,
9 12525 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12526 signalbin(bs_mobil_opkald);
9 12527 end;
8 12528 signal(ss_samtale_nedlagt(i));
8 12529 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12530 begin
9 12531 if kanal_tab.ref.kanal_id1<>0 and
9 12532 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12533 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12534 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12535 if kanal_tab.ref.kanal_id2<>0 and
9 12536 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12537 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12538 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12539 end;
8 12540 sætbiti(optaget_flag,i,0);
8 12541 end;
7 12542 ac:= 0;
7 12543 end;
6 12544 end
5 12545 else ac:= 1;
5 12546 if ac>=0 then
5 12547 begin
6 12548 pos:= i:= 1; sum:= 0;
6 12549 skrivtegn(answ,pos,'D');
6 12550 skrivtegn(answ,pos,' ');
6 12551 skrivtegn(answ,pos,ac+'@');
6 12552 skrivtegn(answ,pos,'@');
6 12553 while i<pos do
6 12554 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12555 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12556 skrivtegn(answ,pos, sum extract 4 + '@');
6 12557 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12558 <*+2*>
6 12559 if (testbit36 or testbit38) and overvåget then
6 12560 disable begin
7 12561 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12562 outchar(zrl,'nl');
7 12563 end;
6 12564 <*-2*>
6 12565 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12566 disable setposition(z_fr_out,0,0);
6 12567 ac:= -1;
6 12568 end;
5 12569 \f
5 12569 message procedure radio_ind side 9 - 881107/cl;
5 12570 end <* ttyp = D *>
4 12571 else
4 12572 if ttyp='H' then
4 12573 begin
5 12574 integer htyp;
5 12575
5 12575 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12576
5 12576 if htyp='A' then
5 12577 begin <*mobilopkald*>
6 12578 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12579 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12580 ac:= 1
6 12581 else
6 12582 begin
7 12583 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12584 if læstegn(tlgr,6,tegn)='D' then
7 12585 begin <*teknisk nr. i telegram*>
8 12586 b_pn:= 0;
8 12587 for i:= 1 step 1 until 4 do
8 12588 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12589 end
7 12590 else b_pn:= 0;
7 12591 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12592 <* opkaldstype *>
7 12593 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12594 if j>0 then
7 12595 begin
8 12596 if bs=10 then
8 12597 ann_opkald(b_pn,j)
8 12598 else
8 12599 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12600 ac:= 0;
8 12601 end else ac:= 1;
7 12602 end;
6 12603 \f
6 12603 message procedure radio_ind side 10 - 881107/cl;
6 12604 end
5 12605 else
5 12606 if htyp='E' then
5 12607 begin <* radiokanal status *>
6 12608 long onavn;
6 12609
6 12609 ac:= 0;
6 12610 j:= 0;
6 12611 for i:= 1 step 1 until max_antal_kanaler do
6 12612 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12613
6 12613 <* Alarmer for K12 = GLX ignoreres *>
6 12614 <* 94.06.14/CL *>
6 12615 <* Alarmer for K15 = HG ignoreres *>
6 12616 <* 95.07.31/CL *>
6 12617 <* Alarmer for K10 = FS ignoreres *>
6 12618 <* 96.05.27/CL *>
6 12619 if j>0 then
6 12620 begin
7 12621 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12622 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
7 12623 (onavn = long<:FS:>) then 0 else j);
7 12624 end;
6 12625
6 12625 læstegn(tlgr,9,tegn);
6 12626 if j<>0 and (tegn='A' or tegn='E') then
6 12627 begin
7 12628 ref:= (j-1)*kanalbeskrlængde;
7 12629 bs:= if tegn='E' then 0 else 15;
7 12630 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12631 begin
8 12632 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12633 signalbin(bs_mobil_opkald);
8 12634 end;
7 12635 end;
6 12636 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12637 begin
7 12638 waitch(cs_radio_pulje,opref,true,-1);
7 12639 startoperation(opref,401,cs_radio_pulje,23);
7 12640 i:= 1;
7 12641 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12642 if læstegn(tlgr,4,k)<>'@' then
7 12643 begin
8 12644 if k-'@' = 17 then
8 12645 hægtstring(d.opref.data,i,<: AMV:>)
8 12646 else
8 12647 if k-'@' = 18 then
8 12648 hægtstring(d.opref.data,i,<: BHV:>)
8 12649 else
8 12650 begin
9 12651 hægtstring(d.opref.data,i,<: BST:>);
9 12652 anbringtal(d.opref.data,i,k-'@',1);
9 12653 end;
8 12654 end;
7 12655 skrivtegn(d.opref.data,i,' ');
7 12656 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12657 skrivtegn(d.opref.data,i,' ');
7 12658 hægtstring(d.opref.data,i,
7 12659 string område_navn(kanal_til_omr(j)));
7 12660 if '@'<=tegn and tegn<='F' then
7 12661 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12662 <*@*> <:: ukendt fejl:>,
7 12663 <*A*> <:: compad-fejl:>,
7 12664 <*B*> <:: ladefejl:>,
7 12665 <*C*> <:: dør åben:>,
7 12666 <*D*> <:: senderfejl:>,
7 12667 <*E*> <:: compad ok:>,
7 12668 <*F*> <:: liniefejl:>,
7 12669 <::>))
7 12670 else
7 12671 begin
8 12672 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12673 skrivtegn(d.opref.data,i,tegn);
8 12674 end;
7 12675 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12676 signalch(cs_io,opref,gen_optype or rad_optype);
7 12677 ref:= (j-1)*kanalbeskrlængde;
7 12678 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12679 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12680 signalbin(bs_mobilopkald);
7 12681 end;
6 12682 \f
6 12682 message procedure radio_ind side 11 - 881107/cl;
6 12683 end
5 12684 else
5 12685 if htyp='G' then
5 12686 begin <* fjerninkludering/-ekskludering af område *>
6 12687 bs:= læstegn(tlgr,9,tegn)-'@';
6 12688 j:= 0;
6 12689 for i:= 1 step 1 until max_antal_kanaler do
6 12690 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12691 if j<>0 then
6 12692 begin
7 12693 ref:= (j-1)*kanalbeskrlængde;
7 12694 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12695 end;
6 12696 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12697 signalbin(bs_mobilopkald);
6 12698 ac:= 0;
6 12699 end
5 12700 else
5 12701 if htyp='L' then
5 12702 begin <* vogntabelændringer *>
6 12703 long field ll;
6 12704
6 12704 ll:= 10;
6 12705 ac:= 0;
6 12706 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12707 læstegn(tlgr,9,tegn);
6 12708 if (tegn='N') or (tegn='O') then
6 12709 begin
7 12710 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12711 typ(2):= -1;
7 12712 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12713 if opref>0 then
7 12714 begin
8 12715 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12716 signalch(d.opref.retur,opref,d.opref.optype);
8 12717 end;
7 12718 ac:= -1;
7 12719 end
6 12720 else
6 12721 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12722 ac:= -1
6 12723 else
6 12724 if tegn='G' then <*indkodning*>
6 12725 begin
7 12726 pos:= 10; i:= 0;
7 12727 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12728 i:= i*10 + (tegn-'0');
7 12729 i:= i mod 1000;
7 12730 b_pn:= (1 shift 22) + (i shift 12);
7 12731 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12732 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12733 pos:= 14; i:= 0;
7 12734 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12735 i:= i*10 + (tegn-'0');
7 12736 b_pn:= b_pn + i;
7 12737 pos:= 16; i:= 0;
7 12738 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12739 i:= i*10 + (tegn-'0');
7 12740 b_pt:= i;
7 12741 bs:= 11;
7 12742 \f
7 12742 message procedure radio_ind side 12 - 881107/cl;
7 12743 end
6 12744 else
6 12745 if tegn='H' then <*udkodning*>
6 12746 begin
7 12747 pos:= 10; i:= 0;
7 12748 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12749 i:= i*10 + (tegn-'0');
7 12750 b_pt:= i;
7 12751 b_pn:= 0;
7 12752 bs:= 12;
7 12753 end
6 12754 else
6 12755 if tegn='I' then <*slet tabel*>
6 12756 begin
7 12757 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12758 pos:= 10; i:= 0;
7 12759 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12760 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12761 zno:= i;
7 12762 end
6 12763 else ac:= 2;
6 12764 if ac<0 then
6 12765 ac:= 0
6 12766 else
6 12767
6 12767 if ac=0 then
6 12768 begin
7 12769 waitch(cs_vt_adgang,opref,true,-1);
7 12770 startoperation(opref,401,cs_vt_adgang,bs);
7 12771 d.opref.data(1):= b_pt;
7 12772 d.opref.data(2):= b_pn;
7 12773 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12774 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12775 end;
6 12776 end
5 12777 else
5 12778 ac:= 2;
5 12779
5 12779 pos:= 1;
5 12780 skrivtegn(answ,pos,'H');
5 12781 skrivtegn(answ,pos,' ');
5 12782 skrivtegn(answ,pos,ac+'@');
5 12783 i:= 1; sum:= 0;
5 12784 while i < pos do
5 12785 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12786 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12787 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12788 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12789 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12790 disable begin
6 12791 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12792 outchar(zrl,'nl');
6 12793 end;
5 12794 <*-2*>
5 12795 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12796 disable setposition(z_fr_out,0,0);
5 12797 ac:= -1;
5 12798 \f
5 12798 message procedure radio_ind side 13 - 881107/cl;
5 12799 end
4 12800 else
4 12801 if ttyp = 'I' then
4 12802 begin
5 12803 typ(1):= -1;
5 12804 repeat
5 12805 getch(cs_radio_ind,opref,true,typ,val);
5 12806 if opref<>0 then
5 12807 begin
6 12808 d.opref.resultat:= 31;
6 12809 signalch(d.opref.retur,opref,d.opref.op_type);
6 12810 end;
5 12811 until opref=0;
5 12812 for i:= 1 step 1 until max_antal_taleveje do
5 12813 if læsbit_ia(hookoff_maske,i) then
5 12814 begin
6 12815 signalbin(bs_talevej_udkoblet(i));
6 12816 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12817 end;
5 12818 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12819 signal_bin(bs_mobil_opkald);
5 12820 for i:= 1 step 1 until max_antal_kanaler do
5 12821 begin
6 12822 ref:= (i-1)*kanalbeskrlængde;
6 12823 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12824 begin
7 12825 if kanal_tab.ref.kanal_id2<>0 and
7 12826 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12827 then
7 12828 begin
8 12829 signal(ss_samtale_nedlagt(i));
8 12830 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12831 end;
7 12832 if kanal_tab.ref.kanal_id1<>0 then
7 12833 begin
8 12834 signal(ss_samtale_nedlagt(i));
8 12835 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12836 end;
7 12837 end;
6 12838 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12839 end;
5 12840 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12841 startoperation(opref,401,cs_radio_pulje,23);
5 12842 i:= 1;
5 12843 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12844 j:= 4;
5 12845 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12846 begin
6 12847 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12848 end;
5 12849 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12850 signalch(cs_io,opref,gen_optype or rad_optype);
5 12851 optaget_flag:= 0;
5 12852 pos:= i:= 1; sum:= 0;
5 12853 skrivtegn(answ,pos,'I');
5 12854 skrivtegn(answ,pos,' ');
5 12855 skrivtegn(answ,pos,'@');
5 12856 while i<pos do
5 12857 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12858 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12859 skrivtegn(answ,pos,sum extract 4 + '@');
5 12860 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12861 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12862 disable begin
6 12863 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12864 outchar(zrl,'nl');
6 12865 end;
5 12866 <*-2*>
5 12867 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12868 disable setposition(z_fr_out,0,0);
5 12869 ac:= -1;
5 12870 \f
5 12870 message procedure radio_ind side 14 - 881107/cl;
5 12871 end
4 12872 else
4 12873 if ttyp='L' then
4 12874 begin
5 12875 ac:= 0;
5 12876 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12877 if testbit21 then
5 12878 begin
6 12879 waitch(cs_radio_pulje,opref,true,-1);
6 12880 startoperation(opref,401,cs_radio_pulje,23);
6 12881 i:= 1;
6 12882 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12883 j:= 4;
6 12884 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12885 begin
7 12886 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12887 end;
6 12888 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12889 signalch(cs_io,opref,gen_optype or rad_optype);
6 12890 end; <*testbit21*>
5 12891 end
4 12892 else
4 12893 if ttyp='Z' then
4 12894 begin
5 12895 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12896 disable begin
6 12897 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12898 outchar(zrl,'nl');
6 12899 end;
5 12900 <*-2*>
5 12901 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12902 disable setposition(z_fr_out,0,0);
5 12903 ac:= -1;
5 12904 end
4 12905 else
4 12906 ac:= 1;
4 12907 end; <* telegram modtaget ok *>
3 12908 \f
3 12908 message procedure radio_ind side 15 - 881107/cl;
3 12909 if ac>=0 then
3 12910 begin
4 12911 pos:= i:= 1; sum:= 0;
4 12912 skrivtegn(answ,pos,ttyp);
4 12913 skrivtegn(answ,pos,' ');
4 12914 skrivtegn(answ,pos,ac+'@');
4 12915 while i<pos do
4 12916 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12917 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12918 skrivtegn(answ,pos, sum extract 4 + '@');
4 12919 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12920 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12921 disable begin
5 12922 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12923 outchar(zrl,'nl');
5 12924 end;
4 12925 <*-2*>
4 12926 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12927 disable setposition(z_fr_out,0,0);
4 12928 ac:= -1;
4 12929 end;
3 12930
3 12930 typ(1):= 0;
3 12931 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12932 rf:= 4;
3 12933 systime(1,0.0,val.rf);
3 12934 val.rf:= val.rf - 30.0;
3 12935 typ(3):= -1;
3 12936 repeat
3 12937 getch(cs_radio_ind,opref,true,typ,val);
3 12938 if opref>0 then
3 12939 begin
4 12940 d.opref.resultat:= 53; <*annuleret*>
4 12941 signalch(d.opref.retur,opref,d.opref.optype);
4 12942 end;
3 12943 until opref=0;
3 12944
3 12944 until false;
3 12945
3 12945 radio_ind_trap:
3 12946
3 12946 disable skriv_radio_ind(zbillede,1);
3 12947
3 12947 end radio_ind;
2 12948 \f
2 12948 message procedure radio_ud side 1 - 820301/hko;
2 12949
2 12949 procedure radio_ud(op);
2 12950 value op;
2 12951 integer op;
2 12952 begin
3 12953 integer array field opref,io_opref;
3 12954 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12955 integer array answ, tlgr(1:32);
3 12956 long array field laf;
3 12957
3 12957 procedure skriv_radio_ud(z,omfang);
3 12958 value omfang;
3 12959 zone z;
3 12960 integer omfang;
3 12961 begin integer i1;
4 12962 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12963 if omfang > 0 then
4 12964 disable begin real x; long array field tx;
5 12965 tx:= 0;
5 12966 trap(slut);
5 12967 write(z,"nl",1,
5 12968 <: opref: :>,opref,"nl",1,
5 12969 <: io-opref: :>,io_opref,"nl",1,
5 12970 <: opgave: :>,opgave,"nl",1,
5 12971 <: kode: :>,kode,"nl",1,
5 12972 <: pos: :>,pos,"nl",1,
5 12973 <: tegn: :>,tegn,"nl",1,
5 12974 <: i: :>,i,"nl",1,
5 12975 <: sum: :>,sum,"nl",1,
5 12976 <: rc: :>,rc,"nl",1,
5 12977 <: svar-status: :>,svar_status,"nl",1,
5 12978 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12979 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12980 <::>);
5 12981 skriv_coru(z,coru_no(402));
5 12982 slut:
5 12983 end; <*disable*>
4 12984 end skriv_radio_ud;
3 12985
3 12985 trap(radio_ud_trap);
3 12986 laf:= 0;
3 12987 stack_claim((if cm_test then 200 else 150) +35+100);
3 12988
3 12988 <*+2*>if testbit32 and overvåget or testbit28 then
3 12989 skriv_radio_ud(out,0);
3 12990 <*-2*>
3 12991
3 12991 io_opref:= op;
3 12992 \f
3 12992 message procedure radio_ud side 2 - 810529/hko;
3 12993
3 12993 repeat
3 12994
3 12994 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12995 kode:= d.op_ref.opkode;
3 12996 opgave:= kode shift(-12);
3 12997 kode:= kode extract 12;
3 12998 if opgave < 'A' or opgave > 'I' then
3 12999 begin
4 13000 d.opref.resultat:= 31;
4 13001 end
3 13002 else
3 13003 begin
4 13004 pos:= 1;
4 13005 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 13006 begin
5 13007 skrivtegn(tlgr,pos,opgave);
5 13008 if d.opref.data(1) = 0 then
5 13009 begin
6 13010 skrivtegn(tlgr,pos,'G');
6 13011 skrivtegn(tlgr,pos,'A');
6 13012 end
5 13013 else
5 13014 begin
6 13015 skrivtegn(tlgr,pos,'D');
6 13016 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 13017 end;
5 13018 if opgave='A' then
5 13019 begin
6 13020 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 13021 end
5 13022 else
5 13023 if opgave='B' then
5 13024 begin
6 13025 skrivtegn(tlgr,pos,d.opref.data(2));
6 13026 if d.opref.data(2)='V' then
6 13027 begin
7 13028 skrivtegn(tlgr,pos,
7 13029 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 13030 skrivtegn(tlgr,pos,
7 13031 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 13032 end;
6 13033 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 13034 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 13035 end
5 13036 else
5 13037 if opgave='H' then
5 13038 begin
6 13039 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 13040 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 13041 hægtstring(tlgr,pos,<:@@@:>);
6 13042 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 13043 skrivtegn(tlgr,pos,'A');
6 13044 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 13045 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 13046 if d.opref.data(2)='L' then
6 13047 begin
7 13048 if d.opref.data(5)=7 then
7 13049 begin
8 13050 anbringtal(tlgr,pos,
8 13051 d.opref.data(8) shift (-12) extract 10,-4);
8 13052 anbringtal(tlgr,pos,
8 13053 d.opref.data(8) extract 7,-2);
8 13054 end
7 13055 else
7 13056 if d.opref.data(5)=8 then
7 13057 begin
8 13058 hægtstring(tlgr,pos,<:FFFFFF:>);
8 13059 end;
7 13060 if d.opref.data(5)<>9 then
7 13061 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 13062 skrivtegn(tlgr,pos,
7 13063 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 13064 skrivtegn(tlgr,pos,
7 13065 dec_to_hex(d.opref.data(6) extract 4));
7 13066 skrivtegn(tlgr,10,pos-11+'@');
7 13067 end;
6 13068 end;
5 13069 end
4 13070 else
4 13071 if opgave='I' then
4 13072 begin
5 13073 hægtstring(tlgr,pos,<:IGA:>);
5 13074 end
4 13075 else d.opref.resultat:= 31; <*systemfejl*>
4 13076 end;
3 13077 \f
3 13077 message procedure radio_ud side 3 - 881107/cl;
3 13078
3 13078 if d.opref.resultat=0 then
3 13079 begin
4 13080 if (opgave <= 'B')
4 13081 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 13082 begin
5 13083 systime(1,0,d.opref.tid);
5 13084 signalch(cs_radio_ind,opref,d.opref.optype);
5 13085 opref:= 0;
5 13086 end;
4 13087 <* beregn checksum og send *>
4 13088 i:= 1; sum:= 0;
4 13089 while i < pos do
4 13090 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 13091 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 13092 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 13093 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 13094 <**********************************************>
4 13095 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 13096
4 13096 if opgave='B' then delay(1);
4 13097
4 13097 <* 94.04.19/cl *>
4 13098 <**********************************************>
4 13099
4 13099 <*+2*> if (testbit36 or testbit39) and overvåget then
4 13100 disable begin
5 13101 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 13102 outchar(zrl,'nl');
5 13103 end;
4 13104 <*-2*>
4 13105 setposition(z_rf_in,0,0);
4 13106 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 13107 disable setposition(z_rf_out,0,0);
4 13108 rc:= 0;
4 13109
4 13109 <* afvent svar*>
4 13110 repeat
4 13111 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 13112 if svar_status=6 then
4 13113 begin
5 13114 svar_status:= -3;
5 13115 goto radio_ud_check;
5 13116 end;
4 13117 pos:= 1;
4 13118 while læstegn(answ,pos,i)<>0 do ;
4 13119 pos:= pos-2;
4 13120 if pos > 0 then
4 13121 begin
5 13122 if pos<3 then
5 13123 svar_status:= -2 <*format error*>
5 13124 else
5 13125 begin
6 13126 if læstegn(answ,3,tegn)<>'@' then
6 13127 svar_status:= tegn - '@'
6 13128 else
6 13129 begin
7 13130 pos:= 1;
7 13131 læstegn(answ,pos,tegn);
7 13132 if tegn<>opgave then
7 13133 svar_status:= -4 <*gal type*>
7 13134 else
7 13135 if læstegn(answ,pos,tegn)<>' ' then
7 13136 svar_status:= -tegn <*fejl*>
7 13137 else
7 13138 svar_status:= læstegn(answ,pos,tegn)-'@';
7 13139 end;
6 13140 end;
5 13141 end
4 13142 else
4 13143 svar_status:= -1;
4 13144 \f
4 13144 message procedure radio_ud side 5 - 881107/cl;
4 13145
4 13145 radio_ud_check:
4 13146 rc:= rc+1;
4 13147 if -3<=svar_status and svar_status< -1 then
4 13148 disable begin
5 13149 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 13150 setposition(z_rf_out,0,0);
5 13151 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13152 begin
6 13153 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 13154 outchar(zrl,'nl');
6 13155 end;
5 13156 <*-2*>
5 13157 end
4 13158 else
4 13159 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 13160 disable begin
5 13161 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 13162 setposition(z_rf_out,0,0);
5 13163 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13164 begin
6 13165 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 13166 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 13167 end;
5 13168 <*-2*>
5 13169 end
4 13170 else
4 13171 if svar_status=0 and opref<>0 then
4 13172 d.opref.resultat:= 0
4 13173 else
4 13174 if opref<>0 then
4 13175 d.opref.resultat:= 31;
4 13176 until svar_status=0 or rc>3;
4 13177 end;
3 13178 if opref<>0 then
3 13179 begin
4 13180 if svar_status<>0 and rc>3 then
4 13181 d.opref.resultat:= 53; <* annulleret *>
4 13182 signalch(d.opref.retur,opref,d.opref.optype);
4 13183 opref:= 0;
4 13184 end;
3 13185 until false;
3 13186
3 13186 radio_ud_trap:
3 13187
3 13187 disable skriv_radio_ud(zbillede,1);
3 13188
3 13188 end radio_ud;
2 13189 \f
2 13189 message procedure radio_medd_opkald side 1 - 810610/hko;
2 13190
2 13190 procedure radio_medd_opkald;
2 13191 begin
3 13192 integer array field ref,op_ref;
3 13193 integer i;
3 13194
3 13194 procedure skriv_radio_medd_opkald(z,omfang);
3 13195 value omfang;
3 13196 zone z;
3 13197 integer omfang;
3 13198 begin integer x;
4 13199 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 13200 write(z,"sp",26-x);
4 13201 if omfang > 0 then
4 13202 disable begin
5 13203 trap(slut);
5 13204 write(z,"nl",1,
5 13205 <: ref: :>,ref,"nl",1,
5 13206 <: opref: :>,op_ref,"nl",1,
5 13207 <: i: :>,i,"nl",1,
5 13208 <::>);
5 13209 skriv_coru(z,abs curr_coruno);
5 13210 slut:
5 13211 end;<*disable*>
4 13212 end skriv_radio_medd_opkald;
3 13213
3 13213 trap(radio_medd_opkald_trap);
3 13214
3 13214 stack_claim((if cm_test then 200 else 150) +1);
3 13215
3 13215 <*+2*>if testbit32 and overvåget or testbit28 then
3 13216 disable skriv_radio_medd_opkald(out,0);
3 13217 <*-2*>
3 13218 \f
3 13218 message procedure radio_medd_opkald side 2 - 820301/hko;
3 13219
3 13219 repeat
3 13220
3 13220 <*V*> wait(bs_mobil_opkald);
3 13221 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 13222 <*V*> wait(bs_opkaldskø_adgang);
3 13223
3 13223 ref:= første_nød_opkald;
3 13224 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 13225 begin
4 13226 i:= opkaldskø.ref(2);
4 13227 if i < 0 then
4 13228 begin
5 13229 <* nødopkald ikke meldt *>
5 13230
5 13230 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 13231 d.op_ref.data(1):= <* vogn_id *>
5 13232 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 13233 opkaldskø.ref(2):= i extract 22;
5 13234 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 13235 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 13236 i:= op_ref;
5 13237 <*+2*> if testbit35 and overvåget then
5 13238 disable begin
6 13239 write(out,"nl",1,<:radio nød-medd:>);
6 13240 skriv_op(out,op_ref);
6 13241 ud;
6 13242 end;
5 13243 <*-2*>
5 13244 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 13245 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 13246 <*+4*> if i <> op_ref then
5 13247 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 13248 <*-4*>
5 13249 end;<*nødopkald ikke meldt*>
4 13250
4 13250 ref:= opkaldskø.ref(1) extract 12;
4 13251 end; <* melding til io *>
3 13252 \f
3 13252 message procedure radio_medd_opkald side 3 - 820304/hko;
3 13253
3 13253 start_operation(op_ref,403,cs_radio_medd,
3 13254 40<*opdater opkaldskøbill*>);
3 13255 signal_bin(bs_opkaldskø_adgang);
3 13256 <*+2*> if testbit35 and overvåget then
3 13257 disable begin
4 13258 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 13259 skriv_op(out,op_ref);
4 13260 write(out, <:opkaldsflag: :>,"nl",1);
4 13261 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 13262 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 13263 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 13264 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 13265 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 13266 ud;
4 13267 end;
3 13268 <*-2*>
3 13269 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 13270
3 13270 until false;
3 13271
3 13271 radio_medd_opkald_trap:
3 13272
3 13272 disable skriv_radio_medd_opkald(zbillede,1);
3 13273
3 13273 end radio_medd_opkald;
2 13274 \f
2 13274 message procedure radio_adm side 1 - 820301/hko;
2 13275
2 13275 procedure radio_adm(op);
2 13276 value op;
2 13277 integer op;
2 13278 begin
3 13279 integer array field opref, rad_op, iaf;
3 13280 integer nr,i,j,k,res,opgave,tilst,operatør;
3 13281
3 13281 procedure skriv_radio_adm(z,omfang);
3 13282 value omfang;
3 13283 zone z;
3 13284 integer omfang;
3 13285 begin integer i1;
4 13286 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 13287 write(z,"sp",26-i1);
4 13288 if omfang > 0 then
4 13289 disable begin real x;
5 13290 trap(slut);
5 13291 \f
5 13291 message procedure radio_adm side 2- 820301/hko;
5 13292
5 13292 write(z,"nl",1,
5 13293 <: op_ref: :>,op_ref,"nl",1,
5 13294 <: iaf: :>,iaf,"nl",1,
5 13295 <: rad-op: :>,rad_op,"nl",1,
5 13296 <: nr: :>,nr,"nl",1,
5 13297 <: i: :>,i,"nl",1,
5 13298 <: j: :>,j,"nl",1,
5 13299 <: k: :>,k,"nl",1,
5 13300 <: tilst: :>,tilst,"nl",1,
5 13301 <: res: :>,res,"nl",1,
5 13302 <: opgave: :>,opgave,"nl",1,
5 13303 <: operatør: :>,operatør,"nl",1);
5 13304 skriv_coru(z,coru_no(404));
5 13305 slut:
5 13306 end;<*disable*>
4 13307 end skriv_radio_adm;
3 13308 \f
3 13308 message procedure radio_adm side 3 - 820304/hko;
3 13309
3 13309 rad_op:= op;
3 13310
3 13310 trap(radio_adm_trap);
3 13311 stack_claim((if cm_test then 200 else 150) +50);
3 13312
3 13312 <*+2*>if testbit32 and overvåget or testbit28 then
3 13313 skriv_radio_adm(out,0);
3 13314 <*-2*>
3 13315
3 13315 pass;
3 13316 if -,testbit22 then
3 13317 begin
4 13318 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13319 signalch(cs_radio_ud,rad_op,rad_optype);
4 13320 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13321 end;
3 13322 repeat
3 13323 waitch(cs_radio_adm,opref,true,-1);
3 13324 <*+2*>
3 13325 if testbit33 and overvåget then
3 13326 disable begin
4 13327 skriv_radio_adm(out,0);
4 13328 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 13329 skriv_op(out,opref);
4 13330 end;
3 13331 <*-2*>
3 13332
3 13332 k:= d.op_ref.opkode extract 12;
3 13333 opgave:= d.opref.opkode shift (-12);
3 13334 nr:=operatør:=d.op_ref.data(1);
3 13335
3 13335 <*+4*> if (d.op_ref.optype and
3 13336 (gen_optype or io_optype or op_optype or vt_optype))
3 13337 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 13338 <:radio_adm:>,0);
3 13339 <*-4*>
3 13340 if k = 74 <* RA,I *> then
3 13341 begin
4 13342 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13343 signalch(cs_radio_ud,rad_op,rad_optype);
4 13344 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13345 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 13346 else d.rad_op.resultat;
4 13347 signalch(d.opref.retur,opref,d.opref.optype);
4 13348 \f
4 13348 message procedure radio_adm side 4 - 820301/hko;
4 13349 end
3 13350 else
3 13351
3 13351 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 13352 k = 5<*FO,L*> or k = 6<*ST *> then
3 13353 begin
4 13354 if k = 5 or k=77 then
4 13355 begin
5 13356
5 13356 <*V*> wait(bs_opkaldskø_adgang);
5 13357 if k=5 then
5 13358 begin
6 13359 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 13360 begin
7 13361 i:= læs_fil(1035,iaf//512+1,nr);
7 13362 if i <> 0 then
7 13363 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 13364 tofrom(radio_linietabel.iaf,fil(nr),
7 13365 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 13366 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 13367 end;
6 13368
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(3) shift (-12) extract 10; <*linienr*>
7 13372 if nr>0 then
7 13373 begin
8 13374 læs_tegn(radio_linietabel,nr+1,operatør);
8 13375 if operatør>max_antal_operatører then operatør:= 0;
8 13376 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 13377 operatør;
8 13378 end;
7 13379 end;
6 13380 end
5 13381 else
5 13382 if k=77 then
5 13383 begin
6 13384 disable i:= læsfil(1034,1,nr);
6 13385 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 13386 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 13387 for i:= 1 step 1 until max_antal_mobilopkald do
6 13388 begin
7 13389 iaf:= i*opkaldskø_postlængde;
7 13390 nr:= opkaldskø.iaf(5) extract 4;
7 13391 operatør:= radio_områdetabel(nr);
7 13392 if operatør < 0 or max_antal_operatører < operatør then
7 13393 operatør:= 0;
7 13394 if opkaldskø.iaf(4) extract 8=0 and
7 13395 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13396 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13397 operatør;
7 13398 end;
6 13399 end;
5 13400
5 13400 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13401 signal_bin(bs_opkaldskø_adgang);
5 13402
5 13402 signal_bin(bs_mobil_opkald);
5 13403
5 13403 d.op_ref.resultat:= res:= 3;
5 13404 \f
5 13404 message procedure radio_adm side 5 - 820304/hko;
5 13405
5 13405 end <*k = 5 / k = 77*>
4 13406 else
4 13407 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13408 res:= 3;
5 13409 for nr:= 1 step 1 until max_antal_kanaler do
5 13410 begin
6 13411 iaf:= (nr-1)*kanal_beskr_længde;
6 13412 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13413 op_talevej(operatør) then
6 13414 begin
7 13415 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13416 if tilst <> 0 then
7 13417 res:= 16; <*skærm optaget*>
7 13418 end; <* kanal_tab(operatør) = operatør*>
6 13419 end;
5 13420 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13421 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13422 signal_bin(bs_mobil_opkald);
5 13423 d.op_ref.resultat:= res;
5 13424 end;<*k=1,2 eller 6 *>
4 13425
4 13425 <*+2*> if testbit35 and overvåget then
4 13426 disable begin
5 13427 skriv_radio_adm(out,0);
5 13428 write(out,<: sender til :>,
5 13429 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13430 else cs_op);
5 13431 skriv_op(out,op_ref);
5 13432 end;
4 13433 <*-2*>
4 13434
4 13434 if k=5 or k=6 or k=77 or res > 3 then
4 13435 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13436 else
4 13437 begin <*k = (1 eller 2) og res = 3 *>
5 13438 d.op_ref.resultat:=0;
5 13439 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13440 end;
4 13441 \f
4 13441 message procedure radio_adm side 6 - 816610/hko;
4 13442
4 13442 end <*k=1,2,5 eller 6*>
3 13443 else
3 13444 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13445 begin
4 13446 nr:= d.op_ref.data(1);
4 13447 res:= 3;
4 13448
4 13448 if nr<=3 then
4 13449 res:= 51 <* afvist *>
4 13450 else
4 13451 begin
5 13452
5 13452 <* gennemstilling af område *>
5 13453 j:= 1;
5 13454 for i:= 1 step 1 until max_antal_kanaler do
5 13455 begin
6 13456 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13457 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13458 end;
5 13459 nr:= j;
5 13460 iaf:= (nr-1)*kanalbeskrlængde;
5 13461 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13462 begin
6 13463 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13464 d.rad_op.data(1):= 0;
6 13465 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13466 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13467 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13468 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13469 signalch(cs_radio_ud,rad_op,rad_optype);
6 13470 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13471 res:= d.rad_op.resultat;
6 13472 if res=0 then res:= 3;
6 13473 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13474 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13475 end;
5 13476 end;
4 13477 d.op_ref.resultat:=res;
4 13478 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13479 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13480 signal_bin(bs_mobil_opkald);
4 13481 \f
4 13481 message procedure radio_adm side 7 - 880930/cl;
4 13482
4 13482
4 13482 end <* k=3 eller 4 *>
3 13483 else
3 13484 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13485 begin
4 13486 nr:= d.opref.data(1) extract 22;
4 13487 res:= 3;
4 13488 iaf:= (nr-1)*kanalbeskrlængde;
4 13489 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13490 d.rad_op.data(1):= 0;
4 13491 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13492 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13493 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13494 d.rad_op.data(5):= k extract 1;
4 13495 signalch(cs_radio_ud,radop,rad_optype);
4 13496 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13497 res:= d.radop.resultat;
4 13498 if res=0 then res:= 3;
4 13499 j:= if k=72 then 15 else 0;
4 13500 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13501 begin
5 13502 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13503 signalbin(bs_mobilopkald);
5 13504 end;
4 13505 d.opref.resultat:= res;
4 13506 signalch(d.opref.retur,opref,d.opref.optype);
4 13507 end
3 13508 else
3 13509 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13510 begin
4 13511 nr:= d.opref.data(1) extract 8;
4 13512 opgave:= if k=19 then 9 else (k-4);
4 13513 if nr<=3 then
4 13514 res:= 51 <*afvist*>
4 13515 else
4 13516 begin
5 13517 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13518 d.radop.data(1):= 0;
5 13519 d.radop.data(2):= 'L';
5 13520 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13521 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13522 d.radop.data(5):= opgave;
5 13523 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13524 d.radop.data(7):= d.opref.data(2);
5 13525 d.radop.data(8):= d.opref.data(3);
5 13526 signalch(cs_radio_ud,radop,rad_optype);
5 13527 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13528 res:= d.radop.resultat;
5 13529 if res=0 then res:= 3;
5 13530 end;
4 13531 d.opref.resultat:= res;
4 13532 signalch(d.opref.retur,opref,d.opref.optype);
4 13533 end
3 13534 else
3 13535
3 13535 begin
4 13536
4 13536 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13537
4 13537 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13538
4 13538 end;
3 13539
3 13539 until false;
3 13540 radio_adm_trap:
3 13541 disable skriv_radio_adm(zbillede,1);
3 13542 end radio_adm;
2 13543
2 13543 \f
2 13543 message vogntabel erklæringer side 1 - 820301/cl;
2 13544
2 13544 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13545 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13546 cs_vt_log;
2 13547 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13548 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13549 vt_log_slicelgd;
2 13550 integer array bustabel,bustabel1(0:max_antal_busser),
2 13551 linie_løb_tabel(0:max_antal_linie_løb),
2 13552 springtabel(1:max_antal_spring,1:3),
2 13553 gruppetabel(1:max_antal_grupper),
2 13554 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13555 vt_logop(1:2),
2 13556 vt_logdisc(1:4),
2 13557 vt_log_tail(1:10);
2 13558 boolean array busindeks(-1:max_antal_linie_løb),
2 13559 bustilstand(-1:max_antal_busser),
2 13560 linie_løb_indeks(-1:max_antal_busser);
2 13561 real array springtid,springstart(1:max_antal_spring);
2 13562 real vt_logstart;
2 13563 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13564 integer array field v_tekst;
2 13565 real field v_tid;
2 13566
2 13566 zone zvtlog(128,1,stderror);
2 13567
2 13567 \f
2 13567 message vogntabel erklæringer side 2 - 851001/cl;
2 13568
2 13568 procedure skriv_vt_variable(zud);
2 13569 zone zud;
2 13570 begin integer i; long array field laf;
3 13571 laf:= 0;
3 13572 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13573 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13574 <:cs-vt :>,cs_vt,"nl",1,
3 13575 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13576 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13577 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13578 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13579 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13580 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13581 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13582 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13583 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13584 <:vt-op :>,vt_op,"nl",1,
3 13585 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13586 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13587 <:sidste-bus :>,sidste_bus,"nl",1,
3 13588 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13589 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13590 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13591 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13592 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13593 <:tf-springdef :>,tf_springdef,"nl",1,
3 13594 <:vt-logskift :>,vt_logskift,"nl",1,
3 13595 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13596 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13597 <:vt-log-aktiv :>,
3 13598 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13599 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13600 <::>);
3 13601 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13602 laf:= 2;
3 13603 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13604 for i:= 6 step 1 until 10 do
3 13605 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13606 write(zud,"nl",1);
3 13607 end;
2 13608 \f
2 13608 message procedure p_vogntabel side 1 - 820301/cl;
2 13609
2 13609 procedure p_vogntabel(z);
2 13610 zone z;
2 13611 begin
3 13612 integer i,b,s,o,t,li,lb,lø,g;
3 13613 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13614 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13615 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13616 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13617
3 13617 for i:= 1 step 1 until sidste_bus do
3 13618 begin
4 13619 b:= bustabel(i) extract 14;
4 13620 g:= bustabel(i) shift (-14);
4 13621 s:= bustabel1(i) shift (-23);
4 13622 o:= bustabel1(i) extract 8;
4 13623 t:= intg(bustilstand(i));
4 13624 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13625 lø:= li extract 7;
4 13626 lb:= li shift (-7) extract 5;
4 13627 lb:= if lb=0 then 32 else lb+64;
4 13628 li:= li shift (-12) extract 10;
4 13629 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13630 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13631 if g > 0 then string bpl_navn(g) else <: :>,
4 13632 ";",1,true,4,string område_navn(o),
4 13633 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13634 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13635 end;
3 13636 end p_vogntabel;
2 13637 \f
2 13637 message procedure p_gruppetabel side 1 - 810531/cl;
2 13638
2 13638 procedure p_gruppetabel(z);
2 13639 zone z;
2 13640 begin
3 13641 integer i,nr,bogst;
3 13642 boolean spc_gr;
3 13643 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13644 <:max-antal-grupper =:>,max_antal_grupper,
3 13645 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13646 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13647 <:gruppetabel::>);
3 13648 for i:= 1 step 1 until max_antal_grupper do
3 13649 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13650 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13651 gruppetabel(i) extract 7);
3 13652 write(z,"nl",2,<:gruppeopkald::>);
3 13653 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13654 begin
4 13655 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13656 if gruppeopkald(i,1) = 0 then
4 13657 write(z,"sp",11)
4 13658 else
4 13659 begin
5 13660 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13661 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13662 else
5 13663 begin
6 13664 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13665 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13666 if bogst = '@' then bogst:= 'sp';
6 13667 end;
5 13668 if spc_gr then
5 13669 write(z,<:(G:>,<<d>,true,3,nr)
5 13670 else
5 13671 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13672 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13673 end;
4 13674 end;
3 13675 end p_gruppetabel;
2 13676 \f
2 13676 message procedure p_springtabel side 1 - 810519/cl;
2 13677
2 13677 procedure p_springtabel(z);
2 13678 zone z;
2 13679 begin
3 13680 integer li,bo,max,st,nr;
3 13681 long indeks;
3 13682 real t;
3 13683
3 13683 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13684 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13685 <:nr spring-id max status næste-tid:>,"nl",1);
3 13686 for nr:= 1 step 1 until max_antal_spring do
3 13687 begin
4 13688 write(z,<<dd>,nr);
4 13689 <* if springtabel(nr,1)<>0 then *>
4 13690 begin
5 13691 li:= springtabel(nr,1) shift (-5) extract 10;
5 13692 bo:= springtabel(nr,1) extract 5;
5 13693 if bo<>0 then bo:= bo + 'A' - 1;
5 13694 indeks:= extend springtabel(nr,2) shift 24;
5 13695 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13696 max:= springtabel(nr,3) extract 12;
5 13697 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13698 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13699 if springtid(nr)<>0.0 then
5 13700 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13701 else
5 13702 write(z,<< d.d >,0.0);
5 13703 if springstart(nr)<>0.0 then
5 13704 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13705 else
5 13706 write(z,<< d.d >,0.0);
5 13707 end
4 13708 <* else
4 13709 write(z,<: --------:>)*>;
4 13710 write(z,"nl",1);
4 13711 end;
3 13712 end p_springtabel;
2 13713 \f
2 13713 message procedure find_busnr side 1 - 820301/cl;
2 13714
2 13714 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13715 value ll_id;
2 13716 integer ll_id, busnr, garage, tilst;
2 13717 begin
3 13718 integer i,j;
3 13719
3 13719 j:= binærsøg(sidste_linie_løb,
3 13720 (linie_løb_tabel(i) - ll_id), i);
3 13721 if j<>0 then <* linie/løb findes ikke *>
3 13722 begin
4 13723 find_busnr:= -1;
4 13724 busnr:= 0;
4 13725 garage:= 0;
4 13726 tilst:= 0;
4 13727 end
3 13728 else
3 13729 begin
4 13730 busnr:= bustabel(busindeks(i) extract 12);
4 13731 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13732 garage:= busnr shift (-14);
4 13733 busnr:= busnr extract 14;
4 13734 find_busnr:= busindeks(i) extract 12;
4 13735 end;
3 13736 end find_busnr;
2 13737 \f
2 13737 message procedure søg_omr_bus side 1 - 881027/cl;
2 13738
2 13738
2 13738 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13739 value bus;
2 13740 integer bus,ll,gar,omr,sig,tilst;
2 13741 begin
3 13742 integer i,j,nr,bu,bi,bl;
3 13743
3 13743 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13744 nr:= -1;
3 13745 if j=0 then
3 13746 begin
4 13747 bl:= bu:= bi;
4 13748 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13749 while bu<sidste_bus and
4 13750 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13751
4 13751 if bl<>bu then
4 13752 begin
5 13753 <* flere busser med samme tekniske nr. omr skal passe *>
5 13754 nr:= -2;
5 13755 for bi:= bl step 1 until bu do
5 13756 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13757 end
4 13758 else
4 13759 nr:= bi;
4 13760 end;
3 13761
3 13761 if nr<0 then
3 13762 begin
4 13763 <* bus findes ikke *>
4 13764 ll:= gar:= tilst:= sig:= 0;
4 13765 end
3 13766 else
3 13767 begin
4 13768 tilst:= intg(bustilstand(nr));
4 13769 gar:= bustabel(nr) shift (-14);
4 13770 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13771 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13772 sig:= bustabel1(nr) shift (-23);
4 13773 end;
3 13774 søg_omr_bus:= nr;
3 13775 end;
2 13776 \f
2 13776 message procedure find_linie_løb side 1 - 820301/cl;
2 13777
2 13777 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13778 value busnr;
2 13779 integer busnr, linie_løb, garage, tilst;
2 13780 begin
3 13781 integer i,j;
3 13782
3 13782 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13783
3 13783 if j<>0 then <* bus findes ikke *>
3 13784 begin
4 13785 find_linie_løb:= -1;
4 13786 linie_løb:= 0;
4 13787 garage:= 0;
4 13788 tilst:= 0;
4 13789 end
3 13790 else
3 13791 begin
4 13792 tilst:= intg(bustilstand(i));
4 13793 garage:= bustabel(i) shift (-14);
4 13794 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13795 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13796 end;
3 13797 end find_linie_løb;
2 13798 \f
2 13798 message procedure h_vogntabel side 1 - 810413/cl;
2 13799
2 13799 <* hovedmodulcorutine for vogntabelmodul *>
2 13800
2 13800 procedure h_vogntabel;
2 13801 begin
3 13802 integer array field op;
3 13803 integer dest_sem,k;
3 13804
3 13804 procedure skriv_h_vogntabel(zud,omfang);
3 13805 value omfang;
3 13806 zone zud;
3 13807 integer omfang;
3 13808 begin
4 13809 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13810 if omfang<>0 then
4 13811 disable
4 13812 begin
5 13813 skriv_coru(zud,abs curr_coruno);
5 13814 write(zud,"nl",1,<<d>,
5 13815 <:cs-vt :>,cs_vt,"nl",1,
5 13816 <:op :>,op,"nl",1,
5 13817 <:dest-sem :>,dest_sem,"nl",1,
5 13818 <:k :>,k,"nl",1,
5 13819 <::>);
5 13820 end;
4 13821 end;
3 13822 \f
3 13822 message procedure h_vogntabel side 2 - 820301/cl;
3 13823
3 13823 stackclaim(if cm_test then 198 else 146);
3 13824 trap(h_vt_trap);
3 13825
3 13825 <*+2*>
3 13826 <**> disable if testbit47 and overvåget or testbit28 then
3 13827 <**> skriv_h_vogntabel(out,0);
3 13828 <*-2*>
3 13829
3 13829 repeat
3 13830 waitch(cs_vt,op,true,-1);
3 13831 <*+4*>
3 13832 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13833 (d.op.optype and vt_optype) extract 12 = 0 then
3 13834 fejlreaktion(12,op,<:vogntabel:>,0);
3 13835 <*-4*>
3 13836 disable
3 13837 begin
4 13838
4 13838 k:= d.op.opkode extract 12;
4 13839 dest_sem:=
4 13840 if k = 9 then cs_vt_rap else
4 13841 if k = 10 then cs_vt_rap else
4 13842 if k = 11 then cs_vt_opd else
4 13843 if k = 12 then cs_vt_opd else
4 13844 if k = 13 then cs_vt_opd else
4 13845 if k = 14 then cs_vt_tilst else
4 13846 if k = 15 then cs_vt_tilst else
4 13847 if k = 16 then cs_vt_tilst else
4 13848 if k = 17 then cs_vt_tilst else
4 13849 if k = 18 then cs_vt_tilst else
4 13850 if k = 19 then cs_vt_opd else
4 13851 if k = 20 then cs_vt_opd else
4 13852 if k = 21 then cs_vt_auto else
4 13853 if k = 24 then cs_vt_opd else
4 13854 if k = 25 then cs_vt_grp else
4 13855 if k = 26 then cs_vt_grp else
4 13856 if k = 27 then cs_vt_grp else
4 13857 if k = 28 then cs_vt_grp else
4 13858 if k = 30 then cs_vt_spring else
4 13859 if k = 31 then cs_vt_spring else
4 13860 if k = 32 then cs_vt_spring else
4 13861 if k = 33 then cs_vt_spring else
4 13862 if k = 34 then cs_vt_spring else
4 13863 if k = 35 then cs_vt_spring else
4 13864 -1;
4 13865 \f
4 13865 message procedure h_vogntabel side 3 - 810422/cl;
4 13866
4 13866 <*+2*>
4 13867 <**> if testbit41 and overvåget then
4 13868 <**> begin
5 13869 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13870 <**> skriv_op(out,op);
5 13871 <**> end;
4 13872 <*-2*>
4 13873 end;
3 13874
3 13874 if dest_sem = -1 then
3 13875 fejlreaktion(2,k,<:vogntabel:>,0);
3 13876 disable signalch(dest_sem,op,d.op.optype);
3 13877 until false;
3 13878 h_vt_trap:
3 13879 disable skriv_h_vogntabel(zbillede,1);
3 13880 end h_vogntabel;
2 13881 \f
2 13881 message procedure vt_opdater side 1 - 810317/cl;
2 13882
2 13882 procedure vt_opdater(op1);
2 13883 value op1;
2 13884 integer op1;
2 13885 begin
3 13886 integer array field op,radop;
3 13887 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13888 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13889 flin,slin,finx,sinx;
3 13890 integer field bn,ll;
3 13891
3 13891 procedure skriv_vt_opd(zud,omfang);
3 13892 value omfang; integer omfang;
3 13893 zone zud;
3 13894 begin
4 13895 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13896 if omfang <> 0 then
4 13897 disable
4 13898 begin
5 13899 skriv_coru(zud,abs curr_coruno);
5 13900 write(zud,"nl",1,
5 13901 <: op: :>,op,"nl",1,
5 13902 <: radop::>,radop,"nl",1,
5 13903 <: funk: :>,funk,"nl",1,
5 13904 <: res: :>,res,"nl",1,
5 13905 <::>);
5 13906 end;
4 13907 end skriv_vt_opd;
3 13908
3 13908 integer procedure opd_omr(fnk,omr,bus,ll);
3 13909 value fnk,omr,bus,ll;
3 13910 integer fnk,omr,bus,ll;
3 13911 begin
4 13912 opd_omr:= 3;
4 13913 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13914 ændringer skal ikke længere meldes til yderområder *>
4 13915 goto dummy_retur;
4 13916
4 13916 if omr extract 8 > 3 then
4 13917 begin
5 13918 startoperation(radop,501,cs_vt_opd,fnk);
5 13919 d.radop.data(1):= omr;
5 13920 d.radop.data(2):= bus;
5 13921 d.radop.data(3):= ll;
5 13922 signalch(cs_rad,radop,vt_optype);
5 13923 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13924 opd_omr:= d.radop.resultat;
5 13925 end
4 13926 else
4 13927 opd_omr:= 0;
4 13928 dummy_retur:
4 13929 end;
3 13930 message procedure vt_opdater side 1a - 920517/cl;
3 13931
3 13931 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13932 value kilde,kode,bus,ll1,ll2;
3 13933 integer kilde,kode,bus,ll1,ll2;
3 13934 begin
4 13935 integer array field op;
4 13936
4 13936 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13937
4 13937 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13938 systime(1,0.0,d.op.data.v_tid);
4 13939 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13940 d.op.data.v_bus:= bus;
4 13941 d.op.data.v_ll1:= ll1;
4 13942 d.op.data.v_ll2:= ll2;
4 13943 signalch(cs_vt_log,op,vt_optype);
4 13944 end;
3 13945
3 13945 stackclaim((if cm_test then 198 else 146)+125);
3 13946
3 13946 bn:= 4; ll:= 2;
3 13947 radop:= op1;
3 13948 trap(vt_opd_trap);
3 13949
3 13949 <*+2*>
3 13950 <**> disable if testbit47 and overvåget or testbit28 then
3 13951 <**> skriv_vt_opd(out,0);
3 13952 <*-2*>
3 13953 \f
3 13953 message procedure vt_opdater side 2 - 851001/cl;
3 13954
3 13954 vent_op:
3 13955 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13956
3 13956 <*+2*>
3 13957 <**> disable
3 13958 <**> if testbit41 and overvåget then
3 13959 <**> begin
4 13960 <**> skriv_vt_opd(out,0);
4 13961 <**> write(out,<: modtaget operation:>);
4 13962 <**> skriv_op(out,op);
4 13963 <**> end;
3 13964 <*-2*>
3 13965
3 13965 <*+4*>
3 13966 <**>if op<>vt_op then
3 13967 <**>begin
4 13968 <**> disable begin
5 13969 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13970 <**> d.op.resultat:= 31; <*systemfejl*>
5 13971 <**> signalch(d.op.retur,op,d.op.optype);
5 13972 <**> end;
4 13973 <**> goto vent_op;
4 13974 <**>end;
3 13975 <*-4*>
3 13976 disable
3 13977 begin integer opk;
4 13978
4 13978 opk:= d.op.opkode extract 12;
4 13979 funk:= if opk=11 then 1 else
4 13980 if opk=12 then 2 else
4 13981 if opk=13 then 3 else
4 13982 if opk=19 then 4 else
4 13983 if opk=20 then 5 else
4 13984 if opk=24 then 6 else
4 13985 0;
4 13986 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13987 end;
3 13988 res:= 0;
3 13989 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13990 \f
3 13990 message procedure vt_opdater side 3 - 820301/cl;
3 13991
3 13991 indsæt:
3 13992 begin
4 13993 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13994 <*+4*>
4 13995 <**> if d.op.data(1) shift (-22) <> 0 then
4 13996 <**> begin
5 13997 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13998 <**> goto slut_indsæt;
5 13999 <**> end;
4 14000 <*-4*>
4 14001 busnr:= d.op.data(1) extract 14;
4 14002 <*+4*>
4 14003 <**> if d.op.data(2) shift (-22) <> 1 then
4 14004 <**> begin
5 14005 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 14006 <**> goto slut_indsæt;
5 14007 <**> end;
4 14008 <*-4*>
4 14009 ll_id:= d.op.data(2);
4 14010 s:= omr:= d.op.data(4) extract 8;
4 14011 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 14012 if bi<0 then
4 14013 begin
5 14014 if bi=(-1) then res:=10 <*bus ukendt*> else
5 14015 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 14016 end
4 14017 else
4 14018 if s<>0 and s<>omr then
4 14019 res:= 58 <* ulovligt område for bus *>
4 14020 else
4 14021 if intg(bustilstand(bi)) <> 0 then
4 14022 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 14023 else 14 <* optaget *>)
4 14024 else
4 14025 begin
5 14026 if linie_løb_indeks(bi) extract 12 <> 0 then
5 14027 begin <* linie/løb allerede indsat *>
6 14028 res:= 11;
6 14029 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 14030 end
5 14031 else
5 14032 begin
6 14033 \f
6 14033 message procedure vt_opdater side 3a - 900108/cl;
6 14034
6 14034 if d.op.kilde//100 <> 4 then
6 14035 res:= opd_omr(11,gar shift 8 +
6 14036 bustabel1(bi) extract 8,busnr,ll_id);
6 14037 if res>3 then goto slut_indsæt;
6 14038 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 14039 if s=0 then <* linie/løb findes allerede *>
6 14040 begin
7 14041 sig:= busindeks(li) extract 12;
7 14042 d.op.data(3):= bustabel(sig);
7 14043 linie_løb_indeks(sig):= false;
7 14044 disable modiffil(tf_vogntabel,sig,zi);
7 14045 fil(zi).ll:= 0;
7 14046 fil(zi).bn:= bustabel(sig) extract 14 add
7 14047 (bustabel1(sig) extract 8 shift 14);
7 14048 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 14049
7 14049 linie_løb_indeks(bi):= false add li;
7 14050 busindeks(li):= false add bi;
7 14051 disable modiffil(tf_vogntabel,bi,zi);
7 14052 fil(zi).ll:= ll_id;
7 14053 fil(zi).bn:= bustabel(bi) extract 14 add
7 14054 (bustabel1(bi) extract 8 shift 14);
7 14055 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 14056 res:= 3;
7 14057 end
6 14058 else
6 14059 begin
7 14060 \f
7 14060 message procedure vt_opdater side 4 - 810527/cl;
7 14061
7 14061 if s<0 then li:= li +1;
7 14062 if sidste_linie_løb=max_antal_linie_løb then
7 14063 begin
8 14064 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 14065 res:= 31;
8 14066 end
7 14067 else
7 14068 begin
8 14069 for i:= sidste_linie_løb step -1 until li do
8 14070 begin
9 14071 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 14072 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 14073 bus_indeks(i+1):=bus_indeks(i);
9 14074 end;
8 14075 sidste_linie_løb:= sidste_linie_løb +1;
8 14076 linie_løb_tabel(li):= ll_id;
8 14077 linie_løb_indeks(bi):= false add li;
8 14078 busindeks(li):= false add bi;
8 14079 disable s:= modiffil(tf_vogntabel,bi,zi);
8 14080 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 14081 fil(zi).bn:= busnr extract 14 add
8 14082 (bustabel1(bi) extract 8 shift 14);
8 14083 fil(zi).ll:= ll_id;
8 14084 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 14085 res:= 3; <* ok *>
8 14086 end;
7 14087 end;
6 14088 end;
5 14089 end;
4 14090 slut_indsæt:
4 14091 d.op.resultat:= res;
4 14092 end;
3 14093 goto returner;
3 14094 \f
3 14094 message procedure vt_opdater side 5 - 820301/cl;
3 14095
3 14095 udtag:
3 14096 begin
4 14097 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 14098
4 14098 busnr:= ll_id:= 0;
4 14099 omr:= s:= d.op.data(2) extract 8;
4 14100 format:= d.op.data(1) shift (-22);
4 14101 if format=0 then <*busnr*>
4 14102 begin
5 14103 busnr:= d.op.data(1) extract 14;
5 14104 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 14105 if bi<0 then
5 14106 begin
6 14107 if bi=-1 then res:= 10 else
6 14108 if s<>0 then res:= 58 else res:= 57;
6 14109 goto slut_udtag;
6 14110 end;
5 14111 if bi>0 and s<>0 and s<>omr then
5 14112 begin
6 14113 res:= 58; goto slut_udtag;
6 14114 end;
5 14115 li:= linie_løb_indeks(bi) extract 12;
5 14116 busnr:= bustabel(bi);
5 14117 if li=0 or linie_løb_tabel(li)=0 then
5 14118 begin <* bus ej indsat *>
6 14119 res:= 13;
6 14120 goto slut_udtag;
6 14121 end;
5 14122 ll_id:= linie_løb_tabel(li);
5 14123 end
4 14124 else
4 14125 if format=1 then <* linie_løb *>
4 14126 begin
5 14127 ll_id:= d.op.data(1);
5 14128 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 14129 if s<>0 then
5 14130 begin <* linie/løb findes ikke *>
6 14131 res:= 9;
6 14132 goto slut_udtag;
6 14133 end;
5 14134 bi:= busindeks(li) extract 12;
5 14135 busnr:= bustabel(bi);
5 14136 end
4 14137 else <* ulovlig identifikation *>
4 14138 begin
5 14139 res:= 31;
5 14140 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 14141 goto slut_udtag;
5 14142 end;
4 14143 \f
4 14143 message procedure vt_opdater side 6 - 820301/cl;
4 14144
4 14144 tilst:= intg(bustilstand(bi));
4 14145 if tilst<>0 then
4 14146 begin
5 14147 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 14148 goto slut_udtag;
5 14149 end;
4 14150 if d.op.kilde//100 <> 4 then
4 14151 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 14152 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 14153 if res>3 then goto slut_udtag;
4 14154 linie_løb_indeks(bi):= false;
4 14155 for i:= li step 1 until sidste_linie_løb -1 do
4 14156 begin
5 14157 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 14158 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 14159 bus_indeks(i):= bus_indeks(i+1);
5 14160 end;
4 14161 linie_løb_tabel(sidste_linie_løb):= 0;
4 14162 bus_indeks(sidste_linie_løb):= false;
4 14163 sidste_linie_løb:= sidste_linie_løb -1;
4 14164 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 14165 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 14166 fil(zi).ll:= 0;
4 14167 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 14168 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 14169 res:= 3; <* ok *>
4 14170 slut_udtag:
4 14171 d.op.resultat:= res;
4 14172 d.op.data(2):= ll_id;
4 14173 d.op.data(3):= busnr;
4 14174 end;
3 14175 goto returner;
3 14176 \f
3 14176 message procedure vt_opdater side 7 - 851001/cl;
3 14177
3 14177 omkod:
3 14178 flyt:
3 14179 roker:
3 14180 begin
4 14181 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 14182
4 14182 inf1:= inf2:= 0;
4 14183 ll_id1:= d.op.data(1);
4 14184 ll_id2:= d.op.data(2);
4 14185 if ll_id1=ll_id2 then
4 14186 begin
5 14187 res:= 24; inf1:= ll_id2;
5 14188 goto slut_flyt;
5 14189 end;
4 14190 <*+4*>
4 14191 <**> for i:= 1,2 do
4 14192 <**> if d.op.data(i) shift (-22) <> 1 then
4 14193 <**> begin
5 14194 <**> res:= 31;
5 14195 <**> fejlreaktion(10,d.op.data(i),case i of (
5 14196 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 14197 <**> goto slut_flyt;
5 14198 <**> end;
4 14199 <*-4*>
4 14200
4 14200 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 14201 if s<>0 and funk=6 <* roker *> then
4 14202 begin
5 14203 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 14204 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 14205 end;
4 14206 if s<>0 then
4 14207 begin
5 14208 res:= 9; <* ukendt linie/løb *>
5 14209 goto slut_flyt;
5 14210 end;
4 14211 bi1:= busindeks(li1) extract 12;
4 14212 inf1:= bustabel(bi1);
4 14213 tilst:= intg(bustilstand(bi1));
4 14214 if tilst<>0 then <* bus ikke fri *>
4 14215 begin
5 14216 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 14217 goto slut_flyt;
5 14218 end;
4 14219 \f
4 14219 message procedure vt_opdater side 7a- 851001/cl;
4 14220 if d.op.kilde//100 <> 4 then
4 14221
4 14221 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 14222 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 14223 if res>3 then goto slut_flyt;
4 14224
4 14224 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 14225 if s=0 then
4 14226 begin <* ll_id2 er indkodet *>
5 14227 bi2:= busindeks(li2) extract 12;
5 14228 inf2:= bustabel(bi2);
5 14229 tilst:= intg(bustilstand(bi2));
5 14230 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 14231 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 14232 if res>3 then
5 14233 begin
6 14234 inf1:= inf2; inf2:= 0;
6 14235 goto slut_flyt;
6 14236 end;
5 14237
5 14237 if d.op.kilde//100 <> 4 then
5 14238 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 14239 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 14240 if res>3 then goto slut_flyt;
5 14241
5 14241 <* flyt bus *>
5 14242 if funk=6 then
5 14243 linie_løb_indeks(bi2):= false add li1
5 14244 else
5 14245 linie_løb_indeks(bi2):= false;
5 14246 linie_løb_indeks(bi1):= false add li2;
5 14247 if funk=6 then
5 14248 busindeks(li1):= false add bi2
5 14249 else
5 14250 busindeks(li1):= false;
5 14251 busindeks(li2):= false add bi1;
5 14252
5 14252 if funk<>6 then
5 14253 begin
6 14254 <* fjern ll_id1 *>
6 14255 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 14256 begin
7 14257 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 14258 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 14259 busindeks(i):= busindeks(i+1);
7 14260 end;
6 14261 linie_løb_tabel(sidste_linie_løb):= 0;
6 14262 bus_indeks(sidste_linie_løb):= false;
6 14263 sidste_linie_løb:= sidste_linie_løb-1;
6 14264 end;
5 14265
5 14265 <* opdater vogntabelfil *>
5 14266 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 14267 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14268 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 14269 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 14270 if funk=6 then
5 14271 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 14272 else
5 14273 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 14274 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14275 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14276 fil(zi).ll:= ll_id2;
5 14277 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14278 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14279 \f
5 14279 message procedure vt_opdater side 8 - 820301/cl;
5 14280
5 14280 end <* ll_id2 indkodet *>
4 14281 else
4 14282 begin
5 14283 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 14284 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 14285 pm1:= sgn(li2-li1);
5 14286 for i:= li1 step pm1 until li2-pm1 do
5 14287 begin
6 14288 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 14289 busindeks(i):= busindeks(i+pm1);
6 14290 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 14291 end;
5 14292 linie_løb_tabel(li2):= ll_id2;
5 14293 busindeks(li2):= false add bi1;
5 14294 linie_løb_indeks(bi1):= false add li2;
5 14295 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14296 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14297 fil(zi).ll:= ll_id2;
5 14298 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14299 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14300 end;
4 14301 res:= 3; <*udført*>
4 14302 slut_flyt:
4 14303 d.op.resultat:= res;
4 14304 d.op.data(3):= inf1;
4 14305 if funk=5 then d.op.data(4):= inf2;
4 14306 end;
3 14307 goto returner;
3 14308 \f
3 14308 message procedure vt_opdater side 9 - 851001/cl;
3 14309
3 14309 slet:
3 14310 begin
4 14311 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 14312 boolean test24;
4 14313
4 14313 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 14314 omr:= d.op.data(3);
4 14315
4 14315 if d.op.data(1) > d.op.data(2) then
4 14316 begin
5 14317 res:= 44; <* intervalstørrelse ulovlig *>
5 14318 goto slut_slet;
5 14319 end;
4 14320
4 14320 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 14321 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 14322
4 14322 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 14323 if s<0 then finx:= finx+1;
4 14324 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 14325 if s>0 then sinx:= sinx-1;
4 14326
4 14326 for li:= finx step 1 until sinx do
4 14327 begin
5 14328 bi:= busindeks(li) extract 12;
5 14329 gar:= bustabel(bi) shift (-14) extract 8;
5 14330 if intg(bustilstand(bi))=0 and
5 14331 (omr = 0 or (omr > 0 and omr = gar) or
5 14332 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 14333 begin
6 14334 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 14335 linie_løb_indeks(bi):= busindeks(li):= false;
6 14336 linie_løb_tabel(li):= 0;
6 14337 end;
5 14338 end;
4 14339 \f
4 14339 message procedure vt_opdater side 10 - 850820/cl;
4 14340
4 14340 sinx:= finx-1;
4 14341 for li:= finx step 1 until sidste_linie_løb do
4 14342 begin
5 14343 if linie_løb_tabel(li)<>0 then
5 14344 begin
6 14345 sinx:= sinx+1;
6 14346 if sinx<>li then
6 14347 begin
7 14348 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 14349 busindeks(sinx):= busindeks(li);
7 14350 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 14351 linie_løb_tabel(li):= 0;
7 14352 busindeks(li):= false;
7 14353 end;
6 14354 end;
5 14355 end;
4 14356 sidste_linie_løb:= sinx;
4 14357
4 14357 test24:= testbit24; testbit24:= false;
4 14358 for bi:= 1 step 1 until sidste_bus do
4 14359 disable
4 14360 begin
5 14361 s:= modiffil(tf_vogntabel,bi,finx);
5 14362 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 14363 fil(finx).bn:= bustabel(bi) extract 14 add
5 14364 (bustabel1(bi) extract 8 shift 14);
5 14365 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 14366 end;
4 14367 testbit24:= test24;
4 14368 res:= 3;
4 14369
4 14369 slut_slet:
4 14370 d.op.resultat:= res;
4 14371 end;
3 14372 goto returner;
3 14373 \f
3 14373 message procedure vt_opdater side 11 - 810409/cl;
3 14374
3 14374 returner:
3 14375 disable
3 14376 begin
4 14377
4 14377 <*+2*>
4 14378 <**> if testbit40 and overvåget then
4 14379 <**> begin
5 14380 <**> skriv_vt_opd(out,0);
5 14381 <**> write(out,<: vogntabel efter ændring:>);
5 14382 <**> p_vogntabel(out);
5 14383 <**> end;
4 14384 <**> if testbit41 and overvåget then
4 14385 <**> begin
5 14386 <**> skriv_vt_opd(out,0);
5 14387 <**> write(out,<: returner operation:>);
5 14388 <**> skriv_op(out,op);
5 14389 <**> end;
4 14390 <*-2*>
4 14391
4 14391 signalch(d.op.retur,op,d.op.optype);
4 14392 end;
3 14393 goto vent_op;
3 14394
3 14394 vt_opd_trap:
3 14395 disable skriv_vt_opd(zbillede,1);
3 14396
3 14396 end vt_opdater;
2 14397 \f
2 14397 message procedure vt_tilstand side 1 - 810424/cl;
2 14398
2 14398 procedure vt_tilstand(cs_fil,fil_opref);
2 14399 value cs_fil,fil_opref;
2 14400 integer cs_fil,fil_opref;
2 14401 begin
3 14402 integer array field op,filop;
3 14403 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14404 g_type,gr,antal,ej_res,zi,li,filref;
3 14405 integer array identer(1:max_antal_i_gruppe);
3 14406
3 14406 procedure skriv_vt_tilst(zud,omfang);
3 14407 value omfang;
3 14408 zone zud;
3 14409 integer omfang;
3 14410 begin
4 14411 real array field raf;
4 14412 raf:= 0;
4 14413 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14414 if omfang <> 0 then
4 14415 begin
5 14416 skriv_coru(zud,abs curr_coruno);
5 14417 write(zud,"nl",1,<<d>,
5 14418 <:cs-fil :>,cs_fil,"nl",1,
5 14419 <:filop :>,filop,"nl",1,
5 14420 <:op :>,op,"nl",1,
5 14421 <:funk :>,funk,"nl",1,
5 14422 <:format :>,format,"nl",1,
5 14423 <:busid :>,busid,"nl",1,
5 14424 <:res :>,res,"nl",1,
5 14425 <:bi :>,bi,"nl",1,
5 14426 <:tilst :>,tilst,"nl",1,
5 14427 <:opk :>,opk,"nl",1,
5 14428 <:opk-indeks :>,opk_indeks,"nl",1,
5 14429 <:g-type :>,g_type,"nl",1,
5 14430 <:gr :>,gr,"nl",1,
5 14431 <:antal :>,antal,"nl",1,
5 14432 <:ej-res :>,ej_res,"nl",1,
5 14433 <:zi :>,zi,"nl",1,
5 14434 <:li :>,li,"nl",1,
5 14435 <::>);
5 14436 write(zud,"nl",1,<:identer:>);
5 14437 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14438 end;
4 14439 end;
3 14440
3 14440 procedure sorter_gruppe(tab,l,u);
3 14441 value l,u;
3 14442 integer array tab;
3 14443 integer l,u;
3 14444 begin
4 14445 integer array field ii,jj;
4 14446 integer array ww, xx(1:2);
4 14447
4 14447 integer procedure sml(a,b);
4 14448 integer array a,b;
4 14449 begin
5 14450 integer res;
5 14451
5 14451 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14452 if res = 0 then
5 14453 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14454 if res = 0 then
5 14455 res:=
5 14456 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14457 if res = 0 then
5 14458 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14459 sml:= res;
5 14460 end;
4 14461
4 14461 ii:= ((l+u)//2 - 1)*4;
4 14462 tofrom(xx,tab.ii,4);
4 14463 ii:= (l-1)*4; jj:= (u-1)*4;
4 14464 repeat
4 14465 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14466 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14467 if ii <= jj then
4 14468 begin
5 14469 tofrom(ww,tab.ii,4);
5 14470 tofrom(tab.ii,tab.jj,4);
5 14471 tofrom(tab.jj,ww,4);
5 14472 ii:= ii+4;
5 14473 jj:= jj-4;
5 14474 end;
4 14475 until ii>jj;
4 14476 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14477 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14478 end;
3 14479 \f
3 14479 message procedure vt_tilstand side 2 - 820301/cl;
3 14480
3 14480 filop:= filopref;
3 14481 stackclaim(if cm_test then 550 else 500);
3 14482 trap(vt_tilst_trap);
3 14483
3 14483 <*+2*>
3 14484 <**> disable if testbit47 and overvåget or testbit28 then
3 14485 <**> skriv_vt_tilst(out,0);
3 14486 <*-2*>
3 14487
3 14487 vent_op:
3 14488 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14489 <*+2*>disable
3 14490 <**> if (testbit41 and overvåget) or
3 14491 (testbit46 and overvåget and
3 14492 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14493 then
3 14494 <**> begin
4 14495 <**> skriv_vt_tilst(out,0);
4 14496 <**> write(out,<: modtaget operation:>);
4 14497 <**> skriv_op(out,op);
4 14498 <**> end;
3 14499 <*-2*>
3 14500
3 14500 <*+4*>
3 14501 <**> if op <> vt_op then
3 14502 <**> begin
4 14503 <**> disable begin
5 14504 <**> d.op.resultat:= 31;
5 14505 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14506 <**> end;
4 14507 <**> goto returner;
4 14508 <**> end;
3 14509 <*-4*>
3 14510
3 14510 opk:= d.op.opkode extract 12;
3 14511 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14512 if opk = 15 <*bus res *> then 2 else
3 14513 if opk = 16 <*grp res *> then 4 else
3 14514 if opk = 17 <*bus fri *> then 3 else
3 14515 if opk = 18 <*grp fri *> then 5 else
3 14516 0;
3 14517 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14518 res:= 0;
3 14519 format:= d.op.data(1) shift (-22);
3 14520
3 14520 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14521 \f
3 14521 message procedure vt_tilstand side 3 - 820301/cl;
3 14522
3 14522 enkelt_bus:
3 14523 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14524 disable
3 14525 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14526 <*+4*>
4 14527 <**>if format <> 0 and format <> 1 then
4 14528 <**>begin
5 14529 <**> res:= 31;
5 14530 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14531 <**> goto slut_enkelt_bus;
5 14532 <**>end;
4 14533 <*-4*>
4 14534 <* find busnr og tilstand *>
4 14535 case format+1 of
4 14536 begin
5 14537 <* 0: budident *>
5 14538 begin
6 14539 busnr:= d.op.data(1) extract 14;
6 14540 s:= omr:= d.op.data(4) extract 8;
6 14541 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14542 if bi<0 then
6 14543 begin
7 14544 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14545 goto slut_enkelt_bus;
7 14546 end
6 14547 else
6 14548 begin
7 14549 tilst:= intg(bustilstand(bi));
7 14550 end;
6 14551 end;
5 14552
5 14552 <* 1: linie_løb_ident *>
5 14553 begin
6 14554 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14555 if bi < 0 then <* ukendt linie_løb *>
6 14556 begin
7 14557 res:= 9;
7 14558 goto slut_enkelt_bus;
7 14559 end;
6 14560 end;
5 14561 end case;
4 14562 \f
4 14562 message procedure vt_tilstand side 4 - 830310/cl;
4 14563
4 14563 if funk < 3 then
4 14564 begin
5 14565 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14566 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14567 else 0;
5 14568 d.op.data(3):= bustabel(bi);
5 14569 d.op.data(4):= bustabel1(bi);
5 14570 end;
4 14571
4 14571 <* check tilstand *>
4 14572 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14573 res:= 39 <* bus ikke reserveret *>
4 14574 else
4 14575 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14576 res:= 14 <* bus optaget *>
4 14577 else
4 14578 if funk = 1 <* i kø *> and tilst = (-1) then
4 14579 res:= 18 <* i kø *>
4 14580 else
4 14581 res:= 3; <*udført*>
4 14582
4 14582 if res = 3 then
4 14583 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14584
4 14584 slut_enkelt_bus:
4 14585 d.op.resultat:= res;
4 14586 end <*disable*>;
3 14587 goto returner;
3 14588 \f
3 14588 message procedure vt_tilstand side 5 - 810424/cl;
3 14589
3 14589 grp_res: <* reserver gruppe *>
3 14590 disable
3 14591 begin
4 14592
4 14592 <*+4*>
4 14593 <**> if format <> 2 then
4 14594 <**> begin
5 14595 <**> res:= 31;
5 14596 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14597 <**> goto slut_grp_res_1;
5 14598 <**> end;
4 14599 <*-4*>
4 14600
4 14600 <* find frit indeks i opkaldstabel *>
4 14601 opk_indeks:= 0;
4 14602 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14603 begin
5 14604 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14605 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14606 end;
4 14607 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14608 if res <> 0 then goto slut_grp_res_1;
4 14609 g_type:= d.op.data(1) shift (-21) extract 1;
4 14610 if g_type = 1 <*special gruppe*> then
4 14611 begin <*check eksistens*>
5 14612 gr:= 0;
5 14613 for i:= 1 step 1 until max_antal_grupper do
5 14614 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14615 if gr = 0 then <*gruppe ukendt*>
5 14616 begin
6 14617 res:= 8;
6 14618 goto slut_grp_res_1;
6 14619 end;
5 14620 end;
4 14621
4 14621 <* reserver i opkaldstabel *>
4 14622 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14623 \f
4 14623 message procedure vt_tilstand side 6 - 810428/cl;
4 14624
4 14624 <* tilknyt fil *>
4 14625 start_operation(filop,curr_coruid,cs_fil,101);
4 14626 d.filop.data(1):= 0; <*postantal*>
4 14627 d.filop.data(2):= 256; <*postlængde*>
4 14628 d.filop.data(3):= 1; <*segmentantal*>
4 14629 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14630 signalch(cs_opret_fil,filop,vt_optype);
4 14631
4 14631 slut_grp_res_1:
4 14632 if res <> 0 then d.op.resultat:= res;
4 14633 end;
3 14634 if res <> 0 then goto returner;
3 14635
3 14635 waitch(cs_fil,filop,vt_optype,-1);
3 14636
3 14636 <* check filsys-resultat *>
3 14637 if d.filop.data(9) <> 0 then
3 14638 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14639 filref:= d.filop.data(4);
3 14640 \f
3 14640 message procedure vt_tilstand side 7 - 820301/cl;
3 14641 disable if g_type = 0 <*linie-gruppe*> then
3 14642 begin
4 14643 integer s,i,ll_id;
4 14644 integer array field iaf1;
4 14645
4 14645 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14646 iaf1:= 2;
4 14647 s:= binærsøg(sidste_linie_løb,
4 14648 linie_løb_tabel(i) - ll_id, i);
4 14649 if s < 0 then i:= i +1;
4 14650 antal:= ej_res:= 0;
4 14651 skrivfil(filref,1,zi);
4 14652 if i <= sidste_linie_løb then
4 14653 begin
5 14654 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14655 begin
6 14656 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14657 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14658 ej_res:= ej_res+1
6 14659 else
6 14660 begin
7 14661 antal:= antal+1;
7 14662 bi:= busindeks(i) extract 12;
7 14663 fil(zi).iaf1(1):=
7 14664 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14665 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14666 fil(zi).iaf1(2):= bustabel(bi);
7 14667 iaf1:= iaf1+4;
7 14668 bustilstand(bi):= false add opk_indeks;
7 14669 end;
6 14670 i:= i +1;
6 14671 if i > sidste_linie_løb then goto slut_l_grp;
6 14672 end;
5 14673 end;
4 14674 \f
4 14674 message procedure vt_tilstand side 8 - 820301/cl;
4 14675
4 14675 slut_l_grp:
4 14676 end
3 14677 else
3 14678 begin <*special gruppe*>
4 14679 integer i,s,li,omr,gar,tilst;
4 14680 integer array field iaf1;
4 14681
4 14681 iaf1:= 2;
4 14682 antal:= ej_res:= 0;
4 14683 s:= læsfil(tf_gruppedef,gr,zi);
4 14684 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14685 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14686 s:= skrivfil(filref,1,zi);
4 14687 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14688 i:= 1;
4 14689 while identer(i) <> 0 do
4 14690 begin
5 14691 if identer(i) shift (-22) = 0 then
5 14692 begin <*busident*>
6 14693 omr:= 0;
6 14694 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14695 if bi<0 then goto næste_ident;
6 14696 li:= linie_løb_indeks(bi) extract 12;
6 14697 end
5 14698 else
5 14699 begin <*linie/løb ident*>
6 14700 s:= binærsøg(sidste_linie_løb,
6 14701 linie_løb_tabel(li) - identer(i), li);
6 14702 if s <> 0 then goto næste_ident;
6 14703 bi:= busindeks(li) extract 12;
6 14704 end;
5 14705 if (intg(bustilstand(bi))<>0) or
5 14706 (bustabel1(bi) extract 8 <> 3) then
5 14707 ej_res:= ej_res+1
5 14708 else
5 14709 begin
6 14710 antal:= antal +1;
6 14711 fil(zi).iaf1(1):=
6 14712 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14713 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14714 fil(zi).iaf1(2):= bustabel(bi);
6 14715 iaf1:= iaf1+4;
6 14716 bustilstand(bi):= false add opk_indeks;
6 14717 end;
5 14718 næste_ident:
5 14719 i:= i +1;
5 14720 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14721 end;
4 14722 slut_s_grp:
4 14723 end;
3 14724 \f
3 14724 message procedure vt_tilstand side 9 - 820301/cl;
3 14725
3 14725 if antal > 0 then <*ok*>
3 14726 disable begin
4 14727 integer array field spec,akt;
4 14728 integer a;
4 14729 integer field antal_spec;
4 14730
4 14730 antal_spec:= 2; a:= 0;
4 14731 spec:= 2; akt:= 2;
4 14732 sorter_gruppe(fil(zi).spec,1,antal);
4 14733 fil(zi).antal_spec:= 0;
4 14734 while akt//4 < antal do
4 14735 begin
5 14736 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14737 a:= 0;
5 14738 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14739 and a<15 do
5 14740 begin
6 14741 a:= a+1;
6 14742 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14743 akt:= akt+4;
6 14744 end;
5 14745 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14746 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14747 spec:= spec + 2*a + 2;
5 14748 end;
4 14749 antal:= fil(zi).antal_spec;
4 14750 gruppeopkald(opk_indeks,2):= filref;
4 14751 d.op.resultat:= 3;
4 14752 d.op.data(2):= antal;
4 14753 d.op.data(3):= filref;
4 14754 d.op.data(4):= ej_res;
4 14755 end
3 14756 else
3 14757 begin
4 14758 disable begin
5 14759 d.filop.opkode:= 104; <*slet fil*>
5 14760 signalch(cs_slet_fil,filop,vt_optype);
5 14761 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14762 d.op.resultat:= 54;
5 14763 d.op.data(2):= antal;
5 14764 d.op.data(3):= 0;
5 14765 d.op.data(4):= ej_res;
5 14766 end;
4 14767 waitch(cs_fil,filop,vt_optype,-1);
4 14768 if d.filop.data(9) <> 0 then
4 14769 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14770 end;
3 14771 goto returner;
3 14772 \f
3 14772 message procedure vt_tilstand side 10 - 820301/cl;
3 14773
3 14773 grp_fri: <* frigiv gruppe *>
3 14774 disable
3 14775 begin integer i,j,s,ll,gar,omr,tilst;
4 14776 integer array field spec;
4 14777
4 14777 <*+4*>
4 14778 <**> if format <> 2 then
4 14779 <**> begin
5 14780 <**> res:= 31;
5 14781 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14782 <**> goto slut_grp_fri;
5 14783 <**> end;
4 14784 <*-4*>
4 14785
4 14785 <* find indeks i opkaldstabel *>
4 14786 opk_indeks:= 0;
4 14787 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14788 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14789 if opk_indeks = 0 <*ikke fundet*> then
4 14790 begin
5 14791 res:= 40; <*gruppe ej reserveret*>
5 14792 goto slut_grp_fri;
5 14793 end;
4 14794 filref:= gruppeopkald(opk_indeks,2);
4 14795 start_operation(filop,curr_coruid,cs_fil,104);
4 14796 d.filop.data(4):= filref;
4 14797 hentfildim(d.filop.data);
4 14798 læsfil(filref,1,zi);
4 14799 spec:= 0;
4 14800 antal:= fil(zi).spec(1);
4 14801 spec:= spec+2;
4 14802 for i:= 1 step 1 until antal do
4 14803 begin
5 14804 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14805 begin
6 14806 busid:= fil(zi).spec(1+j) extract 14;
6 14807 omr:= 0;
6 14808 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14809 if bi>=0 then bustilstand(bi):= false;
6 14810 end;
5 14811 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14812 end;
4 14813
4 14813 slut_grp_fri:
4 14814 d.op.resultat:= res;
4 14815 end;
3 14816 if res <> 0 then goto returner;
3 14817 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14818 signalch(cs_slet_fil,filop,vt_optype);
3 14819 \f
3 14819 message procedure vt_tilstand side 11 - 810424/cl;
3 14820
3 14820 waitch(cs_fil,filop,vt_optype,-1);
3 14821
3 14821 if d.filop.data(9) <> 0 then
3 14822 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14823 d.op.resultat:= 3;
3 14824
3 14824 returner:
3 14825 disable
3 14826 begin
4 14827 <*+2*>
4 14828 <**> if testbit40 and overvåget then
4 14829 <**> begin
5 14830 <**> skriv_vt_tilst(out,0);
5 14831 <**> write(out,<: vogntabel efter ændring:>);
5 14832 <**> p_vogntabel(out);
5 14833 <**> end;
4 14834 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14835 <**> begin
5 14836 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14837 <**> p_gruppetabel(out);
5 14838 <**> end;
4 14839 <**> if (testbit41 and overvåget) or
4 14840 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14841 <**> begin
5 14842 <**> skriv_vt_tilst(out,0);
5 14843 <**> write(out,<: returner operation:>);
5 14844 <**> skriv_op(out,op);
5 14845 <**> end;
4 14846 <*-2*>
4 14847 signalch(d.op.retur,op,d.op.optype);
4 14848 end;
3 14849 goto vent_op;
3 14850
3 14850 vt_tilst_trap:
3 14851 disable skriv_vt_tilst(zbillede,1);
3 14852
3 14852 end vt_tilstand;
2 14853 \f
2 14853 message procedure vt_rapport side 1 - 810428/cl;
2 14854
2 14854 procedure vt_rapport(cs_fil,fil_opref);
2 14855 value cs_fil,fil_opref;
2 14856 integer cs_fil,fil_opref;
2 14857 begin
3 14858 integer array field op,filop;
3 14859 integer funk,filref,antal,id_ant,res;
3 14860 integer field i1,i2;
3 14861
3 14861 procedure skriv_vt_rap(z,omfang);
3 14862 value omfang;
3 14863 zone z;
3 14864 integer omfang;
3 14865 begin
4 14866 write(z,"nl",1,<:+++ vt_rapport :>);
4 14867 if omfang <> 0 then
4 14868 begin
5 14869 skriv_coru(z,abs curr_coruno);
5 14870 write(z,"nl",1,<<d>,
5 14871 <: cs_fil :>,cs_fil,"nl",1,
5 14872 <: filop :>,filop,"nl",1,
5 14873 <: op :>,op,"nl",1,
5 14874 <: funk :>,funk,"nl",1,
5 14875 <: filref :>,filref,"nl",1,
5 14876 <: antal :>,antal,"nl",1,
5 14877 <: id-ant :>,id_ant,"nl",1,
5 14878 <: res :>,res,"nl",1,
5 14879 <::>);
5 14880
5 14880 end;
4 14881 end skriv_vt_rap;
3 14882
3 14882 stackclaim(if cm_test then 198 else 146);
3 14883 filop:= fil_opref;
3 14884 i1:= 2; i2:= 4;
3 14885 trap(vt_rap_trap);
3 14886
3 14886 <*+2*>
3 14887 <**> disable if testbit47 and overvåget or testbit28 then
3 14888 <**> skriv_vt_rap(out,0);
3 14889 <*-2*>
3 14890 \f
3 14890 message procedure vt_rapport side 2 - 810505/cl;
3 14891
3 14891 vent_op:
3 14892 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14893
3 14893 <*+2*>
3 14894 <**> disable begin
4 14895 <**> if testbit41 and overvåget then
4 14896 <**> begin
5 14897 <**> skriv_vt_rap(out,0);
5 14898 <**> write(out,<: modtaget operation:>);
5 14899 <**> skriv_op(out,op);
5 14900 <**> ud;
5 14901 <**> end;
4 14902 <**> end;<*disable*>
3 14903 <*-2*>
3 14904
3 14904 disable
3 14905 begin
4 14906 integer opk;
4 14907
4 14907 opk:= d.op.opkode extract 12;
4 14908 funk:= if opk = 9 then 1 else
4 14909 if opk =10 then 2 else
4 14910 0;
4 14911 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14912
4 14912 <* opret og tilknyt fil *>
4 14913 start_operation(filop,curr_coruid,cs_fil,101);
4 14914 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14915 d.filop.data(2):= 2; <*postlængde*>
4 14916 d.filop.data(3):=10; <*segmenter*>
4 14917 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14918 signalch(cs_opretfil,filop,vt_optype);
4 14919 end;
3 14920
3 14920 waitch(cs_fil,filop,vt_optype,-1);
3 14921
3 14921 <* check resultat *>
3 14922 if d.filop.data(9) <> 0 then
3 14923 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14924 filref:= d.filop.data(4);
3 14925 antal:= 0;
3 14926 goto case funk of (l_rapport,b_rapport);
3 14927 \f
3 14927 message procedure vt_rapport side 3 - 850820/cl;
3 14928
3 14928 l_rapport:
3 14929 disable
3 14930 begin
4 14931 integer i,j,s,ll,zi;
4 14932 idant:= 0;
4 14933 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14934 <*+4*>
4 14935 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14936 <**> begin
5 14937 <**> res:= 31;
5 14938 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14939 <**> goto l_rap_slut;
5 14940 <**> end;
4 14941 <*-4*>
4 14942 ;
4 14943
4 14943 for i:= 1 step 1 until id_ant do
4 14944 begin
5 14945 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14946 s:= binærsøg(sidste_linie_løb,
5 14947 linie_løb_tabel(j) - ll, j);
5 14948 if s < 0 then j:= j +1;
5 14949
5 14949 if j<= sidste_linie_løb then
5 14950 begin <* skriv identer *>
6 14951 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14952 begin
7 14953 antal:= antal +1;
7 14954 s:= skrivfil(filref,antal,zi);
7 14955 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14956 fil(zi).i1:= linie_løb_tabel(j);
7 14957 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14958 j:= j +1;
7 14959 if j > sidste_bus then goto linie_slut;
7 14960 end;
6 14961 end;
5 14962 linie_slut:
5 14963 end;
4 14964 res:= 3;
4 14965 l_rap_slut:
4 14966 end <*disable*>;
3 14967 goto returner;
3 14968 \f
3 14968 message procedure vt_rapport side 4 - 820301/cl;
3 14969
3 14969 b_rapport:
3 14970 disable
3 14971 begin
4 14972 integer i,j,s,zi,busnr1,busnr2;
4 14973 <*+4*>
4 14974 <**> for i:= 1,2 do
4 14975 <**> if d.op.data(i) shift (-14) <> 0 then
4 14976 <**> begin
5 14977 <**> res:= 31;
5 14978 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14979 <**> goto bus_slut;
5 14980 <**> end;
4 14981 <*-4*>
4 14982
4 14982 busnr1:= d.op.data(1) extract 14;
4 14983 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14984 if busnr1 = 0 or busnr2 < busnr1 then
4 14985 begin
5 14986 res:= 7; <* fejl i busnr *>
5 14987 goto bus_slut;
5 14988 end;
4 14989
4 14989 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14990 - busnr1,j);
4 14991 if s < 0 then j:= j +1;
4 14992 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14993 if j <= sidste_bus then
4 14994 begin <* skriv identer *>
5 14995 while bustabel(j) extract 14 <= busnr2 do
5 14996 begin
6 14997 i:= linie_løb_indeks(j) extract 12;
6 14998 if i<>0 then
6 14999 begin
7 15000 antal:= antal +1;
7 15001 s:= skriv_fil(filref,antal,zi);
7 15002 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 15003 fil(zi).i1:= bustabel(j);
7 15004 fil(zi).i2:= linie_løb_tabel(i);
7 15005 end;
6 15006 j:= j +1;
6 15007 if j > sidste_bus then goto bus_slut;
6 15008 end;
5 15009 end;
4 15010 bus_slut:
4 15011 end <*disable*>;
3 15012 res:= 3; <*ok*>
3 15013 \f
3 15013 message procedure vt_rapport side 5 - 810409/cl;
3 15014
3 15014 returner:
3 15015 disable
3 15016 begin
4 15017 d.op.resultat:= res;
4 15018 d.op.data(6):= antal;
4 15019 d.op.data(7):= filref;
4 15020 d.filop.data(1):= antal;
4 15021 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 15022 i:= sæt_fil_dim(d.filop.data);
4 15023 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 15024 <*+2*>
4 15025 <**> if testbit41 and overvåget then
4 15026 <**> begin
5 15027 <**> skriv_vt_rap(out,0);
5 15028 <**> write(out,<: returner operation:>);
5 15029 <**> skriv_op(out,op);
5 15030 <**> end;
4 15031 <*-2*>
4 15032 signalch(d.op.retur,op,d.op.optype);
4 15033 end;
3 15034 goto vent_op;
3 15035
3 15035 vt_rap_trap:
3 15036 disable skriv_vt_rap(zbillede,1);
3 15037
3 15037 end vt_rapport;
2 15038 \f
2 15038 message procedure vt_gruppe side 1 - 810428/cl;
2 15039
2 15039 procedure vt_gruppe(cs_fil,fil_opref);
2 15040
2 15040 value cs_fil,fil_opref;
2 15041 integer cs_fil,fil_opref;
2 15042 begin
3 15043 integer array field op, fil_op, iaf;
3 15044 integer funk, res, filref, gr, i, antal, zi, s;
3 15045 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 15046 max_antal_grupper else max_antal_i_gruppe));
3 15047
3 15047 procedure skriv_vt_gruppe(zud,omfang);
3 15048 value omfang;
3 15049 integer omfang;
3 15050 zone zud;
3 15051 begin
4 15052 integer øg;
4 15053
4 15053 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 15054 if omfang <> 0 then
4 15055 disable
4 15056 begin
5 15057 skriv_coru(zud,abs curr_coruno);
5 15058 write(zud,"nl",1,<<d>,
5 15059 <: cs_fil :>,cs_fil,"nl",1,
5 15060 <: op :>,op,"nl",1,
5 15061 <: filop :>,filop,"nl",1,
5 15062 <: funk :>,funk,"nl",1,
5 15063 <: res :>,res,"nl",1,
5 15064 <: filref :>,filref,"nl",1,
5 15065 <: gr :>,gr,"nl",1,
5 15066 <: i :>,i,"nl",1,
5 15067 <: antal :>,antal,"nl",1,
5 15068 <: zi :>,zi,"nl",1,
5 15069 <: s :>,s,"nl",1,
5 15070 <::>);
5 15071 raf:= 0;
5 15072 system(3,øg,identer);
5 15073 write(zud,"nl",1,<:identer::>);
5 15074 skriv_hele(zud,identer.raf,øg*2,2);
5 15075 end;
4 15076 end;
3 15077
3 15077 stackclaim(if cm_test then 198 else 146);
3 15078 filop:= fil_opref;
3 15079 trap(vt_grp_trap);
3 15080 iaf:= 0;
3 15081 \f
3 15081 message procedure vt_gruppe side 2 - 810409/cl;
3 15082
3 15082 <*+2*>
3 15083 <**> disable if testbit47 and overvåget or testbit28 then
3 15084 <**> skriv_vt_gruppe(out,0);
3 15085 <*-2*>
3 15086
3 15086 vent_op:
3 15087 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 15088 <*+2*>
3 15089 <**>disable
3 15090 <**>begin
4 15091 <**> if testbit41 and overvåget then
4 15092 <**> begin
5 15093 <**> skriv_vt_gruppe(out,0);
5 15094 <**> write(out,<: modtaget operation:>);
5 15095 <**> skriv_op(out,op);
5 15096 <**> ud;
5 15097 <**> end;
4 15098 <**>end;
3 15099 <*-2*>
3 15100
3 15100 disable
3 15101 begin
4 15102 integer opk;
4 15103
4 15103 opk:= d.op.opkode extract 12;
4 15104 funk:= if opk=25 then 1 else
4 15105 if opk=26 then 2 else
4 15106 if opk=27 then 3 else
4 15107 if opk=28 then 4 else
4 15108 0;
4 15109 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 15110 end;
3 15111 <*+4*>
3 15112 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 15113 <**> begin
4 15114 <**> disable begin
5 15115 <**> d.op.resultat:= 31;
5 15116 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 15117 <**> end;
4 15118 <**> goto returner;
4 15119 <**> end;
3 15120 <*-4*>
3 15121
3 15121 goto case funk of(definer,slet,vis,oversigt);
3 15122 \f
3 15122 message procedure vt_gruppe side 3 - 810505/cl;
3 15123
3 15123 definer:
3 15124 disable
3 15125 begin
4 15126 gr:= 0; res:= 0;
4 15127 for i:= max_antal_grupper step -1 until 1 do
4 15128 begin
5 15129 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 15130 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 15131 end;
4 15132 if gr=0 then res:= 32; <*ingen plads*>
4 15133 end;
3 15134 if res<>0 then goto slut_definer;
3 15135 disable
3 15136 begin <*fri plads fundet*>
4 15137 antal:= d.op.data(2);
4 15138 if antal <=0 or max_antal_i_gruppe<antal then
4 15139 res:= 33 <*fejl i gruppestørrelse*>
4 15140 else
4 15141 begin
5 15142 for i:= 1 step 1 until antal do
5 15143 begin
6 15144 s:= læsfil(d.op.data(3),i,zi);
6 15145 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 15146 identer(i):= fil(zi).iaf(1);
6 15147 end;
5 15148 s:= modif_fil(tf_gruppedef,gr,zi);
5 15149 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15150 tofrom(fil(zi).iaf,identer,antal*2);
5 15151 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 15152 fil(zi).iaf(i):= 0;
5 15153 gruppetabel(gr):= d.op.data(1);
5 15154 s:= modiffil(tf_gruppeidenter,gr,zi);
5 15155 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15156 fil(zi).iaf(1):= gruppetabel(gr);
5 15157 res:= 3;
5 15158 end;
4 15159 end;
3 15160 slut_definer:
3 15161 <*slet fil*>
3 15162 start_operation(fil_op,curr_coruid,cs_fil,104);
3 15163 d.filop.data(4):= d.op.data(3);
3 15164 signalch(cs_slet_fil,filop,vt_optype);
3 15165 waitch(cs_fil,filop,vt_optype,-1);
3 15166 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 15167 d.op.resultat:= res;
3 15168 goto returner;
3 15169 \f
3 15169 message procedure vt_gruppe side 4 - 810409/cl;
3 15170
3 15170 slet:
3 15171 disable
3 15172 begin
4 15173 gr:= 0; res:= 0;
4 15174 for i:= 1 step 1 until max_antal_grupper do
4 15175 begin
5 15176 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 15177 end;
4 15178 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 15179 else
4 15180 begin
5 15181 for i:= 1 step 1 until max_antal_gruppeopkald do
5 15182 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 15183 if res = 0 then
5 15184 begin
6 15185 gruppetabel(gr):= 0;
6 15186 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 15187 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 15188 fil(zi).iaf(1):= gruppetabel(gr);
6 15189 res:= 3;
6 15190 end;
5 15191 end;
4 15192 d.op.resultat:= res;
4 15193 end;
3 15194 goto returner;
3 15195 \f
3 15195 message procedure vt_gruppe side 5 - 810505/cl;
3 15196
3 15196 vis:
3 15197 disable
3 15198 begin
4 15199 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 15200 for i:= 1 step 1 until max_antal_grupper do
4 15201 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 15202 if gr = 0 then res:= 8
4 15203 else
4 15204 begin
5 15205 s:= læsfil(tf_gruppedef,gr,zi);
5 15206 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 15207 for i:= 1 step 1 until max_antal_i_gruppe do
5 15208 begin
6 15209 identer(i):= fil(zi).iaf(i);
6 15210 if identer(i) <> 0 then antal:= antal +1;
6 15211 end;
5 15212 start_operation(filop,curr_coruid,cs_fil,101);
5 15213 d.filop.data(1):= antal; <*postantal*>
5 15214 d.filop.data(2):= 1; <*postlængde*>
5 15215 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 15216 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 15217 d.filop.data(5):= d.filop.data(6):=
5 15218 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 15219 signalch(cs_opret_fil,filop,vt_optype);
5 15220 end;
4 15221 end;
3 15222 if res <> 0 then goto slut_vis;
3 15223 waitch(cs_fil,filop,vt_optype,-1);
3 15224 disable
3 15225 begin
4 15226 if d.filop.data(9) <> 0 then
4 15227 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 15228 filref:= d.filop.data(4);
4 15229 for i:= 1 step 1 until antal do
4 15230 begin
5 15231 s:= skrivfil(filref,i,zi);
5 15232 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 15233 fil(zi).iaf(1):= identer(i);
5 15234 end;
4 15235 res:= 3;
4 15236 end;
3 15237 slut_vis:
3 15238 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 15239 goto returner;
3 15240 \f
3 15240 message procedure vt_gruppe side 6 - 810508/cl;
3 15241
3 15241 oversigt:
3 15242 disable
3 15243 begin
4 15244 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 15245 for i:= 1 step 1 until max_antal_grupper do
4 15246 begin
5 15247 if gruppetabel(i) <> 0 then
5 15248 begin
6 15249 antal:= antal +1;
6 15250 identer(antal):= gruppetabel(i);
6 15251 end;
5 15252 end;
4 15253 start_operation(filop,curr_coruid,cs_fil,101);
4 15254 d.filop.data(1):= antal; <*postantal*>
4 15255 d.filop.data(2):= 1; <*postlængde*>
4 15256 d.filop.data(3):= if antal = 0 then 1 else
4 15257 (antal-1)//256 +1; <*segm.antal*>
4 15258 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 15259 d.filop.data(5):= d.filop.data(6):=
4 15260 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 15261 signalch(cs_opretfil,filop,vt_optype);
4 15262 end;
3 15263 waitch(cs_fil,filop,vt_optype,-1);
3 15264 disable
3 15265 begin
4 15266 if d.filop.data(9) <> 0 then
4 15267 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 15268 filref:= d.filop.data(4);
4 15269 for i:= 1 step 1 until antal do
4 15270 begin
5 15271 s:= skriv_fil(filref,i,zi);
5 15272 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 15273 fil(zi).iaf(1):= identer(i);
5 15274 end;
4 15275 d.op.resultat:= 3; <*ok*>
4 15276 d.op.data(1):= antal;
4 15277 d.op.data(2):= filref;
4 15278 end;
3 15279 \f
3 15279 message procedure vt_gruppe side 7 - 810505/cl;
3 15280
3 15280 returner:
3 15281 disable
3 15282 begin
4 15283 <*+2*>
4 15284 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 15285 <**> begin
5 15286 <**> skriv_vt_gruppe(out,0);
5 15287 <**> write(out,<: gruppetabel efter ændring:>);
5 15288 <**> p_gruppetabel(out);
5 15289 <**> end;
4 15290 <**> if testbit41 and overvåget then
4 15291 <**> begin
5 15292 <**> skriv_vt_gruppe(out,0);
5 15293 <**> write(out,<: returner operation:>);
5 15294 <**> skriv_op(out,op);
5 15295 <**> end;
4 15296 <*-2*>
4 15297 signalch(d.op.retur,op,d.op.optype);
4 15298 end;
3 15299 goto vent_op;
3 15300
3 15300 vt_grp_trap:
3 15301 disable skriv_vt_gruppe(zbillede,1);
3 15302
3 15302 end vt_gruppe;
2 15303 \f
2 15303 message procedure vt_spring side 1 - 810506/cl;
2 15304
2 15304 procedure vt_spring(cs_spring_retur,spr_opref);
2 15305 value cs_spring_retur,spr_opref;
2 15306 integer cs_spring_retur,spr_opref;
2 15307 begin
3 15308 integer array field komm_op,spr_op,iaf;
3 15309 real nu;
3 15310 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 15311
3 15311 procedure skriv_vt_spring(zud,omfang);
3 15312 value omfang;
3 15313 zone zud;
3 15314 integer omfang;
3 15315 begin
4 15316 write(zud,"nl",1,<:+++ vt_spring :>);
4 15317 if omfang <> 0 then
4 15318 begin
5 15319 skriv_coru(zud,abs curr_coruno);
5 15320 write(zud,"nl",1,<<d>,
5 15321 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 15322 <:spr-op :>,spr_op,"nl",1,
5 15323 <:komm-op :>,komm_op,"nl",1,
5 15324 <:funk :>,funk,"nl",1,
5 15325 <:interval :>,interval,"nl",1,
5 15326 <:nr :>,nr,"nl",1,
5 15327 <:i :>,i,"nl",1,
5 15328 <:s :>,s,"nl",1,
5 15329 <:id1 :>,id1,"nl",1,
5 15330 <:id2 :>,id2,"nl",1,
5 15331 <:res :>,res,"nl",1,
5 15332 <:res-inf :>,res_inf,"nl",1,
5 15333 <:medd-kode :>,medd_kode,"nl",1,
5 15334 <:zi :>,zi,"nl",1,
5 15335 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 15336 <::>);
5 15337 end;
4 15338 end;
3 15339 \f
3 15339 message procedure vt_spring side 2 - 810506/cl;
3 15340
3 15340 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 15341 value aktion,id1,id2;
3 15342 integer aktion,id1,id2,res,res_inf;
3 15343 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 15344 integer array field akt_op;
4 15345
4 15345 <* vent på adgang til vogntabel *>
4 15346 waitch(cs_vt_adgang,akt_op,true,-1);
4 15347
4 15347 <* start operation *>
4 15348 disable
4 15349 begin
5 15350 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 15351 d.akt_op.data(1):= id1;
5 15352 d.akt_op.data(2):= id2;
5 15353 signalch(cs_vt_opd,akt_op,vt_optype);
5 15354 end;
4 15355
4 15355 <* afvent svar *>
4 15356 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 15357 res:= d.akt_op.resultat;
4 15358 res_inf:= d.akt_op.data(3);
4 15359 <*+2*>
4 15360 <**> disable
4 15361 <**> if testbit45 and overvåget then
4 15362 <**> begin
5 15363 <**> real t;
5 15364 <**> skriv_vt_spring(out,0);
5 15365 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 15366 <**> skriv_id(out,springtabel(nr,1),0);
5 15367 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 15368 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 15369 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 15370 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 15371 <**> d.akt_op.resultat,"sp",2);
5 15372 <**> skriv_id(out,d.akt_op.data(1),8);
5 15373 <**> skriv_id(out,d.akt_op.data(2),8);
5 15374 <**> skriv_id(out,d.akt_op.data(3),8);
5 15375 <**> systime(4,springtid(nr),t);
5 15376 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 15377 <**> end;
4 15378 <*-2*>
4 15379
4 15379 <* åbn adgang til vogntabel *>
4 15380 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 15381 end vt_operation;
3 15382 \f
3 15382 message procedure vt_spring side 2a - 810506/cl;
3 15383
3 15383 procedure io_meddelelse(medd_no,bus,linie,springno);
3 15384 value medd_no,bus,linie,springno;
3 15385 integer medd_no,bus,linie,springno;
3 15386 begin
4 15387 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 15388 d.spr_op.data(1):= medd_no;
4 15389 d.spr_op.data(2):= bus;
4 15390 d.spr_op.data(3):= linie;
4 15391 d.spr_op.data(4):= springtabel(springno,1);
4 15392 d.spr_op.data(5):= springtabel(springno,2);
4 15393 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15394 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15395 end;
3 15396
3 15396 procedure returner_op(op,res);
3 15397 value res;
3 15398 integer array field op;
3 15399 integer res;
3 15400 begin
4 15401 <*+2*>
4 15402 <**> disable
4 15403 <**> if testbit41 and overvåget then
4 15404 <**> begin
5 15405 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15406 <**> skriv_op(out,op);
5 15407 <**> end;
4 15408 <*-2*>
4 15409 d.op.resultat:= res;
4 15410 signalch(d.op.retur,op,d.op.optype);
4 15411 end;
3 15412 \f
3 15412 message procedure vt_spring side 3 - 810603/cl;
3 15413
3 15413 iaf:= 0;
3 15414 spr_op:= spr_opref;
3 15415 stack_claim((if cm_test then 198 else 146) + 24);
3 15416
3 15416 trap(vt_spring_trap);
3 15417
3 15417 for i:= 1 step 1 until max_antal_spring do
3 15418 begin
4 15419 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15420 springtid(i):= springstart(i):= 0.0;
4 15421 end;
3 15422
3 15422 <*+2*>
3 15423 <**> disable
3 15424 <**> if testbit44 and overvåget then
3 15425 <**> begin
4 15426 <**> skriv_vt_spring(out,0);
4 15427 <**> write(out,<: springtabel efter initialisering:>);
4 15428 <**> p_springtabel(out); ud;
4 15429 <**> end;
3 15430 <*-2*>
3 15431
3 15431 <*+2*>
3 15432 <**> disable if testbit47 and overvåget or testbit28 then
3 15433 <**> skriv_vt_spring(out,0);
3 15434 <*-2*>
3 15435 \f
3 15435 message procedure vt_spring side 4 - 810609/cl;
3 15436
3 15436 næste_tid: <* find næste tid *>
3 15437 disable
3 15438 begin
4 15439 interval:= -1; <*vent uendeligt*>
4 15440 systime(1,0.0,nu);
4 15441 for i:= 1 step 1 until max_antal_spring do
4 15442 if springtabel(i,3) < 0 then
4 15443 interval:= 5
4 15444 else
4 15445 if springtid(i) <> 0.0 and
4 15446 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15447 interval:= (if springtid(i) <= nu then 0 else
4 15448 round(springtid(i) -nu));
4 15449 if interval=0 then interval:= 1;
4 15450 end;
3 15451 \f
3 15451 message procedure vt_spring side 4a - 810525/cl;
3 15452
3 15452 <* afvent operation eller timeout *>
3 15453 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15454 if komm_op <> 0 then goto afkod_operation;
3 15455
3 15455 <* timeout *>
3 15456 systime(1,0.0,nu);
3 15457 nr:= 1;
3 15458 næste_sekv:
3 15459 if nr > max_antal_spring then goto næste_tid;
3 15460 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15461 begin
4 15462 nr:= nr +1;
4 15463 goto næste_sekv;
4 15464 end;
3 15465 disable s:= modif_fil(tf_springdef,nr,zi);
3 15466 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15467 if springtabel(nr,3) < 0 then
3 15468 begin <* hængende spring *>
4 15469 if springtid(nr) <= nu then
4 15470 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15471 <* find frit løb *>
5 15472 disable
5 15473 begin
6 15474 id2:= 0;
6 15475 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15476 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15477 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15478 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15479 end;
5 15480 <* send meddelelse til io *>
5 15481 io_meddelelse(5,0,id2,nr);
5 15482
5 15482 <* annuler spring*>
5 15483 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15484 springtid(nr):= springstart(nr):= 0.0;
5 15485 end
4 15486 else
4 15487 begin <* forsøg igen *>
5 15488 \f
5 15488 message procedure vt_spring side 5 - 810525/cl;
5 15489
5 15489 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15490 if i = 2 <* første spring ej udført *> then
5 15491 begin
6 15492 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15493 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15494 id2:= id1;
6 15495 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15496 end
5 15497 else
5 15498 begin
6 15499 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15500 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15501 id2:= id1 shift (-7) shift 7
6 15502 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15503 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15504 end;
5 15505
5 15505 <* check resultat *>
5 15506 medd_kode:= if res = 3 and i = 2 then 7 else
5 15507 if res = 3 and i > 2 then 8 else
5 15508 <* if res = 9 then 1 else
5 15509 if res =12 then 2 else
5 15510 if res =14 then 4 else
5 15511 if res =18 then 3 else *>
5 15512 0;
5 15513 if medd_kode > 0 then
5 15514 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15515 id2 else id1,nr);
5 15516 if res = 3 then
5 15517 begin <* spring udført *>
6 15518 disable s:= modiffil(tf_springdef,nr,zi);
6 15519 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15520 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15521 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15522 if i > 2 then fil(zi).iaf(2+i-2):=
6 15523 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15524 end;
5 15525 end;
4 15526 end <* hængende spring *>
3 15527 else
3 15528 begin
4 15529 i:= spring_tabel(nr,3) shift (-12);
4 15530 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15531 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15532 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15533 + id1 shift (-7) shift 7;
4 15534 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15535 \f
4 15535 message procedure vt_spring side 6 - 820304/cl;
4 15536
4 15536 <* check resultat *>
4 15537 medd_kode:= if res = 3 then 8 else
4 15538 if res = 9 then 1 else
4 15539 if res =12 then 2 else
4 15540 if res =14 then 4 else
4 15541 if res =18 then 3 else
4 15542 if res =60 then 9 else 0;
4 15543 if medd_kode > 0 then
4 15544 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15545
4 15545 <* opdater springtabel *>
4 15546 disable s:= modiffil(tf_springdef,nr,zi);
4 15547 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15548 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15549 begin
5 15550 io_meddelelse(if res=3 then 6 else 5,0,
5 15551 if res=3 then id1 else id2,nr);
5 15552 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15553 springtid(nr):= springstart(nr):= 0.0;
5 15554 end
4 15555 else
4 15556 begin
5 15557 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15558 if res = 3 then
5 15559 begin
6 15560 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15561 (fil(zi).iaf(2+i-1) extract 22);
6 15562 fil(zi).iaf(2+i) := (1 shift 22) add
6 15563 (fil(zi).iaf(2+i) extract 22);
6 15564 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15565 end
5 15566 else
5 15567 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15568 end;
4 15569 end;
3 15570 <*+2*>
3 15571 <**> disable
3 15572 <**> if testbit44 and overvåget then
3 15573 <**> begin
4 15574 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15575 <**> p_springtabel(out); ud;
4 15576 <**> end;
3 15577 <*-2*>
3 15578
3 15578 nr:= nr +1;
3 15579 goto næste_sekv;
3 15580 \f
3 15580 message procedure vt_spring side 7 - 810506/cl;
3 15581
3 15581 afkod_operation:
3 15582 <*+2*>
3 15583 <**> disable
3 15584 <**> if testbit41 and overvåget then
3 15585 <**> begin
4 15586 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15587 <**> skriv_op(out,komm_op);
4 15588 <**> end;
3 15589 <*-2*>
3 15590
3 15590 disable
3 15591 begin integer opk;
4 15592
4 15592 opk:= d.komm_op.opkode extract 12;
4 15593 funk:= if opk = 30 <*sp,d*> then 5 else
4 15594 if opk = 31 <*sp. *> then 1 else
4 15595 if opk = 32 <*sp,v*> then 4 else
4 15596 if opk = 33 <*sp,o*> then 6 else
4 15597 if opk = 34 <*sp,r*> then 2 else
4 15598 if opk = 35 <*sp,a*> then 3 else
4 15599 0;
4 15600 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15601
4 15601 if funk <> 6 <*sp,o*> then
4 15602 begin <* find nr i springtabel *>
5 15603 nr:= 0;
5 15604 for i:= 1 step 1 until max_antal_spring do
5 15605 if springtabel(i,1) = d.komm_op.data(1) and
5 15606 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15607 end;
4 15608 end;
3 15609 if funk = 6 then goto oversigt;
3 15610 if funk = 5 then goto definer;
3 15611
3 15611 if nr = 0 then
3 15612 begin
4 15613 returner_op(komm_op,37<*spring ukendt*>);
4 15614 goto næste_tid;
4 15615 end;
3 15616
3 15616 goto case funk of(start,indsæt,annuler,vis);
3 15617 \f
3 15617 message procedure vt_spring side 8 - 810525/cl;
3 15618
3 15618 start:
3 15619 if springtabel(nr,3) shift (-12) <> 0 then
3 15620 begin returner_op(komm_op,38); goto næste_tid; end;
3 15621 disable
3 15622 begin <* find linie_løb_og_udtag *>
4 15623 s:= modif_fil(tf_springdef,nr,zi);
4 15624 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15625 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15626 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15627 id2:= 0;
4 15628 end;
3 15629 vt_operation(12,id1,id2,res,res_inf);
3 15630
3 15630 disable <* check resultat *>
3 15631 medd_kode:= if res = 3 <*ok*> then 7 else
3 15632 if res = 9 <*linie/løb ukendt*> then 1 else
3 15633 if res =14 <*optaget*> then 4 else
3 15634 if res =18 <*i kø*> then 3 else 0;
3 15635 returner_op(komm_op,3);
3 15636 if medd_kode = 0 then goto næste_tid;
3 15637
3 15637 <* send spring-meddelelse til io *>
3 15638 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15639
3 15639 <* opdater springtabel *>
3 15640 disable
3 15641 begin
4 15642 s:= modif_fil(tf_springdef,nr,zi);
4 15643 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15644 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15645 add (springtabel(nr,3) extract 12);
4 15646 systime(1,0.0,nu);
4 15647 springstart(nr):= nu;
4 15648 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15649 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15650 end;
3 15651 <*+2*>
3 15652 <**> disable
3 15653 <**> if testbit44 and overvåget then
3 15654 <**> begin
4 15655 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15656 <**> p_springtabel(out); ud;
4 15657 <**> end;
3 15658 <*-2*>
3 15659
3 15659 goto næste_tid;
3 15660 \f
3 15660 message procedure vt_spring side 9 - 810506/cl;
3 15661
3 15661 indsæt:
3 15662 if springtabel(nr,3) shift (-12) = 0 then
3 15663 begin <* ikke igangsat *>
4 15664 returner_op(komm_op,41);
4 15665 goto næste_tid;
4 15666 end;
3 15667 <* find frie linie/løb *>
3 15668 disable
3 15669 begin
4 15670 s:= læs_fil(tf_springdef,nr,zi);
4 15671 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15672 id2:= 0;
4 15673 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15674 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15675 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15676 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15677 id1:= d.komm_op.data(3);
4 15678 end;
3 15679
3 15679 if id2<>0 then
3 15680 vt_operation(11,id1,id2,res,res_inf)
3 15681 else
3 15682 res:= 42;
3 15683
3 15683 disable <* check resultat *>
3 15684 medd_kode:= if res = 3 <*ok*> then 8 else
3 15685 if res =10 <*bus ukendt*> then 0 else
3 15686 if res =11 <*bus allerede indsat*> then 0 else
3 15687 if res =12 <*linie/løb allerede besat*> then 2 else
3 15688 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15689 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15690 returner_op(komm_op,res);
3 15691 if medd_kode = 0 then goto næste_tid;
3 15692
3 15692 <* send springmeddelelse til io *>
3 15693 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15694 io_meddelelse(5,0,0,nr);
3 15695 \f
3 15695 message procedure vt_spring side 9a - 810525/cl;
3 15696
3 15696 <* annuler springtabel *>
3 15697 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15698 springtid(nr):= springstart(nr):= 0.0;
3 15699 <*+2*>
3 15700 <**> disable
3 15701 <**> if testbit44 and overvåget then
3 15702 <**> begin
4 15703 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15704 <**> p_springtabel(out); ud;
4 15705 <**> end;
3 15706 <*-2*>
3 15707
3 15707 goto næste_tid;
3 15708 \f
3 15708 message procedure vt_spring side 10 - 810525/cl;
3 15709
3 15709 annuler:
3 15710 disable
3 15711 begin <* find evt. frit linie/løb *>
4 15712 s:= læs_fil(tf_springdef,nr,zi);
4 15713 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15714 id1:= id2:= 0;
4 15715 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15716 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15717 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15718 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15719 returner_op(komm_op,3);
4 15720 end;
3 15721
3 15721 <* send springmeddelelse til io *>
3 15722 io_meddelelse(5,id1,id2,nr);
3 15723
3 15723 <* annuler springtabel *>
3 15724 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15725 springtid(nr):= springstart(nr):= 0.0;
3 15726 <*+2*>
3 15727 <**> disable
3 15728 <**> if testbit44 and overvåget then
3 15729 <**> begin
4 15730 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15731 <**> p_springtabel(out); ud;
4 15732 <**> end;
3 15733 <*-2*>
3 15734
3 15734 goto næste_tid;
3 15735
3 15735 definer:
3 15736 if nr <> 0 then <* allerede defineret *>
3 15737 begin
4 15738 res:= 36;
4 15739 goto slut_definer;
4 15740 end;
3 15741
3 15741 <* find frit nr *>
3 15742 i:= 0;
3 15743 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15744 if springtabel(i,1) = 0 then nr:= i;
3 15745 if nr = 0 then
3 15746 begin
4 15747 res:= 32; <* ingen fri plads *>
4 15748 goto slut_definer;
4 15749 end;
3 15750 \f
3 15750 message procedure vt_spring side 11 - 810525/cl;
3 15751
3 15751 disable
3 15752 begin integer array fdim(1:8),ia(1:32);
4 15753 <* læs sekvens *>
4 15754 fdim(4):= d.komm_op.data(3);
4 15755 s:= hent_fil_dim(fdim);
4 15756 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15757 if fdim(1) > 30 then
4 15758 res:= 35 <* springsekvens for stor *>
4 15759 else
4 15760 begin
5 15761 for i:= 1 step 1 until fdim(1) do
5 15762 begin
6 15763 s:= læs_fil(fdim(4),i,zi);
6 15764 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15765 ia(i):= fil(zi).iaf(1) shift 12;
6 15766 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15767 end;
5 15768 s:= modif_fil(tf_springdef,nr,zi);
5 15769 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15770 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15771 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15772 iaf:= 4;
5 15773 tofrom(fil(zi).iaf,ia,60);
5 15774 iaf:= 0;
5 15775 springtabel(nr,3):= fdim(1);
5 15776 springtid(nr):= springstart(nr):= 0.0;
5 15777 res:= 3;
5 15778 end;
4 15779 end;
3 15780 \f
3 15780 message procedure vt_spring side 11a - 81-525/cl;
3 15781
3 15781 slut_definer:
3 15782
3 15782 <* slet fil *>
3 15783 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15784 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15785 signalch(cs_slet_fil,spr_op,vt_optype);
3 15786 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15787 if d.spr_op.data(9) <> 0 then
3 15788 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15789 returner_op(komm_op,res);
3 15790 <*+2*>
3 15791 <**> disable
3 15792 <**> if testbit44 and overvåget then
3 15793 <**> begin
4 15794 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15795 <**> p_springtabel(out); ud;
4 15796 <**> end;
3 15797 <*-2*>
3 15798 goto næste_tid;
3 15799 \f
3 15799 message procedure vt_spring side 12 - 810525/cl;
3 15800
3 15800 vis:
3 15801 disable
3 15802 begin
4 15803 <* tilknyt fil *>
4 15804 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15805 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15806 d.spr_op.data(2):= 1;
4 15807 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15808 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15809 signalch(cs_opret_fil,spr_op,vt_optype);
4 15810 end;
3 15811
3 15811 <* afvent svar *>
3 15812 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15813 if d.spr_op.data(9) <> 0 then
3 15814 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15815 disable
3 15816 begin integer array ia(1:30);
4 15817 s:= læs_fil(tf_springdef,nr,zi);
4 15818 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15819 iaf:= 4;
4 15820 tofrom(ia,fil(zi).iaf,60);
4 15821 iaf:= 0;
4 15822 for i:= 1 step 1 until d.spr_op.data(1) do
4 15823 begin
5 15824 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15825 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15826 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15827 ia(i) shift (-12) extract 7
5 15828 else -(ia(i) shift (-12) extract 7);
5 15829 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15830 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15831 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15832 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15833 else ia(i) extract 12)
5 15834 else 0;
5 15835 end;
4 15836 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15837 sæt_fil_dim(d.spr_op.data);
4 15838 d.komm_op.data(3):= d.spr_op.data(1);
4 15839 d.komm_op.data(4):= d.spr_op.data(4);
4 15840 raf:= data+8;
4 15841 d.komm_op.raf(1):= springstart(nr);
4 15842 returner_op(komm_op,3);
4 15843 end;
3 15844 goto næste_tid;
3 15845 \f
3 15845 message procedure vt_spring side 13 - 810525/cl;
3 15846
3 15846 oversigt:
3 15847 disable
3 15848 begin
4 15849 <* opret fil *>
4 15850 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15851 d.spr_op.data(1):= max_antal_spring;
4 15852 d.spr_op.data(2):= 4;
4 15853 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15854 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15855 signalch(cs_opret_fil,spr_op,vt_optype);
4 15856 end;
3 15857
3 15857 <* afvent svar *>
3 15858 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15859 if d.spr_op.data(9) <> 0 then
3 15860 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15861 disable
3 15862 begin
4 15863 nr:= 0;
4 15864 for i:= 1 step 1 until max_antal_spring do
4 15865 begin
5 15866 if springtabel(i,1) <> 0 then
5 15867 begin
6 15868 nr:= nr +1;
6 15869 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15870 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15871 fil(zi).iaf(1):= springtabel(i,1);
6 15872 fil(zi).iaf(2):= springtabel(i,2);
6 15873 fil(zi,2):= springstart(i);
6 15874 end;
5 15875 end;
4 15876 d.spr_op.data(1):= nr;
4 15877 s:= sæt_fil_dim(d.spr_op.data);
4 15878 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15879 d.komm_op.data(1):= nr;
4 15880 d.komm_op.data(2):= d.spr_op.data(4);
4 15881 returner_op(komm_op,3);
4 15882 end;
3 15883 goto næste_tid;
3 15884
3 15884 vt_spring_trap:
3 15885 disable skriv_vt_spring(zbillede,1);
3 15886
3 15886 end vt_spring;
2 15887 \f
2 15887 message procedure vt_auto side 1 - 810505/cl;
2 15888
2 15888 procedure vt_auto(cs_auto_retur,auto_opref);
2 15889 value cs_auto_retur,auto_opref;
2 15890 integer cs_auto_retur,auto_opref;
2 15891 begin
3 15892 integer array field op,auto_op,iaf;
3 15893 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15894 res_inf,i,s,zi,kl,døgnstart;
3 15895 real t,nu,næste_tid;
3 15896 boolean optaget;
3 15897 integer array filnavn,nytnavn(1:4);
3 15898
3 15898 procedure skriv_vt_auto(zud,omfang);
3 15899 value omfang;
3 15900 zone zud;
3 15901 integer omfang;
3 15902 begin
4 15903 long array field laf;
4 15904
4 15904 laf:= 0;
4 15905 write(zud,"nl",1,<:+++ vt_auto :>);
4 15906 if omfang<>0 then
4 15907 begin
5 15908 skriv_coru(zud,abs curr_coruno);
5 15909 write(zud,"nl",1,<<d>,
5 15910 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15911 <:op :>,op,"nl",1,
5 15912 <:auto-op :>,auto_op,"nl",1,
5 15913 <:filref :>,filref,"nl",1,
5 15914 <:id1 :>,id1,"nl",1,
5 15915 <:id2 :>,id2,"nl",1,
5 15916 <:aktion :>,aktion,"nl",1,
5 15917 <:postnr :>,postnr,"nl",1,
5 15918 <:sidste-post :>,sidste_post,"nl",1,
5 15919 <:interval :>,interval,"nl",1,
5 15920 <:res :>,res,"nl",1,
5 15921 <:res-inf :>,res_inf,"nl",1,
5 15922 <:i :>,i,"nl",1,
5 15923 <:s :>,s,"nl",1,
5 15924 <:zi :>,zi,"nl",1,
5 15925 <:kl :>,kl,"nl",1,
5 15926 <:døgnstart :>,døgnstart,"nl",1,
5 15927 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15928 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15929 <:nu :>,nu,"nl",1,
5 15930 <:næste-tid :>,næste_tid,"nl",1,
5 15931 <:filnavn :>,filnavn.laf,"nl",1,
5 15932 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15933 <::>);
5 15934 end;
4 15935 end skriv_vt_auto;
3 15936 \f
3 15936 message procedure vt_auto side 2 - 810507/cl;
3 15937
3 15937 iaf:= 0;
3 15938 auto_op:= auto_opref;
3 15939 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15940 optaget:= false;
3 15941 næste_tid:= 0.0;
3 15942 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15943 stack_claim(if cm_test then 298 else 246);
3 15944 trap(vt_auto_trap);
3 15945
3 15945 <*+2*>
3 15946 <**> disable if testbit47 and overvåget or testbit28 then
3 15947 <**> skriv_vt_auto(out,0);
3 15948 <*-2*>
3 15949
3 15949 vent:
3 15950
3 15950 systime(1,0.0,nu);
3 15951 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15952 if næste_tid > nu then round(næste_tid-nu) else
3 15953 if optaget then 5 else 0;
3 15954 if interval=0 then interval:= 1;
3 15955
3 15955 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15956
3 15956 if op<>0 then goto filskift;
3 15957
3 15957 <* vent på adgang til vogntabel *>
3 15958 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15959
3 15959 <* afsend relevant operation til opdatering af vogntabel *>
3 15960 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15961 d.op.data(1):= id1;
3 15962 d.op.data(2):= id2;
3 15963 signalch(cs_vt_opd,op,vt_optype);
3 15964 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15965 res:= d.op.resultat;
3 15966 id2:= d.op.data(2);
3 15967 res_inf:= d.op.data(3);
3 15968
3 15968 <* åbn for vogntabel *>
3 15969 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15970 \f
3 15970 message procedure vt_auto side 3 - 810507/cl;
3 15971
3 15971 <* behandl svar fra opdatering *>
3 15972 <*+2*>
3 15973 <**> disable
3 15974 <**> if testbit45 and overvåget then
3 15975 <**> begin
4 15976 <**> integer li,lø,bo;
4 15977 <**> skriv_vt_auto(out,0);
4 15978 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15979 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15980 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15981 <**> for i:= 1,2 do
4 15982 <**> begin
5 15983 <**> li:= d.op.data(i);
5 15984 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15985 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15986 <**> li:= li shift (-12) extract 10;
5 15987 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15988 <**> end;
4 15989 <**> systime(4,næste_tid,t);
4 15990 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15991 <**> << zd.dd>,t/10000,"nl",1);
4 15992 <**> end;
3 15993 <*-2*>
3 15994 if res=31 then
3 15995 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15996 else
3 15997 if res<>3 then
3 15998 begin
4 15999 if -, optaget then
4 16000 begin
5 16001 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 16002 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 16003 if res=18 then 3 else if res=60 then 9 else 4;
5 16004 d.auto_op.data(2):= res_inf;
5 16005 d.auto_op.data(3):= if res=12 then id2 else id1;
5 16006 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16007 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 16008 end;
4 16009 if res=14 or res=18 then <* i kø eller optaget *>
4 16010 begin
5 16011 optaget:= true;
5 16012 goto vent;
5 16013 end;
4 16014 end;
3 16015 optaget:= false;
3 16016 \f
3 16016 message procedure vt_auto side 4 - 810507/cl;
3 16017
3 16017 <* find næste post *>
3 16018 disable
3 16019 begin
4 16020 if postnr=sidste_post then
4 16021 begin <* døgnskift *>
5 16022 postnr:= 1;
5 16023 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16024 end
4 16025 else postnr:= postnr+1;
4 16026 s:= læsfil(filref,postnr,zi);
4 16027 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 16028 aktion:= fil(zi).iaf(1);
4 16029 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 16030 id1:= fil(zi).iaf(3);
4 16031 id2:= fil(zi).iaf(4);
4 16032 end;
3 16033 goto vent;
3 16034 \f
3 16034 message procedure vt_auto side 5 - 810507/cl;
3 16035
3 16035 filskift:
3 16036
3 16036 <*+2*>
3 16037 <**> disable
3 16038 <**> if testbit41 and overvåget then
3 16039 <**> begin
4 16040 <**> skriv_vt_auto(out,0);
4 16041 <**> write(out,<: modtaget operation::>);
4 16042 <**> skriv_op(out,op);
4 16043 <**> end;
3 16044 <*-2*>
3 16045 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 16046 res:= 46;
3 16047 if d.op.opkode extract 12 <> 21 then
3 16048 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 16049 if filref = 0 then goto knyt;
3 16050
3 16050 <* gem filnavn til io-meddelelse *>
3 16051 disable begin
4 16052 integer array fdim(1:8);
4 16053 integer array field navn;
4 16054 fdim(4):= filref;
4 16055 hentfildim(fdim);
4 16056 navn:= 8;
4 16057 tofrom(filnavn,fdim.navn,8);
4 16058 end;
3 16059
3 16059 <* frivgiv tilknyttet autofil *>
3 16060 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 16061 d.auto_op.data(4):= filref;
3 16062 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 16063 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 16064 if d.auto_op.data(9) <> 0 then
3 16065 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 16066 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 16067 optaget:= false;
3 16068 næste_tid:= 0.0;
3 16069 res:= 3;
3 16070 \f
3 16070 message procedure vt_auto side 6 - 810507/cl;
3 16071
3 16071 <* tilknyt evt. ny autofil *>
3 16072 knyt:
3 16073 if d.op.data(1)<>0 then
3 16074 begin
4 16075 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 16076 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 16077 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 16078 disable
4 16079 begin integer pos1,pos2;
5 16080 pos1:= pos2:= 13;
5 16081 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 16082 begin
6 16083 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 16084 skrivtegn(d.auto_op.data,pos2,i);
6 16085 end;
5 16086 end;
4 16087 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 16088 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 16089 s:= d.auto_op.data(9);
4 16090 if s=0 then res:= 3 <* ok *> else
4 16091 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 16092 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 16093 if s=6 then res:= 48 <* i brug *> else
4 16094 fejlreaktion(14,2,<:auto,filskift:>,0);
4 16095 if res<>3 then goto returner;
4 16096
4 16096 tofrom(nytnavn,d.op.data,8);
4 16097
4 16097 <* find første post *>
4 16098 disable
4 16099 begin
5 16100 døgnstart:= systime(5,0.0,t);
5 16101 kl:= round t;
5 16102 filref:= d.auto_op.data(4);
5 16103 sidste_post:= d.auto_op.data(1);
5 16104 postnr:= 0;
5 16105 for postnr:= postnr+1 while postnr <= sidste_post do
5 16106 begin
6 16107 s:= læsfil(filref,postnr,zi);
6 16108 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 16109 if fil(zi).iaf(2) > kl then goto post_fundet;
6 16110 end;
5 16111 postnr:= 1;
5 16112 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16113 \f
5 16113 message procedure vt_auto side 7 - 810507/cl;
5 16114
5 16114 post_fundet:
5 16115 s:= læsfil(filref,postnr,zi);
5 16116 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 16117 aktion:= fil(zi).iaf(1);
5 16118 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 16119 id1:= fil(zi).iaf(3);
5 16120 id2:= fil(zi).iaf(4);
5 16121 res:= 3;
5 16122 end;
4 16123 end ny fil;
3 16124
3 16124 returner:
3 16125 d.op.resultat:= res;
3 16126 <*+2*>
3 16127 <**> disable
3 16128 <**> if testbit41 and overvåget then
3 16129 <**> begin
4 16130 <**> skriv_vt_auto(out,0);
4 16131 <**> write(out,<: returner operation::>);
4 16132 <**> skriv_op(out,op);
4 16133 <**> end;
3 16134 <*-2*>
3 16135 signalch(d.op.retur,op,d.op.optype);
3 16136
3 16136 if vt_log_aktiv then
3 16137 begin
4 16138 waitch(cs_vt_logpool,op,vt_optype,-1);
4 16139 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 16140 if nytnavn(1)=0 then
4 16141 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 16142 else
4 16143 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 16144 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 16145 systime(1,0.0,d.op.data.v_tid);
4 16146 signalch(cs_vt_log,op,vt_optype);
4 16147 end;
3 16148
3 16148 if filnavn(1)<>0 then
3 16149 begin <* meddelelse til io om annulering *>
4 16150 disable begin
5 16151 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 16152 i:= 1;
5 16153 hægtstring(d.auto_op.data,i,<:auto :>);
5 16154 skriv_text(d.auto_op.data,i,filnavn);
5 16155 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 16156 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 16157 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16158 end;
4 16159 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 16160 end;
3 16161 goto vent;
3 16162
3 16162 vt_auto_trap:
3 16163 disable skriv_vt_auto(zbillede,1);
3 16164
3 16164 end vt_auto;
2 16165 message procedure vt_log side 1 - 920517/cl;
2 16166
2 16166 procedure vt_log;
2 16167 begin
3 16168 integer i,j,ventetid;
3 16169 real dg,t,nu,skiftetid;
3 16170 boolean fil_åben;
3 16171 integer array ia(1:10),dp,dp1(1:8);
3 16172 integer array field op, iaf;
3 16173
3 16173 procedure skriv_vt_log(zud,omfang);
3 16174 value omfang;
3 16175 zone zud;
3 16176 integer omfang;
3 16177 begin
4 16178 write(zud,"nl",1,<:+++ vt-log :>);
4 16179 if omfang<>0 then
4 16180 begin
5 16181 skriv_coru(zud, abs curr_coruno);
5 16182 write(zud,"nl",1,<<d>,
5 16183 <:i :>,i,"nl",1,
5 16184 <:j :>,j,"nl",1,
5 16185 <:ventetid :>,ventetid,"nl",1,
5 16186 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 16187 <:t :>,t,"nl",1,
5 16188 <:nu :>,nu,"nl",1,
5 16189 <:skiftetid :>,skiftetid,"nl",1,
5 16190 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 16191 <:op :>,<<d>,op,"nl",1,
5 16192 <::>);
5 16193 raf:= 0;
5 16194 write(zud,"nl",1,<:ia::>);
5 16195 skrivhele(zud,ia.raf,20,2);
5 16196 write(zud,"nl",2,<:dp::>);
5 16197 skrivhele(zud,dp.raf,16,2);
5 16198 write(zud,"nl",2,<:dp1::>);
5 16199 skrivhele(zud,dp1.raf,16,2);
5 16200 end;
4 16201 end;
3 16202
3 16202 message procedure vt_log side 2 - 920517/cl;
3 16203
3 16203 procedure slet_fil;
3 16204 begin
4 16205 integer segm,res;
4 16206 integer array tail(1:10);
4 16207
4 16207 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 16208 if res=0 then
4 16209 begin
5 16210 segm:= tail(10);
5 16211 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 16212 if res=0 then
5 16213 begin
6 16214 close(zvtlog,true);
6 16215 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 16216 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16217 if res=0 then
6 16218 begin
7 16219 tail(1):= tail(1)+segm;
7 16220 monitor(44)change_entry:(zvtlog,0,tail);
7 16221 end;
6 16222 end;
5 16223 end;
4 16224 end;
3 16225
3 16225 boolean procedure udvid_fil;
3 16226 begin
4 16227 integer res,spos;
4 16228 integer array tail(1:10);
4 16229 zone z(1,1,stderror);
4 16230
4 16230 udvid_fil:= false;
4 16231 open(z,0,<:vtlogpool:>,0); close(z,true);
4 16232 res:= monitor(42)lookup_entry:(z,0,tail);
4 16233 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 16234 begin
5 16235 tail(1):=tail(1) - vt_log_slicelgd;
5 16236 res:=monitor(44)change_entry:(z,0,tail);
5 16237 if res=0 then
5 16238 begin
6 16239 spos:= vt_logtail(1);
6 16240 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 16241 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 16242 if res<>0 then
6 16243 begin
7 16244 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 16245 tail(1):= tail(1) + vt_log_slicelgd;
7 16246 monitor(44)change_entry:(z,0,tail);
7 16247 end
6 16248 else
6 16249 begin
7 16250 setposition(zvtlog,0,spos);
7 16251 udvid_fil:= true;
7 16252 end;
6 16253 end;
5 16254 end;
4 16255 end;
3 16256
3 16256 message procedure vt_log side 3 - 920517/cl;
3 16257
3 16257 boolean procedure ny_fil;
3 16258 begin
4 16259 integer res,i,j;
4 16260 integer array nyt(1:4), ia,tail(1:10);
4 16261 long array field navn;
4 16262 real t;
4 16263
4 16263 navn:=0;
4 16264 if fil_åben then
4 16265 begin
5 16266 close(zvtlog,true);
5 16267 fil_åben:= false;
5 16268 nyt.navn(1):= long<:vtlo:>;
5 16269 nyt.navn(2):= long<::>;
5 16270 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 16271 j:= 'a' - 1;
5 16272 repeat
5 16273 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 16274 if res=3 then
5 16275 begin
6 16276 j:= j+1;
6 16277 if j <= 'å' then skrivtegn(nyt,11,j);
6 16278 end;
5 16279 until (res<>3) or (j > 'å');
5 16280
5 16280 if res=0 then
5 16281 begin
6 16282 open(zvtlog,4,<:vtlogklar:>,0);
6 16283 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16284 if res=0 then
6 16285 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 16286 if res=0 then
6 16287 begin
7 16288 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 16289 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 16290 end;
6 16291
6 16291 if res=0 then
6 16292 begin
7 16293 setposition(zvtlog,0,tail(10)//64);
7 16294 navn:= (tail(10) mod 64)*8;
7 16295 if (tail(1) <= tail(10)//64) then
7 16296 outrec6(zvtlog,512)
7 16297 else
7 16298 swoprec6(zvtlog,512);
7 16299 tofrom(zvtlog.navn,nyt,8);
7 16300 tail(10):= tail(10)+1;
7 16301 setposition(zvtlog,0,tail(10)//64);
7 16302 monitor(44)change_entry:(zvtlog,0,tail);
7 16303 close(zvtlog,true);
7 16304 end
6 16305 else
6 16306 begin
7 16307 navn:= 0;
7 16308 close(zvtlog,true);
7 16309 open(zvtlog,4,<:vtlog:>,0);
7 16310 slet_fil;
7 16311 end;
6 16312 end
5 16313 else
5 16314 slet_fil;
5 16315 end;
4 16316
4 16316 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 16317 <* eller den er blevet slettet. *>
4 16318
4 16318 open(zvtlog,4,<:vtlog:>,0);
4 16319 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 16320 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 16321 vt_logtail(6):= systime(7,0,t);
4 16322
4 16322 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 16323 if res=0 then
4 16324 begin
5 16325 monitor(50)permanent_entry:(zvtlog,3,ia);
5 16326 if res<>0 then
5 16327 monitor(48)remove_entry:(zvtlog,0,ia);
5 16328 end;
4 16329
4 16329 if res=0 then fil_åben:= true;
4 16330
4 16330 ny_fil:= fil_åben;
4 16331 end ny_fil;
3 16332
3 16332 message procedure vt_log side 4 - 920517/cl;
3 16333
3 16333 procedure skriv_post(logpost);
3 16334 integer array logpost;
3 16335 begin
4 16336 integer array field post;
4 16337 real t;
4 16338
4 16338 if vt_logtail(10)//32 < vt_logtail(1) then
4 16339 begin
5 16340 outrec6(zvtlog,512);
5 16341 post:= (vt_logtail(10) mod 32)*16;
5 16342 tofrom(zvtlog.post,logpost,16);
5 16343 vt_logtail(10):= vt_logtail(10)+1;
5 16344 setposition(zvtlog,0,vt_logtail(10)//32);
5 16345 vt_logtail(6):= systime(7,0,t);
5 16346 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 16347 end;
4 16348 end;
3 16349
3 16349 procedure sletsendte;
3 16350 begin
4 16351 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 16352 integer array pooltail,tail,ia(1:10);
4 16353 integer i,res;
4 16354
4 16354 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 16355 res:=monitor(42,zpool,0,pooltail);
4 16356
4 16356 open(z,4,<:vtlogslet:>,0);
4 16357 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 16358 begin
5 16359 if monitor(52,z,0,tail)=0 then
5 16360 begin
6 16361 if monitor(8,z,0,tail)=0 then
6 16362 begin
7 16363 for i:=1 step 1 until tail(10) do
7 16364 begin
8 16365 inrec6(z,8);
8 16366 open(zlog,0,z,0); close(zlog,true);
8 16367 if monitor(42,zlog,0,ia)=0 then
8 16368 begin
9 16369 if monitor(48,zlog,0,ia)=0 then
9 16370 begin
10 16371 pooltail(1):=pooltail(1)+ia(1);
10 16372 end;
9 16373 end;
8 16374 end;
7 16375 tail(10):=0;
7 16376 monitor(44,z,0,tail);
7 16377 end
6 16378 else
6 16379 monitor(64,z,0,tail);
6 16380 end;
5 16381 if res=0 then monitor(44,zpool,0,pooltail);
5 16382 end;
4 16383 close(z,true);
4 16384 end;
3 16385
3 16385 message procedure vt_log side 5 - 920517/cl;
3 16386
3 16386 trap(vt_log_trap);
3 16387 stack_claim(200);
3 16388
3 16388 fil_åben:= false;
3 16389 if -, vt_log_aktiv then goto init_slut;
3 16390 open(zvtlog,4,<:vtlog:>,0);
3 16391 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16392 if i=0 then
3 16393 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16394 if i=0 then
3 16395 begin
4 16396 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16397 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16398 end;
3 16399
3 16399 if (i=0) and (vt_logtail(1)=0) then
3 16400 begin
4 16401 close(zvtlog,true);
4 16402 monitor(48)remove_entry:(zvtlog,0,ia);
4 16403 i:= 1;
4 16404 end;
3 16405
3 16405 disable
3 16406 if i=0 then
3 16407 begin
4 16408 fil_åben:= true;
4 16409 inrec6(zvtlog,512);
4 16410 vt_logstart:= zvtlog.v_tid;
4 16411 systime(1,0.0,nu);
4 16412 if (nu - vt_logstart) < 24*60*60.0 then
4 16413 begin
5 16414 setposition(zvtlog,0,vt_logtail(10)//32);
5 16415 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16416 begin
6 16417 inrec6(zvtlog,512);
6 16418 setposition(zvtlog,0,vt_logtail(10)//32);
6 16419 end;
5 16420 end
4 16421 else
4 16422 begin
5 16423 if ny_fil then
5 16424 begin
6 16425 if udvid_fil then
6 16426 begin
7 16427 systime(1,0.0,dp.v_tid);
7 16428 vt_logstart:= dp.v_tid;
7 16429 dp.v_kode:=0;
7 16430 skriv_post(dp);
7 16431 end
6 16432 else
6 16433 begin
7 16434 close(zvtlog,true);
7 16435 monitor(48)remove_entry:(zvtlog,0,ia);
7 16436 fil_åben:= false;
7 16437 end;
6 16438 end;
5 16439 end;
4 16440 end
3 16441 else
3 16442 begin
4 16443 close(zvtlog,true);
4 16444 if ny_fil then
4 16445 begin
5 16446 if udvid_fil then
5 16447 begin
6 16448 systime(1,0.0,dp.v_tid);
6 16449 vt_logstart:= dp.v_tid;
6 16450 dp.v_kode:=0;
6 16451 skriv_post(dp);
6 16452 end
5 16453 else
5 16454 begin
6 16455 close(zvtlog,true);
6 16456 monitor(48)remove_entry:(zvtlog,0,ia);
6 16457 fil_åben:= false;
6 16458 end;
5 16459 end;
4 16460 end;
3 16461
3 16461 init_slut:
3 16462
3 16462 dg:= systime(5,0,t);
3 16463 if t < vt_logskift then
3 16464 skiftetid:= systid(dg,vt_logskift)
3 16465 else
3 16466 skiftetid:= systid(dg+1,vt_logskift);
3 16467
3 16467 message procedure vt_log side 6 - 920517/cl;
3 16468
3 16468 vent:
3 16469
3 16469 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16470 ventetid:= round(skiftetid - nu);
3 16471 if ventetid < 1 then ventetid:= 1;
3 16472
3 16472 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16473
3 16473 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16474 if op <> 0 then
3 16475 begin
4 16476 tofrom(dp,d.op.data,16);
4 16477 signalch(cs_vt_logpool,op,vt_optype);
4 16478 end;
3 16479
3 16479 if -, vt_log_aktiv then goto vent;
3 16480
3 16480 disable if (op=0) or (nu > skiftetid) then
3 16481 begin
4 16482 if fil_åben then
4 16483 begin
5 16484 dp1.v_tid:= systid(dg,vt_logskift);
5 16485 dp1.v_kode:= 1;
5 16486 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16487 begin
6 16488 if udvid_fil then
6 16489 skriv_post(dp1);
6 16490 end
5 16491 else
5 16492 skriv_post(dp1);
5 16493 end;
4 16494
4 16494 if (op=0) or (nu > skiftetid) then
4 16495 skiftetid:= skiftetid + 24*60*60.0;
4 16496
4 16496 sletsendte;
4 16497
4 16497 if ny_fil then
4 16498 begin
5 16499 if udvid_fil then
5 16500 begin
6 16501 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16502 dp1.v_kode:= 0;
6 16503 skriv_post(dp1);
6 16504 end
5 16505 else
5 16506 begin
6 16507 close(zvtlog,true);
6 16508 monitor(48)remove_entry:(zvtlog,0,ia);
6 16509 fil_åben:= false;
6 16510 end;
5 16511 end;
4 16512 end;
3 16513
3 16513 disable if op<>0 and fil_åben then
3 16514 begin
4 16515 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16516 begin
5 16517 if -, udvid_fil then
5 16518 begin
6 16519 if ny_fil then
6 16520 begin
7 16521 if udvid_fil then
7 16522 begin
8 16523 systime(1,0.0,dp1.v_tid);
8 16524 vt_logstart:= dp1.v_tid;
8 16525 dp1.v_kode:= 0;
8 16526 skriv_post(dp1);
8 16527 end
7 16528 else
7 16529 begin
8 16530 close(zvtlog,true);
8 16531 monitor(48)remove_entry:(zvtlog,0,ia);
8 16532 fil_åben:= false;
8 16533 end;
7 16534 end;
6 16535 end;
5 16536 end;
4 16537
4 16537 if fil_åben then skriv_post(dp);
4 16538 end;
3 16539
3 16539 goto vent;
3 16540
3 16540 vt_log_trap:
3 16541 disable skriv_vt_log(zbillede,1);
3 16542 end vt_log;
2 16543 \f
2 16543
2 16543 algol list.off;
2 16544 message coroutinemonitor - 11 ;
2 16545
2 16545
2 16545 <*************** coroutine monitor procedures ***************>
2 16546
2 16546
2 16546 <***** delay *****
2 16547
2 16547 this procedure links the calling coroutine into the timerqueue and sets
2 16548 the timeout value to 'timeout'. *>
2 16549
2 16549
2 16549 procedure delay (timeout);
2 16550 value timeout;
2 16551 integer timeout;
2 16552 begin
3 16553 link(current, idlequeue);
3 16554 link(current + corutimerchain, timerqueue);
3 16555 d.current.corutimer:= timeout;
3 16556
3 16556
3 16556 passivate;
3 16557 d.current.corutimer:= 0;
3 16558 end;
2 16559 \f
2 16559
2 16559 message coroutinemonitor - 12 ;
2 16560
2 16560
2 16560 <***** pass *****
2 16561
2 16561 this procedure moves the calling coroutine from the head of the ready
2 16562 queue down below all coroutines of lower or equal priority. *>
2 16563
2 16563
2 16563 procedure pass;
2 16564 begin
3 16565 linkprio(current, readyqueue);
3 16566
3 16566
3 16566 passivate;
3 16567 end;
2 16568
2 16568
2 16568 <***** signal ****
2 16569
2 16569 this procedure increases the value af 'semaphore' by 1.
2 16570 in case some coroutine is already waiting, it is linked into the ready
2 16571 queue for activation. the calling coroutine continues execution. *>
2 16572
2 16572
2 16572 procedure signal (semaphore);
2 16573 value semaphore;
2 16574 integer semaphore;
2 16575 begin
3 16576 integer array field sem;
3 16577 sem:= semaphore;
3 16578 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16579 d.sem.simvalue:= d.sem.simvalue + 1;
3 16580
3 16580
3 16580 end;
2 16581 \f
2 16581
2 16581 message coroutinemonitor - 13 ;
2 16582
2 16582
2 16582 <***** wait *****
2 16583
2 16583 this procedure decreases the value of 'semaphore' by 1.
2 16584 in case the value of the semaphore is negative after the decrease, the
2 16585 calling coroutine is linked into the semaphore queue waiting for a
2 16586 coroutine to signal this semaphore. *>
2 16587
2 16587
2 16587 procedure wait (semaphore);
2 16588 value semaphore;
2 16589 integer semaphore;
2 16590 begin
3 16591 integer array field sem;
3 16592 sem:= semaphore;
3 16593 d.sem.simvalue:= d.sem.simvalue - 1;
3 16594
3 16594
3 16594 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16595 passivate;
3 16596 end;
2 16597 \f
2 16597
2 16597 message coroutinemonitor - 14 ;
2 16598
2 16598
2 16598 <***** inspect *****
2 16599
2 16599 this procedure inspects the value of the semaphore and returns it in
2 16600 'elements'.
2 16601 the semaphore is left unchanged. *>
2 16602
2 16602
2 16602 procedure inspect (semaphore, elements);
2 16603 value semaphore;
2 16604 integer semaphore, elements;
2 16605 begin
3 16606 integer array field sem;
3 16607 sem:= semaphore;
3 16608 elements:= d.sem.simvalue;
3 16609
3 16609
3 16609 end;
2 16610 \f
2 16610
2 16610 message coroutinemonitor - 15 ;
2 16611
2 16611
2 16611 <***** signalch *****
2 16612
2 16612 this procedure delivers an operation at 'semaphore'.
2 16613 in case another coroutine is already waiting for an operation of the
2 16614 kind 'operationtype' this coroutine will get the operation and it will
2 16615 be put into the ready queue for activation.
2 16616 in case no coroutine is waiting for the actial kind of operation it is
2 16617 linked into the semaphore queue, at the end of the queue
2 16618 if operation is positive and at the beginning if operation is negative.
2 16619 the calling coroutine continues execution. *>
2 16620
2 16620
2 16620 procedure signalch (semaphore, operation, operationtype);
2 16621 value semaphore, operation, operationtype;
2 16622 integer semaphore, operation;
2 16623 boolean operationtype;
2 16624 begin
3 16625 integer array field firstcoru, currcoru, op,currop;
3 16626 op:= abs operation;
3 16627 d.op.optype:= operationtype;
3 16628 firstcoru:= semaphore + semcoru;
3 16629 currcoru:= d.firstcoru.next;
3 16630 while currcoru <> firstcoru do
3 16631 begin
4 16632 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16633 begin
5 16634 link(operation, 0);
5 16635 d.currcoru.coruop:= operation;
5 16636 linkprio(currcoru, readyqueue);
5 16637 link(currcoru + corutimerchain, idlequeue);
5 16638 goto exit;
5 16639 end else currcoru:= d.currcoru.next;
4 16640 end;
3 16641 currop:=semaphore + semop;
3 16642 if operation < 0 then currop:=d.currop.next;
3 16643 link(op, currop);
3 16644 exit:
3 16645
3 16645
3 16645 end;
2 16646 \f
2 16646
2 16646 message coroutinemonitor - 16 ;
2 16647
2 16647
2 16647 <***** waitch *****
2 16648
2 16648 this procedure fetches an operation from a semaphore.
2 16649 in case an operation matching 'operationtypeset' is already waiting at
2 16650 'semaphore' it is handed over to the calling coroutine.
2 16651 in case no matching operation is waiting, the calling coroutine is
2 16652 linked to the semaphore.
2 16653 in any case the calling coroutine will be stopped and all corouti-
2 16654 nes are rescheduled. *>
2 16655
2 16655
2 16655 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16656 value semaphore, operationtypeset, timeout;
2 16657 integer semaphore, operation, timeout;
2 16658 boolean operationtypeset;
2 16659 begin
3 16660 integer array field firstop, currop;
3 16661 firstop:= semaphore + semop;
3 16662 currop:= d.firstop.next;
3 16663
3 16663
3 16663 while currop <> firstop do
3 16664 begin
4 16665 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16666 begin
5 16667 link(currop, 0);
5 16668 d.current.coruop:= currop;
5 16669 operation:= currop;
5 16670 \f
5 16670
5 16670 message coroutinemonitor - 17 ;
5 16671
5 16671 linkprio(current, readyqueue);
5 16672 passivate;
5 16673 goto exit;
5 16674 end else currop:= d.currop.next;
4 16675 end;
3 16676 linkprio(current, semaphore + semcoru);
3 16677 if timeout > 0 then
3 16678 begin
4 16679 link(current + corutimerchain, timerqueue);
4 16680 d.current.corutimer:= timeout;
4 16681 end else d.current.corutimer:= 0;
3 16682 d.current.corutypeset:= operationtypeset;
3 16683 passivate;
3 16684 if d.current.corutimer < 0 then operation:= 0
3 16685 else operation:= d.current.coruop;
3 16686 d.current.corutimer:= 0;
3 16687 currop:= operation;
3 16688 d.current.coruop:= currop;
3 16689 link(current+corutimerchain, idlequeue);
3 16690 exit:
3 16691
3 16691
3 16691 end;
2 16692 \f
2 16692
2 16692 message coroutinemonitor - 18 ;
2 16693
2 16693
2 16693 <***** inspectch *****
2 16694
2 16694 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16695 the number of matching operations are counted and delivered in 'elements'.
2 16696 if no operations are found the number of coroutines waiting
2 16697 for operations of the typeset are counted and delivered as
2 16698 negative value in 'elements'.
2 16699 the semaphore is left unchanged. *>
2 16700
2 16700
2 16700 procedure inspectch (semaphore, operationtypeset, elements);
2 16701 value semaphore, operationtypeset;
2 16702 integer semaphore, elements;
2 16703 boolean operationtypeset;
2 16704 begin
3 16705 integer array field firstop, currop,firstcoru,currcoru;
3 16706 integer counter;
3 16707 counter:= 0;
3 16708 firstop:= semaphore + semop;
3 16709 currop:= d.firstop.next;
3 16710 while currop <> firstop do
3 16711 begin
4 16712 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16713 counter:= counter + 1;
4 16714 currop:= d.currop.next;
4 16715 end;
3 16716 if counter=0 then
3 16717 begin
4 16718 firstcoru:=semaphore + sem_coru;
4 16719 curr_coru:=d.firstcoru.next;
4 16720 while curr_coru<>first_coru do
4 16721 begin
5 16722 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16723 counter:=counter - 1;
5 16724 curr_coru:=d.curr_coru.next;
5 16725 end;
4 16726 end;
3 16727 elements:= counter;
3 16728
3 16728
3 16728 end;
2 16729 \f
2 16729
2 16729 message coroutinemonitor - 19 ;
2 16730
2 16730
2 16730 <***** csendmessage *****
2 16731
2 16731 this procedure sends the message in 'mess' to the process defined by the name
2 16732 in 'receiver', and returns an identification of the message extension used
2 16733 for sending the message (this identification is to be used for calling 'cwait-
2 16734 answer' or 'cregretmessage'. *>
2 16735
2 16735
2 16735 procedure csendmessage (receiver, mess, messextension);
2 16736 real array receiver;
2 16737 integer array mess;
2 16738 integer messextension;
2 16739 begin
3 16740 integer bufref, messext;
3 16741 messref(maxmessext):= 0;
3 16742 messext:= 1;
3 16743 while messref(messext) <> 0 do messext:= messext + 1;
3 16744 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16745 begin
4 16746 messcode(messext):= 1 shift 12 add 2;
4 16747 mon(16) send message :(0, mess, 0, receiver);
4 16748 messref(messext):= monw2;
4 16749 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16750 end;
3 16751
3 16751
3 16751 end;
2 16752 \f
2 16752
2 16752 message coroutinemonitor - 20 ;
2 16753
2 16753
2 16753 <***** cwaitanswer *****
2 16754
2 16754 this procedure asks the coroutine monitor to get an answer to the message
2 16755 corresponding to 'messextension'. in case the answer has already arrived
2 16756 it stays in the eventqueue until 'cwaitanswer' is called.
2 16757 in case 'timeout' is positive, the coroutine is linked into the timer
2 16758 queue, and in case the answer does not arrive within 'timout' seconds the
2 16759 coroutine is restarted with result = 0. *>
2 16760
2 16760
2 16760 procedure cwaitanswer (messextension, answer, result, timeout);
2 16761 value messextension, timeout;
2 16762 integer messextension, result, timeout;
2 16763 integer array answer;
2 16764 begin
3 16765 integer messext;
3 16766 messext:= messextension;
3 16767 messcode(messext):= messcode(messext) extract 12;
3 16768 link(current, idlequeue);
3 16769 messop(messext):= current;
3 16770 if timeout > 0 then
3 16771 begin
4 16772 link(current + corutimerchain, timerqueue);
4 16773 d.current.corutimer:= timeout;
4 16774 end else d.current.corutimer:= 0;
3 16775
3 16775
3 16775 passivate;
3 16776 if d.current.corutimer < 0 then result:= 0 else
3 16777 begin
4 16778 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16779 result:= monw0;
4 16780 baseevent:= 0;
4 16781 messref(messextension):= 0;
4 16782 end;
3 16783 d.current.corutimer:= 0;
3 16784 link(current+corutimerchain, idlequeue);
3 16785 end;
2 16786 \f
2 16786
2 16786 message coroutinemonitor - 21 ;
2 16787
2 16787
2 16787 <***** cwaitmessage *****
2 16788
2 16788 this procedure asks the coroutine monitor to give it a message, when some-
2 16789 one arrives. in case a message has arrived already it stays at the event queue
2 16790 until 'cwaitmessage' is called.
2 16791 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16792 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16793 with messbufferref = 0. *>
2 16794
2 16794
2 16794 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16795 value timeout, processextension;
2 16796 integer processextension, messbufferref, timeout;
2 16797 integer array mess;
2 16798 begin
3 16799 integer i;
3 16800 integer array field messbuf;
3 16801 proccode(processextension):= 2;
3 16802 procop(processextension):= current;
3 16803 link(current, idlequeue);
3 16804 if timeout > 0 then
3 16805 begin
4 16806 link(current + corutimerchain, timerqueue);
4 16807 d.current.corutimer:= timeout;
4 16808 end else d.current.corutimer:= 0;
3 16809
3 16809
3 16809 passivate;
3 16810 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16811 begin
4 16812 messbuf:= procop(processextension);
4 16813 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16814 proccode(procext):= 1 shift 12;
4 16815 messbufferref:= messbuf;
4 16816 baseevent:= 0;
4 16817 end;
3 16818 d.current.corutimer:= 0;
3 16819 link(current+corutimerchain, idlequeue);
3 16820 end;
2 16821 \f
2 16821
2 16821 message coroutinemonitor - 22 ;
2 16822
2 16822
2 16822 <***** cregretmessage *****
2 16823
2 16823 this procedure regrets the message corresponding to messageexten-
2 16824 sion, to release message buffer and message extension.
2 16825 i/o messages are not regretable. *>
2 16826
2 16826
2 16826
2 16826 procedure cregretmessage (messageextension);
2 16827 value messageextension;
2 16828 integer messageextension;
2 16829 begin
3 16830 integer array field messbuf;
3 16831 messbuf:= messref(messageextension);
3 16832 mon(82) regret message :(0, 0, messbuf, 0);
3 16833 messref(messageextension):= 0;
3 16834
3 16834
3 16834 end;
2 16835 \f
2 16835
2 16835 message coroutinemonitor - 23 ;
2 16836
2 16836
2 16836 <***** semsendmessage *****
2 16837
2 16837 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16838 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16839 by the monitor, when the answer arrives.
2 16840 in case there are too few resources to send the message, the operation is
2 16841 returned immediately with the result field set to zero. *>
2 16842
2 16842
2 16842 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16843 value semaphore, operation, operationtype;
2 16844 real array receiver;
2 16845 integer array mess;
2 16846 integer semaphore, operation;
2 16847 boolean operationtype;
2 16848 begin
3 16849 integer array field op;
3 16850 integer messext;
3 16851 op:= operation;
3 16852 messref(maxmessext):= 0;
3 16853 messext:= 1;
3 16854 while messref(messext) <> 0 do messext:= messext + 1;
3 16855 if messext < maxmessext then
3 16856 begin
4 16857 messop(messext):= op;
4 16858 messcode(messext):=1;
4 16859 d.op(1):= semaphore;
4 16860 d.op.optype:= operationtype;
4 16861 mon(16) send message :(0, mess, 0, receiver);
4 16862 messref(messext):= monw2;
4 16863 end;
3 16864
3 16864
3 16864 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16865 begin <* return the operation immediately with result = 0 *>
4 16866 d.op(9):= 0;
4 16867 signalch(semaphore, op, operationtype);
4 16868 end;
3 16869 end;
2 16870 \f
2 16870
2 16870 message coroutinemonitor - 24 ;
2 16871
2 16871
2 16871 <***** semwaitmessage *****
2 16872
2 16872 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16873 be performed by the coroutine monitor when a message arrives to the process
2 16874 corresponding to 'processextension'. *>
2 16875
2 16875
2 16875 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16876 value processextension, semaphore, operation, operationtype;
2 16877 integer processextension, semaphore, operation;
2 16878 boolean operationtype;
2 16879 begin
3 16880 integer array field op;
3 16881 op:= operation;
3 16882 procop(processextension):= operation;
3 16883 d.op(1):= semaphore;
3 16884 d.op.optype:= operationtype;
3 16885 proccode(processextension):= 1;
3 16886
3 16886
3 16886 end;
2 16887 \f
2 16887
2 16887 message coroutinemonitor - 25 ;
2 16888
2 16888
2 16888 <***** semregretmessage *****
2 16889
2 16889 this procedure regrets a message sent by semsendmessage.
2 16890 the message is identified by the operation in which the answer should be
2 16891 returned.
2 16892 the procedure sets the result field of the operation to zero, and then
2 16893 returns it by performing a signalch. *>
2 16894
2 16894
2 16894 procedure semregretmessage (operation);
2 16895 value operation;
2 16896 integer operation;
2 16897 begin
3 16898 integer i, j;
3 16899 integer array field op, sem;
3 16900 op:= operation;
3 16901 i:= 1;
3 16902 while i < maxmessext do
3 16903 begin
4 16904 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16905 begin
5 16906 mon(82) regret message :(0, 0, messref(i), 0);
5 16907 messref(i):= 0;
5 16908 sem:= d.op(1);
5 16909 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16910 signalch(sem, op, d.op.optype);
5 16911 i:= maxmessext;
5 16912 end;
4 16913 i:= i + 1;
4 16914 end;
3 16915
3 16915
3 16915 end;
2 16916 \f
2 16916
2 16916 message coroutinemonitor - 26 ;
2 16917
2 16917
2 16917 <***** link *****
2 16918
2 16918 this procedure links an object (allocated in the descriptor array 'd') into
2 16919 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16920 are all double chained, and the chainhead is of the same format as the chain
2 16921 fields of the objects.
2 16922 the procedure links the object immediately after the head. *>
2 16923
2 16923
2 16923 procedure link (object, chainhead);
2 16924 value object, chainhead;
2 16925 integer object, chainhead;
2 16926 begin
3 16927 integer array field prevelement, nextelement, chead, obj;
3 16928 obj:= object;
3 16929 chead:= chainhead;
3 16930 prevelement:= d.obj.prev;
3 16931 nextelement:= d.obj.next;
3 16932 d.prevelement.next:= nextelement;
3 16933 d.nextelement.prev:= prevelement;
3 16934 if chead > 0 then <* link into queue *>
3 16935 begin
4 16936 prevelement:= d.chead.prev;
4 16937 d.obj.prev:= prevelement;
4 16938 d.prevelement.next:= obj;
4 16939 d.obj.next:= chead;
4 16940 d.chead.prev:= obj;
4 16941 end else
3 16942 begin <* link onto itself *>
4 16943 d.obj.prev:= obj;
4 16944 d.obj.next:= obj;
4 16945 end;
3 16946 end;
2 16947 \f
2 16947
2 16947 message coroutinemonitor - 27 ;
2 16948
2 16948
2 16948 <***** linkprio *****
2 16949
2 16949 this procedure is used to link coroutines into queues corresponding to
2 16950 the priorities of the actual coroutine and the queue elements.
2 16951 the object is linked immediately before the first coroutine of lower prio-
2 16952 rity. *>
2 16953
2 16953
2 16953 procedure linkprio (object, chainhead);
2 16954 value object, chainhead;
2 16955 integer object, chainhead;
2 16956 begin
3 16957 integer array field currelement, chead, obj;
3 16958 obj:= object;
3 16959 chead:= chainhead;
3 16960 currelement:= d.chead.next;
3 16961 while currelement <> chead
3 16962 and d.currelement.corupriority <= d.obj.corupriority
3 16963 do currelement:= d.currelement.next;
3 16964 link(obj, currelement);
3 16965 end;
2 16966 \f
2 16966
2 16966 message coroutinemonitor - 28 ;
2 16967
2 16967 \f
2 16967
2 16967 message coroutinemonitor - 30a ;
2 16968
2 16968
2 16968 <*************** extention to coroutine monitor procedures **********>
2 16969
2 16969 <***** signalbin *****
2 16970
2 16970 this procedure simulates a binary semaphore on a simple semaphore
2 16971 by testing the value of the semaphore before signaling the
2 16972 semaphore. if the value of the semaphore is one (=open) nothing is
2 16973 done, otherwise a normal signal is carried out. *>
2 16974
2 16974
2 16974 procedure signalbin(semaphore);
2 16975 value semaphore;
2 16976 integer semaphore;
2 16977 begin
3 16978 integer array field sem;
3 16979 integer val;
3 16980 sem:= semaphore;
3 16981 inspect(sem,val);
3 16982 if val<1 then signal(sem);
3 16983 end;
2 16984 \f
2 16984
2 16984 message coroutinemonitor - 30b ;
2 16985
2 16985 <***** coruno *****
2 16986
2 16986 delivers the coroutinenumber for a give coroutine id.
2 16987 if the coroutine does not exists the value 0 is delivered *>
2 16988
2 16988 integer procedure coru_no(coru_id);
2 16989 value coru_id;
2 16990 integer coru_id;
2 16991 begin
3 16992 integer array field cor;
3 16993
3 16993 coru_no:= 0;
3 16994 for cor:= firstcoru step corusize until (coruref-1) do
3 16995 if d.cor.coruident//1000 = coru_id then
3 16996 coru_no:= d.cor.coruident mod 1000;
3 16997 end;
2 16998 \f
2 16998
2 16998 message coroutinemonitor - 30c ;
2 16999
2 16999 <***** coroutine *****
2 17000
2 17000 delivers the referencebyte for the coroutinedescriptor for
2 17001 a coroutine identified by coroutinenumber *>
2 17002
2 17002 integer procedure coroutine(cor_no);
2 17003 value cor_no;
2 17004 integer cor_no;
2 17005 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 17006 firstcoru + (cor_no-1)*corusize;
2 17007 \f
2 17007
2 17007 message coroutinemonitor - 30d ;
2 17008
2 17008 <***** curr_coruno *****
2 17009
2 17009 delivers number of calling coroutine
2 17010 curr_coruno:
2 17011 < 0 = -current_coroutine_number in disabled mode
2 17012 = 0 = procedure not called from coroutine
2 17013 > 0 = current_coroutine_number in enabled mode *>
2 17014
2 17014 integer procedure curr_coruno;
2 17015 begin
3 17016 integer i;
3 17017 integer array ia(1:12);
3 17018
3 17018 i:= system(12,0,ia);
3 17019 if i > 0 then
3 17020 begin
4 17021 i:= system(12,1,ia);
4 17022 curr_coruno:= ia(3);
4 17023 end else curr_coruno:= 0;
3 17024 end curr_coruno;
2 17025 \f
2 17025
2 17025 message coroutinemonitor - 30e ;
2 17026
2 17026 <***** curr_coruid *****
2 17027
2 17027 delivers coruident of calling coroutine :
2 17028
2 17028 curr_coruid:
2 17029 > 0 = coruident of calling coroutine
2 17030 = 0 = procedure not called from coroutine *>
2 17031
2 17031 integer procedure curr_coruid;
2 17032 begin
3 17033 integer cor_no;
3 17034 integer array field cor;
3 17035
3 17035 cor_no:= abs curr_coruno;
3 17036 if cor_no <> 0 then
3 17037 begin
4 17038 cor:= coroutine(cor_no);
4 17039 curr_coruid:= d.cor.coruident // 1000;
4 17040 end
3 17041 else curr_coruid:= 0;
3 17042 end curr_coruid;
2 17043 \f
2 17043 message coroutinemonitor - 30f.1 ;
2 17044
2 17044 <**** getch *****
2 17045
2 17045 this procedure searches the queue of operations waiting at 'semaphore'
2 17046 to find an operation that matches the operationstypeset and a set of
2 17047 select-values. each select value is specified by type and fieldvalue
2 17048 in integer array 'type' and by the value in integer array 'val'.
2 17049
2 17049 0: eq 0: not used
2 17050 1: lt 1: boolean
2 17051 2: le 2: integer
2 17052 3: gt 3: long
2 17053 4: ge 4: real
2 17054 5: ne
2 17055 *>
2 17056
2 17056 procedure getch(semaphore,operation,operationtypeset,type,val);
2 17057 value semaphore,operationtypeset;
2 17058 integer semaphore,operation;
2 17059 boolean operationtypeset;
2 17060 integer array type,val;
2 17061 begin
3 17062 integer array field firstop,currop;
3 17063 integer ø,n,i,f,t,rel,i1,i2;
3 17064 boolean field bf,bfval;
3 17065 integer field intf;
3 17066 long field lf,lfval; long l1,l2;
3 17067 real field rf,rfval; real r1,r2;
3 17068
3 17068 boolean match;
3 17069
3 17069 operation:= 0;
3 17070 n:= system(3,ø,type);
3 17071 match:= false;
3 17072 firstop:= semaphore + semop;
3 17073 currop:= d.firstop.next;
3 17074 while currop <> firstop and -,match do
3 17075 begin
4 17076 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 17077 begin
5 17078 i:= n;
5 17079 match:= true;
5 17080 \f
5 17080 message coroutinemonitor - 30f.2 ;
5 17081
5 17081 while match and (if i <= ø then type(i) >= 0 else false) do
5 17082 begin
6 17083 rel:= type(i) shift(-18);
6 17084 t:= type(i) shift(-12) extract 6;
6 17085 f:= type(i) extract 12;
6 17086 if f > 2047 then f:= f -4096;
6 17087 case t+1 of
6 17088 begin
7 17089 ; <* not used *>
7 17090
7 17090 begin <*boolean or signed short integer*>
8 17091 bf:= f;
8 17092 bfval:= 2*i;
8 17093 i1:= d.currop.bf extract 12;
8 17094 if i1 > 2047 then i1:= i1-4096;
8 17095 i2:= val.bfval extract 12;
8 17096 if i2 > 2047 then i2:= i2-4096;
8 17097 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17098 end;
7 17099
7 17099 begin <*integer*>
8 17100 intf:= f;
8 17101 i1:= d.currop.intf;
8 17102 i2:= val(i);
8 17103 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17104 end;
7 17105
7 17105 begin <*long*>
8 17106 lf:= f;
8 17107 lfval:= i*2;
8 17108 l1:= d.currop.lf;
8 17109 l2:= val.lfval;
8 17110 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 17111 end;
7 17112
7 17112 begin <*real*>
8 17113 rf:= f;
8 17114 rfval:= i*2;
8 17115 r1:= d.currop.rf;
8 17116 r2:= val.rfval;
8 17117 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 17118 end;
7 17119
7 17119 end;<*case t+1*>
6 17120
6 17120 i:= i+1;
6 17121 end; <*while match and i<=ø and t>=0 *>
5 17122 \f
5 17122 message coroutinemonitor - 30f.3 ;
5 17123
5 17123 end; <* if operationtypeset and ---*>
4 17124 if -,match then currop:= d.currop.next;
4 17125 end; <*while currop <> firstop and -,match*>
3 17126
3 17126 if match then
3 17127 begin
4 17128 link(currop,0);
4 17129 d.current.coruop:= currop;
4 17130 operation:= currop;
4 17131 end;
3 17132 end getch;
2 17133 \f
2 17133
2 17133 message coroutinemonitor - 31 ;
2 17134
2 17134 activity(maxcoru);
2 17135
2 17135 goto initialization;
2 17136
2 17136
2 17136
2 17136 <*************** event handling ***************>
2 17137
2 17137
2 17137
2 17137 takeexternal:
2 17138 currevent:= baseevent;
2 17139 eventqueueempty:= false;
2 17140 repeat
2 17141 current:= 0;
2 17142 prevevent:= currevent;
2 17143 mon(66) test event :(0, 0, currevent, 0);
2 17144 currevent:= monw2;
2 17145 if monw0 < 0 <* no event *> then goto takeinternal;
2 17146 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 17147 cmi:= monw1
2 17148 else
2 17149 cmi:= - monw0;
2 17150
2 17150 if cmi > 0 then
2 17151 begin <* answer to activity zone *>
3 17152 current:= firstcoru + (cmi - 1) * corusize;
3 17153 linkprio(current, readyqueue);
3 17154 baseevent:= 0;
3 17155 end else
2 17156
2 17156 if cmi = 0 then
2 17157 begin <* message arrived *>
3 17158 \f
3 17158
3 17158 message coroutinemonitor - 32 ;
3 17159
3 17159 receiver:= core.currevent(3);
3 17160 if receiver < 0 then receiver:= - receiver;
3 17161 procref(maxprocext):= receiver;
3 17162 procext:= 1;
3 17163 while procref(procext) <> receiver do procext:= procext + 1;
3 17164 if procext = maxprocext then
3 17165 begin <* receiver unknown *>
4 17166 <* leave the message unchanged *>
4 17167 end else
3 17168 if proccode(procext) shift (-12) = 0 then
3 17169 begin <* the receiver is ready for accepting messages *>
4 17170 mon(26) get event :(0, 0, currevent, 0);
4 17171 case proccode(procext) of
4 17172 begin
5 17173 begin <* message received by semwaitmessage *>
6 17174 op:= procop(procext);
6 17175 sem:= d.op(1);
6 17176 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 17177 d.op(9):= currevent;
6 17178 signalch(sem, op, d.op.optype);
6 17179 proccode(procext):= 1 shift 12;
6 17180 end;
5 17181 begin <* message received by cwaitmessage *>
6 17182 current:= procop(procext);
6 17183 procop(procext):= currevent;
6 17184 linkprio(current, readyqueue);
6 17185 link(current + corutimerchain, idlequeue);
6 17186
6 17186
6 17186 end;
5 17187 end; <* case *>
4 17188 currevent:= baseevent;
4 17189 proccode(procext):= 1 shift 12;
4 17190 end;
3 17191 end <* message *> else
2 17192
2 17192 if cmi = -1 then
2 17193 begin <* answer arrived *>
3 17194 \f
3 17194
3 17194 message coroutinemonitor - 33 ;
3 17195
3 17195 if currevent = timermessage then
3 17196 begin
4 17197 mon(26) get event :(0, 0, currevent, 0);
4 17198 coru:= d.timerqueue.next;
4 17199 while coru <> timerqueue do
4 17200 begin
5 17201 current:= coru - corutimerchain;
5 17202 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 17203 coru:= d.coru.next;
5 17204 if d.current.corutimer <= 0 then
5 17205 begin <* timer perion expired *>
6 17206 d.current.corutimer:= -1;
6 17207 linkprio(current, readyqueue);
6 17208 link(current + corutimerchain, idlequeue);
6 17209 end;
5 17210 end;
4 17211 mon(16) send message :(0, clockmess, 0, clock);
4 17212 timermessage:= monw2;
4 17213 currevent:= baseevent;
4 17214 end <* timer answer *> else
3 17215 begin
4 17216 messref(maxmessext):= currevent;
4 17217 messext:= 1;
4 17218 while messref(messext) <> currevent do messext:= messext + 1;
4 17219 if messext = maxmessext then
4 17220 begin <* the answer is unknown *>
5 17221 <* leave the answer unchanged - it may belong to an activity *>
5 17222 end else
4 17223 if messcode(messext) shift (-12) = 0 then
4 17224 begin
5 17225 case messcode(messext) extract 12 of
5 17226 begin
6 17227 \f
6 17227
6 17227 message coroutinemonitor - 34 ;
6 17228 begin <* answer arrived after semsendmessage *>
7 17229 op:= messop(messext);
7 17230 sem:= d.op(1);
7 17231 mon(18) wait answer :(0, d.op, currevent, 0);
7 17232 d.op(9):= monw0;
7 17233 signalch(sem, op, d.op.optype);
7 17234 messref(messext):= 0;
7 17235 baseevent:= 0;
7 17236 end;
6 17237 begin <* answer arrived after csendmessage *>
7 17238 current:= messop(messext);
7 17239 linkprio(current, readyqueue);
7 17240 link(current + corutimerchain, idlequeue);
7 17241
7 17241
7 17241 end;
6 17242 end;
5 17243 end else baseevent:= currevent;
4 17244 end;
3 17245 end;
2 17246 until eventqueueempty;
2 17247 \f
2 17247
2 17247 message coroutinemonitor - 35 ;
2 17248
2 17248
2 17248
2 17248 <*************** coroutine activation ***************>
2 17249
2 17249 takeinternal:
2 17250
2 17250 current:= d.readyqueue.next;
2 17251 if current = readyqueue then
2 17252 begin
3 17253 mon(24) wait event :(0, 0, prevevent, 0);
3 17254 goto takeexternal;
3 17255 end;
2 17256
2 17256 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17257 <**> begin
3 17258 <**> systime(5,0,r);
3 17259 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17260 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17261 <**> d.current.coruident//1000,<: aktiveres:>);
3 17262 <**> end;
2 17263 <*-2*>
2 17264
2 17264 corustate:= activate(d.current.coruident mod 1000);
2 17265 cmi:= corustate extract 24;
2 17266 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17267 <**> begin
3 17268 <**> systime(5,0,r);
3 17269 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17270 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17271 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 17272 <**> end;
2 17273 <*-2*>
2 17274
2 17274 if cmi = 1 then
2 17275 begin <* programmed passivate *>
3 17276 goto takeexternal;
3 17277 end;
2 17278
2 17278 if cmi = 2 then
2 17279 begin <* implicit passivate in activity *>
3 17280
3 17280
3 17280 link(current, idlequeue);
3 17281 goto takeexternal;
3 17282 end;
2 17283 \f
2 17283
2 17283 message coroutinemonitor - 36 ;
2 17284
2 17284 <* coroutine termination (normal or abnormal) *>
2 17285
2 17285 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 17286 coru_term:
2 17287
2 17287 begin
3 17288 if false and alarmcause extract 24 = (-9) <* break *> and
3 17289 alarmcause shift (-24) extract 24 = 0 then
3 17290 begin
4 17291 endaction:= 2;
4 17292 goto program_slut;
4 17293 end;
3 17294 if alarmcause extract 24 = (-9) <* break *> and
3 17295 alarmcause shift (-24) = 8 <* parent *>
3 17296 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 17297 if alarmcause shift (-24) extract 24 <> -2 or
3 17298 alarmcause extract 24 <> -13 then
3 17299 begin
4 17300 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 17301 alarmcause shift (-24),<:,:>,
4 17302 alarmcause extract 24);
4 17303 for i:=1 step 1 until max_coru do
4 17304 j:=activate(-i); <* kill *>
4 17305 <* skriv billede *>
4 17306 end
3 17307 else
3 17308 begin
4 17309 errorbits:= 0; <* ok.yes warning.no *>
4 17310 goto finale;
4 17311 end;
3 17312 end;
2 17313
2 17313 goto dump;
2 17314
2 17314 link(current, idlequeue);
2 17315 goto takeexternal;
2 17316 \f
2 17316
2 17316 message coroutinemonitor - 37 ;
2 17317
2 17317
2 17317
2 17317 initialization:
2 17318
2 17318
2 17318 <*************** initialization ***************>
2 17319
2 17319 <* chain head *>
2 17320
2 17320 prev:= -2; <* -2 prev *>
2 17321 next:= 0; <* +0 next *>
2 17322
2 17322 <* corutine descriptor *>
2 17323
2 17323 <* -2 prev *>
2 17324 <* +0 next *>
2 17325 <* +2 (link field) *>
2 17326 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 17327 <* +6 (link field) *>
2 17328 coruop:= corutimerchain + 4; <* +8 coruop *>
2 17329 corutimer:= coruop + 2; <*+10 corutimer *>
2 17330 coruident:= corutimer + 2; <*+12 coruident *>
2 17331 corupriority:= coruident + 2; <*+14 corupriority *>
2 17332 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 17333 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 17334
2 17334 <* simple semaphore *>
2 17335
2 17335 <* -2 (link field) *>
2 17336 simcoru:= next; <* +0 simcoru *>
2 17337 simvalue:= simcoru + 2; <* +2 simvalue *>
2 17338
2 17338 <* chained semaphore *>
2 17339
2 17339 <* -2 (link field) *>
2 17340 semcoru:= next; <* +0 semcoru *>
2 17341 <* +2 (link field) *>
2 17342 semop:= semcoru + 4; <* +4 semop *>
2 17343 \f
2 17343
2 17343 message coroutinemonitor - 38 ;
2 17344
2 17344 <* operation *>
2 17345
2 17345 opsize:= next - 6; <* -6 opsize *>
2 17346 optype:= opsize + 1; <* -5 optype *>
2 17347 <* -2 prev *>
2 17348 <* +0 next *>
2 17349 <* +2 operation(1) *>
2 17350 <* +4 operation(2) *>
2 17351 <* +6 - *>
2 17352 <* . - *>
2 17353 <* . - *>
2 17354
2 17354 \f
2 17354
2 17354 message coroutinemonitor - 39 ;
2 17355
2 17355 trap(dump);
2 17356 systime(1, 0, starttime);
2 17357 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 17358 clockmess(1):= 0;
2 17359 clockmess(2):= timeinterval;
2 17360 clock(1):= real <:clock:>;
2 17361 clock(2):= real <::>;
2 17362 mon(16) send message :(0, clockmess, 0, clock);
2 17363 timermessage:= monw2;
2 17364 readyqueue:= 4;
2 17365 initchain(readyqueue);
2 17366 idlequeue:= readyqueue + 4;
2 17367 initchain(idlequeue);
2 17368 timerqueue:= idlequeue + 4;
2 17369 initchain(timerqueue);
2 17370 current:= 0;
2 17371 corucount:= 0;
2 17372 proccount:= 0;
2 17373 baseevent:= 0;
2 17374 coruref:= timerqueue + 4;
2 17375 firstcoru:= coruref;
2 17376 simref:= coruref + maxcoru * corusize;
2 17377 firstsim:= simref;
2 17378 semref:= simref + maxsem * simsize;
2 17379 firstsem:= semref;
2 17380 opref:= semref + maxsemch * semsize + 4;
2 17381 firstop:= opref;
2 17382 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 17383 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 17384 reflectcore(core);
2 17385
2 17385 algol list.on;
2 17386
2 17386 \f
2 17386 message sys_initialisering side 1 - 810601/hko;
2 17387
2 17387 trapmode:= 1 shift 15;
2 17388 errorbits:= 1; <* warning.no ok.no *>
2 17389 trap(coru_term);
2 17390
2 17390 open(zbillede,4,<:billede:>,0);
2 17391 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17392 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17393 system(2,0,ia);
2 17394 open(zdummy,4,ia,0); close(zdummy,false);
2 17395 monitor(42,zdummy,0,ia);
2 17396 laf:= 0;
2 17397 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17398 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17399 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17400
2 17400 open(zrl,4,<:radiolog:>,0);
2 17401 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17402 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17403 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17404 begin
3 17405 ia(1):=1; ia(2):= 3;
3 17406 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17407 monitor(40)create_area:(zrl,0,ia);
3 17408 end;
2 17409
2 17409 for i:=1 step 1 until max_antal_fejltekster do
2 17410 fejltekst(i):= real (case i of (
2 17411 <* 1*><:filsystem:>,
2 17412 <* 2*><:operationskode:>,
2 17413 <* 3*><:programfejl:>,
2 17414 <* 4*><:monitor<'_'>resultat=:>,
2 17415 <* 5*><:læs<'_'>fil:>,
2 17416 <* 6*><:skriv<'_'>fil:>,
2 17417 <* 7*><:modif<'_'>fil:>,
2 17418 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17419 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17420 <*10*><:vogntabel:>,
2 17421 <*11*><:fremmed operation:>,
2 17422 <*12*><:operationstype:>,
2 17423 <*13*><:opret<'_'>fil:>,
2 17424 <*14*><:tilknyt<'_'>fil:>,
2 17425 <*15*><:frigiv<'_'>fil:>,
2 17426 <*16*><:slet<'_'>fil:>,
2 17427 <*17*><:ydre enhed, status=:>,
2 17428 <*18*><:tabelfil:>,
2 17429 <*19*><:radio:>,
2 17430 <*20*><:mobilopkald, bus:>,
2 17431 <*21*><:talevejsswitch:>,
2 17432 <*99*><:ftslut:>));
2 17433
2 17433 for i:= 1 step 1 until max_antal_områder do
2 17434 begin
3 17435 område_navn(i):= long (case i of
3 17436 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17437 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17438 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17439 område_id(i,2):=
3 17440 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17441 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17442 end;
2 17443
2 17443 pabx_id(1):= -1;
2 17444 pabx_id(2):= 1;
2 17445
2 17445 for i:= 1 step 1 until max_antal_radiokanaler do
2 17446 begin
3 17447 radio_id(i):=
3 17448 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17449 end;
2 17450
2 17450 for i:=1 step 1 until max_antal_kanaler do
2 17451 begin
3 17452 kanal_navn(i):= long (case i of (
3 17453 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17454 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17455 kanal_id(i):=
3 17456 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17457 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17458 end;
2 17459
2 17459 for i:= 1 step 1 until op_maske_lgd//2 do
2 17460 ingen_operatører(i):= alle_operatører(i):= 0;
2 17461 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17462 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17463
2 17463 begin
3 17464 long array navn(1:2);
3 17465 long array field doc, ref;
3 17466
3 17466 doc:= 2; iaf:= 0;
3 17467 movestring(navn,1,<:terminal0:>);
3 17468 for i:= 1 step 1 until max_antal_operatører do
3 17469 begin
4 17470 ref:=(i-1)*8; k:=9;
4 17471 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17472 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17473 open(zdummy,8,navn,0); close(zdummy,true);
4 17474 k:= monitor(42,zdummy,0,ia);
4 17475 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17476 else tofrom(terminal_navn.ref,navn,8);
4 17477 operatør_auto_include(i):= false;
4 17478 sætbit_ia(alle_operatører,i,1);
4 17479 end;
3 17480
3 17480 movestring(navn,1,<:garage0:>);
3 17481 for i:= 1 step 1 until max_antal_garageterminaler do
3 17482 begin
4 17483 ref:=(i-1)*8; k:=7;
4 17484 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17485 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17486 open(zdummy,8,navn,0); close(zdummy,true);
4 17487 k:= monitor(42,zdummy,0,ia);
4 17488 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17489 else tofrom(garage_terminal_navn.ref,navn,8);
4 17490 garage_auto_include(i):= false;
4 17491 end;
3 17492 end;
2 17493
2 17493 for i:= 1 step 1 until max_antal_taleveje do
2 17494 sætbit_ia(alle_taleveje,i,1);
2 17495 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17496 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17497 operatør_auto_include(ia(i)):= true;
2 17498 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17499 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17500 garage_auto_include(ia(i)):= true;
2 17501
2 17501
2 17501 \f
2 17501 message fil_init side 1 - 801030/jg;
2 17502
2 17502 begin integer i,antz,tz,s;
3 17503 real array field raf;
3 17504
3 17504 filskrevet:=fillæst:=0; <*fil*>
3 17505 dbsegmax:= 2**18-1;
3 17506
3 17506 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17507 for i:=1 step 1 until dbantez do
3 17508 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17509 for i:=dbantez+1 step 1 until tz do
3 17510 open(fil(i),4,dbsnavn,0);
3 17511 for i:=tz+1 step 1 until antz do
3 17512 open(fil(i),4,dbtnavn,0);
3 17513
3 17513 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17514 dbkatz(i,1):=dbkatz(i,2):=0;
3 17515 for i:=dbantez+1 step 1 until tz do
3 17516 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17517 for i:=tz+1 step 1 until antz do
3 17518 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17519 dbkatz(antz,2):=tz+1;
3 17520 dbsidstetz:=antz;
3 17521 dbsidstesz:=tz;
3 17522
3 17522 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17523 begin integer j;
4 17524 for j:=1,3 step 1 until 6 do
4 17525 dbkate(i,j):=0;
4 17526 dbkate(i,2):=i+1;
4 17527 end;
3 17528 dbkate(dbmaxef,2):=0;
3 17529 dbkatefri:=1;
3 17530 dbantef:=0;
3 17531 \f
3 17531 message fil_init side 2 - 801030/jg;
3 17532
3 17532
3 17532 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17533 begin
4 17534 dbkats(i,1):=0;
4 17535 dbkats(i,2):=i+1;
4 17536 end;
3 17537 dbkats(dbmaxsf,2):=0;
3 17538 dbkatsfri:=1;
3 17539 dbantsf:=0;
3 17540
3 17540 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17541 dbkatb(i):=false add (i+1);
3 17542 dbkatb(dbmaxb):=false;
3 17543 dbkatbfri:=1;
3 17544 dbantb:=0;
3 17545 raf:=4;
3 17546 for i:=1 step 1 until dbmaxtf do
3 17547 begin
4 17548 inrec6(fil(antz),4);
4 17549 dbkatt.raf(i):=fil(antz,1);
4 17550 end;
3 17551 inrec6(fil(antz),4);
3 17552 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17553 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17554 setposition(fil(antz),0,0);
3 17555
3 17555 end filsystem;
2 17556 \f
2 17556 message fil_init side 3 - 810209/cl;
2 17557
2 17557 bs_kats_fri:= nextsem;
2 17558 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17559 <*-3*>
2 17560 bs_kate_fri:= nextsem;
2 17561 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17562 <*-3*>
2 17563 cs_opret_fil:= nextsemch;
2 17564 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17565 <*-3*>
2 17566 cs_tilknyt_fil:= nextsemch;
2 17567 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17568 <*-3*>
2 17569 cs_frigiv_fil:= nextsemch;
2 17570 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17571 <*-3*>
2 17572 cs_slet_fil:= nextsemch;
2 17573 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17574 <*-3*>
2 17575 cs_opret_spoolfil:= nextsemch;
2 17576 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17577 <*-3*>
2 17578 cs_opret_eksternfil:= nextsemch;
2 17579 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17580 <*-3*>
2 17581 \f
2 17581 message fil_init side 4 810209/cl;
2 17582
2 17582
2 17582 <* initialisering af filsystemcoroutiner *>
2 17583
2 17583 i:= nextcoru(001,10,true);
2 17584 j:= newactivity(i,0,opretfil);
2 17585 <*+3*> skriv_newactivity(out,i,j);
2 17586 <*-3*>
2 17587
2 17587 i:= nextcoru(002,10,true);
2 17588 j:= newactivity(i,0,tilknytfil);
2 17589 <*+3*> skriv_newactivity(out,i,j);
2 17590 <*-3*>
2 17591
2 17591 i:= nextcoru(003,10,true);
2 17592 j:= newactivity(i,0,frigivfil);
2 17593 <*+3*> skriv_newactivity(out,i,j);
2 17594 <*-3*>
2 17595
2 17595 i:= nextcoru(004,10,true);
2 17596 j:= newactivity(i,0,sletfil);
2 17597 <*+3*> skriv_newactivity(out,i,j);
2 17598 <*-3*>
2 17599
2 17599 i:= nextcoru(005,10,true);
2 17600 j:= newactivity(i,0,opretspoolfil);
2 17601 <*+3*> skriv_newactivity(out,i,j);
2 17602 <*-3*>
2 17603
2 17603 i:= nextcoru(006,10,true);
2 17604 j:= newactivity(i,0,opreteksternfil);
2 17605 <*+3*> skriv_newactivity(out,i,j);
2 17606 <*-3*>
2 17607 \f
2 17607 message attention_initialisering side 1 - 850820/cl;
2 17608
2 17608 tf_kommandotabel:= 1 shift 10 + 1;
2 17609
2 17609 begin
3 17610 integer i, s, zno;
3 17611 zone z(128,1,stderror);
3 17612 integer array fdim(1:8);
3 17613
3 17613 fdim(4):= tf_kommandotabel;
3 17614 hentfildim(fdim);
3 17615
3 17615 open(z,4,<:htkommando:>,0);
3 17616 for i:= 1 step 1 until fdim(3) do
3 17617 begin
4 17618 inrec6(z,512);
4 17619 s:= skrivfil(tf_kommandotabel,i,zno);
4 17620 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17621 tofrom(fil(zno),z,512);
4 17622 end;
3 17623 close(z,true);
3 17624 end;
2 17625 \f
2 17625 message attention_initialisering side 1a - 810428/hko;
2 17626
2 17626 for j:= system(3,i,terminal_tab) step 1 until i do
2 17627 terminal_tab(j):= 0;
2 17628
2 17628 cs_att_pulje:=next_semch;
2 17629 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17630 <*-3*>
2 17631
2 17631 bs_fortsæt_adgang:= nextsem;
2 17632 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17633 <*-3*>
2 17634 signalbin(bs_fortsæt_adgang);
2 17635
2 17635 for i:= 1,
2 17636 1 step 1 until max_antal_operatører,
2 17637 1 step 1 until max_antal_garageterminaler do
2 17638
2 17638 <* initialisering af pulje med attention_operationer *>
2 17639
2 17639 signalch(cs_att_pulje, <* pulje_semafor *>
2 17640 nextop(data+att_op_længde), <* næste_operation *>
2 17641 gen_optype);
2 17642
2 17642 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17643
2 17643 i:=next_coru(010,<*ident*>
2 17644 2,<*prioritet*>
2 17645 true<*test_maske*>);
2 17646 j:=newactivity( i, <*activityno *>
2 17647 0, <*ikke virtual *>
2 17648 attention);<*ingen parametre*>
2 17649
2 17649 <*+3*>skriv_newactivity(out,i,j);
2 17650 <*-3*>
2 17651
2 17651 \f
2 17651 message io_initialisering side 1 - 810507/hko;
2 17652
2 17652 io_spoolfil:= 1028;
2 17653 begin
3 17654 integer array fdim(1:8);
3 17655 fdim(4):= io_spoolfil;
3 17656 hent_fildim(fdim);
3 17657 io_spool_postantal:= fdim(1);
3 17658 io_spool_postlængde:= fdim(2);
3 17659 end;
2 17660
2 17660 io_spool_post:= 4;
2 17661
2 17661 cs_io:= next_semch;
2 17662 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17663 <*-3*>
2 17664
2 17664 i:= next_coru(100,<*ident *>
2 17665 5,<*prioritet *>
2 17666 true<*test_maske*>);
2 17667
2 17667 j:= new_activity( i,
2 17668 0,
2 17669 h_io);
2 17670
2 17670 <*+3*>skriv_newactivity(out,i,j);
2 17671 <*-3*>
2 17672 cs_io_komm:= next_semch;
2 17673 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17674 <*-3*>
2 17675
2 17675 i:= next_coru(101,<*ident*>
2 17676 10,<*prioritet*>
2 17677 true <*testmaske*>);
2 17678 j:= new_activity( i,
2 17679 0,
2 17680 io_komm);<*ingen parametre*>
2 17681
2 17681 <*+3*>skriv_newactivity(out,i,j);
2 17682 <*-3*>
2 17683 \f
2 17683 message io_initialisering side 2 - 810520/hko/cl;
2 17684
2 17684 bs_zio_adgang:= next_sem;
2 17685 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17686 <*-3*>
2 17687 signal_bin(bs_zio_adgang);
2 17688
2 17688 cs_io_spool:= next_semch;
2 17689 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17690 <*-3*>
2 17691
2 17691 cs_io_fil:=next_semch;
2 17692 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17693 <*-3*>
2 17694 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17695
2 17695 ss_io_spool_fulde:= next_sem;
2 17696 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17697 <*-3*>
2 17698
2 17698 ss_io_spool_tomme:= next_sem;
2 17699 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17700 <*-3*>
2 17701 for i:= 1 step 1 until io_spool_postantal do
2 17702 signal(ss_io_spool_tomme);
2 17703 \f
2 17703 message io_initialisering side 3 - 880901/cl;
2 17704
2 17704 i:= next_coru(102,
2 17705 5,
2 17706 true);
2 17707 j:= new_activity(i,0,io_spool);
2 17708
2 17708 <*+3*>skriv_newactivity(out,i,j);
2 17709 <*-3*>
2 17710
2 17710 i:= next_coru(103,
2 17711 10,
2 17712 true);
2 17713 j:= new_activity(i,0,io_spon);
2 17714
2 17714 <*+3*>skriv_newactivity(out,i,j);
2 17715 <*-3*>
2 17716
2 17716 cs_io_medd:= next_semch;
2 17717 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17718 <*-3*>
2 17719
2 17719 i:= next_coru(104,<*ident *>
2 17720 10,<*prioritet *>
2 17721 true<*test_maske*>);
2 17722
2 17722 j:= new_activity( i,
2 17723 0,
2 17724 io_medd);
2 17725
2 17725 <*+3*>skriv_newactivity(out,i,j);
2 17726 <*-3*>
2 17727
2 17727 cs_io_nulstil:= next_semch;
2 17728 <*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
2 17729 <*-3*>
2 17730
2 17730 i:= next_coru(105,<*ident *>
2 17731 10,<*prioritet *>
2 17732 true<*test_maske*>);
2 17733
2 17733 j:= new_activity( i,
2 17734 0,
2 17735 io_nulstil_tællere);
2 17736
2 17736 <*+3*>skriv_newactivity(out,i,j);
2 17737 <*-3*>
2 17738
2 17738 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17739 i:= monitor(8)reserve process:(z_io,0,ia);
2 17740 if i <> 0 then
2 17741 begin
3 17742 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17743 end
2 17744 else
2 17745 begin
3 17746 ref:= 0;
3 17747 terminal_tab.ref.terminal_tilstand:= 0;
3 17748 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17749 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17750 "sp",1,"*",15,"nl",1);
3 17751 setposition(z_io,0,0);
3 17752 end;
2 17753 \f
2 17753 message operatør_initialisering side 1 - 810520/hko;
2 17754
2 17754 top_bpl_gruppe:= 64;
2 17755
2 17755 bpl_navn(0):= long<::>;
2 17756 for i:= 1 step 1 until 127 do
2 17757 begin
3 17758 k:= læsfil(tf_bpl_navne,i,j);
3 17759 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17760 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17761 if i<=max_antal_operatører then
3 17762 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17763 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17764 top_bpl_gruppe:= i;
3 17765 end;
2 17766
2 17766 for i:= 0 step 1 until 64 do
2 17767 begin
3 17768 iaf:= i*op_maske_lgd;
3 17769 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17770 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17771 if 1<=i and i<= max_antal_operatører then
3 17772 begin
4 17773 bpl_tilst(i,2):= 1;
4 17774 sætbit_ia(bpl_def.iaf,i,1);
4 17775 end;
3 17776 end;
2 17777 for i:= 65 step 1 until 127 do
2 17778 begin
3 17779 k:= læsfil(tf_bpl_def,i-64,j);
3 17780 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17781 iaf:= i*op_maske_lgd;
3 17782 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17783 bpl_tilst(i,1):= 0;
3 17784 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17785 end;
2 17786
2 17786 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17787 iaf:= 0;
2 17788 for i:= 1 step 1 until max_antal_operatører do
2 17789 begin
3 17790 k:= læsfil(tf_stoptabel,i,j);
3 17791 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17792 operatør_stop(i,0):= i;
3 17793 for k:= 1,2,3 do
3 17794 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17795 ant_i_opkø(i):= 0;
3 17796 end;
2 17797
2 17797 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17798 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17799 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17800 sidste_tv_brugt:= max_antal_taleveje;
2 17801
2 17801 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17802 opk_alarm(i):= 0;
2 17803 for i:= 1 step 1 until max_antal_operatører do
2 17804 begin
3 17805 integer array field tab;
3 17806
3 17806 k:= læsfil(tf_alarmlgd,i,j);
3 17807 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17808 tab:= (i-1)*opk_alarm_tab_lgd;
3 17809 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17810 opk_alarm.tab.alarm_start:= 0.0;
3 17811 end;
2 17812
2 17812 op_spool_kilde:= 2;
2 17813 op_spool_tid := 6;
2 17814 op_spool_text := 6;
2 17815 begin
3 17816 long array field laf1, laf2;
3 17817 laf2:= 4; laf1:= 0;
3 17818 op_spool_buf.laf1(1):= long<::>;
3 17819 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17820 op_spool_postantal*op_spool_postlgd-4);
3 17821 end;
2 17822
2 17822 k:=læsfil(1033,1,j);
2 17823 systime(1,0.0,r);
2 17824 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17825 for i:= 1 step 1 until max_cqf do
2 17826 begin
3 17827 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17828 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17829 cqf_tabel.ref.cqf_næste_tid:=
3 17830 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17831 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17832 end;
2 17833 op_cqf_tab_ændret:= true;
2 17834
2 17834 laf:= raf:= 0;
2 17835 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17836 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17837 j:= 1;
2 17838 if i<>0 then
2 17839 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17840 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17841 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17842 j:= 1;
2 17843 if i<>0 then
2 17844 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17845
2 17845 ia(1):= 3; <*canonical*>
2 17846 ia(2):= 0; <*no echo*>
2 17847 ia(3):= 0; <*prompt*>
2 17848 ia(4):= 2; <*timeout*>
2 17849 setcspterm(taleswitch_in_navn.laf,ia);
2 17850 setcspterm(taleswitch_out_navn.laf,ia);
2 17851
2 17851 cs_op:= next_semch;
2 17852
2 17852 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17853 <*-3*>
2 17854
2 17854 cs_op_retur:= next_semch;
2 17855
2 17855 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17856 <*-3*>
2 17857
2 17857 i:= nextcoru(200,<*ident*>
2 17858 10,<*prioitet*>
2 17859 true<*test_maske*>);
2 17860
2 17860 j:= new_activity( i,
2 17861 0,
2 17862 h_operatør);
2 17863
2 17863 <*+3*>skriv_newactivity(out,i,j);
2 17864 <*-3*>
2 17865 \f
2 17865 message operatør_initialisering side 2 - 810520/hko;
2 17866
2 17866 for k:= 1 step 1 until max_antal_operatører do
2 17867 begin
3 17868 ref:= (k-1)*8;
3 17869 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17870 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17871 ref:=k*terminal_beskr_længde;
3 17872 if i = 0 then
3 17873 begin
4 17874 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17875 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17876 end
3 17877 else
3 17878 begin
4 17879 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17880 end;
3 17881
3 17881 cs_operatør(k):= next_semch;
3 17882 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17883 <*-3*>
3 17884
3 17884 cs_op_fil(k):= nextsemch;
3 17885 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17886 <*-3*>
3 17887 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17888
3 17888 i:= next_coru(200+k,<*ident*>
3 17889 10,<*prioitet*>
3 17890 true<*testmaske*>);
3 17891 j:= new_activity( i,
3 17892 0,
3 17893 operatør,k);
3 17894
3 17894 <*+3*>skriv_newactivity(out,i,j);
3 17895 <*-3*>
3 17896 end;
2 17897
2 17897 cs_cqf:= next_semch;
2 17898 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17899 <*-3*>
2 17900
2 17900 signalch(cs_cqf,nextop(60),true);
2 17901
2 17901 i:= next_coru(292, <*ident*>
2 17902 10, <*prioritet*>
2 17903 true <*testmaske*>);
2 17904 j:= new_activity( i,
2 17905 0,
2 17906 op_cqftest);
2 17907 <*+3*>skriv_new_activity(out,i,j);
2 17908 <*-3*>
2 17909
2 17909 cs_op_spool:= next_semch;
2 17910 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17911 <*-3*>
2 17912
2 17912 cs_op_medd:= next_semch;
2 17913 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17914 <*-3*>
2 17915
2 17915 ss_op_spool_tomme:= next_sem;
2 17916 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17917 <*-3*>
2 17918 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17919
2 17919 ss_op_spool_fulde:= next_sem;
2 17920 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17921 <*-3*>
2 17922
2 17922 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17923
2 17923 i:= next_coru(293, <*ident*>
2 17924 10, <*prioritet*>
2 17925 true <*testmaske*>);
2 17926 j:= new_activity( i,
2 17927 0,
2 17928 op_spool);
2 17929 <*+3*>skriv_new_activity(out,i,j);
2 17930 <*-3*>
2 17931
2 17931 i:= next_coru(294, <*ident*>
2 17932 10, <*prioritet*>
2 17933 true <*testmaske*>);
2 17934 j:= new_activity( i,
2 17935 0,
2 17936 op_medd);
2 17937 <*+3*>skriv_new_activity(out,i,j);
2 17938 <*-3*>
2 17939
2 17939 cs_op_iomedd:= next_semch;
2 17940 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17941 <*-3*>
2 17942
2 17942 bs_opk_alarm:= next_sem;
2 17943 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17944 <*-3*>
2 17945
2 17945 cs_opk_alarm:= next_semch;
2 17946 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17947 <*-3*>
2 17948
2 17948 cs_opk_alarm_ur:= next_semch;
2 17949 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17950 <*-3*>
2 17951
2 17951 cs_opk_alarm_ur_ret:= next_semch;
2 17952 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17953 <*-3*>
2 17954
2 17954 cs_tvswitch_adgang:= next_semch;
2 17955 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17956 <*-3*>
2 17957
2 17957 cs_tv_switch_input:= next_semch;
2 17958 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17959 <*-3*>
2 17960
2 17960 cs_tv_switch_adm:= next_semch;
2 17961 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17962 <*-3*>
2 17963
2 17963 cs_talevejsswitch:= next_semch;
2 17964 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17965 <*-3*>
2 17966
2 17966 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17967
2 17967 iaf:= nextop(data+128);
2 17968 if testbit22 then
2 17969 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17970 else
2 17971 begin
3 17972 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17973 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17974 end;
2 17975
2 17975 i:= next_coru(295, <*ident*>
2 17976 8, <*prioritet*>
2 17977 true <*testmaske*>);
2 17978 j:= new_activity( i,
2 17979 0,
2 17980 alarmur);
2 17981 <*+3*>skriv_new_activity(out,i,j);
2 17982 <*-3*>
2 17983
2 17983 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17984
2 17984 i:= next_coru(296, <*ident*>
2 17985 8, <*prioritet*>
2 17986 true <*testmaske*>);
2 17987 j:= new_activity( i,
2 17988 0,
2 17989 opkaldsalarmer);
2 17990 <*+3*>skriv_new_activity(out,i,j);
2 17991 <*-3*>
2 17992
2 17992 i:= next_coru(297, <*ident*>
2 17993 3, <*prioritet*>
2 17994 true <*testmaske*>);
2 17995 j:= new_activity( i,
2 17996 0,
2 17997 tv_switch_input);
2 17998 <*+3*>skriv_new_activity(out,i,j);
2 17999 <*-3*>
2 18000
2 18000 for i:= 1,2 do
2 18001 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 18002
2 18002 i:= next_coru(298, <*ident*>
2 18003 20, <*prioritet*>
2 18004 true <*testmaske*>);
2 18005 j:= new_activity( i,
2 18006 0,
2 18007 tv_switch_adm);
2 18008 <*+3*>skriv_new_activity(out,i,j);
2 18009 <*-3*>
2 18010
2 18010 i:= next_coru(299, <*ident*>
2 18011 3, <*prioritet*>
2 18012 true <*testmaske*>);
2 18013 j:= new_activity( i,
2 18014 0,
2 18015 talevejsswitch);
2 18016 <*+3*>skriv_new_activity(out,i,j);
2 18017 <*-3*>
2 18018 \f
2 18018 message garage_initialisering side 1 - 810521/hko;
2 18019
2 18019 cs_gar:= next_semch;
2 18020 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 18021 <*-3*>
2 18022
2 18022 i:= next_coru(300,<*ident*>
2 18023 10,<*prioritet*>
2 18024 true<*test_maske*>);
2 18025
2 18025 j:= new_activity( i,
2 18026 0,
2 18027 h_garage);
2 18028
2 18028 <*+3*>skriv_newactivity(out,i,j);
2 18029 <*-3*>
2 18030
2 18030 for k:= 1 step 1 until max_antal_garageterminaler do
2 18031 begin
3 18032 ref:= (k-1)*8;
3 18033 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 18034 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 18035 i:=monitor(4)process address:(z_gar(k),0,ia);
3 18036 if i = 0 then
3 18037 begin
4 18038 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 18039 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 18040 end
3 18041 else
3 18042 begin
4 18043 terminal_tab.ref.terminal_tilstand:=
4 18044 if garage_auto_include(k) then 0 else 7 shift 21;
4 18045 if garage_auto_include(k) then
4 18046 monitor(8)reserve:(z_gar(k),0,ia);
4 18047 end;
3 18048 cs_garage(k):= next_semch;
3 18049 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 18050 <*-3*>
3 18051 i:= next_coru(300+k,<*ident*>
3 18052 10,<*prioritet*>
3 18053 true <*testmaske*>);
3 18054 j:= new_activity( i,
3 18055 0,
3 18056 garage,k);
3 18057
3 18057 <*+3*>skriv_newactivity(out,i,j);
3 18058 <*-3*>
3 18059
3 18059 end;
2 18060 \f
2 18060 message radio_initialisering side 1 - 820301/hko;
2 18061
2 18061 cs_rad:= next_semch;
2 18062 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 18063 <*-3*>
2 18064
2 18064 i:= next_coru(400,<*ident*>
2 18065 10,<*prioritet*>
2 18066 true<*test_maske*>);
2 18067 j:= new_activity( i,
2 18068 0,
2 18069 h_radio);
2 18070 <*+3*>skriv_newactivity(out,i,j);
2 18071 <*-3*>
2 18072
2 18072 opkalds_kø_ledige:= max_antal_mobilopkald;
2 18073 nødopkald_brugt:= 0;
2 18074 læsfil(1034,1,i);
2 18075 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 18076
2 18076 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 18077 for i:= system(3,j,opkaldskø) step 1 until j do
2 18078 opkaldskø(i):= 0;
2 18079 første_frie_opkald:=opkaldskø_postlængde;
2 18080 første_opkald:=sidste_opkald:=
2 18081 første_nødopkald:=sidste_nødopkald:=j:=0;
2 18082
2 18082 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 18083 begin
3 18084 ref:=i*opkaldskø_postlængde;
3 18085 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 18086 end;
2 18087 ref:=ref+opkaldskø_postlængde;
2 18088 opkaldskø.ref(1):=j shift 12;
2 18089
2 18089 for ref:= 0 step 512 until (max_linienr//768*512) do
2 18090 begin
3 18091 i:= læs_fil(1035,ref//512+1,j);
3 18092 if i <> 0 then
3 18093 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 18094 tofrom(radio_linietabel.ref,fil(j),
3 18095 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 18096 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 18097 end;
2 18098
2 18098 for i:= system(3,j,kanal_tab) step 1 until j do
2 18099 kanal_tab(i):= 0;
2 18100 kanal_tilstand:= 2;
2 18101 kanal_id1:= 4;
2 18102 kanal_id2:= 6;
2 18103 kanal_spec:= 8;
2 18104 kanal_alt_id1:= 10;
2 18105 kanal_alt_id2:= 12;
2 18106 kanal_mon_maske:= 12;
2 18107 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 18108
2 18108 for i:= 1 step 1 until max_antal_kanaler do
2 18109 begin
3 18110 ref:= (i-1)*kanalbeskrlængde;
3 18111 sæthexciffer(kanal_tab.ref,3,15);
3 18112 if kanal_id(i) shift (-5) extract 3 = 2 or
3 18113 kanal_id(i) shift (-5) extract 3 = 3 and
3 18114 radio_id(kanal_id(i) extract 5)<=3
3 18115 then
3 18116 begin
4 18117 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 18118 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 18119 end;
3 18120 end;
2 18121 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 18122 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 18123 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 18124 optaget_flag:= 0;
2 18125 \f
2 18125 message radio_initialisering side 2 - 810524/hko;
2 18126
2 18126 bs_mobil_opkald:= next_sem;
2 18127
2 18127 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 18128 <*-3*>
2 18129
2 18129 bs_opkaldskø_adgang:= next_sem;
2 18130 signal_bin(bs_opkaldskø_adgang);
2 18131
2 18131 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 18132 <*-3*>
2 18133
2 18133 cs_radio_medd:=next_semch;
2 18134 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 18135
2 18135 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 18136 <*-3*>
2 18137
2 18137 i:= next_coru(403,
2 18138 5,<*prioritet*>
2 18139 true<*testmaske*>);
2 18140
2 18140 j:= new_activity( i,
2 18141 0,
2 18142 radio_medd_opkald);
2 18143
2 18143 <*+3*>skriv_newactivity(out,i,j);
2 18144 <*-3*>
2 18145
2 18145 cs_radio_adm:= nextsemch;
2 18146 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 18147 <*-3*>
2 18148
2 18148 i:= next_coru(404,
2 18149 10,
2 18150 true);
2 18151 j:= new_activity(i,
2 18152 0,
2 18153 radio_adm,next_op(data+radio_op_længde));
2 18154 <*+3*>skriv_new_activity(out,i,j);
2 18155 <*-3*>
2 18156 \f
2 18156 message radio_initialisering side 3 - 810526/hko;
2 18157 for k:= 1 step 1 until max_antal_taleveje do
2 18158 begin
3 18159
3 18159 cs_radio(k):=next_semch;
3 18160
3 18160 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 18161 <*-3*>
3 18162
3 18162 bs_talevej_udkoblet(k):= nextsem;
3 18163 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 18164 <*-3*>
3 18165
3 18165 i:=next_coru(410+k,
3 18166 10,
3 18167 true);
3 18168
3 18168 j:=new_activity( i,
3 18169 0,
3 18170 radio,k,next_op(data + radio_op_længde));
3 18171
3 18171 <*+3*>skriv_newactivity(out,i,j);
3 18172 <*-3*>
3 18173 end;
2 18174
2 18174 cs_radio_pulje:=next_semch;
2 18175
2 18175 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 18176 <*-3*>
2 18177
2 18177 for i:= 1 step 1 until radiopulje_størrelse do
2 18178 signal_ch(cs_radio_pulje,
2 18179 next_op(60),
2 18180 gen_optype or rad_optype);
2 18181
2 18181 cs_radio_kø:= next_semch;
2 18182
2 18182 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 18183 <*-3*>
2 18184
2 18184 mobil_opkald_aktiveret:= true;
2 18185 \f
2 18185 message radio_initialisering side 4 - 810522/hko;
2 18186
2 18186 laf:=raf:=0;
2 18187
2 18187 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 18188 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 18189 j:=1;
2 18190 if i <> 0 then
2 18191 fejlreaktion(4<*monitor resultat*>,i,
2 18192 string radio_fr_navn.raf(increase(j)),1);
2 18193 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 18194 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 18195 j:=1;
2 18196 if i <> 0 then
2 18197 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 18198 ia(1):= 3 <*canonical*>;
2 18199 ia(2):= 0 <*no echo*>;
2 18200 ia(3):= 0 <*prompt*>;
2 18201 ia(4):= 5 <*timeout*>;
2 18202 setcspterm(radio_fr_navn.laf,ia);
2 18203
2 18203 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 18204 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 18205 j:= 1;
2 18206 if i <> 0 then
2 18207 fejlreaktion(4<*monitor resultat*>,i,
2 18208 string radio_rf_navn.raf(increase(j)),1);
2 18209 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 18210 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 18211 j:= 1;
2 18212 if i <> 0 then
2 18213 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 18214 ia(1):= 3 <*canonical*>;
2 18215 ia(2):= 0 <*no echo*>;
2 18216 ia(3):= 0 <*prompt*>;
2 18217 ia(4):= 5 <*timeout*>;
2 18218 setcspterm(radio_rf_navn.laf,ia);
2 18219 \f
2 18219 message radio_initialisering side 5 - 810521/hko;
2 18220 for k:= 1 step 1 until max_antal_kanaler do
2 18221 begin
3 18222
3 18222 ss_radio_aktiver(k):=next_sem;
3 18223 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 18224 <*-3*>
3 18225
3 18225 ss_samtale_nedlagt(k):=next_sem;
3 18226 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 18227 <*-3*>
3 18228 end;
2 18229
2 18229 cs_radio_ind:= next_semch;
2 18230 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 18231 <*-3*>
2 18232
2 18232 i:= next_coru(401,<*ident radio_ind*>
2 18233 3, <*prioritet*>
2 18234 true <*testmaske*>);
2 18235 j:= new_activity( i,
2 18236 0,
2 18237 radio_ind,next_op(data + 64));
2 18238
2 18238 <*+3*>skriv_newactivity(out,i,j);
2 18239 <*-3*>
2 18240
2 18240 cs_radio_ud:=next_semch;
2 18241 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 18242 <*-3*>
2 18243
2 18243 i:= next_coru(402,<*ident radio_out*>
2 18244 10,<*prioritet*>
2 18245 true <*testmaske*>);
2 18246 j:= new_activity( i,
2 18247 0,
2 18248 radio_ud,next_op(data + 64));
2 18249
2 18249 <*+3*>skriv_newactivity(out,i,j);
2 18250 <*-3*>
2 18251 \f
2 18251 message vogntabel initialisering side 1 - 820301;
2 18252
2 18252 sidste_bus:= sidste_linie_løb:= 0;
2 18253
2 18253 tf_vogntabel:= 1 shift 10 + 2;
2 18254 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 18255 tf_gruppeidenter:= 1 shift 10 +6;
2 18256 tf_springdef:= 1 shift 10 +7;
2 18257 hent_fil_dim(ia);
2 18258 max_antal_i_gruppe:= ia(2);
2 18259 if ia(1) < max_antal_grupper then
2 18260 max_antal_grupper:= ia(1);
2 18261
2 18261 <* initialisering af interne vogntabeller *>
2 18262 begin
3 18263 long array field laf1,laf2;
3 18264 integer array fdim(1:8);
3 18265 zone z(128,1,stderror);
3 18266 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 18267 long omr,garageid;
3 18268 integer field ll, bn;
3 18269 boolean binær, test24;
3 18270
3 18270 ll:= 2; bn:= 4;
3 18271
3 18271 <* nulstil tabellerne *>
3 18272 laf1:= -2;
3 18273 laf2:= 2;
3 18274 bustabel1.laf2(0):=
3 18275 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 18276 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 18277 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 18278 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 18279 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 18280 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 18281 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 18282 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 18283 \f
3 18283 message vogntabel initialisering side 1a - 810505/cl;
3 18284
3 18284
3 18284 <* initialisering af intern busnummertabel *>
3 18285 open(z,4,<:busnumre:>,0);
3 18286 busnr:= -1;
3 18287 read(z,busnr);
3 18288 while busnr > 0 do
3 18289 begin
4 18290 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 18291 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 18292 sidste_bus:= sidste_bus+1;
4 18293 if sidste_bus > max_antal_busser then
4 18294 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 18295 repeatchar(z); readchar(z,tegn);
4 18296 garageid:= extend 0; binær:= false; omr:= extend 0;
4 18297 g_nr:= o_nr:= 0;
4 18298 if tegn='!' then
4 18299 begin
5 18300 binær:= true;
5 18301 readchar(z,tegn);
5 18302 end;
4 18303 if tegn='/' then <*garageid*>
4 18304 begin
5 18305 readchar(z,tegn); repeatchar(z);
5 18306 if '0'<=tegn and tegn<='9' then
5 18307 begin
6 18308 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 18309 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 18310 if g_nr<>0 and garageid=long<::> then
6 18311 begin
7 18312 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 18313 g_nr:= 0;
7 18314 end;
6 18315 end
5 18316 else
5 18317 begin
6 18318 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 18319 begin
7 18320 garageid:= garageid shift 8 + tegn;
7 18321 readchar(z,tegn);
7 18322 end;
6 18323 while garageid shift (-40) extract 8 = 0 do
6 18324 garageid:= garageid shift 8;
6 18325 g_nr:= find_bpl(garageid);
6 18326 if g_nr=0 then
6 18327 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 18328 end;
5 18329 repeatchar(z); readchar(z,tegn);
5 18330 end;
4 18331 if tegn=';' then
4 18332 begin
5 18333 readchar(z,tegn); repeatchar(z);
5 18334 if '0'<=tegn and tegn<='9' then
5 18335 begin
6 18336 read(z,o_nr);
6 18337 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 18338 if o_nr<>0 then omr:= område_navn(o_nr);
6 18339 if o_nr<>0 and omr=long<::> then
6 18340 begin
7 18341 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 18342 o_nr:= 0;
7 18343 end;
6 18344 end
5 18345 else
5 18346 begin
6 18347 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 18348 begin
7 18349 omr:= omr shift 8 + tegn;
7 18350 readchar(z,tegn);
7 18351 end;
6 18352 while omr shift (-40) extract 8 = 0 do
6 18353 omr:= omr shift 8;
6 18354 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 18355 i:= 1;
6 18356 while i<=max_antal_områder and o_nr=0 do
6 18357 begin
7 18358 if omr=område_navn(i) then o_nr:= i;
7 18359 i:= i+1;
7 18360 end;
6 18361 if o_nr=0 then
6 18362 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 18363 end;
5 18364 repeatchar(z); readchar(z,tegn);
5 18365 end;
4 18366 if o_nr=0 then o_nr:= 3;
4 18367 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 18368 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 18369
4 18369 busnr:= -1;
4 18370 read(z,busnr);
4 18371 end;
3 18372 close(z,true);
3 18373 \f
3 18373 message vogntabel initialisering side 2 - 820301/cl;
3 18374
3 18374 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 18375 test24:= testbit24;
3 18376 testbit24:= false;
3 18377 i:= 1;
3 18378 s:= læsfil(tf_vogntabel,i,zi);
3 18379 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 18380 while fil(zi).bn<>0 do
3 18381 begin
4 18382 if fil(zi).ll <> 0 then
4 18383 begin <* indsæt linie/løb *>
5 18384 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 18385 fil(zi).ll,j);
5 18386 if res < 0 then j:= j+1;
5 18387 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 18388 <:dobbeltregistrering i vogntabel:>,1)
5 18389 else
5 18390 begin
6 18391 o_nr:= fil(zi).bn shift (-14) extract 8;
6 18392 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 18393 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 18394 <:ukendt bus i vogntabel:>,1)
6 18395 else
6 18396 begin
7 18397 if sidste_linie_løb >= max_antal_linie_løb then
7 18398 fejlreaktion(10,fil(zi).bn extract 14,
7 18399 <:for mange linie/løb i vogntabel:>,0);
7 18400 for ll_nr:= sidste_linie_løb step (-1) until j do
7 18401 begin
8 18402 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18403 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18404 end;
7 18405 linie_løb_tabel(j):= fil(zi).ll;
7 18406 bus_indeks(j):= false add b_nr;
7 18407 sidste_linie_løb:= sidste_linie_løb + 1;
7 18408 end;
6 18409 end;
5 18410 end;
4 18411 i:= i+1;
4 18412 s:= læsfil(tf_vogntabel,i,zi);
4 18413 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18414 end;
3 18415 \f
3 18415 message vogntabel initialisering side 3 - 810428/cl;
3 18416
3 18416 <* initialisering af intern linie/løb-indekstabel *>
3 18417 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18418 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18419
3 18419 <* gem ny vogntabel i tabelfil *>
3 18420 for i:= 1 step 1 until sidste_bus do
3 18421 begin
4 18422 s:= skriv_fil(tf_vogntabel,i,zi);
4 18423 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18424 fil(zi).bn:= bustabel(i) extract 14 add
4 18425 (bustabel1(i) extract 8 shift 14);
4 18426 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18427 end;
3 18428 fdim(4):= tf_vogntabel;
3 18429 hent_fil_dim(fdim);
3 18430 pant:= fdim(3) * (256//fdim(2));
3 18431 for i:= sidste_bus+1 step 1 until pant do
3 18432 begin
4 18433 s:= skriv_fil(tf_vogntabel,i,zi);
4 18434 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18435 fil(zi).ll:= fil(zi).bn:= 0;
4 18436 end;
3 18437
3 18437 <* initialisering/nulstilling af gruppetabeller *>
3 18438 for i:= 1 step 1 until max_antal_grupper do
3 18439 begin
4 18440 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18441 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18442 gruppetabel(i):= fil(zi).ll;
4 18443 end;
3 18444 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18445 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18446 testbit24:= test24;
3 18447 end;
2 18448
2 18448
2 18448 <*+2*>
2 18449 <**> if testbit40 then p_vogntabel(out);
2 18450 <**> if testbit43 then p_gruppetabel(out);
2 18451 <*-2*>
2 18452
2 18452 message vogntabel initialisering side 3a -920517/cl;
2 18453
2 18453 <* initialisering for vt_log *>
2 18454
2 18454 v_tid:= 4;
2 18455 v_kode:= 6;
2 18456 v_bus:= 8;
2 18457 v_ll1:= 10;
2 18458 v_ll2:= 12;
2 18459 v_tekst:= 6;
2 18460 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18461 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18462 if vt_log_aktiv then
2 18463 begin
3 18464 integer i;
3 18465 real t;
3 18466 integer array field iaf;
3 18467 integer array
3 18468 tail(1:10),ia(1:10),chead(1:20);
3 18469
3 18469 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18470 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18471 if i=0 then
3 18472 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18473 if i=0 then
3 18474 begin
4 18475 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18476 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18477 end;
3 18478
3 18478 if i=0 then
3 18479 begin
4 18480 iaf:= 2;
4 18481 tofrom(vt_logdisc,tail.iaf,8);
4 18482 i:=slices(vt_logdisc,0,tail,chead);
4 18483 if i > (-2048) then
4 18484 begin
5 18485 vt_log_slicelgd:= chead(15);
5 18486 i:= 0;
5 18487 end;
4 18488 end;
3 18489
3 18489 if i=0 then
3 18490 begin
4 18491 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18492 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18493 if i=0 then
4 18494 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18495 if i=0 then
4 18496 begin
5 18497 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18498 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18499 end;
4 18500
4 18500 if i<>0 then
4 18501 begin
5 18502 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18503 tail(1):= 1;
5 18504 iaf:= 2;
5 18505 tofrom(tail.iaf,vt_logdisc,8);
5 18506 tail(6):=systime(7,0,t);
5 18507 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18508 if i=0 then
5 18509 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18510 end;
4 18511 end;
3 18512
3 18512 if i<>0 then vt_log_aktiv:= false;
3 18513 end;
2 18514
2 18514
2 18514 \f
2 18514 message vogntabel initialisering side 4 - 810520/cl;
2 18515
2 18515 cs_vt:= nextsemch;
2 18516 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18517 <*-3*>
2 18518
2 18518 cs_vt_adgang:= nextsemch;
2 18519 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18520 <*-3*>
2 18521
2 18521 cs_vt_opd:= nextsemch;
2 18522 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18523 <*-3*>
2 18524
2 18524 cs_vt_rap:= nextsemch;
2 18525 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18526 <*-3*>
2 18527
2 18527 cs_vt_tilst:= nextsemch;
2 18528 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18529 <*-3*>
2 18530
2 18530 cs_vt_auto:= nextsemch;
2 18531 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18532 <*-3*>
2 18533
2 18533 cs_vt_grp:= nextsemch;
2 18534 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18535 <*-3*>
2 18536
2 18536 cs_vt_spring:= nextsemch;
2 18537 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18538 <*-3*>
2 18539
2 18539 cs_vt_log:= nextsemch;
2 18540 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18541 <*-3*>
2 18542
2 18542 cs_vt_logpool:= nextsemch;
2 18543 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18544 <*-3*>
2 18545
2 18545 vt_op:= nextop(vt_op_længde);
2 18546 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18547
2 18547 vt_logop(1):= nextop(vt_op_længde);
2 18548 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18549 vt_logop(2):= nextop(vt_op_længde);
2 18550 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18551
2 18551 \f
2 18551 message vogntabel initialisering side 5 - 81-520/cl;
2 18552
2 18552 i:= nextcoru(500, <*ident*>
2 18553 10, <*prioitet*>
2 18554 true <*testmaske*>);
2 18555 j:= new_activity( i,
2 18556 0,
2 18557 h_vogntabel);
2 18558 <*+3*> skriv_newactivity(out,i,j);
2 18559 <*-3*>
2 18560
2 18560 i:= nextcoru(501, <*ident*>
2 18561 10, <*prioritet*>
2 18562 true <*testmaske*>);
2 18563 iaf:= nextop(filop_længde);
2 18564 j:= new_activity(i,
2 18565 0,
2 18566 vt_opdater,iaf);
2 18567 <*+3*> skriv_newactivity(out,i,j);
2 18568 <*-3*>
2 18569
2 18569 i:= nextcoru(502, <*ident*>
2 18570 10, <*prioritet*>
2 18571 true <*testmaske*>);
2 18572 k:= nextsemch;
2 18573 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18574 <*-3*>
2 18575 iaf:= nextop(fil_op_længde);
2 18576 j:= newactivity(i,
2 18577 0,
2 18578 vt_tilstand,
2 18579 k,
2 18580 iaf);
2 18581 <*+3*> skriv_newactivity(out,i,j);
2 18582 <*-3*>
2 18583 \f
2 18583 message vogntabel initialisering side 6 - 810520/cl;
2 18584
2 18584 i:= nextcoru(503, <*ident*>
2 18585 10, <*prioritet*>
2 18586 true <*testmaske*>);
2 18587 k:= nextsemch;
2 18588 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18589 <*-3*>
2 18590 iaf:= nextop(fil_op_længde);
2 18591 j:= newactivity(i,
2 18592 0,
2 18593 vt_rapport,
2 18594 k,
2 18595 iaf);
2 18596 <*+3*> skriv_newactivity(out,i,j);
2 18597 <*-3*>
2 18598
2 18598 i:= nextcoru(504, <*ident*>
2 18599 10, <*prioritet*>
2 18600 true <*testmaske*>);
2 18601 k:= nextsemch;
2 18602 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18603 <*-3*>
2 18604 iaf:= nextop(fil_op_længde);
2 18605 j:= new_activity(i,
2 18606 0,
2 18607 vt_gruppe,
2 18608 k,
2 18609 iaf);
2 18610 <*+3*> skriv_newactivity(out,i,j);
2 18611 <*-3*>
2 18612 \f
2 18612 message vogntabel initialisering side 7 - 810520/cl;
2 18613
2 18613 i:= nextcoru(505, <*ident*>
2 18614 10, <*prioritet*>
2 18615 true <*testmaske*>);
2 18616 k:= nextsemch;
2 18617 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18618 <*-3*>
2 18619 iaf:= nextop(fil_op_længde);
2 18620 j:= newactivity(i,
2 18621 0,
2 18622 vt_spring,
2 18623 k,
2 18624 iaf);
2 18625 <*+3*> skriv_newactivity(out,i,j);
2 18626 <*-3*>
2 18627
2 18627 i:= nextcoru(506, <*ident*>
2 18628 10,
2 18629 true <*testmaske*>);
2 18630 k:= nextsemch;
2 18631 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18632 <*-3*>
2 18633 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18634 j:= newactivity(i,
2 18635 0,
2 18636 vt_auto,
2 18637 k,
2 18638 iaf);
2 18639 <*+3*> skriv_newactivity(out,i,j);
2 18640 <*-3*>
2 18641
2 18641 i:=nextcoru(507, <*ident*>
2 18642 10, <*prioritet*>
2 18643 true <*testmaske*>);
2 18644 j:=newactivity(i,
2 18645 0,
2 18646 vt_log);
2 18647 <*+3*> skriv_newactivity(out,i,j);
2 18648 <*-3*>
2 18649
2 18649 <*+2*>
2 18650 <**> if testbit42 then skriv_vt_variable(out);
2 18651 <*-2*>
2 18652 \f
2 18652 message sysslut initialisering side 1 - 810406/cl;
2 18653 begin
3 18654 zone z(128,1,stderror);
3 18655 integer i,coruid,j,k;
3 18656 integer array field cor;
3 18657
3 18657 open(z,4,<:overvågede:>,0);
3 18658 for i:= read(z,coruid) while i > 0 do
3 18659 begin
4 18660 if coruid = 0 then
4 18661 begin
5 18662 for coruid:= 1 step 1 until maxcoru do
5 18663 begin
6 18664 cor:= coroutine(coruid);
6 18665 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18666 end
5 18667 end
4 18668 else
4 18669 begin
5 18670 cor:= coroutine(coru_no(abs coruid));
5 18671 if cor > 0 then
5 18672 begin
6 18673 d.cor.corutestmask:=
6 18674 (d.cor.corutestmask shift 1 shift (-1)) add
6 18675 ((coruid > 0) extract 1 shift 11);
6 18676 end;
5 18677 end;
4 18678 end;
3 18679 close(z,true);
3 18680
3 18680 læsfil(tf_systællere,1,k);
3 18681 rf:=iaf:= 4;
3 18682 systællere_nulstillet:= fil(k).rf;
3 18683 nulstil_systællere:= fil(k).iaf(1);
3 18684 if systællere_nulstillet=real<::> then
3 18685 begin
4 18686 systællere_nulstillet:= 0.0;
4 18687 nulstil_systællere:= -1;
4 18688 end;
3 18689 iaf:= 32;
3 18690 tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*10);
3 18691 iaf:= 192;
3 18692 tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*10);
3 18693
3 18693 end;
2 18694 \f
2 18694 message sysslut initialisering side 2 - 810603/cl;
2 18695
2 18695
2 18695 if låsning > 0 then
2 18696 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18697
2 18697 if låsning > 1 then
2 18698 <* låsning 2 : *> lock(readchar,1,write,2);
2 18699
2 18699 if låsning > 2 then
2 18700 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18701
2 18701
2 18701
2 18701
2 18701 if låsning > 0 then
2 18702 begin
3 18703 i:= locked(ia);
3 18704 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18705 end;
2 18706 \f
2 18706 message sysslut initialisering side 3 - 810406/cl;
2 18707
2 18707 write(z_io,"nl",2,<:initialisering slut:>);
2 18708 system(2)free core:(i,ra);
2 18709 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18710 setposition(z_io,0,0);
2 18711 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18712 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18713 "nl",1);
2 18714 errorbits:= 3; <* ok.no warning.yes *>
2 18715 \f
2 18715
2 18715 algol list.off;
2 18716 message coroutinemonitor - 40 ;
2 18717
2 18717 if simref <> firstsem then initerror(1, false);
2 18718 if semref <> firstop - 4 then initerror(2, false);
2 18719 if coruref <> firstsim then initerror(3, false);
2 18720 if opref <> optop + 6 then initerror(4, false);
2 18721 if proccount <> maxprocext -1 then initerror(5, false);
2 18722 goto takeexternal;
2 18723
2 18723 dump:
2 18724 op:= op;
2 18725 \f
2 18725 message sys trapaktion side 1 - 810521/hko/cl;
2 18726 trap(finale);
2 18727 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18728 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18729 begin
3 18730 k:= 0;
3 18731 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18732 <:timerqueue->:>));
3 18733 iaf:= i;
3 18734 for iaf:= d.iaf.next while iaf<>i do
3 18735 begin
4 18736 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18737 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18738 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18739 end;
3 18740 end;
2 18741 outchar(zbillede,'nl');
2 18742
2 18742 skriv_opkaldstællere(zbillede);
2 18743
2 18743
2 18743 pfilsystem(zbillede);
2 18744
2 18744
2 18744 write(zbillede,"nl",2,"=",20,<: attentionmodul :>,"=",20,"nl",1);
2 18745
2 18745 write(zbillede,"nl",1,<:attention-flag: :>,"nl",1);
2 18746 outintbits_ia(zbillede,att_flag,1,att_maske_lgd//2);
2 18747
2 18747 write(zbillede,"nl",1,<:attention-signal: :>,"nl",1);
2 18748 outintbits_ia(zbillede,att_signal,1,att_maske_lgd//2);
2 18749 \f
2 18749 message operatør trapaktion1 side 1 - 810521/hko;
2 18750 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18751
2 18751 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18752 for i:= 1 step 1 until max_antal_operatører do
2 18753 begin
3 18754 laf:= (i-1)*8;
3 18755 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18756 case operatør_auto_include(i) extract 2 + 1 of (
3 18757 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18758 terminal_navn.laf,"nl",1);
3 18759 end;
2 18760 write(zbillede,"nl",1);
2 18761
2 18761 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18762 <:betjeningspladsgrupper::>,"nl",1);
2 18763 for i:= 1 step 1 until 127 do
2 18764 if bpl_navn(i)<>long<::> then
2 18765 begin
3 18766 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18767 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18768 write(zbillede,"sp",16-k,<:= :>);
3 18769 iaf:= i*op_maske_lgd; j:=0;
3 18770 for k:= 1 step 1 until max_antal_operatører do
3 18771 begin
4 18772 if læsbit_ia(bpl_def.iaf,k) then
4 18773 begin
5 18774 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18775 write(zbillede,true,6,string bpl_navn(k));
5 18776 j:= j+1;
5 18777 end;
4 18778 end;
3 18779 write(zbillede,"nl",1);
3 18780 end;
2 18781
2 18781 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18782 for i:= 1 step 1 until max_antal_operatører do
2 18783 begin
3 18784 write(zbillede,<<dd >,i);
3 18785 for j:= 0 step 1 until 3 do
3 18786 begin
4 18787 k:= operatør_stop(i,j);
4 18788 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18789 else string bpl_navn(k));
4 18790 end;
3 18791 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18792 end;
2 18793
2 18793 skriv_terminal_tab(zbillede);
2 18794 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18795 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18796 skriv_opk_alarm_tab(zbillede);
2 18797 skriv_talevejs_tab(zbillede);
2 18798 skriv_op_spool_buf(zbillede);
2 18799 skriv_cqf_tabel(zbillede,true);
2 18800 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18801
2 18801 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18802 for i:= 1 step 1 until max_antal_garageterminaler do
2 18803 begin
3 18804 laf:= (i-1)*8;
3 18805 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18806 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18807 end;
2 18808 \f
2 18808 message radio trapaktion side 1 - 820301/hko;
2 18809 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18810 skriv_kanal_tab(zbillede);
2 18811 skriv_opkaldskø(zbillede);
2 18812 skriv_radio_linietabel(zbillede);
2 18813 skriv_radio_områdetabel(zbillede);
2 18814
2 18814 \f
2 18814 message vogntabel trapaktion side 1 - 810520/cl;
2 18815 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18816 skriv_vt_variable(zbillede);
2 18817 p_vogntabel(zbillede);
2 18818 p_gruppetabel(zbillede);
2 18819 p_springtabel(zbillede);
2 18820 \f
2 18820 message sysslut trapaktion side 1 - 810519/cl;
2 18821 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18822 corutable(zbillede);
2 18823 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18824 <: ref værdi prev next:>,"nl",1);
2 18825 iaf:= firstsim;
2 18826 repeat
2 18827 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18828 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18829 iaf:= iaf + simsize;
2 18830 until iaf>=simref;
2 18831 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18832 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18833 iaf:= firstsem;
2 18834 repeat
2 18835 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18836 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18837 iaf:= iaf+semsize;
2 18838 until iaf>=semref;
2 18839 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18840 iaf:= firstop;
2 18841 repeat
2 18842 skriv_op(zbillede,iaf);
2 18843 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18844 until iaf>=optop;
2 18845 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18846 <: messref messcode messop:>,"nl",1);
2 18847 for i:= 1 step 1 until maxmessext do
2 18848 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18849 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18850 <: procref proccode procop:>,"nl",1);
2 18851 for i:= 1 step 1 until maxprocext do
2 18852 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18853
2 18853
2 18853 \f
2 18853 message sys_finale side 1 - 810428/hko;
2 18854
2 18854 finale:
2 18855 trap(slut_finale);
2 18856 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18857 endaction:=0;
2 18858 \f
2 18858 message filsystem finale side 1 - 810428/cl;
2 18859
2 18859 <* lukning af zoner *>
2 18860 write(out,<:lukker filsystem:>); ud;
2 18861 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18862 close(fil(i),true);
2 18863 \f
2 18863 message operatør_finale side 1 - 810428/hko;
2 18864
2 18864 goto op_trap2_slut;
2 18865
2 18865 write(out,<:lukker operatører:>); ud;
2 18866 for k:= 1 step 1 until max_antal_operatører do
2 18867 begin
3 18868 close(z_op(k),true);
3 18869 end;
2 18870 op_trap2_slut:
2 18871 k:=k;
2 18872
2 18872 \f
2 18872 message garage_finale side 1 - 810428/hko;
2 18873
2 18873 write(out,<:lukker garager:>); ud;
2 18874 for k:= 1 step 1 until max_antal_garageterminaler do
2 18875 begin
3 18876 close(z_gar(k),true);
3 18877 end;
2 18878 \f
2 18878 message radio_finale side 1 - 810525/hko;
2 18879 write(out,<:lukker radio:>); ud;
2 18880 close(z_fr_in,true);
2 18881 close(z_fr_out,true);
2 18882 close(z_rf_in,true);
2 18883 close(z_rf_out,true);
2 18884 \f
2 18884 message sysslut finale side 1 - 810530/cl;
2 18885
2 18885 slut_finale:
2 18886
2 18886 trap(exit_finale);
2 18887
2 18887 outchar(zrl,'em');
2 18888 close(zrl,true);
2 18889
2 18889 write(zbillede,
2 18890 "nl",2,<:blocksread=:>,blocksread,
2 18891 "nl",1,<:blocksout= :>,blocksout,
2 18892 "nl",1,<:fillæst= :>,fillæst,
2 18893 "nl",1,<:filskrevet=:>,filskrevet,
2 18894 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18895 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18896 close(zbillede,true);
2 18897 monitor(42,zbillede,0,ia);
2 18898 ia(6):= systime(7,0,0.0);
2 18899 monitor(44,zbillede,0,ia);
2 18900 setposition(z_io,0,0);
2 18901 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18902 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18903 close(z_io,true);
2 18904 exit_finale: trapmode:= 1 shift 10;
2 18905
2 18905 end;
1 18906
1 18906
1 18906 algol list.on;
1 18907 message programslut;
1 18908 program_slut:
1 18909 end
\f
1. 7228154 10651832 611 0 0
2. 14384074 7146392 351 0 0
3. 2294176 16427317 420 368 0
4. 7761538 1851563 429 1657 742
5. 13934184 7655032 584 29975 605
6. 14584248 11160213 585 0 0
7. 15833432 505096 634 0 0
8. 18899 18893 18880 18862 18849 18841 18831 18823 18812 18801
18794 18781 18767 18758 18750 18744 18732 18719 18710 18700
18687 18658 18633 18615 18591 18572 18550 18537 18522 18506
18491 18470 18444 18430 18413 18393 18384 18362 18337 18312
18294 18281 18277 18249 18234 18218 18207 18194 18179 18163
18150 18134 18118 18096 18078 18062 18044 18027 18004 17985
17966 17954 17940 17920 17906 17887 17874 17855 17844 17831
17821 17804 17791 17780 17762 17749 17736 17716 17698 17685
17662 17642 17626 17613 17596 17584 17569 17554 17535 17514
17500 17490 17485 17475 17467 17448 17427 17407 17399 17392
17382 17337 17292 17264 17251 17218 17191 17168 17128 17103
17074 17018 16963 16910 16881 16848 16806 16774 16739 16683
16645 16605 16557 16524 16499 16476 16456 16428 16409 16390
16367 16356 16345 16325 16308 16293 16277 16250 16231 16215
16197 16188 16181 16156 16148 16138 16118 16107 16088 16077
16060 16045 16027 16002 15989 15978 15961 15943 15929 15922
15914 15905 15877 15860 15843 15830 15822 15813 15794 15783
15769 15757 15730 15715 15697 15675 15655 15642 15623 15600
15574 15553 15542 15520 15500 15478 15460 15432 15411 15393
15380 15372 15365 15350 15331 15324 15307 15287 15267 15253
15228 15213 15192 15166 15154 15145 15116 15094 15074 15064
15053 15028 15007 14987 14957 14938 14919 14899 14878 14870
14844 14831 14814 14795 14769 14750 14733 14706 14686 14664
14647 14627 14596 14565 14530 14503 14482 14469 14458 14437
14429 14420 14401 14381 14358 14331 14314 14296 14283 14273
14262 14238 14214 14195 14165 14152 14119 14084 14069 14048
14036 14010 13989 13969 13945 13934 13904 13885 13862 13832
13816 13793 13766 13731 13704 13697 13683 13662 13650 13636
13628 13613 13599 13592 13585 13578 13570 13537 13522 13502
13489 13471 13457 13429 13402 13384 13363 13345 13328 13311
13299 13289 13265 13259 13244 13224 13208 13191 13166 13153
13118 13101 13084 13061 13045 13033 13015 12988 12977 12969
12946 12927 12918 12901 12886 12868 12859 12847 12838 12820
12804 12789 12778 12759 12731 12710 12689 12673 12659 12652
12640 12623 12591 12573 12557 12540 12524 12493 12469 12459
12446 12431 12415 12397 12379 12355 12344 12328 12311 12295
12278 12254 12247 12229 12202 12184 12159 12134 12090 12079
12068 12040 12007 11977 11950 11908 11881 11860 11847 11839
11831 11821 11792 11775 11754 11739 11719 11696 11674 11650
11622 11600 11583 11558 11541 11525 11502 11487 11468 11449
11425 11390 11364 11346 11327 11306 11278 11261 11239 11225
11202 11174 11161 11148 11119 11081 11050 11007 10973 10942
10935 10927 10919 10908 10879 10856 10841 10831 10811 10793
10780 10771 10759 10750 10735 10727 10715 10686 10664 10646
10592 10557 10523 10490 10431 10415 10398 10379 10366 10353
10332 10320 10302 10289 10276 10249 10230 10213 10176 10160
10141 10133 10123 10092 10073 10056 10045 10015 9992 9967
9954 9945 9931 9907 9900 9890 9873 9854 9840 9821
9809 9793 9782 9771 9746 9729 9707 9689 9671 9651
9638 9618 9607 9581 9562 9543 9529 9519 9491 9473
9465 9441 9429 9417 9393 9375 9359 9348 9320 9303
9299 9282 9273 9266 9255 9241 9225 9208 9196 9184
9165 9155 9147 9120 9104 9097 9084 9070 9053 9045
9029 9020 9001 8964 8955 8930 8918 8904 8880 8860
8840 8818 8778 8760 8745 8733 8715 8706 8699 8687
8672 8661 8650 8636 8627 8606 8601 8590 8579 8563
8555 8545 8524 8512 8500 8480 8471 8457 8447 8433
8412 8397 8380 8370 8354 8341 8334 8317 8295 8276
8255 8241 8224 8206 8190 8173 8162 8148 8133 8087
8068 8031 8008 7984 7972 7950 7934 7905 7892 7867
7850 7820 7805 7793 7773 7760 7745 7724 7715 7699
7682 7669 7653 7626 7604 7584 7561 7536 7519 7501
7481 7463 7449 7408 7384 7376 7354 7339 7315 7301
7293 7275 7263 7244 7233 7212 7199 7182 7166 7147
7120 7112 7104 7097 7076 7046 7030 7008 6992 6975
6959 6950 6930 6915 6897 6886 6875 6864 6854 6848
6837 6827 6808 6794 6774 6756 6740 6732 6715 6701
6688 6651 6635 6624 6591 6565 6551 6541 6527 6515
6505 6490 6477 6460 6443 6435 6429 6419 6399 6391
6375 6366 6345 6331 6317 6307 6294 6277 6266 6242
6220 6206 6179 6155 6136 6109 6090 6068 6056 6042
6025 6011 5997 5975 5962 5952 5939 5928 5905 5874
5857 5843 5818 5791 5778 5770 5759 5744 5733 5721
5707 5693 5673 5654 5633 5614 5584 5572 5559 5539
5522 5500 5485 5471 5454 5436 5420 5403 5392 5383
5370 5352 5342 5326 5310 5298 5285 5270 5259 5242
5224 5214 5199 5178 5154 5136 5122 5109 5092 5074
5052 5029 5013 4997 4980 4960 4940 4916 4895 4880
4861 4848 4825 4812 4794 4773 4753 4726 4708 4685
4650 4635 4627 4619 4597 4571 4555 4535 4521 4505
4467 4424 4405 4383 4359 4349 4326 4316 4307 4278
4258 4240 4218 4199 4176 4170 4126 4114 4069 4039
4006 3973 3937 3892 3844 3800 3771 3728 3668 3617
3567 3533 3491 3460 3420 3367 3327 3290 3277 3258
3243 3225 3205 3182 3167 3145 3099 3077 3044 3003
2979 2938 2917 2887 2855 2828 2810 2673 2644 2619
2584 2559 2519 2475 2460 2444 2429 2404 2384 2374
2365 2340 2318 2291 2280 2259 2238 2219 2196 2167
2144 2134 2112 2094 2081 2055 2039 2031 2004 1988
1970 1940 1919 1906 1898 1873 1852 1832 1817 1796
1782 1775 1762 1750 1736 1720 1707 1699 1685 1656
1638 1606 1572 1534 1507 1478 1450 1427 1401 1386
1355 1331 1308 1283 1273 1260 1254 1243 1216 1209
1204 1180 1171 1162 1156 1134 1103 1083 1051 1030
995 960 928 914 900 878 853 845 834 824
812 788 766 735 698 663 632 590 445 344
327 310 283 259 213 200 185 171 32 1
1 1 1
15833432 505096 973 506071 31003
9. 16 434 16 4 960619 231420 buskom1
7 3 1995 306 algftnrts
0 1 0 2 *version
986 400 986 4 flushout
986 44 986 4 911004 101112 sendmessage
987 106 987 12 910308 134214 copyout
988 244 988 12 890821 163833 getzone6
0 410 0 0 out
989 178 989 12 940411 220029 testbit
992 414 992 18 940411 222629 findfpparam
995 46 995 18 890821 163814 system
998 238 998 18 movestring
998 56 998 18 890821 163907 outdate
999 124 999 18 isotable
1000 176 999 18 890821 163656 write
1005 310 1005 152 intable
1006 34 1005 152 890821 163503 read
1010 24 1010 340 890821 163714 tofrom
997 420 995 18 stderror
1012 80 1012 340 890821 163740 open
1016 112 1016 340 890821 163754 monitor
1013 344 1012 340 close
1014 22 1012 340 setposition
997 378 995 18 increase
1004 50 999 18 outchar
999 26 999 18 replacechar
1019 98 1019 340 951214 094619 systime
0 1700 0 0 trapmode
1020 302 1020 340 trap
1020 112 1020 340 890821 163915 initzones
1021 268 1021 340 940411 222959 læsbitia
1022 22 1022 340 sign
1022 28 1022 340 890821 163648 ln
1023 432 1023 340 810409 111908 skrivhele
988 320 988 12 setzone6
1031 52 1031 340 inrec6
1031 28 1031 340 890821 163732 changerec6
1032 228 1032 340 940411 222949 sætbitia
1006 36 1005 152 readchar
1033 348 1033 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1034 278 1034 340 940411 222636 skrivtegn
1035 384 1035 340 940411 222639 afsluttext
1036 394 1036 340 940411 222952 læsbiti
1037 498 1037 340 960610 222201 systid
1039 28 1039 340 getnumber
1039 18 1039 340 900925 171358 putnumber
1 656 0 0 errorbits
1046 60 1046 342 940411 222943 sætbiti
1047 354 1047 342 940411 222801 openbs
1049 228 1049 342 940411 222742 hægttekst
1031 54 1031 340 outrec6
0 1704 0 0 alarmcause
1050 332 1050 342 940411 222745 hægtstring
1051 254 1051 342 940411 222749 anbringtal
1005 288 1005 152 repeatchar
1052 444 1052 342 940411 223002 intg
1053 350 1053 342 940411 222739 binærsøg
1022 20 1022 340 sgn
1054 380 1054 342 940411 222646 skrivtext
1031 56 1031 340 swoprec6
1058 56 1055 342 passivate
1055 40 1055 342 890821 163947 activity
1060 78 1060 350 260479 150000 mon
1 1043 1060 350 monw2
1 1039 1060 350 monw0
1 1041 1060 350 monw1
1057 56 1055 342 activate
0 1588 0 0 endaction
1060 320 1060 350 reflectcore
1056 50 1055 342 newactivity
1061 372 1061 358 940327 154135 setcspterm
1063 428 1063 358 941030 233200 slices
1067 52 1067 358 890821 163933 lock
1067 258 1067 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1068 162 1068 358 940411 222622 fpparam
1 1049 1069 358 nl
1 1047 1069 358 220978 131500 bel
1070 330 1070 446 940411 222722 ud
1071 252 1071 446 940411 222656 taltekst
1 1045 1060 350 monw3
988 296 988 12 getshare6
988 398 988 12 setshare6
70 480 1074 446 0
algol end 1074
*if ok.no
*if warning.yes
*o c
▶EOF◀