|
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: »buskom1ud «, »buskomud «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskom1ud «
└─ ⟦this⟧ »buskomud «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.12477717.1610
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 <= 1 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, interval, 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 <: interval :>,interval,"nl",1,
5 9155 <: pausetid: :>,pausetid,"nl",1,
5 9156 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 9157 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 9158 <::>);
5 9159 skriv_coru(zud,coru_no(292));
5 9160 slut:
5 9161 end;
4 9162 end skriv_op_cqftest;
3 9163
3 9163 trap(op_cqf_trap);
3 9164 interval:= 6*60*60; <* 6 timer mellem test *>
3 9165 stackclaim(1000);
3 9166
3 9166
3 9166 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9167 skriv_op_cqftest(out,0);
3 9168 <*-4*>
3 9169
3 9169 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 9170 repeat
3 9171 i:= sidste_tv_brugt; tv:= 0;
3 9172 repeat
3 9173 i:= (i mod max_antal_taleveje) + 1;
3 9174 if tv_operatør(i) = 0 then tv:= i;
3 9175 until (tv<>0) or (i=sidste_tv_brugt);
3 9176
3 9176 if tv<>0 then
3 9177 begin
4 9178 tv_operatør(tv):= -1;
4 9179 systime(1,0.0,nu); næste_tid:= nu + interval;
4 9180 for cqf:= 1 step 1 until max_cqf do
4 9181 begin
5 9182 ref:= (cqf-1)*cqf_lgd;
5 9183 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 9184 begin
6 9185 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 9186 d.opref.data(1):= tv;
6 9187 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 9188 disable if testbit19 then
6 9189 begin
7 9190 integer i; <*lav en trap-bar blok*>
7 9191
7 9191 trap(test19_trap);
7 9192 systime(1,0,kommstart);
7 9193 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 9194 skriv_id(zrl,d.opref.data(2),0);
7 9195 test19_trap: outchar(zrl,'nl');
7 9196 end;
6 9197 signalch(cs_rad,opref,op_optype or gen_optype);
6 9198 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 9199 res:= d.opref.resultat;
6 9200 <*+2*>
6 9201 disable if testbit19 then
6 9202 begin
7 9203 integer i; <*lav en trap-bar blok*>
7 9204
7 9204 trap(test19_trap);
7 9205 systime(1,0,kommslut);
7 9206 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 9207 if d.opref.data(7)=2 then outchar(zrl,'*');
7 9208 if d.opref.data(9)<>0 then
7 9209 begin
8 9210 skriv_id(zrl,d.opref.data(9),0);
8 9211 outchar(zrl,' ');
8 9212 end;
7 9213 if d.opref.data(8)<>0 then
7 9214 begin
8 9215 skriv_id(zrl,d.opref.data(8),0);
8 9216 outchar(zrl,' ');
8 9217 end;
7 9218 if d.opref.data(12)<>0 then
7 9219 begin
8 9220 if d.opref.data(12) shift (-20) = 15 then
8 9221 write(zrl,<:OMR*:>)
8 9222 else
8 9223 if d.opref.data(12) shift (-20) = 14 then
8 9224 write(zrl,
8 9225 string områdenavn(d.opref.data(12) extract 20))
8 9226 else
8 9227 skriv_id(zrl,d.opref.data(12),0);
8 9228 outchar(zrl,' ');
8 9229 end;
7 9230 if d.opref.data(10)<>0 then
7 9231 begin
8 9232 skriv_id(zrl,d.opref.data(10),0);
8 9233 outchar(zrl,' ');
8 9234 end;
7 9235 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 9236 <<dd.dd>,kommslut-kommstart);
7 9237 test19_trap: outchar(zrl,'nl');
7 9238 end;
6 9239 <*-2*>
6 9240 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 9241 begin
7 9242 delay(3);
7 9243 d.opref.opkode:= 12 shift 12 + 41;
7 9244 d.opref.resultat:= 0;
7 9245 disable if testbit19 then
7 9246 begin
8 9247 integer i; <*lav en trap-bar blok*>
8 9248
8 9248 trap(test19_trap);
8 9249 systime(1,0,kommstart);
8 9250 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 9251 test19_trap: outchar(zrl,'nl');
8 9252 end;
7 9253 signalch(cs_rad,opref,op_optype or gen_optype);
7 9254 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 9255 <*+2*>
7 9256 disable if testbit19 then
7 9257 begin
8 9258 integer i; <*lav en trap-bar blok*>
8 9259
8 9259 trap(test19_trap);
8 9260 systime(1,0,kommslut);
8 9261 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 9262 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 9263 <<dd.dd>,kommslut-kommstart);
8 9264 test19_trap: outchar(zrl,'nl');
8 9265 end;
7 9266 <*-2*>
7 9267 if d.opref.resultat <> 3 then
7 9268 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 9269 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 9270 begin
8 9271 startoperation(opref,292,cs_cqf,23);
8 9272 i:= 1;
8 9273 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9274 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9275 skriv_tegn(d.opref.data,i,' ');
8 9276 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9277 hægtstring(d.opref.data,i,<: ok!:>);
8 9278 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9279 signalch(cs_io,opref,gen_optype);
8 9280 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9281 end;
7 9282 if cqf_tabel.ref.cqf_bus > 0 then
7 9283 begin
8 9284 cqf_tabel.ref.cqf_fejl:= 0;
8 9285 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 9286 cqf_tabel.ref.cqf_næste_tid:= nu+interval;
8 9287 end;
7 9288 end <*res=3*>
6 9289 else
6 9290 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 9291 cqf_tabel.ref.cqf_bus > 0
6 9292 then
6 9293 begin
7 9294 cqf_tabel.ref.cqf_næste_tid:= nu + interval;
7 9295 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 9296 if cqf_tabel.ref.cqf_fejl >= 2 then
7 9297 begin
8 9298 startoperation(opref,292,cs_cqf,23);
8 9299 i:= 1;
8 9300 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 9301 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 9302 skriv_tegn(d.opref.data,i,' ');
8 9303 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 9304 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 9305 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 9306 signalch(cs_io,opref,gen_optype);
8 9307 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 9308 end;
7 9309 end;
6 9310 delay(10);
6 9311 end;
5 9312 if cqf_tabel.ref.cqf_bus > 0 and
5 9313 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 9314 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 9315 end; <*for cqf*>
4 9316
4 9316 tv_operatør(tv):= 0; tv:= 0;
4 9317 if op_cqf_tab_ændret then
4 9318 begin
5 9319 j:= skrivfil(1033,1,i);
5 9320 if j<>0 then
5 9321 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 9322 sorter_cqftab(1,max_cqf);
5 9323 for cqf:= 1 step 1 until max_cqf do
5 9324 begin
6 9325 ref:= (cqf-1)*cqf_lgd;
6 9326 ref1:= (cqf-1)*cqf_id;
6 9327 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 9328 end;
5 9329 op_cqf_tab_ændret:= false;
5 9330 end;
4 9331 end; <*tv*>
3 9332
3 9332 systime(1,0.0,nu);
3 9333 pausetid:= round(næste_tid - nu);
3 9334 if pausetid < 30 then pausetid:= 30;
3 9335
3 9335 <*V*> delay(pausetid);
3 9336
3 9336 until false;
3 9337
3 9337 op_cqf_trap:
3 9338 disable skriv_op_cqftest(zbillede,1);
3 9339 end op_cqftest;
2 9340 \f
2 9340 message procedure op_spool side 1;
2 9341
2 9341 procedure op_spool;
2 9342 begin
3 9343 integer array field opref, ref;
3 9344 integer næste_tomme, i;
3 9345
3 9345 procedure skriv_op_spool(zud,omfang);
3 9346 value omfang;
3 9347 zone zud;
3 9348 integer omfang;
3 9349 begin
4 9350 write(zud,"nl",1,<:+++ op-spool:>);
4 9351 if omfang > 0 then
4 9352 disable begin
5 9353 real t;
5 9354
5 9354 trap(slut);
5 9355 write(zud,"nl",1,
5 9356 <: opref: :>,opref,"nl",1,
5 9357 <: næste-tomme: :>,næste_tomme,"nl",1,
5 9358 <: ref: :>,ref,"nl",1,
5 9359 <: i: :>,i,"nl",1,
5 9360 <::>);
5 9361 skriv_coru(zud,coru_no(293));
5 9362 slut:
5 9363 end;
4 9364 end skriv_op_spool;
3 9365
3 9365 trap(op_spool_trap);
3 9366 stackclaim(400);
3 9367
3 9367 næste_tomme:= 0;
3 9368
3 9368 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9369 skriv_op_spool(out,0);
3 9370 <*-4*>
3 9371
3 9371 repeat
3 9372 <*V*> waitch(cs_op_spool,opref,true,-1);
3 9373 inspect(ss_op_spool_tomme,i);
3 9374
3 9374 if d.opref.opkode extract 12 <> 37 then
3 9375 begin
4 9376 d.opref.resultat:= 31;
4 9377 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 9378 end
3 9379 else
3 9380 if i<=0 then
3 9381 d.opref.resultat:= 32 <*ingen fri plads*>
3 9382 else
3 9383 begin
4 9384 <*V*> wait(ss_op_spool_tomme);
4 9385 ref:= næste_tomme*op_spool_postlgd;
4 9386 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9387 i:= d.opref.opsize - data;
4 9388 if i > (op_spool_postlgd - op_spool_text) then
4 9389 i:= (op_spool_postlgd - op_spool_text);
4 9390 op_spool_buf.ref.op_spool_kilde:=
4 9391 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9392 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9393 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9394 op_spool_buf.ref(op_spool_postlgd//2):=
4 9395 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9396 d.opref.resultat:= 3;
4 9397
4 9397 signal(ss_op_spool_fulde);
4 9398 end;
3 9399
3 9399 signalch(d.opref.retur,opref,d.opref.optype);
3 9400 until false;
3 9401
3 9401 op_spool_trap:
3 9402 disable skriv_op_spool(zbillede,1);
3 9403 end op_spool;
2 9404 \f
2 9404 message procedure op_medd side 1;
2 9405
2 9405 procedure op_medd;
2 9406 begin
3 9407 integer array field opref, ref;
3 9408 integer næste_fulde, i;
3 9409
3 9409 procedure skriv_op_medd(zud,omfang);
3 9410 value omfang;
3 9411 zone zud;
3 9412 integer omfang;
3 9413 begin
4 9414 write(zud,"nl",1,<:+++ op-medd:>);
4 9415 if omfang > 0 then
4 9416 disable begin
5 9417 real t;
5 9418
5 9418 trap(slut);
5 9419 write(zud,"nl",1,
5 9420 <: opref: :>,opref,"nl",1,
5 9421 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9422 <: ref: :>,ref,"nl",1,
5 9423 <: i: :>,i,"nl",1,
5 9424 <::>);
5 9425 skriv_coru(zud,coru_no(294));
5 9426 slut:
5 9427 end;
4 9428 end skriv_op_medd;
3 9429
3 9429 trap(op_medd_trap);
3 9430 næste_fulde:= 0;
3 9431 stackclaim(400);
3 9432
3 9432 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9433 skriv_op_medd(out,0);
3 9434 <*-4*>
3 9435
3 9435 repeat
3 9436 <*V*> wait(ss_op_spool_fulde);
3 9437 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9438
3 9438 ref:= næste_fulde*op_spool_postlgd;
3 9439 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9440
3 9440 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9441 d.opref.resultat:= 0;
3 9442 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9443 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9444 opref,gen_optype);
3 9445 signal(ss_op_spool_tomme);
3 9446 until false;
3 9447
3 9447 op_medd_trap:
3 9448 disable skriv_op_medd(zbillede,1);
3 9449 end op_medd;
2 9450 \f
2 9450 message procedure alarmur side 1;
2 9451
2 9451 procedure alarmur;
2 9452 begin
3 9453 integer ventetid, nr;
3 9454 integer array field opref, tab;
3 9455 real nu;
3 9456
3 9456 procedure skriv_alarmur(zud,omfang);
3 9457 value omfang;
3 9458 zone zud;
3 9459 integer omfang;
3 9460 begin
4 9461 write(zud,"nl",1,<:+++ alarmur:>);
4 9462 if omfang > 0 then
4 9463 disable begin
5 9464 real t;
5 9465
5 9465 trap(slut);
5 9466 write(zud,"nl",1,
5 9467 <: ventetid: :>,ventetid,"nl",1,
5 9468 <: nr: :>,nr,"nl",1,
5 9469 <: opref: :>,opref,"nl",1,
5 9470 <: tab: :>,tab,"nl",1,
5 9471 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9472 <::>);
5 9473 skriv_coru(zud,coru_no(295));
5 9474 slut:
5 9475 end;
4 9476 end skriv_alarmur;
3 9477
3 9477 trap(alarmur_trap);
3 9478 stackclaim(400);
3 9479
3 9479 systime(1,0.0,nu);
3 9480 ventetid:= -1;
3 9481 repeat
3 9482 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9483 if opref > 0 then
3 9484 signalch(d.opref.retur,opref,op_optype);
3 9485
3 9485 ventetid:= -1;
3 9486 systime(1,0.0,nu);
3 9487 for nr:= 1 step 1 until max_antal_operatører do
3 9488 begin
4 9489 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9490 if opk_alarm.tab.alarm_tilst > 0 and
4 9491 opk_alarm.tab.alarm_lgd >= 0 then
4 9492 begin
5 9493 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9494 begin
6 9495 opk_alarm.tab.alarm_kmdo:= 3;
6 9496 signalbin(bs_opk_alarm);
6 9497 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9498 end
5 9499 else
5 9500 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9501 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9502 end;
4 9503 end;
3 9504 if ventetid=0 then ventetid:= 1;
3 9505 until false;
3 9506
3 9506 alarmur_trap:
3 9507 disable skriv_alarmur(zbillede,1);
3 9508 end alarmur;
2 9509 \f
2 9509 message procedure opkaldsalarmer side 1;
2 9510
2 9510 procedure opkaldsalarmer;
2 9511 begin
3 9512 integer nr, ny_kommando, tilst, aktion, tt;
3 9513 integer array field tab, opref, alarmop;
3 9514
3 9514 procedure skriv_opkaldsalarmer(zud,omfang);
3 9515 value omfang;
3 9516 zone zud;
3 9517 integer omfang;
3 9518 begin
4 9519 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9520 if omfang>0 then
4 9521 disable begin
5 9522 real array field raf;
5 9523 trap(slut);
5 9524 raf:=0;
5 9525 write(zud,"nl",1,
5 9526 <: nr: :>,nr,"nl",1,
5 9527 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9528 <: tilst: :>,tilst,"nl",1,
5 9529 <: aktion: :>,aktion,"nl",1,
5 9530 <: tt: :>,false add tt,1,"nl",1,
5 9531 <: tab: :>,tab,"nl",1,
5 9532 <: opref: :>,opref,"nl",1,
5 9533 <: alarmop: :>,alarmop,"nl",1,
5 9534 <::>);
5 9535 skriv_coru(zud,coru_no(296));
5 9536 slut:
5 9537 end;
4 9538 end skriv_opkaldsalarmer;
3 9539
3 9539 trap(opk_alarm_trap);
3 9540 stackclaim(400);
3 9541
3 9541 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9542 skriv_opkaldsalarmer(out,0);
3 9543 <*-2*>
3 9544
3 9544 repeat
3 9545 wait(bs_opk_alarm);
3 9546 alarmop:= 0;
3 9547 for nr:= 1 step 1 until max_antal_operatører do
3 9548 begin
4 9549 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9550 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9551 tilst:= opk_alarm.tab.alarm_tilst;
4 9552 aktion:= case ny_kommando+1 of (
4 9553 <*ingenting*> case tilst+1 of (4,4,4),
4 9554 <*normal *> case tilst+1 of (1,4,4),
4 9555 <*nød *> case tilst+1 of (2,2,4),
4 9556 <*sluk *> case tilst+1 of (4,3,3));
4 9557 tt:= case aktion of ('B','C','F','-');
4 9558 if tt<>'-' then
4 9559 begin
5 9560 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9561 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9562 d.opref.data(1):= nr+16;
5 9563 signalch(cs_talevejsswitch,opref,op_optype);
5 9564 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9565 if d.opref.resultat = 3 then
5 9566 begin
6 9567 opk_alarm.tab.alarm_kmdo:= 0;
6 9568 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9569 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9570 if aktion < 3 then
6 9571 begin
7 9572 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9573 if alarmop = 0 then
7 9574 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9575 end;
6 9576 end;
5 9577 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9578 end;
4 9579 end;
3 9580 if alarmop<>0 then
3 9581 begin
4 9582 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9583 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9584 end;
3 9585 until false;
3 9586
3 9586 opk_alarm_trap:
3 9587 disable skriv_opkaldsalarmer(zbillede,1);
3 9588 end;
2 9589
2 9589 \f
2 9589 message procedure tvswitch_input side 1 - 940810/cl;
2 9590
2 9590 procedure tv_switch_input;
2 9591 begin
3 9592 integer array field opref;
3 9593 integer tt,ant;
3 9594 boolean ok;
3 9595 integer array ia(1:128);
3 9596
3 9596 procedure skriv_tvswitch_input(zud,omfang);
3 9597 value omfang;
3 9598 zone zud;
3 9599 integer omfang;
3 9600 begin
4 9601 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9602 if omfang>0 then
4 9603 disable begin
5 9604 real array field raf;
5 9605 trap(slut);
5 9606 raf:=0;
5 9607 write(zud,"nl",1,
5 9608 <: opref: :>,opref,"nl",1,
5 9609 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9610 <: ant: :>,ant,"nl",1,
5 9611 <: tt: :>,tt,"nl",1,
5 9612 <::>);
5 9613 write(zud,"nl",1,<:ia: :>);
5 9614 skrivhele(zud,ia.raf,256,2);
5 9615 skriv_coru(zud,coru_no(297));
5 9616 slut:
5 9617 end;
4 9618 end skriv_tvswitch_input;
3 9619 \f
3 9619 boolean procedure læs_tlgr;
3 9620 begin
4 9621 integer kl,ch,i,pos,p;
4 9622 long field lf;
4 9623 boolean ok;
4 9624
4 9624 integer procedure readch(z,c);
4 9625 zone z; integer c;
4 9626 begin
5 9627 readch:= readchar(z,c);
5 9628 <*+2*> if testbit15 and overvåget then
5 9629 disable begin
6 9630 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9631 else write(zrl,"<",1,<<d>,c,">",1);
6 9632 if c='em' then write(zrl,<: *timeout*:>);
6 9633 end;
5 9634 <*-2*>
5 9635 end;
4 9636
4 9636 ok:= false; tt:=' ';
4 9637 repeat
4 9638 readchar(z_tv_in,ch);
4 9639 until ch<>'em';
4 9640 repeatchar(z_tv_in);
4 9641
4 9641 <*+2*>if testbit15 and overvåget then
4 9642 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9643 <*-2*>
4 9644
4 9644 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9645 if ch='%' then
4 9646 begin
5 9647 ant:= 0; pos:= 1; lf:= 4;
5 9648 ok:= true;
5 9649 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9650
5 9650 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9651 skrivtegn(ia,pos,ch);
5 9652
5 9652 p:=pos;
5 9653 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9654
5 9654 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9655 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9656 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9657
5 9657 if ok and ch=' ' then
5 9658 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9659
5 9659 while kl = 2 do
5 9660 begin
6 9661 i:= ch - '0';
6 9662 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9663 if ant < 128 then
6 9664 begin
7 9665 ant:= ant+1;
7 9666 ia(ant):= i;
7 9667 end
6 9668 else
6 9669 ok:= false;
6 9670 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9671 end;
5 9672 if ch<>'nl' then ok:= false;
5 9673 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9674 <* !! setposition(z_tv_in,0,0); !! *>
5 9675 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9676 <*-2*>
5 9677
5 9677 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9678 ok:= ok
5 9679 else if tt='C' or tt='N' or
5 9680 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9681 ok:= ok and ant=1
5 9682 else if tt='X' or tt='Y' then
5 9683 ok:= ok and ant=2
5 9684 else if tt='T' or tt='W' then
5 9685 ok:= ok and ant=64
5 9686 else if tt='R' then
5 9687 ok:= ok and ant extract 1 = 0
5 9688 else
5 9689 begin
6 9690 ok:= false;
6 9691 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9692 end;
5 9693
5 9693 end; <* if ch='%' *>
4 9694 læs_tlgr:= ok;
4 9695 end læs_tlgr;
3 9696 \f
3 9696 trap(tvswitch_input_trap);
3 9697 stackclaim(400);
3 9698 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9699
3 9699 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9700 skriv_tvswitch_input(out,0);
3 9701 <*-2*>
3 9702
3 9702 repeat
3 9703 ok:= læs_tlgr;
3 9704 if ok then
3 9705 begin
4 9706 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9707 start_operation(opref,297,cs_tvswitch_input,0);
4 9708 d.opref.resultat:= tt shift 12 + ant;
4 9709 tofrom(d.opref.data,ia,ant*2);
4 9710 signalch(cs_talevejsswitch,opref,op_optype);
4 9711 end;
3 9712 until false;
3 9713
3 9713 tvswitch_input_trap:
3 9714
3 9714 disable skriv_tvswitch_input(zbillede,1);
3 9715
3 9715 end tvswitch_input;
2 9716 \f
2 9716 message procedure tv_switch_adm side 1 - 940502/cl;
2 9717
2 9717 procedure tv_switch_adm;
2 9718 begin
3 9719 integer array field opref;
3 9720 integer rc;
3 9721
3 9721 procedure skriv_tv_switch_adm(zud,omfang);
3 9722 value omfang;
3 9723 zone zud;
3 9724 integer omfang;
3 9725 begin
4 9726 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9727 if omfang>0 then
4 9728 disable begin
5 9729 trap(slut);
5 9730 write(zud,"nl",1,
5 9731 <: opref: :>,opref,"nl",1,
5 9732 <: rc: :>,rc,"nl",1,
5 9733 <::>);
5 9734 skriv_coru(zud,coru_no(298));
5 9735 slut:
5 9736 end;
4 9737 end skriv_tv_switch_adm;
3 9738
3 9738 trap(tv_switch_adm_trap);
3 9739 stackclaim(400);
3 9740
3 9740 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9741 disable skriv_tv_switch_adm(out,0);
3 9742 <*-2*>
3 9743
3 9743
3 9743
3 9743 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9744 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9745 *>
3 9746
3 9746 repeat
3 9747 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9748 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9749 rc:= 0;
3 9750 repeat
3 9751 signalch(cs_talevejsswitch,opref,op_optype);
3 9752 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9753 rc:= rc+1;
3 9754 until rc=3 or d.opref.resultat=3;
3 9755
3 9755 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9756
3 9756 <*V*> delay(15*60);
3 9757 until false;
3 9758 tv_switch_adm_trap:
3 9759 disable skriv_tv_switch_adm(zbillede,1);
3 9760 end;
2 9761 \f
2 9761 message procedure talevejsswitch side 1 -940426/cl;
2 9762
2 9762 procedure talevejsswitch;
2 9763 begin
3 9764 integer tt, ant, ventetid;
3 9765 integer array field opref, gemt_op, tab;
3 9766 boolean ok;
3 9767 integer array ia(1:128);
3 9768
3 9768 procedure skriv_talevejsswitch(zud,omfang);
3 9769 value omfang;
3 9770 zone zud;
3 9771 integer omfang;
3 9772 begin
4 9773 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9774 if omfang>0 then
4 9775 disable begin
5 9776 real array field raf;
5 9777 trap(slut);
5 9778 raf:= 0;
5 9779 write(zud,"nl",1,
5 9780 <: tt: :>,tt,"nl",1,
5 9781 <: ant: :>,ant,"nl",1,
5 9782 <: ventetid: :>,ventetid,"nl",1,
5 9783 <: opref: :>,opref,"nl",1,
5 9784 <: gemt-op: :>,gemt_op,"nl",1,
5 9785 <: tab: :>,tab,"nl",1,
5 9786 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9787 <::>);
5 9788 write(zud,"nl",1,<:ia: :>);
5 9789 skriv_hele(zud,ia.raf,256,2);
5 9790 skriv_coru(zud,coru_no(299));
5 9791 slut:
5 9792 end;
4 9793 end skriv_talevejsswitch;
3 9794 \f
3 9794 trap(tvswitch_trap);
3 9795 stackclaim(400);
3 9796 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9797
3 9797 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9798 skriv_talevejsswitch(out,0);
3 9799 <*-2*>
3 9800
3 9800 ventetid:= -1; ant:= 0; tt:= ' ';
3 9801 repeat
3 9802 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9803 if opref > 0 then
3 9804 begin
4 9805 if d.opref.opkode extract 12 = 0 then
4 9806 begin <*input fra talevejsswitchen *>
5 9807 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9808 tt:= d.opref.resultat shift (-12) extract 12;
5 9809 ant:= d.opref.resultat extract 12;
5 9810 tofrom(ia,d.opref.data,ant*2);
5 9811 signalch(d.opref.retur,opref,d.opref.optype);
5 9812
5 9812 if tt<>'+' and tt<>'-' then
5 9813 begin
6 9814 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9815 setposition(z_tv_out,0,0);
6 9816 <*+2*> if testbit15 and overvåget then
6 9817 disable begin
7 9818 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9819 outchar(zrl,'nl');
7 9820 end;
6 9821 <*-2*>
6 9822 end;
5 9823 if (tt='+' or tt='-') and gemt_op<>0 then
5 9824 begin
6 9825 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9826 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9827 gemt_op:= 0;
6 9828 ventetid:= -1;
6 9829 end
5 9830 else
5 9831 if tt='R' then
5 9832 begin
6 9833 for i:= 1 step 2 until ant do
6 9834 begin
7 9835 if ia(i) <= max_antal_taleveje and
7 9836 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9837 then
7 9838 begin
8 9839 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9840 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9841 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9842 op_talevej(tv_operatør(ia(i))):= 0;
8 9843 tv_operatør(ia(i)):= ia(i+1)-16;
8 9844 op_talevej(ia(i+1)-16):= ia(i);
8 9845 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9846 end
7 9847 else
7 9848 if ia(i+1) <= max_antal_taleveje and
7 9849 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9850 then
7 9851 begin
8 9852 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9853 tv_operatør(op_talevej(ia(i))):= 0;
8 9854 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9855 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9856 tv_operatør(ia(i+1)):= ia(i)-16;
8 9857 op_talevej(ia(i)-16):= ia(i+1);
8 9858 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9859 end;
7 9860 end;
6 9861 signal_bin(bs_mobil_opkald);
6 9862 <*+2*> if testbit15 and testbit16 and overvåget then
6 9863 disable begin
7 9864 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9865 end;
6 9866 <*-2*>
6 9867 end <* tt='R' and ant>0 *>
5 9868 else
5 9869 if tt='Y' then
5 9870 begin
6 9871 if ia(1) <= max_antal_taleveje and
6 9872 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9873 then
6 9874 begin
7 9875 if tv_operatør(ia(1))=ia(2)-16 and
7 9876 op_talevej(ia(2)-16)=ia(1)
7 9877 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9878 end
6 9879 else
6 9880 if ia(2) <= max_antal_taleveje and
6 9881 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9882 then
6 9883 begin
7 9884 if tv_operatør(ia(2))=ia(1)-16 and
7 9885 op_talevej(ia(1)-16)=ia(2)
7 9886 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9887 end;
6 9888 end
5 9889 else
5 9890 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9891 begin
6 9892 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9893 startoperation(opref,299,cs_op_iomedd,23);
6 9894 ant:= 1;
6 9895 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9896 anbringtal(d.opref.data,ant,ia(1),2);
6 9897 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9898 begin
7 9899 hægtstring(d.opref.data,ant,<: (:>);
7 9900 if bpl_navn(ia(1)-16)=long<::> then
7 9901 begin
8 9902 hægtstring(d.opref.data,ant,<:op:>);
8 9903 anbringtal(d.opref.data,ant,ia(1)-16,
8 9904 if ia(1)-16 > 9 then 2 else 1);
8 9905 end
7 9906 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9907 skrivtegn(d.opref.data,ant,')');
7 9908 end;
6 9909 hægtstring(d.opref.data,ant,
6 9910 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9911 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9912 if tt='P' then <: Tilgængelig:> else
6 9913 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9914 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9915 signalch(cs_io,opref,gen_optype);
6 9916 end
5 9917 else
5 9918 if tt='Z' then
5 9919 begin
6 9920 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9921 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9922 end
5 9923 else
5 9924 begin
6 9925 <* ikke implementeret *>
6 9926 end;
5 9927 end
4 9928 else
4 9929 if d.opref.opkode extract 12 = 44 then
4 9930 begin
5 9931 tt:= d.opref.opkode shift (-12);
5 9932 ok:= true;
5 9933 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9934 begin
6 9935 <*+2*> if testbit15 and overvåget then
6 9936 disable begin
7 9937 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9938 outchar(zrl,'nl');
7 9939 end;
6 9940 <*-2*>
6 9941 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9942 setposition(z_tv_out,0,0);
6 9943 end
5 9944 else
5 9945 if tt='B' or tt='C' or tt='F' then
5 9946 begin
6 9947 <*+2*> if testbit15 and overvåget then
6 9948 disable begin
7 9949 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9950 " ",1,<<d>,d.opref.data(1));
7 9951 outchar(zrl,'nl');
7 9952 end;
6 9953 <*-2*>
6 9954 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9955 d.opref.data(1),"cr",1);
6 9956 setposition(z_tv_out,0,0);
6 9957 end
5 9958 else
5 9959 if tt='A' or tt='D' or tt='T' then
5 9960 begin
6 9961 <*+2*> if testbit15 and overvåget then
6 9962 disable begin
7 9963 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9964 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9965 outchar(zrl,'nl');
7 9966 end;
6 9967 <*-2*>
6 9968 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9969 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9970 setposition(z_tv_out,0,0);
6 9971 end
5 9972 else
5 9973 ok:= false;
5 9974 if ok then
5 9975 begin
6 9976 gemt_op:= opref;
6 9977 ventetid:= 2;
6 9978 end
5 9979 else
5 9980 begin
6 9981 d.opref.resultat:= 4;
6 9982 signalch(d.opref.retur,opref,d.opref.optype);
6 9983 end;
5 9984 end;
4 9985 end
3 9986 else
3 9987 if gemt_op<>0 then
3 9988 begin <*timeout*>
4 9989 d.gemt_op.resultat:= 0;
4 9990 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9991 gemt_op:= 0;
4 9992 ventetid:= -1;
4 9993 <*+2*> if testbit15 and overvåget then
4 9994 disable begin
5 9995 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9996 outchar(zrl,'nl');
5 9997 end;
4 9998 <*-2*>
4 9999 end;
3 10000 until false;
3 10001 tvswitch_trap:
3 10002 disable skriv_talevejsswitch(zbillede,1);
3 10003 end talevejsswitch;
2 10004
2 10004 \f
2 10004 message garage_erklæringer side 1 - 810415/hko;
2 10005
2 10005 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 10006
2 10006 procedure gar_fejl(z,s,b);
2 10007 integer s,b;
2 10008 zone z;
2 10009 begin
3 10010 disable begin
4 10011 integer array iz(1:20);
4 10012 integer i,j,k;
4 10013 integer array field iaf;
4 10014 real array field raf;
4 10015
4 10015 getzone6(z,iz);
4 10016 iaf:=raf:=2;
4 10017 getnumber(iz.raf,7,j);
4 10018
4 10018 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 10019 k:=1;
4 10020
4 10020 j:= terminal_tab.iaf.terminal_tilstand;
4 10021 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 10022 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 10023 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 10024 if s <> (1 shift 21 +2) then
4 10025 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 10026 + terminal_tab.iaf.terminal_tilstand extract 21;
4 10027 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 10028 begin
5 10029 z(1):=real <:<'?'><'em'>:>;
5 10030 b:=2;
5 10031 end;
4 10032 end; <*disable*>
3 10033 end gar_fejl;
2 10034
2 10034 integer cs_gar;
2 10035 integer array cs_garage(1:max_antal_garageterminaler);
2 10036 \f
2 10036 message procedure h_garage side 1 - 810520/hko;
2 10037
2 10037 <* hovedmodulkorutine for garageterminaler *>
2 10038 procedure h_garage;
2 10039 begin
3 10040 integer array field op_ref;
3 10041 integer k,dest_sem;
3 10042 procedure skriv_hgarage(zud,omfang);
3 10043 value omfang;
3 10044 zone zud;
3 10045 integer omfang;
3 10046 begin integer i;
4 10047
4 10047 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 10048 write(zud,"sp",26-i);
4 10049 if omfang>0 then
4 10050 disable begin
5 10051 integer x;
5 10052 trap(slut);
5 10053 write(zud,"nl",1,
5 10054 <: op_ref: :>,op_ref,"nl",1,
5 10055 <: k: :>,k,"nl",1,
5 10056 <: dest_sem: :>,dest_sem,"nl",1,
5 10057 <::>);
5 10058 skriv_coru(zud,coru_no(300));
5 10059 slut:
5 10060 end;
4 10061 end skriv_hgarage;
3 10062
3 10062 trap(hgar_trap);
3 10063 stack_claim(if cm_test then 198 else 146);
3 10064
3 10064 <*+2*>
3 10065 if testbit16 and overvåget or testbit28 then
3 10066 skriv_hgarage(out,0);
3 10067 <*-2*>
3 10068 \f
3 10068 message procedure h_garage side 2 - 811105/hko;
3 10069
3 10069 repeat
3 10070 wait_ch(cs_gar,op_ref,true,-1);
3 10071 <*+4*>
3 10072 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 10073 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 10074 <*-4*>
3 10075
3 10075 k:=d.op_ref.opkode extract 12;
3 10076 dest_sem:=
3 10077 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 10078 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 10079 else -1;
3 10080 <*+4*>
3 10081 if dest_sem=-1 then
3 10082 begin
4 10083 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 10084 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10085 end
3 10086 else
3 10087 <*-4*>
3 10088 if k=7<*inkluder*> then
3 10089 begin
4 10090 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 10091 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 10092 begin
5 10093 d.op_ref.resultat:=3;
5 10094 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 10095 dest_sem:=-2;
5 10096 end;
4 10097 end
3 10098 else
3 10099 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 10100 begin
4 10101 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 10102 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 10103 +terminal_tab.iaf.terminal_tilstand extract 21;
4 10104 end;
3 10105 if dest_sem>0 then
3 10106 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 10107 until false;
3 10108
3 10108 hgar_trap:
3 10109 disable skriv_hgarage(zbillede,1);
3 10110 end h_garage;
2 10111 \f
2 10111 message procedure garage side 1 - 830310/cl;
2 10112
2 10112 procedure garage(nr);
2 10113 value nr;
2 10114 integer nr;
2 10115 begin
3 10116 integer array field op_ref,ref;
3 10117 integer i,kode,aktion,status,opgave,retur_sem,
3 10118 pos,indeks,sep,sluttegn,vogn,ll;
3 10119
3 10119 procedure skriv_garage(zud,omfang);
3 10120 value omfang;
3 10121 zone zud;
3 10122 integer omfang;
3 10123 begin integer i;
4 10124
4 10124 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 10125 write(zud,"sp",26-i);
4 10126 if omfang > 0 then
4 10127 disable begin integer x;
5 10128 trap(slut);
5 10129 write(zud,"nl",1,
5 10130 <: op-ref: :>,op_ref,"nl",1,
5 10131 <: kode: :>,kode,"nl",1,
5 10132 <: ref: :>,ref,"nl",1,
5 10133 <: i: :>,i,"nl",1,
5 10134 <: aktion: :>,aktion,"nl",1,
5 10135 <: retur-sem: :>,retur_sem,"nl",1,
5 10136 <: vogn: :>,vogn,"nl",1,
5 10137 <: ll: :>,ll,"nl",1,
5 10138 <: status: :>,status,"nl",1,
5 10139 <: opgave: :>,opgave,"nl",1,
5 10140 <: pos: :>,pos,"nl",1,
5 10141 <: indeks: :>,indeks,"nl",1,
5 10142 <: sep: :>,sep,"nl",1,
5 10143 <: sluttegn: :>,sluttegn,"nl",1,
5 10144 <::>);
5 10145 skriv_coru(zud,coru_no(300+nr));
5 10146 slut:
5 10147 end;
4 10148 end skriv_garage;
3 10149 \f
3 10149 message procedure garage side 2 - 830310/hko;
3 10150
3 10150 trap(gar_trap);
3 10151 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 10152
3 10152 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 10153
3 10153 <*+2*>
3 10154 if testbit16 and overvåget or testbit28 then
3 10155 skriv_garage(out,0);
3 10156 <*-2*>
3 10157
3 10157 <* attention simulering
3 10158 *>
3 10159 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 10160 begin
4 10161 wait_ch(cs_att_pulje,op_ref,true,-1);
4 10162 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 10163 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 10164 end;
3 10165 <*
3 10166 *>
3 10167 \f
3 10167 message procedure garage side 3 - 830310/hko;
3 10168
3 10168 repeat
3 10169
3 10169 <*V*> wait_ch(cs_garage(nr),
3 10170 op_ref,
3 10171 true,
3 10172 -1<*timeout*>);
3 10173 <*+2*>
3 10174 if testbit17 and overvåget then
3 10175 disable begin
4 10176 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 10177 <: til garage :>,nr);
4 10178 skriv_op(out,op_ref);
4 10179 end;
3 10180 <*-2*>
3 10181
3 10181 kode:= d.op_ref.op_kode;
3 10182 retur_sem:= d.op_ref.retur;
3 10183 i:= terminal_tab.ref.terminal_tilstand;
3 10184 status:= i shift(-21);
3 10185 opgave:=
3 10186 if kode=0 then 1 <* indlæs kommando *> else
3 10187 if kode=7 then 2 <* inkluder *> else
3 10188 if kode=8 then 3 <* ekskluder *> else
3 10189 0; <* afvises *>
3 10190
3 10190 aktion:= case status +1 of(
3 10191 <* status *> <* opgave: 0 1 2 3 *>
3 10192 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 10193 <* 1 - *>(-1),<* ulovlig tilstand *>
3 10194 <* 2 - *>(-1),<* ulovlig tilstand *>
3 10195 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 10196 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 10197 <* 5 - *>(-1),<* ulovlig tilstand *>
3 10198 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 10199 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 10200 -1);
3 10201 \f
3 10201 message procedure garage side 4 - 810424/hko;
3 10202
3 10202 case aktion+6 of
3 10203 begin
4 10204 begin
5 10205 <*-5: terminal optaget *>
5 10206
5 10206 d.op_ref.resultat:= 16;
5 10207 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10208 end;
4 10209
4 10209 begin
5 10210 <*-4: operation uden virkning *>
5 10211
5 10211 afslut_operation(op_ref,-1);
5 10212 end;
4 10213
4 10213 begin
5 10214 <*-3: ulovlig operationskode *>
5 10215
5 10215 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 10216 afslut_operation(op_ref,-1);
5 10217 end;
4 10218
4 10218 begin
5 10219 <*-2: ulovligt garageterminal_nr *>
5 10220
5 10220 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 10221 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 10222 end;
4 10223
4 10223 begin
5 10224 <*-1: ulovlig operatørtilstand *>
5 10225
5 10225 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 10226 afslut_operation(op_ref,-1);
5 10227 end;
4 10228
4 10228 begin
5 10229 <* 0: ikke implementeret *>
5 10230
5 10230 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 10231 afslut_operation(op_ref,-1);
5 10232 end;
4 10233
4 10233 begin
5 10234 \f
5 10234 message procedure garage side 5 - 851001/cl;
5 10235
5 10235 <* 1: indlæs kommando *>
5 10236
5 10236
5 10236 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 10237
5 10237 if d.op_ref.resultat > 3 then
5 10238 begin
6 10239 <*V*> setposition(z_gar(nr),0,0);
6 10240 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 10241 skriv_kvittering(z_gar(nr),op_ref,pos,
6 10242 d.op_ref.resultat);
6 10243 end
5 10244 else if d.op_ref.resultat>0 then
5 10245 begin <*godkendt*>
6 10246 kode:=d.op_ref.opkode;
6 10247 i:= kode extract 12;
6 10248 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 10249 else if kode=9 or kode=10 then 2
6 10250 else 0;
6 10251 if j > 0 then
6 10252 begin
7 10253 case j of
7 10254 begin
8 10255 begin
9 10256 \f
9 10256 message procedure garage side 6 - 851001/cl;
9 10257
9 10257 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 10258 integer vogn,ll;
9 10259 integer array field vtop;
9 10260
9 10260 vogn:=ia(1);
9 10261 ll:=ia(2);
9 10262 <*V*> wait_ch(cs_vt_adgang,
9 10263 vt_op,
9 10264 gen_optype,
9 10265 -1<*timeout sek*>);
9 10266 start_operation(vtop,300+nr,cs_garage(nr),
9 10267 kode);
9 10268 d.vt_op.data(1):=vogn;
9 10269 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 10270 indeks:= vt_op;
9 10271 signal_ch(cs_vt,
9 10272 vt_op,
9 10273 gen_optype or gar_optype);
9 10274
9 10274 <*V*> wait_ch(cs_garage(nr),
9 10275 vt_op,
9 10276 gar_optype,
9 10277 -1<*timeout sek*>);
9 10278 <*+2*> if testbit18 and overvåget then
9 10279 disable begin
10 10280 write(out,"nl",1,<:garage :>,<<d>,nr,
10 10281 <:: operation retur fra vt:>);
10 10282 skriv_op(out,vt_op);
10 10283 end;
9 10284 <*-2*>
9 10285 <*+4*> if vt_op<>indeks then
9 10286 fejl_reaktion(11<*fremmede op*>,op_ref,
9 10287 <:garage-kommando:>,0);
9 10288 <*-4*>
9 10289 <*V*> setposition(z_gar(nr),0,0);
9 10290 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 10291 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 10292 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 10293 else vt_op,-1,d.vt_op.resultat);
9 10294 d.vt_op.optype:=gen_optype or vtoptype;
9 10295 disable afslut_operation(vt_op,cs_vt_adgang);
9 10296 end;
8 10297
8 10297 begin
9 10298 \f
9 10298 message procedure garage side 6a - 830310/cl;
9 10299
9 10299 <* 2 vogntabel,linienr/-,busnr *>
9 10300
9 10300 d.op_ref.retur:= cs_garage(nr);
9 10301 tofrom(d.op_ref.data,ia,10);
9 10302 indeks:= op_ref;
9 10303 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 10304 wait_ch(cs_garage(nr),
9 10305 op_ref,
9 10306 gar_optype,
9 10307 -1<*timeout*>);
9 10308 <*+2*> if testbit18 and overvåget then
9 10309 disable begin
10 10310 write(out,"nl",1,<:garage operation retur fra vt:>);
10 10311 skriv_op(out,op_ref);
10 10312 end;
9 10313 <*-2*>
9 10314 <*+4*>
9 10315 if indeks <> op_ref then
9 10316 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 10317 <*-4*>
9 10318 i:= d.op_ref.resultat;
9 10319 if i = 0 or i > 3 then
9 10320 begin
10 10321 <*V*> setposition(z_gar(nr),0,0);
10 10322 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 10323 end
9 10324 else
9 10325 begin
10 10326 integer antal,fil_ref;
10 10327 antal:= d.op_ref.data(6);
10 10328 fil_ref:= d.op_ref.data(7);
10 10329 <*V*> setposition(z_gar(nr),0,0);
10 10330 write(z_gar(nr),"*",24,"sp",6,
10 10331 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 10332 <*V*> setposition(z_gar(nr),0,0);
10 10333 \f
10 10333 message procedure garage side 6c - 841213/cl;
10 10334
10 10334 pos:= 1;
10 10335 while pos <= antal do
10 10336 begin
11 10337 integer bogst,løb;
11 10338
11 10338 disable i:= læs_fil(fil_ref,pos,j);
11 10339 if i <> 0 then
11 10340 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 10341 else
11 10342 begin
12 10343 vogn:= fil(j,1) shift (-24) extract 24;
12 10344 løb:= fil(j,1) extract 24;
12 10345 if d.op_ref.opkode=9 then
12 10346 begin i:=vogn; vogn:=løb; løb:=i; end;
12 10347 ll:= løb shift (-12) extract 10;
12 10348 bogst:= løb shift (-7) extract 5;
12 10349 if bogst > 0 then bogst:= bogst +'A'-1;
12 10350 løb:= løb extract 7;
12 10351 vogn:= vogn extract 14;
12 10352 i:= d.op_ref.opkode-8;
12 10353 for i:= i,i+1 do
12 10354 begin
13 10355 j:= (i+1) extract 1;
13 10356 case j +1 of
13 10357 begin
14 10358 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 10359 false add bogst,1,"/",1,<<d__>,løb);
14 10360 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 10361 end;
13 10362 end;
12 10363 if pos mod 5 = 0 then
12 10364 begin
13 10365 write(z_gar(nr),"nl",1);
13 10366 <*V*> setposition(z_gar(nr),0,0);
13 10367 end
12 10368 else write(z_gar(nr),"sp",3);
12 10369 end;
11 10370 pos:=pos+1;
11 10371 end;
10 10372 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 10373 \f
10 10373 message procedure garage side 6d- 830310/cl;
10 10374
10 10374 d.opref.opkode:=104; <*slet-fil*>
10 10375 d.op_ref.data(4):=filref;
10 10376 indeks:=op_ref;
10 10377 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 10378 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 10379
10 10379 <*+2*> if testbit18 and overvåget then
10 10380 disable begin
11 10381 write(out,"nl",1,<:garage, slet-fil retur:>);
11 10382 skriv_op(out,op_ref);
11 10383 end;
10 10384 <*-2*>
10 10385
10 10385 <*+4*> if op_ref<>indeks then
10 10386 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10387 <*-4*>
10 10388 if d.op_ref.data(9)<>0 then
10 10389 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10390 <:garage, slet_fil:>,1);
10 10391 end;
9 10392 \f
9 10392 message procedure garage side 7 -810424/hko;
9 10393
9 10393 end;
8 10394
8 10394 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10395 <*-4*>
8 10396 end;<*case j *>
7 10397 end <* j > 0 *>
6 10398 else
6 10399 begin
7 10400 <*V*> setposition(z_gar(nr),0,0);
7 10401 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10402 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10403 4 <*kommando ukendt *>);
7 10404 end;
6 10405 end;<* godkendt *>
5 10406
5 10406 <*V*> setposition(z_gar(nr),0,0);
5 10407
5 10407 d.op_ref.opkode:=0; <*telex*>
5 10408
5 10408 disable afslut_operation(op_ref,cs_gar);
5 10409 end; <* indlæs kommando *>
4 10410
4 10410 begin
5 10411 \f
5 10411 message procedure garage side 8 - 841213/cl;
5 10412
5 10412 <* 2: inkluder *>
5 10413
5 10413 d.op_ref.resultat:=3;
5 10414 afslut_operation(op_ref,-1);
5 10415 monitor(8)reserve:(z_gar(nr),0,ia);
5 10416 terminal_tab.ref.terminal_tilstand:=
5 10417 terminal_tab.ref.terminal_tilstand extract 21;
5 10418 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10419 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10420 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10421 end;
4 10422
4 10422 begin
5 10423
5 10423 <* 3: ekskluder *>
5 10424 d.op_ref.resultat:= 3;
5 10425 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10426 terminal_tab.ref.terminal_tilstand extract 21;
5 10427 monitor(10)release:(z_gar(nr),0,ia);
5 10428 afslut_operation(op_ref,-1);
5 10429
5 10429 end;
4 10430
4 10430 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10431 <*-4*>
4 10432 end; <* case aktion+6 *>
3 10433
3 10433 until false;
3 10434 gar_trap:
3 10435 skriv_garage(zbillede,1);
3 10436 end garage;
2 10437
2 10437 \f
2 10437 message procedure radio_erklæringer side 1 - 820304/hko;
2 10438
2 10438 zone z_fr_in(14,1,rad_in_fejl),
2 10439 z_rf_in(14,1,rad_in_fejl),
2 10440 z_fr_out(14,1,rad_out_fejl),
2 10441 z_rf_out(14,1,rad_out_fejl);
2 10442
2 10442 integer array
2 10443 radiofejl,
2 10444 ss_samtale_nedlagt,
2 10445 ss_radio_aktiver(1:max_antal_kanaler),
2 10446 bs_talevej_udkoblet,
2 10447 cs_radio(1:max_antal_taleveje),
2 10448 radio_linietabel(1:max_linienr//3+1),
2 10449 radio_områdetabel(0:max_antal_områder),
2 10450 opkaldskø(opkaldskø_postlængde//2+1:
2 10451 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10452 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10453 hookoff_maske(1:(tv_maske_lgd//2)),
2 10454 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10455
2 10455 integer field
2 10456 kanal_tilstand,
2 10457 kanal_id1,
2 10458 kanal_id2,
2 10459 kanal_spec,
2 10460 kanal_alt_id1,
2 10461 kanal_alt_id2;
2 10462 integer array field
2 10463 kanal_mon_maske,
2 10464 kanal_alarm,
2 10465 opkald_meldt;
2 10466
2 10466 integer
2 10467 cs_rad,
2 10468 cs_radio_medd,
2 10469 cs_radio_adm,
2 10470 cs_radio_ind,
2 10471 cs_radio_ud,
2 10472 cs_radio_pulje,
2 10473 cs_radio_kø,
2 10474 bs_mobil_opkald,
2 10475 bs_opkaldskø_adgang,
2 10476 opkaldskø_ledige,
2 10477 nødopkald_brugt,
2 10478 første_frie_opkald,
2 10479 første_opkald,
2 10480 sidste_opkald,
2 10481 første_nødopkald,
2 10482 sidste_nødopkald,
2 10483 optaget_flag;
2 10484
2 10484 boolean
2 10485 mobil_opkald_aktiveret;
2 10486 \f
2 10486 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10487
2 10487 integer
2 10488 procedure læs_hex_ciffer(tabel,linie,op);
2 10489 value linie;
2 10490 integer array tabel;
2 10491 integer linie,op;
2 10492 begin
3 10493 integer i,j;
3 10494
3 10494 i:=(if linie>=0 then linie+6 else linie)//6;
3 10495 j:=((i-1)*6-linie)*4;
3 10496 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10497 end læs_hex_ciffer;
2 10498
2 10498 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10499
2 10499 integer
2 10500 procedure sæt_hex_ciffer(tabel,linie,op);
2 10501 value linie;
2 10502 integer array tabel;
2 10503 integer linie,op;
2 10504 begin
3 10505 integer i,j;
3 10506
3 10506 i:=(if linie>=0 then linie+6 else linie)//6;
3 10507 j:=(linie-(i-1)*6)*4;
3 10508 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10509 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10510 shift j add (tabel(i) extract j);
3 10511 end sæt_hex_ciffer;
2 10512
2 10512 message procedure hex_to_dec side 1 - 900108/cl;
2 10513
2 10513 integer procedure hex_to_dec(hex);
2 10514 value hex;
2 10515 integer hex;
2 10516 begin
3 10517 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10518 else (hex-'0');
3 10519 end;
2 10520
2 10520 message procedure dec_to_hex side 1 - 900108/cl;
2 10521
2 10521 integer procedure dec_to_hex(dec);
2 10522 value dec;
2 10523 integer dec;
2 10524 begin
3 10525 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10526 else ('A'+dec-10);
3 10527 end;
2 10528
2 10528 message procedure rad_out_fejl side 1 - 820304/hko;
2 10529
2 10529 procedure rad_out_fejl(z,s,b);
2 10530 value s;
2 10531 zone z;
2 10532 integer s,b;
2 10533 begin
3 10534 integer array field iaf;
3 10535 integer pos,tegn,max,i;
3 10536 integer array ia(1:20);
3 10537 long array field laf;
3 10538
3 10538 disable begin
4 10539 laf:= iaf:= 2;
4 10540 tegn:= 1;
4 10541 getzone6(z,ia);
4 10542 max:= ia(16)//2*3;
4 10543 if s = 1 shift 21 + 2 then
4 10544 begin
5 10545 z(1):= real<:<'em'>:>;
5 10546 b:= 2;
5 10547 end
4 10548 else
4 10549 begin
5 10550 pos:= 0;
5 10551 for i:= 1 step 1 until max_antal_kanaler do
5 10552 begin
6 10553 iaf:= (i-1)*kanalbeskr_længde;
6 10554 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10555 if pos>0 then
6 10556 begin
7 10557 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10558 signalbin(bs_mobilopkald);
7 10559 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10560 1 shift 12<*binært*> +1<*fortsæt*>);
7 10561 end;
6 10562 end;
5 10563 end;
4 10564 end;
3 10565 end;
2 10566 \f
2 10566 message procedure rad_in_fejl side 1 - 810601/hko;
2 10567
2 10567 procedure rad_in_fejl(z,s,b);
2 10568 value s;
2 10569 zone z;
2 10570 integer s,b;
2 10571 begin
3 10572 integer array field iaf;
3 10573 integer pos,tegn,max,i;
3 10574 integer array ia(1:20);
3 10575 long array field laf;
3 10576
3 10576 disable begin
4 10577 laf:= iaf:= 2;
4 10578 i:= 1;
4 10579 getzone6(z,ia);
4 10580 max:= ia(16)//2*3;
4 10581 if s shift (-21) extract 1 = 0
4 10582 and s shift(-19) extract 1 = 0 then
4 10583 begin
5 10584 if b = 0 then
5 10585 begin
6 10586 z(1):= real<:!:>;
6 10587 b:= 2;
6 10588 end;
5 10589 end;
4 10590 \f
4 10590 message procedure rad_in_fejl side 2 - 820304/hko;
4 10591
4 10591 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10592 begin
5 10593 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10594 1 shift 12<*binær*> +1<*fortsæt*>);
5 10595 end
4 10596 else
4 10597 if s shift (-19) extract 1 = 1 then
4 10598 begin
5 10599 z(1):= real<:!<'nl'>:>;
5 10600 b:= 2;
5 10601 end
4 10602 else
4 10603 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10604 begin
5 10605 <*
5 10606 if b = 0 then
5 10607 begin
5 10608 *>
5 10609 z(1):= real <:<'em'>:>;
5 10610 b:= 2;
5 10611 <*
5 10612 end
5 10613 else
5 10614 begin
5 10615 tegn:= -1;
5 10616 iaf:= 0;
5 10617 pos:= b//2*3-2;
5 10618 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10619 skriv_tegn(z.iaf,pos,'?');
5 10620 if pos<=max then
5 10621 afslut_text(z.iaf,pos);
5 10622 b:= (pos-1)//3*2;
5 10623 end;
5 10624 *>
5 10625 end;<* s=1 shift 21+2 *>
4 10626 end;
3 10627 if testbit22 and
3 10628 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10629 then
3 10630 delay(60);
3 10631 end rad_in_fejl;
2 10632 \f
2 10632 message procedure afvent_radioinput side 1 - 880901/cl;
2 10633
2 10633 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10634 value rf;
2 10635 zone z_in;
2 10636 integer array tlgr;
2 10637 boolean rf;
2 10638 begin
3 10639 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10640 long array field laf;
3 10641
3 10641 laf:= 0;
3 10642 pos:= 1;
3 10643 repeat
3 10644 i:=readchar(z_in,tegn);
3 10645 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10646 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10647 p:=pos;
3 10648 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10649 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10650 (rf and testbit39)) then
3 10651 disable begin
4 10652 write(zrl,<<zd dd dd.dd >,now,
4 10653 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10654 if tegn='em' then <:*timeout*:> else
4 10655 if pos>=80 then <:*for langt*:> else <::>);
4 10656 outchar(zrl,'nl');
4 10657 end;
3 10658 <*-2*>
3 10659 ac:= -1;
3 10660 if pos >= 80 then
3 10661 begin <* telegram for langt *>
4 10662 repeat readchar(z_in,tegn)
4 10663 until tegn='nl' or tegn='em';
4 10664 end
3 10665 else
3 10666 if pos>1 and tegn='nl' then
3 10667 begin
4 10668 lgd:= 1;
4 10669 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10670 lgd:= lgd-2;
4 10671 if lgd >= 5 then
4 10672 begin
5 10673 lgd:= lgd-2; <* se bort fra checksum *>
5 10674 i:= lgd + 1;
5 10675 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10676 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10677 i:= lgd + 1;
5 10678 skrivtegn(tlgr,i,0);
5 10679 skrivtegn(tlgr,i,0);
5 10680 i:= 1; sum:= 0;
5 10681 while i <= lgd do
5 10682 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10683 if csum >= 0 and csum <> sum then
5 10684 begin
6 10685 <*+2*> if overvåget and (testbit36 or
6 10686 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10687 disable begin
7 10688 write(zrl,<<zd dd dd.dd >,now,
7 10689 (if rf then <:rf:> else <:fr:>),
7 10690 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10691 end;
6 10692 <*-2*>
6 10693 ac:= 6 <* checksumfejl *>
6 10694 end
5 10695 else
5 10696 ac:= 0;
5 10697 end
4 10698 else ac:= 6; <* for kort telegram - retransmitter *>
4 10699 end;
3 10700 afvent_radioinput:= ac;
3 10701 end;
2 10702 \f
2 10702 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10703
2 10703 procedure skriv_kanal_tab(z);
2 10704 zone z;
2 10705 begin
3 10706 integer array field ref;
3 10707 integer i,j,t,op,id1,id2;
3 10708
3 10708 write(z,"ff",1,"nl",1,<:
3 10709 ******** kanal-beskrivelser *******
3 10710
3 10710 a k l p m b n
3 10711 l a y a o s ø
3 10712 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10713 <*
3 10714 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10715 *>
3 10716 "nl",1);
3 10717 for i:=1 step 1 until max_antal_kanaler do
3 10718 begin
4 10719 ref:=(i-1)*kanal_beskr_længde;
4 10720 t:=kanal_tab.ref.kanal_tilstand;
4 10721 id1:=kanal_tab.ref.kanal_id1;
4 10722 id2:=kanal_tab.ref.kanal_id2;
4 10723 write(z,"nl",1,"sp",4,
4 10724 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10725 for j:=11 step -1 until 2 do
4 10726 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10727 write(z,case t extract 2 +1 of
4 10728 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10729 "sp",1);
4 10730 skriv_id(z,id1,9);
4 10731 skriv_id(z,id2,9);
4 10732 t:=kanal_tab.ref.kanal_spec;
4 10733 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10734 write(z,"nl",1,"sp",14,<:mon: :>);
4 10735 for j:= max_antal_taleveje step -1 until 1 do
4 10736 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10737 else "."),1);
4 10738 write(z,"sp",25-max_antal_taleveje);
4 10739 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10740 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10741 end;
3 10742 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10743 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10744 write(z,"nl",2);
3 10745 end skriv_kanal_tab;
2 10746 \f
2 10746 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10747
2 10747 procedure skriv_opkaldskø(z);
2 10748 zone z;
2 10749 begin
3 10750 integer i,bogst,løb,j;
3 10751 integer array field ref;
3 10752 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10753 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10754 <: sig omr :>,"nl",1);
3 10755 for i:= 1 step 1 until max_antal_mobilopkald do
3 10756 begin
4 10757 ref:= i*opkaldskø_postlængde;
4 10758 j:= opkaldskø.ref(1);
4 10759 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10760 j:= opkaldskø.ref(2);
4 10761 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10762 skriv_id(z,j extract 23,9);
4 10763 j:= opkaldskø.ref(3);
4 10764 skriv_id(z,j,7);
4 10765 j:= opkaldskø.ref(4);
4 10766 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10767 << zd>,j extract 8);
4 10768 j:= j shift (-8) extract 4;
4 10769 if j = 1 or j = 2 then
4 10770 write(z,if j=1 then <: normal:> else <: nød :>)
4 10771 else write(z,<<dddd>,j,"sp",3);
4 10772 j:= opkaldskø.ref(5);
4 10773 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10774 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10775 string område_navn(j extract 8) else <:---:>);
4 10776 outchar(z,'nl');
4 10777 end;
3 10778
3 10778 write(z,"nl",1,<<z>,
3 10779 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10780 <:første_opkald=:>,første_opkald,"nl",1,
3 10781 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10782 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10783 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10784 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10785 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10786 "nl",1,<:opkaldsflag::>,"nl",1);
3 10787 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10788 write(z,"nl",2);
3 10789 end skriv_opkaldskø;
2 10790 \f
2 10790 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10791
2 10791 procedure skriv_radio_linie_tabel(z);
2 10792 zone z;
2 10793 begin
3 10794 integer i,j,k;
3 10795
3 10795 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10796 k:= 0;
3 10797 for i:= 1 step 1 until max_linienr do
3 10798 begin
4 10799 læstegn(radio_linietabel,i+1,j);
4 10800 if j > 0 then
4 10801 begin
5 10802 k:= k +1;
5 10803 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10804 "nl",if k mod 5=0 then 1 else 0);
5 10805 end;
4 10806 end;
3 10807 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10808 end skriv_radio_linietabel;
2 10809
2 10809 procedure skriv_radio_områdetabel(z);
2 10810 zone z;
2 10811 begin
3 10812 integer i;
3 10813
3 10813 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10814 for i:= 1 step 1 until max_antal_områder do
3 10815 begin
4 10816 laf:= (i-1)*4;
4 10817 if radio_områdetabel(i)<>0 then
4 10818 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10819 radio_områdetabel(i),"nl",1);
4 10820 end;
3 10821 end skriv_radio_områdetabel;
2 10822 \f
2 10822 message procedure h_radio side 1 - 810520/hko;
2 10823
2 10823 <* hovedmodulkorutine for radiokanaler *>
2 10824 procedure h_radio;
2 10825 begin
3 10826 integer array field op_ref;
3 10827 integer k,dest_sem;
3 10828 procedure skriv_hradio(z,omfang);
3 10829 value omfang;
3 10830 zone z;
3 10831 integer omfang;
3 10832 begin integer i;
4 10833 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10834 write(z,"sp",26-i);
4 10835 if omfang >0 then
4 10836 disable begin integer x;
5 10837 trap(slut);
5 10838 write(z,"nl",1,
5 10839 <: op_ref: :>,op_ref,"nl",1,
5 10840 <: k: :>,k,"nl",1,
5 10841 <: dest_sem: :>,dest_sem,"nl",1,
5 10842 <::>);
5 10843 skriv_coru(z,coru_no(400));
5 10844 slut:
5 10845 end;
4 10846 end skriv_hradio;
3 10847
3 10847 trap(hrad_trap);
3 10848 stack_claim(if cm_test then 198 else 146);
3 10849
3 10849 <*+2*> if testbit32 and overvåget or testbit28 then
3 10850 skriv_hradio(out,0);
3 10851 <*-2*>
3 10852 \f
3 10852 message procedure h_radio side 2 - 820304/hko;
3 10853
3 10853 repeat
3 10854 wait_ch(cs_rad,op_ref,true,-1);
3 10855 <*+2*>if testbit33 and overvåget then
3 10856 disable begin
4 10857 skriv_h_radio(out,0);
4 10858 write(out,<: operation modtaget:>);
4 10859 skriv_op(out,op_ref);
4 10860 end;
3 10861 <*-2*>
3 10862 <*+4*>
3 10863 if (d.op_ref.optype and
3 10864 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10865 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10866 <*-4*>
3 10867
3 10867 k:=d.op_ref.op_kode extract 12;
3 10868 dest_sem:=
3 10869 if k > 0 and k < 7
3 10870 or k=11 or k=12 or k=19
3 10871 or (72<=k and k<=74) or k = 77
3 10872 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10873 then cs_radio_adm
3 10874 else if k=41 <* radiokommando fra operatør *>
3 10875 then cs_radio(d.opref.data(1)) else -1;
3 10876 <*+4*>
3 10877 if dest_sem<1 then
3 10878 begin
4 10879 if dest_sem<0 then
4 10880 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10881 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10882 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10883 end
3 10884 else
3 10885 <*-4*>
3 10886 begin <* operationskode ok *>
4 10887 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10888 end;
3 10889 until false;
3 10890
3 10890 hrad_trap:
3 10891 disable skriv_hradio(zbillede,1);
3 10892 end h_radio;
2 10893 \f
2 10893 message procedure radio side 1 - 820301/hko;
2 10894
2 10894 procedure radio(talevej,op);
2 10895 value talevej,op;
2 10896 integer talevej,op;
2 10897 begin
3 10898 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10899 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10900 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10901 integer array felt,værdi(1:8);
3 10902 boolean byt,nød,frigiv_samtale;
3 10903 real kl;
3 10904 real field rf;
3 10905
3 10905 procedure skriv_radio(z,omfang);
3 10906 value omfang;
3 10907 zone z;
3 10908 integer omfang;
3 10909 begin integer i1;
4 10910 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10911 write(z,"sp",26-i1);
4 10912 if omfang > 0 then
4 10913 disable begin real x;
5 10914 trap(slut);
5 10915 \f
5 10915 message procedure radio side 1a- 820301/hko;
5 10916
5 10916 write(z,"nl",1,
5 10917 <: op_ref: :>,op_ref,"nl",1,
5 10918 <: opref1: :>,opref1,"nl",1,
5 10919 <: iaf: :>,iaf,"nl",1,
5 10920 <: iaf1: :>,iaf1,"nl",1,
5 10921 <: vt-op: :>,vt_op,"nl",1,
5 10922 <: rad-op: :>,rad_op,"nl",1,
5 10923 <: rf: :>,rf,"nl",1,
5 10924 <: nr: :>,nr,"nl",1,
5 10925 <: i: :>,i,"nl",1,
5 10926 <: j: :>,j,"nl",1,
5 10927 <: k: :>,k,"nl",1,
5 10928 <: operatør: :>,operatør,"nl",1,
5 10929 <: tilst: :>,tilst,"nl",1,
5 10930 <: res: :>,res,"nl",1,
5 10931 <: opgave: :>,opgave,"nl",1,
5 10932 <: type: :>,type,"nl",1,
5 10933 <: bus: :>,bus,"nl",1,
5 10934 <: ll: :>,ll,"nl",1,
5 10935 <: ttmm: :>,ttmm,"nl",1,
5 10936 <: vogn: :>,vogn,"nl",1,
5 10937 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10938 <: vtop2: :>,vtop2,"nl",1,
5 10939 <: vtop3: :>,vtop3,"nl",1,
5 10940 <: sig: :>,sig,"nl",1,
5 10941 <: omr: :>,omr,"nl",1,
5 10942 <: garage: :>,garage,"nl",1,
5 10943 <<-dddddd'-dd>,
5 10944 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10945 <:samtaleflag: :>,"nl",1);
5 10946 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10947 skriv_coru(z,coru_no(410+talevej));
5 10948 slut:
5 10949 end;<*disable*>
4 10950 end skriv_radio;
3 10951 \f
3 10951 message procedure udtag_opkald side 1 - 820301/hko;
3 10952
3 10952 integer
3 10953 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10954 value vogn, operatør;
3 10955 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10956 begin
4 10957 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10958 integer array field vt_op,ref,næste,forrige;
4 10959 integer array field iaf1;
4 10960 boolean skal_ud;
4 10961
4 10961 boolean procedure skal_udskrives(fordelt,aktuel);
4 10962 value fordelt,aktuel;
4 10963 integer fordelt,aktuel;
4 10964 begin
5 10965 boolean skal;
5 10966 integer n;
5 10967 integer array field iaf;
5 10968
5 10968 skal:= true;
5 10969 if fordelt > 0 and fordelt<>aktuel then
5 10970 begin
6 10971 for n:= 0 step 1 until 3 do
6 10972 begin
7 10973 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10974 begin
8 10975 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10976 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10977 goto returner;
8 10978 end;
7 10979 end;
6 10980 end;
5 10981 returner:
5 10982 skal_udskrives:= skal;
5 10983 end;
4 10984
4 10984 l:= b:= tm:= t:= 0;
4 10985 garage:= sig:= 0;
4 10986 res:= -1;
4 10987 <*V*> wait(bs_opkaldskø_adgang);
4 10988 ref:= første_nødopkald;
4 10989 if ref <> 0 then
4 10990 t:= 2
4 10991 else
4 10992 begin
5 10993 ref:= første_opkald;
5 10994 t:= if ref = 0 then 0 else 1;
5 10995 end;
4 10996 if t = 0 then res:= +19 <*kø er tom*> else
4 10997 if vogn=0 and omr=0 then
4 10998 begin
5 10999 while ref <> 0 and res = -1 do
5 11000 begin
6 11001 nr:= opkaldskø.ref(4) extract 8;
6 11002 if nr>64 then
6 11003 begin
7 11004 <*opk. primærfordelt til gruppe af btj.pl.*>
7 11005 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 11006 while skal_ud and i<max_antal_operatører do
7 11007 begin
8 11008 i:=i+1;
8 11009 if læsbit_ia(bpl_def.iaf1,i) then
8 11010 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 11011 end;
7 11012 end
6 11013 else
6 11014 skal_ud:= skal_udskrives(nr,operatør);
6 11015
6 11015 if skal_ud then
6 11016 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 11017 *>
6 11018 res:= 0
6 11019 else
6 11020 begin
7 11021 ref:= opkaldskø.ref(1) extract 12;
7 11022 if ref = 0 and t = 2 then
7 11023 begin
8 11024 ref:= første_opkald;
8 11025 t:= if ref = 0 then 0 else 1;
8 11026 end else if ref = 0 then t:= 0;
7 11027 end;
6 11028 end; <*while*>
5 11029 \f
5 11029 message procedure udtag_opkald side 2 - 820304/hko;
5 11030
5 11030 if ref <> 0 then
5 11031 begin
6 11032 b:= opkaldskø.ref(2);
6 11033 <*+4*> if b < 0 then
6 11034 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 11035 <:nødopkald(besvaret/ej meldt):>,1);
6 11036 <*-4*>
6 11037 garage:=b shift(-14) extract 8;
6 11038 b:= b extract 14;
6 11039 l:= opkaldskø.ref(3);
6 11040 tm:= opkaldskø.ref(4);
6 11041 o:= tm extract 8;
6 11042 tm:= tm shift(-12);
6 11043 omr:= opkaldskø.ref(5) extract 8;
6 11044 sig:= opkaldskø.ref(5) shift (-20);
6 11045 end
5 11046 else res:=19; <* kø er tom *>
5 11047 end <*vogn=0 and omr=0 *>
4 11048 else
4 11049 begin
5 11050 <* vogn<>0 or omr<>0 *>
5 11051 i:= 0; tilst:= -1;
5 11052 if vogn shift(-22) = 1 then
5 11053 begin
6 11054 i:= find_busnr(vogn,nr,garage,tilst);
6 11055 l:= vogn;
6 11056 end
5 11057 else
5 11058 if vogn<>0 and (omr=0 or omr>2) then
5 11059 begin
6 11060 o:= 0;
6 11061 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 11062 if i=(-2) then
6 11063 begin
7 11064 o:= omr;
7 11065 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 11066 end;
6 11067 nr:= vogn extract 14;
6 11068 end
5 11069 else nr:= vogn extract 14;
5 11070 if i<0 then ref:= 0;
5 11071 while ref <> 0 and res = -1 do
5 11072 begin
6 11073 i:= opkaldskø.ref(2) extract 14;
6 11074 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 11075 if nr = i and
6 11076 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 11077 else
6 11078 begin
7 11079 ref:= opkaldskø.ref(1) extract 12;
7 11080 if ref = 0 and t = 2 then
7 11081 begin
8 11082 ref:= første_opkald;
8 11083 t:= if ref = 0 then 0 else 1;
8 11084 end else if ref = 0 then t:= 0;
7 11085 end;
6 11086 end; <*while*>
5 11087 \f
5 11087 message procedure udtag_opkald side 3 - 810603/hko;
5 11088
5 11088 if ref <> 0 then
5 11089 begin
6 11090 b:= nr;
6 11091 tm:= opkaldskø.ref(4);
6 11092 o:= tm extract 8;
6 11093 tm:= tm shift(-12);
6 11094 omr:= opkaldskø.ref(5) extract 4;
6 11095 sig:= opkaldskø.ref(5) shift (-20);
6 11096
6 11096 <*+4*> if tilst <> -1 then
6 11097 fejlreaktion(3<*prg.fejl*>,tilst,
6 11098 <:vogntabel_tilstand for vogn i kø:>,1);
6 11099 <*-4*>
6 11100 end;
5 11101 end;
4 11102
4 11102 if ref <> 0 then
4 11103 begin
5 11104 næste:= opkaldskø.ref(1);
5 11105 forrige:= næste shift(-12);
5 11106 næste:= næste extract 12;
5 11107 if forrige <> 0 then
5 11108 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 11109 + næste
5 11110 else if t = 1 then første_opkald:= næste
5 11111 else <*if t = 2 then*> første_nødopkald:= næste;
5 11112
5 11112 if næste <> 0 then
5 11113 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 11114 + forrige shift 12
5 11115 else if t = 1 then sidste_opkald:= forrige
5 11116 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 11117
5 11117 opkaldskø.ref(1):=første_frie_opkald;
5 11118 første_frie_opkald:=ref;
5 11119
5 11119 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 11120 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 11121 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 11122 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 11123 else
5 11124 begin
6 11125 sætbit_ia(opkaldsflag,operatør,1);
6 11126 sætbit_ia(opkaldsflag,o,1);
6 11127 end;
5 11128 signal_bin(bs_mobil_opkald);
5 11129 end;
4 11130 \f
4 11130 message procedure udtag_opkald side 4 - 810531/hko;
4 11131
4 11131 signal_bin(bs_opkaldskø_adgang);
4 11132 bus:= b;
4 11133 type:= t;
4 11134 ll:= l;
4 11135 ttmm:= tm;
4 11136 udtag_opkald:= res;
4 11137 end udtag opkald;
3 11138 \f
3 11138 message procedure frigiv_kanal side 1 - 810603/hko;
3 11139
3 11139 procedure frigiv_kanal(nr);
3 11140 value nr;
3 11141 integer nr;
3 11142 begin
4 11143 integer id1, id2, omr, i;
4 11144 integer array field iaf, vt_op;
4 11145
4 11145 iaf:= (nr-1)*kanal_beskrlængde;
4 11146 id1:= kanal_tab.iaf.kanal_id1;
4 11147 id2:= kanal_tab.iaf.kanal_id2;
4 11148 omr:= kanal_til_omr(nr);
4 11149 if id1 <> 0 then
4 11150 wait(ss_samtale_nedlagt(nr));
4 11151 if id1 shift (-22) < 3 and omr > 2 then
4 11152 begin
5 11153 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11154 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11155 if id1 shift (-22) = 2 then 18 else 17);
5 11156 d.vt_op.data(1):= id1;
5 11157 d.vt_op.data(4):= omr;
5 11158 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11159 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11160 signalch(cs_vt_adgang,vt_op,true);
5 11161 end;
4 11162
4 11162 if id2 <> 0 and id2 shift(-20) <> 12 then
4 11163 wait(ss_samtale_nedlagt(nr));
4 11164 if id2 shift (-22) < 3 and omr > 2 then
4 11165 begin
5 11166 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 11167 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11168 if id2 shift (-22) = 2 then 18 else 17);
5 11169 d.vt_op.data(1):= id2;
5 11170 d.vt_op.data(4):= omr;
5 11171 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 11172 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 11173 signalch(cs_vt_adgang,vt_op,true);
5 11174 end;
4 11175
4 11175 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 11176 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 11177 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 11178 shift (-10) extract 6 shift 10;
4 11179 <* repeat
4 11180 inspect(ss_samtale_nedlagt(nr),i);
4 11181 if i>0 then wait(ss_samtale_nedlagt(nr));
4 11182 until i<=0;
4 11183 *>
4 11184 end frigiv_kanal;
3 11185 \f
3 11185 message procedure hookoff side 1 - 880901/cl;
3 11186
3 11186 integer procedure hookoff(talevej,op,retursem,flash);
3 11187 value talevej,op,retursem,flash;
3 11188 integer talevej,op,retursem;
3 11189 boolean flash;
3 11190 begin
4 11191 integer array field opref;
4 11192
4 11192 opref:= op;
4 11193 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 11194 d.opref.data(1):= talevej;
4 11195 d.opref.data(2):= if flash then 2 else 1;
4 11196 signalch(cs_radio_ud,opref,rad_optype);
4 11197 <*V*> waitch(retursem,opref,rad_optype,-1);
4 11198 hookoff:= d.opref.resultat;
4 11199 end;
3 11200 \f
3 11200 message procedure hookon side 1 - 880901/cl;
3 11201
3 11201 integer procedure hookon(talevej,op,retursem);
3 11202 value talevej,op,retursem;
3 11203 integer talevej,op,retursem;
3 11204 begin
4 11205 integer i,res;
4 11206 integer array field opref;
4 11207
4 11207 if læsbit_ia(hookoff_maske,talevej) then
4 11208 begin
5 11209 inspect(bs_talevej_udkoblet(talevej),i);
5 11210 if i<=0 then
5 11211 begin
6 11212 opref:= op;
6 11213 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 11214 d.opref.data(1):= talevej;
6 11215 signalch(cs_radio_ud,opref,rad_optype);
6 11216 <*V*> waitch(retursem,opref,rad_optype,-1);
6 11217 res:= d.opref.resultat;
6 11218 end
5 11219 else
5 11220 res:= 0;
5 11221
5 11221 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 11222 end
4 11223 else
4 11224 res:= 0;
4 11225
4 11225 sætbit_ia(hookoff_maske,talevej,0);
4 11226 hookon:= res;
4 11227 end;
3 11228 \f
3 11228 message procedure radio side 2 - 820304/hko;
3 11229
3 11229 rad_op:= op;
3 11230
3 11230 trap(radio_trap);
3 11231 stack_claim((if cm_test then 200 else 150) +200);
3 11232
3 11232 <*+2*>if testbit32 and overvåget or testbit28 then
3 11233 skriv_radio(out,0);
3 11234 <*-2*>
3 11235 repeat
3 11236 waitch(cs_radio(talevej),opref,true,-1);
3 11237 <*+2*>
3 11238 if testbit33 and overvåget then
3 11239 disable begin
4 11240 skriv_radio(out,0);
4 11241 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 11242 skriv_op(out,opref);
4 11243 end;
3 11244 <*-2*>
3 11245
3 11245 k:= d.op_ref.opkode extract 12;
3 11246 opgave:= d.opref.opkode shift (-12);
3 11247 operatør:= d.op_ref.data(4);
3 11248
3 11248 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 11249 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 11250 <:radio:>,0);
3 11251 <*-4*>
3 11252 \f
3 11252 message procedure radio side 3 - 880930/cl;
3 11253 if k=41 <*radiokommando fra operatør*> then
3 11254 begin
4 11255 vogn:= d.opref.data(2);
4 11256 res:= -1;
4 11257 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 11258 sig:= 0; omr:= d.opref.data(3) extract 8;
4 11259 bus:= garage:= ll:= 0;
4 11260
4 11260 if opgave=1 or opgave=9 then
4 11261 begin <* opkald til enkelt vogn (CHF) *>
5 11262 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 11263 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 11264 <* ok at kø er tom når vogn er angivet eller VHF *>
5 11265
5 11265 d.opref.data(11):= if res=0 then
5 11266 (if ll<>0 then ll else bus) else vogn;
5 11267
5 11267 if type=2 <*nød*> then
5 11268 begin
6 11269 waitch(cs_radio_pulje,opref1,true,-1);
6 11270 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 11271 d.opref1.data(1):= if ll<>0 then ll else bus;
6 11272 systime(5,0,kl);
6 11273 d.opref1.data(2):= entier(kl/100.0);
6 11274 d.opref1.data(3):= omr;
6 11275 signalch(cs_io,opref1,gen_optype or rad_optype);
6 11276 end
5 11277 end; <* enkeltvogn (CHF) *>
4 11278
4 11278 <* check enkeltvogn for ledig *>
4 11279 if res<=0 and omr=2<*VHF*> and bus=0 and
4 11280 (opgave=1 or opgave=9) then
4 11281 begin
5 11282 for i:= 1 step 1 until max_antal_kanaler do
5 11283 if kanal_til_omr(i)=2 then nr:= i;
5 11284 iaf:= (nr-1)*kanalbeskrlængde;
5 11285 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 11286 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 11287 then res:= 52;
5 11288 end;
4 11289 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 11290 d.opref.data(3)=0 <*std. omr*>) and
4 11291 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 11292 then
4 11293 begin
5 11294 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 11295 if vogn shift (-22) = 1 then
5 11296 begin
6 11297 find_busnr(vogn,bus,garage,res);
6 11298 ll:= vogn;
6 11299 end
5 11300 else
5 11301 if vogn shift (-22) = 0 then
5 11302 begin
6 11303 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 11304 bus:= vogn;
6 11305 end
5 11306 else
5 11307 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 11308 res:= if res=(-1) then 18 <* i kø *> else
5 11309 (if res<>0 then 14 <*opt*> else 0);
5 11310 end
4 11311 else
4 11312 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 11313 opgave <= 2 then
4 11314 begin
5 11315 bus:= vogn; garage:= type:= ttmm:= 0;
5 11316 res:= 0; omr:= 0; sig:= 0;
5 11317 end
4 11318 else
4 11319 if opgave>1 and opgave<>9 then
4 11320 type:= ttmm:= res:= 0;
4 11321 \f
4 11321 message procedure radio side 4 - 880930/cl;
4 11322
4 11322 if res=0 and (opgave<=4 or opgave=9) and
4 11323 (omr<1 or 2<omr) and
4 11324 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 11325 begin <* reserver i vogntabel *>
5 11326 waitch(cs_vt_adgang,vt_op,true,-1);
5 11327 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 11328 if opgave <=2 or opgave=9 then 15 else 16);
5 11329 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 11330 (if vogn=0 then garage shift 14 + bus else
5 11331 if ll<>0 then ll else garage shift 14 + bus)
5 11332 else vogn <*gruppeid*>;
5 11333 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 11334 d.opref.data(3) extract 8
5 11335 else omr extract 8;
5 11336 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 11337 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 11338
5 11338 res:= d.vt_op.resultat;
5 11339 if res=3 then res:= 0;
5 11340 vtop2:= d.vt_op.data(2);
5 11341 vtop3:= d.vt_op.data(3);
5 11342 tekn_inf:= d.vt_op.data(4);
5 11343 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 11344 end;
4 11345
4 11345 if res<>0 then
4 11346 begin
5 11347 d.opref.resultat:= res;
5 11348 signalch(d.opref.retur,opref,d.opref.optype);
5 11349 end
4 11350 else
4 11351
4 11351 if opgave <= 9 then
4 11352 begin <* opkald *>
5 11353 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 11354 opgave<>9 and d.opref.data(6)<>0);
5 11355
5 11355 if res<>0 then
5 11356 goto returner_op;
5 11357
5 11357 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 11358 begin
6 11359 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 11360 'H' shift 12 + 60);
6 11361 d.rad_op.data(1):= talevej;
6 11362 d.rad_op.data(2):= 'D';
6 11363 d.rad_op.data(3):= 6; <* rear *>
6 11364 d.rad_op.data(4):= 1; <* rear no *>
6 11365 d.rad_op.data(5):= 0; <* disconnect *>
6 11366 signalch(cs_radio_ud,rad_op,rad_optype);
6 11367 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 11368 if d.rad_op.resultat<>0 then
6 11369 begin
7 11370 res:= d.rad_op.resultat;
7 11371 goto returner_op;
7 11372 end;
6 11373 <*
6 11374 while optaget_flag shift (-1) <> 0 do
6 11375 delay(1);
6 11376 *>
6 11377 end;
5 11378 \f
5 11378 message procedure radio side 5 - 880930/cl;
5 11379
5 11379 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 11380 'B' shift 12 + 60);
5 11381 d.rad_op.data(1):= talevej;
5 11382 d.rad_op.data(2):= 'D';
5 11383 d.rad_op.data(3):= if opgave=9 then 3 else
5 11384 (2 - (opgave extract 1)); <* højttalerkode *>
5 11385
5 11385 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11386 begin
6 11387 j:= 0;
6 11388 for i:= 2 step 1 until max_antal_områder do
6 11389 begin
7 11390 if opgave > 6 or
7 11391 (d.opref.data(3) shift (-20) = 15 and
7 11392 læsbiti(d.opref.data(3),i)) or
7 11393 (d.opref.data(3) shift (-20) = 14 and
7 11394 d.opref.data(3) extract 20 = i)
7 11395 then
7 11396 begin
8 11397 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11398 begin
9 11399 j:= j+1;
9 11400 d.rad_op.data(10+(j-1)*2):=
9 11401 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11402 (if i=2<*VHF*> then 4 else k)
9 11403 shift 8 + <* signal type *>
9 11404 1; <* antal tno *>
9 11405 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11406 end;
8 11407 end;
7 11408 end;
6 11409 d.rad_op.data(4):= j;
6 11410 d.rad_op.data(5):= 0;
6 11411 end
5 11412 else
5 11413 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11414 begin
6 11415 d.rad_op.data(4):= vtop2;
6 11416 d.rad_op.data(5):= vtop3;
6 11417 end
5 11418 else
5 11419 begin <* enkeltvogn *>
6 11420 if omr=0 then
6 11421 begin
7 11422 sig:= tekn_inf shift (-23);
7 11423 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11424 else tekn_inf extract 8;
7 11425 end
6 11426 else
6 11427 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11428
6 11428 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11429 <* tvinges til alm. opkald *>
6 11430 if (opgave=9) and (type=2) and (omr<=3) then
6 11431 begin
7 11432 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11433 opgave:= 1;
7 11434 d.radop.data(3):= 1;
7 11435 end;
6 11436
6 11436 if omr=2 <*VHF*> then sig:= 4 else
6 11437 if omr=1 <*TLF*> then sig:= 7 else
6 11438 <*UHF*> sig:= sig+1;
6 11439 d.rad_op.data(4):= 1;
6 11440 d.rad_op.data(5):= 0;
6 11441 d.rad_op.data(10):=
6 11442 (område_id(omr,2) extract 12) shift 12 +
6 11443 sig shift 8 +
6 11444 1;
6 11445 d.rad_op.data(11):= bus;
6 11446 end;
5 11447 \f
5 11447 message procedure radio side 6 - 880930/cl;
5 11448
5 11448 signalch(cs_radio_ud,rad_op,rad_optype);
5 11449 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11450 res:= d.rad_op.resultat;
5 11451
5 11451 d.rad_op.data(6):= 0;
5 11452 for i:= 1 step 1 until max_antal_områder do
5 11453 if læsbiti(d.rad_op.data(7),i) then
5 11454 increase(d.rad_op.data(6));
5 11455 returner_op:
5 11456 if d.rad_op.data(6)=1 then
5 11457 begin
6 11458 for i:= 1 step 1 until max_antal_områder do
6 11459 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11460 d.opref.data(12):= 14 shift 20 + i;
6 11461 end
5 11462 else
5 11463 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11464 d.opref.data(7):= type;
5 11465 d.opref.data(8):= garage shift 14 + bus;
5 11466 d.opref.data(9):= ll;
5 11467 if res=0 then
5 11468 begin
6 11469 d.opref.resultat:= 3;
6 11470 d.opref.data(5):= d.opref.data(6);
6 11471 j:= 0;
6 11472 for i:= 1 step 1 until max_antal_kanaler do
6 11473 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11474 if j>1 then
6 11475 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11476 else
6 11477 begin
7 11478 j:= 0;
7 11479 for i:= 1 step 1 until max_antal_kanaler do
7 11480 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11481 d.opref.data(6):= 3 shift 22 + j;
7 11482 end;
6 11483 d.opref.data(7):= type;
6 11484 d.opref.data(8):= garage shift 14 + bus;
6 11485 d.opref.data(9):= ll;
6 11486 d.opref.data(10):= d.opref.data(6);
6 11487 for i:= 1 step 1 until max_antal_kanaler do
6 11488 begin
7 11489 if læsbiti(d.rad_op.data(9),i) then
7 11490 begin
8 11491 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11492 j:= pabx_id( kanal_id(i) extract 5 )
8 11493 else
8 11494 j:= radio_id( kanal_id(i) extract 5 );
8 11495 if j>0 and type=0 and operatør>0 then tæl_opkald(j,1);
8 11496
8 11496 iaf:= (i-1)*kanalbeskrlængde;
8 11497 skrivtegn(kanal_tab.iaf,1,talevej);
8 11498 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11499 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11500 kanal_tab.iaf.kanal_id1:=
8 11501 if opgave<=2 or opgave=9 then
8 11502 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11503 else
8 11504 d.opref.data(2);
8 11505 kanal_tab.iaf.kanal_alt_id1:=
8 11506 if opgave<=2 or opgave=9 then
8 11507 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11508 else
8 11509 0;
8 11510 if kanal_tab.iaf.kanal_id1=0 then
8 11511 kanal_tab.iaf.kanal_id1:= 10000;
8 11512 kanal_tab.iaf.kanal_spec:=
8 11513 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11514 end;
7 11515 end;
6 11516 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11517 sætbit_ia(kanalflag,operatør,1);
6 11518 \f
6 11518 message procedure radio side 7 - 880930/cl;
6 11519
6 11519 end
5 11520 else
5 11521 begin
6 11522 d.opref.resultat:= res;
6 11523 if res=20 or res=52 then
6 11524 begin <* tæl ej.forb og opt.kanal *>
7 11525 for i:= 1 step 1 until max_antal_områder do
7 11526 if læsbiti(d.rad_op.data(7),i) then
7 11527 tæl_opkald(i,(if res=20 then 4 else 5));
7 11528 end;
6 11529 if d.opref.data(6)=0 then
6 11530 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11531 <* frigiv fra vogntabel hvis reserveret *>
6 11532 if (opgave<=4 or opgave=9) and
6 11533 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11534 begin
7 11535 waitch(cs_vt_adgang,vt_op,true,-1);
7 11536 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11537 if opgave<=2 or opgave=9 then 17 else 18);
7 11538 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11539 (if vogn=0 then garage shift 14 + bus else
7 11540 if ll<>0 then ll else garage shift 14 + bus)
7 11541 else vogn;
7 11542 d.vt_op.data(4):= omr;
7 11543 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11544 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11545 signalch(cs_vt_adgang,vt_op,true);
7 11546 end;
6 11547 end;
5 11548 signalch(d.opref.retur,opref,d.opref.optype);
5 11549 \f
5 11549 message procedure radio side 8 - 880930/cl;
5 11550
5 11550 end <* opkald *>
4 11551 else
4 11552 if opgave = 10 <* MONITER *> then
4 11553 begin
5 11554 nr:= d.opref.data(2);
5 11555 if nr shift (-20) <> 12 then
5 11556 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11557 nr:= nr extract 20;
5 11558 iaf:= (nr-1)*kanalbeskrlængde;
5 11559 inspect(ss_samtale_nedlagt(nr),i);
5 11560 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11561 kanal_tab.iaf.kanal_id2 extract 20
5 11562 else
5 11563 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11564 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11565 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11566 (i<>0 or j<>0) then
5 11567 begin
6 11568 res:= 0;
6 11569 d.opref.data(5):= 12 shift 20 + k;
6 11570 d.opref.data(6):= 12 shift 20 + nr;
6 11571 sætbit_ia(kanalflag,operatør,1);
6 11572 goto radio_nedlæg;
6 11573 end
5 11574 else
5 11575 if i<>0 or j<>0 then
5 11576 res:= 49
5 11577 else
5 11578 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11579 res:= 49 <* ingen samtale igang *>
5 11580 else
5 11581 begin
6 11582 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11583 if res=0 then
6 11584 begin
7 11585 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11586 'B' shift 12 + 60);
7 11587 d.rad_op.data(1):= talevej;
7 11588 d.rad_op.data(2):= 'V';
7 11589 d.rad_op.data(3):= 0;
7 11590 d.rad_op.data(4):= 1;
7 11591 d.rad_op.data(5):= 0;
7 11592 d.rad_op.data(10):=
7 11593 (kanal_id(nr) shift (-5) shift 18) +
7 11594 (kanal_id(nr) extract 5 shift 12) + 0;
7 11595 signalch(cs_radio_ud,rad_op,rad_optype);
7 11596 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11597 res:= d.rad_op.resultat;
7 11598 if res=0 then
7 11599 begin
8 11600 d.opref.data(5):= 0;
8 11601 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11602 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11603 res:= 3;
8 11604 end;
7 11605 end;
6 11606 end;
5 11607 \f
5 11607 message procedure radio side 9 - 880930/cl;
5 11608 if res=3 then
5 11609 begin
6 11610 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11611 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11612 else
6 11613 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11614 d.opref.data(6):= 12 shift 20 + nr;
6 11615 i:= kanal_tab.iaf.kanal_id2;
6 11616 if i<>0 then
6 11617 begin
7 11618 if i shift (-20) = 12 then
7 11619 begin <* ident2 henviser til anden kanal *>
8 11620 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11621 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11622 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11623 else
8 11624 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11625 d.opref.data(5):= 12 shift 20 + i;
8 11626 end
7 11627 else
7 11628 d.opref.data(5):= 12 shift 20 + nr;
7 11629 end
6 11630 else
6 11631 d.opref.data(5):= 0;
6 11632 end;
5 11633
5 11633 if res<>3 then
5 11634 begin
6 11635 res:= 0;
6 11636 sætbit_ia(kanalflag,operatør,1);
6 11637 goto radio_nedlæg;
6 11638 end;
5 11639 d.opref.resultat:= res;
5 11640 signalch(d.opref.retur,opref,d.opref.optype);
5 11641 \f
5 11641 message procedure radio side 10 - 880930/cl;
5 11642
5 11642 end <* MONITERING *>
4 11643 else
4 11644 if opgave = 11 then <* GENNEMSTILLING *>
4 11645 begin
5 11646 nr:= d.opref.data(6) extract 20;
5 11647 k:= if d.opref.data(5) shift (-20) = 12 then
5 11648 d.opref.data(5) extract 20
5 11649 else
5 11650 0;
5 11651 inspect(ss_samtale_nedlagt(nr),i);
5 11652 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11653 if i<>0 and j<>0 then
5 11654 begin
6 11655 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11656 goto radio_nedlæg;
6 11657 end;
5 11658
5 11658 iaf:= (nr-1)*kanal_beskr_længde;
5 11659 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11660 begin
6 11661 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11662 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11663 then
6 11664 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11665 else
6 11666 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11667 d.opref.data(5)<>0
6 11668 then
6 11669 res:= 0
6 11670 else
6 11671 res:= 21; <* ingen at gennemstille til *>
6 11672 end
5 11673 else
5 11674 res:= 50; <* kanalnr *>
5 11675
5 11675 if res=0 then
5 11676 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11677 if res=0 then
5 11678 begin
6 11679 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11680 kanal_tab.iaf.kanal_tilstand:=
6 11681 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11682 d.opref.data(6):= 0;
6 11683 if kanal_tab.iaf.kanal_id2=0 then
6 11684 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11685
6 11685 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11686 begin <* gennemstillet til anden kanal *>
7 11687 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11688 *kanalbeskrlængde;
7 11689 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11690 kanal_tab.iaf1.kanal_tilstand:=
7 11691 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11692 if kanal_tab.iaf1.kanal_id2=0 then
7 11693 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11694 end;
6 11695 d.opref.data(5):= 0;
6 11696
6 11696 res:= 3;
6 11697 end;
5 11698
5 11698 d.opref.resultat:= res;
5 11699 signalch(d.opref.retur,opref,d.opref.optype);
5 11700 \f
5 11700 message procedure radio side 11 - 880930/cl;
5 11701
5 11701 end
4 11702 else
4 11703 if opgave = 12 then <* NEDLÆG *>
4 11704 begin
5 11705 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11706 radio_nedlæg:
5 11707 if res=0 then
5 11708 begin
6 11709 for k:= 5, 6 do
6 11710 begin
7 11711 if d.opref.data(k) shift (-20) = 12 then
7 11712 begin
8 11713 i:= d.opref.data(k) extract 20;
8 11714 iaf:= (i-1)*kanalbeskrlængde;
8 11715 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11716 frigiv_kanal(d.opref.data(k) extract 20)
8 11717 else
8 11718 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11719 end
7 11720 else
7 11721 if d.opref.data(k) shift (-20) = 13 then
7 11722 begin
8 11723 for i:= 1 step 1 until max_antal_kanaler do
8 11724 if læsbiti(d.opref.data(k),i) then
8 11725 begin
9 11726 iaf:= (i-1)*kanalbeskrlængde;
9 11727 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11728 frigiv_kanal(i)
9 11729 else
9 11730 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11731 end;
8 11732 sætbit_ia(kanalflag,operatør,1);
8 11733 end;
7 11734 end;
6 11735 d.opref.data(5):= 0;
6 11736 d.opref.data(6):= 0;
6 11737 d.opref.data(9):= 0;
6 11738 res:= if opgave=12 then 3 else 49;
6 11739 end;
5 11740 d.opref.resultat:= res;
5 11741 signalch(d.opref.retur,opref,d.opref.optype);
5 11742 end
4 11743 else
4 11744 if opgave=13 then <* R *>
4 11745 begin
5 11746 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11747 'H' shift 12 + 60);
5 11748 d.rad_op.data(1):= talevej;
5 11749 d.rad_op.data(2):= 'M';
5 11750 d.rad_op.data(3):= 0; <*tkt*>
5 11751 d.rad_op.data(4):= 0; <*tkn*>
5 11752 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11753 signalch(cs_radio_ud,rad_op,rad_optype);
5 11754 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11755 res:= d.rad_op.resultat;
5 11756 d.opref.resultat:= if res=0 then 3 else res;
5 11757 signalch(d.opref.retur,opref,d.opref.optype);
5 11758 end
4 11759 else
4 11760 if opgave=14 <* VENTEPOS *> then
4 11761 begin
5 11762 res:= 0;
5 11763 while (res<=3 and d.opref.data(2)>0) do
5 11764 begin
6 11765 nr:= d.opref.data(6) extract 20;
6 11766 k:= if d.opref.data(5) shift (-20) = 12 then
6 11767 d.opref.data(5) extract 20
6 11768 else
6 11769 0;
6 11770 inspect(ss_samtale_nedlagt(nr),i);
6 11771 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11772 if i<>0 or j<>0 then
6 11773 begin
7 11774 res:= hookon(talevej,radop,cs_radio(talevej));
7 11775 goto radio_nedlæg;
7 11776 end;
6 11777
6 11777 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11778
6 11778 if res=0 then
6 11779 begin
7 11780 i:= d.opref.data(5);
7 11781 d.opref.data(5):= d.opref.data(6);
7 11782 d.opref.data(6):= i;
7 11783 res:= 3;
7 11784 end;
6 11785
6 11785 d.opref.data(2):= d.opref.data(2)-1;
6 11786 end;
5 11787 d.opref.resultat:= res;
5 11788 signalch(d.opref.retur,opref,d.opref.optype);
5 11789 end
4 11790 else
4 11791 begin
5 11792 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11793 d.opref.resultat:= 31;
5 11794 signalch(d.opref.retur,opref,d.opref.optype);
5 11795 end;
4 11796
4 11796 end <* radiokommando fra operatør *>
3 11797 else
3 11798 begin
4 11799
4 11799 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11800
4 11800 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11801
4 11801 end;
3 11802
3 11802 until false;
3 11803 radio_trap:
3 11804 disable skriv_radio(zbillede,1);
3 11805 end radio;
2 11806 \f
2 11806 message procedure radio_ind side 1 - 810521/hko;
2 11807
2 11807 procedure radio_ind(op);
2 11808 value op;
2 11809 integer op;
2 11810 begin
3 11811 integer array field op_ref,ref,io_opref;
3 11812 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11813 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11814 integer array typ, val(1:6), answ, tlgr(1:32);
3 11815 integer array field spec;
3 11816 real field rf;
3 11817 long array field laf;
3 11818
3 11818 procedure skriv_radio_ind(zud,omfang);
3 11819 value omfang;
3 11820 zone zud;
3 11821 integer omfang;
3 11822 begin integer ii;
4 11823 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11824 if omfang > 0 then
4 11825 disable begin integer x; long array field tx;
5 11826 tx:= 0;
5 11827 trap(slut);
5 11828 write(zud,"nl",1,
5 11829 <: op-ref: :>,op_ref,"nl",1,
5 11830 <: ref: :>,ref,"nl",1,
5 11831 <: io-opref: :>,io_opref,"nl",1,
5 11832 <: ac: :>,ac,"nl",1,
5 11833 <: lgd: :>,lgd,"nl",1,
5 11834 <: ttyp: :>,ttyp,"nl",1,
5 11835 <: ptyp: :>,ptyp,"nl",1,
5 11836 <: pnum: :>,pnum,"nl",1,
5 11837 <: pos: :>,pos,"nl",1,
5 11838 <: tegn: :>,tegn,"nl",1,
5 11839 <: bs: :>,bs,"nl",1,
5 11840 <: b-pt: :>,b_pt,"nl",1,
5 11841 <: b-pn: :>,b_pn,"nl",1,
5 11842 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11843 <: antal-spec: :>,antal_spec,"nl",1,
5 11844 <: sum: :>,sum,"nl",1,
5 11845 <: csum: :>,csum,"nl",1,
5 11846 <: i: :>,i,"nl",1,
5 11847 <: j: :>,j,"nl",1,
5 11848 <: k: :>,k,"nl",1,
5 11849 <: filref :>,filref,"nl",1,
5 11850 <: zno: :>,zno,"nl",1,
5 11851 <: answ: :>,answ.tx,"nl",1,
5 11852 <: tlgr: :>,tlgr.tx,"nl",1,
5 11853 <: spec: :>,spec,"nl",1);
5 11854 trap(slut);
5 11855 slut:
5 11856 end; <*disable*>
4 11857 end skriv_radio_ind;
3 11858 \f
3 11858 message procedure indsæt_opkald side 1 - 811105/hko;
3 11859
3 11859 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11860 value bus,type,omr,sig;
3 11861 integer bus,type,omr,sig;
3 11862 begin
4 11863 integer res,tilst,ll,operatør;
4 11864 integer array field vt_op,ref,næste,forrige;
4 11865 real r;
4 11866
4 11866 res:= -1;
4 11867 begin
5 11868 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11869 if vt_op <> 0 then
5 11870 begin
6 11871 wait(bs_opkaldskø_adgang);
6 11872 if omr>2 then
6 11873 begin
7 11874 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11875 d.vt_op.data(1):= bus;
7 11876 d.vt_op.data(4):= omr;
7 11877 tilst:= vt_op;
7 11878 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11879 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11880 <*+4*> if tilst <> vt_op then
7 11881 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11882 <*-4*>
7 11883 <*+2*> if testbit34 and overvåget then
7 11884 disable begin
8 11885 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11886 skriv_op(out,vt_op);
8 11887 ud;
8 11888 end;
7 11889 end
6 11890 else
6 11891 begin
7 11892 d.vt_op.data(1):= bus;
7 11893 d.vt_op.data(2):= 0;
7 11894 d.vt_op.data(3):= bus;
7 11895 d.vt_op.data(4):= omr;
7 11896 d.vt_op.resultat:= 0;
7 11897 ref:= første_nødopkald;
7 11898 if ref<>0 then tilst:= 2
7 11899 else
7 11900 begin
8 11901 ref:= første_opkald;
8 11902 tilst:= if ref=0 then 0 else 1;
8 11903 end;
7 11904 if tilst=0 then
7 11905 d.vt_op.resultat:= 3
7 11906 else
7 11907 begin
8 11908 while ref<>0 and d.vt_op.resultat=0 do
8 11909 begin
9 11910 if opkaldskø.ref(2) extract 14 = bus and
9 11911 opkaldskø.ref(5) extract 8 = omr
9 11912 then
9 11913 d.vt_op.resultat:= 18
9 11914 else
9 11915 begin
10 11916 ref:= opkaldskø.ref(1) extract 12;
10 11917 if ref=0 and tilst=2 then
10 11918 begin
11 11919 ref:= første_opkald;
11 11920 tilst:= if ref=0 then 0 else 1;
11 11921 end
10 11922 else
10 11923 if ref=0 then tilst:= 0;
10 11924 end;
9 11925 end;
8 11926 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11927 end;
7 11928 end;
6 11929 <*-2*>
6 11930 \f
6 11930 message procedure indsæt_opkald side 1a- 820301/hko;
6 11931
6 11931 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11932 begin
7 11933 ref:=første_opkald;
7 11934 tilst:=-1;
7 11935 while ref<>0 and tilst=-1 do
7 11936 begin
8 11937 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11938 begin <* udtag normalopkald *>
9 11939 næste:=opkaldskø.ref(1);
9 11940 forrige:=næste shift(-12);
9 11941 næste:=næste extract 12;
9 11942 if forrige<>0 then
9 11943 opkaldskø.forrige(1):=
9 11944 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11945 else
9 11946 første_opkald:=næste;
9 11947 if næste<>0 then
9 11948 opkaldskø.næste(1):=
9 11949 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11950 else
9 11951 sidste_opkald:=forrige;
9 11952 opkaldskø.ref(1):=første_frie_opkald;
9 11953 første_frie_opkald:=ref;
9 11954 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11955 tilst:=0;
9 11956 end
8 11957 else
8 11958 ref:=opkaldskø.ref(1) extract 12;
8 11959 end; <*while*>
7 11960 if tilst=0 then
7 11961 d.vt_op.resultat:=3;
7 11962 end; <*nødopkald bus i kø*>
6 11963 \f
6 11963 message procedure indsæt_opkald side 2 - 820304/hko;
6 11964
6 11964 if d.vt_op.resultat = 3 then
6 11965 begin
7 11966 ll:= d.vt_op.data(2);
7 11967 tilst:= d.vt_op.data(3);
7 11968 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11969 if operatør < 0 or max_antal_operatører < operatør then
7 11970 operatør:= 0;
7 11971 if operatør=0 then
7 11972 operatør:= (tilst shift (-14) extract 8);
7 11973 if operatør=0 then
7 11974 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11975 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11976 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11977 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11978 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11979 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11980 forrige:= (if type = 1 then sidste_opkald
7 11981 else sidste_nødopkald);
7 11982 opkaldskø.ref(1):= forrige shift 12;
7 11983 if type = 1 then
7 11984 begin
8 11985 if første_opkald = 0 then første_opkald:= ref;
8 11986 sidste_opkald:= ref;
8 11987 end
7 11988 else
7 11989 begin <*type = 2*>
8 11990 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11991 sidste_nødopkald:= ref;
8 11992 end;
7 11993 if forrige <> 0 then
7 11994 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11995 shift 12 +ref;
7 11996
7 11996 opkaldskø.ref(2):= tilst extract 22 add
7 11997 (if type=2 then 1 shift 23 else 0);
7 11998 opkaldskø.ref(3):= ll;
7 11999 systime(5,0.0,r);
7 12000 ll:= round r//100;<*ttmm*>
7 12001 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 12002 opkaldskø.ref(5):= sig shift 20 + omr;
7 12003 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 12004 res:= 0;
7 12005 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 12006 opkaldskø_ledige:= opkaldskø_ledige -1;
7 12007 <*meddel opkald til berørte operatører *>
7 12008 signal_bin(bs_mobil_opkald);
7 12009 tæl_opkald(omr,type+1);
7 12010 end <* resultat = 3 *>
6 12011 else
6 12012 begin
7 12013 \f
7 12013 message procedure indsæt_opkald side 3 - 810601/hko;
7 12014
7 12014 <* d.vt_op.resultat <> 3 *>
7 12015
7 12015 res:= d.vt_op.resultat;
7 12016 if res = 10 then
7 12017 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 12018 <:er ikke i bustabel:>,1)
7 12019 else
7 12020 <*+4*> if res <> 14 and res <> 18 then
7 12021 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 12022 <*-4*>
7 12023 ;
7 12024 end;
6 12025 signalbin(bs_opkaldskø_adgang);
6 12026 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 12027 end
5 12028 else
5 12029 res:= -2; <*timeout for cs_vt_adgang*>
5 12030 end;
4 12031 indsæt_opkald:= res;
4 12032 end indsæt_opkald;
3 12033 \f
3 12033 message procedure afvent_telegram side 1 - 880901/cl;
3 12034
3 12034 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12035 integer array tlgr;
3 12036 integer lgd,ttyp,ptyp,pnum;
3 12037 begin
4 12038 integer i, pos, tegn, ac, sum, csum;
4 12039
4 12039 pos:= 1;
4 12040 lgd:= 0;
4 12041 ttyp:= 'Z';
4 12042 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 12043 if ac >= 0 then
4 12044 begin
5 12045 lgd:= 1;
5 12046 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 12047 lgd:= lgd-2;
5 12048 if lgd >= 3 then
5 12049 begin
6 12050 i:= 1;
6 12051 ttyp:= læstegn(tlgr,i,tegn);
6 12052 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 12053 pnum:= læstegn(tlgr,i,tegn) - '@';
6 12054 end
5 12055 else ac:= 6; <* for kort telegram - retransmitter *>
5 12056 end;
4 12057
4 12057 afvent_telegram:= ac;
4 12058 end;
3 12059 \f
3 12059 message procedure b_answ side 1 - 880901/cl;
3 12060
3 12060 procedure b_answ(answ,ht,spec,more,ac);
3 12061 value ht, more,ac;
3 12062 integer array answ, spec;
3 12063 boolean more;
3 12064 integer ht, ac;
3 12065 begin
4 12066 integer pos, i, sum, tegn;
4 12067
4 12067 pos:= 1;
4 12068 skrivtegn(answ,pos,'B');
4 12069 skrivtegn(answ,pos,if more then 'B' else ' ');
4 12070 skrivtegn(answ,pos,ac+'@');
4 12071 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 12072 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 12073 skrivtegn(answ,pos,'@');
4 12074 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 12075 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 12076 for i:= 1 step 1 until spec(1) extract 8 do
4 12077 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 12078 else
4 12079 begin
5 12080 skrivtegn(answ,pos,'D');
5 12081 anbringtal(answ,pos,spec(1+i),-4);
5 12082 end;
4 12083 for i:= 1 step 1 until 4 do
4 12084 skrivtegn(answ,pos,'@');
4 12085 skrivtegn(answ,pos,ht+'@');
4 12086 skrivtegn(answ,pos,'@');
4 12087
4 12087 i:= 1; sum:= 0;
4 12088 while i < pos do
4 12089 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 12090 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 12091 skrivtegn(answ,pos,sum extract 4 + '@');
4 12092 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 12093 end;
3 12094 \f
3 12094 message procedure ann_opkald side 1 - 881108/cl;
3 12095
3 12095 integer procedure ann_opkald(vogn,omr);
3 12096 value vogn,omr;
3 12097 integer vogn,omr;
3 12098 begin
4 12099 integer array field vt_op,ref,næste,forrige;
4 12100 integer res, t, i, o;
4 12101
4 12101 waitch(cs_vt_adgang,vt_op,true,-1);
4 12102 res:= -1;
4 12103 wait(bs_opkaldskø_adgang);
4 12104 ref:= første_nødopkald;
4 12105 if ref <> 0 then
4 12106 t:= 2
4 12107 else
4 12108 begin
5 12109 ref:= første_opkald;
5 12110 t:= if ref<>0 then 1 else 0;
5 12111 end;
4 12112
4 12112 if t=0 then
4 12113 res:= 19 <* kø tom *>
4 12114 else
4 12115 begin
5 12116 while ref<>0 and res=(-1) do
5 12117 begin
6 12118 if vogn=opkaldskø.ref(2) extract 14 and
6 12119 omr=opkaldskø.ref(5) extract 8
6 12120 then
6 12121 res:= 0
6 12122 else
6 12123 begin
7 12124 ref:= opkaldskø.ref(1) extract 12;
7 12125 if ref=0 and t=2 then
7 12126 begin
8 12127 ref:= første_opkald;
8 12128 t:= if ref=0 then 0 else 1;
8 12129 end;
7 12130 end;
6 12131 end; <*while*>
5 12132 \f
5 12132 message procedure ann_opkald side 2 - 881108/cl;
5 12133
5 12133 if ref<>0 then
5 12134 begin
6 12135 start_operation(vt_op,401,cs_radio_ind,17);
6 12136 d.vt_op.data(1):= vogn;
6 12137 d.vt_op.data(4):= omr;
6 12138 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 12139 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 12140
6 12140 o:= opkaldskø.ref(4) extract 8;
6 12141 næste:= opkaldskø.ref(1);
6 12142 forrige:= næste shift (-12);
6 12143 næste:= næste extract 12;
6 12144 if forrige<>0 then
6 12145 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 12146 + næste
6 12147 else
6 12148 if t=2 then første_nødopkald:= næste
6 12149 else første_opkald:= næste;
6 12150
6 12150 if næste<>0 then
6 12151 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 12152 + forrige shift 12
6 12153 else
6 12154 if t=2 then sidste_nødopkald:= forrige
6 12155 else sidste_opkald:= forrige;
6 12156
6 12156 opkaldskø.ref(1):= første_frie_opkald;
6 12157 første_frie_opkald:= ref;
6 12158 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 12159 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 12160
6 12160 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 12161 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 12162 else
6 12163 begin
7 12164 sætbit_ia(opkaldsflag,o,1);
7 12165 end;
6 12166 signalbin(bs_mobilopkald);
6 12167 end;
5 12168 end;
4 12169
4 12169 signalbin(bs_opkaldskø_adgang);
4 12170 signalch(cs_vt_adgang, vt_op, true);
4 12171 ann_opkald:= res;
4 12172 end;
3 12173 \f
3 12173 message procedure frigiv_id side 1 - 881114/cl;
3 12174
3 12174 integer procedure frigiv_id(id,omr);
3 12175 value id,omr;
3 12176 integer id,omr;
3 12177 begin
4 12178 integer array field vt_op;
4 12179
4 12179 if id shift (-22) < 3 and omr > 2 then
4 12180 begin
5 12181 waitch(cs_vt_adgang,vt_op,true,-1);
5 12182 start_operation(vt_op,401,cs_radio_ind,
5 12183 if id shift (-22) = 2 then 18 else 17);
5 12184 d.vt_op.data(1):= id;
5 12185 d.vt_op.data(4):= omr;
5 12186 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 12187 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 12188 frigiv_id:= d.vt_op.resultat;
5 12189 signalch(cs_vt_adgang,vt_op,true);
5 12190 end;
4 12191 end;
3 12192 \f
3 12192 message procedure radio_ind side 2 - 810524/hko;
3 12193 trap(radio_ind_trap);
3 12194 laf:= 0;
3 12195 stack_claim((if cm_test then 200 else 150) +135+75);
3 12196
3 12196 <*+2*>if testbit32 and overvåget or testbit28 then
3 12197 skriv_radio_ind(out,0);
3 12198 <*-2*>
3 12199 answ.laf(1):= long<:<'nl'>:>;
3 12200 io_opref:= op;
3 12201
3 12201 repeat
3 12202 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 12203 pos:= 4;
3 12204 if ac = 0 then
3 12205 begin
4 12206 \f
4 12206 message procedure radio_ind side 3 - 881107/cl;
4 12207 if ttyp = 'A' then
4 12208 begin
5 12209 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12210 ac:= 1
5 12211 else
5 12212 begin
6 12213 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 12214 val(1):= ttyp;
6 12215 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 12216 val(2):= pnum;
6 12217 typ(3):= -1;
6 12218 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12219 if opref>0 then
6 12220 begin
7 12221 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 12222 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 12223 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 12224 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 12225 then
7 12226 begin
8 12227 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 12228 end
7 12229 else
7 12230 begin
8 12231 ac:= 0;
8 12232 d.opref.resultat:= 0;
8 12233 sætbit_ia(hookoff_maske,pnum,1);
8 12234 end;
7 12235 signalch(d.opref.retur,opref,d.opref.optype);
7 12236 end
6 12237 else
6 12238 ac:= 2;
6 12239 end;
5 12240 pos:= 1;
5 12241 skrivtegn(answ,pos,'A');
5 12242 skrivtegn(answ,pos,' ');
5 12243 skrivtegn(answ,pos,ac+'@');
5 12244 for i:= 1 step 1 until 5 do
5 12245 skrivtegn(answ,pos,'@');
5 12246 skrivtegn(answ,pos,'0');
5 12247 i:= 1; sum:= 0;
5 12248 while i < pos do
5 12249 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12250 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12251 skrivtegn(answ,pos,sum extract 4 + '@');
5 12252 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12253 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12254 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12255 disable begin
6 12256 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12257 outchar(zrl,'nl');
6 12258 end;
5 12259 <*-2*>
5 12260 disable setposition(z_fr_out,0,0);
5 12261 ac:= -1;
5 12262 \f
5 12262 message procedure radio_ind side 4 - 881107/cl;
5 12263 end <* ttyp=A *>
4 12264 else
4 12265 if ttyp = 'B' then
4 12266 begin
5 12267 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12268 ac:= 1
5 12269 else
5 12270 begin
6 12271 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 12272 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 12273 typ(3):= -1;
6 12274 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12275 if opref > 0 then
6 12276 begin
7 12277 <*+2*> if testbit37 and overvåget then
7 12278 disable begin
8 12279 skriv_radio_ind(out,0);
8 12280 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 12281 skriv_op(out,opref);
8 12282 end;
7 12283 <*-2*>
7 12284 læstegn(tlgr,pos,bs);
7 12285 if bs = 'V' then
7 12286 begin
8 12287 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 12288 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 12289 end;
7 12290 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 12291 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 12292 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 12293 then
7 12294 begin
8 12295 ac:= 1;
8 12296 d.opref.resultat:= 31; <* systemfejl *>
8 12297 signalch(d.opref.retur,opref,d.opref.optype);
8 12298 end
7 12299 else
7 12300 if bs='V' then
7 12301 begin
8 12302 ac:= 0;
8 12303 d.opref.resultat:= 1;
8 12304 d.opref.data(4):= 0;
8 12305 d.opref.data(7):=
8 12306 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 12307 radio_id(b_pn));
8 12308 systime(1,0.0,d.opref.tid);
8 12309 signalch(cs_radio_ind,opref,d.opref.optype);
8 12310 spec:= data+18;
8 12311 b_answ(answ,0,d.opref.spec,false,ac);
8 12312 <*+2*> if (testbit36 or testbit38) and overvåget then
8 12313 disable begin
9 12314 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 12315 outchar(zrl,'nl');
9 12316 end;
8 12317 <*-2*>
8 12318 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 12319 disable setposition(z_fr_out,0,0);
8 12320 ac:= -1;
8 12321 \f
8 12321 message procedure radio_ind side 5 - 881107/cl;
8 12322 end
7 12323 else
7 12324 begin
8 12325 integer sig_type;
8 12326
8 12326 ac:= 0;
8 12327 antal_spec:= d.opref.data(4);
8 12328 filref:= d.opref.data(5);
8 12329 spec:= d.opref.data(6);
8 12330 if antal_spec>0 then
8 12331 begin
9 12332 antal_spec:= antal_spec-1;
9 12333 if filref<>0 then
9 12334 begin
10 12335 læsfil(filref,1,zno);
10 12336 b_pt:= fil(zno).spec(1) shift (-12);
10 12337 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 12338 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 12339 antal_spec>0,ac);
10 12340 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 12341 end
9 12342 else
9 12343 begin
10 12344 b_pt:= d.opref.spec(1) shift (-12);
10 12345 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 12346 b_answ(answ,d.opref.data(3),d.opref.spec,
10 12347 antal_spec>0,ac);
10 12348 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 12349 end;
9 12350
9 12350 <* send answer *>
9 12351 <*+2*> if (testbit36 or testbit38) and overvåget then
9 12352 disable begin
10 12353 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 12354 outchar(zrl,'nl');
10 12355 end;
9 12356 <*-2*>
9 12357 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 12358 disable setposition(z_fr_out,0,0);
9 12359 if ac<>0 then
9 12360 begin
10 12361 antal_spec:= 0;
10 12362 ac:= -1;
10 12363 end
9 12364 else
9 12365 begin
10 12366 for i:= 1 step 1 until max_antal_områder do
10 12367 if område_id(i,2)=b_pt then
10 12368 begin
11 12369 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 12370 if sætbiti(d.opref.data(7),j,1)=0 then
11 12371 d.opref.resultat:= d.opref.resultat + 1;
11 12372 end;
10 12373 end;
9 12374 end;
8 12375 \f
8 12375 message procedure radio_ind side 6 - 881107/cl;
8 12376
8 12376 <* afvent nyt telegram *>
8 12377 d.opref.data(4):= antal_spec;
8 12378 d.opref.data(6):= spec;
8 12379 ac:= -1;
8 12380 systime(1,0.0,d.opref.tid);
8 12381 <*+2*> if testbit37 and overvåget then
8 12382 disable begin
9 12383 skriv_radio_ind(out,0);
9 12384 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 12385 ud;
9 12386 end;
8 12387 <*-2*>
8 12388 signalch(cs_radio_ind,opref,d.opref.optype);
8 12389 end;
7 12390 end
6 12391 else ac:= 2;
6 12392 end;
5 12393 if ac > 0 then
5 12394 begin
6 12395 for i:= 1 step 1 until 6 do val(i):= 0;
6 12396 b_answ(answ,0,val,false,ac);
6 12397 <*+2*>
6 12398 if (testbit36 or testbit38) and overvåget then
6 12399 disable begin
7 12400 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12401 outchar(zrl,'nl');
7 12402 end;
6 12403 <*-2*>
6 12404 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12405 disable setposition(z_fr_out,0,0);
6 12406 ac:= -1;
6 12407 end;
5 12408 \f
5 12408 message procedure radio_ind side 7 - 881107/cl;
5 12409 end <* ttyp = 'B' *>
4 12410 else
4 12411 if ttyp='C' or ttyp='J' then
4 12412 begin
5 12413 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12414 ac:= 1
5 12415 else
5 12416 begin
6 12417 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12418 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12419 typ(3):= -1;
6 12420 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12421 if opref > 0 then
6 12422 begin
7 12423 d.opref.resultat:= d.opref.resultat - 1;
7 12424 if ttyp = 'C' then
7 12425 begin
8 12426 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12427 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12428 j:= 0;
8 12429 for i:= 1 step 1 until max_antal_kanaler do
8 12430 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12431 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12432 d.opref.resultat:= d.opref.resultat-1;
8 12433 sætbiti(optaget_flag,j,1);
8 12434 sætbiti(d.opref.data(9),j,1);
8 12435 end
7 12436 else
7 12437 begin <* INGEN FORBINDELSE *>
8 12438 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12439 end;
7 12440 ac:= 0;
7 12441 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12442 begin
8 12443 systime(1,0,d.opref.tid);
8 12444 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12445 end
7 12446 else
7 12447 begin
8 12448 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12449 if læsbiti(d.opref.data(8),9) then 52 else
8 12450 if læsbiti(d.opref.data(8),10) then 20 else
8 12451 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12452 signalch(d.opref.retur, opref, d.opref.optype);
8 12453 end;
7 12454 end
6 12455 else
6 12456 ac:= 2;
6 12457 end;
5 12458 pos:= 1;
5 12459 skrivtegn(answ,pos,ttyp);
5 12460 skrivtegn(answ,pos,' ');
5 12461 skrivtegn(answ,pos,ac+'@');
5 12462 i:= 1; sum:= 0;
5 12463 while i < pos do
5 12464 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12465 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12466 skrivtegn(answ,pos,sum extract 4 + '@');
5 12467 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12468 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12469 disable begin
6 12470 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12471 outchar(zrl,'nl');
6 12472 end;
5 12473 <*-2*>
5 12474 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12475 disable setposition(z_fr_out,0,0);
5 12476 ac:= -1;
5 12477 \f
5 12477 message procedure radio_ind side 8 - 881107/cl;
5 12478 end <* ttyp = 'C' or 'J' *>
4 12479 else
4 12480 if ttyp = 'D' then
4 12481 begin
5 12482 if ptyp = 4 <* VDU *> then
5 12483 begin
6 12484 if pnum<1 or pnum>max_antal_taleveje then
6 12485 ac:= 1
6 12486 else
6 12487 begin
7 12488 inspect(bs_talevej_udkoblet(pnum),j);
7 12489 if j>=0 then
7 12490 begin
8 12491 sætbit_ia(samtaleflag,pnum,1);
8 12492 signal_bin(bs_mobil_opkald);
8 12493 end;
7 12494 if læsbit_ia(hookoff_maske,pnum) then
7 12495 signalbin(bs_talevej_udkoblet(pnum));
7 12496 ac:= 0;
7 12497 end
6 12498 end
5 12499 else
5 12500 if ptyp=3 or ptyp=2 then
5 12501 begin
6 12502 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12503 ptyp=2 and pnum<>2
6 12504 then
6 12505 ac:= 1
6 12506 else
6 12507 begin
7 12508 if læstegn(tlgr,5,tegn)='D' then
7 12509 begin <* teknisk nr i telegram *>
8 12510 b_pn:= 0;
8 12511 for i:= 1 step 1 until 4 do
8 12512 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12513 end
7 12514 else
7 12515 b_pn:= 0;
7 12516 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12517 i:= 0;
7 12518 for j:= 1 step 1 until max_antal_kanaler do
7 12519 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12520 if i<>0 then
7 12521 begin
8 12522 ref:= (i-1)*kanalbeskrlængde;
8 12523 inspect(ss_samtale_nedlagt(i),j);
8 12524 if j>=0 then
8 12525 begin
9 12526 sætbit_ia(samtaleflag,
9 12527 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12528 signalbin(bs_mobil_opkald);
9 12529 end;
8 12530 signal(ss_samtale_nedlagt(i));
8 12531 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12532 begin
9 12533 if kanal_tab.ref.kanal_id1<>0 and
9 12534 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12535 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12536 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12537 if kanal_tab.ref.kanal_id2<>0 and
9 12538 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12539 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12540 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12541 end;
8 12542 sætbiti(optaget_flag,i,0);
8 12543 end;
7 12544 ac:= 0;
7 12545 end;
6 12546 end
5 12547 else ac:= 1;
5 12548 if ac>=0 then
5 12549 begin
6 12550 pos:= i:= 1; sum:= 0;
6 12551 skrivtegn(answ,pos,'D');
6 12552 skrivtegn(answ,pos,' ');
6 12553 skrivtegn(answ,pos,ac+'@');
6 12554 skrivtegn(answ,pos,'@');
6 12555 while i<pos do
6 12556 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12557 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12558 skrivtegn(answ,pos, sum extract 4 + '@');
6 12559 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12560 <*+2*>
6 12561 if (testbit36 or testbit38) and overvåget then
6 12562 disable begin
7 12563 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12564 outchar(zrl,'nl');
7 12565 end;
6 12566 <*-2*>
6 12567 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12568 disable setposition(z_fr_out,0,0);
6 12569 ac:= -1;
6 12570 end;
5 12571 \f
5 12571 message procedure radio_ind side 9 - 881107/cl;
5 12572 end <* ttyp = D *>
4 12573 else
4 12574 if ttyp='H' then
4 12575 begin
5 12576 integer htyp;
5 12577
5 12577 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12578
5 12578 if htyp='A' then
5 12579 begin <*mobilopkald*>
6 12580 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12581 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12582 ac:= 1
6 12583 else
6 12584 begin
7 12585 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12586 if læstegn(tlgr,6,tegn)='D' then
7 12587 begin <*teknisk nr. i telegram*>
8 12588 b_pn:= 0;
8 12589 for i:= 1 step 1 until 4 do
8 12590 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12591 end
7 12592 else b_pn:= 0;
7 12593 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12594 <* opkaldstype *>
7 12595 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12596 if j>0 then
7 12597 begin
8 12598 if bs=10 then
8 12599 ann_opkald(b_pn,j)
8 12600 else
8 12601 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12602 ac:= 0;
8 12603 end else ac:= 1;
7 12604 end;
6 12605 \f
6 12605 message procedure radio_ind side 10 - 881107/cl;
6 12606 end
5 12607 else
5 12608 if htyp='E' then
5 12609 begin <* radiokanal status *>
6 12610 long onavn;
6 12611
6 12611 ac:= 0;
6 12612 j:= 0;
6 12613 for i:= 1 step 1 until max_antal_kanaler do
6 12614 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12615
6 12615 <* Alarmer for K12 = GLX ignoreres *>
6 12616 <* 94.06.14/CL *>
6 12617 <* Alarmer for K15 = HG ignoreres *>
6 12618 <* 95.07.31/CL *>
6 12619 <* Alarmer for K10 = FS ignoreres *>
6 12620 <* 96.05.27/CL *>
6 12621 if j>0 then
6 12622 begin
7 12623 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12624 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>) or
7 12625 (onavn = long<:FS:>) then 0 else j);
7 12626 end;
6 12627
6 12627 læstegn(tlgr,9,tegn);
6 12628 if j<>0 and (tegn='A' or tegn='E') then
6 12629 begin
7 12630 ref:= (j-1)*kanalbeskrlængde;
7 12631 bs:= if tegn='E' then 0 else 15;
7 12632 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12633 begin
8 12634 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12635 signalbin(bs_mobil_opkald);
8 12636 end;
7 12637 end;
6 12638 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12639 begin
7 12640 waitch(cs_radio_pulje,opref,true,-1);
7 12641 startoperation(opref,401,cs_radio_pulje,23);
7 12642 i:= 1;
7 12643 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12644 if læstegn(tlgr,4,k)<>'@' then
7 12645 begin
8 12646 if k-'@' = 17 then
8 12647 hægtstring(d.opref.data,i,<: AMV:>)
8 12648 else
8 12649 if k-'@' = 18 then
8 12650 hægtstring(d.opref.data,i,<: BHV:>)
8 12651 else
8 12652 begin
9 12653 hægtstring(d.opref.data,i,<: BST:>);
9 12654 anbringtal(d.opref.data,i,k-'@',1);
9 12655 end;
8 12656 end;
7 12657 skrivtegn(d.opref.data,i,' ');
7 12658 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12659 skrivtegn(d.opref.data,i,' ');
7 12660 hægtstring(d.opref.data,i,
7 12661 string område_navn(kanal_til_omr(j)));
7 12662 if '@'<=tegn and tegn<='F' then
7 12663 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12664 <*@*> <:: ukendt fejl:>,
7 12665 <*A*> <:: compad-fejl:>,
7 12666 <*B*> <:: ladefejl:>,
7 12667 <*C*> <:: dør åben:>,
7 12668 <*D*> <:: senderfejl:>,
7 12669 <*E*> <:: compad ok:>,
7 12670 <*F*> <:: liniefejl:>,
7 12671 <::>))
7 12672 else
7 12673 begin
8 12674 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12675 skrivtegn(d.opref.data,i,tegn);
8 12676 end;
7 12677 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12678 signalch(cs_io,opref,gen_optype or rad_optype);
7 12679 ref:= (j-1)*kanalbeskrlængde;
7 12680 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12681 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12682 signalbin(bs_mobilopkald);
7 12683 end;
6 12684 \f
6 12684 message procedure radio_ind side 11 - 881107/cl;
6 12685 end
5 12686 else
5 12687 if htyp='G' then
5 12688 begin <* fjerninkludering/-ekskludering af område *>
6 12689 bs:= læstegn(tlgr,9,tegn)-'@';
6 12690 j:= 0;
6 12691 for i:= 1 step 1 until max_antal_kanaler do
6 12692 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12693 if j<>0 then
6 12694 begin
7 12695 ref:= (j-1)*kanalbeskrlængde;
7 12696 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12697 end;
6 12698 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12699 signalbin(bs_mobilopkald);
6 12700 ac:= 0;
6 12701 end
5 12702 else
5 12703 if htyp='L' then
5 12704 begin <* vogntabelændringer *>
6 12705 long field ll;
6 12706
6 12706 ll:= 10;
6 12707 ac:= 0;
6 12708 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12709 læstegn(tlgr,9,tegn);
6 12710 if (tegn='N') or (tegn='O') then
6 12711 begin
7 12712 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12713 typ(2):= -1;
7 12714 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12715 if opref>0 then
7 12716 begin
8 12717 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12718 signalch(d.opref.retur,opref,d.opref.optype);
8 12719 end;
7 12720 ac:= -1;
7 12721 end
6 12722 else
6 12723 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12724 ac:= -1
6 12725 else
6 12726 if tegn='G' then <*indkodning*>
6 12727 begin
7 12728 pos:= 10; i:= 0;
7 12729 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12730 i:= i*10 + (tegn-'0');
7 12731 i:= i mod 1000;
7 12732 b_pn:= (1 shift 22) + (i shift 12);
7 12733 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12734 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12735 pos:= 14; i:= 0;
7 12736 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12737 i:= i*10 + (tegn-'0');
7 12738 b_pn:= b_pn + i;
7 12739 pos:= 16; i:= 0;
7 12740 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12741 i:= i*10 + (tegn-'0');
7 12742 b_pt:= i;
7 12743 bs:= 11;
7 12744 \f
7 12744 message procedure radio_ind side 12 - 881107/cl;
7 12745 end
6 12746 else
6 12747 if tegn='H' then <*udkodning*>
6 12748 begin
7 12749 pos:= 10; i:= 0;
7 12750 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12751 i:= i*10 + (tegn-'0');
7 12752 b_pt:= i;
7 12753 b_pn:= 0;
7 12754 bs:= 12;
7 12755 end
6 12756 else
6 12757 if tegn='I' then <*slet tabel*>
6 12758 begin
7 12759 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12760 pos:= 10; i:= 0;
7 12761 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12762 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12763 zno:= i;
7 12764 end
6 12765 else ac:= 2;
6 12766 if ac<0 then
6 12767 ac:= 0
6 12768 else
6 12769
6 12769 if ac=0 then
6 12770 begin
7 12771 waitch(cs_vt_adgang,opref,true,-1);
7 12772 startoperation(opref,401,cs_vt_adgang,bs);
7 12773 d.opref.data(1):= b_pt;
7 12774 d.opref.data(2):= b_pn;
7 12775 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12776 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12777 end;
6 12778 end
5 12779 else
5 12780 ac:= 2;
5 12781
5 12781 pos:= 1;
5 12782 skrivtegn(answ,pos,'H');
5 12783 skrivtegn(answ,pos,' ');
5 12784 skrivtegn(answ,pos,ac+'@');
5 12785 i:= 1; sum:= 0;
5 12786 while i < pos do
5 12787 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12788 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12789 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12790 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12791 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12792 disable begin
6 12793 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12794 outchar(zrl,'nl');
6 12795 end;
5 12796 <*-2*>
5 12797 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12798 disable setposition(z_fr_out,0,0);
5 12799 ac:= -1;
5 12800 \f
5 12800 message procedure radio_ind side 13 - 881107/cl;
5 12801 end
4 12802 else
4 12803 if ttyp = 'I' then
4 12804 begin
5 12805 typ(1):= -1;
5 12806 repeat
5 12807 getch(cs_radio_ind,opref,true,typ,val);
5 12808 if opref<>0 then
5 12809 begin
6 12810 d.opref.resultat:= 31;
6 12811 signalch(d.opref.retur,opref,d.opref.op_type);
6 12812 end;
5 12813 until opref=0;
5 12814 for i:= 1 step 1 until max_antal_taleveje do
5 12815 if læsbit_ia(hookoff_maske,i) then
5 12816 begin
6 12817 signalbin(bs_talevej_udkoblet(i));
6 12818 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12819 end;
5 12820 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12821 signal_bin(bs_mobil_opkald);
5 12822 for i:= 1 step 1 until max_antal_kanaler do
5 12823 begin
6 12824 ref:= (i-1)*kanalbeskrlængde;
6 12825 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12826 begin
7 12827 if kanal_tab.ref.kanal_id2<>0 and
7 12828 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12829 then
7 12830 begin
8 12831 signal(ss_samtale_nedlagt(i));
8 12832 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12833 end;
7 12834 if kanal_tab.ref.kanal_id1<>0 then
7 12835 begin
8 12836 signal(ss_samtale_nedlagt(i));
8 12837 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12838 end;
7 12839 end;
6 12840 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12841 end;
5 12842 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12843 startoperation(opref,401,cs_radio_pulje,23);
5 12844 i:= 1;
5 12845 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12846 j:= 4;
5 12847 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12848 begin
6 12849 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12850 end;
5 12851 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12852 signalch(cs_io,opref,gen_optype or rad_optype);
5 12853 optaget_flag:= 0;
5 12854 pos:= i:= 1; sum:= 0;
5 12855 skrivtegn(answ,pos,'I');
5 12856 skrivtegn(answ,pos,' ');
5 12857 skrivtegn(answ,pos,'@');
5 12858 while i<pos do
5 12859 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12860 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12861 skrivtegn(answ,pos,sum extract 4 + '@');
5 12862 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12863 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12864 disable begin
6 12865 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12866 outchar(zrl,'nl');
6 12867 end;
5 12868 <*-2*>
5 12869 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12870 disable setposition(z_fr_out,0,0);
5 12871 ac:= -1;
5 12872 \f
5 12872 message procedure radio_ind side 14 - 881107/cl;
5 12873 end
4 12874 else
4 12875 if ttyp='L' then
4 12876 begin
5 12877 ac:= 0;
5 12878 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12879 if testbit21 then
5 12880 begin
6 12881 waitch(cs_radio_pulje,opref,true,-1);
6 12882 startoperation(opref,401,cs_radio_pulje,23);
6 12883 i:= 1;
6 12884 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12885 j:= 4;
6 12886 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12887 begin
7 12888 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12889 end;
6 12890 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12891 signalch(cs_io,opref,gen_optype or rad_optype);
6 12892 end; <*testbit21*>
5 12893 end
4 12894 else
4 12895 if ttyp='Z' then
4 12896 begin
5 12897 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12898 disable begin
6 12899 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12900 outchar(zrl,'nl');
6 12901 end;
5 12902 <*-2*>
5 12903 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12904 disable setposition(z_fr_out,0,0);
5 12905 ac:= -1;
5 12906 end
4 12907 else
4 12908 ac:= 1;
4 12909 end; <* telegram modtaget ok *>
3 12910 \f
3 12910 message procedure radio_ind side 15 - 881107/cl;
3 12911 if ac>=0 then
3 12912 begin
4 12913 pos:= i:= 1; sum:= 0;
4 12914 skrivtegn(answ,pos,ttyp);
4 12915 skrivtegn(answ,pos,' ');
4 12916 skrivtegn(answ,pos,ac+'@');
4 12917 while i<pos do
4 12918 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12919 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12920 skrivtegn(answ,pos, sum extract 4 + '@');
4 12921 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12922 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12923 disable begin
5 12924 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12925 outchar(zrl,'nl');
5 12926 end;
4 12927 <*-2*>
4 12928 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12929 disable setposition(z_fr_out,0,0);
4 12930 ac:= -1;
4 12931 end;
3 12932
3 12932 typ(1):= 0;
3 12933 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12934 rf:= 4;
3 12935 systime(1,0.0,val.rf);
3 12936 val.rf:= val.rf - 30.0;
3 12937 typ(3):= -1;
3 12938 repeat
3 12939 getch(cs_radio_ind,opref,true,typ,val);
3 12940 if opref>0 then
3 12941 begin
4 12942 d.opref.resultat:= 53; <*annuleret*>
4 12943 signalch(d.opref.retur,opref,d.opref.optype);
4 12944 end;
3 12945 until opref=0;
3 12946
3 12946 until false;
3 12947
3 12947 radio_ind_trap:
3 12948
3 12948 disable skriv_radio_ind(zbillede,1);
3 12949
3 12949 end radio_ind;
2 12950 \f
2 12950 message procedure radio_ud side 1 - 820301/hko;
2 12951
2 12951 procedure radio_ud(op);
2 12952 value op;
2 12953 integer op;
2 12954 begin
3 12955 integer array field opref,io_opref;
3 12956 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12957 integer array answ, tlgr(1:32);
3 12958 long array field laf;
3 12959
3 12959 procedure skriv_radio_ud(z,omfang);
3 12960 value omfang;
3 12961 zone z;
3 12962 integer omfang;
3 12963 begin integer i1;
4 12964 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12965 if omfang > 0 then
4 12966 disable begin real x; long array field tx;
5 12967 tx:= 0;
5 12968 trap(slut);
5 12969 write(z,"nl",1,
5 12970 <: opref: :>,opref,"nl",1,
5 12971 <: io-opref: :>,io_opref,"nl",1,
5 12972 <: opgave: :>,opgave,"nl",1,
5 12973 <: kode: :>,kode,"nl",1,
5 12974 <: pos: :>,pos,"nl",1,
5 12975 <: tegn: :>,tegn,"nl",1,
5 12976 <: i: :>,i,"nl",1,
5 12977 <: sum: :>,sum,"nl",1,
5 12978 <: rc: :>,rc,"nl",1,
5 12979 <: svar-status: :>,svar_status,"nl",1,
5 12980 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12981 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12982 <::>);
5 12983 skriv_coru(z,coru_no(402));
5 12984 slut:
5 12985 end; <*disable*>
4 12986 end skriv_radio_ud;
3 12987
3 12987 trap(radio_ud_trap);
3 12988 laf:= 0;
3 12989 stack_claim((if cm_test then 200 else 150) +35+100);
3 12990
3 12990 <*+2*>if testbit32 and overvåget or testbit28 then
3 12991 skriv_radio_ud(out,0);
3 12992 <*-2*>
3 12993
3 12993 io_opref:= op;
3 12994 \f
3 12994 message procedure radio_ud side 2 - 810529/hko;
3 12995
3 12995 repeat
3 12996
3 12996 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12997 kode:= d.op_ref.opkode;
3 12998 opgave:= kode shift(-12);
3 12999 kode:= kode extract 12;
3 13000 if opgave < 'A' or opgave > 'I' then
3 13001 begin
4 13002 d.opref.resultat:= 31;
4 13003 end
3 13004 else
3 13005 begin
4 13006 pos:= 1;
4 13007 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 13008 begin
5 13009 skrivtegn(tlgr,pos,opgave);
5 13010 if d.opref.data(1) = 0 then
5 13011 begin
6 13012 skrivtegn(tlgr,pos,'G');
6 13013 skrivtegn(tlgr,pos,'A');
6 13014 end
5 13015 else
5 13016 begin
6 13017 skrivtegn(tlgr,pos,'D');
6 13018 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 13019 end;
5 13020 if opgave='A' then
5 13021 begin
6 13022 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 13023 end
5 13024 else
5 13025 if opgave='B' then
5 13026 begin
6 13027 skrivtegn(tlgr,pos,d.opref.data(2));
6 13028 if d.opref.data(2)='V' then
6 13029 begin
7 13030 skrivtegn(tlgr,pos,
7 13031 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 13032 skrivtegn(tlgr,pos,
7 13033 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 13034 end;
6 13035 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 13036 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 13037 end
5 13038 else
5 13039 if opgave='H' then
5 13040 begin
6 13041 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 13042 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 13043 hægtstring(tlgr,pos,<:@@@:>);
6 13044 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 13045 skrivtegn(tlgr,pos,'A');
6 13046 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 13047 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 13048 if d.opref.data(2)='L' then
6 13049 begin
7 13050 if d.opref.data(5)=7 then
7 13051 begin
8 13052 anbringtal(tlgr,pos,
8 13053 d.opref.data(8) shift (-12) extract 10,-4);
8 13054 anbringtal(tlgr,pos,
8 13055 d.opref.data(8) extract 7,-2);
8 13056 end
7 13057 else
7 13058 if d.opref.data(5)=8 then
7 13059 begin
8 13060 hægtstring(tlgr,pos,<:FFFFFF:>);
8 13061 end;
7 13062 if d.opref.data(5)<>9 then
7 13063 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 13064 skrivtegn(tlgr,pos,
7 13065 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 13066 skrivtegn(tlgr,pos,
7 13067 dec_to_hex(d.opref.data(6) extract 4));
7 13068 skrivtegn(tlgr,10,pos-11+'@');
7 13069 end;
6 13070 end;
5 13071 end
4 13072 else
4 13073 if opgave='I' then
4 13074 begin
5 13075 hægtstring(tlgr,pos,<:IGA:>);
5 13076 end
4 13077 else d.opref.resultat:= 31; <*systemfejl*>
4 13078 end;
3 13079 \f
3 13079 message procedure radio_ud side 3 - 881107/cl;
3 13080
3 13080 if d.opref.resultat=0 then
3 13081 begin
4 13082 if (opgave <= 'B')
4 13083 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 13084 begin
5 13085 systime(1,0,d.opref.tid);
5 13086 signalch(cs_radio_ind,opref,d.opref.optype);
5 13087 opref:= 0;
5 13088 end;
4 13089 <* beregn checksum og send *>
4 13090 i:= 1; sum:= 0;
4 13091 while i < pos do
4 13092 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 13093 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 13094 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 13095 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 13096 <**********************************************>
4 13097 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 13098
4 13098 if opgave='B' then delay(1);
4 13099
4 13099 <* 94.04.19/cl *>
4 13100 <**********************************************>
4 13101
4 13101 <*+2*> if (testbit36 or testbit39) and overvåget then
4 13102 disable begin
5 13103 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 13104 outchar(zrl,'nl');
5 13105 end;
4 13106 <*-2*>
4 13107 setposition(z_rf_in,0,0);
4 13108 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 13109 disable setposition(z_rf_out,0,0);
4 13110 rc:= 0;
4 13111
4 13111 <* afvent svar*>
4 13112 repeat
4 13113 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 13114 if svar_status=6 then
4 13115 begin
5 13116 svar_status:= -3;
5 13117 goto radio_ud_check;
5 13118 end;
4 13119 pos:= 1;
4 13120 while læstegn(answ,pos,i)<>0 do ;
4 13121 pos:= pos-2;
4 13122 if pos > 0 then
4 13123 begin
5 13124 if pos<3 then
5 13125 svar_status:= -2 <*format error*>
5 13126 else
5 13127 begin
6 13128 if læstegn(answ,3,tegn)<>'@' then
6 13129 svar_status:= tegn - '@'
6 13130 else
6 13131 begin
7 13132 pos:= 1;
7 13133 læstegn(answ,pos,tegn);
7 13134 if tegn<>opgave then
7 13135 svar_status:= -4 <*gal type*>
7 13136 else
7 13137 if læstegn(answ,pos,tegn)<>' ' then
7 13138 svar_status:= -tegn <*fejl*>
7 13139 else
7 13140 svar_status:= læstegn(answ,pos,tegn)-'@';
7 13141 end;
6 13142 end;
5 13143 end
4 13144 else
4 13145 svar_status:= -1;
4 13146 \f
4 13146 message procedure radio_ud side 5 - 881107/cl;
4 13147
4 13147 radio_ud_check:
4 13148 rc:= rc+1;
4 13149 if -3<=svar_status and svar_status< -1 then
4 13150 disable begin
5 13151 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 13152 setposition(z_rf_out,0,0);
5 13153 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13154 begin
6 13155 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 13156 outchar(zrl,'nl');
6 13157 end;
5 13158 <*-2*>
5 13159 end
4 13160 else
4 13161 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 13162 disable begin
5 13163 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 13164 setposition(z_rf_out,0,0);
5 13165 <*+2*> if (testbit36 or testbit39) and overvåget then
5 13166 begin
6 13167 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 13168 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 13169 end;
5 13170 <*-2*>
5 13171 end
4 13172 else
4 13173 if svar_status=0 and opref<>0 then
4 13174 d.opref.resultat:= 0
4 13175 else
4 13176 if opref<>0 then
4 13177 d.opref.resultat:= 31;
4 13178 until svar_status=0 or rc>3;
4 13179 end;
3 13180 if opref<>0 then
3 13181 begin
4 13182 if svar_status<>0 and rc>3 then
4 13183 d.opref.resultat:= 53; <* annulleret *>
4 13184 signalch(d.opref.retur,opref,d.opref.optype);
4 13185 opref:= 0;
4 13186 end;
3 13187 until false;
3 13188
3 13188 radio_ud_trap:
3 13189
3 13189 disable skriv_radio_ud(zbillede,1);
3 13190
3 13190 end radio_ud;
2 13191 \f
2 13191 message procedure radio_medd_opkald side 1 - 810610/hko;
2 13192
2 13192 procedure radio_medd_opkald;
2 13193 begin
3 13194 integer array field ref,op_ref;
3 13195 integer i;
3 13196
3 13196 procedure skriv_radio_medd_opkald(z,omfang);
3 13197 value omfang;
3 13198 zone z;
3 13199 integer omfang;
3 13200 begin integer x;
4 13201 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 13202 write(z,"sp",26-x);
4 13203 if omfang > 0 then
4 13204 disable begin
5 13205 trap(slut);
5 13206 write(z,"nl",1,
5 13207 <: ref: :>,ref,"nl",1,
5 13208 <: opref: :>,op_ref,"nl",1,
5 13209 <: i: :>,i,"nl",1,
5 13210 <::>);
5 13211 skriv_coru(z,abs curr_coruno);
5 13212 slut:
5 13213 end;<*disable*>
4 13214 end skriv_radio_medd_opkald;
3 13215
3 13215 trap(radio_medd_opkald_trap);
3 13216
3 13216 stack_claim((if cm_test then 200 else 150) +1);
3 13217
3 13217 <*+2*>if testbit32 and overvåget or testbit28 then
3 13218 disable skriv_radio_medd_opkald(out,0);
3 13219 <*-2*>
3 13220 \f
3 13220 message procedure radio_medd_opkald side 2 - 820301/hko;
3 13221
3 13221 repeat
3 13222
3 13222 <*V*> wait(bs_mobil_opkald);
3 13223 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 13224 <*V*> wait(bs_opkaldskø_adgang);
3 13225
3 13225 ref:= første_nød_opkald;
3 13226 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 13227 begin
4 13228 i:= opkaldskø.ref(2);
4 13229 if i < 0 then
4 13230 begin
5 13231 <* nødopkald ikke meldt *>
5 13232
5 13232 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 13233 d.op_ref.data(1):= <* vogn_id *>
5 13234 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 13235 opkaldskø.ref(2):= i extract 22;
5 13236 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 13237 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 13238 i:= op_ref;
5 13239 <*+2*> if testbit35 and overvåget then
5 13240 disable begin
6 13241 write(out,"nl",1,<:radio nød-medd:>);
6 13242 skriv_op(out,op_ref);
6 13243 ud;
6 13244 end;
5 13245 <*-2*>
5 13246 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 13247 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 13248 <*+4*> if i <> op_ref then
5 13249 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 13250 <*-4*>
5 13251 end;<*nødopkald ikke meldt*>
4 13252
4 13252 ref:= opkaldskø.ref(1) extract 12;
4 13253 end; <* melding til io *>
3 13254 \f
3 13254 message procedure radio_medd_opkald side 3 - 820304/hko;
3 13255
3 13255 start_operation(op_ref,403,cs_radio_medd,
3 13256 40<*opdater opkaldskøbill*>);
3 13257 signal_bin(bs_opkaldskø_adgang);
3 13258 <*+2*> if testbit35 and overvåget then
3 13259 disable begin
4 13260 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 13261 skriv_op(out,op_ref);
4 13262 write(out, <:opkaldsflag: :>,"nl",1);
4 13263 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 13264 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 13265 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 13266 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 13267 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 13268 ud;
4 13269 end;
3 13270 <*-2*>
3 13271 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 13272
3 13272 until false;
3 13273
3 13273 radio_medd_opkald_trap:
3 13274
3 13274 disable skriv_radio_medd_opkald(zbillede,1);
3 13275
3 13275 end radio_medd_opkald;
2 13276 \f
2 13276 message procedure radio_adm side 1 - 820301/hko;
2 13277
2 13277 procedure radio_adm(op);
2 13278 value op;
2 13279 integer op;
2 13280 begin
3 13281 integer array field opref, rad_op, iaf;
3 13282 integer nr,i,j,k,res,opgave,tilst,operatør;
3 13283
3 13283 procedure skriv_radio_adm(z,omfang);
3 13284 value omfang;
3 13285 zone z;
3 13286 integer omfang;
3 13287 begin integer i1;
4 13288 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 13289 write(z,"sp",26-i1);
4 13290 if omfang > 0 then
4 13291 disable begin real x;
5 13292 trap(slut);
5 13293 \f
5 13293 message procedure radio_adm side 2- 820301/hko;
5 13294
5 13294 write(z,"nl",1,
5 13295 <: op_ref: :>,op_ref,"nl",1,
5 13296 <: iaf: :>,iaf,"nl",1,
5 13297 <: rad-op: :>,rad_op,"nl",1,
5 13298 <: nr: :>,nr,"nl",1,
5 13299 <: i: :>,i,"nl",1,
5 13300 <: j: :>,j,"nl",1,
5 13301 <: k: :>,k,"nl",1,
5 13302 <: tilst: :>,tilst,"nl",1,
5 13303 <: res: :>,res,"nl",1,
5 13304 <: opgave: :>,opgave,"nl",1,
5 13305 <: operatør: :>,operatør,"nl",1);
5 13306 skriv_coru(z,coru_no(404));
5 13307 slut:
5 13308 end;<*disable*>
4 13309 end skriv_radio_adm;
3 13310 \f
3 13310 message procedure radio_adm side 3 - 820304/hko;
3 13311
3 13311 rad_op:= op;
3 13312
3 13312 trap(radio_adm_trap);
3 13313 stack_claim((if cm_test then 200 else 150) +50);
3 13314
3 13314 <*+2*>if testbit32 and overvåget or testbit28 then
3 13315 skriv_radio_adm(out,0);
3 13316 <*-2*>
3 13317
3 13317 pass;
3 13318 if -,testbit22 then
3 13319 begin
4 13320 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13321 signalch(cs_radio_ud,rad_op,rad_optype);
4 13322 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13323 end;
3 13324 repeat
3 13325 waitch(cs_radio_adm,opref,true,-1);
3 13326 <*+2*>
3 13327 if testbit33 and overvåget then
3 13328 disable begin
4 13329 skriv_radio_adm(out,0);
4 13330 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 13331 skriv_op(out,opref);
4 13332 end;
3 13333 <*-2*>
3 13334
3 13334 k:= d.op_ref.opkode extract 12;
3 13335 opgave:= d.opref.opkode shift (-12);
3 13336 nr:=operatør:=d.op_ref.data(1);
3 13337
3 13337 <*+4*> if (d.op_ref.optype and
3 13338 (gen_optype or io_optype or op_optype or vt_optype))
3 13339 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 13340 <:radio_adm:>,0);
3 13341 <*-4*>
3 13342 if k = 74 <* RA,I *> then
3 13343 begin
4 13344 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 13345 signalch(cs_radio_ud,rad_op,rad_optype);
4 13346 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 13347 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 13348 else d.rad_op.resultat;
4 13349 signalch(d.opref.retur,opref,d.opref.optype);
4 13350 \f
4 13350 message procedure radio_adm side 4 - 820301/hko;
4 13351 end
3 13352 else
3 13353
3 13353 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 13354 k = 5<*FO,L*> or k = 6<*ST *> then
3 13355 begin
4 13356 if k = 5 or k=77 then
4 13357 begin
5 13358
5 13358 <*V*> wait(bs_opkaldskø_adgang);
5 13359 if k=5 then
5 13360 begin
6 13361 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 13362 begin
7 13363 i:= læs_fil(1035,iaf//512+1,nr);
7 13364 if i <> 0 then
7 13365 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 13366 tofrom(radio_linietabel.iaf,fil(nr),
7 13367 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 13368 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 13369 end;
6 13370
6 13370 for i:= 1 step 1 until max_antal_mobilopkald do
6 13371 begin
7 13372 iaf:= i*opkaldskø_postlængde;
7 13373 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 13374 if nr>0 then
7 13375 begin
8 13376 læs_tegn(radio_linietabel,nr+1,operatør);
8 13377 if operatør>max_antal_operatører then operatør:= 0;
8 13378 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 13379 operatør;
8 13380 end;
7 13381 end;
6 13382 end
5 13383 else
5 13384 if k=77 then
5 13385 begin
6 13386 disable i:= læsfil(1034,1,nr);
6 13387 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 13388 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 13389 for i:= 1 step 1 until max_antal_mobilopkald do
6 13390 begin
7 13391 iaf:= i*opkaldskø_postlængde;
7 13392 nr:= opkaldskø.iaf(5) extract 4;
7 13393 operatør:= radio_områdetabel(nr);
7 13394 if operatør < 0 or max_antal_operatører < operatør then
7 13395 operatør:= 0;
7 13396 if opkaldskø.iaf(4) extract 8=0 and
7 13397 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13398 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13399 operatør;
7 13400 end;
6 13401 end;
5 13402
5 13402 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13403 signal_bin(bs_opkaldskø_adgang);
5 13404
5 13404 signal_bin(bs_mobil_opkald);
5 13405
5 13405 d.op_ref.resultat:= res:= 3;
5 13406 \f
5 13406 message procedure radio_adm side 5 - 820304/hko;
5 13407
5 13407 end <*k = 5 / k = 77*>
4 13408 else
4 13409 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13410 res:= 3;
5 13411 for nr:= 1 step 1 until max_antal_kanaler do
5 13412 begin
6 13413 iaf:= (nr-1)*kanal_beskr_længde;
6 13414 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13415 op_talevej(operatør) then
6 13416 begin
7 13417 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13418 if tilst <> 0 then
7 13419 res:= 16; <*skærm optaget*>
7 13420 end; <* kanal_tab(operatør) = operatør*>
6 13421 end;
5 13422 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13423 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13424 signal_bin(bs_mobil_opkald);
5 13425 d.op_ref.resultat:= res;
5 13426 end;<*k=1,2 eller 6 *>
4 13427
4 13427 <*+2*> if testbit35 and overvåget then
4 13428 disable begin
5 13429 skriv_radio_adm(out,0);
5 13430 write(out,<: sender til :>,
5 13431 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13432 else cs_op);
5 13433 skriv_op(out,op_ref);
5 13434 end;
4 13435 <*-2*>
4 13436
4 13436 if k=5 or k=6 or k=77 or res > 3 then
4 13437 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13438 else
4 13439 begin <*k = (1 eller 2) og res = 3 *>
5 13440 d.op_ref.resultat:=0;
5 13441 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13442 end;
4 13443 \f
4 13443 message procedure radio_adm side 6 - 816610/hko;
4 13444
4 13444 end <*k=1,2,5 eller 6*>
3 13445 else
3 13446 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13447 begin
4 13448 nr:= d.op_ref.data(1);
4 13449 res:= 3;
4 13450
4 13450 if nr<=3 then
4 13451 res:= 51 <* afvist *>
4 13452 else
4 13453 begin
5 13454
5 13454 <* gennemstilling af område *>
5 13455 j:= 1;
5 13456 for i:= 1 step 1 until max_antal_kanaler do
5 13457 begin
6 13458 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13459 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13460 end;
5 13461 nr:= j;
5 13462 iaf:= (nr-1)*kanalbeskrlængde;
5 13463 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13464 begin
6 13465 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13466 d.rad_op.data(1):= 0;
6 13467 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13468 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13469 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13470 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13471 signalch(cs_radio_ud,rad_op,rad_optype);
6 13472 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13473 res:= d.rad_op.resultat;
6 13474 if res=0 then res:= 3;
6 13475 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13476 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13477 end;
5 13478 end;
4 13479 d.op_ref.resultat:=res;
4 13480 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13481 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13482 signal_bin(bs_mobil_opkald);
4 13483 \f
4 13483 message procedure radio_adm side 7 - 880930/cl;
4 13484
4 13484
4 13484 end <* k=3 eller 4 *>
3 13485 else
3 13486 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13487 begin
4 13488 nr:= d.opref.data(1) extract 22;
4 13489 res:= 3;
4 13490 iaf:= (nr-1)*kanalbeskrlængde;
4 13491 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13492 d.rad_op.data(1):= 0;
4 13493 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13494 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13495 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13496 d.rad_op.data(5):= k extract 1;
4 13497 signalch(cs_radio_ud,radop,rad_optype);
4 13498 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13499 res:= d.radop.resultat;
4 13500 if res=0 then res:= 3;
4 13501 j:= if k=72 then 15 else 0;
4 13502 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13503 begin
5 13504 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13505 signalbin(bs_mobilopkald);
5 13506 end;
4 13507 d.opref.resultat:= res;
4 13508 signalch(d.opref.retur,opref,d.opref.optype);
4 13509 end
3 13510 else
3 13511 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13512 begin
4 13513 nr:= d.opref.data(1) extract 8;
4 13514 opgave:= if k=19 then 9 else (k-4);
4 13515 if nr<=3 then
4 13516 res:= 51 <*afvist*>
4 13517 else
4 13518 begin
5 13519 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13520 d.radop.data(1):= 0;
5 13521 d.radop.data(2):= 'L';
5 13522 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13523 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13524 d.radop.data(5):= opgave;
5 13525 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13526 d.radop.data(7):= d.opref.data(2);
5 13527 d.radop.data(8):= d.opref.data(3);
5 13528 signalch(cs_radio_ud,radop,rad_optype);
5 13529 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13530 res:= d.radop.resultat;
5 13531 if res=0 then res:= 3;
5 13532 end;
4 13533 d.opref.resultat:= res;
4 13534 signalch(d.opref.retur,opref,d.opref.optype);
4 13535 end
3 13536 else
3 13537
3 13537 begin
4 13538
4 13538 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13539
4 13539 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13540
4 13540 end;
3 13541
3 13541 until false;
3 13542 radio_adm_trap:
3 13543 disable skriv_radio_adm(zbillede,1);
3 13544 end radio_adm;
2 13545
2 13545 \f
2 13545 message vogntabel erklæringer side 1 - 820301/cl;
2 13546
2 13546 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13547 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13548 cs_vt_log;
2 13549 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13550 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13551 vt_log_slicelgd;
2 13552 integer array bustabel,bustabel1(0:max_antal_busser),
2 13553 linie_løb_tabel(0:max_antal_linie_løb),
2 13554 springtabel(1:max_antal_spring,1:3),
2 13555 gruppetabel(1:max_antal_grupper),
2 13556 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13557 vt_logop(1:2),
2 13558 vt_logdisc(1:4),
2 13559 vt_log_tail(1:10);
2 13560 boolean array busindeks(-1:max_antal_linie_løb),
2 13561 bustilstand(-1:max_antal_busser),
2 13562 linie_løb_indeks(-1:max_antal_busser);
2 13563 real array springtid,springstart(1:max_antal_spring);
2 13564 real vt_logstart;
2 13565 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13566 integer array field v_tekst;
2 13567 real field v_tid;
2 13568
2 13568 zone zvtlog(128,1,stderror);
2 13569
2 13569 \f
2 13569 message vogntabel erklæringer side 2 - 851001/cl;
2 13570
2 13570 procedure skriv_vt_variable(zud);
2 13571 zone zud;
2 13572 begin integer i; long array field laf;
3 13573 laf:= 0;
3 13574 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13575 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13576 <:cs-vt :>,cs_vt,"nl",1,
3 13577 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13578 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13579 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13580 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13581 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13582 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13583 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13584 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13585 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13586 <:vt-op :>,vt_op,"nl",1,
3 13587 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13588 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13589 <:sidste-bus :>,sidste_bus,"nl",1,
3 13590 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13591 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13592 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13593 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13594 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13595 <:tf-springdef :>,tf_springdef,"nl",1,
3 13596 <:vt-logskift :>,vt_logskift,"nl",1,
3 13597 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13598 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13599 <:vt-log-aktiv :>,
3 13600 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13601 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13602 <::>);
3 13603 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13604 laf:= 2;
3 13605 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13606 for i:= 6 step 1 until 10 do
3 13607 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13608 write(zud,"nl",1);
3 13609 end;
2 13610 \f
2 13610 message procedure p_vogntabel side 1 - 820301/cl;
2 13611
2 13611 procedure p_vogntabel(z);
2 13612 zone z;
2 13613 begin
3 13614 integer i,b,s,o,t,li,lb,lø,g;
3 13615 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13616 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13617 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13618 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13619
3 13619 for i:= 1 step 1 until sidste_bus do
3 13620 begin
4 13621 b:= bustabel(i) extract 14;
4 13622 g:= bustabel(i) shift (-14);
4 13623 s:= bustabel1(i) shift (-23);
4 13624 o:= bustabel1(i) extract 8;
4 13625 t:= intg(bustilstand(i));
4 13626 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13627 lø:= li extract 7;
4 13628 lb:= li shift (-7) extract 5;
4 13629 lb:= if lb=0 then 32 else lb+64;
4 13630 li:= li shift (-12) extract 10;
4 13631 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13632 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13633 if g > 0 then string bpl_navn(g) else <: :>,
4 13634 ";",1,true,4,string område_navn(o),
4 13635 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13636 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13637 end;
3 13638 end p_vogntabel;
2 13639 \f
2 13639 message procedure p_gruppetabel side 1 - 810531/cl;
2 13640
2 13640 procedure p_gruppetabel(z);
2 13641 zone z;
2 13642 begin
3 13643 integer i,nr,bogst;
3 13644 boolean spc_gr;
3 13645 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13646 <:max-antal-grupper =:>,max_antal_grupper,
3 13647 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13648 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13649 <:gruppetabel::>);
3 13650 for i:= 1 step 1 until max_antal_grupper do
3 13651 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13652 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13653 gruppetabel(i) extract 7);
3 13654 write(z,"nl",2,<:gruppeopkald::>);
3 13655 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13656 begin
4 13657 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13658 if gruppeopkald(i,1) = 0 then
4 13659 write(z,"sp",11)
4 13660 else
4 13661 begin
5 13662 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13663 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13664 else
5 13665 begin
6 13666 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13667 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13668 if bogst = '@' then bogst:= 'sp';
6 13669 end;
5 13670 if spc_gr then
5 13671 write(z,<:(G:>,<<d>,true,3,nr)
5 13672 else
5 13673 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13674 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13675 end;
4 13676 end;
3 13677 end p_gruppetabel;
2 13678 \f
2 13678 message procedure p_springtabel side 1 - 810519/cl;
2 13679
2 13679 procedure p_springtabel(z);
2 13680 zone z;
2 13681 begin
3 13682 integer li,bo,max,st,nr;
3 13683 long indeks;
3 13684 real t;
3 13685
3 13685 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13686 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13687 <:nr spring-id max status næste-tid:>,"nl",1);
3 13688 for nr:= 1 step 1 until max_antal_spring do
3 13689 begin
4 13690 write(z,<<dd>,nr);
4 13691 <* if springtabel(nr,1)<>0 then *>
4 13692 begin
5 13693 li:= springtabel(nr,1) shift (-5) extract 10;
5 13694 bo:= springtabel(nr,1) extract 5;
5 13695 if bo<>0 then bo:= bo + 'A' - 1;
5 13696 indeks:= extend springtabel(nr,2) shift 24;
5 13697 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13698 max:= springtabel(nr,3) extract 12;
5 13699 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13700 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13701 if springtid(nr)<>0.0 then
5 13702 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13703 else
5 13704 write(z,<< d.d >,0.0);
5 13705 if springstart(nr)<>0.0 then
5 13706 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13707 else
5 13708 write(z,<< d.d >,0.0);
5 13709 end
4 13710 <* else
4 13711 write(z,<: --------:>)*>;
4 13712 write(z,"nl",1);
4 13713 end;
3 13714 end p_springtabel;
2 13715 \f
2 13715 message procedure find_busnr side 1 - 820301/cl;
2 13716
2 13716 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13717 value ll_id;
2 13718 integer ll_id, busnr, garage, tilst;
2 13719 begin
3 13720 integer i,j;
3 13721
3 13721 j:= binærsøg(sidste_linie_løb,
3 13722 (linie_løb_tabel(i) - ll_id), i);
3 13723 if j<>0 then <* linie/løb findes ikke *>
3 13724 begin
4 13725 find_busnr:= -1;
4 13726 busnr:= 0;
4 13727 garage:= 0;
4 13728 tilst:= 0;
4 13729 end
3 13730 else
3 13731 begin
4 13732 busnr:= bustabel(busindeks(i) extract 12);
4 13733 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13734 garage:= busnr shift (-14);
4 13735 busnr:= busnr extract 14;
4 13736 find_busnr:= busindeks(i) extract 12;
4 13737 end;
3 13738 end find_busnr;
2 13739 \f
2 13739 message procedure søg_omr_bus side 1 - 881027/cl;
2 13740
2 13740
2 13740 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13741 value bus;
2 13742 integer bus,ll,gar,omr,sig,tilst;
2 13743 begin
3 13744 integer i,j,nr,bu,bi,bl;
3 13745
3 13745 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13746 nr:= -1;
3 13747 if j=0 then
3 13748 begin
4 13749 bl:= bu:= bi;
4 13750 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13751 while bu<sidste_bus and
4 13752 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13753
4 13753 if bl<>bu then
4 13754 begin
5 13755 <* flere busser med samme tekniske nr. omr skal passe *>
5 13756 nr:= -2;
5 13757 for bi:= bl step 1 until bu do
5 13758 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13759 end
4 13760 else
4 13761 nr:= bi;
4 13762 end;
3 13763
3 13763 if nr<0 then
3 13764 begin
4 13765 <* bus findes ikke *>
4 13766 ll:= gar:= tilst:= sig:= 0;
4 13767 end
3 13768 else
3 13769 begin
4 13770 tilst:= intg(bustilstand(nr));
4 13771 gar:= bustabel(nr) shift (-14);
4 13772 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13773 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13774 sig:= bustabel1(nr) shift (-23);
4 13775 end;
3 13776 søg_omr_bus:= nr;
3 13777 end;
2 13778 \f
2 13778 message procedure find_linie_løb side 1 - 820301/cl;
2 13779
2 13779 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13780 value busnr;
2 13781 integer busnr, linie_løb, garage, tilst;
2 13782 begin
3 13783 integer i,j;
3 13784
3 13784 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13785
3 13785 if j<>0 then <* bus findes ikke *>
3 13786 begin
4 13787 find_linie_løb:= -1;
4 13788 linie_løb:= 0;
4 13789 garage:= 0;
4 13790 tilst:= 0;
4 13791 end
3 13792 else
3 13793 begin
4 13794 tilst:= intg(bustilstand(i));
4 13795 garage:= bustabel(i) shift (-14);
4 13796 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13797 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13798 end;
3 13799 end find_linie_løb;
2 13800 \f
2 13800 message procedure h_vogntabel side 1 - 810413/cl;
2 13801
2 13801 <* hovedmodulcorutine for vogntabelmodul *>
2 13802
2 13802 procedure h_vogntabel;
2 13803 begin
3 13804 integer array field op;
3 13805 integer dest_sem,k;
3 13806
3 13806 procedure skriv_h_vogntabel(zud,omfang);
3 13807 value omfang;
3 13808 zone zud;
3 13809 integer omfang;
3 13810 begin
4 13811 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13812 if omfang<>0 then
4 13813 disable
4 13814 begin
5 13815 skriv_coru(zud,abs curr_coruno);
5 13816 write(zud,"nl",1,<<d>,
5 13817 <:cs-vt :>,cs_vt,"nl",1,
5 13818 <:op :>,op,"nl",1,
5 13819 <:dest-sem :>,dest_sem,"nl",1,
5 13820 <:k :>,k,"nl",1,
5 13821 <::>);
5 13822 end;
4 13823 end;
3 13824 \f
3 13824 message procedure h_vogntabel side 2 - 820301/cl;
3 13825
3 13825 stackclaim(if cm_test then 198 else 146);
3 13826 trap(h_vt_trap);
3 13827
3 13827 <*+2*>
3 13828 <**> disable if testbit47 and overvåget or testbit28 then
3 13829 <**> skriv_h_vogntabel(out,0);
3 13830 <*-2*>
3 13831
3 13831 repeat
3 13832 waitch(cs_vt,op,true,-1);
3 13833 <*+4*>
3 13834 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13835 (d.op.optype and vt_optype) extract 12 = 0 then
3 13836 fejlreaktion(12,op,<:vogntabel:>,0);
3 13837 <*-4*>
3 13838 disable
3 13839 begin
4 13840
4 13840 k:= d.op.opkode extract 12;
4 13841 dest_sem:=
4 13842 if k = 9 then cs_vt_rap else
4 13843 if k = 10 then cs_vt_rap else
4 13844 if k = 11 then cs_vt_opd else
4 13845 if k = 12 then cs_vt_opd else
4 13846 if k = 13 then cs_vt_opd else
4 13847 if k = 14 then cs_vt_tilst else
4 13848 if k = 15 then cs_vt_tilst else
4 13849 if k = 16 then cs_vt_tilst else
4 13850 if k = 17 then cs_vt_tilst else
4 13851 if k = 18 then cs_vt_tilst else
4 13852 if k = 19 then cs_vt_opd else
4 13853 if k = 20 then cs_vt_opd else
4 13854 if k = 21 then cs_vt_auto else
4 13855 if k = 24 then cs_vt_opd else
4 13856 if k = 25 then cs_vt_grp else
4 13857 if k = 26 then cs_vt_grp else
4 13858 if k = 27 then cs_vt_grp else
4 13859 if k = 28 then cs_vt_grp else
4 13860 if k = 30 then cs_vt_spring else
4 13861 if k = 31 then cs_vt_spring else
4 13862 if k = 32 then cs_vt_spring else
4 13863 if k = 33 then cs_vt_spring else
4 13864 if k = 34 then cs_vt_spring else
4 13865 if k = 35 then cs_vt_spring else
4 13866 -1;
4 13867 \f
4 13867 message procedure h_vogntabel side 3 - 810422/cl;
4 13868
4 13868 <*+2*>
4 13869 <**> if testbit41 and overvåget then
4 13870 <**> begin
5 13871 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13872 <**> skriv_op(out,op);
5 13873 <**> end;
4 13874 <*-2*>
4 13875 end;
3 13876
3 13876 if dest_sem = -1 then
3 13877 fejlreaktion(2,k,<:vogntabel:>,0);
3 13878 disable signalch(dest_sem,op,d.op.optype);
3 13879 until false;
3 13880 h_vt_trap:
3 13881 disable skriv_h_vogntabel(zbillede,1);
3 13882 end h_vogntabel;
2 13883 \f
2 13883 message procedure vt_opdater side 1 - 810317/cl;
2 13884
2 13884 procedure vt_opdater(op1);
2 13885 value op1;
2 13886 integer op1;
2 13887 begin
3 13888 integer array field op,radop;
3 13889 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13890 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13891 flin,slin,finx,sinx;
3 13892 integer field bn,ll;
3 13893
3 13893 procedure skriv_vt_opd(zud,omfang);
3 13894 value omfang; integer omfang;
3 13895 zone zud;
3 13896 begin
4 13897 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13898 if omfang <> 0 then
4 13899 disable
4 13900 begin
5 13901 skriv_coru(zud,abs curr_coruno);
5 13902 write(zud,"nl",1,
5 13903 <: op: :>,op,"nl",1,
5 13904 <: radop::>,radop,"nl",1,
5 13905 <: funk: :>,funk,"nl",1,
5 13906 <: res: :>,res,"nl",1,
5 13907 <::>);
5 13908 end;
4 13909 end skriv_vt_opd;
3 13910
3 13910 integer procedure opd_omr(fnk,omr,bus,ll);
3 13911 value fnk,omr,bus,ll;
3 13912 integer fnk,omr,bus,ll;
3 13913 begin
4 13914 opd_omr:= 3;
4 13915 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13916 ændringer skal ikke længere meldes til yderområder *>
4 13917 goto dummy_retur;
4 13918
4 13918 if omr extract 8 > 3 then
4 13919 begin
5 13920 startoperation(radop,501,cs_vt_opd,fnk);
5 13921 d.radop.data(1):= omr;
5 13922 d.radop.data(2):= bus;
5 13923 d.radop.data(3):= ll;
5 13924 signalch(cs_rad,radop,vt_optype);
5 13925 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13926 opd_omr:= d.radop.resultat;
5 13927 end
4 13928 else
4 13929 opd_omr:= 0;
4 13930 dummy_retur:
4 13931 end;
3 13932 message procedure vt_opdater side 1a - 920517/cl;
3 13933
3 13933 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13934 value kilde,kode,bus,ll1,ll2;
3 13935 integer kilde,kode,bus,ll1,ll2;
3 13936 begin
4 13937 integer array field op;
4 13938
4 13938 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13939
4 13939 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13940 systime(1,0.0,d.op.data.v_tid);
4 13941 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13942 d.op.data.v_bus:= bus;
4 13943 d.op.data.v_ll1:= ll1;
4 13944 d.op.data.v_ll2:= ll2;
4 13945 signalch(cs_vt_log,op,vt_optype);
4 13946 end;
3 13947
3 13947 stackclaim((if cm_test then 198 else 146)+125);
3 13948
3 13948 bn:= 4; ll:= 2;
3 13949 radop:= op1;
3 13950 trap(vt_opd_trap);
3 13951
3 13951 <*+2*>
3 13952 <**> disable if testbit47 and overvåget or testbit28 then
3 13953 <**> skriv_vt_opd(out,0);
3 13954 <*-2*>
3 13955 \f
3 13955 message procedure vt_opdater side 2 - 851001/cl;
3 13956
3 13956 vent_op:
3 13957 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13958
3 13958 <*+2*>
3 13959 <**> disable
3 13960 <**> if testbit41 and overvåget then
3 13961 <**> begin
4 13962 <**> skriv_vt_opd(out,0);
4 13963 <**> write(out,<: modtaget operation:>);
4 13964 <**> skriv_op(out,op);
4 13965 <**> end;
3 13966 <*-2*>
3 13967
3 13967 <*+4*>
3 13968 <**>if op<>vt_op then
3 13969 <**>begin
4 13970 <**> disable begin
5 13971 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13972 <**> d.op.resultat:= 31; <*systemfejl*>
5 13973 <**> signalch(d.op.retur,op,d.op.optype);
5 13974 <**> end;
4 13975 <**> goto vent_op;
4 13976 <**>end;
3 13977 <*-4*>
3 13978 disable
3 13979 begin integer opk;
4 13980
4 13980 opk:= d.op.opkode extract 12;
4 13981 funk:= if opk=11 then 1 else
4 13982 if opk=12 then 2 else
4 13983 if opk=13 then 3 else
4 13984 if opk=19 then 4 else
4 13985 if opk=20 then 5 else
4 13986 if opk=24 then 6 else
4 13987 0;
4 13988 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13989 end;
3 13990 res:= 0;
3 13991 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13992 \f
3 13992 message procedure vt_opdater side 3 - 820301/cl;
3 13993
3 13993 indsæt:
3 13994 begin
4 13995 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13996 <*+4*>
4 13997 <**> if d.op.data(1) shift (-22) <> 0 then
4 13998 <**> begin
5 13999 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 14000 <**> goto slut_indsæt;
5 14001 <**> end;
4 14002 <*-4*>
4 14003 busnr:= d.op.data(1) extract 14;
4 14004 <*+4*>
4 14005 <**> if d.op.data(2) shift (-22) <> 1 then
4 14006 <**> begin
5 14007 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 14008 <**> goto slut_indsæt;
5 14009 <**> end;
4 14010 <*-4*>
4 14011 ll_id:= d.op.data(2);
4 14012 s:= omr:= d.op.data(4) extract 8;
4 14013 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 14014 if bi<0 then
4 14015 begin
5 14016 if bi=(-1) then res:=10 <*bus ukendt*> else
5 14017 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 14018 end
4 14019 else
4 14020 if s<>0 and s<>omr then
4 14021 res:= 58 <* ulovligt område for bus *>
4 14022 else
4 14023 if intg(bustilstand(bi)) <> 0 then
4 14024 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 14025 else 14 <* optaget *>)
4 14026 else
4 14027 begin
5 14028 if linie_løb_indeks(bi) extract 12 <> 0 then
5 14029 begin <* linie/løb allerede indsat *>
6 14030 res:= 11;
6 14031 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 14032 end
5 14033 else
5 14034 begin
6 14035 \f
6 14035 message procedure vt_opdater side 3a - 900108/cl;
6 14036
6 14036 if d.op.kilde//100 <> 4 then
6 14037 res:= opd_omr(11,gar shift 8 +
6 14038 bustabel1(bi) extract 8,busnr,ll_id);
6 14039 if res>3 then goto slut_indsæt;
6 14040 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 14041 if s=0 then <* linie/løb findes allerede *>
6 14042 begin
7 14043 sig:= busindeks(li) extract 12;
7 14044 d.op.data(3):= bustabel(sig);
7 14045 linie_løb_indeks(sig):= false;
7 14046 disable modiffil(tf_vogntabel,sig,zi);
7 14047 fil(zi).ll:= 0;
7 14048 fil(zi).bn:= bustabel(sig) extract 14 add
7 14049 (bustabel1(sig) extract 8 shift 14);
7 14050 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 14051
7 14051 linie_løb_indeks(bi):= false add li;
7 14052 busindeks(li):= false add bi;
7 14053 disable modiffil(tf_vogntabel,bi,zi);
7 14054 fil(zi).ll:= ll_id;
7 14055 fil(zi).bn:= bustabel(bi) extract 14 add
7 14056 (bustabel1(bi) extract 8 shift 14);
7 14057 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 14058 res:= 3;
7 14059 end
6 14060 else
6 14061 begin
7 14062 \f
7 14062 message procedure vt_opdater side 4 - 810527/cl;
7 14063
7 14063 if s<0 then li:= li +1;
7 14064 if sidste_linie_løb=max_antal_linie_løb then
7 14065 begin
8 14066 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 14067 res:= 31;
8 14068 end
7 14069 else
7 14070 begin
8 14071 for i:= sidste_linie_løb step -1 until li do
8 14072 begin
9 14073 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 14074 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 14075 bus_indeks(i+1):=bus_indeks(i);
9 14076 end;
8 14077 sidste_linie_løb:= sidste_linie_løb +1;
8 14078 linie_løb_tabel(li):= ll_id;
8 14079 linie_løb_indeks(bi):= false add li;
8 14080 busindeks(li):= false add bi;
8 14081 disable s:= modiffil(tf_vogntabel,bi,zi);
8 14082 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 14083 fil(zi).bn:= busnr extract 14 add
8 14084 (bustabel1(bi) extract 8 shift 14);
8 14085 fil(zi).ll:= ll_id;
8 14086 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 14087 res:= 3; <* ok *>
8 14088 end;
7 14089 end;
6 14090 end;
5 14091 end;
4 14092 slut_indsæt:
4 14093 d.op.resultat:= res;
4 14094 end;
3 14095 goto returner;
3 14096 \f
3 14096 message procedure vt_opdater side 5 - 820301/cl;
3 14097
3 14097 udtag:
3 14098 begin
4 14099 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 14100
4 14100 busnr:= ll_id:= 0;
4 14101 omr:= s:= d.op.data(2) extract 8;
4 14102 format:= d.op.data(1) shift (-22);
4 14103 if format=0 then <*busnr*>
4 14104 begin
5 14105 busnr:= d.op.data(1) extract 14;
5 14106 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 14107 if bi<0 then
5 14108 begin
6 14109 if bi=-1 then res:= 10 else
6 14110 if s<>0 then res:= 58 else res:= 57;
6 14111 goto slut_udtag;
6 14112 end;
5 14113 if bi>0 and s<>0 and s<>omr then
5 14114 begin
6 14115 res:= 58; goto slut_udtag;
6 14116 end;
5 14117 li:= linie_løb_indeks(bi) extract 12;
5 14118 busnr:= bustabel(bi);
5 14119 if li=0 or linie_løb_tabel(li)=0 then
5 14120 begin <* bus ej indsat *>
6 14121 res:= 13;
6 14122 goto slut_udtag;
6 14123 end;
5 14124 ll_id:= linie_løb_tabel(li);
5 14125 end
4 14126 else
4 14127 if format=1 then <* linie_løb *>
4 14128 begin
5 14129 ll_id:= d.op.data(1);
5 14130 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 14131 if s<>0 then
5 14132 begin <* linie/løb findes ikke *>
6 14133 res:= 9;
6 14134 goto slut_udtag;
6 14135 end;
5 14136 bi:= busindeks(li) extract 12;
5 14137 busnr:= bustabel(bi);
5 14138 end
4 14139 else <* ulovlig identifikation *>
4 14140 begin
5 14141 res:= 31;
5 14142 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 14143 goto slut_udtag;
5 14144 end;
4 14145 \f
4 14145 message procedure vt_opdater side 6 - 820301/cl;
4 14146
4 14146 tilst:= intg(bustilstand(bi));
4 14147 if tilst<>0 then
4 14148 begin
5 14149 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 14150 goto slut_udtag;
5 14151 end;
4 14152 if d.op.kilde//100 <> 4 then
4 14153 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 14154 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 14155 if res>3 then goto slut_udtag;
4 14156 linie_løb_indeks(bi):= false;
4 14157 for i:= li step 1 until sidste_linie_løb -1 do
4 14158 begin
5 14159 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 14160 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 14161 bus_indeks(i):= bus_indeks(i+1);
5 14162 end;
4 14163 linie_løb_tabel(sidste_linie_løb):= 0;
4 14164 bus_indeks(sidste_linie_løb):= false;
4 14165 sidste_linie_løb:= sidste_linie_løb -1;
4 14166 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 14167 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 14168 fil(zi).ll:= 0;
4 14169 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 14170 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 14171 res:= 3; <* ok *>
4 14172 slut_udtag:
4 14173 d.op.resultat:= res;
4 14174 d.op.data(2):= ll_id;
4 14175 d.op.data(3):= busnr;
4 14176 end;
3 14177 goto returner;
3 14178 \f
3 14178 message procedure vt_opdater side 7 - 851001/cl;
3 14179
3 14179 omkod:
3 14180 flyt:
3 14181 roker:
3 14182 begin
4 14183 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 14184
4 14184 inf1:= inf2:= 0;
4 14185 ll_id1:= d.op.data(1);
4 14186 ll_id2:= d.op.data(2);
4 14187 if ll_id1=ll_id2 then
4 14188 begin
5 14189 res:= 24; inf1:= ll_id2;
5 14190 goto slut_flyt;
5 14191 end;
4 14192 <*+4*>
4 14193 <**> for i:= 1,2 do
4 14194 <**> if d.op.data(i) shift (-22) <> 1 then
4 14195 <**> begin
5 14196 <**> res:= 31;
5 14197 <**> fejlreaktion(10,d.op.data(i),case i of (
5 14198 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 14199 <**> goto slut_flyt;
5 14200 <**> end;
4 14201 <*-4*>
4 14202
4 14202 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 14203 if s<>0 and funk=6 <* roker *> then
4 14204 begin
5 14205 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 14206 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 14207 end;
4 14208 if s<>0 then
4 14209 begin
5 14210 res:= 9; <* ukendt linie/løb *>
5 14211 goto slut_flyt;
5 14212 end;
4 14213 bi1:= busindeks(li1) extract 12;
4 14214 inf1:= bustabel(bi1);
4 14215 tilst:= intg(bustilstand(bi1));
4 14216 if tilst<>0 then <* bus ikke fri *>
4 14217 begin
5 14218 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 14219 goto slut_flyt;
5 14220 end;
4 14221 \f
4 14221 message procedure vt_opdater side 7a- 851001/cl;
4 14222 if d.op.kilde//100 <> 4 then
4 14223
4 14223 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 14224 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 14225 if res>3 then goto slut_flyt;
4 14226
4 14226 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 14227 if s=0 then
4 14228 begin <* ll_id2 er indkodet *>
5 14229 bi2:= busindeks(li2) extract 12;
5 14230 inf2:= bustabel(bi2);
5 14231 tilst:= intg(bustilstand(bi2));
5 14232 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 14233 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 14234 if res>3 then
5 14235 begin
6 14236 inf1:= inf2; inf2:= 0;
6 14237 goto slut_flyt;
6 14238 end;
5 14239
5 14239 if d.op.kilde//100 <> 4 then
5 14240 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 14241 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 14242 if res>3 then goto slut_flyt;
5 14243
5 14243 <* flyt bus *>
5 14244 if funk=6 then
5 14245 linie_løb_indeks(bi2):= false add li1
5 14246 else
5 14247 linie_løb_indeks(bi2):= false;
5 14248 linie_løb_indeks(bi1):= false add li2;
5 14249 if funk=6 then
5 14250 busindeks(li1):= false add bi2
5 14251 else
5 14252 busindeks(li1):= false;
5 14253 busindeks(li2):= false add bi1;
5 14254
5 14254 if funk<>6 then
5 14255 begin
6 14256 <* fjern ll_id1 *>
6 14257 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 14258 begin
7 14259 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 14260 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 14261 busindeks(i):= busindeks(i+1);
7 14262 end;
6 14263 linie_løb_tabel(sidste_linie_løb):= 0;
6 14264 bus_indeks(sidste_linie_løb):= false;
6 14265 sidste_linie_løb:= sidste_linie_løb-1;
6 14266 end;
5 14267
5 14267 <* opdater vogntabelfil *>
5 14268 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 14269 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14270 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 14271 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 14272 if funk=6 then
5 14273 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 14274 else
5 14275 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 14276 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14277 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14278 fil(zi).ll:= ll_id2;
5 14279 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14280 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14281 \f
5 14281 message procedure vt_opdater side 8 - 820301/cl;
5 14282
5 14282 end <* ll_id2 indkodet *>
4 14283 else
4 14284 begin
5 14285 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 14286 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 14287 pm1:= sgn(li2-li1);
5 14288 for i:= li1 step pm1 until li2-pm1 do
5 14289 begin
6 14290 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 14291 busindeks(i):= busindeks(i+pm1);
6 14292 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 14293 end;
5 14294 linie_løb_tabel(li2):= ll_id2;
5 14295 busindeks(li2):= false add bi1;
5 14296 linie_løb_indeks(bi1):= false add li2;
5 14297 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 14298 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 14299 fil(zi).ll:= ll_id2;
5 14300 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 14301 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 14302 end;
4 14303 res:= 3; <*udført*>
4 14304 slut_flyt:
4 14305 d.op.resultat:= res;
4 14306 d.op.data(3):= inf1;
4 14307 if funk=5 then d.op.data(4):= inf2;
4 14308 end;
3 14309 goto returner;
3 14310 \f
3 14310 message procedure vt_opdater side 9 - 851001/cl;
3 14311
3 14311 slet:
3 14312 begin
4 14313 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 14314 boolean test24;
4 14315
4 14315 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 14316 omr:= d.op.data(3);
4 14317
4 14317 if d.op.data(1) > d.op.data(2) then
4 14318 begin
5 14319 res:= 44; <* intervalstørrelse ulovlig *>
5 14320 goto slut_slet;
5 14321 end;
4 14322
4 14322 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 14323 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 14324
4 14324 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 14325 if s<0 then finx:= finx+1;
4 14326 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 14327 if s>0 then sinx:= sinx-1;
4 14328
4 14328 for li:= finx step 1 until sinx do
4 14329 begin
5 14330 bi:= busindeks(li) extract 12;
5 14331 gar:= bustabel(bi) shift (-14) extract 8;
5 14332 if intg(bustilstand(bi))=0 and
5 14333 (omr = 0 or (omr > 0 and omr = gar) or
5 14334 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 14335 begin
6 14336 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 14337 linie_løb_indeks(bi):= busindeks(li):= false;
6 14338 linie_løb_tabel(li):= 0;
6 14339 end;
5 14340 end;
4 14341 \f
4 14341 message procedure vt_opdater side 10 - 850820/cl;
4 14342
4 14342 sinx:= finx-1;
4 14343 for li:= finx step 1 until sidste_linie_løb do
4 14344 begin
5 14345 if linie_løb_tabel(li)<>0 then
5 14346 begin
6 14347 sinx:= sinx+1;
6 14348 if sinx<>li then
6 14349 begin
7 14350 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 14351 busindeks(sinx):= busindeks(li);
7 14352 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 14353 linie_løb_tabel(li):= 0;
7 14354 busindeks(li):= false;
7 14355 end;
6 14356 end;
5 14357 end;
4 14358 sidste_linie_løb:= sinx;
4 14359
4 14359 test24:= testbit24; testbit24:= false;
4 14360 for bi:= 1 step 1 until sidste_bus do
4 14361 disable
4 14362 begin
5 14363 s:= modiffil(tf_vogntabel,bi,finx);
5 14364 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 14365 fil(finx).bn:= bustabel(bi) extract 14 add
5 14366 (bustabel1(bi) extract 8 shift 14);
5 14367 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 14368 end;
4 14369 testbit24:= test24;
4 14370 res:= 3;
4 14371
4 14371 slut_slet:
4 14372 d.op.resultat:= res;
4 14373 end;
3 14374 goto returner;
3 14375 \f
3 14375 message procedure vt_opdater side 11 - 810409/cl;
3 14376
3 14376 returner:
3 14377 disable
3 14378 begin
4 14379
4 14379 <*+2*>
4 14380 <**> if testbit40 and overvåget then
4 14381 <**> begin
5 14382 <**> skriv_vt_opd(out,0);
5 14383 <**> write(out,<: vogntabel efter ændring:>);
5 14384 <**> p_vogntabel(out);
5 14385 <**> end;
4 14386 <**> if testbit41 and overvåget then
4 14387 <**> begin
5 14388 <**> skriv_vt_opd(out,0);
5 14389 <**> write(out,<: returner operation:>);
5 14390 <**> skriv_op(out,op);
5 14391 <**> end;
4 14392 <*-2*>
4 14393
4 14393 signalch(d.op.retur,op,d.op.optype);
4 14394 end;
3 14395 goto vent_op;
3 14396
3 14396 vt_opd_trap:
3 14397 disable skriv_vt_opd(zbillede,1);
3 14398
3 14398 end vt_opdater;
2 14399 \f
2 14399 message procedure vt_tilstand side 1 - 810424/cl;
2 14400
2 14400 procedure vt_tilstand(cs_fil,fil_opref);
2 14401 value cs_fil,fil_opref;
2 14402 integer cs_fil,fil_opref;
2 14403 begin
3 14404 integer array field op,filop;
3 14405 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14406 g_type,gr,antal,ej_res,zi,li,filref;
3 14407 integer array identer(1:max_antal_i_gruppe);
3 14408
3 14408 procedure skriv_vt_tilst(zud,omfang);
3 14409 value omfang;
3 14410 zone zud;
3 14411 integer omfang;
3 14412 begin
4 14413 real array field raf;
4 14414 raf:= 0;
4 14415 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14416 if omfang <> 0 then
4 14417 begin
5 14418 skriv_coru(zud,abs curr_coruno);
5 14419 write(zud,"nl",1,<<d>,
5 14420 <:cs-fil :>,cs_fil,"nl",1,
5 14421 <:filop :>,filop,"nl",1,
5 14422 <:op :>,op,"nl",1,
5 14423 <:funk :>,funk,"nl",1,
5 14424 <:format :>,format,"nl",1,
5 14425 <:busid :>,busid,"nl",1,
5 14426 <:res :>,res,"nl",1,
5 14427 <:bi :>,bi,"nl",1,
5 14428 <:tilst :>,tilst,"nl",1,
5 14429 <:opk :>,opk,"nl",1,
5 14430 <:opk-indeks :>,opk_indeks,"nl",1,
5 14431 <:g-type :>,g_type,"nl",1,
5 14432 <:gr :>,gr,"nl",1,
5 14433 <:antal :>,antal,"nl",1,
5 14434 <:ej-res :>,ej_res,"nl",1,
5 14435 <:zi :>,zi,"nl",1,
5 14436 <:li :>,li,"nl",1,
5 14437 <::>);
5 14438 write(zud,"nl",1,<:identer:>);
5 14439 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14440 end;
4 14441 end;
3 14442
3 14442 procedure sorter_gruppe(tab,l,u);
3 14443 value l,u;
3 14444 integer array tab;
3 14445 integer l,u;
3 14446 begin
4 14447 integer array field ii,jj;
4 14448 integer array ww, xx(1:2);
4 14449
4 14449 integer procedure sml(a,b);
4 14450 integer array a,b;
4 14451 begin
5 14452 integer res;
5 14453
5 14453 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14454 if res = 0 then
5 14455 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14456 if res = 0 then
5 14457 res:=
5 14458 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14459 if res = 0 then
5 14460 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14461 sml:= res;
5 14462 end;
4 14463
4 14463 ii:= ((l+u)//2 - 1)*4;
4 14464 tofrom(xx,tab.ii,4);
4 14465 ii:= (l-1)*4; jj:= (u-1)*4;
4 14466 repeat
4 14467 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14468 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14469 if ii <= jj then
4 14470 begin
5 14471 tofrom(ww,tab.ii,4);
5 14472 tofrom(tab.ii,tab.jj,4);
5 14473 tofrom(tab.jj,ww,4);
5 14474 ii:= ii+4;
5 14475 jj:= jj-4;
5 14476 end;
4 14477 until ii>jj;
4 14478 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14479 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14480 end;
3 14481 \f
3 14481 message procedure vt_tilstand side 2 - 820301/cl;
3 14482
3 14482 filop:= filopref;
3 14483 stackclaim(if cm_test then 550 else 500);
3 14484 trap(vt_tilst_trap);
3 14485
3 14485 <*+2*>
3 14486 <**> disable if testbit47 and overvåget or testbit28 then
3 14487 <**> skriv_vt_tilst(out,0);
3 14488 <*-2*>
3 14489
3 14489 vent_op:
3 14490 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14491 <*+2*>disable
3 14492 <**> if (testbit41 and overvåget) or
3 14493 (testbit46 and overvåget and
3 14494 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14495 then
3 14496 <**> begin
4 14497 <**> skriv_vt_tilst(out,0);
4 14498 <**> write(out,<: modtaget operation:>);
4 14499 <**> skriv_op(out,op);
4 14500 <**> end;
3 14501 <*-2*>
3 14502
3 14502 <*+4*>
3 14503 <**> if op <> vt_op then
3 14504 <**> begin
4 14505 <**> disable begin
5 14506 <**> d.op.resultat:= 31;
5 14507 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14508 <**> end;
4 14509 <**> goto returner;
4 14510 <**> end;
3 14511 <*-4*>
3 14512
3 14512 opk:= d.op.opkode extract 12;
3 14513 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14514 if opk = 15 <*bus res *> then 2 else
3 14515 if opk = 16 <*grp res *> then 4 else
3 14516 if opk = 17 <*bus fri *> then 3 else
3 14517 if opk = 18 <*grp fri *> then 5 else
3 14518 0;
3 14519 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14520 res:= 0;
3 14521 format:= d.op.data(1) shift (-22);
3 14522
3 14522 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14523 \f
3 14523 message procedure vt_tilstand side 3 - 820301/cl;
3 14524
3 14524 enkelt_bus:
3 14525 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14526 disable
3 14527 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14528 <*+4*>
4 14529 <**>if format <> 0 and format <> 1 then
4 14530 <**>begin
5 14531 <**> res:= 31;
5 14532 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14533 <**> goto slut_enkelt_bus;
5 14534 <**>end;
4 14535 <*-4*>
4 14536 <* find busnr og tilstand *>
4 14537 case format+1 of
4 14538 begin
5 14539 <* 0: budident *>
5 14540 begin
6 14541 busnr:= d.op.data(1) extract 14;
6 14542 s:= omr:= d.op.data(4) extract 8;
6 14543 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14544 if bi<0 then
6 14545 begin
7 14546 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14547 goto slut_enkelt_bus;
7 14548 end
6 14549 else
6 14550 begin
7 14551 tilst:= intg(bustilstand(bi));
7 14552 end;
6 14553 end;
5 14554
5 14554 <* 1: linie_løb_ident *>
5 14555 begin
6 14556 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14557 if bi < 0 then <* ukendt linie_løb *>
6 14558 begin
7 14559 res:= 9;
7 14560 goto slut_enkelt_bus;
7 14561 end;
6 14562 end;
5 14563 end case;
4 14564 \f
4 14564 message procedure vt_tilstand side 4 - 830310/cl;
4 14565
4 14565 if funk < 3 then
4 14566 begin
5 14567 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14568 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14569 else 0;
5 14570 d.op.data(3):= bustabel(bi);
5 14571 d.op.data(4):= bustabel1(bi);
5 14572 end;
4 14573
4 14573 <* check tilstand *>
4 14574 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14575 res:= 39 <* bus ikke reserveret *>
4 14576 else
4 14577 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14578 res:= 14 <* bus optaget *>
4 14579 else
4 14580 if funk = 1 <* i kø *> and tilst = (-1) then
4 14581 res:= 18 <* i kø *>
4 14582 else
4 14583 res:= 3; <*udført*>
4 14584
4 14584 if res = 3 then
4 14585 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14586
4 14586 slut_enkelt_bus:
4 14587 d.op.resultat:= res;
4 14588 end <*disable*>;
3 14589 goto returner;
3 14590 \f
3 14590 message procedure vt_tilstand side 5 - 810424/cl;
3 14591
3 14591 grp_res: <* reserver gruppe *>
3 14592 disable
3 14593 begin
4 14594
4 14594 <*+4*>
4 14595 <**> if format <> 2 then
4 14596 <**> begin
5 14597 <**> res:= 31;
5 14598 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14599 <**> goto slut_grp_res_1;
5 14600 <**> end;
4 14601 <*-4*>
4 14602
4 14602 <* find frit indeks i opkaldstabel *>
4 14603 opk_indeks:= 0;
4 14604 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14605 begin
5 14606 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14607 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14608 end;
4 14609 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14610 if res <> 0 then goto slut_grp_res_1;
4 14611 g_type:= d.op.data(1) shift (-21) extract 1;
4 14612 if g_type = 1 <*special gruppe*> then
4 14613 begin <*check eksistens*>
5 14614 gr:= 0;
5 14615 for i:= 1 step 1 until max_antal_grupper do
5 14616 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14617 if gr = 0 then <*gruppe ukendt*>
5 14618 begin
6 14619 res:= 8;
6 14620 goto slut_grp_res_1;
6 14621 end;
5 14622 end;
4 14623
4 14623 <* reserver i opkaldstabel *>
4 14624 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14625 \f
4 14625 message procedure vt_tilstand side 6 - 810428/cl;
4 14626
4 14626 <* tilknyt fil *>
4 14627 start_operation(filop,curr_coruid,cs_fil,101);
4 14628 d.filop.data(1):= 0; <*postantal*>
4 14629 d.filop.data(2):= 256; <*postlængde*>
4 14630 d.filop.data(3):= 1; <*segmentantal*>
4 14631 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14632 signalch(cs_opret_fil,filop,vt_optype);
4 14633
4 14633 slut_grp_res_1:
4 14634 if res <> 0 then d.op.resultat:= res;
4 14635 end;
3 14636 if res <> 0 then goto returner;
3 14637
3 14637 waitch(cs_fil,filop,vt_optype,-1);
3 14638
3 14638 <* check filsys-resultat *>
3 14639 if d.filop.data(9) <> 0 then
3 14640 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14641 filref:= d.filop.data(4);
3 14642 \f
3 14642 message procedure vt_tilstand side 7 - 820301/cl;
3 14643 disable if g_type = 0 <*linie-gruppe*> then
3 14644 begin
4 14645 integer s,i,ll_id;
4 14646 integer array field iaf1;
4 14647
4 14647 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14648 iaf1:= 2;
4 14649 s:= binærsøg(sidste_linie_løb,
4 14650 linie_løb_tabel(i) - ll_id, i);
4 14651 if s < 0 then i:= i +1;
4 14652 antal:= ej_res:= 0;
4 14653 skrivfil(filref,1,zi);
4 14654 if i <= sidste_linie_løb then
4 14655 begin
5 14656 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14657 begin
6 14658 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14659 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14660 ej_res:= ej_res+1
6 14661 else
6 14662 begin
7 14663 antal:= antal+1;
7 14664 bi:= busindeks(i) extract 12;
7 14665 fil(zi).iaf1(1):=
7 14666 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14667 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14668 fil(zi).iaf1(2):= bustabel(bi);
7 14669 iaf1:= iaf1+4;
7 14670 bustilstand(bi):= false add opk_indeks;
7 14671 end;
6 14672 i:= i +1;
6 14673 if i > sidste_linie_løb then goto slut_l_grp;
6 14674 end;
5 14675 end;
4 14676 \f
4 14676 message procedure vt_tilstand side 8 - 820301/cl;
4 14677
4 14677 slut_l_grp:
4 14678 end
3 14679 else
3 14680 begin <*special gruppe*>
4 14681 integer i,s,li,omr,gar,tilst;
4 14682 integer array field iaf1;
4 14683
4 14683 iaf1:= 2;
4 14684 antal:= ej_res:= 0;
4 14685 s:= læsfil(tf_gruppedef,gr,zi);
4 14686 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14687 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14688 s:= skrivfil(filref,1,zi);
4 14689 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14690 i:= 1;
4 14691 while identer(i) <> 0 do
4 14692 begin
5 14693 if identer(i) shift (-22) = 0 then
5 14694 begin <*busident*>
6 14695 omr:= 0;
6 14696 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14697 if bi<0 then goto næste_ident;
6 14698 li:= linie_løb_indeks(bi) extract 12;
6 14699 end
5 14700 else
5 14701 begin <*linie/løb ident*>
6 14702 s:= binærsøg(sidste_linie_løb,
6 14703 linie_løb_tabel(li) - identer(i), li);
6 14704 if s <> 0 then goto næste_ident;
6 14705 bi:= busindeks(li) extract 12;
6 14706 end;
5 14707 if (intg(bustilstand(bi))<>0) or
5 14708 (bustabel1(bi) extract 8 <> 3) then
5 14709 ej_res:= ej_res+1
5 14710 else
5 14711 begin
6 14712 antal:= antal +1;
6 14713 fil(zi).iaf1(1):=
6 14714 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14715 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14716 fil(zi).iaf1(2):= bustabel(bi);
6 14717 iaf1:= iaf1+4;
6 14718 bustilstand(bi):= false add opk_indeks;
6 14719 end;
5 14720 næste_ident:
5 14721 i:= i +1;
5 14722 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14723 end;
4 14724 slut_s_grp:
4 14725 end;
3 14726 \f
3 14726 message procedure vt_tilstand side 9 - 820301/cl;
3 14727
3 14727 if antal > 0 then <*ok*>
3 14728 disable begin
4 14729 integer array field spec,akt;
4 14730 integer a;
4 14731 integer field antal_spec;
4 14732
4 14732 antal_spec:= 2; a:= 0;
4 14733 spec:= 2; akt:= 2;
4 14734 sorter_gruppe(fil(zi).spec,1,antal);
4 14735 fil(zi).antal_spec:= 0;
4 14736 while akt//4 < antal do
4 14737 begin
5 14738 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14739 a:= 0;
5 14740 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14741 and a<15 do
5 14742 begin
6 14743 a:= a+1;
6 14744 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14745 akt:= akt+4;
6 14746 end;
5 14747 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14748 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14749 spec:= spec + 2*a + 2;
5 14750 end;
4 14751 antal:= fil(zi).antal_spec;
4 14752 gruppeopkald(opk_indeks,2):= filref;
4 14753 d.op.resultat:= 3;
4 14754 d.op.data(2):= antal;
4 14755 d.op.data(3):= filref;
4 14756 d.op.data(4):= ej_res;
4 14757 end
3 14758 else
3 14759 begin
4 14760 disable begin
5 14761 d.filop.opkode:= 104; <*slet fil*>
5 14762 signalch(cs_slet_fil,filop,vt_optype);
5 14763 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14764 d.op.resultat:= 54;
5 14765 d.op.data(2):= antal;
5 14766 d.op.data(3):= 0;
5 14767 d.op.data(4):= ej_res;
5 14768 end;
4 14769 waitch(cs_fil,filop,vt_optype,-1);
4 14770 if d.filop.data(9) <> 0 then
4 14771 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14772 end;
3 14773 goto returner;
3 14774 \f
3 14774 message procedure vt_tilstand side 10 - 820301/cl;
3 14775
3 14775 grp_fri: <* frigiv gruppe *>
3 14776 disable
3 14777 begin integer i,j,s,ll,gar,omr,tilst;
4 14778 integer array field spec;
4 14779
4 14779 <*+4*>
4 14780 <**> if format <> 2 then
4 14781 <**> begin
5 14782 <**> res:= 31;
5 14783 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14784 <**> goto slut_grp_fri;
5 14785 <**> end;
4 14786 <*-4*>
4 14787
4 14787 <* find indeks i opkaldstabel *>
4 14788 opk_indeks:= 0;
4 14789 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14790 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14791 if opk_indeks = 0 <*ikke fundet*> then
4 14792 begin
5 14793 res:= 40; <*gruppe ej reserveret*>
5 14794 goto slut_grp_fri;
5 14795 end;
4 14796 filref:= gruppeopkald(opk_indeks,2);
4 14797 start_operation(filop,curr_coruid,cs_fil,104);
4 14798 d.filop.data(4):= filref;
4 14799 hentfildim(d.filop.data);
4 14800 læsfil(filref,1,zi);
4 14801 spec:= 0;
4 14802 antal:= fil(zi).spec(1);
4 14803 spec:= spec+2;
4 14804 for i:= 1 step 1 until antal do
4 14805 begin
5 14806 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14807 begin
6 14808 busid:= fil(zi).spec(1+j) extract 14;
6 14809 omr:= 0;
6 14810 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14811 if bi>=0 then bustilstand(bi):= false;
6 14812 end;
5 14813 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14814 end;
4 14815
4 14815 slut_grp_fri:
4 14816 d.op.resultat:= res;
4 14817 end;
3 14818 if res <> 0 then goto returner;
3 14819 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14820 signalch(cs_slet_fil,filop,vt_optype);
3 14821 \f
3 14821 message procedure vt_tilstand side 11 - 810424/cl;
3 14822
3 14822 waitch(cs_fil,filop,vt_optype,-1);
3 14823
3 14823 if d.filop.data(9) <> 0 then
3 14824 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14825 d.op.resultat:= 3;
3 14826
3 14826 returner:
3 14827 disable
3 14828 begin
4 14829 <*+2*>
4 14830 <**> if testbit40 and overvåget then
4 14831 <**> begin
5 14832 <**> skriv_vt_tilst(out,0);
5 14833 <**> write(out,<: vogntabel efter ændring:>);
5 14834 <**> p_vogntabel(out);
5 14835 <**> end;
4 14836 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14837 <**> begin
5 14838 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14839 <**> p_gruppetabel(out);
5 14840 <**> end;
4 14841 <**> if (testbit41 and overvåget) or
4 14842 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14843 <**> begin
5 14844 <**> skriv_vt_tilst(out,0);
5 14845 <**> write(out,<: returner operation:>);
5 14846 <**> skriv_op(out,op);
5 14847 <**> end;
4 14848 <*-2*>
4 14849 signalch(d.op.retur,op,d.op.optype);
4 14850 end;
3 14851 goto vent_op;
3 14852
3 14852 vt_tilst_trap:
3 14853 disable skriv_vt_tilst(zbillede,1);
3 14854
3 14854 end vt_tilstand;
2 14855 \f
2 14855 message procedure vt_rapport side 1 - 810428/cl;
2 14856
2 14856 procedure vt_rapport(cs_fil,fil_opref);
2 14857 value cs_fil,fil_opref;
2 14858 integer cs_fil,fil_opref;
2 14859 begin
3 14860 integer array field op,filop;
3 14861 integer funk,filref,antal,id_ant,res;
3 14862 integer field i1,i2;
3 14863
3 14863 procedure skriv_vt_rap(z,omfang);
3 14864 value omfang;
3 14865 zone z;
3 14866 integer omfang;
3 14867 begin
4 14868 write(z,"nl",1,<:+++ vt_rapport :>);
4 14869 if omfang <> 0 then
4 14870 begin
5 14871 skriv_coru(z,abs curr_coruno);
5 14872 write(z,"nl",1,<<d>,
5 14873 <: cs_fil :>,cs_fil,"nl",1,
5 14874 <: filop :>,filop,"nl",1,
5 14875 <: op :>,op,"nl",1,
5 14876 <: funk :>,funk,"nl",1,
5 14877 <: filref :>,filref,"nl",1,
5 14878 <: antal :>,antal,"nl",1,
5 14879 <: id-ant :>,id_ant,"nl",1,
5 14880 <: res :>,res,"nl",1,
5 14881 <::>);
5 14882
5 14882 end;
4 14883 end skriv_vt_rap;
3 14884
3 14884 stackclaim(if cm_test then 198 else 146);
3 14885 filop:= fil_opref;
3 14886 i1:= 2; i2:= 4;
3 14887 trap(vt_rap_trap);
3 14888
3 14888 <*+2*>
3 14889 <**> disable if testbit47 and overvåget or testbit28 then
3 14890 <**> skriv_vt_rap(out,0);
3 14891 <*-2*>
3 14892 \f
3 14892 message procedure vt_rapport side 2 - 810505/cl;
3 14893
3 14893 vent_op:
3 14894 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14895
3 14895 <*+2*>
3 14896 <**> disable begin
4 14897 <**> if testbit41 and overvåget then
4 14898 <**> begin
5 14899 <**> skriv_vt_rap(out,0);
5 14900 <**> write(out,<: modtaget operation:>);
5 14901 <**> skriv_op(out,op);
5 14902 <**> ud;
5 14903 <**> end;
4 14904 <**> end;<*disable*>
3 14905 <*-2*>
3 14906
3 14906 disable
3 14907 begin
4 14908 integer opk;
4 14909
4 14909 opk:= d.op.opkode extract 12;
4 14910 funk:= if opk = 9 then 1 else
4 14911 if opk =10 then 2 else
4 14912 0;
4 14913 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14914
4 14914 <* opret og tilknyt fil *>
4 14915 start_operation(filop,curr_coruid,cs_fil,101);
4 14916 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14917 d.filop.data(2):= 2; <*postlængde*>
4 14918 d.filop.data(3):=10; <*segmenter*>
4 14919 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14920 signalch(cs_opretfil,filop,vt_optype);
4 14921 end;
3 14922
3 14922 waitch(cs_fil,filop,vt_optype,-1);
3 14923
3 14923 <* check resultat *>
3 14924 if d.filop.data(9) <> 0 then
3 14925 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14926 filref:= d.filop.data(4);
3 14927 antal:= 0;
3 14928 goto case funk of (l_rapport,b_rapport);
3 14929 \f
3 14929 message procedure vt_rapport side 3 - 850820/cl;
3 14930
3 14930 l_rapport:
3 14931 disable
3 14932 begin
4 14933 integer i,j,s,ll,zi;
4 14934 idant:= 0;
4 14935 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14936 <*+4*>
4 14937 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14938 <**> begin
5 14939 <**> res:= 31;
5 14940 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14941 <**> goto l_rap_slut;
5 14942 <**> end;
4 14943 <*-4*>
4 14944 ;
4 14945
4 14945 for i:= 1 step 1 until id_ant do
4 14946 begin
5 14947 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14948 s:= binærsøg(sidste_linie_løb,
5 14949 linie_løb_tabel(j) - ll, j);
5 14950 if s < 0 then j:= j +1;
5 14951
5 14951 if j<= sidste_linie_løb then
5 14952 begin <* skriv identer *>
6 14953 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14954 begin
7 14955 antal:= antal +1;
7 14956 s:= skrivfil(filref,antal,zi);
7 14957 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14958 fil(zi).i1:= linie_løb_tabel(j);
7 14959 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14960 j:= j +1;
7 14961 if j > sidste_bus then goto linie_slut;
7 14962 end;
6 14963 end;
5 14964 linie_slut:
5 14965 end;
4 14966 res:= 3;
4 14967 l_rap_slut:
4 14968 end <*disable*>;
3 14969 goto returner;
3 14970 \f
3 14970 message procedure vt_rapport side 4 - 820301/cl;
3 14971
3 14971 b_rapport:
3 14972 disable
3 14973 begin
4 14974 integer i,j,s,zi,busnr1,busnr2;
4 14975 <*+4*>
4 14976 <**> for i:= 1,2 do
4 14977 <**> if d.op.data(i) shift (-14) <> 0 then
4 14978 <**> begin
5 14979 <**> res:= 31;
5 14980 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14981 <**> goto bus_slut;
5 14982 <**> end;
4 14983 <*-4*>
4 14984
4 14984 busnr1:= d.op.data(1) extract 14;
4 14985 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14986 if busnr1 = 0 or busnr2 < busnr1 then
4 14987 begin
5 14988 res:= 7; <* fejl i busnr *>
5 14989 goto bus_slut;
5 14990 end;
4 14991
4 14991 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14992 - busnr1,j);
4 14993 if s < 0 then j:= j +1;
4 14994 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14995 if j <= sidste_bus then
4 14996 begin <* skriv identer *>
5 14997 while bustabel(j) extract 14 <= busnr2 do
5 14998 begin
6 14999 i:= linie_løb_indeks(j) extract 12;
6 15000 if i<>0 then
6 15001 begin
7 15002 antal:= antal +1;
7 15003 s:= skriv_fil(filref,antal,zi);
7 15004 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 15005 fil(zi).i1:= bustabel(j);
7 15006 fil(zi).i2:= linie_løb_tabel(i);
7 15007 end;
6 15008 j:= j +1;
6 15009 if j > sidste_bus then goto bus_slut;
6 15010 end;
5 15011 end;
4 15012 bus_slut:
4 15013 end <*disable*>;
3 15014 res:= 3; <*ok*>
3 15015 \f
3 15015 message procedure vt_rapport side 5 - 810409/cl;
3 15016
3 15016 returner:
3 15017 disable
3 15018 begin
4 15019 d.op.resultat:= res;
4 15020 d.op.data(6):= antal;
4 15021 d.op.data(7):= filref;
4 15022 d.filop.data(1):= antal;
4 15023 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 15024 i:= sæt_fil_dim(d.filop.data);
4 15025 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 15026 <*+2*>
4 15027 <**> if testbit41 and overvåget then
4 15028 <**> begin
5 15029 <**> skriv_vt_rap(out,0);
5 15030 <**> write(out,<: returner operation:>);
5 15031 <**> skriv_op(out,op);
5 15032 <**> end;
4 15033 <*-2*>
4 15034 signalch(d.op.retur,op,d.op.optype);
4 15035 end;
3 15036 goto vent_op;
3 15037
3 15037 vt_rap_trap:
3 15038 disable skriv_vt_rap(zbillede,1);
3 15039
3 15039 end vt_rapport;
2 15040 \f
2 15040 message procedure vt_gruppe side 1 - 810428/cl;
2 15041
2 15041 procedure vt_gruppe(cs_fil,fil_opref);
2 15042
2 15042 value cs_fil,fil_opref;
2 15043 integer cs_fil,fil_opref;
2 15044 begin
3 15045 integer array field op, fil_op, iaf;
3 15046 integer funk, res, filref, gr, i, antal, zi, s;
3 15047 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 15048 max_antal_grupper else max_antal_i_gruppe));
3 15049
3 15049 procedure skriv_vt_gruppe(zud,omfang);
3 15050 value omfang;
3 15051 integer omfang;
3 15052 zone zud;
3 15053 begin
4 15054 integer øg;
4 15055
4 15055 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 15056 if omfang <> 0 then
4 15057 disable
4 15058 begin
5 15059 skriv_coru(zud,abs curr_coruno);
5 15060 write(zud,"nl",1,<<d>,
5 15061 <: cs_fil :>,cs_fil,"nl",1,
5 15062 <: op :>,op,"nl",1,
5 15063 <: filop :>,filop,"nl",1,
5 15064 <: funk :>,funk,"nl",1,
5 15065 <: res :>,res,"nl",1,
5 15066 <: filref :>,filref,"nl",1,
5 15067 <: gr :>,gr,"nl",1,
5 15068 <: i :>,i,"nl",1,
5 15069 <: antal :>,antal,"nl",1,
5 15070 <: zi :>,zi,"nl",1,
5 15071 <: s :>,s,"nl",1,
5 15072 <::>);
5 15073 raf:= 0;
5 15074 system(3,øg,identer);
5 15075 write(zud,"nl",1,<:identer::>);
5 15076 skriv_hele(zud,identer.raf,øg*2,2);
5 15077 end;
4 15078 end;
3 15079
3 15079 stackclaim(if cm_test then 198 else 146);
3 15080 filop:= fil_opref;
3 15081 trap(vt_grp_trap);
3 15082 iaf:= 0;
3 15083 \f
3 15083 message procedure vt_gruppe side 2 - 810409/cl;
3 15084
3 15084 <*+2*>
3 15085 <**> disable if testbit47 and overvåget or testbit28 then
3 15086 <**> skriv_vt_gruppe(out,0);
3 15087 <*-2*>
3 15088
3 15088 vent_op:
3 15089 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 15090 <*+2*>
3 15091 <**>disable
3 15092 <**>begin
4 15093 <**> if testbit41 and overvåget then
4 15094 <**> begin
5 15095 <**> skriv_vt_gruppe(out,0);
5 15096 <**> write(out,<: modtaget operation:>);
5 15097 <**> skriv_op(out,op);
5 15098 <**> ud;
5 15099 <**> end;
4 15100 <**>end;
3 15101 <*-2*>
3 15102
3 15102 disable
3 15103 begin
4 15104 integer opk;
4 15105
4 15105 opk:= d.op.opkode extract 12;
4 15106 funk:= if opk=25 then 1 else
4 15107 if opk=26 then 2 else
4 15108 if opk=27 then 3 else
4 15109 if opk=28 then 4 else
4 15110 0;
4 15111 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 15112 end;
3 15113 <*+4*>
3 15114 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 15115 <**> begin
4 15116 <**> disable begin
5 15117 <**> d.op.resultat:= 31;
5 15118 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 15119 <**> end;
4 15120 <**> goto returner;
4 15121 <**> end;
3 15122 <*-4*>
3 15123
3 15123 goto case funk of(definer,slet,vis,oversigt);
3 15124 \f
3 15124 message procedure vt_gruppe side 3 - 810505/cl;
3 15125
3 15125 definer:
3 15126 disable
3 15127 begin
4 15128 gr:= 0; res:= 0;
4 15129 for i:= max_antal_grupper step -1 until 1 do
4 15130 begin
5 15131 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 15132 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 15133 end;
4 15134 if gr=0 then res:= 32; <*ingen plads*>
4 15135 end;
3 15136 if res<>0 then goto slut_definer;
3 15137 disable
3 15138 begin <*fri plads fundet*>
4 15139 antal:= d.op.data(2);
4 15140 if antal <=0 or max_antal_i_gruppe<antal then
4 15141 res:= 33 <*fejl i gruppestørrelse*>
4 15142 else
4 15143 begin
5 15144 for i:= 1 step 1 until antal do
5 15145 begin
6 15146 s:= læsfil(d.op.data(3),i,zi);
6 15147 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 15148 identer(i):= fil(zi).iaf(1);
6 15149 end;
5 15150 s:= modif_fil(tf_gruppedef,gr,zi);
5 15151 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15152 tofrom(fil(zi).iaf,identer,antal*2);
5 15153 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 15154 fil(zi).iaf(i):= 0;
5 15155 gruppetabel(gr):= d.op.data(1);
5 15156 s:= modiffil(tf_gruppeidenter,gr,zi);
5 15157 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 15158 fil(zi).iaf(1):= gruppetabel(gr);
5 15159 res:= 3;
5 15160 end;
4 15161 end;
3 15162 slut_definer:
3 15163 <*slet fil*>
3 15164 start_operation(fil_op,curr_coruid,cs_fil,104);
3 15165 d.filop.data(4):= d.op.data(3);
3 15166 signalch(cs_slet_fil,filop,vt_optype);
3 15167 waitch(cs_fil,filop,vt_optype,-1);
3 15168 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 15169 d.op.resultat:= res;
3 15170 goto returner;
3 15171 \f
3 15171 message procedure vt_gruppe side 4 - 810409/cl;
3 15172
3 15172 slet:
3 15173 disable
3 15174 begin
4 15175 gr:= 0; res:= 0;
4 15176 for i:= 1 step 1 until max_antal_grupper do
4 15177 begin
5 15178 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 15179 end;
4 15180 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 15181 else
4 15182 begin
5 15183 for i:= 1 step 1 until max_antal_gruppeopkald do
5 15184 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 15185 if res = 0 then
5 15186 begin
6 15187 gruppetabel(gr):= 0;
6 15188 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 15189 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 15190 fil(zi).iaf(1):= gruppetabel(gr);
6 15191 res:= 3;
6 15192 end;
5 15193 end;
4 15194 d.op.resultat:= res;
4 15195 end;
3 15196 goto returner;
3 15197 \f
3 15197 message procedure vt_gruppe side 5 - 810505/cl;
3 15198
3 15198 vis:
3 15199 disable
3 15200 begin
4 15201 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 15202 for i:= 1 step 1 until max_antal_grupper do
4 15203 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 15204 if gr = 0 then res:= 8
4 15205 else
4 15206 begin
5 15207 s:= læsfil(tf_gruppedef,gr,zi);
5 15208 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 15209 for i:= 1 step 1 until max_antal_i_gruppe do
5 15210 begin
6 15211 identer(i):= fil(zi).iaf(i);
6 15212 if identer(i) <> 0 then antal:= antal +1;
6 15213 end;
5 15214 start_operation(filop,curr_coruid,cs_fil,101);
5 15215 d.filop.data(1):= antal; <*postantal*>
5 15216 d.filop.data(2):= 1; <*postlængde*>
5 15217 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 15218 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 15219 d.filop.data(5):= d.filop.data(6):=
5 15220 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 15221 signalch(cs_opret_fil,filop,vt_optype);
5 15222 end;
4 15223 end;
3 15224 if res <> 0 then goto slut_vis;
3 15225 waitch(cs_fil,filop,vt_optype,-1);
3 15226 disable
3 15227 begin
4 15228 if d.filop.data(9) <> 0 then
4 15229 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 15230 filref:= d.filop.data(4);
4 15231 for i:= 1 step 1 until antal do
4 15232 begin
5 15233 s:= skrivfil(filref,i,zi);
5 15234 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 15235 fil(zi).iaf(1):= identer(i);
5 15236 end;
4 15237 res:= 3;
4 15238 end;
3 15239 slut_vis:
3 15240 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 15241 goto returner;
3 15242 \f
3 15242 message procedure vt_gruppe side 6 - 810508/cl;
3 15243
3 15243 oversigt:
3 15244 disable
3 15245 begin
4 15246 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 15247 for i:= 1 step 1 until max_antal_grupper do
4 15248 begin
5 15249 if gruppetabel(i) <> 0 then
5 15250 begin
6 15251 antal:= antal +1;
6 15252 identer(antal):= gruppetabel(i);
6 15253 end;
5 15254 end;
4 15255 start_operation(filop,curr_coruid,cs_fil,101);
4 15256 d.filop.data(1):= antal; <*postantal*>
4 15257 d.filop.data(2):= 1; <*postlængde*>
4 15258 d.filop.data(3):= if antal = 0 then 1 else
4 15259 (antal-1)//256 +1; <*segm.antal*>
4 15260 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 15261 d.filop.data(5):= d.filop.data(6):=
4 15262 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 15263 signalch(cs_opretfil,filop,vt_optype);
4 15264 end;
3 15265 waitch(cs_fil,filop,vt_optype,-1);
3 15266 disable
3 15267 begin
4 15268 if d.filop.data(9) <> 0 then
4 15269 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 15270 filref:= d.filop.data(4);
4 15271 for i:= 1 step 1 until antal do
4 15272 begin
5 15273 s:= skriv_fil(filref,i,zi);
5 15274 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 15275 fil(zi).iaf(1):= identer(i);
5 15276 end;
4 15277 d.op.resultat:= 3; <*ok*>
4 15278 d.op.data(1):= antal;
4 15279 d.op.data(2):= filref;
4 15280 end;
3 15281 \f
3 15281 message procedure vt_gruppe side 7 - 810505/cl;
3 15282
3 15282 returner:
3 15283 disable
3 15284 begin
4 15285 <*+2*>
4 15286 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 15287 <**> begin
5 15288 <**> skriv_vt_gruppe(out,0);
5 15289 <**> write(out,<: gruppetabel efter ændring:>);
5 15290 <**> p_gruppetabel(out);
5 15291 <**> end;
4 15292 <**> if testbit41 and overvåget then
4 15293 <**> begin
5 15294 <**> skriv_vt_gruppe(out,0);
5 15295 <**> write(out,<: returner operation:>);
5 15296 <**> skriv_op(out,op);
5 15297 <**> end;
4 15298 <*-2*>
4 15299 signalch(d.op.retur,op,d.op.optype);
4 15300 end;
3 15301 goto vent_op;
3 15302
3 15302 vt_grp_trap:
3 15303 disable skriv_vt_gruppe(zbillede,1);
3 15304
3 15304 end vt_gruppe;
2 15305 \f
2 15305 message procedure vt_spring side 1 - 810506/cl;
2 15306
2 15306 procedure vt_spring(cs_spring_retur,spr_opref);
2 15307 value cs_spring_retur,spr_opref;
2 15308 integer cs_spring_retur,spr_opref;
2 15309 begin
3 15310 integer array field komm_op,spr_op,iaf;
3 15311 real nu;
3 15312 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 15313
3 15313 procedure skriv_vt_spring(zud,omfang);
3 15314 value omfang;
3 15315 zone zud;
3 15316 integer omfang;
3 15317 begin
4 15318 write(zud,"nl",1,<:+++ vt_spring :>);
4 15319 if omfang <> 0 then
4 15320 begin
5 15321 skriv_coru(zud,abs curr_coruno);
5 15322 write(zud,"nl",1,<<d>,
5 15323 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 15324 <:spr-op :>,spr_op,"nl",1,
5 15325 <:komm-op :>,komm_op,"nl",1,
5 15326 <:funk :>,funk,"nl",1,
5 15327 <:interval :>,interval,"nl",1,
5 15328 <:nr :>,nr,"nl",1,
5 15329 <:i :>,i,"nl",1,
5 15330 <:s :>,s,"nl",1,
5 15331 <:id1 :>,id1,"nl",1,
5 15332 <:id2 :>,id2,"nl",1,
5 15333 <:res :>,res,"nl",1,
5 15334 <:res-inf :>,res_inf,"nl",1,
5 15335 <:medd-kode :>,medd_kode,"nl",1,
5 15336 <:zi :>,zi,"nl",1,
5 15337 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 15338 <::>);
5 15339 end;
4 15340 end;
3 15341 \f
3 15341 message procedure vt_spring side 2 - 810506/cl;
3 15342
3 15342 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 15343 value aktion,id1,id2;
3 15344 integer aktion,id1,id2,res,res_inf;
3 15345 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 15346 integer array field akt_op;
4 15347
4 15347 <* vent på adgang til vogntabel *>
4 15348 waitch(cs_vt_adgang,akt_op,true,-1);
4 15349
4 15349 <* start operation *>
4 15350 disable
4 15351 begin
5 15352 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 15353 d.akt_op.data(1):= id1;
5 15354 d.akt_op.data(2):= id2;
5 15355 signalch(cs_vt_opd,akt_op,vt_optype);
5 15356 end;
4 15357
4 15357 <* afvent svar *>
4 15358 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 15359 res:= d.akt_op.resultat;
4 15360 res_inf:= d.akt_op.data(3);
4 15361 <*+2*>
4 15362 <**> disable
4 15363 <**> if testbit45 and overvåget then
4 15364 <**> begin
5 15365 <**> real t;
5 15366 <**> skriv_vt_spring(out,0);
5 15367 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 15368 <**> skriv_id(out,springtabel(nr,1),0);
5 15369 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 15370 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 15371 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 15372 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 15373 <**> d.akt_op.resultat,"sp",2);
5 15374 <**> skriv_id(out,d.akt_op.data(1),8);
5 15375 <**> skriv_id(out,d.akt_op.data(2),8);
5 15376 <**> skriv_id(out,d.akt_op.data(3),8);
5 15377 <**> systime(4,springtid(nr),t);
5 15378 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 15379 <**> end;
4 15380 <*-2*>
4 15381
4 15381 <* åbn adgang til vogntabel *>
4 15382 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 15383 end vt_operation;
3 15384 \f
3 15384 message procedure vt_spring side 2a - 810506/cl;
3 15385
3 15385 procedure io_meddelelse(medd_no,bus,linie,springno);
3 15386 value medd_no,bus,linie,springno;
3 15387 integer medd_no,bus,linie,springno;
3 15388 begin
4 15389 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 15390 d.spr_op.data(1):= medd_no;
4 15391 d.spr_op.data(2):= bus;
4 15392 d.spr_op.data(3):= linie;
4 15393 d.spr_op.data(4):= springtabel(springno,1);
4 15394 d.spr_op.data(5):= springtabel(springno,2);
4 15395 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15396 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15397 end;
3 15398
3 15398 procedure returner_op(op,res);
3 15399 value res;
3 15400 integer array field op;
3 15401 integer res;
3 15402 begin
4 15403 <*+2*>
4 15404 <**> disable
4 15405 <**> if testbit41 and overvåget then
4 15406 <**> begin
5 15407 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15408 <**> skriv_op(out,op);
5 15409 <**> end;
4 15410 <*-2*>
4 15411 d.op.resultat:= res;
4 15412 signalch(d.op.retur,op,d.op.optype);
4 15413 end;
3 15414 \f
3 15414 message procedure vt_spring side 3 - 810603/cl;
3 15415
3 15415 iaf:= 0;
3 15416 spr_op:= spr_opref;
3 15417 stack_claim((if cm_test then 198 else 146) + 24);
3 15418
3 15418 trap(vt_spring_trap);
3 15419
3 15419 for i:= 1 step 1 until max_antal_spring do
3 15420 begin
4 15421 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15422 springtid(i):= springstart(i):= 0.0;
4 15423 end;
3 15424
3 15424 <*+2*>
3 15425 <**> disable
3 15426 <**> if testbit44 and overvåget then
3 15427 <**> begin
4 15428 <**> skriv_vt_spring(out,0);
4 15429 <**> write(out,<: springtabel efter initialisering:>);
4 15430 <**> p_springtabel(out); ud;
4 15431 <**> end;
3 15432 <*-2*>
3 15433
3 15433 <*+2*>
3 15434 <**> disable if testbit47 and overvåget or testbit28 then
3 15435 <**> skriv_vt_spring(out,0);
3 15436 <*-2*>
3 15437 \f
3 15437 message procedure vt_spring side 4 - 810609/cl;
3 15438
3 15438 næste_tid: <* find næste tid *>
3 15439 disable
3 15440 begin
4 15441 interval:= -1; <*vent uendeligt*>
4 15442 systime(1,0.0,nu);
4 15443 for i:= 1 step 1 until max_antal_spring do
4 15444 if springtabel(i,3) < 0 then
4 15445 interval:= 5
4 15446 else
4 15447 if springtid(i) <> 0.0 and
4 15448 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15449 interval:= (if springtid(i) <= nu then 0 else
4 15450 round(springtid(i) -nu));
4 15451 if interval=0 then interval:= 1;
4 15452 end;
3 15453 \f
3 15453 message procedure vt_spring side 4a - 810525/cl;
3 15454
3 15454 <* afvent operation eller timeout *>
3 15455 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15456 if komm_op <> 0 then goto afkod_operation;
3 15457
3 15457 <* timeout *>
3 15458 systime(1,0.0,nu);
3 15459 nr:= 1;
3 15460 næste_sekv:
3 15461 if nr > max_antal_spring then goto næste_tid;
3 15462 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15463 begin
4 15464 nr:= nr +1;
4 15465 goto næste_sekv;
4 15466 end;
3 15467 disable s:= modif_fil(tf_springdef,nr,zi);
3 15468 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15469 if springtabel(nr,3) < 0 then
3 15470 begin <* hængende spring *>
4 15471 if springtid(nr) <= nu then
4 15472 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15473 <* find frit løb *>
5 15474 disable
5 15475 begin
6 15476 id2:= 0;
6 15477 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15478 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15479 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15480 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15481 end;
5 15482 <* send meddelelse til io *>
5 15483 io_meddelelse(5,0,id2,nr);
5 15484
5 15484 <* annuler spring*>
5 15485 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15486 springtid(nr):= springstart(nr):= 0.0;
5 15487 end
4 15488 else
4 15489 begin <* forsøg igen *>
5 15490 \f
5 15490 message procedure vt_spring side 5 - 810525/cl;
5 15491
5 15491 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15492 if i = 2 <* første spring ej udført *> then
5 15493 begin
6 15494 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15495 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15496 id2:= id1;
6 15497 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15498 end
5 15499 else
5 15500 begin
6 15501 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15502 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15503 id2:= id1 shift (-7) shift 7
6 15504 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15505 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15506 end;
5 15507
5 15507 <* check resultat *>
5 15508 medd_kode:= if res = 3 and i = 2 then 7 else
5 15509 if res = 3 and i > 2 then 8 else
5 15510 <* if res = 9 then 1 else
5 15511 if res =12 then 2 else
5 15512 if res =14 then 4 else
5 15513 if res =18 then 3 else *>
5 15514 0;
5 15515 if medd_kode > 0 then
5 15516 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15517 id2 else id1,nr);
5 15518 if res = 3 then
5 15519 begin <* spring udført *>
6 15520 disable s:= modiffil(tf_springdef,nr,zi);
6 15521 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15522 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15523 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15524 if i > 2 then fil(zi).iaf(2+i-2):=
6 15525 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15526 end;
5 15527 end;
4 15528 end <* hængende spring *>
3 15529 else
3 15530 begin
4 15531 i:= spring_tabel(nr,3) shift (-12);
4 15532 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15533 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15534 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15535 + id1 shift (-7) shift 7;
4 15536 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15537 \f
4 15537 message procedure vt_spring side 6 - 820304/cl;
4 15538
4 15538 <* check resultat *>
4 15539 medd_kode:= if res = 3 then 8 else
4 15540 if res = 9 then 1 else
4 15541 if res =12 then 2 else
4 15542 if res =14 then 4 else
4 15543 if res =18 then 3 else
4 15544 if res =60 then 9 else 0;
4 15545 if medd_kode > 0 then
4 15546 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15547
4 15547 <* opdater springtabel *>
4 15548 disable s:= modiffil(tf_springdef,nr,zi);
4 15549 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15550 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15551 begin
5 15552 io_meddelelse(if res=3 then 6 else 5,0,
5 15553 if res=3 then id1 else id2,nr);
5 15554 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15555 springtid(nr):= springstart(nr):= 0.0;
5 15556 end
4 15557 else
4 15558 begin
5 15559 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15560 if res = 3 then
5 15561 begin
6 15562 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15563 (fil(zi).iaf(2+i-1) extract 22);
6 15564 fil(zi).iaf(2+i) := (1 shift 22) add
6 15565 (fil(zi).iaf(2+i) extract 22);
6 15566 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15567 end
5 15568 else
5 15569 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15570 end;
4 15571 end;
3 15572 <*+2*>
3 15573 <**> disable
3 15574 <**> if testbit44 and overvåget then
3 15575 <**> begin
4 15576 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15577 <**> p_springtabel(out); ud;
4 15578 <**> end;
3 15579 <*-2*>
3 15580
3 15580 nr:= nr +1;
3 15581 goto næste_sekv;
3 15582 \f
3 15582 message procedure vt_spring side 7 - 810506/cl;
3 15583
3 15583 afkod_operation:
3 15584 <*+2*>
3 15585 <**> disable
3 15586 <**> if testbit41 and overvåget then
3 15587 <**> begin
4 15588 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15589 <**> skriv_op(out,komm_op);
4 15590 <**> end;
3 15591 <*-2*>
3 15592
3 15592 disable
3 15593 begin integer opk;
4 15594
4 15594 opk:= d.komm_op.opkode extract 12;
4 15595 funk:= if opk = 30 <*sp,d*> then 5 else
4 15596 if opk = 31 <*sp. *> then 1 else
4 15597 if opk = 32 <*sp,v*> then 4 else
4 15598 if opk = 33 <*sp,o*> then 6 else
4 15599 if opk = 34 <*sp,r*> then 2 else
4 15600 if opk = 35 <*sp,a*> then 3 else
4 15601 0;
4 15602 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15603
4 15603 if funk <> 6 <*sp,o*> then
4 15604 begin <* find nr i springtabel *>
5 15605 nr:= 0;
5 15606 for i:= 1 step 1 until max_antal_spring do
5 15607 if springtabel(i,1) = d.komm_op.data(1) and
5 15608 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15609 end;
4 15610 end;
3 15611 if funk = 6 then goto oversigt;
3 15612 if funk = 5 then goto definer;
3 15613
3 15613 if nr = 0 then
3 15614 begin
4 15615 returner_op(komm_op,37<*spring ukendt*>);
4 15616 goto næste_tid;
4 15617 end;
3 15618
3 15618 goto case funk of(start,indsæt,annuler,vis);
3 15619 \f
3 15619 message procedure vt_spring side 8 - 810525/cl;
3 15620
3 15620 start:
3 15621 if springtabel(nr,3) shift (-12) <> 0 then
3 15622 begin returner_op(komm_op,38); goto næste_tid; end;
3 15623 disable
3 15624 begin <* find linie_løb_og_udtag *>
4 15625 s:= modif_fil(tf_springdef,nr,zi);
4 15626 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15627 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15628 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15629 id2:= 0;
4 15630 end;
3 15631 vt_operation(12,id1,id2,res,res_inf);
3 15632
3 15632 disable <* check resultat *>
3 15633 medd_kode:= if res = 3 <*ok*> then 7 else
3 15634 if res = 9 <*linie/løb ukendt*> then 1 else
3 15635 if res =14 <*optaget*> then 4 else
3 15636 if res =18 <*i kø*> then 3 else 0;
3 15637 returner_op(komm_op,3);
3 15638 if medd_kode = 0 then goto næste_tid;
3 15639
3 15639 <* send spring-meddelelse til io *>
3 15640 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15641
3 15641 <* opdater springtabel *>
3 15642 disable
3 15643 begin
4 15644 s:= modif_fil(tf_springdef,nr,zi);
4 15645 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15646 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15647 add (springtabel(nr,3) extract 12);
4 15648 systime(1,0.0,nu);
4 15649 springstart(nr):= nu;
4 15650 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15651 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15652 end;
3 15653 <*+2*>
3 15654 <**> disable
3 15655 <**> if testbit44 and overvåget then
3 15656 <**> begin
4 15657 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15658 <**> p_springtabel(out); ud;
4 15659 <**> end;
3 15660 <*-2*>
3 15661
3 15661 goto næste_tid;
3 15662 \f
3 15662 message procedure vt_spring side 9 - 810506/cl;
3 15663
3 15663 indsæt:
3 15664 if springtabel(nr,3) shift (-12) = 0 then
3 15665 begin <* ikke igangsat *>
4 15666 returner_op(komm_op,41);
4 15667 goto næste_tid;
4 15668 end;
3 15669 <* find frie linie/løb *>
3 15670 disable
3 15671 begin
4 15672 s:= læs_fil(tf_springdef,nr,zi);
4 15673 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15674 id2:= 0;
4 15675 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15676 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15677 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15678 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15679 id1:= d.komm_op.data(3);
4 15680 end;
3 15681
3 15681 if id2<>0 then
3 15682 vt_operation(11,id1,id2,res,res_inf)
3 15683 else
3 15684 res:= 42;
3 15685
3 15685 disable <* check resultat *>
3 15686 medd_kode:= if res = 3 <*ok*> then 8 else
3 15687 if res =10 <*bus ukendt*> then 0 else
3 15688 if res =11 <*bus allerede indsat*> then 0 else
3 15689 if res =12 <*linie/løb allerede besat*> then 2 else
3 15690 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15691 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15692 returner_op(komm_op,res);
3 15693 if medd_kode = 0 then goto næste_tid;
3 15694
3 15694 <* send springmeddelelse til io *>
3 15695 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15696 io_meddelelse(5,0,0,nr);
3 15697 \f
3 15697 message procedure vt_spring side 9a - 810525/cl;
3 15698
3 15698 <* annuler springtabel *>
3 15699 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15700 springtid(nr):= springstart(nr):= 0.0;
3 15701 <*+2*>
3 15702 <**> disable
3 15703 <**> if testbit44 and overvåget then
3 15704 <**> begin
4 15705 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15706 <**> p_springtabel(out); ud;
4 15707 <**> end;
3 15708 <*-2*>
3 15709
3 15709 goto næste_tid;
3 15710 \f
3 15710 message procedure vt_spring side 10 - 810525/cl;
3 15711
3 15711 annuler:
3 15712 disable
3 15713 begin <* find evt. frit linie/løb *>
4 15714 s:= læs_fil(tf_springdef,nr,zi);
4 15715 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15716 id1:= id2:= 0;
4 15717 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15718 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15719 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15720 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15721 returner_op(komm_op,3);
4 15722 end;
3 15723
3 15723 <* send springmeddelelse til io *>
3 15724 io_meddelelse(5,id1,id2,nr);
3 15725
3 15725 <* annuler springtabel *>
3 15726 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15727 springtid(nr):= springstart(nr):= 0.0;
3 15728 <*+2*>
3 15729 <**> disable
3 15730 <**> if testbit44 and overvåget then
3 15731 <**> begin
4 15732 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15733 <**> p_springtabel(out); ud;
4 15734 <**> end;
3 15735 <*-2*>
3 15736
3 15736 goto næste_tid;
3 15737
3 15737 definer:
3 15738 if nr <> 0 then <* allerede defineret *>
3 15739 begin
4 15740 res:= 36;
4 15741 goto slut_definer;
4 15742 end;
3 15743
3 15743 <* find frit nr *>
3 15744 i:= 0;
3 15745 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15746 if springtabel(i,1) = 0 then nr:= i;
3 15747 if nr = 0 then
3 15748 begin
4 15749 res:= 32; <* ingen fri plads *>
4 15750 goto slut_definer;
4 15751 end;
3 15752 \f
3 15752 message procedure vt_spring side 11 - 810525/cl;
3 15753
3 15753 disable
3 15754 begin integer array fdim(1:8),ia(1:32);
4 15755 <* læs sekvens *>
4 15756 fdim(4):= d.komm_op.data(3);
4 15757 s:= hent_fil_dim(fdim);
4 15758 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15759 if fdim(1) > 30 then
4 15760 res:= 35 <* springsekvens for stor *>
4 15761 else
4 15762 begin
5 15763 for i:= 1 step 1 until fdim(1) do
5 15764 begin
6 15765 s:= læs_fil(fdim(4),i,zi);
6 15766 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15767 ia(i):= fil(zi).iaf(1) shift 12;
6 15768 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15769 end;
5 15770 s:= modif_fil(tf_springdef,nr,zi);
5 15771 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15772 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15773 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15774 iaf:= 4;
5 15775 tofrom(fil(zi).iaf,ia,60);
5 15776 iaf:= 0;
5 15777 springtabel(nr,3):= fdim(1);
5 15778 springtid(nr):= springstart(nr):= 0.0;
5 15779 res:= 3;
5 15780 end;
4 15781 end;
3 15782 \f
3 15782 message procedure vt_spring side 11a - 81-525/cl;
3 15783
3 15783 slut_definer:
3 15784
3 15784 <* slet fil *>
3 15785 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15786 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15787 signalch(cs_slet_fil,spr_op,vt_optype);
3 15788 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15789 if d.spr_op.data(9) <> 0 then
3 15790 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15791 returner_op(komm_op,res);
3 15792 <*+2*>
3 15793 <**> disable
3 15794 <**> if testbit44 and overvåget then
3 15795 <**> begin
4 15796 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15797 <**> p_springtabel(out); ud;
4 15798 <**> end;
3 15799 <*-2*>
3 15800 goto næste_tid;
3 15801 \f
3 15801 message procedure vt_spring side 12 - 810525/cl;
3 15802
3 15802 vis:
3 15803 disable
3 15804 begin
4 15805 <* tilknyt fil *>
4 15806 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15807 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15808 d.spr_op.data(2):= 1;
4 15809 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15810 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15811 signalch(cs_opret_fil,spr_op,vt_optype);
4 15812 end;
3 15813
3 15813 <* afvent svar *>
3 15814 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15815 if d.spr_op.data(9) <> 0 then
3 15816 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15817 disable
3 15818 begin integer array ia(1:30);
4 15819 s:= læs_fil(tf_springdef,nr,zi);
4 15820 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15821 iaf:= 4;
4 15822 tofrom(ia,fil(zi).iaf,60);
4 15823 iaf:= 0;
4 15824 for i:= 1 step 1 until d.spr_op.data(1) do
4 15825 begin
5 15826 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15827 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15828 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15829 ia(i) shift (-12) extract 7
5 15830 else -(ia(i) shift (-12) extract 7);
5 15831 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15832 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15833 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15834 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15835 else ia(i) extract 12)
5 15836 else 0;
5 15837 end;
4 15838 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15839 sæt_fil_dim(d.spr_op.data);
4 15840 d.komm_op.data(3):= d.spr_op.data(1);
4 15841 d.komm_op.data(4):= d.spr_op.data(4);
4 15842 raf:= data+8;
4 15843 d.komm_op.raf(1):= springstart(nr);
4 15844 returner_op(komm_op,3);
4 15845 end;
3 15846 goto næste_tid;
3 15847 \f
3 15847 message procedure vt_spring side 13 - 810525/cl;
3 15848
3 15848 oversigt:
3 15849 disable
3 15850 begin
4 15851 <* opret fil *>
4 15852 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15853 d.spr_op.data(1):= max_antal_spring;
4 15854 d.spr_op.data(2):= 4;
4 15855 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15856 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15857 signalch(cs_opret_fil,spr_op,vt_optype);
4 15858 end;
3 15859
3 15859 <* afvent svar *>
3 15860 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15861 if d.spr_op.data(9) <> 0 then
3 15862 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15863 disable
3 15864 begin
4 15865 nr:= 0;
4 15866 for i:= 1 step 1 until max_antal_spring do
4 15867 begin
5 15868 if springtabel(i,1) <> 0 then
5 15869 begin
6 15870 nr:= nr +1;
6 15871 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15872 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15873 fil(zi).iaf(1):= springtabel(i,1);
6 15874 fil(zi).iaf(2):= springtabel(i,2);
6 15875 fil(zi,2):= springstart(i);
6 15876 end;
5 15877 end;
4 15878 d.spr_op.data(1):= nr;
4 15879 s:= sæt_fil_dim(d.spr_op.data);
4 15880 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15881 d.komm_op.data(1):= nr;
4 15882 d.komm_op.data(2):= d.spr_op.data(4);
4 15883 returner_op(komm_op,3);
4 15884 end;
3 15885 goto næste_tid;
3 15886
3 15886 vt_spring_trap:
3 15887 disable skriv_vt_spring(zbillede,1);
3 15888
3 15888 end vt_spring;
2 15889 \f
2 15889 message procedure vt_auto side 1 - 810505/cl;
2 15890
2 15890 procedure vt_auto(cs_auto_retur,auto_opref);
2 15891 value cs_auto_retur,auto_opref;
2 15892 integer cs_auto_retur,auto_opref;
2 15893 begin
3 15894 integer array field op,auto_op,iaf;
3 15895 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15896 res_inf,i,s,zi,kl,døgnstart;
3 15897 real t,nu,næste_tid;
3 15898 boolean optaget;
3 15899 integer array filnavn,nytnavn(1:4);
3 15900
3 15900 procedure skriv_vt_auto(zud,omfang);
3 15901 value omfang;
3 15902 zone zud;
3 15903 integer omfang;
3 15904 begin
4 15905 long array field laf;
4 15906
4 15906 laf:= 0;
4 15907 write(zud,"nl",1,<:+++ vt_auto :>);
4 15908 if omfang<>0 then
4 15909 begin
5 15910 skriv_coru(zud,abs curr_coruno);
5 15911 write(zud,"nl",1,<<d>,
5 15912 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15913 <:op :>,op,"nl",1,
5 15914 <:auto-op :>,auto_op,"nl",1,
5 15915 <:filref :>,filref,"nl",1,
5 15916 <:id1 :>,id1,"nl",1,
5 15917 <:id2 :>,id2,"nl",1,
5 15918 <:aktion :>,aktion,"nl",1,
5 15919 <:postnr :>,postnr,"nl",1,
5 15920 <:sidste-post :>,sidste_post,"nl",1,
5 15921 <:interval :>,interval,"nl",1,
5 15922 <:res :>,res,"nl",1,
5 15923 <:res-inf :>,res_inf,"nl",1,
5 15924 <:i :>,i,"nl",1,
5 15925 <:s :>,s,"nl",1,
5 15926 <:zi :>,zi,"nl",1,
5 15927 <:kl :>,kl,"nl",1,
5 15928 <:døgnstart :>,døgnstart,"nl",1,
5 15929 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15930 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15931 <:nu :>,nu,"nl",1,
5 15932 <:næste-tid :>,næste_tid,"nl",1,
5 15933 <:filnavn :>,filnavn.laf,"nl",1,
5 15934 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15935 <::>);
5 15936 end;
4 15937 end skriv_vt_auto;
3 15938 \f
3 15938 message procedure vt_auto side 2 - 810507/cl;
3 15939
3 15939 iaf:= 0;
3 15940 auto_op:= auto_opref;
3 15941 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15942 optaget:= false;
3 15943 næste_tid:= 0.0;
3 15944 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15945 stack_claim(if cm_test then 298 else 246);
3 15946 trap(vt_auto_trap);
3 15947
3 15947 <*+2*>
3 15948 <**> disable if testbit47 and overvåget or testbit28 then
3 15949 <**> skriv_vt_auto(out,0);
3 15950 <*-2*>
3 15951
3 15951 vent:
3 15952
3 15952 systime(1,0.0,nu);
3 15953 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15954 if næste_tid > nu then round(næste_tid-nu) else
3 15955 if optaget then 5 else 0;
3 15956 if interval=0 then interval:= 1;
3 15957
3 15957 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15958
3 15958 if op<>0 then goto filskift;
3 15959
3 15959 <* vent på adgang til vogntabel *>
3 15960 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15961
3 15961 <* afsend relevant operation til opdatering af vogntabel *>
3 15962 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15963 d.op.data(1):= id1;
3 15964 d.op.data(2):= id2;
3 15965 signalch(cs_vt_opd,op,vt_optype);
3 15966 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15967 res:= d.op.resultat;
3 15968 id2:= d.op.data(2);
3 15969 res_inf:= d.op.data(3);
3 15970
3 15970 <* åbn for vogntabel *>
3 15971 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15972 \f
3 15972 message procedure vt_auto side 3 - 810507/cl;
3 15973
3 15973 <* behandl svar fra opdatering *>
3 15974 <*+2*>
3 15975 <**> disable
3 15976 <**> if testbit45 and overvåget then
3 15977 <**> begin
4 15978 <**> integer li,lø,bo;
4 15979 <**> skriv_vt_auto(out,0);
4 15980 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15981 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15982 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15983 <**> for i:= 1,2 do
4 15984 <**> begin
5 15985 <**> li:= d.op.data(i);
5 15986 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15987 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15988 <**> li:= li shift (-12) extract 10;
5 15989 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15990 <**> end;
4 15991 <**> systime(4,næste_tid,t);
4 15992 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15993 <**> << zd.dd>,t/10000,"nl",1);
4 15994 <**> end;
3 15995 <*-2*>
3 15996 if res=31 then
3 15997 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15998 else
3 15999 if res<>3 then
3 16000 begin
4 16001 if -, optaget then
4 16002 begin
5 16003 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 16004 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 16005 if res=18 then 3 else if res=60 then 9 else 4;
5 16006 d.auto_op.data(2):= res_inf;
5 16007 d.auto_op.data(3):= if res=12 then id2 else id1;
5 16008 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16009 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 16010 end;
4 16011 if res=14 or res=18 then <* i kø eller optaget *>
4 16012 begin
5 16013 optaget:= true;
5 16014 goto vent;
5 16015 end;
4 16016 end;
3 16017 optaget:= false;
3 16018 \f
3 16018 message procedure vt_auto side 4 - 810507/cl;
3 16019
3 16019 <* find næste post *>
3 16020 disable
3 16021 begin
4 16022 if postnr=sidste_post then
4 16023 begin <* døgnskift *>
5 16024 postnr:= 1;
5 16025 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16026 end
4 16027 else postnr:= postnr+1;
4 16028 s:= læsfil(filref,postnr,zi);
4 16029 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 16030 aktion:= fil(zi).iaf(1);
4 16031 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 16032 id1:= fil(zi).iaf(3);
4 16033 id2:= fil(zi).iaf(4);
4 16034 end;
3 16035 goto vent;
3 16036 \f
3 16036 message procedure vt_auto side 5 - 810507/cl;
3 16037
3 16037 filskift:
3 16038
3 16038 <*+2*>
3 16039 <**> disable
3 16040 <**> if testbit41 and overvåget then
3 16041 <**> begin
4 16042 <**> skriv_vt_auto(out,0);
4 16043 <**> write(out,<: modtaget operation::>);
4 16044 <**> skriv_op(out,op);
4 16045 <**> end;
3 16046 <*-2*>
3 16047 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 16048 res:= 46;
3 16049 if d.op.opkode extract 12 <> 21 then
3 16050 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 16051 if filref = 0 then goto knyt;
3 16052
3 16052 <* gem filnavn til io-meddelelse *>
3 16053 disable begin
4 16054 integer array fdim(1:8);
4 16055 integer array field navn;
4 16056 fdim(4):= filref;
4 16057 hentfildim(fdim);
4 16058 navn:= 8;
4 16059 tofrom(filnavn,fdim.navn,8);
4 16060 end;
3 16061
3 16061 <* frivgiv tilknyttet autofil *>
3 16062 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 16063 d.auto_op.data(4):= filref;
3 16064 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 16065 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 16066 if d.auto_op.data(9) <> 0 then
3 16067 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 16068 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 16069 optaget:= false;
3 16070 næste_tid:= 0.0;
3 16071 res:= 3;
3 16072 \f
3 16072 message procedure vt_auto side 6 - 810507/cl;
3 16073
3 16073 <* tilknyt evt. ny autofil *>
3 16074 knyt:
3 16075 if d.op.data(1)<>0 then
3 16076 begin
4 16077 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 16078 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 16079 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 16080 disable
4 16081 begin integer pos1,pos2;
5 16082 pos1:= pos2:= 13;
5 16083 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 16084 begin
6 16085 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 16086 skrivtegn(d.auto_op.data,pos2,i);
6 16087 end;
5 16088 end;
4 16089 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 16090 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 16091 s:= d.auto_op.data(9);
4 16092 if s=0 then res:= 3 <* ok *> else
4 16093 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 16094 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 16095 if s=6 then res:= 48 <* i brug *> else
4 16096 fejlreaktion(14,2,<:auto,filskift:>,0);
4 16097 if res<>3 then goto returner;
4 16098
4 16098 tofrom(nytnavn,d.op.data,8);
4 16099
4 16099 <* find første post *>
4 16100 disable
4 16101 begin
5 16102 døgnstart:= systime(5,0.0,t);
5 16103 kl:= round t;
5 16104 filref:= d.auto_op.data(4);
5 16105 sidste_post:= d.auto_op.data(1);
5 16106 postnr:= 0;
5 16107 for postnr:= postnr+1 while postnr <= sidste_post do
5 16108 begin
6 16109 s:= læsfil(filref,postnr,zi);
6 16110 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 16111 if fil(zi).iaf(2) > kl then goto post_fundet;
6 16112 end;
5 16113 postnr:= 1;
5 16114 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 16115 \f
5 16115 message procedure vt_auto side 7 - 810507/cl;
5 16116
5 16116 post_fundet:
5 16117 s:= læsfil(filref,postnr,zi);
5 16118 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 16119 aktion:= fil(zi).iaf(1);
5 16120 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 16121 id1:= fil(zi).iaf(3);
5 16122 id2:= fil(zi).iaf(4);
5 16123 res:= 3;
5 16124 end;
4 16125 end ny fil;
3 16126
3 16126 returner:
3 16127 d.op.resultat:= res;
3 16128 <*+2*>
3 16129 <**> disable
3 16130 <**> if testbit41 and overvåget then
3 16131 <**> begin
4 16132 <**> skriv_vt_auto(out,0);
4 16133 <**> write(out,<: returner operation::>);
4 16134 <**> skriv_op(out,op);
4 16135 <**> end;
3 16136 <*-2*>
3 16137 signalch(d.op.retur,op,d.op.optype);
3 16138
3 16138 if vt_log_aktiv then
3 16139 begin
4 16140 waitch(cs_vt_logpool,op,vt_optype,-1);
4 16141 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 16142 if nytnavn(1)=0 then
4 16143 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 16144 else
4 16145 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 16146 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 16147 systime(1,0.0,d.op.data.v_tid);
4 16148 signalch(cs_vt_log,op,vt_optype);
4 16149 end;
3 16150
3 16150 if filnavn(1)<>0 then
3 16151 begin <* meddelelse til io om annulering *>
4 16152 disable begin
5 16153 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 16154 i:= 1;
5 16155 hægtstring(d.auto_op.data,i,<:auto :>);
5 16156 skriv_text(d.auto_op.data,i,filnavn);
5 16157 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 16158 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 16159 signalch(cs_io,auto_op,io_optype or gen_optype);
5 16160 end;
4 16161 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 16162 end;
3 16163 goto vent;
3 16164
3 16164 vt_auto_trap:
3 16165 disable skriv_vt_auto(zbillede,1);
3 16166
3 16166 end vt_auto;
2 16167 message procedure vt_log side 1 - 920517/cl;
2 16168
2 16168 procedure vt_log;
2 16169 begin
3 16170 integer i,j,ventetid;
3 16171 real dg,t,nu,skiftetid;
3 16172 boolean fil_åben;
3 16173 integer array ia(1:10),dp,dp1(1:8);
3 16174 integer array field op, iaf;
3 16175
3 16175 procedure skriv_vt_log(zud,omfang);
3 16176 value omfang;
3 16177 zone zud;
3 16178 integer omfang;
3 16179 begin
4 16180 write(zud,"nl",1,<:+++ vt-log :>);
4 16181 if omfang<>0 then
4 16182 begin
5 16183 skriv_coru(zud, abs curr_coruno);
5 16184 write(zud,"nl",1,<<d>,
5 16185 <:i :>,i,"nl",1,
5 16186 <:j :>,j,"nl",1,
5 16187 <:ventetid :>,ventetid,"nl",1,
5 16188 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 16189 <:t :>,t,"nl",1,
5 16190 <:nu :>,nu,"nl",1,
5 16191 <:skiftetid :>,skiftetid,"nl",1,
5 16192 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 16193 <:op :>,<<d>,op,"nl",1,
5 16194 <::>);
5 16195 raf:= 0;
5 16196 write(zud,"nl",1,<:ia::>);
5 16197 skrivhele(zud,ia.raf,20,2);
5 16198 write(zud,"nl",2,<:dp::>);
5 16199 skrivhele(zud,dp.raf,16,2);
5 16200 write(zud,"nl",2,<:dp1::>);
5 16201 skrivhele(zud,dp1.raf,16,2);
5 16202 end;
4 16203 end;
3 16204
3 16204 message procedure vt_log side 2 - 920517/cl;
3 16205
3 16205 procedure slet_fil;
3 16206 begin
4 16207 integer segm,res;
4 16208 integer array tail(1:10);
4 16209
4 16209 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 16210 if res=0 then
4 16211 begin
5 16212 segm:= tail(10);
5 16213 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 16214 if res=0 then
5 16215 begin
6 16216 close(zvtlog,true);
6 16217 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 16218 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16219 if res=0 then
6 16220 begin
7 16221 tail(1):= tail(1)+segm;
7 16222 monitor(44)change_entry:(zvtlog,0,tail);
7 16223 end;
6 16224 end;
5 16225 end;
4 16226 end;
3 16227
3 16227 boolean procedure udvid_fil;
3 16228 begin
4 16229 integer res,spos;
4 16230 integer array tail(1:10);
4 16231 zone z(1,1,stderror);
4 16232
4 16232 udvid_fil:= false;
4 16233 open(z,0,<:vtlogpool:>,0); close(z,true);
4 16234 res:= monitor(42)lookup_entry:(z,0,tail);
4 16235 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 16236 begin
5 16237 tail(1):=tail(1) - vt_log_slicelgd;
5 16238 res:=monitor(44)change_entry:(z,0,tail);
5 16239 if res=0 then
5 16240 begin
6 16241 spos:= vt_logtail(1);
6 16242 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 16243 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 16244 if res<>0 then
6 16245 begin
7 16246 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 16247 tail(1):= tail(1) + vt_log_slicelgd;
7 16248 monitor(44)change_entry:(z,0,tail);
7 16249 end
6 16250 else
6 16251 begin
7 16252 setposition(zvtlog,0,spos);
7 16253 udvid_fil:= true;
7 16254 end;
6 16255 end;
5 16256 end;
4 16257 end;
3 16258
3 16258 message procedure vt_log side 3 - 920517/cl;
3 16259
3 16259 boolean procedure ny_fil;
3 16260 begin
4 16261 integer res,i,j;
4 16262 integer array nyt(1:4), ia,tail(1:10);
4 16263 long array field navn;
4 16264 real t;
4 16265
4 16265 navn:=0;
4 16266 if fil_åben then
4 16267 begin
5 16268 close(zvtlog,true);
5 16269 fil_åben:= false;
5 16270 nyt.navn(1):= long<:vtlo:>;
5 16271 nyt.navn(2):= long<::>;
5 16272 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 16273 j:= 'a' - 1;
5 16274 repeat
5 16275 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 16276 if res=3 then
5 16277 begin
6 16278 j:= j+1;
6 16279 if j <= 'å' then skrivtegn(nyt,11,j);
6 16280 end;
5 16281 until (res<>3) or (j > 'å');
5 16282
5 16282 if res=0 then
5 16283 begin
6 16284 open(zvtlog,4,<:vtlogklar:>,0);
6 16285 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 16286 if res=0 then
6 16287 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 16288 if res=0 then
6 16289 begin
7 16290 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 16291 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 16292 end;
6 16293
6 16293 if res=0 then
6 16294 begin
7 16295 setposition(zvtlog,0,tail(10)//64);
7 16296 navn:= (tail(10) mod 64)*8;
7 16297 if (tail(1) <= tail(10)//64) then
7 16298 outrec6(zvtlog,512)
7 16299 else
7 16300 swoprec6(zvtlog,512);
7 16301 tofrom(zvtlog.navn,nyt,8);
7 16302 tail(10):= tail(10)+1;
7 16303 setposition(zvtlog,0,tail(10)//64);
7 16304 monitor(44)change_entry:(zvtlog,0,tail);
7 16305 close(zvtlog,true);
7 16306 end
6 16307 else
6 16308 begin
7 16309 navn:= 0;
7 16310 close(zvtlog,true);
7 16311 open(zvtlog,4,<:vtlog:>,0);
7 16312 slet_fil;
7 16313 end;
6 16314 end
5 16315 else
5 16316 slet_fil;
5 16317 end;
4 16318
4 16318 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 16319 <* eller den er blevet slettet. *>
4 16320
4 16320 open(zvtlog,4,<:vtlog:>,0);
4 16321 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 16322 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 16323 vt_logtail(6):= systime(7,0,t);
4 16324
4 16324 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 16325 if res=0 then
4 16326 begin
5 16327 monitor(50)permanent_entry:(zvtlog,3,ia);
5 16328 if res<>0 then
5 16329 monitor(48)remove_entry:(zvtlog,0,ia);
5 16330 end;
4 16331
4 16331 if res=0 then fil_åben:= true;
4 16332
4 16332 ny_fil:= fil_åben;
4 16333 end ny_fil;
3 16334
3 16334 message procedure vt_log side 4 - 920517/cl;
3 16335
3 16335 procedure skriv_post(logpost);
3 16336 integer array logpost;
3 16337 begin
4 16338 integer array field post;
4 16339 real t;
4 16340
4 16340 if vt_logtail(10)//32 < vt_logtail(1) then
4 16341 begin
5 16342 outrec6(zvtlog,512);
5 16343 post:= (vt_logtail(10) mod 32)*16;
5 16344 tofrom(zvtlog.post,logpost,16);
5 16345 vt_logtail(10):= vt_logtail(10)+1;
5 16346 setposition(zvtlog,0,vt_logtail(10)//32);
5 16347 vt_logtail(6):= systime(7,0,t);
5 16348 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 16349 end;
4 16350 end;
3 16351
3 16351 procedure sletsendte;
3 16352 begin
4 16353 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 16354 integer array pooltail,tail,ia(1:10);
4 16355 integer i,res;
4 16356
4 16356 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 16357 res:=monitor(42,zpool,0,pooltail);
4 16358
4 16358 open(z,4,<:vtlogslet:>,0);
4 16359 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 16360 begin
5 16361 if monitor(52,z,0,tail)=0 then
5 16362 begin
6 16363 if monitor(8,z,0,tail)=0 then
6 16364 begin
7 16365 for i:=1 step 1 until tail(10) do
7 16366 begin
8 16367 inrec6(z,8);
8 16368 open(zlog,0,z,0); close(zlog,true);
8 16369 if monitor(42,zlog,0,ia)=0 then
8 16370 begin
9 16371 if monitor(48,zlog,0,ia)=0 then
9 16372 begin
10 16373 pooltail(1):=pooltail(1)+ia(1);
10 16374 end;
9 16375 end;
8 16376 end;
7 16377 tail(10):=0;
7 16378 monitor(44,z,0,tail);
7 16379 end
6 16380 else
6 16381 monitor(64,z,0,tail);
6 16382 end;
5 16383 if res=0 then monitor(44,zpool,0,pooltail);
5 16384 end;
4 16385 close(z,true);
4 16386 end;
3 16387
3 16387 message procedure vt_log side 5 - 920517/cl;
3 16388
3 16388 trap(vt_log_trap);
3 16389 stack_claim(200);
3 16390
3 16390 fil_åben:= false;
3 16391 if -, vt_log_aktiv then goto init_slut;
3 16392 open(zvtlog,4,<:vtlog:>,0);
3 16393 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16394 if i=0 then
3 16395 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16396 if i=0 then
3 16397 begin
4 16398 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16399 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16400 end;
3 16401
3 16401 if (i=0) and (vt_logtail(1)=0) then
3 16402 begin
4 16403 close(zvtlog,true);
4 16404 monitor(48)remove_entry:(zvtlog,0,ia);
4 16405 i:= 1;
4 16406 end;
3 16407
3 16407 disable
3 16408 if i=0 then
3 16409 begin
4 16410 fil_åben:= true;
4 16411 inrec6(zvtlog,512);
4 16412 vt_logstart:= zvtlog.v_tid;
4 16413 systime(1,0.0,nu);
4 16414 if (nu - vt_logstart) < 24*60*60.0 then
4 16415 begin
5 16416 setposition(zvtlog,0,vt_logtail(10)//32);
5 16417 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16418 begin
6 16419 inrec6(zvtlog,512);
6 16420 setposition(zvtlog,0,vt_logtail(10)//32);
6 16421 end;
5 16422 end
4 16423 else
4 16424 begin
5 16425 if ny_fil then
5 16426 begin
6 16427 if udvid_fil then
6 16428 begin
7 16429 systime(1,0.0,dp.v_tid);
7 16430 vt_logstart:= dp.v_tid;
7 16431 dp.v_kode:=0;
7 16432 skriv_post(dp);
7 16433 end
6 16434 else
6 16435 begin
7 16436 close(zvtlog,true);
7 16437 monitor(48)remove_entry:(zvtlog,0,ia);
7 16438 fil_åben:= false;
7 16439 end;
6 16440 end;
5 16441 end;
4 16442 end
3 16443 else
3 16444 begin
4 16445 close(zvtlog,true);
4 16446 if ny_fil then
4 16447 begin
5 16448 if udvid_fil then
5 16449 begin
6 16450 systime(1,0.0,dp.v_tid);
6 16451 vt_logstart:= dp.v_tid;
6 16452 dp.v_kode:=0;
6 16453 skriv_post(dp);
6 16454 end
5 16455 else
5 16456 begin
6 16457 close(zvtlog,true);
6 16458 monitor(48)remove_entry:(zvtlog,0,ia);
6 16459 fil_åben:= false;
6 16460 end;
5 16461 end;
4 16462 end;
3 16463
3 16463 init_slut:
3 16464
3 16464 dg:= systime(5,0,t);
3 16465 if t < vt_logskift then
3 16466 skiftetid:= systid(dg,vt_logskift)
3 16467 else
3 16468 skiftetid:= systid(dg+1,vt_logskift);
3 16469
3 16469 message procedure vt_log side 6 - 920517/cl;
3 16470
3 16470 vent:
3 16471
3 16471 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16472 ventetid:= round(skiftetid - nu);
3 16473 if ventetid < 1 then ventetid:= 1;
3 16474
3 16474 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16475
3 16475 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16476 if op <> 0 then
3 16477 begin
4 16478 tofrom(dp,d.op.data,16);
4 16479 signalch(cs_vt_logpool,op,vt_optype);
4 16480 end;
3 16481
3 16481 if -, vt_log_aktiv then goto vent;
3 16482
3 16482 disable if (op=0) or (nu > skiftetid) then
3 16483 begin
4 16484 if fil_åben then
4 16485 begin
5 16486 dp1.v_tid:= systid(dg,vt_logskift);
5 16487 dp1.v_kode:= 1;
5 16488 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16489 begin
6 16490 if udvid_fil then
6 16491 skriv_post(dp1);
6 16492 end
5 16493 else
5 16494 skriv_post(dp1);
5 16495 end;
4 16496
4 16496 if (op=0) or (nu > skiftetid) then
4 16497 skiftetid:= skiftetid + 24*60*60.0;
4 16498
4 16498 sletsendte;
4 16499
4 16499 if ny_fil then
4 16500 begin
5 16501 if udvid_fil then
5 16502 begin
6 16503 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16504 dp1.v_kode:= 0;
6 16505 skriv_post(dp1);
6 16506 end
5 16507 else
5 16508 begin
6 16509 close(zvtlog,true);
6 16510 monitor(48)remove_entry:(zvtlog,0,ia);
6 16511 fil_åben:= false;
6 16512 end;
5 16513 end;
4 16514 end;
3 16515
3 16515 disable if op<>0 and fil_åben then
3 16516 begin
4 16517 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16518 begin
5 16519 if -, udvid_fil then
5 16520 begin
6 16521 if ny_fil then
6 16522 begin
7 16523 if udvid_fil then
7 16524 begin
8 16525 systime(1,0.0,dp1.v_tid);
8 16526 vt_logstart:= dp1.v_tid;
8 16527 dp1.v_kode:= 0;
8 16528 skriv_post(dp1);
8 16529 end
7 16530 else
7 16531 begin
8 16532 close(zvtlog,true);
8 16533 monitor(48)remove_entry:(zvtlog,0,ia);
8 16534 fil_åben:= false;
8 16535 end;
7 16536 end;
6 16537 end;
5 16538 end;
4 16539
4 16539 if fil_åben then skriv_post(dp);
4 16540 end;
3 16541
3 16541 goto vent;
3 16542
3 16542 vt_log_trap:
3 16543 disable skriv_vt_log(zbillede,1);
3 16544 end vt_log;
2 16545 \f
2 16545
2 16545 algol list.off;
2 16546 message coroutinemonitor - 11 ;
2 16547
2 16547
2 16547 <*************** coroutine monitor procedures ***************>
2 16548
2 16548
2 16548 <***** delay *****
2 16549
2 16549 this procedure links the calling coroutine into the timerqueue and sets
2 16550 the timeout value to 'timeout'. *>
2 16551
2 16551
2 16551 procedure delay (timeout);
2 16552 value timeout;
2 16553 integer timeout;
2 16554 begin
3 16555 link(current, idlequeue);
3 16556 link(current + corutimerchain, timerqueue);
3 16557 d.current.corutimer:= timeout;
3 16558
3 16558
3 16558 passivate;
3 16559 d.current.corutimer:= 0;
3 16560 end;
2 16561 \f
2 16561
2 16561 message coroutinemonitor - 12 ;
2 16562
2 16562
2 16562 <***** pass *****
2 16563
2 16563 this procedure moves the calling coroutine from the head of the ready
2 16564 queue down below all coroutines of lower or equal priority. *>
2 16565
2 16565
2 16565 procedure pass;
2 16566 begin
3 16567 linkprio(current, readyqueue);
3 16568
3 16568
3 16568 passivate;
3 16569 end;
2 16570
2 16570
2 16570 <***** signal ****
2 16571
2 16571 this procedure increases the value af 'semaphore' by 1.
2 16572 in case some coroutine is already waiting, it is linked into the ready
2 16573 queue for activation. the calling coroutine continues execution. *>
2 16574
2 16574
2 16574 procedure signal (semaphore);
2 16575 value semaphore;
2 16576 integer semaphore;
2 16577 begin
3 16578 integer array field sem;
3 16579 sem:= semaphore;
3 16580 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16581 d.sem.simvalue:= d.sem.simvalue + 1;
3 16582
3 16582
3 16582 end;
2 16583 \f
2 16583
2 16583 message coroutinemonitor - 13 ;
2 16584
2 16584
2 16584 <***** wait *****
2 16585
2 16585 this procedure decreases the value of 'semaphore' by 1.
2 16586 in case the value of the semaphore is negative after the decrease, the
2 16587 calling coroutine is linked into the semaphore queue waiting for a
2 16588 coroutine to signal this semaphore. *>
2 16589
2 16589
2 16589 procedure wait (semaphore);
2 16590 value semaphore;
2 16591 integer semaphore;
2 16592 begin
3 16593 integer array field sem;
3 16594 sem:= semaphore;
3 16595 d.sem.simvalue:= d.sem.simvalue - 1;
3 16596
3 16596
3 16596 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16597 passivate;
3 16598 end;
2 16599 \f
2 16599
2 16599 message coroutinemonitor - 14 ;
2 16600
2 16600
2 16600 <***** inspect *****
2 16601
2 16601 this procedure inspects the value of the semaphore and returns it in
2 16602 'elements'.
2 16603 the semaphore is left unchanged. *>
2 16604
2 16604
2 16604 procedure inspect (semaphore, elements);
2 16605 value semaphore;
2 16606 integer semaphore, elements;
2 16607 begin
3 16608 integer array field sem;
3 16609 sem:= semaphore;
3 16610 elements:= d.sem.simvalue;
3 16611
3 16611
3 16611 end;
2 16612 \f
2 16612
2 16612 message coroutinemonitor - 15 ;
2 16613
2 16613
2 16613 <***** signalch *****
2 16614
2 16614 this procedure delivers an operation at 'semaphore'.
2 16615 in case another coroutine is already waiting for an operation of the
2 16616 kind 'operationtype' this coroutine will get the operation and it will
2 16617 be put into the ready queue for activation.
2 16618 in case no coroutine is waiting for the actial kind of operation it is
2 16619 linked into the semaphore queue, at the end of the queue
2 16620 if operation is positive and at the beginning if operation is negative.
2 16621 the calling coroutine continues execution. *>
2 16622
2 16622
2 16622 procedure signalch (semaphore, operation, operationtype);
2 16623 value semaphore, operation, operationtype;
2 16624 integer semaphore, operation;
2 16625 boolean operationtype;
2 16626 begin
3 16627 integer array field firstcoru, currcoru, op,currop;
3 16628 op:= abs operation;
3 16629 d.op.optype:= operationtype;
3 16630 firstcoru:= semaphore + semcoru;
3 16631 currcoru:= d.firstcoru.next;
3 16632 while currcoru <> firstcoru do
3 16633 begin
4 16634 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16635 begin
5 16636 link(operation, 0);
5 16637 d.currcoru.coruop:= operation;
5 16638 linkprio(currcoru, readyqueue);
5 16639 link(currcoru + corutimerchain, idlequeue);
5 16640 goto exit;
5 16641 end else currcoru:= d.currcoru.next;
4 16642 end;
3 16643 currop:=semaphore + semop;
3 16644 if operation < 0 then currop:=d.currop.next;
3 16645 link(op, currop);
3 16646 exit:
3 16647
3 16647
3 16647 end;
2 16648 \f
2 16648
2 16648 message coroutinemonitor - 16 ;
2 16649
2 16649
2 16649 <***** waitch *****
2 16650
2 16650 this procedure fetches an operation from a semaphore.
2 16651 in case an operation matching 'operationtypeset' is already waiting at
2 16652 'semaphore' it is handed over to the calling coroutine.
2 16653 in case no matching operation is waiting, the calling coroutine is
2 16654 linked to the semaphore.
2 16655 in any case the calling coroutine will be stopped and all corouti-
2 16656 nes are rescheduled. *>
2 16657
2 16657
2 16657 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16658 value semaphore, operationtypeset, timeout;
2 16659 integer semaphore, operation, timeout;
2 16660 boolean operationtypeset;
2 16661 begin
3 16662 integer array field firstop, currop;
3 16663 firstop:= semaphore + semop;
3 16664 currop:= d.firstop.next;
3 16665
3 16665
3 16665 while currop <> firstop do
3 16666 begin
4 16667 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16668 begin
5 16669 link(currop, 0);
5 16670 d.current.coruop:= currop;
5 16671 operation:= currop;
5 16672 \f
5 16672
5 16672 message coroutinemonitor - 17 ;
5 16673
5 16673 linkprio(current, readyqueue);
5 16674 passivate;
5 16675 goto exit;
5 16676 end else currop:= d.currop.next;
4 16677 end;
3 16678 linkprio(current, semaphore + semcoru);
3 16679 if timeout > 0 then
3 16680 begin
4 16681 link(current + corutimerchain, timerqueue);
4 16682 d.current.corutimer:= timeout;
4 16683 end else d.current.corutimer:= 0;
3 16684 d.current.corutypeset:= operationtypeset;
3 16685 passivate;
3 16686 if d.current.corutimer < 0 then operation:= 0
3 16687 else operation:= d.current.coruop;
3 16688 d.current.corutimer:= 0;
3 16689 currop:= operation;
3 16690 d.current.coruop:= currop;
3 16691 link(current+corutimerchain, idlequeue);
3 16692 exit:
3 16693
3 16693
3 16693 end;
2 16694 \f
2 16694
2 16694 message coroutinemonitor - 18 ;
2 16695
2 16695
2 16695 <***** inspectch *****
2 16696
2 16696 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16697 the number of matching operations are counted and delivered in 'elements'.
2 16698 if no operations are found the number of coroutines waiting
2 16699 for operations of the typeset are counted and delivered as
2 16700 negative value in 'elements'.
2 16701 the semaphore is left unchanged. *>
2 16702
2 16702
2 16702 procedure inspectch (semaphore, operationtypeset, elements);
2 16703 value semaphore, operationtypeset;
2 16704 integer semaphore, elements;
2 16705 boolean operationtypeset;
2 16706 begin
3 16707 integer array field firstop, currop,firstcoru,currcoru;
3 16708 integer counter;
3 16709 counter:= 0;
3 16710 firstop:= semaphore + semop;
3 16711 currop:= d.firstop.next;
3 16712 while currop <> firstop do
3 16713 begin
4 16714 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16715 counter:= counter + 1;
4 16716 currop:= d.currop.next;
4 16717 end;
3 16718 if counter=0 then
3 16719 begin
4 16720 firstcoru:=semaphore + sem_coru;
4 16721 curr_coru:=d.firstcoru.next;
4 16722 while curr_coru<>first_coru do
4 16723 begin
5 16724 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16725 counter:=counter - 1;
5 16726 curr_coru:=d.curr_coru.next;
5 16727 end;
4 16728 end;
3 16729 elements:= counter;
3 16730
3 16730
3 16730 end;
2 16731 \f
2 16731
2 16731 message coroutinemonitor - 19 ;
2 16732
2 16732
2 16732 <***** csendmessage *****
2 16733
2 16733 this procedure sends the message in 'mess' to the process defined by the name
2 16734 in 'receiver', and returns an identification of the message extension used
2 16735 for sending the message (this identification is to be used for calling 'cwait-
2 16736 answer' or 'cregretmessage'. *>
2 16737
2 16737
2 16737 procedure csendmessage (receiver, mess, messextension);
2 16738 real array receiver;
2 16739 integer array mess;
2 16740 integer messextension;
2 16741 begin
3 16742 integer bufref, messext;
3 16743 messref(maxmessext):= 0;
3 16744 messext:= 1;
3 16745 while messref(messext) <> 0 do messext:= messext + 1;
3 16746 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16747 begin
4 16748 messcode(messext):= 1 shift 12 add 2;
4 16749 mon(16) send message :(0, mess, 0, receiver);
4 16750 messref(messext):= monw2;
4 16751 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16752 end;
3 16753
3 16753
3 16753 end;
2 16754 \f
2 16754
2 16754 message coroutinemonitor - 20 ;
2 16755
2 16755
2 16755 <***** cwaitanswer *****
2 16756
2 16756 this procedure asks the coroutine monitor to get an answer to the message
2 16757 corresponding to 'messextension'. in case the answer has already arrived
2 16758 it stays in the eventqueue until 'cwaitanswer' is called.
2 16759 in case 'timeout' is positive, the coroutine is linked into the timer
2 16760 queue, and in case the answer does not arrive within 'timout' seconds the
2 16761 coroutine is restarted with result = 0. *>
2 16762
2 16762
2 16762 procedure cwaitanswer (messextension, answer, result, timeout);
2 16763 value messextension, timeout;
2 16764 integer messextension, result, timeout;
2 16765 integer array answer;
2 16766 begin
3 16767 integer messext;
3 16768 messext:= messextension;
3 16769 messcode(messext):= messcode(messext) extract 12;
3 16770 link(current, idlequeue);
3 16771 messop(messext):= current;
3 16772 if timeout > 0 then
3 16773 begin
4 16774 link(current + corutimerchain, timerqueue);
4 16775 d.current.corutimer:= timeout;
4 16776 end else d.current.corutimer:= 0;
3 16777
3 16777
3 16777 passivate;
3 16778 if d.current.corutimer < 0 then result:= 0 else
3 16779 begin
4 16780 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16781 result:= monw0;
4 16782 baseevent:= 0;
4 16783 messref(messextension):= 0;
4 16784 end;
3 16785 d.current.corutimer:= 0;
3 16786 link(current+corutimerchain, idlequeue);
3 16787 end;
2 16788 \f
2 16788
2 16788 message coroutinemonitor - 21 ;
2 16789
2 16789
2 16789 <***** cwaitmessage *****
2 16790
2 16790 this procedure asks the coroutine monitor to give it a message, when some-
2 16791 one arrives. in case a message has arrived already it stays at the event queue
2 16792 until 'cwaitmessage' is called.
2 16793 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16794 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16795 with messbufferref = 0. *>
2 16796
2 16796
2 16796 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16797 value timeout, processextension;
2 16798 integer processextension, messbufferref, timeout;
2 16799 integer array mess;
2 16800 begin
3 16801 integer i;
3 16802 integer array field messbuf;
3 16803 proccode(processextension):= 2;
3 16804 procop(processextension):= current;
3 16805 link(current, idlequeue);
3 16806 if timeout > 0 then
3 16807 begin
4 16808 link(current + corutimerchain, timerqueue);
4 16809 d.current.corutimer:= timeout;
4 16810 end else d.current.corutimer:= 0;
3 16811
3 16811
3 16811 passivate;
3 16812 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16813 begin
4 16814 messbuf:= procop(processextension);
4 16815 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16816 proccode(procext):= 1 shift 12;
4 16817 messbufferref:= messbuf;
4 16818 baseevent:= 0;
4 16819 end;
3 16820 d.current.corutimer:= 0;
3 16821 link(current+corutimerchain, idlequeue);
3 16822 end;
2 16823 \f
2 16823
2 16823 message coroutinemonitor - 22 ;
2 16824
2 16824
2 16824 <***** cregretmessage *****
2 16825
2 16825 this procedure regrets the message corresponding to messageexten-
2 16826 sion, to release message buffer and message extension.
2 16827 i/o messages are not regretable. *>
2 16828
2 16828
2 16828
2 16828 procedure cregretmessage (messageextension);
2 16829 value messageextension;
2 16830 integer messageextension;
2 16831 begin
3 16832 integer array field messbuf;
3 16833 messbuf:= messref(messageextension);
3 16834 mon(82) regret message :(0, 0, messbuf, 0);
3 16835 messref(messageextension):= 0;
3 16836
3 16836
3 16836 end;
2 16837 \f
2 16837
2 16837 message coroutinemonitor - 23 ;
2 16838
2 16838
2 16838 <***** semsendmessage *****
2 16839
2 16839 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16840 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16841 by the monitor, when the answer arrives.
2 16842 in case there are too few resources to send the message, the operation is
2 16843 returned immediately with the result field set to zero. *>
2 16844
2 16844
2 16844 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16845 value semaphore, operation, operationtype;
2 16846 real array receiver;
2 16847 integer array mess;
2 16848 integer semaphore, operation;
2 16849 boolean operationtype;
2 16850 begin
3 16851 integer array field op;
3 16852 integer messext;
3 16853 op:= operation;
3 16854 messref(maxmessext):= 0;
3 16855 messext:= 1;
3 16856 while messref(messext) <> 0 do messext:= messext + 1;
3 16857 if messext < maxmessext then
3 16858 begin
4 16859 messop(messext):= op;
4 16860 messcode(messext):=1;
4 16861 d.op(1):= semaphore;
4 16862 d.op.optype:= operationtype;
4 16863 mon(16) send message :(0, mess, 0, receiver);
4 16864 messref(messext):= monw2;
4 16865 end;
3 16866
3 16866
3 16866 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16867 begin <* return the operation immediately with result = 0 *>
4 16868 d.op(9):= 0;
4 16869 signalch(semaphore, op, operationtype);
4 16870 end;
3 16871 end;
2 16872 \f
2 16872
2 16872 message coroutinemonitor - 24 ;
2 16873
2 16873
2 16873 <***** semwaitmessage *****
2 16874
2 16874 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16875 be performed by the coroutine monitor when a message arrives to the process
2 16876 corresponding to 'processextension'. *>
2 16877
2 16877
2 16877 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16878 value processextension, semaphore, operation, operationtype;
2 16879 integer processextension, semaphore, operation;
2 16880 boolean operationtype;
2 16881 begin
3 16882 integer array field op;
3 16883 op:= operation;
3 16884 procop(processextension):= operation;
3 16885 d.op(1):= semaphore;
3 16886 d.op.optype:= operationtype;
3 16887 proccode(processextension):= 1;
3 16888
3 16888
3 16888 end;
2 16889 \f
2 16889
2 16889 message coroutinemonitor - 25 ;
2 16890
2 16890
2 16890 <***** semregretmessage *****
2 16891
2 16891 this procedure regrets a message sent by semsendmessage.
2 16892 the message is identified by the operation in which the answer should be
2 16893 returned.
2 16894 the procedure sets the result field of the operation to zero, and then
2 16895 returns it by performing a signalch. *>
2 16896
2 16896
2 16896 procedure semregretmessage (operation);
2 16897 value operation;
2 16898 integer operation;
2 16899 begin
3 16900 integer i, j;
3 16901 integer array field op, sem;
3 16902 op:= operation;
3 16903 i:= 1;
3 16904 while i < maxmessext do
3 16905 begin
4 16906 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16907 begin
5 16908 mon(82) regret message :(0, 0, messref(i), 0);
5 16909 messref(i):= 0;
5 16910 sem:= d.op(1);
5 16911 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16912 signalch(sem, op, d.op.optype);
5 16913 i:= maxmessext;
5 16914 end;
4 16915 i:= i + 1;
4 16916 end;
3 16917
3 16917
3 16917 end;
2 16918 \f
2 16918
2 16918 message coroutinemonitor - 26 ;
2 16919
2 16919
2 16919 <***** link *****
2 16920
2 16920 this procedure links an object (allocated in the descriptor array 'd') into
2 16921 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16922 are all double chained, and the chainhead is of the same format as the chain
2 16923 fields of the objects.
2 16924 the procedure links the object immediately after the head. *>
2 16925
2 16925
2 16925 procedure link (object, chainhead);
2 16926 value object, chainhead;
2 16927 integer object, chainhead;
2 16928 begin
3 16929 integer array field prevelement, nextelement, chead, obj;
3 16930 obj:= object;
3 16931 chead:= chainhead;
3 16932 prevelement:= d.obj.prev;
3 16933 nextelement:= d.obj.next;
3 16934 d.prevelement.next:= nextelement;
3 16935 d.nextelement.prev:= prevelement;
3 16936 if chead > 0 then <* link into queue *>
3 16937 begin
4 16938 prevelement:= d.chead.prev;
4 16939 d.obj.prev:= prevelement;
4 16940 d.prevelement.next:= obj;
4 16941 d.obj.next:= chead;
4 16942 d.chead.prev:= obj;
4 16943 end else
3 16944 begin <* link onto itself *>
4 16945 d.obj.prev:= obj;
4 16946 d.obj.next:= obj;
4 16947 end;
3 16948 end;
2 16949 \f
2 16949
2 16949 message coroutinemonitor - 27 ;
2 16950
2 16950
2 16950 <***** linkprio *****
2 16951
2 16951 this procedure is used to link coroutines into queues corresponding to
2 16952 the priorities of the actual coroutine and the queue elements.
2 16953 the object is linked immediately before the first coroutine of lower prio-
2 16954 rity. *>
2 16955
2 16955
2 16955 procedure linkprio (object, chainhead);
2 16956 value object, chainhead;
2 16957 integer object, chainhead;
2 16958 begin
3 16959 integer array field currelement, chead, obj;
3 16960 obj:= object;
3 16961 chead:= chainhead;
3 16962 currelement:= d.chead.next;
3 16963 while currelement <> chead
3 16964 and d.currelement.corupriority <= d.obj.corupriority
3 16965 do currelement:= d.currelement.next;
3 16966 link(obj, currelement);
3 16967 end;
2 16968 \f
2 16968
2 16968 message coroutinemonitor - 28 ;
2 16969
2 16969 \f
2 16969
2 16969 message coroutinemonitor - 30a ;
2 16970
2 16970
2 16970 <*************** extention to coroutine monitor procedures **********>
2 16971
2 16971 <***** signalbin *****
2 16972
2 16972 this procedure simulates a binary semaphore on a simple semaphore
2 16973 by testing the value of the semaphore before signaling the
2 16974 semaphore. if the value of the semaphore is one (=open) nothing is
2 16975 done, otherwise a normal signal is carried out. *>
2 16976
2 16976
2 16976 procedure signalbin(semaphore);
2 16977 value semaphore;
2 16978 integer semaphore;
2 16979 begin
3 16980 integer array field sem;
3 16981 integer val;
3 16982 sem:= semaphore;
3 16983 inspect(sem,val);
3 16984 if val<1 then signal(sem);
3 16985 end;
2 16986 \f
2 16986
2 16986 message coroutinemonitor - 30b ;
2 16987
2 16987 <***** coruno *****
2 16988
2 16988 delivers the coroutinenumber for a give coroutine id.
2 16989 if the coroutine does not exists the value 0 is delivered *>
2 16990
2 16990 integer procedure coru_no(coru_id);
2 16991 value coru_id;
2 16992 integer coru_id;
2 16993 begin
3 16994 integer array field cor;
3 16995
3 16995 coru_no:= 0;
3 16996 for cor:= firstcoru step corusize until (coruref-1) do
3 16997 if d.cor.coruident//1000 = coru_id then
3 16998 coru_no:= d.cor.coruident mod 1000;
3 16999 end;
2 17000 \f
2 17000
2 17000 message coroutinemonitor - 30c ;
2 17001
2 17001 <***** coroutine *****
2 17002
2 17002 delivers the referencebyte for the coroutinedescriptor for
2 17003 a coroutine identified by coroutinenumber *>
2 17004
2 17004 integer procedure coroutine(cor_no);
2 17005 value cor_no;
2 17006 integer cor_no;
2 17007 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 17008 firstcoru + (cor_no-1)*corusize;
2 17009 \f
2 17009
2 17009 message coroutinemonitor - 30d ;
2 17010
2 17010 <***** curr_coruno *****
2 17011
2 17011 delivers number of calling coroutine
2 17012 curr_coruno:
2 17013 < 0 = -current_coroutine_number in disabled mode
2 17014 = 0 = procedure not called from coroutine
2 17015 > 0 = current_coroutine_number in enabled mode *>
2 17016
2 17016 integer procedure curr_coruno;
2 17017 begin
3 17018 integer i;
3 17019 integer array ia(1:12);
3 17020
3 17020 i:= system(12,0,ia);
3 17021 if i > 0 then
3 17022 begin
4 17023 i:= system(12,1,ia);
4 17024 curr_coruno:= ia(3);
4 17025 end else curr_coruno:= 0;
3 17026 end curr_coruno;
2 17027 \f
2 17027
2 17027 message coroutinemonitor - 30e ;
2 17028
2 17028 <***** curr_coruid *****
2 17029
2 17029 delivers coruident of calling coroutine :
2 17030
2 17030 curr_coruid:
2 17031 > 0 = coruident of calling coroutine
2 17032 = 0 = procedure not called from coroutine *>
2 17033
2 17033 integer procedure curr_coruid;
2 17034 begin
3 17035 integer cor_no;
3 17036 integer array field cor;
3 17037
3 17037 cor_no:= abs curr_coruno;
3 17038 if cor_no <> 0 then
3 17039 begin
4 17040 cor:= coroutine(cor_no);
4 17041 curr_coruid:= d.cor.coruident // 1000;
4 17042 end
3 17043 else curr_coruid:= 0;
3 17044 end curr_coruid;
2 17045 \f
2 17045 message coroutinemonitor - 30f.1 ;
2 17046
2 17046 <**** getch *****
2 17047
2 17047 this procedure searches the queue of operations waiting at 'semaphore'
2 17048 to find an operation that matches the operationstypeset and a set of
2 17049 select-values. each select value is specified by type and fieldvalue
2 17050 in integer array 'type' and by the value in integer array 'val'.
2 17051
2 17051 0: eq 0: not used
2 17052 1: lt 1: boolean
2 17053 2: le 2: integer
2 17054 3: gt 3: long
2 17055 4: ge 4: real
2 17056 5: ne
2 17057 *>
2 17058
2 17058 procedure getch(semaphore,operation,operationtypeset,type,val);
2 17059 value semaphore,operationtypeset;
2 17060 integer semaphore,operation;
2 17061 boolean operationtypeset;
2 17062 integer array type,val;
2 17063 begin
3 17064 integer array field firstop,currop;
3 17065 integer ø,n,i,f,t,rel,i1,i2;
3 17066 boolean field bf,bfval;
3 17067 integer field intf;
3 17068 long field lf,lfval; long l1,l2;
3 17069 real field rf,rfval; real r1,r2;
3 17070
3 17070 boolean match;
3 17071
3 17071 operation:= 0;
3 17072 n:= system(3,ø,type);
3 17073 match:= false;
3 17074 firstop:= semaphore + semop;
3 17075 currop:= d.firstop.next;
3 17076 while currop <> firstop and -,match do
3 17077 begin
4 17078 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 17079 begin
5 17080 i:= n;
5 17081 match:= true;
5 17082 \f
5 17082 message coroutinemonitor - 30f.2 ;
5 17083
5 17083 while match and (if i <= ø then type(i) >= 0 else false) do
5 17084 begin
6 17085 rel:= type(i) shift(-18);
6 17086 t:= type(i) shift(-12) extract 6;
6 17087 f:= type(i) extract 12;
6 17088 if f > 2047 then f:= f -4096;
6 17089 case t+1 of
6 17090 begin
7 17091 ; <* not used *>
7 17092
7 17092 begin <*boolean or signed short integer*>
8 17093 bf:= f;
8 17094 bfval:= 2*i;
8 17095 i1:= d.currop.bf extract 12;
8 17096 if i1 > 2047 then i1:= i1-4096;
8 17097 i2:= val.bfval extract 12;
8 17098 if i2 > 2047 then i2:= i2-4096;
8 17099 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17100 end;
7 17101
7 17101 begin <*integer*>
8 17102 intf:= f;
8 17103 i1:= d.currop.intf;
8 17104 i2:= val(i);
8 17105 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 17106 end;
7 17107
7 17107 begin <*long*>
8 17108 lf:= f;
8 17109 lfval:= i*2;
8 17110 l1:= d.currop.lf;
8 17111 l2:= val.lfval;
8 17112 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 17113 end;
7 17114
7 17114 begin <*real*>
8 17115 rf:= f;
8 17116 rfval:= i*2;
8 17117 r1:= d.currop.rf;
8 17118 r2:= val.rfval;
8 17119 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 17120 end;
7 17121
7 17121 end;<*case t+1*>
6 17122
6 17122 i:= i+1;
6 17123 end; <*while match and i<=ø and t>=0 *>
5 17124 \f
5 17124 message coroutinemonitor - 30f.3 ;
5 17125
5 17125 end; <* if operationtypeset and ---*>
4 17126 if -,match then currop:= d.currop.next;
4 17127 end; <*while currop <> firstop and -,match*>
3 17128
3 17128 if match then
3 17129 begin
4 17130 link(currop,0);
4 17131 d.current.coruop:= currop;
4 17132 operation:= currop;
4 17133 end;
3 17134 end getch;
2 17135 \f
2 17135
2 17135 message coroutinemonitor - 31 ;
2 17136
2 17136 activity(maxcoru);
2 17137
2 17137 goto initialization;
2 17138
2 17138
2 17138
2 17138 <*************** event handling ***************>
2 17139
2 17139
2 17139
2 17139 takeexternal:
2 17140 currevent:= baseevent;
2 17141 eventqueueempty:= false;
2 17142 repeat
2 17143 current:= 0;
2 17144 prevevent:= currevent;
2 17145 mon(66) test event :(0, 0, currevent, 0);
2 17146 currevent:= monw2;
2 17147 if monw0 < 0 <* no event *> then goto takeinternal;
2 17148 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 17149 cmi:= monw1
2 17150 else
2 17151 cmi:= - monw0;
2 17152
2 17152 if cmi > 0 then
2 17153 begin <* answer to activity zone *>
3 17154 current:= firstcoru + (cmi - 1) * corusize;
3 17155 linkprio(current, readyqueue);
3 17156 baseevent:= 0;
3 17157 end else
2 17158
2 17158 if cmi = 0 then
2 17159 begin <* message arrived *>
3 17160 \f
3 17160
3 17160 message coroutinemonitor - 32 ;
3 17161
3 17161 receiver:= core.currevent(3);
3 17162 if receiver < 0 then receiver:= - receiver;
3 17163 procref(maxprocext):= receiver;
3 17164 procext:= 1;
3 17165 while procref(procext) <> receiver do procext:= procext + 1;
3 17166 if procext = maxprocext then
3 17167 begin <* receiver unknown *>
4 17168 <* leave the message unchanged *>
4 17169 end else
3 17170 if proccode(procext) shift (-12) = 0 then
3 17171 begin <* the receiver is ready for accepting messages *>
4 17172 mon(26) get event :(0, 0, currevent, 0);
4 17173 case proccode(procext) of
4 17174 begin
5 17175 begin <* message received by semwaitmessage *>
6 17176 op:= procop(procext);
6 17177 sem:= d.op(1);
6 17178 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 17179 d.op(9):= currevent;
6 17180 signalch(sem, op, d.op.optype);
6 17181 proccode(procext):= 1 shift 12;
6 17182 end;
5 17183 begin <* message received by cwaitmessage *>
6 17184 current:= procop(procext);
6 17185 procop(procext):= currevent;
6 17186 linkprio(current, readyqueue);
6 17187 link(current + corutimerchain, idlequeue);
6 17188
6 17188
6 17188 end;
5 17189 end; <* case *>
4 17190 currevent:= baseevent;
4 17191 proccode(procext):= 1 shift 12;
4 17192 end;
3 17193 end <* message *> else
2 17194
2 17194 if cmi = -1 then
2 17195 begin <* answer arrived *>
3 17196 \f
3 17196
3 17196 message coroutinemonitor - 33 ;
3 17197
3 17197 if currevent = timermessage then
3 17198 begin
4 17199 mon(26) get event :(0, 0, currevent, 0);
4 17200 coru:= d.timerqueue.next;
4 17201 while coru <> timerqueue do
4 17202 begin
5 17203 current:= coru - corutimerchain;
5 17204 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 17205 coru:= d.coru.next;
5 17206 if d.current.corutimer <= 0 then
5 17207 begin <* timer perion expired *>
6 17208 d.current.corutimer:= -1;
6 17209 linkprio(current, readyqueue);
6 17210 link(current + corutimerchain, idlequeue);
6 17211 end;
5 17212 end;
4 17213 mon(16) send message :(0, clockmess, 0, clock);
4 17214 timermessage:= monw2;
4 17215 currevent:= baseevent;
4 17216 end <* timer answer *> else
3 17217 begin
4 17218 messref(maxmessext):= currevent;
4 17219 messext:= 1;
4 17220 while messref(messext) <> currevent do messext:= messext + 1;
4 17221 if messext = maxmessext then
4 17222 begin <* the answer is unknown *>
5 17223 <* leave the answer unchanged - it may belong to an activity *>
5 17224 end else
4 17225 if messcode(messext) shift (-12) = 0 then
4 17226 begin
5 17227 case messcode(messext) extract 12 of
5 17228 begin
6 17229 \f
6 17229
6 17229 message coroutinemonitor - 34 ;
6 17230 begin <* answer arrived after semsendmessage *>
7 17231 op:= messop(messext);
7 17232 sem:= d.op(1);
7 17233 mon(18) wait answer :(0, d.op, currevent, 0);
7 17234 d.op(9):= monw0;
7 17235 signalch(sem, op, d.op.optype);
7 17236 messref(messext):= 0;
7 17237 baseevent:= 0;
7 17238 end;
6 17239 begin <* answer arrived after csendmessage *>
7 17240 current:= messop(messext);
7 17241 linkprio(current, readyqueue);
7 17242 link(current + corutimerchain, idlequeue);
7 17243
7 17243
7 17243 end;
6 17244 end;
5 17245 end else baseevent:= currevent;
4 17246 end;
3 17247 end;
2 17248 until eventqueueempty;
2 17249 \f
2 17249
2 17249 message coroutinemonitor - 35 ;
2 17250
2 17250
2 17250
2 17250 <*************** coroutine activation ***************>
2 17251
2 17251 takeinternal:
2 17252
2 17252 current:= d.readyqueue.next;
2 17253 if current = readyqueue then
2 17254 begin
3 17255 mon(24) wait event :(0, 0, prevevent, 0);
3 17256 goto takeexternal;
3 17257 end;
2 17258
2 17258 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17259 <**> begin
3 17260 <**> systime(5,0,r);
3 17261 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17262 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17263 <**> d.current.coruident//1000,<: aktiveres:>);
3 17264 <**> end;
2 17265 <*-2*>
2 17266
2 17266 corustate:= activate(d.current.coruident mod 1000);
2 17267 cmi:= corustate extract 24;
2 17268 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 17269 <**> begin
3 17270 <**> systime(5,0,r);
3 17271 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 17272 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 17273 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 17274 <**> end;
2 17275 <*-2*>
2 17276
2 17276 if cmi = 1 then
2 17277 begin <* programmed passivate *>
3 17278 goto takeexternal;
3 17279 end;
2 17280
2 17280 if cmi = 2 then
2 17281 begin <* implicit passivate in activity *>
3 17282
3 17282
3 17282 link(current, idlequeue);
3 17283 goto takeexternal;
3 17284 end;
2 17285 \f
2 17285
2 17285 message coroutinemonitor - 36 ;
2 17286
2 17286 <* coroutine termination (normal or abnormal) *>
2 17287
2 17287 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 17288 coru_term:
2 17289
2 17289 begin
3 17290 if false and alarmcause extract 24 = (-9) <* break *> and
3 17291 alarmcause shift (-24) extract 24 = 0 then
3 17292 begin
4 17293 endaction:= 2;
4 17294 goto program_slut;
4 17295 end;
3 17296 if alarmcause extract 24 = (-9) <* break *> and
3 17297 alarmcause shift (-24) = 8 <* parent *>
3 17298 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 17299 if alarmcause shift (-24) extract 24 <> -2 or
3 17300 alarmcause extract 24 <> -13 then
3 17301 begin
4 17302 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 17303 alarmcause shift (-24),<:,:>,
4 17304 alarmcause extract 24);
4 17305 for i:=1 step 1 until max_coru do
4 17306 j:=activate(-i); <* kill *>
4 17307 <* skriv billede *>
4 17308 end
3 17309 else
3 17310 begin
4 17311 errorbits:= 0; <* ok.yes warning.no *>
4 17312 goto finale;
4 17313 end;
3 17314 end;
2 17315
2 17315 goto dump;
2 17316
2 17316 link(current, idlequeue);
2 17317 goto takeexternal;
2 17318 \f
2 17318
2 17318 message coroutinemonitor - 37 ;
2 17319
2 17319
2 17319
2 17319 initialization:
2 17320
2 17320
2 17320 <*************** initialization ***************>
2 17321
2 17321 <* chain head *>
2 17322
2 17322 prev:= -2; <* -2 prev *>
2 17323 next:= 0; <* +0 next *>
2 17324
2 17324 <* corutine descriptor *>
2 17325
2 17325 <* -2 prev *>
2 17326 <* +0 next *>
2 17327 <* +2 (link field) *>
2 17328 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 17329 <* +6 (link field) *>
2 17330 coruop:= corutimerchain + 4; <* +8 coruop *>
2 17331 corutimer:= coruop + 2; <*+10 corutimer *>
2 17332 coruident:= corutimer + 2; <*+12 coruident *>
2 17333 corupriority:= coruident + 2; <*+14 corupriority *>
2 17334 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 17335 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 17336
2 17336 <* simple semaphore *>
2 17337
2 17337 <* -2 (link field) *>
2 17338 simcoru:= next; <* +0 simcoru *>
2 17339 simvalue:= simcoru + 2; <* +2 simvalue *>
2 17340
2 17340 <* chained semaphore *>
2 17341
2 17341 <* -2 (link field) *>
2 17342 semcoru:= next; <* +0 semcoru *>
2 17343 <* +2 (link field) *>
2 17344 semop:= semcoru + 4; <* +4 semop *>
2 17345 \f
2 17345
2 17345 message coroutinemonitor - 38 ;
2 17346
2 17346 <* operation *>
2 17347
2 17347 opsize:= next - 6; <* -6 opsize *>
2 17348 optype:= opsize + 1; <* -5 optype *>
2 17349 <* -2 prev *>
2 17350 <* +0 next *>
2 17351 <* +2 operation(1) *>
2 17352 <* +4 operation(2) *>
2 17353 <* +6 - *>
2 17354 <* . - *>
2 17355 <* . - *>
2 17356
2 17356 \f
2 17356
2 17356 message coroutinemonitor - 39 ;
2 17357
2 17357 trap(dump);
2 17358 systime(1, 0, starttime);
2 17359 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 17360 clockmess(1):= 0;
2 17361 clockmess(2):= timeinterval;
2 17362 clock(1):= real <:clock:>;
2 17363 clock(2):= real <::>;
2 17364 mon(16) send message :(0, clockmess, 0, clock);
2 17365 timermessage:= monw2;
2 17366 readyqueue:= 4;
2 17367 initchain(readyqueue);
2 17368 idlequeue:= readyqueue + 4;
2 17369 initchain(idlequeue);
2 17370 timerqueue:= idlequeue + 4;
2 17371 initchain(timerqueue);
2 17372 current:= 0;
2 17373 corucount:= 0;
2 17374 proccount:= 0;
2 17375 baseevent:= 0;
2 17376 coruref:= timerqueue + 4;
2 17377 firstcoru:= coruref;
2 17378 simref:= coruref + maxcoru * corusize;
2 17379 firstsim:= simref;
2 17380 semref:= simref + maxsem * simsize;
2 17381 firstsem:= semref;
2 17382 opref:= semref + maxsemch * semsize + 4;
2 17383 firstop:= opref;
2 17384 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 17385 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 17386 reflectcore(core);
2 17387
2 17387 algol list.on;
2 17388
2 17388 \f
2 17388 message sys_initialisering side 1 - 810601/hko;
2 17389
2 17389 trapmode:= 1 shift 15;
2 17390 errorbits:= 1; <* warning.no ok.no *>
2 17391 trap(coru_term);
2 17392
2 17392 open(zbillede,4,<:billede:>,0);
2 17393 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17394 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17395 system(2,0,ia);
2 17396 open(zdummy,4,ia,0); close(zdummy,false);
2 17397 monitor(42,zdummy,0,ia);
2 17398 laf:= 0;
2 17399 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17400 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17401 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17402
2 17402 open(zrl,4,<:radiolog:>,0);
2 17403 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17404 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17405 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17406 begin
3 17407 ia(1):=1; ia(2):= 3;
3 17408 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17409 monitor(40)create_area:(zrl,0,ia);
3 17410 end;
2 17411
2 17411 for i:=1 step 1 until max_antal_fejltekster do
2 17412 fejltekst(i):= real (case i of (
2 17413 <* 1*><:filsystem:>,
2 17414 <* 2*><:operationskode:>,
2 17415 <* 3*><:programfejl:>,
2 17416 <* 4*><:monitor<'_'>resultat=:>,
2 17417 <* 5*><:læs<'_'>fil:>,
2 17418 <* 6*><:skriv<'_'>fil:>,
2 17419 <* 7*><:modif<'_'>fil:>,
2 17420 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17421 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17422 <*10*><:vogntabel:>,
2 17423 <*11*><:fremmed operation:>,
2 17424 <*12*><:operationstype:>,
2 17425 <*13*><:opret<'_'>fil:>,
2 17426 <*14*><:tilknyt<'_'>fil:>,
2 17427 <*15*><:frigiv<'_'>fil:>,
2 17428 <*16*><:slet<'_'>fil:>,
2 17429 <*17*><:ydre enhed, status=:>,
2 17430 <*18*><:tabelfil:>,
2 17431 <*19*><:radio:>,
2 17432 <*20*><:mobilopkald, bus:>,
2 17433 <*21*><:talevejsswitch:>,
2 17434 <*99*><:ftslut:>));
2 17435
2 17435 for i:= 1 step 1 until max_antal_områder do
2 17436 begin
3 17437 område_navn(i):= long (case i of
3 17438 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17439 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17440 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17441 område_id(i,2):=
3 17442 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17443 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17444 end;
2 17445
2 17445 pabx_id(1):= -1;
2 17446 pabx_id(2):= 1;
2 17447
2 17447 for i:= 1 step 1 until max_antal_radiokanaler do
2 17448 begin
3 17449 radio_id(i):=
3 17450 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17451 end;
2 17452
2 17452 for i:=1 step 1 until max_antal_kanaler do
2 17453 begin
3 17454 kanal_navn(i):= long (case i of (
3 17455 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17456 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17457 kanal_id(i):=
3 17458 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17459 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17460 end;
2 17461
2 17461 for i:= 1 step 1 until op_maske_lgd//2 do
2 17462 ingen_operatører(i):= alle_operatører(i):= 0;
2 17463 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17464 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17465
2 17465 begin
3 17466 long array navn(1:2);
3 17467 long array field doc, ref;
3 17468
3 17468 doc:= 2; iaf:= 0;
3 17469 movestring(navn,1,<:terminal0:>);
3 17470 for i:= 1 step 1 until max_antal_operatører do
3 17471 begin
4 17472 ref:=(i-1)*8; k:=9;
4 17473 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17474 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17475 open(zdummy,8,navn,0); close(zdummy,true);
4 17476 k:= monitor(42,zdummy,0,ia);
4 17477 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17478 else tofrom(terminal_navn.ref,navn,8);
4 17479 operatør_auto_include(i):= false;
4 17480 sætbit_ia(alle_operatører,i,1);
4 17481 end;
3 17482
3 17482 movestring(navn,1,<:garage0:>);
3 17483 for i:= 1 step 1 until max_antal_garageterminaler do
3 17484 begin
4 17485 ref:=(i-1)*8; k:=7;
4 17486 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17487 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17488 open(zdummy,8,navn,0); close(zdummy,true);
4 17489 k:= monitor(42,zdummy,0,ia);
4 17490 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17491 else tofrom(garage_terminal_navn.ref,navn,8);
4 17492 garage_auto_include(i):= false;
4 17493 end;
3 17494 end;
2 17495
2 17495 for i:= 1 step 1 until max_antal_taleveje do
2 17496 sætbit_ia(alle_taleveje,i,1);
2 17497 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17498 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17499 operatør_auto_include(ia(i)):= true;
2 17500 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17501 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17502 garage_auto_include(ia(i)):= true;
2 17503
2 17503
2 17503 \f
2 17503 message fil_init side 1 - 801030/jg;
2 17504
2 17504 begin integer i,antz,tz,s;
3 17505 real array field raf;
3 17506
3 17506 filskrevet:=fillæst:=0; <*fil*>
3 17507 dbsegmax:= 2**18-1;
3 17508
3 17508 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17509 for i:=1 step 1 until dbantez do
3 17510 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17511 for i:=dbantez+1 step 1 until tz do
3 17512 open(fil(i),4,dbsnavn,0);
3 17513 for i:=tz+1 step 1 until antz do
3 17514 open(fil(i),4,dbtnavn,0);
3 17515
3 17515 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17516 dbkatz(i,1):=dbkatz(i,2):=0;
3 17517 for i:=dbantez+1 step 1 until tz do
3 17518 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17519 for i:=tz+1 step 1 until antz do
3 17520 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17521 dbkatz(antz,2):=tz+1;
3 17522 dbsidstetz:=antz;
3 17523 dbsidstesz:=tz;
3 17524
3 17524 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17525 begin integer j;
4 17526 for j:=1,3 step 1 until 6 do
4 17527 dbkate(i,j):=0;
4 17528 dbkate(i,2):=i+1;
4 17529 end;
3 17530 dbkate(dbmaxef,2):=0;
3 17531 dbkatefri:=1;
3 17532 dbantef:=0;
3 17533 \f
3 17533 message fil_init side 2 - 801030/jg;
3 17534
3 17534
3 17534 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17535 begin
4 17536 dbkats(i,1):=0;
4 17537 dbkats(i,2):=i+1;
4 17538 end;
3 17539 dbkats(dbmaxsf,2):=0;
3 17540 dbkatsfri:=1;
3 17541 dbantsf:=0;
3 17542
3 17542 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17543 dbkatb(i):=false add (i+1);
3 17544 dbkatb(dbmaxb):=false;
3 17545 dbkatbfri:=1;
3 17546 dbantb:=0;
3 17547 raf:=4;
3 17548 for i:=1 step 1 until dbmaxtf do
3 17549 begin
4 17550 inrec6(fil(antz),4);
4 17551 dbkatt.raf(i):=fil(antz,1);
4 17552 end;
3 17553 inrec6(fil(antz),4);
3 17554 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17555 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17556 setposition(fil(antz),0,0);
3 17557
3 17557 end filsystem;
2 17558 \f
2 17558 message fil_init side 3 - 810209/cl;
2 17559
2 17559 bs_kats_fri:= nextsem;
2 17560 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17561 <*-3*>
2 17562 bs_kate_fri:= nextsem;
2 17563 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17564 <*-3*>
2 17565 cs_opret_fil:= nextsemch;
2 17566 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17567 <*-3*>
2 17568 cs_tilknyt_fil:= nextsemch;
2 17569 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17570 <*-3*>
2 17571 cs_frigiv_fil:= nextsemch;
2 17572 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17573 <*-3*>
2 17574 cs_slet_fil:= nextsemch;
2 17575 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17576 <*-3*>
2 17577 cs_opret_spoolfil:= nextsemch;
2 17578 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17579 <*-3*>
2 17580 cs_opret_eksternfil:= nextsemch;
2 17581 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17582 <*-3*>
2 17583 \f
2 17583 message fil_init side 4 810209/cl;
2 17584
2 17584
2 17584 <* initialisering af filsystemcoroutiner *>
2 17585
2 17585 i:= nextcoru(001,10,true);
2 17586 j:= newactivity(i,0,opretfil);
2 17587 <*+3*> skriv_newactivity(out,i,j);
2 17588 <*-3*>
2 17589
2 17589 i:= nextcoru(002,10,true);
2 17590 j:= newactivity(i,0,tilknytfil);
2 17591 <*+3*> skriv_newactivity(out,i,j);
2 17592 <*-3*>
2 17593
2 17593 i:= nextcoru(003,10,true);
2 17594 j:= newactivity(i,0,frigivfil);
2 17595 <*+3*> skriv_newactivity(out,i,j);
2 17596 <*-3*>
2 17597
2 17597 i:= nextcoru(004,10,true);
2 17598 j:= newactivity(i,0,sletfil);
2 17599 <*+3*> skriv_newactivity(out,i,j);
2 17600 <*-3*>
2 17601
2 17601 i:= nextcoru(005,10,true);
2 17602 j:= newactivity(i,0,opretspoolfil);
2 17603 <*+3*> skriv_newactivity(out,i,j);
2 17604 <*-3*>
2 17605
2 17605 i:= nextcoru(006,10,true);
2 17606 j:= newactivity(i,0,opreteksternfil);
2 17607 <*+3*> skriv_newactivity(out,i,j);
2 17608 <*-3*>
2 17609 \f
2 17609 message attention_initialisering side 1 - 850820/cl;
2 17610
2 17610 tf_kommandotabel:= 1 shift 10 + 1;
2 17611
2 17611 begin
3 17612 integer i, s, zno;
3 17613 zone z(128,1,stderror);
3 17614 integer array fdim(1:8);
3 17615
3 17615 fdim(4):= tf_kommandotabel;
3 17616 hentfildim(fdim);
3 17617
3 17617 open(z,4,<:htkommando:>,0);
3 17618 for i:= 1 step 1 until fdim(3) do
3 17619 begin
4 17620 inrec6(z,512);
4 17621 s:= skrivfil(tf_kommandotabel,i,zno);
4 17622 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17623 tofrom(fil(zno),z,512);
4 17624 end;
3 17625 close(z,true);
3 17626 end;
2 17627 \f
2 17627 message attention_initialisering side 1a - 810428/hko;
2 17628
2 17628 for j:= system(3,i,terminal_tab) step 1 until i do
2 17629 terminal_tab(j):= 0;
2 17630
2 17630 cs_att_pulje:=next_semch;
2 17631 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17632 <*-3*>
2 17633
2 17633 bs_fortsæt_adgang:= nextsem;
2 17634 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17635 <*-3*>
2 17636 signalbin(bs_fortsæt_adgang);
2 17637
2 17637 for i:= 1,
2 17638 1 step 1 until max_antal_operatører,
2 17639 1 step 1 until max_antal_garageterminaler do
2 17640
2 17640 <* initialisering af pulje med attention_operationer *>
2 17641
2 17641 signalch(cs_att_pulje, <* pulje_semafor *>
2 17642 nextop(data+att_op_længde), <* næste_operation *>
2 17643 gen_optype);
2 17644
2 17644 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17645
2 17645 i:=next_coru(010,<*ident*>
2 17646 2,<*prioritet*>
2 17647 true<*test_maske*>);
2 17648 j:=newactivity( i, <*activityno *>
2 17649 0, <*ikke virtual *>
2 17650 attention);<*ingen parametre*>
2 17651
2 17651 <*+3*>skriv_newactivity(out,i,j);
2 17652 <*-3*>
2 17653
2 17653 \f
2 17653 message io_initialisering side 1 - 810507/hko;
2 17654
2 17654 io_spoolfil:= 1028;
2 17655 begin
3 17656 integer array fdim(1:8);
3 17657 fdim(4):= io_spoolfil;
3 17658 hent_fildim(fdim);
3 17659 io_spool_postantal:= fdim(1);
3 17660 io_spool_postlængde:= fdim(2);
3 17661 end;
2 17662
2 17662 io_spool_post:= 4;
2 17663
2 17663 cs_io:= next_semch;
2 17664 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17665 <*-3*>
2 17666
2 17666 i:= next_coru(100,<*ident *>
2 17667 5,<*prioritet *>
2 17668 true<*test_maske*>);
2 17669
2 17669 j:= new_activity( i,
2 17670 0,
2 17671 h_io);
2 17672
2 17672 <*+3*>skriv_newactivity(out,i,j);
2 17673 <*-3*>
2 17674 cs_io_komm:= next_semch;
2 17675 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17676 <*-3*>
2 17677
2 17677 i:= next_coru(101,<*ident*>
2 17678 10,<*prioritet*>
2 17679 true <*testmaske*>);
2 17680 j:= new_activity( i,
2 17681 0,
2 17682 io_komm);<*ingen parametre*>
2 17683
2 17683 <*+3*>skriv_newactivity(out,i,j);
2 17684 <*-3*>
2 17685 \f
2 17685 message io_initialisering side 2 - 810520/hko/cl;
2 17686
2 17686 bs_zio_adgang:= next_sem;
2 17687 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17688 <*-3*>
2 17689 signal_bin(bs_zio_adgang);
2 17690
2 17690 cs_io_spool:= next_semch;
2 17691 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17692 <*-3*>
2 17693
2 17693 cs_io_fil:=next_semch;
2 17694 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17695 <*-3*>
2 17696 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17697
2 17697 ss_io_spool_fulde:= next_sem;
2 17698 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17699 <*-3*>
2 17700
2 17700 ss_io_spool_tomme:= next_sem;
2 17701 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17702 <*-3*>
2 17703 for i:= 1 step 1 until io_spool_postantal do
2 17704 signal(ss_io_spool_tomme);
2 17705 \f
2 17705 message io_initialisering side 3 - 880901/cl;
2 17706
2 17706 i:= next_coru(102,
2 17707 5,
2 17708 true);
2 17709 j:= new_activity(i,0,io_spool);
2 17710
2 17710 <*+3*>skriv_newactivity(out,i,j);
2 17711 <*-3*>
2 17712
2 17712 i:= next_coru(103,
2 17713 10,
2 17714 true);
2 17715 j:= new_activity(i,0,io_spon);
2 17716
2 17716 <*+3*>skriv_newactivity(out,i,j);
2 17717 <*-3*>
2 17718
2 17718 cs_io_medd:= next_semch;
2 17719 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17720 <*-3*>
2 17721
2 17721 i:= next_coru(104,<*ident *>
2 17722 10,<*prioritet *>
2 17723 true<*test_maske*>);
2 17724
2 17724 j:= new_activity( i,
2 17725 0,
2 17726 io_medd);
2 17727
2 17727 <*+3*>skriv_newactivity(out,i,j);
2 17728 <*-3*>
2 17729
2 17729 cs_io_nulstil:= next_semch;
2 17730 <*+3*> skriv_new_sem(out,3,cs_io_nulstil,<:cs-io-nulstil:>);
2 17731 <*-3*>
2 17732
2 17732 i:= next_coru(105,<*ident *>
2 17733 10,<*prioritet *>
2 17734 true<*test_maske*>);
2 17735
2 17735 j:= new_activity( i,
2 17736 0,
2 17737 io_nulstil_tællere);
2 17738
2 17738 <*+3*>skriv_newactivity(out,i,j);
2 17739 <*-3*>
2 17740
2 17740 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17741 i:= monitor(8)reserve process:(z_io,0,ia);
2 17742 if i <> 0 then
2 17743 begin
3 17744 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17745 end
2 17746 else
2 17747 begin
3 17748 ref:= 0;
3 17749 terminal_tab.ref.terminal_tilstand:= 0;
3 17750 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17751 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17752 "sp",1,"*",15,"nl",1);
3 17753 setposition(z_io,0,0);
3 17754 end;
2 17755 \f
2 17755 message operatør_initialisering side 1 - 810520/hko;
2 17756
2 17756 top_bpl_gruppe:= 64;
2 17757
2 17757 bpl_navn(0):= long<::>;
2 17758 for i:= 1 step 1 until 127 do
2 17759 begin
3 17760 k:= læsfil(tf_bpl_navne,i,j);
3 17761 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17762 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17763 if i<=max_antal_operatører then
3 17764 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17765 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17766 top_bpl_gruppe:= i;
3 17767 end;
2 17768
2 17768 for i:= 0 step 1 until 64 do
2 17769 begin
3 17770 iaf:= i*op_maske_lgd;
3 17771 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17772 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17773 if 1<=i and i<= max_antal_operatører then
3 17774 begin
4 17775 bpl_tilst(i,2):= 1;
4 17776 sætbit_ia(bpl_def.iaf,i,1);
4 17777 end;
3 17778 end;
2 17779 for i:= 65 step 1 until 127 do
2 17780 begin
3 17781 k:= læsfil(tf_bpl_def,i-64,j);
3 17782 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17783 iaf:= i*op_maske_lgd;
3 17784 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17785 bpl_tilst(i,1):= 0;
3 17786 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17787 end;
2 17788
2 17788 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17789 iaf:= 0;
2 17790 for i:= 1 step 1 until max_antal_operatører do
2 17791 begin
3 17792 k:= læsfil(tf_stoptabel,i,j);
3 17793 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17794 operatør_stop(i,0):= i;
3 17795 for k:= 1,2,3 do
3 17796 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17797 ant_i_opkø(i):= 0;
3 17798 end;
2 17799
2 17799 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17800 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17801 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17802 sidste_tv_brugt:= max_antal_taleveje;
2 17803
2 17803 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17804 opk_alarm(i):= 0;
2 17805 for i:= 1 step 1 until max_antal_operatører do
2 17806 begin
3 17807 integer array field tab;
3 17808
3 17808 k:= læsfil(tf_alarmlgd,i,j);
3 17809 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17810 tab:= (i-1)*opk_alarm_tab_lgd;
3 17811 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17812 opk_alarm.tab.alarm_start:= 0.0;
3 17813 end;
2 17814
2 17814 op_spool_kilde:= 2;
2 17815 op_spool_tid := 6;
2 17816 op_spool_text := 6;
2 17817 begin
3 17818 long array field laf1, laf2;
3 17819 laf2:= 4; laf1:= 0;
3 17820 op_spool_buf.laf1(1):= long<::>;
3 17821 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17822 op_spool_postantal*op_spool_postlgd-4);
3 17823 end;
2 17824
2 17824 k:=læsfil(1033,1,j);
2 17825 systime(1,0.0,r);
2 17826 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17827 for i:= 1 step 1 until max_cqf do
2 17828 begin
3 17829 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17830 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17831 cqf_tabel.ref.cqf_næste_tid:=
3 17832 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17833 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17834 end;
2 17835 op_cqf_tab_ændret:= true;
2 17836
2 17836 laf:= raf:= 0;
2 17837 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17838 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17839 j:= 1;
2 17840 if i<>0 then
2 17841 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17842 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17843 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17844 j:= 1;
2 17845 if i<>0 then
2 17846 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17847
2 17847 ia(1):= 3; <*canonical*>
2 17848 ia(2):= 0; <*no echo*>
2 17849 ia(3):= 0; <*prompt*>
2 17850 ia(4):= 2; <*timeout*>
2 17851 setcspterm(taleswitch_in_navn.laf,ia);
2 17852 setcspterm(taleswitch_out_navn.laf,ia);
2 17853
2 17853 cs_op:= next_semch;
2 17854
2 17854 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17855 <*-3*>
2 17856
2 17856 cs_op_retur:= next_semch;
2 17857
2 17857 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17858 <*-3*>
2 17859
2 17859 i:= nextcoru(200,<*ident*>
2 17860 10,<*prioitet*>
2 17861 true<*test_maske*>);
2 17862
2 17862 j:= new_activity( i,
2 17863 0,
2 17864 h_operatør);
2 17865
2 17865 <*+3*>skriv_newactivity(out,i,j);
2 17866 <*-3*>
2 17867 \f
2 17867 message operatør_initialisering side 2 - 810520/hko;
2 17868
2 17868 for k:= 1 step 1 until max_antal_operatører do
2 17869 begin
3 17870 ref:= (k-1)*8;
3 17871 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17872 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17873 ref:=k*terminal_beskr_længde;
3 17874 if i = 0 then
3 17875 begin
4 17876 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17877 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17878 end
3 17879 else
3 17880 begin
4 17881 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17882 end;
3 17883
3 17883 cs_operatør(k):= next_semch;
3 17884 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17885 <*-3*>
3 17886
3 17886 cs_op_fil(k):= nextsemch;
3 17887 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17888 <*-3*>
3 17889 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17890
3 17890 i:= next_coru(200+k,<*ident*>
3 17891 10,<*prioitet*>
3 17892 true<*testmaske*>);
3 17893 j:= new_activity( i,
3 17894 0,
3 17895 operatør,k);
3 17896
3 17896 <*+3*>skriv_newactivity(out,i,j);
3 17897 <*-3*>
3 17898 end;
2 17899
2 17899 cs_cqf:= next_semch;
2 17900 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17901 <*-3*>
2 17902
2 17902 signalch(cs_cqf,nextop(60),true);
2 17903
2 17903 i:= next_coru(292, <*ident*>
2 17904 10, <*prioritet*>
2 17905 true <*testmaske*>);
2 17906 j:= new_activity( i,
2 17907 0,
2 17908 op_cqftest);
2 17909 <*+3*>skriv_new_activity(out,i,j);
2 17910 <*-3*>
2 17911
2 17911 cs_op_spool:= next_semch;
2 17912 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17913 <*-3*>
2 17914
2 17914 cs_op_medd:= next_semch;
2 17915 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17916 <*-3*>
2 17917
2 17917 ss_op_spool_tomme:= next_sem;
2 17918 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17919 <*-3*>
2 17920 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17921
2 17921 ss_op_spool_fulde:= next_sem;
2 17922 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17923 <*-3*>
2 17924
2 17924 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17925
2 17925 i:= next_coru(293, <*ident*>
2 17926 10, <*prioritet*>
2 17927 true <*testmaske*>);
2 17928 j:= new_activity( i,
2 17929 0,
2 17930 op_spool);
2 17931 <*+3*>skriv_new_activity(out,i,j);
2 17932 <*-3*>
2 17933
2 17933 i:= next_coru(294, <*ident*>
2 17934 10, <*prioritet*>
2 17935 true <*testmaske*>);
2 17936 j:= new_activity( i,
2 17937 0,
2 17938 op_medd);
2 17939 <*+3*>skriv_new_activity(out,i,j);
2 17940 <*-3*>
2 17941
2 17941 cs_op_iomedd:= next_semch;
2 17942 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17943 <*-3*>
2 17944
2 17944 bs_opk_alarm:= next_sem;
2 17945 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17946 <*-3*>
2 17947
2 17947 cs_opk_alarm:= next_semch;
2 17948 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17949 <*-3*>
2 17950
2 17950 cs_opk_alarm_ur:= next_semch;
2 17951 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17952 <*-3*>
2 17953
2 17953 cs_opk_alarm_ur_ret:= next_semch;
2 17954 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17955 <*-3*>
2 17956
2 17956 cs_tvswitch_adgang:= next_semch;
2 17957 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17958 <*-3*>
2 17959
2 17959 cs_tv_switch_input:= next_semch;
2 17960 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17961 <*-3*>
2 17962
2 17962 cs_tv_switch_adm:= next_semch;
2 17963 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17964 <*-3*>
2 17965
2 17965 cs_talevejsswitch:= next_semch;
2 17966 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17967 <*-3*>
2 17968
2 17968 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17969
2 17969 iaf:= nextop(data+128);
2 17970 if testbit22 then
2 17971 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17972 else
2 17973 begin
3 17974 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17975 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17976 end;
2 17977
2 17977 i:= next_coru(295, <*ident*>
2 17978 8, <*prioritet*>
2 17979 true <*testmaske*>);
2 17980 j:= new_activity( i,
2 17981 0,
2 17982 alarmur);
2 17983 <*+3*>skriv_new_activity(out,i,j);
2 17984 <*-3*>
2 17985
2 17985 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17986
2 17986 i:= next_coru(296, <*ident*>
2 17987 8, <*prioritet*>
2 17988 true <*testmaske*>);
2 17989 j:= new_activity( i,
2 17990 0,
2 17991 opkaldsalarmer);
2 17992 <*+3*>skriv_new_activity(out,i,j);
2 17993 <*-3*>
2 17994
2 17994 i:= next_coru(297, <*ident*>
2 17995 3, <*prioritet*>
2 17996 true <*testmaske*>);
2 17997 j:= new_activity( i,
2 17998 0,
2 17999 tv_switch_input);
2 18000 <*+3*>skriv_new_activity(out,i,j);
2 18001 <*-3*>
2 18002
2 18002 for i:= 1,2 do
2 18003 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 18004
2 18004 i:= next_coru(298, <*ident*>
2 18005 20, <*prioritet*>
2 18006 true <*testmaske*>);
2 18007 j:= new_activity( i,
2 18008 0,
2 18009 tv_switch_adm);
2 18010 <*+3*>skriv_new_activity(out,i,j);
2 18011 <*-3*>
2 18012
2 18012 i:= next_coru(299, <*ident*>
2 18013 3, <*prioritet*>
2 18014 true <*testmaske*>);
2 18015 j:= new_activity( i,
2 18016 0,
2 18017 talevejsswitch);
2 18018 <*+3*>skriv_new_activity(out,i,j);
2 18019 <*-3*>
2 18020 \f
2 18020 message garage_initialisering side 1 - 810521/hko;
2 18021
2 18021 cs_gar:= next_semch;
2 18022 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 18023 <*-3*>
2 18024
2 18024 i:= next_coru(300,<*ident*>
2 18025 10,<*prioritet*>
2 18026 true<*test_maske*>);
2 18027
2 18027 j:= new_activity( i,
2 18028 0,
2 18029 h_garage);
2 18030
2 18030 <*+3*>skriv_newactivity(out,i,j);
2 18031 <*-3*>
2 18032
2 18032 for k:= 1 step 1 until max_antal_garageterminaler do
2 18033 begin
3 18034 ref:= (k-1)*8;
3 18035 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 18036 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 18037 i:=monitor(4)process address:(z_gar(k),0,ia);
3 18038 if i = 0 then
3 18039 begin
4 18040 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 18041 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 18042 end
3 18043 else
3 18044 begin
4 18045 terminal_tab.ref.terminal_tilstand:=
4 18046 if garage_auto_include(k) then 0 else 7 shift 21;
4 18047 if garage_auto_include(k) then
4 18048 monitor(8)reserve:(z_gar(k),0,ia);
4 18049 end;
3 18050 cs_garage(k):= next_semch;
3 18051 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 18052 <*-3*>
3 18053 i:= next_coru(300+k,<*ident*>
3 18054 10,<*prioritet*>
3 18055 true <*testmaske*>);
3 18056 j:= new_activity( i,
3 18057 0,
3 18058 garage,k);
3 18059
3 18059 <*+3*>skriv_newactivity(out,i,j);
3 18060 <*-3*>
3 18061
3 18061 end;
2 18062 \f
2 18062 message radio_initialisering side 1 - 820301/hko;
2 18063
2 18063 cs_rad:= next_semch;
2 18064 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 18065 <*-3*>
2 18066
2 18066 i:= next_coru(400,<*ident*>
2 18067 10,<*prioritet*>
2 18068 true<*test_maske*>);
2 18069 j:= new_activity( i,
2 18070 0,
2 18071 h_radio);
2 18072 <*+3*>skriv_newactivity(out,i,j);
2 18073 <*-3*>
2 18074
2 18074 opkalds_kø_ledige:= max_antal_mobilopkald;
2 18075 nødopkald_brugt:= 0;
2 18076 læsfil(1034,1,i);
2 18077 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 18078
2 18078 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 18079 for i:= system(3,j,opkaldskø) step 1 until j do
2 18080 opkaldskø(i):= 0;
2 18081 første_frie_opkald:=opkaldskø_postlængde;
2 18082 første_opkald:=sidste_opkald:=
2 18083 første_nødopkald:=sidste_nødopkald:=j:=0;
2 18084
2 18084 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 18085 begin
3 18086 ref:=i*opkaldskø_postlængde;
3 18087 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 18088 end;
2 18089 ref:=ref+opkaldskø_postlængde;
2 18090 opkaldskø.ref(1):=j shift 12;
2 18091
2 18091 for ref:= 0 step 512 until (max_linienr//768*512) do
2 18092 begin
3 18093 i:= læs_fil(1035,ref//512+1,j);
3 18094 if i <> 0 then
3 18095 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 18096 tofrom(radio_linietabel.ref,fil(j),
3 18097 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 18098 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 18099 end;
2 18100
2 18100 for i:= system(3,j,kanal_tab) step 1 until j do
2 18101 kanal_tab(i):= 0;
2 18102 kanal_tilstand:= 2;
2 18103 kanal_id1:= 4;
2 18104 kanal_id2:= 6;
2 18105 kanal_spec:= 8;
2 18106 kanal_alt_id1:= 10;
2 18107 kanal_alt_id2:= 12;
2 18108 kanal_mon_maske:= 12;
2 18109 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 18110
2 18110 for i:= 1 step 1 until max_antal_kanaler do
2 18111 begin
3 18112 ref:= (i-1)*kanalbeskrlængde;
3 18113 sæthexciffer(kanal_tab.ref,3,15);
3 18114 if kanal_id(i) shift (-5) extract 3 = 2 or
3 18115 kanal_id(i) shift (-5) extract 3 = 3 and
3 18116 radio_id(kanal_id(i) extract 5)<=3
3 18117 then
3 18118 begin
4 18119 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 18120 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 18121 end;
3 18122 end;
2 18123 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 18124 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 18125 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 18126 optaget_flag:= 0;
2 18127 \f
2 18127 message radio_initialisering side 2 - 810524/hko;
2 18128
2 18128 bs_mobil_opkald:= next_sem;
2 18129
2 18129 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 18130 <*-3*>
2 18131
2 18131 bs_opkaldskø_adgang:= next_sem;
2 18132 signal_bin(bs_opkaldskø_adgang);
2 18133
2 18133 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 18134 <*-3*>
2 18135
2 18135 cs_radio_medd:=next_semch;
2 18136 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 18137
2 18137 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 18138 <*-3*>
2 18139
2 18139 i:= next_coru(403,
2 18140 5,<*prioritet*>
2 18141 true<*testmaske*>);
2 18142
2 18142 j:= new_activity( i,
2 18143 0,
2 18144 radio_medd_opkald);
2 18145
2 18145 <*+3*>skriv_newactivity(out,i,j);
2 18146 <*-3*>
2 18147
2 18147 cs_radio_adm:= nextsemch;
2 18148 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 18149 <*-3*>
2 18150
2 18150 i:= next_coru(404,
2 18151 10,
2 18152 true);
2 18153 j:= new_activity(i,
2 18154 0,
2 18155 radio_adm,next_op(data+radio_op_længde));
2 18156 <*+3*>skriv_new_activity(out,i,j);
2 18157 <*-3*>
2 18158 \f
2 18158 message radio_initialisering side 3 - 810526/hko;
2 18159 for k:= 1 step 1 until max_antal_taleveje do
2 18160 begin
3 18161
3 18161 cs_radio(k):=next_semch;
3 18162
3 18162 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 18163 <*-3*>
3 18164
3 18164 bs_talevej_udkoblet(k):= nextsem;
3 18165 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 18166 <*-3*>
3 18167
3 18167 i:=next_coru(410+k,
3 18168 10,
3 18169 true);
3 18170
3 18170 j:=new_activity( i,
3 18171 0,
3 18172 radio,k,next_op(data + radio_op_længde));
3 18173
3 18173 <*+3*>skriv_newactivity(out,i,j);
3 18174 <*-3*>
3 18175 end;
2 18176
2 18176 cs_radio_pulje:=next_semch;
2 18177
2 18177 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 18178 <*-3*>
2 18179
2 18179 for i:= 1 step 1 until radiopulje_størrelse do
2 18180 signal_ch(cs_radio_pulje,
2 18181 next_op(60),
2 18182 gen_optype or rad_optype);
2 18183
2 18183 cs_radio_kø:= next_semch;
2 18184
2 18184 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 18185 <*-3*>
2 18186
2 18186 mobil_opkald_aktiveret:= true;
2 18187 \f
2 18187 message radio_initialisering side 4 - 810522/hko;
2 18188
2 18188 laf:=raf:=0;
2 18189
2 18189 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 18190 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 18191 j:=1;
2 18192 if i <> 0 then
2 18193 fejlreaktion(4<*monitor resultat*>,i,
2 18194 string radio_fr_navn.raf(increase(j)),1);
2 18195 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 18196 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 18197 j:=1;
2 18198 if i <> 0 then
2 18199 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 18200 ia(1):= 3 <*canonical*>;
2 18201 ia(2):= 0 <*no echo*>;
2 18202 ia(3):= 0 <*prompt*>;
2 18203 ia(4):= 5 <*timeout*>;
2 18204 setcspterm(radio_fr_navn.laf,ia);
2 18205
2 18205 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 18206 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 18207 j:= 1;
2 18208 if i <> 0 then
2 18209 fejlreaktion(4<*monitor resultat*>,i,
2 18210 string radio_rf_navn.raf(increase(j)),1);
2 18211 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 18212 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 18213 j:= 1;
2 18214 if i <> 0 then
2 18215 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 18216 ia(1):= 3 <*canonical*>;
2 18217 ia(2):= 0 <*no echo*>;
2 18218 ia(3):= 0 <*prompt*>;
2 18219 ia(4):= 5 <*timeout*>;
2 18220 setcspterm(radio_rf_navn.laf,ia);
2 18221 \f
2 18221 message radio_initialisering side 5 - 810521/hko;
2 18222 for k:= 1 step 1 until max_antal_kanaler do
2 18223 begin
3 18224
3 18224 ss_radio_aktiver(k):=next_sem;
3 18225 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 18226 <*-3*>
3 18227
3 18227 ss_samtale_nedlagt(k):=next_sem;
3 18228 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 18229 <*-3*>
3 18230 end;
2 18231
2 18231 cs_radio_ind:= next_semch;
2 18232 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 18233 <*-3*>
2 18234
2 18234 i:= next_coru(401,<*ident radio_ind*>
2 18235 3, <*prioritet*>
2 18236 true <*testmaske*>);
2 18237 j:= new_activity( i,
2 18238 0,
2 18239 radio_ind,next_op(data + 64));
2 18240
2 18240 <*+3*>skriv_newactivity(out,i,j);
2 18241 <*-3*>
2 18242
2 18242 cs_radio_ud:=next_semch;
2 18243 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 18244 <*-3*>
2 18245
2 18245 i:= next_coru(402,<*ident radio_out*>
2 18246 10,<*prioritet*>
2 18247 true <*testmaske*>);
2 18248 j:= new_activity( i,
2 18249 0,
2 18250 radio_ud,next_op(data + 64));
2 18251
2 18251 <*+3*>skriv_newactivity(out,i,j);
2 18252 <*-3*>
2 18253 \f
2 18253 message vogntabel initialisering side 1 - 820301;
2 18254
2 18254 sidste_bus:= sidste_linie_løb:= 0;
2 18255
2 18255 tf_vogntabel:= 1 shift 10 + 2;
2 18256 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 18257 tf_gruppeidenter:= 1 shift 10 +6;
2 18258 tf_springdef:= 1 shift 10 +7;
2 18259 hent_fil_dim(ia);
2 18260 max_antal_i_gruppe:= ia(2);
2 18261 if ia(1) < max_antal_grupper then
2 18262 max_antal_grupper:= ia(1);
2 18263
2 18263 <* initialisering af interne vogntabeller *>
2 18264 begin
3 18265 long array field laf1,laf2;
3 18266 integer array fdim(1:8);
3 18267 zone z(128,1,stderror);
3 18268 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 18269 long omr,garageid;
3 18270 integer field ll, bn;
3 18271 boolean binær, test24;
3 18272
3 18272 ll:= 2; bn:= 4;
3 18273
3 18273 <* nulstil tabellerne *>
3 18274 laf1:= -2;
3 18275 laf2:= 2;
3 18276 bustabel1.laf2(0):=
3 18277 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 18278 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 18279 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 18280 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 18281 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 18282 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 18283 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 18284 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 18285 \f
3 18285 message vogntabel initialisering side 1a - 810505/cl;
3 18286
3 18286
3 18286 <* initialisering af intern busnummertabel *>
3 18287 open(z,4,<:busnumre:>,0);
3 18288 busnr:= -1;
3 18289 read(z,busnr);
3 18290 while busnr > 0 do
3 18291 begin
4 18292 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 18293 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 18294 sidste_bus:= sidste_bus+1;
4 18295 if sidste_bus > max_antal_busser then
4 18296 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 18297 repeatchar(z); readchar(z,tegn);
4 18298 garageid:= extend 0; binær:= false; omr:= extend 0;
4 18299 g_nr:= o_nr:= 0;
4 18300 if tegn='!' then
4 18301 begin
5 18302 binær:= true;
5 18303 readchar(z,tegn);
5 18304 end;
4 18305 if tegn='/' then <*garageid*>
4 18306 begin
5 18307 readchar(z,tegn); repeatchar(z);
5 18308 if '0'<=tegn and tegn<='9' then
5 18309 begin
6 18310 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 18311 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 18312 if g_nr<>0 and garageid=long<::> then
6 18313 begin
7 18314 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 18315 g_nr:= 0;
7 18316 end;
6 18317 end
5 18318 else
5 18319 begin
6 18320 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 18321 begin
7 18322 garageid:= garageid shift 8 + tegn;
7 18323 readchar(z,tegn);
7 18324 end;
6 18325 while garageid shift (-40) extract 8 = 0 do
6 18326 garageid:= garageid shift 8;
6 18327 g_nr:= find_bpl(garageid);
6 18328 if g_nr=0 then
6 18329 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 18330 end;
5 18331 repeatchar(z); readchar(z,tegn);
5 18332 end;
4 18333 if tegn=';' then
4 18334 begin
5 18335 readchar(z,tegn); repeatchar(z);
5 18336 if '0'<=tegn and tegn<='9' then
5 18337 begin
6 18338 read(z,o_nr);
6 18339 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 18340 if o_nr<>0 then omr:= område_navn(o_nr);
6 18341 if o_nr<>0 and omr=long<::> then
6 18342 begin
7 18343 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 18344 o_nr:= 0;
7 18345 end;
6 18346 end
5 18347 else
5 18348 begin
6 18349 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 18350 begin
7 18351 omr:= omr shift 8 + tegn;
7 18352 readchar(z,tegn);
7 18353 end;
6 18354 while omr shift (-40) extract 8 = 0 do
6 18355 omr:= omr shift 8;
6 18356 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 18357 i:= 1;
6 18358 while i<=max_antal_områder and o_nr=0 do
6 18359 begin
7 18360 if omr=område_navn(i) then o_nr:= i;
7 18361 i:= i+1;
7 18362 end;
6 18363 if o_nr=0 then
6 18364 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 18365 end;
5 18366 repeatchar(z); readchar(z,tegn);
5 18367 end;
4 18368 if o_nr=0 then o_nr:= 3;
4 18369 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 18370 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 18371
4 18371 busnr:= -1;
4 18372 read(z,busnr);
4 18373 end;
3 18374 close(z,true);
3 18375 \f
3 18375 message vogntabel initialisering side 2 - 820301/cl;
3 18376
3 18376 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 18377 test24:= testbit24;
3 18378 testbit24:= false;
3 18379 i:= 1;
3 18380 s:= læsfil(tf_vogntabel,i,zi);
3 18381 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 18382 while fil(zi).bn<>0 do
3 18383 begin
4 18384 if fil(zi).ll <> 0 then
4 18385 begin <* indsæt linie/løb *>
5 18386 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 18387 fil(zi).ll,j);
5 18388 if res < 0 then j:= j+1;
5 18389 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 18390 <:dobbeltregistrering i vogntabel:>,1)
5 18391 else
5 18392 begin
6 18393 o_nr:= fil(zi).bn shift (-14) extract 8;
6 18394 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 18395 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 18396 <:ukendt bus i vogntabel:>,1)
6 18397 else
6 18398 begin
7 18399 if sidste_linie_løb >= max_antal_linie_løb then
7 18400 fejlreaktion(10,fil(zi).bn extract 14,
7 18401 <:for mange linie/løb i vogntabel:>,0);
7 18402 for ll_nr:= sidste_linie_løb step (-1) until j do
7 18403 begin
8 18404 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18405 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18406 end;
7 18407 linie_løb_tabel(j):= fil(zi).ll;
7 18408 bus_indeks(j):= false add b_nr;
7 18409 sidste_linie_løb:= sidste_linie_løb + 1;
7 18410 end;
6 18411 end;
5 18412 end;
4 18413 i:= i+1;
4 18414 s:= læsfil(tf_vogntabel,i,zi);
4 18415 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18416 end;
3 18417 \f
3 18417 message vogntabel initialisering side 3 - 810428/cl;
3 18418
3 18418 <* initialisering af intern linie/løb-indekstabel *>
3 18419 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18420 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18421
3 18421 <* gem ny vogntabel i tabelfil *>
3 18422 for i:= 1 step 1 until sidste_bus do
3 18423 begin
4 18424 s:= skriv_fil(tf_vogntabel,i,zi);
4 18425 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18426 fil(zi).bn:= bustabel(i) extract 14 add
4 18427 (bustabel1(i) extract 8 shift 14);
4 18428 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18429 end;
3 18430 fdim(4):= tf_vogntabel;
3 18431 hent_fil_dim(fdim);
3 18432 pant:= fdim(3) * (256//fdim(2));
3 18433 for i:= sidste_bus+1 step 1 until pant do
3 18434 begin
4 18435 s:= skriv_fil(tf_vogntabel,i,zi);
4 18436 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18437 fil(zi).ll:= fil(zi).bn:= 0;
4 18438 end;
3 18439
3 18439 <* initialisering/nulstilling af gruppetabeller *>
3 18440 for i:= 1 step 1 until max_antal_grupper do
3 18441 begin
4 18442 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18443 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18444 gruppetabel(i):= fil(zi).ll;
4 18445 end;
3 18446 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18447 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18448 testbit24:= test24;
3 18449 end;
2 18450
2 18450
2 18450 <*+2*>
2 18451 <**> if testbit40 then p_vogntabel(out);
2 18452 <**> if testbit43 then p_gruppetabel(out);
2 18453 <*-2*>
2 18454
2 18454 message vogntabel initialisering side 3a -920517/cl;
2 18455
2 18455 <* initialisering for vt_log *>
2 18456
2 18456 v_tid:= 4;
2 18457 v_kode:= 6;
2 18458 v_bus:= 8;
2 18459 v_ll1:= 10;
2 18460 v_ll2:= 12;
2 18461 v_tekst:= 6;
2 18462 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18463 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18464 if vt_log_aktiv then
2 18465 begin
3 18466 integer i;
3 18467 real t;
3 18468 integer array field iaf;
3 18469 integer array
3 18470 tail(1:10),ia(1:10),chead(1:20);
3 18471
3 18471 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18472 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18473 if i=0 then
3 18474 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18475 if i=0 then
3 18476 begin
4 18477 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18478 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18479 end;
3 18480
3 18480 if i=0 then
3 18481 begin
4 18482 iaf:= 2;
4 18483 tofrom(vt_logdisc,tail.iaf,8);
4 18484 i:=slices(vt_logdisc,0,tail,chead);
4 18485 if i > (-2048) then
4 18486 begin
5 18487 vt_log_slicelgd:= chead(15);
5 18488 i:= 0;
5 18489 end;
4 18490 end;
3 18491
3 18491 if i=0 then
3 18492 begin
4 18493 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18494 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18495 if i=0 then
4 18496 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18497 if i=0 then
4 18498 begin
5 18499 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18500 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18501 end;
4 18502
4 18502 if i<>0 then
4 18503 begin
5 18504 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18505 tail(1):= 1;
5 18506 iaf:= 2;
5 18507 tofrom(tail.iaf,vt_logdisc,8);
5 18508 tail(6):=systime(7,0,t);
5 18509 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18510 if i=0 then
5 18511 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18512 end;
4 18513 end;
3 18514
3 18514 if i<>0 then vt_log_aktiv:= false;
3 18515 end;
2 18516
2 18516
2 18516 \f
2 18516 message vogntabel initialisering side 4 - 810520/cl;
2 18517
2 18517 cs_vt:= nextsemch;
2 18518 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18519 <*-3*>
2 18520
2 18520 cs_vt_adgang:= nextsemch;
2 18521 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18522 <*-3*>
2 18523
2 18523 cs_vt_opd:= nextsemch;
2 18524 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18525 <*-3*>
2 18526
2 18526 cs_vt_rap:= nextsemch;
2 18527 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18528 <*-3*>
2 18529
2 18529 cs_vt_tilst:= nextsemch;
2 18530 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18531 <*-3*>
2 18532
2 18532 cs_vt_auto:= nextsemch;
2 18533 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18534 <*-3*>
2 18535
2 18535 cs_vt_grp:= nextsemch;
2 18536 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18537 <*-3*>
2 18538
2 18538 cs_vt_spring:= nextsemch;
2 18539 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18540 <*-3*>
2 18541
2 18541 cs_vt_log:= nextsemch;
2 18542 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18543 <*-3*>
2 18544
2 18544 cs_vt_logpool:= nextsemch;
2 18545 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18546 <*-3*>
2 18547
2 18547 vt_op:= nextop(vt_op_længde);
2 18548 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18549
2 18549 vt_logop(1):= nextop(vt_op_længde);
2 18550 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18551 vt_logop(2):= nextop(vt_op_længde);
2 18552 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18553
2 18553 \f
2 18553 message vogntabel initialisering side 5 - 81-520/cl;
2 18554
2 18554 i:= nextcoru(500, <*ident*>
2 18555 10, <*prioitet*>
2 18556 true <*testmaske*>);
2 18557 j:= new_activity( i,
2 18558 0,
2 18559 h_vogntabel);
2 18560 <*+3*> skriv_newactivity(out,i,j);
2 18561 <*-3*>
2 18562
2 18562 i:= nextcoru(501, <*ident*>
2 18563 10, <*prioritet*>
2 18564 true <*testmaske*>);
2 18565 iaf:= nextop(filop_længde);
2 18566 j:= new_activity(i,
2 18567 0,
2 18568 vt_opdater,iaf);
2 18569 <*+3*> skriv_newactivity(out,i,j);
2 18570 <*-3*>
2 18571
2 18571 i:= nextcoru(502, <*ident*>
2 18572 10, <*prioritet*>
2 18573 true <*testmaske*>);
2 18574 k:= nextsemch;
2 18575 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18576 <*-3*>
2 18577 iaf:= nextop(fil_op_længde);
2 18578 j:= newactivity(i,
2 18579 0,
2 18580 vt_tilstand,
2 18581 k,
2 18582 iaf);
2 18583 <*+3*> skriv_newactivity(out,i,j);
2 18584 <*-3*>
2 18585 \f
2 18585 message vogntabel initialisering side 6 - 810520/cl;
2 18586
2 18586 i:= nextcoru(503, <*ident*>
2 18587 10, <*prioritet*>
2 18588 true <*testmaske*>);
2 18589 k:= nextsemch;
2 18590 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18591 <*-3*>
2 18592 iaf:= nextop(fil_op_længde);
2 18593 j:= newactivity(i,
2 18594 0,
2 18595 vt_rapport,
2 18596 k,
2 18597 iaf);
2 18598 <*+3*> skriv_newactivity(out,i,j);
2 18599 <*-3*>
2 18600
2 18600 i:= nextcoru(504, <*ident*>
2 18601 10, <*prioritet*>
2 18602 true <*testmaske*>);
2 18603 k:= nextsemch;
2 18604 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18605 <*-3*>
2 18606 iaf:= nextop(fil_op_længde);
2 18607 j:= new_activity(i,
2 18608 0,
2 18609 vt_gruppe,
2 18610 k,
2 18611 iaf);
2 18612 <*+3*> skriv_newactivity(out,i,j);
2 18613 <*-3*>
2 18614 \f
2 18614 message vogntabel initialisering side 7 - 810520/cl;
2 18615
2 18615 i:= nextcoru(505, <*ident*>
2 18616 10, <*prioritet*>
2 18617 true <*testmaske*>);
2 18618 k:= nextsemch;
2 18619 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18620 <*-3*>
2 18621 iaf:= nextop(fil_op_længde);
2 18622 j:= newactivity(i,
2 18623 0,
2 18624 vt_spring,
2 18625 k,
2 18626 iaf);
2 18627 <*+3*> skriv_newactivity(out,i,j);
2 18628 <*-3*>
2 18629
2 18629 i:= nextcoru(506, <*ident*>
2 18630 10,
2 18631 true <*testmaske*>);
2 18632 k:= nextsemch;
2 18633 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18634 <*-3*>
2 18635 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18636 j:= newactivity(i,
2 18637 0,
2 18638 vt_auto,
2 18639 k,
2 18640 iaf);
2 18641 <*+3*> skriv_newactivity(out,i,j);
2 18642 <*-3*>
2 18643
2 18643 i:=nextcoru(507, <*ident*>
2 18644 10, <*prioritet*>
2 18645 true <*testmaske*>);
2 18646 j:=newactivity(i,
2 18647 0,
2 18648 vt_log);
2 18649 <*+3*> skriv_newactivity(out,i,j);
2 18650 <*-3*>
2 18651
2 18651 <*+2*>
2 18652 <**> if testbit42 then skriv_vt_variable(out);
2 18653 <*-2*>
2 18654 \f
2 18654 message sysslut initialisering side 1 - 810406/cl;
2 18655 begin
3 18656 zone z(128,1,stderror);
3 18657 integer i,coruid,j,k;
3 18658 integer array field cor;
3 18659
3 18659 open(z,4,<:overvågede:>,0);
3 18660 for i:= read(z,coruid) while i > 0 do
3 18661 begin
4 18662 if coruid = 0 then
4 18663 begin
5 18664 for coruid:= 1 step 1 until maxcoru do
5 18665 begin
6 18666 cor:= coroutine(coruid);
6 18667 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18668 end
5 18669 end
4 18670 else
4 18671 begin
5 18672 cor:= coroutine(coru_no(abs coruid));
5 18673 if cor > 0 then
5 18674 begin
6 18675 d.cor.corutestmask:=
6 18676 (d.cor.corutestmask shift 1 shift (-1)) add
6 18677 ((coruid > 0) extract 1 shift 11);
6 18678 end;
5 18679 end;
4 18680 end;
3 18681 close(z,true);
3 18682
3 18682 læsfil(tf_systællere,1,k);
3 18683 rf:=iaf:= 4;
3 18684 systællere_nulstillet:= fil(k).rf;
3 18685 nulstil_systællere:= fil(k).iaf(1);
3 18686 if systællere_nulstillet=real<::> then
3 18687 begin
4 18688 systællere_nulstillet:= 0.0;
4 18689 nulstil_systællere:= -1;
4 18690 end;
3 18691 iaf:= 32;
3 18692 tofrom(opkalds_tællere,fil(k).iaf,max_antal_områder*10);
3 18693 iaf:= 192;
3 18694 tofrom(operatør_tællere,fil(k).iaf,max_antal_operatører*10);
3 18695
3 18695 end;
2 18696 \f
2 18696 message sysslut initialisering side 2 - 810603/cl;
2 18697
2 18697
2 18697 if låsning > 0 then
2 18698 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18699
2 18699 if låsning > 1 then
2 18700 <* låsning 2 : *> lock(readchar,1,write,2);
2 18701
2 18701 if låsning > 2 then
2 18702 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18703
2 18703
2 18703
2 18703
2 18703 if låsning > 0 then
2 18704 begin
3 18705 i:= locked(ia);
3 18706 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18707 end;
2 18708 \f
2 18708 message sysslut initialisering side 3 - 810406/cl;
2 18709
2 18709 write(z_io,"nl",2,<:initialisering slut:>);
2 18710 system(2)free core:(i,ra);
2 18711 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18712 setposition(z_io,0,0);
2 18713 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18714 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18715 "nl",1);
2 18716 errorbits:= 3; <* ok.no warning.yes *>
2 18717 \f
2 18717
2 18717 algol list.off;
2 18718 message coroutinemonitor - 40 ;
2 18719
2 18719 if simref <> firstsem then initerror(1, false);
2 18720 if semref <> firstop - 4 then initerror(2, false);
2 18721 if coruref <> firstsim then initerror(3, false);
2 18722 if opref <> optop + 6 then initerror(4, false);
2 18723 if proccount <> maxprocext -1 then initerror(5, false);
2 18724 goto takeexternal;
2 18725
2 18725 dump:
2 18726 op:= op;
2 18727 \f
2 18727 message sys trapaktion side 1 - 810521/hko/cl;
2 18728 trap(finale);
2 18729 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18730 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18731 begin
3 18732 k:= 0;
3 18733 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18734 <:timerqueue->:>));
3 18735 iaf:= i;
3 18736 for iaf:= d.iaf.next while iaf<>i do
3 18737 begin
4 18738 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18739 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18740 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18741 end;
3 18742 end;
2 18743 outchar(zbillede,'nl');
2 18744
2 18744 skriv_opkaldstællere(zbillede);
2 18745
2 18745
2 18745 pfilsystem(zbillede);
2 18746
2 18746
2 18746 write(zbillede,"nl",2,"=",20,<: attentionmodul :>,"=",20,"nl",1);
2 18747
2 18747 write(zbillede,"nl",1,<:attention-flag: :>,"nl",1);
2 18748 outintbits_ia(zbillede,att_flag,1,att_maske_lgd//2);
2 18749
2 18749 write(zbillede,"nl",1,<:attention-signal: :>,"nl",1);
2 18750 outintbits_ia(zbillede,att_signal,1,att_maske_lgd//2);
2 18751 \f
2 18751 message operatør trapaktion1 side 1 - 810521/hko;
2 18752 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18753
2 18753 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18754 for i:= 1 step 1 until max_antal_operatører do
2 18755 begin
3 18756 laf:= (i-1)*8;
3 18757 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18758 case operatør_auto_include(i) extract 2 + 1 of (
3 18759 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18760 terminal_navn.laf,"nl",1);
3 18761 end;
2 18762 write(zbillede,"nl",1);
2 18763
2 18763 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18764 <:betjeningspladsgrupper::>,"nl",1);
2 18765 for i:= 1 step 1 until 127 do
2 18766 if bpl_navn(i)<>long<::> then
2 18767 begin
3 18768 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18769 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18770 write(zbillede,"sp",16-k,<:= :>);
3 18771 iaf:= i*op_maske_lgd; j:=0;
3 18772 for k:= 1 step 1 until max_antal_operatører do
3 18773 begin
4 18774 if læsbit_ia(bpl_def.iaf,k) then
4 18775 begin
5 18776 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18777 write(zbillede,true,6,string bpl_navn(k));
5 18778 j:= j+1;
5 18779 end;
4 18780 end;
3 18781 write(zbillede,"nl",1);
3 18782 end;
2 18783
2 18783 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18784 for i:= 1 step 1 until max_antal_operatører do
2 18785 begin
3 18786 write(zbillede,<<dd >,i);
3 18787 for j:= 0 step 1 until 3 do
3 18788 begin
4 18789 k:= operatør_stop(i,j);
4 18790 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18791 else string bpl_navn(k));
4 18792 end;
3 18793 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18794 end;
2 18795
2 18795 skriv_terminal_tab(zbillede);
2 18796 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18797 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18798 skriv_opk_alarm_tab(zbillede);
2 18799 skriv_talevejs_tab(zbillede);
2 18800 skriv_op_spool_buf(zbillede);
2 18801 skriv_cqf_tabel(zbillede,true);
2 18802 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18803
2 18803 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18804 for i:= 1 step 1 until max_antal_garageterminaler do
2 18805 begin
3 18806 laf:= (i-1)*8;
3 18807 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18808 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18809 end;
2 18810 \f
2 18810 message radio trapaktion side 1 - 820301/hko;
2 18811 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18812 skriv_kanal_tab(zbillede);
2 18813 skriv_opkaldskø(zbillede);
2 18814 skriv_radio_linietabel(zbillede);
2 18815 skriv_radio_områdetabel(zbillede);
2 18816
2 18816 \f
2 18816 message vogntabel trapaktion side 1 - 810520/cl;
2 18817 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18818 skriv_vt_variable(zbillede);
2 18819 p_vogntabel(zbillede);
2 18820 p_gruppetabel(zbillede);
2 18821 p_springtabel(zbillede);
2 18822 \f
2 18822 message sysslut trapaktion side 1 - 810519/cl;
2 18823 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18824 corutable(zbillede);
2 18825 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18826 <: ref værdi prev next:>,"nl",1);
2 18827 iaf:= firstsim;
2 18828 repeat
2 18829 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18830 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18831 iaf:= iaf + simsize;
2 18832 until iaf>=simref;
2 18833 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18834 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18835 iaf:= firstsem;
2 18836 repeat
2 18837 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18838 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18839 iaf:= iaf+semsize;
2 18840 until iaf>=semref;
2 18841 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18842 iaf:= firstop;
2 18843 repeat
2 18844 skriv_op(zbillede,iaf);
2 18845 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18846 until iaf>=optop;
2 18847 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18848 <: messref messcode messop:>,"nl",1);
2 18849 for i:= 1 step 1 until maxmessext do
2 18850 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18851 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18852 <: procref proccode procop:>,"nl",1);
2 18853 for i:= 1 step 1 until maxprocext do
2 18854 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18855
2 18855
2 18855 \f
2 18855 message sys_finale side 1 - 810428/hko;
2 18856
2 18856 finale:
2 18857 trap(slut_finale);
2 18858 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18859 endaction:=0;
2 18860 \f
2 18860 message filsystem finale side 1 - 810428/cl;
2 18861
2 18861 <* lukning af zoner *>
2 18862 write(out,<:lukker filsystem:>); ud;
2 18863 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18864 close(fil(i),true);
2 18865 \f
2 18865 message operatør_finale side 1 - 810428/hko;
2 18866
2 18866 goto op_trap2_slut;
2 18867
2 18867 write(out,<:lukker operatører:>); ud;
2 18868 for k:= 1 step 1 until max_antal_operatører do
2 18869 begin
3 18870 close(z_op(k),true);
3 18871 end;
2 18872 op_trap2_slut:
2 18873 k:=k;
2 18874
2 18874 \f
2 18874 message garage_finale side 1 - 810428/hko;
2 18875
2 18875 write(out,<:lukker garager:>); ud;
2 18876 for k:= 1 step 1 until max_antal_garageterminaler do
2 18877 begin
3 18878 close(z_gar(k),true);
3 18879 end;
2 18880 \f
2 18880 message radio_finale side 1 - 810525/hko;
2 18881 write(out,<:lukker radio:>); ud;
2 18882 close(z_fr_in,true);
2 18883 close(z_fr_out,true);
2 18884 close(z_rf_in,true);
2 18885 close(z_rf_out,true);
2 18886 \f
2 18886 message sysslut finale side 1 - 810530/cl;
2 18887
2 18887 slut_finale:
2 18888
2 18888 trap(exit_finale);
2 18889
2 18889 outchar(zrl,'em');
2 18890 close(zrl,true);
2 18891
2 18891 write(zbillede,
2 18892 "nl",2,<:blocksread=:>,blocksread,
2 18893 "nl",1,<:blocksout= :>,blocksout,
2 18894 "nl",1,<:fillæst= :>,fillæst,
2 18895 "nl",1,<:filskrevet=:>,filskrevet,
2 18896 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18897 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18898 close(zbillede,true);
2 18899 monitor(42,zbillede,0,ia);
2 18900 ia(6):= systime(7,0,0.0);
2 18901 monitor(44,zbillede,0,ia);
2 18902 setposition(z_io,0,0);
2 18903 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18904 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18905 close(z_io,true);
2 18906 exit_finale: trapmode:= 1 shift 10;
2 18907
2 18907 end;
1 18908
1 18908
1 18908 algol list.on;
1 18909 message programslut;
1 18910 program_slut:
1 18911 end
\f
1. 7243143 9798898 611 0 0
2. 14420435 9620877 351 0 0
3. 2345542 15489587 420 368 0
4. 7831238 12320017 429 1657 742
5. 14057705 15299 584 29980 605
6. 14754120 13735534 585 0 0
7. 16051858 2408786 634 0 0
8. 18901 18895 18882 18864 18851 18843 18833 18825 18814 18803
18796 18783 18769 18760 18752 18746 18734 18721 18712 18702
18689 18660 18635 18617 18593 18574 18552 18539 18524 18508
18493 18472 18446 18432 18415 18395 18386 18364 18339 18314
18296 18283 18279 18251 18236 18220 18209 18196 18181 18165
18152 18136 18120 18098 18080 18064 18046 18029 18006 17987
17968 17956 17942 17922 17908 17889 17876 17857 17846 17833
17823 17806 17793 17782 17764 17751 17738 17718 17700 17687
17664 17644 17628 17615 17598 17586 17571 17556 17537 17516
17502 17492 17487 17477 17469 17450 17429 17409 17401 17394
17384 17339 17294 17266 17253 17220 17193 17170 17130 17105
17076 17020 16965 16912 16883 16850 16808 16776 16741 16685
16647 16607 16559 16526 16501 16478 16458 16430 16411 16392
16369 16358 16347 16327 16310 16295 16279 16252 16233 16217
16199 16190 16183 16158 16150 16140 16120 16109 16090 16079
16062 16047 16029 16004 15991 15980 15963 15945 15931 15924
15916 15907 15879 15862 15845 15832 15824 15815 15796 15785
15771 15759 15732 15717 15699 15677 15657 15644 15625 15602
15576 15555 15544 15522 15502 15480 15462 15434 15413 15395
15382 15374 15367 15352 15333 15326 15309 15289 15269 15255
15230 15215 15194 15168 15156 15147 15118 15096 15076 15066
15055 15030 15009 14989 14959 14940 14921 14901 14880 14872
14846 14833 14816 14797 14771 14752 14735 14708 14688 14666
14649 14629 14598 14567 14532 14505 14484 14471 14460 14439
14431 14422 14403 14383 14360 14333 14316 14298 14285 14275
14264 14240 14216 14197 14167 14154 14121 14086 14071 14050
14038 14012 13991 13971 13947 13936 13906 13887 13864 13834
13818 13795 13768 13733 13706 13699 13685 13664 13652 13638
13630 13615 13601 13594 13587 13580 13572 13539 13524 13504
13491 13473 13459 13431 13404 13386 13365 13347 13330 13313
13301 13291 13267 13261 13246 13226 13210 13193 13168 13155
13120 13103 13086 13063 13047 13035 13017 12990 12979 12971
12948 12929 12920 12903 12888 12870 12861 12849 12840 12822
12806 12791 12780 12761 12733 12712 12691 12675 12661 12654
12642 12625 12593 12575 12559 12542 12526 12495 12471 12461
12448 12433 12417 12399 12381 12357 12346 12330 12313 12297
12280 12256 12249 12231 12204 12186 12161 12136 12092 12081
12070 12042 12009 11979 11952 11910 11883 11862 11849 11841
11833 11823 11794 11777 11756 11741 11721 11698 11676 11652
11624 11602 11585 11560 11543 11527 11504 11489 11470 11451
11427 11392 11366 11348 11329 11308 11280 11263 11241 11227
11204 11176 11163 11150 11121 11083 11052 11009 10975 10944
10937 10929 10921 10910 10881 10858 10843 10833 10813 10795
10782 10773 10761 10752 10737 10729 10717 10688 10666 10648
10594 10559 10525 10492 10433 10417 10400 10381 10368 10355
10334 10322 10304 10291 10278 10251 10232 10215 10178 10162
10143 10135 10125 10094 10075 10058 10047 10017 9994 9969
9956 9947 9933 9909 9902 9892 9875 9856 9842 9823
9811 9795 9784 9773 9748 9731 9709 9691 9673 9653
9640 9620 9609 9583 9564 9545 9531 9521 9493 9475
9467 9443 9431 9419 9395 9377 9361 9350 9322 9305
9301 9284 9275 9268 9257 9243 9227 9210 9198 9186
9167 9156 9148 9121 9108 9099 9092 9073 9057 9046
9031 9023 9004 8965 8956 8932 8919 8908 8883 8864
8842 8823 8781 8769 8753 8734 8717 8710 8700 8690
8675 8662 8651 8637 8629 8609 8602 8591 8580 8565
8556 8548 8529 8517 8501 8483 8472 8458 8448 8437
8416 8402 8383 8371 8356 8343 8335 8321 8297 8279
8263 8242 8230 8208 8193 8177 8164 8150 8135 8094
8070 8036 8014 7989 7974 7952 7938 7914 7895 7868
7854 7832 7807 7795 7778 7764 7750 7730 7721 7705
7689 7675 7657 7639 7607 7589 7570 7547 7527 7505
7489 7466 7456 7422 7386 7377 7360 7343 7324 7310
7296 7283 7265 7248 7235 7222 7208 7184 7171 7152
7125 7115 7107 7099 7088 7053 7033 7010 6995 6978
6963 6953 6933 6924 6900 6889 6878 6867 6856 6848
6842 6830 6814 6795 6779 6761 6742 6734 6717 6705
6689 6657 6639 6624 6603 6566 6552 6542 6530 6516
6506 6493 6478 6462 6443 6437 6431 6419 6400 6393
6376 6368 6346 6334 6318 6308 6297 6279 6267 6242
6223 6207 6181 6162 6139 6115 6092 6069 6062 6045
6027 6013 5999 5976 5963 5953 5940 5930 5913 5875
5857 5844 5821 5791 5779 5770 5761 5746 5733 5721
5707 5695 5673 5654 5635 5614 5585 5572 5559 5539
5524 5501 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
16051858 2408786 973 506071 31003
9. 16 434 16 4 960807 235735 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◀