|
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 - metrics - download
Length: 969984 (0xecd00)
Types: TextFile
Names: »buskomudx08 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »buskomudx08 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.950613.2023
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
1 37 long array la(1:2);
1 38 long array field laf;
1 39
1 39 procedure ud;
1 40 begin
2 41 <*
2 42 outchar(out,'nl');
2 43 if out_tw_lp then setposition(out,0,0);
2 44 *>
2 45 flushout('nl');
2 46 end;
1 47 \f
1 47 message sys_parametererklæringer side 3 - 810310/hko;
1 48
1 48 <* hovedmodul_parametre *>
1 49
1 49 integer
1 50 sys_mod,
1 51 io_mod,
1 52 op_mod,
1 53 gar_mod,
1 54 rad_mod,
1 55 vt_mod;
1 56
1 56 <* operations_parametre *>
1 57
1 57 integer field
1 58 kilde,
1 59 retur,
1 60 resultat,
1 61 opkode;
1 62
1 62 real field
1 63 tid;
1 64
1 64 integer array field
1 65 data;
1 66
1 66 boolean
1 67 sys_optype,
1 68 io_optype,
1 69 op_optype,
1 70 gar_optype,
1 71 rad_optype,
1 72 vt_optype,
1 73 gen_optype;
1 74 \f
1 74 message sys_parametererklæringer side 4 - 820301/hko,cl;
1 75
1 75 <* trimme-variable *>
1 76
1 76 integer
1 77 max_antal_operatører,
1 78 max_antal_taleveje,
1 79 max_antal_garageterminaler,
1 80 max_antal_garager,
1 81 max_antal_områder,
1 82 max_antal_radiokanaler,
1 83 max_antal_pabx,
1 84 max_antal_kanaler,
1 85 max_antal_mobilopkald,
1 86 min_antal_nødopkald,
1 87 max_antal_grupper,
1 88 max_antal_gruppeopkald,
1 89 max_antal_spring,
1 90 max_antal_busser,
1 91 max_antal_linie_løb,
1 92 max_antal_fejltekster,
1 93 max_linienr,
1 94 op_maske_lgd,
1 95 tv_maske_lgd;
1 96
1 96 integer array
1 97 konsol_navn,
1 98 taleswitch_in_navn,
1 99 taleswitch_out_navn,
1 100 radio_fr_navn,
1 101 radio_rf_navn(1:4),
1 102 alfabet(0:255);
1 103
1 103 integer
1 104 tf_systællere,
1 105 tf_stoptabel,
1 106 tf_bplnavne,
1 107 tf_bpldef,
1 108 tf_alarmlgd;
1 109 \f
1 109 message filparm side 1 - 800529/jg/cl;
1 110
1 110 integer
1 111 fil_op_længde,
1 112 dbantez,dbantsz,dbanttz,
1 113 dbmaxtf, dbmaxsf, dbblokt,
1 114 dbmaxb,dbbidlængde,dbbidmax,
1 115 dbmaxef;
1 116 long array
1 117 dbsnavn, dbtnavn(1:2);
1 118
1 118 message attention parametererklæringer side 1 - 810318/hko;
1 119
1 119 integer
1 120 att_op_længde,
1 121 att_maske_lgd,
1 122 terminal_beskr_længde;
1 123 integer field
1 124 terminal_tilstand,
1 125 terminal_suppl;
1 126
1 126 message io_parametererklæringer side 1 - 820301/hko;
1 127
1 127 message operatør_parametererklæringer side 1 - 810422/hko;
1 128
1 128 integer field
1 129 cqf_bus, cqf_fejl,
1 130 alarm_kmdo, alarm_tilst, alarm_gtilst, alarm_lgd;
1 131 real field
1 132 cqf_ok_tid, cqf_næste_tid,
1 133 alarm_start;
1 134 long field
1 135 cqf_id;
1 136
1 136 integer
1 137 max_cqf, cqf_lgd,
1 138 op_spool_postlgd,
1 139 op_spool_postantal,
1 140 opk_alarm_tab_lgd;
1 141
1 141
1 141 \f
1 141 message procedure radio_parametererklæringer side 1 - 810524/hko;
1 142
1 142 integer
1 143 radio_giveup,
1 144 opkaldskø_postlængde,
1 145 kanal_beskr_længde,
1 146 radio_op_længde,
1 147 radio_pulje_størrelse;
1 148
1 148
1 148 \f
1 148 message vogntabel parametererklæringer side 1 - 810309/cl;
1 149
1 149 integer vt_op_længde, vt_logskift;
1 150 boolean vt_log_aktiv;
1 151
1 151 \f
1 151
1 151 algol list.off;
1 152 message coroutinemonitor - 2 ;
1 153
1 153 maxsem:= maxsemch:= maxop:= maxcoru:= maxnettoop:= 0;
1 154 maxmessext:= maxprocext:= 1;
1 155 corusize:= 20;
1 156 simsize:= 6;
1 157 semsize:= 8;
1 158 opheadsize:= 8;
1 159 testbuffering:= 1;
1 160 timeinterval:= 5;
1 161 algol list.on;
1 162 algol list.on;
1 163
1 163 \f
1 163 message sys_parameterinitialisering side 1 - 810305/hko;
1 164
1 164 copyout;
1 165
1 165 cl_overvåget:= false;
1 166 getzone6(out,ia);
1 167 out_tw_lp:= ia(1) extract 12 = 8 or ia(1) extract 12 = 14;
1 168
1 168 testbit0 :=testbit( 0);
1 169 testbit1 :=testbit( 1);
1 170 testbit2 :=testbit( 2);
1 171 testbit3 :=testbit( 3);
1 172 testbit4 :=testbit( 4);
1 173 testbit5 :=testbit( 5);
1 174 testbit6 :=testbit( 6);
1 175 testbit7 :=testbit( 7);
1 176 testbit8 :=testbit( 8);
1 177 testbit9 :=testbit( 9);
1 178 testbit10:=testbit(10);
1 179 testbit11:=testbit(11);
1 180 testbit12:=testbit(12);
1 181 testbit13:=testbit(13);
1 182 testbit14:=testbit(14);
1 183 testbit15:=testbit(15);
1 184 testbit16:=testbit(16);
1 185 testbit17:=testbit(17);
1 186 testbit18:=testbit(18);
1 187 testbit19:=testbit(19);
1 188 testbit20:=testbit(20);
1 189 testbit21:=testbit(21);
1 190 testbit22:=testbit(22);
1 191 testbit23:=testbit(23);
1 192 \f
1 192 message sys_parameterinitialisering side 2 - 810316/cl;
1 193
1 193 testbit24:=testbit(24);
1 194 testbit25:=testbit(25);
1 195 testbit26:=testbit(26);
1 196 testbit27:=testbit(27);
1 197 testbit28:=testbit(28);
1 198 testbit29:=testbit(29);
1 199 testbit30:=testbit(30);
1 200 testbit31:=testbit(31);
1 201 testbit32:=testbit(32);
1 202 testbit33:=testbit(33);
1 203 testbit34:=testbit(34);
1 204 testbit35:=testbit(35);
1 205 testbit36:=testbit(36);
1 206 testbit37:=testbit(37);
1 207 testbit38:=testbit(38);
1 208 testbit39:=testbit(39);
1 209 testbit40:=testbit(40);
1 210 testbit41:=testbit(41);
1 211 testbit42:=testbit(42);
1 212 testbit43:=testbit(43);
1 213 testbit44:=testbit(44);
1 214 testbit45:=testbit(45);
1 215 testbit46:=testbit(46);
1 216 testbit47:=testbit(47);
1 217 cm_test:= false;
1 218 \f
1 218 message sys_parameterinitialisering side 3 - 810409/cl,hko;
1 219
1 219 timeinterval:=1; <* tidsinterval for cmon's timeoutinspection *>
1 220
1 220 if findfpparam(<:låsning:>,true,ia) > 0 then låsning:= ia(1)
1 221 else låsning:= 0;
1 222 \f
1 222 message sys_parameterinitialisering side 4 - 820301/hko/cl;
1 223
1 223 <* initialisering af hovedmodul_parametre *>
1 224
1 224 i:=0; sys_mod:=i;
1 225 i:=i+1; io_mod:=i;
1 226 i:=i+1; op_mod:=i;
1 227 i:=i+1; gar_mod:=i;
1 228 i:=i+1; rad_mod:=i;
1 229 i:=i+1; vt_mod:=i;
1 230
1 230 <* initialisering af operationstyper *>
1 231
1 231 sys_optype:=false add (1 shift sys_mod);
1 232 io_optype:= false add (1 shift io_mod);
1 233 op_optype:= false add (1 shift op_mod);
1 234 gar_optype:=false add (1 shift gar_mod);
1 235 rad_optype:=false add (1 shift rad_mod);
1 236 vt_optype:= false add (1 shift vt_mod);
1 237 gen_optype:=false add (1 shift 11);
1 238
1 238 <* initialisering af fieldvariable for operationer *>
1 239
1 239 i:=2; kilde:=i;
1 240 i:=i+4; tid:=i;
1 241 i:=i+2; retur:=i;
1 242 i:=i+2; opkode:=i;
1 243 i:=i+2; resultat:=i;
1 244 i:=i+0; data:=i;
1 245
1 245 <* initialisering af trimme-variable *>
1 246
1 246 max_antal_operatører:=28;
1 247 max_antal_taleveje:=12;
1 248 max_antal_garageterminaler:=3;
1 249 max_antal_garager:=99;
1 250 max_antal_radiokanaler:=16;
1 251 max_antal_pabx:=2;
1 252 max_antal_kanaler:=14; <* 1 pabx + 13 radio *>
1 253 max_antal_områder:=11;
1 254 max_antal_mobilopkald:=100;
1 255 min_antal_nødopkald:=20;
1 256 max_antal_grupper:=16;
1 257 max_antal_gruppeopkald:=16;
1 258 max_antal_spring:=16;
1 259 max_antal_busser:=2000;
1 260 max_antal_linie_løb:=2000;
1 261 max_antal_fejltekster:=21;
1 262 max_linienr:=999; <*<=999*>
1 263
1 263 op_maske_lgd:= ((1+max_antal_operatører+23)//24)*2;
1 264 tv_maske_lgd:= ((1+max_antal_taleveje+23)//24)*2;
1 265 \f
1 265 message sys_parameterinitialisering side 5 - 880901/cl;
1 266
1 266 <* initialisering af konsol-navn *>
1 267 raf:= 0;
1 268 if findfpparam(<:io:>,false,ia)>0 then
1 269 begin
2 270 for i:= 1 step 1 until 4 do konsol_navn(i):= ia(i);
2 271 end
1 272 else
1 273 system(7,0,konsol_navn);
1 274 <*
1 275 movestring(konsol_navn.raf,1,<:console1:>);
1 276 *>
1 277
1 277 raf:= 0;
1 278
1 278 <* intialiserning af talevejsswitchens navn *>
1 279
1 279 movestring(taleswitch_in_navn.raf,1,<:taleswitchi:>);
1 280 movestring(taleswitch_out_navn.raf,1,<:taleswitch:>);
1 281
1 281 <* initialisering af radiokanalnavne *>
1 282
1 282 movestring(radio_fr_navn.raf,1,<:radiofr:>);
1 283 movestring(radio_rf_navn.raf,1,<:radiorf:>);
1 284
1 284 <* initialisering af 'input'-alfabet *>
1 285
1 285 isotable(alfabet);
1 286 alfabet('esc'):= 8 shift 12 + 'esc';
1 287 <* for i:='a' step 1 until 'å' do alfabet(i):=alfabet(i)-32; *>
1 288 for i:= 128 step 1 until 255 do alfabet(i):= 0 shift 12 + i;
1 289 intable(alfabet);
1 290
1 290 <* initialsering af tf_systællere *>
1 291
1 291 tf_systællere:= 1024<*tabelfil*> + 8;
1 292 tf_stoptabel := 1024<*tabelfil*> + 5;
1 293 tf_bpl_navne := 1024<*tabelfil*> + 12;
1 294 tf_bpl_def := 1024<*tabelfil*> + 13;
1 295 tf_alarmlgd := 1024<*tabelfil*> + 14;
1 296
1 296 \f
1 296 message filparminit side 1 - 801030/jg;
1 297
1 297 fil_op_længde:= data + 18 <*halvord*>;
1 298
1 298
1 298 dbantez:= 1;
1 299 dbantsz:= 2;
1 300 dbanttz:= 3; <* >=2 aht. samtidig tilgang*>
1 301 dbblokt:= 8;
1 302 dbmaxsf:= 7;
1 303 dbbidlængde:= 3;
1 304 dbbidmax:= 5;
1 305 dbmaxb:= dbmaxsf * dbbidmax;
1 306 dbmaxef:= 12;
1 307 movestring(dbsnavn,1,<:spoolfil:>);
1 308 movestring(dbtnavn,1,<:tabelfil:>);
1 309 if findfpparam(<:tabelfil:>,false,ia)>0 then
1 310 tofrom(dbtnavn,ia,8);
1 311 \f
1 311 message filparminit side 2 - 801030/jg;
1 312
1 312
1 312 <* reserver og check spoolfil og tabelfil *>
1 313 begin integer s,i,funk,f;
2 314 zone z(128,1,stderror); integer array tail(1:10);
2 315
2 315 for f:=1,2 do
2 316 begin
3 317 <*open(z,4,string (case f of(dbsnavn,dbtnavn)),0);*>
3 318 case f of
3 319 begin
4 320 open(z,4,dbsnavn,0);
4 321 open(z,4,dbtnavn,0);
4 322 end;
3 323 for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do
3 324 begin
4 325 s:=monitor(funk,z,i,tail);
4 326 if s<>0 then system(9,funk*100+s,
4 327 case f of(<:<10>spoolfil:>,<:<10>tabelfil:>));
4 328 end;
3 329 case f of begin
4 330 begin integer antseg; <*spoolfil*>
5 331 antseg:=dbmaxb * dbbidlængde;
5 332 if tail(1) < antseg then
5 333 begin
6 334 tail(1):=antseg;
6 335 s:=monitor(44<*change*>,z,i,tail);
6 336 if s<>0 then
6 337 system(9,44*100+s,<:<10>spoolfil:>);
6 338 end;
5 339 end;
4 340 begin <*tabelfil*>
5 341 dbmaxtf:=tail(10);
5 342 if dbmaxtf<1 or dbmaxtf>1023 then
5 343 system(9,dbmaxtf,<:<10>tabelfil:>);
5 344 end
4 345 end case;
3 346 close(z,false);
3 347 end for;
2 348 end;
1 349 \f
1 349 message attention parameterinitialisering side 1 - 810318/hko;
1 350
1 350 att_op_længde:= 40;
1 351 att_maske_lgd:=
1 352 (1+max_antal_operatører+max_antal_garageterminaler+1+23)//24*2;
1 353 terminal_beskr_længde:=6;
1 354 terminal_tilstand:= 2;
1 355 terminal_suppl:=4;
1 356
1 356 message io_parameterinitialisering side 1 - 810421/hko;
1 357
1 357
1 357 message operatør_parameterinitialisering side 1 - 810422/hko;
1 358
1 358 <* felter i cqf_tabel *>
1 359 cqf_lgd:=
1 360 cqf_næste_tid:= 16;
1 361 cqf_ok_tid := 12;
1 362 cqf_id := 8;
1 363 cqf_fejl := 4;
1 364 cqf_bus := 2;
1 365
1 365 max_cqf:= 64;
1 366
1 366 <* felter i opkaldsalarmtabel *>
1 367 alarm_kmdo := 2;
1 368 alarm_tilst := 4;
1 369 alarm_gtilst:= 6;
1 370 alarm_lgd := 8;
1 371 alarm_start := 12;
1 372
1 372 opk_alarm_tab_lgd:= 12;
1 373 op_spool_postantal:= 16;
1 374 op_spool_postlgd:= 64;
1 375
1 375
1 375 \f
1 375 message procedure radio_parameterinitialisering side 1 - 810601/hko;
1 376
1 376 radio_giveup:= 1 shift 21 + 1 shift 9;
1 377 opkaldskø_postlængde:= 10+op_maske_lgd;
1 378 kanal_beskr_længde:= 12+op_maske_lgd+tv_maske_lgd;
1 379 radio_op_længde:= 30*2;
1 380 radio_pulje_størrelse:= 1+max_antal_taleveje;
1 381
1 381 \f
1 381 message vogntabel parameterinitialisering side 1 - 810309/cl;
1 382
1 382 vt_op_længde:= data + 16; <* halvord *>
1 383
1 383 if findfpparam(<:vtlogskift:>,true,ia) > 0 then
1 384 vt_logskift:= ia(1) else vt_logskift:= -1;
1 385
1 385 vt_log_aktiv:= (vt_logskift >= 0) and (vt_logskift < 240000);
1 386
1 386
1 386 \f
1 386 message filclaim, side 1 - 810202/cl;
1 387
1 387 maxcoru:= maxcoru+6;
1 388 maxsem:= maxsem+2;
1 389 maxsemch:= maxsemch+6;
1 390 \f
1 390 message attention_claiming side 1 - 810318/hko;
1 391
1 391
1 391 maxcoru:=maxcoru+1;
1 392
1 392 max_op:=max_op +1
1 393 +max_antal_operatører
1 394 +max_antal_garageterminaler;
1 395
1 395 max_nettoop:=maxnettoop+(data+att_op_længde)
1 396 *(1+max_antal_operatører
1 397 +max_antal_garageterminaler);
1 398
1 398 max_procext:=max_procext+1;
1 399
1 399 max_sem:= max_sem+1;
1 400
1 400 max_semch:=maxsemch+1;
1 401
1 401
1 401 \f
1 401 message io_claiming side 1 - 810421/hko;
1 402
1 402 max_coru:= max_coru
1 403 + 1 <* hovedmodul io *>
1 404 + 1 <* io kommando *>
1 405 + 1 <* io operatørmeddelelser *>
1 406 + 1 <* io spontane meddelelser *>
1 407 + 1; <* io spoolkorutine *>
1 408
1 408 max_semch:= max_semch
1 409 + 1 <* cs_io *>
1 410 + 1 <* cs_io_komm *>
1 411 + 1 <* cs_io_fil *>
1 412 + 1 <* cs_io_medd *>
1 413 + 1; <* cs_io_spool *>
1 414
1 414 max_sem:= max_sem
1 415 + 1 <* ss_io_spool_fulde *>
1 416 + 1 <* ss_io_spool_tomme *>
1 417 + 1; <* bs_zio_adgang *>
1 418
1 418 max_op:=max_op
1 419 + 1; <* fil-operation *>
1 420
1 420 max_nettoop:=max_nettoop
1 421 + (data+18); <* fil-operation *>
1 422
1 422 \f
1 422 message operatør_claiming side 1 - 810520/hko;
1 423
1 423 max_coru:= max_coru +1 <* h_op *>
1 424 +1 <* alarmur *>
1 425 +1 <* opkaldsalarmer *>
1 426 +1 <* talevejsswitch *>
1 427 +1 <* tv_switch_adm *>
1 428 +1 <* tv_switch_input *>
1 429 +1 <* op_spool *>
1 430 +1 <* op_medd *>
1 431 +1 <* op_cqftest *>
1 432 +max_antal_operatører;
1 433
1 433 max_sem:= 1 <* bs_opk_alarm *>
1 434 +1 <* ss_op_spool_tomme *>
1 435 +1 <* ss_op_spool_fulde *>
1 436 +max_sem;
1 437
1 437 max_semch:= max_semch +1 <* cs_op *>
1 438 +1 <* cs_op_retur *>
1 439 +1 <* cs_opk_alarm_ur *>
1 440 +1 <* cs_opk_alarm_ur_ret *>
1 441 +1 <* cs_opk_alarm *>
1 442 +1 <* cs_talevejsswitch *>
1 443 +1 <* cs_tv_switch_adm *>
1 444 +1 <* cs_tvswitch_adgang *>
1 445 +1 <* cs_tvswitch_input *>
1 446 +1 <* cs_op_iomedd *>
1 447 +1 <* cs_op_spool *>
1 448 +1 <* cs_op_medd *>
1 449 +1 <* cs_cqf *>
1 450 +max_antal_operatører<* cs_operatør *>
1 451 +max_antal_operatører<* cs_op_fil *>;
1 452
1 452 max_op:= max_op + 1 <* talevejsoperation *>
1 453 + 2 <* tv_switch_input *>
1 454 + 1 <* op_iomedd *>
1 455 + 1 <* opk_alarm_ur *>
1 456 + 1 <* op_spool_medd *>
1 457 + 1 <* op_cqftest *>
1 458 + max_antal_operatører;
1 459
1 459 max_netto_op:= filoplængde*max_antal_operatører
1 460 + data+128 <* talevejsoperation *>
1 461 + 2*(data+256) <* tv_switch_input *>
1 462 + 60 <* op_iomedd *>
1 463 + data <* opk_alarm_ur *>
1 464 + data+op_spool_postlgd <* op_spool_med *>
1 465 + 60 <* op_cqftest *>
1 466 + max_netto_op;
1 467
1 467 \f
1 467 message garage_claiming side 1 -810226/hko;
1 468
1 468 max_coru:= max_coru +1
1 469 +max_antal_garageterminaler;
1 470
1 470 max_semch:= max_semch +1
1 471 +max_antal_garageterminaler;
1 472
1 472 \f
1 472 message procedure radio_claiming side 1 - 810526/hko;
1 473
1 473 max_coru:= max_coru
1 474 +1 <* hovedmodul radio *>
1 475 +1 <* opkaldskø_meddelelse *>
1 476 +1 <* radio_adm *>
1 477 +max_antal_taleveje <* radio *>
1 478 +2; <* radio ind/-ud*>
1 479
1 479 max_semch:= max_semch
1 480 +1 <* cs_rad *>
1 481 +max_antal_taleveje <* cs_radio *>
1 482 +1 <* cs_radio_pulje *>
1 483 +1 <* cs_radio_kø *>
1 484 +1 <* cs_radio_medd *>
1 485 +1 <* cs_radio_adm *>
1 486 +2 ; <* cs_radio_ind/-ud *>
1 487
1 487 max_sem:=
1 488 +1 <* bs_mobil_opkald *>
1 489 +1 <* bs_opkaldskø_adgang *>
1 490 +max_antal_kanaler <* ss_radio_aktiver *>
1 491 +max_antal_kanaler <* ss_samtale_nedlagt *>
1 492 +max_antal_taleveje <* bs_talevej_udkoblet *>
1 493 +max_sem;
1 494
1 494 max_op:=
1 495 + radio_pulje_størrelse <* radio_pulje_operationer *>
1 496 + 1 <* radio_medd *>
1 497 + 1 <* radio_adm *>
1 498 + max_antal_taleveje <* operationer for radio *>
1 499 + 2 <* operationer for radio_ind/-ud *>
1 500 + max_op;
1 501
1 501 max_netto_op:=
1 502 + radio_pulje_størrelse * 60 <* radio_pulje_operationer *>
1 503 + data + 6 <* radio_medd *>
1 504 + max_antal_taleveje <* operationer for radio *>
1 505 * (data + radio_op_længde)
1 506 + data + radio_op_længde <* operation for radio_adm *>
1 507 + 2*(data + 64) <* operationer for radio_ind/-ud *>
1 508 + max_netto_op;
1 509 \f
1 509 message vogntabel_claiming side 1 - 810413/cl;
1 510
1 510 maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
1 511 + 1 <* coroutine vt_opdater *>
1 512 + 1 <* coroutine vt_tilstand *>
1 513 + 1 <* coroutine vt_rapport *>
1 514 + 1 <* coroutine vt_gruppe *>
1 515 + 1 <* coroutine vt_spring *>
1 516 + 1 <* coroutine vt_auto *>
1 517 + 1 <* coroutine vt_log *>
1 518 + maxcoru;
1 519
1 519 maxsemch:= 1 <* cs_vt *>
1 520 + 1 <* cs_vt_adgang *>
1 521 + 1 <* cs_vt_logpool *>
1 522 + 1 <* cs_vt_opd *>
1 523 + 1 <* cs_vt_rap *>
1 524 + 1 <* cs_vt_tilst *>
1 525 + 1 <* cs_vtt_auto *>
1 526 + 1 <* cs_vt_grp *>
1 527 + 1 <* cs_vt_spring *>
1 528 + 1 <* cs_vt_log *>
1 529 + 5 <* cs_vt_filretur(coru) *>
1 530 + maxsemch;
1 531
1 531 maxop:= 1 <* vt_op *>
1 532 + 2 <* vt_log_op *>
1 533 + 6 <* vt_fil_op + radop *>
1 534 + maxop;
1 535
1 535 maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
1 536 + 5*fil_op_længde
1 537 + (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
1 538 + maxnettoop;
1 539
1 539 \f
1 539
1 539 algol list.off;
1 540 message coroutinemonitor - 3 ;
1 541
1 541 begin
2 542
2 542 <* work variables - primarily used during initialization *>
2 543 integer array field simref, semref, coruref, opref;
2 544 integer proccount, corucount, messcount, cmi, cmj;
2 545 integer array zoneia(1:20);
2 546
2 546 <* field variables describing the format of basic entities *>
2 547 integer field
2 548 <* chain head *>
2 549 next, prev,
2 550 <* simple semaphore *>
2 551 simvalue, simcoru,
2 552 <* chained semaphore *>
2 553 semop, semcoru,
2 554 <* coroutine *>
2 555 coruop, corutimerchain, corutimer, corupriority, coruident,
2 556 <* operation head *>
2 557 opnext, opsize;
2 558
2 558 \f
2 558
2 558 message coroutinemonitor - 4 ;
2 559
2 559 boolean field
2 560 corutypeset, corutestmask, optype;
2 561 real starttime;
2 562 long corustate;
2 563
2 563 <* field variables used as queue identifiers (addresses) *>
2 564 integer array field current, readyqueue, idlequeue, timerqueue;
2 565
2 565 <* extensions (message- and process- extensions) *>
2 566 integer array messref, messcode, messop (1:maxmessext);
2 567 integer array procref, proccode, procop (1:maxprocext);
2 568
2 568 <* core array used for accessing the core using addresses as field
2 569 variables (as delivered by the monitor functions)
2 570 - descriptor array 'd' in which all basic entities are allocated
2 571 (except for extensions) *>
2 572 integer array core (1:1), d (1:(4 <* readyqueue *> +
2 573 4 <* idlequeue *> +
2 574 4 <* timerqueue *> +
2 575 maxcoru * corusize +
2 576 maxsem * simsize +
2 577 maxsemch * semsize +
2 578 maxop * opheadsize +
2 579 maxnettoop)/2);
2 580 \f
2 580
2 580 message coroutinemonitor - 5 ;
2 581
2 581
2 581
2 581 <*************** initialization procedures ***************>
2 582
2 582
2 582
2 582 procedure initchain (chainref);
2 583 value chainref;
2 584 integer array field chainref;
2 585 begin
3 586 integer array field cref;
3 587 cref:= chainref;
3 588 d.cref.next:= d.cref.prev:= cref;
3 589 end;
2 590 \f
2 590
2 590 message coroutinemonitor - 6 ;
2 591
2 591
2 591 <***** nextsem *****
2 592
2 592 this procedure allocates and initializes the next simple semaphore in the
2 593 pool of claimed semaphores.
2 594 the procedure returns the identification (the address) of the semaphore to
2 595 be used when calling 'signal', 'wait' and 'inspect'. *>
2 596
2 596 integer procedure nextsem;
2 597 begin
3 598 nextsem:= simref;
3 599 if simref >= firstsem then initerror(1, true);
3 600 initchain(simref + simcoru);
3 601 d.simref.simvalue:= 0;
3 602 simref:= simref + simsize;
3 603 end;
2 604
2 604
2 604 <***** nextsemch *****
2 605
2 605 this procedure allocates and initializes the next simple semaphore in the
2 606 pool of claimed semaphores.
2 607 the procedure returns the identification (the address) of the semaphore to
2 608 be used when calling 'signalch', 'waitch' and 'inspectch'. *>
2 609
2 609 integer procedure nextsemch;
2 610 begin
3 611 nextsemch:= semref;
3 612 if semref >= firstop-4 then initerror(2, true);
3 613 initchain(semref + semcoru);
3 614 initchain(semref + semop);
3 615 semref:= semref + semsize;
3 616 end;
2 617 \f
2 617
2 617 message coroutinemonitor - 7 ;
2 618
2 618
2 618 <***** nextcoru *****
2 619
2 619 this procedure initializes the next coroutine description in the pool of
2 620 claimed coroutine descriptions.
2 621 at initialization is defined the priority (an integer value), an identi-
2 622 fication (an integer value 0..8000) and a test pattern (a boolean). *>
2 623
2 623 integer procedure nextcoru(ident, priority, testmask);
2 624 value ident, priority, testmask;
2 625 integer ident, priority;
2 626 boolean testmask;
2 627 begin
3 628 corucount:= corucount + 1;
3 629 if corucount > maxcoru then initerror(3, true);
3 630 nextcoru:= corucount;
3 631 initchain(coruref + next);
3 632 initchain(coruref + corutimerchain);
3 633 initchain(coruref + coruop);
3 634 d.coruref.corupriority:= priority;
3 635 d.coruref.coruident:= ident * 1000 + corucount;
3 636 d.coruref.corutypeset:= false;
3 637 d.coruref.corutimer:= 0;
3 638 d.coruref.corutestmask:= testmask;
3 639 linkprio(coruref, readyqueue);
3 640 current:= coruref;
3 641 coruref:= coruref + corusize;
3 642 end;
2 643 \f
2 643
2 643 message coroutinemonitor - 8 ;
2 644
2 644
2 644 <***** nextop *****
2 645
2 645 this procedure initializes the next operation in the pool of claimed ope-
2 646 rations (heads and buffers).
2 647 the head is allocated and immediately following the head is allocated 'size'
2 648 halfwords forming the operation buffer.
2 649 the procedure returns an identification of the operation (an address) and
2 650 in case this address is held in a field variable 'op', the buffer area may
2 651 be accessed as: d.op(1), d.op(2), d.op(3) ... *>
2 652
2 652 integer procedure nextop (size);
2 653 value size;
2 654 integer size;
2 655 begin
3 656 nextop:= opref;
3 657 if opref >= optop then initerror(4, true);
3 658 initchain(opref + next);
3 659 d.opref.opsize:= size;
3 660 opref:= opref + size + opheadsize;
3 661 end;
2 662 \f
2 662
2 662 message coroutinemonitor - 9 ;
2 663
2 663
2 663 <***** nextprocext *****
2 664
2 664 this procedure initializes the next process extension in the series of
2 665 claimed process extensions.
2 666 the process description address is put into the process extension and the
2 667 state of the extension is initialized to be closed. *>
2 668
2 668 integer procedure nextprocext (processref);
2 669 value processref;
2 670 integer processref;
2 671 begin
3 672 proccount:= proccount + 1;
3 673 if proccount >= maxprocext then initerror(5, true);
3 674 nextprocext:= proccount;
3 675 procref(proccount):= processref;
3 676 proccode(proccount):= 1 shift 12;
3 677 end;
2 678 \f
2 678
2 678 message coroutinemonitor - 10 ;
2 679
2 679
2 679 <***** initerror *****
2 680
2 680 this procedure is activated in case the initialized set of resources does
2 681 not match the claimed set.
2 682 in case more resources are claimed than used, a warning is written,
2 683 in case too few resources are claimed, an error message is written and
2 684 the execution is terminated. *>
2 685
2 685 procedure initerror (resource, exceeded);
2 686 value resource, exceeded;
2 687 integer resource; boolean exceeded;
2 688 begin
3 689 write(out, false add 10, 1,
3 690 if exceeded then <:more :> else <:less :>,
3 691 case resource of (
3 692 <:simple semaphores:>,
3 693 <:chained semaphores:>,
3 694 <:coroutines:>,
3 695 <:operations:>,
3 696 <:process extensions:>),
3 697 <: initialized than claimed:>,
3 698 false add 10, 1);
3 699 if exceeded then goto dump;
3 700 end;
2 701
2 701
2 701 <***** stackclaim *****
2 702
2 702 this procedure is used by a coroutine from its first activation to it
2 703 arrives its first waiting point. the procedure is used to claim an addi-
2 704 tional amount of stack space. this must be done because the maximum
2 705 stack space for a coroutine is set to be the max amount used during its
2 706 very first activation. *>
2 707
2 707
2 707 procedure stackclaim (size);
2 708 value size; integer size;
2 709 begin
3 710 boolean array stackspace (1:size);
3 711 end;
2 712 algol list.on;
2 713
2 713 \f
2 713 message sys_erklæringer side 1 - 810406/cl,hko;
2 714
2 714 zone
2 715 zdummy(1,1,stderror),
2 716 zrl(128,1,stderror),
2 717 zbillede(128,1,stderror);
2 718
2 718 real array
2 719 fejltekst(1:max_antal_fejltekster);
2 720
2 720 integer
2 721 top_bpl_gruppe;
2 722
2 722 integer array
2 723 ingen_operatører, alle_operatører(1:(op_maske_lgd//2)),
2 724 ingen_taleveje, alle_taleveje(1:(tv_maske_lgd//2)),
2 725 bpl_def(1:(128*(op_maske_lgd//2))),
2 726 bpl_tilst(0:127,1:2),
2 727 operatør_stop(0:max_antal_operatører,0:3),
2 728 område_id(1:max_antal_områder,1:2),
2 729 pabx_id(1:max_antal_pabx),
2 730 radio_id(1:max_antal_radiokanaler),
2 731 kanal_id(1:max_antal_kanaler),
2 732 opkalds_tællere(1:(max_antal_områder*3));
2 733
2 733 boolean array
2 734 operatør_auto_include(1:max_antal_operatører),
2 735 garage_auto_include(1:max_antal_garageterminaler);
2 736
2 736 long array
2 737 terminal_navn(1:(2*max_antal_operatører)),
2 738 garage_terminal_navn(1:(2*max_antal_garageterminaler)),
2 739 bpl_navn(0:127),
2 740 område_navn(1:max_antal_områder),
2 741 kanal_navn(1:max_antal_kanaler);
2 742 \f
2 742 message procedure findområde side 1 - 880901/cl;
2 743
2 743 integer procedure find_bpl(navn);
2 744 value navn;
2 745 long navn;
2 746 begin
3 747 integer i;
3 748
3 748 find_bpl:= 0;
3 749 for i:= 0 step 1 until 127 do
3 750 if navn = bpl_navn(i) then find_bpl:= i;
3 751 end;
2 752
2 752 integer procedure findområde(omr);
2 753 value omr;
2 754 integer omr;
2 755 begin
3 756 integer i;
3 757
3 757 if omr = '*' shift 16 then findområde:= -1 else
3 758 begin
4 759 findområde:= 0;
4 760 for i:= 1 step 1 until max_antal_områder do
4 761 if (extend omr) shift 24=område_navn(i) then findområde:= i;
4 762 end;
3 763 end;
2 764 \f
2 764 message procedure tæl_opkald side 1 - 880926/cl;
2 765
2 765 procedure tæl_opkald(område,type);
2 766 value område,type;
2 767 integer område,type;
2 768 begin
3 769 integer zi;
3 770 integer array field iaf;
3 771
3 771 iaf:= 0;
3 772 increase(opkalds_tællere((område-1)*3+type));
3 773
3 773 disable begin
4 774 skrivfil(tf_systællere,1,zi);
4 775 tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*6);
4 776 setposition(fil(zi),0,0);
4 777 end;
3 778 end;
2 779
2 779 procedure skriv_opkaldstællere(z);
2 780 zone z;
2 781 begin
3 782 integer omr,typ;
3 783
3 783 write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
3 784 <:omr ud ind-alm ind-nød:>,"nl",1);
3 785 for omr:= 1 step 1 until max_antal_områder do
3 786 begin
4 787 write(z,true,6,string område_navn(omr),":",1);
4 788 for typ:= 1 step 1 until 3 do
4 789 write(z,<< ddddddd>,opkalds_tællere((omr-1)*3+typ));
4 790 outchar(z,'nl');
4 791 end;
3 792 end;
2 793 \f
2 793 message procedure start_operation side 1 - 810521/hko;
2 794
2 794 procedure start_operation(op_ref,kor,ret_sem,kode);
2 795 value kor,ret_sem,kode;
2 796 integer array field op_ref;
2 797 integer kor,ret_sem,kode;
2 798 <*
2 799 op_ref: kald, reference til operation
2 800
2 800 kor: kald, kilde= hovedmodulnr*100 +løbenr
2 801 = korutineident.
2 802 ret_sem: kald, retursemafor
2 803
2 803 kode: kald, suppl shift 12 + operationskode
2 804
2 804 proceduren initialiserer en operations hoved med
2 805 parameterværdierne samt tidfeltet med aktueltid.
2 806 resultatfelt og datafelter nulstilles.
2 807
2 807 *>
2 808 begin
3 809 integer i;
3 810 d.op_ref.kilde:= kor;
3 811 systime(1,0,d.op_ref.tid);
3 812 d.op_ref.retur:=ret_sem;
3 813 d.op_ref.op_kode:=kode;
3 814 d.op_ref.resultat:=0;
3 815 for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
3 816 d.op_ref.data(i):=0;
3 817 end start_operation;
2 818 \f
2 818 message procedure afslut_operation side 1 - 810331/hko;
2 819
2 819 procedure afslut_operation(op_ref,sem);
2 820 value op_ref,sem;
2 821 integer op_ref,sem;
2 822 begin
3 823 integer array field op;
3 824 op:=op_ref;
3 825 if sem>0 then signal_ch(sem,op,d.op.optype) else
3 826 if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
3 827 ;
3 828 end afslut_operation;
2 829 \f
2 829 message procedure fejlreaktion - side 1 - 810424/cl,hko;
2 830
2 830 procedure fejlreaktion(nr,værdi,str,måde);
2 831 value nr,værdi,måde;
2 832 integer nr,værdi,måde;
2 833 string str;
2 834 begin
3 835 disable begin
4 836 write(out,<:<10>!!! :>);
4 837 if nr>0 and nr <=max_antal_fejltekster then
4 838 write(out,string fejltekst(nr))
4 839 else write(out,<:fejl nr.:>,nr);
4 840 outchar(out,'sp');
4 841 if måde shift (-12) extract 2=1 then
4 842 outintbits(out,værdi)
4 843 else
4 844 if måde shift (-12) extract 2=2 then
4 845 write(out,<:":>,false add værdi,1,<:":>)
4 846 else
4 847 write(out,værdi);
4 848 write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
4 849 <: korutine nr=:>,<<d>, abs curr_coruno,
4 850 <: ident=:>,curr_coruid,"nl",0);
4 851 if testbit27 and måde extract 12=1 then
4 852 trace(1);
4 853 ud;
4 854 end;<*disable*>
3 855 if måde extract 12 =2 then trapmode:=1 shift 13;
3 856 if måde extract 12= 0 then trap(-1)
3 857 else if måde extract 12 = 2 then trap(-2);
3 858 end fejlreaktion;
2 859
2 859 procedure trace(n);
2 860 value n;
2 861 integer n;
2 862 begin
3 863 trap(finis);
3 864 trap(n);
3 865 finis:
3 866 end trace;
2 867 \f
2 867 message procedure overvåget side 1 - 810413/cl;
2 868
2 868 boolean procedure overvåget;
2 869 begin
3 870 disable begin
4 871 integer i,måde;
4 872 integer array field cor;
4 873 integer array ia(1:12);
4 874
4 874 i:= system(12,0,ia);
4 875 if i > 0 then
4 876 begin
5 877 i:= system(12,1,ia);
5 878 måde:= ia(3);
5 879 end
4 880 else måde:= 0;
4 881
4 881 if måde<>0 then
4 882 begin
5 883 cor:= coroutine(abs ia(3));
5 884 overvåget:= d.cor.corutestmask shift (-11);
5 885 end
4 886 else overvåget:= cl_overvåget;
4 887 end;
3 888 end;
2 889 \f
2 889 message procedure antal_bits_ia side 1 - 940424/cl;
2 890
2 890 integer procedure antal_bits_ia(ia,n,ø);
2 891 value n,ø;
2 892 integer array ia;
2 893 integer n,ø;
2 894 begin
3 895 integer i, ant;
3 896
3 896 ant:= 0;
3 897 for i:= n step 1 until ø do
3 898 if læsbit_ia(ia,i) then ant:= ant+1;
3 899 end;
2 900
2 900 message procedure trunk_til_omr side 1 - 881006/cl;
2 901
2 901 integer procedure trunk_til_omr(trunk);
2 902 value trunk; integer trunk;
2 903 begin
3 904 integer i,j;
3 905
3 905 j:=0;
3 906 for i:= 1 step 1 until max_antal_områder do
3 907 if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
3 908 trunk_til_omr:=j;
3 909 end;
2 910
2 910 integer procedure omr_til_trunk(omr);
2 911 value omr; integer omr;
2 912 begin
3 913 omr_til_trunk:= område_id(omr,2) extract 12;
3 914 end;
2 915
2 915 integer procedure port_til_omr(port);
2 916 value port; integer port;
2 917 begin
3 918 if port shift (-6) extract 6 = 2 then
3 919 port_til_omr:= pabx_id(port extract 6)
3 920 else
3 921 if port shift (-6) extract 6 = 3 then
3 922 port_til_omr:= radio_id(port extract 6)
3 923 else
3 924 port_til_omr:= 0;
3 925 end;
2 926
2 926 integer procedure kanal_til_port(kanal);
2 927 value kanal; integer kanal;
2 928 begin
3 929 kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
3 930 kanal_id(kanal) extract 5;
3 931 end;
2 932
2 932 integer procedure port_til_kanal(port);
2 933 value port; integer port;
2 934 begin
3 935 integer i,j;
3 936
3 936 j:=0;
3 937 for i:= 1 step 1 until max_antal_kanaler do
3 938 if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
3 939 port_til_kanal:= j;
3 940 end;
2 941
2 941 integer procedure kanal_til_omr(kanal);
2 942 value kanal; integer kanal;
2 943 begin
3 944 kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
3 945 end;
2 946
2 946 \f
2 946 message procedure out_xxx_bits side 1 - 810406/cl;
2 947
2 947 procedure outboolbits(zud,b);
2 948 value b;
2 949 zone zud;
2 950 boolean b;
2 951 begin
3 952 integer i;
3 953
3 953 for i:= -11 step 1 until 0 do
3 954 outchar(zud,if b shift i then '1' else '.');
3 955 end;
2 956
2 956 procedure outintbits(zud,j);
2 957 value j;
2 958 zone zud;
2 959 integer j;
2 960 begin
3 961 integer i;
3 962
3 962 for i:= -23 step 1 until 0 do
3 963 begin
4 964 outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
4 965 if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
4 966 end;
3 967 end;
2 968
2 968 procedure outintbits_ia(zud,ia,n,ø);
2 969 value n,ø;
2 970 zone zud;
2 971 integer array ia;
2 972 integer n,ø;
2 973 begin
3 974 integer i;
3 975
3 975 for i:= n step 1 until ø do
3 976 begin
4 977 outintbits(zud,ia(i));
4 978 outchar(zud,'nl');
4 979 end;
3 980 end;
2 981
2 981 real procedure now;
2 982 begin
3 983 real f,r,r1; long l;
3 984
3 984 systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
3 985 systime(4,r,r1);
3 986 now:= r1+f;
3 987 end;
2 988 \f
2 988 message procedure skriv_id side 1 - 820301/cl;
2 989
2 989 procedure skriv_id(z,id,lgd);
2 990 value id,lgd;
2 991 integer id,lgd;
2 992 zone z;
2 993 begin
3 994 integer type,p,li,lø,bo;
3 995
3 995 type:= id shift (-22);
3 996 case type+1 of
3 997 begin
4 998 <* 1: bus *>
4 999 begin
5 1000 p:= write(z,<<d>,id extract 14);
5 1001 if id shift (-14) <> 0 then
5 1002 p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
5 1003 end;
4 1004
4 1004 <* 2: linie/løb *>
4 1005 begin
5 1006 li:= id shift (-12) extract 10;
5 1007 bo:= id shift (-7) extract 5;
5 1008 if bo<>0 then bo:= bo + 'A' - 1;
5 1009 lø:= id extract 7;
5 1010 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
5 1011 end;
4 1012
4 1012 <* 3: gruppe *>
4 1013 begin
5 1014 if id shift (-21) = 4 <* linie-gruppe *> then
5 1015 begin
6 1016 li:= id shift (-5) extract 10;
6 1017 bo:= id extract 5;
6 1018 if bo<>0 then bo:= bo + 'A' - 1;
6 1019 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
6 1020 end
5 1021 else <* special-gruppe *>
5 1022 p:= write(z,"G",1,<<d>,id extract 7);
5 1023 end;
4 1024
4 1024 <* 4: telefon *>
4 1025 begin
5 1026 bo:= id shift (-20) extract 2;
5 1027 li:= id extract 20;
5 1028 case bo+1 of
5 1029 begin
6 1030 p:= write(z,string kanalnavn(li));
6 1031 p:= write(z,<:K*:>);
6 1032 p:= write(z,<:OMR :>,string områdenavn(li));
6 1033 p:= write(z,<:OMR*:>);
6 1034 end;
5 1035 end;
4 1036 end case;
3 1037 write(z,"sp",lgd-p);
3 1038 end skriv_id;
2 1039 <*+3*>
2 1040 \f
2 1040 message skriv_new_sem side 1 - 810520/cl;
2 1041
2 1041 procedure skriv_new_sem(z,type,ref,navn);
2 1042 value type,ref;
2 1043 zone z;
2 1044 integer type,ref;
2 1045 string navn;
2 1046 <* skriver en identifikation af en semafor 'ref' i zonen z.
2 1047
2 1047 type: 1=binær sem
2 1048 2=simpel sem
2 1049 3=kædet sem
2 1050
2 1050 ref: semaforreference
2 1051
2 1051 navn: semafornavn, max 18 tegn
2 1052 *>
2 1053 begin
3 1054 disable if testbit29 then
3 1055 write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
3 1056 true,5,<<zddd>,ref,true,19,navn);
3 1057 end;
2 1058 \f
2 1058 message procedure skriv_newactivity side 1 - 810520/hko/cl;
2 1059
2 1059 <**> procedure skriv_newactivity(zud,actno,cause);
2 1060 <**> value actno,cause;
2 1061 <**> zone zud;
2 1062 <**> integer actno,cause;
2 1063 <**> begin
3 1064 <*+2*>
3 1065 <**> if testbit28 then
3 1066 <**> begin integer array field cor;
4 1067 <**> cor:= coroutine(actno);
4 1068 <**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
4 1069 <**> << zdd>,d.cor.coruident//1000);
4 1070 <**> end;
3 1071 <**> if -, testbit23 then goto skriv_newact_slut;
3 1072 <*-2*>
3 1073 <**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
3 1074 <**> <:) cause=:>,<<-d>,cause);
3 1075 <**> if cause<1 then write(zud,<: !!!:>);
3 1076 <**> skriv_coru(zud,actno);
3 1077 <**> skriv_newact_slut:
3 1078 <**> end skriv_newactivity;
2 1079 <*-3*>
2 1080 <*+99*>
2 1081 \f
2 1081 message procedure skriv_activity side 1 - 810313/hko;
2 1082
2 1082 <**> procedure skriv_activity(zud,actno);
2 1083 <**> value actno;
2 1084 <**> zone zud;
2 1085 <**> integer actno;
2 1086 <**> begin
3 1087 <**> integer i;
3 1088 <**> integer array iact(1:12);
3 1089 <**>
3 1090 <**> i:=system(12,actno,iact);
3 1091 <**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
3 1092 <**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
3 1093 <**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
3 1094 <**> if i>0 and actno>0 and actno<=i then
3 1095 <**> begin
4 1096 <**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
4 1097 <**> (<:tom:>,<:passivate:>,
4 1098 <**> <:implicit passivate:>,<:activate:>));
4 1099 <**> if iact(1)<>0 then
4 1100 <**> write(zud,<: ventende på message:>,iact(1));
4 1101 <**> if iact(7)>0 then
4 1102 <**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
4 1103 <**> <:hovedlager stak benyttes af activity(:>,<<d>,
4 1104 <**> iact(2));
4 1105 <**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
4 1106 <**> iact(4),iact(5),iact(6),iact(10),iact(11));
4 1107 <**> if iact(9)<> 1 shift 22 then
4 1108 <**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
4 1109 <**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
4 1110 <**> end;
3 1111 <**> end skriv_activity
2 1112 <*-99*>
2 1113 <*+98*>
2 1114 \f
2 1114 message procedure identificer side 1 - 810520/cl;
2 1115
2 1115 procedure identificer(z);
2 1116 zone z;
2 1117 begin
3 1118 disable write(z,<:coroutine::>,<< dd>,curr_coruno,
3 1119 <: ident::>,<< zdd >,curr_coruid);
3 1120 end;
2 1121 \f
2 1121 message procedure skriv_coru side 1 - 810317/cl;
2 1122
2 1122 <**> procedure skriv_coru(zud,cor_no);
2 1123 <**> value cor_no;
2 1124 <**> zone zud;
2 1125 <**> integer cor_no;
2 1126 <**> begin
3 1127 <**> integer i;
3 1128 <**> integer array field cor;
3 1129 <**>
3 1130 <**>
3 1131 <**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
3 1132 <**>
3 1133 <**> cor:= coroutine(cor_no);
3 1134 <**> if cor = -1 then
3 1135 <**> write(zud,<: eksisterer ikke !!!:>)
3 1136 <**> else
3 1137 <**> begin
4 1138 <**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
4 1139 <**> <: refbyte: :>,<<d>,cor,"nl",1,
4 1140 <**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
4 1141 <**> <: next: :>,d.cor.next,"nl",1,
4 1142 <**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
4 1143 <**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
4 1144 <**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
4 1145 <**> <: opchain.next: :>,d.cor.coruop,"nl",1,
4 1146 <**> <: timer: :>,d.cor.corutimer,"nl",1,
4 1147 <**> <: priority: :>,d.cor.corupriority,"nl",1,
4 1148 <**> <: typeset: :>);
4 1149 <**> for i:= -11 step 1 until 0 do
4 1150 <**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
4 1151 <**> write(zud,"nl",1,<: testmask: :>);
4 1152 <**> for i:= -11 step 1 until 0 do
4 1153 <**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
4 1154 <*+99*>
4 1155 <**> skriv_activity(zud,cor_no);
4 1156 <*-99*>
4 1157 <**> end;
3 1158 <**> end skriv_coru;
2 1159 <*-98*>
2 1160 <*+98*>
2 1161 \f
2 1161 message procedure skriv_op side 1 - 810409/cl;
2 1162
2 1162 <**> procedure skriv_op(zud,opref);
2 1163 <**> value opref;
2 1164 <**> integer opref;
2 1165 <**> zone zud;
2 1166 <**> begin
3 1167 <**> integer array field op;
3 1168 <**> real array field raf;
3 1169 <**> integer lgd,i;
3 1170 <**> real t;
3 1171 <**>
3 1172 <**> raf:= data;
3 1173 <**> op:= opref;
3 1174 <**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
3 1175 <**> if opref<first_op ! optop<=opref then
3 1176 <**> begin
4 1177 <**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
4 1178 <**> goto slut_skriv_op;
4 1179 <**> end;
3 1180 <**>
3 1181 <**> lgd:= d.op.opsize;
3 1182 <**> write(zud,"nl",1,<<d>,
3 1183 <**> <: opsize :>,d.op.opsize,"nl",1,
3 1184 <**> <: optype :>);
3 1185 <**> for i:= -11 step 1 until 0 do
3 1186 <**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
3 1187 <**> write(zud,"nl",1,<<d>,
3 1188 <**> <: prev :>,d.op.prev,"nl",1,
3 1189 <**> <: next :>,d.op.next);
3 1190 <**> if lgd=0 then goto slut_skriv_op;
3 1191 <**> write(zud,"nl",1,<<d>,
3 1192 <**> <: kilde :>,d.op.kilde extract 10,"nl",1,
3 1193 <**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
3 1194 <**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
3 1195 d.op.retur,"nl",1,
3 1196 <**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
3 1197 <**> d.op.opkode extract 12,"nl",1,
3 1198 <**> <: resultat :>,d.op.resultat,"nl",2,
3 1199 <**> <:data::>);
3 1200 <**> skriv_hele(zud,d.op.raf,lgd-data,1278);
3 1201 <**>slut_skriv_op:
3 1202 <**> end skriv_op;
2 1203 <*-98*>
2 1204 \f
2 1204 message procedure corutable side 1 - 810406/cl;
2 1205
2 1205 procedure corutable(zud);
2 1206 zone zud;
2 1207 begin
3 1208 integer i;
3 1209 integer array field cor;
3 1210
3 1210 write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
3 1211 <:no id ref chain timerch opchain timer pr:>,
3 1212 <: typeset testmask:>,"nl",2);
3 1213 for i:= 1 step 1 until maxcoru do
3 1214 begin
4 1215 cor:= coroutine(i);
4 1216 write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
4 1217 d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
4 1218 d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
4 1219 d.cor.corutimer,<< dd>,d.cor.corupriority);
4 1220 outchar(zud,'sp');
4 1221 outboolbits(zud,d.cor.corutypeset);
4 1222 outchar(zud,'sp');
4 1223 outboolbits(zud,d.cor.corutestmask);
4 1224 outchar(zud,'nl');
4 1225 end;
3 1226 end;
2 1227 \f
2 1227 message filglobal side 1 - 790302/jg;
2 1228
2 1228 integer
2 1229 dbantsf,dbkatsfri,
2 1230 dbantb,dbkatbfri,
2 1231 dbantef,dbkatefri,
2 1232 dbsidstesz,dbsidstetz,
2 1233 dbsegmax,
2 1234 filskrevet,fillæst;
2 1235 integer
2 1236 bs_kats_fri, bs_kate_fri,
2 1237 cs_opret_fil, cs_tilknyt_fil,
2 1238 cs_frigiv_fil, cs_slet_fil,
2 1239 cs_opret_spoolfil, cs_opret_eksternfil;
2 1240 integer array
2 1241 dbkatt(1:dbmaxtf,1:2),
2 1242 dbkats(1:dbmaxsf,1:2),
2 1243 dbkate(1:dbmaxef,1:6),
2 1244 dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
2 1245 boolean array
2 1246 dbkatb(1:dbmaxb);
2 1247 zone array
2 1248 fil(dbantez+dbantsz+dbanttz,128,1,stderror);
2 1249 \f
2 1249 message hentfildim side 1 - 781120/jg;
2 1250
2 1250
2 1250 integer procedure hentfildim(fdim);
2 1251 integer array fdim;
2 1252 <*inddata filref i fdim(4),uddata fdim(1:8)*>
2 1253
2 1253 begin integer ftype,fno,katf,i,s;
3 1254 ftype:=fdim(4) shift (-10);
3 1255 fno:=fdim(4) extract 10;
3 1256 if ftype>3 or ftype=0 or fno=0 then
3 1257 begin s:=1; goto udgang; end;
3 1258 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
3 1259 begin s:=1; goto udgang end; <*paramfejl*>
3 1260 katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
3 1261 if katf extract 9 = 0 then
3 1262 begin s:=2; goto udgang end; <*tom indgang*>
3 1263
3 1263 fdim(1):=katf shift (-9); <*post antal*>
3 1264 fdim(2):=katf extract 9; <*post længde*>
3 1265 fdim(3):=case ftype of( <*seg antal*>
3 1266 dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
3 1267 extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
3 1268 dbkate(fno,2) extract 18);
3 1269 for i:=5 step 1 until 8 do <*externt filnavn*>
3 1270 fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
3 1271 s:=0;
3 1272 udgang:
3 1273 hentfildim:=s;
3 1274 <*+2*>
3 1275 <*tz*> if testbit24 and overvåget then <*zt*>
3 1276 <*tz*> begin <*zt*>
4 1277 <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
4 1278 <*tz*> pfdim(fdim); <*zt*>
4 1279 <*tz*> ud; <*zt*>
4 1280 <*tz*> end; <*zt*>
3 1281 <*-2*>
3 1282 end hentfildim;
2 1283 \f
2 1283 message sætfildim side 1 - 780916/jg;
2 1284
2 1284 integer procedure sætfildim(fdim);
2 1285 integer array fdim;
2 1286 <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
2 1287
2 1287 begin
3 1288 integer ftype,fno,katf,s,pl;
3 1289 integer array gdim(1:8);
3 1290 gdim(4):=fdim(4);
3 1291 s:=hentfildim(gdim);
3 1292 if s>0 then
3 1293 goto udgang;
3 1294 fno:=fdim(4) extract 10;
3 1295 ftype:=fdim(4) shift (-10);
3 1296 pl:= fdim(2) extract 12;
3 1297 if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
3 1298 begin
4 1299 s:=1; <*parameter fejl*>
4 1300 goto udgang
4 1301 end;
3 1302 if fdim(1)>256//pl*fdim(3) then
3 1303 begin
4 1304 s:=1;
4 1305 goto udgang;
4 1306 end;
3 1307
3 1307 <*segant*>
3 1308 if ftype=3 then
3 1309 begin integer segant;
4 1310 segant:= fdim(3);
4 1311 if segant > dbsegmax then
4 1312 begin
5 1313 s:=4; <*ingen plads*>
5 1314 goto udgang
5 1315 end;
4 1316 \f
4 1316 message sætfildim side 2 - 780916/jg;
4 1317
4 1317
4 1317 if segant<>gdim(3) then
4 1318 begin integer i,z,s; array field enavn; integer array tail(1:10);
5 1319 z:=dbkate(fno,2) shift (-19); if z>0 then begin
6 1320 if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
6 1321 begin integer array zd(1:20);
7 1322 getzone6(fil(z),zd);
7 1323 if zd(13)>5 and zd(9)>=segant then
7 1324 begin <*dødt segment skal ikke udskrives*>
8 1325 zd(13):=5;
8 1326 setzone6(fil(z),zd)
8 1327 end
7 1328 end end;
5 1329 \f
5 1329 message sætfildim side 3 - 801031/jg;
5 1330
5 1330
5 1330 enavn:=8; <*ændr fil størrelse*>
5 1331 i:=1;
5 1332 open(zdummy,0,string gdim.enavn(increase(i)),0);
5 1333 s:=monitor(42,zdummy,0,tail); <*lookup*>
5 1334 if s>0 then
5 1335 fejlreaktion(1,s,<:lookup entry:>,0);
5 1336 tail(1):=segant;
5 1337 s:=monitor(44,zdummy,0,tail); <*change entry*>
5 1338 close(zdummy,false);
5 1339 if s<>0 then
5 1340 begin
6 1341 if s=6 then
6 1342 begin <*ingen plads*>
7 1343 s:=4; goto udgang
7 1344 end
6 1345 else fejlreaktion(1,s,<:change entry:>,0);
6 1346 end;
5 1347 dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
5 1348 add segant;
5 1349 \f
5 1349 message sætfildim side 4 - 801013/jg;
5 1350
5 1350
5 1350 end;
4 1351 fdim(3):=segant
4 1352 end
3 1353 else
3 1354 if fdim(3)>gdim(3) then
3 1355 begin
4 1356 s:=4; <*altid ingen plads*>
4 1357 goto udgang
4 1358 end
3 1359 else fdim(3):=gdim(3); <*samme længde*>
3 1360 <*postantal,postlængde*>
3 1361 katf:=fdim(1) shift 9 add pl;
3 1362 case ftype of begin
4 1363 dbkatt(fno,1):=katf;
4 1364 dbkats(fno,1):=katf;
4 1365 dbkate(fno,1):=katf end;
3 1366 udgang:
3 1367 sætfildim:=s;
3 1368 <*+2*>
3 1369 <*tz*> if testbit24 and overvåget then <*zt*>
3 1370 <*tz*> begin integer i; <*zt*>
4 1371 <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
4 1372 <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
4 1373 <*tz*> pfdim(gdim); <*zt*>
4 1374 <*tz*> ud; <*zt*>
4 1375 <*tz*> end; <*zt*>
3 1376 <*-2*>
3 1377 end sætfildim;
2 1378 \f
2 1378 message findfilenavn side 1 - 780916/jg;
2 1379
2 1379 integer procedure findfilenavn(navn);
2 1380 real array navn;
2 1381
2 1381 begin
3 1382 integer fno; array field enavn;
3 1383 for fno:=1 step 1 until dbmaxef do
3 1384 if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
3 1385 begin
4 1386 enavn:=fno*12+4;
4 1387 if navn(1)=dbkate.enavn(1) and
4 1388 navn(2)=dbkate.enavn(2) then
4 1389 begin
5 1390 findfilenavn:=fno;
5 1391 goto udgang
5 1392 end
4 1393 end;
3 1394 findfilenavn:=0;
3 1395 udgang:
3 1396 end findfilenavn;
2 1397 \f
2 1397 message læsfil side 1 - 781120/jg;
2 1398
2 1398 integer procedure læsfil(filref,postindex,zoneno);
2 1399 value filref,postindex;
2 1400 integer filref,postindex,zoneno;
2 1401 <*+2*>
2 1402 <*tz*> begin integer i,o,s; <*zt*>
3 1403 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1404 <*-2*>
3 1405
3 1405 læsfil:=tilgangfil(filref,postindex,zoneno,5);
3 1406
3 1406 <*+2*>
3 1407 <*tz*> if testbit24 and overvåget then <*zt*>
3 1408 <*tz*> begin <*zt*>
4 1409 <*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*>
4 1410 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1411 <*tz*> end; <*zt*>
3 1412 <*tz*> end procedure; <*zt*>
2 1413 <*-2*>
2 1414 \f
2 1414 message skrivfil side 1 - 781120/jg;
2 1415
2 1415 integer procedure skrivfil(filref,postindex,zoneno);
2 1416 value filref,postindex;
2 1417 integer filref,postindex,zoneno;
2 1418 <*+2*>
2 1419 <*tz*> begin integer i,o,s; <*zt*>
3 1420 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1421 <*-2*>
3 1422
3 1422 skrivfil:=tilgangfil(filref,postindex,zoneno,6);
3 1423
3 1423 <*+2*>
3 1424 <*tz*> if testbit24 and overvåget then <*zt*>
3 1425 <*tz*> begin <*zt*>
4 1426 <*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
4 1427 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1428 <*tz*> end; <*zt*>
3 1429 <*tz*> end procedure; <*zt*>
2 1430 <*-2*>
2 1431 \f
2 1431 message modiffil side 1 - 781120/jg;
2 1432
2 1432 integer procedure modiffil(filref,postindex,zoneno);
2 1433 value filref,postindex;
2 1434 integer filref,postindex,zoneno;
2 1435 <*+2*>
2 1436 <*tz*> begin integer i,o,s; <*zt*>
3 1437 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1438 <*-2*>
3 1439
3 1439 modiffil:=tilgangfil(filref,postindex,zoneno,7);
3 1440
3 1440 <*+2*>
3 1441 <*tz*> if testbit24 and overvåget then <*zt*>
3 1442 <*tz*> begin <*zt*>
4 1443 <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
4 1444 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1445 <*tz*> end; <*zt*>
3 1446 <*tz*> end procedure; <*zt*>
2 1447 <*-2*>
2 1448 \f
2 1448 message tilgangfil side 1 - 781003/jg;
2 1449
2 1449 integer procedure tilgangfil(filref,postindex,zoneno,operation);
2 1450 value filref,postindex,operation;
2 1451 integer filref,postindex,zoneno,operation;
2 1452 <*proceduren kaldes fra læsfil,skrivfil og modiffil*>
2 1453
2 1453 begin
3 1454 integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
3 1455 integer array zd(1:20),fdim(1:8);
3 1456
3 1456
3 1456
3 1456 <*hent katalog*>
3 1457
3 1457 fdim(4):=filref;
3 1458 st:=hentfildim(fdim);
3 1459 if st<>0 then
3 1460 goto udgang; <*parameter fejl eller fil findes ikke*>
3 1461 fno:=filref extract 10;
3 1462 ftype:=filref shift (-10);
3 1463 pl:=fdim(2);
3 1464 katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
3 1465 \f
3 1465 message tilgangfil side 2 - 781003/jg;
3 1466
3 1466
3 1466
3 1466 <*find segment adr og check postindex*>
3 1467
3 1467 pps:=256//pl; <*poster pr segment*>
3 1468 seg:=(postindex-1)//pps; <*relativt segment*>
3 1469 pr:=(postindex-1) mod pps; <*post relativ til seg*>
3 1470 if postindex <1 then
3 1471 begin <*parameter fejl*>
4 1472 st:=1;
4 1473 goto udgang
4 1474 end;
3 1475 if seg>=fdim(3) then
3 1476 begin <*post findes ikke*>
4 1477 st:=3;
4 1478 goto udgang
4 1479 end;
3 1480 case ftype of
3 1481 begin <*find absolut segment*>
4 1482
4 1482 <*tabelfil*>
4 1483 seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
4 1484
4 1484 begin <*spoolfil*>
5 1485 integer i,bidno;
5 1486 bidno:=katf extract 12;
5 1487 for i:=seg//dbbidlængde step -1 until 1 do
5 1488 bidno:=dbkatb(bidno) extract 12;
5 1489 seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
5 1490 end;
4 1491
4 1491 <*extern fil,seg ok*>
4 1492
4 1492 end case find abs seg;
3 1493 \f
3 1493 message tilgangfil side 3 - 801030/jg;
3 1494
3 1494 <*alloker zone*>
3 1495
3 1495 zno:=katf shift(-19);
3 1496 case ftype of begin
4 1497
4 1497 begin <*tabelfil*>
5 1498 integer førstetz;
5 1499 førstetz:=dbkatz(dbsidstetz,2);
5 1500 if zno=0 then
5 1501 zno:=førstetz
5 1502 else if dbkatz(zno,1)<>filref then
5 1503 zno:=førstetz
5 1504 else if zno <> førstetz and zno <> dbsidstetz then
5 1505 begin integer z;
6 1506 for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
6 1507 dbkatz(z,2):=dbkatz(zno,2);
6 1508 dbkatz(zno,2):=førstetz;
6 1509 dbkatz(dbsidstetz,2):=zno;
6 1510 end;
5 1511 dbsidstetz:=zno
5 1512 end;
4 1513 \f
4 1513 message tilgangfil side 4 - 801030/jg;
4 1514
4 1514
4 1514 begin <*spoolfil*>
5 1515 integer p,zslut,z;
5 1516 if zno>0 then begin if dbkatz(zno,1) =filref then
6 1517 goto udgangs end; <*strategi 1*>
5 1518 p:=0;
5 1519 zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
5 1520 zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
5 1521 for z:=dbantez+dbantsz step -1 until zslut do
5 1522 begin integer zfref;
6 1523 zfref:=dbkatz(z,1);
6 1524 if zfref extract 10=0 then <*fri zone*>
6 1525 begin <*strategi 2*>
7 1526 zno:=z;
7 1527 goto udgangs
7 1528 end
6 1529 else
6 1530 if zfref shift (-10)=2 then
6 1531 begin <*zone tilknyttet spoolfil*>
7 1532 integer q;
7 1533 q:=dbkatz(z,2); <*prioritet*>
7 1534 if q>p then
7 1535 begin <*strategi 3*>
8 1536 p:=q;
8 1537 zno:=z
8 1538 end
7 1539 end;
6 1540 end z;
5 1541 udgangs:
5 1542 if zno> dbantez then dbsidstesz:=zno;
5 1543 end;
4 1544 \f
4 1544 message tilgangfil side 5 - 780916/jg;
4 1545
4 1545 begin <*extern fil*>
5 1546 integer z;
5 1547 if zno=0 then
5 1548 zno:=1
5 1549 else if dbkatz(zno,1) = filref then
5 1550 goto udgange; <*strategi 1*>
5 1551 for z:=1 step 1 until dbantez do
5 1552 begin integer zfref;
6 1553 zfref:=dbkatz(z,1);
6 1554 if zfref=0 then <*zone fri*>
6 1555 begin zno:=z; goto udgange end <*strategi 2*>
6 1556 else if zfref shift (-10) =2 then <*spoolfil*>
6 1557 zno:=z; <*strategi 3*> <*else strategi 4-5*>
6 1558 end z;
5 1559 udgange:
5 1560 end
4 1561 end case alloker zone;
3 1562
3 1562
3 1562
3 1562 <*åbn zone*>
3 1563
3 1563 if zno<=dbantez then
3 1564 begin <*extern zone;spool og tabel zoner altid åbne*>
4 1565 integer zfref;
4 1566 zfref:=dbkatz(zno,1);
4 1567 if zfref<>0 and zfref<>filref and ftype=3 then
4 1568 begin <*luk hvis ny extern fil*>
5 1569 getzone6(fil(zno),zd);
5 1570 if zd(13)>5 then filskrevet:=filskrevet+1;
5 1571 zfref:=0;
5 1572 close(fil(zno),false);
5 1573 end;
4 1574 if zfref=0 then
4 1575 begin <*åbn zone*>
5 1576 array field enavn; integer i;
5 1577 enavn:=4*2; i:=1;
5 1578 open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
5 1579 string fdim.enavn(increase(i))),0)
5 1580 end
4 1581 end;
3 1582 \f
3 1582 message tilgangfil side 6 - 780916/jg;
3 1583
3 1583
3 1583
3 1583 <*hent segment og sæt zone descriptor*>
3 1584
3 1584 getzone6(fil(zno),zd);
3 1585 zstate:=zd(13);
3 1586 if zstate=0 or zd(9)<>seg then
3 1587 begin <*positioner*>
4 1588 if zstate>5 then
4 1589 filskrevet:=filskrevet+1;
4 1590 setposition(fil(zno),0,seg);
4 1591 if -,(operation=6 and pr=0) then
4 1592 begin <*læs seg medmindre op er skriv første post*>
5 1593 inrec6(fil(zno),512);
5 1594 fillæst:=fillæst+1
5 1595 end;
4 1596 zstate:=operation
4 1597 end
3 1598 else <*zstate:=max(operation,zone state)*>
3 1599 if operation>zstate then
3 1600 zstate:=operation;
3 1601 zd(9):=seg;
3 1602 zd(13):=zstate;
3 1603 zd(16):=pl shift 1;
3 1604 zd(14):=zd(19)+pr*zd(16);
3 1605 setzone6(fil(zno),zd);
3 1606 \f
3 1606 message tilgangfil side 7 - 780916/jg;
3 1607
3 1607
3 1607
3 1607 <*opdater kataloger*>
3 1608
3 1608 katf:=zno shift 19 add (katf extract 19);
3 1609 case ftype of
3 1610 begin
4 1611 dbkatt(fno,2):=katf;
4 1612 dbkats(fno,2):=katf;
4 1613 dbkate(fno,2):=katf
4 1614 end;
3 1615 dbkatz(zno,1):= filref;
3 1616 if ftype=3 then dbkatz(zno,2):=0 else
3 1617 <*if ftype=1 then allerede opd under zoneallokering*>
3 1618 if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
3 1619 if zstate=5 then (if pr=pps-1 then 2 else 1)
3 1620 else if zstate=6 and pr=pps-1 then 3 else 0;
3 1621
3 1621
3 1621
3 1621 <*udgang*>
3 1622
3 1622 udgang:
3 1623 if st=0 then
3 1624 zoneno:=zno
3 1625 else zoneno:=0; <*fejl*>
3 1626 tilgangfil:=st;
3 1627 end tilgangfil;
2 1628 \f
2 1628
2 1628 message pfilsystem side 1 - 781003/jg;
2 1629
2 1629 procedure pfilparm(z);
2 1630 zone z;
2 1631 write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
2 1632 dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
2 1633 <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
2 1634 dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
2 1635
2 1635 procedure pfilglobal(z);
2 1636 zone z;
2 1637 write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
2 1638 <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
2 1639 <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
2 1640 <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
2 1641 <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
2 1642 <:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
2 1643
2 1643
2 1643 procedure pdbkate(z,i);
2 1644 value i; integer i;
2 1645 zone z;
2 1646 begin integer j; array field navn;
3 1647 navn:=i*12+4; j:=1;
3 1648 write(z,<:<10>dbkate(:>,i,<:)=:>,
3 1649 dbkate(i,1) shift (-9),
3 1650 dbkate(i,1) extract 9,
3 1651 dbkate(i,2) shift (-19),
3 1652 dbkate(i,2) shift (-18) extract 1,
3 1653 dbkate(i,2) extract 18,
3 1654 <: :>,string dbkate.navn(increase(j)));
3 1655 end;
2 1656 \f
2 1656 message pfilsystem side 2 - 781003/jg;
2 1657
2 1657
2 1657
2 1657 procedure pdbkats(z,i);
2 1658 value i; integer i;
2 1659 zone z;
2 1660 write(z,<:<10>dbkats(:>,i,<:)=:>,
2 1661 dbkats(i,1) shift (-9),
2 1662 dbkats(i,1) extract 9,
2 1663 dbkats(i,2) shift (-19),
2 1664 dbkats(i,2) shift (-18) extract 1,
2 1665 dbkats(i,2) shift (-12) extract 6,
2 1666 dbkats(i,2) extract 12);
2 1667
2 1667 procedure pdbkatb(z,i);
2 1668 value i;integer i;
2 1669 zone z;
2 1670 write(z,<:<10>dbkatb(:>,i,<:)=:>,
2 1671 dbkatb(i) extract 12);
2 1672
2 1672 procedure pdbkatt(z,i);
2 1673 value i; integer i;
2 1674 zone z;
2 1675 write(z,<:<10>dbkatt(:>,i,<:)=:>,
2 1676 dbkatt(i,1) shift (-9),
2 1677 dbkatt(i,1) extract 9,
2 1678 dbkatt(i,2) shift (-19),
2 1679 dbkatt(i,2) shift (-18) extract 1,
2 1680 dbkatt(i,2) extract 18);
2 1681
2 1681 procedure pdbkatz(z,i);
2 1682 value i; integer i;
2 1683 zone z;
2 1684 write(z,<:<10>dbkatz(:>,i,<:)=:>,
2 1685 dbkatz(i,1),dbkatz(i,2));
2 1686 \f
2 1686 message pfilsystem side 3 - 781003/jg;
2 1687
2 1687
2 1687
2 1687 procedure pfil(z,i);
2 1688 value i; integer i;
2 1689 zone z;
2 1690 begin integer j,k; array field navn; integer array zd(1:20);
3 1691 navn:=2; k:=1;
3 1692 getzone6(fil(i),zd);
3 1693 write(z,<:<10>fil(:>,i,<:)=:>,
3 1694 zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
3 1695 string zd.navn(increase(k)));
3 1696 for j:=6 step 1 until 10 do write(z,zd(j));
3 1697 write(z,<:<10>:>);
3 1698 for j:=11 step 1 until 20 do write(z,zd(j));
3 1699 end;
2 1700
2 1700 procedure pfilsystem(z);
2 1701 zone z;
2 1702 begin integer i;
3 1703
3 1703 write(z,<:<12>udskrift af variable i filsystem:>);
3 1704 write(z,<:<10><10>filparm::>);
3 1705 pfilparm(z);
3 1706 write(z,<:<10><10>filglobal::>);
3 1707 pfilglobal(z);
3 1708 write(z,<:<10><10>fil: zone descriptor:>);
3 1709 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
3 1710 write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
3 1711 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
3 1712 write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
3 1713 for i :=1 step 1 until dbmaxef do pdbkate(z,i);
3 1714 write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
3 1715 for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
3 1716 write(z,<:<10><10>dbkatb: katbref:>);
3 1717 for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
3 1718 write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
3 1719 for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
3 1720 end pfilsystem;
2 1721 \f
2 1721 message pfilsystem side 4 - 781003/jg;
2 1722
2 1722
2 1722
2 1722 procedure pfdim(fdim);
2 1723 integer array fdim;
2 1724 begin
3 1725 integer i;
3 1726 array field navn;
3 1727 i:=1;navn:=8;
3 1728 write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
3 1729 string fdim.navn(increase(i)));
3 1730 end pfdim;
2 1731 \f
2 1731 message opretfil side 0 - 810529/cl;
2 1732
2 1732 procedure opretfil;
2 1733 <* checker parametre og vidresender operation
2 1734 til opret_spoolfil eller opret_eksternfil *>
2 1735
2 1735 begin
3 1736 integer array field op;
3 1737 integer status,pant,pl,segant,p_nøgle,fno,ftype;
3 1738
3 1738 procedure skriv_opret_fil(z,omfang);
3 1739 value omfang;
3 1740 zone z;
3 1741 integer omfang;
3 1742 begin
4 1743 write(z,"nl",1,<:+++ opret fil :>);
4 1744 if omfang > 0 then
4 1745 disable
4 1746 begin
5 1747 skriv_coru(z,abs curr_coruno);
5 1748 write(z,"nl",1,<<d>,
5 1749 <:op :>,op,"nl",1,
5 1750 <:status :>,status,"nl",1,
5 1751 <:pant :>,pant,"nl",1,
5 1752 <:pl :>,pl,"nl",1,
5 1753 <:segant :>,segant,"nl",1,
5 1754 <:p-nøgle:>,p_nøgle,"nl",1,
5 1755 <:fno :>,fno,"nl",1,
5 1756 <:ftype :>,ftype,"nl",1,
5 1757 <::>);
5 1758 end;
4 1759 end skriv_opret_fil;
3 1760 \f
3 1760 message opretfil side 1 - 810526/cl;
3 1761
3 1761 trap(opretfil_trap);
3 1762 <*+2*>
3 1763 <**> disable if testbit28 then
3 1764 <**> skriv_opret_fil(out,0);
3 1765 <*-2*>
3 1766
3 1766 stack_claim(if cm_test then 200 else 150);
3 1767
3 1767 <*+2*>
3 1768 <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
3 1769 <*-2*>
3 1770
3 1770 trin1:
3 1771 waitch(cs_opret_fil,op,true,-1);
3 1772
3 1772 trin2: <* check parametre *>
3 1773 disable begin
4 1774
4 1774 ftype:= d.op.data(4) shift (-10);
4 1775 fno:= d.op.data(4) extract 10;
4 1776 if ftype<2 or ftype>3 or fno<>0 then
4 1777 begin
5 1778 status:= 1; <*parameterfejl*>
5 1779 goto returner;
5 1780 end;
4 1781
4 1781 pant:= d.op.data(1);
4 1782 pl:= d.op.data(2);
4 1783 segant:= d.op.data(3);
4 1784 p_nøgle:= d.op.opkode shift (-12);
4 1785 if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
4 1786 or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
4 1787 status:= 1 <*parameterfejl *>
4 1788 else
4 1789 if pant>256//pl*segant then status:= 1 else
4 1790 if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
4 1791 status:= 4 <*ingen plads*>
4 1792 else
4 1793 status:=0;
4 1794 \f
4 1794 message opretfil side 2 - 810526/cl;
4 1795
4 1795
4 1795 returner:
4 1796
4 1796 d.op.data(9):= status;
4 1797
4 1797 <*+2*>
4 1798 <*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
4 1799 <*tz*> begin <*zt*>
5 1800 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 1801 <*tz*> pfdim(d.op.data); <*zt*>
5 1802 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1803 <*tz*> end; <*zt*>
4 1804 <*-2*>
4 1805
4 1805 <*returner eller vidresend operation*>
4 1806 signalch(if status>0 then d.op.retur else
4 1807 case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
4 1808 op,d.op.optype);
4 1809 end;
3 1810 goto trin1;
3 1811 opretfil_trap:
3 1812 disable skriv_opret_fil(zbillede,1);
3 1813
3 1813 end opretfil;
2 1814 \f
2 1814 message tilknytfil side 0 - 810526/cl;
2 1815
2 1815 procedure tilknytfil;
2 1816 <* tilknytter ekstern fil og returnerer intern filid *>
2 1817
2 1817 begin
3 1818 integer array field op;
3 1819 integer status,i,fno,segant,pa,pl,sliceant,s;
3 1820 array field enavn;
3 1821 integer array tail(1:10);
3 1822
3 1822 procedure skriv_tilknyt_fil(z,omfang);
3 1823 value omfang;
3 1824 zone z;
3 1825 integer omfang;
3 1826 begin
4 1827 write(z,"nl",1,<:+++ tilknyt fil :>);
4 1828 if omfang > 0 then
4 1829 disable
4 1830 begin real array field raf;
5 1831 skriv_coru(z,abs curr_coruno);
5 1832 write(z,"nl",1,<<d>,
5 1833 <:op :>,op,"nl",1,
5 1834 <:status :>,status,"nl",1,
5 1835 <:i :>,i,"nl",1,
5 1836 <:fno :>,fno,"nl",1,
5 1837 <:segant :>,segant,"nl",1,
5 1838 <:pa :>,pa,"nl",1,
5 1839 <:pl :>,pl,"nl",1,
5 1840 <:sliceant:>,sliceant,"nl",1,
5 1841 <:s :>,s,"nl",1,
5 1842 <::>);
5 1843 raf:= 0;
5 1844 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 1845 write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
5 1846 end;
4 1847 end skriv_tilknyt_fil;
3 1848 \f
3 1848 message tilknytfil side 1 - 810529/cl;
3 1849
3 1849 stack_claim(if cm_test then 200 else 150);
3 1850 trap(tilknytfil_trap);
3 1851
3 1851 <*+2*>
3 1852 <**> if testbit28 then
3 1853 <**> skriv_tilknyt_fil(out,0);
3 1854 <*-2*>
3 1855
3 1855 trin1:
3 1856 waitch(cs_tilknyt_fil,op,true,-1);
3 1857
3 1857 trin2:
3 1858 wait(bs_kate_fri);
3 1859
3 1859 trin3:
3 1860 disable begin
4 1861
4 1861 <* find ekstern rapportfil *>
4 1862 enavn:= 8;
4 1863 if find_fil_enavn(d.op.data.enavn)>0 then
4 1864 begin
5 1865 status:= 6; <* fil i brug *>
5 1866 goto returner;
5 1867 end;
4 1868 open(zdummy,0,d.op.data.enavn,0);
4 1869 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 1870 if s<>0 then
4 1871 begin
5 1872 if s=3 then status:= 2 <* fil findes ikke *>
5 1873 else if s=6 then status:= 1 <* parameterfejl, navn *>
5 1874 else fejlreaktion(1,s,<:lookup entry:>,0);
5 1875 goto returner;
5 1876 end;
4 1877 if tail(9)<>d.op.data(4) <* contentskey,subno *> then
4 1878 begin
5 1879 status:= 5; <* forkert indhold *> goto returner;
5 1880 end;
4 1881 segant:= tail(1);
4 1882 if segant>db_seg_max then
4 1883 segant:= db_seg_max;
4 1884 pa:= tail(10);
4 1885 pl:= tail(7) extract 12;
4 1886 if pl < 1 or pl > 256 then
4 1887 begin status:= 7; goto returner; end;
4 1888 \f
4 1888 message tilknytfil side 2 - 810529/cl;
4 1889 if pa>256//pl*segant then
4 1890 begin status:= 7; goto returner; end;
4 1891
4 1891 <* reserver *>
4 1892 s:= monitor(52)create area:(zdummy,0,ia);
4 1893 if s<>0 then
4 1894 begin
5 1895 if s=3 then status:= 2 <* fil findes ikke *>
5 1896 else if s=1 <* areaclaims exeeded *> then
5 1897 begin
6 1898 status:= 4;
6 1899 fejlreaktion(1,s,<:create area:>,1);
6 1900 end
5 1901 else fejlreaktion(1,s,<:create area:>,0);
5 1902 goto returner;
5 1903 end;
4 1904
4 1904 s:= monitor(8)reserve:(zdummy,0,ia);
4 1905 if s<>0 then
4 1906 begin
5 1907 if s<3 then status:= 6 <* i brug *>
5 1908 else fejlreaktion(1,s,<:reserve:>,0);
5 1909 monitor(64)remove area:(zdummy,0,ia);
5 1910 goto returner;
5 1911 end;
4 1912
4 1912 tail(7):= 1 shift 12 +pl; <* tilknyttet *>
4 1913 s:= monitor(44)change entry:(zdummy,0,tail);
4 1914 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 1915
4 1915 <* opdater katalog *>
4 1916 dbantef:= dbantef+1;
4 1917 fno:= dbkatefri;
4 1918 dbkatefri:= dbkate(fno,2);
4 1919 dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
4 1920 dbkate(fno,2):= segant;
4 1921 for i:= 5 step 1 until 8 do
4 1922 dbkate(fno,i-2):= d.op.data(i);
4 1923
4 1923 <* returparametre *>
4 1924 d.op.data(1):= pa;
4 1925 d.op.data(2):= pl;
4 1926 d.op.data(3):= segant;
4 1927 d.op.data(4):= 3 shift 10 +fno;
4 1928 status:= 0;
4 1929 \f
4 1929 message tilknytfil side 3 - 810526/cl;
4 1930
4 1930
4 1930 returner:
4 1931 close(zdummy,false);
4 1932 d.op.data(9):= status;
4 1933
4 1933
4 1933 <*+2*>
4 1934 <*tz*> if testbit24 and overvåget then <*zt*>
4 1935 <*tz*> begin <*zt*>
5 1936 <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
5 1937 <*tz*> pfdim(d.op.data); <*zt*>
5 1938 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1939 <*tz*> end; <*zt*>
4 1940 <*-2*>
4 1941
4 1941 signalch(d.op.retur,op,d.op.optype);
4 1942 if dbantef < dbmaxef then
4 1943 signalbin(bs_kate_fri);
4 1944 end;
3 1945 goto trin1;
3 1946 tilknytfil_trap:
3 1947 disable skriv_tilknyt_fil(zbillede,1);
3 1948 end tilknyt_fil;
2 1949 \f
2 1949 message frigivfil side 0 - 810529/cl;
2 1950
2 1950 procedure frigivfil;
2 1951 <* frigiver en tilknyttet ekstern fil *>
2 1952
2 1952 begin
3 1953 integer array field op;
3 1954 integer status,fref,ftype,fno,s,i,z;
3 1955 array field enavn;
3 1956 integer array tail(1:10);
3 1957
3 1957 procedure skriv_frigiv_fil(zud,omfang);
3 1958 value omfang;
3 1959 zone zud;
3 1960 integer omfang;
3 1961 begin
4 1962 write(zud,"nl",1,<:+++ frigiv fil :>);
4 1963 if omfang > 0 then
4 1964 disable
4 1965 begin real array field raf;
5 1966 skriv_coru(zud,abs curr_coruno);
5 1967 write(zud,"nl",1,<<d>,
5 1968 <:op :>,op,"nl",1,
5 1969 <:status:>,status,"nl",1,
5 1970 <:fref :>,fref,"nl",1,
5 1971 <:ftype :>,ftype,"nl",1,
5 1972 <:fno :>,fno,"nl",1,
5 1973 <:s :>,s,"nl",1,
5 1974 <:i :>,i,"nl",1,
5 1975 <:z :>,z,"nl",1,
5 1976 <::>);
5 1977 raf:= 0;
5 1978 write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
5 1979 end;
4 1980 end skriv_frigiv_fil;
3 1981 \f
3 1981 message frigivfil side 1 - 810526/cl;
3 1982
3 1982
3 1982 stack_claim(if cm_test then 200 else 150);
3 1983 trap(frigivfil_trap);
3 1984
3 1984 <*+2*>
3 1985 <**> disable if testbit28 then
3 1986 <**> skriv_frigiv_fil(out,0);
3 1987 <*-2*>
3 1988
3 1988 trin1:
3 1989 waitch(cs_frigiv_fil,op,true,-1);
3 1990
3 1990 trin2:
3 1991 disable begin
4 1992
4 1992 <* find fil *>
4 1993 fref:= d.op.data(4);
4 1994 ftype:= fref shift (-10);
4 1995 fno:= fref extract 10;
4 1996 if ftype=0 or ftype>3 or fno=0 then
4 1997 begin status:= 1; goto returner; end;
4 1998 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 1999 begin status:= 1; goto returner; end;
4 2000 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2001 extract 9 = 0 then
4 2002 begin
5 2003 status:= 2; <* fil findes ikke *>
5 2004 goto returner;
5 2005 end;
4 2006 if ftype <> 3 then
4 2007 begin status:= 5; goto returner; end;
4 2008
4 2008 <* frigiv evt. tilknyttet zone og areaprocess *>
4 2009 z:= dbkate(fno,2) shift (-19);
4 2010 if z > 0 then
4 2011 begin
5 2012 if dbkatz(z,1)=fref then
5 2013 begin integer array zd(1:20);
6 2014 getzone6(fil(z),zd);
6 2015 if zd(13)>5 then filskrevet:= filskrevet +1;
6 2016 close(fil(z),true);
6 2017 dbkatz(z,1):= 0;
6 2018 end;
5 2019 end;
4 2020 \f
4 2020 message frigivfil side 2 - 810526/cl;
4 2021
4 2021 <* opdater tail *>
4 2022 enavn:= fno*12+4;
4 2023 open(zdummy,0,dbkate.enavn,0);
4 2024 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 2025 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
4 2026 tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
4 2027 tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
4 2028 s:= monitor(44)change entry:(zdummy,0,tail);
4 2029 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 2030 monitor(64)remove process:(zdummy,0,tail);
4 2031 close(zdummy,true);
4 2032
4 2032 <* frigiv indgang *>
4 2033 for i:= 1, 3 step 1 until 6 do
4 2034 dbkate(fno,1):= 0;
4 2035 dbkate(fno,2):= dbkatefri;
4 2036 dbkatefri:= fno;
4 2037 dbantef:= dbantef -1;
4 2038 signalbin(bs_kate_fri);
4 2039 d.op.data(4):= 0; <* filref null *>
4 2040 status:= 0;
4 2041
4 2041 returner:
4 2042 d.op.data(9):= status;
4 2043 <*+2*>
4 2044 <*tz*> if testbit24 and overvåget then <*zt*>
4 2045 <*tz*> begin <*zt*>
5 2046 <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
5 2047 <*tz*> pfdim(d.op.data); <*zt*>
5 2048 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2049 <*tz*> end; <*zt*>
4 2050 <*-2*>
4 2051
4 2051 signalch(d.op.retur,op,d.op.optype);
4 2052 end;
3 2053 goto trin1;
3 2054 frigiv_fil_trap:
3 2055 disable skriv_frigiv_fil(zbillede,1);
3 2056 end frigivfil;
2 2057 \f
2 2057 message sletfil side 0 - 810526/cl;
2 2058
2 2058 procedure sletfil;
2 2059 <* sletter en spool- eller ekstern fil *>
2 2060
2 2060 begin
3 2061 integer array field op;
3 2062 integer fref,fno,ftype,status;
3 2063
3 2063 procedure skriv_slet_fil(z,omfang);
3 2064 value omfang;
3 2065 zone z;
3 2066 integer omfang;
3 2067 begin
4 2068 write(z,"nl",1,<:+++ slet fil :>);
4 2069 if omfang > 0 then
4 2070 disable
4 2071 begin
5 2072 skriv_coru(z,abs curr_coruno);
5 2073 write(z,"nl",1,<<d>,
5 2074 <:op :>,op,"nl",1,
5 2075 <:fref :>,fref,"nl",1,
5 2076 <:fno :>,fno,"nl",1,
5 2077 <:ftype :>,ftype,"nl",1,
5 2078 <:status:>,status,"nl",1,
5 2079 <::>);
5 2080 end;
4 2081 end skriv_slet_fil;
3 2082 \f
3 2082 message sletfil side 1 - 810526/cl;
3 2083
3 2083 stack_claim(if cm_test then 200 else 150);
3 2084
3 2084 trap(sletfil_trap);
3 2085 <*+2*>
3 2086 <**> disable if testbit28 then
3 2087 <**> skriv_slet_fil(out,0);
3 2088 <*-2*>
3 2089
3 2089 trin1:
3 2090 waitch(cs_slet_fil,op,true,-1);
3 2091
3 2091 trin2:
3 2092 disable begin
4 2093
4 2093 <* find fil *>
4 2094 fref:= d.op.data(4);
4 2095 ftype:= fref shift (-10);
4 2096 fno:= fref extract 10;
4 2097 if ftype=0 or ftype>3 or fno=0 then
4 2098 begin status:= 1; goto returner; end;
4 2099 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2100 begin status:= 1; goto returner; end;
4 2101 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2102 extract 9 = 0 then
4 2103 begin
5 2104 status:= 2; <* fil findes ikke *>
5 2105 goto returner;
5 2106 end;
4 2107
4 2107
4 2107 <* slet spool- eller ekstern fil *>
4 2108 case ftype of
4 2109 begin
5 2110
5 2110 <* tabelfil - ingen aktion *>
5 2111 ;
5 2112 \f
5 2112 message sletfil side 2 - 810203/cl;
5 2113
5 2113 <* spoolfil *>
5 2114 begin
6 2115 integer z,bidno,bf,bidant,i;
6 2116
6 2116 <* hvis tilknyttet så frigiv *>
6 2117 z:= dbkats(fno,2) shift (-19);
6 2118 if z>0 then
6 2119 begin
7 2120 if dbkatz(z,1)=fref then
7 2121 begin integer array zd(1:20);
8 2122 dbkatz(z,1):= 2 shift 10;
8 2123 getzone6(fil(z),zd); <*annuler evt. udskrivning*>
8 2124 if zd(13)>5 then
8 2125 begin zd(13):= 0; setzone6(fil(z),zd); end;
8 2126 end;
7 2127 end;
6 2128
6 2128 <* frigiv bidder *>
6 2129 bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
6 2130 bidant:= dbkats(fno,2) shift (-12) extract 6;
6 2131 for i:= bidant -1 step -1 until 1 do
6 2132 bidno:= dbkatb(bidno) extract 12;
6 2133 dbkatb(bidno):= false add dbkatbfri;
6 2134 dbkatbfri:= bf;
6 2135 dbantb:= dbantb-bidant;
6 2136
6 2136 <* frigiv indgang *>
6 2137 dbkats(fno,1):= 0;
6 2138 dbkats(fno,2):= dbkatsfri;
6 2139 dbkatsfri:= fno;
6 2140 dbantsf:= dbantsf -1;
6 2141 signalbin(bs_kats_fri);
6 2142 end spoolfil;
5 2143 \f
5 2143 message sletfil side 3 - 810203/cl;
5 2144
5 2144 <* extern fil *>
5 2145 begin
6 2146 integer i,s,z;
6 2147 real array field enavn;
6 2148 integer array tail(1:10);
6 2149
6 2149 <* find head and tail *>
6 2150 enavn:= fno*12+4;
6 2151 open(zdummy,0,dbkate.enavn,0);
6 2152 s:= monitor(42)lookup entry:(zdummy,0,tail);
6 2153 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
6 2154
6 2154 <*frigiv evt. tilknyttet zone og areaprocess*>
6 2155 z:=dbkate(fno,2) shift (-19);
6 2156 if z>0 then
6 2157 begin
7 2158 if dbkatz(z,1)=fref then
7 2159 begin integer array zd(1:20);
8 2160 getzone6(fil(z),zd);
8 2161 if zd(13)>5 then <* udskrivning *>
8 2162 begin <*annuler*>
9 2163 zd(13):= 0;
9 2164 setzone6(fil(z),zd);
9 2165 end;
8 2166 close(fil(z),true);
8 2167 dbkatz(z,1):= 0;
8 2168 end;
7 2169 end;
6 2170
6 2170 <* fjern entry *>
6 2171 s:= monitor(48)remove entry:(zdummy,0,tail);
6 2172 if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
6 2173 close(zdummy,true);
6 2174
6 2174 <* frigiv indgang *>
6 2175 for i:=1, 3 step 1 until 6 do
6 2176 dbkate(fno,i):= 0;
6 2177 dbkate(fno,2):= dbkatefri;
6 2178 dbkatefri:= fno;
6 2179 dbantef:= dbantef -1;
6 2180 signalbin(bs_kate_fri);
6 2181 end eksternfil;
5 2182
5 2182 end ftype;
4 2183 \f
4 2183 message sletfil side 4 - 810526/cl;
4 2184
4 2184
4 2184 status:= 0;
4 2185 if ftype > 1 then
4 2186 d.op.data(4):= 0; <*filref null*>
4 2187
4 2187 returner:
4 2188 d.op.data(9):= status;
4 2189
4 2189 <*+2*>
4 2190 <*tz*> if testbit24 and overvåget then <*zt*>
4 2191 <*tz*> begin <*zt*>
5 2192 <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
5 2193 <*tz*> pfdim(d.op.data); <*zt*>
5 2194 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2195 <*tz*> end; <*zt*>
4 2196 <*-2*>
4 2197
4 2197 signalch(d.op.retur,op,d.op.optype);
4 2198 end;
3 2199 goto trin1;
3 2200 sletfil_trap:
3 2201 disable skriv_slet_fil(zbillede,1);
3 2202 end sletfil;
2 2203 \f
2 2203 message opretspoolfil side 0 - 810526/cl;
2 2204
2 2204 procedure opretspoolfil;
2 2205 <* opretter en spoolfil og returnerer intern filid *>
2 2206
2 2206 begin
3 2207 integer array field op;
3 2208 integer bidantal,fno,i,bs,bidstart;
3 2209
3 2209 procedure skriv_opret_spoolfil(z,omfang);
3 2210 value omfang;
3 2211 zone z;
3 2212 integer omfang;
3 2213 begin
4 2214 write(z,"nl",1,<:+++ opret spoolfil :>);
4 2215 if omfang > 0 then
4 2216 disable
4 2217 begin
5 2218 skriv_coru(z,abs curr_coruno);
5 2219 write(z,"nl",1,<<d>,
5 2220 <:op :>,op,"nl",1,
5 2221 <:bidantal:>,bidantal,"nl",1,
5 2222 <:fno :>,fno,"nl",1,
5 2223 <:i :>,i,"nl",1,
5 2224 <:bs :>,bs,"nl",1,
5 2225 <:bidstart:>,bidstart,"nl",1,
5 2226 <::>);
5 2227 end;
4 2228 end skriv_opret_spoolfil;
3 2229 \f
3 2229 message opretspoolfil side 1 - 810526/cl;
3 2230
3 2230 stack_claim(if cm_test then 200 else 150);
3 2231
3 2231 signalbin(bs_kats_fri); <*initialiseres til åben*>
3 2232
3 2232 trap(opretspool_trap);
3 2233 <*+2*>
3 2234 <**> disable if testbit28 then
3 2235 <**> skriv_opret_spoolfil(out,0);
3 2236 <*-2*>
3 2237 trin1:
3 2238 waitch(cs_opret_spoolfil,op,true,-1);
3 2239
3 2239 trin2:
3 2240 bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
3 2241 wait(bs_kats_fri);
3 2242
3 2242 trin3:
3 2243 if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
3 2244 begin
4 2245 wait(bs_kats_fri);
4 2246 goto trin3;
4 2247 end;
3 2248 disable begin
4 2249
4 2249 <*alloker bidder*>
4 2250 bs:= bidstart:= dbkatbfri;
4 2251 for i:= bidantal-1 step -1 until 1 do
4 2252 bs:= dbkatb(bs) extract 12;
4 2253 dbkatbfri:= dbkatb(bs) extract 12;
4 2254 dbkatb(bs):= false; <*sidste ref null*>
4 2255 dbantb:= dbantb+bidantal;
4 2256
4 2256 <*alloker indgang*>
4 2257 fno:= dbkatsfri;
4 2258 dbkatsfri:= dbkats(fno,2);
4 2259 dbantsf:= dbantsf +1;
4 2260 dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
4 2261 d.op.data(2) extract 9; <*postlængde*>
4 2262 dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
4 2263 \f
4 2263 message opretspoolfil side 2 - 810526/cl;
4 2264
4 2264 <*returner*>
4 2265 d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
4 2266 d.op.data(4):= 2 shift 10 add fno; <*filref*>
4 2267 for i:= 5 step 1 until 8 do <*filnavn null*>
4 2268 d.op.data(i):= 0;
4 2269 d.op.data(9):= 0; <*status ok*>
4 2270
4 2270 <*+2*>
4 2271 <*tz*> if testbit24 and overvåget then <*zt*>
4 2272 <*tz*> begin <*zt*>
5 2273 <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
5 2274 <*tz*> pfdim(d.op.data); <*zt*>
5 2275 <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
5 2276 <*tz*> end; <*zt*>
4 2277 <*-2*>
4 2278
4 2278 signalch(d.op.retur,op,d.op.optype);
4 2279 if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
4 2280 end;
3 2281 goto trin1;
3 2282
3 2282 opretspool_trap:
3 2283 disable skriv_opret_spoolfil(zbillede,1);
3 2284
3 2284 end opretspoolfil;
2 2285 \f
2 2285 message opreteksternfil side 0 - 810526/cl;
2 2286
2 2286 procedure opreteksternfil;
2 2287 <* opretter og knytter en ekstern fil *>
2 2288
2 2288 begin
3 2289 integer array field op;
3 2290 integer status,s,i,fno,p_nøgle;
3 2291 integer array tail(1:10),zd(1:20);
3 2292 real r;
3 2293 real array field enavn;
3 2294
3 2294 procedure skriv_opret_ekstfil(z,omfang);
3 2295 value omfang;
3 2296 zone z;
3 2297 integer omfang;
3 2298 begin
4 2299 write(z,"nl",1,<:+++ opret ekstern fil :>);
4 2300 if omfang > 0 then
4 2301 disable
4 2302 begin real array field raf;
5 2303 skriv_coru(z,abs curr_coruno);
5 2304 write(z,"nl",1,<<d>,
5 2305 <:op :>,op,"nl",1,
5 2306 <:status :>,status,"nl",1,
5 2307 <:s :>,s,"nl",1,
5 2308 <:i :>,i,"nl",1,
5 2309 <:fno :>,fno,"nl",1,
5 2310 <:p-nøgle:>,p_nøgle,"nl",1,
5 2311 <::>);
5 2312 raf:= 0;
5 2313 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 2314 write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
5 2315 end;
4 2316 end skriv_opret_ekstfil;
3 2317 \f
3 2317 message opreteksternfil side 1 - 810526/cl;
3 2318
3 2318 stack_claim(if cm_test then 200 else 150);
3 2319
3 2319 signalbin(bs_kate_fri); <*initialiseres til åben*>
3 2320
3 2320 trap(opretekst_trap);
3 2321 <*+2*>
3 2322 <**> disable if testbit28 then
3 2323 <**> skriv_opret_ekstfil(out,0);
3 2324 <*-2*>
3 2325 trin1:
3 2326 waitch(cs_opret_eksternfil,op,true,-1);
3 2327
3 2327 trin2:
3 2328 wait(bs_kate_fri);
3 2329
3 2329 trin3:
3 2330 <*opret temporær fil og tilknyt den*>
3 2331 disable begin
4 2332
4 2332 enavn:= 8;
4 2333 <*opret*>
4 2334 open(zdummy,0,d.op.data.enavn,0);
4 2335 tail(1):= d.op.data(3); <*segant*>
4 2336 tail(2):= 1;
4 2337 tail(6):= systime(7,0,r); <*shortclock*>
4 2338 tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
4 2339 tail(8):= 0;
4 2340 tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
4 2341 tail(10):= d.op.data(1); <*postantal*>
4 2342 s:= monitor(40)create entry:(zdummy,0,tail);
4 2343 if s<>0 then
4 2344 begin
5 2345 if s=4 <*claims exeeded*> then
5 2346 begin
6 2347 status:= 4;
6 2348 fejlreaktion(1,s,<:create entry:>,1);
6 2349 goto returner;
6 2350 end;
5 2351 if s=3 <*navn ikke unikt*> then
5 2352 begin status:= 6; goto returner; end;
5 2353 fejlreaktion(1,s,<:create entry:>,0);
5 2354 end;
4 2355 \f
4 2355 message opreteksternfil side 2 - 810203/cl;
4 2356
4 2356 p_nøgle:= d.op.opkode shift (-12);
4 2357 s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
4 2358 if s<>0 then
4 2359 begin
5 2360 if s=6 then
5 2361 begin <*claims exeeded*>
6 2362 status:= 4;
6 2363 fejlreaktion(1,s,<:permanent entry:>,1);
6 2364 monitor(48)remove entry:(zdummy,0,tail);
6 2365 goto returner;
6 2366 end
5 2367 else fejlreaktion(1,s,<:permanent entry:>,0);
5 2368 end;
4 2369
4 2369 <*reserver*>
4 2370 s:= monitor(52)create areaprocess:(zdummy,0,zd);
4 2371 if s<>0 then
4 2372 begin
5 2373 fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
5 2374 status:= 4;
5 2375 monitor(48)remove entry:(zdummy,0,zd);
5 2376 goto returner;
5 2377 end;
4 2378
4 2378 s:= monitor(8)reserve:(zdummy,0,zd);
4 2379 if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
4 2380
4 2380 <*tilknyt*>
4 2381 dbantef:= dbantef +1;
4 2382 fno:= dbkatefri;
4 2383 dbkatefri:= dbkate(fno,2);
4 2384 dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
4 2385 dbkate(fno,2):= tail(1);
4 2386 getzone6(zdummy,zd);
4 2387 for i:= 2 step 1 until 5 do
4 2388 dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
4 2389 d.op.data(3):= tail(1);
4 2390 d.op.data(4):= 3 shift 10 +fno;
4 2391 status:= 0;
4 2392 \f
4 2392 message opreteksternfil side 3 - 810526/cl;
4 2393
4 2393 returner:
4 2394
4 2394 close(zdummy,false);
4 2395 d.op.data(9):= status;
4 2396
4 2396 <*+2*>
4 2397 <*tz*> if testbit24 and overvåget then <*zt*>
4 2398 <*tz*> begin <*zt*>
5 2399 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 2400 <*tz*> pfdim(d.op.data); <*zt*>
5 2401 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2402 <*tz*> end; <*zt*>
4 2403 <*-2*>
4 2404
4 2404 signalch(d.op.retur,op,d.op.optype);
4 2405 if dbantef<dbmaxef then signalbin(bs_kate_fri);
4 2406 end;
3 2407 goto trin1;
3 2408
3 2408 opretekst_trap:
3 2409 disable skriv_opret_ekstfil(zbillede,1);
3 2410
3 2410 end opreteksternfil;
2 2411
2 2411 \f
2 2411 message attention_erklæringer side 1 - 850820/cl;
2 2412
2 2412 integer
2 2413 tf_kommandotabel,
2 2414 cs_att_pulje,
2 2415 bs_fortsæt_adgang,
2 2416 att_proc_ref;
2 2417
2 2417 integer array
2 2418 att_flag,
2 2419 att_signal(1:att_maske_lgd//2);
2 2420
2 2420 integer array
2 2421 terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
2 2422 max_antal_operatører+max_antal_garageterminaler)),
2 2423 fortsæt(1:32);
2 2424 \f
2 2424 message procedure afslut_kommando side 1 - 810507/hko;
2 2425
2 2425 procedure afslut_kommando(op_ref);
2 2426 integer array field op_ref;
2 2427 begin integer nr,i,sem;
3 2428 i:= d.op_ref.kilde;
3 2429 nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
3 2430 else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
3 2431 sætbit_ia(att_flag,nr,0);
3 2432 d.op_ref.optype:=gen_optype;
3 2433 <* "husket" attention disabled ****************
3 2434 if sætbit_ia(att_signal,nr,0)=1 then
3 2435 begin
3 2436 sem:=if i=299 then cs_talevejsswitch else
3 2437 case i//100 of (cs_io_komm,cs_operatør(i mod 100),
3 2438 cs_garage(i mod 100));
3 2439 afslut_operation(op_ref,0);
3 2440 start_operation(op_ref,i,cs_att_pulje,0);
3 2441 signal_ch(sem,op_ref,gen_optype);
3 2442 end
3 2443 else
3 2444 ********************* disable "husket" attention *>
3 2445 afslut_operation(op_ref,cs_att_pulje);
3 2446 end;
2 2447 \f
2 2447 message procedure læs_store side 1 - 880919/cl;
2 2448
2 2448 integer procedure læs_store(z,c);
2 2449 zone z;
2 2450 integer c;
2 2451 begin
3 2452 læs_store:= readchar(z,c);
3 2453 if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
3 2454 end;
2 2455 \f
2 2455 message procedure param side 1 - 810226/cl;
2 2456
2 2456
2 2456
2 2456 integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
2 2457 value tabel_id;
2 2458 integer pos, tabel_id, type, sep;
2 2459 integer array txt, spec, værdi;
2 2460
2 2460
2 2460
2 2460 <*************************************>
2 2461 <* *>
2 2462 <* CLAUS LARSEN: 15.07.77 *>
2 2463 <* *>
2 2464 <*************************************>
2 2465
2 2465
2 2465
2 2465
2 2465 <* param syntax-analyserer en parameterliste, og *>
2 2466 <* bestemmer næste parameter og den separator der *>
2 2467 <* afslutter parameteren *>
2 2468
2 2468
2 2468
2 2468 begin
3 2469 integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
3 2470 real array indgang(1:2);
3 2471 integer i, j, tegn, tegn_pos, tal, hashnøgle,
3 2472 zone_nr, top, max_segm, start_segm, lpos;
3 2473 boolean minus, separator;
3 2474 lpos := pos;
3 2475 type:=-1;
3 2476 for i:=1 step 1 until 4 do værdi(i):=0;
3 2477 \f
3 2477 message procedure param side 2 - 810428/cl,hko;
3 2478
3 2478
3 2478
3 2478 <* grænsecheck for pos *>
3 2479 begin
4 2480 integer nedre, øvre;
4 2481
4 2481 nedre := system(3,øvre,txt);
4 2482 nedre := nedre * 3 - 2;
4 2483 øvre := øvre * 3;
4 2484 if lpos < (nedre - 1) or øvre < lpos then
4 2485 begin
5 2486 sep:= -1;
5 2487 param:= 5;
5 2488 goto slut;
5 2489 end;
4 2490
4 2490 <* er parameterlisten slut *>
4 2491 lpos:= lpos+1;
4 2492 læs_tegn(txt,lpos,tegn);
4 2493 if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
4 2494 begin
5 2495 lpos := lpos - 2;
5 2496 sep := tegn;
5 2497 param := 5;
5 2498
5 2498 goto slut;
5 2499 end else lpos:= lpos-1;
4 2500 end;
3 2501 \f
3 2501 message procedure param side 3 - 810428/cl;
3 2502
3 2502
3 2502 <* initialisering *>
3 2503 for i := 1 step 1 until 4 do
3 2504 aktuel_param(i) := 0;
3 2505 minus := separator := false;
3 2506
3 2506 <* initialiser klassetabel *>
3 2507 for i := 65 step 1 until 93,
3 2508 97 step 1 until 125 do klasse(i) := 1;
3 2509 for i := 48 step 1 until 57 do klasse(i) := 2;
3 2510 for i := 0 step 1 until 47, 58 step 1 until 64,
3 2511 94, 95, 96, 126, 127 do klasse(i) := 4;
3 2512
3 2512
3 2512 <* sæt specialtegn *>
3 2513 i := 1;
3 2514 læs_tegn(spec,i,tegn);
3 2515 while tegn <> 0 do
3 2516 begin
4 2517 if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
4 2518 klasse(tegn) := 3;
4 2519 læs_tegn(spec,i,tegn);
4 2520 end;
3 2521 \f
3 2521 message procedure param side 4 - 810226/cl;
3 2522
3 2522
3 2522 <* læs første tegn i ny parameter og bestem typen *>
3 2523 læs_tegn(txt,lpos,tegn);
3 2524
3 2524 case klasse(tegn) of
3 2525 begin
4 2526
4 2526 <* case 1 - bogstav *>
4 2527 begin
5 2528 type := 0;
5 2529 param := 0;
5 2530 tegn_pos := 1;
5 2531 hashnøgle := 0;
5 2532
5 2532 <* læs parameter *>
5 2533 while tegn_pos < 12 and klasse(tegn) <> 4 do
5 2534 begin
6 2535 hashnøgle := hashnøgle + tegn;
6 2536 skriv_tegn(aktuel_param,tegn_pos,tegn);
6 2537 læs_tegn(txt,lpos,tegn);
6 2538 end;
5 2539
5 2539 <* find separator *>
5 2540 while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
5 2541 sep := tegn;
5 2542 \f
5 2542 message procedure param side 5 - 810226/cl;
5 2543
5 2543 <* tabelopslag *>
5 2544 if tabel_id <> 0 then
5 2545 begin
6 2546 <* hent max_segm *>
6 2547
6 2547 fdim(4) := tabel_id;
6 2548 j := hent_fil_dim(fdim);
6 2549 if j > 0 then
6 2550 begin
7 2551 param := 4;
7 2552 for i := 1 step 1 until 4 do
7 2553 værdi(i) := aktuel_param(i);
7 2554 goto slut;
7 2555 end;
6 2556 max_segm := fdim(3);
6 2557
6 2557 <* forbered opslag *>
6 2558 start_segm := (hashnøgle mod max_segm) + 1;
6 2559 indgang(1) := 0.0 shift 48 add aktuel_param(1)
6 2560 shift 24 add aktuel_param(2);
6 2561 indgang(2) := 0.0 shift 48 add aktuel_param(3)
6 2562 shift 24 add aktuel_param(4);
6 2563 hashnøgle := start_segm;
6 2564 \f
6 2564 message procedure param side 6 - 810226/cl;
6 2565
6 2565 <* søg navn *>
6 2566 repeat
6 2567 <* læs segment *>
6 2568 læs_fil(tabel_id,hashnøgle,zone_nr);
6 2569
6 2569 <* beregn sidste element *>
6 2570 top := fil(zone_nr,1) extract 24;
6 2571 top := (top - 1) * 4 + 2;
6 2572
6 2572 <* søg *>
6 2573 for i := 2 step 4 until top do
6 2574 if fil(zone_nr,i) = indgang(1) and
6 2575 fil(zone_nr,i+1) = indgang(2) then
6 2576 begin
7 2577 <* fundet *>
7 2578 værdi(1) := fil(zone_nr,i+2) shift (-24)
7 2579 extract 24;
7 2580 værdi(2) := fil(zone_nr,i+2) extract 24;
7 2581 værdi(3) := fil(zone_nr,i+3) shift (-24)
7 2582 extract 24;
7 2583 værdi(4) := fil(zone_nr,i+3) extract 24;
7 2584 goto fundet;
7 2585 end;
6 2586
6 2586 if top = 122 then <*overløb *>
6 2587 hashnøgle := (hashnøgle mod max_segm) + 1;
6 2588 until top < 122 or hashnøgle = start_segm;
6 2589
6 2589 <* navn findes ikke *>
6 2590 param := 2;
6 2591 for j := 1 step 1 until 4 do
6 2592 værdi(j) := aktuel_param(j);
6 2593 fundet: ;
6 2594 end <*tabel_id <> 0 *>
5 2595 else
5 2596 for i := 1 step 1 until 4 do
5 2597 værdi(i) := aktuel_param(i);
5 2598 end <* case 1 *>;
4 2599 \f
4 2599 message procedure param side 7 - 810310/cl,hko;
4 2600
4 2600 <* case 2 - ciffer *>
4 2601 cif: begin
5 2602 type:=tal := 0;
5 2603 while klasse(tegn) = 2 do
5 2604 begin
6 2605 type:=type+1;
6 2606 tal := tal * 10 + (tegn - 48);
6 2607 læs_tegn(txt,lpos,tegn);
6 2608 end;
5 2609 if minus then tal := -tal;
5 2610 værdi(1) := tal;
5 2611 sep := tegn;
5 2612 param := 0;
5 2613 end <* case 2 *>;
4 2614 \f
4 2614 message procedure param side 8 - 810428/cl;
4 2615
4 2615 <* case 3 - specialtegn *>
4 2616 spc: begin
5 2617 if tegn = '-' then
5 2618 begin
6 2619 læs_tegn(txt,lpos,tegn);
6 2620 if klasse(tegn) = 2 then
6 2621 begin
7 2622 minus := true;
7 2623 goto cif;
7 2624 end
6 2625 else
6 2626 begin
7 2627 tegn := '-';
7 2628 lpos := lpos - 1;
7 2629 end;
6 2630 end;
5 2631 <* syntaxfejl *>
5 2632 param := if separator then 1 else 3;
5 2633 sep := tegn;
5 2634 end <* case 3 *>;
4 2635
4 2635 <* case 4 - separator *>
4 2636 begin
5 2637 separator := true;
5 2638 goto spc;
5 2639 end <* case 4 *>;
4 2640
4 2640 end <* case *>;
3 2641
3 2641 lpos := lpos - 1;
3 2642 slut:
3 2643 pos := lpos;
3 2644 end;
2 2645 \f
2 2645 message procedure læs_param_sæt side 1 - 830310/cl;
2 2646
2 2646 integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
2 2647 integer array tekst, parm;
2 2648 integer pos,ant, term,res;
2 2649
2 2649 <* proceduren læser et sammenhørende sæt parametre
2 2650 afsluttet med (sp),(nl),(;),(,) eller (nul)
2 2651
2 2651 læs_param_sæt returstatus eller 'typen' af det læste parametersæt
2 2652 (retur,int)
2 2653 type ant parm indeholder:
2 2654 <0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
2 2655 0: 0 (ingenting) 'rest kommando er tom'
2 2656 1: 1 (tekst) 'indtil 11 tegn'
2 2657 2: 1 (pos.tal)
2 2658 3: 1 (neg.tal)
2 2659 4: 1 (pos.tal<1000)(bogstav) 'linienummer'
2 2660 5: 1 G(pos.tal<100) 'gruppe_ident'
2 2661 6: 2 (linie)/(løb) 'vogn_ident'
2 2662 7: 3 (bus)/(linie)/(løb)
2 2663 8: 3 (linie).(indeks):(løb)
2 2664 9: 2 (linie).(indeks)
2 2665 10: 2 (pos.tal).(pos.tal)
2 2666 11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
2 2667 12: 3 D.(dato).(tid)
2 2668
2 2668 tekst indeholder teksten hvori parametersættet
2 2669 (kald,int.arr.) skal søges.
2 2670
2 2670 pos
2 2671 (kald/retur,int.) position efter hvilken søgningen starter, og
2 2672 ved retur positionen for afsluttende tegn.
2 2673 (ikke ændret ved fejl)
2 2674
2 2674 ant hvis kaldeværdien er >0 skal parametersættet
2 2675 (kald/retur,int) indeholde det angivne antal enkeltparametre,
2 2676 i modsat fald returneres med fejltype -26
2 2677 (skilletegn) eller -25 (parameter mangler).
2 2678 ellers læses op til 3 enkeltparametre. retur-
2 2679 værdien afhænger af det læste parametersæts
2 2680 type, se ovenfor under læs_param_sæt.
2 2681 \f
2 2681 message procedure læs_param_sæt side 2 - 810428/hko;
2 2682
2 2682 parm skal omfatte elementerne 1 til 4.
2 2683 (retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
2 2684 terne værdien 0.
2 2685
2 2685 type (element,indhold)
2 2686 1: 1-4,teksten
2 2687 2-3: 1, talværdien
2 2688 4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
2 2689 5: 1, talværdi (uden G)
2 2690 6: 1, (som'4') shift 7 + løb
2 2691 7: 1, bus
2 2692 2, linie/løb som '6'
2 2693 8: 1, tal shift 5 eller som '4'
2 2694 2, tekst (1-3 bogstaver)
2 2695 3, løb
2 2696 9: 1 og 2, som '8'
2 2697 10: 1, talværdi
2 2698 2, talværdi
2 2699 11: 1, som '5'
2 2700 2, vogn (bus eller linie/løb)
2 2701 12: 1, dato
2 2702 2, tid
2 2703
2 2703 term iso-tegnværdien for tegnet der afslutter
2 2704 (retur,int) parameter_sættet.
2 2705
2 2705 res som læs_param_sæt.
2 2706 (retur,int)
2 2707
2 2707 *>
2 2708 \f
2 2708 message procedure læs_param_sæt side 3 - 810310/hko;
2 2709
2 2709 begin
3 2710 integer max_ant;
3 2711
3 2711 max_ant:= 3;
3 2712
3 2712 begin
4 2713 integer
4 2714 i,j,k, <* hjælpe variable *>
4 2715 nr, <* nummer på parameter i sættet *>
4 2716 apos, <* aktuel tegnposition *>
4 2717 cifre, <* parametertype (param: 0=tekst, >1=tal) *>
4 2718 sep; <* afsluttende skilletegn ved param *>
4 2719
4 2719 integer array field
4 2720 iaf; <* hjælpe variabel *>
4 2721
4 2721 integer array
4 2722 par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
4 2723 s, <* 1 element med separator for hver parameter *>
4 2724 t(1:max_ant), <* 1 element med typen for hver parameter *>
4 2725 værdi(1:4), <* værdi af aktuel parameter jvf. param *>
4 2726 spec(1:1); <* specialtegn i navne jvf. param *>
4 2727
4 2727 <* de interne typer af enkeltparametre er
4 2728
4 2728 type parameter
4 2729
4 2729 1: 1-3 tegn tekst (1 ord)
4 2730 2: 4-6 tegn (2 ord)
4 2731 3: 7-9 tegn (3 ord)
4 2732 4:10-11 tegn (4 ord)
4 2733 5: positivt heltal
4 2734 6: negativt heltal
4 2735 7: positivt heltal<1000 efterfulgt af stort bogstav
4 2736 8: G efterfulgt af positivt heltal<100
4 2737
4 2737 *>
4 2738 \f
4 2738 message procedure læs_param_sæt side 4 - 810408/hko;
4 2739
4 2739 nr:= 0;
4 2740 res:= -1;
4 2741 spec(1):= 0; <* ingen specialtegn *>
4 2742 apos:= pos;
4 2743 for i:= 1 step 1 until 4 do parm(i):= 0;
4 2744 for i:= 1 step 1 until max_ant do
4 2745 begin
5 2746 s(i):= t(i):= 0;
5 2747 for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
5 2748 end;
4 2749 repeat
4 2750 <* skip foranstillede sp-tegn *>
4 2751 for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
4 2752 while i=1 and sep='sp' do;
4 2753 <*+2*>
4 2754 begin
5 2755 if testbit25 and testbit26 then
5 2756 disable begin
6 2757 write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
6 2758 i,apos,cifre,sep);
6 2759 laf:=0;
6 2760 if cifre<>0 then
6 2761 write(out,<: værdi(1-4)::>,
6 2762 << -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
6 2763 else write(out,<: værdi::>,værdi.laf);
6 2764 ud;
6 2765 end;
5 2766 end;
4 2767 <*-2*>
4 2768 ;
4 2769 if i<>0 then <* ikke ok *>
4 2770 begin
5 2771 if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
5 2772 begin
6 2773 apos:= apos -1;
6 2774 res:= 0;
6 2775 end
5 2776 else if i=1 then res:=-26 <* skilletegn *>
5 2777 else <* i=5 *> res:= -25 <* parameter mangler *>
5 2778 end
4 2779 else <* i=0 *>
4 2780 begin
5 2781 if sep=',' or sep=';' then apos:=apos-1;
5 2782 iaf:= nr*8;
5 2783 nr:= nr +1;
5 2784 \f
5 2784 message procedure læs_param_sæt side 5 - 810520/hko/cl;
5 2785
5 2785 if cifre=0 <* navne_parameter *> then
5 2786 begin
6 2787 if værdi(2)=0
6 2788 and læstegn(værdi,1,i)='G'
6 2789 and læstegn(værdi,2,j)>'0' and j<='9'
6 2790 and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
6 2791 then
6 2792 begin <* gruppenavn, repræsenteres som tal *>
7 2793 t(nr):= 8;
7 2794 j:= j -'0';
7 2795 par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
7 2796 s(nr):= sep;
7 2797 end
6 2798 else
6 2799 begin <* generel tekst *>
7 2800 i:= 0;
7 2801 for i:= i +1 while i<=4 do
7 2802 begin
8 2803 if værdi(i)<>0 then
8 2804 begin
9 2805 t(nr):= i;
9 2806 par.iaf(i):= værdi(i);
9 2807 end
8 2808 else i:= 4;
8 2809 end;
7 2810 s(nr):= sep;
7 2811 end <* generel tekst *>
6 2812 end <* navne_parameter *>
5 2813 else
5 2814 begin <* talparameter *>
6 2815 i:= if værdi(1)<0 then 6 <* neg.tal *>
6 2816 else if værdi(1)>0 and værdi(1)<1000
6 2817 and sep>='A' and sep<='Å' then 7
6 2818 else 5 <* positivt tal *>;
6 2819 t(nr):= i;
6 2820 par.iaf(1):= if i<>7 then værdi(1)
6 2821 else værdi(1) shift 5 +(sep+1-'A');
6 2822 par.iaf(2):= cifre;
6 2823 apos:= apos+1;
6 2824 s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
6 2825 apos:= apos-1;
6 2826 end;
5 2827 end;<* i=0 *>
4 2828 until (ant>0 and nr=ant)
4 2829 or nr=max_ant
4 2830 or res<> -1
4 2831 or sep='sp' or sep=';' or sep='em'
4 2832 or sep=',' or sep='nl' or sep='nul';
4 2833 \f
4 2833 message procedure læs_param_sæt side 6 - 810508/hko;
4 2834
4 2834 if ant>nr then res:= -25 <*parameter mangler*>
4 2835 else
4 2836 if nr=0 or t(1)=0 then
4 2837 begin <* ingen parameter før skilletegn *>
5 2838 if res=-25 then res:= 0;
5 2839 end
4 2840 else if sep<>'sp' and sep<>'nl' and sep <> 'em'
4 2841 and sep<>';' and sep<>',' then
4 2842 begin <* ulovligt afsluttende skilletegn *>
5 2843 res:= -26;
5 2844 end
4 2845 else
4 2846 begin <* en eller flere lovligt afsluttede parametre *>
5 2847 if t(1)<5 and nr=1 then
5 2848
5 2848 <* 1 navne_parameter *>
5 2849
5 2849 begin
6 2850 res:= 1;
6 2851 tofrom(parm,par,8);
6 2852 end
5 2853 else if <*t(1)<9 and *> nr=1 then
5 2854
5 2854 <* 1 parameter af anden type *>
5 2855
5 2855 begin <*tal,linie eller gruppe *>
6 2856 res:= t(1) -3;
6 2857 parm(1):= par(1);
6 2858 end
5 2859 else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
5 2860
5 2860 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
5 2861
5 2861 begin
6 2862 i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
6 2863 j:= par(5); <* internt *>
6 2864 k:= par(9); <* *>
6 2865 if nr=2 then
6 2866 <* 2 parametre i sættet *>
6 2867 begin
7 2868 res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
7 2869 else if s(1)='.' and t(2)=1 then 9
7 2870 else if s(1)='-' and t(1)=5 and t(2)=5 then 10
7 2871 else if s(1)<>'/' and s(1)<>'.'
7 2872 and s(1)<>'-' then -26 <* skilletegn *>
7 2873 else -27;<* parametertype*>
7 2874 \f
7 2874 message procedure læs_param_sæt side 7 - 810501/hko;
7 2875
7 2875 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2876
7 2876 <* 2 parametre i sættet *>
7 2877 if res=6 then
7 2878 begin
8 2879 if (i<1 or i>999) and t(1)=5 then
8 2880 res:= -5 <* ulovligt linienr *>
8 2881 else if (j<1 or j>99) then
8 2882 res:= -6 <* ulovligt løbsnr *>
8 2883 else
8 2884 begin
9 2885 if t(1)=5 then i:= i shift 5;
9 2886 parm(1):= i shift 7 +j;
9 2887 end;
8 2888 end <* res=6 *>
7 2889 else if res=9 then
7 2890 begin
8 2891 if t(1)=5 and (i<1 or 999<i) then
8 2892 res:= -5 <*ulovligt linienr*>
8 2893 else
8 2894 begin
9 2895 if t(1)=5 then i:=i shift 5;
9 2896 parm(1):= i;
9 2897 parm(2):= j;
9 2898 end;
8 2899 end <* res=9 *>
7 2900 else if res=10 then
7 2901 begin
8 2902 begin
9 2903 parm(1):= i;
9 2904 parm(2):= j;
9 2905 end;
8 2906 end; <* res=10 *>
7 2907 end <* nr=2 *>
6 2908 else
6 2909 if nr=3 then
6 2910 <* 3 paramtre i sættet *>
6 2911 begin
7 2912 res:= if (s(1)='/' or s(1)='.') and
7 2913 (s(2)='/' or s(2)='.') then 7
7 2914 else if s(1)='.' and s(2)=':' then 8
7 2915 else -26; <* skilletegn *>
7 2916 \f
7 2916 message procedure læs_param_sæt side 8 - 810501/hko;
7 2917
7 2917 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2918 <* 3 parametre i sættet *>
7 2919 if res=7 then
7 2920 begin
8 2921 if t(1)<>5 or (t(2)<>5 and t(2)<>7)
8 2922 or t(3)<>5 then
8 2923 res:= -27 <* parametertype *>
8 2924 else
8 2925 if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
8 2926 else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
8 2927 else if k<1 or k>99 then res:= -6 <* løb *>
8 2928 else
8 2929 begin <* ok *>
9 2930 parm(1):= i;
9 2931 if t(2)=5 then j:= j shift 5;
9 2932 parm(2):= j shift 7 +k;
9 2933 end;
8 2934 end
7 2935 else if res=8 then
7 2936 begin
8 2937 if t(2)<>1 or t(3)<>5 then res:= -27
8 2938 else if t(1)=5 and (i<1 or i>999) then res:= -5
8 2939 else if k<1 or k>99 then res:= -6
8 2940 else
8 2941 begin
9 2942 if t(1)=5 then i:= i shift 5;
9 2943 parm(1):= i;
9 2944 parm(2):= j;
9 2945 parm(3):= k;
9 2946 end;
8 2947 end;
7 2948 end <* nr=3 *>
6 2949 else res:=-24; <* syntaks *>
6 2950 \f
6 2950 message procedure læs_param_sæt side 9 - 810428/hko;
6 2951
6 2951 end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
5 2952 else if t(1)=8 <* gruppe_id *> then
5 2953 begin
6 2954 <* mere end 1 parameter , hvoraf den første
6 2955 er en gruppe_identifikation ved navn.
6 2956 lovlige parametre er alle internt repræsenteret i et ord *>
6 2957
6 2957 i:=par(1);
6 2958 j:=par(5);
6 2959 k:=par(9);
6 2960
6 2960 if nr=2 then
6 2961 <* 2 parametre *>
6 2962 begin
7 2963 res:=if s(1)=':' and t(2)=5 then 11
7 2964 else if s(1)<>':' then -26 <* skilletegn *>
7 2965 else -27; <*param.type *>
7 2966 if res=11 then
7 2967 begin
8 2968 if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
8 2969 else
8 2970 begin
9 2971 parm(1):=i;
9 2972 parm(2):=j;
9 2973 end;
8 2974 end;
7 2975 \f
7 2975 message procedure læs_param_sæt side 10 - 810428/hko;
7 2976
7 2976 <* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
7 2977
7 2977 end <*nr=2*>
6 2978 else if nr=3 then
6 2979 <* 3 parametre *>
6 2980 begin
7 2981 res:=if s(1)=':' and s(2)='/' then 11
7 2982 else -26; <* skilletegn *>
7 2983 if res=11 then
7 2984 begin
8 2985 if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
8 2986 else
8 2987 begin
9 2988 if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
9 2989 else
9 2990 begin
10 2991 parm(1):=i;
10 2992 if t(2)=5 then j:=j shift 5;
10 2993 parm(2):= 1 shift 22 +j shift 7 +k;
10 2994 end;
9 2995 end;
8 2996 end;
7 2997 end <* nr=3 *>
6 2998 else res:=-24; <* syntaks *>
6 2999 \f
6 2999 message procedure læs_param_sæt side 11 - 810501/hko;
6 3000
6 3000 end <* t(1)=8 *>
5 3001 else if t(1)=1 and par(1)= 'D' shift 16 then
5 3002 begin
6 3003 <* mere end 1 parameter i sættet og 1. parameter er et 'D'.
6 3004 lovlige parametre er alle internt repræsenteret i et ord. *>
6 3005 i:=par(1);
6 3006 j:=par(5);
6 3007 k:=par(9);
6 3008
6 3008 if nr=3 then
6 3009 begin
7 3010 res:=if s(1)='.' and s(2)='.' then 12
7 3011 else -26; <* skilletegn *>
7 3012 if res=12 then
7 3013 begin
8 3014 if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
8 3015 else
8 3016 begin
9 3017 integer år,md,dg,tt,mm,ss;
9 3018 real dato,tid;
9 3019 år:=j//10000;
9 3020 md:=(j//100) mod 100;
9 3021 dg:=j mod 100;
9 3022 cifre:= par(10);
9 3023 tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
9 3024 else k;
9 3025 mm:=if cifre>4 then (k//100) mod 100
9 3026 else if cifre>2 then k mod 100 else 0;
9 3027 ss:=if cifre>4 then k mod 100 else 0;
9 3028 \f
9 3028 message procedure læs_param_sæt side 12 - 810501/hko;
9 3029
9 3029 dato:=systime(5,0.0,tid);
9 3030 if j=0 then dg:=round dato mod 100;
9 3031 if år=0 and md=0 then md:=(round dato//100) mod 100;
9 3032 if år=0 then år:=round dato//10000;
9 3033 if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
9 3034 res:=-24 <* syntaks *>
9 3035 else if dg<1 or dg > (case md of (
9 3036 31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
9 3037 31,31,30, 31,30,31)) then res:=-24
9 3038 else
9 3039 begin
10 3040 parm(1):=år*10000+md*100+dg;
10 3041 parm(2):=tt*10000+mm*100+ss;
10 3042 end;
9 3043 end;
8 3044
8 3044 end; <* res=12 *>
7 3045 end <* nr=3 *>
6 3046 else res:=-24; <*syntaks*>
6 3047 end <* t(1)=1 and par(1)='D' shift 16 *>
5 3048
5 3048 else res:=-27;<*parametertype*>
5 3049 end; <* en eller flere parametre *>
4 3050
4 3050 læs_param_sæt:= res;
4 3051 term:= sep;
4 3052 if res>= 0 then pos:= apos;
4 3053 end;
3 3054 end læs_param_sæt;
2 3055 \f
2 3055 message procedure læs_kommando side 1 - 810428/hko;
2 3056
2 3056 integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
2 3057 value kilde;
2 3058 zone z;
2 3059 integer kilde, pos,indeks,sep,slut_tegn;
2 3060 integer array field op_ref;
2 3061
2 3061 <* proceduren indlæser er kommmando fra en terminal (telex,
2 3062 skærm eller skrivemaskine). ved indlæsning fra skærm eller
2 3063 skrivemaskine inviteres først ved udskrivning af '>'-tegn.
2 3064 for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
2 3065 23'ende linie inden invitation.
2 3066 *>
2 3067 \f
2 3067 message procedure læs_kommando side 2 - 810428/hko;
2 3068
2 3068 begin
3 3069 integer
3 3070 a_pos,
3 3071 a_res,res,
3 3072 i,j,k;
3 3073 boolean
3 3074 skip;
3 3075
3 3075 <*V*>setposition(z,0,0);
3 3076
3 3076 case kilde//100 of
3 3077 begin
4 3078 begin <* io *>
5 3079 write(z,"nl",1,">",1);
5 3080 end;
4 3081
4 3081 begin <* operatør *>
5 3082 cursor(z,24,1);
5 3083 write(z,"esc" add 128,1,<:ÆK:>);
5 3084 cursor(z,23,1);
5 3085 write(z,"esc" add 128,1,<:ÆK:>);
5 3086 outchar(z,'>');
5 3087 end;
4 3088
4 3088 begin <* garageterminal *> ;
5 3089 outchar(z,'nl');
5 3090 end
4 3091 end;
3 3092
3 3092 <*V*>setposition(z,0,0);
3 3093 \f
3 3093 message procedure læs_kommando side 3 - 810921/hko,cl;
3 3094
3 3094 res:=0;
3 3095 skip:= false;
3 3096 <*V*>
3 3097 k:=læs_store(z,i);
3 3098
3 3098 apos:= 1;
3 3099 while k<=6 <*klasse=bogstav*> do
3 3100 begin
4 3101 if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
4 3102 <*V*> k:= læs_store(z,i);
4 3103 end;
3 3104
3 3104 skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
3 3105
3 3105 if i=',' and a_pos>1 then
3 3106 begin
4 3107 skrivtegn(d.op_ref.data,a_pos,i);
4 3108 repeat
4 3109 <*V*> k:= læs_store(z,i);
4 3110 if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
4 3111 until k>=7;
4 3112 end;
3 3113
3 3113 pos:=a_pos;
3 3114 while k<8 do
3 3115 begin
4 3116 if a_pos< (att_op_længde//2*3-2) then
4 3117 skriv_tegn(d.op_ref.data,a_pos,i);
4 3118 skip:= skip or i='?';
4 3119 <*V*> k:= læs_store(z,i);
4 3120 pos:=pos+1;
4 3121 end;
3 3122
3 3122 skip:= skip or i='?' or i='esc';
3 3123 slut_tegn:= i;
3 3124 skrivtegn(d.op_ref.data,apos,'em');
3 3125 afslut_text(d.op_ref.data,apos);
3 3126 \f
3 3126 message procedure læs_kommando side 4 - 820301/hko/cl;
3 3127
3 3127 disable
3 3128 begin
4 3129 integer
4 3130 i1,
4 3131 nr,
4 3132 partype,
4 3133 cifre;
4 3134 integer array
4 3135 spec(1:1),
4 3136 værdi(1:4);
4 3137
4 3137 <*+2*>
4 3138 if testbit25 and overvåget then
4 3139 disable begin
5 3140 real array field raf;
5 3141 write(out,"nl",1,<:kommando læst::>);
5 3142 laf:=data;
5 3143 write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
5 3144 <: skip=:>,if skip then <:true:> else <:false:>);
5 3145 ud;
5 3146 end;
4 3147 <*-2*>
4 3148
4 3148 for i:=1 step 1 until 32 do ia(i):=0;
4 3149
4 3149 if skip then
4 3150 begin
5 3151 res:=53; <*annulleret*>
5 3152 pos:= -1;
5 3153 goto slut_læskommando;
5 3154 end;
4 3155 \f
4 3155 message procedure læs_kommando side 5 - 850820/cl;
4 3156
4 3156 i:= kilde//100; <* hovedmodul *>
4 3157 k:= kilde mod 100; <* løbenr *>
4 3158 <* if pos>79 then linieoverløb; *>
4 3159 pos:=a_pos:=0;
4 3160 spec(1):= ',' shift 16;
4 3161
4 3161 <*+4*>
4 3162 if k<1 or k>(case i of (1,max_antal_operatører,
4 3163 max_antal_garageterminaler)) then
4 3164 begin
5 3165 fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
5 3166 res:=31;
5 3167 end
4 3168 else
4 3169 <*-4*>
4 3170 if i>0 and i<4 then <* io, operatør eller garageterminal *>
4 3171 begin
5 3172 <* læs operationskode *>
5 3173 j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
5 3174
5 3174 res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
5 3175 else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
5 3176 else if j=2 then 4 <*ukendt kommando*>
5 3177 else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
5 3178 else if sep<>'sp' and sep<>','
5 3179 and sep<>'nl' and sep<>';'
5 3180 and sep<>'nul' and sep<>'em' then 26
5 3181 <*skilletegn*>
5 3182 else if -, læsbit_i(værdi(4),i-1) then 4
5 3183 <* logand(extend 0 add værdi(4)
5 3184 extend 1 shift (case i of (0,k,8+k)))=0 then 4
5 3185 *> <*ukendt kommando*>
5 3186 else 1;
5 3187 \f
5 3187 message procedure læs_kommando side 5a- 810409/hko;
5 3188
5 3188 <*+2*>if testbit25 and overvåget then
5 3189 begin
6 3190 write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
6 3191 << -dddd>,j,apos,cifre,sep,res,
6 3192 <: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
6 3193 "nl",0);
6 3194 if j<>0 then skriv_op(out,op_ref);
6 3195 ud;
6 3196 end;
5 3197 <*-2*>
5 3198
5 3198 if res=31 then fejlreaktion(18<*tabelfil*>,j,
5 3199 <:=res, filnr 1025, læskommando:>,0);
5 3200
5 3200 if res=1 then <* operationskode ok *>
5 3201 begin
6 3202 if sep<>'sp' then apos:=apos-1;
6 3203 d.op_ref.opkode:=værdi(1);
6 3204 indeks:=værdi(2);
6 3205 partype:= værdi(3);
6 3206 nr:= 0;
6 3207 pos:= apos;
6 3208 \f
6 3208 message procedure læs_kommando side 6 - 810409/hko;
6 3209
6 3209 while res=1 do
6 3210 begin
7 3211 læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
7 3212 værdi,sep,a_res);
7 3213 nr:= nr +1;
7 3214 i1:= værdi(1);
7 3215 <*+2*> if testbit25 and overvåget then
7 3216 begin
8 3217 write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
8 3218 apos,sep,ares,<: værdi(1-4)::>,
8 3219 værdi(1),værdi(2),værdi(3),værdi(4),
8 3220 "nl",0);
8 3221 ud;
8 3222 end;
7 3223 <*-2*>
7 3224 case par_type of
7 3225 begin
8 3226
8 3226 <*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
8 3227
8 3227 begin
9 3228 if nr=1 then
9 3229 begin
10 3230 if a_res=0 then res:=2 <*godkendt*>
10 3231 else if a_res=2 and (i1<1 or i1>9999)
10 3232 then res:=7 <*busnr ulovligt*>
10 3233 else if a_res=2 or a_res=6 then
10 3234 begin
11 3235 ia(1):= if a_res=2 then i1
11 3236 else 1 shift 22 +i1;
11 3237 end
10 3238 else res:= 27; <*parametertype*>
10 3239 if res<4 then pos:= apos;
10 3240 end <*nr=1*>
9 3241 else
9 3242 if nr=2 then
9 3243 begin
10 3244 if ares=0 then res:= 2 <*godkendt*>
10 3245 else if ares=1 then
10 3246 begin
11 3247 ia(2):= find_område(i1);
11 3248 if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
11 3249 end
10 3250 else res:= 27; <* syntaks, parametertype *>
10 3251 end
9 3252 else
9 3253 if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
9 3254 end;
8 3255 \f
8 3255 message procedure læs_kommando side 7 - 810226/hko;
8 3256
8 3256 <*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
8 3257
8 3257 begin
9 3258 if nr=1 then
9 3259 begin
10 3260 if a_res=0 then res:=25 <*parameter mangler*>
10 3261 else if a_res=2 and (i1<1 or i1>9999)
10 3262 then res:=7 <*busnr ulovligt*>
10 3263 else if a_res=2 or a_res=6 then
10 3264 begin
11 3265 ia(1):=if a_res=2 then i1
11 3266 else 1 shift 22 +i1;
11 3267 end
10 3268 else res:= 27; <*parametertype*>
10 3269 if res<4 then pos:=a_pos;
10 3270 end
9 3271 else
9 3272 if nr=2 then
9 3273 begin
10 3274 if ares=0 then res:= 2 <*godkendt*> else
10 3275 if ares=1 and ia(1) shift (-21) = 0 then
10 3276 begin
11 3277 ia(2):= findområde(i1);
11 3278 if ia(2)=0 then res:= 56; <*område ukendt*>
11 3279 end
10 3280 else res:= 27;
10 3281 if res<4 then pos:= apos;
10 3282 end
9 3283 else
9 3284 if ares=0 then res:= 2 else res:= 24<*syntaks*>;
9 3285 end;
8 3286 \f
8 3286 message procedure læs_kommando side 8 - 810223/hko;
8 3287
8 3287 <*3: (<linie>!G<nr>) *>
8 3288
8 3288 begin
9 3289 if nr=1 then
9 3290 begin
10 3291 if a_res=0 then res:=25 <*parameter mangler*>
10 3292 else if a_res=2 and (i1<1 or i1>999) then res:=5
10 3293 <*linienr ulovligt*>
10 3294 else if a_res=2 or a_res=4 or a_res=5 then
10 3295 begin
11 3296 ia(1):=
11 3297 if a_res=2 then 4 shift 21 +i1 shift 5
11 3298 else if a_res=4 then 4 shift 21 +i1
11 3299 else <* a_res=5 *> 5 shift 21 +i1;
11 3300 end
10 3301 else res:=27; <* parametertype *>
10 3302 if res<4 then pos:= a_pos;
10 3303 end
9 3304 else
9 3305 res:= if nr=2 and a_res<>0 then 24<*syntaks*>
9 3306 else 2;<*godkendt*>
9 3307 end;
8 3308
8 3308 <*4: <ingenting> *>
8 3309
8 3309 begin
9 3310 res:= if a_res<>0 then 24<*syntaks*>
9 3311 else 2;<*godkendt*>
9 3312 end;
8 3313 \f
8 3313 message procedure læs_kommando side 9 - 810226/hko;
8 3314
8 3314 <*5: (<kanalnr>) *>
8 3315
8 3315 begin
9 3316 long field lf;
9 3317
9 3317 if nr=1 then
9 3318 begin
10 3319 if a_res=0 then res:= 25
10 3320 else if a_res<>1 then res:=27<*parametertype*>
10 3321 else
10 3322 begin
11 3323 j:= 0; lf:= 4;
11 3324 for i:= 1 step 1 until max_antal_kanaler do
11 3325 if kanal_navn(i)=værdi.lf then j:= i;
11 3326 if j<>0 then
11 3327 begin
12 3328 ia(1):= 3 shift 22 + j;
12 3329 res:= 2;
12 3330 end
11 3331 else
11 3332 res:= 17; <* kanal ukendt *>
11 3333 end;
10 3334 if res<4 then pos:= a_pos;
10 3335 end
9 3336 else
9 3337 res:=if nr=2 and a_res<>0 then 24<*syntaks*>
9 3338 else 2;<*godkendt*>
9 3339 end;
8 3340 \f
8 3340 message procedure læs_kommando side 10 - 810415/hko;
8 3341
8 3341 <*6: <busnr>/<linie>/<løb> (<område>) *>
8 3342
8 3342 begin
9 3343 if nr=1 then
9 3344 begin
10 3345 if a_res=0 then res:=25<*parameter mangler*>
10 3346 else if a_res=7 then
10 3347 begin
11 3348 ia(1):= i1;
11 3349 ia(2):= 1 shift 22 + værdi(2);
11 3350 end
10 3351 else res:=27;<*parametertype*>
10 3352 if res<4 then pos:= apos;
10 3353 end
9 3354 else
9 3355 if nr=2 then
9 3356 begin
10 3357 if ares=0 then res:= 2 <*godkendt*> else
10 3358 if ares=1 then
10 3359 begin
11 3360 ia(3):= findområde(i1);
11 3361 if ia(3)=0 then res:= 56; <* område ukendt *>
11 3362 end
10 3363 else res:= 27; <*parametertype*>
10 3364 if res<4 then pos:= apos;
10 3365 end
9 3366 else
9 3367 if ares=0 then res:= 2 else res:= 24;
9 3368 end;
8 3369 \f
8 3369 message procedure læs_kommando side 11 - 810512/hko/cl;
8 3370
8 3370
8 3370 <* att_op_længde//2-2 *>
8 3371 <*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
8 3372 <* 1 *>
8 3373
8 3373 begin
9 3374 if nr=1 then
9 3375 begin
10 3376 if a_res=0 then res:=25 <*parameter mangler*>
10 3377 else if a_res=8 then
10 3378 begin
11 3379 ia(1):= 4 shift 21 + i1;
11 3380 ia(2):= værdi(2);
11 3381 ia(3):= værdi(3);
11 3382 indeks:= 3;
11 3383 end
10 3384 else res:=27;<*parametertype*>
10 3385 end
9 3386 else if nr<=att_op_længde//2-2 then
9 3387 begin
10 3388 if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
10 3389 else if a_res=0 then res:=25 <* parameter mangler *>
10 3390 else if a_res=10 then
10 3391 begin
11 3392 if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
11 3393 begin
12 3394 ia(nr+2):= i1 shift 12 + værdi(2);
12 3395 indeks:= nr +2;
12 3396 end
11 3397 else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
11 3398 else res:=6; <*løb-nr ulovligt*>
11 3399 end
10 3400 else res:=27;<*parametertype*>
10 3401 end
9 3402 else
9 3403 res:= if a_res=0 then 2 else 24;<* syntaks *>
9 3404 if res<4 then pos:=a_pos;
9 3405 end;
8 3406 \f
8 3406 message procedure læs_kommando side 12 - 810306/hko;
8 3407
8 3407 <*8: (<operatør>!<radiokanal>!<garageterminal>) *>
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=2 then
10 3413 begin
11 3414 j:=d.op_ref.opkode;
11 3415 ia(1):=i1;
11 3416 k:=(j+1)//2;
11 3417 if k<1 or k=3 or k>4 then
11 3418 fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
11 3419 else
11 3420 begin
12 3421 if k=4 then k:=3;
12 3422 if i1<1 or i1> (case k of
12 3423 (max_antal_operatører,max_antal_radiokanaler,
12 3424 max_antal_garageterminaler))
12 3425 then res:=case k of (28,29,17);
12 3426 end;
11 3427 end
10 3428 else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
10 3429 begin
11 3430 laf:= 0;
11 3431 ia(1):= find_bpl(værdi.laf(1));
11 3432 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3433 end
10 3434 else res:=27; <*parametertype*>
10 3435 end
9 3436 else
9 3437 if nr=2 and d.opref.opkode=1 then
9 3438 begin
10 3439 <* åbningstilstand for operatørplads *>
10 3440 if a_res=0 then res:= 2 <*godkendt*>
10 3441 else if a_res<>1 then res:= 27 <*parametertype*>
10 3442 else begin
11 3443 res:= 2<*godkendt*>;
11 3444 j:= værdi(1) shift (-16);
11 3445 if j='S' then ia(2):= 3 else
11 3446 if j<>'Å' then res:= 24; <*syntaks*>
11 3447 end;
10 3448 end
9 3449 else
9 3450 begin
10 3451 res:=if a_res=0 then 2 <* godkendt *>
10 3452 else 24;<* syntaks *>
10 3453 end;
9 3454 if res<4 then pos:=a_pos;
9 3455 end; <* partype 8 *>
8 3456 \f
8 3456 message procedure læs_kommando side 13 - 810306/hko;
8 3457
8 3457
8 3457 <* att_op_længde//2 *>
8 3458 <*9: <operatør>((+!-)<linienr>) *>
8 3459 <* 1 *>
8 3460
8 3460 begin
9 3461 if nr=1 then
9 3462 begin
10 3463 if a_res=0 then res:=25 <* parameter mangler *>
10 3464 else if a_res=2 then
10 3465 begin
11 3466 ia(1):=i1;
11 3467 if i1<1 or i1>max_antal_operatører then res:=28;
11 3468 end
10 3469 else if a_res=1 then
10 3470 begin
11 3471 laf:= 0;
11 3472 ia(1):= find_bpl(værdi.laf(1));
11 3473 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3474 end
10 3475 else res:=27; <* parametertype *>
10 3476 end
9 3477 else if nr<=att_op_længde//2 then
9 3478 begin <* nr>1 *>
10 3479 if a_res=0 then res:=(if nr>2 then 2 else 25)
10 3480 else if a_res=2 or a_res=3 then
10 3481 begin
11 3482 ia(nr):=i1; indeks:= nr;
11 3483 if i1=0 or abs(i1)>999 then res:=5;
11 3484 end
10 3485 else res:=27; <* parametertype *>
10 3486 if res<4 then pos:=a_pos;
10 3487 end
9 3488 else
9 3489 res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
9 3490 else 2;
9 3491 end; <* partype 9 *>
8 3492 \f
8 3492 message procedure læs_kommando side 14 - 810428/hko;
8 3493
8 3493 <* 2 *>
8 3494 <*10: (bus) *>
8 3495 <* 1 *>
8 3496
8 3496 begin
9 3497 if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
9 3498 else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
9 3499 else if a_res=0 then res:=2 <* godkendt *>
9 3500 else if a_res<>2 then res:=27 <* parametertype *>
9 3501 else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
9 3502 else
9 3503 ia(nr):=i1;
9 3504 end;
8 3505
8 3505 <* 5 *>
8 3506 <*11: (<linie>) *>
8 3507 <* 1 *>
8 3508
8 3508 begin
9 3509 if a_res=0 and nr=1 then res:=25
9 3510 else if a_res<>0 and nr>5 then res:=24
9 3511 else if a_res=0 then res:=2
9 3512 else if a_res<>2 and a_res<>4 then res:=27
9 3513 else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
9 3514 else
9 3515 ia(nr):=
9 3516 (if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
9 3517 end;
8 3518 \f
8 3518 message procedure læs_kommando side 15 - 810306/hko;
8 3519
8 3519 <*12: (<ingenting>!<navn>) *>
8 3520
8 3520 begin
9 3521 if nr=1 then
9 3522 begin
10 3523 if a_res=0 then res:=2 <*godkendt*>
10 3524 else if a_res=1 then
10 3525 tofrom(ia,værdi,8)
10 3526 else res:=27; <* parametertype *>
10 3527 end
9 3528 else
9 3529 res:=if a_res<>0 then 24 <* syntaks (for mange) *>
9 3530 else 2;
9 3531 end; <* partype 12 *>
8 3532 \f
8 3532 message procedure læs_kommando side 16 - 810512/hko/cl;
8 3533
8 3533 <* 15 *>
8 3534 <*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
8 3535 <* 1 *>
8 3536
8 3536 begin
9 3537 if nr=1 then
9 3538 begin
10 3539 if a_res=0 then res:=25 <* parameter mangler *>
10 3540 else
10 3541 if a_res=11 then
10 3542 begin
11 3543 ia(1):= 5 shift 21 + i1;
11 3544 ia(2):=værdi(2);
11 3545 indeks:= 2;
11 3546 end
10 3547 else res:=27; <* parametertype *>
10 3548 end
9 3549 else if nr<= att_op_længde//2-1 then
9 3550 begin
10 3551 if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
10 3552 else if a_res=0 then res:=25 <* parameter mangler *>
10 3553 else if ares=2 and (i1<1 or i1>9999) then
10 3554 res:= 7 <*busnr ulovligt*>
10 3555 else if a_res=2 or a_res=6 then
10 3556 begin
11 3557 ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
11 3558 indeks:= nr+1;
11 3559 end
10 3560 else res:=27; <* parametertype *>
10 3561 end
9 3562 else
9 3563 res:=if a_res=0 then 2 <*godkendt *>
9 3564 else 24;<* syntaks *>
9 3565 if res<4 then pos:=a_pos;
9 3566 end; <* partype 13 *>
8 3567 \f
8 3567 message procedure læs_kommando side 17 - 810311/hko;
8 3568
8 3568 <*14: <linie>.<indeks> *>
8 3569
8 3569 begin
9 3570 if nr=1 then
9 3571 begin
10 3572 if a_res=0 then res:=25 <* parameter mangler *>
10 3573 else if a_res=9 then
10 3574 begin
11 3575 ia(1):= 1 shift 23 +i1;
11 3576 ia(2):= værdi(2);
11 3577 end
10 3578 else res:=27; <* parametertype *>
10 3579 end
9 3580 else <* nr>1 *>
9 3581 res:= if a_res=0 then 2 <* godkendt *>
9 3582 else 24;<* syntaks *>
9 3583 end; <* partype 14 *>
8 3584 \f
8 3584 message procedure læs_kommando side 18 - 810313/hko;
8 3585
8 3585 <*15: <linie>.<indeks> <bus> *>
8 3586
8 3586 begin
9 3587 if nr=1 then
9 3588 begin
10 3589 if a_res=0 then res:= 25 <* parameter mangler *>
10 3590 else if a_res=9 then
10 3591 begin
11 3592 ia(1):= 1 shift 23 +i1;
11 3593 ia(2):= værdi(2);
11 3594 end
10 3595 else res:=27; <* parametertype *>
10 3596 end
9 3597 else if nr=2 then
9 3598 begin
10 3599 if a_res=0 then res:=25
10 3600 else if a_res=2 then
10 3601 begin
11 3602 if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
11 3603 else ia(3):= i1;
11 3604 end
10 3605 else res:=27; <*parametertype *>
10 3606 end
9 3607 else
9 3608 res:=if a_res=0 then 2 <* godkendt *>
9 3609 else 24;<* syntaks *>
9 3610 if res<4 then pos:=a_pos;
9 3611 end; <* partype 15 *>
8 3612 \f
8 3612 message procedure læs_kommando side 19 - 810311/hko;
8 3613
8 3613 <*16: (<ingenting>!D.<dato>.<klokkeslet> *>
8 3614
8 3614 begin
9 3615 if nr=1 then
9 3616 begin
10 3617 if a_res=0 then res:=2 <* godkendt *>
10 3618 else if a_res=12 then
10 3619 begin
11 3620 raf:=0;
11 3621 ia.raf(1):= systid(i1,værdi(2));
11 3622 end
10 3623 else res:=27; <* parametertype *>
10 3624 end
9 3625 else
9 3626 res:= if a_res=0 then 2 <* godkendt *>
9 3627 else 24;<* syntaks *>
9 3628 if res<4 then pos:=a_pos;
9 3629 end; <* partype 16 *>
8 3630 \f
8 3630 message procedure læs_kommando side 20 - 810511/hko;
8 3631
8 3631 <*17: G<grp.nr> *>
8 3632
8 3632 begin
9 3633 if nr=1 then
9 3634 begin
10 3635 if a_res=0 then res:=25 <*parameter mangler *>
10 3636 else if a_res=5 then
10 3637 begin
11 3638 ia(1):= 5 shift 21 +i1;
11 3639 end
10 3640 else res:=27; <* parametertype *>
10 3641 end
9 3642 else
9 3643 res:= if a_res=0 then 2 <* godkendt *>
9 3644 else 24;<* syntaks *>
9 3645 end; <* partype 17 *>
8 3646
8 3646 <* att_op_længde//2 *>
8 3647 <*18: (<heltal>) *>
8 3648 <* 1 *>
8 3649
8 3649 begin
9 3650 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3651 else
9 3652 if nr<=att_op_længde//2 then
9 3653 begin
10 3654 if a_res=2 or a_res=3 <* pos/neg heltal *> then
10 3655 begin
11 3656 ia(nr):= i1; indeks:= nr;
11 3657 end
10 3658 else if a_res=0 then res:= 2
10 3659 else res:= 27; <*parametertype*>
10 3660 end
9 3661 else
9 3662 res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
9 3663 end;
8 3664 \f
8 3664 message procedure læs_kommando side 21 - 820302/cl;
8 3665
8 3665 <*19: <linie>/<løb> <linie>/<løb> *>
8 3666
8 3666 begin
9 3667 if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3668 else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
9 3669 else if nr<3 then
9 3670 begin
10 3671 ia(nr):=i1 + 1 shift 22;
10 3672 end
9 3673 else
9 3674 res:= if a_res=0 then 2 <*godkendt*>
9 3675 else 24;<*syntaks (for mange)*>
9 3676 if res<4 then pos:= a_pos;
9 3677 end; <* partype 19 *>
8 3678
8 3678 <*20: <busnr> <kortnavn> *>
8 3679 begin
9 3680 if nr=1 then
9 3681 begin
10 3682 if ares=0 then res:= 25 else
10 3683 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3684 if ares<>2 then res:= 27 else ia(1):= i1;
10 3685 end
9 3686 else
9 3687 if nr=2 then
9 3688 begin
10 3689 if ares=1 and værdi(2) extract 8 = 0 then
10 3690 begin
11 3691 ia(2):= værdi(1); ia(3):= værdi(2);
11 3692 end
10 3693 else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
10 3694 end
9 3695 else
9 3696 if ares=0 then res:= 2 else res:= 24;
9 3697 end; <* partype 20 *>
8 3698 \f
8 3698 message procedure læs_kommando side 22 - 851001/cl;
8 3699
8 3699 <* 2 *>
8 3700 <*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
8 3701 <* 0 *>
8 3702
8 3702 begin
9 3703 laf:= 0;
9 3704 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3705 else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
9 3706 else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
9 3707 else if a_res=0 then res:= 2 <*godkendt*>
9 3708 else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
9 3709 else if (a_res=2 or a_res=4) and nr<=2 then
9 3710 begin
10 3711 if ia(3)<>0 then res:= 27 else
10 3712 ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
10 3713 end
9 3714 else
9 3715 if ares=1 then
9 3716 begin
10 3717 if nr=1 then
10 3718 begin
11 3719 ia(1):= (4 shift 21) + (1 shift 5);
11 3720 ia(2):= (4 shift 21) + (999 shift 5);
11 3721 end;
10 3722 if ia(3)=-2 then
10 3723 begin
11 3724 if i1=long<:ALL:> shift (-24) extract 24 then
11 3725 ia(3):= -1
11 3726 else
11 3727 begin
12 3728 ia(3):= findområde(i1);
12 3729 if ia(3)=0 then res:= 56 else
12 3730 ia(3):= 14 shift 20 + ia(3);
12 3731 end;
11 3732 end
10 3733 else
10 3734 if ia(3) = 0 then
10 3735 begin
11 3736 if i1 = long<:OMR:> shift (-24) extract (24) then
11 3737 ia(3):= -2
11 3738 else
11 3739 ia(3):= find_bpl(værdi.laf(1));
11 3740 if ia(3)=0 then res:= 55;
11 3741 end
10 3742 else res:= 24;
10 3743 end
9 3744 else res:= 27; <*parametertype*>
9 3745 if res<4 then pos:= apos;
9 3746 end;
8 3747
8 3747 <*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
8 3748
8 3748 begin
9 3749 if nr=1 then
9 3750 begin
10 3751 if ares=0 then res:= 25 <*parameter mangler*>
10 3752 else if ares=2 and (i1<1 or i1>9999)
10 3753 then res:= 7 <* busnr ulovligt *>
10 3754 else if ares=2 or ares=6 then
10 3755 begin
11 3756 ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
11 3757 end
10 3758 else res:= 27 <* parametertype *>
10 3759 end
9 3760 else
9 3761 if nr=2 then
9 3762 begin
10 3763 if ares=0 then res:= 2 <* godkendt *>
10 3764 else if ares=1 then
10 3765 begin
11 3766 ia(2):= findområde(i1);
11 3767 if ia(2)=0 then res:= 17 <*kanal ukendt*>
11 3768 end
10 3769 else
10 3770 res:= 27; <* parametertype *>
10 3771 end
9 3772 else if ares=0 then res:= 2 <*godkendt*>
9 3773 else res:= 24; <*syntaks*>
9 3774 if res < 4 then pos:= apos;
9 3775 end;
8 3776
8 3776 <*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
8 3777
8 3777 begin
9 3778 if nr=1 then
9 3779 begin
10 3780 if ares=0 then res:= 25 else
10 3781 if ares=2 and (i1<1 or i1>999) then res:= 5 else
10 3782 if ares=2 or ares=4 or ares=5 then
10 3783 begin
11 3784 ia(1):=
11 3785 if ares=2 then 4 shift 21 + i1 shift 5 else
11 3786 if ares=4 then 4 shift 21 + i1 else
11 3787 5 shift 21 + i1;
11 3788 end
10 3789 else res:= 27;
10 3790 if res < 4 then pos:= apos;
10 3791 end
9 3792 else
9 3793 if nr=2 then
9 3794 begin
10 3795 if ares=0 then res:= 2 else
10 3796 if ares=1 then
10 3797 begin
11 3798 ia(2):= findområde(i1);
11 3799 if ia(2)=0 then res:= 17;
11 3800 end
10 3801 else res:= 27;
10 3802 end
9 3803 else
9 3804 if ares=0 then res:= 2 else res:= 24;
9 3805 end;
8 3806
8 3806 <*24: ( <ingenting> ! <område> ! * ) *>
8 3807
8 3807 begin
9 3808 if nr=1 then
9 3809 begin
10 3810 if ares=0 then res:= 2 else
10 3811 if ares=1 then
10 3812 begin
11 3813 if i1=long<:ALL:> shift (-24) extract 24 then
11 3814 ia(1):= (-1) shift (-3) shift 3
11 3815 else
11 3816 begin
12 3817 k:= findområde(i1);
12 3818 if k=0 then res:= 17 else
12 3819 ia(1):= 14 shift 20 + k;
12 3820 end;
11 3821 end
10 3822 else res:= 27;
10 3823 end
9 3824 else
9 3825 if ares=0 then res:= 2 else res:= 24;
9 3826 if res < 4 then pos:= apos;
9 3827 end;
8 3828
8 3828 <*25: <område> *>
8 3829
8 3829 begin
9 3830 if nr=1 then
9 3831 begin
10 3832 if ares=0 then res:= 25 else
10 3833 if ares=1 then
10 3834 begin
11 3835 if i1 = '*' shift 16 then ia(1):= -1 else
11 3836 ia(1):= findområde(i1);
11 3837 if ia(1)=0 then res:= 17;
11 3838 end
10 3839 else res:= 27;
10 3840 end
9 3841 else
9 3842 if ares=0 then res:= 2 else res:= 24;
9 3843 if res < 4 then pos:= apos;
9 3844 end;
8 3845
8 3845 <*26: <busnr> *>
8 3846 begin
9 3847 if nr=1 then
9 3848 begin
10 3849 if ares=0 then res:= 25 else
10 3850 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3851 if ares<>2 then res:= 27 else ia(1):= i1;
10 3852 end
9 3853 else
9 3854 if ares=0 then res:= 2 else res:= 24;
9 3855 end;
8 3856
8 3856 <* 8 *>
8 3857 <*27: <operatørnr> (<område>) *>
8 3858 <* 1 *>
8 3859 begin
9 3860 if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3861 else if nr=1 then
9 3862 begin
10 3863 if a_res=2 then
10 3864 begin
11 3865 ia(1):= i1;
11 3866 if i1 < 0 or max_antal_operatører < i1 then res:= 28;
11 3867 end
10 3868 else if a_res=1 then
10 3869 begin
11 3870 laf:= 0;
11 3871 ia(1):= find_bpl(værdi.laf(1));
11 3872 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3873 end
10 3874 else res:= 27; <*parametertype*>
10 3875 end
9 3876 else
9 3877 begin
10 3878 if a_res=0 then res:= (if nr > 2 then 2 else 25)
10 3879 else if nr > 9 then res:= 24
10 3880 else if a_res=1 then
10 3881 begin
11 3882 ia(nr):= find_område(i1);
11 3883 indeks:= nr;
11 3884 if ia(nr)=0 then res:= 56;
11 3885 end
10 3886 else res:= 27;
10 3887 end;
9 3888 if res < 4 then pos:= a_pos;
9 3889 end <* partype 27 *>;
8 3890
8 3890 <*28: (<ingenting>!<kanalnr>) *>
8 3891 begin
9 3892 long field lf;
9 3893
9 3893 if nr=1 then
9 3894 begin
10 3895 if ares=0 then res:= 2 else
10 3896 if ares=1 then
10 3897 begin
11 3898 j:= 0; lf:= 4;
11 3899 for i:= 1 step 1 until max_antal_kanaler do
11 3900 if kanal_navn(i)=værdi.lf then j:= i;
11 3901 if j<>0 then
11 3902 begin
12 3903 ia(1):= 3 shift 22 + j;
12 3904 res:= 2;
12 3905 end
11 3906 else
11 3907 res:= 17; <*kanal ukendt*>
11 3908 end
10 3909 else
10 3910 res:= 27; <*parametertype*>
10 3911 if res < 4 then pos:= apos;
10 3912 end
9 3913 else
9 3914 res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
9 3915 end;
8 3916
8 3916 <* n *>
8 3917 <*29: <btj.pl.navn> ( <operatørnavn>) *>
8 3918 <* 0 *>
8 3919 begin
9 3920 laf:= 0;
9 3921 if nr=1 then
9 3922 begin
10 3923 if a_res=0 then res:= 25 <*parameter mangler*>
10 3924 else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
10 3925 else begin
11 3926 indeks:= 2;
11 3927 ia(1):= værdi(1); ia(2):= værdi(2);
11 3928 j:= find_bpl(værdi.laf(1));
11 3929 if 0<j and j<=max_antal_operatører then
11 3930 res:= 62; <*ulovligt navn*>
11 3931 end;
10 3932 end
9 3933 else
9 3934 begin
10 3935 if a_res=0 then res:= 2 <*godkendt*>
10 3936 else if a_res<>1 then res:= 27 <*parametertype*>
10 3937 else begin
11 3938 indeks:= indeks+1;
11 3939 ia(indeks):= find_bpl(værdi.laf(1));
11 3940 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3941 res:= 28; <*ukendt operatør*>
11 3942 end;
10 3943 end;
9 3944 if res<4 then pos:= a_pos;
9 3945 end;
8 3946
8 3946 <* 3 *>
8 3947 <*30: (<operatørnavn>) ( <btj.pl.navn>) *>
8 3948 <* io 0 *>
8 3949
8 3949 begin
9 3950 boolean io;
9 3951
9 3951 io:= (kilde//100 = 1);
9 3952 laf:= 0;
9 3953 if -,io and nr=1 then
9 3954 begin
10 3955 indeks:= 1;
10 3956 ia(1):= kilde mod 100; <*egen operatørplads*>
10 3957 end;
9 3958
9 3958 if io and nr=1 then
9 3959 begin
10 3960 if a_res=0 then res:= 25 <*parameter mangler*>
10 3961 else if a_res<>1 then res:= 27 <*parametertype*>
10 3962 else begin
11 3963 indeks:= nr;
11 3964 ia(indeks):= find_bpl(værdi.laf(1));
11 3965 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3966 res:= 28; <*ukendt operatør*>
11 3967 end;
10 3968 end
9 3969 else
9 3970 begin
10 3971 if a_res=0 then res:= 2<*godkendt*>
10 3972 else if indeks=4 then res:= 24 <*syntaks, for mange*>
10 3973 else if a_res<>1 then res:= 27 <*parametertype*>
10 3974 else begin
11 3975 indeks:= indeks+1;
11 3976 ia(indeks):= find_bpl(værdi.laf(1));
11 3977 if ia(indeks)=0 then res:= 46 <*navn ukendt*>
11 3978 else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
11 3979 end;
10 3980 end;
9 3981 if res<4 then pos:= a_pos;
9 3982 end;
8 3983
8 3983 <* *>
8 3984 <*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
8 3985 <* *>
8 3986
8 3986 begin
9 3987 laf:= 0;
9 3988 if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
9 3989 else
9 3990 if nr=1 then
9 3991 begin
10 3992 if a_res=2 then
10 3993 begin
11 3994 ia(1):= i1;
11 3995 if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
11 3996 end else res:= 27; <*parametertype*>
10 3997 end
9 3998 else
9 3999 if nr=2 then
9 4000 begin
10 4001 if a_res=1 and værdi(2) extract 8 = 0 then
10 4002 begin
11 4003 ia(2):= værdi(1); ia(3):= værdi(2);
11 4004 j:= find_bpl(værdi.laf(1));
11 4005 if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
11 4006 end
10 4007 else res:= if a_res=0 then 2 <*godkendt*>
10 4008 else 27 <*parametertype*>;
10 4009 end
9 4010 else
9 4011 if nr=3 then
9 4012 begin
10 4013 if a_res=0 then res:=2 <*godkendt*>
10 4014 else if a_res<>1 then res:= 27 <*parametertype*>
10 4015 else begin
11 4016 j:= værdi(1) shift (-16);
11 4017 if j='Å' then ia(4):= 1 else
11 4018 if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
11 4019 end;
10 4020 end
9 4021 else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
9 4022 if res<4 then pos:= a_pos;
9 4023 end;
8 4024
8 4024 <* 1 *>
8 4025 <*32: (heltal) *>
8 4026 <* 0 *>
8 4027 begin
9 4028 if nr=1 then
9 4029 begin
10 4030 if ares=0 then res:= 2 else
10 4031 if ares=2 or ares=3 then
10 4032 begin
11 4033 ia(nr):= i1; indeks:= nr;
11 4034 end
10 4035 else res:=27; <*parametertype*>
10 4036 end
9 4037 else
9 4038 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4039 if res < 4 then pos:= a_pos;
9 4040 end;
8 4041
8 4041 <*33 generel tekst*>
8 4042 begin
9 4043 integer p,p1,ch,lgd;
9 4044
9 4044 if nr=1 and a_res<>0 then
9 4045 begin
10 4046 p:=pos; p1:=1;
10 4047 lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
10 4048 if 95<lgd then lgd:=95;
10 4049 repeat læstegn(d.opref.data,p,ch) until ch<>' ';
10 4050 while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
10 4051 begin
11 4052 skrivtegn(ia,p1,ch);
11 4053 læstegn(d.opref.data,p,ch);
11 4054 end;
10 4055 if p1=1 then res:= 25 else res:= 2;
10 4056 repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
10 4057 end
9 4058 else
9 4059 if a_res=0 then res:= 25 else res:= 24;
9 4060 end;
8 4061
8 4061 <*+4*> begin
9 4062 fejlreaktion(4<*systemfejl*>,partype,
9 4063 <:parametertype fejl i kommandofil:>,1);
9 4064 res:=31;
9 4065 end
8 4066 <*-4*>
8 4067 end;<*case partype*>
7 4068 end;<* while læs_param_sæt *>
6 4069 end; <* operationskode ok *>
5 4070 end
4 4071 else
4 4072 begin
5 4073 fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
5 4074 end;
4 4075
4 4075 if a_res<0 then res:= -a_res;
4 4076 slut_læskommando:
4 4077
4 4077 læs_kommando:=d.op_ref.resultat:= res;
4 4078 end;<* disable-blok*>
3 4079 end læs_kommando;
2 4080 \f
2 4080 message procedure skriv_kvittering side 1 - 820301/hko/cl;
2 4081
2 4081 procedure skriv_kvittering(z,ref,pos,res);
2 4082 value ref,pos,res;
2 4083 zone z;
2 4084 integer ref,pos,res;
2 4085 begin
3 4086 integer array field op;
3 4087 integer pos1,tegn;
3 4088 op:=ref;
3 4089 if res<1 or res>3 then write(z,<:*** :>);
3 4090 write(z,case res+1 of (
3 4091 <* 0*><:ubehandlet:>,
3 4092 <* 1*><:ok:>,
3 4093 <* 2*><:godkendt:>,
3 4094 <* 3*><:udført:>,
3 4095 <* 4*><:kommando ukendt:>,
3 4096
3 4096 <* 5*><:linie-nr ulovligt:>,
3 4097 <* 6*><:løb-nr ulovligt:>,
3 4098 <* 7*><:bus-nr ulovligt:>,
3 4099 <* 8*><:gruppe ukendt:>,
3 4100 <* 9*><:linie/løb ukendt:>,
3 4101
3 4101 <*10*><:bus-nr ukendt:>,
3 4102 <*11*><:bus allerede indsat på :>,
3 4103 <*12*><:linie/løb allerede besat af :>,
3 4104 <*13*><:bus ikke indsat:>,
3 4105 <*14*><:bus optaget:>,
3 4106
3 4106 <*15*><:gruppe optaget:>,
3 4107 <*16*><:skærm optaget:>,
3 4108 <*17*><:kanal ukendt:>,
3 4109 <*18*><:bus i kø:>,
3 4110 <*19*><:kø er tom:>,
3 4111
3 4111 <*20*><:ej forbindelse :>,
3 4112 <*21*><:ingen at gennemstille til:>,
3 4113 <*22*><:ingen samtale at nedlægge:>,
3 4114 <*23*><:ingen samtale at monitere:>,
3 4115 <*24*><:syntaks:>,
3 4116
3 4116 <*25*><:syntaks, parameter mangler:>,
3 4117 <*26*><:syntaks, skilletegn:>,
3 4118 <*27*><:syntaks, parametertype:>,
3 4119 <*28*><:operatør ukendt:>,
3 4120 <*29*><:garageterminal ukendt:>,
3 4121 \f
3 4121
3 4121 <*30*><:rapport kan ikke dannes:>,
3 4122 <*31*><:systemfejl:>,
3 4123 <*32*><:ingen fri plads:>,
3 4124 <*33*><:gruppe for stor:>,
3 4125 <*34*><:gruppe allerede defineret:>,
3 4126
3 4126 <*35*><:springsekvens for stor:>,
3 4127 <*36*><:spring allerede defineret:>,
3 4128 <*37*><:spring ukendt:>,
3 4129 <*38*><:spring allerede igangsat:>,
3 4130 <*39*><:bus ikke reserveret:>,
3 4131
3 4131 <*40*><:gruppe ikke reserveret:>,
3 4132 <*41*><:spring ikke igangsat:>,
3 4133 <*42*><:intet frit linie/løb:>,
3 4134 <*43*><:ændring af dato/tid ikke lovlig:>,
3 4135 <*44*><:interval-størrelse ulovlig:>,
3 4136
3 4136 <*45*><:ikke implementeret:>,
3 4137 <*46*><:navn ukendt:>,
3 4138 <*47*><:forkert indhold:>,
3 4139 <*48*><:i brug:>,
3 4140 <*49*><:ingen samtale igang:>,
3 4141
3 4141 <*50*><:kanal:>,
3 4142 <*51*><:afvist:>,
3 4143 <*52*><:kanal optaget :>,
3 4144 <*53*><:annulleret:>,
3 4145 <*54*><:ingen busser at kalde op:>,
3 4146
3 4146 <*55*><:garagenavn ukendt:>,
3 4147 <*56*><:område ukendt:>,
3 4148 <*57*><:område nødvendigt:>,
3 4149 <*58*><:ulovligt område for bus:>,
3 4150 <*59*><:radiofejl :>,
3 4151
3 4151 <*60*><:område kan ikke opdateres:>,
3 4152 <*61*><:ingen talevej:>,
3 4153 <*62*><:ulovligt navn:>,
3 4154 <*63*><:alarmlængde: :>,
3 4155
3 4155 <*99*><:- <'?'> -:>));
3 4156 \f
3 4156 message procedure skriv_kvittering side 3 - 820301/hko;
3 4157 if res=3 and op<>0 then
3 4158 begin
4 4159 if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
4 4160 begin
5 4161 i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
5 4162 if i<>0 then write(z,i,<: udtaget:>);
5 4163 end;
4 4164 end;
3 4165 if res = 11 or res = 12 then
3 4166 i:=ref;
3 4167 if res=11 then write(z,i shift(-12) extract 10,
3 4168 if i shift(-7) extract 5 =0 then false
3 4169 else "A" add (i shift(-7) extract 5 -1),1,
3 4170 <:/:>,<<d>,i extract 7) else
3 4171 if res=12 then write(z,i extract 14) else
3 4172 if res = 20 or res = 52 or res = 59 then
3 4173 begin
4 4174 i:= d.op.data(12);
4 4175 if i <> 0 then skriv_id(z,i,8);
4 4176 i:=d.op.data(2);
4 4177 if i=0 then i:=d.op.data(9);
4 4178 if i=0 then i:=d.op.data(8);
4 4179 skriv_id(z,i,8);
4 4180 end;
3 4181 if res=63 then
3 4182 begin
4 4183 i:= ref;
4 4184 if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
4 4185 end;
3 4186
3 4186 if pos>=0 then
3 4187 begin
4 4188 pos:=pos+1;
4 4189 outchar(z,':');
4 4190 tegn:=-1;
4 4191 while tegn<>10 and tegn<>0 do
4 4192 outchar(z,læs_tegn(d.op.data,pos,tegn));
4 4193 end;
3 4194 <*V*>setposition(z,0,0);
3 4195 end skriv_kvittering;
2 4196 \f
2 4196 message procedure cursor, side 1 - 810213/hko;
2 4197
2 4197 procedure cursor(z,linie,pos);
2 4198 value linie,pos;
2 4199 zone z;
2 4200 integer linie,pos;
2 4201 begin
3 4202 if linie>0 and linie<25
3 4203 and pos>0 and pos<81 then
3 4204 begin
4 4205 write(z,"esc" add 128,1,<:Æ:>,
4 4206 <<d>,linie,<:;:>,pos,<:H:>);
4 4207 end;
3 4208 end cursor;
2 4209 \f
2 4209 message procedure attention side 1 - 810529/hko;
2 4210
2 4210 procedure attention;
2 4211 begin
3 4212 integer i, j, k;
3 4213 integer array field op_ref,mess_ref;
3 4214 integer array att_message(1:9);
3 4215 long array field laf1, laf2;
3 4216 boolean optaget;
3 4217 procedure skriv_attention(zud,omfang);
3 4218 integer omfang;
3 4219 zone zud;
3 4220 begin
4 4221 write(zud,"nl",1,<:+++ attention :>);
4 4222 if omfang <> 0 then
4 4223 disable begin integer x;
5 4224 trap(slut);
5 4225 write(zud,"nl",1,
5 4226 <: i: :>,i,"nl",1,
5 4227 <: j: :>,j,"nl",1,
5 4228 <: k: :>,k,"nl",1,
5 4229 <: op-ref: :>,op_ref,"nl",1,
5 4230 <: mess-ref: :>,mess_ref,"nl",1,
5 4231 <: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
5 4232 <: laf2 :>,laf2,"nl",1,
5 4233 <: att-message::>,"nl",1,
5 4234 <::>);
5 4235 raf:= 0;
5 4236 skriv_hele(zud,att_message.raf,18,127);
5 4237 skriv_coru(zud,coru_no(010));
5 4238 slut:
5 4239 end;
4 4240 end skriv_attention;
3 4241
3 4241 integer procedure udtag_tal(tekst,pos);
3 4242 long array tekst;
3 4243 integer pos;
3 4244 begin
4 4245 integer i;
4 4246
4 4246 if getnumber(tekst,pos,i) >= 0 then
4 4247 udtag_tal:= i
4 4248 else
4 4249 udtag_tal:= 0;
4 4250 end;
3 4251
3 4251 for i:= 1 step 1 until att_maske_lgd//2 do
3 4252 att_signal(i):=att_flag(i):=0;
3 4253 trap(att_trap);
3 4254 stack_claim((if cm_test then 198 else 146)+50);
3 4255 <*+2*>
3 4256 if testbit26 and overvåget or testbit28 then
3 4257 skriv_attention(out,0);
3 4258 <*-2*>
3 4259 \f
3 4259 message procedure attention side 2 - 810406/hko;
3 4260
3 4260 repeat
3 4261
3 4261 wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
3 4262
3 4262 repeat
3 4263 <*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
3 4264 raf:= laf1:= 0;
3 4265 laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
3 4266
3 4266 <*+2*>if testbit7 and overvåget then
3 4267 disable begin
4 4268 laf2:= abs(laf);
4 4269 write(out,"nl",1,<:attention - :>);
4 4270 if laf<=0 then write(out,<:Regrettet :>);
4 4271 write(out,<:Message modtaget fra :>);
4 4272 if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
4 4273 skriv_hele(out,att_message.raf,16,127);
4 4274 ud;
4 4275 end;
3 4276 <*-2*>
3 4277 \f
3 4277 message procedure attention side 3 - 830310/cl;
3 4278
3 4278 if laf <= 0 then
3 4279 i:= -1
3 4280 else
3 4281 if core.laf(1)=konsol_navn.laf1(1)
3 4282 and core.laf(2)=konsol_navn.laf1(2) then
3 4283 i:= 101
3 4284 else
3 4285 begin
4 4286 i:= -1; j:= 1;
4 4287 while i=(-1) and (j <= max_antal_operatører) do
4 4288 begin
5 4289 laf2:= (j-1)*8;
5 4290 if core.laf(1) = terminal_navn.laf2(1)
5 4291 and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
5 4292 j:= j+1;
5 4293 end;
4 4294 j:= 1;
4 4295 while i=(-1) and (j<=max_antal_garageterminaler) do
4 4296 begin
5 4297 laf2:= (j-1)*8;
5 4298 if core.laf(1) = garage_terminal_navn.laf2(1)
5 4299 and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
5 4300 j:= j+1;
5 4301 end;
4 4302 end;
3 4303
3 4303 if i=101 or (201<=i and i<=200+max_antal_operatører)
3 4304 <* or (301<=i and i<=300+max_antal_garageterminaler) *>
3 4305 then
3 4306 begin
4 4307
4 4307 j:= if i=101 then 0
4 4308 else max_antal_operatører*(i//100-2)+i mod 100;
4 4309
4 4309 ref:=j*terminal_beskr_længde;
4 4310 att_message(9):=
4 4311 if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
4 4312 else 4 <*disconnected*>;
4 4313 optaget:=læsbit_ia(att_flag,j);
4 4314 if optaget and att_message(9)=1 then
4 4315 sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
4 4316 else optaget:=optaget or att_message(9)<>1;
4 4317 if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
4 4318 begin <* att fra ekskluderet operatør - inkluder *>
5 4319 start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
5 4320 d.op_ref.data(1):= i mod 100;
5 4321 signalch(cs_rad,op_ref,gen_optype);
5 4322 waitch(cs_att_pulje,op_ref,true,-1);
5 4323 end;
4 4324 end
3 4325 else
3 4326 begin
4 4327 optaget:= true;
4 4328 att_message(9):= 2 <*rejected*>;
4 4329 end;
3 4330
3 4330 monitor(22)send_answer:(zdummy,mess_ref,att_message);
3 4331
3 4331 until -,optaget;
3 4332 \f
3 4332 message procedure attention side 4 - 810424/hko;
3 4333
3 4333 sætbit_ia(att_flag,j,1);
3 4334
3 4334 start_operation(op_ref,i,cs_att_pulje,0);
3 4335
3 4335 signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
3 4336
3 4336 until false;
3 4337
3 4337 att_trap:
3 4338
3 4338 skriv_attention(zbillede,1);
3 4339
3 4339
3 4339 end attention;
2 4340
2 4340 \f
2 4340 message io_erklæringer side 1 - 810421/hko;
2 4341
2 4341 integer
2 4342 cs_io,
2 4343 cs_io_komm,
2 4344 cs_io_fil,
2 4345 cs_io_spool,
2 4346 cs_io_medd,
2 4347 ss_io_spool_tomme,
2 4348 ss_io_spool_fulde,
2 4349 bs_zio_adgang,
2 4350 io_spool_fil,
2 4351 io_spool_postantal,
2 4352 io_spool_postlængde;
2 4353
2 4353 integer array field
2 4354 io_spool_post;
2 4355
2 4355 zone z_io(32,1,io_fejl);
2 4356
2 4356 procedure io_fejl(z,s,b);
2 4357 integer s,b;
2 4358 zone z;
2 4359 begin
3 4360 disable begin
4 4361 integer array iz(1:20);
4 4362 integer i,j,k;
4 4363 integer array field iaf;
4 4364 real array field raf;
4 4365 if s<>(1 shift 21 + 2) then
4 4366 begin
5 4367 getzone6(z,iz);
5 4368 raf:=2;
5 4369 iaf:=0;
5 4370 k:=1;
5 4371
5 4371 j:= terminal_tab.iaf.terminal_tilstand;
5 4372 if j shift(-21)<>6 then
5 4373 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
5 4374 1 shift 12 <*binært*> +1 <*fortsæt*>);
5 4375 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
5 4376 + terminal_tab.iaf.terminal_tilstand extract 21;
5 4377 end;
4 4378 z(1):=real <:<'?'><'?'><'em'>:>;
4 4379 b:=2;
4 4380 end; <*disable*>
3 4381 end io_fejl;
2 4382 \f
2 4382 message procedure skriv_auto_spring_medd side 1 - 820301/hko;
2 4383
2 4383 procedure skriv_auto_spring_medd(z,medd,tid);
2 4384 value tid;
2 4385 zone z;
2 4386 real tid;
2 4387 integer array medd;
2 4388 begin
3 4389 disable begin
4 4390 real t;
4 4391 integer kode,bus,linie,bogst,løb,dato,kl;
4 4392 long array indeks(1:1);
4 4393 kode:= medd(1);
4 4394 indeks(1):= extend medd(5) shift 24;
4 4395 if kode > 0 and kode < 10 then
4 4396 begin
5 4397 write(z,"nl",0,<:-<'>'>:>,case kode of(
5 4398 <*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
5 4399 <*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
5 4400 <*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
5 4401 <*4*><:vogn optaget:>, <* - i - - / - *>
5 4402 <*5*><:spring annulleret:>, <*udløb af ventetid *>
5 4403 <*6*><::>, <* - af springliste *>
5 4404 <*7*><::>, <*start af springsekvens *>
5 4405 <*8*><::>, <*afvikling af springsekvens *>
5 4406 <*9*><:område kan ikke opdateres:>,<*vt-ændring*>
5 4407 <::>));
5 4408 <* if kode = 5 then
5 4409 begin
5 4410 bogst:= medd(4);
5 4411 linie:= bogst shift(-5) extract 10;
5 4412 bogst:= bogst extract 5;
5 4413 if bogst > 0 then bogst:= bogst +'A'-1;
5 4414 write(z,"sp",1,<<z>,linie,false add bogst,1,
5 4415 ".",1,indeks);
5 4416 end;
5 4417 *>
5 4418 outchar(z,'sp');
5 4419 bus:= medd(2) extract 14;
5 4420 if bus > 0 then
5 4421 write(z,<<z>,bus,"/",1);
5 4422 løb:= medd(3);
5 4423 <*+4*> if løb shift(-22) <> 1 and løb <> 0 then
5 4424 fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
5 4425 <*-4*>
5 4426 \f
5 4426 message procedure skriv_auto_spring_medd side 2 - 810507/hko;
5 4427
5 4427 linie:= løb shift(-12) extract 10;
5 4428 bogst:= løb shift(-7) extract 5;
5 4429 if bogst > 0 then bogst:= bogst +'A'-1;
5 4430 løb:= løb extract 7;
5 4431 if medd(3) <> 0 or kode <> 5 then
5 4432 begin
6 4433 write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
6 4434 if kode = 5 or kode = 6 then write(z,<:er frit :>);
6 4435 end;
5 4436 if kode = 7 or kode = 8 then
5 4437 write(z,<*indeks,"sp",1,*>
5 4438 if kode=7 then <:udtaget :> else <:indsat :>);
5 4439
5 4439 dato:= systime(4,tid,t);
5 4440 kl:= t/100.0;
5 4441 løb:= replace_char(1<*space in number*>,'.');
5 4442 write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
5 4443 replace_char(1,løb);
5 4444 end
4 4445 else <*kode < 1 or kode > 8*>
4 4446 fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
4 4447 end; <*disable*>
3 4448 end skriv_auto_spring_medd;
2 4449 \f
2 4449 message procedure h_io side 1 - 810507/hko;
2 4450
2 4450 <* hovedmodulkorutine for io *>
2 4451 procedure h_io;
2 4452 begin
3 4453 integer array field op_ref;
3 4454 integer k,dest_sem;
3 4455 procedure skriv_hio(zud,omfang);
3 4456 value omfang;
3 4457 zone zud;
3 4458 integer omfang;
3 4459 begin
4 4460
4 4460 write(zud,"nl",1,<:+++ hovedmodul io :>);
4 4461 if omfang>0 then
4 4462 disable begin integer x;
5 4463 trap(slut);
5 4464 write(zud,"nl",1,
5 4465 <: op_ref: :>,op_ref,"nl",1,
5 4466 <: k: :>,k,"nl",1,
5 4467 <: dest_sem: :>,dest_sem,"nl",1,
5 4468 <::>);
5 4469 skriv_coru(zud,coru_no(100));
5 4470 slut:
5 4471 end;
4 4472 end skriv_hio;
3 4473
3 4473 trap(hio_trap);
3 4474 stack_claim(if cm_test then 198 else 146);
3 4475
3 4475 <*+2*>
3 4476 if testbit0 and overvåget or testbit28 then
3 4477 skriv_hio(out,0);
3 4478 <*-2*>
3 4479 \f
3 4479 message procedure h_io side 2 - 810507/hko;
3 4480
3 4480 repeat
3 4481 wait_ch(cs_io,op_ref,true,-1);
3 4482 <*+4*>
3 4483 if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
3 4484 then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
3 4485 <*-4*>
3 4486
3 4486 k:=d.op_ref.opkode extract 12;
3 4487 dest_sem:=
3 4488 if k = 0 <*attention*> then cs_io_komm else
3 4489
3 4489 if k = 22 <*auto vt opdatering*>
3 4490 or k = 23 <*generel meddelelse*>
3 4491 or k = 36 <*spring meddelelse*>
3 4492 or k = 44 <*udeladt i gruppeopkald*>
3 4493 or k = 45 <*nødopkald modtaget*>
3 4494 or k = 46 <*nødopkald besvaret*> then cs_io_spool else
3 4495
3 4495 if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
3 4496 0;
3 4497 <*+4*>
3 4498 if dest_sem = 0 then
3 4499 begin
4 4500 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
4 4501 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 4502 end
3 4503 else
3 4504 <*-4*>
3 4505 begin
4 4506 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 4507 end;
3 4508 until false;
3 4509
3 4509 hio_trap:
3 4510 disable skriv_hio(zbillede,1);
3 4511 end h_io;
2 4512 \f
2 4512 message procedure io_komm side 1 - 810507/hko;
2 4513
2 4513 procedure io_komm;
2 4514 begin
3 4515 integer array field op_ref,ref,vt_op,iaf;
3 4516 integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
3 4517 pos,indeks,sep,sluttegn,operatør,i,j,k;
3 4518 long navn;
3 4519
3 4519 procedure skriv_io_komm(zud,omfang);
3 4520 value omfang;
3 4521 zone zud;
3 4522 integer omfang;
3 4523 begin
4 4524
4 4524 disable
4 4525
4 4525 write(zud,"nl",1,<:+++ io_komm :>);
4 4526 if omfang > 0 then
4 4527 disable begin integer x;
5 4528 trap(slut);
5 4529 write(zud,"nl",1,
5 4530 <: op-ref: :>,op_ref,"nl",1,
5 4531 <: kode: :>,kode,"nl",1,
5 4532 <: aktion: :>,aktion,"nl",1,
5 4533 <: ref: :>,ref,"nl",1,
5 4534 <: vt_op: :>,vt_op,"nl",1,
5 4535 <: status: :>,status,"nl",1,
5 4536 <: opgave: :>,opgave,"nl",1,
5 4537 <: dest-sem: :>,dest_sem,"nl",1,
5 4538 <: iaf: :>,iaf,"nl",1,
5 4539 <: i: :>,i,"nl",1,
5 4540 <: j: :>,j,"nl",1,
5 4541 <: k: :>,k,"nl",1,
5 4542 <: navn: :>,string navn,"nl",1,
5 4543 <: pos: :>,pos,"nl",1,
5 4544 <: indeks: :>,indeks,"nl",1,
5 4545 <: sep: :>,sep,"nl",1,
5 4546 <: sluttegn: :>,sluttegn,"nl",1,
5 4547 <: vogn: :>,vogn,"nl",1,
5 4548 <: ll: :>,ll,"nl",1,
5 4549 <: omr: :>,omr,"nl",1,
5 4550 <: operatør: :>,operatør,"nl",1,
5 4551 <::>);
5 4552 skriv_coru(zud,coru_no(101));
5 4553 slut:
5 4554 end;
4 4555 end skriv_io_komm;
3 4556 \f
3 4556 message procedure io_komm side 2 - 810424/hko;
3 4557
3 4557 trap(io_komm_trap);
3 4558 stack_claim((if cm_test then 200 else 146)+24+200);
3 4559
3 4559 ref:=0;
3 4560 navn:= long<::>;
3 4561
3 4561 <*+2*>
3 4562 if testbit0 and overvåget or testbit28 then
3 4563 skriv_io_komm(out,0);
3 4564 <*-2*>
3 4565
3 4565 repeat
3 4566
3 4566 <*V*> wait_ch(cs_io_komm,
3 4567 op_ref,
3 4568 true,
3 4569 -1<*timeout*>);
3 4570 <*+2*>
3 4571 if testbit1 and overvåget then
3 4572 disable begin
4 4573 skriv_io_komm(out,0);
4 4574 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
4 4575 <: til io :>);
4 4576 skriv_op(out,op_ref);
4 4577 end;
3 4578 <*-2*>
3 4579
3 4579 kode:= d.op_ref.op_kode;
3 4580 i:= terminal_tab.ref.terminal_tilstand;
3 4581 status:= i shift(-21);
3 4582 opgave:=
3 4583 if kode=0 then 1 <* indlæs kommando *> else
3 4584 0; <* afvises *>
3 4585
3 4585 aktion:= if opgave = 0 then 0 else
3 4586 (case status +1 of(
3 4587 <* status *>
3 4588 <* 0 klar *>(1),
3 4589 <* 1 - *>(-1),<* ulovlig tilstand *>
3 4590 <* 2 - *>(-1),<* ulovlig tilstand *>
3 4591 <* 3 stoppet *>(2),
3 4592 <* 4 noneksist *>(-1),<* ulovlig tilstand *>
3 4593 <* 5 - *>(-1),<* ulovlig tilstand *>
3 4594 <* 6 - *>(-1),<* ulovlig tilstand *>
3 4595 <* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
3 4596 -1));
3 4597 \f
3 4597 message procedure io_komm side 3 - 810428/hko;
3 4598
3 4598 case aktion+6 of
3 4599 begin
4 4600 begin
5 4601 <*-5: terminal optaget *>
5 4602
5 4602 d.op_ref.resultat:= 16;
5 4603 afslut_operation(op_ref,-1);
5 4604 end;
4 4605
4 4605 begin
5 4606 <*-4: operation uden virkning *>
5 4607
5 4607 afslut_operation(op_ref,-1);
5 4608 end;
4 4609
4 4609 begin
5 4610 <*-3: ulovlig operationskode *>
5 4611
5 4611 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 4612 afslut_operation(op_ref,-1);
5 4613 end;
4 4614
4 4614 begin
5 4615 <*-2: ulovlig aktion *>
5 4616
5 4616 fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
5 4617 afslut_operation(op_ref,-1);
5 4618 end;
4 4619
4 4619 begin
5 4620 <*-1: ulovlig io_tilstand *>
5 4621
5 4621 fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
5 4622 afslut_operation(op_ref,-1);
5 4623 end;
4 4624
4 4624 begin
5 4625 <* 0: ikke implementeret *>
5 4626
5 4626 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 4627 afslut_operation(op_ref,-1);
5 4628 end;
4 4629
4 4629 begin
5 4630 \f
5 4630 message procedure io_komm side 4 - 851001/cl;
5 4631
5 4631 <* 1: indlæs kommando *>
5 4632 <*V*> wait(bs_zio_adgang);
5 4633
5 4633 <*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
5 4634
5 4634 if d.op_ref.resultat > 3 then
5 4635 begin
6 4636 <*V*> setposition(z_io,0,0);
6 4637 if sluttegn<>'nl' then outchar(z_io,'nl');
6 4638 skriv_kvittering(z_io,op_ref,pos,
6 4639 d.op_ref.resultat);
6 4640 end
5 4641 else if d.op_ref.resultat>0 then
5 4642 begin <*godkendt*>
6 4643 kode:=d.op_ref.opkode;
6 4644 i:= kode extract 12;
6 4645 j:= if kode < 5 or
6 4646 kode=7 or kode=8 or
6 4647 kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
6 4648 if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
6 4649 if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
6 4650 if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
6 4651 kode=20 or kode=24 then 4<*VO,F/VO,R*>else
6 4652 if kode =21 then 5 <*AU*> else
6 4653 if kode =25 then 6 <*GR,D*> else
6 4654 if kode =26 then 5 <*GR,S*> else
6 4655 if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
6 4656 if kode =30 then 10 <*SP,D*> else
6 4657 if kode =31 then 5 <*SP*> else
6 4658 if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
6 4659 if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
6 4660 if kode=71 then 11 <*FO,V*> else
6 4661 if kode =75 then 12 <*TÆ,V *>else
6 4662 if kode =76 then 12 <*TÆ,N *>else
6 4663 if kode =65 then 13 <*BE,N *>else
6 4664 if kode =66 then 14 <*BE,G *>else
6 4665 if kode =67 then 15 <*BE,V *>else
6 4666 if kode =68 then 16 <*ST,D *>else
6 4667 if kode =69 then 17 <*ST,V *>else
6 4668 if kode =36 then 18 <*AL *>else
6 4669 if kode =37 then 19 <*CC *>else
6 4670 if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
6 4671 if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
6 4672 0;
6 4673 if j > 0 then
6 4674 begin
7 4675 case j of
7 4676 begin
8 4677 begin
9 4678 \f
9 4678 message procedure io_komm side 5 - 810424/hko;
9 4679
9 4679 <* 1: inkluder/ekskluder ydre enhed *>
9 4680
9 4680 d.op_ref.retur:= cs_io_komm;
9 4681 if kode=1 then d.opref.opkode:=
9 4682 ia(2) shift 12 + d.opref.opkode extract 12;
9 4683 d.op_ref.data(1):= ia(1);
9 4684 signal_ch(if kode < 5 or kode>=72 then cs_rad
9 4685 else cs_gar,
9 4686 op_ref,gen_optype or io_optype);
9 4687 indeks:= op_ref;
9 4688 wait_ch(cs_io_komm,
9 4689 op_ref,
9 4690 true,
9 4691 -1<*timeout*>);
9 4692 <*+4*> if op_ref <> indeks then
9 4693 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4694 <*-4*>
9 4695 <*V*> setposition(z_io,0,0);
9 4696 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4697 skriv_kvittering(z_io,op_ref,-1,
9 4698 d.op_ref.resultat);
9 4699 end;
8 4700
8 4700 begin
9 4701 \f
9 4701 message procedure io_komm side 6 - 810501/hko;
9 4702
9 4702 <* 2: tid/attention,ja/attention,nej
9 4703 slut/slut med billede *>
9 4704
9 4704 case d.op_ref.opkode -79 of
9 4705 begin
10 4706
10 4706 <* 80: TI *> begin
11 4707 setposition(z_io,0,0);
11 4708 if sluttegn<>'nl' then outchar(z_io,'nl');
11 4709 if ia(1) <> 0 or ia(2) <> 0 then
11 4710 begin real field rf;
12 4711 rf:= 4;
12 4712 trap(forbudt);
12 4713 <*V*> setposition(z_io,0,0);
12 4714 systime(3,ia.rf,0.0);
12 4715 if false then
12 4716 begin
13 4717 forbudt: skriv_kvittering(z_io,0,-1,
13 4718 43<*ændring af dato/tid ikke lovlig*>);
13 4719 end
12 4720 else
12 4721 skriv_kvittering(z_io,0,-1,3);
12 4722 end
11 4723 else
11 4724 begin
12 4725 setposition(z_io,0,0);
12 4726 write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
12 4727 end;
11 4728 end TI;
10 4729 \f
10 4729 message procedure io_komm side 7 - 810424/hko;
10 4730
10 4730 <*81: AT,J*> begin
11 4731 <*V*> setposition(z_io,0,0);
11 4732 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4733 monitor(10)release process:(z_io,0,ia);
11 4734 skriv_kvittering(z_io,0,-1,3);
11 4735 end;
10 4736
10 4736 <* 82: AT,N*> begin
11 4737 i:= monitor(8)reserve process:(z_io,0,ia);
11 4738 <*V*> setposition(z_io,0,0);
11 4739 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4740 skriv_kvittering(z_io,0,-1,
11 4741 if i = 0 then 3 else 0);
11 4742 end;
10 4743
10 4743 <* 83: SL *> begin
11 4744 errorbits:=0; <* warning.no ok.yes *>
11 4745 trapmode:= 1 shift 13;
11 4746 trap(-2);
11 4747 end;
10 4748
10 4748 <* 84: SL,B *>begin
11 4749 errorbits:=1; <* warning.no ok.no *>
11 4750 trap(-3);
11 4751 end;
10 4752 <* 85: SL,K *>begin
11 4753 errorbits:=1; <* warning.no ok.no *>
11 4754 disable sæt_bit_i(trapmode,15,0);
11 4755 trap(-3);
11 4756 end;
10 4757 \f
10 4757 message procedure io_komm side 7a - 810511/cl;
10 4758
10 4758 <* 86: TE,J *>begin
11 4759 setposition(z_io,0,0);
11 4760 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4761 for i:= 1 step 1 until indeks do
11 4762 if 0<=ia(i) and ia(i)<=47 then
11 4763 begin
12 4764 case (ia(i)+1) of
12 4765 begin
13 4766 testbit0 := true;testbit1 := true;testbit2 := true;
13 4767 testbit3 := true;testbit4 := true;testbit5 := true;
13 4768 testbit6 := true;testbit7 := true;testbit8 := true;
13 4769 testbit9 := true;testbit10:= true;testbit11:= true;
13 4770 testbit12:= true;testbit13:= true;testbit14:= true;
13 4771 testbit15:= true;testbit16:= true;testbit17:= true;
13 4772 testbit18:= true;testbit19:= true;testbit20:= true;
13 4773 testbit21:= true;testbit22:= true;testbit23:= true;
13 4774 testbit24:= true;testbit25:= true;testbit26:= true;
13 4775 testbit27:= true;testbit28:= true;testbit29:= true;
13 4776 testbit30:= true;testbit31:= true;testbit32:= true;
13 4777 testbit33:= true;testbit34:= true;testbit35:= true;
13 4778 testbit36:= true;testbit37:= true;testbit38:= true;
13 4779 testbit39:= true;testbit40:= true;testbit41:= true;
13 4780 testbit42:= true;testbit43:= true;testbit44:= true;
13 4781 testbit45:= true;testbit46:= true;testbit47:= true;
13 4782 end;
12 4783 end;
11 4784 skriv_kvittering(z_io,0,-1,3);
11 4785 end;
10 4786 \f
10 4786 message procedure io_komm side 7b - 810511/cl;
10 4787
10 4787 <* 87: TE,N *>begin
11 4788 setposition(z_io,0,0);
11 4789 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4790 for i:= 1 step 1 until indeks do
11 4791 if 0<=ia(i) and ia(i)<=47 then
11 4792 begin
12 4793 case (ia(i)+1) of
12 4794 begin
13 4795 testbit0 := false;testbit1 := false;testbit2 := false;
13 4796 testbit3 := false;testbit4 := false;testbit5 := false;
13 4797 testbit6 := false;testbit7 := false;testbit8 := false;
13 4798 testbit9 := false;testbit10:= false;testbit11:= false;
13 4799 testbit12:= false;testbit13:= false;testbit14:= false;
13 4800 testbit15:= false;testbit16:= false;testbit17:= false;
13 4801 testbit18:= false;testbit19:= false;testbit20:= false;
13 4802 testbit21:= false;testbit22:= false;testbit23:= false;
13 4803 testbit24:= false;testbit25:= false;testbit26:= false;
13 4804 testbit27:= false;testbit28:= false;testbit29:= false;
13 4805 testbit30:= false;testbit31:= false;testbit32:= false;
13 4806 testbit33:= false;testbit34:= false;testbit35:= false;
13 4807 testbit36:= false;testbit37:= false;testbit38:= false;
13 4808 testbit39:= false;testbit40:= false;testbit41:= false;
13 4809 testbit42:= false;testbit43:= false;testbit44:= false;
13 4810 testbit45:= false;testbit46:= false;testbit47:= false;
13 4811 end;
12 4812 end;
11 4813 skriv_kvittering(z_io,0,-1,3);
11 4814 end;
10 4815
10 4815 <* 88: O *> begin
11 4816 integer array odescr,zdescr(1:20);
11 4817 long array field laf;
11 4818 integer res, i, j;
11 4819
11 4819 i:= j:= 1;
11 4820 while læstegn(ia,i,res)<>0 do
11 4821 begin
12 4822 if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
12 4823 skrivtegn(ia,j,res);
12 4824 end;
11 4825
11 4825 laf:= 2;
11 4826 getzone6(out,odescr);
11 4827 getzone6(z_io,zdescr);
11 4828 close(out,zdescr.laf(1)<>odescr.laf(1) or
11 4829 zdescr.laf(2)<>odescr.laf(2));
11 4830 laf:= 0;
11 4831
11 4831 if ia(1)=0 then
11 4832 begin
12 4833 res:= 3;
12 4834 j:= 0;
12 4835 end
11 4836 else
11 4837 begin
12 4838 j:= res:= openbs(out,j,ia,0);
12 4839 if res<>0 then
12 4840 res:= 46;
12 4841 end;
11 4842 if res<>0 then
11 4843 begin
12 4844 open(out,8,konsol_navn,0);
12 4845 if j<>0 then
12 4846 begin
13 4847 i:= 1;
13 4848 fejlreaktion(4,j,string ia.laf(increase(i)),1);
13 4849 end;
12 4850 end
11 4851 else res:= 3;
11 4852 setposition(z_io,0,0);
11 4853 skriv_kvittering(z_io,0,-1,res);
11 4854 end;
10 4855 end;<*case d.op_ref.opkode -79*>
9 4856 end;<*case 2*>
8 4857 begin
9 4858 \f
9 4858 message procedure io_komm side 8 - 810424/hko;
9 4859
9 4859 <* 3: vogntabel,linienr/-,busnr*>
9 4860
9 4860 d.op_ref.retur:= cs_io_komm;
9 4861 tofrom(d.op_ref.data,ia,10);
9 4862 indeks:= op_ref;
9 4863 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 4864 wait_ch(cs_io_komm,
9 4865 op_ref,
9 4866 io_optype,
9 4867 -1<*timeout*>);
9 4868 <*+2*> if testbit2 and overvåget then
9 4869 disable begin
10 4870 skriv_io_komm(out,0);
10 4871 write(out,"nl",1,<:io operation retur fra vt:>);
10 4872 skriv_op(out,op_ref);
10 4873 end;
9 4874 <*-2*>
9 4875 <*+4*> if indeks <> op_ref then
9 4876 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4877 <*-4*>
9 4878
9 4878 i:=d.op_ref.resultat;
9 4879 if i<1 or i>3 then
9 4880 begin
10 4881 <*V*> setposition(z_io,0,0);
10 4882 if sluttegn<>'nl' then outchar(z_io,'nl');
10 4883 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 4884 end
9 4885 else
9 4886 begin
10 4887 \f
10 4887 message procedure io_komm side 9 - 820301/hko,cl;
10 4888
10 4888 integer antal,filref;
10 4889
10 4889 antal:= d.op_ref.data(6);
10 4890 fil_ref:= d.op_ref.data(7);
10 4891 pos:= 0;
10 4892 <*V*> setposition(zio,0,0);
10 4893 if sluttegn <> 'nl' then outchar(z_io,'nl');
10 4894 for pos:= pos +1 while pos <= antal do
10 4895 begin
11 4896 integer bogst,løb;
11 4897
11 4897 disable i:= læsfil(fil_ref,pos,j);
11 4898 if i <> 0 then
11 4899 fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
11 4900 vogn:= fil(j,1) shift (-24) extract 24;
11 4901 løb:= fil(j,1) extract 24;
11 4902 if d.op_ref.opkode=9 then
11 4903 begin i:=vogn; vogn:=løb; løb:=i; end;
11 4904 ll:= løb shift(-12) extract 10;
11 4905 bogst:= løb shift(-7) extract 5;
11 4906 if bogst > 0 then bogst:= bogst+'A'-1;
11 4907 løb:= løb extract 7;
11 4908 vogn:= vogn extract 14;
11 4909 i:= d.op_ref.opkode -8;
11 4910 for i:= i,i +1 do
11 4911 begin
12 4912 j:= (i+1) extract 1;
12 4913 case j+1 of
12 4914 begin
13 4915 write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 4916 false add bogst,1,"/",1,true,3,<<d>,løb);
13 4917 write(zio,<<dddd>,vogn,"sp",1);
13 4918 end;
12 4919 end;
11 4920 if pos mod 5 = 0 then
11 4921 begin
12 4922 outchar(zio,'nl');
12 4923 <*V*> setposition(zio,0,0);
12 4924 end
11 4925 else write(zio,"sp",3);
11 4926 end;
10 4927 write(zio,"*",1);
10 4928 \f
10 4928 message procedure io_komm side 9a - 810505/hko;
10 4929
10 4929 d.op_ref.opkode:=104;<*slet fil*>
10 4930 d.op_ref.data(4):=filref;
10 4931 indeks:=op_ref;
10 4932 signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
10 4933 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
10 4934
10 4934 <*+2*> if testbit2 and overvåget then
10 4935 disable begin
11 4936 skriv_io_komm(out,0);
11 4937 write(out,"nl",1,<:io operation retur fra sletfil:>);
11 4938 skriv_op(out,op_ref);
11 4939 end;
10 4940 <*-2*>
10 4941
10 4941 <*+4*> if op_ref<>indeks then
10 4942 fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
10 4943 <*-4*>
10 4944 if d.op_ref.data(9)<>0 then
10 4945 fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 4946 <:io-komm, sletfil:>,1);
10 4947 end;
9 4948 end;
8 4949
8 4949 begin
9 4950 \f
9 4950 message procedure io_komm side 10 - 820301/hko;
9 4951
9 4951 <* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
9 4952
9 4952 vogn:=ia(1);
9 4953 ll:=ia(2);
9 4954 omr:= if kode=11 or kode=19 then ia(3) else
9 4955 if kode=12 then ia(2) else 0;
9 4956 if kode=19 and omr<=0 then
9 4957 begin
10 4958 if omr=-1 then omr:= 0
10 4959 else omr:= 14 shift 20 + 3; <*OMR TCT*>
10 4960 end;
9 4961 <*V*> wait_ch(cs_vt_adgang,
9 4962 vt_op,
9 4963 gen_optype,
9 4964 -1<*timeout sek*>);
9 4965 start_operation(vtop,101,cs_io_komm,
9 4966 kode);
9 4967 d.vt_op.data(1):=vogn;
9 4968 d.vt_op.data(2):=ll;
9 4969 d.vt_op.data(if kode=19 then 3 else 4):= omr;
9 4970 indeks:= vt_op;
9 4971 signal_ch(cs_vt,
9 4972 vt_op,
9 4973 gen_optype or io_optype);
9 4974
9 4974 <*V*> wait_ch(cs_io_komm,
9 4975 vt_op,
9 4976 io_optype,
9 4977 -1<*timeout sek*>);
9 4978 <*+2*> if testbit2 and overvåget then
9 4979 disable begin
10 4980 skriv_io_komm(out,0);
10 4981 write(out,"nl",1,
10 4982 <:iooperation retur fra vt:>);
10 4983 skriv_op(out,vt_op);
10 4984 end;
9 4985 <*-2*>
9 4986 <*+4*> if vt_op<>indeks then
9 4987 fejl_reaktion(11<*fremmede op*>,op_ref,
9 4988 <:io-kommando:>,0);
9 4989 <*-4*>
9 4990 <*V*> setposition(z_io,0,0);
9 4991 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4992 skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
9 4993 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 4994 else vt_op,-1,d.vt_op.resultat);
9 4995 d.vt_op.optype:= genoptype or vt_optype;
9 4996 disable afslut_operation(vt_op,cs_vt_adgang);
9 4997 end;
8 4998
8 4998 begin
9 4999 \f
9 4999 message procedure io_komm side 11 - 810428/hko;
9 5000
9 5000 <* 5 autofil-skift
9 5001 gruppe,slet
9 5002 spring (igangsæt)
9 5003 spring,annuler
9 5004 spring,reserve *>
9 5005
9 5005 tofrom(d.op_ref.data,ia,8);
9 5006 d.op_ref.retur:=cs_io_komm;
9 5007 indeks:=op_ref;
9 5008 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5009 <*V*> wait_ch(cs_io_komm,
9 5010 op_ref,
9 5011 io_optype,
9 5012 -1<*timeout*>);
9 5013 <*+2*> if testbit2 and overvåget then
9 5014 disable begin
10 5015 skriv_io_komm(out,0);
10 5016 write(out,"nl",1,<:io operation retur fra vt:>);
10 5017 skriv_op(out,op_ref);
10 5018 end;
9 5019 <*-2*>
9 5020 <*+4*> if indeks<>op_ref then
9 5021 fejlreaktion(11<*fremmed post*>,op_ref,
9 5022 <:io-kommando(autofil):>,0);
9 5023 <*-4*>
9 5024
9 5024 <*V*> setposition(z_io,0,0);
9 5025 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5026 skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
9 5027 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 5028 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 5029 end;
8 5030
8 5030 begin
9 5031 \f
9 5031 message procedure io_komm side 12 - 820301/hko/cl;
9 5032
9 5032 <* 6 gruppedefinition *>
9 5033
9 5033 tofrom(d.op_ref.data,ia,indeks*2);
9 5034 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5035 start_operation(vt_op,101,cs_io_komm,
9 5036 101<*opret fil*>);
9 5037 d.vt_op.data(1):=256;<*postantal*>
9 5038 d.vt_op.data(2):=1; <*postlængde*>
9 5039 d.vt_op.data(3):=1; <*segmentantal*>
9 5040 d.vt_op.data(4):=
9 5041 2 shift 10; <*spool fil*>
9 5042 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5043 pos:=vt_op;<*variabel lånes*>
9 5044 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5045 <*+4*> if vt_op<>pos then
9 5046 fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
9 5047 if d.vt_op.data(9)<>0 then
9 5048 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5049 <:io-kommando(gruppedefinition):>,0);
9 5050 <*-4*>
9 5051 iaf:=0;
9 5052 for i:=1 step 1 until indeks-1 do
9 5053 begin
10 5054 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5055 if k<>0 then
10 5056 fejlreaktion(7<*modif-fil*>,k,
10 5057 <:io kommando(gruppe-def):>,0);
10 5058 fil(j).iaf(1):=d.op_ref.data(i+1);
10 5059 end;
9 5060 while sep = ',' do
9 5061 begin
10 5062 wait(bs_fortsæt_adgang);
10 5063 pos:= 1; j:= 0;
10 5064 while læs_store(z_io,i) < 8 do
10 5065 begin
11 5066 skrivtegn(fortsæt,pos,i);
11 5067 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5068 end;
10 5069 skrivtegn(fortsæt,pos,'em');
10 5070 afsluttext(fortsæt,pos);
10 5071 sluttegn:= i;
10 5072 if j<>0 then
10 5073 begin
11 5074 setposition(z_io,0,0);
11 5075 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5076 skriv_kvittering(zio,opref,-1,53);<*annulleret*>
11 5077 goto gr_ann;
11 5078 end;
10 5079 \f
10 5079 message procedure io_komm side 13 - 810512/hko/cl;
10 5080
10 5080 disable begin
11 5081 integer array værdi(1:4);
11 5082 integer a_pos,res;
11 5083 pos:= 0;
11 5084 repeat
11 5085 apos:= pos;
11 5086 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5087 if res >= 0 then
11 5088 begin
12 5089 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5090 else if res=0 then res:= -25 <*parameter mangler*>
12 5091 else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
12 5092 res:= -7 <*busnr ulovligt*>
12 5093 else if res=2 or res=6 then
12 5094 begin
13 5095 k:=modiffil(d.vt_op.data(4),indeks,j);
13 5096 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5097 <:io kommando(gruppe-def):>,0);
13 5098 iaf:= 0;
13 5099 fil(j).iaf(1):= værdi(1) +
13 5100 (if res=6 then 1 shift 22 else 0);
13 5101 indeks:= indeks+1;
13 5102 if sep = ',' then res:= 0;
13 5103 end
12 5104 else res:= -27; <*parametertype*>
12 5105 end;
11 5106 if res>0 then pos:= a_pos;
11 5107 until sep<>'sp' or res<=0;
11 5108
11 5108 if res<0 then
11 5109 begin
12 5110 d.op_ref.resultat:= -res;
12 5111 i:=1;
12 5112 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5113 afsluttext(d.op_ref.data,i);
12 5114 end;
11 5115 end;
10 5116 \f
10 5116 message procedure io_komm side 13a - 810512/hko/cl;
10 5117
10 5117 if d.op_ref.resultat > 3 then
10 5118 begin
11 5119 setposition(z_io,0,0);
11 5120 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5121 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5122 goto gr_ann;
11 5123 end;
10 5124 signalbin(bs_fortsæt_adgang);
10 5125 end while sep = ',';
9 5126 d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
9 5127 k:= sætfildim(d.vt_op.data);
9 5128 if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
9 5129 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5130 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5131 d.op_ref.retur:=cs_io_komm;
9 5132 pos:=op_ref;
9 5133 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5134 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5135 <*+4*> if pos<>op_ref then
9 5136 fejlreaktion(11<*fremmed post*>,op_ref,
9 5137 <:io kommando(gruppedef retur fra vt):>,0);
9 5138 <*-4*>
9 5139
9 5139 <*V*> setposition(z_io,0,0);
9 5140 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5141 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5142
9 5142 if false then
9 5143 begin
10 5144 gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5145 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5146 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5147 end;
9 5148
9 5148 end;
8 5149
8 5149 begin
9 5150 \f
9 5150 message procedure io_komm side 14 - 810525/hko/cl;
9 5151
9 5151 <* 7 gruppe(-oversigts-)rapport *>
9 5152
9 5152 d.op_ref.retur:=cs_io_komm;
9 5153 d.op_ref.data(1):=ia(1);
9 5154 indeks:=op_ref;
9 5155 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5156 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5157
9 5157 <*+4*> if op_ref<>indeks then
9 5158 fejlreaktion(11<*fremmed post*>,op_ref,
9 5159 <:io-kommando(gruppe-rapport):>,0);
9 5160 <*-4*>
9 5161
9 5161 <*V*> setposition(z_io,0,0);
9 5162 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5163 if d.op_ref.resultat<>3 then
9 5164 begin
10 5165 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5166 end
9 5167 else
9 5168 begin
10 5169 integer bogst,løb;
10 5170
10 5170 if kode = 27 then <* gruppe,vis *>
10 5171 begin
11 5172 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
11 5173 "G",1,<<z>,d.op_ref.data(1) extract 7,
11 5174 "sp",2,"-",5,"nl",1);
11 5175 \f
11 5175 message procedure io_komm side 15 - 820301/hko;
11 5176
11 5176 for pos:=1 step 1 until d.op_ref.data(2) do
11 5177 begin
12 5178 disable i:=læsfil(d.op_ref.data(3),pos,j);
12 5179 if i<>0 then
12 5180 fejlreaktion(5<*læsfil*>,i,
12 5181 <:io_kommando(gruppe,vis):>,0);
12 5182 iaf:=0;
12 5183 vogn:=fil(j).iaf(1);
12 5184 if vogn shift(-22) =0 then
12 5185 write(z_io,<<ddddddd>,vogn extract 14)
12 5186 else
12 5187 begin
13 5188 løb:=vogn extract 7;
13 5189 bogst:=vogn shift(-7) extract 5;
13 5190 if bogst>0 then bogst:=bogst+'A'-1;
13 5191 ll:=vogn shift(-12) extract 10;
13 5192 write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5193 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5194 end;
12 5195 if pos mod 8 =0 then outchar(z_io,'nl')
12 5196 else write(z_io,"sp",2);
12 5197 end;
11 5198 write(z_io,"*",1);
11 5199 \f
11 5199 message procedure io_komm side 16 - 810512/hko/cl;
11 5200
11 5200 end
10 5201 else if kode=28 then <* gruppe,oversigt *>
10 5202 begin
11 5203 write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
11 5204 "sp",2,"-",5,"nl",2);
11 5205 for pos:=1 step 1 until d.op_ref.data(1) do
11 5206 begin
12 5207 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5208 if i<>0 then
12 5209 fejlreaktion(5<*læsfil*>,i,
12 5210 <:io-kommando(gruppe-oversigt):>,0);
12 5211 iaf:=0;
12 5212 ll:=fil(j).iaf(1);
12 5213 write(z_io,"G",1,<<z>,true,3,ll extract 7);
12 5214 if pos mod 10 =0 then outchar(z_io,'nl')
12 5215 else write(z_io,"sp",3);
12 5216 end;
11 5217 write(z_io,"*",1);
11 5218 end;
10 5219 <* slet fil *>
10 5220 d.op_ref.opkode:= 104;
10 5221 d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
10 5222 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5223 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5224 end; <* resultat=3 *>
9 5225
9 5225 end;
8 5226
8 5226 begin
9 5227 \f
9 5227 message procedure io_komm side 17 - 810525/cl;
9 5228
9 5228 <* 8 spring(-oversigts-)rapport *>
9 5229
9 5229 d.op_ref.retur:=cs_io_komm;
9 5230 tofrom(d.op_ref.data,ia,4);
9 5231 indeks:=op_ref;
9 5232 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5233 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5234
9 5234 <*+4*> if op_ref<>indeks then
9 5235 fejlreaktion(11<*fremmed post*>,op_ref,
9 5236 <:io-kommando(spring-rapport):>,0);
9 5237 <*-4*>
9 5238
9 5238 <*V*> setposition(z_io,0,0);
9 5239 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5240 if d.op_ref.resultat<>3 then
9 5241 begin
10 5242 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5243 end
9 5244 else
9 5245 begin
10 5246 boolean p_skrevet;
10 5247 integer bogst,løb;
10 5248
10 5248 if kode = 32 then <* spring,vis *>
10 5249 begin
11 5250 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 5251 bogst:= d.op_ref.data(1) extract 5;
11 5252 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 5253 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
11 5254 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 5255 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 5256 raf:= data+8;
11 5257 if d.op_ref.raf(1)<>0.0 then
11 5258 write(z_io,<:, startet :>,<<zddddd>,round
11 5259 systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 5260 else
11 5261 write(z_io,<:, ikke startet:>);
11 5262 write(z_io,"sp",2,"-",5,"nl",1);
11 5263 \f
11 5263 message procedure io_komm side 18 - 810518/cl;
11 5264
11 5264 p_skrevet:= false;
11 5265 for pos:=1 step 1 until d.op_ref.data(3) do
11 5266 begin
12 5267 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 5268 if i<>0 then
12 5269 fejlreaktion(5<*læsfil*>,i,
12 5270 <:io_kommando(spring,vis):>,0);
12 5271 iaf:=0;
12 5272 i:= fil(j).iaf(1);
12 5273 if i < 0 and -, p_skrevet then
12 5274 begin
13 5275 outchar(z_io,'('); p_skrevet:= true;
13 5276 end;
12 5277 if i > 0 and p_skrevet then
12 5278 begin
13 5279 outchar(z_io,')'); p_skrevet:= false;
13 5280 end;
12 5281 if pos mod 2 = 0 then
12 5282 write(z_io,<< dd>,abs i,<:.:>)
12 5283 else
12 5284 write(z_io,true,3,<<d>,abs i);
12 5285 if pos mod 21 = 0 then outchar(z_io,'nl');
12 5286 end;
11 5287 write(z_io,"*",1);
11 5288 \f
11 5288 message procedure io_komm side 19 - 810525/cl;
11 5289
11 5289 end
10 5290 else if kode=33 then <* spring,oversigt *>
10 5291 begin
11 5292 write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
11 5293 "sp",2,"-",5,"nl",2);
11 5294 for pos:=1 step 1 until d.op_ref.data(1) do
11 5295 begin
12 5296 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5297 if i<>0 then
12 5298 fejlreaktion(5<*læsfil*>,i,
12 5299 <:io-kommando(spring-oversigt):>,0);
12 5300 iaf:=0;
12 5301 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 5302 bogst:=fil(j).iaf(1) extract 5;
12 5303 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 5304 write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 5305 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 5306 string (extend fil(j).iaf(2) shift 24));
12 5307 if fil(j,2)<>0.0 then
12 5308 write(z_io,<:startet :>,<<zddddd>,
12 5309 round systime(4,fil(j,2),r),<:.:>,round r);
12 5310 outchar(z_io,'nl');
12 5311 end;
11 5312 write(z_io,"*",1);
11 5313 end;
10 5314 <* slet fil *>
10 5315 d.op_ref.opkode:= 104;
10 5316 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 5317 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5318 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5319 end; <* resultat=3 *>
9 5320
9 5320 end;
8 5321
8 5321 begin
9 5322 \f
9 5322 message procedure io_komm side 20 - 820302/hko;
9 5323
9 5323 <* 9 fordeling af linier/områder på operatører *>
9 5324
9 5324 d.op_ref.retur:=cs_io_komm;
9 5325 disable
9 5326 if kode=5 then
9 5327 begin
10 5328 integer array io_linietabel(1:max_linienr//3+1);
10 5329
10 5329 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5330 begin
11 5331 i:= læs_fil(1035,ref//512+1,j);
11 5332 if i <> 0 then
11 5333 fejlreaktion(5,i,<:liniefordelingstabel:>,0);
11 5334 tofrom(io_linietabel.ref,fil(j),
11 5335 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
11 5336 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
11 5337 end;
10 5338 ref:=0;
10 5339 operatør:=ia(1);
10 5340 for j:=2 step 1 until indeks do
10 5341 begin
11 5342 ll:=ia(j);
11 5343 if ll<>0 then
11 5344 skrivtegn(io_linietabel,abs(ll)+1,
11 5345 if ll>0 then operatør else 0);
11 5346 end;
10 5347 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5348 begin
11 5349 i:= skriv_fil(1035,ref//512+1,j);
11 5350 if i <> 0 then
11 5351 fejlreaktion(6,i,<:liniefordelingstabel:>,0);
11 5352 tofrom(fil(j),io_linietabel.ref,
11 5353 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
11 5354 then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
11 5355 );
11 5356 end;
10 5357 ref:=0;
10 5358 end
9 5359 else
9 5360 begin
10 5361 modiffil(1034,1,i);
10 5362 ref:=0;
10 5363 operatør:=ia(1);
10 5364 for j:=2 step 1 until indeks do
10 5365 begin
11 5366 ll:=ia(j);
11 5367 fil(i).ref(ll):= if ll>0 then operatør else 0;
11 5368 end;
10 5369 end;
9 5370 indeks:=op_ref;
9 5371 signal_ch(cs_rad,op_ref,gen_optype or io_optype);
9 5372 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
9 5373
9 5373 <*+4*> if op_ref<>indeks then
9 5374 fejlreaktion(11<*fr.post*>,op_ref,
9 5375 <:io-komm,liniefordeling retur fra rad:>,0);
9 5376 <*-4*>
9 5377
9 5377 <*V*> setposition(z_io,0,0);
9 5378 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5379 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5380
9 5380 end;
8 5381
8 5381 begin
9 5382 \f
9 5382 message procedure io_komm side 21 - 820301/cl;
9 5383
9 5383 <* 10 springdefinition *>
9 5384
9 5384 tofrom(d.op_ref.data,ia,indeks*2);
9 5385 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5386 start_operation(vt_op,101,cs_io_komm,
9 5387 101<*opret fil*>);
9 5388 d.vt_op.data(1):=128;<*postantal*>
9 5389 d.vt_op.data(2):=2; <*postlængde*>
9 5390 d.vt_op.data(3):=1; <*segmentantal*>
9 5391 d.vt_op.data(4):=
9 5392 2 shift 10; <*spool fil*>
9 5393 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5394 pos:=vt_op;<*variabel lånes*>
9 5395 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5396 <*+4*> if vt_op<>pos then
9 5397 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 5398 if d.vt_op.data(9)<>0 then
9 5399 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5400 <:io-kommando(springdefinition):>,0);
9 5401 <*-4*>
9 5402 iaf:=0;
9 5403 for i:=1 step 1 until indeks-2 do
9 5404 begin
10 5405 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5406 if k<>0 then
10 5407 fejlreaktion(7<*modif-fil*>,k,
10 5408 <:io kommando(spring-def):>,0);
10 5409 fil(j).iaf(1):=d.op_ref.data(i+2);
10 5410 end;
9 5411 while sep = ',' do
9 5412 begin
10 5413 wait(bs_fortsæt_adgang);
10 5414 pos:= 1; j:= 0;
10 5415 while læs_store(z_io,i) < 8 do
10 5416 begin
11 5417 skrivtegn(fortsæt,pos,i);
11 5418 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5419 end;
10 5420 skrivtegn(fortsæt,pos,'em');
10 5421 afsluttext(fortsæt,pos);
10 5422 sluttegn:= i;
10 5423 if j<>0 then
10 5424 begin
11 5425 setposition(z_io,0,0);
11 5426 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5427 skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
11 5428 goto sp_ann;
11 5429 end;
10 5430 \f
10 5430 message procedure io_komm side 22 - 810519/cl;
10 5431
10 5431 disable begin
11 5432 integer array værdi(1:4);
11 5433 integer a_pos,res;
11 5434 pos:= 0;
11 5435 repeat
11 5436 apos:= pos;
11 5437 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5438 if res >= 0 then
11 5439 begin
12 5440 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5441 else if res=0 then res:= -25 <*parameter mangler*>
12 5442 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 5443 res:= -44 <*intervalstørrelse ulovlig*>
12 5444 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 5445 res:= -6 <*løbnr ulovligt*>
12 5446 else if res=10 then
12 5447 begin
13 5448 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 5449 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5450 <:io kommando(spring-def):>,0);
13 5451 iaf:= 0;
13 5452 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 5453 indeks:= indeks+1;
13 5454 if sep = ',' then res:= 0;
13 5455 end
12 5456 else res:= -27; <*parametertype*>
12 5457 end;
11 5458 if res>0 then pos:= a_pos;
11 5459 until sep<>'sp' or res<=0;
11 5460
11 5460 if res<0 then
11 5461 begin
12 5462 d.op_ref.resultat:= -res;
12 5463 i:=1;
12 5464 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5465 afsluttext(d.op_ref.data,i);
12 5466 end;
11 5467 end;
10 5468 \f
10 5468 message procedure io_komm side 23 - 810519/cl;
10 5469
10 5469 if d.op_ref.resultat > 3 then
10 5470 begin
11 5471 setposition(z_io,0,0);
11 5472 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5473 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5474 goto sp_ann;
11 5475 end;
10 5476 signalbin(bs_fortsæt_adgang);
10 5477 end while sep = ',';
9 5478 d.vt_op.data(1):= indeks-2;
9 5479 k:= sætfildim(d.vt_op.data);
9 5480 if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
9 5481 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5482 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5483 d.op_ref.retur:=cs_io_komm;
9 5484 pos:=op_ref;
9 5485 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5486 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5487 <*+4*> if pos<>op_ref then
9 5488 fejlreaktion(11<*fremmed post*>,op_ref,
9 5489 <:io kommando(springdef retur fra vt):>,0);
9 5490 <*-4*>
9 5491
9 5491 <*V*> setposition(z_io,0,0);
9 5492 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5493 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5494
9 5494 if false then
9 5495 begin
10 5496 sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5497 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5498 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5499 signalbin(bs_fortsæt_adgang);
10 5500 end;
9 5501
9 5501 end;
8 5502 begin
9 5503 integer i,j,k,opr,lin,max_lin;
9 5504 boolean o_ud, t_ud;
9 5505 \f
9 5505 message procedure io_komm side 23a - 820301/cl;
9 5506
9 5506 <* 11 fordelingsrapport *>
9 5507
9 5507 <*V*> setposition(z_io,0,0);
9 5508 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5509
9 5509 max_lin:= max_linienr;
9 5510 for opr:= 1 step 1 until max_antal_operatører, 0 do
9 5511 begin
10 5512 o_ud:= t_ud:= false;
10 5513 k:= 0;
10 5514
10 5514 if opr<>0 then
10 5515 begin
11 5516 j:= k:= 0;
11 5517 for lin:= 1 step 1 until max_lin do
11 5518 begin
12 5519 læs_tegn(radio_linietabel,lin+1,i);
12 5520 if i<>0 then j:= lin;
12 5521 if opr=i and opr<>0 then
12 5522 begin
13 5523 if -, o_ud then
13 5524 begin
14 5525 o_ud:= true;
14 5526 if opr<>0 then
14 5527 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
14 5528 "sp",2,string bpl_navn(opr))
14 5529 else
14 5530 write(z_io,"nl",1,<:ikke fordelte:>);
14 5531 end;
13 5532 if -, t_ud then
13 5533 begin
14 5534 write(z_io,<:<'nl'> linier: :>);
14 5535 t_ud:= true;
14 5536 end;
13 5537 k:=k+1;
13 5538 if k>1 and k mod 10 = 1 then
13 5539 write(z_io,"nl",1,"sp",13);
13 5540 write(z_io,<<ddd >,lin);
13 5541 end;
12 5542 if lin=max_lin then max_lin:= j;
12 5543 end;
11 5544 end;
10 5545
10 5545 k:= 0; t_ud:= false;
10 5546 for i:= 1 step 1 until max_antal_områder do
10 5547 begin
11 5548 if radio_områdetabel(i)= opr then
11 5549 begin
12 5550 if -, o_ud then
12 5551 begin
13 5552 o_ud:= true;
13 5553 if opr<>0 then
13 5554 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
13 5555 "sp",2,string bpl_navn(opr))
13 5556 else
13 5557 write(z_io,"nl",1,<:ikke fordelte:>);
13 5558 end;
12 5559 if -, t_ud then
12 5560 begin
13 5561 write(z_io,<:<'nl'> områder: :>);
13 5562 t_ud:= true;
13 5563 end;
12 5564 k:= k+1;
12 5565 if k>1 and k mod 10 = 1 then
12 5566 write(z_io,"nl",1,"sp",13);
12 5567 write(z_io,true,4,string område_navn(i));
12 5568 end;
11 5569 end;
10 5570 if o_ud then write(z_io,"nl",1);
10 5571 end;
9 5572 write(z_io,"*",1);
9 5573 end;
8 5574
8 5574 begin
9 5575 integer omr,typ,sum;
9 5576 integer array ialt(1:3);
9 5577 \f
9 5577 message procedure io_komm side 24 - 810501/hko;
9 5578
9 5578 <* 12 vis/nulstil opkaldstællere *>
9 5579
9 5579 setposition(z_io,0,0);
9 5580 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5581 for typ:= 1 step 1 until 3 do ialt(typ):= 0;
9 5582
9 5582 write(z_io,
9 5583 <:område udgående alm. ind nød ind:>,
9 5584 <: ind ialt total:>,"nl",1);
9 5585 for omr := 1 step 1 until max_antal_områder do
9 5586 begin
10 5587 sum:= 0;
10 5588 write(z_io,true,6,string område_navn(omr),":",1);
10 5589 for typ:= 1 step 1 until 3 do
10 5590 begin
11 5591 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*3+typ));
11 5592 sum:= sum + opkalds_tællere((omr-1)*3+typ);
11 5593 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*3+typ);
11 5594 end;
10 5595 write(z_io,<< ddddddd>,
10 5596 sum-opkalds_tællere((omr-1)*3+1),sum,"nl",1);
10 5597 end;
9 5598 sum:= 0;
9 5599 write(z_io,"nl",1,<:ialt ::>);
9 5600 for typ:= 1 step 1 until 3 do
9 5601 begin
10 5602 write(z_io,<< ddddddd>,ialt(typ));
10 5603 sum:= sum+ialt(typ);
10 5604 end;
9 5605 write(z_io,<< ddddddd>,sum-ialt(1),sum,"nl",1);
9 5606 write(z_io,"*",1,"nl",1);
9 5607 setposition(z_io,0,0);
9 5608
9 5608 if kode = 76 <* nulstil tællere *> then
9 5609 disable begin
10 5610 for omr:= 1 step 1 until max_antal_områder*3 do
10 5611 opkalds_tællere(omr):= 0;
10 5612 skrivfil(tf_systællere,1,omr);
10 5613 tofrom(fil(omr),opkaldstællere,max_antal_områder*6);
10 5614 setposition(fil(omr),0,0);
10 5615 write(z_io,<:!!! tabeller nulstillet !!!:>,"nl",1);
10 5616 end;
9 5617 end;
8 5618
8 5618 begin
9 5619 \f
9 5619 message procedure io_komm side 25 - 940522/cl;
9 5620
9 5620 <* 13 navngiv betjeningsplads *>
9 5621 boolean incl;
9 5622 long field lf;
9 5623
9 5623 lf:=6;
9 5624 operatør:= ia(1);
9 5625 navn:= ia.lf;
9 5626 incl:= false add (ia(4) extract 8);
9 5627
9 5627 if navn=long<::> then
9 5628 begin
10 5629 <* nedlæg navn - check for i brug *>
10 5630 iaf:= operatør*terminal_beskr_længde;
10 5631 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5632 d.opref.resultat:= 48 <*i brug*>
10 5633 else
10 5634 begin
11 5635 for i:= 65 step 1 until top_bpl_gruppe do
11 5636 begin
12 5637 iaf:= i*op_maske_lgd;
12 5638 if læsbit_ia(bpl_def.iaf,operatør) then
12 5639 d.opref.resultat:= 48<*i brug*>;
12 5640 end;
11 5641 end;
10 5642 if d.opref.resultat <= 3 then
10 5643 begin
11 5644 for i:= 1 step 1 until sidste_bus do
11 5645 if bustabel(i) shift (-14) extract 8 = operatør then
11 5646 d.opref.resultat:= 48<*i brug*>;
11 5647 end;
10 5648 end
9 5649 else
9 5650 begin
10 5651 <* opret/omdøb *>
10 5652 i:= find_bpl(navn);
10 5653 if i<>0 and i<>operatør then
10 5654 d.opref.resultat:= 48 <*i brug*>;
10 5655 end;
9 5656 if d.opref.resultat<=3 then
9 5657 begin
10 5658 bpl_navn(operatør):= navn;
10 5659 operatør_auto_include(operatør):= incl;
10 5660 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5661 if k<>0 then
10 5662 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5663 lf:= 4;
10 5664 fil(ll).lf:= navn add (incl extract 8);
10 5665 setposition(fil(ll),0,0);
10 5666
10 5666 <* skriv bplnavne *>
10 5667 disable begin
11 5668 zone z(128,1,stderror);
11 5669 long array field laf;
11 5670 integer array ia(1:10);
11 5671
11 5671 open(z,4,<:bplnavne:>,0);
11 5672 laf:= 0;
11 5673 outrec6(z,512);
11 5674 for i:= 1 step 1 until 127 do
11 5675 z.laf(i):= bpl_navn(i);
11 5676 close(z,true);
11 5677 monitor(42,z,0,ia);
11 5678 ia(6):= systime(7,0,0.0);
11 5679 monitor(44,z,0,ia);
11 5680 end;
10 5681 d.opref.resultat:= 3;<*udført*>
10 5682 end;
9 5683
9 5683 setposition(z_io,0,0);
9 5684 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5685 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5686 end;
8 5687
8 5687 begin
9 5688 \f
9 5688 message procedure io_komm side 26 - 940522/cl;
9 5689
9 5689 <* 14 betjeningsplads - gruppe *>
9 5690 integer ant_i_gruppe;
9 5691 long field lf;
9 5692 integer array maske(1:op_maske_lgd//2);
9 5693
9 5693 lf:= 4; ant_i_gruppe:= 0;
9 5694 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5695 navn:= ia.lf;
9 5696 operatør:= find_bpl(navn);
9 5697 for i:= 3 step 1 until indeks do
9 5698 if sætbit_ia(maske,ia(i),1)=0 then
9 5699 ant_i_gruppe:= ant_i_gruppe+1;
9 5700 if ant_i_gruppe=0 then
9 5701 begin
10 5702 <* slet gruppe *>
10 5703 if operatør<=64 then
10 5704 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5705 else 62<*navn ulovligt*>)
10 5706 else
10 5707 begin
11 5708 for i:= 1 step 1 until max_antal_operatører do
11 5709 for j:= 1 step 1 until 3 do
11 5710 if operatør_stop(i,j)=operatør then
11 5711 d.opref.resultat:= 48<*i brug*>;
11 5712 end;
10 5713 navn:= long<::>;
10 5714 end
9 5715 else
9 5716 begin
10 5717 if 1<=operatør and operatør<=64 then
10 5718 d.opref.resultat:= 62<*navn ulovligt*>
10 5719 else
10 5720 if operatør=0 then
10 5721 begin
11 5722 i:=65;
11 5723 while i<=127 and operatør=0 do
11 5724 begin
12 5725 if bpl_navn(i)=long<::> then operatør:=i;
12 5726 i:= i+1;
12 5727 end;
11 5728 if operatør=0 then
11 5729 d.opref.resultat:= 32<*ikke plads*>
11 5730 else if operatør>top_bpl_gruppe then
11 5731 top_bpl_gruppe:= operatør;
11 5732 end;
10 5733 end;
9 5734 if d.opref.resultat<=3 then
9 5735 begin
10 5736 bpl_navn(operatør):= navn;
10 5737 iaf:= operatør*op_maske_lgd;
10 5738 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5739 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5740 for i:= 1 step 1 until max_antal_operatører do
10 5741 begin
11 5742 if læsbit_ia(maske,i) then
11 5743 begin
12 5744 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5745 if læsbit_ia(operatør_maske,i) then
12 5746 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5747 end;
11 5748 end;
10 5749 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5750 if k<>0 then
10 5751 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5752 lf:= 4;
10 5753 fil(ll).lf:= navn;
10 5754 setposition(fil(ll),0,0);
10 5755 iaf:= 0;
10 5756 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5757 if k<>0 then
10 5758 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5759 for i:= 1 step 1 until op_maske_lgd//2 do
10 5760 fil(ll).iaf(i):= maske(i);
10 5761 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5762 setposition(fil(ll),0,0);
10 5763 d.opref.resultat:= 3;
10 5764 end;
9 5765
9 5765 setposition(z_io,0,0);
9 5766 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5767 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5768 end;
8 5769
8 5769 begin
9 5770 \f
9 5770 message procedure io_komm side 27 - 940522/cl;
9 5771
9 5771 <* 15 vis betjeningspladsdefinitioner *>
9 5772
9 5772 setposition(z_io,0,0);
9 5773 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5774 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5775 for i:= 1 step 1 until max_antal_operatører do
9 5776 begin
10 5777 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5778 case operatør_auto_include(i) extract 2 + 1 of(
10 5779 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5780 if i mod 4 = 0 then write(z_io,"nl",1)
10 5781 else write(z_io,"sp",5);
10 5782 end;
9 5783 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5784 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5785 for i:= 65 step 1 until top_bpl_gruppe do
9 5786 begin
10 5787 ll:=0; iaf:= i*op_maske_lgd;
10 5788 if bpl_navn(i)<>long<::> then
10 5789 begin
11 5790 write(z_io,true,6,string bpl_navn(i),":",1);
11 5791 for j:= 1 step 1 until max_antal_operatører do
11 5792 begin
12 5793 if læsbit_ia(bpl_def.iaf,j) then
12 5794 begin
13 5795 if ll mod 8 = 0 and ll<>0 then
13 5796 write(z_io,"nl",1,"sp",7);
13 5797 write(z_io,"sp",2,string bpl_navn(j));
13 5798 ll:=ll+1;
13 5799 end;
12 5800 end;
11 5801 write(z_io,"nl",1);
11 5802 end;
10 5803 end;
9 5804 write(z_io,"*",1);
9 5805 end;
8 5806
8 5806 begin
9 5807 \f
9 5807 message procedure io_komm side 28 - 940522/cl;
9 5808
9 5808 <* 16 stopniveau,definer *>
9 5809
9 5809 operatør:= ia(1);
9 5810 iaf:= operatør*terminal_beskr_længde;
9 5811 for i:= 1 step 1 until 3 do
9 5812 operatør_stop(operatør,i):= ia(i+1);
9 5813 if -,læsbit_ia(operatørmaske,operatør) then
9 5814 begin
10 5815 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5816 signal_bin(bs_mobilopkald);
10 5817 end;
9 5818 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5819 if k<>0 then
9 5820 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 5821 iaf:= 0;
9 5822 for i:= 0 step 1 until 3 do
9 5823 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 5824 setposition(fil(ll),0,0);
9 5825 setposition(z_io,0,0);
9 5826 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5827 skriv_kvittering(z_io,0,-1,3);
9 5828 end;
8 5829
8 5829 begin
9 5830 \f
9 5830 message procedure io_komm side 29 - 940522/cl;
9 5831
9 5831 <* 17 stopniveauer,vis *>
9 5832
9 5832 setposition(z_io,0,0);
9 5833 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5834
9 5834 for operatør:= 1 step 1 until max_antal_operatører do
9 5835 begin
10 5836 iaf:=operatør*terminal_beskr_længde;
10 5837 ll:=0;
10 5838 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 5839 string bpl_navn(operatør),<:(:>,
10 5840 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 5841 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 5842 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 5843 for i:= 1 step 1 until 3 do
10 5844 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 5845 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 5846 else string bpl_navn(operatør_stop(operatør,i)));
10 5847 if operatør mod 2 = 1 then
10 5848 write(z_io,"sp",40-ll)
10 5849 else
10 5850 write(z_io,"nl",1);
10 5851 end;
9 5852 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 5853 write(z_io,"*",1);
9 5854 end;
8 5855
8 5855 begin
9 5856 \f
9 5856 message procedure io_komm side 30 - 941007/cl;
9 5857
9 5857 <* 18 alarmlængder *>
9 5858
9 5858 setposition(z_io,0,0);
9 5859 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5860
9 5860 for operatør:= 1 step 1 until max_antal_operatører do
9 5861 begin
10 5862 ll:=0;
10 5863 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 5864 string bpl_navn(operatør));
10 5865 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 5866 if opk_alarm.iaf.alarm_lgd < 0 then
10 5867 ll:= ll+write(z_io,<:uendelig:>)
10 5868 else
10 5869 ll:= ll+write(z_io,<<ddddddd>,
10 5870 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 5871
10 5871 if operatør mod 2 = 1 then
10 5872 write(z_io,"sp",40-ll)
10 5873 else
10 5874 write(z_io,"nl",1);
10 5875 end;
9 5876 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 5877 write(z_io,"*",1);
9 5878 end;
8 5879
8 5879 begin
9 5880 <* 19 CC *>
9 5881 integer i, c;
9 5882
9 5882 i:= 1;
9 5883 while læstegn(ia,i+0,c)<>0 and
9 5884 i<(op_spool_postlgd-op_spool_text)//2*3
9 5885 do skrivtegn(d.opref.data,i,c);
9 5886 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 5887
9 5887 d.opref.retur:= cs_io_komm;
9 5888 signalch(cs_op,opref,io_optype or gen_optype);
9 5889 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 5890
9 5890 setposition(z_io,0,0);
9 5891 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5892 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5893 end;
8 5894
8 5894 begin
9 5895 <* 20: CQF,I CQF,U CQF,V *>
9 5896 integer kode, res, i, j;
9 5897 integer array field iaf, iaf1;
9 5898 long field navn;
9 5899
9 5899 kode:= d.opref.opkode extract 12;
9 5900 navn:= 6; res:= 0;
9 5901 if kode=90 <*CQF,I*> then
9 5902 begin
10 5903 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 5904 res:= 10 <*busnr ukendt*>
10 5905 else
10 5906 begin
11 5907 j:= -1;
11 5908 for i:= 1 step 1 until max_cqf do
11 5909 begin
12 5910 iaf:= (i-1)*cqf_lgd;
12 5911 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 5912 ia.navn = cqf_tabel.iaf.cqf_id
12 5913 then res:= 48; <*i brug*>
12 5914 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 5915 end;
11 5916 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 5917 if res=0 then
11 5918 begin
12 5919 iaf:= (j-1)*cqf_lgd;
12 5920 cqf_tabel.iaf.cqf_bus:= ia(1);
12 5921 cqf_tabel.iaf.cqf_fejl:= 0;
12 5922 cqf_tabel.iaf.cqf_id:= ia.navn;
12 5923 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 5924 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 5925 res:= 3;
12 5926 end;
11 5927 end;
10 5928 setposition(z_io,0,0);
10 5929 if sluttegn<>'nl' then outchar(z_io,'nl');
10 5930 skriv_kvittering(z_io,opref,-1,res);
10 5931 end
9 5932 else
9 5933 if kode=91 <*CQF,U*> then
9 5934 begin
10 5935 j:= -1;
10 5936 for i:= 1 step 1 until max_cqf do
10 5937 begin
11 5938 iaf:= (i-1)*cqf_lgd;
11 5939 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 5940 end;
10 5941 if j>=0 then
10 5942 begin
11 5943 iaf:= (j-1)*cqf_lgd;
11 5944 for i:= 1 step 1 until cqf_lgd//2 do
11 5945 cqf_tabel.iaf(i):= 0;
11 5946 res:= 3;
11 5947 end
10 5948 else res:= 13; <*bus ikke indsat*>
10 5949 setposition(z_io,0,0);
10 5950 if sluttegn<>'nl' then outchar(z_io,'nl');
10 5951 skriv_kvittering(z_io,opref,-1,res);
10 5952 end
9 5953 else
9 5954 begin
10 5955 setposition(z_io,0,0);
10 5956 skriv_cqf_tabel(z_io,false);
10 5957 outchar(z_io,'*');
10 5958 setposition(z_io,0,0);
10 5959 end;
9 5960
9 5960 if kode=90 or kode=91 then
9 5961 begin
10 5962 j:= skrivfil(1033,1,i);
10 5963 if j<>0 then
10 5964 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 5965 for k:= 1 step 1 until max_cqf do
10 5966 begin
11 5967 iaf1:= (k-1)*cqf_lgd;
11 5968 iaf := (k-1)*cqf_id;
11 5969 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 5970 end;
10 5971 op_cqf_tab_ændret:= true;
10 5972 end;
9 5973 end;<*CQF*>
8 5974
8 5974
8 5974 begin
9 5975 \f
9 5975 message procedure io_komm side xx - 940522/cl;
9 5976
9 5976
9 5976
9 5976 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 5977 <*-3*>
9 5978 end
8 5979 end;<*case j *>
7 5980 end <* j > 0 *>
6 5981 else
6 5982 begin
7 5983 <*V*> setposition(z_io,0,0);
7 5984 if sluttegn<>'nl' then outchar(z_io,'nl');
7 5985 skriv_kvittering(z_io,op_ref,-1,
7 5986 45 <* ikke implementeret *>);
7 5987 end;
6 5988 end;<* godkendt *>
5 5989
5 5989 <*V*> setposition(z_io,0,0);
5 5990 signal_bin(bs_zio_adgang);
5 5991 d.op_ref.retur:=cs_att_pulje;
5 5992 disable afslut_kommando(op_ref);
5 5993 end; <* indlæs kommando *>
4 5994
4 5994 begin
5 5995 \f
5 5995 message procedure io_komm side xx+1 - 810428/hko;
5 5996
5 5996 <* 2: aktiver efter stop *>
5 5997 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 5998 terminal_tab.ref.terminal_tilstand extract 21;
5 5999 afslut_operation(op_ref,-1);
5 6000 signal_bin(bs_zio_adgang);
5 6001 end;
4 6002
4 6002 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6003 <*-3*>
4 6004 end; <* case aktion+6 *>
3 6005
3 6005 until false;
3 6006 io_komm_trap:
3 6007 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6008 alarmcause extract 24 = (-13)) then
3 6009 disable skriv_io_komm(zbillede,1);
3 6010 end io_komm;
2 6011 \f
2 6011 message procedure io_spool side 1 - 810507/hko;
2 6012
2 6012 procedure io_spool;
2 6013 begin
3 6014 integer
3 6015 næste_tomme,nr;
3 6016 integer array field
3 6017 op_ref;
3 6018
3 6018 procedure skriv_io_spool(zud,omfang);
3 6019 value omfang;
3 6020 zone zud;
3 6021 integer omfang;
3 6022 begin
4 6023 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6024 if omfang > 0 then
4 6025 disable begin integer x;
5 6026 trap(slut);
5 6027 write(zud,"nl",1,
5 6028 <: opref: :>,op_ref,"nl",1,
5 6029 <: næstetomme::>,næste_tomme,"nl",1,
5 6030 <: nr :>,nr,"nl",1,
5 6031 <::>);
5 6032 skriv_coru(zud,coru_no(102));
5 6033 slut:
5 6034 end;<*disable*>
4 6035 end skriv_io_spool;
3 6036
3 6036 trap(io_spool_trap);
3 6037 næste_tomme:= 1;
3 6038 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6039 <*+2*>
3 6040 if testbit0 and overvåget or testbit28 then
3 6041 skriv_io_spool(out,0);
3 6042 <*-2*>
3 6043 \f
3 6043 message procedure io_spool side 2 - 810602/hko;
3 6044
3 6044 repeat
3 6045
3 6045 wait_ch(cs_io_spool,
3 6046 op_ref,
3 6047 true,
3 6048 -1<*timeout*>);
3 6049
3 6049 i:= d.op_ref.opkode;
3 6050 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6051 begin
4 6052 wait(ss_io_spool_tomme);
4 6053 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6054 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6055
4 6055 i:= d.op_ref.opsize;
4 6056 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6057 begin
5 6058 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6059 i:= io_spool_postlængde*2 -io_spool_post;
5 6060 end;
4 6061 <*-4*>
4 6062 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6063 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6064 signal(ss_io_spool_fulde);
4 6065 d.op_ref.resultat:= 1;
4 6066 end
3 6067 else
3 6068 begin
4 6069 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6070 <:io_spool_korutine:>,1);
4 6071 end;
3 6072
3 6072 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6073
3 6073 until false;
3 6074
3 6074 io_spool_trap:
3 6075
3 6075 disable skriv_io_spool(zbillede,1);
3 6076 end io_spool;
2 6077 \f
2 6077 message procedure io_spon side 1 - 810507/hko;
2 6078
2 6078 procedure io_spon;
2 6079 begin
3 6080 integer
3 6081 næste_fulde,nr,i,dato,kl;
3 6082 real t;
3 6083
3 6083 procedure skriv_io_spon(zud,omfang);
3 6084 value omfang;
3 6085 zone zud;
3 6086 integer omfang;
3 6087 begin
4 6088 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6089 if omfang > 0 then
4 6090 disable begin integer x;
5 6091 trap(slut);
5 6092 write(zud,"nl",1,
5 6093 <: næste-fulde::>,næste_fulde,"nl",1,
5 6094 <: nr :>,nr,"nl",1,
5 6095 <::>);
5 6096 skriv_coru(zud,coru_no(103));
5 6097 slut:
5 6098 end;<*disable*>
4 6099 end skriv_io_spon;
3 6100
3 6100 trap(io_spon_trap);
3 6101 næste_fulde:= 1;
3 6102 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6103 <*+2*>
3 6104 if testbit0 and overvåget or testbit28 then
3 6105 skriv_io_spon(out,0);
3 6106 <*-2*>
3 6107 \f
3 6107 message procedure io_spon side 2 - 810602/hko/cl;
3 6108
3 6108 repeat
3 6109
3 6109 <*V*> wait(ss_io_spool_fulde);
3 6110 <*V*> wait(bs_zio_adgang);
3 6111
3 6111 <*V*> setposition(zio,0,0);
3 6112
3 6112 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6113 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6114
3 6114 laf:=data;
3 6115 k:= fil(nr).io_spool_post.opkode;
3 6116 if k = 22 or k = 36 then
3 6117 disable begin
4 6118 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6119 if k=36 then
4 6120 begin
5 6121 i:= fil(nr).io_spool_post.data(4);
5 6122 j:= i extract 5;
5 6123 if j<>0 then j:=j+'A'-1;
5 6124 i:= i shift (-5) extract 10;
5 6125 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6126 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6127 end;
4 6128 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6129 fil(nr).io_spool_post.tid)
4 6130 end
3 6131 else if k = 23 then
3 6132 disable
3 6133 begin
4 6134 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6135 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6136 kl:= round t;
4 6137 i:= replace_char(1<*space in number*>,'.');
4 6138 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6139 replace_char(1,i);
4 6140 end
3 6141 else if k = 45 or k = 46 then
3 6142 disable begin
4 6143 integer vogn,linie,bogst,løb,t;
4 6144
4 6144 t:=fil(nr).io_spool_post.data(2);
4 6145 outchar(z_io,'nl');
4 6146 if k = 45 then
4 6147 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6148
4 6148 write(zio,<:nødopkald fra :>);
4 6149 vogn:= fil(nr).io_spool_post.data(1);
4 6150 i:= vogn shift (-22);
4 6151 if i < 2 then
4 6152 skrivid(zio,vogn,9)
4 6153 else
4 6154 begin
5 6155 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6156 write(zio,<:!!!:>,vogn);
5 6157 end;
4 6158 \f
4 6158 message procedure io_spon side 3 - 810507/hko;
4 6159
4 6159 if fil(nr).io_spool_post.data(3)<>0 then
4 6160 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6161
4 6161 if k = 46 then
4 6162 begin
5 6163 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6164 end;
4 6165 end <*disable*>
3 6166 else
3 6167 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6168
3 6168 fil(nr,1):= fil(nr,1) add 1;
3 6169
3 6169 <*V*> setposition(zio,0,0);
3 6170
3 6170 signal_bin(bs_zio_adgang);
3 6171
3 6171 signal(ss_io_spool_tomme);
3 6172
3 6172 until false;
3 6173
3 6173 io_spon_trap:
3 6174 skriv_io_spon(zbillede,1);
3 6175
3 6175 end io_spon;
2 6176 \f
2 6176 message procedure io_medd side 1;
2 6177
2 6177 procedure io_medd;
2 6178 begin
3 6179 integer array field opref;
3 6180 integer afs, kl, i;
3 6181 real dato, t;
3 6182
3 6182
3 6182 procedure skriv_io_medd(zud,omfang);
3 6183 value omfang;
3 6184 zone zud;
3 6185 integer omfang;
3 6186 begin
4 6187 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6188 if omfang > 0 then
4 6189 disable begin integer x;
5 6190 trap(slut);
5 6191 write(zud,"nl",1,
5 6192 <: opref: :>,opref,"nl",1,
5 6193 <: afs: :>,afs,"nl",1,
5 6194 <: kl: :>,kl,"nl",1,
5 6195 <: i: :>,i,"nl",1,
5 6196 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6197 <: t: :>,t,"nl",1,
5 6198 <::>);
5 6199 skriv_coru(zud,coru_no(104));
5 6200 slut:
5 6201 end;<*disable*>
4 6202 end skriv_io_medd;
3 6203
3 6203 trap(io_medd_trap);
3 6204 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6205 <*+2*>
3 6206 if testbit0 and overvåget or testbit28 then
3 6207 skriv_io_medd(out,0);
3 6208 <*-2*>
3 6209 \f
3 6209 message procedure io_medd side 2;
3 6210
3 6210 repeat
3 6211 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6212 <*V*> wait(bs_zio_adgang);
3 6213
3 6213 afs:= d.opref.data.op_spool_kilde;
3 6214 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6215 kl:= round t;
3 6216 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6217 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6218 i:= replacechar(1,'.');
3 6219 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6220 replacechar(1,i);
3 6221 write(z_io,d.opref.data.op_spool_text);
3 6222 setposition(z_io,0,0);
3 6223
3 6223 signalbin(bs_zio_adgang);
3 6224 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6225 until false;
3 6226
3 6226 io_medd_trap:
3 6227 skriv_io_medd(zbillede,1);
3 6228
3 6228 end io_medd;
2 6229 \f
2 6229 message operatør_erklæringer side 1 - 810602/hko;
2 6230 integer
2 6231 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6232 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6233 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6234 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6235 integer array
2 6236 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6237 operatørmaske(1:op_maske_lgd//2),
2 6238 op_talevej(0:max_antal_operatører),
2 6239 tv_operatør(0:max_antal_taleveje),
2 6240 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6241 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6242 ant_i_opkø,
2 6243 cs_operatør,
2 6244 cs_op_fil(1:max_antal_operatører);
2 6245 boolean
2 6246 op_cqf_tab_ændret;
2 6247 integer field
2 6248 op_spool_kilde;
2 6249 real field
2 6250 op_spool_tid;
2 6251 long array field
2 6252 op_spool_text;
2 6253 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6254 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6255 \f
2 6255 message procedure op_fejl side 1 - 830310/hko;
2 6256
2 6256 procedure op_fejl(z,s,b);
2 6257 integer s,b;
2 6258 zone z;
2 6259 begin
3 6260 disable begin
4 6261 integer array iz(1:20);
4 6262 integer i,j,k,n;
4 6263 integer array field iaf,iaf1,msk;
4 6264 boolean input;
4 6265 real array field laf,laf1;
4 6266
4 6266 getzone6(z,iz);
4 6267 iaf:=laf:=2;
4 6268 input:= iz(13) = 1;
4 6269 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6270 if iz.laf(1)=terminal_navn.laf1(1) and
4 6271 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6272
4 6272 <*+2*> if testbit31 then
4 6273 <**> begin
5 6274 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6275 <**> <:s=:>); outintbits(out,s);
5 6276 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6277 <**> else <:output:>,"nl",1);
5 6278 <**> setposition(out,0,0);
5 6279 <**> end;
4 6280 <*-2*>
4 6281 iaf:=j*terminal_beskr_længde;
4 6282 k:=1;
4 6283
4 6283 i:= terminal_tab.iaf.terminal_tilstand;
4 6284 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6285 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6286 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6287 if s <> (1 shift 21 +2) then
4 6288 begin
5 6289 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6290 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6291 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6292 sæt_bit_ia(opkaldsflag,j,0);
5 6293 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6294 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6295 begin
6 6296 msk:= k*op_maske_lgd;
6 6297 if læsbit_ia(bpl_def.msk,j) then
6 6298 <**> begin
7 6299 n:= 0;
7 6300 for i:= 1 step 1 until max_antal_operatører do
7 6301 if læsbit_ia(bpl_def.msk,i) then
7 6302 begin
8 6303 iaf1:= i*terminal_beskr_længde;
8 6304 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6305 n:= n+1;
8 6306 end;
7 6307 bpl_tilst(j,1):= n;
7 6308 end;
6 6309 <**> <*
6 6310 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6311 *> end;
5 6312 signal_bin(bs_mobil_opkald);
5 6313 end;
4 6314
4 6314 if input or -,input then
4 6315 begin
5 6316 z(1):=real <:<'?'><'?'><'em'>:>;
5 6317 b:=2;
5 6318 end;
4 6319 end; <*disable*>
3 6320 end op_fejl;
2 6321 \f
2 6321 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6322
2 6322 procedure tvswitch_fejl(z,s,b);
2 6323 integer s,b;
2 6324 zone z;
2 6325 begin
3 6326 disable begin
4 6327 integer array iz(1:20);
4 6328 integer i,j,k;
4 6329 integer array field iaf;
4 6330 boolean input;
4 6331 real array field raf;
4 6332
4 6332 getzone6(z,iz);
4 6333 iaf:=raf:=2;
4 6334 input:= iz(13) = 1;
4 6335 <*+2*> if testbit31 then
4 6336 <**> begin
5 6337 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6338 <**> <:s=:>); outintbits(out,s);
5 6339 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6340 <**> else <:output:>,"nl",1);
5 6341 <**> skrivhele(out,z,b,5);
5 6342 <**> setposition(out,0,0);
5 6343 <**> end;
4 6344 <*-2*>
4 6345 k:=1;
4 6346 if s <> (1 shift 21 +2) then
4 6347 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6348 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6349
4 6349 if input or -,input then
4 6350 begin
5 6351 z(1):=real <:<'em'>:>;
5 6352 b:=2;
5 6353 end;
4 6354 end; <*disable*>
3 6355 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6356 end tvswitch_fejl;
2 6357
2 6357 procedure skriv_talevejs_tab(z);
2 6358 zone z;
2 6359 begin
3 6360 write(z,"nl",2,<:talevejsswitch::>);
3 6361 write(z,"nl",1,<: operatører::>,"nl",1);
3 6362 for i:= 1 step 1 until max_antal_operatører do
3 6363 begin
4 6364 write(z,<< dd>,i,":",1,op_talevej(i));
4 6365 if i mod 8=0 then outchar(z,'nl');
4 6366 end;
3 6367 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6368 for i:= 1 step 1 until max_antal_taleveje do
3 6369 begin
4 6370 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6371 if i mod 8=0 then outchar(z,'nl');
4 6372 end;
3 6373 write(z,"nl",3);
3 6374 end;
2 6375 \f
2 6375 message procedure skriv_opk_alarm_tab side 1;
2 6376
2 6376 procedure skriv_opk_alarm_tab(z);
2 6377 zone z;
2 6378 begin
3 6379 integer nr;
3 6380 integer array field tab;
3 6381 real t;
3 6382
3 6382 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6383 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6384 for nr:=1 step 1 until max_antal_operatører do
3 6385 begin
4 6386 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6387 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6388 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6389 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6390 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6391 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6392 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6393 "nl",1);
4 6394 end;
3 6395 end;
2 6396 \f
2 6396 message procedure skriv_op_spool_buf side 1;
2 6397
2 6397 procedure skriv_op_spool_buf(z);
2 6398 zone z;
2 6399 begin
3 6400 integer array field ref;
3 6401 integer nr, kilde;
3 6402 real dato, kl;
3 6403
3 6403 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6404 for nr:= 1 step 1 until op_spool_postantal do
3 6405 begin
4 6406 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6407 ref:= (nr-1)*op_spool_postlgd;
4 6408 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6409 begin
5 6410 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6411 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6412 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6413 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6414 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6415 op_spool_buf.ref.op_spool_text);
5 6416 end;
4 6417 outchar(z,'nl');
4 6418 end;
3 6419 end;
2 6420
2 6420 procedure skriv_cqf_tabel(z,lang);
2 6421 value lang;
2 6422 zone z;
2 6423 boolean lang;
2 6424 begin
3 6425 integer array field ref;
3 6426 integer i,ant;
3 6427 real dato, kl;
3 6428
3 6428 ant:= 0;
3 6429 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6430 if -,lang then
3 6431 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6432 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6433 else
3 6434 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6435 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6436 for i:= 1 step 1 until max_cqf do
3 6437 begin
4 6438 ref:= (i-1)*cqf_lgd;
4 6439 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6440 begin
5 6441 ant:= ant+1;
5 6442 if lang then
5 6443 write(z,<<dd>,i,":",1);
5 6444 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6445 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6446 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6447 begin
6 6448 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6449 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6450 end
5 6451 else
5 6452 write(z,"sp",14,"?",1);
5 6453 if lang then
5 6454 begin
6 6455 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6456 begin
7 6457 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6458 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6459 end
6 6460 else
6 6461 write(z,"sp",14,"?",1);
6 6462 end
5 6463 else
5 6464 write(z,"sp",2);
5 6465 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6466 end;
4 6467 end;
3 6468 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6469 end;
2 6470
2 6470 procedure sorter_cqftab(l,u);
2 6471 value l,u;
2 6472 integer l,u;
2 6473 begin
3 6474 integer array field ii,jj;
3 6475 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6476
3 6476 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6477 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6478 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6479 repeat
3 6480 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6481 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6482 if ii <= jj then
3 6483 begin
4 6484 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6485 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6486 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6487 ii:= ii+cqf_lgd;
4 6488 jj:= jj-cqf_lgd;
4 6489 end;
3 6490 until ii>jj;
3 6491 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6492 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6493 end;
2 6494 \f
2 6494 message procedure ht_symbol side 1 - 851001/cl;
2 6495
2 6495 procedure ht_symbol(z);
2 6496 zone z;
2 6497 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6498
2 6498
2 6498
2 6498
2 6498 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6498 @@ @@ @@
2 6498 @@ @@ @@
2 6498 @@ @@ @@
2 6498 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6498 @@ @@
2 6498 @@ @@
2 6498 @@ @@
2 6498 @@ @@@@@@@@@@@@@ @@
2 6498 @@ @@ @@ @@
2 6498 @@ @@ @@ @@
2 6498 @@ @@ @@ @@
2 6498 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6498 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6499 \f
2 6499 message procedure definer_taster side 1 - 891214,cl;
2 6500
2 6500 procedure definer_taster(nr);
2 6501 value nr;
2 6502 integer nr;
2 6503 begin
3 6504
3 6504 setposition(z_op(nr),0,0);
3 6505 write(z_op(nr),
3 6506 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6507 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6508 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6509 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6510 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6511 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6512 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6513 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6514 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6515 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6516 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6517 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6518 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6519 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6520 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6521 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6522 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6523 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6524 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6525 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6526 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6527 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6528 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6529 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6530 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6531 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6532 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6533 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6534 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6535 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6536 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6537 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6538 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6539 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6540 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6541 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6542 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6543 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6544 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6545 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6546 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6547 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6548 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6549 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6550 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6551 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6552 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6553 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6554 <::>);
3 6555 end;
2 6556 \f
2 6556 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6557
2 6557 procedure skriv_terminal_tab(z);
2 6558 zone z;
2 6559 begin
3 6560 integer array field ref;
3 6561 integer t1,i,j,id,k;
3 6562
3 6562 write(z,"ff",1,<:
3 6563 ******* terminalbeskrivelser ********
3 6564
3 6564 # a k l p m m n o
3 6565 1 l a y a o o ø p
3 6566 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6567 <*
3 6568 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6569 *>
3 6570 for i:=1 step 1 until max_antal_operatører do
3 6571 begin
4 6572 ref:=i*terminal_beskr_længde;
4 6573 t1:=terminal_tab.ref(1);
4 6574 id:=terminal_tab.ref(2);
4 6575 k:=terminal_tab.ref(3);
4 6576 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6577 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6578 "sp",1);
4 6579 for j:=11 step -1 until 2 do
4 6580 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6581 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6582 "sp",1);
4 6583 skriv_id(z,id,9);
4 6584 skriv_id(z,k,9);
4 6585 end;
3 6586 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6587 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6588 write(z,"nl",1);
3 6589 end skriv_terminal_tab;
2 6590 \f
2 6590 message procedure h_operatør side 1 - 810520/hko;
2 6591
2 6591 <* hovedmodulkorutine for operatørterminaler *>
2 6592 procedure h_operatør;
2 6593 begin
3 6594 integer array field op_ref;
3 6595 integer k,nr,ant,ref,dest_sem;
3 6596 procedure skriv_hoperatør(zud,omfang);
3 6597 value omfang;
3 6598 zone zud;
3 6599 integer omfang;
3 6600 begin
4 6601
4 6601 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6602 if omfang>0 then
4 6603 disable begin integer x;
5 6604 trap(slut);
5 6605 write(zud,"nl",1,
5 6606 <: op_ref: :>,op_ref,"nl",1,
5 6607 <: nr: :>,nr,"nl",1,
5 6608 <: ant: :>,ant,"nl",1,
5 6609 <: ref: :>,ref,"nl",1,
5 6610 <: k: :>,k,"nl",1,
5 6611 <: dest_sem: :>,dest_sem,"nl",1,
5 6612 <::>);
5 6613 skriv_coru(zud,coru_no(200));
5 6614 slut:
5 6615 end;
4 6616 end skriv_hoperatør;
3 6617
3 6617 trap(hop_trap);
3 6618 stack_claim(if cm_test then 198 else 146);
3 6619
3 6619 <*+2*>
3 6620 if testbit8 and overvåget or testbit28 then
3 6621 skriv_hoperatør(out,0);
3 6622 <*-2*>
3 6623 \f
3 6623 message procedure h_operatør side 2 - 820304/hko;
3 6624
3 6624 repeat
3 6625 wait_ch(cs_op,op_ref,true,-1);
3 6626 <*+4*>
3 6627 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6628 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6629 <*-4*>
3 6630
3 6630 k:=d.op_ref.opkode extract 12;
3 6631 dest_sem:=
3 6632 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6633 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6634 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6635 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6636 if k=37 then cs_op_spool else
3 6637 if k=40 or k=38 then 0
3 6638 else -1;
3 6639 <*+4*>
3 6640 if dest_sem=-1 then
3 6641 begin
4 6642 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6643 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6644 end
3 6645 else
3 6646 <*-4*>
3 6647 if k=40 then
3 6648 begin
4 6649 dest_sem:= d.op_ref.retur;
4 6650 d.op_ref.retur:= cs_op_retur;
4 6651 for nr:= 1 step 1 until max_antal_operatører do
4 6652 begin
5 6653 inspect_ch(cs_operatør(nr),genoptype,ant);
5 6654 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 6655 or læsbit_ia(samtaleflag,nr))
5 6656 and læsbit_ia(operatørmaske,nr) then
5 6657 begin
6 6658 ref:= op_ref;
6 6659 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6660 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6661 <*+4*> if op_ref <> ref then
6 6662 fejlreaktion(11<*fr.post*>,op_ref,
6 6663 <:opdater opkaldskø,retur:>,0);
6 6664 <*-4*>
6 6665 end;
5 6666 end;
4 6667 d.op_ref.retur:= dest_sem;
4 6668 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6669 end
3 6670 else
3 6671 if k=38 then
3 6672 begin
4 6673 dest_sem:= d.opref.retur;
4 6674 d.op_ref.retur:= cs_op_retur;
4 6675 for nr:= 1 step 1 until max_antal_operatører do
4 6676 begin
5 6677 if d.opref.data.op_spool_kilde <> nr then
5 6678 begin
6 6679 ref:= op_ref;
6 6680 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6681 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6682 <*+4*> if op_ref <> ref then
6 6683 fejlreaktion(11<*fr.post*>,op_ref,
6 6684 <:opdater opkaldskø,retur:>,0);
6 6685 <*-4*>
6 6686 end;
5 6687 end;
4 6688 if d.opref.data.op_spool_kilde<>0 then
4 6689 begin
5 6690 ref:= op_ref;
5 6691 nr:= d.opref.data.op_spool_kilde;
5 6692 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 6693 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 6694 <*+4*> if op_ref <> ref then
5 6695 fejlreaktion(11<*fr.post*>,op_ref,
5 6696 <:operatørmedddelelse, retur:>,0);
5 6697 <*-4*>
5 6698 d.op_ref.retur:= dest_sem;
5 6699 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 6700 end
4 6701 else
4 6702 begin
5 6703 d.op_ref.retur:= dest_sem;
5 6704 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 6705 end;
4 6706 end
3 6707 else
3 6708 begin
4 6709 \f
4 6709 message procedure h_operatør side 3 - 810601/hko;
4 6710
4 6710 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 6711 begin
5 6712 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 6713 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 6714 +terminal_tab.iaf.terminal_tilstand extract 21;
5 6715 end;
4 6716 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6717 end;
3 6718 until false;
3 6719
3 6719 hop_trap:
3 6720 disable skriv_hoperatør(zbillede,1);
3 6721 end h_operatør;
2 6722 \f
2 6722 message procedure operatør side 1 - 820304/hko;
2 6723
2 6723 procedure operatør(nr);
2 6724 value nr;
2 6725 integer nr;
2 6726 begin
3 6727 integer array field op_ref,ref,vt_op,iaf,tab;
3 6728 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 6729 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 6730 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 6731 real kommstart,kommslut;
3 6732 \f
3 6732 message procedure operatør side 1a - 820301/hko;
3 6733
3 6733 procedure skriv_operatør(zud,omfang);
3 6734 value omfang;
3 6735 zone zud;
3 6736 integer omfang;
3 6737 begin integer i;
4 6738
4 6738 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 6739 write(zud,"sp",26-i);
4 6740 if omfang > 0 then
4 6741 disable begin
5 6742 integer x;
5 6743 trap(slut);
5 6744 write(zud,"nl",1,
5 6745 <: op-ref: :>,op_ref,"nl",1,
5 6746 <: kode: :>,kode,"nl",1,
5 6747 <: aktion: :>,aktion,"nl",1,
5 6748 <: ref: :>,ref,"nl",1,
5 6749 <: vt_op: :>,vt_op,"nl",1,
5 6750 <: iaf: :>,iaf,"nl",1,
5 6751 <: status: :>,status,"nl",1,
5 6752 <: tilstand: :>,tilstand,"nl",1,
5 6753 <: bv: :>,bv,"nl",1,
5 6754 <: bs: :>,bs,"nl",1,
5 6755 <: bs-tilst: :>,bs_tilst,"nl",1,
5 6756 <: kanal: :>,kanal,"nl",1,
5 6757 <: opgave: :>,opgave,"nl",1,
5 6758 <: pos: :>,pos,"nl",1,
5 6759 <: indeks: :>,indeks,"nl",1,
5 6760 <: sep: :>,sep,"nl",1,
5 6761 <: sluttegn: :>,sluttegn,"nl",1,
5 6762 <: vogn: :>,vogn,"nl",1,
5 6763 <: ll: :>,ll,"nl",1,
5 6764 <: garage: :>,garage,"nl",1,
5 6765 <: skærmmåde: :>,skærmmåde,"nl",1,
5 6766 <: res: :>,res,"nl",1,
5 6767 <: tab: :>,tab,"nl",1,
5 6768 <: rkom: :>,rkom,"nl",1,
5 6769 <: par1: :>,par1,"nl",1,
5 6770 <: par2: :>,par2,"nl",1,
5 6771 <::>);
5 6772 skriv_coru(zud,coru_no(200+nr));
5 6773 slut:
5 6774 end;
4 6775 end skriv_operatør;
3 6776 \f
3 6776 message procedure skærmstatus side 1 - 810518/hko;
3 6777
3 6777 integer
3 6778 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 6779 integer tilstand,b_v,b_s,b_s_tilst;
3 6780 begin
4 6781 integer i,j;
4 6782
4 6782 i:= terminal_tab.ref(1);
4 6783 b_s:= terminal_tab.ref(2);
4 6784 b_s_tilst:= i extract 12;
4 6785 j:= b_s_tilst extract 3;
4 6786 b_v:= i shift (-12) extract 4;
4 6787 tilstand:= i shift (-21);
4 6788
4 6788 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 6789 if b_v = 0 and j = 1<*opkald*> then 1 else
4 6790 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 6791 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 6792 end skærmstatus;
3 6793 \f
3 6793 message procedure skriv_skærm side 1 - 810522/hko;
3 6794
3 6794 procedure skriv_skærm(nr);
3 6795 value nr;
3 6796 integer nr;
3 6797 begin
4 6798 integer i;
4 6799
4 6799 disable definer_taster(nr);
4 6800
4 6800 skriv_skærm_maske(nr);
4 6801 skriv_skærm_opkaldskø(nr);
4 6802 skriv_skærm_b_v_s(nr);
4 6803 for i:= 1 step 1 until max_antal_kanaler do
4 6804 skriv_skærm_kanal(nr,i);
4 6805 cursor(z_op(nr),1,1);
4 6806 <*V*> setposition(z_op(nr),0,0);
4 6807 end skriv_skærm;
3 6808 \f
3 6808 message procedure skriv_skærm_id side 1 - 830310/hko;
3 6809
3 6809 procedure skriv_skærm_id(nr,id,nød);
3 6810 value nr,id,nød;
3 6811 integer nr,id;
3 6812 boolean nød;
3 6813 begin
4 6814 integer linie,løb,bogst,i,p;
4 6815
4 6815 i:= id shift (-22);
4 6816
4 6816 case i+1 of
4 6817 begin
5 6818 begin <* busnr *>
6 6819 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 6820 (id extract 14) mod 10000);
6 6821 if id shift (-14) extract 8 > 0 then
6 6822 p:= p+write(z_op(nr),".",1,
6 6823 string bpl_navn(id shift (-14) extract 8));
6 6824 write(z_op(nr),"sp",11-p);
6 6825 end;
5 6826
5 6826 begin <*linie/løb*>
6 6827 linie:= id shift (-12) extract 10;
6 6828 bogst:= id shift (-7) extract 5;
6 6829 if bogst > 0 then bogst:= bogst +'A'-1;
6 6830 løb:= id extract 7;
6 6831 write(z_op(nr),if nød then "*" else "sp",1,
6 6832 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 6833 false add bogst,1,"/",1,løb,
6 6834 "sp",if løb > 9 then 3 else 4);
6 6835 end;
5 6836
5 6836 begin <*gruppe*>
6 6837 write(z_op(nr),<:GRP :>);
6 6838 if id shift (-21) extract 1 = 1 then
6 6839 begin <*specialgruppe*>
7 6840 løb:= id extract 7;
7 6841 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 6842 <<d>,løb,"sp",2);
7 6843 end
6 6844 else
6 6845 begin
7 6846 linie:= id shift (-5) extract 10;
7 6847 bogst:= id extract 5;
7 6848 if bogst > 0 then bogst:= bogst +'A'-1;
7 6849 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 6850 false add bogst,1,"sp",2);
7 6851 end;
6 6852 end;
5 6853
5 6853 <* kanal eller område *>
5 6854 begin
6 6855 linie:= (id shift (-20) extract 2) + 1;
6 6856 case linie of
6 6857 begin
7 6858 write(z_op(nr),"sp",11-write(z_op(nr),
7 6859 string kanal_navn(id extract 20)));
7 6860 write(z_op(nr),<:K*:>,"sp",9);
7 6861 write(z_op(nr),"sp",11-write(z_op(nr),
7 6862 <:OMR :>,string område_navn(id extract 20)));
7 6863 write(z_op(nr),<:ALLE:>,"sp",7);
7 6864 end;
6 6865 end;
5 6866
5 6866 end <* case i *>
4 6867 end skriv_skærm_id;
3 6868 \f
3 6868 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 6869
3 6869 procedure skriv_skærm_kanal(nr,kanal);
3 6870 value nr,kanal;
3 6871 integer nr,kanal;
3 6872 begin
4 6873 integer i,j,k,t,omr;
4 6874 integer array field tref,kref;
4 6875 boolean nød;
4 6876
4 6876 tref:= nr*terminal_beskr_længde;
4 6877 kref:= (kanal-1)*kanal_beskr_længde;
4 6878 t:= kanaltab.kref.kanal_tilstand;
4 6879 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 6880 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 6881 cursor(z_op(nr),kanal+2,28);
4 6882 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 6883 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 6884 " ",1," ",1);
4 6885 write(z_op(nr),true,6,string kanal_navn(kanal));
4 6886 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 6887 pabx_id(kanal_id(kanal) extract 5)
4 6888 else
4 6889 radio_id(kanal_id(kanal) extract 5);
4 6890 for i:= -2 step 1 until 0 do
4 6891 begin
5 6892 write(z_op(nr),
5 6893 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 6894 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 6895 end;
4 6896 write(z_op(nr),<:: :>);
4 6897 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 6898 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 6899 begin
5 6900 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 6901 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 6902 end
4 6903 else
4 6904 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 6905 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 6906 else
4 6907 if i > 0 and
4 6908 ( i <> nr
4 6909 or j = kanal <* kanal = kanalnr for ventepos *>
4 6910 or (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 6911 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 6912 begin
5 6913 write(z_op(nr),<:OPT :>);
5 6914 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 6915 else write(z_op(nr),string bpl_navn(i));
5 6916 end
4 6917 else
4 6918 if false then
4 6919 begin
5 6920 i:= kanaltab.kref.kanal_id1;
5 6921 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 6922 skriv_skærm_id(nr,i,nød);
5 6923 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 6924 i:= kanaltab.kref.kanal_id2;
5 6925 if i<>0 then skriv_skærm_id(nr,i,false);
5 6926 end;
4 6927 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6928 end skriv_skærm_kanal;
3 6929 \f
3 6929 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 6930
3 6930 procedure skriv_skærm_b_v_s(nr);
3 6931 value nr;
3 6932 integer nr;
3 6933 begin
4 6934 integer i,j,k,kv,ks,t;
4 6935 integer array field tref,kref;
4 6936
4 6936 tref:= nr*terminal_beskr_længde;
4 6937 i:= terminal_tab.tref.terminal_tilstand;
4 6938 kv:= i shift (-12) extract 4;
4 6939 ks:= terminaltab.tref(2) extract 20;
4 6940 <*V*> setposition(z_op(nr),0,0);
4 6941 cursor(z_op(nr),18,28);
4 6942 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6943 cursor(z_op(nr),20,28);
4 6944 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6945 cursor(z_op(nr),21,28);
4 6946 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6947 cursor(z_op(nr),20,28);
4 6948 if op_talevej(nr)<>0 then
4 6949 begin
5 6950 cursor(z_op(nr),18,28);
5 6951 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 6952 end;
4 6953 if kv <> 0 then
4 6954 begin
5 6955 kref:= (kv-1)*kanal_beskr_længde;
5 6956 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 6957 else kanaltab.kref.kanal_id2;
5 6958 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 6959 else kanaltab.kref.kanal_alt_id2;
5 6960 write(z_op(nr),true,6,string kanal_navn(kv));
5 6961 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 6962 skriv_skærm_id(nr,k,false);
5 6963 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 6964 end;
4 6965
4 6965 cursor(z_op(nr),21,28);
4 6966 j:= terminal_tab.tref(2);
4 6967 if i shift (-21) <> 0 <*ikke ledig*> then
4 6968 begin
5 6969 \f
5 6969 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 6970
5 6970 if i shift (-21) = 1 <*samtale*> then
5 6971 begin
6 6972 if j shift (-20) = 12 then
6 6973 begin
7 6974 write(z_op(nr),true,6,string kanal_navn(ks));
7 6975 end
6 6976 else
6 6977 begin
7 6978 write(z_op(nr),true,6,<:K*:>);
7 6979 k:= 0;
7 6980 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 6981 k:= k+1;
7 6982 ks:= k;
7 6983 end;
6 6984 kref:= (ks-1)*kanal_beskr_længde;
6 6985 t:= kanaltab.kref.kanaltilstand;
6 6986 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 6987 t shift (-3) extract 1 = 1);
6 6988 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 6989 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 6990 if t shift (-5) extract 1 = 1 then <:MON :> else
6 6991 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 6992 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 6993 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 6994 if t shift (-9) extract 1 = 1 then
6 6995 write(z_op(nr),<:ALLE :>);
6 6996 if t shift (-8) extract 1 = 1 then
6 6997 write(z_op(nr),<:KATASTROFE :>);
6 6998 k:= kanaltab.kref.kanal_spec;
6 6999 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7000 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7001 end
5 7002 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7003 begin
6 7004 write(z_op(nr),<:K-:>,"sp",3);
6 7005 if j <> 0 then
6 7006 skriv_skærm_id(nr,j,false)
6 7007 else
6 7008 begin
7 7009 j:=terminal_tab.tref(3);
7 7010 skriv_skærm_id(nr,j,
7 7011 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7012 else 0));
7 7013 end;
6 7014 write(z_op(nr),<:OPT:>);
6 7015 end;
5 7016 end;
4 7017 <*V*> setposition(z_op(nr),0,0);
4 7018 end skriv_skærm_b_v_s;
3 7019 \f
3 7019 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7020
3 7020 procedure skriv_skærm_maske(nr);
3 7021 value nr;
3 7022 integer nr;
3 7023 begin
4 7024 integer i;
4 7025 <*V*> setposition(z_op(nr),0,0);
4 7026 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7027 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7028 "sp",1,"*",5,"nl",1,"-",80);
4 7029
4 7029 for i:= 3 step 1 until 21 do
4 7030 begin
5 7031 cursor(z_op(nr),i,26);
5 7032 outchar(z_op(nr),'!');
5 7033 end;
4 7034 cursor(z_op(nr),22,1);
4 7035 write(z_op(nr),"-",80);
4 7036 cursor(z_op(nr),1,1);
4 7037 <*V*> setposition(z_op(nr),0,0);
4 7038 end skriv_skærm_maske;
3 7039 \f
3 7039 message procedure skal_udskrives side 1 - 940522/cl;
3 7040
3 7040 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7041 value fordelt_til,aktuel_skærm;
3 7042 integer fordelt_til,aktuel_skærm;
3 7043 begin
4 7044 boolean skal_ud;
4 7045 integer n;
4 7046 integer array field iaf;
4 7047
4 7047 skal_ud:= true;
4 7048 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7049 begin
5 7050 for n:= 0 step 1 until 3 do
5 7051 begin
6 7052 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7053 begin
7 7054 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7055 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7056 goto returner;
7 7057 end;
6 7058 end;
5 7059 end;
4 7060 returner:
4 7061 skal_udskrives:= skal_ud;
4 7062 end;
3 7063
3 7063 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7064
3 7064 procedure skriv_skærm_opkaldskø(nr);
3 7065 value nr;
3 7066 integer nr;
3 7067 begin
4 7068 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7069 integer array field ref,iaf,tab;
4 7070 boolean skal_ud;
4 7071
4 7071 <*V*> wait(bs_opkaldskø_adgang);
4 7072 setposition(z_op(nr),0,0);
4 7073 ant:= 0; kmdo:= 0;
4 7074 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7075 ref:= første_nødopkald;
4 7076 if ref=0 then ref:=første_opkald;
4 7077 while ref <> 0 do
4 7078 begin
5 7079 i:= opkaldskø.ref(4);
5 7080 operatør:= i extract 8;
5 7081 type:=i shift (-8) extract 4;
5 7082
5 7082 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7083 *>
5 7084 if operatør > 64 then
5 7085 begin
6 7086 <* fordelt til gruppe af betjeningspladser *>
6 7087 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7088 while skal_ud and i<max_antal_operatører do
6 7089 begin
7 7090 i:=i+1;
7 7091 if læsbit_ia(bpl_def.iaf,i) then
7 7092 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7093 end;
6 7094 end
5 7095 else
5 7096 skal_ud:= skal_udskrives(operatør,nr);
5 7097 if skal_ud then
5 7098 begin
6 7099 ant:= ant +1;
6 7100 if ant < 6 then
6 7101 begin
7 7102 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7103 ttmm:= i shift (-12);
7 7104 vogn:= opkaldskø.ref(3);
7 7105 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7106 skriv_skærm_id(nr,vogn,type=2);
7 7107 write(z_op(nr),true,4,
7 7108 string område_navn(opkaldskø.ref(5) extract 4),
7 7109 <<zd.dd>,ttmm/100.0);
7 7110 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7111 begin
8 7112 if opkaldskø.ref(5) extract 4 <= 2 or
8 7113 opk_alarm.tab.alarm_lgd = 0 then
8 7114 begin
9 7115 if type=2 then
9 7116 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7117 else
9 7118 write(z_op(nr),"bel",1);
9 7119 end
8 7120 else if type>kmdo then kmdo:= type;
8 7121 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7122 end;
7 7123 end;<* ant < 6 *>
6 7124 end;<* operatør ok *>
5 7125
5 7125 ref:= opkaldskø.ref(1) extract 12;
5 7126 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7127 end;
4 7128 \f
4 7128 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7129
4 7129 signal_bin(bs_opkaldskø_adgang);
4 7130 if kmdo > opk_alarm.tab.alarm_tilst and
4 7131 kmdo > opk_alarm.tab.alarm_kmdo then
4 7132 begin
5 7133 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7134 signal_bin(bs_opk_alarm);
5 7135 end;
4 7136 if ant > 5 then
4 7137 begin
5 7138 cursor(z_op(nr),13,9);
5 7139 write(z_op(nr),<<+ddd>,ant-5);
5 7140 end
4 7141 else
4 7142 begin
5 7143 for i:= ant +1 step 1 until 6 do
5 7144 begin
6 7145 cursor(z_op(nr),i*2+1,1);
6 7146 write(z_op(nr),"sp",25);
6 7147 end;
5 7148 end;
4 7149 ant_i_opkø(nr):= ant;
4 7150 cursor(z_op(nr),1,1);
4 7151 <*V*> setposition(z_op(nr),0,0);
4 7152 end skriv_skærm_opkaldskø;
3 7153 \f
3 7153 message procedure operatør side 2 - 810522/hko;
3 7154
3 7154 trap(op_trap);
3 7155 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7156
3 7156 ref:= nr*terminal_beskr_længde;
3 7157 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7158 skærmmåde:= 0; <*normal*>
3 7159
3 7159 if operatør_auto_include(nr) then
3 7160 begin
4 7161 waitch(cs_att_pulje,opref,true,-1);
4 7162 i:= operatør_auto_include(nr) extract 2;
4 7163 if i<>3 then i:= 0;
4 7164 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7165 d.opref.data(1):= nr;
4 7166 signalch(cs_rad,opref,gen_optype or io_optype);
4 7167 end;
3 7168
3 7168 <*+2*>
3 7169 if testbit8 and overvåget or testbit28 then
3 7170 skriv_operatør(out,0);
3 7171 <*-2*>
3 7172 \f
3 7172 message procedure operatør side 3 - 810602/hko;
3 7173
3 7173 repeat
3 7174
3 7174 <*V*> wait_ch(cs_operatør(nr),
3 7175 op_ref,
3 7176 true,
3 7177 -1<*timeout*>);
3 7178 <*+2*>
3 7179 if testbit9 and overvåget then
3 7180 disable begin
4 7181 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7182 <: til operatør :>,nr);
4 7183 skriv_op(out,op_ref);
4 7184 end;
3 7185 <*-2*>
3 7186 monitor(8)reserve process:(z_op(nr),0,ia);
3 7187 kode:= d.op_ref.op_kode extract 12;
3 7188 i:= terminal_tab.ref.terminal_tilstand;
3 7189 status:= i shift(-21);
3 7190 opgave:=
3 7191 if kode=0 then 1 <* indlæs kommando *> else
3 7192 if kode=1 then 2 <* inkluder *> else
3 7193 if kode=2 then 3 <* ekskluder *> else
3 7194 if kode=40 then 4 <* opdater skærm *> else
3 7195 if kode=43 then 5 <* opkald etableret *> else
3 7196 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7197 if kode=38 then 7 <* operatør meddelelse *> else
3 7198 0; <* afvises *>
3 7199
3 7199 aktion:= case status +1 of(
3 7200 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7201 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7202 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7203 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7204 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7205 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7206 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7207 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7208 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7209 -1);
3 7210 \f
3 7210 message procedure operatør side 4 - 810424/hko;
3 7211
3 7211 case aktion+6 of
3 7212 begin
4 7213 begin
5 7214 <*-5: terminal optaget *>
5 7215
5 7215 d.op_ref.resultat:= 16;
5 7216 afslut_operation(op_ref,-1);
5 7217 end;
4 7218
4 7218 begin
5 7219 <*-4: operation uden virkning *>
5 7220
5 7220 afslut_operation(op_ref,-1);
5 7221 end;
4 7222
4 7222 begin
5 7223 <*-3: ulovlig operationskode *>
5 7224
5 7224 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7225 afslut_operation(op_ref,-1);
5 7226 end;
4 7227
4 7227 begin
5 7228 <*-2: ulovligt operatørterminal_nr *>
5 7229
5 7229 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7230 afslut_operation(op_ref,-1);
5 7231 end;
4 7232
4 7232 begin
5 7233 <*-1: ulovlig operatørtilstand *>
5 7234
5 7234 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7235 afslut_operation(op_ref,-1);
5 7236 end;
4 7237
4 7237 begin
5 7238 <* 0: ikke implementeret *>
5 7239
5 7239 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7240 afslut_operation(op_ref,-1);
5 7241 end;
4 7242
4 7242 begin
5 7243 \f
5 7243 message procedure operatør side 5 - 851001/cl;
5 7244
5 7244 <* 1: indlæs kommando *>
5 7245
5 7245
5 7245 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7246 if opk_alarm.tab.alarm_tilst > 0 then
5 7247 begin
6 7248 opk_alarm.tab.alarm_kmdo:= 3;
6 7249 signal_bin(bs_opk_alarm);
6 7250 pass;
6 7251 end;
5 7252 if d.op_ref.resultat > 3 then
5 7253 begin
6 7254 <*V*> setposition(z_op(nr),0,0);
6 7255 cursor(z_op(nr),24,1);
6 7256 skriv_kvittering(z_op(nr),op_ref,pos,
6 7257 d.op_ref.resultat);
6 7258 end
5 7259 else if d.op_ref.resultat = -1 then
5 7260 begin
6 7261 skærmmåde:= 0;
6 7262 skrivskærm(nr);
6 7263 end
5 7264 else if d.op_ref.resultat>0 then
5 7265 begin <*godkendt*>
6 7266 kode:=d.op_ref.opkode;
6 7267 i:= kode extract 12;
6 7268 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7269 if kode = 19 then 1 <*VO,S *> else
6 7270 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7271 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7272 if kode = 6 then 4 <*STop*> else
6 7273 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7274 if kode = 30 then 5 <*SP,D*> else
6 7275 if kode = 31 then 6 <*SP*> else
6 7276 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7277 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7278 if kode = 83 then 8 <*SL*> else
6 7279 if kode = 68 then 9 <*ST,D*> else
6 7280 if kode = 69 then 10 <*ST,V*> else
6 7281 if kode = 36 then 11 <*AL*> else
6 7282 if kode = 37 then 12 <*CC*> else
6 7283 if kode = 2 then 13 <*EX*> else
6 7284 if kode = 92 then 14 <*CQF,V*> else
6 7285 0;
6 7286 if j > 0 then
6 7287 begin
7 7288 case j of
7 7289 begin
8 7290 begin
9 7291 \f
9 7291 message procedure operatør side 6 - 851001/cl;
9 7292
9 7292 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7293
9 7293 vogn:=ia(1);
9 7294 ll:=ia(2);
9 7295 kanal:= if kode=11 or kode=19 then ia(3) else
9 7296 if kode=12 then ia(2) else 0;
9 7297 <*V*> wait_ch(cs_vt_adgang,
9 7298 vt_op,
9 7299 gen_optype,
9 7300 -1<*timeout sek*>);
9 7301 start_operation(vtop,200+nr,cs_operatør(nr),
9 7302 kode);
9 7303 d.vt_op.data(1):=vogn;
9 7304 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7305 d.vt_op.data(2):=ll;
9 7306 if kode=19 then d.vt_op.data(3):= kanal else
9 7307 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7308 indeks:= vt_op;
9 7309 signal_ch(cs_vt,
9 7310 vt_op,
9 7311 gen_optype or op_optype);
9 7312
9 7312 <*V*> wait_ch(cs_operatør(nr),
9 7313 vt_op,
9 7314 op_optype,
9 7315 -1<*timeout sek*>);
9 7316 <*+2*> if testbit10 and overvåget then
9 7317 disable begin
10 7318 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7319 <:: operation retur fra vt:>);
10 7320 skriv_op(out,vt_op);
10 7321 end;
9 7322 <*-2*>
9 7323 <*+4*> if vt_op<>indeks then
9 7324 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7325 <:operatør-kommando:>,0);
9 7326 <*-4*>
9 7327 <*V*> setposition(z_op(nr),0,0);
9 7328 cursor(z_op(nr),24,1);
9 7329 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7330 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7331 else vt_op,-1,d.vt_op.resultat);
9 7332 d.vt_op.optype:= gen_optype or vt_optype;
9 7333 disable afslut_operation(vt_op,cs_vt_adgang);
9 7334 end;
8 7335 begin
9 7336 \f
9 7336 message procedure operatør side 7 - 810921/hko,cl;
9 7337
9 7337 <* 2 vogntabel,linienr/-,busnr *>
9 7338
9 7338 d.op_ref.retur:= cs_operatør(nr);
9 7339 tofrom(d.op_ref.data,ia,10);
9 7340 indeks:= op_ref;
9 7341 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7342 wait_ch(cs_operatør(nr),
9 7343 op_ref,
9 7344 op_optype,
9 7345 -1<*timeout*>);
9 7346 <*+2*> if testbit10 and overvåget then
9 7347 disable begin
10 7348 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7349 skriv_op(out,op_ref);
10 7350 end;
9 7351 <*-2*>
9 7352 <*+4*>
9 7353 if indeks <> op_ref then
9 7354 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7355 <*-4*>
9 7356 i:= d.op_ref.resultat;
9 7357 if i = 0 or i > 3 then
9 7358 begin
10 7359 <*V*> setposition(z_op(nr),0,0);
10 7360 cursor(z_op(nr),24,1);
10 7361 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7362 end
9 7363 else
9 7364 begin
10 7365 integer antal,fil_ref;
10 7366
10 7366 skærm_måde:= 1;
10 7367 antal:= d.op_ref.data(6);
10 7368 fil_ref:= d.op_ref.data(7);
10 7369 <*V*> setposition(z_op(nr),0,0);
10 7370 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7371 "sp",14,"*",10,"sp",6,
10 7372 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7373 <*V*> setposition(z_op(nr),0,0);
10 7374 \f
10 7374 message procedure operatør side 8 - 841213/cl;
10 7375
10 7375 pos:= 1;
10 7376 while pos <= antal do
10 7377 begin
11 7378 integer bogst,løb;
11 7379
11 7379 disable i:= læs_fil(fil_ref,pos,j);
11 7380 if i <> 0 then
11 7381 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7382 else
11 7383 begin
12 7384 vogn:= fil(j,1) shift (-24) extract 24;
12 7385 løb:= fil(j,1) extract 24;
12 7386 if d.op_ref.opkode=9 then
12 7387 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7388 ll:= løb shift (-12) extract 10;
12 7389 bogst:= løb shift (-7) extract 5;
12 7390 if bogst > 0 then bogst:= bogst +'A'-1;
12 7391 løb:= løb extract 7;
12 7392 vogn:= vogn extract 14;
12 7393 i:= d.op_ref.opkode-8;
12 7394 for i:= i,i+1 do
12 7395 begin
13 7396 j:= (i+1) extract 1;
13 7397 case j +1 of
13 7398 begin
14 7399 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7400 false add bogst,1,"/",1,<<d__>,løb);
14 7401 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7402 end;
13 7403 end;
12 7404 if pos mod 5 = 0 then
12 7405 begin
13 7406 outchar(z_op(nr),'nl');
13 7407 <*V*> setposition(z_op(nr),0,0);
13 7408 end
12 7409 else write(z_op(nr),"sp",3);
12 7410 end;
11 7411 pos:=pos+1;
11 7412 end;
10 7413 write(z_op(nr),"*",1,"nl",1);
10 7414 \f
10 7414 message procedure operatør side 8a- 810507/hko;
10 7415
10 7415 d.opref.opkode:=104; <*slet-fil*>
10 7416 d.op_ref.data(4):=filref;
10 7417 indeks:=op_ref;
10 7418 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7419 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7420
10 7420 <*+2*> if testbit10 and overvåget then
10 7421 disable begin
11 7422 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7423 skriv_op(out,op_ref);
11 7424 end;
10 7425 <*-2*>
10 7426
10 7426 <*+4*> if op_ref<>indeks then
10 7427 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7428 <*-4*>
10 7429 if d.op_ref.data(9)<>0 then
10 7430 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7431 <:operatør, slet_fil:>,1);
10 7432 end;
9 7433 end;
8 7434
8 7434 begin
9 7435 \f
9 7435 message procedure operatør side 9 - 830310/hko;
9 7436
9 7436 <* 3 radio_kommandoer *>
9 7437
9 7437 kode:= d.op_ref.opkode;
9 7438 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7439 disable if testbit14 then
9 7440 begin
10 7441 integer i; <*lav en trap-bar blok*>
10 7442
10 7442 trap(test14_trap);
10 7443 systime(1,0,kommstart);
10 7444 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7445 string bpl_navn(nr),<: start :>,case rkom of (
10 7446 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7447 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7448 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7449 <:GE,T:>),<: :>);
10 7450 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7451 rkom=16 or rkom=17 or rkom=19)
10 7452 then
10 7453 begin
11 7454 if par1<>0 then skriv_id(zrl,par1,0);
11 7455 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7456 write(zrl,"sp",1,string områdenavn(par2));
11 7457 end
10 7458 else
10 7459 if rkom=10 and par1<>0 then
10 7460 write(zrl,string kanalnavn(par1 extract 20))
10 7461 else
10 7462 if rkom=5 or rkom=6 then
10 7463 begin
11 7464 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7465 if par1 shift (-20)=14 then
11 7466 write(zrl,string områdenavn(par1 extract 20));
11 7467 end;
10 7468 test14_trap: outchar(zrl,'nl');
10 7469 end;
9 7470 d.op_ref.data(4):= nr; <*operatør*>
9 7471 opgave:=
9 7472 if kode = 45 <*OP *> then 1 else
9 7473 if kode = 46 <*ME *> then 2 else
9 7474 if kode = 47 <*OP,G*> then 3 else
9 7475 if kode = 48 <*ME,G*> then 4 else
9 7476 if kode = 49 <*OP,A*> then 5 else
9 7477 if kode = 50 <*ME,A*> then 6 else
9 7478 if kode = 51 <*KA,C*> then 7 else
9 7479 if kode = 52 <*KA,P*> then 8 else
9 7480 if kode = 53 <*OP,L*> then 9 else
9 7481 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7482 if kode = 55 <*VE *> then 14 else
9 7483 if kode = 56 <*NE *> then 12 else
9 7484 if kode = 57 <*OP,V*> then 1 else
9 7485 if kode = 58 <*OP,T*> then 1 else
9 7486 if kode = 59 <*R *> then 13 else
9 7487 if kode = 60 <*GE *> then 15 else
9 7488 if kode = 61 <*GE,G*> then 16 else
9 7489 if kode = 62 <*GE,V*> then 15 else
9 7490 if kode = 63 <*GE,T*> then 15 else
9 7491 -1;
9 7492 <*+4*> if opgave < 0 then
9 7493 fejlreaktion(2<*operationskode*>,kode,
9 7494 <:operatør, radio-kommando :>,0);
9 7495 <*-4*>
9 7496 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7497 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7498 if 5<=opgave and opgave<=8 then
9 7499 d.opref.data(2):= -1;
9 7500 if opgave=13 then d.opref.data(2):=
9 7501 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7502 then 0 else 1);
9 7503 if opgave = 14 then d.opref.data(2):= 1;
9 7504 if opgave=7 or opgave=8 then
9 7505 d.opref.data(3):= -1
9 7506 else
9 7507 if opgave=5 or opgave=6 then
9 7508 begin
10 7509 if ia(1) shift (-20) = 15 then
10 7510 begin
11 7511 d.opref.data(3):= 15 shift 20;
11 7512 for j:= 1 step 1 until max_antal_kanaler do
11 7513 begin
12 7514 iaf:= (j-1)*kanalbeskrlængde;
12 7515 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7516 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7517 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7518 end;
11 7519 end
10 7520 else
10 7521 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7522 else ia(1);
10 7523 end
9 7524 else
9 7525 if kode = 57 then d.opref.data(3):= 2 else
9 7526 if kode = 58 then d.opref.data(3):= 1 else
9 7527 if kode = 62 then d.opref.data(3):= 2 else
9 7528 if kode = 63 then d.opref.data(3):= 1 else
9 7529 d.opref.data(3):= ia(2);
9 7530
9 7530 <* !!! i første if-sætning nedenfor er 'status>1'
9 7531 rettet til 'status>0' for at forhindre
9 7532 at opkald nr. 2 kan udføres med et allerede
9 7533 etableret opkald i skærmens s-felt,
9 7534 jvf. ulykke d. 7/2-1995
9 7535 !!! *>
9 7536 res:=
9 7537 if (opgave=1 or opgave=3) and status>0
9 7538 then 16 <*skærm optaget*> else
9 7539 if (opgave=15 or opgave=16) and
9 7540 status>1 then 16 <*skærm optaget*> else
9 7541 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7542 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7543 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7544 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7545 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7546 then 52 else 1) else
9 7547 if opgave<11 and status>0 then 16 else
9 7548 if opgave=11 and status<2 then 21 else
9 7549 if opgave=12 and status=0 then 22 else
9 7550 if opgave=13 and status=0 then 49 else
9 7551 if opgave=14 and status<>3 then 21 else 1;
9 7552 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7553 begin <* specialbetingelser for TLF og VHF *>
10 7554 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7555 end;
9 7556 if skærmmåde<>0 then
9 7557 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7558 kode:= opgave;
9 7559 if opgave = 15 then opgave:= 1 else
9 7560 if opgave = 16 then opgave:= 3;
9 7561 \f
9 7561 message procedure operatør side 10 - 810616/hko;
9 7562
9 7562 <* tilknyt talevej (om nødvendigt) *>
9 7563 if res = 1 and op_talevej(nr)=0 then
9 7564 begin
10 7565 i:= sidste_tv_brugt;
10 7566 repeat
10 7567 i:= (i mod max_antal_taleveje)+1;
10 7568 if tv_operatør(i)=0 then
10 7569 begin
11 7570 tv_operatør(i):= nr;
11 7571 op_talevej(nr):= i;
11 7572 end;
10 7573 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7574 if op_talevej(nr)=0 then
10 7575 res:=61
10 7576 else
10 7577 begin
11 7578 sidste_tv_brugt:=
11 7579 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7580
11 7580 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7581 start_operation(iaf,200+nr,cs_operatør(nr),
11 7582 'A' shift 12 + 44);
11 7583 d.iaf.data(1):= op_talevej(nr);
11 7584 d.iaf.data(2):= nr+16;
11 7585 ll:= 0;
11 7586 repeat
11 7587 signalch(cs_talevejsswitch,iaf,op_optype);
11 7588 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7589 ll:= ll+1;
11 7590 until ll=3 or d.iaf.resultat=3;
11 7591 res:= if d.iaf.resultat=3 then 1 else 61;
11 7592 <* ********* *>
11 7593 delay(1);
11 7594 start_operation(iaf,200+nr,cs_operatør(nr),
11 7595 'R' shift 12 + 44);
11 7596 ll:= 0;
11 7597 repeat
11 7598 signalch(cs_talevejsswitch,iaf,op_optype);
11 7599 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7600 ll:= ll+1;
11 7601 until ll=3 or d.iaf.resultat=3;
11 7602 <* ********* *>
11 7603 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7604 if res<>1 then
11 7605 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7606 end;
10 7607 end;
9 7608 if op_talevej(nr)=0 then res:= 61;
9 7609 d.op_ref.data(1):= op_talevej(nr);
9 7610
9 7610 if res <= 1 then
9 7611 begin
10 7612 til_radio: <* send operation til radiomodul *>
10 7613 d.op_ref.opkode:= opgave shift 12 + 41;
10 7614 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7615 else 0;
10 7616 d.op_ref.data(6):= b_s;
10 7617 d.op_ref.resultat:=0;
10 7618 d.op_ref.retur:= cs_operatør(nr);
10 7619 indeks:= op_ref;
10 7620 <*+2*> if testbit11 and overvåget then
10 7621 disable begin
11 7622 skriv_operatør(out,0);
11 7623 write(out,<: operation til radio:>);
11 7624 skriv_op(out,op_ref); ud;
11 7625 end;
10 7626 <*-2*>
10 7627 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7628 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7629
10 7629 <*+2*> if testbit12 and overvåget then
10 7630 disable begin
11 7631 skriv_operatør(out,0);
11 7632 write(out,<: operation retur fra radio:>);
11 7633 skriv_op(out,op_ref); ud;
11 7634 end;
10 7635 <*-2*>
10 7636 <*+4*> if op_ref <> indeks then
10 7637 fejlreaktion(11<*fr.post*>,op_ref,
10 7638 <:operatør, retur fra radio:>,0);
10 7639 <*-4*>
10 7640 \f
10 7640 message procedure operatør side 11 - 810529/hko;
10 7641
10 7641 res:= d.op_ref.resultat;
10 7642 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7643 begin
11 7644 <*+4*> if res < 2 then
11 7645 fejlreaktion(3<*prg.fejl*>,res,
11 7646 <: operatør,radio_op,resultat:>,1);
11 7647 <*-4*>
11 7648 if res = 1 then res:= 0;
11 7649 end
10 7650 else
10 7651 begin <* res = 2 eller 3 *>
11 7652 s_kanal:= v_kanal:= 0;
11 7653 opgave:= d.opref.opkode shift (-12);
11 7654 bv:= d.op_ref.data(5) extract 4;
11 7655 bs:= d.op_ref.data(6);
11 7656 if opgave < 10 then
11 7657 begin
12 7658 j:= d.op_ref.data(7) <*type*>;
12 7659 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 7660 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 7661 terminal_tab.ref(1):= i
12 7662 +(if res=2 then 4 <*optaget*> else 0)
12 7663 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 7664 then 8 <*nød*> else 0)
12 7665 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 7666 then 16 else 0)
12 7667 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 7668 + (if opgave=9 then 128 else
12 7669 if opgave>=7 then 256 else
12 7670 if opgave>=5 then 512 else 0)
12 7671 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 7672 else if b_s = 0 then 0 <*tilstand = ledig *>
12 7673 else 1 shift 21 <*tilstand = samtale*>);
12 7674 end
11 7675 else if opgave=10 <*monitering*> or
11 7676 opgave=14 <*ventepos *> then
11 7677 begin
12 7678 <*+4*> if res = 2 then
12 7679 fejlreaktion(3<*prg.fejl*>,res,
12 7680 <: operatør,moniter,res:>,1);
12 7681 <*-4*>
12 7682 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 7683 i:= if bs<0 then
12 7684 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 7685 terminal_tab.ref(1):= i +
12 7686 (if bs < 0 then (1 shift 21) else 0);
12 7687 if opgave=10 then
12 7688 begin
13 7689 s_kanal:= bs;
13 7690 v_kanal:= d.opref.data(5);
13 7691 end;
12 7692 \f
12 7692 message procedure operatør side 12 - 810603/hko;
12 7693 end
11 7694 else if opgave=11 or opgave=12 then
11 7695 begin
12 7696 <*+4*> if res = 2 then
12 7697 fejlreaktion(3<*prg.fejl*>,res,
12 7698 <: operatør,ge/ne,res:>,1);
12 7699 <*-4*>
12 7700 if opgave=11 <*GE*> and res<>49 then
12 7701 begin
13 7702 s_kanal:= terminal_tab.ref(2);
13 7703 v_kanal:= 12 shift 20 +
13 7704 (terminal_tab.ref(1) shift (-12) extract 4);
13 7705 end;
12 7706 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 7707 end
11 7708 else
11 7709 if opgave=13 then
11 7710 begin
12 7711 if res=2 then
12 7712 fejlreaktion(3<*prg.fejl*>,res,
12 7713 <:operatør,R,res:>,1);
12 7714 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 7715 d.opref.data(2));
12 7716 end
11 7717 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 7718 <*-4*>
11 7719 ;
11 7720 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 7721
11 7721 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 7722 terminal_tab.ref(2):= b_s;
11 7723 terminal_tab.ref(3):= d.op_ref.data(11);
11 7724 if (opgave<10 or opgave=14) and res=3 then
11 7725 <*så henviser b_s til radiokanal*>
11 7726 begin
12 7727 if bs shift (-20) = 12 then
12 7728 begin
13 7729 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 7730 kanaltab.iaf.kanal_tilstand:=
13 7731 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 7732 +terminal_tab.ref(1) extract 10;
13 7733 end
12 7734 else
12 7735 begin
13 7736 for i:= 1 step 1 until max_antal_kanaler do
13 7737 begin
14 7738 if læsbit_i(bs,i) then
14 7739 begin
15 7740 iaf:= (i-1)*kanal_beskr_længde;
15 7741 kanaltab.iaf.kanaltilstand:=
15 7742 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 7743 + terminal_tab.ref(1) extract 10;
15 7744 end;
14 7745 end;
13 7746 end;
12 7747 end;
11 7748 if kode=15 or kode=16 then
11 7749 begin
12 7750 if opgave<10 then
12 7751 begin
13 7752 opgave:= 11;
13 7753 kanal:= (12 shift 20) +
13 7754 d.opref.data(6) extract 20;
13 7755 goto til_radio;
13 7756 end
12 7757 else
12 7758 if opgave=11 then
12 7759 begin
13 7760 opgave:= 10;
13 7761 d.opref.data(2):= kanal;
13 7762 goto til_radio;
13 7763 end;
12 7764 end
11 7765 else
11 7766 if (kode=1 or kode=3) then
11 7767 begin
12 7768 if opgave<10 and bv<>0 then
12 7769 begin
13 7770 opgave:= 14;
13 7771 d.opref.data(2):= 2;
13 7772 goto til_radio;
13 7773 end;
12 7774 end;
11 7775 <*V*> skriv_skærm_b_v_s(nr);
11 7776 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 7777 skriv_skærm_opkaldskø(nr);
11 7778 for i:= s_kanal, v_kanal do
11 7779 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 7780 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 7781 signalbin(bs_mobilopkald);
11 7782 <*V*> setposition(z_op(nr),0,0);
11 7783 end; <* res = 2 eller 3 *>
10 7784 end; <* res <= 1 *>
9 7785 <* frigiv talevej (om nødvendigt) *>
9 7786 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 7787 and terminal_tab.ref(2)=0 <*b_s*>
9 7788 and op_talevej(nr)<>0
9 7789 then
9 7790 begin
10 7791 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 7792 start_operation(iaf,200+nr,cs_operatør(nr),
10 7793 'D' shift 12 + 44);
10 7794 d.iaf.data(1):= op_talevej(nr);
10 7795 d.iaf.data(2):= nr+16;
10 7796 ll:= 0;
10 7797 repeat
10 7798 signalch(cs_talevejsswitch,iaf,op_optype);
10 7799 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 7800 ll:= ll+1;
10 7801 until ll=3 or d.iaf.resultat=3;
10 7802 ll:= d.iaf.resultat;
10 7803 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 7804 if ll<>3 then
10 7805 fejlreaktion(21,op_talevej(nr)*100+nr,
10 7806 <:frigiv operatør fejlet:>,1)
10 7807 else
10 7808 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 7809 skriv_skærm_b_v_s(nr);
10 7810 end;
9 7811 disable if testbit14 then
9 7812 begin
10 7813 integer t; <*lav en trap-bar blok*>
10 7814
10 7814 trap(test14_trap);
10 7815 systime(1,0,kommslut);
10 7816 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7817 string bpl_navn(nr),<: slut :>,case rkom of (
10 7818 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7819 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7820 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7821 <:GE,T:>),<: :>);
10 7822 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7823 rkom=16 or rkom=17 or rkom=19)
10 7824 then
10 7825 begin
11 7826 if d.opref.data(7)=2 then outchar(zrl,'*');
11 7827 if d.opref.data(9)<>0 then
11 7828 begin
12 7829 skriv_id(zrl,d.opref.data(9),0);
12 7830 outchar(zrl,' ');
12 7831 end;
11 7832 if d.opref.data(8)<>0 then
11 7833 begin
12 7834 skriv_id(zrl,d.opref.data(8),0);
12 7835 outchar(zrl,' ');
12 7836 end;
11 7837 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 7838 d.opref.data(2)<>0 then
11 7839 begin
12 7840 skriv_id(zrl,d.opref.data(2),0);
12 7841 outchar(zrl,' ');
12 7842 end;
11 7843 if d.opref.data(12)<>0 then
11 7844 begin
12 7845 if d.opref.data(12) shift (-20) = 15 then
12 7846 write(zrl,<:OMR*:>)
12 7847 else
12 7848 if d.opref.data(12) shift (-20) = 14 then
12 7849 write(zrl,
12 7850 string områdenavn(d.opref.data(12) extract 20))
12 7851 else
12 7852 skriv_id(zrl,d.opref.data(12),0);
12 7853 outchar(zrl,' ');
12 7854 end;
11 7855 t:= terminal_tab.ref.terminaltilstand extract 10;
11 7856 if res=3 and rkom=1 and
11 7857 (t shift (-4) extract 1 = 1) and
11 7858 (t extract 2 <> 3)
11 7859 then
11 7860 begin
12 7861 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 7862 kanal_beskr_længde;
12 7863 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 7864 extract 12)/100," ",1);
12 7865 end;
11 7866 if d.opref.data(10)<>0 then
11 7867 begin
12 7868 skriv_id(zrl,d.opref.data(10),0);
12 7869 outchar(zrl,' ');
12 7870 end;
11 7871 end
10 7872 else
10 7873 if rkom=10 and par1<>0 then
10 7874 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 7875 else
10 7876 if rkom=5 or rkom=6 then
10 7877 begin
11 7878 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7879 if par1 shift (-20)=14 then
11 7880 write(zrl,string områdenavn(par1 extract 20));
11 7881 outchar(zrl,' ');
11 7882 end;
10 7883 if op_talevej(nr) > 0 then
10 7884 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 7885 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 7886 <<dd.dd>,kommslut-kommstart);
10 7887 test14_trap: outchar(zrl,'nl');
10 7888 end;
9 7889 <*V*> setposition(z_op(nr),0,0);
9 7890 cursor(z_op(nr),24,1);
9 7891 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 7892 end; <* radio-kommando *>
8 7893 begin
9 7894 \f
9 7894 message procedure operatør side 13 - 810518/hko;
9 7895
9 7895 <* 4 stop kommando *>
9 7896
9 7896 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7897 if tilstand <> 0 then
9 7898 begin
10 7899 d.op_ref.resultat:= 16; <*skærm optaget*>
10 7900 end
9 7901 else
9 7902 begin
10 7903 d.op_ref.retur:= cs_operatør(nr);
10 7904 d.op_ref.resultat:= 0;
10 7905 d.op_ref.data(1):= nr;
10 7906 indeks:= op_ref;
10 7907 <*+2*> if testbit11 and overvåget then
10 7908 disable begin
11 7909 skriv_operatør(out,0);
11 7910 write(out,<: stop_operation til radio:>);
11 7911 skriv_op(out,op_ref); ud;
11 7912 end;
10 7913 <*-2*>
10 7914 if opk_alarm.tab.alarm_tilst > 0 then
10 7915 begin
11 7916 opk_alarm.tab.alarm_kmdo:= 3;
11 7917 signal_bin(bs_opk_alarm);
11 7918 end;
10 7919
10 7919 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7920 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7921 <*+2*> if testbit12 and overvåget then
10 7922 disable begin
11 7923 skriv_operatør(out,0);
11 7924 write(out,<: operation retur fra radio:>);
11 7925 skriv_op(out,op_ref); ud;
11 7926 end;
10 7927 <*-2*>
10 7928 <*+4*> if indeks <> op_ref then
10 7929 fejlreaktion(11<*fr.post*>,op_ref,
10 7930 <: operatør, retur fra radio:>,0);
10 7931 <*-4*>
10 7932 \f
10 7932 message procedure operatør side 14 - 810527/hko;
10 7933
10 7933 if d.op_ref.resultat = 3 then
10 7934 begin
11 7935 integer k,n;
11 7936 integer array field msk,iaf1;
11 7937
11 7937 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 7938 +terminal_tab.ref.terminal_tilstand extract 21;
11 7939 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 7940 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 7941 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 7942 begin
12 7943 msk:= k*op_maske_lgd;
12 7944 if læsbit_ia(bpl_def.msk,nr) then
12 7945 <**> begin
13 7946 n:= 0;
13 7947 for i:= 1 step 1 until max_antal_operatører do
13 7948 if læsbit_ia(bpl_def.msk,i) then
13 7949 begin
14 7950 iaf1:= i*terminal_beskr_længde;
14 7951 if terminal_tab.iaf1.terminal_tilstand
14 7952 shift (-21) < 3 then
14 7953 n:= n+1;
14 7954 end;
13 7955 bpl_tilst(k,1):= n;
13 7956 end;
12 7957 <**> <*
12 7958 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 7959 *> end;
11 7960 signal_bin(bs_mobil_opkald);
11 7961 <*V*> setposition(z_op(nr),0,0);
11 7962 ht_symbol(z_op(nr));
11 7963 end;
10 7964 end;
9 7965 <*V*> setposition(z_op(nr),0,0);
9 7966 cursor(z_op(nr),24,1);
9 7967 if d.op_ref.resultat<> 3 then
9 7968 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 7969 end;
8 7970 begin
9 7971 boolean l22;
9 7972 \f
9 7972 message procedure operatør side 15 - 810521/cl;
9 7973
9 7973 <* 5 springdefinition *>
9 7974 l22:= false;
9 7975 if sep=',' then
9 7976 disable begin
10 7977 setposition(z_op(nr),0,0);
10 7978 cursor(z_op(nr),22,1);
10 7979 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 7980 l22:= true; pos:= 1;
10 7981 while læstegn(d.op_ref.data,pos,i)<>0 do
10 7982 outchar(z_op(nr),i);
10 7983 end;
9 7984
9 7984 tofrom(d.op_ref.data,ia,indeks*2);
9 7985 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 7986 start_operation(vt_op,200+nr,cs_operatør(nr),
9 7987 101<*opret fil*>);
9 7988 d.vt_op.data(1):=128;<*postantal*>
9 7989 d.vt_op.data(2):=2; <*postlængde*>
9 7990 d.vt_op.data(3):=1; <*segmentantal*>
9 7991 d.vt_op.data(4):=
9 7992 2 shift 10; <*spool fil*>
9 7993 signal_ch(cs_opret_fil,vt_op,op_optype);
9 7994 pos:=vt_op;<*variabel lånes*>
9 7995 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 7996 <*+4*> if vt_op<>pos then
9 7997 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 7998 if d.vt_op.data(9)<>0 then
9 7999 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8000 <:op kommando(springdefinition):>,0);
9 8001 <*-4*>
9 8002 iaf:=0;
9 8003 for i:=1 step 1 until indeks-2 do
9 8004 begin
10 8005 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8006 if k<>0 then
10 8007 fejlreaktion(7<*modif-fil*>,k,
10 8008 <:op kommando(spring-def):>,0);
10 8009 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8010 end;
9 8011 \f
9 8011 message procedure operatør side 15a - 820301/cl;
9 8012
9 8012 while sep = ',' do
9 8013 begin
10 8014 setposition(z_op(nr),0,0);
10 8015 cursor(z_op(nr),23,1);
10 8016 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8017 setposition(z_op(nr),0,0);
10 8018 wait(bs_fortsæt_adgang);
10 8019 pos:= 1; j:= 0;
10 8020 while læs_store(z_op(nr),i) < 8 do
10 8021 begin
11 8022 skrivtegn(fortsæt,pos,i);
11 8023 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8024 end;
10 8025 skrivtegn(fortsæt,pos,'em');
10 8026 afsluttext(fortsæt,pos);
10 8027 sluttegn:= i;
10 8028 if j<>0 then
10 8029 begin
11 8030 setposition(z_op(nr),0,0);
11 8031 cursor(z_op(nr),24,1);
11 8032 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8033 cursor(z_op(nr),1,1);
11 8034 goto sp_ann;
11 8035 end;
10 8036 \f
10 8036 message procedure operatør side 16 - 810521/cl;
10 8037
10 8037 disable begin
11 8038 integer array værdi(1:4);
11 8039 integer a_pos,res;
11 8040 pos:= 0;
11 8041 repeat
11 8042 apos:= pos;
11 8043 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8044 if res >= 0 then
11 8045 begin
12 8046 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8047 else if res=0 then res:= -25 <*parameter mangler*>
12 8048 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8049 res:= -44 <*intervalstørrelse ulovlig*>
12 8050 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8051 res:= -6 <*løbnr ulovligt*>
12 8052 else if res=10 then
12 8053 begin
13 8054 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8055 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8056 <:op kommando(spring-def):>,0);
13 8057 iaf:= 0;
13 8058 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8059 indeks:= indeks+1;
13 8060 if sep = ',' then res:= 0;
13 8061 end
12 8062 else res:= -27; <*parametertype*>
12 8063 end;
11 8064 if res>0 then pos:= a_pos;
11 8065 until sep<>'sp' or res<=0;
11 8066
11 8066 if res<0 then
11 8067 begin
12 8068 d.op_ref.resultat:= -res;
12 8069 i:=1; j:= 1;
12 8070 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8071 afsluttext(d.op_ref.data,i);
12 8072 end;
11 8073 end;
10 8074 \f
10 8074 message procedure operatør side 17 - 810521/cl;
10 8075
10 8075 if d.op_ref.resultat > 3 then
10 8076 begin
11 8077 setposition(z_op(nr),0,0);
11 8078 if l22 then
11 8079 begin
12 8080 cursor(z_op(nr),22,1); l22:= false;
12 8081 write(z_op(nr),"-",80);
12 8082 end;
11 8083 cursor(z_op(nr),24,1);
11 8084 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8085 goto sp_ann;
11 8086 end;
10 8087 if sep=',' then
10 8088 begin
11 8089 setposition(z_op(nr),0,0);
11 8090 cursor(z_op(nr),22,1);
11 8091 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8092 pos:= 1; l22:= true;
11 8093 while læstegn(fortsæt,pos,i)<>0 do
11 8094 outchar(z_op(nr),i);
11 8095 end;
10 8096 signalbin(bs_fortsæt_adgang);
10 8097 end while sep = ',';
9 8098 d.vt_op.data(1):= indeks-2;
9 8099 k:= sætfildim(d.vt_op.data);
9 8100 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8101 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8102 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8103 d.op_ref.retur:=cs_operatør(nr);
9 8104 pos:=op_ref;
9 8105 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8106 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8107 <*+4*> if pos<>op_ref then
9 8108 fejlreaktion(11<*fremmed post*>,op_ref,
9 8109 <:op kommando(springdef retur fra vt):>,0);
9 8110 <*-4*>
9 8111 \f
9 8111 message procedure operatør side 18 - 810521/cl;
9 8112
9 8112 <*V*> setposition(z_op(nr),0,0);
9 8113 if l22 then
9 8114 begin
10 8115 cursor(z_op(nr),22,1);
10 8116 write(z_op(nr),"-",80);
10 8117 end;
9 8118 cursor(z_op(nr),24,1);
9 8119 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8120
9 8120 if false then
9 8121 begin
10 8122 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8123 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8124 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8125 signalbin(bs_fortsæt_adgang);
10 8126 end;
9 8127
9 8127 end;
8 8128
8 8128 begin
9 8129 \f
9 8129 message procedure operatør side 19 - 810522/cl;
9 8130
9 8130 <* 6 spring (igangsæt)
9 8131 spring,annuler
9 8132 spring,reserve *>
9 8133
9 8133 tofrom(d.op_ref.data,ia,6);
9 8134 d.op_ref.retur:=cs_operatør(nr);
9 8135 indeks:=op_ref;
9 8136 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8137 <*V*> wait_ch(cs_operatør(nr),
9 8138 op_ref,
9 8139 op_optype,
9 8140 -1<*timeout*>);
9 8141 <*+2*> if testbit10 and overvåget then
9 8142 disable begin
10 8143 skriv_operatør(out,0);
10 8144 write(out,"nl",1,<:op operation retur fra vt:>);
10 8145 skriv_op(out,op_ref);
10 8146 end;
9 8147 <*-2*>
9 8148 <*+4*> if indeks<>op_ref then
9 8149 fejlreaktion(11<*fremmed post*>,op_ref,
9 8150 <:op kommando(spring):>,0);
9 8151 <*-4*>
9 8152
9 8152 <*V*> setposition(z_op(nr),0,0);
9 8153 cursor(z_op(nr),24,1);
9 8154 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8155 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8156 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8157 end;
8 8158
8 8158 begin
9 8159 \f
9 8159 message procedure operatør side 20 - 810525/cl;
9 8160
9 8160 <* 7 spring(-oversigts-)rapport *>
9 8161
9 8161 d.op_ref.retur:=cs_operatør(nr);
9 8162 tofrom(d.op_ref.data,ia,4);
9 8163 indeks:=op_ref;
9 8164 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8165 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8166 <*+2*> disable if testbit10 and overvåget then
9 8167 begin
10 8168 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8169 skriv_op(out,op_ref);
10 8170 end;
9 8171 <*-2*>
9 8172
9 8172 <*+4*> if op_ref<>indeks then
9 8173 fejlreaktion(11<*fremmed post*>,op_ref,
9 8174 <:op kommando(spring-rapport):>,0);
9 8175 <*-4*>
9 8176
9 8176 <*V*> setposition(z_op(nr),0,0);
9 8177 if d.op_ref.resultat<>3 then
9 8178 begin
10 8179 cursor(z_op(nr),24,1);
10 8180 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8181 end
9 8182 else
9 8183 begin
10 8184 boolean p_skrevet;
10 8185 integer bogst,løb;
10 8186
10 8186 skærmmåde:= 1;
10 8187
10 8187 if kode = 32 then <* spring,vis *>
10 8188 begin
11 8189 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8190 bogst:= d.op_ref.data(1) extract 5;
11 8191 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8192 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8193 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8194 <:spring: :>,
11 8195 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8196 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8197 raf:= data+8;
11 8198 if d.op_ref.raf(1)<>0.0 then
11 8199 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8200 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8201 else write(z_op(nr),<:, ikke startet:>);
11 8202 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8203 \f
11 8203 message procedure operatør side 21 - 810522/cl;
11 8204
11 8204 p_skrevet:= false;
11 8205 for pos:=1 step 1 until d.op_ref.data(3) do
11 8206 begin
12 8207 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8208 if i<>0 then
12 8209 fejlreaktion(5<*læsfil*>,i,
12 8210 <:op kommando(spring,vis):>,0);
12 8211 iaf:=0;
12 8212 i:= fil(j).iaf(1);
12 8213 if i < 0 and -, p_skrevet then
12 8214 begin
13 8215 outchar(z_op(nr),'('); p_skrevet:= true;
13 8216 end;
12 8217 if i > 0 and p_skrevet then
12 8218 begin
13 8219 outchar(z_op(nr),')'); p_skrevet:= false;
13 8220 end;
12 8221 if pos mod 2 = 0 then
12 8222 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8223 else
12 8224 write(z_op(nr),true,3,<<d>,abs i);
12 8225 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8226 end;
11 8227 write(z_op(nr),"*",1);
11 8228 \f
11 8228 message procedure operatør side 22 - 810522/cl;
11 8229
11 8229 end
10 8230 else if kode=33 then <* spring,oversigt *>
10 8231 begin
11 8232 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8233 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8234 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8235
11 8235 for pos:=1 step 1 until d.op_ref.data(1) do
11 8236 begin
12 8237 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8238 if i<>0 then
12 8239 fejlreaktion(5<*læsfil*>,i,
12 8240 <:op kommando(spring-oversigt):>,0);
12 8241 iaf:=0;
12 8242 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8243 bogst:=fil(j).iaf(1) extract 5;
12 8244 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8245 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8246 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8247 string (extend fil(j).iaf(2) shift 24));
12 8248 if fil(j,2)<>0.0 then
12 8249 write(z_op(nr),<:startet :>,<<zddddd>,
12 8250 round systime(4,fil(j,2),r),<:.:>,round r);
12 8251 outchar(z_op(nr),'nl');
12 8252 end;
11 8253 write(z_op(nr),"*",1);
11 8254 end;
10 8255 <* slet fil *>
10 8256 d.op_ref.opkode:= 104;
10 8257 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8258 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8259 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8260 end; <* resultat=3 *>
9 8261
9 8261 end;
8 8262
8 8262 begin
9 8263 \f
9 8263 message procedure operatør side 23 - 940522/cl;
9 8264
9 8264
9 8264 <* 8 SLUT *>
9 8265 trapmode:= 1 shift 13;
9 8266 trap(-2);
9 8267 end;
8 8268
8 8268 begin
9 8269 <* 9 stopniveauer,definer *>
9 8270 integer fno;
9 8271
9 8271 for i:= 1 step 1 until 3 do
9 8272 operatør_stop(nr,i):= ia(i+1);
9 8273 i:= modif_fil(tf_stoptabel,nr,fno);
9 8274 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8275 iaf:=0;
9 8276 for i:= 0,1,2,3 do
9 8277 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8278 setposition(fil(fno),0,0);
9 8279 setposition(z_op(nr),0,0);
9 8280 cursor(z_op(nr),24,1);
9 8281 skriv_kvittering(z_op(nr),0,-1,3);
9 8282 end;
8 8283
8 8283 begin
9 8284 \f
9 8284 message procedure operatør side 24 - 940522/cl;
9 8285
9 8285 <* 10 stopniveauer,vis *>
9 8286 integer bpl,j,k;
9 8287
9 8287 skærm_måde:= 1;
9 8288 setposition(z_op(nr),0,0);
9 8289 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8290 <:stopniveauer: :>);
9 8291 for i:= 0 step 1 until 3 do
9 8292 begin
10 8293 bpl:= operatør_stop(nr,i);
10 8294 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8295 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8296 end;
9 8297 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8298 j:=0;
9 8299 for bpl:= 1 step 1 until max_antal_operatører do
9 8300 if bpl_navn(bpl)<>long<::> then
9 8301 begin
10 8302 if j mod 8 = 0 and j > 0 then
10 8303 write(z_op(nr),"nl",1,"sp",18);
10 8304 iaf:= bpl*terminal_beskr_længde;
10 8305 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8306 true,6,string bpl_navn(bpl));
10 8307 j:=j+1;
10 8308 end;
9 8309 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8310 j:=0;
9 8311 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8312 if bpl_navn(bpl)<>long<::> then
9 8313 begin
10 8314 if j mod 8 = 0 and j > 0 then
10 8315 write(z_op(nr),"nl",1,"sp",19);
10 8316 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8317 j:=j+1;
10 8318 end;
9 8319 write(z_op(nr),"nl",1,"*",1);
9 8320 end;
8 8321
8 8321 begin
9 8322 <* 11 alarmlængde *>
9 8323 integer fno;
9 8324
9 8324 if indeks > 0 then
9 8325 begin
10 8326 opk_alarm.tab.alarm_lgd:= ia(1);
10 8327 i:= modiffil(tf_alarmlgd,nr,fno);
10 8328 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8329 iaf:= 0;
10 8330 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8331 setposition(fil(fno),0,0);
10 8332 end;
9 8333
9 8333 setposition(z_op(nr),0,0);
9 8334 cursor(z_op(nr),24,1);
9 8335 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8336 end;
8 8337
8 8337 begin
9 8338 <* 12 CC *>
9 8339 integer i, c;
9 8340
9 8340 i:= 1;
9 8341 while læstegn(ia,i+0,c)<>0 and
9 8342 i<(op_spool_postlgd-op_spool_text)//2*3
9 8343 do skrivtegn(d.opref.data,i,c);
9 8344 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8345
9 8345 d.opref.retur:= cs_operatør(nr);
9 8346 signalch(cs_op_spool,opref,op_optype);
9 8347 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8348
9 8348 setposition(z_op(nr),0,0);
9 8349 cursor(z_op(nr),24,1);
9 8350 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8351 end;
8 8352
8 8352 <* 13 EXkluder skærmen *>
8 8353 begin
9 8354 d.opref.resultat:= 2;
9 8355 setposition(z_op(nr),0,0);
9 8356 cursor(z_op(nr),24,1);
9 8357 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8358
9 8358 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8359 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8360 d.vt_op.data(1):= nr;
9 8361 signalch(cs_rad,vt_op,gen_optype);
9 8362 end;
8 8363
8 8363 begin
9 8364 <* 14 CQF-tabel,vis *>
9 8365
9 8365 skærm_måde:= 1;
9 8366 setposition(z_op(nr),0,0);
9 8367 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8368 "esc" add 128,1,<:ÆJ:>);
9 8369 skriv_cqf_tabel(z_op(nr),false);
9 8370 write(z_op(nr),"*",1);
9 8371 end;
8 8372
8 8372 begin
9 8373 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8374 setposition(z_op(nr),0,0);
9 8375 cursor(z_op(nr),24,1);
9 8376 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8377 end;
8 8378 \f
8 8378 message procedure operatør side x - 810522/hko;
8 8379
8 8379 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8380 <*-4*>
8 8381 end;<*case j *>
7 8382 end <* j > 0 *>
6 8383 else
6 8384 begin
7 8385 <*V*> setposition(z_op(nr),0,0);
7 8386 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8387 skriv_kvittering(z_op(nr),op_ref,-1,
7 8388 45 <*ikke implementeret *>);
7 8389 end;
6 8390 end;<* godkendt *>
5 8391
5 8391 <*V*> setposition(z_op(nr),0,0);
5 8392 <*???*>
5 8393 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8394 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8395 skærmmåde = 0 do
5 8396 begin
6 8397 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8398 begin
7 8399 skriv_skærm_bvs(nr);
7 8400 <*940920 if op_talevej(nr)=0 then status:= 0
7 8401 else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8402 if status>0 then
7 8403 begin
7 8404 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8405 terminaltab.ref(ll):= 0;
7 8406 skriv_skærm_bvs(nr);
7 8407 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8408 end;
7 8409 for i:= 1 step 1 until max_antal_kanaler do
7 8410 begin
7 8411 iaf:= (i-1)*kanalbeskrlængde;
7 8412 inspect(ss_samtale_nedlagt(i),status);
7 8413 if status>0 and
7 8414 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8415 begin
7 8416 kanaltab.iaf.kanal_tilstand:=
7 8417 kanaltab.iaf(1) shift (-10) extract 6 shift 10;
7 8418 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8419 kanaltab.iaf(ll):= 0;
7 8420 skriv_skærm_kanal(nr,i);
7 8421 repeat
7 8422 wait(ss_samtale_nedlagt(i));
7 8423 inspect(ss_samtale_nedlagt(i),status);
7 8424 until status=0;
7 8425 end;
7 8426 end;
7 8427 940920*> cursor(z_op(nr),1,1);
7 8428 setposition(z_op(nr),0,0);
7 8429 end;
6 8430 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8431 and skærmmåde = 0
6 8432 and læsbit_ia(operatørmaske,nr) then
6 8433 begin
7 8434 if sætbit_ia(opkaldsflag,nr,0) = 1 then
7 8435 skriv_skærm_opkaldskø(nr);
7 8436 if sætbit_ia(kanalflag,nr,0) = 1 then
7 8437 begin
8 8438 for i:= 1 step 1 until max_antal_kanaler do
8 8439 skriv_skærm_kanal(nr,i);
8 8440 end;
7 8441 cursor(z_op(nr),1,1);
7 8442 <*V*> setposition(z_op(nr),0,0);
7 8443 end;
6 8444 end;
5 8445 d.op_ref.retur:=cs_att_pulje;
5 8446 disable afslut_kommando(op_ref);
5 8447 end; <* indlæs kommando *>
4 8448
4 8448 begin
5 8449 \f
5 8449 message procedure operatør side x+1 - 810617/hko;
5 8450
5 8450 <* 2: inkluder *>
5 8451 integer k,n;
5 8452 integer array field msk,iaf1;
5 8453
5 8453 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8454 if i=0 then
5 8455 begin
6 8456 fejlreaktion(3<*programfejl*>,nr,
6 8457 <:operatør(nr) eksisterer ikke:>,1);
6 8458 d.op_ref.resultat:=28;
6 8459 end
5 8460 else
5 8461 begin
6 8462 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8463 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8464 else if d.op_ref.opkode = 0 then 0
6 8465 else 3;<*udført*>
6 8466 if i > 0 then
6 8467 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8468 <:operatørskærm reservation:>,1)
6 8469 else
6 8470 begin
7 8471 i:=terminal_tab.ref.terminal_tilstand;
7 8472 <*940418/cl inkluderet sættes i stop - start *>
7 8473 kode:= d.opref.opkode extract 12;
7 8474 if kode <> 0 then
7 8475 terminal_tab.ref.terminal_tilstand:=
7 8476 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8477 else
7 8478 <*940418/cl inkluderet sættes i stop - slut *>
7 8479 terminal_tab.ref.terminal_tilstand:= i extract
7 8480 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8481 for i:= 1 step 1 until max_antal_kanaler do
7 8482 begin
8 8483 iaf:= (i-1)*kanalbeskrlængde;
8 8484 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8485 end;
7 8486 skærm_måde:= 0;
7 8487 sætbit_ia(operatørmaske,nr,
7 8488 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8489 then 0 else 1));
7 8490 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8491 begin
8 8492 msk:= k*op_maske_lgd;
8 8493 if læsbit_ia(bpl_def.msk,nr) then
8 8494 <**> begin
9 8495 n:= 0;
9 8496 for i:= 1 step 1 until max_antal_operatører do
9 8497 if læsbit_ia(bpl_def.msk,i) then
9 8498 begin
10 8499 iaf1:= i*terminal_beskr_længde;
10 8500 if terminal_tab.iaf1.terminal_tilstand
10 8501 shift (-21) < 3 then
10 8502 n:= n+1;
10 8503 end;
9 8504 bpl_tilst(k,1):= n;
9 8505 end;
8 8506 <**> <*
8 8507 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8508 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8509 *> end;
7 8510 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8511 sætbit_ia(opkaldsflag,nr,0);
7 8512 signal_bin(bs_mobil_opkald);
7 8513 <*940418/cl inkluderet sættes i stop - start *>
7 8514 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8515 <*V*> ht_symbol(z_op(nr))
7 8516 else
7 8517 <*940418/cl inkluderet sættes i stop - slut *>
7 8518 <*V*> skriv_skærm(nr);
7 8519 cursor(z_op(nr),24,1);
7 8520 <*V*> setposition(z_op(nr),0,0);
7 8521 end;
6 8522 end;
5 8523 if d.op_ref.opkode = 0 then
5 8524 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8525 else
5 8526 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8527 end;
4 8528
4 8528 begin
5 8529 \f
5 8529 message procedure operatør side x+2 - 820304/hko;
5 8530
5 8530 <* 3: ekskluder *>
5 8531 integer k,n;
5 8532 integer array field iaf1,msk;
5 8533
5 8533 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8534 <*V*> setposition(z_op(nr),0,0);
5 8535 monitor(10) release process:(z_op(nr),0,ia);
5 8536 d.op_ref.resultat:=3;
5 8537 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8538 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8539 terminal_tab.ref.terminal_tilstand extract 21;
5 8540 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8541 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8542 begin
6 8543 msk:= k*op_maske_lgd;
6 8544 if læsbit_ia(bpl_def.msk,nr) then
6 8545 <**> begin
7 8546 n:= 0;
7 8547 for i:= 1 step 1 until max_antal_operatører do
7 8548 if læsbit_ia(bpl_def.msk,i) then
7 8549 begin
8 8550 iaf1:= i*terminal_beskr_længde;
8 8551 if terminal_tab.iaf1.terminal_tilstand
8 8552 shift (-21) < 3 then
8 8553 n:= n+1;
8 8554 end;
7 8555 bpl_tilst(k,1):= n;
7 8556 end;
6 8557 <**> <*
6 8558 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8559 *> end;
5 8560 signal_bin(bs_mobil_opkald);
5 8561 if opk_alarm.tab.alarm_tilst > 0 then
5 8562 begin
6 8563 opk_alarm.tab.alarm_kmdo:= 3;
6 8564 signal_bin(bs_opk_alarm);
6 8565 end;
5 8566 end;
4 8567 begin
5 8568
5 8568 <* 4: opdater skærm *>
5 8569
5 8569 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8570 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8571 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8572 skærmmåde=0 do
5 8573 begin
6 8574
6 8574 <*+2*> if testbit13 and overvåget then
6 8575 disable begin
7 8576 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8577 <:) opkaldsflag::>,"nl",1);
7 8578 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8579 write(out,<: operatørmaske::>,"nl",1);
7 8580 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8581 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8582 ud;
7 8583 end;
6 8584 <*-2*>
6 8585 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8586 begin
7 8587 skriv_skærm_bvs(nr);
7 8588 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8589 if status>0 then
7 8590 begin
7 8591 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8592 terminaltab.ref(ll):= 0;
7 8593 skriv_skærm_bvs(nr);
7 8594 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8595 end;
7 8596 for i:= 1 step 1 until max_antal_kanaler do
7 8597 begin
7 8598 iaf:= (i-1)*kanalbeskrlængde;
7 8599 inspect(ss_samtale_nedlagt(i),status);
7 8600 if status>0 and
7 8601 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8602 begin
7 8603 kanaltab.iaf.kanal_tilstand:=
7 8604 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8605 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8606 kanaltab.iaf(ll):= 0;
7 8607 skriv_skærm_kanal(nr,i);
7 8608 repeat
7 8609 wait(ss_samtale_nedlagt(i));
7 8610 inspect(ss_samtale_nedlagt(i),status);
7 8611 until status=0;
7 8612 end;
7 8613 end;
7 8614 940920*> cursor(z_op(nr),1,1);
7 8615 setposition(z_op(nr),0,0);
7 8616 end;
6 8617 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8618 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8619 begin
7 8620 <*V*> setposition(z_op(nr),0,0);
7 8621 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 8622 skriv_skærm_opkaldskø(nr);
7 8623 if sætbit_ia(kanalflag,nr,0) =1 then
7 8624 begin
8 8625 for i:=1 step 1 until max_antal_kanaler do
8 8626 skriv_skærm_kanal(nr,i);
8 8627 end;
7 8628 cursor(z_op(nr),1,1);
7 8629 <*V*> setposition(z_op(nr),0,0);
7 8630 end;
6 8631 end;
5 8632 end;
4 8633 begin
5 8634 \f
5 8634 message procedure operatør side x+3 - 830310/hko;
5 8635
5 8635 <* 5: samtale etableret *>
5 8636
5 8636 res:= d.op_ref.resultat;
5 8637 b_v:= d.op_ref.data(3) extract 4;
5 8638 b_s:= d.op_ref.data(4);
5 8639 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8640 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 8641 begin
6 8642 sætbit_i(terminal_tab.ref(1),21,1);
6 8643 sætbit_i(terminal_tab.ref(1),22,0);
6 8644 sætbit_i(terminal_tab.ref(1),2,0);
6 8645 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 8646 terminal_tab.ref(2):= b_s;
6 8647 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 8648 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 8649 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 8650 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 8651
6 8651 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8652 begin
7 8653 <*V*> setposition(z_op(nr),0,0);
7 8654 skriv_skærm_b_v_s(nr);
7 8655 <*V*> setposition(z_op(nr),0,0);
7 8656 end;
6 8657 end
5 8658 else
5 8659 if terminal_tab.ref(1) shift(-21) = 2 then
5 8660 begin
6 8661 sætbit_i(terminal_tab.ref(1),22,0);
6 8662 sætbit_i(terminal_tab.ref(1),2,0);
6 8663 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 8664 terminal_tab.ref(2):= 0;
6 8665 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8666 begin
7 8667 <*V*> setposition(z_op(nr),0,0);
7 8668 cursor(z_op(nr),21,17);
7 8669 write(z_op(nr),<:EJ FORB:>);
7 8670 <*V*> setposition(z_op(nr),0,0);
7 8671 end;
6 8672 end
5 8673 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 8674 <:terminal tilstand:>,1);
5 8675 end;
4 8676
4 8676 begin
5 8677 \f
5 8677 message procedure operatør side x+4 - 810602/hko;
5 8678
5 8678 <* 6: radiokanal ekskluderet *>
5 8679
5 8679 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 8680 pos:= d.op_ref.data(1);
5 8681 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8682 indeks:= terminal_tab.ref(2);
5 8683 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 8684 then indeks extract 4 else 0;
5 8685 if b_v = pos then
5 8686 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 8687 if b_s = pos then
5 8688 begin
6 8689 terminal_tab.ref(2):= 0;
6 8690 sætbit_i(terminal_tab.ref(1),21,0);
6 8691 sætbit_i(terminal_tab.ref(1),22,0);
6 8692 sætbit_i(terminal_tab.ref(1),2,0);
6 8693 end;
5 8694 if skærmmåde=0 then
5 8695 begin
6 8696 if b_v = pos or b_s = pos then
6 8697 <*V*> skriv_skærm_b_v_s(nr);
6 8698 <*V*> skriv_skærm_kanal(nr,pos);
6 8699 cursor(z_op(nr),1,1);
6 8700 setposition(z_op(nr),0,0);
6 8701 end;
5 8702 end;
4 8703
4 8703 begin
5 8704 \f
5 8704 message procedure operatør side x+5 - 950118/cl;
5 8705
5 8705 <* 7: operatørmeddelelse *>
5 8706 integer afs, kl, i;
5 8707 real dato, t;
5 8708
5 8708 cursor(z_op(nr),24,1);
5 8709 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 8710 cursor(z_op(nr),23,1);
5 8711 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 8712
5 8712 afs:= d.opref.data.op_spool_kilde;
5 8713 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 8714 kl:= round t;
5 8715 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 8716 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 8717 i:= replacechar(1,'.');
5 8718 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 8719 replacechar(1,i);
5 8720 write(z_op(nr),d.opref.data.op_spool_text);
5 8721
5 8721 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 8722 begin
6 8723 if opk_alarm.tab.alarm_lgd > 0 and
6 8724 opk_alarm.tab.alarm_tilst < 1 and
6 8725 opk_alarm.tab.alarm_kmdo < 1
6 8726 then
6 8727 begin
7 8728 opk_alarm.tab.alarm_kmdo := 1;
7 8729 signalbin(bs_opk_alarm);
7 8730 end
6 8731 else
6 8732 if opk_alarm.tab.alarm_lgd = 0 then
6 8733 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 8734 end;
5 8735
5 8735 setposition(z_op(nr),0,0);
5 8736
5 8736 signalch(d.opref.retur,opref,d.opref.optype);
5 8737 end;
4 8738
4 8738 begin
5 8739
5 8739 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 8740 <*-4*>
5 8741 end
4 8742 end; <* case aktion+6 *>
3 8743
3 8743 until false;
3 8744 op_trap:
3 8745 skriv_operatør(zbillede,1);
3 8746 end operatør;
2 8747
2 8747 \f
2 8747 message procedure op_cqftest side 1;
2 8748
2 8748 procedure op_cqftest;
2 8749 begin
3 8750 integer array field opref, ref, ref1;
3 8751 integer i, j, tv, cqf, res, pausetid;
3 8752 real nu, næstetid, kommstart, kommslut;
3 8753
3 8753 procedure skriv_op_cqftest(zud,omfang);
3 8754 value omfang;
3 8755 zone zud;
3 8756 integer omfang;
3 8757 begin
4 8758 write(zud,"nl",1,<:+++ op-cqftest:>);
4 8759 if omfang > 0 then
4 8760 disable begin
5 8761 real t;
5 8762
5 8762 trap(slut);
5 8763 write(zud,"nl",1,
5 8764 <: opref: :>,opref,"nl",1,
5 8765 <: ref: :>,ref,"nl",1,
5 8766 <: i: :>,i,"nl",1,
5 8767 <: tv: :>,tv,"nl",1,
5 8768 <: cqf: :>,cqf,"nl",1,
5 8769 <: res: :>,res,"nl",1,
5 8770 <: pausetid: :>,pausetid,"nl",1,
5 8771 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 8772 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 8773 <::>);
5 8774 skriv_coru(zud,coru_no(292));
5 8775 slut:
5 8776 end;
4 8777 end skriv_op_cqftest;
3 8778
3 8778 trap(op_cqf_trap);
3 8779 stackclaim(1000);
3 8780
3 8780
3 8780 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 8781 skriv_op_cqftest(out,0);
3 8782 <*-4*>
3 8783
3 8783 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 8784 repeat
3 8785 i:= sidste_tv_brugt; tv:= 0;
3 8786 repeat
3 8787 i:= (i mod max_antal_taleveje) + 1;
3 8788 if tv_operatør(i) = 0 then tv:= i;
3 8789 until (tv<>0) or (i=sidste_tv_brugt);
3 8790
3 8790 if tv<>0 then
3 8791 begin
4 8792 tv_operatør(tv):= -1;
4 8793 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 8794 for cqf:= 1 step 1 until max_cqf do
4 8795 begin
5 8796 ref:= (cqf-1)*cqf_lgd;
5 8797 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 8798 begin
6 8799 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 8800 d.opref.data(1):= tv;
6 8801 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 8802 disable if testbit19 then
6 8803 begin
7 8804 integer i; <*lav en trap-bar blok*>
7 8805
7 8805 trap(test19_trap);
7 8806 systime(1,0,kommstart);
7 8807 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 8808 skriv_id(zrl,d.opref.data(2),0);
7 8809 test19_trap: outchar(zrl,'nl');
7 8810 end;
6 8811 signalch(cs_rad,opref,op_optype or gen_optype);
6 8812 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 8813 res:= d.opref.resultat;
6 8814 <*+2*>
6 8815 disable if testbit19 then
6 8816 begin
7 8817 integer i; <*lav en trap-bar blok*>
7 8818
7 8818 trap(test19_trap);
7 8819 systime(1,0,kommslut);
7 8820 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 8821 if d.opref.data(7)=2 then outchar(zrl,'*');
7 8822 if d.opref.data(9)<>0 then
7 8823 begin
8 8824 skriv_id(zrl,d.opref.data(9),0);
8 8825 outchar(zrl,' ');
8 8826 end;
7 8827 if d.opref.data(8)<>0 then
7 8828 begin
8 8829 skriv_id(zrl,d.opref.data(8),0);
8 8830 outchar(zrl,' ');
8 8831 end;
7 8832 if d.opref.data(12)<>0 then
7 8833 begin
8 8834 if d.opref.data(12) shift (-20) = 15 then
8 8835 write(zrl,<:OMR*:>)
8 8836 else
8 8837 if d.opref.data(12) shift (-20) = 14 then
8 8838 write(zrl,
8 8839 string områdenavn(d.opref.data(12) extract 20))
8 8840 else
8 8841 skriv_id(zrl,d.opref.data(12),0);
8 8842 outchar(zrl,' ');
8 8843 end;
7 8844 if d.opref.data(10)<>0 then
7 8845 begin
8 8846 skriv_id(zrl,d.opref.data(10),0);
8 8847 outchar(zrl,' ');
8 8848 end;
7 8849 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 8850 <<dd.dd>,kommslut-kommstart);
7 8851 test19_trap: outchar(zrl,'nl');
7 8852 end;
6 8853 <*-2*>
6 8854 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 8855 begin
7 8856 delay(3);
7 8857 d.opref.opkode:= 12 shift 12 + 41;
7 8858 d.opref.resultat:= 0;
7 8859 disable if testbit19 then
7 8860 begin
8 8861 integer i; <*lav en trap-bar blok*>
8 8862
8 8862 trap(test19_trap);
8 8863 systime(1,0,kommstart);
8 8864 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 8865 test19_trap: outchar(zrl,'nl');
8 8866 end;
7 8867 signalch(cs_rad,opref,op_optype or gen_optype);
7 8868 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 8869 <*+2*>
7 8870 disable if testbit19 then
7 8871 begin
8 8872 integer i; <*lav en trap-bar blok*>
8 8873
8 8873 trap(test19_trap);
8 8874 systime(1,0,kommslut);
8 8875 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 8876 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 8877 <<dd.dd>,kommslut-kommstart);
8 8878 test19_trap: outchar(zrl,'nl');
8 8879 end;
7 8880 <*-2*>
7 8881 if d.opref.resultat <> 3 then
7 8882 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 8883 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 8884 begin
8 8885 startoperation(opref,292,cs_cqf,23);
8 8886 i:= 1;
8 8887 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 8888 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 8889 skriv_tegn(d.opref.data,i,' ');
8 8890 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 8891 hægtstring(d.opref.data,i,<: ok!:>);
8 8892 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 8893 signalch(cs_io,opref,gen_optype);
8 8894 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 8895 end;
7 8896 if cqf_tabel.ref.cqf_bus > 0 then
7 8897 begin
8 8898 cqf_tabel.ref.cqf_fejl:= 0;
8 8899 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 8900 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 8901 end;
7 8902 end <*res=3*>
6 8903 else
6 8904 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 8905 cqf_tabel.ref.cqf_bus > 0
6 8906 then
6 8907 begin
7 8908 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 8909 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 8910 if cqf_tabel.ref.cqf_fejl >= 2 then
7 8911 begin
8 8912 startoperation(opref,292,cs_cqf,23);
8 8913 i:= 1;
8 8914 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 8915 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 8916 skriv_tegn(d.opref.data,i,' ');
8 8917 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 8918 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 8919 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 8920 signalch(cs_io,opref,gen_optype);
8 8921 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 8922 end;
7 8923 end;
6 8924 delay(10);
6 8925 end;
5 8926 if cqf_tabel.ref.cqf_bus > 0 and
5 8927 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 8928 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 8929 end; <*for cqf*>
4 8930
4 8930 tv_operatør(tv):= 0; tv:= 0;
4 8931 if op_cqf_tab_ændret then
4 8932 begin
5 8933 j:= skrivfil(1033,1,i);
5 8934 if j<>0 then
5 8935 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 8936 sorter_cqftab(1,max_cqf);
5 8937 for cqf:= 1 step 1 until max_cqf do
5 8938 begin
6 8939 ref:= (cqf-1)*cqf_lgd;
6 8940 ref1:= (cqf-1)*cqf_id;
6 8941 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 8942 end;
5 8943 op_cqf_tab_ændret:= false;
5 8944 end;
4 8945 end; <*tv*>
3 8946
3 8946 systime(1,0.0,nu);
3 8947 pausetid:= round(næste_tid - nu);
3 8948 if pausetid < 30 then pausetid:= 30;
3 8949
3 8949 <*V*> delay(pausetid);
3 8950
3 8950 until false;
3 8951
3 8951 op_cqf_trap:
3 8952 disable skriv_op_cqftest(zbillede,1);
3 8953 end op_cqftest;
2 8954 \f
2 8954 message procedure op_spool side 1;
2 8955
2 8955 procedure op_spool;
2 8956 begin
3 8957 integer array field opref, ref;
3 8958 integer næste_tomme, i;
3 8959
3 8959 procedure skriv_op_spool(zud,omfang);
3 8960 value omfang;
3 8961 zone zud;
3 8962 integer omfang;
3 8963 begin
4 8964 write(zud,"nl",1,<:+++ op-spool:>);
4 8965 if omfang > 0 then
4 8966 disable begin
5 8967 real t;
5 8968
5 8968 trap(slut);
5 8969 write(zud,"nl",1,
5 8970 <: opref: :>,opref,"nl",1,
5 8971 <: næste-tomme: :>,næste_tomme,"nl",1,
5 8972 <: ref: :>,ref,"nl",1,
5 8973 <: i: :>,i,"nl",1,
5 8974 <::>);
5 8975 skriv_coru(zud,coru_no(293));
5 8976 slut:
5 8977 end;
4 8978 end skriv_op_spool;
3 8979
3 8979 trap(op_spool_trap);
3 8980 stackclaim(400);
3 8981
3 8981 næste_tomme:= 0;
3 8982
3 8982 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 8983 skriv_op_spool(out,0);
3 8984 <*-4*>
3 8985
3 8985 repeat
3 8986 <*V*> waitch(cs_op_spool,opref,true,-1);
3 8987 inspect(ss_op_spool_tomme,i);
3 8988
3 8988 if d.opref.opkode extract 12 <> 37 then
3 8989 begin
4 8990 d.opref.resultat:= 31;
4 8991 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 8992 end
3 8993 else
3 8994 if i<=0 then
3 8995 d.opref.resultat:= 32 <*ingen fri plads*>
3 8996 else
3 8997 begin
4 8998 <*V*> wait(ss_op_spool_tomme);
4 8999 ref:= næste_tomme*op_spool_postlgd;
4 9000 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9001 i:= d.opref.opsize - data;
4 9002 if i > (op_spool_postlgd - op_spool_text) then
4 9003 i:= (op_spool_postlgd - op_spool_text);
4 9004 op_spool_buf.ref.op_spool_kilde:=
4 9005 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9006 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9007 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9008 op_spool_buf.ref(op_spool_postlgd//2):=
4 9009 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9010 d.opref.resultat:= 3;
4 9011
4 9011 signal(ss_op_spool_fulde);
4 9012 end;
3 9013
3 9013 signalch(d.opref.retur,opref,d.opref.optype);
3 9014 until false;
3 9015
3 9015 op_spool_trap:
3 9016 disable skriv_op_spool(zbillede,1);
3 9017 end op_spool;
2 9018 \f
2 9018 message procedure op_medd side 1;
2 9019
2 9019 procedure op_medd;
2 9020 begin
3 9021 integer array field opref, ref;
3 9022 integer næste_fulde, i;
3 9023
3 9023 procedure skriv_op_medd(zud,omfang);
3 9024 value omfang;
3 9025 zone zud;
3 9026 integer omfang;
3 9027 begin
4 9028 write(zud,"nl",1,<:+++ op-medd:>);
4 9029 if omfang > 0 then
4 9030 disable begin
5 9031 real t;
5 9032
5 9032 trap(slut);
5 9033 write(zud,"nl",1,
5 9034 <: opref: :>,opref,"nl",1,
5 9035 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9036 <: ref: :>,ref,"nl",1,
5 9037 <: i: :>,i,"nl",1,
5 9038 <::>);
5 9039 skriv_coru(zud,coru_no(294));
5 9040 slut:
5 9041 end;
4 9042 end skriv_op_medd;
3 9043
3 9043 trap(op_medd_trap);
3 9044 næste_fulde:= 0;
3 9045 stackclaim(400);
3 9046
3 9046 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9047 skriv_op_medd(out,0);
3 9048 <*-4*>
3 9049
3 9049 repeat
3 9050 <*V*> wait(ss_op_spool_fulde);
3 9051 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9052
3 9052 ref:= næste_fulde*op_spool_postlgd;
3 9053 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9054
3 9054 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9055 d.opref.resultat:= 0;
3 9056 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9057 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9058 opref,gen_optype);
3 9059 signal(ss_op_spool_tomme);
3 9060 until false;
3 9061
3 9061 op_medd_trap:
3 9062 disable skriv_op_medd(zbillede,1);
3 9063 end op_medd;
2 9064 \f
2 9064 message procedure alarmur side 1;
2 9065
2 9065 procedure alarmur;
2 9066 begin
3 9067 integer ventetid, nr;
3 9068 integer array field opref, tab;
3 9069 real nu;
3 9070
3 9070 procedure skriv_alarmur(zud,omfang);
3 9071 value omfang;
3 9072 zone zud;
3 9073 integer omfang;
3 9074 begin
4 9075 write(zud,"nl",1,<:+++ alarmur:>);
4 9076 if omfang > 0 then
4 9077 disable begin
5 9078 real t;
5 9079
5 9079 trap(slut);
5 9080 write(zud,"nl",1,
5 9081 <: ventetid: :>,ventetid,"nl",1,
5 9082 <: nr: :>,nr,"nl",1,
5 9083 <: opref: :>,opref,"nl",1,
5 9084 <: tab: :>,tab,"nl",1,
5 9085 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9086 <::>);
5 9087 skriv_coru(zud,coru_no(295));
5 9088 slut:
5 9089 end;
4 9090 end skriv_alarmur;
3 9091
3 9091 trap(alarmur_trap);
3 9092 stackclaim(400);
3 9093
3 9093 systime(1,0.0,nu);
3 9094 ventetid:= -1;
3 9095 repeat
3 9096 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9097 if opref > 0 then
3 9098 signalch(d.opref.retur,opref,op_optype);
3 9099
3 9099 ventetid:= -1;
3 9100 systime(1,0.0,nu);
3 9101 for nr:= 1 step 1 until max_antal_operatører do
3 9102 begin
4 9103 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9104 if opk_alarm.tab.alarm_tilst > 0 and
4 9105 opk_alarm.tab.alarm_lgd >= 0 then
4 9106 begin
5 9107 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9108 begin
6 9109 opk_alarm.tab.alarm_kmdo:= 3;
6 9110 signalbin(bs_opk_alarm);
6 9111 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9112 end
5 9113 else
5 9114 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9115 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9116 end;
4 9117 end;
3 9118 if ventetid=0 then ventetid:= 1;
3 9119 until false;
3 9120
3 9120 alarmur_trap:
3 9121 disable skriv_alarmur(zbillede,1);
3 9122 end alarmur;
2 9123 \f
2 9123 message procedure opkaldsalarmer side 1;
2 9124
2 9124 procedure opkaldsalarmer;
2 9125 begin
3 9126 integer nr, ny_kommando, tilst, aktion, tt;
3 9127 integer array field tab, opref, alarmop;
3 9128
3 9128 procedure skriv_opkaldsalarmer(zud,omfang);
3 9129 value omfang;
3 9130 zone zud;
3 9131 integer omfang;
3 9132 begin
4 9133 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9134 if omfang>0 then
4 9135 disable begin
5 9136 real array field raf;
5 9137 trap(slut);
5 9138 raf:=0;
5 9139 write(zud,"nl",1,
5 9140 <: nr: :>,nr,"nl",1,
5 9141 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9142 <: tilst: :>,tilst,"nl",1,
5 9143 <: aktion: :>,aktion,"nl",1,
5 9144 <: tt: :>,false add tt,1,"nl",1,
5 9145 <: tab: :>,tab,"nl",1,
5 9146 <: opref: :>,opref,"nl",1,
5 9147 <: alarmop: :>,alarmop,"nl",1,
5 9148 <::>);
5 9149 skriv_coru(zud,coru_no(296));
5 9150 slut:
5 9151 end;
4 9152 end skriv_opkaldsalarmer;
3 9153
3 9153 trap(opk_alarm_trap);
3 9154 stackclaim(400);
3 9155
3 9155 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9156 skriv_opkaldsalarmer(out,0);
3 9157 <*-2*>
3 9158
3 9158 repeat
3 9159 wait(bs_opk_alarm);
3 9160 alarmop:= 0;
3 9161 for nr:= 1 step 1 until max_antal_operatører do
3 9162 begin
4 9163 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9164 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9165 tilst:= opk_alarm.tab.alarm_tilst;
4 9166 aktion:= case ny_kommando+1 of (
4 9167 <*ingenting*> case tilst+1 of (4,4,4),
4 9168 <*normal *> case tilst+1 of (1,4,4),
4 9169 <*nød *> case tilst+1 of (2,2,4),
4 9170 <*sluk *> case tilst+1 of (4,3,3));
4 9171 tt:= case aktion of ('B','C','F','-');
4 9172 if tt<>'-' then
4 9173 begin
5 9174 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9175 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9176 d.opref.data(1):= nr+16;
5 9177 signalch(cs_talevejsswitch,opref,op_optype);
5 9178 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9179 if d.opref.resultat = 3 then
5 9180 begin
6 9181 opk_alarm.tab.alarm_kmdo:= 0;
6 9182 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9183 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9184 if aktion < 3 then
6 9185 begin
7 9186 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9187 if alarmop = 0 then
7 9188 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9189 end;
6 9190 end;
5 9191 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9192 end;
4 9193 end;
3 9194 if alarmop<>0 then
3 9195 begin
4 9196 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9197 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9198 end;
3 9199 until false;
3 9200
3 9200 opk_alarm_trap:
3 9201 disable skriv_opkaldsalarmer(zbillede,1);
3 9202 end;
2 9203
2 9203 \f
2 9203 message procedure tvswitch_input side 1 - 940810/cl;
2 9204
2 9204 procedure tv_switch_input;
2 9205 begin
3 9206 integer array field opref;
3 9207 integer tt,ant;
3 9208 boolean ok;
3 9209 integer array ia(1:128);
3 9210
3 9210 procedure skriv_tvswitch_input(zud,omfang);
3 9211 value omfang;
3 9212 zone zud;
3 9213 integer omfang;
3 9214 begin
4 9215 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9216 if omfang>0 then
4 9217 disable begin
5 9218 real array field raf;
5 9219 trap(slut);
5 9220 raf:=0;
5 9221 write(zud,"nl",1,
5 9222 <: opref: :>,opref,"nl",1,
5 9223 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9224 <: ant: :>,ant,"nl",1,
5 9225 <: tt: :>,tt,"nl",1,
5 9226 <::>);
5 9227 write(zud,"nl",1,<:ia: :>);
5 9228 skrivhele(zud,ia.raf,256,2);
5 9229 skriv_coru(zud,coru_no(297));
5 9230 slut:
5 9231 end;
4 9232 end skriv_tvswitch_input;
3 9233 \f
3 9233 boolean procedure læs_tlgr;
3 9234 begin
4 9235 integer kl,ch,i,pos,p;
4 9236 long field lf;
4 9237 boolean ok;
4 9238
4 9238 integer procedure readch(z,c);
4 9239 zone z; integer c;
4 9240 begin
5 9241 readch:= readchar(z,c);
5 9242 <*+2*> if testbit15 and overvåget then
5 9243 disable begin
6 9244 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9245 else write(zrl,"<",1,<<d>,c,">",1);
6 9246 if c='em' then write(zrl,<: *timeout*:>);
6 9247 end;
5 9248 <*-2*>
5 9249 end;
4 9250
4 9250 ok:= false; tt:=' ';
4 9251 repeat
4 9252 readchar(z_tv_in,ch);
4 9253 until ch<>'em';
4 9254 repeatchar(z_tv_in);
4 9255
4 9255 <*+2*>if testbit15 and overvåget then
4 9256 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9257 <*-2*>
4 9258
4 9258 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9259 if ch='%' then
4 9260 begin
5 9261 ant:= 0; pos:= 1; lf:= 4;
5 9262 ok:= true;
5 9263 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9264
5 9264 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9265 skrivtegn(ia,pos,ch);
5 9266
5 9266 p:=pos;
5 9267 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9268
5 9268 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9269 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9270 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9271
5 9271 if ok and ch=' ' then
5 9272 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9273
5 9273 while kl = 2 do
5 9274 begin
6 9275 i:= ch - '0';
6 9276 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9277 if ant < 128 then
6 9278 begin
7 9279 ant:= ant+1;
7 9280 ia(ant):= i;
7 9281 end
6 9282 else
6 9283 ok:= false;
6 9284 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9285 end;
5 9286 if ch<>'nl' then ok:= false;
5 9287 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9288 <* !! setposition(z_tv_in,0,0); !! *>
5 9289 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9290 <*-2*>
5 9291
5 9291 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9292 ok:= ok
5 9293 else if tt='C' or tt='N' or
5 9294 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9295 ok:= ok and ant=1
5 9296 else if tt='X' or tt='Y' then
5 9297 ok:= ok and ant=2
5 9298 else if tt='T' or tt='W' then
5 9299 ok:= ok and ant=64
5 9300 else if tt='R' then
5 9301 ok:= ok and ant extract 1 = 0
5 9302 else
5 9303 begin
6 9304 ok:= false;
6 9305 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9306 end;
5 9307
5 9307 end; <* if ch='%' *>
4 9308 læs_tlgr:= ok;
4 9309 end læs_tlgr;
3 9310 \f
3 9310 trap(tvswitch_input_trap);
3 9311 stackclaim(400);
3 9312 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9313
3 9313 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9314 skriv_tvswitch_input(out,0);
3 9315 <*-2*>
3 9316
3 9316 repeat
3 9317 ok:= læs_tlgr;
3 9318 if ok then
3 9319 begin
4 9320 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9321 start_operation(opref,297,cs_tvswitch_input,0);
4 9322 d.opref.resultat:= tt shift 12 + ant;
4 9323 tofrom(d.opref.data,ia,ant*2);
4 9324 signalch(cs_talevejsswitch,opref,op_optype);
4 9325 end;
3 9326 until false;
3 9327
3 9327 tvswitch_input_trap:
3 9328
3 9328 disable skriv_tvswitch_input(zbillede,1);
3 9329
3 9329 end tvswitch_input;
2 9330 \f
2 9330 message procedure tv_switch_adm side 1 - 940502/cl;
2 9331
2 9331 procedure tv_switch_adm;
2 9332 begin
3 9333 integer array field opref;
3 9334 integer rc;
3 9335
3 9335 procedure skriv_tv_switch_adm(zud,omfang);
3 9336 value omfang;
3 9337 zone zud;
3 9338 integer omfang;
3 9339 begin
4 9340 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9341 if omfang>0 then
4 9342 disable begin
5 9343 trap(slut);
5 9344 write(zud,"nl",1,
5 9345 <: opref: :>,opref,"nl",1,
5 9346 <: rc: :>,rc,"nl",1,
5 9347 <::>);
5 9348 skriv_coru(zud,coru_no(298));
5 9349 slut:
5 9350 end;
4 9351 end skriv_tv_switch_adm;
3 9352
3 9352 trap(tv_switch_adm_trap);
3 9353 stackclaim(400);
3 9354
3 9354 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9355 disable skriv_tv_switch_adm(out,0);
3 9356 <*-2*>
3 9357
3 9357
3 9357
3 9357 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9358 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9359 *>
3 9360
3 9360 repeat
3 9361 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9362 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9363 rc:= 0;
3 9364 repeat
3 9365 signalch(cs_talevejsswitch,opref,op_optype);
3 9366 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9367 rc:= rc+1;
3 9368 until rc=3 or d.opref.resultat=3;
3 9369
3 9369 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9370
3 9370 <*V*> delay(15*60);
3 9371 until false;
3 9372 tv_switch_adm_trap:
3 9373 disable skriv_tv_switch_adm(zbillede,1);
3 9374 end;
2 9375 \f
2 9375 message procedure talevejsswitch side 1 -940426/cl;
2 9376
2 9376 procedure talevejsswitch;
2 9377 begin
3 9378 integer tt, ant, ventetid;
3 9379 integer array field opref, gemt_op, tab;
3 9380 boolean ok;
3 9381 integer array ia(1:128);
3 9382
3 9382 procedure skriv_talevejsswitch(zud,omfang);
3 9383 value omfang;
3 9384 zone zud;
3 9385 integer omfang;
3 9386 begin
4 9387 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9388 if omfang>0 then
4 9389 disable begin
5 9390 real array field raf;
5 9391 trap(slut);
5 9392 raf:= 0;
5 9393 write(zud,"nl",1,
5 9394 <: tt: :>,tt,"nl",1,
5 9395 <: ant: :>,ant,"nl",1,
5 9396 <: ventetid: :>,ventetid,"nl",1,
5 9397 <: opref: :>,opref,"nl",1,
5 9398 <: gemt-op: :>,gemt_op,"nl",1,
5 9399 <: tab: :>,tab,"nl",1,
5 9400 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9401 <::>);
5 9402 write(zud,"nl",1,<:ia: :>);
5 9403 skriv_hele(zud,ia.raf,256,2);
5 9404 skriv_coru(zud,coru_no(299));
5 9405 slut:
5 9406 end;
4 9407 end skriv_talevejsswitch;
3 9408 \f
3 9408 trap(tvswitch_trap);
3 9409 stackclaim(400);
3 9410 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9411
3 9411 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9412 skriv_talevejsswitch(out,0);
3 9413 <*-2*>
3 9414
3 9414 ventetid:= -1; ant:= 0; tt:= ' ';
3 9415 repeat
3 9416 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9417 if opref > 0 then
3 9418 begin
4 9419 if d.opref.opkode extract 12 = 0 then
4 9420 begin <*input fra talevejsswitchen *>
5 9421 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9422 tt:= d.opref.resultat shift (-12) extract 12;
5 9423 ant:= d.opref.resultat extract 12;
5 9424 tofrom(ia,d.opref.data,ant*2);
5 9425 signalch(d.opref.retur,opref,d.opref.optype);
5 9426
5 9426 if tt<>'+' and tt<>'-' then
5 9427 begin
6 9428 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9429 setposition(z_tv_out,0,0);
6 9430 <*+2*> if testbit15 and overvåget then
6 9431 disable begin
7 9432 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9433 outchar(zrl,'nl');
7 9434 end;
6 9435 <*-2*>
6 9436 end;
5 9437 if (tt='+' or tt='-') and gemt_op<>0 then
5 9438 begin
6 9439 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9440 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9441 gemt_op:= 0;
6 9442 ventetid:= -1;
6 9443 end
5 9444 else
5 9445 if tt='R' then
5 9446 begin
6 9447 for i:= 1 step 2 until ant do
6 9448 begin
7 9449 if ia(i) <= max_antal_taleveje and
7 9450 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9451 then
7 9452 begin
8 9453 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9454 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9455 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9456 op_talevej(tv_operatør(ia(i))):= 0;
8 9457 tv_operatør(ia(i)):= ia(i+1)-16;
8 9458 op_talevej(ia(i+1)-16):= ia(i);
8 9459 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9460 end
7 9461 else
7 9462 if ia(i+1) <= max_antal_taleveje and
7 9463 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9464 then
7 9465 begin
8 9466 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9467 tv_operatør(op_talevej(ia(i))):= 0;
8 9468 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9469 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9470 tv_operatør(ia(i+1)):= ia(i)-16;
8 9471 op_talevej(ia(i)-16):= ia(i+1);
8 9472 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9473 end;
7 9474 end;
6 9475 signal_bin(bs_mobil_opkald);
6 9476 <*+2*> if testbit15 and testbit16 and overvåget then
6 9477 disable begin
7 9478 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9479 end;
6 9480 <*-2*>
6 9481 end <* tt='R' and ant>0 *>
5 9482 else
5 9483 if tt='Y' then
5 9484 begin
6 9485 if ia(1) <= max_antal_taleveje and
6 9486 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9487 then
6 9488 begin
7 9489 if tv_operatør(ia(1))=ia(2)-16 and
7 9490 op_talevej(ia(2)-16)=ia(1)
7 9491 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9492 end
6 9493 else
6 9494 if ia(2) <= max_antal_taleveje and
6 9495 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9496 then
6 9497 begin
7 9498 if tv_operatør(ia(2))=ia(1)-16 and
7 9499 op_talevej(ia(1)-16)=ia(2)
7 9500 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9501 end;
6 9502 end
5 9503 else
5 9504 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9505 begin
6 9506 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9507 startoperation(opref,299,cs_op_iomedd,23);
6 9508 ant:= 1;
6 9509 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9510 anbringtal(d.opref.data,ant,ia(1),2);
6 9511 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9512 begin
7 9513 hægtstring(d.opref.data,ant,<: (:>);
7 9514 if bpl_navn(ia(1)-16)=long<::> then
7 9515 begin
8 9516 hægtstring(d.opref.data,ant,<:op:>);
8 9517 anbringtal(d.opref.data,ant,ia(1)-16,
8 9518 if ia(1)-16 > 9 then 2 else 1);
8 9519 end
7 9520 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9521 skrivtegn(d.opref.data,ant,')');
7 9522 end;
6 9523 hægtstring(d.opref.data,ant,
6 9524 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9525 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9526 if tt='P' then <: Tilgængelig:> else
6 9527 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9528 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9529 signalch(cs_io,opref,gen_optype);
6 9530 end
5 9531 else
5 9532 if tt='Z' then
5 9533 begin
6 9534 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9535 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9536 end
5 9537 else
5 9538 begin
6 9539 <* ikke implementeret *>
6 9540 end;
5 9541 end
4 9542 else
4 9543 if d.opref.opkode extract 12 = 44 then
4 9544 begin
5 9545 tt:= d.opref.opkode shift (-12);
5 9546 ok:= true;
5 9547 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9548 begin
6 9549 <*+2*> if testbit15 and overvåget then
6 9550 disable begin
7 9551 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9552 outchar(zrl,'nl');
7 9553 end;
6 9554 <*-2*>
6 9555 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9556 setposition(z_tv_out,0,0);
6 9557 end
5 9558 else
5 9559 if tt='B' or tt='C' or tt='F' then
5 9560 begin
6 9561 <*+2*> if testbit15 and overvåget then
6 9562 disable begin
7 9563 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9564 " ",1,<<d>,d.opref.data(1));
7 9565 outchar(zrl,'nl');
7 9566 end;
6 9567 <*-2*>
6 9568 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9569 d.opref.data(1),"cr",1);
6 9570 setposition(z_tv_out,0,0);
6 9571 end
5 9572 else
5 9573 if tt='A' or tt='D' or tt='T' then
5 9574 begin
6 9575 <*+2*> if testbit15 and overvåget then
6 9576 disable begin
7 9577 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9578 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9579 outchar(zrl,'nl');
7 9580 end;
6 9581 <*-2*>
6 9582 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9583 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9584 setposition(z_tv_out,0,0);
6 9585 end
5 9586 else
5 9587 ok:= false;
5 9588 if ok then
5 9589 begin
6 9590 gemt_op:= opref;
6 9591 ventetid:= 2;
6 9592 end
5 9593 else
5 9594 begin
6 9595 d.opref.resultat:= 4;
6 9596 signalch(d.opref.retur,opref,d.opref.optype);
6 9597 end;
5 9598 end;
4 9599 end
3 9600 else
3 9601 if gemt_op<>0 then
3 9602 begin <*timeout*>
4 9603 d.gemt_op.resultat:= 0;
4 9604 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9605 gemt_op:= 0;
4 9606 ventetid:= -1;
4 9607 <*+2*> if testbit15 and overvåget then
4 9608 disable begin
5 9609 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9610 outchar(zrl,'nl');
5 9611 end;
4 9612 <*-2*>
4 9613 end;
3 9614 until false;
3 9615 tvswitch_trap:
3 9616 disable skriv_talevejsswitch(zbillede,1);
3 9617 end talevejsswitch;
2 9618
2 9618 \f
2 9618 message garage_erklæringer side 1 - 810415/hko;
2 9619
2 9619 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 9620
2 9620 procedure gar_fejl(z,s,b);
2 9621 integer s,b;
2 9622 zone z;
2 9623 begin
3 9624 disable begin
4 9625 integer array iz(1:20);
4 9626 integer i,j,k;
4 9627 integer array field iaf;
4 9628 real array field raf;
4 9629
4 9629 getzone6(z,iz);
4 9630 iaf:=raf:=2;
4 9631 getnumber(iz.raf,7,j);
4 9632
4 9632 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 9633 k:=1;
4 9634
4 9634 j:= terminal_tab.iaf.terminal_tilstand;
4 9635 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 9636 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 9637 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 9638 if s <> (1 shift 21 +2) then
4 9639 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 9640 + terminal_tab.iaf.terminal_tilstand extract 21;
4 9641 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 9642 begin
5 9643 z(1):=real <:<'?'><'em'>:>;
5 9644 b:=2;
5 9645 end;
4 9646 end; <*disable*>
3 9647 end gar_fejl;
2 9648
2 9648 integer cs_gar;
2 9649 integer array cs_garage(1:max_antal_garageterminaler);
2 9650 \f
2 9650 message procedure h_garage side 1 - 810520/hko;
2 9651
2 9651 <* hovedmodulkorutine for garageterminaler *>
2 9652 procedure h_garage;
2 9653 begin
3 9654 integer array field op_ref;
3 9655 integer k,dest_sem;
3 9656 procedure skriv_hgarage(zud,omfang);
3 9657 value omfang;
3 9658 zone zud;
3 9659 integer omfang;
3 9660 begin integer i;
4 9661
4 9661 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 9662 write(zud,"sp",26-i);
4 9663 if omfang>0 then
4 9664 disable begin
5 9665 integer x;
5 9666 trap(slut);
5 9667 write(zud,"nl",1,
5 9668 <: op_ref: :>,op_ref,"nl",1,
5 9669 <: k: :>,k,"nl",1,
5 9670 <: dest_sem: :>,dest_sem,"nl",1,
5 9671 <::>);
5 9672 skriv_coru(zud,coru_no(300));
5 9673 slut:
5 9674 end;
4 9675 end skriv_hgarage;
3 9676
3 9676 trap(hgar_trap);
3 9677 stack_claim(if cm_test then 198 else 146);
3 9678
3 9678 <*+2*>
3 9679 if testbit16 and overvåget or testbit28 then
3 9680 skriv_hgarage(out,0);
3 9681 <*-2*>
3 9682 \f
3 9682 message procedure h_garage side 2 - 811105/hko;
3 9683
3 9683 repeat
3 9684 wait_ch(cs_gar,op_ref,true,-1);
3 9685 <*+4*>
3 9686 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 9687 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 9688 <*-4*>
3 9689
3 9689 k:=d.op_ref.opkode extract 12;
3 9690 dest_sem:=
3 9691 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 9692 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 9693 else -1;
3 9694 <*+4*>
3 9695 if dest_sem=-1 then
3 9696 begin
4 9697 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 9698 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 9699 end
3 9700 else
3 9701 <*-4*>
3 9702 if k=7<*inkluder*> then
3 9703 begin
4 9704 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 9705 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 9706 begin
5 9707 d.op_ref.resultat:=3;
5 9708 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9709 dest_sem:=-2;
5 9710 end;
4 9711 end
3 9712 else
3 9713 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 9714 begin
4 9715 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 9716 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 9717 +terminal_tab.iaf.terminal_tilstand extract 21;
4 9718 end;
3 9719 if dest_sem>0 then
3 9720 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 9721 until false;
3 9722
3 9722 hgar_trap:
3 9723 disable skriv_hgarage(zbillede,1);
3 9724 end h_garage;
2 9725 \f
2 9725 message procedure garage side 1 - 830310/cl;
2 9726
2 9726 procedure garage(nr);
2 9727 value nr;
2 9728 integer nr;
2 9729 begin
3 9730 integer array field op_ref,ref;
3 9731 integer i,kode,aktion,status,opgave,retur_sem,
3 9732 pos,indeks,sep,sluttegn,vogn,ll;
3 9733
3 9733 procedure skriv_garage(zud,omfang);
3 9734 value omfang;
3 9735 zone zud;
3 9736 integer omfang;
3 9737 begin integer i;
4 9738
4 9738 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 9739 write(zud,"sp",26-i);
4 9740 if omfang > 0 then
4 9741 disable begin integer x;
5 9742 trap(slut);
5 9743 write(zud,"nl",1,
5 9744 <: op-ref: :>,op_ref,"nl",1,
5 9745 <: kode: :>,kode,"nl",1,
5 9746 <: ref: :>,ref,"nl",1,
5 9747 <: i: :>,i,"nl",1,
5 9748 <: aktion: :>,aktion,"nl",1,
5 9749 <: retur-sem: :>,retur_sem,"nl",1,
5 9750 <: vogn: :>,vogn,"nl",1,
5 9751 <: ll: :>,ll,"nl",1,
5 9752 <: status: :>,status,"nl",1,
5 9753 <: opgave: :>,opgave,"nl",1,
5 9754 <: pos: :>,pos,"nl",1,
5 9755 <: indeks: :>,indeks,"nl",1,
5 9756 <: sep: :>,sep,"nl",1,
5 9757 <: sluttegn: :>,sluttegn,"nl",1,
5 9758 <::>);
5 9759 skriv_coru(zud,coru_no(300+nr));
5 9760 slut:
5 9761 end;
4 9762 end skriv_garage;
3 9763 \f
3 9763 message procedure garage side 2 - 830310/hko;
3 9764
3 9764 trap(gar_trap);
3 9765 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 9766
3 9766 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 9767
3 9767 <*+2*>
3 9768 if testbit16 and overvåget or testbit28 then
3 9769 skriv_garage(out,0);
3 9770 <*-2*>
3 9771
3 9771 <* attention simulering
3 9772 *>
3 9773 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 9774 begin
4 9775 wait_ch(cs_att_pulje,op_ref,true,-1);
4 9776 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 9777 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 9778 end;
3 9779 <*
3 9780 *>
3 9781 \f
3 9781 message procedure garage side 3 - 830310/hko;
3 9782
3 9782 repeat
3 9783
3 9783 <*V*> wait_ch(cs_garage(nr),
3 9784 op_ref,
3 9785 true,
3 9786 -1<*timeout*>);
3 9787 <*+2*>
3 9788 if testbit17 and overvåget then
3 9789 disable begin
4 9790 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 9791 <: til garage :>,nr);
4 9792 skriv_op(out,op_ref);
4 9793 end;
3 9794 <*-2*>
3 9795
3 9795 kode:= d.op_ref.op_kode;
3 9796 retur_sem:= d.op_ref.retur;
3 9797 i:= terminal_tab.ref.terminal_tilstand;
3 9798 status:= i shift(-21);
3 9799 opgave:=
3 9800 if kode=0 then 1 <* indlæs kommando *> else
3 9801 if kode=7 then 2 <* inkluder *> else
3 9802 if kode=8 then 3 <* ekskluder *> else
3 9803 0; <* afvises *>
3 9804
3 9804 aktion:= case status +1 of(
3 9805 <* status *> <* opgave: 0 1 2 3 *>
3 9806 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 9807 <* 1 - *>(-1),<* ulovlig tilstand *>
3 9808 <* 2 - *>(-1),<* ulovlig tilstand *>
3 9809 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 9810 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 9811 <* 5 - *>(-1),<* ulovlig tilstand *>
3 9812 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 9813 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 9814 -1);
3 9815 \f
3 9815 message procedure garage side 4 - 810424/hko;
3 9816
3 9816 case aktion+6 of
3 9817 begin
4 9818 begin
5 9819 <*-5: terminal optaget *>
5 9820
5 9820 d.op_ref.resultat:= 16;
5 9821 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 9822 end;
4 9823
4 9823 begin
5 9824 <*-4: operation uden virkning *>
5 9825
5 9825 afslut_operation(op_ref,-1);
5 9826 end;
4 9827
4 9827 begin
5 9828 <*-3: ulovlig operationskode *>
5 9829
5 9829 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 9830 afslut_operation(op_ref,-1);
5 9831 end;
4 9832
4 9832 begin
5 9833 <*-2: ulovligt garageterminal_nr *>
5 9834
5 9834 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 9835 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 9836 end;
4 9837
4 9837 begin
5 9838 <*-1: ulovlig operatørtilstand *>
5 9839
5 9839 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 9840 afslut_operation(op_ref,-1);
5 9841 end;
4 9842
4 9842 begin
5 9843 <* 0: ikke implementeret *>
5 9844
5 9844 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 9845 afslut_operation(op_ref,-1);
5 9846 end;
4 9847
4 9847 begin
5 9848 \f
5 9848 message procedure garage side 5 - 851001/cl;
5 9849
5 9849 <* 1: indlæs kommando *>
5 9850
5 9850
5 9850 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 9851
5 9851 if d.op_ref.resultat > 3 then
5 9852 begin
6 9853 <*V*> setposition(z_gar(nr),0,0);
6 9854 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 9855 skriv_kvittering(z_gar(nr),op_ref,pos,
6 9856 d.op_ref.resultat);
6 9857 end
5 9858 else if d.op_ref.resultat>0 then
5 9859 begin <*godkendt*>
6 9860 kode:=d.op_ref.opkode;
6 9861 i:= kode extract 12;
6 9862 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 9863 else if kode=9 or kode=10 then 2
6 9864 else 0;
6 9865 if j > 0 then
6 9866 begin
7 9867 case j of
7 9868 begin
8 9869 begin
9 9870 \f
9 9870 message procedure garage side 6 - 851001/cl;
9 9871
9 9871 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 9872 integer vogn,ll;
9 9873 integer array field vtop;
9 9874
9 9874 vogn:=ia(1);
9 9875 ll:=ia(2);
9 9876 <*V*> wait_ch(cs_vt_adgang,
9 9877 vt_op,
9 9878 gen_optype,
9 9879 -1<*timeout sek*>);
9 9880 start_operation(vtop,300+nr,cs_garage(nr),
9 9881 kode);
9 9882 d.vt_op.data(1):=vogn;
9 9883 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 9884 indeks:= vt_op;
9 9885 signal_ch(cs_vt,
9 9886 vt_op,
9 9887 gen_optype or gar_optype);
9 9888
9 9888 <*V*> wait_ch(cs_garage(nr),
9 9889 vt_op,
9 9890 gar_optype,
9 9891 -1<*timeout sek*>);
9 9892 <*+2*> if testbit18 and overvåget then
9 9893 disable begin
10 9894 write(out,"nl",1,<:garage :>,<<d>,nr,
10 9895 <:: operation retur fra vt:>);
10 9896 skriv_op(out,vt_op);
10 9897 end;
9 9898 <*-2*>
9 9899 <*+4*> if vt_op<>indeks then
9 9900 fejl_reaktion(11<*fremmede op*>,op_ref,
9 9901 <:garage-kommando:>,0);
9 9902 <*-4*>
9 9903 <*V*> setposition(z_gar(nr),0,0);
9 9904 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 9905 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 9906 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 9907 else vt_op,-1,d.vt_op.resultat);
9 9908 d.vt_op.optype:=gen_optype or vtoptype;
9 9909 disable afslut_operation(vt_op,cs_vt_adgang);
9 9910 end;
8 9911
8 9911 begin
9 9912 \f
9 9912 message procedure garage side 6a - 830310/cl;
9 9913
9 9913 <* 2 vogntabel,linienr/-,busnr *>
9 9914
9 9914 d.op_ref.retur:= cs_garage(nr);
9 9915 tofrom(d.op_ref.data,ia,10);
9 9916 indeks:= op_ref;
9 9917 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 9918 wait_ch(cs_garage(nr),
9 9919 op_ref,
9 9920 gar_optype,
9 9921 -1<*timeout*>);
9 9922 <*+2*> if testbit18 and overvåget then
9 9923 disable begin
10 9924 write(out,"nl",1,<:garage operation retur fra vt:>);
10 9925 skriv_op(out,op_ref);
10 9926 end;
9 9927 <*-2*>
9 9928 <*+4*>
9 9929 if indeks <> op_ref then
9 9930 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 9931 <*-4*>
9 9932 i:= d.op_ref.resultat;
9 9933 if i = 0 or i > 3 then
9 9934 begin
10 9935 <*V*> setposition(z_gar(nr),0,0);
10 9936 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 9937 end
9 9938 else
9 9939 begin
10 9940 integer antal,fil_ref;
10 9941 antal:= d.op_ref.data(6);
10 9942 fil_ref:= d.op_ref.data(7);
10 9943 <*V*> setposition(z_gar(nr),0,0);
10 9944 write(z_gar(nr),"*",24,"sp",6,
10 9945 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 9946 <*V*> setposition(z_gar(nr),0,0);
10 9947 \f
10 9947 message procedure garage side 6c - 841213/cl;
10 9948
10 9948 pos:= 1;
10 9949 while pos <= antal do
10 9950 begin
11 9951 integer bogst,løb;
11 9952
11 9952 disable i:= læs_fil(fil_ref,pos,j);
11 9953 if i <> 0 then
11 9954 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 9955 else
11 9956 begin
12 9957 vogn:= fil(j,1) shift (-24) extract 24;
12 9958 løb:= fil(j,1) extract 24;
12 9959 if d.op_ref.opkode=9 then
12 9960 begin i:=vogn; vogn:=løb; løb:=i; end;
12 9961 ll:= løb shift (-12) extract 10;
12 9962 bogst:= løb shift (-7) extract 5;
12 9963 if bogst > 0 then bogst:= bogst +'A'-1;
12 9964 løb:= løb extract 7;
12 9965 vogn:= vogn extract 14;
12 9966 i:= d.op_ref.opkode-8;
12 9967 for i:= i,i+1 do
12 9968 begin
13 9969 j:= (i+1) extract 1;
13 9970 case j +1 of
13 9971 begin
14 9972 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 9973 false add bogst,1,"/",1,<<d__>,løb);
14 9974 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 9975 end;
13 9976 end;
12 9977 if pos mod 5 = 0 then
12 9978 begin
13 9979 write(z_gar(nr),"nl",1);
13 9980 <*V*> setposition(z_gar(nr),0,0);
13 9981 end
12 9982 else write(z_gar(nr),"sp",3);
12 9983 end;
11 9984 pos:=pos+1;
11 9985 end;
10 9986 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 9987 \f
10 9987 message procedure garage side 6d- 830310/cl;
10 9988
10 9988 d.opref.opkode:=104; <*slet-fil*>
10 9989 d.op_ref.data(4):=filref;
10 9990 indeks:=op_ref;
10 9991 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 9992 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 9993
10 9993 <*+2*> if testbit18 and overvåget then
10 9994 disable begin
11 9995 write(out,"nl",1,<:garage, slet-fil retur:>);
11 9996 skriv_op(out,op_ref);
11 9997 end;
10 9998 <*-2*>
10 9999
10 9999 <*+4*> if op_ref<>indeks then
10 10000 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10001 <*-4*>
10 10002 if d.op_ref.data(9)<>0 then
10 10003 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10004 <:garage, slet_fil:>,1);
10 10005 end;
9 10006 \f
9 10006 message procedure garage side 7 -810424/hko;
9 10007
9 10007 end;
8 10008
8 10008 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10009 <*-4*>
8 10010 end;<*case j *>
7 10011 end <* j > 0 *>
6 10012 else
6 10013 begin
7 10014 <*V*> setposition(z_gar(nr),0,0);
7 10015 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10016 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10017 4 <*kommando ukendt *>);
7 10018 end;
6 10019 end;<* godkendt *>
5 10020
5 10020 <*V*> setposition(z_gar(nr),0,0);
5 10021
5 10021 d.op_ref.opkode:=0; <*telex*>
5 10022
5 10022 disable afslut_operation(op_ref,cs_gar);
5 10023 end; <* indlæs kommando *>
4 10024
4 10024 begin
5 10025 \f
5 10025 message procedure garage side 8 - 841213/cl;
5 10026
5 10026 <* 2: inkluder *>
5 10027
5 10027 d.op_ref.resultat:=3;
5 10028 afslut_operation(op_ref,-1);
5 10029 monitor(8)reserve:(z_gar(nr),0,ia);
5 10030 terminal_tab.ref.terminal_tilstand:=
5 10031 terminal_tab.ref.terminal_tilstand extract 21;
5 10032 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10033 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10034 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10035 end;
4 10036
4 10036 begin
5 10037
5 10037 <* 3: ekskluder *>
5 10038 d.op_ref.resultat:= 3;
5 10039 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10040 terminal_tab.ref.terminal_tilstand extract 21;
5 10041 monitor(10)release:(z_gar(nr),0,ia);
5 10042 afslut_operation(op_ref,-1);
5 10043
5 10043 end;
4 10044
4 10044 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10045 <*-4*>
4 10046 end; <* case aktion+6 *>
3 10047
3 10047 until false;
3 10048 gar_trap:
3 10049 skriv_garage(zbillede,1);
3 10050 end garage;
2 10051
2 10051 \f
2 10051 message procedure radio_erklæringer side 1 - 820304/hko;
2 10052
2 10052 zone z_fr_in(14,1,rad_in_fejl),
2 10053 z_rf_in(14,1,rad_in_fejl),
2 10054 z_fr_out(14,1,rad_out_fejl),
2 10055 z_rf_out(14,1,rad_out_fejl);
2 10056
2 10056 integer array
2 10057 radiofejl,
2 10058 ss_samtale_nedlagt,
2 10059 ss_radio_aktiver(1:max_antal_kanaler),
2 10060 bs_talevej_udkoblet,
2 10061 cs_radio(1:max_antal_taleveje),
2 10062 radio_linietabel(1:max_linienr//3+1),
2 10063 radio_områdetabel(0:max_antal_områder),
2 10064 opkaldskø(opkaldskø_postlængde//2+1:
2 10065 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10066 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10067 hookoff_maske(1:(tv_maske_lgd//2)),
2 10068 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10069
2 10069 integer field
2 10070 kanal_tilstand,
2 10071 kanal_id1,
2 10072 kanal_id2,
2 10073 kanal_spec,
2 10074 kanal_alt_id1,
2 10075 kanal_alt_id2;
2 10076 integer array field
2 10077 kanal_mon_maske,
2 10078 kanal_alarm,
2 10079 opkald_meldt;
2 10080
2 10080 integer
2 10081 cs_rad,
2 10082 cs_radio_medd,
2 10083 cs_radio_adm,
2 10084 cs_radio_ind,
2 10085 cs_radio_ud,
2 10086 cs_radio_pulje,
2 10087 cs_radio_kø,
2 10088 bs_mobil_opkald,
2 10089 bs_opkaldskø_adgang,
2 10090 opkaldskø_ledige,
2 10091 nødopkald_brugt,
2 10092 første_frie_opkald,
2 10093 første_opkald,
2 10094 sidste_opkald,
2 10095 første_nødopkald,
2 10096 sidste_nødopkald,
2 10097 optaget_flag;
2 10098
2 10098 boolean
2 10099 mobil_opkald_aktiveret;
2 10100 \f
2 10100 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10101
2 10101 integer
2 10102 procedure læs_hex_ciffer(tabel,linie,op);
2 10103 value linie;
2 10104 integer array tabel;
2 10105 integer linie,op;
2 10106 begin
3 10107 integer i,j;
3 10108
3 10108 i:=(if linie>=0 then linie+6 else linie)//6;
3 10109 j:=((i-1)*6-linie)*4;
3 10110 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10111 end læs_hex_ciffer;
2 10112
2 10112 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10113
2 10113 integer
2 10114 procedure sæt_hex_ciffer(tabel,linie,op);
2 10115 value linie;
2 10116 integer array tabel;
2 10117 integer linie,op;
2 10118 begin
3 10119 integer i,j;
3 10120
3 10120 i:=(if linie>=0 then linie+6 else linie)//6;
3 10121 j:=(linie-(i-1)*6)*4;
3 10122 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10123 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10124 shift j add (tabel(i) extract j);
3 10125 end sæt_hex_ciffer;
2 10126
2 10126 message procedure hex_to_dec side 1 - 900108/cl;
2 10127
2 10127 integer procedure hex_to_dec(hex);
2 10128 value hex;
2 10129 integer hex;
2 10130 begin
3 10131 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10132 else (hex-'0');
3 10133 end;
2 10134
2 10134 message procedure dec_to_hex side 1 - 900108/cl;
2 10135
2 10135 integer procedure dec_to_hex(dec);
2 10136 value dec;
2 10137 integer dec;
2 10138 begin
3 10139 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10140 else ('A'+dec-10);
3 10141 end;
2 10142
2 10142 message procedure rad_out_fejl side 1 - 820304/hko;
2 10143
2 10143 procedure rad_out_fejl(z,s,b);
2 10144 value s;
2 10145 zone z;
2 10146 integer s,b;
2 10147 begin
3 10148 integer array field iaf;
3 10149 integer pos,tegn,max,i;
3 10150 integer array ia(1:20);
3 10151 long array field laf;
3 10152
3 10152 disable begin
4 10153 laf:= iaf:= 2;
4 10154 tegn:= 1;
4 10155 getzone6(z,ia);
4 10156 max:= ia(16)//2*3;
4 10157 if s = 1 shift 21 + 2 then
4 10158 begin
5 10159 z(1):= real<:<'em'>:>;
5 10160 b:= 2;
5 10161 end
4 10162 else
4 10163 begin
5 10164 pos:= 0;
5 10165 for i:= 1 step 1 until max_antal_kanaler do
5 10166 begin
6 10167 iaf:= (i-1)*kanalbeskr_længde;
6 10168 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10169 if pos>0 then
6 10170 begin
7 10171 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10172 signalbin(bs_mobilopkald);
7 10173 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10174 1 shift 12<*binært*> +1<*fortsæt*>);
7 10175 end;
6 10176 end;
5 10177 end;
4 10178 end;
3 10179 end;
2 10180 \f
2 10180 message procedure rad_in_fejl side 1 - 810601/hko;
2 10181
2 10181 procedure rad_in_fejl(z,s,b);
2 10182 value s;
2 10183 zone z;
2 10184 integer s,b;
2 10185 begin
3 10186 integer array field iaf;
3 10187 integer pos,tegn,max,i;
3 10188 integer array ia(1:20);
3 10189 long array field laf;
3 10190
3 10190 disable begin
4 10191 laf:= iaf:= 2;
4 10192 i:= 1;
4 10193 getzone6(z,ia);
4 10194 max:= ia(16)//2*3;
4 10195 if s shift (-21) extract 1 = 0
4 10196 and s shift(-19) extract 1 = 0 then
4 10197 begin
5 10198 if b = 0 then
5 10199 begin
6 10200 z(1):= real<:!:>;
6 10201 b:= 2;
6 10202 end;
5 10203 end;
4 10204 \f
4 10204 message procedure rad_in_fejl side 2 - 820304/hko;
4 10205
4 10205 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10206 begin
5 10207 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10208 1 shift 12<*binær*> +1<*fortsæt*>);
5 10209 end
4 10210 else
4 10211 if s shift (-19) extract 1 = 1 then
4 10212 begin
5 10213 z(1):= real<:!<'nl'>:>;
5 10214 b:= 2;
5 10215 end
4 10216 else
4 10217 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10218 begin
5 10219 <*
5 10220 if b = 0 then
5 10221 begin
5 10222 *>
5 10223 z(1):= real <:<'em'>:>;
5 10224 b:= 2;
5 10225 <*
5 10226 end
5 10227 else
5 10228 begin
5 10229 tegn:= -1;
5 10230 iaf:= 0;
5 10231 pos:= b//2*3-2;
5 10232 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10233 skriv_tegn(z.iaf,pos,'?');
5 10234 if pos<=max then
5 10235 afslut_text(z.iaf,pos);
5 10236 b:= (pos-1)//3*2;
5 10237 end;
5 10238 *>
5 10239 end;<* s=1 shift 21+2 *>
4 10240 end;
3 10241 if testbit22 and
3 10242 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10243 then
3 10244 delay(60);
3 10245 end rad_in_fejl;
2 10246 \f
2 10246 message procedure afvent_radioinput side 1 - 880901/cl;
2 10247
2 10247 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10248 value rf;
2 10249 zone z_in;
2 10250 integer array tlgr;
2 10251 boolean rf;
2 10252 begin
3 10253 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10254 long array field laf;
3 10255
3 10255 laf:= 0;
3 10256 pos:= 1;
3 10257 repeat
3 10258 i:=readchar(z_in,tegn);
3 10259 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10260 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10261 p:=pos;
3 10262 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10263 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10264 (rf and testbit39)) then
3 10265 disable begin
4 10266 write(zrl,<<zd dd dd.dd >,now,
4 10267 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10268 if tegn='em' then <:*timeout*:> else
4 10269 if pos>=80 then <:*for langt*:> else <::>);
4 10270 outchar(zrl,'nl');
4 10271 end;
3 10272 <*-2*>
3 10273 ac:= -1;
3 10274 if pos >= 80 then
3 10275 begin <* telegram for langt *>
4 10276 repeat readchar(z_in,tegn)
4 10277 until tegn='nl' or tegn='em';
4 10278 end
3 10279 else
3 10280 if pos>1 and tegn='nl' then
3 10281 begin
4 10282 lgd:= 1;
4 10283 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10284 lgd:= lgd-2;
4 10285 if lgd >= 5 then
4 10286 begin
5 10287 lgd:= lgd-2; <* se bort fra checksum *>
5 10288 i:= lgd + 1;
5 10289 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10290 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10291 i:= lgd + 1;
5 10292 skrivtegn(tlgr,i,0);
5 10293 skrivtegn(tlgr,i,0);
5 10294 i:= 1; sum:= 0;
5 10295 while i <= lgd do
5 10296 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10297 if csum >= 0 and csum <> sum then
5 10298 begin
6 10299 <*+2*> if overvåget and (testbit36 or
6 10300 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10301 disable begin
7 10302 write(zrl,<<zd dd dd.dd >,now,
7 10303 (if rf then <:rf:> else <:fr:>),
7 10304 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10305 end;
6 10306 <*-2*>
6 10307 ac:= 6 <* checksumfejl *>
6 10308 end
5 10309 else
5 10310 ac:= 0;
5 10311 end
4 10312 else ac:= 6; <* for kort telegram - retransmitter *>
4 10313 end;
3 10314 afvent_radioinput:= ac;
3 10315 end;
2 10316 \f
2 10316 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10317
2 10317 procedure skriv_kanal_tab(z);
2 10318 zone z;
2 10319 begin
3 10320 integer array field ref;
3 10321 integer i,j,t,op,id1,id2;
3 10322
3 10322 write(z,"ff",1,"nl",1,<:
3 10323 ******** kanal-beskrivelser *******
3 10324
3 10324 a k l p m b n
3 10325 l a y a o s ø
3 10326 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10327 <*
3 10328 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10329 *>
3 10330 "nl",1);
3 10331 for i:=1 step 1 until max_antal_kanaler do
3 10332 begin
4 10333 ref:=(i-1)*kanal_beskr_længde;
4 10334 t:=kanal_tab.ref.kanal_tilstand;
4 10335 id1:=kanal_tab.ref.kanal_id1;
4 10336 id2:=kanal_tab.ref.kanal_id2;
4 10337 write(z,"nl",1,"sp",4,
4 10338 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10339 for j:=11 step -1 until 2 do
4 10340 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10341 write(z,case t extract 2 +1 of
4 10342 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10343 "sp",1);
4 10344 skriv_id(z,id1,9);
4 10345 skriv_id(z,id2,9);
4 10346 t:=kanal_tab.ref.kanal_spec;
4 10347 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10348 write(z,"nl",1,"sp",14,<:mon: :>);
4 10349 for j:= max_antal_taleveje step -1 until 1 do
4 10350 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10351 else "."),1);
4 10352 write(z,"sp",25-max_antal_taleveje);
4 10353 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10354 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10355 end;
3 10356 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10357 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10358 write(z,"nl",2);
3 10359 end skriv_kanal_tab;
2 10360 \f
2 10360 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10361
2 10361 procedure skriv_opkaldskø(z);
2 10362 zone z;
2 10363 begin
3 10364 integer i,bogst,løb,j;
3 10365 integer array field ref;
3 10366 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10367 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10368 <: sig omr :>,"nl",1);
3 10369 for i:= 1 step 1 until max_antal_mobilopkald do
3 10370 begin
4 10371 ref:= i*opkaldskø_postlængde;
4 10372 j:= opkaldskø.ref(1);
4 10373 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10374 j:= opkaldskø.ref(2);
4 10375 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10376 skriv_id(z,j extract 23,9);
4 10377 j:= opkaldskø.ref(3);
4 10378 skriv_id(z,j,7);
4 10379 j:= opkaldskø.ref(4);
4 10380 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10381 << zd>,j extract 8);
4 10382 j:= j shift (-8) extract 4;
4 10383 if j = 1 or j = 2 then
4 10384 write(z,if j=1 then <: normal:> else <: nød :>)
4 10385 else write(z,<<dddd>,j,"sp",3);
4 10386 j:= opkaldskø.ref(5);
4 10387 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10388 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10389 string område_navn(j extract 8) else <:---:>);
4 10390 outchar(z,'nl');
4 10391 end;
3 10392
3 10392 write(z,"nl",1,<<z>,
3 10393 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10394 <:første_opkald=:>,første_opkald,"nl",1,
3 10395 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10396 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10397 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10398 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10399 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10400 "nl",1,<:opkaldsflag::>,"nl",1);
3 10401 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10402 write(z,"nl",2);
3 10403 end skriv_opkaldskø;
2 10404 \f
2 10404 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10405
2 10405 procedure skriv_radio_linie_tabel(z);
2 10406 zone z;
2 10407 begin
3 10408 integer i,j,k;
3 10409
3 10409 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10410 k:= 0;
3 10411 for i:= 1 step 1 until max_linienr do
3 10412 begin
4 10413 læstegn(radio_linietabel,i+1,j);
4 10414 if j > 0 then
4 10415 begin
5 10416 k:= k +1;
5 10417 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10418 "nl",if k mod 5=0 then 1 else 0);
5 10419 end;
4 10420 end;
3 10421 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10422 end skriv_radio_linietabel;
2 10423
2 10423 procedure skriv_radio_områdetabel(z);
2 10424 zone z;
2 10425 begin
3 10426 integer i;
3 10427
3 10427 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10428 for i:= 1 step 1 until max_antal_områder do
3 10429 begin
4 10430 laf:= (i-1)*4;
4 10431 if radio_områdetabel(i)<>0 then
4 10432 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10433 radio_områdetabel(i),"nl",1);
4 10434 end;
3 10435 end skriv_radio_områdetabel;
2 10436 \f
2 10436 message procedure h_radio side 1 - 810520/hko;
2 10437
2 10437 <* hovedmodulkorutine for radiokanaler *>
2 10438 procedure h_radio;
2 10439 begin
3 10440 integer array field op_ref;
3 10441 integer k,dest_sem;
3 10442 procedure skriv_hradio(z,omfang);
3 10443 value omfang;
3 10444 zone z;
3 10445 integer omfang;
3 10446 begin integer i;
4 10447 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10448 write(z,"sp",26-i);
4 10449 if omfang >0 then
4 10450 disable begin integer x;
5 10451 trap(slut);
5 10452 write(z,"nl",1,
5 10453 <: op_ref: :>,op_ref,"nl",1,
5 10454 <: k: :>,k,"nl",1,
5 10455 <: dest_sem: :>,dest_sem,"nl",1,
5 10456 <::>);
5 10457 skriv_coru(z,coru_no(400));
5 10458 slut:
5 10459 end;
4 10460 end skriv_hradio;
3 10461
3 10461 trap(hrad_trap);
3 10462 stack_claim(if cm_test then 198 else 146);
3 10463
3 10463 <*+2*> if testbit32 and overvåget or testbit28 then
3 10464 skriv_hradio(out,0);
3 10465 <*-2*>
3 10466 \f
3 10466 message procedure h_radio side 2 - 820304/hko;
3 10467
3 10467 repeat
3 10468 wait_ch(cs_rad,op_ref,true,-1);
3 10469 <*+2*>if testbit33 and overvåget then
3 10470 disable begin
4 10471 skriv_h_radio(out,0);
4 10472 write(out,<: operation modtaget:>);
4 10473 skriv_op(out,op_ref);
4 10474 end;
3 10475 <*-2*>
3 10476 <*+4*>
3 10477 if (d.op_ref.optype and
3 10478 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10479 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10480 <*-4*>
3 10481
3 10481 k:=d.op_ref.op_kode extract 12;
3 10482 dest_sem:=
3 10483 if k > 0 and k < 7
3 10484 or k=11 or k=12 or k=19
3 10485 or (72<=k and k<=74) or k = 77
3 10486 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10487 then cs_radio_adm
3 10488 else if k=41 <* radiokommando fra operatør *>
3 10489 then cs_radio(d.opref.data(1)) else -1;
3 10490 <*+4*>
3 10491 if dest_sem<1 then
3 10492 begin
4 10493 if dest_sem<0 then
4 10494 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10495 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10496 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10497 end
3 10498 else
3 10499 <*-4*>
3 10500 begin <* operationskode ok *>
4 10501 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10502 end;
3 10503 until false;
3 10504
3 10504 hrad_trap:
3 10505 disable skriv_hradio(zbillede,1);
3 10506 end h_radio;
2 10507 \f
2 10507 message procedure radio side 1 - 820301/hko;
2 10508
2 10508 procedure radio(talevej,op);
2 10509 value talevej,op;
2 10510 integer talevej,op;
2 10511 begin
3 10512 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10513 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10514 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10515 integer array felt,værdi(1:8);
3 10516 boolean byt,nød,frigiv_samtale;
3 10517 real kl;
3 10518 real field rf;
3 10519
3 10519 procedure skriv_radio(z,omfang);
3 10520 value omfang;
3 10521 zone z;
3 10522 integer omfang;
3 10523 begin integer i1;
4 10524 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10525 write(z,"sp",26-i1);
4 10526 if omfang > 0 then
4 10527 disable begin real x;
5 10528 trap(slut);
5 10529 \f
5 10529 message procedure radio side 1a- 820301/hko;
5 10530
5 10530 write(z,"nl",1,
5 10531 <: op_ref: :>,op_ref,"nl",1,
5 10532 <: opref1: :>,opref1,"nl",1,
5 10533 <: iaf: :>,iaf,"nl",1,
5 10534 <: iaf1: :>,iaf1,"nl",1,
5 10535 <: vt-op: :>,vt_op,"nl",1,
5 10536 <: rad-op: :>,rad_op,"nl",1,
5 10537 <: rf: :>,rf,"nl",1,
5 10538 <: nr: :>,nr,"nl",1,
5 10539 <: i: :>,i,"nl",1,
5 10540 <: j: :>,j,"nl",1,
5 10541 <: k: :>,k,"nl",1,
5 10542 <: operatør: :>,operatør,"nl",1,
5 10543 <: tilst: :>,tilst,"nl",1,
5 10544 <: res: :>,res,"nl",1,
5 10545 <: opgave: :>,opgave,"nl",1,
5 10546 <: type: :>,type,"nl",1,
5 10547 <: bus: :>,bus,"nl",1,
5 10548 <: ll: :>,ll,"nl",1,
5 10549 <: ttmm: :>,ttmm,"nl",1,
5 10550 <: vogn: :>,vogn,"nl",1,
5 10551 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10552 <: vtop2: :>,vtop2,"nl",1,
5 10553 <: vtop3: :>,vtop3,"nl",1,
5 10554 <: sig: :>,sig,"nl",1,
5 10555 <: omr: :>,omr,"nl",1,
5 10556 <: garage: :>,garage,"nl",1,
5 10557 <<-dddddd'-dd>,
5 10558 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10559 <:samtaleflag: :>,"nl",1);
5 10560 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10561 skriv_coru(z,coru_no(410+talevej));
5 10562 slut:
5 10563 end;<*disable*>
4 10564 end skriv_radio;
3 10565 \f
3 10565 message procedure udtag_opkald side 1 - 820301/hko;
3 10566
3 10566 integer
3 10567 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10568 value vogn, operatør;
3 10569 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10570 begin
4 10571 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10572 integer array field vt_op,ref,næste,forrige;
4 10573 integer array field iaf1;
4 10574 boolean skal_ud;
4 10575
4 10575 boolean procedure skal_udskrives(fordelt,aktuel);
4 10576 value fordelt,aktuel;
4 10577 integer fordelt,aktuel;
4 10578 begin
5 10579 boolean skal;
5 10580 integer n;
5 10581 integer array field iaf;
5 10582
5 10582 skal:= true;
5 10583 if fordelt > 0 and fordelt<>aktuel then
5 10584 begin
6 10585 for n:= 0 step 1 until 3 do
6 10586 begin
7 10587 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10588 begin
8 10589 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10590 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10591 goto returner;
8 10592 end;
7 10593 end;
6 10594 end;
5 10595 returner:
5 10596 skal_udskrives:= skal;
5 10597 end;
4 10598
4 10598 l:= b:= tm:= t:= 0;
4 10599 garage:= sig:= 0;
4 10600 res:= -1;
4 10601 <*V*> wait(bs_opkaldskø_adgang);
4 10602 ref:= første_nødopkald;
4 10603 if ref <> 0 then
4 10604 t:= 2
4 10605 else
4 10606 begin
5 10607 ref:= første_opkald;
5 10608 t:= if ref = 0 then 0 else 1;
5 10609 end;
4 10610 if t = 0 then res:= +19 <*kø er tom*> else
4 10611 if vogn=0 and omr=0 then
4 10612 begin
5 10613 while ref <> 0 and res = -1 do
5 10614 begin
6 10615 nr:= opkaldskø.ref(4) extract 8;
6 10616 if nr>64 then
6 10617 begin
7 10618 <*opk. primærfordelt til gruppe af btj.pl.*>
7 10619 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 10620 while skal_ud and i<max_antal_operatører do
7 10621 begin
8 10622 i:=i+1;
8 10623 if læsbit_ia(bpl_def.iaf1,i) then
8 10624 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 10625 end;
7 10626 end
6 10627 else
6 10628 skal_ud:= skal_udskrives(nr,operatør);
6 10629
6 10629 if skal_ud then
6 10630 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 10631 *>
6 10632 res:= 0
6 10633 else
6 10634 begin
7 10635 ref:= opkaldskø.ref(1) extract 12;
7 10636 if ref = 0 and t = 2 then
7 10637 begin
8 10638 ref:= første_opkald;
8 10639 t:= if ref = 0 then 0 else 1;
8 10640 end else if ref = 0 then t:= 0;
7 10641 end;
6 10642 end; <*while*>
5 10643 \f
5 10643 message procedure udtag_opkald side 2 - 820304/hko;
5 10644
5 10644 if ref <> 0 then
5 10645 begin
6 10646 b:= opkaldskø.ref(2);
6 10647 <*+4*> if b < 0 then
6 10648 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 10649 <:nødopkald(besvaret/ej meldt):>,1);
6 10650 <*-4*>
6 10651 garage:=b shift(-14) extract 8;
6 10652 b:= b extract 14;
6 10653 l:= opkaldskø.ref(3);
6 10654 tm:= opkaldskø.ref(4);
6 10655 o:= tm extract 8;
6 10656 tm:= tm shift(-12);
6 10657 omr:= opkaldskø.ref(5) extract 8;
6 10658 sig:= opkaldskø.ref(5) shift (-20);
6 10659 end
5 10660 else res:=19; <* kø er tom *>
5 10661 end <*vogn=0 and omr=0 *>
4 10662 else
4 10663 begin
5 10664 <* vogn<>0 or omr<>0 *>
5 10665 i:= 0; tilst:= -1;
5 10666 if vogn shift(-22) = 1 then
5 10667 begin
6 10668 i:= find_busnr(vogn,nr,garage,tilst);
6 10669 l:= vogn;
6 10670 end
5 10671 else
5 10672 if vogn<>0 and (omr=0 or omr>2) then
5 10673 begin
6 10674 o:= 0;
6 10675 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 10676 if i=(-2) then
6 10677 begin
7 10678 o:= omr;
7 10679 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 10680 end;
6 10681 nr:= vogn extract 14;
6 10682 end
5 10683 else nr:= vogn extract 14;
5 10684 if i<0 then ref:= 0;
5 10685 while ref <> 0 and res = -1 do
5 10686 begin
6 10687 i:= opkaldskø.ref(2) extract 14;
6 10688 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 10689 if nr = i and
6 10690 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 10691 else
6 10692 begin
7 10693 ref:= opkaldskø.ref(1) extract 12;
7 10694 if ref = 0 and t = 2 then
7 10695 begin
8 10696 ref:= første_opkald;
8 10697 t:= if ref = 0 then 0 else 1;
8 10698 end else if ref = 0 then t:= 0;
7 10699 end;
6 10700 end; <*while*>
5 10701 \f
5 10701 message procedure udtag_opkald side 3 - 810603/hko;
5 10702
5 10702 if ref <> 0 then
5 10703 begin
6 10704 b:= nr;
6 10705 tm:= opkaldskø.ref(4);
6 10706 o:= tm extract 8;
6 10707 tm:= tm shift(-12);
6 10708 omr:= opkaldskø.ref(5) extract 4;
6 10709 sig:= opkaldskø.ref(5) shift (-20);
6 10710
6 10710 <*+4*> if tilst <> -1 then
6 10711 fejlreaktion(3<*prg.fejl*>,tilst,
6 10712 <:vogntabel_tilstand for vogn i kø:>,1);
6 10713 <*-4*>
6 10714 end;
5 10715 end;
4 10716
4 10716 if ref <> 0 then
4 10717 begin
5 10718 næste:= opkaldskø.ref(1);
5 10719 forrige:= næste shift(-12);
5 10720 næste:= næste extract 12;
5 10721 if forrige <> 0 then
5 10722 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 10723 + næste
5 10724 else if t = 1 then første_opkald:= næste
5 10725 else <*if t = 2 then*> første_nødopkald:= næste;
5 10726
5 10726 if næste <> 0 then
5 10727 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 10728 + forrige shift 12
5 10729 else if t = 1 then sidste_opkald:= forrige
5 10730 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 10731
5 10731 opkaldskø.ref(1):=første_frie_opkald;
5 10732 første_frie_opkald:=ref;
5 10733
5 10733 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 10734 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 10735 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 10736 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 10737 else
5 10738 begin
6 10739 sætbit_ia(opkaldsflag,operatør,1);
6 10740 sætbit_ia(opkaldsflag,o,1);
6 10741 end;
5 10742 signal_bin(bs_mobil_opkald);
5 10743 end;
4 10744 \f
4 10744 message procedure udtag_opkald side 4 - 810531/hko;
4 10745
4 10745 signal_bin(bs_opkaldskø_adgang);
4 10746 bus:= b;
4 10747 type:= t;
4 10748 ll:= l;
4 10749 ttmm:= tm;
4 10750 udtag_opkald:= res;
4 10751 end udtag opkald;
3 10752 \f
3 10752 message procedure frigiv_kanal side 1 - 810603/hko;
3 10753
3 10753 procedure frigiv_kanal(nr);
3 10754 value nr;
3 10755 integer nr;
3 10756 begin
4 10757 integer id1, id2, omr, i;
4 10758 integer array field iaf, vt_op;
4 10759
4 10759 iaf:= (nr-1)*kanal_beskrlængde;
4 10760 id1:= kanal_tab.iaf.kanal_id1;
4 10761 id2:= kanal_tab.iaf.kanal_id2;
4 10762 omr:= kanal_til_omr(nr);
4 10763 if id1 <> 0 then
4 10764 wait(ss_samtale_nedlagt(nr));
4 10765 if id1 shift (-22) < 3 and omr > 2 then
4 10766 begin
5 10767 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 10768 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10769 if id1 shift (-22) = 2 then 18 else 17);
5 10770 d.vt_op.data(1):= id1;
5 10771 d.vt_op.data(4):= omr;
5 10772 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 10773 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 10774 signalch(cs_vt_adgang,vt_op,true);
5 10775 end;
4 10776
4 10776 if id2 <> 0 and id2 shift(-20) <> 12 then
4 10777 wait(ss_samtale_nedlagt(nr));
4 10778 if id2 shift (-22) < 3 and omr > 2 then
4 10779 begin
5 10780 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 10781 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10782 if id2 shift (-22) = 2 then 18 else 17);
5 10783 d.vt_op.data(1):= id2;
5 10784 d.vt_op.data(4):= omr;
5 10785 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 10786 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 10787 signalch(cs_vt_adgang,vt_op,true);
5 10788 end;
4 10789
4 10789 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 10790 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 10791 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 10792 shift (-10) extract 6 shift 10;
4 10793 <* repeat
4 10794 inspect(ss_samtale_nedlagt(nr),i);
4 10795 if i>0 then wait(ss_samtale_nedlagt(nr));
4 10796 until i<=0;
4 10797 *>
4 10798 end frigiv_kanal;
3 10799 \f
3 10799 message procedure hookoff side 1 - 880901/cl;
3 10800
3 10800 integer procedure hookoff(talevej,op,retursem,flash);
3 10801 value talevej,op,retursem,flash;
3 10802 integer talevej,op,retursem;
3 10803 boolean flash;
3 10804 begin
4 10805 integer array field opref;
4 10806
4 10806 opref:= op;
4 10807 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 10808 d.opref.data(1):= talevej;
4 10809 d.opref.data(2):= if flash then 2 else 1;
4 10810 signalch(cs_radio_ud,opref,rad_optype);
4 10811 <*V*> waitch(retursem,opref,rad_optype,-1);
4 10812 hookoff:= d.opref.resultat;
4 10813 end;
3 10814 \f
3 10814 message procedure hookon side 1 - 880901/cl;
3 10815
3 10815 integer procedure hookon(talevej,op,retursem);
3 10816 value talevej,op,retursem;
3 10817 integer talevej,op,retursem;
3 10818 begin
4 10819 integer i,res;
4 10820 integer array field opref;
4 10821
4 10821 if læsbit_ia(hookoff_maske,talevej) then
4 10822 begin
5 10823 inspect(bs_talevej_udkoblet(talevej),i);
5 10824 if i<=0 then
5 10825 begin
6 10826 opref:= op;
6 10827 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 10828 d.opref.data(1):= talevej;
6 10829 signalch(cs_radio_ud,opref,rad_optype);
6 10830 <*V*> waitch(retursem,opref,rad_optype,-1);
6 10831 res:= d.opref.resultat;
6 10832 end
5 10833 else
5 10834 res:= 0;
5 10835
5 10835 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 10836 end
4 10837 else
4 10838 res:= 0;
4 10839
4 10839 sætbit_ia(hookoff_maske,talevej,0);
4 10840 hookon:= res;
4 10841 end;
3 10842 \f
3 10842 message procedure radio side 2 - 820304/hko;
3 10843
3 10843 rad_op:= op;
3 10844
3 10844 trap(radio_trap);
3 10845 stack_claim((if cm_test then 200 else 150) +200);
3 10846
3 10846 <*+2*>if testbit32 and overvåget or testbit28 then
3 10847 skriv_radio(out,0);
3 10848 <*-2*>
3 10849 repeat
3 10850 waitch(cs_radio(talevej),opref,true,-1);
3 10851 <*+2*>
3 10852 if testbit33 and overvåget then
3 10853 disable begin
4 10854 skriv_radio(out,0);
4 10855 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 10856 skriv_op(out,opref);
4 10857 end;
3 10858 <*-2*>
3 10859
3 10859 k:= d.op_ref.opkode extract 12;
3 10860 opgave:= d.opref.opkode shift (-12);
3 10861 operatør:= d.op_ref.data(4);
3 10862
3 10862 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 10863 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 10864 <:radio:>,0);
3 10865 <*-4*>
3 10866 \f
3 10866 message procedure radio side 3 - 880930/cl;
3 10867 if k=41 <*radiokommando fra operatør*> then
3 10868 begin
4 10869 vogn:= d.opref.data(2);
4 10870 res:= -1;
4 10871 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 10872 sig:= 0; omr:= d.opref.data(3) extract 8;
4 10873 bus:= garage:= ll:= 0;
4 10874
4 10874 if opgave=1 or opgave=9 then
4 10875 begin <* opkald til enkelt vogn (CHF) *>
5 10876 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 10877 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 10878 <* ok at kø er tom når vogn er angivet eller VHF *>
5 10879
5 10879 d.opref.data(11):= if res=0 then
5 10880 (if ll<>0 then ll else bus) else vogn;
5 10881
5 10881 if type=2 <*nød*> then
5 10882 begin
6 10883 waitch(cs_radio_pulje,opref1,true,-1);
6 10884 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 10885 d.opref1.data(1):= if ll<>0 then ll else bus;
6 10886 systime(5,0,kl);
6 10887 d.opref1.data(2):= entier(kl/100.0);
6 10888 d.opref1.data(3):= omr;
6 10889 signalch(cs_io,opref1,gen_optype or rad_optype);
6 10890 end
5 10891 end; <* enkeltvogn (CHF) *>
4 10892
4 10892 <* check enkeltvogn for ledig *>
4 10893 if res<=0 and omr=2<*VHF*> and bus=0 and
4 10894 (opgave=1 or opgave=9) then
4 10895 begin
5 10896 for i:= 1 step 1 until max_antal_kanaler do
5 10897 if kanal_til_omr(i)=2 then nr:= i;
5 10898 iaf:= (nr-1)*kanalbeskrlængde;
5 10899 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 10900 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 10901 then res:= 52;
5 10902 end;
4 10903 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 10904 d.opref.data(3)=0 <*std. omr*>) and
4 10905 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 10906 then
4 10907 begin
5 10908 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 10909 if vogn shift (-22) = 1 then
5 10910 begin
6 10911 find_busnr(vogn,bus,garage,res);
6 10912 ll:= vogn;
6 10913 end
5 10914 else
5 10915 if vogn shift (-22) = 0 then
5 10916 begin
6 10917 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 10918 bus:= vogn;
6 10919 end
5 10920 else
5 10921 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 10922 res:= if res=(-1) then 18 <* i kø *> else
5 10923 (if res<>0 then 14 <*opt*> else 0);
5 10924 end
4 10925 else
4 10926 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 10927 opgave <= 2 then
4 10928 begin
5 10929 bus:= vogn; garage:= type:= ttmm:= 0;
5 10930 res:= 0; omr:= 0; sig:= 0;
5 10931 end
4 10932 else
4 10933 if opgave>1 and opgave<>9 then
4 10934 type:= ttmm:= res:= 0;
4 10935 \f
4 10935 message procedure radio side 4 - 880930/cl;
4 10936
4 10936 if res=0 and (opgave<=4 or opgave=9) and
4 10937 (omr<1 or 2<omr) and
4 10938 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 10939 begin <* reserver i vogntabel *>
5 10940 waitch(cs_vt_adgang,vt_op,true,-1);
5 10941 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10942 if opgave <=2 or opgave=9 then 15 else 16);
5 10943 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 10944 (if vogn=0 then garage shift 14 + bus else
5 10945 if ll<>0 then ll else garage shift 14 + bus)
5 10946 else vogn <*gruppeid*>;
5 10947 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 10948 d.opref.data(3) extract 8
5 10949 else omr extract 8;
5 10950 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 10951 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 10952
5 10952 res:= d.vt_op.resultat;
5 10953 if res=3 then res:= 0;
5 10954 vtop2:= d.vt_op.data(2);
5 10955 vtop3:= d.vt_op.data(3);
5 10956 tekn_inf:= d.vt_op.data(4);
5 10957 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 10958 end;
4 10959
4 10959 if res<>0 then
4 10960 begin
5 10961 d.opref.resultat:= res;
5 10962 signalch(d.opref.retur,opref,d.opref.optype);
5 10963 end
4 10964 else
4 10965
4 10965 if opgave <= 9 then
4 10966 begin <* opkald *>
5 10967 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 10968 opgave<>9 and d.opref.data(6)<>0);
5 10969
5 10969 if res<>0 then
5 10970 goto returner_op;
5 10971
5 10971 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 10972 begin
6 10973 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 10974 'H' shift 12 + 60);
6 10975 d.rad_op.data(1):= talevej;
6 10976 d.rad_op.data(2):= 'D';
6 10977 d.rad_op.data(3):= 6; <* rear *>
6 10978 d.rad_op.data(4):= 1; <* rear no *>
6 10979 d.rad_op.data(5):= 0; <* disconnect *>
6 10980 signalch(cs_radio_ud,rad_op,rad_optype);
6 10981 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 10982 if d.rad_op.resultat<>0 then
6 10983 begin
7 10984 res:= d.rad_op.resultat;
7 10985 goto returner_op;
7 10986 end;
6 10987 <*
6 10988 while optaget_flag shift (-1) <> 0 do
6 10989 delay(1);
6 10990 *>
6 10991 end;
5 10992 \f
5 10992 message procedure radio side 5 - 880930/cl;
5 10993
5 10993 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 10994 'B' shift 12 + 60);
5 10995 d.rad_op.data(1):= talevej;
5 10996 d.rad_op.data(2):= 'D';
5 10997 d.rad_op.data(3):= if opgave=9 then 3 else
5 10998 (2 - (opgave extract 1)); <* højttalerkode *>
5 10999
5 10999 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11000 begin
6 11001 j:= 0;
6 11002 for i:= 2 step 1 until max_antal_områder do
6 11003 begin
7 11004 if opgave > 6 or
7 11005 (d.opref.data(3) shift (-20) = 15 and
7 11006 læsbiti(d.opref.data(3),i)) or
7 11007 (d.opref.data(3) shift (-20) = 14 and
7 11008 d.opref.data(3) extract 20 = i)
7 11009 then
7 11010 begin
8 11011 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11012 begin
9 11013 j:= j+1;
9 11014 d.rad_op.data(10+(j-1)*2):=
9 11015 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11016 (if i=2<*VHF*> then 4 else k)
9 11017 shift 8 + <* signal type *>
9 11018 1; <* antal tno *>
9 11019 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11020 end;
8 11021 end;
7 11022 end;
6 11023 d.rad_op.data(4):= j;
6 11024 d.rad_op.data(5):= 0;
6 11025 end
5 11026 else
5 11027 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11028 begin
6 11029 d.rad_op.data(4):= vtop2;
6 11030 d.rad_op.data(5):= vtop3;
6 11031 end
5 11032 else
5 11033 begin <* enkeltvogn *>
6 11034 if omr=0 then
6 11035 begin
7 11036 sig:= tekn_inf shift (-23);
7 11037 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11038 else tekn_inf extract 8;
7 11039 end
6 11040 else
6 11041 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11042
6 11042 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11043 <* tvinges til alm. opkald *>
6 11044 if (opgave=9) and (type=2) and (omr<=3) then
6 11045 begin
7 11046 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11047 opgave:= 1;
7 11048 d.radop.data(3):= 1;
7 11049 end;
6 11050
6 11050 if omr=2 <*VHF*> then sig:= 4 else
6 11051 if omr=1 <*TLF*> then sig:= 7 else
6 11052 <*UHF*> sig:= sig+1;
6 11053 d.rad_op.data(4):= 1;
6 11054 d.rad_op.data(5):= 0;
6 11055 d.rad_op.data(10):=
6 11056 (område_id(omr,2) extract 12) shift 12 +
6 11057 sig shift 8 +
6 11058 1;
6 11059 d.rad_op.data(11):= bus;
6 11060 end;
5 11061 \f
5 11061 message procedure radio side 6 - 880930/cl;
5 11062
5 11062 signalch(cs_radio_ud,rad_op,rad_optype);
5 11063 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11064 res:= d.rad_op.resultat;
5 11065
5 11065 d.rad_op.data(6):= 0;
5 11066 for i:= 1 step 1 until max_antal_områder do
5 11067 if læsbiti(d.rad_op.data(7),i) then
5 11068 increase(d.rad_op.data(6));
5 11069 returner_op:
5 11070 if d.rad_op.data(6)=1 then
5 11071 begin
6 11072 for i:= 1 step 1 until max_antal_områder do
6 11073 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11074 d.opref.data(12):= 14 shift 20 + i;
6 11075 end
5 11076 else
5 11077 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11078 d.opref.data(7):= type;
5 11079 d.opref.data(8):= garage shift 14 + bus;
5 11080 d.opref.data(9):= ll;
5 11081 if res=0 then
5 11082 begin
6 11083 d.opref.resultat:= 3;
6 11084 d.opref.data(5):= d.opref.data(6);
6 11085 j:= 0;
6 11086 for i:= 1 step 1 until max_antal_kanaler do
6 11087 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11088 if j>1 then
6 11089 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11090 else
6 11091 begin
7 11092 j:= 0;
7 11093 for i:= 1 step 1 until max_antal_kanaler do
7 11094 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11095 d.opref.data(6):= 3 shift 22 + j;
7 11096 end;
6 11097 d.opref.data(7):= type;
6 11098 d.opref.data(8):= garage shift 14 + bus;
6 11099 d.opref.data(9):= ll;
6 11100 d.opref.data(10):= d.opref.data(6);
6 11101 for i:= 1 step 1 until max_antal_kanaler do
6 11102 begin
7 11103 if læsbiti(d.rad_op.data(9),i) then
7 11104 begin
8 11105 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11106 j:= pabx_id( kanal_id(i) extract 5 )
8 11107 else
8 11108 j:= radio_id( kanal_id(i) extract 5 );
8 11109 if j>0 and type=0 then tæl_opkald(j,1);
8 11110
8 11110 iaf:= (i-1)*kanalbeskrlængde;
8 11111 skrivtegn(kanal_tab.iaf,1,talevej);
8 11112 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11113 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11114 kanal_tab.iaf.kanal_id1:=
8 11115 if opgave<=2 or opgave=9 then
8 11116 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11117 else
8 11118 d.opref.data(2);
8 11119 kanal_tab.iaf.kanal_alt_id1:=
8 11120 if opgave<=2 or opgave=9 then
8 11121 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11122 else
8 11123 0;
8 11124 if kanal_tab.iaf.kanal_id1=0 then
8 11125 kanal_tab.iaf.kanal_id1:= 10000;
8 11126 kanal_tab.iaf.kanal_spec:=
8 11127 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11128 end;
7 11129 end;
6 11130 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11131 sætbit_ia(kanalflag,operatør,1);
6 11132 \f
6 11132 message procedure radio side 7 - 880930/cl;
6 11133
6 11133 end
5 11134 else
5 11135 begin
6 11136 d.opref.resultat:= res;
6 11137 if d.opref.data(6)=0 then
6 11138 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11139 <* frigiv fra vogntabel hvis reserveret *>
6 11140 if (opgave<=4 or opgave=9) and
6 11141 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11142 begin
7 11143 waitch(cs_vt_adgang,vt_op,true,-1);
7 11144 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11145 if opgave<=2 or opgave=9 then 17 else 18);
7 11146 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11147 (if vogn=0 then garage shift 14 + bus else
7 11148 if ll<>0 then ll else garage shift 14 + bus)
7 11149 else vogn;
7 11150 d.vt_op.data(4):= omr;
7 11151 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11152 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11153 signalch(cs_vt_adgang,vt_op,true);
7 11154 end;
6 11155 end;
5 11156 signalch(d.opref.retur,opref,d.opref.optype);
5 11157 \f
5 11157 message procedure radio side 8 - 880930/cl;
5 11158
5 11158 end <* opkald *>
4 11159 else
4 11160 if opgave = 10 <* MONITER *> then
4 11161 begin
5 11162 nr:= d.opref.data(2);
5 11163 if nr shift (-20) <> 12 then
5 11164 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11165 nr:= nr extract 20;
5 11166 iaf:= (nr-1)*kanalbeskrlængde;
5 11167 inspect(ss_samtale_nedlagt(nr),i);
5 11168 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11169 kanal_tab.iaf.kanal_id2 extract 20
5 11170 else
5 11171 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11172 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11173 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11174 (i<>0 or j<>0) then
5 11175 begin
6 11176 res:= 0;
6 11177 d.opref.data(5):= 12 shift 20 + k;
6 11178 d.opref.data(6):= 12 shift 20 + nr;
6 11179 sætbit_ia(kanalflag,operatør,1);
6 11180 goto radio_nedlæg;
6 11181 end
5 11182 else
5 11183 if i<>0 or j<>0 then
5 11184 res:= 49
5 11185 else
5 11186 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11187 res:= 49 <* ingen samtale igang *>
5 11188 else
5 11189 begin
6 11190 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11191 if res=0 then
6 11192 begin
7 11193 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11194 'B' shift 12 + 60);
7 11195 d.rad_op.data(1):= talevej;
7 11196 d.rad_op.data(2):= 'V';
7 11197 d.rad_op.data(3):= 0;
7 11198 d.rad_op.data(4):= 1;
7 11199 d.rad_op.data(5):= 0;
7 11200 d.rad_op.data(10):=
7 11201 (kanal_id(nr) shift (-5) shift 18) +
7 11202 (kanal_id(nr) extract 5 shift 12) + 0;
7 11203 signalch(cs_radio_ud,rad_op,rad_optype);
7 11204 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11205 res:= d.rad_op.resultat;
7 11206 if res=0 then
7 11207 begin
8 11208 d.opref.data(5):= 0;
8 11209 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11210 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11211 res:= 3;
8 11212 end;
7 11213 end;
6 11214 end;
5 11215 \f
5 11215 message procedure radio side 9 - 880930/cl;
5 11216 if res=3 then
5 11217 begin
6 11218 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11219 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11220 else
6 11221 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11222 d.opref.data(6):= 12 shift 20 + nr;
6 11223 i:= kanal_tab.iaf.kanal_id2;
6 11224 if i<>0 then
6 11225 begin
7 11226 if i shift (-20) = 12 then
7 11227 begin <* ident2 henviser til anden kanal *>
8 11228 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11229 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11230 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11231 else
8 11232 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11233 d.opref.data(5):= 12 shift 20 + i;
8 11234 end
7 11235 else
7 11236 d.opref.data(5):= 12 shift 20 + nr;
7 11237 end
6 11238 else
6 11239 d.opref.data(5):= 0;
6 11240 end;
5 11241
5 11241 if res<>3 then
5 11242 begin
6 11243 res:= 0;
6 11244 sætbit_ia(kanalflag,operatør,1);
6 11245 goto radio_nedlæg;
6 11246 end;
5 11247 d.opref.resultat:= res;
5 11248 signalch(d.opref.retur,opref,d.opref.optype);
5 11249 \f
5 11249 message procedure radio side 10 - 880930/cl;
5 11250
5 11250 end <* MONITERING *>
4 11251 else
4 11252 if opgave = 11 then <* GENNEMSTILLING *>
4 11253 begin
5 11254 nr:= d.opref.data(6) extract 20;
5 11255 k:= if d.opref.data(5) shift (-20) = 12 then
5 11256 d.opref.data(5) extract 20
5 11257 else
5 11258 0;
5 11259 inspect(ss_samtale_nedlagt(nr),i);
5 11260 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11261 if i<>0 and j<>0 then
5 11262 begin
6 11263 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11264 goto radio_nedlæg;
6 11265 end;
5 11266
5 11266 iaf:= (nr-1)*kanal_beskr_længde;
5 11267 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11268 begin
6 11269 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11270 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11271 then
6 11272 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11273 else
6 11274 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11275 d.opref.data(5)<>0
6 11276 then
6 11277 res:= 0
6 11278 else
6 11279 res:= 21; <* ingen at gennemstille til *>
6 11280 end
5 11281 else
5 11282 res:= 50; <* kanalnr *>
5 11283
5 11283 if res=0 then
5 11284 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11285 if res=0 then
5 11286 begin
6 11287 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11288 kanal_tab.iaf.kanal_tilstand:=
6 11289 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11290 d.opref.data(6):= 0;
6 11291 if kanal_tab.iaf.kanal_id2=0 then
6 11292 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11293
6 11293 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11294 begin <* gennemstillet til anden kanal *>
7 11295 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11296 *kanalbeskrlængde;
7 11297 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11298 kanal_tab.iaf1.kanal_tilstand:=
7 11299 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11300 if kanal_tab.iaf1.kanal_id2=0 then
7 11301 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11302 end;
6 11303 d.opref.data(5):= 0;
6 11304
6 11304 res:= 3;
6 11305 end;
5 11306
5 11306 d.opref.resultat:= res;
5 11307 signalch(d.opref.retur,opref,d.opref.optype);
5 11308 \f
5 11308 message procedure radio side 11 - 880930/cl;
5 11309
5 11309 end
4 11310 else
4 11311 if opgave = 12 then <* NEDLÆG *>
4 11312 begin
5 11313 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11314 radio_nedlæg:
5 11315 if res=0 then
5 11316 begin
6 11317 for k:= 5, 6 do
6 11318 begin
7 11319 if d.opref.data(k) shift (-20) = 12 then
7 11320 begin
8 11321 i:= d.opref.data(k) extract 20;
8 11322 iaf:= (i-1)*kanalbeskrlængde;
8 11323 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11324 frigiv_kanal(d.opref.data(k) extract 20)
8 11325 else
8 11326 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11327 end
7 11328 else
7 11329 if d.opref.data(k) shift (-20) = 13 then
7 11330 begin
8 11331 for i:= 1 step 1 until max_antal_kanaler do
8 11332 if læsbiti(d.opref.data(k),i) then
8 11333 begin
9 11334 iaf:= (i-1)*kanalbeskrlængde;
9 11335 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11336 frigiv_kanal(i)
9 11337 else
9 11338 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11339 end;
8 11340 sætbit_ia(kanalflag,operatør,1);
8 11341 end;
7 11342 end;
6 11343 d.opref.data(5):= 0;
6 11344 d.opref.data(6):= 0;
6 11345 d.opref.data(9):= 0;
6 11346 res:= if opgave=12 then 3 else 49;
6 11347 end;
5 11348 d.opref.resultat:= res;
5 11349 signalch(d.opref.retur,opref,d.opref.optype);
5 11350 end
4 11351 else
4 11352 if opgave=13 then <* R *>
4 11353 begin
5 11354 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11355 'H' shift 12 + 60);
5 11356 d.rad_op.data(1):= talevej;
5 11357 d.rad_op.data(2):= 'M';
5 11358 d.rad_op.data(3):= 0; <*tkt*>
5 11359 d.rad_op.data(4):= 0; <*tkn*>
5 11360 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11361 signalch(cs_radio_ud,rad_op,rad_optype);
5 11362 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11363 res:= d.rad_op.resultat;
5 11364 d.opref.resultat:= if res=0 then 3 else res;
5 11365 signalch(d.opref.retur,opref,d.opref.optype);
5 11366 end
4 11367 else
4 11368 if opgave=14 <* VENTEPOS *> then
4 11369 begin
5 11370 res:= 0;
5 11371 while (res<=3 and d.opref.data(2)>0) do
5 11372 begin
6 11373 nr:= d.opref.data(6) extract 20;
6 11374 k:= if d.opref.data(5) shift (-20) = 12 then
6 11375 d.opref.data(5) extract 20
6 11376 else
6 11377 0;
6 11378 inspect(ss_samtale_nedlagt(nr),i);
6 11379 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11380 if i<>0 or j<>0 then
6 11381 begin
7 11382 res:= hookon(talevej,radop,cs_radio(talevej));
7 11383 goto radio_nedlæg;
7 11384 end;
6 11385
6 11385 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11386
6 11386 if res=0 then
6 11387 begin
7 11388 i:= d.opref.data(5);
7 11389 d.opref.data(5):= d.opref.data(6);
7 11390 d.opref.data(6):= i;
7 11391 res:= 3;
7 11392 end;
6 11393
6 11393 d.opref.data(2):= d.opref.data(2)-1;
6 11394 end;
5 11395 d.opref.resultat:= res;
5 11396 signalch(d.opref.retur,opref,d.opref.optype);
5 11397 end
4 11398 else
4 11399 begin
5 11400 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11401 d.opref.resultat:= 31;
5 11402 signalch(d.opref.retur,opref,d.opref.optype);
5 11403 end;
4 11404
4 11404 end <* radiokommando fra operatør *>
3 11405 else
3 11406 begin
4 11407
4 11407 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11408
4 11408 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11409
4 11409 end;
3 11410
3 11410 until false;
3 11411 radio_trap:
3 11412 disable skriv_radio(zbillede,1);
3 11413 end radio;
2 11414 \f
2 11414 message procedure radio_ind side 1 - 810521/hko;
2 11415
2 11415 procedure radio_ind(op);
2 11416 value op;
2 11417 integer op;
2 11418 begin
3 11419 integer array field op_ref,ref,io_opref;
3 11420 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11421 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11422 integer array typ, val(1:6), answ, tlgr(1:32);
3 11423 integer array field spec;
3 11424 real field rf;
3 11425 long array field laf;
3 11426
3 11426 procedure skriv_radio_ind(zud,omfang);
3 11427 value omfang;
3 11428 zone zud;
3 11429 integer omfang;
3 11430 begin integer ii;
4 11431 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11432 if omfang > 0 then
4 11433 disable begin integer x; long array field tx;
5 11434 tx:= 0;
5 11435 trap(slut);
5 11436 write(zud,"nl",1,
5 11437 <: op-ref: :>,op_ref,"nl",1,
5 11438 <: ref: :>,ref,"nl",1,
5 11439 <: io-opref: :>,io_opref,"nl",1,
5 11440 <: ac: :>,ac,"nl",1,
5 11441 <: lgd: :>,lgd,"nl",1,
5 11442 <: ttyp: :>,ttyp,"nl",1,
5 11443 <: ptyp: :>,ptyp,"nl",1,
5 11444 <: pnum: :>,pnum,"nl",1,
5 11445 <: pos: :>,pos,"nl",1,
5 11446 <: tegn: :>,tegn,"nl",1,
5 11447 <: bs: :>,bs,"nl",1,
5 11448 <: b-pt: :>,b_pt,"nl",1,
5 11449 <: b-pn: :>,b_pn,"nl",1,
5 11450 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11451 <: antal-spec: :>,antal_spec,"nl",1,
5 11452 <: sum: :>,sum,"nl",1,
5 11453 <: csum: :>,csum,"nl",1,
5 11454 <: i: :>,i,"nl",1,
5 11455 <: j: :>,j,"nl",1,
5 11456 <: k: :>,k,"nl",1,
5 11457 <: filref :>,filref,"nl",1,
5 11458 <: zno: :>,zno,"nl",1,
5 11459 <: answ: :>,answ.tx,"nl",1,
5 11460 <: tlgr: :>,tlgr.tx,"nl",1,
5 11461 <: spec: :>,spec,"nl",1);
5 11462 trap(slut);
5 11463 slut:
5 11464 end; <*disable*>
4 11465 end skriv_radio_ind;
3 11466 \f
3 11466 message procedure indsæt_opkald side 1 - 811105/hko;
3 11467
3 11467 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11468 value bus,type,omr,sig;
3 11469 integer bus,type,omr,sig;
3 11470 begin
4 11471 integer res,tilst,ll,operatør;
4 11472 integer array field vt_op,ref,næste,forrige;
4 11473 real r;
4 11474
4 11474 res:= -1;
4 11475 begin
5 11476 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11477 if vt_op <> 0 then
5 11478 begin
6 11479 wait(bs_opkaldskø_adgang);
6 11480 if omr>2 then
6 11481 begin
7 11482 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11483 d.vt_op.data(1):= bus;
7 11484 d.vt_op.data(4):= omr;
7 11485 tilst:= vt_op;
7 11486 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11487 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11488 <*+4*> if tilst <> vt_op then
7 11489 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11490 <*-4*>
7 11491 <*+2*> if testbit34 and overvåget then
7 11492 disable begin
8 11493 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11494 skriv_op(out,vt_op);
8 11495 ud;
8 11496 end;
7 11497 end
6 11498 else
6 11499 begin
7 11500 d.vt_op.data(1):= bus;
7 11501 d.vt_op.data(2):= 0;
7 11502 d.vt_op.data(3):= bus;
7 11503 d.vt_op.data(4):= omr;
7 11504 d.vt_op.resultat:= 0;
7 11505 ref:= første_nødopkald;
7 11506 if ref<>0 then tilst:= 2
7 11507 else
7 11508 begin
8 11509 ref:= første_opkald;
8 11510 tilst:= if ref=0 then 0 else 1;
8 11511 end;
7 11512 if tilst=0 then
7 11513 d.vt_op.resultat:= 3
7 11514 else
7 11515 begin
8 11516 while ref<>0 and d.vt_op.resultat=0 do
8 11517 begin
9 11518 if opkaldskø.ref(2) extract 14 = bus and
9 11519 opkaldskø.ref(5) extract 8 = omr
9 11520 then
9 11521 d.vt_op.resultat:= 18
9 11522 else
9 11523 begin
10 11524 ref:= opkaldskø.ref(1) extract 12;
10 11525 if ref=0 and tilst=2 then
10 11526 begin
11 11527 ref:= første_opkald;
11 11528 tilst:= if ref=0 then 0 else 1;
11 11529 end
10 11530 else
10 11531 if ref=0 then tilst:= 0;
10 11532 end;
9 11533 end;
8 11534 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11535 end;
7 11536 end;
6 11537 <*-2*>
6 11538 \f
6 11538 message procedure indsæt_opkald side 1a- 820301/hko;
6 11539
6 11539 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11540 begin
7 11541 ref:=første_opkald;
7 11542 tilst:=-1;
7 11543 while ref<>0 and tilst=-1 do
7 11544 begin
8 11545 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11546 begin <* udtag normalopkald *>
9 11547 næste:=opkaldskø.ref(1);
9 11548 forrige:=næste shift(-12);
9 11549 næste:=næste extract 12;
9 11550 if forrige<>0 then
9 11551 opkaldskø.forrige(1):=
9 11552 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11553 else
9 11554 første_opkald:=næste;
9 11555 if næste<>0 then
9 11556 opkaldskø.næste(1):=
9 11557 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11558 else
9 11559 sidste_opkald:=forrige;
9 11560 opkaldskø.ref(1):=første_frie_opkald;
9 11561 første_frie_opkald:=ref;
9 11562 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11563 tilst:=0;
9 11564 end
8 11565 else
8 11566 ref:=opkaldskø.ref(1) extract 12;
8 11567 end; <*while*>
7 11568 if tilst=0 then
7 11569 d.vt_op.resultat:=3;
7 11570 end; <*nødopkald bus i kø*>
6 11571 \f
6 11571 message procedure indsæt_opkald side 2 - 820304/hko;
6 11572
6 11572 if d.vt_op.resultat = 3 then
6 11573 begin
7 11574 ll:= d.vt_op.data(2);
7 11575 tilst:= d.vt_op.data(3);
7 11576 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11577 if operatør < 0 or max_antal_operatører < operatør then
7 11578 operatør:= 0;
7 11579 if operatør=0 then
7 11580 operatør:= (tilst shift (-14) extract 8);
7 11581 if operatør=0 then
7 11582 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11583 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11584 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11585 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11586 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11587 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11588 forrige:= (if type = 1 then sidste_opkald
7 11589 else sidste_nødopkald);
7 11590 opkaldskø.ref(1):= forrige shift 12;
7 11591 if type = 1 then
7 11592 begin
8 11593 if første_opkald = 0 then første_opkald:= ref;
8 11594 sidste_opkald:= ref;
8 11595 end
7 11596 else
7 11597 begin <*type = 2*>
8 11598 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11599 sidste_nødopkald:= ref;
8 11600 end;
7 11601 if forrige <> 0 then
7 11602 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11603 shift 12 +ref;
7 11604
7 11604 opkaldskø.ref(2):= tilst extract 22 add
7 11605 (if type=2 then 1 shift 23 else 0);
7 11606 opkaldskø.ref(3):= ll;
7 11607 systime(5,0.0,r);
7 11608 ll:= round r//100;<*ttmm*>
7 11609 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 11610 opkaldskø.ref(5):= sig shift 20 + omr;
7 11611 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 11612 res:= 0;
7 11613 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 11614 opkaldskø_ledige:= opkaldskø_ledige -1;
7 11615 <*meddel opkald til berørte operatører *>
7 11616 signal_bin(bs_mobil_opkald);
7 11617 tæl_opkald(omr,type+1);
7 11618 end <* resultat = 3 *>
6 11619 else
6 11620 begin
7 11621 \f
7 11621 message procedure indsæt_opkald side 3 - 810601/hko;
7 11622
7 11622 <* d.vt_op.resultat <> 3 *>
7 11623
7 11623 res:= d.vt_op.resultat;
7 11624 if res = 10 then
7 11625 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 11626 <:er ikke i bustabel:>,1)
7 11627 else
7 11628 <*+4*> if res <> 14 and res <> 18 then
7 11629 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 11630 <*-4*>
7 11631 ;
7 11632 end;
6 11633 signalbin(bs_opkaldskø_adgang);
6 11634 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 11635 end
5 11636 else
5 11637 res:= -2; <*timeout for cs_vt_adgang*>
5 11638 end;
4 11639 indsæt_opkald:= res;
4 11640 end indsæt_opkald;
3 11641 \f
3 11641 message procedure afvent_telegram side 1 - 880901/cl;
3 11642
3 11642 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 11643 integer array tlgr;
3 11644 integer lgd,ttyp,ptyp,pnum;
3 11645 begin
4 11646 integer i, pos, tegn, ac, sum, csum;
4 11647
4 11647 pos:= 1;
4 11648 lgd:= 0;
4 11649 ttyp:= 'Z';
4 11650 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 11651 if ac >= 0 then
4 11652 begin
5 11653 lgd:= 1;
5 11654 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 11655 lgd:= lgd-2;
5 11656 if lgd >= 3 then
5 11657 begin
6 11658 i:= 1;
6 11659 ttyp:= læstegn(tlgr,i,tegn);
6 11660 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 11661 pnum:= læstegn(tlgr,i,tegn) - '@';
6 11662 end
5 11663 else ac:= 6; <* for kort telegram - retransmitter *>
5 11664 end;
4 11665
4 11665 afvent_telegram:= ac;
4 11666 end;
3 11667 \f
3 11667 message procedure b_answ side 1 - 880901/cl;
3 11668
3 11668 procedure b_answ(answ,ht,spec,more,ac);
3 11669 value ht, more,ac;
3 11670 integer array answ, spec;
3 11671 boolean more;
3 11672 integer ht, ac;
3 11673 begin
4 11674 integer pos, i, sum, tegn;
4 11675
4 11675 pos:= 1;
4 11676 skrivtegn(answ,pos,'B');
4 11677 skrivtegn(answ,pos,if more then 'B' else ' ');
4 11678 skrivtegn(answ,pos,ac+'@');
4 11679 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 11680 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 11681 skrivtegn(answ,pos,'@');
4 11682 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 11683 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 11684 for i:= 1 step 1 until spec(1) extract 8 do
4 11685 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 11686 else
4 11687 begin
5 11688 skrivtegn(answ,pos,'D');
5 11689 anbringtal(answ,pos,spec(1+i),-4);
5 11690 end;
4 11691 for i:= 1 step 1 until 4 do
4 11692 skrivtegn(answ,pos,'@');
4 11693 skrivtegn(answ,pos,ht+'@');
4 11694 skrivtegn(answ,pos,'@');
4 11695
4 11695 i:= 1; sum:= 0;
4 11696 while i < pos do
4 11697 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 11698 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 11699 skrivtegn(answ,pos,sum extract 4 + '@');
4 11700 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 11701 end;
3 11702 \f
3 11702 message procedure ann_opkald side 1 - 881108/cl;
3 11703
3 11703 integer procedure ann_opkald(vogn,omr);
3 11704 value vogn,omr;
3 11705 integer vogn,omr;
3 11706 begin
4 11707 integer array field vt_op,ref,næste,forrige;
4 11708 integer res, t, i, o;
4 11709
4 11709 waitch(cs_vt_adgang,vt_op,true,-1);
4 11710 res:= -1;
4 11711 wait(bs_opkaldskø_adgang);
4 11712 ref:= første_nødopkald;
4 11713 if ref <> 0 then
4 11714 t:= 2
4 11715 else
4 11716 begin
5 11717 ref:= første_opkald;
5 11718 t:= if ref<>0 then 1 else 0;
5 11719 end;
4 11720
4 11720 if t=0 then
4 11721 res:= 19 <* kø tom *>
4 11722 else
4 11723 begin
5 11724 while ref<>0 and res=(-1) do
5 11725 begin
6 11726 if vogn=opkaldskø.ref(2) extract 14 and
6 11727 omr=opkaldskø.ref(5) extract 8
6 11728 then
6 11729 res:= 0
6 11730 else
6 11731 begin
7 11732 ref:= opkaldskø.ref(1) extract 12;
7 11733 if ref=0 and t=2 then
7 11734 begin
8 11735 ref:= første_opkald;
8 11736 t:= if ref=0 then 0 else 1;
8 11737 end;
7 11738 end;
6 11739 end; <*while*>
5 11740 \f
5 11740 message procedure ann_opkald side 2 - 881108/cl;
5 11741
5 11741 if ref<>0 then
5 11742 begin
6 11743 start_operation(vt_op,401,cs_radio_ind,17);
6 11744 d.vt_op.data(1):= vogn;
6 11745 d.vt_op.data(4):= omr;
6 11746 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 11747 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 11748
6 11748 o:= opkaldskø.ref(4) extract 8;
6 11749 næste:= opkaldskø.ref(1);
6 11750 forrige:= næste shift (-12);
6 11751 næste:= næste extract 12;
6 11752 if forrige<>0 then
6 11753 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 11754 + næste
6 11755 else
6 11756 if t=2 then første_nødopkald:= næste
6 11757 else første_opkald:= næste;
6 11758
6 11758 if næste<>0 then
6 11759 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 11760 + forrige shift 12
6 11761 else
6 11762 if t=2 then sidste_nødopkald:= forrige
6 11763 else sidste_opkald:= forrige;
6 11764
6 11764 opkaldskø.ref(1):= første_frie_opkald;
6 11765 første_frie_opkald:= ref;
6 11766 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 11767 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 11768
6 11768 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 11769 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 11770 else
6 11771 begin
7 11772 sætbit_ia(opkaldsflag,o,1);
7 11773 end;
6 11774 signalbin(bs_mobilopkald);
6 11775 end;
5 11776 end;
4 11777
4 11777 signalbin(bs_opkaldskø_adgang);
4 11778 signalch(cs_vt_adgang, vt_op, true);
4 11779 ann_opkald:= res;
4 11780 end;
3 11781 \f
3 11781 message procedure frigiv_id side 1 - 881114/cl;
3 11782
3 11782 integer procedure frigiv_id(id,omr);
3 11783 value id,omr;
3 11784 integer id,omr;
3 11785 begin
4 11786 integer array field vt_op;
4 11787
4 11787 if id shift (-22) < 3 and omr > 2 then
4 11788 begin
5 11789 waitch(cs_vt_adgang,vt_op,true,-1);
5 11790 start_operation(vt_op,401,cs_radio_ind,
5 11791 if id shift (-22) = 2 then 18 else 17);
5 11792 d.vt_op.data(1):= id;
5 11793 d.vt_op.data(4):= omr;
5 11794 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 11795 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 11796 frigiv_id:= d.vt_op.resultat;
5 11797 signalch(cs_vt_adgang,vt_op,true);
5 11798 end;
4 11799 end;
3 11800 \f
3 11800 message procedure radio_ind side 2 - 810524/hko;
3 11801 trap(radio_ind_trap);
3 11802 laf:= 0;
3 11803 stack_claim((if cm_test then 200 else 150) +135+75);
3 11804
3 11804 <*+2*>if testbit32 and overvåget or testbit28 then
3 11805 skriv_radio_ind(out,0);
3 11806 <*-2*>
3 11807 answ.laf(1):= long<:<'nl'>:>;
3 11808 io_opref:= op;
3 11809
3 11809 repeat
3 11810 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 11811 pos:= 4;
3 11812 if ac = 0 then
3 11813 begin
4 11814 \f
4 11814 message procedure radio_ind side 3 - 881107/cl;
4 11815 if ttyp = 'A' then
4 11816 begin
5 11817 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 11818 ac:= 1
5 11819 else
5 11820 begin
6 11821 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 11822 val(1):= ttyp;
6 11823 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 11824 val(2):= pnum;
6 11825 typ(3):= -1;
6 11826 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 11827 if opref>0 then
6 11828 begin
7 11829 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 11830 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 11831 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 11832 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 11833 then
7 11834 begin
8 11835 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 11836 end
7 11837 else
7 11838 begin
8 11839 ac:= 0;
8 11840 d.opref.resultat:= 0;
8 11841 sætbit_ia(hookoff_maske,pnum,1);
8 11842 end;
7 11843 signalch(d.opref.retur,opref,d.opref.optype);
7 11844 end
6 11845 else
6 11846 ac:= 2;
6 11847 end;
5 11848 pos:= 1;
5 11849 skrivtegn(answ,pos,'A');
5 11850 skrivtegn(answ,pos,' ');
5 11851 skrivtegn(answ,pos,ac+'@');
5 11852 for i:= 1 step 1 until 5 do
5 11853 skrivtegn(answ,pos,'@');
5 11854 skrivtegn(answ,pos,'0');
5 11855 i:= 1; sum:= 0;
5 11856 while i < pos do
5 11857 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 11858 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 11859 skrivtegn(answ,pos,sum extract 4 + '@');
5 11860 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 11861 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 11862 <*+2*> if (testbit36 or testbit38) and overvåget then
5 11863 disable begin
6 11864 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 11865 outchar(zrl,'nl');
6 11866 end;
5 11867 <*-2*>
5 11868 disable setposition(z_fr_out,0,0);
5 11869 ac:= -1;
5 11870 \f
5 11870 message procedure radio_ind side 4 - 881107/cl;
5 11871 end <* ttyp=A *>
4 11872 else
4 11873 if ttyp = 'B' then
4 11874 begin
5 11875 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 11876 ac:= 1
5 11877 else
5 11878 begin
6 11879 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 11880 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 11881 typ(3):= -1;
6 11882 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 11883 if opref > 0 then
6 11884 begin
7 11885 <*+2*> if testbit37 and overvåget then
7 11886 disable begin
8 11887 skriv_radio_ind(out,0);
8 11888 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 11889 skriv_op(out,opref);
8 11890 end;
7 11891 <*-2*>
7 11892 læstegn(tlgr,pos,bs);
7 11893 if bs = 'V' then
7 11894 begin
8 11895 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 11896 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 11897 end;
7 11898 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 11899 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 11900 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 11901 then
7 11902 begin
8 11903 ac:= 1;
8 11904 d.opref.resultat:= 31; <* systemfejl *>
8 11905 signalch(d.opref.retur,opref,d.opref.optype);
8 11906 end
7 11907 else
7 11908 if bs='V' then
7 11909 begin
8 11910 ac:= 0;
8 11911 d.opref.resultat:= 1;
8 11912 d.opref.data(4):= 0;
8 11913 d.opref.data(7):=
8 11914 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 11915 radio_id(b_pn));
8 11916 systime(1,0.0,d.opref.tid);
8 11917 signalch(cs_radio_ind,opref,d.opref.optype);
8 11918 spec:= data+18;
8 11919 b_answ(answ,0,d.opref.spec,false,ac);
8 11920 <*+2*> if (testbit36 or testbit38) and overvåget then
8 11921 disable begin
9 11922 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 11923 outchar(zrl,'nl');
9 11924 end;
8 11925 <*-2*>
8 11926 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 11927 disable setposition(z_fr_out,0,0);
8 11928 ac:= -1;
8 11929 \f
8 11929 message procedure radio_ind side 5 - 881107/cl;
8 11930 end
7 11931 else
7 11932 begin
8 11933 integer sig_type;
8 11934
8 11934 ac:= 0;
8 11935 antal_spec:= d.opref.data(4);
8 11936 filref:= d.opref.data(5);
8 11937 spec:= d.opref.data(6);
8 11938 if antal_spec>0 then
8 11939 begin
9 11940 antal_spec:= antal_spec-1;
9 11941 if filref<>0 then
9 11942 begin
10 11943 læsfil(filref,1,zno);
10 11944 b_pt:= fil(zno).spec(1) shift (-12);
10 11945 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 11946 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 11947 antal_spec>0,ac);
10 11948 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 11949 end
9 11950 else
9 11951 begin
10 11952 b_pt:= d.opref.spec(1) shift (-12);
10 11953 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 11954 b_answ(answ,d.opref.data(3),d.opref.spec,
10 11955 antal_spec>0,ac);
10 11956 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 11957 end;
9 11958
9 11958 <* send answer *>
9 11959 <*+2*> if (testbit36 or testbit38) and overvåget then
9 11960 disable begin
10 11961 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 11962 outchar(zrl,'nl');
10 11963 end;
9 11964 <*-2*>
9 11965 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 11966 disable setposition(z_fr_out,0,0);
9 11967 if ac<>0 then
9 11968 begin
10 11969 antal_spec:= 0;
10 11970 ac:= -1;
10 11971 end
9 11972 else
9 11973 begin
10 11974 for i:= 1 step 1 until max_antal_områder do
10 11975 if område_id(i,2)=b_pt then
10 11976 begin
11 11977 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 11978 if sætbiti(d.opref.data(7),j,1)=0 then
11 11979 d.opref.resultat:= d.opref.resultat + 1;
11 11980 end;
10 11981 end;
9 11982 end;
8 11983 \f
8 11983 message procedure radio_ind side 6 - 881107/cl;
8 11984
8 11984 <* afvent nyt telegram *>
8 11985 d.opref.data(4):= antal_spec;
8 11986 d.opref.data(6):= spec;
8 11987 ac:= -1;
8 11988 systime(1,0.0,d.opref.tid);
8 11989 <*+2*> if testbit37 and overvåget then
8 11990 disable begin
9 11991 skriv_radio_ind(out,0);
9 11992 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 11993 ud;
9 11994 end;
8 11995 <*-2*>
8 11996 signalch(cs_radio_ind,opref,d.opref.optype);
8 11997 end;
7 11998 end
6 11999 else ac:= 2;
6 12000 end;
5 12001 if ac > 0 then
5 12002 begin
6 12003 for i:= 1 step 1 until 6 do val(i):= 0;
6 12004 b_answ(answ,0,val,false,ac);
6 12005 <*+2*>
6 12006 if (testbit36 or testbit38) and overvåget then
6 12007 disable begin
7 12008 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12009 outchar(zrl,'nl');
7 12010 end;
6 12011 <*-2*>
6 12012 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12013 disable setposition(z_fr_out,0,0);
6 12014 ac:= -1;
6 12015 end;
5 12016 \f
5 12016 message procedure radio_ind side 7 - 881107/cl;
5 12017 end <* ttyp = 'B' *>
4 12018 else
4 12019 if ttyp='C' or ttyp='J' then
4 12020 begin
5 12021 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12022 ac:= 1
5 12023 else
5 12024 begin
6 12025 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12026 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12027 typ(3):= -1;
6 12028 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12029 if opref > 0 then
6 12030 begin
7 12031 d.opref.resultat:= d.opref.resultat - 1;
7 12032 if ttyp = 'C' then
7 12033 begin
8 12034 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12035 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12036 j:= 0;
8 12037 for i:= 1 step 1 until max_antal_kanaler do
8 12038 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12039 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12040 d.opref.resultat:= d.opref.resultat-1;
8 12041 sætbiti(optaget_flag,j,1);
8 12042 sætbiti(d.opref.data(9),j,1);
8 12043 end
7 12044 else
7 12045 begin <* INGEN FORBINDELSE *>
8 12046 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12047 end;
7 12048 ac:= 0;
7 12049 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12050 begin
8 12051 systime(1,0,d.opref.tid);
8 12052 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12053 end
7 12054 else
7 12055 begin
8 12056 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12057 if læsbiti(d.opref.data(8),9) then 52 else
8 12058 if læsbiti(d.opref.data(8),10) then 20 else
8 12059 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12060 signalch(d.opref.retur, opref, d.opref.optype);
8 12061 end;
7 12062 end
6 12063 else
6 12064 ac:= 2;
6 12065 end;
5 12066 pos:= 1;
5 12067 skrivtegn(answ,pos,ttyp);
5 12068 skrivtegn(answ,pos,' ');
5 12069 skrivtegn(answ,pos,ac+'@');
5 12070 i:= 1; sum:= 0;
5 12071 while i < pos do
5 12072 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12073 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12074 skrivtegn(answ,pos,sum extract 4 + '@');
5 12075 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12076 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12077 disable begin
6 12078 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12079 outchar(zrl,'nl');
6 12080 end;
5 12081 <*-2*>
5 12082 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12083 disable setposition(z_fr_out,0,0);
5 12084 ac:= -1;
5 12085 \f
5 12085 message procedure radio_ind side 8 - 881107/cl;
5 12086 end <* ttyp = 'C' or 'J' *>
4 12087 else
4 12088 if ttyp = 'D' then
4 12089 begin
5 12090 if ptyp = 4 <* VDU *> then
5 12091 begin
6 12092 if pnum<1 or pnum>max_antal_taleveje then
6 12093 ac:= 1
6 12094 else
6 12095 begin
7 12096 inspect(bs_talevej_udkoblet(pnum),j);
7 12097 if j>=0 then
7 12098 begin
8 12099 sætbit_ia(samtaleflag,pnum,1);
8 12100 signal_bin(bs_mobil_opkald);
8 12101 end;
7 12102 if læsbit_ia(hookoff_maske,pnum) then
7 12103 signalbin(bs_talevej_udkoblet(pnum));
7 12104 ac:= 0;
7 12105 end
6 12106 end
5 12107 else
5 12108 if ptyp=3 or ptyp=2 then
5 12109 begin
6 12110 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12111 ptyp=2 and pnum<>2
6 12112 then
6 12113 ac:= 1
6 12114 else
6 12115 begin
7 12116 if læstegn(tlgr,5,tegn)='D' then
7 12117 begin <* teknisk nr i telegram *>
8 12118 b_pn:= 0;
8 12119 for i:= 1 step 1 until 4 do
8 12120 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12121 end
7 12122 else
7 12123 b_pn:= 0;
7 12124 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12125 i:= 0;
7 12126 for j:= 1 step 1 until max_antal_kanaler do
7 12127 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12128 if i<>0 then
7 12129 begin
8 12130 ref:= (i-1)*kanalbeskrlængde;
8 12131 inspect(ss_samtale_nedlagt(i),j);
8 12132 if j>=0 then
8 12133 begin
9 12134 sætbit_ia(samtaleflag,
9 12135 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12136 signalbin(bs_mobil_opkald);
9 12137 end;
8 12138 signal(ss_samtale_nedlagt(i));
8 12139 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12140 begin
9 12141 if kanal_tab.ref.kanal_id1<>0 and
9 12142 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12143 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12144 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12145 if kanal_tab.ref.kanal_id2<>0 and
9 12146 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12147 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12148 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12149 end;
8 12150 sætbiti(optaget_flag,i,0);
8 12151 end;
7 12152 ac:= 0;
7 12153 end;
6 12154 end
5 12155 else ac:= 1;
5 12156 if ac>=0 then
5 12157 begin
6 12158 pos:= i:= 1; sum:= 0;
6 12159 skrivtegn(answ,pos,'D');
6 12160 skrivtegn(answ,pos,' ');
6 12161 skrivtegn(answ,pos,ac+'@');
6 12162 skrivtegn(answ,pos,'@');
6 12163 while i<pos do
6 12164 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12165 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12166 skrivtegn(answ,pos, sum extract 4 + '@');
6 12167 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12168 <*+2*>
6 12169 if (testbit36 or testbit38) and overvåget then
6 12170 disable begin
7 12171 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12172 outchar(zrl,'nl');
7 12173 end;
6 12174 <*-2*>
6 12175 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12176 disable setposition(z_fr_out,0,0);
6 12177 ac:= -1;
6 12178 end;
5 12179 \f
5 12179 message procedure radio_ind side 9 - 881107/cl;
5 12180 end <* ttyp = D *>
4 12181 else
4 12182 if ttyp='H' then
4 12183 begin
5 12184 integer htyp;
5 12185
5 12185 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12186
5 12186 if htyp='A' then
5 12187 begin <*mobilopkald*>
6 12188 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12189 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12190 ac:= 1
6 12191 else
6 12192 begin
7 12193 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12194 if læstegn(tlgr,6,tegn)='D' then
7 12195 begin <*teknisk nr. i telegram*>
8 12196 b_pn:= 0;
8 12197 for i:= 1 step 1 until 4 do
8 12198 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12199 end
7 12200 else b_pn:= 0;
7 12201 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12202 <* opkaldstype *>
7 12203 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12204 if j>0 then
7 12205 begin
8 12206 if bs=10 then
8 12207 ann_opkald(b_pn,j)
8 12208 else
8 12209 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12210 ac:= 0;
8 12211 end else ac:= 1;
7 12212 end;
6 12213 \f
6 12213 message procedure radio_ind side 10 - 881107/cl;
6 12214 end
5 12215 else
5 12216 if htyp='E' then
5 12217 begin <* radiokanal status *>
6 12218 ac:= 0;
6 12219 j:= 0;
6 12220 for i:= 1 step 1 until max_antal_kanaler do
6 12221 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12222
6 12222 <* Alarmer for K12 = GLX ignoreres *>
6 12223 <* 94.06.14/CL *>
6 12224 if j>0 then
6 12225 j:= (if områdenavn(port_til_omr(ptyp shift 6 + pnum))
6 12226 = long<:GLX:> then 0 else j);
6 12227
6 12227 læstegn(tlgr,9,tegn);
6 12228 if j<>0 and (tegn='A' or tegn='E') then
6 12229 begin
7 12230 ref:= (j-1)*kanalbeskrlængde;
7 12231 bs:= if tegn='E' then 0 else 15;
7 12232 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12233 begin
8 12234 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12235 signalbin(bs_mobil_opkald);
8 12236 end;
7 12237 end;
6 12238 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12239 begin
7 12240 waitch(cs_radio_pulje,opref,true,-1);
7 12241 startoperation(opref,401,cs_radio_pulje,23);
7 12242 i:= 1;
7 12243 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12244 if læstegn(tlgr,4,k)<>'@' then
7 12245 begin
8 12246 if k-'@' = 17 then
8 12247 hægtstring(d.opref.data,i,<: AMV:>)
8 12248 else
8 12249 if k-'@' = 18 then
8 12250 hægtstring(d.opref.data,i,<: BHV:>)
8 12251 else
8 12252 begin
9 12253 hægtstring(d.opref.data,i,<: BST:>);
9 12254 anbringtal(d.opref.data,i,k-'@',1);
9 12255 end;
8 12256 end;
7 12257 skrivtegn(d.opref.data,i,' ');
7 12258 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12259 skrivtegn(d.opref.data,i,' ');
7 12260 hægtstring(d.opref.data,i,
7 12261 string område_navn(kanal_til_omr(j)));
7 12262 if '@'<=tegn and tegn<='F' then
7 12263 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12264 <*@*> <:: ukendt fejl:>,
7 12265 <*A*> <:: compad-fejl:>,
7 12266 <*B*> <:: ladefejl:>,
7 12267 <*C*> <:: dør åben:>,
7 12268 <*D*> <:: senderfejl:>,
7 12269 <*E*> <:: compad ok:>,
7 12270 <*F*> <:: liniefejl:>,
7 12271 <::>))
7 12272 else
7 12273 begin
8 12274 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12275 skrivtegn(d.opref.data,i,tegn);
8 12276 end;
7 12277 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12278 signalch(cs_io,opref,gen_optype or rad_optype);
7 12279 ref:= (j-1)*kanalbeskrlængde;
7 12280 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12281 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12282 signalbin(bs_mobilopkald);
7 12283 end;
6 12284 \f
6 12284 message procedure radio_ind side 11 - 881107/cl;
6 12285 end
5 12286 else
5 12287 if htyp='G' then
5 12288 begin <* fjerninkludering/-ekskludering af område *>
6 12289 bs:= læstegn(tlgr,9,tegn)-'@';
6 12290 j:= 0;
6 12291 for i:= 1 step 1 until max_antal_kanaler do
6 12292 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12293 if j<>0 then
6 12294 begin
7 12295 ref:= (j-1)*kanalbeskrlængde;
7 12296 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12297 end;
6 12298 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12299 signalbin(bs_mobilopkald);
6 12300 ac:= 0;
6 12301 end
5 12302 else
5 12303 if htyp='L' then
5 12304 begin <* vogntabelændringer *>
6 12305 long field ll;
6 12306
6 12306 ll:= 10;
6 12307 ac:= 0;
6 12308 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12309 læstegn(tlgr,9,tegn);
6 12310 if (tegn='N') or (tegn='O') then
6 12311 begin
7 12312 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12313 typ(2):= -1;
7 12314 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12315 if opref>0 then
7 12316 begin
8 12317 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12318 signalch(d.opref.retur,opref,d.opref.optype);
8 12319 end;
7 12320 ac:= -1;
7 12321 end
6 12322 else
6 12323 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12324 ac:= -1
6 12325 else
6 12326 if tegn='G' then <*indkodning*>
6 12327 begin
7 12328 pos:= 10; i:= 0;
7 12329 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12330 i:= i*10 + (tegn-'0');
7 12331 i:= i mod 1000;
7 12332 b_pn:= (1 shift 22) + (i shift 12);
7 12333 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12334 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12335 pos:= 14; i:= 0;
7 12336 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12337 i:= i*10 + (tegn-'0');
7 12338 b_pn:= b_pn + i;
7 12339 pos:= 16; i:= 0;
7 12340 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12341 i:= i*10 + (tegn-'0');
7 12342 b_pt:= i;
7 12343 bs:= 11;
7 12344 \f
7 12344 message procedure radio_ind side 12 - 881107/cl;
7 12345 end
6 12346 else
6 12347 if tegn='H' then <*udkodning*>
6 12348 begin
7 12349 pos:= 10; i:= 0;
7 12350 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12351 i:= i*10 + (tegn-'0');
7 12352 b_pt:= i;
7 12353 b_pn:= 0;
7 12354 bs:= 12;
7 12355 end
6 12356 else
6 12357 if tegn='I' then <*slet tabel*>
6 12358 begin
7 12359 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12360 pos:= 10; i:= 0;
7 12361 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12362 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12363 zno:= i;
7 12364 end
6 12365 else ac:= 2;
6 12366 if ac<0 then
6 12367 ac:= 0
6 12368 else
6 12369
6 12369 if ac=0 then
6 12370 begin
7 12371 waitch(cs_vt_adgang,opref,true,-1);
7 12372 startoperation(opref,401,cs_vt_adgang,bs);
7 12373 d.opref.data(1):= b_pt;
7 12374 d.opref.data(2):= b_pn;
7 12375 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12376 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12377 end;
6 12378 end
5 12379 else
5 12380 ac:= 2;
5 12381
5 12381 pos:= 1;
5 12382 skrivtegn(answ,pos,'H');
5 12383 skrivtegn(answ,pos,' ');
5 12384 skrivtegn(answ,pos,ac+'@');
5 12385 i:= 1; sum:= 0;
5 12386 while i < pos do
5 12387 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12388 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12389 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12390 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12391 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12392 disable begin
6 12393 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12394 outchar(zrl,'nl');
6 12395 end;
5 12396 <*-2*>
5 12397 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12398 disable setposition(z_fr_out,0,0);
5 12399 ac:= -1;
5 12400 \f
5 12400 message procedure radio_ind side 13 - 881107/cl;
5 12401 end
4 12402 else
4 12403 if ttyp = 'I' then
4 12404 begin
5 12405 typ(1):= -1;
5 12406 repeat
5 12407 getch(cs_radio_ind,opref,true,typ,val);
5 12408 if opref<>0 then
5 12409 begin
6 12410 d.opref.resultat:= 31;
6 12411 signalch(d.opref.retur,opref,d.opref.op_type);
6 12412 end;
5 12413 until opref=0;
5 12414 for i:= 1 step 1 until max_antal_taleveje do
5 12415 if læsbit_ia(hookoff_maske,i) then
5 12416 begin
6 12417 signalbin(bs_talevej_udkoblet(i));
6 12418 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12419 end;
5 12420 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12421 signal_bin(bs_mobil_opkald);
5 12422 for i:= 1 step 1 until max_antal_kanaler do
5 12423 begin
6 12424 ref:= (i-1)*kanalbeskrlængde;
6 12425 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12426 begin
7 12427 if kanal_tab.ref.kanal_id2<>0 and
7 12428 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12429 then
7 12430 begin
8 12431 signal(ss_samtale_nedlagt(i));
8 12432 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12433 end;
7 12434 if kanal_tab.ref.kanal_id1<>0 then
7 12435 begin
8 12436 signal(ss_samtale_nedlagt(i));
8 12437 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12438 end;
7 12439 end;
6 12440 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12441 end;
5 12442 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12443 startoperation(opref,401,cs_radio_pulje,23);
5 12444 i:= 1;
5 12445 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12446 j:= 4;
5 12447 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12448 begin
6 12449 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12450 end;
5 12451 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12452 signalch(cs_io,opref,gen_optype or rad_optype);
5 12453 optaget_flag:= 0;
5 12454 pos:= i:= 1; sum:= 0;
5 12455 skrivtegn(answ,pos,'I');
5 12456 skrivtegn(answ,pos,' ');
5 12457 skrivtegn(answ,pos,'@');
5 12458 while i<pos do
5 12459 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12460 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12461 skrivtegn(answ,pos,sum extract 4 + '@');
5 12462 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12463 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12464 disable begin
6 12465 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12466 outchar(zrl,'nl');
6 12467 end;
5 12468 <*-2*>
5 12469 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12470 disable setposition(z_fr_out,0,0);
5 12471 ac:= -1;
5 12472 \f
5 12472 message procedure radio_ind side 14 - 881107/cl;
5 12473 end
4 12474 else
4 12475 if ttyp='L' then
4 12476 begin
5 12477 ac:= 0;
5 12478 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12479 if testbit21 then
5 12480 begin
6 12481 waitch(cs_radio_pulje,opref,true,-1);
6 12482 startoperation(opref,401,cs_radio_pulje,23);
6 12483 i:= 1;
6 12484 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12485 j:= 4;
6 12486 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12487 begin
7 12488 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12489 end;
6 12490 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12491 signalch(cs_io,opref,gen_optype or rad_optype);
6 12492 end; <*testbit21*>
5 12493 end
4 12494 else
4 12495 if ttyp='Z' then
4 12496 begin
5 12497 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12498 disable begin
6 12499 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12500 outchar(zrl,'nl');
6 12501 end;
5 12502 <*-2*>
5 12503 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12504 disable setposition(z_fr_out,0,0);
5 12505 ac:= -1;
5 12506 end
4 12507 else
4 12508 ac:= 1;
4 12509 end; <* telegram modtaget ok *>
3 12510 \f
3 12510 message procedure radio_ind side 15 - 881107/cl;
3 12511 if ac>=0 then
3 12512 begin
4 12513 pos:= i:= 1; sum:= 0;
4 12514 skrivtegn(answ,pos,ttyp);
4 12515 skrivtegn(answ,pos,' ');
4 12516 skrivtegn(answ,pos,ac+'@');
4 12517 while i<pos do
4 12518 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12519 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12520 skrivtegn(answ,pos, sum extract 4 + '@');
4 12521 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12522 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12523 disable begin
5 12524 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12525 outchar(zrl,'nl');
5 12526 end;
4 12527 <*-2*>
4 12528 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12529 disable setposition(z_fr_out,0,0);
4 12530 ac:= -1;
4 12531 end;
3 12532
3 12532 typ(1):= 0;
3 12533 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12534 rf:= 4;
3 12535 systime(1,0.0,val.rf);
3 12536 val.rf:= val.rf - 30.0;
3 12537 typ(3):= -1;
3 12538 repeat
3 12539 getch(cs_radio_ind,opref,true,typ,val);
3 12540 if opref>0 then
3 12541 begin
4 12542 d.opref.resultat:= 53; <*annuleret*>
4 12543 signalch(d.opref.retur,opref,d.opref.optype);
4 12544 end;
3 12545 until opref=0;
3 12546
3 12546 until false;
3 12547
3 12547 radio_ind_trap:
3 12548
3 12548 disable skriv_radio_ind(zbillede,1);
3 12549
3 12549 end radio_ind;
2 12550 \f
2 12550 message procedure radio_ud side 1 - 820301/hko;
2 12551
2 12551 procedure radio_ud(op);
2 12552 value op;
2 12553 integer op;
2 12554 begin
3 12555 integer array field opref,io_opref;
3 12556 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12557 integer array answ, tlgr(1:32);
3 12558 long array field laf;
3 12559
3 12559 procedure skriv_radio_ud(z,omfang);
3 12560 value omfang;
3 12561 zone z;
3 12562 integer omfang;
3 12563 begin integer i1;
4 12564 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12565 if omfang > 0 then
4 12566 disable begin real x; long array field tx;
5 12567 tx:= 0;
5 12568 trap(slut);
5 12569 write(z,"nl",1,
5 12570 <: opref: :>,opref,"nl",1,
5 12571 <: io-opref: :>,io_opref,"nl",1,
5 12572 <: opgave: :>,opgave,"nl",1,
5 12573 <: kode: :>,kode,"nl",1,
5 12574 <: pos: :>,pos,"nl",1,
5 12575 <: tegn: :>,tegn,"nl",1,
5 12576 <: i: :>,i,"nl",1,
5 12577 <: sum: :>,sum,"nl",1,
5 12578 <: rc: :>,rc,"nl",1,
5 12579 <: svar-status: :>,svar_status,"nl",1,
5 12580 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12581 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12582 <::>);
5 12583 skriv_coru(z,coru_no(402));
5 12584 slut:
5 12585 end; <*disable*>
4 12586 end skriv_radio_ud;
3 12587
3 12587 trap(radio_ud_trap);
3 12588 laf:= 0;
3 12589 stack_claim((if cm_test then 200 else 150) +35+100);
3 12590
3 12590 <*+2*>if testbit32 and overvåget or testbit28 then
3 12591 skriv_radio_ud(out,0);
3 12592 <*-2*>
3 12593
3 12593 io_opref:= op;
3 12594 \f
3 12594 message procedure radio_ud side 2 - 810529/hko;
3 12595
3 12595 repeat
3 12596
3 12596 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12597 kode:= d.op_ref.opkode;
3 12598 opgave:= kode shift(-12);
3 12599 kode:= kode extract 12;
3 12600 if opgave < 'A' or opgave > 'I' then
3 12601 begin
4 12602 d.opref.resultat:= 31;
4 12603 end
3 12604 else
3 12605 begin
4 12606 pos:= 1;
4 12607 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12608 begin
5 12609 skrivtegn(tlgr,pos,opgave);
5 12610 if d.opref.data(1) = 0 then
5 12611 begin
6 12612 skrivtegn(tlgr,pos,'G');
6 12613 skrivtegn(tlgr,pos,'A');
6 12614 end
5 12615 else
5 12616 begin
6 12617 skrivtegn(tlgr,pos,'D');
6 12618 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 12619 end;
5 12620 if opgave='A' then
5 12621 begin
6 12622 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 12623 end
5 12624 else
5 12625 if opgave='B' then
5 12626 begin
6 12627 skrivtegn(tlgr,pos,d.opref.data(2));
6 12628 if d.opref.data(2)='V' then
6 12629 begin
7 12630 skrivtegn(tlgr,pos,
7 12631 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 12632 skrivtegn(tlgr,pos,
7 12633 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 12634 end;
6 12635 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 12636 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 12637 end
5 12638 else
5 12639 if opgave='H' then
5 12640 begin
6 12641 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 12642 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 12643 hægtstring(tlgr,pos,<:@@@:>);
6 12644 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 12645 skrivtegn(tlgr,pos,'A');
6 12646 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 12647 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 12648 if d.opref.data(2)='L' then
6 12649 begin
7 12650 if d.opref.data(5)=7 then
7 12651 begin
8 12652 anbringtal(tlgr,pos,
8 12653 d.opref.data(8) shift (-12) extract 10,-4);
8 12654 anbringtal(tlgr,pos,
8 12655 d.opref.data(8) extract 7,-2);
8 12656 end
7 12657 else
7 12658 if d.opref.data(5)=8 then
7 12659 begin
8 12660 hægtstring(tlgr,pos,<:FFFFFF:>);
8 12661 end;
7 12662 if d.opref.data(5)<>9 then
7 12663 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 12664 skrivtegn(tlgr,pos,
7 12665 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 12666 skrivtegn(tlgr,pos,
7 12667 dec_to_hex(d.opref.data(6) extract 4));
7 12668 skrivtegn(tlgr,10,pos-11+'@');
7 12669 end;
6 12670 end;
5 12671 end
4 12672 else
4 12673 if opgave='I' then
4 12674 begin
5 12675 hægtstring(tlgr,pos,<:IGA:>);
5 12676 end
4 12677 else d.opref.resultat:= 31; <*systemfejl*>
4 12678 end;
3 12679 \f
3 12679 message procedure radio_ud side 3 - 881107/cl;
3 12680
3 12680 if d.opref.resultat=0 then
3 12681 begin
4 12682 if (opgave <= 'B')
4 12683 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 12684 begin
5 12685 systime(1,0,d.opref.tid);
5 12686 signalch(cs_radio_ind,opref,d.opref.optype);
5 12687 opref:= 0;
5 12688 end;
4 12689 <* beregn checksum og send *>
4 12690 i:= 1; sum:= 0;
4 12691 while i < pos do
4 12692 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 12693 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 12694 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 12695 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 12696 <**********************************************>
4 12697 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 12698
4 12698 if opgave='B' then delay(1);
4 12699
4 12699 <* 94.04.19/cl *>
4 12700 <**********************************************>
4 12701
4 12701 <*+2*> if (testbit36 or testbit39) and overvåget then
4 12702 disable begin
5 12703 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 12704 outchar(zrl,'nl');
5 12705 end;
4 12706 <*-2*>
4 12707 setposition(z_rf_in,0,0);
4 12708 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 12709 disable setposition(z_rf_out,0,0);
4 12710 rc:= 0;
4 12711
4 12711 <* afvent svar*>
4 12712 repeat
4 12713 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 12714 if svar_status=6 then
4 12715 begin
5 12716 svar_status:= -3;
5 12717 goto radio_ud_check;
5 12718 end;
4 12719 pos:= 1;
4 12720 while læstegn(answ,pos,i)<>0 do ;
4 12721 pos:= pos-2;
4 12722 if pos > 0 then
4 12723 begin
5 12724 if pos<3 then
5 12725 svar_status:= -2 <*format error*>
5 12726 else
5 12727 begin
6 12728 if læstegn(answ,3,tegn)<>'@' then
6 12729 svar_status:= tegn - '@'
6 12730 else
6 12731 begin
7 12732 pos:= 1;
7 12733 læstegn(answ,pos,tegn);
7 12734 if tegn<>opgave then
7 12735 svar_status:= -4 <*gal type*>
7 12736 else
7 12737 if læstegn(answ,pos,tegn)<>' ' then
7 12738 svar_status:= -tegn <*fejl*>
7 12739 else
7 12740 svar_status:= læstegn(answ,pos,tegn)-'@';
7 12741 end;
6 12742 end;
5 12743 end
4 12744 else
4 12745 svar_status:= -1;
4 12746 \f
4 12746 message procedure radio_ud side 5 - 881107/cl;
4 12747
4 12747 radio_ud_check:
4 12748 rc:= rc+1;
4 12749 if -3<=svar_status and svar_status< -1 then
4 12750 disable begin
5 12751 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 12752 setposition(z_rf_out,0,0);
5 12753 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12754 begin
6 12755 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 12756 outchar(zrl,'nl');
6 12757 end;
5 12758 <*-2*>
5 12759 end
4 12760 else
4 12761 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 12762 disable begin
5 12763 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 12764 setposition(z_rf_out,0,0);
5 12765 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12766 begin
6 12767 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 12768 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 12769 end;
5 12770 <*-2*>
5 12771 end
4 12772 else
4 12773 if svar_status=0 and opref<>0 then
4 12774 d.opref.resultat:= 0
4 12775 else
4 12776 if opref<>0 then
4 12777 d.opref.resultat:= 31;
4 12778 until svar_status=0 or rc>3;
4 12779 end;
3 12780 if opref<>0 then
3 12781 begin
4 12782 if svar_status<>0 and rc>3 then
4 12783 d.opref.resultat:= 53; <* annulleret *>
4 12784 signalch(d.opref.retur,opref,d.opref.optype);
4 12785 opref:= 0;
4 12786 end;
3 12787 until false;
3 12788
3 12788 radio_ud_trap:
3 12789
3 12789 disable skriv_radio_ud(zbillede,1);
3 12790
3 12790 end radio_ud;
2 12791 \f
2 12791 message procedure radio_medd_opkald side 1 - 810610/hko;
2 12792
2 12792 procedure radio_medd_opkald;
2 12793 begin
3 12794 integer array field ref,op_ref;
3 12795 integer i;
3 12796
3 12796 procedure skriv_radio_medd_opkald(z,omfang);
3 12797 value omfang;
3 12798 zone z;
3 12799 integer omfang;
3 12800 begin integer x;
4 12801 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 12802 write(z,"sp",26-x);
4 12803 if omfang > 0 then
4 12804 disable begin
5 12805 trap(slut);
5 12806 write(z,"nl",1,
5 12807 <: ref: :>,ref,"nl",1,
5 12808 <: opref: :>,op_ref,"nl",1,
5 12809 <: i: :>,i,"nl",1,
5 12810 <::>);
5 12811 skriv_coru(z,abs curr_coruno);
5 12812 slut:
5 12813 end;<*disable*>
4 12814 end skriv_radio_medd_opkald;
3 12815
3 12815 trap(radio_medd_opkald_trap);
3 12816
3 12816 stack_claim((if cm_test then 200 else 150) +1);
3 12817
3 12817 <*+2*>if testbit32 and overvåget or testbit28 then
3 12818 disable skriv_radio_medd_opkald(out,0);
3 12819 <*-2*>
3 12820 \f
3 12820 message procedure radio_medd_opkald side 2 - 820301/hko;
3 12821
3 12821 repeat
3 12822
3 12822 <*V*> wait(bs_mobil_opkald);
3 12823 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 12824 <*V*> wait(bs_opkaldskø_adgang);
3 12825
3 12825 ref:= første_nød_opkald;
3 12826 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 12827 begin
4 12828 i:= opkaldskø.ref(2);
4 12829 if i < 0 then
4 12830 begin
5 12831 <* nødopkald ikke meldt *>
5 12832
5 12832 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 12833 d.op_ref.data(1):= <* vogn_id *>
5 12834 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 12835 opkaldskø.ref(2):= i extract 22;
5 12836 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 12837 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 12838 i:= op_ref;
5 12839 <*+2*> if testbit35 and overvåget then
5 12840 disable begin
6 12841 write(out,"nl",1,<:radio nød-medd:>);
6 12842 skriv_op(out,op_ref);
6 12843 ud;
6 12844 end;
5 12845 <*-2*>
5 12846 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 12847 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 12848 <*+4*> if i <> op_ref then
5 12849 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 12850 <*-4*>
5 12851 end;<*nødopkald ikke meldt*>
4 12852
4 12852 ref:= opkaldskø.ref(1) extract 12;
4 12853 end; <* melding til io *>
3 12854 \f
3 12854 message procedure radio_medd_opkald side 3 - 820304/hko;
3 12855
3 12855 start_operation(op_ref,403,cs_radio_medd,
3 12856 40<*opdater opkaldskøbill*>);
3 12857 signal_bin(bs_opkaldskø_adgang);
3 12858 <*+2*> if testbit35 and overvåget then
3 12859 disable begin
4 12860 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 12861 skriv_op(out,op_ref);
4 12862 write(out, <:opkaldsflag: :>,"nl",1);
4 12863 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 12864 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 12865 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 12866 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 12867 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 12868 ud;
4 12869 end;
3 12870 <*-2*>
3 12871 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 12872
3 12872 until false;
3 12873
3 12873 radio_medd_opkald_trap:
3 12874
3 12874 disable skriv_radio_medd_opkald(zbillede,1);
3 12875
3 12875 end radio_medd_opkald;
2 12876 \f
2 12876 message procedure radio_adm side 1 - 820301/hko;
2 12877
2 12877 procedure radio_adm(op);
2 12878 value op;
2 12879 integer op;
2 12880 begin
3 12881 integer array field opref, rad_op, iaf;
3 12882 integer nr,i,j,k,res,opgave,tilst,operatør;
3 12883
3 12883 procedure skriv_radio_adm(z,omfang);
3 12884 value omfang;
3 12885 zone z;
3 12886 integer omfang;
3 12887 begin integer i1;
4 12888 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 12889 write(z,"sp",26-i1);
4 12890 if omfang > 0 then
4 12891 disable begin real x;
5 12892 trap(slut);
5 12893 \f
5 12893 message procedure radio_adm side 2- 820301/hko;
5 12894
5 12894 write(z,"nl",1,
5 12895 <: op_ref: :>,op_ref,"nl",1,
5 12896 <: iaf: :>,iaf,"nl",1,
5 12897 <: rad-op: :>,rad_op,"nl",1,
5 12898 <: nr: :>,nr,"nl",1,
5 12899 <: i: :>,i,"nl",1,
5 12900 <: j: :>,j,"nl",1,
5 12901 <: k: :>,k,"nl",1,
5 12902 <: tilst: :>,tilst,"nl",1,
5 12903 <: res: :>,res,"nl",1,
5 12904 <: opgave: :>,opgave,"nl",1,
5 12905 <: operatør: :>,operatør,"nl",1);
5 12906 skriv_coru(z,coru_no(404));
5 12907 slut:
5 12908 end;<*disable*>
4 12909 end skriv_radio_adm;
3 12910 \f
3 12910 message procedure radio_adm side 3 - 820304/hko;
3 12911
3 12911 rad_op:= op;
3 12912
3 12912 trap(radio_adm_trap);
3 12913 stack_claim((if cm_test then 200 else 150) +50);
3 12914
3 12914 <*+2*>if testbit32 and overvåget or testbit28 then
3 12915 skriv_radio_adm(out,0);
3 12916 <*-2*>
3 12917
3 12917 pass;
3 12918 if -,testbit22 then
3 12919 begin
4 12920 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 12921 signalch(cs_radio_ud,rad_op,rad_optype);
4 12922 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 12923 end;
3 12924 repeat
3 12925 waitch(cs_radio_adm,opref,true,-1);
3 12926 <*+2*>
3 12927 if testbit33 and overvåget then
3 12928 disable begin
4 12929 skriv_radio_adm(out,0);
4 12930 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 12931 skriv_op(out,opref);
4 12932 end;
3 12933 <*-2*>
3 12934
3 12934 k:= d.op_ref.opkode extract 12;
3 12935 opgave:= d.opref.opkode shift (-12);
3 12936 nr:=operatør:=d.op_ref.data(1);
3 12937
3 12937 <*+4*> if (d.op_ref.optype and
3 12938 (gen_optype or io_optype or op_optype or vt_optype))
3 12939 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 12940 <:radio_adm:>,0);
3 12941 <*-4*>
3 12942 if k = 74 <* RA,I *> then
3 12943 begin
4 12944 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 12945 signalch(cs_radio_ud,rad_op,rad_optype);
4 12946 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 12947 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 12948 else d.rad_op.resultat;
4 12949 signalch(d.opref.retur,opref,d.opref.optype);
4 12950 \f
4 12950 message procedure radio_adm side 4 - 820301/hko;
4 12951 end
3 12952 else
3 12953
3 12953 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 12954 k = 5<*FO,L*> or k = 6<*ST *> then
3 12955 begin
4 12956 if k = 5 or k=77 then
4 12957 begin
5 12958
5 12958 <*V*> wait(bs_opkaldskø_adgang);
5 12959 if k=5 then
5 12960 begin
6 12961 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 12962 begin
7 12963 i:= læs_fil(1035,iaf//512+1,nr);
7 12964 if i <> 0 then
7 12965 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 12966 tofrom(radio_linietabel.iaf,fil(nr),
7 12967 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 12968 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 12969 end;
6 12970
6 12970 for i:= 1 step 1 until max_antal_mobilopkald do
6 12971 begin
7 12972 iaf:= i*opkaldskø_postlængde;
7 12973 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 12974 if nr>0 then
7 12975 begin
8 12976 læs_tegn(radio_linietabel,nr+1,operatør);
8 12977 if operatør>max_antal_operatører then operatør:= 0;
8 12978 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 12979 operatør;
8 12980 end;
7 12981 end;
6 12982 end
5 12983 else
5 12984 if k=77 then
5 12985 begin
6 12986 disable i:= læsfil(1034,1,nr);
6 12987 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 12988 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 12989 for i:= 1 step 1 until max_antal_mobilopkald do
6 12990 begin
7 12991 iaf:= i*opkaldskø_postlængde;
7 12992 nr:= opkaldskø.iaf(5) extract 4;
7 12993 operatør:= radio_områdetabel(nr);
7 12994 if operatør < 0 or max_antal_operatører < operatør then
7 12995 operatør:= 0;
7 12996 if opkaldskø.iaf(4) extract 8=0 and
7 12997 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 12998 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 12999 operatør;
7 13000 end;
6 13001 end;
5 13002
5 13002 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13003 signal_bin(bs_opkaldskø_adgang);
5 13004
5 13004 signal_bin(bs_mobil_opkald);
5 13005
5 13005 d.op_ref.resultat:= res:= 3;
5 13006 \f
5 13006 message procedure radio_adm side 5 - 820304/hko;
5 13007
5 13007 end <*k = 5 / k = 77*>
4 13008 else
4 13009 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13010 res:= 3;
5 13011 for nr:= 1 step 1 until max_antal_kanaler do
5 13012 begin
6 13013 iaf:= (nr-1)*kanal_beskr_længde;
6 13014 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13015 op_talevej(operatør) then
6 13016 begin
7 13017 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13018 if tilst <> 0 then
7 13019 res:= 16; <*skærm optaget*>
7 13020 end; <* kanal_tab(operatør) = operatør*>
6 13021 end;
5 13022 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13023 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13024 signal_bin(bs_mobil_opkald);
5 13025 d.op_ref.resultat:= res;
5 13026 end;<*k=1,2 eller 6 *>
4 13027
4 13027 <*+2*> if testbit35 and overvåget then
4 13028 disable begin
5 13029 skriv_radio_adm(out,0);
5 13030 write(out,<: sender til :>,
5 13031 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13032 else cs_op);
5 13033 skriv_op(out,op_ref);
5 13034 end;
4 13035 <*-2*>
4 13036
4 13036 if k=5 or k=6 or k=77 or res > 3 then
4 13037 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13038 else
4 13039 begin <*k = (1 eller 2) og res = 3 *>
5 13040 d.op_ref.resultat:=0;
5 13041 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13042 end;
4 13043 \f
4 13043 message procedure radio_adm side 6 - 816610/hko;
4 13044
4 13044 end <*k=1,2,5 eller 6*>
3 13045 else
3 13046 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13047 begin
4 13048 nr:= d.op_ref.data(1);
4 13049 res:= 3;
4 13050
4 13050 if nr<=3 then
4 13051 res:= 51 <* afvist *>
4 13052 else
4 13053 begin
5 13054
5 13054 <* gennemstilling af område *>
5 13055 j:= 1;
5 13056 for i:= 1 step 1 until max_antal_kanaler do
5 13057 begin
6 13058 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13059 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13060 end;
5 13061 nr:= j;
5 13062 iaf:= (nr-1)*kanalbeskrlængde;
5 13063 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13064 begin
6 13065 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13066 d.rad_op.data(1):= 0;
6 13067 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13068 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13069 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13070 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13071 signalch(cs_radio_ud,rad_op,rad_optype);
6 13072 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13073 res:= d.rad_op.resultat;
6 13074 if res=0 then res:= 3;
6 13075 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13076 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13077 end;
5 13078 end;
4 13079 d.op_ref.resultat:=res;
4 13080 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13081 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13082 signal_bin(bs_mobil_opkald);
4 13083 \f
4 13083 message procedure radio_adm side 7 - 880930/cl;
4 13084
4 13084
4 13084 end <* k=3 eller 4 *>
3 13085 else
3 13086 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13087 begin
4 13088 nr:= d.opref.data(1) extract 22;
4 13089 res:= 3;
4 13090 iaf:= (nr-1)*kanalbeskrlængde;
4 13091 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13092 d.rad_op.data(1):= 0;
4 13093 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13094 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13095 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13096 d.rad_op.data(5):= k extract 1;
4 13097 signalch(cs_radio_ud,radop,rad_optype);
4 13098 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13099 res:= d.radop.resultat;
4 13100 if res=0 then res:= 3;
4 13101 j:= if k=72 then 15 else 0;
4 13102 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13103 begin
5 13104 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13105 signalbin(bs_mobilopkald);
5 13106 end;
4 13107 d.opref.resultat:= res;
4 13108 signalch(d.opref.retur,opref,d.opref.optype);
4 13109 end
3 13110 else
3 13111 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13112 begin
4 13113 nr:= d.opref.data(1) extract 8;
4 13114 opgave:= if k=19 then 9 else (k-4);
4 13115 if nr<=3 then
4 13116 res:= 51 <*afvist*>
4 13117 else
4 13118 begin
5 13119 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13120 d.radop.data(1):= 0;
5 13121 d.radop.data(2):= 'L';
5 13122 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13123 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13124 d.radop.data(5):= opgave;
5 13125 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13126 d.radop.data(7):= d.opref.data(2);
5 13127 d.radop.data(8):= d.opref.data(3);
5 13128 signalch(cs_radio_ud,radop,rad_optype);
5 13129 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13130 res:= d.radop.resultat;
5 13131 if res=0 then res:= 3;
5 13132 end;
4 13133 d.opref.resultat:= res;
4 13134 signalch(d.opref.retur,opref,d.opref.optype);
4 13135 end
3 13136 else
3 13137
3 13137 begin
4 13138
4 13138 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13139
4 13139 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13140
4 13140 end;
3 13141
3 13141 until false;
3 13142 radio_adm_trap:
3 13143 disable skriv_radio_adm(zbillede,1);
3 13144 end radio_adm;
2 13145
2 13145 \f
2 13145 message vogntabel erklæringer side 1 - 820301/cl;
2 13146
2 13146 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13147 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13148 cs_vt_log;
2 13149 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13150 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13151 vt_log_slicelgd;
2 13152 integer array bustabel,bustabel1(0:max_antal_busser),
2 13153 linie_løb_tabel(0:max_antal_linie_løb),
2 13154 springtabel(1:max_antal_spring,1:3),
2 13155 gruppetabel(1:max_antal_grupper),
2 13156 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13157 vt_logop(1:2),
2 13158 vt_logdisc(1:4),
2 13159 vt_log_tail(1:10);
2 13160 boolean array busindeks(-1:max_antal_linie_løb),
2 13161 bustilstand(-1:max_antal_busser),
2 13162 linie_løb_indeks(-1:max_antal_busser);
2 13163 real array springtid,springstart(1:max_antal_spring);
2 13164 real vt_logstart;
2 13165 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13166 integer array field v_tekst;
2 13167 real field v_tid;
2 13168
2 13168 zone zvtlog(128,1,stderror);
2 13169
2 13169 \f
2 13169 message vogntabel erklæringer side 2 - 851001/cl;
2 13170
2 13170 procedure skriv_vt_variable(zud);
2 13171 zone zud;
2 13172 begin integer i; long array field laf;
3 13173 laf:= 0;
3 13174 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13175 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13176 <:cs-vt :>,cs_vt,"nl",1,
3 13177 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13178 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13179 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13180 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13181 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13182 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13183 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13184 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13185 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13186 <:vt-op :>,vt_op,"nl",1,
3 13187 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13188 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13189 <:sidste-bus :>,sidste_bus,"nl",1,
3 13190 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13191 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13192 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13193 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13194 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13195 <:tf-springdef :>,tf_springdef,"nl",1,
3 13196 <:vt-logskift :>,vt_logskift,"nl",1,
3 13197 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13198 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13199 <:vt-log-aktiv :>,
3 13200 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13201 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13202 <::>);
3 13203 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13204 laf:= 2;
3 13205 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13206 for i:= 6 step 1 until 10 do
3 13207 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13208 write(zud,"nl",1);
3 13209 end;
2 13210 \f
2 13210 message procedure p_vogntabel side 1 - 820301/cl;
2 13211
2 13211 procedure p_vogntabel(z);
2 13212 zone z;
2 13213 begin
3 13214 integer i,b,s,o,t,li,lb,lø,g;
3 13215 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13216 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13217 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13218 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13219
3 13219 for i:= 1 step 1 until sidste_bus do
3 13220 begin
4 13221 b:= bustabel(i) extract 14;
4 13222 g:= bustabel(i) shift (-14);
4 13223 s:= bustabel1(i) shift (-23);
4 13224 o:= bustabel1(i) extract 8;
4 13225 t:= intg(bustilstand(i));
4 13226 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13227 lø:= li extract 7;
4 13228 lb:= li shift (-7) extract 5;
4 13229 lb:= if lb=0 then 32 else lb+64;
4 13230 li:= li shift (-12) extract 10;
4 13231 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13232 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13233 if g > 0 then string bpl_navn(g) else <: :>,
4 13234 ";",1,true,4,string område_navn(o),
4 13235 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13236 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13237 end;
3 13238 end p_vogntabel;
2 13239 \f
2 13239 message procedure p_gruppetabel side 1 - 810531/cl;
2 13240
2 13240 procedure p_gruppetabel(z);
2 13241 zone z;
2 13242 begin
3 13243 integer i,nr,bogst;
3 13244 boolean spc_gr;
3 13245 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13246 <:max-antal-grupper =:>,max_antal_grupper,
3 13247 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13248 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13249 <:gruppetabel::>);
3 13250 for i:= 1 step 1 until max_antal_grupper do
3 13251 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13252 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13253 gruppetabel(i) extract 7);
3 13254 write(z,"nl",2,<:gruppeopkald::>);
3 13255 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13256 begin
4 13257 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13258 if gruppeopkald(i,1) = 0 then
4 13259 write(z,"sp",11)
4 13260 else
4 13261 begin
5 13262 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13263 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13264 else
5 13265 begin
6 13266 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13267 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13268 if bogst = '@' then bogst:= 'sp';
6 13269 end;
5 13270 if spc_gr then
5 13271 write(z,<:(G:>,<<d>,true,3,nr)
5 13272 else
5 13273 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13274 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13275 end;
4 13276 end;
3 13277 end p_gruppetabel;
2 13278 \f
2 13278 message procedure p_springtabel side 1 - 810519/cl;
2 13279
2 13279 procedure p_springtabel(z);
2 13280 zone z;
2 13281 begin
3 13282 integer li,bo,max,st,nr;
3 13283 long indeks;
3 13284 real t;
3 13285
3 13285 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13286 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13287 <:nr spring-id max status næste-tid:>,"nl",1);
3 13288 for nr:= 1 step 1 until max_antal_spring do
3 13289 begin
4 13290 write(z,<<dd>,nr);
4 13291 <* if springtabel(nr,1)<>0 then *>
4 13292 begin
5 13293 li:= springtabel(nr,1) shift (-5) extract 10;
5 13294 bo:= springtabel(nr,1) extract 5;
5 13295 if bo<>0 then bo:= bo + 'A' - 1;
5 13296 indeks:= extend springtabel(nr,2) shift 24;
5 13297 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13298 max:= springtabel(nr,3) extract 12;
5 13299 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13300 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13301 if springtid(nr)<>0.0 then
5 13302 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13303 else
5 13304 write(z,<< d.d >,0.0);
5 13305 if springstart(nr)<>0.0 then
5 13306 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13307 else
5 13308 write(z,<< d.d >,0.0);
5 13309 end
4 13310 <* else
4 13311 write(z,<: --------:>)*>;
4 13312 write(z,"nl",1);
4 13313 end;
3 13314 end p_springtabel;
2 13315 \f
2 13315 message procedure find_busnr side 1 - 820301/cl;
2 13316
2 13316 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13317 value ll_id;
2 13318 integer ll_id, busnr, garage, tilst;
2 13319 begin
3 13320 integer i,j;
3 13321
3 13321 j:= binærsøg(sidste_linie_løb,
3 13322 (linie_løb_tabel(i) - ll_id), i);
3 13323 if j<>0 then <* linie/løb findes ikke *>
3 13324 begin
4 13325 find_busnr:= -1;
4 13326 busnr:= 0;
4 13327 garage:= 0;
4 13328 tilst:= 0;
4 13329 end
3 13330 else
3 13331 begin
4 13332 busnr:= bustabel(busindeks(i) extract 12);
4 13333 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13334 garage:= busnr shift (-14);
4 13335 busnr:= busnr extract 14;
4 13336 find_busnr:= busindeks(i) extract 12;
4 13337 end;
3 13338 end find_busnr;
2 13339 \f
2 13339 message procedure søg_omr_bus side 1 - 881027/cl;
2 13340
2 13340
2 13340 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13341 value bus;
2 13342 integer bus,ll,gar,omr,sig,tilst;
2 13343 begin
3 13344 integer i,j,nr,bu,bi,bl;
3 13345
3 13345 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13346 nr:= -1;
3 13347 if j=0 then
3 13348 begin
4 13349 bl:= bu:= bi;
4 13350 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13351 while bu<sidste_bus and
4 13352 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13353
4 13353 if bl<>bu then
4 13354 begin
5 13355 <* flere busser med samme tekniske nr. omr skal passe *>
5 13356 nr:= -2;
5 13357 for bi:= bl step 1 until bu do
5 13358 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13359 end
4 13360 else
4 13361 nr:= bi;
4 13362 end;
3 13363
3 13363 if nr<0 then
3 13364 begin
4 13365 <* bus findes ikke *>
4 13366 ll:= gar:= tilst:= sig:= 0;
4 13367 end
3 13368 else
3 13369 begin
4 13370 tilst:= intg(bustilstand(nr));
4 13371 gar:= bustabel(nr) shift (-14);
4 13372 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13373 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13374 sig:= bustabel1(nr) shift (-23);
4 13375 end;
3 13376 søg_omr_bus:= nr;
3 13377 end;
2 13378 \f
2 13378 message procedure find_linie_løb side 1 - 820301/cl;
2 13379
2 13379 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13380 value busnr;
2 13381 integer busnr, linie_løb, garage, tilst;
2 13382 begin
3 13383 integer i,j;
3 13384
3 13384 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13385
3 13385 if j<>0 then <* bus findes ikke *>
3 13386 begin
4 13387 find_linie_løb:= -1;
4 13388 linie_løb:= 0;
4 13389 garage:= 0;
4 13390 tilst:= 0;
4 13391 end
3 13392 else
3 13393 begin
4 13394 tilst:= intg(bustilstand(i));
4 13395 garage:= bustabel(i) shift (-14);
4 13396 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13397 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13398 end;
3 13399 end find_linie_løb;
2 13400 \f
2 13400 message procedure h_vogntabel side 1 - 810413/cl;
2 13401
2 13401 <* hovedmodulcorutine for vogntabelmodul *>
2 13402
2 13402 procedure h_vogntabel;
2 13403 begin
3 13404 integer array field op;
3 13405 integer dest_sem,k;
3 13406
3 13406 procedure skriv_h_vogntabel(zud,omfang);
3 13407 value omfang;
3 13408 zone zud;
3 13409 integer omfang;
3 13410 begin
4 13411 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13412 if omfang<>0 then
4 13413 disable
4 13414 begin
5 13415 skriv_coru(zud,abs curr_coruno);
5 13416 write(zud,"nl",1,<<d>,
5 13417 <:cs-vt :>,cs_vt,"nl",1,
5 13418 <:op :>,op,"nl",1,
5 13419 <:dest-sem :>,dest_sem,"nl",1,
5 13420 <:k :>,k,"nl",1,
5 13421 <::>);
5 13422 end;
4 13423 end;
3 13424 \f
3 13424 message procedure h_vogntabel side 2 - 820301/cl;
3 13425
3 13425 stackclaim(if cm_test then 198 else 146);
3 13426 trap(h_vt_trap);
3 13427
3 13427 <*+2*>
3 13428 <**> disable if testbit47 and overvåget or testbit28 then
3 13429 <**> skriv_h_vogntabel(out,0);
3 13430 <*-2*>
3 13431
3 13431 repeat
3 13432 waitch(cs_vt,op,true,-1);
3 13433 <*+4*>
3 13434 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13435 (d.op.optype and vt_optype) extract 12 = 0 then
3 13436 fejlreaktion(12,op,<:vogntabel:>,0);
3 13437 <*-4*>
3 13438 disable
3 13439 begin
4 13440
4 13440 k:= d.op.opkode extract 12;
4 13441 dest_sem:=
4 13442 if k = 9 then cs_vt_rap else
4 13443 if k = 10 then cs_vt_rap else
4 13444 if k = 11 then cs_vt_opd else
4 13445 if k = 12 then cs_vt_opd else
4 13446 if k = 13 then cs_vt_opd else
4 13447 if k = 14 then cs_vt_tilst else
4 13448 if k = 15 then cs_vt_tilst else
4 13449 if k = 16 then cs_vt_tilst else
4 13450 if k = 17 then cs_vt_tilst else
4 13451 if k = 18 then cs_vt_tilst else
4 13452 if k = 19 then cs_vt_opd else
4 13453 if k = 20 then cs_vt_opd else
4 13454 if k = 21 then cs_vt_auto else
4 13455 if k = 24 then cs_vt_opd else
4 13456 if k = 25 then cs_vt_grp else
4 13457 if k = 26 then cs_vt_grp else
4 13458 if k = 27 then cs_vt_grp else
4 13459 if k = 28 then cs_vt_grp else
4 13460 if k = 30 then cs_vt_spring else
4 13461 if k = 31 then cs_vt_spring else
4 13462 if k = 32 then cs_vt_spring else
4 13463 if k = 33 then cs_vt_spring else
4 13464 if k = 34 then cs_vt_spring else
4 13465 if k = 35 then cs_vt_spring else
4 13466 -1;
4 13467 \f
4 13467 message procedure h_vogntabel side 3 - 810422/cl;
4 13468
4 13468 <*+2*>
4 13469 <**> if testbit41 and overvåget then
4 13470 <**> begin
5 13471 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13472 <**> skriv_op(out,op);
5 13473 <**> end;
4 13474 <*-2*>
4 13475 end;
3 13476
3 13476 if dest_sem = -1 then
3 13477 fejlreaktion(2,k,<:vogntabel:>,0);
3 13478 disable signalch(dest_sem,op,d.op.optype);
3 13479 until false;
3 13480 h_vt_trap:
3 13481 disable skriv_h_vogntabel(zbillede,1);
3 13482 end h_vogntabel;
2 13483 \f
2 13483 message procedure vt_opdater side 1 - 810317/cl;
2 13484
2 13484 procedure vt_opdater(op1);
2 13485 value op1;
2 13486 integer op1;
2 13487 begin
3 13488 integer array field op,radop;
3 13489 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13490 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13491 flin,slin,finx,sinx;
3 13492 integer field bn,ll;
3 13493
3 13493 procedure skriv_vt_opd(zud,omfang);
3 13494 value omfang; integer omfang;
3 13495 zone zud;
3 13496 begin
4 13497 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13498 if omfang <> 0 then
4 13499 disable
4 13500 begin
5 13501 skriv_coru(zud,abs curr_coruno);
5 13502 write(zud,"nl",1,
5 13503 <: op: :>,op,"nl",1,
5 13504 <: radop::>,radop,"nl",1,
5 13505 <: funk: :>,funk,"nl",1,
5 13506 <: res: :>,res,"nl",1,
5 13507 <::>);
5 13508 end;
4 13509 end skriv_vt_opd;
3 13510
3 13510 integer procedure opd_omr(fnk,omr,bus,ll);
3 13511 value fnk,omr,bus,ll;
3 13512 integer fnk,omr,bus,ll;
3 13513 begin
4 13514 opd_omr:= 3;
4 13515 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13516 ændringer skal ikke længere meldes til yderområder *>
4 13517 goto dummy_retur;
4 13518
4 13518 if omr extract 8 > 3 then
4 13519 begin
5 13520 startoperation(radop,501,cs_vt_opd,fnk);
5 13521 d.radop.data(1):= omr;
5 13522 d.radop.data(2):= bus;
5 13523 d.radop.data(3):= ll;
5 13524 signalch(cs_rad,radop,vt_optype);
5 13525 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13526 opd_omr:= d.radop.resultat;
5 13527 end
4 13528 else
4 13529 opd_omr:= 0;
4 13530 dummy_retur:
4 13531 end;
3 13532 message procedure vt_opdater side 1a - 920517/cl;
3 13533
3 13533 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13534 value kilde,kode,bus,ll1,ll2;
3 13535 integer kilde,kode,bus,ll1,ll2;
3 13536 begin
4 13537 integer array field op;
4 13538
4 13538 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13539
4 13539 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13540 systime(1,0.0,d.op.data.v_tid);
4 13541 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13542 d.op.data.v_bus:= bus;
4 13543 d.op.data.v_ll1:= ll1;
4 13544 d.op.data.v_ll2:= ll2;
4 13545 signalch(cs_vt_log,op,vt_optype);
4 13546 end;
3 13547
3 13547 stackclaim((if cm_test then 198 else 146)+125);
3 13548
3 13548 bn:= 4; ll:= 2;
3 13549 radop:= op1;
3 13550 trap(vt_opd_trap);
3 13551
3 13551 <*+2*>
3 13552 <**> disable if testbit47 and overvåget or testbit28 then
3 13553 <**> skriv_vt_opd(out,0);
3 13554 <*-2*>
3 13555 \f
3 13555 message procedure vt_opdater side 2 - 851001/cl;
3 13556
3 13556 vent_op:
3 13557 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13558
3 13558 <*+2*>
3 13559 <**> disable
3 13560 <**> if testbit41 and overvåget then
3 13561 <**> begin
4 13562 <**> skriv_vt_opd(out,0);
4 13563 <**> write(out,<: modtaget operation:>);
4 13564 <**> skriv_op(out,op);
4 13565 <**> end;
3 13566 <*-2*>
3 13567
3 13567 <*+4*>
3 13568 <**>if op<>vt_op then
3 13569 <**>begin
4 13570 <**> disable begin
5 13571 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13572 <**> d.op.resultat:= 31; <*systemfejl*>
5 13573 <**> signalch(d.op.retur,op,d.op.optype);
5 13574 <**> end;
4 13575 <**> goto vent_op;
4 13576 <**>end;
3 13577 <*-4*>
3 13578 disable
3 13579 begin integer opk;
4 13580
4 13580 opk:= d.op.opkode extract 12;
4 13581 funk:= if opk=11 then 1 else
4 13582 if opk=12 then 2 else
4 13583 if opk=13 then 3 else
4 13584 if opk=19 then 4 else
4 13585 if opk=20 then 5 else
4 13586 if opk=24 then 6 else
4 13587 0;
4 13588 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13589 end;
3 13590 res:= 0;
3 13591 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13592 \f
3 13592 message procedure vt_opdater side 3 - 820301/cl;
3 13593
3 13593 indsæt:
3 13594 begin
4 13595 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13596 <*+4*>
4 13597 <**> if d.op.data(1) shift (-22) <> 0 then
4 13598 <**> begin
5 13599 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13600 <**> goto slut_indsæt;
5 13601 <**> end;
4 13602 <*-4*>
4 13603 busnr:= d.op.data(1) extract 14;
4 13604 <*+4*>
4 13605 <**> if d.op.data(2) shift (-22) <> 1 then
4 13606 <**> begin
5 13607 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13608 <**> goto slut_indsæt;
5 13609 <**> end;
4 13610 <*-4*>
4 13611 ll_id:= d.op.data(2);
4 13612 s:= omr:= d.op.data(4) extract 8;
4 13613 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13614 if bi<0 then
4 13615 begin
5 13616 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13617 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13618 end
4 13619 else
4 13620 if s<>0 and s<>omr then
4 13621 res:= 58 <* ulovligt område for bus *>
4 13622 else
4 13623 if intg(bustilstand(bi)) <> 0 then
4 13624 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 13625 else 14 <* optaget *>)
4 13626 else
4 13627 begin
5 13628 if linie_løb_indeks(bi) extract 12 <> 0 then
5 13629 begin <* linie/løb allerede indsat *>
6 13630 res:= 11;
6 13631 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 13632 end
5 13633 else
5 13634 begin
6 13635 \f
6 13635 message procedure vt_opdater side 3a - 900108/cl;
6 13636
6 13636 if d.op.kilde//100 <> 4 then
6 13637 res:= opd_omr(11,gar shift 8 +
6 13638 bustabel1(bi) extract 8,busnr,ll_id);
6 13639 if res>3 then goto slut_indsæt;
6 13640 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 13641 if s=0 then <* linie/løb findes allerede *>
6 13642 begin
7 13643 sig:= busindeks(li) extract 12;
7 13644 d.op.data(3):= bustabel(sig);
7 13645 linie_løb_indeks(sig):= false;
7 13646 disable modiffil(tf_vogntabel,sig,zi);
7 13647 fil(zi).ll:= 0;
7 13648 fil(zi).bn:= bustabel(sig) extract 14 add
7 13649 (bustabel1(sig) extract 8 shift 14);
7 13650 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 13651
7 13651 linie_løb_indeks(bi):= false add li;
7 13652 busindeks(li):= false add bi;
7 13653 disable modiffil(tf_vogntabel,bi,zi);
7 13654 fil(zi).ll:= ll_id;
7 13655 fil(zi).bn:= bustabel(bi) extract 14 add
7 13656 (bustabel1(bi) extract 8 shift 14);
7 13657 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 13658 res:= 3;
7 13659 end
6 13660 else
6 13661 begin
7 13662 \f
7 13662 message procedure vt_opdater side 4 - 810527/cl;
7 13663
7 13663 if s<0 then li:= li +1;
7 13664 if sidste_linie_løb=max_antal_linie_løb then
7 13665 begin
8 13666 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 13667 res:= 31;
8 13668 end
7 13669 else
7 13670 begin
8 13671 for i:= sidste_linie_løb step -1 until li do
8 13672 begin
9 13673 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 13674 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 13675 bus_indeks(i+1):=bus_indeks(i);
9 13676 end;
8 13677 sidste_linie_løb:= sidste_linie_løb +1;
8 13678 linie_løb_tabel(li):= ll_id;
8 13679 linie_løb_indeks(bi):= false add li;
8 13680 busindeks(li):= false add bi;
8 13681 disable s:= modiffil(tf_vogntabel,bi,zi);
8 13682 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 13683 fil(zi).bn:= busnr extract 14 add
8 13684 (bustabel1(bi) extract 8 shift 14);
8 13685 fil(zi).ll:= ll_id;
8 13686 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 13687 res:= 3; <* ok *>
8 13688 end;
7 13689 end;
6 13690 end;
5 13691 end;
4 13692 slut_indsæt:
4 13693 d.op.resultat:= res;
4 13694 end;
3 13695 goto returner;
3 13696 \f
3 13696 message procedure vt_opdater side 5 - 820301/cl;
3 13697
3 13697 udtag:
3 13698 begin
4 13699 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 13700
4 13700 busnr:= ll_id:= 0;
4 13701 omr:= s:= d.op.data(2) extract 8;
4 13702 format:= d.op.data(1) shift (-22);
4 13703 if format=0 then <*busnr*>
4 13704 begin
5 13705 busnr:= d.op.data(1) extract 14;
5 13706 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 13707 if bi<0 then
5 13708 begin
6 13709 if bi=-1 then res:= 10 else
6 13710 if s<>0 then res:= 58 else res:= 57;
6 13711 goto slut_udtag;
6 13712 end;
5 13713 if bi>0 and s<>0 and s<>omr then
5 13714 begin
6 13715 res:= 58; goto slut_udtag;
6 13716 end;
5 13717 li:= linie_løb_indeks(bi) extract 12;
5 13718 busnr:= bustabel(bi);
5 13719 if li=0 or linie_løb_tabel(li)=0 then
5 13720 begin <* bus ej indsat *>
6 13721 res:= 13;
6 13722 goto slut_udtag;
6 13723 end;
5 13724 ll_id:= linie_løb_tabel(li);
5 13725 end
4 13726 else
4 13727 if format=1 then <* linie_løb *>
4 13728 begin
5 13729 ll_id:= d.op.data(1);
5 13730 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 13731 if s<>0 then
5 13732 begin <* linie/løb findes ikke *>
6 13733 res:= 9;
6 13734 goto slut_udtag;
6 13735 end;
5 13736 bi:= busindeks(li) extract 12;
5 13737 busnr:= bustabel(bi);
5 13738 end
4 13739 else <* ulovlig identifikation *>
4 13740 begin
5 13741 res:= 31;
5 13742 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 13743 goto slut_udtag;
5 13744 end;
4 13745 \f
4 13745 message procedure vt_opdater side 6 - 820301/cl;
4 13746
4 13746 tilst:= intg(bustilstand(bi));
4 13747 if tilst<>0 then
4 13748 begin
5 13749 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 13750 goto slut_udtag;
5 13751 end;
4 13752 if d.op.kilde//100 <> 4 then
4 13753 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 13754 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 13755 if res>3 then goto slut_udtag;
4 13756 linie_løb_indeks(bi):= false;
4 13757 for i:= li step 1 until sidste_linie_løb -1 do
4 13758 begin
5 13759 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 13760 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 13761 bus_indeks(i):= bus_indeks(i+1);
5 13762 end;
4 13763 linie_løb_tabel(sidste_linie_løb):= 0;
4 13764 bus_indeks(sidste_linie_løb):= false;
4 13765 sidste_linie_løb:= sidste_linie_løb -1;
4 13766 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 13767 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 13768 fil(zi).ll:= 0;
4 13769 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 13770 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 13771 res:= 3; <* ok *>
4 13772 slut_udtag:
4 13773 d.op.resultat:= res;
4 13774 d.op.data(2):= ll_id;
4 13775 d.op.data(3):= busnr;
4 13776 end;
3 13777 goto returner;
3 13778 \f
3 13778 message procedure vt_opdater side 7 - 851001/cl;
3 13779
3 13779 omkod:
3 13780 flyt:
3 13781 roker:
3 13782 begin
4 13783 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 13784
4 13784 inf1:= inf2:= 0;
4 13785 ll_id1:= d.op.data(1);
4 13786 ll_id2:= d.op.data(2);
4 13787 if ll_id1=ll_id2 then
4 13788 begin
5 13789 res:= 24; inf1:= ll_id2;
5 13790 goto slut_flyt;
5 13791 end;
4 13792 <*+4*>
4 13793 <**> for i:= 1,2 do
4 13794 <**> if d.op.data(i) shift (-22) <> 1 then
4 13795 <**> begin
5 13796 <**> res:= 31;
5 13797 <**> fejlreaktion(10,d.op.data(i),case i of (
5 13798 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 13799 <**> goto slut_flyt;
5 13800 <**> end;
4 13801 <*-4*>
4 13802
4 13802 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 13803 if s<>0 and funk=6 <* roker *> then
4 13804 begin
5 13805 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 13806 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 13807 end;
4 13808 if s<>0 then
4 13809 begin
5 13810 res:= 9; <* ukendt linie/løb *>
5 13811 goto slut_flyt;
5 13812 end;
4 13813 bi1:= busindeks(li1) extract 12;
4 13814 inf1:= bustabel(bi1);
4 13815 tilst:= intg(bustilstand(bi1));
4 13816 if tilst<>0 then <* bus ikke fri *>
4 13817 begin
5 13818 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 13819 goto slut_flyt;
5 13820 end;
4 13821 \f
4 13821 message procedure vt_opdater side 7a- 851001/cl;
4 13822 if d.op.kilde//100 <> 4 then
4 13823
4 13823 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 13824 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 13825 if res>3 then goto slut_flyt;
4 13826
4 13826 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 13827 if s=0 then
4 13828 begin <* ll_id2 er indkodet *>
5 13829 bi2:= busindeks(li2) extract 12;
5 13830 inf2:= bustabel(bi2);
5 13831 tilst:= intg(bustilstand(bi2));
5 13832 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 13833 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 13834 if res>3 then
5 13835 begin
6 13836 inf1:= inf2; inf2:= 0;
6 13837 goto slut_flyt;
6 13838 end;
5 13839
5 13839 if d.op.kilde//100 <> 4 then
5 13840 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 13841 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 13842 if res>3 then goto slut_flyt;
5 13843
5 13843 <* flyt bus *>
5 13844 if funk=6 then
5 13845 linie_løb_indeks(bi2):= false add li1
5 13846 else
5 13847 linie_løb_indeks(bi2):= false;
5 13848 linie_løb_indeks(bi1):= false add li2;
5 13849 if funk=6 then
5 13850 busindeks(li1):= false add bi2
5 13851 else
5 13852 busindeks(li1):= false;
5 13853 busindeks(li2):= false add bi1;
5 13854
5 13854 if funk<>6 then
5 13855 begin
6 13856 <* fjern ll_id1 *>
6 13857 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 13858 begin
7 13859 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 13860 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 13861 busindeks(i):= busindeks(i+1);
7 13862 end;
6 13863 linie_løb_tabel(sidste_linie_løb):= 0;
6 13864 bus_indeks(sidste_linie_løb):= false;
6 13865 sidste_linie_løb:= sidste_linie_løb-1;
6 13866 end;
5 13867
5 13867 <* opdater vogntabelfil *>
5 13868 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 13869 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13870 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 13871 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 13872 if funk=6 then
5 13873 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 13874 else
5 13875 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 13876 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 13877 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13878 fil(zi).ll:= ll_id2;
5 13879 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 13880 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 13881 \f
5 13881 message procedure vt_opdater side 8 - 820301/cl;
5 13882
5 13882 end <* ll_id2 indkodet *>
4 13883 else
4 13884 begin
5 13885 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 13886 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 13887 pm1:= sgn(li2-li1);
5 13888 for i:= li1 step pm1 until li2-pm1 do
5 13889 begin
6 13890 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 13891 busindeks(i):= busindeks(i+pm1);
6 13892 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 13893 end;
5 13894 linie_løb_tabel(li2):= ll_id2;
5 13895 busindeks(li2):= false add bi1;
5 13896 linie_løb_indeks(bi1):= false add li2;
5 13897 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 13898 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13899 fil(zi).ll:= ll_id2;
5 13900 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 13901 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 13902 end;
4 13903 res:= 3; <*udført*>
4 13904 slut_flyt:
4 13905 d.op.resultat:= res;
4 13906 d.op.data(3):= inf1;
4 13907 if funk=5 then d.op.data(4):= inf2;
4 13908 end;
3 13909 goto returner;
3 13910 \f
3 13910 message procedure vt_opdater side 9 - 851001/cl;
3 13911
3 13911 slet:
3 13912 begin
4 13913 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 13914 boolean test24;
4 13915
4 13915 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 13916 omr:= d.op.data(3);
4 13917
4 13917 if d.op.data(1) > d.op.data(2) then
4 13918 begin
5 13919 res:= 44; <* intervalstørrelse ulovlig *>
5 13920 goto slut_slet;
5 13921 end;
4 13922
4 13922 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 13923 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 13924
4 13924 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 13925 if s<0 then finx:= finx+1;
4 13926 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 13927 if s>0 then sinx:= sinx-1;
4 13928
4 13928 for li:= finx step 1 until sinx do
4 13929 begin
5 13930 bi:= busindeks(li) extract 12;
5 13931 gar:= bustabel(bi) shift (-14) extract 8;
5 13932 if intg(bustilstand(bi))=0 and
5 13933 (omr = 0 or (omr > 0 and omr = gar) or
5 13934 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 13935 begin
6 13936 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 13937 linie_løb_indeks(bi):= busindeks(li):= false;
6 13938 linie_løb_tabel(li):= 0;
6 13939 end;
5 13940 end;
4 13941 \f
4 13941 message procedure vt_opdater side 10 - 850820/cl;
4 13942
4 13942 sinx:= finx-1;
4 13943 for li:= finx step 1 until sidste_linie_løb do
4 13944 begin
5 13945 if linie_løb_tabel(li)<>0 then
5 13946 begin
6 13947 sinx:= sinx+1;
6 13948 if sinx<>li then
6 13949 begin
7 13950 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 13951 busindeks(sinx):= busindeks(li);
7 13952 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 13953 linie_løb_tabel(li):= 0;
7 13954 busindeks(li):= false;
7 13955 end;
6 13956 end;
5 13957 end;
4 13958 sidste_linie_løb:= sinx;
4 13959
4 13959 test24:= testbit24; testbit24:= false;
4 13960 for bi:= 1 step 1 until sidste_bus do
4 13961 disable
4 13962 begin
5 13963 s:= modiffil(tf_vogntabel,bi,finx);
5 13964 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 13965 fil(finx).bn:= bustabel(bi) extract 14 add
5 13966 (bustabel1(bi) extract 8 shift 14);
5 13967 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 13968 end;
4 13969 testbit24:= test24;
4 13970 res:= 3;
4 13971
4 13971 slut_slet:
4 13972 d.op.resultat:= res;
4 13973 end;
3 13974 goto returner;
3 13975 \f
3 13975 message procedure vt_opdater side 11 - 810409/cl;
3 13976
3 13976 returner:
3 13977 disable
3 13978 begin
4 13979
4 13979 <*+2*>
4 13980 <**> if testbit40 and overvåget then
4 13981 <**> begin
5 13982 <**> skriv_vt_opd(out,0);
5 13983 <**> write(out,<: vogntabel efter ændring:>);
5 13984 <**> p_vogntabel(out);
5 13985 <**> end;
4 13986 <**> if testbit41 and overvåget then
4 13987 <**> begin
5 13988 <**> skriv_vt_opd(out,0);
5 13989 <**> write(out,<: returner operation:>);
5 13990 <**> skriv_op(out,op);
5 13991 <**> end;
4 13992 <*-2*>
4 13993
4 13993 signalch(d.op.retur,op,d.op.optype);
4 13994 end;
3 13995 goto vent_op;
3 13996
3 13996 vt_opd_trap:
3 13997 disable skriv_vt_opd(zbillede,1);
3 13998
3 13998 end vt_opdater;
2 13999 \f
2 13999 message procedure vt_tilstand side 1 - 810424/cl;
2 14000
2 14000 procedure vt_tilstand(cs_fil,fil_opref);
2 14001 value cs_fil,fil_opref;
2 14002 integer cs_fil,fil_opref;
2 14003 begin
3 14004 integer array field op,filop;
3 14005 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14006 g_type,gr,antal,ej_res,zi,li,filref;
3 14007 integer array identer(1:max_antal_i_gruppe);
3 14008
3 14008 procedure skriv_vt_tilst(zud,omfang);
3 14009 value omfang;
3 14010 zone zud;
3 14011 integer omfang;
3 14012 begin
4 14013 real array field raf;
4 14014 raf:= 0;
4 14015 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14016 if omfang <> 0 then
4 14017 begin
5 14018 skriv_coru(zud,abs curr_coruno);
5 14019 write(zud,"nl",1,<<d>,
5 14020 <:cs-fil :>,cs_fil,"nl",1,
5 14021 <:filop :>,filop,"nl",1,
5 14022 <:op :>,op,"nl",1,
5 14023 <:funk :>,funk,"nl",1,
5 14024 <:format :>,format,"nl",1,
5 14025 <:busid :>,busid,"nl",1,
5 14026 <:res :>,res,"nl",1,
5 14027 <:bi :>,bi,"nl",1,
5 14028 <:tilst :>,tilst,"nl",1,
5 14029 <:opk :>,opk,"nl",1,
5 14030 <:opk-indeks :>,opk_indeks,"nl",1,
5 14031 <:g-type :>,g_type,"nl",1,
5 14032 <:gr :>,gr,"nl",1,
5 14033 <:antal :>,antal,"nl",1,
5 14034 <:ej-res :>,ej_res,"nl",1,
5 14035 <:zi :>,zi,"nl",1,
5 14036 <:li :>,li,"nl",1,
5 14037 <::>);
5 14038 write(zud,"nl",1,<:identer:>);
5 14039 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14040 end;
4 14041 end;
3 14042
3 14042 procedure sorter_gruppe(tab,l,u);
3 14043 value l,u;
3 14044 integer array tab;
3 14045 integer l,u;
3 14046 begin
4 14047 integer array field ii,jj;
4 14048 integer array ww, xx(1:2);
4 14049
4 14049 integer procedure sml(a,b);
4 14050 integer array a,b;
4 14051 begin
5 14052 integer res;
5 14053
5 14053 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14054 if res = 0 then
5 14055 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14056 if res = 0 then
5 14057 res:=
5 14058 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14059 if res = 0 then
5 14060 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14061 sml:= res;
5 14062 end;
4 14063
4 14063 ii:= ((l+u)//2 - 1)*4;
4 14064 tofrom(xx,tab.ii,4);
4 14065 ii:= (l-1)*4; jj:= (u-1)*4;
4 14066 repeat
4 14067 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14068 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14069 if ii <= jj then
4 14070 begin
5 14071 tofrom(ww,tab.ii,4);
5 14072 tofrom(tab.ii,tab.jj,4);
5 14073 tofrom(tab.jj,ww,4);
5 14074 ii:= ii+4;
5 14075 jj:= jj-4;
5 14076 end;
4 14077 until ii>jj;
4 14078 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14079 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14080 end;
3 14081 \f
3 14081 message procedure vt_tilstand side 2 - 820301/cl;
3 14082
3 14082 filop:= filopref;
3 14083 stackclaim(if cm_test then 550 else 500);
3 14084 trap(vt_tilst_trap);
3 14085
3 14085 <*+2*>
3 14086 <**> disable if testbit47 and overvåget or testbit28 then
3 14087 <**> skriv_vt_tilst(out,0);
3 14088 <*-2*>
3 14089
3 14089 vent_op:
3 14090 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14091 <*+2*>disable
3 14092 <**> if (testbit41 and overvåget) or
3 14093 (testbit46 and overvåget and
3 14094 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14095 then
3 14096 <**> begin
4 14097 <**> skriv_vt_tilst(out,0);
4 14098 <**> write(out,<: modtaget operation:>);
4 14099 <**> skriv_op(out,op);
4 14100 <**> end;
3 14101 <*-2*>
3 14102
3 14102 <*+4*>
3 14103 <**> if op <> vt_op then
3 14104 <**> begin
4 14105 <**> disable begin
5 14106 <**> d.op.resultat:= 31;
5 14107 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14108 <**> end;
4 14109 <**> goto returner;
4 14110 <**> end;
3 14111 <*-4*>
3 14112
3 14112 opk:= d.op.opkode extract 12;
3 14113 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14114 if opk = 15 <*bus res *> then 2 else
3 14115 if opk = 16 <*grp res *> then 4 else
3 14116 if opk = 17 <*bus fri *> then 3 else
3 14117 if opk = 18 <*grp fri *> then 5 else
3 14118 0;
3 14119 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14120 res:= 0;
3 14121 format:= d.op.data(1) shift (-22);
3 14122
3 14122 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14123 \f
3 14123 message procedure vt_tilstand side 3 - 820301/cl;
3 14124
3 14124 enkelt_bus:
3 14125 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14126 disable
3 14127 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14128 <*+4*>
4 14129 <**>if format <> 0 and format <> 1 then
4 14130 <**>begin
5 14131 <**> res:= 31;
5 14132 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14133 <**> goto slut_enkelt_bus;
5 14134 <**>end;
4 14135 <*-4*>
4 14136 <* find busnr og tilstand *>
4 14137 case format+1 of
4 14138 begin
5 14139 <* 0: budident *>
5 14140 begin
6 14141 busnr:= d.op.data(1) extract 14;
6 14142 s:= omr:= d.op.data(4) extract 8;
6 14143 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14144 if bi<0 then
6 14145 begin
7 14146 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14147 goto slut_enkelt_bus;
7 14148 end
6 14149 else
6 14150 begin
7 14151 tilst:= intg(bustilstand(bi));
7 14152 end;
6 14153 end;
5 14154
5 14154 <* 1: linie_løb_ident *>
5 14155 begin
6 14156 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14157 if bi < 0 then <* ukendt linie_løb *>
6 14158 begin
7 14159 res:= 9;
7 14160 goto slut_enkelt_bus;
7 14161 end;
6 14162 end;
5 14163 end case;
4 14164 \f
4 14164 message procedure vt_tilstand side 4 - 830310/cl;
4 14165
4 14165 if funk < 3 then
4 14166 begin
5 14167 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14168 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14169 else 0;
5 14170 d.op.data(3):= bustabel(bi);
5 14171 d.op.data(4):= bustabel1(bi);
5 14172 end;
4 14173
4 14173 <* check tilstand *>
4 14174 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14175 res:= 39 <* bus ikke reserveret *>
4 14176 else
4 14177 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14178 res:= 14 <* bus optaget *>
4 14179 else
4 14180 if funk = 1 <* i kø *> and tilst = (-1) then
4 14181 res:= 18 <* i kø *>
4 14182 else
4 14183 res:= 3; <*udført*>
4 14184
4 14184 if res = 3 then
4 14185 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14186
4 14186 slut_enkelt_bus:
4 14187 d.op.resultat:= res;
4 14188 end <*disable*>;
3 14189 goto returner;
3 14190 \f
3 14190 message procedure vt_tilstand side 5 - 810424/cl;
3 14191
3 14191 grp_res: <* reserver gruppe *>
3 14192 disable
3 14193 begin
4 14194
4 14194 <*+4*>
4 14195 <**> if format <> 2 then
4 14196 <**> begin
5 14197 <**> res:= 31;
5 14198 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14199 <**> goto slut_grp_res_1;
5 14200 <**> end;
4 14201 <*-4*>
4 14202
4 14202 <* find frit indeks i opkaldstabel *>
4 14203 opk_indeks:= 0;
4 14204 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14205 begin
5 14206 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14207 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14208 end;
4 14209 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14210 if res <> 0 then goto slut_grp_res_1;
4 14211 g_type:= d.op.data(1) shift (-21) extract 1;
4 14212 if g_type = 1 <*special gruppe*> then
4 14213 begin <*check eksistens*>
5 14214 gr:= 0;
5 14215 for i:= 1 step 1 until max_antal_grupper do
5 14216 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14217 if gr = 0 then <*gruppe ukendt*>
5 14218 begin
6 14219 res:= 8;
6 14220 goto slut_grp_res_1;
6 14221 end;
5 14222 end;
4 14223
4 14223 <* reserver i opkaldstabel *>
4 14224 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14225 \f
4 14225 message procedure vt_tilstand side 6 - 810428/cl;
4 14226
4 14226 <* tilknyt fil *>
4 14227 start_operation(filop,curr_coruid,cs_fil,101);
4 14228 d.filop.data(1):= 0; <*postantal*>
4 14229 d.filop.data(2):= 256; <*postlængde*>
4 14230 d.filop.data(3):= 1; <*segmentantal*>
4 14231 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14232 signalch(cs_opret_fil,filop,vt_optype);
4 14233
4 14233 slut_grp_res_1:
4 14234 if res <> 0 then d.op.resultat:= res;
4 14235 end;
3 14236 if res <> 0 then goto returner;
3 14237
3 14237 waitch(cs_fil,filop,vt_optype,-1);
3 14238
3 14238 <* check filsys-resultat *>
3 14239 if d.filop.data(9) <> 0 then
3 14240 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14241 filref:= d.filop.data(4);
3 14242 \f
3 14242 message procedure vt_tilstand side 7 - 820301/cl;
3 14243 disable if g_type = 0 <*linie-gruppe*> then
3 14244 begin
4 14245 integer s,i,ll_id;
4 14246 integer array field iaf1;
4 14247
4 14247 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14248 iaf1:= 2;
4 14249 s:= binærsøg(sidste_linie_løb,
4 14250 linie_løb_tabel(i) - ll_id, i);
4 14251 if s < 0 then i:= i +1;
4 14252 antal:= ej_res:= 0;
4 14253 skrivfil(filref,1,zi);
4 14254 if i <= sidste_linie_løb then
4 14255 begin
5 14256 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14257 begin
6 14258 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14259 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14260 ej_res:= ej_res+1
6 14261 else
6 14262 begin
7 14263 antal:= antal+1;
7 14264 bi:= busindeks(i) extract 12;
7 14265 fil(zi).iaf1(1):=
7 14266 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14267 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14268 fil(zi).iaf1(2):= bustabel(bi);
7 14269 iaf1:= iaf1+4;
7 14270 bustilstand(bi):= false add opk_indeks;
7 14271 end;
6 14272 i:= i +1;
6 14273 if i > sidste_linie_løb then goto slut_l_grp;
6 14274 end;
5 14275 end;
4 14276 \f
4 14276 message procedure vt_tilstand side 8 - 820301/cl;
4 14277
4 14277 slut_l_grp:
4 14278 end
3 14279 else
3 14280 begin <*special gruppe*>
4 14281 integer i,s,li,omr,gar,tilst;
4 14282 integer array field iaf1;
4 14283
4 14283 iaf1:= 2;
4 14284 antal:= ej_res:= 0;
4 14285 s:= læsfil(tf_gruppedef,gr,zi);
4 14286 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14287 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14288 s:= skrivfil(filref,1,zi);
4 14289 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14290 i:= 1;
4 14291 while identer(i) <> 0 do
4 14292 begin
5 14293 if identer(i) shift (-22) = 0 then
5 14294 begin <*busident*>
6 14295 omr:= 0;
6 14296 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14297 if bi<0 then goto næste_ident;
6 14298 li:= linie_løb_indeks(bi) extract 12;
6 14299 end
5 14300 else
5 14301 begin <*linie/løb ident*>
6 14302 s:= binærsøg(sidste_linie_løb,
6 14303 linie_løb_tabel(li) - identer(i), li);
6 14304 if s <> 0 then goto næste_ident;
6 14305 bi:= busindeks(li) extract 12;
6 14306 end;
5 14307 if (intg(bustilstand(bi))<>0) or
5 14308 (bustabel1(bi) extract 8 <> 3) then
5 14309 ej_res:= ej_res+1
5 14310 else
5 14311 begin
6 14312 antal:= antal +1;
6 14313 fil(zi).iaf1(1):=
6 14314 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14315 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14316 fil(zi).iaf1(2):= bustabel(bi);
6 14317 iaf1:= iaf1+4;
6 14318 bustilstand(bi):= false add opk_indeks;
6 14319 end;
5 14320 næste_ident:
5 14321 i:= i +1;
5 14322 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14323 end;
4 14324 slut_s_grp:
4 14325 end;
3 14326 \f
3 14326 message procedure vt_tilstand side 9 - 820301/cl;
3 14327
3 14327 if antal > 0 then <*ok*>
3 14328 disable begin
4 14329 integer array field spec,akt;
4 14330 integer a;
4 14331 integer field antal_spec;
4 14332
4 14332 antal_spec:= 2; a:= 0;
4 14333 spec:= 2; akt:= 2;
4 14334 sorter_gruppe(fil(zi).spec,1,antal);
4 14335 fil(zi).antal_spec:= 0;
4 14336 while akt//4 < antal do
4 14337 begin
5 14338 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14339 a:= 0;
5 14340 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14341 and a<15 do
5 14342 begin
6 14343 a:= a+1;
6 14344 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14345 akt:= akt+4;
6 14346 end;
5 14347 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14348 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14349 spec:= spec + 2*a + 2;
5 14350 end;
4 14351 antal:= fil(zi).antal_spec;
4 14352 gruppeopkald(opk_indeks,2):= filref;
4 14353 d.op.resultat:= 3;
4 14354 d.op.data(2):= antal;
4 14355 d.op.data(3):= filref;
4 14356 d.op.data(4):= ej_res;
4 14357 end
3 14358 else
3 14359 begin
4 14360 disable begin
5 14361 d.filop.opkode:= 104; <*slet fil*>
5 14362 signalch(cs_slet_fil,filop,vt_optype);
5 14363 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14364 d.op.resultat:= 54;
5 14365 d.op.data(2):= antal;
5 14366 d.op.data(3):= 0;
5 14367 d.op.data(4):= ej_res;
5 14368 end;
4 14369 waitch(cs_fil,filop,vt_optype,-1);
4 14370 if d.filop.data(9) <> 0 then
4 14371 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14372 end;
3 14373 goto returner;
3 14374 \f
3 14374 message procedure vt_tilstand side 10 - 820301/cl;
3 14375
3 14375 grp_fri: <* frigiv gruppe *>
3 14376 disable
3 14377 begin integer i,j,s,ll,gar,omr,tilst;
4 14378 integer array field spec;
4 14379
4 14379 <*+4*>
4 14380 <**> if format <> 2 then
4 14381 <**> begin
5 14382 <**> res:= 31;
5 14383 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14384 <**> goto slut_grp_fri;
5 14385 <**> end;
4 14386 <*-4*>
4 14387
4 14387 <* find indeks i opkaldstabel *>
4 14388 opk_indeks:= 0;
4 14389 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14390 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14391 if opk_indeks = 0 <*ikke fundet*> then
4 14392 begin
5 14393 res:= 40; <*gruppe ej reserveret*>
5 14394 goto slut_grp_fri;
5 14395 end;
4 14396 filref:= gruppeopkald(opk_indeks,2);
4 14397 start_operation(filop,curr_coruid,cs_fil,104);
4 14398 d.filop.data(4):= filref;
4 14399 hentfildim(d.filop.data);
4 14400 læsfil(filref,1,zi);
4 14401 spec:= 0;
4 14402 antal:= fil(zi).spec(1);
4 14403 spec:= spec+2;
4 14404 for i:= 1 step 1 until antal do
4 14405 begin
5 14406 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14407 begin
6 14408 busid:= fil(zi).spec(1+j) extract 14;
6 14409 omr:= 0;
6 14410 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14411 if bi>=0 then bustilstand(bi):= false;
6 14412 end;
5 14413 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14414 end;
4 14415
4 14415 slut_grp_fri:
4 14416 d.op.resultat:= res;
4 14417 end;
3 14418 if res <> 0 then goto returner;
3 14419 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14420 signalch(cs_slet_fil,filop,vt_optype);
3 14421 \f
3 14421 message procedure vt_tilstand side 11 - 810424/cl;
3 14422
3 14422 waitch(cs_fil,filop,vt_optype,-1);
3 14423
3 14423 if d.filop.data(9) <> 0 then
3 14424 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14425 d.op.resultat:= 3;
3 14426
3 14426 returner:
3 14427 disable
3 14428 begin
4 14429 <*+2*>
4 14430 <**> if testbit40 and overvåget then
4 14431 <**> begin
5 14432 <**> skriv_vt_tilst(out,0);
5 14433 <**> write(out,<: vogntabel efter ændring:>);
5 14434 <**> p_vogntabel(out);
5 14435 <**> end;
4 14436 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14437 <**> begin
5 14438 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14439 <**> p_gruppetabel(out);
5 14440 <**> end;
4 14441 <**> if (testbit41 and overvåget) or
4 14442 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14443 <**> begin
5 14444 <**> skriv_vt_tilst(out,0);
5 14445 <**> write(out,<: returner operation:>);
5 14446 <**> skriv_op(out,op);
5 14447 <**> end;
4 14448 <*-2*>
4 14449 signalch(d.op.retur,op,d.op.optype);
4 14450 end;
3 14451 goto vent_op;
3 14452
3 14452 vt_tilst_trap:
3 14453 disable skriv_vt_tilst(zbillede,1);
3 14454
3 14454 end vt_tilstand;
2 14455 \f
2 14455 message procedure vt_rapport side 1 - 810428/cl;
2 14456
2 14456 procedure vt_rapport(cs_fil,fil_opref);
2 14457 value cs_fil,fil_opref;
2 14458 integer cs_fil,fil_opref;
2 14459 begin
3 14460 integer array field op,filop;
3 14461 integer funk,filref,antal,id_ant,res;
3 14462 integer field i1,i2;
3 14463
3 14463 procedure skriv_vt_rap(z,omfang);
3 14464 value omfang;
3 14465 zone z;
3 14466 integer omfang;
3 14467 begin
4 14468 write(z,"nl",1,<:+++ vt_rapport :>);
4 14469 if omfang <> 0 then
4 14470 begin
5 14471 skriv_coru(z,abs curr_coruno);
5 14472 write(z,"nl",1,<<d>,
5 14473 <: cs_fil :>,cs_fil,"nl",1,
5 14474 <: filop :>,filop,"nl",1,
5 14475 <: op :>,op,"nl",1,
5 14476 <: funk :>,funk,"nl",1,
5 14477 <: filref :>,filref,"nl",1,
5 14478 <: antal :>,antal,"nl",1,
5 14479 <: id-ant :>,id_ant,"nl",1,
5 14480 <: res :>,res,"nl",1,
5 14481 <::>);
5 14482
5 14482 end;
4 14483 end skriv_vt_rap;
3 14484
3 14484 stackclaim(if cm_test then 198 else 146);
3 14485 filop:= fil_opref;
3 14486 i1:= 2; i2:= 4;
3 14487 trap(vt_rap_trap);
3 14488
3 14488 <*+2*>
3 14489 <**> disable if testbit47 and overvåget or testbit28 then
3 14490 <**> skriv_vt_rap(out,0);
3 14491 <*-2*>
3 14492 \f
3 14492 message procedure vt_rapport side 2 - 810505/cl;
3 14493
3 14493 vent_op:
3 14494 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14495
3 14495 <*+2*>
3 14496 <**> disable begin
4 14497 <**> if testbit41 and overvåget then
4 14498 <**> begin
5 14499 <**> skriv_vt_rap(out,0);
5 14500 <**> write(out,<: modtaget operation:>);
5 14501 <**> skriv_op(out,op);
5 14502 <**> ud;
5 14503 <**> end;
4 14504 <**> end;<*disable*>
3 14505 <*-2*>
3 14506
3 14506 disable
3 14507 begin
4 14508 integer opk;
4 14509
4 14509 opk:= d.op.opkode extract 12;
4 14510 funk:= if opk = 9 then 1 else
4 14511 if opk =10 then 2 else
4 14512 0;
4 14513 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14514
4 14514 <* opret og tilknyt fil *>
4 14515 start_operation(filop,curr_coruid,cs_fil,101);
4 14516 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14517 d.filop.data(2):= 2; <*postlængde*>
4 14518 d.filop.data(3):=10; <*segmenter*>
4 14519 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14520 signalch(cs_opretfil,filop,vt_optype);
4 14521 end;
3 14522
3 14522 waitch(cs_fil,filop,vt_optype,-1);
3 14523
3 14523 <* check resultat *>
3 14524 if d.filop.data(9) <> 0 then
3 14525 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14526 filref:= d.filop.data(4);
3 14527 antal:= 0;
3 14528 goto case funk of (l_rapport,b_rapport);
3 14529 \f
3 14529 message procedure vt_rapport side 3 - 850820/cl;
3 14530
3 14530 l_rapport:
3 14531 disable
3 14532 begin
4 14533 integer i,j,s,ll,zi;
4 14534 idant:= 0;
4 14535 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14536 <*+4*>
4 14537 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14538 <**> begin
5 14539 <**> res:= 31;
5 14540 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14541 <**> goto l_rap_slut;
5 14542 <**> end;
4 14543 <*-4*>
4 14544 ;
4 14545
4 14545 for i:= 1 step 1 until id_ant do
4 14546 begin
5 14547 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14548 s:= binærsøg(sidste_linie_løb,
5 14549 linie_løb_tabel(j) - ll, j);
5 14550 if s < 0 then j:= j +1;
5 14551
5 14551 if j<= sidste_linie_løb then
5 14552 begin <* skriv identer *>
6 14553 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14554 begin
7 14555 antal:= antal +1;
7 14556 s:= skrivfil(filref,antal,zi);
7 14557 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14558 fil(zi).i1:= linie_løb_tabel(j);
7 14559 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14560 j:= j +1;
7 14561 if j > sidste_bus then goto linie_slut;
7 14562 end;
6 14563 end;
5 14564 linie_slut:
5 14565 end;
4 14566 res:= 3;
4 14567 l_rap_slut:
4 14568 end <*disable*>;
3 14569 goto returner;
3 14570 \f
3 14570 message procedure vt_rapport side 4 - 820301/cl;
3 14571
3 14571 b_rapport:
3 14572 disable
3 14573 begin
4 14574 integer i,j,s,zi,busnr1,busnr2;
4 14575 <*+4*>
4 14576 <**> for i:= 1,2 do
4 14577 <**> if d.op.data(i) shift (-14) <> 0 then
4 14578 <**> begin
5 14579 <**> res:= 31;
5 14580 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14581 <**> goto bus_slut;
5 14582 <**> end;
4 14583 <*-4*>
4 14584
4 14584 busnr1:= d.op.data(1) extract 14;
4 14585 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14586 if busnr1 = 0 or busnr2 < busnr1 then
4 14587 begin
5 14588 res:= 7; <* fejl i busnr *>
5 14589 goto bus_slut;
5 14590 end;
4 14591
4 14591 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14592 - busnr1,j);
4 14593 if s < 0 then j:= j +1;
4 14594 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14595 if j <= sidste_bus then
4 14596 begin <* skriv identer *>
5 14597 while bustabel(j) extract 14 <= busnr2 do
5 14598 begin
6 14599 i:= linie_løb_indeks(j) extract 12;
6 14600 if i<>0 then
6 14601 begin
7 14602 antal:= antal +1;
7 14603 s:= skriv_fil(filref,antal,zi);
7 14604 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14605 fil(zi).i1:= bustabel(j);
7 14606 fil(zi).i2:= linie_løb_tabel(i);
7 14607 end;
6 14608 j:= j +1;
6 14609 if j > sidste_bus then goto bus_slut;
6 14610 end;
5 14611 end;
4 14612 bus_slut:
4 14613 end <*disable*>;
3 14614 res:= 3; <*ok*>
3 14615 \f
3 14615 message procedure vt_rapport side 5 - 810409/cl;
3 14616
3 14616 returner:
3 14617 disable
3 14618 begin
4 14619 d.op.resultat:= res;
4 14620 d.op.data(6):= antal;
4 14621 d.op.data(7):= filref;
4 14622 d.filop.data(1):= antal;
4 14623 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 14624 i:= sæt_fil_dim(d.filop.data);
4 14625 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 14626 <*+2*>
4 14627 <**> if testbit41 and overvåget then
4 14628 <**> begin
5 14629 <**> skriv_vt_rap(out,0);
5 14630 <**> write(out,<: returner operation:>);
5 14631 <**> skriv_op(out,op);
5 14632 <**> end;
4 14633 <*-2*>
4 14634 signalch(d.op.retur,op,d.op.optype);
4 14635 end;
3 14636 goto vent_op;
3 14637
3 14637 vt_rap_trap:
3 14638 disable skriv_vt_rap(zbillede,1);
3 14639
3 14639 end vt_rapport;
2 14640 \f
2 14640 message procedure vt_gruppe side 1 - 810428/cl;
2 14641
2 14641 procedure vt_gruppe(cs_fil,fil_opref);
2 14642
2 14642 value cs_fil,fil_opref;
2 14643 integer cs_fil,fil_opref;
2 14644 begin
3 14645 integer array field op, fil_op, iaf;
3 14646 integer funk, res, filref, gr, i, antal, zi, s;
3 14647 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 14648 max_antal_grupper else max_antal_i_gruppe));
3 14649
3 14649 procedure skriv_vt_gruppe(zud,omfang);
3 14650 value omfang;
3 14651 integer omfang;
3 14652 zone zud;
3 14653 begin
4 14654 integer øg;
4 14655
4 14655 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 14656 if omfang <> 0 then
4 14657 disable
4 14658 begin
5 14659 skriv_coru(zud,abs curr_coruno);
5 14660 write(zud,"nl",1,<<d>,
5 14661 <: cs_fil :>,cs_fil,"nl",1,
5 14662 <: op :>,op,"nl",1,
5 14663 <: filop :>,filop,"nl",1,
5 14664 <: funk :>,funk,"nl",1,
5 14665 <: res :>,res,"nl",1,
5 14666 <: filref :>,filref,"nl",1,
5 14667 <: gr :>,gr,"nl",1,
5 14668 <: i :>,i,"nl",1,
5 14669 <: antal :>,antal,"nl",1,
5 14670 <: zi :>,zi,"nl",1,
5 14671 <: s :>,s,"nl",1,
5 14672 <::>);
5 14673 raf:= 0;
5 14674 system(3,øg,identer);
5 14675 write(zud,"nl",1,<:identer::>);
5 14676 skriv_hele(zud,identer.raf,øg*2,2);
5 14677 end;
4 14678 end;
3 14679
3 14679 stackclaim(if cm_test then 198 else 146);
3 14680 filop:= fil_opref;
3 14681 trap(vt_grp_trap);
3 14682 iaf:= 0;
3 14683 \f
3 14683 message procedure vt_gruppe side 2 - 810409/cl;
3 14684
3 14684 <*+2*>
3 14685 <**> disable if testbit47 and overvåget or testbit28 then
3 14686 <**> skriv_vt_gruppe(out,0);
3 14687 <*-2*>
3 14688
3 14688 vent_op:
3 14689 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 14690 <*+2*>
3 14691 <**>disable
3 14692 <**>begin
4 14693 <**> if testbit41 and overvåget then
4 14694 <**> begin
5 14695 <**> skriv_vt_gruppe(out,0);
5 14696 <**> write(out,<: modtaget operation:>);
5 14697 <**> skriv_op(out,op);
5 14698 <**> ud;
5 14699 <**> end;
4 14700 <**>end;
3 14701 <*-2*>
3 14702
3 14702 disable
3 14703 begin
4 14704 integer opk;
4 14705
4 14705 opk:= d.op.opkode extract 12;
4 14706 funk:= if opk=25 then 1 else
4 14707 if opk=26 then 2 else
4 14708 if opk=27 then 3 else
4 14709 if opk=28 then 4 else
4 14710 0;
4 14711 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14712 end;
3 14713 <*+4*>
3 14714 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 14715 <**> begin
4 14716 <**> disable begin
5 14717 <**> d.op.resultat:= 31;
5 14718 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 14719 <**> end;
4 14720 <**> goto returner;
4 14721 <**> end;
3 14722 <*-4*>
3 14723
3 14723 goto case funk of(definer,slet,vis,oversigt);
3 14724 \f
3 14724 message procedure vt_gruppe side 3 - 810505/cl;
3 14725
3 14725 definer:
3 14726 disable
3 14727 begin
4 14728 gr:= 0; res:= 0;
4 14729 for i:= max_antal_grupper step -1 until 1 do
4 14730 begin
5 14731 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 14732 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 14733 end;
4 14734 if gr=0 then res:= 32; <*ingen plads*>
4 14735 end;
3 14736 if res<>0 then goto slut_definer;
3 14737 disable
3 14738 begin <*fri plads fundet*>
4 14739 antal:= d.op.data(2);
4 14740 if antal <=0 or max_antal_i_gruppe<antal then
4 14741 res:= 33 <*fejl i gruppestørrelse*>
4 14742 else
4 14743 begin
5 14744 for i:= 1 step 1 until antal do
5 14745 begin
6 14746 s:= læsfil(d.op.data(3),i,zi);
6 14747 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 14748 identer(i):= fil(zi).iaf(1);
6 14749 end;
5 14750 s:= modif_fil(tf_gruppedef,gr,zi);
5 14751 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14752 tofrom(fil(zi).iaf,identer,antal*2);
5 14753 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 14754 fil(zi).iaf(i):= 0;
5 14755 gruppetabel(gr):= d.op.data(1);
5 14756 s:= modiffil(tf_gruppeidenter,gr,zi);
5 14757 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14758 fil(zi).iaf(1):= gruppetabel(gr);
5 14759 res:= 3;
5 14760 end;
4 14761 end;
3 14762 slut_definer:
3 14763 <*slet fil*>
3 14764 start_operation(fil_op,curr_coruid,cs_fil,104);
3 14765 d.filop.data(4):= d.op.data(3);
3 14766 signalch(cs_slet_fil,filop,vt_optype);
3 14767 waitch(cs_fil,filop,vt_optype,-1);
3 14768 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 14769 d.op.resultat:= res;
3 14770 goto returner;
3 14771 \f
3 14771 message procedure vt_gruppe side 4 - 810409/cl;
3 14772
3 14772 slet:
3 14773 disable
3 14774 begin
4 14775 gr:= 0; res:= 0;
4 14776 for i:= 1 step 1 until max_antal_grupper do
4 14777 begin
5 14778 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 14779 end;
4 14780 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 14781 else
4 14782 begin
5 14783 for i:= 1 step 1 until max_antal_gruppeopkald do
5 14784 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 14785 if res = 0 then
5 14786 begin
6 14787 gruppetabel(gr):= 0;
6 14788 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 14789 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 14790 fil(zi).iaf(1):= gruppetabel(gr);
6 14791 res:= 3;
6 14792 end;
5 14793 end;
4 14794 d.op.resultat:= res;
4 14795 end;
3 14796 goto returner;
3 14797 \f
3 14797 message procedure vt_gruppe side 5 - 810505/cl;
3 14798
3 14798 vis:
3 14799 disable
3 14800 begin
4 14801 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 14802 for i:= 1 step 1 until max_antal_grupper do
4 14803 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 14804 if gr = 0 then res:= 8
4 14805 else
4 14806 begin
5 14807 s:= læsfil(tf_gruppedef,gr,zi);
5 14808 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 14809 for i:= 1 step 1 until max_antal_i_gruppe do
5 14810 begin
6 14811 identer(i):= fil(zi).iaf(i);
6 14812 if identer(i) <> 0 then antal:= antal +1;
6 14813 end;
5 14814 start_operation(filop,curr_coruid,cs_fil,101);
5 14815 d.filop.data(1):= antal; <*postantal*>
5 14816 d.filop.data(2):= 1; <*postlængde*>
5 14817 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 14818 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 14819 d.filop.data(5):= d.filop.data(6):=
5 14820 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 14821 signalch(cs_opret_fil,filop,vt_optype);
5 14822 end;
4 14823 end;
3 14824 if res <> 0 then goto slut_vis;
3 14825 waitch(cs_fil,filop,vt_optype,-1);
3 14826 disable
3 14827 begin
4 14828 if d.filop.data(9) <> 0 then
4 14829 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 14830 filref:= d.filop.data(4);
4 14831 for i:= 1 step 1 until antal do
4 14832 begin
5 14833 s:= skrivfil(filref,i,zi);
5 14834 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 14835 fil(zi).iaf(1):= identer(i);
5 14836 end;
4 14837 res:= 3;
4 14838 end;
3 14839 slut_vis:
3 14840 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 14841 goto returner;
3 14842 \f
3 14842 message procedure vt_gruppe side 6 - 810508/cl;
3 14843
3 14843 oversigt:
3 14844 disable
3 14845 begin
4 14846 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 14847 for i:= 1 step 1 until max_antal_grupper do
4 14848 begin
5 14849 if gruppetabel(i) <> 0 then
5 14850 begin
6 14851 antal:= antal +1;
6 14852 identer(antal):= gruppetabel(i);
6 14853 end;
5 14854 end;
4 14855 start_operation(filop,curr_coruid,cs_fil,101);
4 14856 d.filop.data(1):= antal; <*postantal*>
4 14857 d.filop.data(2):= 1; <*postlængde*>
4 14858 d.filop.data(3):= if antal = 0 then 1 else
4 14859 (antal-1)//256 +1; <*segm.antal*>
4 14860 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14861 d.filop.data(5):= d.filop.data(6):=
4 14862 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 14863 signalch(cs_opretfil,filop,vt_optype);
4 14864 end;
3 14865 waitch(cs_fil,filop,vt_optype,-1);
3 14866 disable
3 14867 begin
4 14868 if d.filop.data(9) <> 0 then
4 14869 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 14870 filref:= d.filop.data(4);
4 14871 for i:= 1 step 1 until antal do
4 14872 begin
5 14873 s:= skriv_fil(filref,i,zi);
5 14874 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 14875 fil(zi).iaf(1):= identer(i);
5 14876 end;
4 14877 d.op.resultat:= 3; <*ok*>
4 14878 d.op.data(1):= antal;
4 14879 d.op.data(2):= filref;
4 14880 end;
3 14881 \f
3 14881 message procedure vt_gruppe side 7 - 810505/cl;
3 14882
3 14882 returner:
3 14883 disable
3 14884 begin
4 14885 <*+2*>
4 14886 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 14887 <**> begin
5 14888 <**> skriv_vt_gruppe(out,0);
5 14889 <**> write(out,<: gruppetabel efter ændring:>);
5 14890 <**> p_gruppetabel(out);
5 14891 <**> end;
4 14892 <**> if testbit41 and overvåget then
4 14893 <**> begin
5 14894 <**> skriv_vt_gruppe(out,0);
5 14895 <**> write(out,<: returner operation:>);
5 14896 <**> skriv_op(out,op);
5 14897 <**> end;
4 14898 <*-2*>
4 14899 signalch(d.op.retur,op,d.op.optype);
4 14900 end;
3 14901 goto vent_op;
3 14902
3 14902 vt_grp_trap:
3 14903 disable skriv_vt_gruppe(zbillede,1);
3 14904
3 14904 end vt_gruppe;
2 14905 \f
2 14905 message procedure vt_spring side 1 - 810506/cl;
2 14906
2 14906 procedure vt_spring(cs_spring_retur,spr_opref);
2 14907 value cs_spring_retur,spr_opref;
2 14908 integer cs_spring_retur,spr_opref;
2 14909 begin
3 14910 integer array field komm_op,spr_op,iaf;
3 14911 real nu;
3 14912 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 14913
3 14913 procedure skriv_vt_spring(zud,omfang);
3 14914 value omfang;
3 14915 zone zud;
3 14916 integer omfang;
3 14917 begin
4 14918 write(zud,"nl",1,<:+++ vt_spring :>);
4 14919 if omfang <> 0 then
4 14920 begin
5 14921 skriv_coru(zud,abs curr_coruno);
5 14922 write(zud,"nl",1,<<d>,
5 14923 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 14924 <:spr-op :>,spr_op,"nl",1,
5 14925 <:komm-op :>,komm_op,"nl",1,
5 14926 <:funk :>,funk,"nl",1,
5 14927 <:interval :>,interval,"nl",1,
5 14928 <:nr :>,nr,"nl",1,
5 14929 <:i :>,i,"nl",1,
5 14930 <:s :>,s,"nl",1,
5 14931 <:id1 :>,id1,"nl",1,
5 14932 <:id2 :>,id2,"nl",1,
5 14933 <:res :>,res,"nl",1,
5 14934 <:res-inf :>,res_inf,"nl",1,
5 14935 <:medd-kode :>,medd_kode,"nl",1,
5 14936 <:zi :>,zi,"nl",1,
5 14937 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 14938 <::>);
5 14939 end;
4 14940 end;
3 14941 \f
3 14941 message procedure vt_spring side 2 - 810506/cl;
3 14942
3 14942 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 14943 value aktion,id1,id2;
3 14944 integer aktion,id1,id2,res,res_inf;
3 14945 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 14946 integer array field akt_op;
4 14947
4 14947 <* vent på adgang til vogntabel *>
4 14948 waitch(cs_vt_adgang,akt_op,true,-1);
4 14949
4 14949 <* start operation *>
4 14950 disable
4 14951 begin
5 14952 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 14953 d.akt_op.data(1):= id1;
5 14954 d.akt_op.data(2):= id2;
5 14955 signalch(cs_vt_opd,akt_op,vt_optype);
5 14956 end;
4 14957
4 14957 <* afvent svar *>
4 14958 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 14959 res:= d.akt_op.resultat;
4 14960 res_inf:= d.akt_op.data(3);
4 14961 <*+2*>
4 14962 <**> disable
4 14963 <**> if testbit45 and overvåget then
4 14964 <**> begin
5 14965 <**> real t;
5 14966 <**> skriv_vt_spring(out,0);
5 14967 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 14968 <**> skriv_id(out,springtabel(nr,1),0);
5 14969 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 14970 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 14971 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 14972 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 14973 <**> d.akt_op.resultat,"sp",2);
5 14974 <**> skriv_id(out,d.akt_op.data(1),8);
5 14975 <**> skriv_id(out,d.akt_op.data(2),8);
5 14976 <**> skriv_id(out,d.akt_op.data(3),8);
5 14977 <**> systime(4,springtid(nr),t);
5 14978 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 14979 <**> end;
4 14980 <*-2*>
4 14981
4 14981 <* åbn adgang til vogntabel *>
4 14982 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 14983 end vt_operation;
3 14984 \f
3 14984 message procedure vt_spring side 2a - 810506/cl;
3 14985
3 14985 procedure io_meddelelse(medd_no,bus,linie,springno);
3 14986 value medd_no,bus,linie,springno;
3 14987 integer medd_no,bus,linie,springno;
3 14988 begin
4 14989 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 14990 d.spr_op.data(1):= medd_no;
4 14991 d.spr_op.data(2):= bus;
4 14992 d.spr_op.data(3):= linie;
4 14993 d.spr_op.data(4):= springtabel(springno,1);
4 14994 d.spr_op.data(5):= springtabel(springno,2);
4 14995 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 14996 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 14997 end;
3 14998
3 14998 procedure returner_op(op,res);
3 14999 value res;
3 15000 integer array field op;
3 15001 integer res;
3 15002 begin
4 15003 <*+2*>
4 15004 <**> disable
4 15005 <**> if testbit41 and overvåget then
4 15006 <**> begin
5 15007 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15008 <**> skriv_op(out,op);
5 15009 <**> end;
4 15010 <*-2*>
4 15011 d.op.resultat:= res;
4 15012 signalch(d.op.retur,op,d.op.optype);
4 15013 end;
3 15014 \f
3 15014 message procedure vt_spring side 3 - 810603/cl;
3 15015
3 15015 iaf:= 0;
3 15016 spr_op:= spr_opref;
3 15017 stack_claim((if cm_test then 198 else 146) + 24);
3 15018
3 15018 trap(vt_spring_trap);
3 15019
3 15019 for i:= 1 step 1 until max_antal_spring do
3 15020 begin
4 15021 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15022 springtid(i):= springstart(i):= 0.0;
4 15023 end;
3 15024
3 15024 <*+2*>
3 15025 <**> disable
3 15026 <**> if testbit44 and overvåget then
3 15027 <**> begin
4 15028 <**> skriv_vt_spring(out,0);
4 15029 <**> write(out,<: springtabel efter initialisering:>);
4 15030 <**> p_springtabel(out); ud;
4 15031 <**> end;
3 15032 <*-2*>
3 15033
3 15033 <*+2*>
3 15034 <**> disable if testbit47 and overvåget or testbit28 then
3 15035 <**> skriv_vt_spring(out,0);
3 15036 <*-2*>
3 15037 \f
3 15037 message procedure vt_spring side 4 - 810609/cl;
3 15038
3 15038 næste_tid: <* find næste tid *>
3 15039 disable
3 15040 begin
4 15041 interval:= -1; <*vent uendeligt*>
4 15042 systime(1,0.0,nu);
4 15043 for i:= 1 step 1 until max_antal_spring do
4 15044 if springtabel(i,3) < 0 then
4 15045 interval:= 5
4 15046 else
4 15047 if springtid(i) <> 0.0 and
4 15048 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15049 interval:= (if springtid(i) <= nu then 0 else
4 15050 round(springtid(i) -nu));
4 15051 if interval=0 then interval:= 1;
4 15052 end;
3 15053 \f
3 15053 message procedure vt_spring side 4a - 810525/cl;
3 15054
3 15054 <* afvent operation eller timeout *>
3 15055 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15056 if komm_op <> 0 then goto afkod_operation;
3 15057
3 15057 <* timeout *>
3 15058 systime(1,0.0,nu);
3 15059 nr:= 1;
3 15060 næste_sekv:
3 15061 if nr > max_antal_spring then goto næste_tid;
3 15062 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15063 begin
4 15064 nr:= nr +1;
4 15065 goto næste_sekv;
4 15066 end;
3 15067 disable s:= modif_fil(tf_springdef,nr,zi);
3 15068 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15069 if springtabel(nr,3) < 0 then
3 15070 begin <* hængende spring *>
4 15071 if springtid(nr) <= nu then
4 15072 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15073 <* find frit løb *>
5 15074 disable
5 15075 begin
6 15076 id2:= 0;
6 15077 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15078 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15079 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15080 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15081 end;
5 15082 <* send meddelelse til io *>
5 15083 io_meddelelse(5,0,id2,nr);
5 15084
5 15084 <* annuler spring*>
5 15085 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15086 springtid(nr):= springstart(nr):= 0.0;
5 15087 end
4 15088 else
4 15089 begin <* forsøg igen *>
5 15090 \f
5 15090 message procedure vt_spring side 5 - 810525/cl;
5 15091
5 15091 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15092 if i = 2 <* første spring ej udført *> then
5 15093 begin
6 15094 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15095 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15096 id2:= id1;
6 15097 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15098 end
5 15099 else
5 15100 begin
6 15101 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15102 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15103 id2:= id1 shift (-7) shift 7
6 15104 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15105 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15106 end;
5 15107
5 15107 <* check resultat *>
5 15108 medd_kode:= if res = 3 and i = 2 then 7 else
5 15109 if res = 3 and i > 2 then 8 else
5 15110 <* if res = 9 then 1 else
5 15111 if res =12 then 2 else
5 15112 if res =14 then 4 else
5 15113 if res =18 then 3 else *>
5 15114 0;
5 15115 if medd_kode > 0 then
5 15116 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15117 id2 else id1,nr);
5 15118 if res = 3 then
5 15119 begin <* spring udført *>
6 15120 disable s:= modiffil(tf_springdef,nr,zi);
6 15121 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15122 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15123 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15124 if i > 2 then fil(zi).iaf(2+i-2):=
6 15125 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15126 end;
5 15127 end;
4 15128 end <* hængende spring *>
3 15129 else
3 15130 begin
4 15131 i:= spring_tabel(nr,3) shift (-12);
4 15132 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15133 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15134 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15135 + id1 shift (-7) shift 7;
4 15136 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15137 \f
4 15137 message procedure vt_spring side 6 - 820304/cl;
4 15138
4 15138 <* check resultat *>
4 15139 medd_kode:= if res = 3 then 8 else
4 15140 if res = 9 then 1 else
4 15141 if res =12 then 2 else
4 15142 if res =14 then 4 else
4 15143 if res =18 then 3 else
4 15144 if res =60 then 9 else 0;
4 15145 if medd_kode > 0 then
4 15146 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15147
4 15147 <* opdater springtabel *>
4 15148 disable s:= modiffil(tf_springdef,nr,zi);
4 15149 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15150 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15151 begin
5 15152 io_meddelelse(if res=3 then 6 else 5,0,
5 15153 if res=3 then id1 else id2,nr);
5 15154 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15155 springtid(nr):= springstart(nr):= 0.0;
5 15156 end
4 15157 else
4 15158 begin
5 15159 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15160 if res = 3 then
5 15161 begin
6 15162 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15163 (fil(zi).iaf(2+i-1) extract 22);
6 15164 fil(zi).iaf(2+i) := (1 shift 22) add
6 15165 (fil(zi).iaf(2+i) extract 22);
6 15166 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15167 end
5 15168 else
5 15169 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15170 end;
4 15171 end;
3 15172 <*+2*>
3 15173 <**> disable
3 15174 <**> if testbit44 and overvåget then
3 15175 <**> begin
4 15176 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15177 <**> p_springtabel(out); ud;
4 15178 <**> end;
3 15179 <*-2*>
3 15180
3 15180 nr:= nr +1;
3 15181 goto næste_sekv;
3 15182 \f
3 15182 message procedure vt_spring side 7 - 810506/cl;
3 15183
3 15183 afkod_operation:
3 15184 <*+2*>
3 15185 <**> disable
3 15186 <**> if testbit41 and overvåget then
3 15187 <**> begin
4 15188 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15189 <**> skriv_op(out,komm_op);
4 15190 <**> end;
3 15191 <*-2*>
3 15192
3 15192 disable
3 15193 begin integer opk;
4 15194
4 15194 opk:= d.komm_op.opkode extract 12;
4 15195 funk:= if opk = 30 <*sp,d*> then 5 else
4 15196 if opk = 31 <*sp. *> then 1 else
4 15197 if opk = 32 <*sp,v*> then 4 else
4 15198 if opk = 33 <*sp,o*> then 6 else
4 15199 if opk = 34 <*sp,r*> then 2 else
4 15200 if opk = 35 <*sp,a*> then 3 else
4 15201 0;
4 15202 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15203
4 15203 if funk <> 6 <*sp,o*> then
4 15204 begin <* find nr i springtabel *>
5 15205 nr:= 0;
5 15206 for i:= 1 step 1 until max_antal_spring do
5 15207 if springtabel(i,1) = d.komm_op.data(1) and
5 15208 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15209 end;
4 15210 end;
3 15211 if funk = 6 then goto oversigt;
3 15212 if funk = 5 then goto definer;
3 15213
3 15213 if nr = 0 then
3 15214 begin
4 15215 returner_op(komm_op,37<*spring ukendt*>);
4 15216 goto næste_tid;
4 15217 end;
3 15218
3 15218 goto case funk of(start,indsæt,annuler,vis);
3 15219 \f
3 15219 message procedure vt_spring side 8 - 810525/cl;
3 15220
3 15220 start:
3 15221 if springtabel(nr,3) shift (-12) <> 0 then
3 15222 begin returner_op(komm_op,38); goto næste_tid; end;
3 15223 disable
3 15224 begin <* find linie_løb_og_udtag *>
4 15225 s:= modif_fil(tf_springdef,nr,zi);
4 15226 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15227 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15228 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15229 id2:= 0;
4 15230 end;
3 15231 vt_operation(12,id1,id2,res,res_inf);
3 15232
3 15232 disable <* check resultat *>
3 15233 medd_kode:= if res = 3 <*ok*> then 7 else
3 15234 if res = 9 <*linie/løb ukendt*> then 1 else
3 15235 if res =14 <*optaget*> then 4 else
3 15236 if res =18 <*i kø*> then 3 else 0;
3 15237 returner_op(komm_op,3);
3 15238 if medd_kode = 0 then goto næste_tid;
3 15239
3 15239 <* send spring-meddelelse til io *>
3 15240 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15241
3 15241 <* opdater springtabel *>
3 15242 disable
3 15243 begin
4 15244 s:= modif_fil(tf_springdef,nr,zi);
4 15245 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15246 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15247 add (springtabel(nr,3) extract 12);
4 15248 systime(1,0.0,nu);
4 15249 springstart(nr):= nu;
4 15250 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15251 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15252 end;
3 15253 <*+2*>
3 15254 <**> disable
3 15255 <**> if testbit44 and overvåget then
3 15256 <**> begin
4 15257 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15258 <**> p_springtabel(out); ud;
4 15259 <**> end;
3 15260 <*-2*>
3 15261
3 15261 goto næste_tid;
3 15262 \f
3 15262 message procedure vt_spring side 9 - 810506/cl;
3 15263
3 15263 indsæt:
3 15264 if springtabel(nr,3) shift (-12) = 0 then
3 15265 begin <* ikke igangsat *>
4 15266 returner_op(komm_op,41);
4 15267 goto næste_tid;
4 15268 end;
3 15269 <* find frie linie/løb *>
3 15270 disable
3 15271 begin
4 15272 s:= læs_fil(tf_springdef,nr,zi);
4 15273 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15274 id2:= 0;
4 15275 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15276 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15277 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15278 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15279 id1:= d.komm_op.data(3);
4 15280 end;
3 15281
3 15281 if id2<>0 then
3 15282 vt_operation(11,id1,id2,res,res_inf)
3 15283 else
3 15284 res:= 42;
3 15285
3 15285 disable <* check resultat *>
3 15286 medd_kode:= if res = 3 <*ok*> then 8 else
3 15287 if res =10 <*bus ukendt*> then 0 else
3 15288 if res =11 <*bus allerede indsat*> then 0 else
3 15289 if res =12 <*linie/løb allerede besat*> then 2 else
3 15290 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15291 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15292 returner_op(komm_op,res);
3 15293 if medd_kode = 0 then goto næste_tid;
3 15294
3 15294 <* send springmeddelelse til io *>
3 15295 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15296 io_meddelelse(5,0,0,nr);
3 15297 \f
3 15297 message procedure vt_spring side 9a - 810525/cl;
3 15298
3 15298 <* annuler springtabel *>
3 15299 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15300 springtid(nr):= springstart(nr):= 0.0;
3 15301 <*+2*>
3 15302 <**> disable
3 15303 <**> if testbit44 and overvåget then
3 15304 <**> begin
4 15305 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15306 <**> p_springtabel(out); ud;
4 15307 <**> end;
3 15308 <*-2*>
3 15309
3 15309 goto næste_tid;
3 15310 \f
3 15310 message procedure vt_spring side 10 - 810525/cl;
3 15311
3 15311 annuler:
3 15312 disable
3 15313 begin <* find evt. frit linie/løb *>
4 15314 s:= læs_fil(tf_springdef,nr,zi);
4 15315 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15316 id1:= id2:= 0;
4 15317 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15318 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15319 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15320 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15321 returner_op(komm_op,3);
4 15322 end;
3 15323
3 15323 <* send springmeddelelse til io *>
3 15324 io_meddelelse(5,id1,id2,nr);
3 15325
3 15325 <* annuler springtabel *>
3 15326 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15327 springtid(nr):= springstart(nr):= 0.0;
3 15328 <*+2*>
3 15329 <**> disable
3 15330 <**> if testbit44 and overvåget then
3 15331 <**> begin
4 15332 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15333 <**> p_springtabel(out); ud;
4 15334 <**> end;
3 15335 <*-2*>
3 15336
3 15336 goto næste_tid;
3 15337
3 15337 definer:
3 15338 if nr <> 0 then <* allerede defineret *>
3 15339 begin
4 15340 res:= 36;
4 15341 goto slut_definer;
4 15342 end;
3 15343
3 15343 <* find frit nr *>
3 15344 i:= 0;
3 15345 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15346 if springtabel(i,1) = 0 then nr:= i;
3 15347 if nr = 0 then
3 15348 begin
4 15349 res:= 32; <* ingen fri plads *>
4 15350 goto slut_definer;
4 15351 end;
3 15352 \f
3 15352 message procedure vt_spring side 11 - 810525/cl;
3 15353
3 15353 disable
3 15354 begin integer array fdim(1:8),ia(1:32);
4 15355 <* læs sekvens *>
4 15356 fdim(4):= d.komm_op.data(3);
4 15357 s:= hent_fil_dim(fdim);
4 15358 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15359 if fdim(1) > 30 then
4 15360 res:= 35 <* springsekvens for stor *>
4 15361 else
4 15362 begin
5 15363 for i:= 1 step 1 until fdim(1) do
5 15364 begin
6 15365 s:= læs_fil(fdim(4),i,zi);
6 15366 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15367 ia(i):= fil(zi).iaf(1) shift 12;
6 15368 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15369 end;
5 15370 s:= modif_fil(tf_springdef,nr,zi);
5 15371 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15372 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15373 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15374 iaf:= 4;
5 15375 tofrom(fil(zi).iaf,ia,60);
5 15376 iaf:= 0;
5 15377 springtabel(nr,3):= fdim(1);
5 15378 springtid(nr):= springstart(nr):= 0.0;
5 15379 res:= 3;
5 15380 end;
4 15381 end;
3 15382 \f
3 15382 message procedure vt_spring side 11a - 81-525/cl;
3 15383
3 15383 slut_definer:
3 15384
3 15384 <* slet fil *>
3 15385 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15386 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15387 signalch(cs_slet_fil,spr_op,vt_optype);
3 15388 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15389 if d.spr_op.data(9) <> 0 then
3 15390 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15391 returner_op(komm_op,res);
3 15392 <*+2*>
3 15393 <**> disable
3 15394 <**> if testbit44 and overvåget then
3 15395 <**> begin
4 15396 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15397 <**> p_springtabel(out); ud;
4 15398 <**> end;
3 15399 <*-2*>
3 15400 goto næste_tid;
3 15401 \f
3 15401 message procedure vt_spring side 12 - 810525/cl;
3 15402
3 15402 vis:
3 15403 disable
3 15404 begin
4 15405 <* tilknyt fil *>
4 15406 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15407 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15408 d.spr_op.data(2):= 1;
4 15409 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15410 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15411 signalch(cs_opret_fil,spr_op,vt_optype);
4 15412 end;
3 15413
3 15413 <* afvent svar *>
3 15414 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15415 if d.spr_op.data(9) <> 0 then
3 15416 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15417 disable
3 15418 begin integer array ia(1:30);
4 15419 s:= læs_fil(tf_springdef,nr,zi);
4 15420 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15421 iaf:= 4;
4 15422 tofrom(ia,fil(zi).iaf,60);
4 15423 iaf:= 0;
4 15424 for i:= 1 step 1 until d.spr_op.data(1) do
4 15425 begin
5 15426 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15427 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15428 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15429 ia(i) shift (-12) extract 7
5 15430 else -(ia(i) shift (-12) extract 7);
5 15431 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15432 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15433 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15434 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15435 else ia(i) extract 12)
5 15436 else 0;
5 15437 end;
4 15438 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15439 sæt_fil_dim(d.spr_op.data);
4 15440 d.komm_op.data(3):= d.spr_op.data(1);
4 15441 d.komm_op.data(4):= d.spr_op.data(4);
4 15442 raf:= data+8;
4 15443 d.komm_op.raf(1):= springstart(nr);
4 15444 returner_op(komm_op,3);
4 15445 end;
3 15446 goto næste_tid;
3 15447 \f
3 15447 message procedure vt_spring side 13 - 810525/cl;
3 15448
3 15448 oversigt:
3 15449 disable
3 15450 begin
4 15451 <* opret fil *>
4 15452 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15453 d.spr_op.data(1):= max_antal_spring;
4 15454 d.spr_op.data(2):= 4;
4 15455 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15456 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15457 signalch(cs_opret_fil,spr_op,vt_optype);
4 15458 end;
3 15459
3 15459 <* afvent svar *>
3 15460 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15461 if d.spr_op.data(9) <> 0 then
3 15462 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15463 disable
3 15464 begin
4 15465 nr:= 0;
4 15466 for i:= 1 step 1 until max_antal_spring do
4 15467 begin
5 15468 if springtabel(i,1) <> 0 then
5 15469 begin
6 15470 nr:= nr +1;
6 15471 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15472 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15473 fil(zi).iaf(1):= springtabel(i,1);
6 15474 fil(zi).iaf(2):= springtabel(i,2);
6 15475 fil(zi,2):= springstart(i);
6 15476 end;
5 15477 end;
4 15478 d.spr_op.data(1):= nr;
4 15479 s:= sæt_fil_dim(d.spr_op.data);
4 15480 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15481 d.komm_op.data(1):= nr;
4 15482 d.komm_op.data(2):= d.spr_op.data(4);
4 15483 returner_op(komm_op,3);
4 15484 end;
3 15485 goto næste_tid;
3 15486
3 15486 vt_spring_trap:
3 15487 disable skriv_vt_spring(zbillede,1);
3 15488
3 15488 end vt_spring;
2 15489 \f
2 15489 message procedure vt_auto side 1 - 810505/cl;
2 15490
2 15490 procedure vt_auto(cs_auto_retur,auto_opref);
2 15491 value cs_auto_retur,auto_opref;
2 15492 integer cs_auto_retur,auto_opref;
2 15493 begin
3 15494 integer array field op,auto_op,iaf;
3 15495 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15496 res_inf,i,s,zi,kl,døgnstart;
3 15497 real t,nu,næste_tid;
3 15498 boolean optaget;
3 15499 integer array filnavn,nytnavn(1:4);
3 15500
3 15500 procedure skriv_vt_auto(zud,omfang);
3 15501 value omfang;
3 15502 zone zud;
3 15503 integer omfang;
3 15504 begin
4 15505 long array field laf;
4 15506
4 15506 laf:= 0;
4 15507 write(zud,"nl",1,<:+++ vt_auto :>);
4 15508 if omfang<>0 then
4 15509 begin
5 15510 skriv_coru(zud,abs curr_coruno);
5 15511 write(zud,"nl",1,<<d>,
5 15512 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15513 <:op :>,op,"nl",1,
5 15514 <:auto-op :>,auto_op,"nl",1,
5 15515 <:filref :>,filref,"nl",1,
5 15516 <:id1 :>,id1,"nl",1,
5 15517 <:id2 :>,id2,"nl",1,
5 15518 <:aktion :>,aktion,"nl",1,
5 15519 <:postnr :>,postnr,"nl",1,
5 15520 <:sidste-post :>,sidste_post,"nl",1,
5 15521 <:interval :>,interval,"nl",1,
5 15522 <:res :>,res,"nl",1,
5 15523 <:res-inf :>,res_inf,"nl",1,
5 15524 <:i :>,i,"nl",1,
5 15525 <:s :>,s,"nl",1,
5 15526 <:zi :>,zi,"nl",1,
5 15527 <:kl :>,kl,"nl",1,
5 15528 <:døgnstart :>,døgnstart,"nl",1,
5 15529 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15530 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15531 <:nu :>,nu,"nl",1,
5 15532 <:næste-tid :>,næste_tid,"nl",1,
5 15533 <:filnavn :>,filnavn.laf,"nl",1,
5 15534 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15535 <::>);
5 15536 end;
4 15537 end skriv_vt_auto;
3 15538 \f
3 15538 message procedure vt_auto side 2 - 810507/cl;
3 15539
3 15539 iaf:= 0;
3 15540 auto_op:= auto_opref;
3 15541 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15542 optaget:= false;
3 15543 næste_tid:= 0.0;
3 15544 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15545 stack_claim(if cm_test then 298 else 246);
3 15546 trap(vt_auto_trap);
3 15547
3 15547 <*+2*>
3 15548 <**> disable if testbit47 and overvåget or testbit28 then
3 15549 <**> skriv_vt_auto(out,0);
3 15550 <*-2*>
3 15551
3 15551 vent:
3 15552
3 15552 systime(1,0.0,nu);
3 15553 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15554 if næste_tid > nu then round(næste_tid-nu) else
3 15555 if optaget then 5 else 0;
3 15556 if interval=0 then interval:= 1;
3 15557
3 15557 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15558
3 15558 if op<>0 then goto filskift;
3 15559
3 15559 <* vent på adgang til vogntabel *>
3 15560 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15561
3 15561 <* afsend relevant operation til opdatering af vogntabel *>
3 15562 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15563 d.op.data(1):= id1;
3 15564 d.op.data(2):= id2;
3 15565 signalch(cs_vt_opd,op,vt_optype);
3 15566 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15567 res:= d.op.resultat;
3 15568 id2:= d.op.data(2);
3 15569 res_inf:= d.op.data(3);
3 15570
3 15570 <* åbn for vogntabel *>
3 15571 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15572 \f
3 15572 message procedure vt_auto side 3 - 810507/cl;
3 15573
3 15573 <* behandl svar fra opdatering *>
3 15574 <*+2*>
3 15575 <**> disable
3 15576 <**> if testbit45 and overvåget then
3 15577 <**> begin
4 15578 <**> integer li,lø,bo;
4 15579 <**> skriv_vt_auto(out,0);
4 15580 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15581 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15582 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15583 <**> for i:= 1,2 do
4 15584 <**> begin
5 15585 <**> li:= d.op.data(i);
5 15586 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15587 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15588 <**> li:= li shift (-12) extract 10;
5 15589 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15590 <**> end;
4 15591 <**> systime(4,næste_tid,t);
4 15592 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15593 <**> << zd.dd>,t/10000,"nl",1);
4 15594 <**> end;
3 15595 <*-2*>
3 15596 if res=31 then
3 15597 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15598 else
3 15599 if res<>3 then
3 15600 begin
4 15601 if -, optaget then
4 15602 begin
5 15603 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15604 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15605 if res=18 then 3 else if res=60 then 9 else 4;
5 15606 d.auto_op.data(2):= res_inf;
5 15607 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15608 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15609 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15610 end;
4 15611 if res=14 or res=18 then <* i kø eller optaget *>
4 15612 begin
5 15613 optaget:= true;
5 15614 goto vent;
5 15615 end;
4 15616 end;
3 15617 optaget:= false;
3 15618 \f
3 15618 message procedure vt_auto side 4 - 810507/cl;
3 15619
3 15619 <* find næste post *>
3 15620 disable
3 15621 begin
4 15622 if postnr=sidste_post then
4 15623 begin <* døgnskift *>
5 15624 postnr:= 1;
5 15625 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15626 end
4 15627 else postnr:= postnr+1;
4 15628 s:= læsfil(filref,postnr,zi);
4 15629 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 15630 aktion:= fil(zi).iaf(1);
4 15631 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 15632 id1:= fil(zi).iaf(3);
4 15633 id2:= fil(zi).iaf(4);
4 15634 end;
3 15635 goto vent;
3 15636 \f
3 15636 message procedure vt_auto side 5 - 810507/cl;
3 15637
3 15637 filskift:
3 15638
3 15638 <*+2*>
3 15639 <**> disable
3 15640 <**> if testbit41 and overvåget then
3 15641 <**> begin
4 15642 <**> skriv_vt_auto(out,0);
4 15643 <**> write(out,<: modtaget operation::>);
4 15644 <**> skriv_op(out,op);
4 15645 <**> end;
3 15646 <*-2*>
3 15647 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 15648 res:= 46;
3 15649 if d.op.opkode extract 12 <> 21 then
3 15650 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 15651 if filref = 0 then goto knyt;
3 15652
3 15652 <* gem filnavn til io-meddelelse *>
3 15653 disable begin
4 15654 integer array fdim(1:8);
4 15655 integer array field navn;
4 15656 fdim(4):= filref;
4 15657 hentfildim(fdim);
4 15658 navn:= 8;
4 15659 tofrom(filnavn,fdim.navn,8);
4 15660 end;
3 15661
3 15661 <* frivgiv tilknyttet autofil *>
3 15662 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 15663 d.auto_op.data(4):= filref;
3 15664 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 15665 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 15666 if d.auto_op.data(9) <> 0 then
3 15667 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 15668 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 15669 optaget:= false;
3 15670 næste_tid:= 0.0;
3 15671 res:= 3;
3 15672 \f
3 15672 message procedure vt_auto side 6 - 810507/cl;
3 15673
3 15673 <* tilknyt evt. ny autofil *>
3 15674 knyt:
3 15675 if d.op.data(1)<>0 then
3 15676 begin
4 15677 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 15678 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 15679 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 15680 disable
4 15681 begin integer pos1,pos2;
5 15682 pos1:= pos2:= 13;
5 15683 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 15684 begin
6 15685 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 15686 skrivtegn(d.auto_op.data,pos2,i);
6 15687 end;
5 15688 end;
4 15689 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 15690 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 15691 s:= d.auto_op.data(9);
4 15692 if s=0 then res:= 3 <* ok *> else
4 15693 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 15694 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 15695 if s=6 then res:= 48 <* i brug *> else
4 15696 fejlreaktion(14,2,<:auto,filskift:>,0);
4 15697 if res<>3 then goto returner;
4 15698
4 15698 tofrom(nytnavn,d.op.data,8);
4 15699
4 15699 <* find første post *>
4 15700 disable
4 15701 begin
5 15702 døgnstart:= systime(5,0.0,t);
5 15703 kl:= round t;
5 15704 filref:= d.auto_op.data(4);
5 15705 sidste_post:= d.auto_op.data(1);
5 15706 postnr:= 0;
5 15707 for postnr:= postnr+1 while postnr <= sidste_post do
5 15708 begin
6 15709 s:= læsfil(filref,postnr,zi);
6 15710 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 15711 if fil(zi).iaf(2) > kl then goto post_fundet;
6 15712 end;
5 15713 postnr:= 1;
5 15714 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15715 \f
5 15715 message procedure vt_auto side 7 - 810507/cl;
5 15716
5 15716 post_fundet:
5 15717 s:= læsfil(filref,postnr,zi);
5 15718 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 15719 aktion:= fil(zi).iaf(1);
5 15720 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 15721 id1:= fil(zi).iaf(3);
5 15722 id2:= fil(zi).iaf(4);
5 15723 res:= 3;
5 15724 end;
4 15725 end ny fil;
3 15726
3 15726 returner:
3 15727 d.op.resultat:= res;
3 15728 <*+2*>
3 15729 <**> disable
3 15730 <**> if testbit41 and overvåget then
3 15731 <**> begin
4 15732 <**> skriv_vt_auto(out,0);
4 15733 <**> write(out,<: returner operation::>);
4 15734 <**> skriv_op(out,op);
4 15735 <**> end;
3 15736 <*-2*>
3 15737 signalch(d.op.retur,op,d.op.optype);
3 15738
3 15738 if vt_log_aktiv then
3 15739 begin
4 15740 waitch(cs_vt_logpool,op,vt_optype,-1);
4 15741 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 15742 if nytnavn(1)=0 then
4 15743 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 15744 else
4 15745 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 15746 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 15747 systime(1,0.0,d.op.data.v_tid);
4 15748 signalch(cs_vt_log,op,vt_optype);
4 15749 end;
3 15750
3 15750 if filnavn(1)<>0 then
3 15751 begin <* meddelelse til io om annulering *>
4 15752 disable begin
5 15753 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 15754 i:= 1;
5 15755 hægtstring(d.auto_op.data,i,<:auto :>);
5 15756 skriv_text(d.auto_op.data,i,filnavn);
5 15757 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 15758 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 15759 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15760 end;
4 15761 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 15762 end;
3 15763 goto vent;
3 15764
3 15764 vt_auto_trap:
3 15765 disable skriv_vt_auto(zbillede,1);
3 15766
3 15766 end vt_auto;
2 15767 message procedure vt_log side 1 - 920517/cl;
2 15768
2 15768 procedure vt_log;
2 15769 begin
3 15770 integer i,j,ventetid;
3 15771 real dg,t,nu,skiftetid;
3 15772 boolean fil_åben;
3 15773 integer array ia(1:10),dp,dp1(1:8);
3 15774 integer array field op, iaf;
3 15775
3 15775 procedure skriv_vt_log(zud,omfang);
3 15776 value omfang;
3 15777 zone zud;
3 15778 integer omfang;
3 15779 begin
4 15780 write(zud,"nl",1,<:+++ vt-log :>);
4 15781 if omfang<>0 then
4 15782 begin
5 15783 skriv_coru(zud, abs curr_coruno);
5 15784 write(zud,"nl",1,<<d>,
5 15785 <:i :>,i,"nl",1,
5 15786 <:j :>,j,"nl",1,
5 15787 <:ventetid :>,ventetid,"nl",1,
5 15788 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 15789 <:t :>,t,"nl",1,
5 15790 <:nu :>,nu,"nl",1,
5 15791 <:skiftetid :>,skiftetid,"nl",1,
5 15792 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 15793 <:op :>,<<d>,op,"nl",1,
5 15794 <::>);
5 15795 raf:= 0;
5 15796 write(zud,"nl",1,<:ia::>);
5 15797 skrivhele(zud,ia.raf,20,2);
5 15798 write(zud,"nl",2,<:dp::>);
5 15799 skrivhele(zud,dp.raf,16,2);
5 15800 write(zud,"nl",2,<:dp1::>);
5 15801 skrivhele(zud,dp1.raf,16,2);
5 15802 end;
4 15803 end;
3 15804
3 15804 message procedure vt_log side 2 - 920517/cl;
3 15805
3 15805 procedure slet_fil;
3 15806 begin
4 15807 integer segm,res;
4 15808 integer array tail(1:10);
4 15809
4 15809 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 15810 if res=0 then
4 15811 begin
5 15812 segm:= tail(10);
5 15813 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 15814 if res=0 then
5 15815 begin
6 15816 close(zvtlog,true);
6 15817 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 15818 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 15819 if res=0 then
6 15820 begin
7 15821 tail(1):= tail(1)+segm;
7 15822 monitor(44)change_entry:(zvtlog,0,tail);
7 15823 end;
6 15824 end;
5 15825 end;
4 15826 end;
3 15827
3 15827 boolean procedure udvid_fil;
3 15828 begin
4 15829 integer res,spos;
4 15830 integer array tail(1:10);
4 15831 zone z(1,1,stderror);
4 15832
4 15832 udvid_fil:= false;
4 15833 open(z,0,<:vtlogpool:>,0); close(z,true);
4 15834 res:= monitor(42)lookup_entry:(z,0,tail);
4 15835 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 15836 begin
5 15837 tail(1):=tail(1) - vt_log_slicelgd;
5 15838 res:=monitor(44)change_entry:(z,0,tail);
5 15839 if res=0 then
5 15840 begin
6 15841 spos:= vt_logtail(1);
6 15842 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 15843 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 15844 if res<>0 then
6 15845 begin
7 15846 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 15847 tail(1):= tail(1) + vt_log_slicelgd;
7 15848 monitor(44)change_entry:(z,0,tail);
7 15849 end
6 15850 else
6 15851 begin
7 15852 setposition(zvtlog,0,spos);
7 15853 udvid_fil:= true;
7 15854 end;
6 15855 end;
5 15856 end;
4 15857 end;
3 15858
3 15858 message procedure vt_log side 3 - 920517/cl;
3 15859
3 15859 boolean procedure ny_fil;
3 15860 begin
4 15861 integer res,i,j;
4 15862 integer array nyt(1:4), ia,tail(1:10);
4 15863 long array field navn;
4 15864 real t;
4 15865
4 15865 navn:=0;
4 15866 if fil_åben then
4 15867 begin
5 15868 close(zvtlog,true);
5 15869 fil_åben:= false;
5 15870 nyt.navn(1):= long<:vtlo:>;
5 15871 nyt.navn(2):= long<::>;
5 15872 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 15873 j:= 'a' - 1;
5 15874 repeat
5 15875 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 15876 if res=3 then
5 15877 begin
6 15878 j:= j+1;
6 15879 if j <= 'å' then skrivtegn(nyt,11,j);
6 15880 end;
5 15881 until (res<>3) or (j > 'å');
5 15882
5 15882 if res=0 then
5 15883 begin
6 15884 open(zvtlog,4,<:vtlogklar:>,0);
6 15885 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 15886 if res=0 then
6 15887 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 15888 if res=0 then
6 15889 begin
7 15890 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 15891 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 15892 end;
6 15893
6 15893 if res=0 then
6 15894 begin
7 15895 setposition(zvtlog,0,tail(10)//64);
7 15896 navn:= (tail(10) mod 64)*8;
7 15897 if (tail(1) <= tail(10)//64) then
7 15898 outrec6(zvtlog,512)
7 15899 else
7 15900 swoprec6(zvtlog,512);
7 15901 tofrom(zvtlog.navn,nyt,8);
7 15902 tail(10):= tail(10)+1;
7 15903 setposition(zvtlog,0,tail(10)//64);
7 15904 monitor(44)change_entry:(zvtlog,0,tail);
7 15905 close(zvtlog,true);
7 15906 end
6 15907 else
6 15908 begin
7 15909 navn:= 0;
7 15910 close(zvtlog,true);
7 15911 open(zvtlog,4,<:vtlog:>,0);
7 15912 slet_fil;
7 15913 end;
6 15914 end
5 15915 else
5 15916 slet_fil;
5 15917 end;
4 15918
4 15918 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 15919 <* eller den er blevet slettet. *>
4 15920
4 15920 open(zvtlog,4,<:vtlog:>,0);
4 15921 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 15922 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 15923 vt_logtail(6):= systime(7,0,t);
4 15924
4 15924 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 15925 if res=0 then
4 15926 begin
5 15927 monitor(50)permanent_entry:(zvtlog,3,ia);
5 15928 if res<>0 then
5 15929 monitor(48)remove_entry:(zvtlog,0,ia);
5 15930 end;
4 15931
4 15931 if res=0 then fil_åben:= true;
4 15932
4 15932 ny_fil:= fil_åben;
4 15933 end ny_fil;
3 15934
3 15934 message procedure vt_log side 4 - 920517/cl;
3 15935
3 15935 procedure skriv_post(logpost);
3 15936 integer array logpost;
3 15937 begin
4 15938 integer array field post;
4 15939 real t;
4 15940
4 15940 if vt_logtail(10)//32 < vt_logtail(1) then
4 15941 begin
5 15942 outrec6(zvtlog,512);
5 15943 post:= (vt_logtail(10) mod 32)*16;
5 15944 tofrom(zvtlog.post,logpost,16);
5 15945 vt_logtail(10):= vt_logtail(10)+1;
5 15946 setposition(zvtlog,0,vt_logtail(10)//32);
5 15947 vt_logtail(6):= systime(7,0,t);
5 15948 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 15949 end;
4 15950 end;
3 15951
3 15951 procedure sletsendte;
3 15952 begin
4 15953 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 15954 integer array pooltail,tail,ia(1:10);
4 15955 integer i,res;
4 15956
4 15956 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 15957 res:=monitor(42,zpool,0,pooltail);
4 15958
4 15958 open(z,4,<:vtlogslet:>,0);
4 15959 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 15960 begin
5 15961 if monitor(52,z,0,tail)=0 then
5 15962 begin
6 15963 if monitor(8,z,0,tail)=0 then
6 15964 begin
7 15965 for i:=1 step 1 until tail(10) do
7 15966 begin
8 15967 inrec6(z,8);
8 15968 open(zlog,0,z,0); close(zlog,true);
8 15969 if monitor(42,zlog,0,ia)=0 then
8 15970 begin
9 15971 if monitor(48,zlog,0,ia)=0 then
9 15972 begin
10 15973 pooltail(1):=pooltail(1)+ia(1);
10 15974 end;
9 15975 end;
8 15976 end;
7 15977 tail(10):=0;
7 15978 monitor(44,z,0,tail);
7 15979 end
6 15980 else
6 15981 monitor(64,z,0,tail);
6 15982 end;
5 15983 if res=0 then monitor(44,zpool,0,pooltail);
5 15984 end;
4 15985 close(z,true);
4 15986 end;
3 15987
3 15987 message procedure vt_log side 5 - 920517/cl;
3 15988
3 15988 trap(vt_log_trap);
3 15989 stack_claim(200);
3 15990
3 15990 fil_åben:= false;
3 15991 if -, vt_log_aktiv then goto init_slut;
3 15992 open(zvtlog,4,<:vtlog:>,0);
3 15993 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 15994 if i=0 then
3 15995 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 15996 if i=0 then
3 15997 begin
4 15998 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 15999 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16000 end;
3 16001
3 16001 if (i=0) and (vt_logtail(1)=0) then
3 16002 begin
4 16003 close(zvtlog,true);
4 16004 monitor(48)remove_entry:(zvtlog,0,ia);
4 16005 i:= 1;
4 16006 end;
3 16007
3 16007 disable
3 16008 if i=0 then
3 16009 begin
4 16010 fil_åben:= true;
4 16011 inrec6(zvtlog,512);
4 16012 vt_logstart:= zvtlog.v_tid;
4 16013 systime(1,0.0,nu);
4 16014 if (nu - vt_logstart) < 24*60*60.0 then
4 16015 begin
5 16016 setposition(zvtlog,0,vt_logtail(10)//32);
5 16017 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16018 begin
6 16019 inrec6(zvtlog,512);
6 16020 setposition(zvtlog,0,vt_logtail(10)//32);
6 16021 end;
5 16022 end
4 16023 else
4 16024 begin
5 16025 if ny_fil then
5 16026 begin
6 16027 if udvid_fil then
6 16028 begin
7 16029 systime(1,0.0,dp.v_tid);
7 16030 vt_logstart:= dp.v_tid;
7 16031 dp.v_kode:=0;
7 16032 skriv_post(dp);
7 16033 end
6 16034 else
6 16035 begin
7 16036 close(zvtlog,true);
7 16037 monitor(48)remove_entry:(zvtlog,0,ia);
7 16038 fil_åben:= false;
7 16039 end;
6 16040 end;
5 16041 end;
4 16042 end
3 16043 else
3 16044 begin
4 16045 close(zvtlog,true);
4 16046 if ny_fil then
4 16047 begin
5 16048 if udvid_fil then
5 16049 begin
6 16050 systime(1,0.0,dp.v_tid);
6 16051 vt_logstart:= dp.v_tid;
6 16052 dp.v_kode:=0;
6 16053 skriv_post(dp);
6 16054 end
5 16055 else
5 16056 begin
6 16057 close(zvtlog,true);
6 16058 monitor(48)remove_entry:(zvtlog,0,ia);
6 16059 fil_åben:= false;
6 16060 end;
5 16061 end;
4 16062 end;
3 16063
3 16063 init_slut:
3 16064
3 16064 dg:= systime(5,0,t);
3 16065 if t < vt_logskift then
3 16066 skiftetid:= systid(dg,vt_logskift)
3 16067 else
3 16068 skiftetid:= systid(dg+1,vt_logskift);
3 16069
3 16069 message procedure vt_log side 6 - 920517/cl;
3 16070
3 16070 vent:
3 16071
3 16071 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16072 ventetid:= round(skiftetid - nu);
3 16073 if ventetid < 1 then ventetid:= 1;
3 16074
3 16074 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16075
3 16075 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16076 if op <> 0 then
3 16077 begin
4 16078 tofrom(dp,d.op.data,16);
4 16079 signalch(cs_vt_logpool,op,vt_optype);
4 16080 end;
3 16081
3 16081 if -, vt_log_aktiv then goto vent;
3 16082
3 16082 disable if (op=0) or (nu > skiftetid) then
3 16083 begin
4 16084 if fil_åben then
4 16085 begin
5 16086 dp1.v_tid:= systid(dg,vt_logskift);
5 16087 dp1.v_kode:= 1;
5 16088 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16089 begin
6 16090 if udvid_fil then
6 16091 skriv_post(dp1);
6 16092 end
5 16093 else
5 16094 skriv_post(dp1);
5 16095 end;
4 16096
4 16096 if (op=0) or (nu > skiftetid) then
4 16097 skiftetid:= skiftetid + 24*60*60.0;
4 16098
4 16098 sletsendte;
4 16099
4 16099 if ny_fil then
4 16100 begin
5 16101 if udvid_fil then
5 16102 begin
6 16103 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16104 dp1.v_kode:= 0;
6 16105 skriv_post(dp1);
6 16106 end
5 16107 else
5 16108 begin
6 16109 close(zvtlog,true);
6 16110 monitor(48)remove_entry:(zvtlog,0,ia);
6 16111 fil_åben:= false;
6 16112 end;
5 16113 end;
4 16114 end;
3 16115
3 16115 disable if op<>0 and fil_åben then
3 16116 begin
4 16117 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16118 begin
5 16119 if -, udvid_fil then
5 16120 begin
6 16121 if ny_fil then
6 16122 begin
7 16123 if udvid_fil then
7 16124 begin
8 16125 systime(1,0.0,dp1.v_tid);
8 16126 vt_logstart:= dp1.v_tid;
8 16127 dp1.v_kode:= 0;
8 16128 skriv_post(dp1);
8 16129 end
7 16130 else
7 16131 begin
8 16132 close(zvtlog,true);
8 16133 monitor(48)remove_entry:(zvtlog,0,ia);
8 16134 fil_åben:= false;
8 16135 end;
7 16136 end;
6 16137 end;
5 16138 end;
4 16139
4 16139 if fil_åben then skriv_post(dp);
4 16140 end;
3 16141
3 16141 goto vent;
3 16142
3 16142 vt_log_trap:
3 16143 disable skriv_vt_log(zbillede,1);
3 16144 end vt_log;
2 16145 \f
2 16145
2 16145 algol list.off;
2 16146 message coroutinemonitor - 11 ;
2 16147
2 16147
2 16147 <*************** coroutine monitor procedures ***************>
2 16148
2 16148
2 16148 <***** delay *****
2 16149
2 16149 this procedure links the calling coroutine into the timerqueue and sets
2 16150 the timeout value to 'timeout'. *>
2 16151
2 16151
2 16151 procedure delay (timeout);
2 16152 value timeout;
2 16153 integer timeout;
2 16154 begin
3 16155 link(current, idlequeue);
3 16156 link(current + corutimerchain, timerqueue);
3 16157 d.current.corutimer:= timeout;
3 16158
3 16158
3 16158 passivate;
3 16159 d.current.corutimer:= 0;
3 16160 end;
2 16161 \f
2 16161
2 16161 message coroutinemonitor - 12 ;
2 16162
2 16162
2 16162 <***** pass *****
2 16163
2 16163 this procedure moves the calling coroutine from the head of the ready
2 16164 queue down below all coroutines of lower or equal priority. *>
2 16165
2 16165
2 16165 procedure pass;
2 16166 begin
3 16167 linkprio(current, readyqueue);
3 16168
3 16168
3 16168 passivate;
3 16169 end;
2 16170
2 16170
2 16170 <***** signal ****
2 16171
2 16171 this procedure increases the value af 'semaphore' by 1.
2 16172 in case some coroutine is already waiting, it is linked into the ready
2 16173 queue for activation. the calling coroutine continues execution. *>
2 16174
2 16174
2 16174 procedure signal (semaphore);
2 16175 value semaphore;
2 16176 integer semaphore;
2 16177 begin
3 16178 integer array field sem;
3 16179 sem:= semaphore;
3 16180 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16181 d.sem.simvalue:= d.sem.simvalue + 1;
3 16182
3 16182
3 16182 end;
2 16183 \f
2 16183
2 16183 message coroutinemonitor - 13 ;
2 16184
2 16184
2 16184 <***** wait *****
2 16185
2 16185 this procedure decreases the value of 'semaphore' by 1.
2 16186 in case the value of the semaphore is negative after the decrease, the
2 16187 calling coroutine is linked into the semaphore queue waiting for a
2 16188 coroutine to signal this semaphore. *>
2 16189
2 16189
2 16189 procedure wait (semaphore);
2 16190 value semaphore;
2 16191 integer semaphore;
2 16192 begin
3 16193 integer array field sem;
3 16194 sem:= semaphore;
3 16195 d.sem.simvalue:= d.sem.simvalue - 1;
3 16196
3 16196
3 16196 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16197 passivate;
3 16198 end;
2 16199 \f
2 16199
2 16199 message coroutinemonitor - 14 ;
2 16200
2 16200
2 16200 <***** inspect *****
2 16201
2 16201 this procedure inspects the value of the semaphore and returns it in
2 16202 'elements'.
2 16203 the semaphore is left unchanged. *>
2 16204
2 16204
2 16204 procedure inspect (semaphore, elements);
2 16205 value semaphore;
2 16206 integer semaphore, elements;
2 16207 begin
3 16208 integer array field sem;
3 16209 sem:= semaphore;
3 16210 elements:= d.sem.simvalue;
3 16211
3 16211
3 16211 end;
2 16212 \f
2 16212
2 16212 message coroutinemonitor - 15 ;
2 16213
2 16213
2 16213 <***** signalch *****
2 16214
2 16214 this procedure delivers an operation at 'semaphore'.
2 16215 in case another coroutine is already waiting for an operation of the
2 16216 kind 'operationtype' this coroutine will get the operation and it will
2 16217 be put into the ready queue for activation.
2 16218 in case no coroutine is waiting for the actial kind of operation it is
2 16219 linked into the semaphore queue, at the end of the queue
2 16220 if operation is positive and at the beginning if operation is negative.
2 16221 the calling coroutine continues execution. *>
2 16222
2 16222
2 16222 procedure signalch (semaphore, operation, operationtype);
2 16223 value semaphore, operation, operationtype;
2 16224 integer semaphore, operation;
2 16225 boolean operationtype;
2 16226 begin
3 16227 integer array field firstcoru, currcoru, op,currop;
3 16228 op:= abs operation;
3 16229 d.op.optype:= operationtype;
3 16230 firstcoru:= semaphore + semcoru;
3 16231 currcoru:= d.firstcoru.next;
3 16232 while currcoru <> firstcoru do
3 16233 begin
4 16234 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16235 begin
5 16236 link(operation, 0);
5 16237 d.currcoru.coruop:= operation;
5 16238 linkprio(currcoru, readyqueue);
5 16239 link(currcoru + corutimerchain, idlequeue);
5 16240 goto exit;
5 16241 end else currcoru:= d.currcoru.next;
4 16242 end;
3 16243 currop:=semaphore + semop;
3 16244 if operation < 0 then currop:=d.currop.next;
3 16245 link(op, currop);
3 16246 exit:
3 16247
3 16247
3 16247 end;
2 16248 \f
2 16248
2 16248 message coroutinemonitor - 16 ;
2 16249
2 16249
2 16249 <***** waitch *****
2 16250
2 16250 this procedure fetches an operation from a semaphore.
2 16251 in case an operation matching 'operationtypeset' is already waiting at
2 16252 'semaphore' it is handed over to the calling coroutine.
2 16253 in case no matching operation is waiting, the calling coroutine is
2 16254 linked to the semaphore.
2 16255 in any case the calling coroutine will be stopped and all corouti-
2 16256 nes are rescheduled. *>
2 16257
2 16257
2 16257 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16258 value semaphore, operationtypeset, timeout;
2 16259 integer semaphore, operation, timeout;
2 16260 boolean operationtypeset;
2 16261 begin
3 16262 integer array field firstop, currop;
3 16263 firstop:= semaphore + semop;
3 16264 currop:= d.firstop.next;
3 16265
3 16265
3 16265 while currop <> firstop do
3 16266 begin
4 16267 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16268 begin
5 16269 link(currop, 0);
5 16270 d.current.coruop:= currop;
5 16271 operation:= currop;
5 16272 \f
5 16272
5 16272 message coroutinemonitor - 17 ;
5 16273
5 16273 linkprio(current, readyqueue);
5 16274 passivate;
5 16275 goto exit;
5 16276 end else currop:= d.currop.next;
4 16277 end;
3 16278 linkprio(current, semaphore + semcoru);
3 16279 if timeout > 0 then
3 16280 begin
4 16281 link(current + corutimerchain, timerqueue);
4 16282 d.current.corutimer:= timeout;
4 16283 end else d.current.corutimer:= 0;
3 16284 d.current.corutypeset:= operationtypeset;
3 16285 passivate;
3 16286 if d.current.corutimer < 0 then operation:= 0
3 16287 else operation:= d.current.coruop;
3 16288 d.current.corutimer:= 0;
3 16289 currop:= operation;
3 16290 d.current.coruop:= currop;
3 16291 link(current+corutimerchain, idlequeue);
3 16292 exit:
3 16293
3 16293
3 16293 end;
2 16294 \f
2 16294
2 16294 message coroutinemonitor - 18 ;
2 16295
2 16295
2 16295 <***** inspectch *****
2 16296
2 16296 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16297 the number of matching operations are counted and delivered in 'elements'.
2 16298 if no operations are found the number of coroutines waiting
2 16299 for operations of the typeset are counted and delivered as
2 16300 negative value in 'elements'.
2 16301 the semaphore is left unchanged. *>
2 16302
2 16302
2 16302 procedure inspectch (semaphore, operationtypeset, elements);
2 16303 value semaphore, operationtypeset;
2 16304 integer semaphore, elements;
2 16305 boolean operationtypeset;
2 16306 begin
3 16307 integer array field firstop, currop,firstcoru,currcoru;
3 16308 integer counter;
3 16309 counter:= 0;
3 16310 firstop:= semaphore + semop;
3 16311 currop:= d.firstop.next;
3 16312 while currop <> firstop do
3 16313 begin
4 16314 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16315 counter:= counter + 1;
4 16316 currop:= d.currop.next;
4 16317 end;
3 16318 if counter=0 then
3 16319 begin
4 16320 firstcoru:=semaphore + sem_coru;
4 16321 curr_coru:=d.firstcoru.next;
4 16322 while curr_coru<>first_coru do
4 16323 begin
5 16324 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16325 counter:=counter - 1;
5 16326 curr_coru:=d.curr_coru.next;
5 16327 end;
4 16328 end;
3 16329 elements:= counter;
3 16330
3 16330
3 16330 end;
2 16331 \f
2 16331
2 16331 message coroutinemonitor - 19 ;
2 16332
2 16332
2 16332 <***** csendmessage *****
2 16333
2 16333 this procedure sends the message in 'mess' to the process defined by the name
2 16334 in 'receiver', and returns an identification of the message extension used
2 16335 for sending the message (this identification is to be used for calling 'cwait-
2 16336 answer' or 'cregretmessage'. *>
2 16337
2 16337
2 16337 procedure csendmessage (receiver, mess, messextension);
2 16338 real array receiver;
2 16339 integer array mess;
2 16340 integer messextension;
2 16341 begin
3 16342 integer bufref, messext;
3 16343 messref(maxmessext):= 0;
3 16344 messext:= 1;
3 16345 while messref(messext) <> 0 do messext:= messext + 1;
3 16346 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16347 begin
4 16348 messcode(messext):= 1 shift 12 add 2;
4 16349 mon(16) send message :(0, mess, 0, receiver);
4 16350 messref(messext):= monw2;
4 16351 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16352 end;
3 16353
3 16353
3 16353 end;
2 16354 \f
2 16354
2 16354 message coroutinemonitor - 20 ;
2 16355
2 16355
2 16355 <***** cwaitanswer *****
2 16356
2 16356 this procedure asks the coroutine monitor to get an answer to the message
2 16357 corresponding to 'messextension'. in case the answer has already arrived
2 16358 it stays in the eventqueue until 'cwaitanswer' is called.
2 16359 in case 'timeout' is positive, the coroutine is linked into the timer
2 16360 queue, and in case the answer does not arrive within 'timout' seconds the
2 16361 coroutine is restarted with result = 0. *>
2 16362
2 16362
2 16362 procedure cwaitanswer (messextension, answer, result, timeout);
2 16363 value messextension, timeout;
2 16364 integer messextension, result, timeout;
2 16365 integer array answer;
2 16366 begin
3 16367 integer messext;
3 16368 messext:= messextension;
3 16369 messcode(messext):= messcode(messext) extract 12;
3 16370 link(current, idlequeue);
3 16371 messop(messext):= current;
3 16372 if timeout > 0 then
3 16373 begin
4 16374 link(current + corutimerchain, timerqueue);
4 16375 d.current.corutimer:= timeout;
4 16376 end else d.current.corutimer:= 0;
3 16377
3 16377
3 16377 passivate;
3 16378 if d.current.corutimer < 0 then result:= 0 else
3 16379 begin
4 16380 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16381 result:= monw0;
4 16382 baseevent:= 0;
4 16383 messref(messextension):= 0;
4 16384 end;
3 16385 d.current.corutimer:= 0;
3 16386 link(current+corutimerchain, idlequeue);
3 16387 end;
2 16388 \f
2 16388
2 16388 message coroutinemonitor - 21 ;
2 16389
2 16389
2 16389 <***** cwaitmessage *****
2 16390
2 16390 this procedure asks the coroutine monitor to give it a message, when some-
2 16391 one arrives. in case a message has arrived already it stays at the event queue
2 16392 until 'cwaitmessage' is called.
2 16393 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16394 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16395 with messbufferref = 0. *>
2 16396
2 16396
2 16396 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16397 value timeout, processextension;
2 16398 integer processextension, messbufferref, timeout;
2 16399 integer array mess;
2 16400 begin
3 16401 integer i;
3 16402 integer array field messbuf;
3 16403 proccode(processextension):= 2;
3 16404 procop(processextension):= current;
3 16405 link(current, idlequeue);
3 16406 if timeout > 0 then
3 16407 begin
4 16408 link(current + corutimerchain, timerqueue);
4 16409 d.current.corutimer:= timeout;
4 16410 end else d.current.corutimer:= 0;
3 16411
3 16411
3 16411 passivate;
3 16412 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16413 begin
4 16414 messbuf:= procop(processextension);
4 16415 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16416 proccode(procext):= 1 shift 12;
4 16417 messbufferref:= messbuf;
4 16418 baseevent:= 0;
4 16419 end;
3 16420 d.current.corutimer:= 0;
3 16421 link(current+corutimerchain, idlequeue);
3 16422 end;
2 16423 \f
2 16423
2 16423 message coroutinemonitor - 22 ;
2 16424
2 16424
2 16424 <***** cregretmessage *****
2 16425
2 16425 this procedure regrets the message corresponding to messageexten-
2 16426 sion, to release message buffer and message extension.
2 16427 i/o messages are not regretable. *>
2 16428
2 16428
2 16428
2 16428 procedure cregretmessage (messageextension);
2 16429 value messageextension;
2 16430 integer messageextension;
2 16431 begin
3 16432 integer array field messbuf;
3 16433 messbuf:= messref(messageextension);
3 16434 mon(82) regret message :(0, 0, messbuf, 0);
3 16435 messref(messageextension):= 0;
3 16436
3 16436
3 16436 end;
2 16437 \f
2 16437
2 16437 message coroutinemonitor - 23 ;
2 16438
2 16438
2 16438 <***** semsendmessage *****
2 16439
2 16439 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16440 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16441 by the monitor, when the answer arrives.
2 16442 in case there are too few resources to send the message, the operation is
2 16443 returned immediately with the result field set to zero. *>
2 16444
2 16444
2 16444 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16445 value semaphore, operation, operationtype;
2 16446 real array receiver;
2 16447 integer array mess;
2 16448 integer semaphore, operation;
2 16449 boolean operationtype;
2 16450 begin
3 16451 integer array field op;
3 16452 integer messext;
3 16453 op:= operation;
3 16454 messref(maxmessext):= 0;
3 16455 messext:= 1;
3 16456 while messref(messext) <> 0 do messext:= messext + 1;
3 16457 if messext < maxmessext then
3 16458 begin
4 16459 messop(messext):= op;
4 16460 messcode(messext):=1;
4 16461 d.op(1):= semaphore;
4 16462 d.op.optype:= operationtype;
4 16463 mon(16) send message :(0, mess, 0, receiver);
4 16464 messref(messext):= monw2;
4 16465 end;
3 16466
3 16466
3 16466 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16467 begin <* return the operation immediately with result = 0 *>
4 16468 d.op(9):= 0;
4 16469 signalch(semaphore, op, operationtype);
4 16470 end;
3 16471 end;
2 16472 \f
2 16472
2 16472 message coroutinemonitor - 24 ;
2 16473
2 16473
2 16473 <***** semwaitmessage *****
2 16474
2 16474 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16475 be performed by the coroutine monitor when a message arrives to the process
2 16476 corresponding to 'processextension'. *>
2 16477
2 16477
2 16477 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16478 value processextension, semaphore, operation, operationtype;
2 16479 integer processextension, semaphore, operation;
2 16480 boolean operationtype;
2 16481 begin
3 16482 integer array field op;
3 16483 op:= operation;
3 16484 procop(processextension):= operation;
3 16485 d.op(1):= semaphore;
3 16486 d.op.optype:= operationtype;
3 16487 proccode(processextension):= 1;
3 16488
3 16488
3 16488 end;
2 16489 \f
2 16489
2 16489 message coroutinemonitor - 25 ;
2 16490
2 16490
2 16490 <***** semregretmessage *****
2 16491
2 16491 this procedure regrets a message sent by semsendmessage.
2 16492 the message is identified by the operation in which the answer should be
2 16493 returned.
2 16494 the procedure sets the result field of the operation to zero, and then
2 16495 returns it by performing a signalch. *>
2 16496
2 16496
2 16496 procedure semregretmessage (operation);
2 16497 value operation;
2 16498 integer operation;
2 16499 begin
3 16500 integer i, j;
3 16501 integer array field op, sem;
3 16502 op:= operation;
3 16503 i:= 1;
3 16504 while i < maxmessext do
3 16505 begin
4 16506 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16507 begin
5 16508 mon(82) regret message :(0, 0, messref(i), 0);
5 16509 messref(i):= 0;
5 16510 sem:= d.op(1);
5 16511 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16512 signalch(sem, op, d.op.optype);
5 16513 i:= maxmessext;
5 16514 end;
4 16515 i:= i + 1;
4 16516 end;
3 16517
3 16517
3 16517 end;
2 16518 \f
2 16518
2 16518 message coroutinemonitor - 26 ;
2 16519
2 16519
2 16519 <***** link *****
2 16520
2 16520 this procedure links an object (allocated in the descriptor array 'd') into
2 16521 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16522 are all double chained, and the chainhead is of the same format as the chain
2 16523 fields of the objects.
2 16524 the procedure links the object immediately after the head. *>
2 16525
2 16525
2 16525 procedure link (object, chainhead);
2 16526 value object, chainhead;
2 16527 integer object, chainhead;
2 16528 begin
3 16529 integer array field prevelement, nextelement, chead, obj;
3 16530 obj:= object;
3 16531 chead:= chainhead;
3 16532 prevelement:= d.obj.prev;
3 16533 nextelement:= d.obj.next;
3 16534 d.prevelement.next:= nextelement;
3 16535 d.nextelement.prev:= prevelement;
3 16536 if chead > 0 then <* link into queue *>
3 16537 begin
4 16538 prevelement:= d.chead.prev;
4 16539 d.obj.prev:= prevelement;
4 16540 d.prevelement.next:= obj;
4 16541 d.obj.next:= chead;
4 16542 d.chead.prev:= obj;
4 16543 end else
3 16544 begin <* link onto itself *>
4 16545 d.obj.prev:= obj;
4 16546 d.obj.next:= obj;
4 16547 end;
3 16548 end;
2 16549 \f
2 16549
2 16549 message coroutinemonitor - 27 ;
2 16550
2 16550
2 16550 <***** linkprio *****
2 16551
2 16551 this procedure is used to link coroutines into queues corresponding to
2 16552 the priorities of the actual coroutine and the queue elements.
2 16553 the object is linked immediately before the first coroutine of lower prio-
2 16554 rity. *>
2 16555
2 16555
2 16555 procedure linkprio (object, chainhead);
2 16556 value object, chainhead;
2 16557 integer object, chainhead;
2 16558 begin
3 16559 integer array field currelement, chead, obj;
3 16560 obj:= object;
3 16561 chead:= chainhead;
3 16562 currelement:= d.chead.next;
3 16563 while currelement <> chead
3 16564 and d.currelement.corupriority <= d.obj.corupriority
3 16565 do currelement:= d.currelement.next;
3 16566 link(obj, currelement);
3 16567 end;
2 16568 \f
2 16568
2 16568 message coroutinemonitor - 28 ;
2 16569
2 16569 \f
2 16569
2 16569 message coroutinemonitor - 30a ;
2 16570
2 16570
2 16570 <*************** extention to coroutine monitor procedures **********>
2 16571
2 16571 <***** signalbin *****
2 16572
2 16572 this procedure simulates a binary semaphore on a simple semaphore
2 16573 by testing the value of the semaphore before signaling the
2 16574 semaphore. if the value of the semaphore is one (=open) nothing is
2 16575 done, otherwise a normal signal is carried out. *>
2 16576
2 16576
2 16576 procedure signalbin(semaphore);
2 16577 value semaphore;
2 16578 integer semaphore;
2 16579 begin
3 16580 integer array field sem;
3 16581 integer val;
3 16582 sem:= semaphore;
3 16583 inspect(sem,val);
3 16584 if val<1 then signal(sem);
3 16585 end;
2 16586 \f
2 16586
2 16586 message coroutinemonitor - 30b ;
2 16587
2 16587 <***** coruno *****
2 16588
2 16588 delivers the coroutinenumber for a give coroutine id.
2 16589 if the coroutine does not exists the value 0 is delivered *>
2 16590
2 16590 integer procedure coru_no(coru_id);
2 16591 value coru_id;
2 16592 integer coru_id;
2 16593 begin
3 16594 integer array field cor;
3 16595
3 16595 coru_no:= 0;
3 16596 for cor:= firstcoru step corusize until (coruref-1) do
3 16597 if d.cor.coruident//1000 = coru_id then
3 16598 coru_no:= d.cor.coruident mod 1000;
3 16599 end;
2 16600 \f
2 16600
2 16600 message coroutinemonitor - 30c ;
2 16601
2 16601 <***** coroutine *****
2 16602
2 16602 delivers the referencebyte for the coroutinedescriptor for
2 16603 a coroutine identified by coroutinenumber *>
2 16604
2 16604 integer procedure coroutine(cor_no);
2 16605 value cor_no;
2 16606 integer cor_no;
2 16607 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16608 firstcoru + (cor_no-1)*corusize;
2 16609 \f
2 16609
2 16609 message coroutinemonitor - 30d ;
2 16610
2 16610 <***** curr_coruno *****
2 16611
2 16611 delivers number of calling coroutine
2 16612 curr_coruno:
2 16613 < 0 = -current_coroutine_number in disabled mode
2 16614 = 0 = procedure not called from coroutine
2 16615 > 0 = current_coroutine_number in enabled mode *>
2 16616
2 16616 integer procedure curr_coruno;
2 16617 begin
3 16618 integer i;
3 16619 integer array ia(1:12);
3 16620
3 16620 i:= system(12,0,ia);
3 16621 if i > 0 then
3 16622 begin
4 16623 i:= system(12,1,ia);
4 16624 curr_coruno:= ia(3);
4 16625 end else curr_coruno:= 0;
3 16626 end curr_coruno;
2 16627 \f
2 16627
2 16627 message coroutinemonitor - 30e ;
2 16628
2 16628 <***** curr_coruid *****
2 16629
2 16629 delivers coruident of calling coroutine :
2 16630
2 16630 curr_coruid:
2 16631 > 0 = coruident of calling coroutine
2 16632 = 0 = procedure not called from coroutine *>
2 16633
2 16633 integer procedure curr_coruid;
2 16634 begin
3 16635 integer cor_no;
3 16636 integer array field cor;
3 16637
3 16637 cor_no:= abs curr_coruno;
3 16638 if cor_no <> 0 then
3 16639 begin
4 16640 cor:= coroutine(cor_no);
4 16641 curr_coruid:= d.cor.coruident // 1000;
4 16642 end
3 16643 else curr_coruid:= 0;
3 16644 end curr_coruid;
2 16645 \f
2 16645 message coroutinemonitor - 30f.1 ;
2 16646
2 16646 <**** getch *****
2 16647
2 16647 this procedure searches the queue of operations waiting at 'semaphore'
2 16648 to find an operation that matches the operationstypeset and a set of
2 16649 select-values. each select value is specified by type and fieldvalue
2 16650 in integer array 'type' and by the value in integer array 'val'.
2 16651
2 16651 0: eq 0: not used
2 16652 1: lt 1: boolean
2 16653 2: le 2: integer
2 16654 3: gt 3: long
2 16655 4: ge 4: real
2 16656 5: ne
2 16657 *>
2 16658
2 16658 procedure getch(semaphore,operation,operationtypeset,type,val);
2 16659 value semaphore,operationtypeset;
2 16660 integer semaphore,operation;
2 16661 boolean operationtypeset;
2 16662 integer array type,val;
2 16663 begin
3 16664 integer array field firstop,currop;
3 16665 integer ø,n,i,f,t,rel,i1,i2;
3 16666 boolean field bf,bfval;
3 16667 integer field intf;
3 16668 long field lf,lfval; long l1,l2;
3 16669 real field rf,rfval; real r1,r2;
3 16670
3 16670 boolean match;
3 16671
3 16671 operation:= 0;
3 16672 n:= system(3,ø,type);
3 16673 match:= false;
3 16674 firstop:= semaphore + semop;
3 16675 currop:= d.firstop.next;
3 16676 while currop <> firstop and -,match do
3 16677 begin
4 16678 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16679 begin
5 16680 i:= n;
5 16681 match:= true;
5 16682 \f
5 16682 message coroutinemonitor - 30f.2 ;
5 16683
5 16683 while match and (if i <= ø then type(i) >= 0 else false) do
5 16684 begin
6 16685 rel:= type(i) shift(-18);
6 16686 t:= type(i) shift(-12) extract 6;
6 16687 f:= type(i) extract 12;
6 16688 if f > 2047 then f:= f -4096;
6 16689 case t+1 of
6 16690 begin
7 16691 ; <* not used *>
7 16692
7 16692 begin <*boolean or signed short integer*>
8 16693 bf:= f;
8 16694 bfval:= 2*i;
8 16695 i1:= d.currop.bf extract 12;
8 16696 if i1 > 2047 then i1:= i1-4096;
8 16697 i2:= val.bfval extract 12;
8 16698 if i2 > 2047 then i2:= i2-4096;
8 16699 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16700 end;
7 16701
7 16701 begin <*integer*>
8 16702 intf:= f;
8 16703 i1:= d.currop.intf;
8 16704 i2:= val(i);
8 16705 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16706 end;
7 16707
7 16707 begin <*long*>
8 16708 lf:= f;
8 16709 lfval:= i*2;
8 16710 l1:= d.currop.lf;
8 16711 l2:= val.lfval;
8 16712 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 16713 end;
7 16714
7 16714 begin <*real*>
8 16715 rf:= f;
8 16716 rfval:= i*2;
8 16717 r1:= d.currop.rf;
8 16718 r2:= val.rfval;
8 16719 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 16720 end;
7 16721
7 16721 end;<*case t+1*>
6 16722
6 16722 i:= i+1;
6 16723 end; <*while match and i<=ø and t>=0 *>
5 16724 \f
5 16724 message coroutinemonitor - 30f.3 ;
5 16725
5 16725 end; <* if operationtypeset and ---*>
4 16726 if -,match then currop:= d.currop.next;
4 16727 end; <*while currop <> firstop and -,match*>
3 16728
3 16728 if match then
3 16729 begin
4 16730 link(currop,0);
4 16731 d.current.coruop:= currop;
4 16732 operation:= currop;
4 16733 end;
3 16734 end getch;
2 16735 \f
2 16735
2 16735 message coroutinemonitor - 31 ;
2 16736
2 16736 activity(maxcoru);
2 16737
2 16737 goto initialization;
2 16738
2 16738
2 16738
2 16738 <*************** event handling ***************>
2 16739
2 16739
2 16739
2 16739 takeexternal:
2 16740 currevent:= baseevent;
2 16741 eventqueueempty:= false;
2 16742 repeat
2 16743 current:= 0;
2 16744 prevevent:= currevent;
2 16745 mon(66) test event :(0, 0, currevent, 0);
2 16746 currevent:= monw2;
2 16747 if monw0 < 0 <* no event *> then goto takeinternal;
2 16748 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 16749 cmi:= monw1
2 16750 else
2 16751 cmi:= - monw0;
2 16752
2 16752 if cmi > 0 then
2 16753 begin <* answer to activity zone *>
3 16754 current:= firstcoru + (cmi - 1) * corusize;
3 16755 linkprio(current, readyqueue);
3 16756 baseevent:= 0;
3 16757 end else
2 16758
2 16758 if cmi = 0 then
2 16759 begin <* message arrived *>
3 16760 \f
3 16760
3 16760 message coroutinemonitor - 32 ;
3 16761
3 16761 receiver:= core.currevent(3);
3 16762 if receiver < 0 then receiver:= - receiver;
3 16763 procref(maxprocext):= receiver;
3 16764 procext:= 1;
3 16765 while procref(procext) <> receiver do procext:= procext + 1;
3 16766 if procext = maxprocext then
3 16767 begin <* receiver unknown *>
4 16768 <* leave the message unchanged *>
4 16769 end else
3 16770 if proccode(procext) shift (-12) = 0 then
3 16771 begin <* the receiver is ready for accepting messages *>
4 16772 mon(26) get event :(0, 0, currevent, 0);
4 16773 case proccode(procext) of
4 16774 begin
5 16775 begin <* message received by semwaitmessage *>
6 16776 op:= procop(procext);
6 16777 sem:= d.op(1);
6 16778 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 16779 d.op(9):= currevent;
6 16780 signalch(sem, op, d.op.optype);
6 16781 proccode(procext):= 1 shift 12;
6 16782 end;
5 16783 begin <* message received by cwaitmessage *>
6 16784 current:= procop(procext);
6 16785 procop(procext):= currevent;
6 16786 linkprio(current, readyqueue);
6 16787 link(current + corutimerchain, idlequeue);
6 16788
6 16788
6 16788 end;
5 16789 end; <* case *>
4 16790 currevent:= baseevent;
4 16791 proccode(procext):= 1 shift 12;
4 16792 end;
3 16793 end <* message *> else
2 16794
2 16794 if cmi = -1 then
2 16795 begin <* answer arrived *>
3 16796 \f
3 16796
3 16796 message coroutinemonitor - 33 ;
3 16797
3 16797 if currevent = timermessage then
3 16798 begin
4 16799 mon(26) get event :(0, 0, currevent, 0);
4 16800 coru:= d.timerqueue.next;
4 16801 while coru <> timerqueue do
4 16802 begin
5 16803 current:= coru - corutimerchain;
5 16804 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 16805 coru:= d.coru.next;
5 16806 if d.current.corutimer <= 0 then
5 16807 begin <* timer perion expired *>
6 16808 d.current.corutimer:= -1;
6 16809 linkprio(current, readyqueue);
6 16810 link(current + corutimerchain, idlequeue);
6 16811 end;
5 16812 end;
4 16813 mon(16) send message :(0, clockmess, 0, clock);
4 16814 timermessage:= monw2;
4 16815 currevent:= baseevent;
4 16816 end <* timer answer *> else
3 16817 begin
4 16818 messref(maxmessext):= currevent;
4 16819 messext:= 1;
4 16820 while messref(messext) <> currevent do messext:= messext + 1;
4 16821 if messext = maxmessext then
4 16822 begin <* the answer is unknown *>
5 16823 <* leave the answer unchanged - it may belong to an activity *>
5 16824 end else
4 16825 if messcode(messext) shift (-12) = 0 then
4 16826 begin
5 16827 case messcode(messext) extract 12 of
5 16828 begin
6 16829 \f
6 16829
6 16829 message coroutinemonitor - 34 ;
6 16830 begin <* answer arrived after semsendmessage *>
7 16831 op:= messop(messext);
7 16832 sem:= d.op(1);
7 16833 mon(18) wait answer :(0, d.op, currevent, 0);
7 16834 d.op(9):= monw0;
7 16835 signalch(sem, op, d.op.optype);
7 16836 messref(messext):= 0;
7 16837 baseevent:= 0;
7 16838 end;
6 16839 begin <* answer arrived after csendmessage *>
7 16840 current:= messop(messext);
7 16841 linkprio(current, readyqueue);
7 16842 link(current + corutimerchain, idlequeue);
7 16843
7 16843
7 16843 end;
6 16844 end;
5 16845 end else baseevent:= currevent;
4 16846 end;
3 16847 end;
2 16848 until eventqueueempty;
2 16849 \f
2 16849
2 16849 message coroutinemonitor - 35 ;
2 16850
2 16850
2 16850
2 16850 <*************** coroutine activation ***************>
2 16851
2 16851 takeinternal:
2 16852
2 16852 current:= d.readyqueue.next;
2 16853 if current = readyqueue then
2 16854 begin
3 16855 mon(24) wait event :(0, 0, prevevent, 0);
3 16856 goto takeexternal;
3 16857 end;
2 16858
2 16858 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 16859 <**> begin
3 16860 <**> systime(5,0,r);
3 16861 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 16862 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 16863 <**> d.current.coruident//1000,<: aktiveres:>);
3 16864 <**> end;
2 16865 <*-2*>
2 16866
2 16866 corustate:= activate(d.current.coruident mod 1000);
2 16867 cmi:= corustate extract 24;
2 16868 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 16869 <**> begin
3 16870 <**> systime(5,0,r);
3 16871 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 16872 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 16873 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 16874 <**> end;
2 16875 <*-2*>
2 16876
2 16876 if cmi = 1 then
2 16877 begin <* programmed passivate *>
3 16878 goto takeexternal;
3 16879 end;
2 16880
2 16880 if cmi = 2 then
2 16881 begin <* implicit passivate in activity *>
3 16882
3 16882
3 16882 link(current, idlequeue);
3 16883 goto takeexternal;
3 16884 end;
2 16885 \f
2 16885
2 16885 message coroutinemonitor - 36 ;
2 16886
2 16886 <* coroutine termination (normal or abnormal) *>
2 16887
2 16887 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 16888 coru_term:
2 16889
2 16889 begin
3 16890 if false and alarmcause extract 24 = (-9) <* break *> and
3 16891 alarmcause shift (-24) extract 24 = 0 then
3 16892 begin
4 16893 endaction:= 2;
4 16894 goto program_slut;
4 16895 end;
3 16896 if alarmcause extract 24 = (-9) <* break *> and
3 16897 alarmcause shift (-24) = 8 <* parent *>
3 16898 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 16899 if alarmcause shift (-24) extract 24 <> -2 or
3 16900 alarmcause extract 24 <> -13 then
3 16901 begin
4 16902 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 16903 alarmcause shift (-24),<:,:>,
4 16904 alarmcause extract 24);
4 16905 for i:=1 step 1 until max_coru do
4 16906 j:=activate(-i); <* kill *>
4 16907 <* skriv billede *>
4 16908 end
3 16909 else
3 16910 begin
4 16911 errorbits:= 0; <* ok.yes warning.no *>
4 16912 goto finale;
4 16913 end;
3 16914 end;
2 16915
2 16915 goto dump;
2 16916
2 16916 link(current, idlequeue);
2 16917 goto takeexternal;
2 16918 \f
2 16918
2 16918 message coroutinemonitor - 37 ;
2 16919
2 16919
2 16919
2 16919 initialization:
2 16920
2 16920
2 16920 <*************** initialization ***************>
2 16921
2 16921 <* chain head *>
2 16922
2 16922 prev:= -2; <* -2 prev *>
2 16923 next:= 0; <* +0 next *>
2 16924
2 16924 <* corutine descriptor *>
2 16925
2 16925 <* -2 prev *>
2 16926 <* +0 next *>
2 16927 <* +2 (link field) *>
2 16928 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 16929 <* +6 (link field) *>
2 16930 coruop:= corutimerchain + 4; <* +8 coruop *>
2 16931 corutimer:= coruop + 2; <*+10 corutimer *>
2 16932 coruident:= corutimer + 2; <*+12 coruident *>
2 16933 corupriority:= coruident + 2; <*+14 corupriority *>
2 16934 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 16935 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 16936
2 16936 <* simple semaphore *>
2 16937
2 16937 <* -2 (link field) *>
2 16938 simcoru:= next; <* +0 simcoru *>
2 16939 simvalue:= simcoru + 2; <* +2 simvalue *>
2 16940
2 16940 <* chained semaphore *>
2 16941
2 16941 <* -2 (link field) *>
2 16942 semcoru:= next; <* +0 semcoru *>
2 16943 <* +2 (link field) *>
2 16944 semop:= semcoru + 4; <* +4 semop *>
2 16945 \f
2 16945
2 16945 message coroutinemonitor - 38 ;
2 16946
2 16946 <* operation *>
2 16947
2 16947 opsize:= next - 6; <* -6 opsize *>
2 16948 optype:= opsize + 1; <* -5 optype *>
2 16949 <* -2 prev *>
2 16950 <* +0 next *>
2 16951 <* +2 operation(1) *>
2 16952 <* +4 operation(2) *>
2 16953 <* +6 - *>
2 16954 <* . - *>
2 16955 <* . - *>
2 16956
2 16956 \f
2 16956
2 16956 message coroutinemonitor - 39 ;
2 16957
2 16957 trap(dump);
2 16958 systime(1, 0, starttime);
2 16959 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 16960 clockmess(1):= 0;
2 16961 clockmess(2):= timeinterval;
2 16962 clock(1):= real <:clock:>;
2 16963 clock(2):= real <::>;
2 16964 mon(16) send message :(0, clockmess, 0, clock);
2 16965 timermessage:= monw2;
2 16966 readyqueue:= 4;
2 16967 initchain(readyqueue);
2 16968 idlequeue:= readyqueue + 4;
2 16969 initchain(idlequeue);
2 16970 timerqueue:= idlequeue + 4;
2 16971 initchain(timerqueue);
2 16972 current:= 0;
2 16973 corucount:= 0;
2 16974 proccount:= 0;
2 16975 baseevent:= 0;
2 16976 coruref:= timerqueue + 4;
2 16977 firstcoru:= coruref;
2 16978 simref:= coruref + maxcoru * corusize;
2 16979 firstsim:= simref;
2 16980 semref:= simref + maxsem * simsize;
2 16981 firstsem:= semref;
2 16982 opref:= semref + maxsemch * semsize + 4;
2 16983 firstop:= opref;
2 16984 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 16985 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 16986 reflectcore(core);
2 16987
2 16987 algol list.on;
2 16988
2 16988 \f
2 16988 message sys_initialisering side 1 - 810601/hko;
2 16989
2 16989 trapmode:= 1 shift 15;
2 16990 errorbits:= 1; <* warning.no ok.no *>
2 16991 trap(coru_term);
2 16992
2 16992 open(zbillede,4,<:billede:>,0);
2 16993 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 16994 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 16995 system(2,0,ia);
2 16996 open(zdummy,4,ia,0); close(zdummy,false);
2 16997 monitor(42,zdummy,0,ia);
2 16998 laf:= 0;
2 16999 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17000 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17001 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17002
2 17002 open(zrl,4,<:radiolog:>,0);
2 17003 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17004 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17005 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17006 begin
3 17007 ia(1):=1; ia(2):= 3;
3 17008 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17009 monitor(40)create_area:(zrl,0,ia);
3 17010 end;
2 17011
2 17011 for i:=1 step 1 until max_antal_fejltekster do
2 17012 fejltekst(i):= real (case i of (
2 17013 <* 1*><:filsystem:>,
2 17014 <* 2*><:operationskode:>,
2 17015 <* 3*><:programfejl:>,
2 17016 <* 4*><:monitor<'_'>resultat=:>,
2 17017 <* 5*><:læs<'_'>fil:>,
2 17018 <* 6*><:skriv<'_'>fil:>,
2 17019 <* 7*><:modif<'_'>fil:>,
2 17020 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17021 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17022 <*10*><:vogntabel:>,
2 17023 <*11*><:fremmed operation:>,
2 17024 <*12*><:operationstype:>,
2 17025 <*13*><:opret<'_'>fil:>,
2 17026 <*14*><:tilknyt<'_'>fil:>,
2 17027 <*15*><:frigiv<'_'>fil:>,
2 17028 <*16*><:slet<'_'>fil:>,
2 17029 <*17*><:ydre enhed, status=:>,
2 17030 <*18*><:tabelfil:>,
2 17031 <*19*><:radio:>,
2 17032 <*20*><:mobilopkald, bus:>,
2 17033 <*21*><:talevejsswitch:>,
2 17034 <*99*><:ftslut:>));
2 17035
2 17035 for i:= 1 step 1 until max_antal_områder do
2 17036 begin
3 17037 område_navn(i):= long (case i of
3 17038 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17039 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17040 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17041 område_id(i,2):=
3 17042 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17043 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17044 end;
2 17045
2 17045 pabx_id(1):= -1;
2 17046 pabx_id(2):= 1;
2 17047
2 17047 for i:= 1 step 1 until max_antal_radiokanaler do
2 17048 begin
3 17049 radio_id(i):=
3 17050 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17051 end;
2 17052
2 17052 for i:=1 step 1 until max_antal_kanaler do
2 17053 begin
3 17054 kanal_navn(i):= long (case i of (
3 17055 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17056 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17057 kanal_id(i):=
3 17058 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17059 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17060 end;
2 17061
2 17061 for i:= 1 step 1 until op_maske_lgd//2 do
2 17062 ingen_operatører(i):= alle_operatører(i):= 0;
2 17063 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17064 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17065
2 17065 begin
3 17066 long array navn(1:2);
3 17067 long array field doc, ref;
3 17068
3 17068 doc:= 2; iaf:= 0;
3 17069 movestring(navn,1,<:terminal0:>);
3 17070 for i:= 1 step 1 until max_antal_operatører do
3 17071 begin
4 17072 ref:=(i-1)*8; k:=9;
4 17073 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17074 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17075 open(zdummy,8,navn,0); close(zdummy,true);
4 17076 k:= monitor(42,zdummy,0,ia);
4 17077 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17078 else tofrom(terminal_navn.ref,navn,8);
4 17079 operatør_auto_include(i):= false;
4 17080 sætbit_ia(alle_operatører,i,1);
4 17081 end;
3 17082
3 17082 movestring(navn,1,<:garage0:>);
3 17083 for i:= 1 step 1 until max_antal_garageterminaler do
3 17084 begin
4 17085 ref:=(i-1)*8; k:=7;
4 17086 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17087 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17088 open(zdummy,8,navn,0); close(zdummy,true);
4 17089 k:= monitor(42,zdummy,0,ia);
4 17090 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17091 else tofrom(garage_terminal_navn.ref,navn,8);
4 17092 garage_auto_include(i):= false;
4 17093 end;
3 17094 end;
2 17095
2 17095 for i:= 1 step 1 until max_antal_taleveje do
2 17096 sætbit_ia(alle_taleveje,i,1);
2 17097 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17098 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17099 operatør_auto_include(ia(i)):= true;
2 17100 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17101 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17102 garage_auto_include(ia(i)):= true;
2 17103
2 17103
2 17103 \f
2 17103 message fil_init side 1 - 801030/jg;
2 17104
2 17104 begin integer i,antz,tz,s;
3 17105 real array field raf;
3 17106
3 17106 filskrevet:=fillæst:=0; <*fil*>
3 17107 dbsegmax:= 2**18-1;
3 17108
3 17108 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17109 for i:=1 step 1 until dbantez do
3 17110 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17111 for i:=dbantez+1 step 1 until tz do
3 17112 open(fil(i),4,dbsnavn,0);
3 17113 for i:=tz+1 step 1 until antz do
3 17114 open(fil(i),4,dbtnavn,0);
3 17115
3 17115 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17116 dbkatz(i,1):=dbkatz(i,2):=0;
3 17117 for i:=dbantez+1 step 1 until tz do
3 17118 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17119 for i:=tz+1 step 1 until antz do
3 17120 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17121 dbkatz(antz,2):=tz+1;
3 17122 dbsidstetz:=antz;
3 17123 dbsidstesz:=tz;
3 17124
3 17124 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17125 begin integer j;
4 17126 for j:=1,3 step 1 until 6 do
4 17127 dbkate(i,j):=0;
4 17128 dbkate(i,2):=i+1;
4 17129 end;
3 17130 dbkate(dbmaxef,2):=0;
3 17131 dbkatefri:=1;
3 17132 dbantef:=0;
3 17133 \f
3 17133 message fil_init side 2 - 801030/jg;
3 17134
3 17134
3 17134 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17135 begin
4 17136 dbkats(i,1):=0;
4 17137 dbkats(i,2):=i+1;
4 17138 end;
3 17139 dbkats(dbmaxsf,2):=0;
3 17140 dbkatsfri:=1;
3 17141 dbantsf:=0;
3 17142
3 17142 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17143 dbkatb(i):=false add (i+1);
3 17144 dbkatb(dbmaxb):=false;
3 17145 dbkatbfri:=1;
3 17146 dbantb:=0;
3 17147 raf:=4;
3 17148 for i:=1 step 1 until dbmaxtf do
3 17149 begin
4 17150 inrec6(fil(antz),4);
4 17151 dbkatt.raf(i):=fil(antz,1);
4 17152 end;
3 17153 inrec6(fil(antz),4);
3 17154 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17155 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17156 setposition(fil(antz),0,0);
3 17157
3 17157 end filsystem;
2 17158 \f
2 17158 message fil_init side 3 - 810209/cl;
2 17159
2 17159 bs_kats_fri:= nextsem;
2 17160 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17161 <*-3*>
2 17162 bs_kate_fri:= nextsem;
2 17163 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17164 <*-3*>
2 17165 cs_opret_fil:= nextsemch;
2 17166 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17167 <*-3*>
2 17168 cs_tilknyt_fil:= nextsemch;
2 17169 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17170 <*-3*>
2 17171 cs_frigiv_fil:= nextsemch;
2 17172 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17173 <*-3*>
2 17174 cs_slet_fil:= nextsemch;
2 17175 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17176 <*-3*>
2 17177 cs_opret_spoolfil:= nextsemch;
2 17178 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17179 <*-3*>
2 17180 cs_opret_eksternfil:= nextsemch;
2 17181 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17182 <*-3*>
2 17183 \f
2 17183 message fil_init side 4 810209/cl;
2 17184
2 17184
2 17184 <* initialisering af filsystemcoroutiner *>
2 17185
2 17185 i:= nextcoru(001,10,true);
2 17186 j:= newactivity(i,0,opretfil);
2 17187 <*+3*> skriv_newactivity(out,i,j);
2 17188 <*-3*>
2 17189
2 17189 i:= nextcoru(002,10,true);
2 17190 j:= newactivity(i,0,tilknytfil);
2 17191 <*+3*> skriv_newactivity(out,i,j);
2 17192 <*-3*>
2 17193
2 17193 i:= nextcoru(003,10,true);
2 17194 j:= newactivity(i,0,frigivfil);
2 17195 <*+3*> skriv_newactivity(out,i,j);
2 17196 <*-3*>
2 17197
2 17197 i:= nextcoru(004,10,true);
2 17198 j:= newactivity(i,0,sletfil);
2 17199 <*+3*> skriv_newactivity(out,i,j);
2 17200 <*-3*>
2 17201
2 17201 i:= nextcoru(005,10,true);
2 17202 j:= newactivity(i,0,opretspoolfil);
2 17203 <*+3*> skriv_newactivity(out,i,j);
2 17204 <*-3*>
2 17205
2 17205 i:= nextcoru(006,10,true);
2 17206 j:= newactivity(i,0,opreteksternfil);
2 17207 <*+3*> skriv_newactivity(out,i,j);
2 17208 <*-3*>
2 17209 \f
2 17209 message attention_initialisering side 1 - 850820/cl;
2 17210
2 17210 tf_kommandotabel:= 1 shift 10 + 1;
2 17211
2 17211 begin
3 17212 integer i, s, zno;
3 17213 zone z(128,1,stderror);
3 17214 integer array fdim(1:8);
3 17215
3 17215 fdim(4):= tf_kommandotabel;
3 17216 hentfildim(fdim);
3 17217
3 17217 open(z,4,<:htkommando:>,0);
3 17218 for i:= 1 step 1 until fdim(3) do
3 17219 begin
4 17220 inrec6(z,512);
4 17221 s:= skrivfil(tf_kommandotabel,i,zno);
4 17222 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17223 tofrom(fil(zno),z,512);
4 17224 end;
3 17225 close(z,true);
3 17226 end;
2 17227 \f
2 17227 message attention_initialisering side 1a - 810428/hko;
2 17228
2 17228 for j:= system(3,i,terminal_tab) step 1 until i do
2 17229 terminal_tab(j):= 0;
2 17230
2 17230 cs_att_pulje:=next_semch;
2 17231 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17232 <*-3*>
2 17233
2 17233 bs_fortsæt_adgang:= nextsem;
2 17234 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17235 <*-3*>
2 17236 signalbin(bs_fortsæt_adgang);
2 17237
2 17237 for i:= 1,
2 17238 1 step 1 until max_antal_operatører,
2 17239 1 step 1 until max_antal_garageterminaler do
2 17240
2 17240 <* initialisering af pulje med attention_operationer *>
2 17241
2 17241 signalch(cs_att_pulje, <* pulje_semafor *>
2 17242 nextop(data+att_op_længde), <* næste_operation *>
2 17243 gen_optype);
2 17244
2 17244 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17245
2 17245 i:=next_coru(010,<*ident*>
2 17246 2,<*prioritet*>
2 17247 true<*test_maske*>);
2 17248 j:=newactivity( i, <*activityno *>
2 17249 0, <*ikke virtual *>
2 17250 attention);<*ingen parametre*>
2 17251
2 17251 <*+3*>skriv_newactivity(out,i,j);
2 17252 <*-3*>
2 17253 \f
2 17253 message io_initialisering side 1 - 810507/hko;
2 17254
2 17254 io_spoolfil:= 1028;
2 17255 begin
3 17256 integer array fdim(1:8);
3 17257 fdim(4):= io_spoolfil;
3 17258 hent_fildim(fdim);
3 17259 io_spool_postantal:= fdim(1);
3 17260 io_spool_postlængde:= fdim(2);
3 17261 end;
2 17262
2 17262 io_spool_post:= 4;
2 17263
2 17263 cs_io:= next_semch;
2 17264 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17265 <*-3*>
2 17266
2 17266 i:= next_coru(100,<*ident *>
2 17267 5,<*prioritet *>
2 17268 true<*test_maske*>);
2 17269
2 17269 j:= new_activity( i,
2 17270 0,
2 17271 h_io);
2 17272
2 17272 <*+3*>skriv_newactivity(out,i,j);
2 17273 <*-3*>
2 17274 cs_io_komm:= next_semch;
2 17275 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17276 <*-3*>
2 17277
2 17277 i:= next_coru(101,<*ident*>
2 17278 10,<*prioritet*>
2 17279 true <*testmaske*>);
2 17280 j:= new_activity( i,
2 17281 0,
2 17282 io_komm);<*ingen parametre*>
2 17283
2 17283 <*+3*>skriv_newactivity(out,i,j);
2 17284 <*-3*>
2 17285 \f
2 17285 message io_initialisering side 2 - 810520/hko/cl;
2 17286
2 17286 bs_zio_adgang:= next_sem;
2 17287 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17288 <*-3*>
2 17289 signal_bin(bs_zio_adgang);
2 17290
2 17290 cs_io_spool:= next_semch;
2 17291 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17292 <*-3*>
2 17293
2 17293 cs_io_fil:=next_semch;
2 17294 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17295 <*-3*>
2 17296 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17297
2 17297 ss_io_spool_fulde:= next_sem;
2 17298 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17299 <*-3*>
2 17300
2 17300 ss_io_spool_tomme:= next_sem;
2 17301 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17302 <*-3*>
2 17303 for i:= 1 step 1 until io_spool_postantal do
2 17304 signal(ss_io_spool_tomme);
2 17305 \f
2 17305 message io_initialisering side 3 - 880901/cl;
2 17306
2 17306 i:= next_coru(102,
2 17307 5,
2 17308 true);
2 17309 j:= new_activity(i,0,io_spool);
2 17310
2 17310 <*+3*>skriv_newactivity(out,i,j);
2 17311 <*-3*>
2 17312
2 17312 i:= next_coru(103,
2 17313 10,
2 17314 true);
2 17315 j:= new_activity(i,0,io_spon);
2 17316
2 17316 <*+3*>skriv_newactivity(out,i,j);
2 17317 <*-3*>
2 17318
2 17318 cs_io_medd:= next_semch;
2 17319 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17320 <*-3*>
2 17321
2 17321 i:= next_coru(104,<*ident *>
2 17322 10,<*prioritet *>
2 17323 true<*test_maske*>);
2 17324
2 17324 j:= new_activity( i,
2 17325 0,
2 17326 io_medd);
2 17327
2 17327 <*+3*>skriv_newactivity(out,i,j);
2 17328 <*-3*>
2 17329
2 17329 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17330 i:= monitor(8)reserve process:(z_io,0,ia);
2 17331 if i <> 0 then
2 17332 begin
3 17333 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17334 end
2 17335 else
2 17336 begin
3 17337 ref:= 0;
3 17338 terminal_tab.ref.terminal_tilstand:= 0;
3 17339 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17340 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17341 "sp",1,"*",15,"nl",1);
3 17342 setposition(z_io,0,0);
3 17343 end;
2 17344 \f
2 17344 message operatør_initialisering side 1 - 810520/hko;
2 17345
2 17345 top_bpl_gruppe:= 64;
2 17346
2 17346 bpl_navn(0):= long<::>;
2 17347 for i:= 1 step 1 until 127 do
2 17348 begin
3 17349 k:= læsfil(tf_bpl_navne,i,j);
3 17350 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17351 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17352 if i<=max_antal_operatører then
3 17353 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17354 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17355 top_bpl_gruppe:= i;
3 17356 end;
2 17357
2 17357 for i:= 0 step 1 until 64 do
2 17358 begin
3 17359 iaf:= i*op_maske_lgd;
3 17360 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17361 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17362 if 1<=i and i<= max_antal_operatører then
3 17363 begin
4 17364 bpl_tilst(i,2):= 1;
4 17365 sætbit_ia(bpl_def.iaf,i,1);
4 17366 end;
3 17367 end;
2 17368 for i:= 65 step 1 until 127 do
2 17369 begin
3 17370 k:= læsfil(tf_bpl_def,i-64,j);
3 17371 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17372 iaf:= i*op_maske_lgd;
3 17373 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17374 bpl_tilst(i,1):= 0;
3 17375 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17376 end;
2 17377
2 17377 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17378 iaf:= 0;
2 17379 for i:= 1 step 1 until max_antal_operatører do
2 17380 begin
3 17381 k:= læsfil(tf_stoptabel,i,j);
3 17382 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17383 operatør_stop(i,0):= i;
3 17384 for k:= 1,2,3 do
3 17385 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17386 ant_i_opkø(i):= 0;
3 17387 end;
2 17388
2 17388 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17389 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17390 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17391 sidste_tv_brugt:= max_antal_taleveje;
2 17392
2 17392 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17393 opk_alarm(i):= 0;
2 17394 for i:= 1 step 1 until max_antal_operatører do
2 17395 begin
3 17396 integer array field tab;
3 17397
3 17397 k:= læsfil(tf_alarmlgd,i,j);
3 17398 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17399 tab:= (i-1)*opk_alarm_tab_lgd;
3 17400 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17401 opk_alarm.tab.alarm_start:= 0.0;
3 17402 end;
2 17403
2 17403 op_spool_kilde:= 2;
2 17404 op_spool_tid := 6;
2 17405 op_spool_text := 6;
2 17406 begin
3 17407 long array field laf1, laf2;
3 17408 laf2:= 4; laf1:= 0;
3 17409 op_spool_buf.laf1(1):= long<::>;
3 17410 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17411 op_spool_postantal*op_spool_postlgd-4);
3 17412 end;
2 17413
2 17413 k:=læsfil(1033,1,j);
2 17414 systime(1,0.0,r);
2 17415 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17416 for i:= 1 step 1 until max_cqf do
2 17417 begin
3 17418 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17419 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17420 cqf_tabel.ref.cqf_næste_tid:=
3 17421 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17422 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17423 end;
2 17424 op_cqf_tab_ændret:= true;
2 17425
2 17425 laf:= raf:= 0;
2 17426 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17427 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17428 j:= 1;
2 17429 if i<>0 then
2 17430 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17431 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17432 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17433 j:= 1;
2 17434 if i<>0 then
2 17435 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17436
2 17436 ia(1):= 3; <*canonical*>
2 17437 ia(2):= 0; <*no echo*>
2 17438 ia(3):= 0; <*prompt*>
2 17439 ia(4):= 2; <*timeout*>
2 17440 setcspterm(taleswitch_in_navn.laf,ia);
2 17441 setcspterm(taleswitch_out_navn.laf,ia);
2 17442
2 17442 cs_op:= next_semch;
2 17443
2 17443 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17444 <*-3*>
2 17445
2 17445 cs_op_retur:= next_semch;
2 17446
2 17446 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17447 <*-3*>
2 17448
2 17448 i:= nextcoru(200,<*ident*>
2 17449 10,<*prioitet*>
2 17450 true<*test_maske*>);
2 17451
2 17451 j:= new_activity( i,
2 17452 0,
2 17453 h_operatør);
2 17454
2 17454 <*+3*>skriv_newactivity(out,i,j);
2 17455 <*-3*>
2 17456 \f
2 17456 message operatør_initialisering side 2 - 810520/hko;
2 17457
2 17457 for k:= 1 step 1 until max_antal_operatører do
2 17458 begin
3 17459 ref:= (k-1)*8;
3 17460 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17461 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17462 ref:=k*terminal_beskr_længde;
3 17463 if i = 0 then
3 17464 begin
4 17465 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17466 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17467 end
3 17468 else
3 17469 begin
4 17470 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17471 end;
3 17472
3 17472 cs_operatør(k):= next_semch;
3 17473 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17474 <*-3*>
3 17475
3 17475 cs_op_fil(k):= nextsemch;
3 17476 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17477 <*-3*>
3 17478 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17479
3 17479 i:= next_coru(200+k,<*ident*>
3 17480 10,<*prioitet*>
3 17481 true<*testmaske*>);
3 17482 j:= new_activity( i,
3 17483 0,
3 17484 operatør,k);
3 17485
3 17485 <*+3*>skriv_newactivity(out,i,j);
3 17486 <*-3*>
3 17487 end;
2 17488
2 17488 cs_cqf:= next_semch;
2 17489 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17490 <*-3*>
2 17491
2 17491 signalch(cs_cqf,nextop(60),true);
2 17492
2 17492 i:= next_coru(292, <*ident*>
2 17493 10, <*prioritet*>
2 17494 true <*testmaske*>);
2 17495 j:= new_activity( i,
2 17496 0,
2 17497 op_cqftest);
2 17498 <*+3*>skriv_new_activity(out,i,j);
2 17499 <*-3*>
2 17500
2 17500 cs_op_spool:= next_semch;
2 17501 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17502 <*-3*>
2 17503
2 17503 cs_op_medd:= next_semch;
2 17504 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17505 <*-3*>
2 17506
2 17506 ss_op_spool_tomme:= next_sem;
2 17507 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17508 <*-3*>
2 17509 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17510
2 17510 ss_op_spool_fulde:= next_sem;
2 17511 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17512 <*-3*>
2 17513
2 17513 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17514
2 17514 i:= next_coru(293, <*ident*>
2 17515 10, <*prioritet*>
2 17516 true <*testmaske*>);
2 17517 j:= new_activity( i,
2 17518 0,
2 17519 op_spool);
2 17520 <*+3*>skriv_new_activity(out,i,j);
2 17521 <*-3*>
2 17522
2 17522 i:= next_coru(294, <*ident*>
2 17523 10, <*prioritet*>
2 17524 true <*testmaske*>);
2 17525 j:= new_activity( i,
2 17526 0,
2 17527 op_medd);
2 17528 <*+3*>skriv_new_activity(out,i,j);
2 17529 <*-3*>
2 17530
2 17530 cs_op_iomedd:= next_semch;
2 17531 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17532 <*-3*>
2 17533
2 17533 bs_opk_alarm:= next_sem;
2 17534 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17535 <*-3*>
2 17536
2 17536 cs_opk_alarm:= next_semch;
2 17537 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17538 <*-3*>
2 17539
2 17539 cs_opk_alarm_ur:= next_semch;
2 17540 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17541 <*-3*>
2 17542
2 17542 cs_opk_alarm_ur_ret:= next_semch;
2 17543 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17544 <*-3*>
2 17545
2 17545 cs_tvswitch_adgang:= next_semch;
2 17546 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17547 <*-3*>
2 17548
2 17548 cs_tv_switch_input:= next_semch;
2 17549 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17550 <*-3*>
2 17551
2 17551 cs_tv_switch_adm:= next_semch;
2 17552 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17553 <*-3*>
2 17554
2 17554 cs_talevejsswitch:= next_semch;
2 17555 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17556 <*-3*>
2 17557
2 17557 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17558
2 17558 iaf:= nextop(data+128);
2 17559 if testbit22 then
2 17560 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17561 else
2 17562 begin
3 17563 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17564 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17565 end;
2 17566
2 17566 i:= next_coru(295, <*ident*>
2 17567 8, <*prioritet*>
2 17568 true <*testmaske*>);
2 17569 j:= new_activity( i,
2 17570 0,
2 17571 alarmur);
2 17572 <*+3*>skriv_new_activity(out,i,j);
2 17573 <*-3*>
2 17574
2 17574 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17575
2 17575 i:= next_coru(296, <*ident*>
2 17576 8, <*prioritet*>
2 17577 true <*testmaske*>);
2 17578 j:= new_activity( i,
2 17579 0,
2 17580 opkaldsalarmer);
2 17581 <*+3*>skriv_new_activity(out,i,j);
2 17582 <*-3*>
2 17583
2 17583 i:= next_coru(297, <*ident*>
2 17584 3, <*prioritet*>
2 17585 true <*testmaske*>);
2 17586 j:= new_activity( i,
2 17587 0,
2 17588 tv_switch_input);
2 17589 <*+3*>skriv_new_activity(out,i,j);
2 17590 <*-3*>
2 17591
2 17591 for i:= 1,2 do
2 17592 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17593
2 17593 i:= next_coru(298, <*ident*>
2 17594 20, <*prioritet*>
2 17595 true <*testmaske*>);
2 17596 j:= new_activity( i,
2 17597 0,
2 17598 tv_switch_adm);
2 17599 <*+3*>skriv_new_activity(out,i,j);
2 17600 <*-3*>
2 17601
2 17601 i:= next_coru(299, <*ident*>
2 17602 3, <*prioritet*>
2 17603 true <*testmaske*>);
2 17604 j:= new_activity( i,
2 17605 0,
2 17606 talevejsswitch);
2 17607 <*+3*>skriv_new_activity(out,i,j);
2 17608 <*-3*>
2 17609 \f
2 17609 message garage_initialisering side 1 - 810521/hko;
2 17610
2 17610 cs_gar:= next_semch;
2 17611 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 17612 <*-3*>
2 17613
2 17613 i:= next_coru(300,<*ident*>
2 17614 10,<*prioritet*>
2 17615 true<*test_maske*>);
2 17616
2 17616 j:= new_activity( i,
2 17617 0,
2 17618 h_garage);
2 17619
2 17619 <*+3*>skriv_newactivity(out,i,j);
2 17620 <*-3*>
2 17621
2 17621 for k:= 1 step 1 until max_antal_garageterminaler do
2 17622 begin
3 17623 ref:= (k-1)*8;
3 17624 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 17625 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 17626 i:=monitor(4)process address:(z_gar(k),0,ia);
3 17627 if i = 0 then
3 17628 begin
4 17629 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 17630 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17631 end
3 17632 else
3 17633 begin
4 17634 terminal_tab.ref.terminal_tilstand:=
4 17635 if garage_auto_include(k) then 0 else 7 shift 21;
4 17636 if garage_auto_include(k) then
4 17637 monitor(8)reserve:(z_gar(k),0,ia);
4 17638 end;
3 17639 cs_garage(k):= next_semch;
3 17640 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 17641 <*-3*>
3 17642 i:= next_coru(300+k,<*ident*>
3 17643 10,<*prioritet*>
3 17644 true <*testmaske*>);
3 17645 j:= new_activity( i,
3 17646 0,
3 17647 garage,k);
3 17648
3 17648 <*+3*>skriv_newactivity(out,i,j);
3 17649 <*-3*>
3 17650
3 17650 end;
2 17651 \f
2 17651 message radio_initialisering side 1 - 820301/hko;
2 17652
2 17652 cs_rad:= next_semch;
2 17653 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 17654 <*-3*>
2 17655
2 17655 i:= next_coru(400,<*ident*>
2 17656 10,<*prioritet*>
2 17657 true<*test_maske*>);
2 17658 j:= new_activity( i,
2 17659 0,
2 17660 h_radio);
2 17661 <*+3*>skriv_newactivity(out,i,j);
2 17662 <*-3*>
2 17663
2 17663 opkalds_kø_ledige:= max_antal_mobilopkald;
2 17664 nødopkald_brugt:= 0;
2 17665 læsfil(1034,1,i);
2 17666 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 17667
2 17667 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 17668 for i:= system(3,j,opkaldskø) step 1 until j do
2 17669 opkaldskø(i):= 0;
2 17670 første_frie_opkald:=opkaldskø_postlængde;
2 17671 første_opkald:=sidste_opkald:=
2 17672 første_nødopkald:=sidste_nødopkald:=j:=0;
2 17673
2 17673 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 17674 begin
3 17675 ref:=i*opkaldskø_postlængde;
3 17676 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 17677 end;
2 17678 ref:=ref+opkaldskø_postlængde;
2 17679 opkaldskø.ref(1):=j shift 12;
2 17680
2 17680 for ref:= 0 step 512 until (max_linienr//768*512) do
2 17681 begin
3 17682 i:= læs_fil(1035,ref//512+1,j);
3 17683 if i <> 0 then
3 17684 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 17685 tofrom(radio_linietabel.ref,fil(j),
3 17686 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 17687 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 17688 end;
2 17689
2 17689 for i:= system(3,j,kanal_tab) step 1 until j do
2 17690 kanal_tab(i):= 0;
2 17691 kanal_tilstand:= 2;
2 17692 kanal_id1:= 4;
2 17693 kanal_id2:= 6;
2 17694 kanal_spec:= 8;
2 17695 kanal_alt_id1:= 10;
2 17696 kanal_alt_id2:= 12;
2 17697 kanal_mon_maske:= 12;
2 17698 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 17699
2 17699 for i:= 1 step 1 until max_antal_kanaler do
2 17700 begin
3 17701 ref:= (i-1)*kanalbeskrlængde;
3 17702 sæthexciffer(kanal_tab.ref,3,15);
3 17703 if kanal_id(i) shift (-5) extract 3 = 2 or
3 17704 kanal_id(i) shift (-5) extract 3 = 3 and
3 17705 radio_id(kanal_id(i) extract 5)<=3
3 17706 then
3 17707 begin
4 17708 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 17709 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 17710 end;
3 17711 end;
2 17712 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 17713 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 17714 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 17715 optaget_flag:= 0;
2 17716 \f
2 17716 message radio_initialisering side 2 - 810524/hko;
2 17717
2 17717 bs_mobil_opkald:= next_sem;
2 17718
2 17718 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 17719 <*-3*>
2 17720
2 17720 bs_opkaldskø_adgang:= next_sem;
2 17721 signal_bin(bs_opkaldskø_adgang);
2 17722
2 17722 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 17723 <*-3*>
2 17724
2 17724 cs_radio_medd:=next_semch;
2 17725 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 17726
2 17726 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 17727 <*-3*>
2 17728
2 17728 i:= next_coru(403,
2 17729 5,<*prioritet*>
2 17730 true<*testmaske*>);
2 17731
2 17731 j:= new_activity( i,
2 17732 0,
2 17733 radio_medd_opkald);
2 17734
2 17734 <*+3*>skriv_newactivity(out,i,j);
2 17735 <*-3*>
2 17736
2 17736 cs_radio_adm:= nextsemch;
2 17737 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 17738 <*-3*>
2 17739
2 17739 i:= next_coru(404,
2 17740 10,
2 17741 true);
2 17742 j:= new_activity(i,
2 17743 0,
2 17744 radio_adm,next_op(data+radio_op_længde));
2 17745 <*+3*>skriv_new_activity(out,i,j);
2 17746 <*-3*>
2 17747 \f
2 17747 message radio_initialisering side 3 - 810526/hko;
2 17748 for k:= 1 step 1 until max_antal_taleveje do
2 17749 begin
3 17750
3 17750 cs_radio(k):=next_semch;
3 17751
3 17751 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 17752 <*-3*>
3 17753
3 17753 bs_talevej_udkoblet(k):= nextsem;
3 17754 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 17755 <*-3*>
3 17756
3 17756 i:=next_coru(410+k,
3 17757 10,
3 17758 true);
3 17759
3 17759 j:=new_activity( i,
3 17760 0,
3 17761 radio,k,next_op(data + radio_op_længde));
3 17762
3 17762 <*+3*>skriv_newactivity(out,i,j);
3 17763 <*-3*>
3 17764 end;
2 17765
2 17765 cs_radio_pulje:=next_semch;
2 17766
2 17766 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 17767 <*-3*>
2 17768
2 17768 for i:= 1 step 1 until radiopulje_størrelse do
2 17769 signal_ch(cs_radio_pulje,
2 17770 next_op(60),
2 17771 gen_optype or rad_optype);
2 17772
2 17772 cs_radio_kø:= next_semch;
2 17773
2 17773 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 17774 <*-3*>
2 17775
2 17775 mobil_opkald_aktiveret:= true;
2 17776 \f
2 17776 message radio_initialisering side 4 - 810522/hko;
2 17777
2 17777 laf:=raf:=0;
2 17778
2 17778 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 17779 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 17780 j:=1;
2 17781 if i <> 0 then
2 17782 fejlreaktion(4<*monitor resultat*>,i,
2 17783 string radio_fr_navn.raf(increase(j)),1);
2 17784 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 17785 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 17786 j:=1;
2 17787 if i <> 0 then
2 17788 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 17789 ia(1):= 3 <*canonical*>;
2 17790 ia(2):= 0 <*no echo*>;
2 17791 ia(3):= 0 <*prompt*>;
2 17792 ia(4):= 5 <*timeout*>;
2 17793 setcspterm(radio_fr_navn.laf,ia);
2 17794
2 17794 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 17795 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 17796 j:= 1;
2 17797 if i <> 0 then
2 17798 fejlreaktion(4<*monitor resultat*>,i,
2 17799 string radio_rf_navn.raf(increase(j)),1);
2 17800 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 17801 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 17802 j:= 1;
2 17803 if i <> 0 then
2 17804 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 17805 ia(1):= 3 <*canonical*>;
2 17806 ia(2):= 0 <*no echo*>;
2 17807 ia(3):= 0 <*prompt*>;
2 17808 ia(4):= 5 <*timeout*>;
2 17809 setcspterm(radio_rf_navn.laf,ia);
2 17810 \f
2 17810 message radio_initialisering side 5 - 810521/hko;
2 17811 for k:= 1 step 1 until max_antal_kanaler do
2 17812 begin
3 17813
3 17813 ss_radio_aktiver(k):=next_sem;
3 17814 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 17815 <*-3*>
3 17816
3 17816 ss_samtale_nedlagt(k):=next_sem;
3 17817 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 17818 <*-3*>
3 17819 end;
2 17820
2 17820 cs_radio_ind:= next_semch;
2 17821 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 17822 <*-3*>
2 17823
2 17823 i:= next_coru(401,<*ident radio_ind*>
2 17824 3, <*prioritet*>
2 17825 true <*testmaske*>);
2 17826 j:= new_activity( i,
2 17827 0,
2 17828 radio_ind,next_op(data + 64));
2 17829
2 17829 <*+3*>skriv_newactivity(out,i,j);
2 17830 <*-3*>
2 17831
2 17831 cs_radio_ud:=next_semch;
2 17832 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 17833 <*-3*>
2 17834
2 17834 i:= next_coru(402,<*ident radio_out*>
2 17835 10,<*prioritet*>
2 17836 true <*testmaske*>);
2 17837 j:= new_activity( i,
2 17838 0,
2 17839 radio_ud,next_op(data + 64));
2 17840
2 17840 <*+3*>skriv_newactivity(out,i,j);
2 17841 <*-3*>
2 17842 \f
2 17842 message vogntabel initialisering side 1 - 820301;
2 17843
2 17843 sidste_bus:= sidste_linie_løb:= 0;
2 17844
2 17844 tf_vogntabel:= 1 shift 10 + 2;
2 17845 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 17846 tf_gruppeidenter:= 1 shift 10 +6;
2 17847 tf_springdef:= 1 shift 10 +7;
2 17848 hent_fil_dim(ia);
2 17849 max_antal_i_gruppe:= ia(2);
2 17850 if ia(1) < max_antal_grupper then
2 17851 max_antal_grupper:= ia(1);
2 17852
2 17852 <* initialisering af interne vogntabeller *>
2 17853 begin
3 17854 long array field laf1,laf2;
3 17855 integer array fdim(1:8);
3 17856 zone z(128,1,stderror);
3 17857 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 17858 long omr,garageid;
3 17859 integer field ll, bn;
3 17860 boolean binær, test24;
3 17861
3 17861 ll:= 2; bn:= 4;
3 17862
3 17862 <* nulstil tabellerne *>
3 17863 laf1:= -2;
3 17864 laf2:= 2;
3 17865 bustabel1.laf2(0):=
3 17866 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 17867 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 17868 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 17869 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 17870 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 17871 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 17872 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 17873 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 17874 \f
3 17874 message vogntabel initialisering side 1a - 810505/cl;
3 17875
3 17875
3 17875 <* initialisering af intern busnummertabel *>
3 17876 open(z,4,<:busnumre:>,0);
3 17877 busnr:= -1;
3 17878 read(z,busnr);
3 17879 while busnr > 0 do
3 17880 begin
4 17881 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 17882 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 17883 sidste_bus:= sidste_bus+1;
4 17884 if sidste_bus > max_antal_busser then
4 17885 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 17886 repeatchar(z); readchar(z,tegn);
4 17887 garageid:= extend 0; binær:= false; omr:= extend 0;
4 17888 g_nr:= o_nr:= 0;
4 17889 if tegn='!' then
4 17890 begin
5 17891 binær:= true;
5 17892 readchar(z,tegn);
5 17893 end;
4 17894 if tegn='/' then <*garageid*>
4 17895 begin
5 17896 readchar(z,tegn); repeatchar(z);
5 17897 if '0'<=tegn and tegn<='9' then
5 17898 begin
6 17899 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 17900 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 17901 if g_nr<>0 and garageid=long<::> then
6 17902 begin
7 17903 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 17904 g_nr:= 0;
7 17905 end;
6 17906 end
5 17907 else
5 17908 begin
6 17909 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 17910 begin
7 17911 garageid:= garageid shift 8 + tegn;
7 17912 readchar(z,tegn);
7 17913 end;
6 17914 while garageid shift (-40) extract 8 = 0 do
6 17915 garageid:= garageid shift 8;
6 17916 g_nr:= find_bpl(garageid);
6 17917 if g_nr=0 then
6 17918 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 17919 end;
5 17920 repeatchar(z); readchar(z,tegn);
5 17921 end;
4 17922 if tegn=';' then
4 17923 begin
5 17924 readchar(z,tegn); repeatchar(z);
5 17925 if '0'<=tegn and tegn<='9' then
5 17926 begin
6 17927 read(z,o_nr);
6 17928 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 17929 if o_nr<>0 then omr:= område_navn(o_nr);
6 17930 if o_nr<>0 and omr=long<::> then
6 17931 begin
7 17932 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 17933 o_nr:= 0;
7 17934 end;
6 17935 end
5 17936 else
5 17937 begin
6 17938 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 17939 begin
7 17940 omr:= omr shift 8 + tegn;
7 17941 readchar(z,tegn);
7 17942 end;
6 17943 while omr shift (-40) extract 8 = 0 do
6 17944 omr:= omr shift 8;
6 17945 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 17946 i:= 1;
6 17947 while i<=max_antal_områder and o_nr=0 do
6 17948 begin
7 17949 if omr=område_navn(i) then o_nr:= i;
7 17950 i:= i+1;
7 17951 end;
6 17952 if o_nr=0 then
6 17953 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 17954 end;
5 17955 repeatchar(z); readchar(z,tegn);
5 17956 end;
4 17957 if o_nr=0 then o_nr:= 3;
4 17958 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 17959 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 17960
4 17960 busnr:= -1;
4 17961 read(z,busnr);
4 17962 end;
3 17963 close(z,true);
3 17964 \f
3 17964 message vogntabel initialisering side 2 - 820301/cl;
3 17965
3 17965 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 17966 test24:= testbit24;
3 17967 testbit24:= false;
3 17968 i:= 1;
3 17969 s:= læsfil(tf_vogntabel,i,zi);
3 17970 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 17971 while fil(zi).bn<>0 do
3 17972 begin
4 17973 if fil(zi).ll <> 0 then
4 17974 begin <* indsæt linie/løb *>
5 17975 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 17976 fil(zi).ll,j);
5 17977 if res < 0 then j:= j+1;
5 17978 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 17979 <:dobbeltregistrering i vogntabel:>,1)
5 17980 else
5 17981 begin
6 17982 o_nr:= fil(zi).bn shift (-14) extract 8;
6 17983 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 17984 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 17985 <:ukendt bus i vogntabel:>,1)
6 17986 else
6 17987 begin
7 17988 if sidste_linie_løb >= max_antal_linie_løb then
7 17989 fejlreaktion(10,fil(zi).bn extract 14,
7 17990 <:for mange linie/løb i vogntabel:>,0);
7 17991 for ll_nr:= sidste_linie_løb step (-1) until j do
7 17992 begin
8 17993 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 17994 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 17995 end;
7 17996 linie_løb_tabel(j):= fil(zi).ll;
7 17997 bus_indeks(j):= false add b_nr;
7 17998 sidste_linie_løb:= sidste_linie_løb + 1;
7 17999 end;
6 18000 end;
5 18001 end;
4 18002 i:= i+1;
4 18003 s:= læsfil(tf_vogntabel,i,zi);
4 18004 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18005 end;
3 18006 \f
3 18006 message vogntabel initialisering side 3 - 810428/cl;
3 18007
3 18007 <* initialisering af intern linie/løb-indekstabel *>
3 18008 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18009 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18010
3 18010 <* gem ny vogntabel i tabelfil *>
3 18011 for i:= 1 step 1 until sidste_bus do
3 18012 begin
4 18013 s:= skriv_fil(tf_vogntabel,i,zi);
4 18014 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18015 fil(zi).bn:= bustabel(i) extract 14 add
4 18016 (bustabel1(i) extract 8 shift 14);
4 18017 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18018 end;
3 18019 fdim(4):= tf_vogntabel;
3 18020 hent_fil_dim(fdim);
3 18021 pant:= fdim(3) * (256//fdim(2));
3 18022 for i:= sidste_bus+1 step 1 until pant do
3 18023 begin
4 18024 s:= skriv_fil(tf_vogntabel,i,zi);
4 18025 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18026 fil(zi).ll:= fil(zi).bn:= 0;
4 18027 end;
3 18028
3 18028 <* initialisering/nulstilling af gruppetabeller *>
3 18029 for i:= 1 step 1 until max_antal_grupper do
3 18030 begin
4 18031 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18032 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18033 gruppetabel(i):= fil(zi).ll;
4 18034 end;
3 18035 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18036 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18037 testbit24:= test24;
3 18038 end;
2 18039
2 18039
2 18039 <*+2*>
2 18040 <**> if testbit40 then p_vogntabel(out);
2 18041 <**> if testbit43 then p_gruppetabel(out);
2 18042 <*-2*>
2 18043
2 18043 message vogntabel initialisering side 3a -920517/cl;
2 18044
2 18044 <* initialisering for vt_log *>
2 18045
2 18045 v_tid:= 4;
2 18046 v_kode:= 6;
2 18047 v_bus:= 8;
2 18048 v_ll1:= 10;
2 18049 v_ll2:= 12;
2 18050 v_tekst:= 6;
2 18051 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18052 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18053 if vt_log_aktiv then
2 18054 begin
3 18055 integer i;
3 18056 real t;
3 18057 integer array field iaf;
3 18058 integer array
3 18059 tail(1:10),ia(1:10),chead(1:20);
3 18060
3 18060 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18061 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18062 if i=0 then
3 18063 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18064 if i=0 then
3 18065 begin
4 18066 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18067 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18068 end;
3 18069
3 18069 if i=0 then
3 18070 begin
4 18071 iaf:= 2;
4 18072 tofrom(vt_logdisc,tail.iaf,8);
4 18073 i:=slices(vt_logdisc,0,tail,chead);
4 18074 if i > (-2048) then
4 18075 begin
5 18076 vt_log_slicelgd:= chead(15);
5 18077 i:= 0;
5 18078 end;
4 18079 end;
3 18080
3 18080 if i=0 then
3 18081 begin
4 18082 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18083 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18084 if i=0 then
4 18085 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18086 if i=0 then
4 18087 begin
5 18088 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18089 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18090 end;
4 18091
4 18091 if i<>0 then
4 18092 begin
5 18093 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18094 tail(1):= 1;
5 18095 iaf:= 2;
5 18096 tofrom(tail.iaf,vt_logdisc,8);
5 18097 tail(6):=systime(7,0,t);
5 18098 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18099 if i=0 then
5 18100 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18101 end;
4 18102 end;
3 18103
3 18103 if i<>0 then vt_log_aktiv:= false;
3 18104 end;
2 18105
2 18105
2 18105 \f
2 18105 message vogntabel initialisering side 4 - 810520/cl;
2 18106
2 18106 cs_vt:= nextsemch;
2 18107 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18108 <*-3*>
2 18109
2 18109 cs_vt_adgang:= nextsemch;
2 18110 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18111 <*-3*>
2 18112
2 18112 cs_vt_opd:= nextsemch;
2 18113 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18114 <*-3*>
2 18115
2 18115 cs_vt_rap:= nextsemch;
2 18116 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18117 <*-3*>
2 18118
2 18118 cs_vt_tilst:= nextsemch;
2 18119 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18120 <*-3*>
2 18121
2 18121 cs_vt_auto:= nextsemch;
2 18122 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18123 <*-3*>
2 18124
2 18124 cs_vt_grp:= nextsemch;
2 18125 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18126 <*-3*>
2 18127
2 18127 cs_vt_spring:= nextsemch;
2 18128 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18129 <*-3*>
2 18130
2 18130 cs_vt_log:= nextsemch;
2 18131 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18132 <*-3*>
2 18133
2 18133 cs_vt_logpool:= nextsemch;
2 18134 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18135 <*-3*>
2 18136
2 18136 vt_op:= nextop(vt_op_længde);
2 18137 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18138
2 18138 vt_logop(1):= nextop(vt_op_længde);
2 18139 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18140 vt_logop(2):= nextop(vt_op_længde);
2 18141 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18142
2 18142 \f
2 18142 message vogntabel initialisering side 5 - 81-520/cl;
2 18143
2 18143 i:= nextcoru(500, <*ident*>
2 18144 10, <*prioitet*>
2 18145 true <*testmaske*>);
2 18146 j:= new_activity( i,
2 18147 0,
2 18148 h_vogntabel);
2 18149 <*+3*> skriv_newactivity(out,i,j);
2 18150 <*-3*>
2 18151
2 18151 i:= nextcoru(501, <*ident*>
2 18152 10, <*prioritet*>
2 18153 true <*testmaske*>);
2 18154 iaf:= nextop(filop_længde);
2 18155 j:= new_activity(i,
2 18156 0,
2 18157 vt_opdater,iaf);
2 18158 <*+3*> skriv_newactivity(out,i,j);
2 18159 <*-3*>
2 18160
2 18160 i:= nextcoru(502, <*ident*>
2 18161 10, <*prioritet*>
2 18162 true <*testmaske*>);
2 18163 k:= nextsemch;
2 18164 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18165 <*-3*>
2 18166 iaf:= nextop(fil_op_længde);
2 18167 j:= newactivity(i,
2 18168 0,
2 18169 vt_tilstand,
2 18170 k,
2 18171 iaf);
2 18172 <*+3*> skriv_newactivity(out,i,j);
2 18173 <*-3*>
2 18174 \f
2 18174 message vogntabel initialisering side 6 - 810520/cl;
2 18175
2 18175 i:= nextcoru(503, <*ident*>
2 18176 10, <*prioritet*>
2 18177 true <*testmaske*>);
2 18178 k:= nextsemch;
2 18179 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18180 <*-3*>
2 18181 iaf:= nextop(fil_op_længde);
2 18182 j:= newactivity(i,
2 18183 0,
2 18184 vt_rapport,
2 18185 k,
2 18186 iaf);
2 18187 <*+3*> skriv_newactivity(out,i,j);
2 18188 <*-3*>
2 18189
2 18189 i:= nextcoru(504, <*ident*>
2 18190 10, <*prioritet*>
2 18191 true <*testmaske*>);
2 18192 k:= nextsemch;
2 18193 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18194 <*-3*>
2 18195 iaf:= nextop(fil_op_længde);
2 18196 j:= new_activity(i,
2 18197 0,
2 18198 vt_gruppe,
2 18199 k,
2 18200 iaf);
2 18201 <*+3*> skriv_newactivity(out,i,j);
2 18202 <*-3*>
2 18203 \f
2 18203 message vogntabel initialisering side 7 - 810520/cl;
2 18204
2 18204 i:= nextcoru(505, <*ident*>
2 18205 10, <*prioritet*>
2 18206 true <*testmaske*>);
2 18207 k:= nextsemch;
2 18208 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18209 <*-3*>
2 18210 iaf:= nextop(fil_op_længde);
2 18211 j:= newactivity(i,
2 18212 0,
2 18213 vt_spring,
2 18214 k,
2 18215 iaf);
2 18216 <*+3*> skriv_newactivity(out,i,j);
2 18217 <*-3*>
2 18218
2 18218 i:= nextcoru(506, <*ident*>
2 18219 10,
2 18220 true <*testmaske*>);
2 18221 k:= nextsemch;
2 18222 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18223 <*-3*>
2 18224 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18225 j:= newactivity(i,
2 18226 0,
2 18227 vt_auto,
2 18228 k,
2 18229 iaf);
2 18230 <*+3*> skriv_newactivity(out,i,j);
2 18231 <*-3*>
2 18232
2 18232 i:=nextcoru(507, <*ident*>
2 18233 10, <*prioritet*>
2 18234 true <*testmaske*>);
2 18235 j:=newactivity(i,
2 18236 0,
2 18237 vt_log);
2 18238 <*+3*> skriv_newactivity(out,i,j);
2 18239 <*-3*>
2 18240
2 18240 <*+2*>
2 18241 <**> if testbit42 then skriv_vt_variable(out);
2 18242 <*-2*>
2 18243 \f
2 18243 message sysslut initialisering side 1 - 810406/cl;
2 18244 begin
3 18245 zone z(128,1,stderror);
3 18246 integer i,coruid,j,k;
3 18247 integer array field cor;
3 18248
3 18248 open(z,4,<:overvågede:>,0);
3 18249 for i:= read(z,coruid) while i > 0 do
3 18250 begin
4 18251 if coruid = 0 then
4 18252 begin
5 18253 for coruid:= 1 step 1 until maxcoru do
5 18254 begin
6 18255 cor:= coroutine(coruid);
6 18256 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18257 end
5 18258 end
4 18259 else
4 18260 begin
5 18261 cor:= coroutine(coru_no(abs coruid));
5 18262 if cor > 0 then
5 18263 begin
6 18264 d.cor.corutestmask:=
6 18265 (d.cor.corutestmask shift 1 shift (-1)) add
6 18266 ((coruid > 0) extract 1 shift 11);
6 18267 end;
5 18268 end;
4 18269 end;
3 18270 close(z,true);
3 18271
3 18271 læsfil(tf_systællere,1,k);
3 18272 cor:= 0;
3 18273 tofrom(opkalds_tællere,fil(k).cor,max_antal_områder*6);
3 18274
3 18274 end;
2 18275 \f
2 18275 message sysslut initialisering side 2 - 810603/cl;
2 18276
2 18276
2 18276 if låsning > 0 then
2 18277 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18278
2 18278 if låsning > 1 then
2 18279 <* låsning 2 : *> lock(readchar,1,write,2);
2 18280
2 18280 if låsning > 2 then
2 18281 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18282
2 18282
2 18282
2 18282
2 18282 if låsning > 0 then
2 18283 begin
3 18284 i:= locked(ia);
3 18285 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18286 end;
2 18287 \f
2 18287 message sysslut initialisering side 3 - 810406/cl;
2 18288
2 18288 write(z_io,"nl",2,<:initialisering slut:>);
2 18289 system(2)free core:(i,ra);
2 18290 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18291 setposition(z_io,0,0);
2 18292 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18293 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18294 "nl",1);
2 18295 errorbits:= 3; <* ok.no warning.yes *>
2 18296 \f
2 18296
2 18296 algol list.off;
2 18297 message coroutinemonitor - 40 ;
2 18298
2 18298 if simref <> firstsem then initerror(1, false);
2 18299 if semref <> firstop - 4 then initerror(2, false);
2 18300 if coruref <> firstsim then initerror(3, false);
2 18301 if opref <> optop + 6 then initerror(4, false);
2 18302 if proccount <> maxprocext -1 then initerror(5, false);
2 18303 goto takeexternal;
2 18304
2 18304 dump:
2 18305 op:= op;
2 18306 \f
2 18306 message sys trapaktion side 1 - 810521/hko/cl;
2 18307 trap(finale);
2 18308 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18309 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18310 begin
3 18311 k:= 0;
3 18312 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18313 <:timerqueue->:>));
3 18314 iaf:= i;
3 18315 for iaf:= d.iaf.next while iaf<>i do
3 18316 begin
4 18317 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18318 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18319 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18320 end;
3 18321 end;
2 18322 outchar(zbillede,'nl');
2 18323
2 18323 skriv_opkaldstællere(zbillede);
2 18324
2 18324
2 18324 pfilsystem(zbillede);
2 18325
2 18325 \f
2 18325 message operatør trapaktion1 side 1 - 810521/hko;
2 18326 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18327
2 18327 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18328 for i:= 1 step 1 until max_antal_operatører do
2 18329 begin
3 18330 laf:= (i-1)*8;
3 18331 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18332 case operatør_auto_include(i) extract 2 + 1 of (
3 18333 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18334 terminal_navn.laf,"nl",1);
3 18335 end;
2 18336 write(zbillede,"nl",1);
2 18337
2 18337 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18338 <:betjeningspladsgrupper::>,"nl",1);
2 18339 for i:= 1 step 1 until 127 do
2 18340 if bpl_navn(i)<>long<::> then
2 18341 begin
3 18342 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18343 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18344 write(zbillede,"sp",16-k,<:= :>);
3 18345 iaf:= i*op_maske_lgd; j:=0;
3 18346 for k:= 1 step 1 until max_antal_operatører do
3 18347 begin
4 18348 if læsbit_ia(bpl_def.iaf,k) then
4 18349 begin
5 18350 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18351 write(zbillede,true,6,string bpl_navn(k));
5 18352 j:= j+1;
5 18353 end;
4 18354 end;
3 18355 write(zbillede,"nl",1);
3 18356 end;
2 18357
2 18357 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18358 for i:= 1 step 1 until max_antal_operatører do
2 18359 begin
3 18360 write(zbillede,<<dd >,i);
3 18361 for j:= 0 step 1 until 3 do
3 18362 begin
4 18363 k:= operatør_stop(i,j);
4 18364 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18365 else string bpl_navn(k));
4 18366 end;
3 18367 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18368 end;
2 18369
2 18369 skriv_terminal_tab(zbillede);
2 18370 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18371 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18372 skriv_opk_alarm_tab(zbillede);
2 18373 skriv_talevejs_tab(zbillede);
2 18374 skriv_op_spool_buf(zbillede);
2 18375 skriv_cqf_tabel(zbillede,true);
2 18376 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18377
2 18377 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18378 for i:= 1 step 1 until max_antal_garageterminaler do
2 18379 begin
3 18380 laf:= (i-1)*8;
3 18381 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18382 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18383 end;
2 18384 \f
2 18384 message radio trapaktion side 1 - 820301/hko;
2 18385 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18386 skriv_kanal_tab(zbillede);
2 18387 skriv_opkaldskø(zbillede);
2 18388 skriv_radio_linietabel(zbillede);
2 18389 skriv_radio_områdetabel(zbillede);
2 18390
2 18390 \f
2 18390 message vogntabel trapaktion side 1 - 810520/cl;
2 18391 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18392 skriv_vt_variable(zbillede);
2 18393 p_vogntabel(zbillede);
2 18394 p_gruppetabel(zbillede);
2 18395 p_springtabel(zbillede);
2 18396 \f
2 18396 message sysslut trapaktion side 1 - 810519/cl;
2 18397 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18398 corutable(zbillede);
2 18399 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18400 <: ref værdi prev next:>,"nl",1);
2 18401 iaf:= firstsim;
2 18402 repeat
2 18403 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18404 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18405 iaf:= iaf + simsize;
2 18406 until iaf>=simref;
2 18407 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18408 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18409 iaf:= firstsem;
2 18410 repeat
2 18411 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18412 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18413 iaf:= iaf+semsize;
2 18414 until iaf>=semref;
2 18415 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18416 iaf:= firstop;
2 18417 repeat
2 18418 skriv_op(zbillede,iaf);
2 18419 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18420 until iaf>=optop;
2 18421 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18422 <: messref messcode messop:>,"nl",1);
2 18423 for i:= 1 step 1 until maxmessext do
2 18424 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18425 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18426 <: procref proccode procop:>,"nl",1);
2 18427 for i:= 1 step 1 until maxprocext do
2 18428 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18429
2 18429
2 18429 \f
2 18429 message sys_finale side 1 - 810428/hko;
2 18430
2 18430 finale:
2 18431 trap(slut_finale);
2 18432 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18433 endaction:=0;
2 18434 \f
2 18434 message filsystem finale side 1 - 810428/cl;
2 18435
2 18435 <* lukning af zoner *>
2 18436 write(out,<:lukker filsystem:>); ud;
2 18437 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18438 close(fil(i),true);
2 18439 \f
2 18439 message operatør_finale side 1 - 810428/hko;
2 18440
2 18440 goto op_trap2_slut;
2 18441
2 18441 write(out,<:lukker operatører:>); ud;
2 18442 for k:= 1 step 1 until max_antal_operatører do
2 18443 begin
3 18444 close(z_op(k),true);
3 18445 end;
2 18446 op_trap2_slut:
2 18447 k:=k;
2 18448
2 18448 \f
2 18448 message garage_finale side 1 - 810428/hko;
2 18449
2 18449 write(out,<:lukker garager:>); ud;
2 18450 for k:= 1 step 1 until max_antal_garageterminaler do
2 18451 begin
3 18452 close(z_gar(k),true);
3 18453 end;
2 18454 \f
2 18454 message radio_finale side 1 - 810525/hko;
2 18455 write(out,<:lukker radio:>); ud;
2 18456 close(z_fr_in,true);
2 18457 close(z_fr_out,true);
2 18458 close(z_rf_in,true);
2 18459 close(z_rf_out,true);
2 18460 \f
2 18460 message sysslut finale side 1 - 810530/cl;
2 18461
2 18461 slut_finale:
2 18462
2 18462 trap(exit_finale);
2 18463
2 18463 outchar(zrl,'em');
2 18464 close(zrl,true);
2 18465
2 18465 write(zbillede,
2 18466 "nl",2,<:blocksread=:>,blocksread,
2 18467 "nl",1,<:blocksout= :>,blocksout,
2 18468 "nl",1,<:fillæst= :>,fillæst,
2 18469 "nl",1,<:filskrevet=:>,filskrevet,
2 18470 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18471 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18472 close(zbillede,true);
2 18473 monitor(42,zbillede,0,ia);
2 18474 ia(6):= systime(7,0,0.0);
2 18475 monitor(44,zbillede,0,ia);
2 18476 setposition(z_io,0,0);
2 18477 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18478 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18479 close(z_io,true);
2 18480 exit_finale: trapmode:= 1 shift 10;
2 18481
2 18481 end;
1 18482
1 18482
1 18482 algol list.on;
1 18483 message programslut;
1 18484 program_slut:
1 18485 end
\f
1. 5508635 16712735 594 0 0
2. 10103444 12521714 341 0 0
3. 12292773 11441756 407 361 0
4. 14809109 6144842 416 1630 721
5. 12781594 14100244 567 29241 590
6. 6456985 5310433 568 0 0
7. 14791579 7651313 616 0 0
8. 18475 18469 18456 18438 18425 18417 18407 18399 18388 18377
18370 18357 18343 18334 18326 18312 18300 18291 18281 18265
18238 18218 18195 18175 18153 18137 18122 18107 18088 18072
18053 18029 18015 17994 17983 17970 17944 17920 17899 17879
17871 17866 17834 17817 17804 17793 17782 17765 17751 17734
17718 17703 17684 17666 17644 17626 17611 17591 17571 17554
17540 17524 17507 17491 17476 17461 17443 17432 17419 17410
17390 17377 17365 17350 17339 17319 17301 17289 17268 17244
17230 17217 17201 17187 17172 17157 17142 17117 17107 17095
17087 17077 17070 17054 17033 17009 17001 16994 16985 16957
16898 16868 16855 16827 16799 16772 16734 16705 16678 16620
16566 16528 16485 16450 16410 16378 16345 16287 16261 16210
16167 16128 16103 16078 16064 16032 16013 15993 15971 15959
15947 15929 15911 15897 15882 15860 15834 15817 15799 15791
15783 15759 15753 15740 15720 15709 15691 15679 15663 15649
15629 15605 15592 15580 15564 15546 15531 15524 15516 15507
15480 15465 15445 15432 15424 15415 15396 15385 15371 15359
15332 15317 15299 15277 15257 15244 15225 15202 15176 15155
15144 15122 15102 15080 15062 15034 15013 14995 14982 14974
14967 14952 14933 14926 14909 14889 14869 14855 14830 14815
14794 14768 14756 14747 14718 14696 14676 14666 14655 14630
14609 14589 14559 14540 14521 14501 14480 14472 14446 14433
14416 14397 14371 14352 14335 14308 14288 14266 14249 14229
14198 14167 14132 14105 14084 14071 14060 14039 14031 14022
14003 13983 13960 13933 13916 13898 13885 13875 13864 13840
13816 13797 13767 13754 13721 13686 13671 13650 13638 13612
13591 13571 13547 13536 13506 13487 13464 13434 13418 13395
13368 13333 13306 13299 13285 13264 13252 13238 13230 13215
13201 13194 13187 13180 13172 13139 13124 13104 13091 13073
13059 13031 13004 12986 12965 12947 12930 12913 12901 12891
12867 12861 12846 12826 12810 12793 12768 12755 12720 12703
12686 12663 12647 12635 12617 12590 12579 12571 12548 12529
12520 12503 12488 12470 12461 12449 12440 12422 12406 12391
12380 12361 12333 12312 12291 12275 12261 12254 12242 12226
12198 12176 12166 12147 12131 12100 12078 12068 12052 12039
12021 12004 11988 11965 11953 11935 11919 11904 11885 11864
11854 11832 11810 11792 11768 11743 11700 11686 11677 11648
11611 11585 11555 11513 11489 11464 11456 11448 11440 11430
11400 11382 11362 11348 11326 11303 11284 11260 11232 11209
11191 11167 11150 11134 11111 11095 11074 11056 11022 10995
10973 10951 10938 10911 10886 10871 10850 10830 10809 10785
10772 10751 10722 10687 10649 10613 10570 10555 10548 10540
10532 10511 10485 10467 10453 10432 10417 10401 10394 10384
10373 10357 10349 10340 10324 10296 10270 10259 10205 10168
10130 10066 10042 10028 10008 9992 9979 9960 9945 9932
9915 9903 9885 9860 9844 9820 9790 9773 9755 9747
9738 9707 9687 9670 9653 9629 9604 9582 9569 9556
9542 9521 9513 9504 9486 9468 9455 9433 9424 9406
9398 9386 9361 9344 9322 9305 9284 9267 9252 9229
9222 9196 9176 9158 9144 9133 9105 9087 9080 9056
9043 9032 9008 8991 8975 8963 8935 8919 8914 8894
8888 8881 8868 8854 8840 8824 8810 8799 8779 8770
8760 8735 8720 8713 8699 8683 8669 8659 8645 8629
8617 8579 8570 8544 8533 8519 8493 8473 8453 8432
8393 8376 8365 8355 8344 8334 8320 8309 8295 8281
8273 8253 8246 8235 8224 8209 8200 8192 8173 8161
8145 8127 8116 8102 8092 8081 8060 8046 8027 8015
8000 7987 7979 7965 7941 7923 7907 7886 7874 7852
7837 7821 7808 7794 7779 7738 7714 7680 7654 7631
7617 7595 7581 7551 7537 7516 7496 7466 7450 7438
7420 7407 7390 7372 7361 7346 7330 7318 7300 7271
7249 7229 7206 7183 7166 7150 7127 7110 7092 7055
7032 7025 7000 6988 6965 6951 6942 6923 6911 6894
6882 6861 6849 6831 6813 6791 6769 6761 6754 6746
6720 6694 6675 6655 6637 6621 6609 6589 6580 6563
6546 6535 6524 6513 6503 6498 6486 6476 6457 6444
6417 6406 6390 6382 6364 6348 6337 6301 6285 6271
6239 6219 6211 6196 6187 6163 6149 6138 6126 6114
6096 6076 6063 6038 6026 5999 5971 5956 5929 5903
5888 5876 5863 5844 5827 5815 5793 5781 5772 5759
5746 5723 5694 5677 5662 5638 5613 5602 5588 5570
5554 5529 5502 5487 5473 5454 5440 5417 5399 5385
5371 5351 5334 5317 5307 5296 5284 5267 5258 5242
5225 5213 5203 5186 5173 5158 5140 5128 5113 5095
5074 5054 5039 5025 5008 4990 4969 4942 4929 4915
4897 4876 4861 4831 4813 4793 4772 4760 4737 4722
4707 4685 4662 4638 4621 4585 4562 4547 4539 4531
4508 4483 4466 4446 4433 4401 4376 4335 4317 4291
4272 4261 4237 4228 4208 4189 4170 4150 4128 4108
4090 4073 4049 4016 3978 3955 3926 3882 3842 3790
3749 3709 3683 3621 3560 3515 3479 3432 3414 3377
3325 3277 3233 3217 3199 3182 3165 3143 3124 3107
3084 3041 3023 2988 2949 2923 2889 2863 2832 2801
2769 2752 2643 2583 2562 2528 2507 2469 2422 2399
2383 2365 2342 2323 2312 2303 2275 2260 2230 2219
2194 2173 2158 2134 2108 2081 2068 2047 2029 2016
1993 1974 1966 1941 1922 1907 1877 1856 1841 1833
1808 1790 1768 1752 1742 1717 1710 1697 1685 1671
1655 1642 1634 1624 1593 1577 1545 1506 1475 1443
1419 1387 1363 1336 1322 1291 1266 1244 1218 1210
1195 1190 1181 1151 1144 1138 1118 1105 1096 1091
1068 1053 1019 996 965 937 899 869 848 838
815 787 775 740 715 677 635 610 541 383
335 320 289 279 221 206 191 178 159 1
1 1 1
14791579 7651313 943 506071 31003
9. 16 192 16 4 950613 202822 buskom1
7 0 1989 801 algftnrts
0 1 0 2 *version
956 400 956 4 flushout
956 44 956 4 911004 101112 sendmessage
957 106 957 12 910308 134214 copyout
958 244 958 12 890821 163833 getzone6
0 410 0 0 out
959 178 959 12 940411 220029 testbit
962 414 962 18 940411 222629 findfpparam
965 46 965 18 890821 163814 system
968 238 968 18 movestring
968 56 968 18 890821 163907 outdate
969 124 969 18 isotable
970 176 969 18 890821 163656 write
975 310 975 152 intable
976 34 975 152 890821 163503 read
980 24 980 340 890821 163714 tofrom
967 420 965 18 stderror
982 80 982 340 890821 163740 open
986 112 986 340 890821 163754 monitor
983 344 982 340 close
967 378 965 18 increase
984 22 982 340 setposition
974 50 969 18 outchar
989 76 989 340 890821 163802 systime
0 1700 0 0 trapmode
990 302 990 340 trap
990 112 990 340 890821 163915 initzones
991 268 991 340 940411 222959 læsbitia
992 22 992 340 sign
992 28 992 340 890821 163648 ln
993 432 993 340 810409 111908 skrivhele
958 320 958 12 setzone6
1001 52 1001 340 inrec6
1001 28 1001 340 890821 163732 changerec6
1002 228 1002 340 940411 222949 sætbitia
976 36 975 152 readchar
1003 348 1003 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1004 278 1004 340 940411 222636 skrivtegn
1005 384 1005 340 940411 222639 afsluttext
1006 394 1006 340 940411 222952 læsbiti
1007 498 1007 340 940411 222816 systid
1009 28 1009 340 getnumber
1009 18 1009 340 890426 134020 putnumber
969 26 969 18 replacechar
1 656 0 0 errorbits
1016 60 1016 342 940411 222943 sætbiti
1017 354 1017 342 940411 222801 openbs
1019 228 1019 342 940411 222742 hægttekst
1001 54 1001 340 outrec6
0 1704 0 0 alarmcause
1020 332 1020 342 940411 222745 hægtstring
1021 254 1021 342 940411 222749 anbringtal
975 288 975 152 repeatchar
1022 444 1022 342 940411 223002 intg
1023 350 1023 342 940411 222739 binærsøg
992 20 992 340 sgn
1024 380 1024 342 940411 222646 skrivtext
1001 56 1001 340 swoprec6
1028 56 1025 342 passivate
1025 40 1025 342 890821 163947 activity
1030 78 1030 350 260479 150000 mon
1 1043 1030 350 monw2
1 1039 1030 350 monw0
1 1041 1030 350 monw1
1027 56 1025 342 activate
0 1588 0 0 endaction
1030 320 1030 350 reflectcore
1026 50 1025 342 newactivity
1031 372 1031 358 940327 154135 setcspterm
1033 428 1033 358 941030 233200 slices
1037 52 1037 358 890821 163933 lock
1037 258 1037 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1038 162 1038 358 940411 222622 fpparam
1 1049 1039 358 nl
1 1047 1039 358 220978 131500 bel
1040 330 1040 446 940411 222722 ud
1041 252 1041 446 940411 222656 taltekst
1 1045 1030 350 monw3
958 296 958 12 getshare6
958 398 958 12 setshare6
70 474 1044 446 0
algol end 1044
*if ok.no
*if warning.yes
*o c
▶EOF◀