|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 969984 (0xecd00)
Types: TextFile
Names: »buskomudx09 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomudx09 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.950509.2146
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;
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 ref:= (k-1)*cqf_lgd;
11 5968 iaf:= (k-1)*cqf_id;
11 5969 tofrom(fil(i).iaf,cqf_tabel.ref,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 waitch(cs_radio_pulje,opref,true,-1);
5 12479 startoperation(opref,401,cs_radio_pulje,23);
5 12480 i:= 1;
5 12481 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12482 j:= 4;
5 12483 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
5 12484 begin
6 12485 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12486 end;
5 12487 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12488 signalch(cs_io,opref,gen_optype or rad_optype);
5 12489 end
4 12490 else
4 12491 if ttyp='Z' then
4 12492 begin
5 12493 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12494 disable begin
6 12495 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12496 outchar(zrl,'nl');
6 12497 end;
5 12498 <*-2*>
5 12499 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12500 disable setposition(z_fr_out,0,0);
5 12501 ac:= -1;
5 12502 end
4 12503 else
4 12504 ac:= 1;
4 12505 end; <* telegram modtaget ok *>
3 12506 \f
3 12506 message procedure radio_ind side 15 - 881107/cl;
3 12507 if ac>=0 then
3 12508 begin
4 12509 pos:= i:= 1; sum:= 0;
4 12510 skrivtegn(answ,pos,ttyp);
4 12511 skrivtegn(answ,pos,' ');
4 12512 skrivtegn(answ,pos,ac+'@');
4 12513 while i<pos do
4 12514 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12515 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12516 skrivtegn(answ,pos, sum extract 4 + '@');
4 12517 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12518 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12519 disable begin
5 12520 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12521 outchar(zrl,'nl');
5 12522 end;
4 12523 <*-2*>
4 12524 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12525 disable setposition(z_fr_out,0,0);
4 12526 ac:= -1;
4 12527 end;
3 12528
3 12528 typ(1):= 0;
3 12529 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12530 rf:= 4;
3 12531 systime(1,0.0,val.rf);
3 12532 val.rf:= val.rf - 30.0;
3 12533 typ(3):= -1;
3 12534 repeat
3 12535 getch(cs_radio_ind,opref,true,typ,val);
3 12536 if opref>0 then
3 12537 begin
4 12538 d.opref.resultat:= 53; <*annuleret*>
4 12539 signalch(d.opref.retur,opref,d.opref.optype);
4 12540 end;
3 12541 until opref=0;
3 12542
3 12542 until false;
3 12543
3 12543 radio_ind_trap:
3 12544
3 12544 disable skriv_radio_ind(zbillede,1);
3 12545
3 12545 end radio_ind;
2 12546 \f
2 12546 message procedure radio_ud side 1 - 820301/hko;
2 12547
2 12547 procedure radio_ud(op);
2 12548 value op;
2 12549 integer op;
2 12550 begin
3 12551 integer array field opref,io_opref;
3 12552 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12553 integer array answ, tlgr(1:32);
3 12554 long array field laf;
3 12555
3 12555 procedure skriv_radio_ud(z,omfang);
3 12556 value omfang;
3 12557 zone z;
3 12558 integer omfang;
3 12559 begin integer i1;
4 12560 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12561 if omfang > 0 then
4 12562 disable begin real x; long array field tx;
5 12563 tx:= 0;
5 12564 trap(slut);
5 12565 write(z,"nl",1,
5 12566 <: opref: :>,opref,"nl",1,
5 12567 <: io-opref: :>,io_opref,"nl",1,
5 12568 <: opgave: :>,opgave,"nl",1,
5 12569 <: kode: :>,kode,"nl",1,
5 12570 <: pos: :>,pos,"nl",1,
5 12571 <: tegn: :>,tegn,"nl",1,
5 12572 <: i: :>,i,"nl",1,
5 12573 <: sum: :>,sum,"nl",1,
5 12574 <: rc: :>,rc,"nl",1,
5 12575 <: svar-status: :>,svar_status,"nl",1,
5 12576 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12577 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12578 <::>);
5 12579 skriv_coru(z,coru_no(402));
5 12580 slut:
5 12581 end; <*disable*>
4 12582 end skriv_radio_ud;
3 12583
3 12583 trap(radio_ud_trap);
3 12584 laf:= 0;
3 12585 stack_claim((if cm_test then 200 else 150) +35+100);
3 12586
3 12586 <*+2*>if testbit32 and overvåget or testbit28 then
3 12587 skriv_radio_ud(out,0);
3 12588 <*-2*>
3 12589
3 12589 io_opref:= op;
3 12590 \f
3 12590 message procedure radio_ud side 2 - 810529/hko;
3 12591
3 12591 repeat
3 12592
3 12592 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12593 kode:= d.op_ref.opkode;
3 12594 opgave:= kode shift(-12);
3 12595 kode:= kode extract 12;
3 12596 if opgave < 'A' or opgave > 'I' then
3 12597 begin
4 12598 d.opref.resultat:= 31;
4 12599 end
3 12600 else
3 12601 begin
4 12602 pos:= 1;
4 12603 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12604 begin
5 12605 skrivtegn(tlgr,pos,opgave);
5 12606 if d.opref.data(1) = 0 then
5 12607 begin
6 12608 skrivtegn(tlgr,pos,'G');
6 12609 skrivtegn(tlgr,pos,'A');
6 12610 end
5 12611 else
5 12612 begin
6 12613 skrivtegn(tlgr,pos,'D');
6 12614 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 12615 end;
5 12616 if opgave='A' then
5 12617 begin
6 12618 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 12619 end
5 12620 else
5 12621 if opgave='B' then
5 12622 begin
6 12623 skrivtegn(tlgr,pos,d.opref.data(2));
6 12624 if d.opref.data(2)='V' then
6 12625 begin
7 12626 skrivtegn(tlgr,pos,
7 12627 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 12628 skrivtegn(tlgr,pos,
7 12629 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 12630 end;
6 12631 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 12632 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 12633 end
5 12634 else
5 12635 if opgave='H' then
5 12636 begin
6 12637 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 12638 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 12639 hægtstring(tlgr,pos,<:@@@:>);
6 12640 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 12641 skrivtegn(tlgr,pos,'A');
6 12642 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 12643 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 12644 if d.opref.data(2)='L' then
6 12645 begin
7 12646 if d.opref.data(5)=7 then
7 12647 begin
8 12648 anbringtal(tlgr,pos,
8 12649 d.opref.data(8) shift (-12) extract 10,-4);
8 12650 anbringtal(tlgr,pos,
8 12651 d.opref.data(8) extract 7,-2);
8 12652 end
7 12653 else
7 12654 if d.opref.data(5)=8 then
7 12655 begin
8 12656 hægtstring(tlgr,pos,<:FFFFFF:>);
8 12657 end;
7 12658 if d.opref.data(5)<>9 then
7 12659 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 12660 skrivtegn(tlgr,pos,
7 12661 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 12662 skrivtegn(tlgr,pos,
7 12663 dec_to_hex(d.opref.data(6) extract 4));
7 12664 skrivtegn(tlgr,10,pos-11+'@');
7 12665 end;
6 12666 end;
5 12667 end
4 12668 else
4 12669 if opgave='I' then
4 12670 begin
5 12671 hægtstring(tlgr,pos,<:IGA:>);
5 12672 end
4 12673 else d.opref.resultat:= 31; <*systemfejl*>
4 12674 end;
3 12675 \f
3 12675 message procedure radio_ud side 3 - 881107/cl;
3 12676
3 12676 if d.opref.resultat=0 then
3 12677 begin
4 12678 if (opgave <= 'B')
4 12679 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 12680 begin
5 12681 systime(1,0,d.opref.tid);
5 12682 signalch(cs_radio_ind,opref,d.opref.optype);
5 12683 opref:= 0;
5 12684 end;
4 12685 <* beregn checksum og send *>
4 12686 i:= 1; sum:= 0;
4 12687 while i < pos do
4 12688 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 12689 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 12690 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 12691 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 12692 <**********************************************>
4 12693 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 12694
4 12694 if opgave='B' then delay(1);
4 12695
4 12695 <* 94.04.19/cl *>
4 12696 <**********************************************>
4 12697
4 12697 <*+2*> if (testbit36 or testbit39) and overvåget then
4 12698 disable begin
5 12699 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 12700 outchar(zrl,'nl');
5 12701 end;
4 12702 <*-2*>
4 12703 setposition(z_rf_in,0,0);
4 12704 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 12705 disable setposition(z_rf_out,0,0);
4 12706 rc:= 0;
4 12707
4 12707 <* afvent svar*>
4 12708 repeat
4 12709 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 12710 if svar_status=6 then
4 12711 begin
5 12712 svar_status:= -3;
5 12713 goto radio_ud_check;
5 12714 end;
4 12715 pos:= 1;
4 12716 while læstegn(answ,pos,i)<>0 do ;
4 12717 pos:= pos-2;
4 12718 if pos > 0 then
4 12719 begin
5 12720 if pos<3 then
5 12721 svar_status:= -2 <*format error*>
5 12722 else
5 12723 begin
6 12724 if læstegn(answ,3,tegn)<>'@' then
6 12725 svar_status:= tegn - '@'
6 12726 else
6 12727 begin
7 12728 pos:= 1;
7 12729 læstegn(answ,pos,tegn);
7 12730 if tegn<>opgave then
7 12731 svar_status:= -4 <*gal type*>
7 12732 else
7 12733 if læstegn(answ,pos,tegn)<>' ' then
7 12734 svar_status:= -tegn <*fejl*>
7 12735 else
7 12736 svar_status:= læstegn(answ,pos,tegn)-'@';
7 12737 end;
6 12738 end;
5 12739 end
4 12740 else
4 12741 svar_status:= -1;
4 12742 \f
4 12742 message procedure radio_ud side 5 - 881107/cl;
4 12743
4 12743 radio_ud_check:
4 12744 rc:= rc+1;
4 12745 if -3<=svar_status and svar_status< -1 then
4 12746 disable begin
5 12747 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 12748 setposition(z_rf_out,0,0);
5 12749 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12750 begin
6 12751 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 12752 outchar(zrl,'nl');
6 12753 end;
5 12754 <*-2*>
5 12755 end
4 12756 else
4 12757 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 12758 disable begin
5 12759 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 12760 setposition(z_rf_out,0,0);
5 12761 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12762 begin
6 12763 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 12764 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 12765 end;
5 12766 <*-2*>
5 12767 end
4 12768 else
4 12769 if svar_status=0 and opref<>0 then
4 12770 d.opref.resultat:= 0
4 12771 else
4 12772 if opref<>0 then
4 12773 d.opref.resultat:= 31;
4 12774 until svar_status=0 or rc>3;
4 12775 end;
3 12776 if opref<>0 then
3 12777 begin
4 12778 if svar_status<>0 and rc>3 then
4 12779 d.opref.resultat:= 53; <* annulleret *>
4 12780 signalch(d.opref.retur,opref,d.opref.optype);
4 12781 opref:= 0;
4 12782 end;
3 12783 until false;
3 12784
3 12784 radio_ud_trap:
3 12785
3 12785 disable skriv_radio_ud(zbillede,1);
3 12786
3 12786 end radio_ud;
2 12787 \f
2 12787 message procedure radio_medd_opkald side 1 - 810610/hko;
2 12788
2 12788 procedure radio_medd_opkald;
2 12789 begin
3 12790 integer array field ref,op_ref;
3 12791 integer i;
3 12792
3 12792 procedure skriv_radio_medd_opkald(z,omfang);
3 12793 value omfang;
3 12794 zone z;
3 12795 integer omfang;
3 12796 begin integer x;
4 12797 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 12798 write(z,"sp",26-x);
4 12799 if omfang > 0 then
4 12800 disable begin
5 12801 trap(slut);
5 12802 write(z,"nl",1,
5 12803 <: ref: :>,ref,"nl",1,
5 12804 <: opref: :>,op_ref,"nl",1,
5 12805 <: i: :>,i,"nl",1,
5 12806 <::>);
5 12807 skriv_coru(z,abs curr_coruno);
5 12808 slut:
5 12809 end;<*disable*>
4 12810 end skriv_radio_medd_opkald;
3 12811
3 12811 trap(radio_medd_opkald_trap);
3 12812
3 12812 stack_claim((if cm_test then 200 else 150) +1);
3 12813
3 12813 <*+2*>if testbit32 and overvåget or testbit28 then
3 12814 disable skriv_radio_medd_opkald(out,0);
3 12815 <*-2*>
3 12816 \f
3 12816 message procedure radio_medd_opkald side 2 - 820301/hko;
3 12817
3 12817 repeat
3 12818
3 12818 <*V*> wait(bs_mobil_opkald);
3 12819 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 12820 <*V*> wait(bs_opkaldskø_adgang);
3 12821
3 12821 ref:= første_nød_opkald;
3 12822 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 12823 begin
4 12824 i:= opkaldskø.ref(2);
4 12825 if i < 0 then
4 12826 begin
5 12827 <* nødopkald ikke meldt *>
5 12828
5 12828 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 12829 d.op_ref.data(1):= <* vogn_id *>
5 12830 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 12831 opkaldskø.ref(2):= i extract 22;
5 12832 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 12833 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 12834 i:= op_ref;
5 12835 <*+2*> if testbit35 and overvåget then
5 12836 disable begin
6 12837 write(out,"nl",1,<:radio nød-medd:>);
6 12838 skriv_op(out,op_ref);
6 12839 ud;
6 12840 end;
5 12841 <*-2*>
5 12842 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 12843 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 12844 <*+4*> if i <> op_ref then
5 12845 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 12846 <*-4*>
5 12847 end;<*nødopkald ikke meldt*>
4 12848
4 12848 ref:= opkaldskø.ref(1) extract 12;
4 12849 end; <* melding til io *>
3 12850 \f
3 12850 message procedure radio_medd_opkald side 3 - 820304/hko;
3 12851
3 12851 start_operation(op_ref,403,cs_radio_medd,
3 12852 40<*opdater opkaldskøbill*>);
3 12853 signal_bin(bs_opkaldskø_adgang);
3 12854 <*+2*> if testbit35 and overvåget then
3 12855 disable begin
4 12856 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 12857 skriv_op(out,op_ref);
4 12858 write(out, <:opkaldsflag: :>,"nl",1);
4 12859 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 12860 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 12861 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 12862 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 12863 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 12864 ud;
4 12865 end;
3 12866 <*-2*>
3 12867 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 12868
3 12868 until false;
3 12869
3 12869 radio_medd_opkald_trap:
3 12870
3 12870 disable skriv_radio_medd_opkald(zbillede,1);
3 12871
3 12871 end radio_medd_opkald;
2 12872 \f
2 12872 message procedure radio_adm side 1 - 820301/hko;
2 12873
2 12873 procedure radio_adm(op);
2 12874 value op;
2 12875 integer op;
2 12876 begin
3 12877 integer array field opref, rad_op, iaf;
3 12878 integer nr,i,j,k,res,opgave,tilst,operatør;
3 12879
3 12879 procedure skriv_radio_adm(z,omfang);
3 12880 value omfang;
3 12881 zone z;
3 12882 integer omfang;
3 12883 begin integer i1;
4 12884 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 12885 write(z,"sp",26-i1);
4 12886 if omfang > 0 then
4 12887 disable begin real x;
5 12888 trap(slut);
5 12889 \f
5 12889 message procedure radio_adm side 2- 820301/hko;
5 12890
5 12890 write(z,"nl",1,
5 12891 <: op_ref: :>,op_ref,"nl",1,
5 12892 <: iaf: :>,iaf,"nl",1,
5 12893 <: rad-op: :>,rad_op,"nl",1,
5 12894 <: nr: :>,nr,"nl",1,
5 12895 <: i: :>,i,"nl",1,
5 12896 <: j: :>,j,"nl",1,
5 12897 <: k: :>,k,"nl",1,
5 12898 <: tilst: :>,tilst,"nl",1,
5 12899 <: res: :>,res,"nl",1,
5 12900 <: opgave: :>,opgave,"nl",1,
5 12901 <: operatør: :>,operatør,"nl",1);
5 12902 skriv_coru(z,coru_no(404));
5 12903 slut:
5 12904 end;<*disable*>
4 12905 end skriv_radio_adm;
3 12906 \f
3 12906 message procedure radio_adm side 3 - 820304/hko;
3 12907
3 12907 rad_op:= op;
3 12908
3 12908 trap(radio_adm_trap);
3 12909 stack_claim((if cm_test then 200 else 150) +50);
3 12910
3 12910 <*+2*>if testbit32 and overvåget or testbit28 then
3 12911 skriv_radio_adm(out,0);
3 12912 <*-2*>
3 12913
3 12913 pass;
3 12914 if -,testbit22 then
3 12915 begin
4 12916 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 12917 signalch(cs_radio_ud,rad_op,rad_optype);
4 12918 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 12919 end;
3 12920 repeat
3 12921 waitch(cs_radio_adm,opref,true,-1);
3 12922 <*+2*>
3 12923 if testbit33 and overvåget then
3 12924 disable begin
4 12925 skriv_radio_adm(out,0);
4 12926 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 12927 skriv_op(out,opref);
4 12928 end;
3 12929 <*-2*>
3 12930
3 12930 k:= d.op_ref.opkode extract 12;
3 12931 opgave:= d.opref.opkode shift (-12);
3 12932 nr:=operatør:=d.op_ref.data(1);
3 12933
3 12933 <*+4*> if (d.op_ref.optype and
3 12934 (gen_optype or io_optype or op_optype or vt_optype))
3 12935 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 12936 <:radio_adm:>,0);
3 12937 <*-4*>
3 12938 if k = 74 <* RA,I *> then
3 12939 begin
4 12940 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 12941 signalch(cs_radio_ud,rad_op,rad_optype);
4 12942 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 12943 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 12944 else d.rad_op.resultat;
4 12945 signalch(d.opref.retur,opref,d.opref.optype);
4 12946 \f
4 12946 message procedure radio_adm side 4 - 820301/hko;
4 12947 end
3 12948 else
3 12949
3 12949 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 12950 k = 5<*FO,L*> or k = 6<*ST *> then
3 12951 begin
4 12952 if k = 5 or k=77 then
4 12953 begin
5 12954
5 12954 <*V*> wait(bs_opkaldskø_adgang);
5 12955 if k=5 then
5 12956 begin
6 12957 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 12958 begin
7 12959 i:= læs_fil(1035,iaf//512+1,nr);
7 12960 if i <> 0 then
7 12961 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 12962 tofrom(radio_linietabel.iaf,fil(nr),
7 12963 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 12964 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 12965 end;
6 12966
6 12966 for i:= 1 step 1 until max_antal_mobilopkald do
6 12967 begin
7 12968 iaf:= i*opkaldskø_postlængde;
7 12969 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 12970 if nr>0 then
7 12971 begin
8 12972 læs_tegn(radio_linietabel,nr+1,operatør);
8 12973 if operatør>max_antal_operatører then operatør:= 0;
8 12974 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 12975 operatør;
8 12976 end;
7 12977 end;
6 12978 end
5 12979 else
5 12980 if k=77 then
5 12981 begin
6 12982 disable i:= læsfil(1034,1,nr);
6 12983 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 12984 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 12985 for i:= 1 step 1 until max_antal_mobilopkald do
6 12986 begin
7 12987 iaf:= i*opkaldskø_postlængde;
7 12988 nr:= opkaldskø.iaf(5) extract 4;
7 12989 operatør:= radio_områdetabel(nr);
7 12990 if operatør < 0 or max_antal_operatører < operatør then
7 12991 operatør:= 0;
7 12992 if opkaldskø.iaf(4) extract 8=0 and
7 12993 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 12994 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 12995 operatør;
7 12996 end;
6 12997 end;
5 12998
5 12998 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 12999 signal_bin(bs_opkaldskø_adgang);
5 13000
5 13000 signal_bin(bs_mobil_opkald);
5 13001
5 13001 d.op_ref.resultat:= res:= 3;
5 13002 \f
5 13002 message procedure radio_adm side 5 - 820304/hko;
5 13003
5 13003 end <*k = 5 / k = 77*>
4 13004 else
4 13005 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13006 res:= 3;
5 13007 for nr:= 1 step 1 until max_antal_kanaler do
5 13008 begin
6 13009 iaf:= (nr-1)*kanal_beskr_længde;
6 13010 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13011 op_talevej(operatør) then
6 13012 begin
7 13013 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13014 if tilst <> 0 then
7 13015 res:= 16; <*skærm optaget*>
7 13016 end; <* kanal_tab(operatør) = operatør*>
6 13017 end;
5 13018 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13019 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13020 signal_bin(bs_mobil_opkald);
5 13021 d.op_ref.resultat:= res;
5 13022 end;<*k=1,2 eller 6 *>
4 13023
4 13023 <*+2*> if testbit35 and overvåget then
4 13024 disable begin
5 13025 skriv_radio_adm(out,0);
5 13026 write(out,<: sender til :>,
5 13027 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13028 else cs_op);
5 13029 skriv_op(out,op_ref);
5 13030 end;
4 13031 <*-2*>
4 13032
4 13032 if k=5 or k=6 or k=77 or res > 3 then
4 13033 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13034 else
4 13035 begin <*k = (1 eller 2) og res = 3 *>
5 13036 d.op_ref.resultat:=0;
5 13037 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13038 end;
4 13039 \f
4 13039 message procedure radio_adm side 6 - 816610/hko;
4 13040
4 13040 end <*k=1,2,5 eller 6*>
3 13041 else
3 13042 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13043 begin
4 13044 nr:= d.op_ref.data(1);
4 13045 res:= 3;
4 13046
4 13046 if nr<=3 then
4 13047 res:= 51 <* afvist *>
4 13048 else
4 13049 begin
5 13050
5 13050 <* gennemstilling af område *>
5 13051 j:= 1;
5 13052 for i:= 1 step 1 until max_antal_kanaler do
5 13053 begin
6 13054 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13055 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13056 end;
5 13057 nr:= j;
5 13058 iaf:= (nr-1)*kanalbeskrlængde;
5 13059 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13060 begin
6 13061 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13062 d.rad_op.data(1):= 0;
6 13063 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13064 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13065 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13066 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13067 signalch(cs_radio_ud,rad_op,rad_optype);
6 13068 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13069 res:= d.rad_op.resultat;
6 13070 if res=0 then res:= 3;
6 13071 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13072 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13073 end;
5 13074 end;
4 13075 d.op_ref.resultat:=res;
4 13076 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13077 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13078 signal_bin(bs_mobil_opkald);
4 13079 \f
4 13079 message procedure radio_adm side 7 - 880930/cl;
4 13080
4 13080
4 13080 end <* k=3 eller 4 *>
3 13081 else
3 13082 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13083 begin
4 13084 nr:= d.opref.data(1) extract 22;
4 13085 res:= 3;
4 13086 iaf:= (nr-1)*kanalbeskrlængde;
4 13087 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13088 d.rad_op.data(1):= 0;
4 13089 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13090 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13091 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13092 d.rad_op.data(5):= k extract 1;
4 13093 signalch(cs_radio_ud,radop,rad_optype);
4 13094 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13095 res:= d.radop.resultat;
4 13096 if res=0 then res:= 3;
4 13097 j:= if k=72 then 15 else 0;
4 13098 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13099 begin
5 13100 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13101 signalbin(bs_mobilopkald);
5 13102 end;
4 13103 d.opref.resultat:= res;
4 13104 signalch(d.opref.retur,opref,d.opref.optype);
4 13105 end
3 13106 else
3 13107 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13108 begin
4 13109 nr:= d.opref.data(1) extract 8;
4 13110 opgave:= if k=19 then 9 else (k-4);
4 13111 if nr<=3 then
4 13112 res:= 51 <*afvist*>
4 13113 else
4 13114 begin
5 13115 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13116 d.radop.data(1):= 0;
5 13117 d.radop.data(2):= 'L';
5 13118 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13119 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13120 d.radop.data(5):= opgave;
5 13121 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13122 d.radop.data(7):= d.opref.data(2);
5 13123 d.radop.data(8):= d.opref.data(3);
5 13124 signalch(cs_radio_ud,radop,rad_optype);
5 13125 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13126 res:= d.radop.resultat;
5 13127 if res=0 then res:= 3;
5 13128 end;
4 13129 d.opref.resultat:= res;
4 13130 signalch(d.opref.retur,opref,d.opref.optype);
4 13131 end
3 13132 else
3 13133
3 13133 begin
4 13134
4 13134 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13135
4 13135 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13136
4 13136 end;
3 13137
3 13137 until false;
3 13138 radio_adm_trap:
3 13139 disable skriv_radio_adm(zbillede,1);
3 13140 end radio_adm;
2 13141
2 13141 \f
2 13141 message vogntabel erklæringer side 1 - 820301/cl;
2 13142
2 13142 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13143 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13144 cs_vt_log;
2 13145 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13146 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13147 vt_log_slicelgd;
2 13148 integer array bustabel,bustabel1(0:max_antal_busser),
2 13149 linie_løb_tabel(0:max_antal_linie_løb),
2 13150 springtabel(1:max_antal_spring,1:3),
2 13151 gruppetabel(1:max_antal_grupper),
2 13152 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13153 vt_logop(1:2),
2 13154 vt_logdisc(1:4),
2 13155 vt_log_tail(1:10);
2 13156 boolean array busindeks(-1:max_antal_linie_løb),
2 13157 bustilstand(-1:max_antal_busser),
2 13158 linie_løb_indeks(-1:max_antal_busser);
2 13159 real array springtid,springstart(1:max_antal_spring);
2 13160 real vt_logstart;
2 13161 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13162 integer array field v_tekst;
2 13163 real field v_tid;
2 13164
2 13164 zone zvtlog(128,1,stderror);
2 13165
2 13165 \f
2 13165 message vogntabel erklæringer side 2 - 851001/cl;
2 13166
2 13166 procedure skriv_vt_variable(zud);
2 13167 zone zud;
2 13168 begin integer i; long array field laf;
3 13169 laf:= 0;
3 13170 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13171 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13172 <:cs-vt :>,cs_vt,"nl",1,
3 13173 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13174 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13175 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13176 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13177 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13178 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13179 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13180 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13181 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13182 <:vt-op :>,vt_op,"nl",1,
3 13183 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13184 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13185 <:sidste-bus :>,sidste_bus,"nl",1,
3 13186 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13187 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13188 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13189 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13190 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13191 <:tf-springdef :>,tf_springdef,"nl",1,
3 13192 <:vt-logskift :>,vt_logskift,"nl",1,
3 13193 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13194 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13195 <:vt-log-aktiv :>,
3 13196 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13197 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13198 <::>);
3 13199 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13200 laf:= 2;
3 13201 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13202 for i:= 6 step 1 until 10 do
3 13203 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13204 write(zud,"nl",1);
3 13205 end;
2 13206 \f
2 13206 message procedure p_vogntabel side 1 - 820301/cl;
2 13207
2 13207 procedure p_vogntabel(z);
2 13208 zone z;
2 13209 begin
3 13210 integer i,b,s,o,t,li,lb,lø,g;
3 13211 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13212 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13213 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13214 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13215
3 13215 for i:= 1 step 1 until sidste_bus do
3 13216 begin
4 13217 b:= bustabel(i) extract 14;
4 13218 g:= bustabel(i) shift (-14);
4 13219 s:= bustabel1(i) shift (-23);
4 13220 o:= bustabel1(i) extract 8;
4 13221 t:= intg(bustilstand(i));
4 13222 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13223 lø:= li extract 7;
4 13224 lb:= li shift (-7) extract 5;
4 13225 lb:= if lb=0 then 32 else lb+64;
4 13226 li:= li shift (-12) extract 10;
4 13227 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13228 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13229 if g > 0 then string bpl_navn(g) else <: :>,
4 13230 ";",1,true,4,string område_navn(o),
4 13231 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13232 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13233 end;
3 13234 end p_vogntabel;
2 13235 \f
2 13235 message procedure p_gruppetabel side 1 - 810531/cl;
2 13236
2 13236 procedure p_gruppetabel(z);
2 13237 zone z;
2 13238 begin
3 13239 integer i,nr,bogst;
3 13240 boolean spc_gr;
3 13241 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13242 <:max-antal-grupper =:>,max_antal_grupper,
3 13243 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13244 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13245 <:gruppetabel::>);
3 13246 for i:= 1 step 1 until max_antal_grupper do
3 13247 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13248 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13249 gruppetabel(i) extract 7);
3 13250 write(z,"nl",2,<:gruppeopkald::>);
3 13251 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13252 begin
4 13253 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13254 if gruppeopkald(i,1) = 0 then
4 13255 write(z,"sp",11)
4 13256 else
4 13257 begin
5 13258 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13259 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13260 else
5 13261 begin
6 13262 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13263 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13264 if bogst = '@' then bogst:= 'sp';
6 13265 end;
5 13266 if spc_gr then
5 13267 write(z,<:(G:>,<<d>,true,3,nr)
5 13268 else
5 13269 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13270 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13271 end;
4 13272 end;
3 13273 end p_gruppetabel;
2 13274 \f
2 13274 message procedure p_springtabel side 1 - 810519/cl;
2 13275
2 13275 procedure p_springtabel(z);
2 13276 zone z;
2 13277 begin
3 13278 integer li,bo,max,st,nr;
3 13279 long indeks;
3 13280 real t;
3 13281
3 13281 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13282 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13283 <:nr spring-id max status næste-tid:>,"nl",1);
3 13284 for nr:= 1 step 1 until max_antal_spring do
3 13285 begin
4 13286 write(z,<<dd>,nr);
4 13287 <* if springtabel(nr,1)<>0 then *>
4 13288 begin
5 13289 li:= springtabel(nr,1) shift (-5) extract 10;
5 13290 bo:= springtabel(nr,1) extract 5;
5 13291 if bo<>0 then bo:= bo + 'A' - 1;
5 13292 indeks:= extend springtabel(nr,2) shift 24;
5 13293 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13294 max:= springtabel(nr,3) extract 12;
5 13295 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13296 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13297 if springtid(nr)<>0.0 then
5 13298 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13299 else
5 13300 write(z,<< d.d >,0.0);
5 13301 if springstart(nr)<>0.0 then
5 13302 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13303 else
5 13304 write(z,<< d.d >,0.0);
5 13305 end
4 13306 <* else
4 13307 write(z,<: --------:>)*>;
4 13308 write(z,"nl",1);
4 13309 end;
3 13310 end p_springtabel;
2 13311 \f
2 13311 message procedure find_busnr side 1 - 820301/cl;
2 13312
2 13312 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13313 value ll_id;
2 13314 integer ll_id, busnr, garage, tilst;
2 13315 begin
3 13316 integer i,j;
3 13317
3 13317 j:= binærsøg(sidste_linie_løb,
3 13318 (linie_løb_tabel(i) - ll_id), i);
3 13319 if j<>0 then <* linie/løb findes ikke *>
3 13320 begin
4 13321 find_busnr:= -1;
4 13322 busnr:= 0;
4 13323 garage:= 0;
4 13324 tilst:= 0;
4 13325 end
3 13326 else
3 13327 begin
4 13328 busnr:= bustabel(busindeks(i) extract 12);
4 13329 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13330 garage:= busnr shift (-14);
4 13331 busnr:= busnr extract 14;
4 13332 find_busnr:= busindeks(i) extract 12;
4 13333 end;
3 13334 end find_busnr;
2 13335 \f
2 13335 message procedure søg_omr_bus side 1 - 881027/cl;
2 13336
2 13336
2 13336 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13337 value bus;
2 13338 integer bus,ll,gar,omr,sig,tilst;
2 13339 begin
3 13340 integer i,j,nr,bu,bi,bl;
3 13341
3 13341 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13342 nr:= -1;
3 13343 if j=0 then
3 13344 begin
4 13345 bl:= bu:= bi;
4 13346 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13347 while bu<sidste_bus and
4 13348 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13349
4 13349 if bl<>bu then
4 13350 begin
5 13351 <* flere busser med samme tekniske nr. omr skal passe *>
5 13352 nr:= -2;
5 13353 for bi:= bl step 1 until bu do
5 13354 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13355 end
4 13356 else
4 13357 nr:= bi;
4 13358 end;
3 13359
3 13359 if nr<0 then
3 13360 begin
4 13361 <* bus findes ikke *>
4 13362 ll:= gar:= tilst:= sig:= 0;
4 13363 end
3 13364 else
3 13365 begin
4 13366 tilst:= intg(bustilstand(nr));
4 13367 gar:= bustabel(nr) shift (-14);
4 13368 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13369 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13370 sig:= bustabel1(nr) shift (-23);
4 13371 end;
3 13372 søg_omr_bus:= nr;
3 13373 end;
2 13374 \f
2 13374 message procedure find_linie_løb side 1 - 820301/cl;
2 13375
2 13375 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13376 value busnr;
2 13377 integer busnr, linie_løb, garage, tilst;
2 13378 begin
3 13379 integer i,j;
3 13380
3 13380 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13381
3 13381 if j<>0 then <* bus findes ikke *>
3 13382 begin
4 13383 find_linie_løb:= -1;
4 13384 linie_løb:= 0;
4 13385 garage:= 0;
4 13386 tilst:= 0;
4 13387 end
3 13388 else
3 13389 begin
4 13390 tilst:= intg(bustilstand(i));
4 13391 garage:= bustabel(i) shift (-14);
4 13392 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13393 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13394 end;
3 13395 end find_linie_løb;
2 13396 \f
2 13396 message procedure h_vogntabel side 1 - 810413/cl;
2 13397
2 13397 <* hovedmodulcorutine for vogntabelmodul *>
2 13398
2 13398 procedure h_vogntabel;
2 13399 begin
3 13400 integer array field op;
3 13401 integer dest_sem,k;
3 13402
3 13402 procedure skriv_h_vogntabel(zud,omfang);
3 13403 value omfang;
3 13404 zone zud;
3 13405 integer omfang;
3 13406 begin
4 13407 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13408 if omfang<>0 then
4 13409 disable
4 13410 begin
5 13411 skriv_coru(zud,abs curr_coruno);
5 13412 write(zud,"nl",1,<<d>,
5 13413 <:cs-vt :>,cs_vt,"nl",1,
5 13414 <:op :>,op,"nl",1,
5 13415 <:dest-sem :>,dest_sem,"nl",1,
5 13416 <:k :>,k,"nl",1,
5 13417 <::>);
5 13418 end;
4 13419 end;
3 13420 \f
3 13420 message procedure h_vogntabel side 2 - 820301/cl;
3 13421
3 13421 stackclaim(if cm_test then 198 else 146);
3 13422 trap(h_vt_trap);
3 13423
3 13423 <*+2*>
3 13424 <**> disable if testbit47 and overvåget or testbit28 then
3 13425 <**> skriv_h_vogntabel(out,0);
3 13426 <*-2*>
3 13427
3 13427 repeat
3 13428 waitch(cs_vt,op,true,-1);
3 13429 <*+4*>
3 13430 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13431 (d.op.optype and vt_optype) extract 12 = 0 then
3 13432 fejlreaktion(12,op,<:vogntabel:>,0);
3 13433 <*-4*>
3 13434 disable
3 13435 begin
4 13436
4 13436 k:= d.op.opkode extract 12;
4 13437 dest_sem:=
4 13438 if k = 9 then cs_vt_rap else
4 13439 if k = 10 then cs_vt_rap else
4 13440 if k = 11 then cs_vt_opd else
4 13441 if k = 12 then cs_vt_opd else
4 13442 if k = 13 then cs_vt_opd else
4 13443 if k = 14 then cs_vt_tilst else
4 13444 if k = 15 then cs_vt_tilst else
4 13445 if k = 16 then cs_vt_tilst else
4 13446 if k = 17 then cs_vt_tilst else
4 13447 if k = 18 then cs_vt_tilst else
4 13448 if k = 19 then cs_vt_opd else
4 13449 if k = 20 then cs_vt_opd else
4 13450 if k = 21 then cs_vt_auto else
4 13451 if k = 24 then cs_vt_opd else
4 13452 if k = 25 then cs_vt_grp else
4 13453 if k = 26 then cs_vt_grp else
4 13454 if k = 27 then cs_vt_grp else
4 13455 if k = 28 then cs_vt_grp else
4 13456 if k = 30 then cs_vt_spring else
4 13457 if k = 31 then cs_vt_spring else
4 13458 if k = 32 then cs_vt_spring else
4 13459 if k = 33 then cs_vt_spring else
4 13460 if k = 34 then cs_vt_spring else
4 13461 if k = 35 then cs_vt_spring else
4 13462 -1;
4 13463 \f
4 13463 message procedure h_vogntabel side 3 - 810422/cl;
4 13464
4 13464 <*+2*>
4 13465 <**> if testbit41 and overvåget then
4 13466 <**> begin
5 13467 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13468 <**> skriv_op(out,op);
5 13469 <**> end;
4 13470 <*-2*>
4 13471 end;
3 13472
3 13472 if dest_sem = -1 then
3 13473 fejlreaktion(2,k,<:vogntabel:>,0);
3 13474 disable signalch(dest_sem,op,d.op.optype);
3 13475 until false;
3 13476 h_vt_trap:
3 13477 disable skriv_h_vogntabel(zbillede,1);
3 13478 end h_vogntabel;
2 13479 \f
2 13479 message procedure vt_opdater side 1 - 810317/cl;
2 13480
2 13480 procedure vt_opdater(op1);
2 13481 value op1;
2 13482 integer op1;
2 13483 begin
3 13484 integer array field op,radop;
3 13485 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13486 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13487 flin,slin,finx,sinx;
3 13488 integer field bn,ll;
3 13489
3 13489 procedure skriv_vt_opd(zud,omfang);
3 13490 value omfang; integer omfang;
3 13491 zone zud;
3 13492 begin
4 13493 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13494 if omfang <> 0 then
4 13495 disable
4 13496 begin
5 13497 skriv_coru(zud,abs curr_coruno);
5 13498 write(zud,"nl",1,
5 13499 <: op: :>,op,"nl",1,
5 13500 <: radop::>,radop,"nl",1,
5 13501 <: funk: :>,funk,"nl",1,
5 13502 <: res: :>,res,"nl",1,
5 13503 <::>);
5 13504 end;
4 13505 end skriv_vt_opd;
3 13506
3 13506 integer procedure opd_omr(fnk,omr,bus,ll);
3 13507 value fnk,omr,bus,ll;
3 13508 integer fnk,omr,bus,ll;
3 13509 begin
4 13510 opd_omr:= 3;
4 13511 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13512 ændringer skal ikke længere meldes til yderområder *>
4 13513 goto dummy_retur;
4 13514
4 13514 if omr extract 8 > 3 then
4 13515 begin
5 13516 startoperation(radop,501,cs_vt_opd,fnk);
5 13517 d.radop.data(1):= omr;
5 13518 d.radop.data(2):= bus;
5 13519 d.radop.data(3):= ll;
5 13520 signalch(cs_rad,radop,vt_optype);
5 13521 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13522 opd_omr:= d.radop.resultat;
5 13523 end
4 13524 else
4 13525 opd_omr:= 0;
4 13526 dummy_retur:
4 13527 end;
3 13528 message procedure vt_opdater side 1a - 920517/cl;
3 13529
3 13529 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13530 value kilde,kode,bus,ll1,ll2;
3 13531 integer kilde,kode,bus,ll1,ll2;
3 13532 begin
4 13533 integer array field op;
4 13534
4 13534 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13535
4 13535 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13536 systime(1,0.0,d.op.data.v_tid);
4 13537 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13538 d.op.data.v_bus:= bus;
4 13539 d.op.data.v_ll1:= ll1;
4 13540 d.op.data.v_ll2:= ll2;
4 13541 signalch(cs_vt_log,op,vt_optype);
4 13542 end;
3 13543
3 13543 stackclaim((if cm_test then 198 else 146)+125);
3 13544
3 13544 bn:= 4; ll:= 2;
3 13545 radop:= op1;
3 13546 trap(vt_opd_trap);
3 13547
3 13547 <*+2*>
3 13548 <**> disable if testbit47 and overvåget or testbit28 then
3 13549 <**> skriv_vt_opd(out,0);
3 13550 <*-2*>
3 13551 \f
3 13551 message procedure vt_opdater side 2 - 851001/cl;
3 13552
3 13552 vent_op:
3 13553 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13554
3 13554 <*+2*>
3 13555 <**> disable
3 13556 <**> if testbit41 and overvåget then
3 13557 <**> begin
4 13558 <**> skriv_vt_opd(out,0);
4 13559 <**> write(out,<: modtaget operation:>);
4 13560 <**> skriv_op(out,op);
4 13561 <**> end;
3 13562 <*-2*>
3 13563
3 13563 <*+4*>
3 13564 <**>if op<>vt_op then
3 13565 <**>begin
4 13566 <**> disable begin
5 13567 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13568 <**> d.op.resultat:= 31; <*systemfejl*>
5 13569 <**> signalch(d.op.retur,op,d.op.optype);
5 13570 <**> end;
4 13571 <**> goto vent_op;
4 13572 <**>end;
3 13573 <*-4*>
3 13574 disable
3 13575 begin integer opk;
4 13576
4 13576 opk:= d.op.opkode extract 12;
4 13577 funk:= if opk=11 then 1 else
4 13578 if opk=12 then 2 else
4 13579 if opk=13 then 3 else
4 13580 if opk=19 then 4 else
4 13581 if opk=20 then 5 else
4 13582 if opk=24 then 6 else
4 13583 0;
4 13584 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13585 end;
3 13586 res:= 0;
3 13587 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13588 \f
3 13588 message procedure vt_opdater side 3 - 820301/cl;
3 13589
3 13589 indsæt:
3 13590 begin
4 13591 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13592 <*+4*>
4 13593 <**> if d.op.data(1) shift (-22) <> 0 then
4 13594 <**> begin
5 13595 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13596 <**> goto slut_indsæt;
5 13597 <**> end;
4 13598 <*-4*>
4 13599 busnr:= d.op.data(1) extract 14;
4 13600 <*+4*>
4 13601 <**> if d.op.data(2) shift (-22) <> 1 then
4 13602 <**> begin
5 13603 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13604 <**> goto slut_indsæt;
5 13605 <**> end;
4 13606 <*-4*>
4 13607 ll_id:= d.op.data(2);
4 13608 s:= omr:= d.op.data(4) extract 8;
4 13609 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13610 if bi<0 then
4 13611 begin
5 13612 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13613 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13614 end
4 13615 else
4 13616 if s<>0 and s<>omr then
4 13617 res:= 58 <* ulovligt område for bus *>
4 13618 else
4 13619 if intg(bustilstand(bi)) <> 0 then
4 13620 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 13621 else 14 <* optaget *>)
4 13622 else
4 13623 begin
5 13624 if linie_løb_indeks(bi) extract 12 <> 0 then
5 13625 begin <* linie/løb allerede indsat *>
6 13626 res:= 11;
6 13627 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 13628 end
5 13629 else
5 13630 begin
6 13631 \f
6 13631 message procedure vt_opdater side 3a - 900108/cl;
6 13632
6 13632 if d.op.kilde//100 <> 4 then
6 13633 res:= opd_omr(11,gar shift 8 +
6 13634 bustabel1(bi) extract 8,busnr,ll_id);
6 13635 if res>3 then goto slut_indsæt;
6 13636 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 13637 if s=0 then <* linie/løb findes allerede *>
6 13638 begin
7 13639 sig:= busindeks(li) extract 12;
7 13640 d.op.data(3):= bustabel(sig);
7 13641 linie_løb_indeks(sig):= false;
7 13642 disable modiffil(tf_vogntabel,sig,zi);
7 13643 fil(zi).ll:= 0;
7 13644 fil(zi).bn:= bustabel(sig) extract 14 add
7 13645 (bustabel1(sig) extract 8 shift 14);
7 13646 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 13647
7 13647 linie_løb_indeks(bi):= false add li;
7 13648 busindeks(li):= false add bi;
7 13649 disable modiffil(tf_vogntabel,bi,zi);
7 13650 fil(zi).ll:= ll_id;
7 13651 fil(zi).bn:= bustabel(bi) extract 14 add
7 13652 (bustabel1(bi) extract 8 shift 14);
7 13653 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 13654 res:= 3;
7 13655 end
6 13656 else
6 13657 begin
7 13658 \f
7 13658 message procedure vt_opdater side 4 - 810527/cl;
7 13659
7 13659 if s<0 then li:= li +1;
7 13660 if sidste_linie_løb=max_antal_linie_løb then
7 13661 begin
8 13662 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 13663 res:= 31;
8 13664 end
7 13665 else
7 13666 begin
8 13667 for i:= sidste_linie_løb step -1 until li do
8 13668 begin
9 13669 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 13670 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 13671 bus_indeks(i+1):=bus_indeks(i);
9 13672 end;
8 13673 sidste_linie_løb:= sidste_linie_løb +1;
8 13674 linie_løb_tabel(li):= ll_id;
8 13675 linie_løb_indeks(bi):= false add li;
8 13676 busindeks(li):= false add bi;
8 13677 disable s:= modiffil(tf_vogntabel,bi,zi);
8 13678 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 13679 fil(zi).bn:= busnr extract 14 add
8 13680 (bustabel1(bi) extract 8 shift 14);
8 13681 fil(zi).ll:= ll_id;
8 13682 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 13683 res:= 3; <* ok *>
8 13684 end;
7 13685 end;
6 13686 end;
5 13687 end;
4 13688 slut_indsæt:
4 13689 d.op.resultat:= res;
4 13690 end;
3 13691 goto returner;
3 13692 \f
3 13692 message procedure vt_opdater side 5 - 820301/cl;
3 13693
3 13693 udtag:
3 13694 begin
4 13695 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 13696
4 13696 busnr:= ll_id:= 0;
4 13697 omr:= s:= d.op.data(2) extract 8;
4 13698 format:= d.op.data(1) shift (-22);
4 13699 if format=0 then <*busnr*>
4 13700 begin
5 13701 busnr:= d.op.data(1) extract 14;
5 13702 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 13703 if bi<0 then
5 13704 begin
6 13705 if bi=-1 then res:= 10 else
6 13706 if s<>0 then res:= 58 else res:= 57;
6 13707 goto slut_udtag;
6 13708 end;
5 13709 if bi>0 and s<>0 and s<>omr then
5 13710 begin
6 13711 res:= 58; goto slut_udtag;
6 13712 end;
5 13713 li:= linie_løb_indeks(bi) extract 12;
5 13714 busnr:= bustabel(bi);
5 13715 if li=0 or linie_løb_tabel(li)=0 then
5 13716 begin <* bus ej indsat *>
6 13717 res:= 13;
6 13718 goto slut_udtag;
6 13719 end;
5 13720 ll_id:= linie_løb_tabel(li);
5 13721 end
4 13722 else
4 13723 if format=1 then <* linie_løb *>
4 13724 begin
5 13725 ll_id:= d.op.data(1);
5 13726 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 13727 if s<>0 then
5 13728 begin <* linie/løb findes ikke *>
6 13729 res:= 9;
6 13730 goto slut_udtag;
6 13731 end;
5 13732 bi:= busindeks(li) extract 12;
5 13733 busnr:= bustabel(bi);
5 13734 end
4 13735 else <* ulovlig identifikation *>
4 13736 begin
5 13737 res:= 31;
5 13738 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 13739 goto slut_udtag;
5 13740 end;
4 13741 \f
4 13741 message procedure vt_opdater side 6 - 820301/cl;
4 13742
4 13742 tilst:= intg(bustilstand(bi));
4 13743 if tilst<>0 then
4 13744 begin
5 13745 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 13746 goto slut_udtag;
5 13747 end;
4 13748 if d.op.kilde//100 <> 4 then
4 13749 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 13750 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 13751 if res>3 then goto slut_udtag;
4 13752 linie_løb_indeks(bi):= false;
4 13753 for i:= li step 1 until sidste_linie_løb -1 do
4 13754 begin
5 13755 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 13756 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 13757 bus_indeks(i):= bus_indeks(i+1);
5 13758 end;
4 13759 linie_løb_tabel(sidste_linie_løb):= 0;
4 13760 bus_indeks(sidste_linie_løb):= false;
4 13761 sidste_linie_løb:= sidste_linie_løb -1;
4 13762 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 13763 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 13764 fil(zi).ll:= 0;
4 13765 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 13766 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 13767 res:= 3; <* ok *>
4 13768 slut_udtag:
4 13769 d.op.resultat:= res;
4 13770 d.op.data(2):= ll_id;
4 13771 d.op.data(3):= busnr;
4 13772 end;
3 13773 goto returner;
3 13774 \f
3 13774 message procedure vt_opdater side 7 - 851001/cl;
3 13775
3 13775 omkod:
3 13776 flyt:
3 13777 roker:
3 13778 begin
4 13779 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 13780
4 13780 inf1:= inf2:= 0;
4 13781 ll_id1:= d.op.data(1);
4 13782 ll_id2:= d.op.data(2);
4 13783 if ll_id1=ll_id2 then
4 13784 begin
5 13785 res:= 24; inf1:= ll_id2;
5 13786 goto slut_flyt;
5 13787 end;
4 13788 <*+4*>
4 13789 <**> for i:= 1,2 do
4 13790 <**> if d.op.data(i) shift (-22) <> 1 then
4 13791 <**> begin
5 13792 <**> res:= 31;
5 13793 <**> fejlreaktion(10,d.op.data(i),case i of (
5 13794 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 13795 <**> goto slut_flyt;
5 13796 <**> end;
4 13797 <*-4*>
4 13798
4 13798 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 13799 if s<>0 and funk=6 <* roker *> then
4 13800 begin
5 13801 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 13802 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 13803 end;
4 13804 if s<>0 then
4 13805 begin
5 13806 res:= 9; <* ukendt linie/løb *>
5 13807 goto slut_flyt;
5 13808 end;
4 13809 bi1:= busindeks(li1) extract 12;
4 13810 inf1:= bustabel(bi1);
4 13811 tilst:= intg(bustilstand(bi1));
4 13812 if tilst<>0 then <* bus ikke fri *>
4 13813 begin
5 13814 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 13815 goto slut_flyt;
5 13816 end;
4 13817 \f
4 13817 message procedure vt_opdater side 7a- 851001/cl;
4 13818 if d.op.kilde//100 <> 4 then
4 13819
4 13819 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 13820 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 13821 if res>3 then goto slut_flyt;
4 13822
4 13822 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 13823 if s=0 then
4 13824 begin <* ll_id2 er indkodet *>
5 13825 bi2:= busindeks(li2) extract 12;
5 13826 inf2:= bustabel(bi2);
5 13827 tilst:= intg(bustilstand(bi2));
5 13828 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 13829 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 13830 if res>3 then
5 13831 begin
6 13832 inf1:= inf2; inf2:= 0;
6 13833 goto slut_flyt;
6 13834 end;
5 13835
5 13835 if d.op.kilde//100 <> 4 then
5 13836 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 13837 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 13838 if res>3 then goto slut_flyt;
5 13839
5 13839 <* flyt bus *>
5 13840 if funk=6 then
5 13841 linie_løb_indeks(bi2):= false add li1
5 13842 else
5 13843 linie_løb_indeks(bi2):= false;
5 13844 linie_løb_indeks(bi1):= false add li2;
5 13845 if funk=6 then
5 13846 busindeks(li1):= false add bi2
5 13847 else
5 13848 busindeks(li1):= false;
5 13849 busindeks(li2):= false add bi1;
5 13850
5 13850 if funk<>6 then
5 13851 begin
6 13852 <* fjern ll_id1 *>
6 13853 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 13854 begin
7 13855 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 13856 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 13857 busindeks(i):= busindeks(i+1);
7 13858 end;
6 13859 linie_løb_tabel(sidste_linie_løb):= 0;
6 13860 bus_indeks(sidste_linie_løb):= false;
6 13861 sidste_linie_løb:= sidste_linie_løb-1;
6 13862 end;
5 13863
5 13863 <* opdater vogntabelfil *>
5 13864 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 13865 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13866 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 13867 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 13868 if funk=6 then
5 13869 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 13870 else
5 13871 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 13872 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 13873 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13874 fil(zi).ll:= ll_id2;
5 13875 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 13876 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 13877 \f
5 13877 message procedure vt_opdater side 8 - 820301/cl;
5 13878
5 13878 end <* ll_id2 indkodet *>
4 13879 else
4 13880 begin
5 13881 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 13882 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 13883 pm1:= sgn(li2-li1);
5 13884 for i:= li1 step pm1 until li2-pm1 do
5 13885 begin
6 13886 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 13887 busindeks(i):= busindeks(i+pm1);
6 13888 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 13889 end;
5 13890 linie_løb_tabel(li2):= ll_id2;
5 13891 busindeks(li2):= false add bi1;
5 13892 linie_løb_indeks(bi1):= false add li2;
5 13893 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 13894 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13895 fil(zi).ll:= ll_id2;
5 13896 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 13897 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 13898 end;
4 13899 res:= 3; <*udført*>
4 13900 slut_flyt:
4 13901 d.op.resultat:= res;
4 13902 d.op.data(3):= inf1;
4 13903 if funk=5 then d.op.data(4):= inf2;
4 13904 end;
3 13905 goto returner;
3 13906 \f
3 13906 message procedure vt_opdater side 9 - 851001/cl;
3 13907
3 13907 slet:
3 13908 begin
4 13909 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 13910 boolean test24;
4 13911
4 13911 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 13912 omr:= d.op.data(3);
4 13913
4 13913 if d.op.data(1) > d.op.data(2) then
4 13914 begin
5 13915 res:= 44; <* intervalstørrelse ulovlig *>
5 13916 goto slut_slet;
5 13917 end;
4 13918
4 13918 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 13919 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 13920
4 13920 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 13921 if s<0 then finx:= finx+1;
4 13922 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 13923 if s>0 then sinx:= sinx-1;
4 13924
4 13924 for li:= finx step 1 until sinx do
4 13925 begin
5 13926 bi:= busindeks(li) extract 12;
5 13927 gar:= bustabel(bi) shift (-14) extract 8;
5 13928 if intg(bustilstand(bi))=0 and
5 13929 (omr = 0 or (omr > 0 and omr = gar) or
5 13930 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 13931 begin
6 13932 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 13933 linie_løb_indeks(bi):= busindeks(li):= false;
6 13934 linie_løb_tabel(li):= 0;
6 13935 end;
5 13936 end;
4 13937 \f
4 13937 message procedure vt_opdater side 10 - 850820/cl;
4 13938
4 13938 sinx:= finx-1;
4 13939 for li:= finx step 1 until sidste_linie_løb do
4 13940 begin
5 13941 if linie_løb_tabel(li)<>0 then
5 13942 begin
6 13943 sinx:= sinx+1;
6 13944 if sinx<>li then
6 13945 begin
7 13946 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 13947 busindeks(sinx):= busindeks(li);
7 13948 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 13949 linie_løb_tabel(li):= 0;
7 13950 busindeks(li):= false;
7 13951 end;
6 13952 end;
5 13953 end;
4 13954 sidste_linie_løb:= sinx;
4 13955
4 13955 test24:= testbit24; testbit24:= false;
4 13956 for bi:= 1 step 1 until sidste_bus do
4 13957 disable
4 13958 begin
5 13959 s:= modiffil(tf_vogntabel,bi,finx);
5 13960 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 13961 fil(finx).bn:= bustabel(bi) extract 14 add
5 13962 (bustabel1(bi) extract 8 shift 14);
5 13963 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 13964 end;
4 13965 testbit24:= test24;
4 13966 res:= 3;
4 13967
4 13967 slut_slet:
4 13968 d.op.resultat:= res;
4 13969 end;
3 13970 goto returner;
3 13971 \f
3 13971 message procedure vt_opdater side 11 - 810409/cl;
3 13972
3 13972 returner:
3 13973 disable
3 13974 begin
4 13975
4 13975 <*+2*>
4 13976 <**> if testbit40 and overvåget then
4 13977 <**> begin
5 13978 <**> skriv_vt_opd(out,0);
5 13979 <**> write(out,<: vogntabel efter ændring:>);
5 13980 <**> p_vogntabel(out);
5 13981 <**> end;
4 13982 <**> if testbit41 and overvåget then
4 13983 <**> begin
5 13984 <**> skriv_vt_opd(out,0);
5 13985 <**> write(out,<: returner operation:>);
5 13986 <**> skriv_op(out,op);
5 13987 <**> end;
4 13988 <*-2*>
4 13989
4 13989 signalch(d.op.retur,op,d.op.optype);
4 13990 end;
3 13991 goto vent_op;
3 13992
3 13992 vt_opd_trap:
3 13993 disable skriv_vt_opd(zbillede,1);
3 13994
3 13994 end vt_opdater;
2 13995 \f
2 13995 message procedure vt_tilstand side 1 - 810424/cl;
2 13996
2 13996 procedure vt_tilstand(cs_fil,fil_opref);
2 13997 value cs_fil,fil_opref;
2 13998 integer cs_fil,fil_opref;
2 13999 begin
3 14000 integer array field op,filop;
3 14001 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14002 g_type,gr,antal,ej_res,zi,li,filref;
3 14003 integer array identer(1:max_antal_i_gruppe);
3 14004
3 14004 procedure skriv_vt_tilst(zud,omfang);
3 14005 value omfang;
3 14006 zone zud;
3 14007 integer omfang;
3 14008 begin
4 14009 real array field raf;
4 14010 raf:= 0;
4 14011 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14012 if omfang <> 0 then
4 14013 begin
5 14014 skriv_coru(zud,abs curr_coruno);
5 14015 write(zud,"nl",1,<<d>,
5 14016 <:cs-fil :>,cs_fil,"nl",1,
5 14017 <:filop :>,filop,"nl",1,
5 14018 <:op :>,op,"nl",1,
5 14019 <:funk :>,funk,"nl",1,
5 14020 <:format :>,format,"nl",1,
5 14021 <:busid :>,busid,"nl",1,
5 14022 <:res :>,res,"nl",1,
5 14023 <:bi :>,bi,"nl",1,
5 14024 <:tilst :>,tilst,"nl",1,
5 14025 <:opk :>,opk,"nl",1,
5 14026 <:opk-indeks :>,opk_indeks,"nl",1,
5 14027 <:g-type :>,g_type,"nl",1,
5 14028 <:gr :>,gr,"nl",1,
5 14029 <:antal :>,antal,"nl",1,
5 14030 <:ej-res :>,ej_res,"nl",1,
5 14031 <:zi :>,zi,"nl",1,
5 14032 <:li :>,li,"nl",1,
5 14033 <::>);
5 14034 write(zud,"nl",1,<:identer:>);
5 14035 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14036 end;
4 14037 end;
3 14038
3 14038 procedure sorter_gruppe(tab,l,u);
3 14039 value l,u;
3 14040 integer array tab;
3 14041 integer l,u;
3 14042 begin
4 14043 integer array field ii,jj;
4 14044 integer array ww, xx(1:2);
4 14045
4 14045 integer procedure sml(a,b);
4 14046 integer array a,b;
4 14047 begin
5 14048 integer res;
5 14049
5 14049 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14050 if res = 0 then
5 14051 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14052 if res = 0 then
5 14053 res:=
5 14054 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14055 if res = 0 then
5 14056 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14057 sml:= res;
5 14058 end;
4 14059
4 14059 ii:= ((l+u)//2 - 1)*4;
4 14060 tofrom(xx,tab.ii,4);
4 14061 ii:= (l-1)*4; jj:= (u-1)*4;
4 14062 repeat
4 14063 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14064 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14065 if ii <= jj then
4 14066 begin
5 14067 tofrom(ww,tab.ii,4);
5 14068 tofrom(tab.ii,tab.jj,4);
5 14069 tofrom(tab.jj,ww,4);
5 14070 ii:= ii+4;
5 14071 jj:= jj-4;
5 14072 end;
4 14073 until ii>jj;
4 14074 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14075 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14076 end;
3 14077 \f
3 14077 message procedure vt_tilstand side 2 - 820301/cl;
3 14078
3 14078 filop:= filopref;
3 14079 stackclaim(if cm_test then 550 else 500);
3 14080 trap(vt_tilst_trap);
3 14081
3 14081 <*+2*>
3 14082 <**> disable if testbit47 and overvåget or testbit28 then
3 14083 <**> skriv_vt_tilst(out,0);
3 14084 <*-2*>
3 14085
3 14085 vent_op:
3 14086 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14087 <*+2*>disable
3 14088 <**> if (testbit41 and overvåget) or
3 14089 (testbit46 and overvåget and
3 14090 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14091 then
3 14092 <**> begin
4 14093 <**> skriv_vt_tilst(out,0);
4 14094 <**> write(out,<: modtaget operation:>);
4 14095 <**> skriv_op(out,op);
4 14096 <**> end;
3 14097 <*-2*>
3 14098
3 14098 <*+4*>
3 14099 <**> if op <> vt_op then
3 14100 <**> begin
4 14101 <**> disable begin
5 14102 <**> d.op.resultat:= 31;
5 14103 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14104 <**> end;
4 14105 <**> goto returner;
4 14106 <**> end;
3 14107 <*-4*>
3 14108
3 14108 opk:= d.op.opkode extract 12;
3 14109 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14110 if opk = 15 <*bus res *> then 2 else
3 14111 if opk = 16 <*grp res *> then 4 else
3 14112 if opk = 17 <*bus fri *> then 3 else
3 14113 if opk = 18 <*grp fri *> then 5 else
3 14114 0;
3 14115 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14116 res:= 0;
3 14117 format:= d.op.data(1) shift (-22);
3 14118
3 14118 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14119 \f
3 14119 message procedure vt_tilstand side 3 - 820301/cl;
3 14120
3 14120 enkelt_bus:
3 14121 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14122 disable
3 14123 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14124 <*+4*>
4 14125 <**>if format <> 0 and format <> 1 then
4 14126 <**>begin
5 14127 <**> res:= 31;
5 14128 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14129 <**> goto slut_enkelt_bus;
5 14130 <**>end;
4 14131 <*-4*>
4 14132 <* find busnr og tilstand *>
4 14133 case format+1 of
4 14134 begin
5 14135 <* 0: budident *>
5 14136 begin
6 14137 busnr:= d.op.data(1) extract 14;
6 14138 s:= omr:= d.op.data(4) extract 8;
6 14139 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14140 if bi<0 then
6 14141 begin
7 14142 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14143 goto slut_enkelt_bus;
7 14144 end
6 14145 else
6 14146 begin
7 14147 tilst:= intg(bustilstand(bi));
7 14148 end;
6 14149 end;
5 14150
5 14150 <* 1: linie_løb_ident *>
5 14151 begin
6 14152 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14153 if bi < 0 then <* ukendt linie_løb *>
6 14154 begin
7 14155 res:= 9;
7 14156 goto slut_enkelt_bus;
7 14157 end;
6 14158 end;
5 14159 end case;
4 14160 \f
4 14160 message procedure vt_tilstand side 4 - 830310/cl;
4 14161
4 14161 if funk < 3 then
4 14162 begin
5 14163 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14164 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14165 else 0;
5 14166 d.op.data(3):= bustabel(bi);
5 14167 d.op.data(4):= bustabel1(bi);
5 14168 end;
4 14169
4 14169 <* check tilstand *>
4 14170 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14171 res:= 39 <* bus ikke reserveret *>
4 14172 else
4 14173 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14174 res:= 14 <* bus optaget *>
4 14175 else
4 14176 if funk = 1 <* i kø *> and tilst = (-1) then
4 14177 res:= 18 <* i kø *>
4 14178 else
4 14179 res:= 3; <*udført*>
4 14180
4 14180 if res = 3 then
4 14181 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14182
4 14182 slut_enkelt_bus:
4 14183 d.op.resultat:= res;
4 14184 end <*disable*>;
3 14185 goto returner;
3 14186 \f
3 14186 message procedure vt_tilstand side 5 - 810424/cl;
3 14187
3 14187 grp_res: <* reserver gruppe *>
3 14188 disable
3 14189 begin
4 14190
4 14190 <*+4*>
4 14191 <**> if format <> 2 then
4 14192 <**> begin
5 14193 <**> res:= 31;
5 14194 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14195 <**> goto slut_grp_res_1;
5 14196 <**> end;
4 14197 <*-4*>
4 14198
4 14198 <* find frit indeks i opkaldstabel *>
4 14199 opk_indeks:= 0;
4 14200 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14201 begin
5 14202 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14203 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14204 end;
4 14205 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14206 if res <> 0 then goto slut_grp_res_1;
4 14207 g_type:= d.op.data(1) shift (-21) extract 1;
4 14208 if g_type = 1 <*special gruppe*> then
4 14209 begin <*check eksistens*>
5 14210 gr:= 0;
5 14211 for i:= 1 step 1 until max_antal_grupper do
5 14212 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14213 if gr = 0 then <*gruppe ukendt*>
5 14214 begin
6 14215 res:= 8;
6 14216 goto slut_grp_res_1;
6 14217 end;
5 14218 end;
4 14219
4 14219 <* reserver i opkaldstabel *>
4 14220 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14221 \f
4 14221 message procedure vt_tilstand side 6 - 810428/cl;
4 14222
4 14222 <* tilknyt fil *>
4 14223 start_operation(filop,curr_coruid,cs_fil,101);
4 14224 d.filop.data(1):= 0; <*postantal*>
4 14225 d.filop.data(2):= 256; <*postlængde*>
4 14226 d.filop.data(3):= 1; <*segmentantal*>
4 14227 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14228 signalch(cs_opret_fil,filop,vt_optype);
4 14229
4 14229 slut_grp_res_1:
4 14230 if res <> 0 then d.op.resultat:= res;
4 14231 end;
3 14232 if res <> 0 then goto returner;
3 14233
3 14233 waitch(cs_fil,filop,vt_optype,-1);
3 14234
3 14234 <* check filsys-resultat *>
3 14235 if d.filop.data(9) <> 0 then
3 14236 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14237 filref:= d.filop.data(4);
3 14238 \f
3 14238 message procedure vt_tilstand side 7 - 820301/cl;
3 14239 disable if g_type = 0 <*linie-gruppe*> then
3 14240 begin
4 14241 integer s,i,ll_id;
4 14242 integer array field iaf1;
4 14243
4 14243 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14244 iaf1:= 2;
4 14245 s:= binærsøg(sidste_linie_løb,
4 14246 linie_løb_tabel(i) - ll_id, i);
4 14247 if s < 0 then i:= i +1;
4 14248 antal:= ej_res:= 0;
4 14249 skrivfil(filref,1,zi);
4 14250 if i <= sidste_linie_løb then
4 14251 begin
5 14252 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14253 begin
6 14254 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14255 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14256 ej_res:= ej_res+1
6 14257 else
6 14258 begin
7 14259 antal:= antal+1;
7 14260 bi:= busindeks(i) extract 12;
7 14261 fil(zi).iaf1(1):=
7 14262 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14263 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14264 fil(zi).iaf1(2):= bustabel(bi);
7 14265 iaf1:= iaf1+4;
7 14266 bustilstand(bi):= false add opk_indeks;
7 14267 end;
6 14268 i:= i +1;
6 14269 if i > sidste_linie_løb then goto slut_l_grp;
6 14270 end;
5 14271 end;
4 14272 \f
4 14272 message procedure vt_tilstand side 8 - 820301/cl;
4 14273
4 14273 slut_l_grp:
4 14274 end
3 14275 else
3 14276 begin <*special gruppe*>
4 14277 integer i,s,li,omr,gar,tilst;
4 14278 integer array field iaf1;
4 14279
4 14279 iaf1:= 2;
4 14280 antal:= ej_res:= 0;
4 14281 s:= læsfil(tf_gruppedef,gr,zi);
4 14282 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14283 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14284 s:= skrivfil(filref,1,zi);
4 14285 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14286 i:= 1;
4 14287 while identer(i) <> 0 do
4 14288 begin
5 14289 if identer(i) shift (-22) = 0 then
5 14290 begin <*busident*>
6 14291 omr:= 0;
6 14292 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14293 if bi<0 then goto næste_ident;
6 14294 li:= linie_løb_indeks(bi) extract 12;
6 14295 end
5 14296 else
5 14297 begin <*linie/løb ident*>
6 14298 s:= binærsøg(sidste_linie_løb,
6 14299 linie_løb_tabel(li) - identer(i), li);
6 14300 if s <> 0 then goto næste_ident;
6 14301 bi:= busindeks(li) extract 12;
6 14302 end;
5 14303 if (intg(bustilstand(bi))<>0) or
5 14304 (bustabel1(bi) extract 8 <> 3) then
5 14305 ej_res:= ej_res+1
5 14306 else
5 14307 begin
6 14308 antal:= antal +1;
6 14309 fil(zi).iaf1(1):=
6 14310 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14311 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14312 fil(zi).iaf1(2):= bustabel(bi);
6 14313 iaf1:= iaf1+4;
6 14314 bustilstand(bi):= false add opk_indeks;
6 14315 end;
5 14316 næste_ident:
5 14317 i:= i +1;
5 14318 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14319 end;
4 14320 slut_s_grp:
4 14321 end;
3 14322 \f
3 14322 message procedure vt_tilstand side 9 - 820301/cl;
3 14323
3 14323 if antal > 0 then <*ok*>
3 14324 disable begin
4 14325 integer array field spec,akt;
4 14326 integer a;
4 14327 integer field antal_spec;
4 14328
4 14328 antal_spec:= 2; a:= 0;
4 14329 spec:= 2; akt:= 2;
4 14330 sorter_gruppe(fil(zi).spec,1,antal);
4 14331 fil(zi).antal_spec:= 0;
4 14332 while akt//4 < antal do
4 14333 begin
5 14334 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14335 a:= 0;
5 14336 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14337 and a<15 do
5 14338 begin
6 14339 a:= a+1;
6 14340 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14341 akt:= akt+4;
6 14342 end;
5 14343 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14344 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14345 spec:= spec + 2*a + 2;
5 14346 end;
4 14347 antal:= fil(zi).antal_spec;
4 14348 gruppeopkald(opk_indeks,2):= filref;
4 14349 d.op.resultat:= 3;
4 14350 d.op.data(2):= antal;
4 14351 d.op.data(3):= filref;
4 14352 d.op.data(4):= ej_res;
4 14353 end
3 14354 else
3 14355 begin
4 14356 disable begin
5 14357 d.filop.opkode:= 104; <*slet fil*>
5 14358 signalch(cs_slet_fil,filop,vt_optype);
5 14359 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14360 d.op.resultat:= 54;
5 14361 d.op.data(2):= antal;
5 14362 d.op.data(3):= 0;
5 14363 d.op.data(4):= ej_res;
5 14364 end;
4 14365 waitch(cs_fil,filop,vt_optype,-1);
4 14366 if d.filop.data(9) <> 0 then
4 14367 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14368 end;
3 14369 goto returner;
3 14370 \f
3 14370 message procedure vt_tilstand side 10 - 820301/cl;
3 14371
3 14371 grp_fri: <* frigiv gruppe *>
3 14372 disable
3 14373 begin integer i,j,s,ll,gar,omr,tilst;
4 14374 integer array field spec;
4 14375
4 14375 <*+4*>
4 14376 <**> if format <> 2 then
4 14377 <**> begin
5 14378 <**> res:= 31;
5 14379 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14380 <**> goto slut_grp_fri;
5 14381 <**> end;
4 14382 <*-4*>
4 14383
4 14383 <* find indeks i opkaldstabel *>
4 14384 opk_indeks:= 0;
4 14385 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14386 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14387 if opk_indeks = 0 <*ikke fundet*> then
4 14388 begin
5 14389 res:= 40; <*gruppe ej reserveret*>
5 14390 goto slut_grp_fri;
5 14391 end;
4 14392 filref:= gruppeopkald(opk_indeks,2);
4 14393 start_operation(filop,curr_coruid,cs_fil,104);
4 14394 d.filop.data(4):= filref;
4 14395 hentfildim(d.filop.data);
4 14396 læsfil(filref,1,zi);
4 14397 spec:= 0;
4 14398 antal:= fil(zi).spec(1);
4 14399 spec:= spec+2;
4 14400 for i:= 1 step 1 until antal do
4 14401 begin
5 14402 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14403 begin
6 14404 busid:= fil(zi).spec(1+j) extract 14;
6 14405 omr:= 0;
6 14406 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14407 if bi>=0 then bustilstand(bi):= false;
6 14408 end;
5 14409 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14410 end;
4 14411
4 14411 slut_grp_fri:
4 14412 d.op.resultat:= res;
4 14413 end;
3 14414 if res <> 0 then goto returner;
3 14415 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14416 signalch(cs_slet_fil,filop,vt_optype);
3 14417 \f
3 14417 message procedure vt_tilstand side 11 - 810424/cl;
3 14418
3 14418 waitch(cs_fil,filop,vt_optype,-1);
3 14419
3 14419 if d.filop.data(9) <> 0 then
3 14420 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14421 d.op.resultat:= 3;
3 14422
3 14422 returner:
3 14423 disable
3 14424 begin
4 14425 <*+2*>
4 14426 <**> if testbit40 and overvåget then
4 14427 <**> begin
5 14428 <**> skriv_vt_tilst(out,0);
5 14429 <**> write(out,<: vogntabel efter ændring:>);
5 14430 <**> p_vogntabel(out);
5 14431 <**> end;
4 14432 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14433 <**> begin
5 14434 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14435 <**> p_gruppetabel(out);
5 14436 <**> end;
4 14437 <**> if (testbit41 and overvåget) or
4 14438 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14439 <**> begin
5 14440 <**> skriv_vt_tilst(out,0);
5 14441 <**> write(out,<: returner operation:>);
5 14442 <**> skriv_op(out,op);
5 14443 <**> end;
4 14444 <*-2*>
4 14445 signalch(d.op.retur,op,d.op.optype);
4 14446 end;
3 14447 goto vent_op;
3 14448
3 14448 vt_tilst_trap:
3 14449 disable skriv_vt_tilst(zbillede,1);
3 14450
3 14450 end vt_tilstand;
2 14451 \f
2 14451 message procedure vt_rapport side 1 - 810428/cl;
2 14452
2 14452 procedure vt_rapport(cs_fil,fil_opref);
2 14453 value cs_fil,fil_opref;
2 14454 integer cs_fil,fil_opref;
2 14455 begin
3 14456 integer array field op,filop;
3 14457 integer funk,filref,antal,id_ant,res;
3 14458 integer field i1,i2;
3 14459
3 14459 procedure skriv_vt_rap(z,omfang);
3 14460 value omfang;
3 14461 zone z;
3 14462 integer omfang;
3 14463 begin
4 14464 write(z,"nl",1,<:+++ vt_rapport :>);
4 14465 if omfang <> 0 then
4 14466 begin
5 14467 skriv_coru(z,abs curr_coruno);
5 14468 write(z,"nl",1,<<d>,
5 14469 <: cs_fil :>,cs_fil,"nl",1,
5 14470 <: filop :>,filop,"nl",1,
5 14471 <: op :>,op,"nl",1,
5 14472 <: funk :>,funk,"nl",1,
5 14473 <: filref :>,filref,"nl",1,
5 14474 <: antal :>,antal,"nl",1,
5 14475 <: id-ant :>,id_ant,"nl",1,
5 14476 <: res :>,res,"nl",1,
5 14477 <::>);
5 14478
5 14478 end;
4 14479 end skriv_vt_rap;
3 14480
3 14480 stackclaim(if cm_test then 198 else 146);
3 14481 filop:= fil_opref;
3 14482 i1:= 2; i2:= 4;
3 14483 trap(vt_rap_trap);
3 14484
3 14484 <*+2*>
3 14485 <**> disable if testbit47 and overvåget or testbit28 then
3 14486 <**> skriv_vt_rap(out,0);
3 14487 <*-2*>
3 14488 \f
3 14488 message procedure vt_rapport side 2 - 810505/cl;
3 14489
3 14489 vent_op:
3 14490 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14491
3 14491 <*+2*>
3 14492 <**> disable begin
4 14493 <**> if testbit41 and overvåget then
4 14494 <**> begin
5 14495 <**> skriv_vt_rap(out,0);
5 14496 <**> write(out,<: modtaget operation:>);
5 14497 <**> skriv_op(out,op);
5 14498 <**> ud;
5 14499 <**> end;
4 14500 <**> end;<*disable*>
3 14501 <*-2*>
3 14502
3 14502 disable
3 14503 begin
4 14504 integer opk;
4 14505
4 14505 opk:= d.op.opkode extract 12;
4 14506 funk:= if opk = 9 then 1 else
4 14507 if opk =10 then 2 else
4 14508 0;
4 14509 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14510
4 14510 <* opret og tilknyt fil *>
4 14511 start_operation(filop,curr_coruid,cs_fil,101);
4 14512 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14513 d.filop.data(2):= 2; <*postlængde*>
4 14514 d.filop.data(3):=10; <*segmenter*>
4 14515 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14516 signalch(cs_opretfil,filop,vt_optype);
4 14517 end;
3 14518
3 14518 waitch(cs_fil,filop,vt_optype,-1);
3 14519
3 14519 <* check resultat *>
3 14520 if d.filop.data(9) <> 0 then
3 14521 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14522 filref:= d.filop.data(4);
3 14523 antal:= 0;
3 14524 goto case funk of (l_rapport,b_rapport);
3 14525 \f
3 14525 message procedure vt_rapport side 3 - 850820/cl;
3 14526
3 14526 l_rapport:
3 14527 disable
3 14528 begin
4 14529 integer i,j,s,ll,zi;
4 14530 idant:= 0;
4 14531 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14532 <*+4*>
4 14533 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14534 <**> begin
5 14535 <**> res:= 31;
5 14536 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14537 <**> goto l_rap_slut;
5 14538 <**> end;
4 14539 <*-4*>
4 14540 ;
4 14541
4 14541 for i:= 1 step 1 until id_ant do
4 14542 begin
5 14543 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14544 s:= binærsøg(sidste_linie_løb,
5 14545 linie_løb_tabel(j) - ll, j);
5 14546 if s < 0 then j:= j +1;
5 14547
5 14547 if j<= sidste_linie_løb then
5 14548 begin <* skriv identer *>
6 14549 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14550 begin
7 14551 antal:= antal +1;
7 14552 s:= skrivfil(filref,antal,zi);
7 14553 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14554 fil(zi).i1:= linie_løb_tabel(j);
7 14555 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14556 j:= j +1;
7 14557 if j > sidste_bus then goto linie_slut;
7 14558 end;
6 14559 end;
5 14560 linie_slut:
5 14561 end;
4 14562 res:= 3;
4 14563 l_rap_slut:
4 14564 end <*disable*>;
3 14565 goto returner;
3 14566 \f
3 14566 message procedure vt_rapport side 4 - 820301/cl;
3 14567
3 14567 b_rapport:
3 14568 disable
3 14569 begin
4 14570 integer i,j,s,zi,busnr1,busnr2;
4 14571 <*+4*>
4 14572 <**> for i:= 1,2 do
4 14573 <**> if d.op.data(i) shift (-14) <> 0 then
4 14574 <**> begin
5 14575 <**> res:= 31;
5 14576 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14577 <**> goto bus_slut;
5 14578 <**> end;
4 14579 <*-4*>
4 14580
4 14580 busnr1:= d.op.data(1) extract 14;
4 14581 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14582 if busnr1 = 0 or busnr2 < busnr1 then
4 14583 begin
5 14584 res:= 7; <* fejl i busnr *>
5 14585 goto bus_slut;
5 14586 end;
4 14587
4 14587 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14588 - busnr1,j);
4 14589 if s < 0 then j:= j +1;
4 14590 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14591 if j <= sidste_bus then
4 14592 begin <* skriv identer *>
5 14593 while bustabel(j) extract 14 <= busnr2 do
5 14594 begin
6 14595 i:= linie_løb_indeks(j) extract 12;
6 14596 if i<>0 then
6 14597 begin
7 14598 antal:= antal +1;
7 14599 s:= skriv_fil(filref,antal,zi);
7 14600 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14601 fil(zi).i1:= bustabel(j);
7 14602 fil(zi).i2:= linie_løb_tabel(i);
7 14603 end;
6 14604 j:= j +1;
6 14605 if j > sidste_bus then goto bus_slut;
6 14606 end;
5 14607 end;
4 14608 bus_slut:
4 14609 end <*disable*>;
3 14610 res:= 3; <*ok*>
3 14611 \f
3 14611 message procedure vt_rapport side 5 - 810409/cl;
3 14612
3 14612 returner:
3 14613 disable
3 14614 begin
4 14615 d.op.resultat:= res;
4 14616 d.op.data(6):= antal;
4 14617 d.op.data(7):= filref;
4 14618 d.filop.data(1):= antal;
4 14619 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 14620 i:= sæt_fil_dim(d.filop.data);
4 14621 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 14622 <*+2*>
4 14623 <**> if testbit41 and overvåget then
4 14624 <**> begin
5 14625 <**> skriv_vt_rap(out,0);
5 14626 <**> write(out,<: returner operation:>);
5 14627 <**> skriv_op(out,op);
5 14628 <**> end;
4 14629 <*-2*>
4 14630 signalch(d.op.retur,op,d.op.optype);
4 14631 end;
3 14632 goto vent_op;
3 14633
3 14633 vt_rap_trap:
3 14634 disable skriv_vt_rap(zbillede,1);
3 14635
3 14635 end vt_rapport;
2 14636 \f
2 14636 message procedure vt_gruppe side 1 - 810428/cl;
2 14637
2 14637 procedure vt_gruppe(cs_fil,fil_opref);
2 14638
2 14638 value cs_fil,fil_opref;
2 14639 integer cs_fil,fil_opref;
2 14640 begin
3 14641 integer array field op, fil_op, iaf;
3 14642 integer funk, res, filref, gr, i, antal, zi, s;
3 14643 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 14644 max_antal_grupper else max_antal_i_gruppe));
3 14645
3 14645 procedure skriv_vt_gruppe(zud,omfang);
3 14646 value omfang;
3 14647 integer omfang;
3 14648 zone zud;
3 14649 begin
4 14650 integer øg;
4 14651
4 14651 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 14652 if omfang <> 0 then
4 14653 disable
4 14654 begin
5 14655 skriv_coru(zud,abs curr_coruno);
5 14656 write(zud,"nl",1,<<d>,
5 14657 <: cs_fil :>,cs_fil,"nl",1,
5 14658 <: op :>,op,"nl",1,
5 14659 <: filop :>,filop,"nl",1,
5 14660 <: funk :>,funk,"nl",1,
5 14661 <: res :>,res,"nl",1,
5 14662 <: filref :>,filref,"nl",1,
5 14663 <: gr :>,gr,"nl",1,
5 14664 <: i :>,i,"nl",1,
5 14665 <: antal :>,antal,"nl",1,
5 14666 <: zi :>,zi,"nl",1,
5 14667 <: s :>,s,"nl",1,
5 14668 <::>);
5 14669 raf:= 0;
5 14670 system(3,øg,identer);
5 14671 write(zud,"nl",1,<:identer::>);
5 14672 skriv_hele(zud,identer.raf,øg*2,2);
5 14673 end;
4 14674 end;
3 14675
3 14675 stackclaim(if cm_test then 198 else 146);
3 14676 filop:= fil_opref;
3 14677 trap(vt_grp_trap);
3 14678 iaf:= 0;
3 14679 \f
3 14679 message procedure vt_gruppe side 2 - 810409/cl;
3 14680
3 14680 <*+2*>
3 14681 <**> disable if testbit47 and overvåget or testbit28 then
3 14682 <**> skriv_vt_gruppe(out,0);
3 14683 <*-2*>
3 14684
3 14684 vent_op:
3 14685 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 14686 <*+2*>
3 14687 <**>disable
3 14688 <**>begin
4 14689 <**> if testbit41 and overvåget then
4 14690 <**> begin
5 14691 <**> skriv_vt_gruppe(out,0);
5 14692 <**> write(out,<: modtaget operation:>);
5 14693 <**> skriv_op(out,op);
5 14694 <**> ud;
5 14695 <**> end;
4 14696 <**>end;
3 14697 <*-2*>
3 14698
3 14698 disable
3 14699 begin
4 14700 integer opk;
4 14701
4 14701 opk:= d.op.opkode extract 12;
4 14702 funk:= if opk=25 then 1 else
4 14703 if opk=26 then 2 else
4 14704 if opk=27 then 3 else
4 14705 if opk=28 then 4 else
4 14706 0;
4 14707 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14708 end;
3 14709 <*+4*>
3 14710 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 14711 <**> begin
4 14712 <**> disable begin
5 14713 <**> d.op.resultat:= 31;
5 14714 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 14715 <**> end;
4 14716 <**> goto returner;
4 14717 <**> end;
3 14718 <*-4*>
3 14719
3 14719 goto case funk of(definer,slet,vis,oversigt);
3 14720 \f
3 14720 message procedure vt_gruppe side 3 - 810505/cl;
3 14721
3 14721 definer:
3 14722 disable
3 14723 begin
4 14724 gr:= 0; res:= 0;
4 14725 for i:= max_antal_grupper step -1 until 1 do
4 14726 begin
5 14727 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 14728 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 14729 end;
4 14730 if gr=0 then res:= 32; <*ingen plads*>
4 14731 end;
3 14732 if res<>0 then goto slut_definer;
3 14733 disable
3 14734 begin <*fri plads fundet*>
4 14735 antal:= d.op.data(2);
4 14736 if antal <=0 or max_antal_i_gruppe<antal then
4 14737 res:= 33 <*fejl i gruppestørrelse*>
4 14738 else
4 14739 begin
5 14740 for i:= 1 step 1 until antal do
5 14741 begin
6 14742 s:= læsfil(d.op.data(3),i,zi);
6 14743 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 14744 identer(i):= fil(zi).iaf(1);
6 14745 end;
5 14746 s:= modif_fil(tf_gruppedef,gr,zi);
5 14747 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14748 tofrom(fil(zi).iaf,identer,antal*2);
5 14749 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 14750 fil(zi).iaf(i):= 0;
5 14751 gruppetabel(gr):= d.op.data(1);
5 14752 s:= modiffil(tf_gruppeidenter,gr,zi);
5 14753 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14754 fil(zi).iaf(1):= gruppetabel(gr);
5 14755 res:= 3;
5 14756 end;
4 14757 end;
3 14758 slut_definer:
3 14759 <*slet fil*>
3 14760 start_operation(fil_op,curr_coruid,cs_fil,104);
3 14761 d.filop.data(4):= d.op.data(3);
3 14762 signalch(cs_slet_fil,filop,vt_optype);
3 14763 waitch(cs_fil,filop,vt_optype,-1);
3 14764 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 14765 d.op.resultat:= res;
3 14766 goto returner;
3 14767 \f
3 14767 message procedure vt_gruppe side 4 - 810409/cl;
3 14768
3 14768 slet:
3 14769 disable
3 14770 begin
4 14771 gr:= 0; res:= 0;
4 14772 for i:= 1 step 1 until max_antal_grupper do
4 14773 begin
5 14774 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 14775 end;
4 14776 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 14777 else
4 14778 begin
5 14779 for i:= 1 step 1 until max_antal_gruppeopkald do
5 14780 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 14781 if res = 0 then
5 14782 begin
6 14783 gruppetabel(gr):= 0;
6 14784 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 14785 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 14786 fil(zi).iaf(1):= gruppetabel(gr);
6 14787 res:= 3;
6 14788 end;
5 14789 end;
4 14790 d.op.resultat:= res;
4 14791 end;
3 14792 goto returner;
3 14793 \f
3 14793 message procedure vt_gruppe side 5 - 810505/cl;
3 14794
3 14794 vis:
3 14795 disable
3 14796 begin
4 14797 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 14798 for i:= 1 step 1 until max_antal_grupper do
4 14799 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 14800 if gr = 0 then res:= 8
4 14801 else
4 14802 begin
5 14803 s:= læsfil(tf_gruppedef,gr,zi);
5 14804 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 14805 for i:= 1 step 1 until max_antal_i_gruppe do
5 14806 begin
6 14807 identer(i):= fil(zi).iaf(i);
6 14808 if identer(i) <> 0 then antal:= antal +1;
6 14809 end;
5 14810 start_operation(filop,curr_coruid,cs_fil,101);
5 14811 d.filop.data(1):= antal; <*postantal*>
5 14812 d.filop.data(2):= 1; <*postlængde*>
5 14813 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 14814 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 14815 d.filop.data(5):= d.filop.data(6):=
5 14816 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 14817 signalch(cs_opret_fil,filop,vt_optype);
5 14818 end;
4 14819 end;
3 14820 if res <> 0 then goto slut_vis;
3 14821 waitch(cs_fil,filop,vt_optype,-1);
3 14822 disable
3 14823 begin
4 14824 if d.filop.data(9) <> 0 then
4 14825 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 14826 filref:= d.filop.data(4);
4 14827 for i:= 1 step 1 until antal do
4 14828 begin
5 14829 s:= skrivfil(filref,i,zi);
5 14830 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 14831 fil(zi).iaf(1):= identer(i);
5 14832 end;
4 14833 res:= 3;
4 14834 end;
3 14835 slut_vis:
3 14836 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 14837 goto returner;
3 14838 \f
3 14838 message procedure vt_gruppe side 6 - 810508/cl;
3 14839
3 14839 oversigt:
3 14840 disable
3 14841 begin
4 14842 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 14843 for i:= 1 step 1 until max_antal_grupper do
4 14844 begin
5 14845 if gruppetabel(i) <> 0 then
5 14846 begin
6 14847 antal:= antal +1;
6 14848 identer(antal):= gruppetabel(i);
6 14849 end;
5 14850 end;
4 14851 start_operation(filop,curr_coruid,cs_fil,101);
4 14852 d.filop.data(1):= antal; <*postantal*>
4 14853 d.filop.data(2):= 1; <*postlængde*>
4 14854 d.filop.data(3):= if antal = 0 then 1 else
4 14855 (antal-1)//256 +1; <*segm.antal*>
4 14856 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14857 d.filop.data(5):= d.filop.data(6):=
4 14858 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 14859 signalch(cs_opretfil,filop,vt_optype);
4 14860 end;
3 14861 waitch(cs_fil,filop,vt_optype,-1);
3 14862 disable
3 14863 begin
4 14864 if d.filop.data(9) <> 0 then
4 14865 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 14866 filref:= d.filop.data(4);
4 14867 for i:= 1 step 1 until antal do
4 14868 begin
5 14869 s:= skriv_fil(filref,i,zi);
5 14870 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 14871 fil(zi).iaf(1):= identer(i);
5 14872 end;
4 14873 d.op.resultat:= 3; <*ok*>
4 14874 d.op.data(1):= antal;
4 14875 d.op.data(2):= filref;
4 14876 end;
3 14877 \f
3 14877 message procedure vt_gruppe side 7 - 810505/cl;
3 14878
3 14878 returner:
3 14879 disable
3 14880 begin
4 14881 <*+2*>
4 14882 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 14883 <**> begin
5 14884 <**> skriv_vt_gruppe(out,0);
5 14885 <**> write(out,<: gruppetabel efter ændring:>);
5 14886 <**> p_gruppetabel(out);
5 14887 <**> end;
4 14888 <**> if testbit41 and overvåget then
4 14889 <**> begin
5 14890 <**> skriv_vt_gruppe(out,0);
5 14891 <**> write(out,<: returner operation:>);
5 14892 <**> skriv_op(out,op);
5 14893 <**> end;
4 14894 <*-2*>
4 14895 signalch(d.op.retur,op,d.op.optype);
4 14896 end;
3 14897 goto vent_op;
3 14898
3 14898 vt_grp_trap:
3 14899 disable skriv_vt_gruppe(zbillede,1);
3 14900
3 14900 end vt_gruppe;
2 14901 \f
2 14901 message procedure vt_spring side 1 - 810506/cl;
2 14902
2 14902 procedure vt_spring(cs_spring_retur,spr_opref);
2 14903 value cs_spring_retur,spr_opref;
2 14904 integer cs_spring_retur,spr_opref;
2 14905 begin
3 14906 integer array field komm_op,spr_op,iaf;
3 14907 real nu;
3 14908 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 14909
3 14909 procedure skriv_vt_spring(zud,omfang);
3 14910 value omfang;
3 14911 zone zud;
3 14912 integer omfang;
3 14913 begin
4 14914 write(zud,"nl",1,<:+++ vt_spring :>);
4 14915 if omfang <> 0 then
4 14916 begin
5 14917 skriv_coru(zud,abs curr_coruno);
5 14918 write(zud,"nl",1,<<d>,
5 14919 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 14920 <:spr-op :>,spr_op,"nl",1,
5 14921 <:komm-op :>,komm_op,"nl",1,
5 14922 <:funk :>,funk,"nl",1,
5 14923 <:interval :>,interval,"nl",1,
5 14924 <:nr :>,nr,"nl",1,
5 14925 <:i :>,i,"nl",1,
5 14926 <:s :>,s,"nl",1,
5 14927 <:id1 :>,id1,"nl",1,
5 14928 <:id2 :>,id2,"nl",1,
5 14929 <:res :>,res,"nl",1,
5 14930 <:res-inf :>,res_inf,"nl",1,
5 14931 <:medd-kode :>,medd_kode,"nl",1,
5 14932 <:zi :>,zi,"nl",1,
5 14933 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 14934 <::>);
5 14935 end;
4 14936 end;
3 14937 \f
3 14937 message procedure vt_spring side 2 - 810506/cl;
3 14938
3 14938 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 14939 value aktion,id1,id2;
3 14940 integer aktion,id1,id2,res,res_inf;
3 14941 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 14942 integer array field akt_op;
4 14943
4 14943 <* vent på adgang til vogntabel *>
4 14944 waitch(cs_vt_adgang,akt_op,true,-1);
4 14945
4 14945 <* start operation *>
4 14946 disable
4 14947 begin
5 14948 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 14949 d.akt_op.data(1):= id1;
5 14950 d.akt_op.data(2):= id2;
5 14951 signalch(cs_vt_opd,akt_op,vt_optype);
5 14952 end;
4 14953
4 14953 <* afvent svar *>
4 14954 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 14955 res:= d.akt_op.resultat;
4 14956 res_inf:= d.akt_op.data(3);
4 14957 <*+2*>
4 14958 <**> disable
4 14959 <**> if testbit45 and overvåget then
4 14960 <**> begin
5 14961 <**> real t;
5 14962 <**> skriv_vt_spring(out,0);
5 14963 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 14964 <**> skriv_id(out,springtabel(nr,1),0);
5 14965 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 14966 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 14967 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 14968 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 14969 <**> d.akt_op.resultat,"sp",2);
5 14970 <**> skriv_id(out,d.akt_op.data(1),8);
5 14971 <**> skriv_id(out,d.akt_op.data(2),8);
5 14972 <**> skriv_id(out,d.akt_op.data(3),8);
5 14973 <**> systime(4,springtid(nr),t);
5 14974 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 14975 <**> end;
4 14976 <*-2*>
4 14977
4 14977 <* åbn adgang til vogntabel *>
4 14978 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 14979 end vt_operation;
3 14980 \f
3 14980 message procedure vt_spring side 2a - 810506/cl;
3 14981
3 14981 procedure io_meddelelse(medd_no,bus,linie,springno);
3 14982 value medd_no,bus,linie,springno;
3 14983 integer medd_no,bus,linie,springno;
3 14984 begin
4 14985 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 14986 d.spr_op.data(1):= medd_no;
4 14987 d.spr_op.data(2):= bus;
4 14988 d.spr_op.data(3):= linie;
4 14989 d.spr_op.data(4):= springtabel(springno,1);
4 14990 d.spr_op.data(5):= springtabel(springno,2);
4 14991 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 14992 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 14993 end;
3 14994
3 14994 procedure returner_op(op,res);
3 14995 value res;
3 14996 integer array field op;
3 14997 integer res;
3 14998 begin
4 14999 <*+2*>
4 15000 <**> disable
4 15001 <**> if testbit41 and overvåget then
4 15002 <**> begin
5 15003 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15004 <**> skriv_op(out,op);
5 15005 <**> end;
4 15006 <*-2*>
4 15007 d.op.resultat:= res;
4 15008 signalch(d.op.retur,op,d.op.optype);
4 15009 end;
3 15010 \f
3 15010 message procedure vt_spring side 3 - 810603/cl;
3 15011
3 15011 iaf:= 0;
3 15012 spr_op:= spr_opref;
3 15013 stack_claim((if cm_test then 198 else 146) + 24);
3 15014
3 15014 trap(vt_spring_trap);
3 15015
3 15015 for i:= 1 step 1 until max_antal_spring do
3 15016 begin
4 15017 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15018 springtid(i):= springstart(i):= 0.0;
4 15019 end;
3 15020
3 15020 <*+2*>
3 15021 <**> disable
3 15022 <**> if testbit44 and overvåget then
3 15023 <**> begin
4 15024 <**> skriv_vt_spring(out,0);
4 15025 <**> write(out,<: springtabel efter initialisering:>);
4 15026 <**> p_springtabel(out); ud;
4 15027 <**> end;
3 15028 <*-2*>
3 15029
3 15029 <*+2*>
3 15030 <**> disable if testbit47 and overvåget or testbit28 then
3 15031 <**> skriv_vt_spring(out,0);
3 15032 <*-2*>
3 15033 \f
3 15033 message procedure vt_spring side 4 - 810609/cl;
3 15034
3 15034 næste_tid: <* find næste tid *>
3 15035 disable
3 15036 begin
4 15037 interval:= -1; <*vent uendeligt*>
4 15038 systime(1,0.0,nu);
4 15039 for i:= 1 step 1 until max_antal_spring do
4 15040 if springtabel(i,3) < 0 then
4 15041 interval:= 5
4 15042 else
4 15043 if springtid(i) <> 0.0 and
4 15044 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15045 interval:= (if springtid(i) <= nu then 0 else
4 15046 round(springtid(i) -nu));
4 15047 if interval=0 then interval:= 1;
4 15048 end;
3 15049 \f
3 15049 message procedure vt_spring side 4a - 810525/cl;
3 15050
3 15050 <* afvent operation eller timeout *>
3 15051 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15052 if komm_op <> 0 then goto afkod_operation;
3 15053
3 15053 <* timeout *>
3 15054 systime(1,0.0,nu);
3 15055 nr:= 1;
3 15056 næste_sekv:
3 15057 if nr > max_antal_spring then goto næste_tid;
3 15058 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15059 begin
4 15060 nr:= nr +1;
4 15061 goto næste_sekv;
4 15062 end;
3 15063 disable s:= modif_fil(tf_springdef,nr,zi);
3 15064 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15065 if springtabel(nr,3) < 0 then
3 15066 begin <* hængende spring *>
4 15067 if springtid(nr) <= nu then
4 15068 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15069 <* find frit løb *>
5 15070 disable
5 15071 begin
6 15072 id2:= 0;
6 15073 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15074 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15075 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15076 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15077 end;
5 15078 <* send meddelelse til io *>
5 15079 io_meddelelse(5,0,id2,nr);
5 15080
5 15080 <* annuler spring*>
5 15081 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15082 springtid(nr):= springstart(nr):= 0.0;
5 15083 end
4 15084 else
4 15085 begin <* forsøg igen *>
5 15086 \f
5 15086 message procedure vt_spring side 5 - 810525/cl;
5 15087
5 15087 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15088 if i = 2 <* første spring ej udført *> then
5 15089 begin
6 15090 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15091 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15092 id2:= id1;
6 15093 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15094 end
5 15095 else
5 15096 begin
6 15097 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15098 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15099 id2:= id1 shift (-7) shift 7
6 15100 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15101 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15102 end;
5 15103
5 15103 <* check resultat *>
5 15104 medd_kode:= if res = 3 and i = 2 then 7 else
5 15105 if res = 3 and i > 2 then 8 else
5 15106 <* if res = 9 then 1 else
5 15107 if res =12 then 2 else
5 15108 if res =14 then 4 else
5 15109 if res =18 then 3 else *>
5 15110 0;
5 15111 if medd_kode > 0 then
5 15112 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15113 id2 else id1,nr);
5 15114 if res = 3 then
5 15115 begin <* spring udført *>
6 15116 disable s:= modiffil(tf_springdef,nr,zi);
6 15117 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15118 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15119 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15120 if i > 2 then fil(zi).iaf(2+i-2):=
6 15121 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15122 end;
5 15123 end;
4 15124 end <* hængende spring *>
3 15125 else
3 15126 begin
4 15127 i:= spring_tabel(nr,3) shift (-12);
4 15128 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15129 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15130 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15131 + id1 shift (-7) shift 7;
4 15132 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15133 \f
4 15133 message procedure vt_spring side 6 - 820304/cl;
4 15134
4 15134 <* check resultat *>
4 15135 medd_kode:= if res = 3 then 8 else
4 15136 if res = 9 then 1 else
4 15137 if res =12 then 2 else
4 15138 if res =14 then 4 else
4 15139 if res =18 then 3 else
4 15140 if res =60 then 9 else 0;
4 15141 if medd_kode > 0 then
4 15142 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15143
4 15143 <* opdater springtabel *>
4 15144 disable s:= modiffil(tf_springdef,nr,zi);
4 15145 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15146 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15147 begin
5 15148 io_meddelelse(if res=3 then 6 else 5,0,
5 15149 if res=3 then id1 else id2,nr);
5 15150 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15151 springtid(nr):= springstart(nr):= 0.0;
5 15152 end
4 15153 else
4 15154 begin
5 15155 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15156 if res = 3 then
5 15157 begin
6 15158 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15159 (fil(zi).iaf(2+i-1) extract 22);
6 15160 fil(zi).iaf(2+i) := (1 shift 22) add
6 15161 (fil(zi).iaf(2+i) extract 22);
6 15162 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15163 end
5 15164 else
5 15165 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15166 end;
4 15167 end;
3 15168 <*+2*>
3 15169 <**> disable
3 15170 <**> if testbit44 and overvåget then
3 15171 <**> begin
4 15172 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15173 <**> p_springtabel(out); ud;
4 15174 <**> end;
3 15175 <*-2*>
3 15176
3 15176 nr:= nr +1;
3 15177 goto næste_sekv;
3 15178 \f
3 15178 message procedure vt_spring side 7 - 810506/cl;
3 15179
3 15179 afkod_operation:
3 15180 <*+2*>
3 15181 <**> disable
3 15182 <**> if testbit41 and overvåget then
3 15183 <**> begin
4 15184 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15185 <**> skriv_op(out,komm_op);
4 15186 <**> end;
3 15187 <*-2*>
3 15188
3 15188 disable
3 15189 begin integer opk;
4 15190
4 15190 opk:= d.komm_op.opkode extract 12;
4 15191 funk:= if opk = 30 <*sp,d*> then 5 else
4 15192 if opk = 31 <*sp. *> then 1 else
4 15193 if opk = 32 <*sp,v*> then 4 else
4 15194 if opk = 33 <*sp,o*> then 6 else
4 15195 if opk = 34 <*sp,r*> then 2 else
4 15196 if opk = 35 <*sp,a*> then 3 else
4 15197 0;
4 15198 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15199
4 15199 if funk <> 6 <*sp,o*> then
4 15200 begin <* find nr i springtabel *>
5 15201 nr:= 0;
5 15202 for i:= 1 step 1 until max_antal_spring do
5 15203 if springtabel(i,1) = d.komm_op.data(1) and
5 15204 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15205 end;
4 15206 end;
3 15207 if funk = 6 then goto oversigt;
3 15208 if funk = 5 then goto definer;
3 15209
3 15209 if nr = 0 then
3 15210 begin
4 15211 returner_op(komm_op,37<*spring ukendt*>);
4 15212 goto næste_tid;
4 15213 end;
3 15214
3 15214 goto case funk of(start,indsæt,annuler,vis);
3 15215 \f
3 15215 message procedure vt_spring side 8 - 810525/cl;
3 15216
3 15216 start:
3 15217 if springtabel(nr,3) shift (-12) <> 0 then
3 15218 begin returner_op(komm_op,38); goto næste_tid; end;
3 15219 disable
3 15220 begin <* find linie_løb_og_udtag *>
4 15221 s:= modif_fil(tf_springdef,nr,zi);
4 15222 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15223 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15224 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15225 id2:= 0;
4 15226 end;
3 15227 vt_operation(12,id1,id2,res,res_inf);
3 15228
3 15228 disable <* check resultat *>
3 15229 medd_kode:= if res = 3 <*ok*> then 7 else
3 15230 if res = 9 <*linie/løb ukendt*> then 1 else
3 15231 if res =14 <*optaget*> then 4 else
3 15232 if res =18 <*i kø*> then 3 else 0;
3 15233 returner_op(komm_op,3);
3 15234 if medd_kode = 0 then goto næste_tid;
3 15235
3 15235 <* send spring-meddelelse til io *>
3 15236 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15237
3 15237 <* opdater springtabel *>
3 15238 disable
3 15239 begin
4 15240 s:= modif_fil(tf_springdef,nr,zi);
4 15241 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15242 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15243 add (springtabel(nr,3) extract 12);
4 15244 systime(1,0.0,nu);
4 15245 springstart(nr):= nu;
4 15246 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15247 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15248 end;
3 15249 <*+2*>
3 15250 <**> disable
3 15251 <**> if testbit44 and overvåget then
3 15252 <**> begin
4 15253 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15254 <**> p_springtabel(out); ud;
4 15255 <**> end;
3 15256 <*-2*>
3 15257
3 15257 goto næste_tid;
3 15258 \f
3 15258 message procedure vt_spring side 9 - 810506/cl;
3 15259
3 15259 indsæt:
3 15260 if springtabel(nr,3) shift (-12) = 0 then
3 15261 begin <* ikke igangsat *>
4 15262 returner_op(komm_op,41);
4 15263 goto næste_tid;
4 15264 end;
3 15265 <* find frie linie/løb *>
3 15266 disable
3 15267 begin
4 15268 s:= læs_fil(tf_springdef,nr,zi);
4 15269 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15270 id2:= 0;
4 15271 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15272 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15273 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15274 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15275 id1:= d.komm_op.data(3);
4 15276 end;
3 15277
3 15277 if id2<>0 then
3 15278 vt_operation(11,id1,id2,res,res_inf)
3 15279 else
3 15280 res:= 42;
3 15281
3 15281 disable <* check resultat *>
3 15282 medd_kode:= if res = 3 <*ok*> then 8 else
3 15283 if res =10 <*bus ukendt*> then 0 else
3 15284 if res =11 <*bus allerede indsat*> then 0 else
3 15285 if res =12 <*linie/løb allerede besat*> then 2 else
3 15286 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15287 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15288 returner_op(komm_op,res);
3 15289 if medd_kode = 0 then goto næste_tid;
3 15290
3 15290 <* send springmeddelelse til io *>
3 15291 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15292 io_meddelelse(5,0,0,nr);
3 15293 \f
3 15293 message procedure vt_spring side 9a - 810525/cl;
3 15294
3 15294 <* annuler springtabel *>
3 15295 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15296 springtid(nr):= springstart(nr):= 0.0;
3 15297 <*+2*>
3 15298 <**> disable
3 15299 <**> if testbit44 and overvåget then
3 15300 <**> begin
4 15301 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15302 <**> p_springtabel(out); ud;
4 15303 <**> end;
3 15304 <*-2*>
3 15305
3 15305 goto næste_tid;
3 15306 \f
3 15306 message procedure vt_spring side 10 - 810525/cl;
3 15307
3 15307 annuler:
3 15308 disable
3 15309 begin <* find evt. frit linie/løb *>
4 15310 s:= læs_fil(tf_springdef,nr,zi);
4 15311 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15312 id1:= id2:= 0;
4 15313 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15314 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15315 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15316 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15317 returner_op(komm_op,3);
4 15318 end;
3 15319
3 15319 <* send springmeddelelse til io *>
3 15320 io_meddelelse(5,id1,id2,nr);
3 15321
3 15321 <* annuler springtabel *>
3 15322 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15323 springtid(nr):= springstart(nr):= 0.0;
3 15324 <*+2*>
3 15325 <**> disable
3 15326 <**> if testbit44 and overvåget then
3 15327 <**> begin
4 15328 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15329 <**> p_springtabel(out); ud;
4 15330 <**> end;
3 15331 <*-2*>
3 15332
3 15332 goto næste_tid;
3 15333
3 15333 definer:
3 15334 if nr <> 0 then <* allerede defineret *>
3 15335 begin
4 15336 res:= 36;
4 15337 goto slut_definer;
4 15338 end;
3 15339
3 15339 <* find frit nr *>
3 15340 i:= 0;
3 15341 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15342 if springtabel(i,1) = 0 then nr:= i;
3 15343 if nr = 0 then
3 15344 begin
4 15345 res:= 32; <* ingen fri plads *>
4 15346 goto slut_definer;
4 15347 end;
3 15348 \f
3 15348 message procedure vt_spring side 11 - 810525/cl;
3 15349
3 15349 disable
3 15350 begin integer array fdim(1:8),ia(1:32);
4 15351 <* læs sekvens *>
4 15352 fdim(4):= d.komm_op.data(3);
4 15353 s:= hent_fil_dim(fdim);
4 15354 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15355 if fdim(1) > 30 then
4 15356 res:= 35 <* springsekvens for stor *>
4 15357 else
4 15358 begin
5 15359 for i:= 1 step 1 until fdim(1) do
5 15360 begin
6 15361 s:= læs_fil(fdim(4),i,zi);
6 15362 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15363 ia(i):= fil(zi).iaf(1) shift 12;
6 15364 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15365 end;
5 15366 s:= modif_fil(tf_springdef,nr,zi);
5 15367 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15368 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15369 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15370 iaf:= 4;
5 15371 tofrom(fil(zi).iaf,ia,60);
5 15372 iaf:= 0;
5 15373 springtabel(nr,3):= fdim(1);
5 15374 springtid(nr):= springstart(nr):= 0.0;
5 15375 res:= 3;
5 15376 end;
4 15377 end;
3 15378 \f
3 15378 message procedure vt_spring side 11a - 81-525/cl;
3 15379
3 15379 slut_definer:
3 15380
3 15380 <* slet fil *>
3 15381 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15382 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15383 signalch(cs_slet_fil,spr_op,vt_optype);
3 15384 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15385 if d.spr_op.data(9) <> 0 then
3 15386 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15387 returner_op(komm_op,res);
3 15388 <*+2*>
3 15389 <**> disable
3 15390 <**> if testbit44 and overvåget then
3 15391 <**> begin
4 15392 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15393 <**> p_springtabel(out); ud;
4 15394 <**> end;
3 15395 <*-2*>
3 15396 goto næste_tid;
3 15397 \f
3 15397 message procedure vt_spring side 12 - 810525/cl;
3 15398
3 15398 vis:
3 15399 disable
3 15400 begin
4 15401 <* tilknyt fil *>
4 15402 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15403 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15404 d.spr_op.data(2):= 1;
4 15405 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15406 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15407 signalch(cs_opret_fil,spr_op,vt_optype);
4 15408 end;
3 15409
3 15409 <* afvent svar *>
3 15410 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15411 if d.spr_op.data(9) <> 0 then
3 15412 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15413 disable
3 15414 begin integer array ia(1:30);
4 15415 s:= læs_fil(tf_springdef,nr,zi);
4 15416 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15417 iaf:= 4;
4 15418 tofrom(ia,fil(zi).iaf,60);
4 15419 iaf:= 0;
4 15420 for i:= 1 step 1 until d.spr_op.data(1) do
4 15421 begin
5 15422 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15423 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15424 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15425 ia(i) shift (-12) extract 7
5 15426 else -(ia(i) shift (-12) extract 7);
5 15427 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15428 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15429 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15430 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15431 else ia(i) extract 12)
5 15432 else 0;
5 15433 end;
4 15434 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15435 sæt_fil_dim(d.spr_op.data);
4 15436 d.komm_op.data(3):= d.spr_op.data(1);
4 15437 d.komm_op.data(4):= d.spr_op.data(4);
4 15438 raf:= data+8;
4 15439 d.komm_op.raf(1):= springstart(nr);
4 15440 returner_op(komm_op,3);
4 15441 end;
3 15442 goto næste_tid;
3 15443 \f
3 15443 message procedure vt_spring side 13 - 810525/cl;
3 15444
3 15444 oversigt:
3 15445 disable
3 15446 begin
4 15447 <* opret fil *>
4 15448 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15449 d.spr_op.data(1):= max_antal_spring;
4 15450 d.spr_op.data(2):= 4;
4 15451 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15452 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15453 signalch(cs_opret_fil,spr_op,vt_optype);
4 15454 end;
3 15455
3 15455 <* afvent svar *>
3 15456 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15457 if d.spr_op.data(9) <> 0 then
3 15458 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15459 disable
3 15460 begin
4 15461 nr:= 0;
4 15462 for i:= 1 step 1 until max_antal_spring do
4 15463 begin
5 15464 if springtabel(i,1) <> 0 then
5 15465 begin
6 15466 nr:= nr +1;
6 15467 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15468 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15469 fil(zi).iaf(1):= springtabel(i,1);
6 15470 fil(zi).iaf(2):= springtabel(i,2);
6 15471 fil(zi,2):= springstart(i);
6 15472 end;
5 15473 end;
4 15474 d.spr_op.data(1):= nr;
4 15475 s:= sæt_fil_dim(d.spr_op.data);
4 15476 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15477 d.komm_op.data(1):= nr;
4 15478 d.komm_op.data(2):= d.spr_op.data(4);
4 15479 returner_op(komm_op,3);
4 15480 end;
3 15481 goto næste_tid;
3 15482
3 15482 vt_spring_trap:
3 15483 disable skriv_vt_spring(zbillede,1);
3 15484
3 15484 end vt_spring;
2 15485 \f
2 15485 message procedure vt_auto side 1 - 810505/cl;
2 15486
2 15486 procedure vt_auto(cs_auto_retur,auto_opref);
2 15487 value cs_auto_retur,auto_opref;
2 15488 integer cs_auto_retur,auto_opref;
2 15489 begin
3 15490 integer array field op,auto_op,iaf;
3 15491 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15492 res_inf,i,s,zi,kl,døgnstart;
3 15493 real t,nu,næste_tid;
3 15494 boolean optaget;
3 15495 integer array filnavn,nytnavn(1:4);
3 15496
3 15496 procedure skriv_vt_auto(zud,omfang);
3 15497 value omfang;
3 15498 zone zud;
3 15499 integer omfang;
3 15500 begin
4 15501 long array field laf;
4 15502
4 15502 laf:= 0;
4 15503 write(zud,"nl",1,<:+++ vt_auto :>);
4 15504 if omfang<>0 then
4 15505 begin
5 15506 skriv_coru(zud,abs curr_coruno);
5 15507 write(zud,"nl",1,<<d>,
5 15508 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15509 <:op :>,op,"nl",1,
5 15510 <:auto-op :>,auto_op,"nl",1,
5 15511 <:filref :>,filref,"nl",1,
5 15512 <:id1 :>,id1,"nl",1,
5 15513 <:id2 :>,id2,"nl",1,
5 15514 <:aktion :>,aktion,"nl",1,
5 15515 <:postnr :>,postnr,"nl",1,
5 15516 <:sidste-post :>,sidste_post,"nl",1,
5 15517 <:interval :>,interval,"nl",1,
5 15518 <:res :>,res,"nl",1,
5 15519 <:res-inf :>,res_inf,"nl",1,
5 15520 <:i :>,i,"nl",1,
5 15521 <:s :>,s,"nl",1,
5 15522 <:zi :>,zi,"nl",1,
5 15523 <:kl :>,kl,"nl",1,
5 15524 <:døgnstart :>,døgnstart,"nl",1,
5 15525 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15526 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15527 <:nu :>,nu,"nl",1,
5 15528 <:næste-tid :>,næste_tid,"nl",1,
5 15529 <:filnavn :>,filnavn.laf,"nl",1,
5 15530 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15531 <::>);
5 15532 end;
4 15533 end skriv_vt_auto;
3 15534 \f
3 15534 message procedure vt_auto side 2 - 810507/cl;
3 15535
3 15535 iaf:= 0;
3 15536 auto_op:= auto_opref;
3 15537 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15538 optaget:= false;
3 15539 næste_tid:= 0.0;
3 15540 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15541 stack_claim(if cm_test then 298 else 246);
3 15542 trap(vt_auto_trap);
3 15543
3 15543 <*+2*>
3 15544 <**> disable if testbit47 and overvåget or testbit28 then
3 15545 <**> skriv_vt_auto(out,0);
3 15546 <*-2*>
3 15547
3 15547 vent:
3 15548
3 15548 systime(1,0.0,nu);
3 15549 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15550 if næste_tid > nu then round(næste_tid-nu) else
3 15551 if optaget then 5 else 0;
3 15552 if interval=0 then interval:= 1;
3 15553
3 15553 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15554
3 15554 if op<>0 then goto filskift;
3 15555
3 15555 <* vent på adgang til vogntabel *>
3 15556 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15557
3 15557 <* afsend relevant operation til opdatering af vogntabel *>
3 15558 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15559 d.op.data(1):= id1;
3 15560 d.op.data(2):= id2;
3 15561 signalch(cs_vt_opd,op,vt_optype);
3 15562 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15563 res:= d.op.resultat;
3 15564 id2:= d.op.data(2);
3 15565 res_inf:= d.op.data(3);
3 15566
3 15566 <* åbn for vogntabel *>
3 15567 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15568 \f
3 15568 message procedure vt_auto side 3 - 810507/cl;
3 15569
3 15569 <* behandl svar fra opdatering *>
3 15570 <*+2*>
3 15571 <**> disable
3 15572 <**> if testbit45 and overvåget then
3 15573 <**> begin
4 15574 <**> integer li,lø,bo;
4 15575 <**> skriv_vt_auto(out,0);
4 15576 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15577 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15578 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15579 <**> for i:= 1,2 do
4 15580 <**> begin
5 15581 <**> li:= d.op.data(i);
5 15582 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15583 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15584 <**> li:= li shift (-12) extract 10;
5 15585 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15586 <**> end;
4 15587 <**> systime(4,næste_tid,t);
4 15588 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15589 <**> << zd.dd>,t/10000,"nl",1);
4 15590 <**> end;
3 15591 <*-2*>
3 15592 if res=31 then
3 15593 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15594 else
3 15595 if res<>3 then
3 15596 begin
4 15597 if -, optaget then
4 15598 begin
5 15599 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15600 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15601 if res=18 then 3 else if res=60 then 9 else 4;
5 15602 d.auto_op.data(2):= res_inf;
5 15603 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15604 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15605 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15606 end;
4 15607 if res=14 or res=18 then <* i kø eller optaget *>
4 15608 begin
5 15609 optaget:= true;
5 15610 goto vent;
5 15611 end;
4 15612 end;
3 15613 optaget:= false;
3 15614 \f
3 15614 message procedure vt_auto side 4 - 810507/cl;
3 15615
3 15615 <* find næste post *>
3 15616 disable
3 15617 begin
4 15618 if postnr=sidste_post then
4 15619 begin <* døgnskift *>
5 15620 postnr:= 1;
5 15621 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15622 end
4 15623 else postnr:= postnr+1;
4 15624 s:= læsfil(filref,postnr,zi);
4 15625 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 15626 aktion:= fil(zi).iaf(1);
4 15627 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 15628 id1:= fil(zi).iaf(3);
4 15629 id2:= fil(zi).iaf(4);
4 15630 end;
3 15631 goto vent;
3 15632 \f
3 15632 message procedure vt_auto side 5 - 810507/cl;
3 15633
3 15633 filskift:
3 15634
3 15634 <*+2*>
3 15635 <**> disable
3 15636 <**> if testbit41 and overvåget then
3 15637 <**> begin
4 15638 <**> skriv_vt_auto(out,0);
4 15639 <**> write(out,<: modtaget operation::>);
4 15640 <**> skriv_op(out,op);
4 15641 <**> end;
3 15642 <*-2*>
3 15643 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 15644 res:= 46;
3 15645 if d.op.opkode extract 12 <> 21 then
3 15646 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 15647 if filref = 0 then goto knyt;
3 15648
3 15648 <* gem filnavn til io-meddelelse *>
3 15649 disable begin
4 15650 integer array fdim(1:8);
4 15651 integer array field navn;
4 15652 fdim(4):= filref;
4 15653 hentfildim(fdim);
4 15654 navn:= 8;
4 15655 tofrom(filnavn,fdim.navn,8);
4 15656 end;
3 15657
3 15657 <* frivgiv tilknyttet autofil *>
3 15658 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 15659 d.auto_op.data(4):= filref;
3 15660 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 15661 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 15662 if d.auto_op.data(9) <> 0 then
3 15663 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 15664 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 15665 optaget:= false;
3 15666 næste_tid:= 0.0;
3 15667 res:= 3;
3 15668 \f
3 15668 message procedure vt_auto side 6 - 810507/cl;
3 15669
3 15669 <* tilknyt evt. ny autofil *>
3 15670 knyt:
3 15671 if d.op.data(1)<>0 then
3 15672 begin
4 15673 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 15674 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 15675 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 15676 disable
4 15677 begin integer pos1,pos2;
5 15678 pos1:= pos2:= 13;
5 15679 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 15680 begin
6 15681 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 15682 skrivtegn(d.auto_op.data,pos2,i);
6 15683 end;
5 15684 end;
4 15685 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 15686 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 15687 s:= d.auto_op.data(9);
4 15688 if s=0 then res:= 3 <* ok *> else
4 15689 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 15690 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 15691 if s=6 then res:= 48 <* i brug *> else
4 15692 fejlreaktion(14,2,<:auto,filskift:>,0);
4 15693 if res<>3 then goto returner;
4 15694
4 15694 tofrom(nytnavn,d.op.data,8);
4 15695
4 15695 <* find første post *>
4 15696 disable
4 15697 begin
5 15698 døgnstart:= systime(5,0.0,t);
5 15699 kl:= round t;
5 15700 filref:= d.auto_op.data(4);
5 15701 sidste_post:= d.auto_op.data(1);
5 15702 postnr:= 0;
5 15703 for postnr:= postnr+1 while postnr <= sidste_post do
5 15704 begin
6 15705 s:= læsfil(filref,postnr,zi);
6 15706 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 15707 if fil(zi).iaf(2) > kl then goto post_fundet;
6 15708 end;
5 15709 postnr:= 1;
5 15710 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15711 \f
5 15711 message procedure vt_auto side 7 - 810507/cl;
5 15712
5 15712 post_fundet:
5 15713 s:= læsfil(filref,postnr,zi);
5 15714 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 15715 aktion:= fil(zi).iaf(1);
5 15716 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 15717 id1:= fil(zi).iaf(3);
5 15718 id2:= fil(zi).iaf(4);
5 15719 res:= 3;
5 15720 end;
4 15721 end ny fil;
3 15722
3 15722 returner:
3 15723 d.op.resultat:= res;
3 15724 <*+2*>
3 15725 <**> disable
3 15726 <**> if testbit41 and overvåget then
3 15727 <**> begin
4 15728 <**> skriv_vt_auto(out,0);
4 15729 <**> write(out,<: returner operation::>);
4 15730 <**> skriv_op(out,op);
4 15731 <**> end;
3 15732 <*-2*>
3 15733 signalch(d.op.retur,op,d.op.optype);
3 15734
3 15734 if vt_log_aktiv then
3 15735 begin
4 15736 waitch(cs_vt_logpool,op,vt_optype,-1);
4 15737 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 15738 if nytnavn(1)=0 then
4 15739 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 15740 else
4 15741 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 15742 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 15743 systime(1,0.0,d.op.data.v_tid);
4 15744 signalch(cs_vt_log,op,vt_optype);
4 15745 end;
3 15746
3 15746 if filnavn(1)<>0 then
3 15747 begin <* meddelelse til io om annulering *>
4 15748 disable begin
5 15749 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 15750 i:= 1;
5 15751 hægtstring(d.auto_op.data,i,<:auto :>);
5 15752 skriv_text(d.auto_op.data,i,filnavn);
5 15753 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 15754 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 15755 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15756 end;
4 15757 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 15758 end;
3 15759 goto vent;
3 15760
3 15760 vt_auto_trap:
3 15761 disable skriv_vt_auto(zbillede,1);
3 15762
3 15762 end vt_auto;
2 15763 message procedure vt_log side 1 - 920517/cl;
2 15764
2 15764 procedure vt_log;
2 15765 begin
3 15766 integer i,j,ventetid;
3 15767 real dg,t,nu,skiftetid;
3 15768 boolean fil_åben;
3 15769 integer array ia(1:10),dp,dp1(1:8);
3 15770 integer array field op, iaf;
3 15771
3 15771 procedure skriv_vt_log(zud,omfang);
3 15772 value omfang;
3 15773 zone zud;
3 15774 integer omfang;
3 15775 begin
4 15776 write(zud,"nl",1,<:+++ vt-log :>);
4 15777 if omfang<>0 then
4 15778 begin
5 15779 skriv_coru(zud, abs curr_coruno);
5 15780 write(zud,"nl",1,<<d>,
5 15781 <:i :>,i,"nl",1,
5 15782 <:j :>,j,"nl",1,
5 15783 <:ventetid :>,ventetid,"nl",1,
5 15784 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 15785 <:t :>,t,"nl",1,
5 15786 <:nu :>,nu,"nl",1,
5 15787 <:skiftetid :>,skiftetid,"nl",1,
5 15788 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 15789 <:op :>,<<d>,op,"nl",1,
5 15790 <::>);
5 15791 raf:= 0;
5 15792 write(zud,"nl",1,<:ia::>);
5 15793 skrivhele(zud,ia.raf,20,2);
5 15794 write(zud,"nl",2,<:dp::>);
5 15795 skrivhele(zud,dp.raf,16,2);
5 15796 write(zud,"nl",2,<:dp1::>);
5 15797 skrivhele(zud,dp1.raf,16,2);
5 15798 end;
4 15799 end;
3 15800
3 15800 message procedure vt_log side 2 - 920517/cl;
3 15801
3 15801 procedure slet_fil;
3 15802 begin
4 15803 integer segm,res;
4 15804 integer array tail(1:10);
4 15805
4 15805 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 15806 if res=0 then
4 15807 begin
5 15808 segm:= tail(10);
5 15809 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 15810 if res=0 then
5 15811 begin
6 15812 close(zvtlog,true);
6 15813 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 15814 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 15815 if res=0 then
6 15816 begin
7 15817 tail(1):= tail(1)+segm;
7 15818 monitor(44)change_entry:(zvtlog,0,tail);
7 15819 end;
6 15820 end;
5 15821 end;
4 15822 end;
3 15823
3 15823 boolean procedure udvid_fil;
3 15824 begin
4 15825 integer res,spos;
4 15826 integer array tail(1:10);
4 15827 zone z(1,1,stderror);
4 15828
4 15828 udvid_fil:= false;
4 15829 open(z,0,<:vtlogpool:>,0); close(z,true);
4 15830 res:= monitor(42)lookup_entry:(z,0,tail);
4 15831 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 15832 begin
5 15833 tail(1):=tail(1) - vt_log_slicelgd;
5 15834 res:=monitor(44)change_entry:(z,0,tail);
5 15835 if res=0 then
5 15836 begin
6 15837 spos:= vt_logtail(1);
6 15838 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 15839 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 15840 if res<>0 then
6 15841 begin
7 15842 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 15843 tail(1):= tail(1) + vt_log_slicelgd;
7 15844 monitor(44)change_entry:(z,0,tail);
7 15845 end
6 15846 else
6 15847 begin
7 15848 setposition(zvtlog,0,spos);
7 15849 udvid_fil:= true;
7 15850 end;
6 15851 end;
5 15852 end;
4 15853 end;
3 15854
3 15854 message procedure vt_log side 3 - 920517/cl;
3 15855
3 15855 boolean procedure ny_fil;
3 15856 begin
4 15857 integer res,i,j;
4 15858 integer array nyt(1:4), ia,tail(1:10);
4 15859 long array field navn;
4 15860 real t;
4 15861
4 15861 navn:=0;
4 15862 if fil_åben then
4 15863 begin
5 15864 close(zvtlog,true);
5 15865 fil_åben:= false;
5 15866 nyt.navn(1):= long<:vtlo:>;
5 15867 nyt.navn(2):= long<::>;
5 15868 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 15869 j:= 'a' - 1;
5 15870 repeat
5 15871 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 15872 if res=3 then
5 15873 begin
6 15874 j:= j+1;
6 15875 if j <= 'å' then skrivtegn(nyt,11,j);
6 15876 end;
5 15877 until (res<>3) or (j > 'å');
5 15878
5 15878 if res=0 then
5 15879 begin
6 15880 open(zvtlog,4,<:vtlogklar:>,0);
6 15881 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 15882 if res=0 then
6 15883 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 15884 if res=0 then
6 15885 begin
7 15886 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 15887 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 15888 end;
6 15889
6 15889 if res=0 then
6 15890 begin
7 15891 setposition(zvtlog,0,tail(10)//64);
7 15892 navn:= (tail(10) mod 64)*8;
7 15893 if (tail(1) <= tail(10)//64) then
7 15894 outrec6(zvtlog,512)
7 15895 else
7 15896 swoprec6(zvtlog,512);
7 15897 tofrom(zvtlog.navn,nyt,8);
7 15898 tail(10):= tail(10)+1;
7 15899 setposition(zvtlog,0,tail(10)//64);
7 15900 monitor(44)change_entry:(zvtlog,0,tail);
7 15901 close(zvtlog,true);
7 15902 end
6 15903 else
6 15904 begin
7 15905 navn:= 0;
7 15906 close(zvtlog,true);
7 15907 open(zvtlog,4,<:vtlog:>,0);
7 15908 slet_fil;
7 15909 end;
6 15910 end
5 15911 else
5 15912 slet_fil;
5 15913 end;
4 15914
4 15914 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 15915 <* eller den er blevet slettet. *>
4 15916
4 15916 open(zvtlog,4,<:vtlog:>,0);
4 15917 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 15918 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 15919 vt_logtail(6):= systime(7,0,t);
4 15920
4 15920 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 15921 if res=0 then
4 15922 begin
5 15923 monitor(50)permanent_entry:(zvtlog,3,ia);
5 15924 if res<>0 then
5 15925 monitor(48)remove_entry:(zvtlog,0,ia);
5 15926 end;
4 15927
4 15927 if res=0 then fil_åben:= true;
4 15928
4 15928 ny_fil:= fil_åben;
4 15929 end ny_fil;
3 15930
3 15930 message procedure vt_log side 4 - 920517/cl;
3 15931
3 15931 procedure skriv_post(logpost);
3 15932 integer array logpost;
3 15933 begin
4 15934 integer array field post;
4 15935 real t;
4 15936
4 15936 if vt_logtail(10)//32 < vt_logtail(1) then
4 15937 begin
5 15938 outrec6(zvtlog,512);
5 15939 post:= (vt_logtail(10) mod 32)*16;
5 15940 tofrom(zvtlog.post,logpost,16);
5 15941 vt_logtail(10):= vt_logtail(10)+1;
5 15942 setposition(zvtlog,0,vt_logtail(10)//32);
5 15943 vt_logtail(6):= systime(7,0,t);
5 15944 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 15945 end;
4 15946 end;
3 15947
3 15947 procedure sletsendte;
3 15948 begin
4 15949 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 15950 integer array pooltail,tail,ia(1:10);
4 15951 integer i,res;
4 15952
4 15952 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 15953 res:=monitor(42,zpool,0,pooltail);
4 15954
4 15954 open(z,4,<:vtlogslet:>,0);
4 15955 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 15956 begin
5 15957 if monitor(52,z,0,tail)=0 then
5 15958 begin
6 15959 if monitor(8,z,0,tail)=0 then
6 15960 begin
7 15961 for i:=1 step 1 until tail(10) do
7 15962 begin
8 15963 inrec6(z,8);
8 15964 open(zlog,0,z,0); close(zlog,true);
8 15965 if monitor(42,zlog,0,ia)=0 then
8 15966 begin
9 15967 if monitor(48,zlog,0,ia)=0 then
9 15968 begin
10 15969 pooltail(1):=pooltail(1)+ia(1);
10 15970 end;
9 15971 end;
8 15972 end;
7 15973 tail(10):=0;
7 15974 monitor(44,z,0,tail);
7 15975 end
6 15976 else
6 15977 monitor(64,z,0,tail);
6 15978 end;
5 15979 if res=0 then monitor(44,zpool,0,pooltail);
5 15980 end;
4 15981 close(z,true);
4 15982 end;
3 15983
3 15983 message procedure vt_log side 5 - 920517/cl;
3 15984
3 15984 trap(vt_log_trap);
3 15985 stack_claim(200);
3 15986
3 15986 fil_åben:= false;
3 15987 if -, vt_log_aktiv then goto init_slut;
3 15988 open(zvtlog,4,<:vtlog:>,0);
3 15989 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 15990 if i=0 then
3 15991 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 15992 if i=0 then
3 15993 begin
4 15994 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 15995 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 15996 end;
3 15997
3 15997 if (i=0) and (vt_logtail(1)=0) then
3 15998 begin
4 15999 close(zvtlog,true);
4 16000 monitor(48)remove_entry:(zvtlog,0,ia);
4 16001 i:= 1;
4 16002 end;
3 16003
3 16003 disable
3 16004 if i=0 then
3 16005 begin
4 16006 fil_åben:= true;
4 16007 inrec6(zvtlog,512);
4 16008 vt_logstart:= zvtlog.v_tid;
4 16009 systime(1,0.0,nu);
4 16010 if (nu - vt_logstart) < 24*60*60.0 then
4 16011 begin
5 16012 setposition(zvtlog,0,vt_logtail(10)//32);
5 16013 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16014 begin
6 16015 inrec6(zvtlog,512);
6 16016 setposition(zvtlog,0,vt_logtail(10)//32);
6 16017 end;
5 16018 end
4 16019 else
4 16020 begin
5 16021 if ny_fil then
5 16022 begin
6 16023 if udvid_fil then
6 16024 begin
7 16025 systime(1,0.0,dp.v_tid);
7 16026 vt_logstart:= dp.v_tid;
7 16027 dp.v_kode:=0;
7 16028 skriv_post(dp);
7 16029 end
6 16030 else
6 16031 begin
7 16032 close(zvtlog,true);
7 16033 monitor(48)remove_entry:(zvtlog,0,ia);
7 16034 fil_åben:= false;
7 16035 end;
6 16036 end;
5 16037 end;
4 16038 end
3 16039 else
3 16040 begin
4 16041 close(zvtlog,true);
4 16042 if ny_fil then
4 16043 begin
5 16044 if udvid_fil then
5 16045 begin
6 16046 systime(1,0.0,dp.v_tid);
6 16047 vt_logstart:= dp.v_tid;
6 16048 dp.v_kode:=0;
6 16049 skriv_post(dp);
6 16050 end
5 16051 else
5 16052 begin
6 16053 close(zvtlog,true);
6 16054 monitor(48)remove_entry:(zvtlog,0,ia);
6 16055 fil_åben:= false;
6 16056 end;
5 16057 end;
4 16058 end;
3 16059
3 16059 init_slut:
3 16060
3 16060 dg:= systime(5,0,t);
3 16061 if t < vt_logskift then
3 16062 skiftetid:= systid(dg,vt_logskift)
3 16063 else
3 16064 skiftetid:= systid(dg+1,vt_logskift);
3 16065
3 16065 message procedure vt_log side 6 - 920517/cl;
3 16066
3 16066 vent:
3 16067
3 16067 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16068 ventetid:= round(skiftetid - nu);
3 16069 if ventetid < 1 then ventetid:= 1;
3 16070
3 16070 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16071
3 16071 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16072 if op <> 0 then
3 16073 begin
4 16074 tofrom(dp,d.op.data,16);
4 16075 signalch(cs_vt_logpool,op,vt_optype);
4 16076 end;
3 16077
3 16077 if -, vt_log_aktiv then goto vent;
3 16078
3 16078 disable if (op=0) or (nu > skiftetid) then
3 16079 begin
4 16080 if fil_åben then
4 16081 begin
5 16082 dp1.v_tid:= systid(dg,vt_logskift);
5 16083 dp1.v_kode:= 1;
5 16084 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16085 begin
6 16086 if udvid_fil then
6 16087 skriv_post(dp1);
6 16088 end
5 16089 else
5 16090 skriv_post(dp1);
5 16091 end;
4 16092
4 16092 if (op=0) or (nu > skiftetid) then
4 16093 skiftetid:= skiftetid + 24*60*60.0;
4 16094
4 16094 sletsendte;
4 16095
4 16095 if ny_fil then
4 16096 begin
5 16097 if udvid_fil then
5 16098 begin
6 16099 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16100 dp1.v_kode:= 0;
6 16101 skriv_post(dp1);
6 16102 end
5 16103 else
5 16104 begin
6 16105 close(zvtlog,true);
6 16106 monitor(48)remove_entry:(zvtlog,0,ia);
6 16107 fil_åben:= false;
6 16108 end;
5 16109 end;
4 16110 end;
3 16111
3 16111 disable if op<>0 and fil_åben then
3 16112 begin
4 16113 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16114 begin
5 16115 if -, udvid_fil then
5 16116 begin
6 16117 if ny_fil then
6 16118 begin
7 16119 if udvid_fil then
7 16120 begin
8 16121 systime(1,0.0,dp1.v_tid);
8 16122 vt_logstart:= dp1.v_tid;
8 16123 dp1.v_kode:= 0;
8 16124 skriv_post(dp1);
8 16125 end
7 16126 else
7 16127 begin
8 16128 close(zvtlog,true);
8 16129 monitor(48)remove_entry:(zvtlog,0,ia);
8 16130 fil_åben:= false;
8 16131 end;
7 16132 end;
6 16133 end;
5 16134 end;
4 16135
4 16135 if fil_åben then skriv_post(dp);
4 16136 end;
3 16137
3 16137 goto vent;
3 16138
3 16138 vt_log_trap:
3 16139 disable skriv_vt_log(zbillede,1);
3 16140 end vt_log;
2 16141 \f
2 16141
2 16141 algol list.off;
2 16142 message coroutinemonitor - 11 ;
2 16143
2 16143
2 16143 <*************** coroutine monitor procedures ***************>
2 16144
2 16144
2 16144 <***** delay *****
2 16145
2 16145 this procedure links the calling coroutine into the timerqueue and sets
2 16146 the timeout value to 'timeout'. *>
2 16147
2 16147
2 16147 procedure delay (timeout);
2 16148 value timeout;
2 16149 integer timeout;
2 16150 begin
3 16151 link(current, idlequeue);
3 16152 link(current + corutimerchain, timerqueue);
3 16153 d.current.corutimer:= timeout;
3 16154
3 16154
3 16154 passivate;
3 16155 d.current.corutimer:= 0;
3 16156 end;
2 16157 \f
2 16157
2 16157 message coroutinemonitor - 12 ;
2 16158
2 16158
2 16158 <***** pass *****
2 16159
2 16159 this procedure moves the calling coroutine from the head of the ready
2 16160 queue down below all coroutines of lower or equal priority. *>
2 16161
2 16161
2 16161 procedure pass;
2 16162 begin
3 16163 linkprio(current, readyqueue);
3 16164
3 16164
3 16164 passivate;
3 16165 end;
2 16166
2 16166
2 16166 <***** signal ****
2 16167
2 16167 this procedure increases the value af 'semaphore' by 1.
2 16168 in case some coroutine is already waiting, it is linked into the ready
2 16169 queue for activation. the calling coroutine continues execution. *>
2 16170
2 16170
2 16170 procedure signal (semaphore);
2 16171 value semaphore;
2 16172 integer semaphore;
2 16173 begin
3 16174 integer array field sem;
3 16175 sem:= semaphore;
3 16176 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16177 d.sem.simvalue:= d.sem.simvalue + 1;
3 16178
3 16178
3 16178 end;
2 16179 \f
2 16179
2 16179 message coroutinemonitor - 13 ;
2 16180
2 16180
2 16180 <***** wait *****
2 16181
2 16181 this procedure decreases the value of 'semaphore' by 1.
2 16182 in case the value of the semaphore is negative after the decrease, the
2 16183 calling coroutine is linked into the semaphore queue waiting for a
2 16184 coroutine to signal this semaphore. *>
2 16185
2 16185
2 16185 procedure wait (semaphore);
2 16186 value semaphore;
2 16187 integer semaphore;
2 16188 begin
3 16189 integer array field sem;
3 16190 sem:= semaphore;
3 16191 d.sem.simvalue:= d.sem.simvalue - 1;
3 16192
3 16192
3 16192 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16193 passivate;
3 16194 end;
2 16195 \f
2 16195
2 16195 message coroutinemonitor - 14 ;
2 16196
2 16196
2 16196 <***** inspect *****
2 16197
2 16197 this procedure inspects the value of the semaphore and returns it in
2 16198 'elements'.
2 16199 the semaphore is left unchanged. *>
2 16200
2 16200
2 16200 procedure inspect (semaphore, elements);
2 16201 value semaphore;
2 16202 integer semaphore, elements;
2 16203 begin
3 16204 integer array field sem;
3 16205 sem:= semaphore;
3 16206 elements:= d.sem.simvalue;
3 16207
3 16207
3 16207 end;
2 16208 \f
2 16208
2 16208 message coroutinemonitor - 15 ;
2 16209
2 16209
2 16209 <***** signalch *****
2 16210
2 16210 this procedure delivers an operation at 'semaphore'.
2 16211 in case another coroutine is already waiting for an operation of the
2 16212 kind 'operationtype' this coroutine will get the operation and it will
2 16213 be put into the ready queue for activation.
2 16214 in case no coroutine is waiting for the actial kind of operation it is
2 16215 linked into the semaphore queue, at the end of the queue
2 16216 if operation is positive and at the beginning if operation is negative.
2 16217 the calling coroutine continues execution. *>
2 16218
2 16218
2 16218 procedure signalch (semaphore, operation, operationtype);
2 16219 value semaphore, operation, operationtype;
2 16220 integer semaphore, operation;
2 16221 boolean operationtype;
2 16222 begin
3 16223 integer array field firstcoru, currcoru, op,currop;
3 16224 op:= abs operation;
3 16225 d.op.optype:= operationtype;
3 16226 firstcoru:= semaphore + semcoru;
3 16227 currcoru:= d.firstcoru.next;
3 16228 while currcoru <> firstcoru do
3 16229 begin
4 16230 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16231 begin
5 16232 link(operation, 0);
5 16233 d.currcoru.coruop:= operation;
5 16234 linkprio(currcoru, readyqueue);
5 16235 link(currcoru + corutimerchain, idlequeue);
5 16236 goto exit;
5 16237 end else currcoru:= d.currcoru.next;
4 16238 end;
3 16239 currop:=semaphore + semop;
3 16240 if operation < 0 then currop:=d.currop.next;
3 16241 link(op, currop);
3 16242 exit:
3 16243
3 16243
3 16243 end;
2 16244 \f
2 16244
2 16244 message coroutinemonitor - 16 ;
2 16245
2 16245
2 16245 <***** waitch *****
2 16246
2 16246 this procedure fetches an operation from a semaphore.
2 16247 in case an operation matching 'operationtypeset' is already waiting at
2 16248 'semaphore' it is handed over to the calling coroutine.
2 16249 in case no matching operation is waiting, the calling coroutine is
2 16250 linked to the semaphore.
2 16251 in any case the calling coroutine will be stopped and all corouti-
2 16252 nes are rescheduled. *>
2 16253
2 16253
2 16253 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16254 value semaphore, operationtypeset, timeout;
2 16255 integer semaphore, operation, timeout;
2 16256 boolean operationtypeset;
2 16257 begin
3 16258 integer array field firstop, currop;
3 16259 firstop:= semaphore + semop;
3 16260 currop:= d.firstop.next;
3 16261
3 16261
3 16261 while currop <> firstop do
3 16262 begin
4 16263 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16264 begin
5 16265 link(currop, 0);
5 16266 d.current.coruop:= currop;
5 16267 operation:= currop;
5 16268 \f
5 16268
5 16268 message coroutinemonitor - 17 ;
5 16269
5 16269 linkprio(current, readyqueue);
5 16270 passivate;
5 16271 goto exit;
5 16272 end else currop:= d.currop.next;
4 16273 end;
3 16274 linkprio(current, semaphore + semcoru);
3 16275 if timeout > 0 then
3 16276 begin
4 16277 link(current + corutimerchain, timerqueue);
4 16278 d.current.corutimer:= timeout;
4 16279 end else d.current.corutimer:= 0;
3 16280 d.current.corutypeset:= operationtypeset;
3 16281 passivate;
3 16282 if d.current.corutimer < 0 then operation:= 0
3 16283 else operation:= d.current.coruop;
3 16284 d.current.corutimer:= 0;
3 16285 currop:= operation;
3 16286 d.current.coruop:= currop;
3 16287 link(current+corutimerchain, idlequeue);
3 16288 exit:
3 16289
3 16289
3 16289 end;
2 16290 \f
2 16290
2 16290 message coroutinemonitor - 18 ;
2 16291
2 16291
2 16291 <***** inspectch *****
2 16292
2 16292 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16293 the number of matching operations are counted and delivered in 'elements'.
2 16294 if no operations are found the number of coroutines waiting
2 16295 for operations of the typeset are counted and delivered as
2 16296 negative value in 'elements'.
2 16297 the semaphore is left unchanged. *>
2 16298
2 16298
2 16298 procedure inspectch (semaphore, operationtypeset, elements);
2 16299 value semaphore, operationtypeset;
2 16300 integer semaphore, elements;
2 16301 boolean operationtypeset;
2 16302 begin
3 16303 integer array field firstop, currop,firstcoru,currcoru;
3 16304 integer counter;
3 16305 counter:= 0;
3 16306 firstop:= semaphore + semop;
3 16307 currop:= d.firstop.next;
3 16308 while currop <> firstop do
3 16309 begin
4 16310 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16311 counter:= counter + 1;
4 16312 currop:= d.currop.next;
4 16313 end;
3 16314 if counter=0 then
3 16315 begin
4 16316 firstcoru:=semaphore + sem_coru;
4 16317 curr_coru:=d.firstcoru.next;
4 16318 while curr_coru<>first_coru do
4 16319 begin
5 16320 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16321 counter:=counter - 1;
5 16322 curr_coru:=d.curr_coru.next;
5 16323 end;
4 16324 end;
3 16325 elements:= counter;
3 16326
3 16326
3 16326 end;
2 16327 \f
2 16327
2 16327 message coroutinemonitor - 19 ;
2 16328
2 16328
2 16328 <***** csendmessage *****
2 16329
2 16329 this procedure sends the message in 'mess' to the process defined by the name
2 16330 in 'receiver', and returns an identification of the message extension used
2 16331 for sending the message (this identification is to be used for calling 'cwait-
2 16332 answer' or 'cregretmessage'. *>
2 16333
2 16333
2 16333 procedure csendmessage (receiver, mess, messextension);
2 16334 real array receiver;
2 16335 integer array mess;
2 16336 integer messextension;
2 16337 begin
3 16338 integer bufref, messext;
3 16339 messref(maxmessext):= 0;
3 16340 messext:= 1;
3 16341 while messref(messext) <> 0 do messext:= messext + 1;
3 16342 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16343 begin
4 16344 messcode(messext):= 1 shift 12 add 2;
4 16345 mon(16) send message :(0, mess, 0, receiver);
4 16346 messref(messext):= monw2;
4 16347 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16348 end;
3 16349
3 16349
3 16349 end;
2 16350 \f
2 16350
2 16350 message coroutinemonitor - 20 ;
2 16351
2 16351
2 16351 <***** cwaitanswer *****
2 16352
2 16352 this procedure asks the coroutine monitor to get an answer to the message
2 16353 corresponding to 'messextension'. in case the answer has already arrived
2 16354 it stays in the eventqueue until 'cwaitanswer' is called.
2 16355 in case 'timeout' is positive, the coroutine is linked into the timer
2 16356 queue, and in case the answer does not arrive within 'timout' seconds the
2 16357 coroutine is restarted with result = 0. *>
2 16358
2 16358
2 16358 procedure cwaitanswer (messextension, answer, result, timeout);
2 16359 value messextension, timeout;
2 16360 integer messextension, result, timeout;
2 16361 integer array answer;
2 16362 begin
3 16363 integer messext;
3 16364 messext:= messextension;
3 16365 messcode(messext):= messcode(messext) extract 12;
3 16366 link(current, idlequeue);
3 16367 messop(messext):= current;
3 16368 if timeout > 0 then
3 16369 begin
4 16370 link(current + corutimerchain, timerqueue);
4 16371 d.current.corutimer:= timeout;
4 16372 end else d.current.corutimer:= 0;
3 16373
3 16373
3 16373 passivate;
3 16374 if d.current.corutimer < 0 then result:= 0 else
3 16375 begin
4 16376 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16377 result:= monw0;
4 16378 baseevent:= 0;
4 16379 messref(messextension):= 0;
4 16380 end;
3 16381 d.current.corutimer:= 0;
3 16382 link(current+corutimerchain, idlequeue);
3 16383 end;
2 16384 \f
2 16384
2 16384 message coroutinemonitor - 21 ;
2 16385
2 16385
2 16385 <***** cwaitmessage *****
2 16386
2 16386 this procedure asks the coroutine monitor to give it a message, when some-
2 16387 one arrives. in case a message has arrived already it stays at the event queue
2 16388 until 'cwaitmessage' is called.
2 16389 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16390 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16391 with messbufferref = 0. *>
2 16392
2 16392
2 16392 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16393 value timeout, processextension;
2 16394 integer processextension, messbufferref, timeout;
2 16395 integer array mess;
2 16396 begin
3 16397 integer i;
3 16398 integer array field messbuf;
3 16399 proccode(processextension):= 2;
3 16400 procop(processextension):= current;
3 16401 link(current, idlequeue);
3 16402 if timeout > 0 then
3 16403 begin
4 16404 link(current + corutimerchain, timerqueue);
4 16405 d.current.corutimer:= timeout;
4 16406 end else d.current.corutimer:= 0;
3 16407
3 16407
3 16407 passivate;
3 16408 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16409 begin
4 16410 messbuf:= procop(processextension);
4 16411 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16412 proccode(procext):= 1 shift 12;
4 16413 messbufferref:= messbuf;
4 16414 baseevent:= 0;
4 16415 end;
3 16416 d.current.corutimer:= 0;
3 16417 link(current+corutimerchain, idlequeue);
3 16418 end;
2 16419 \f
2 16419
2 16419 message coroutinemonitor - 22 ;
2 16420
2 16420
2 16420 <***** cregretmessage *****
2 16421
2 16421 this procedure regrets the message corresponding to messageexten-
2 16422 sion, to release message buffer and message extension.
2 16423 i/o messages are not regretable. *>
2 16424
2 16424
2 16424
2 16424 procedure cregretmessage (messageextension);
2 16425 value messageextension;
2 16426 integer messageextension;
2 16427 begin
3 16428 integer array field messbuf;
3 16429 messbuf:= messref(messageextension);
3 16430 mon(82) regret message :(0, 0, messbuf, 0);
3 16431 messref(messageextension):= 0;
3 16432
3 16432
3 16432 end;
2 16433 \f
2 16433
2 16433 message coroutinemonitor - 23 ;
2 16434
2 16434
2 16434 <***** semsendmessage *****
2 16435
2 16435 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16436 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16437 by the monitor, when the answer arrives.
2 16438 in case there are too few resources to send the message, the operation is
2 16439 returned immediately with the result field set to zero. *>
2 16440
2 16440
2 16440 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16441 value semaphore, operation, operationtype;
2 16442 real array receiver;
2 16443 integer array mess;
2 16444 integer semaphore, operation;
2 16445 boolean operationtype;
2 16446 begin
3 16447 integer array field op;
3 16448 integer messext;
3 16449 op:= operation;
3 16450 messref(maxmessext):= 0;
3 16451 messext:= 1;
3 16452 while messref(messext) <> 0 do messext:= messext + 1;
3 16453 if messext < maxmessext then
3 16454 begin
4 16455 messop(messext):= op;
4 16456 messcode(messext):=1;
4 16457 d.op(1):= semaphore;
4 16458 d.op.optype:= operationtype;
4 16459 mon(16) send message :(0, mess, 0, receiver);
4 16460 messref(messext):= monw2;
4 16461 end;
3 16462
3 16462
3 16462 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16463 begin <* return the operation immediately with result = 0 *>
4 16464 d.op(9):= 0;
4 16465 signalch(semaphore, op, operationtype);
4 16466 end;
3 16467 end;
2 16468 \f
2 16468
2 16468 message coroutinemonitor - 24 ;
2 16469
2 16469
2 16469 <***** semwaitmessage *****
2 16470
2 16470 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16471 be performed by the coroutine monitor when a message arrives to the process
2 16472 corresponding to 'processextension'. *>
2 16473
2 16473
2 16473 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16474 value processextension, semaphore, operation, operationtype;
2 16475 integer processextension, semaphore, operation;
2 16476 boolean operationtype;
2 16477 begin
3 16478 integer array field op;
3 16479 op:= operation;
3 16480 procop(processextension):= operation;
3 16481 d.op(1):= semaphore;
3 16482 d.op.optype:= operationtype;
3 16483 proccode(processextension):= 1;
3 16484
3 16484
3 16484 end;
2 16485 \f
2 16485
2 16485 message coroutinemonitor - 25 ;
2 16486
2 16486
2 16486 <***** semregretmessage *****
2 16487
2 16487 this procedure regrets a message sent by semsendmessage.
2 16488 the message is identified by the operation in which the answer should be
2 16489 returned.
2 16490 the procedure sets the result field of the operation to zero, and then
2 16491 returns it by performing a signalch. *>
2 16492
2 16492
2 16492 procedure semregretmessage (operation);
2 16493 value operation;
2 16494 integer operation;
2 16495 begin
3 16496 integer i, j;
3 16497 integer array field op, sem;
3 16498 op:= operation;
3 16499 i:= 1;
3 16500 while i < maxmessext do
3 16501 begin
4 16502 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16503 begin
5 16504 mon(82) regret message :(0, 0, messref(i), 0);
5 16505 messref(i):= 0;
5 16506 sem:= d.op(1);
5 16507 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16508 signalch(sem, op, d.op.optype);
5 16509 i:= maxmessext;
5 16510 end;
4 16511 i:= i + 1;
4 16512 end;
3 16513
3 16513
3 16513 end;
2 16514 \f
2 16514
2 16514 message coroutinemonitor - 26 ;
2 16515
2 16515
2 16515 <***** link *****
2 16516
2 16516 this procedure links an object (allocated in the descriptor array 'd') into
2 16517 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16518 are all double chained, and the chainhead is of the same format as the chain
2 16519 fields of the objects.
2 16520 the procedure links the object immediately after the head. *>
2 16521
2 16521
2 16521 procedure link (object, chainhead);
2 16522 value object, chainhead;
2 16523 integer object, chainhead;
2 16524 begin
3 16525 integer array field prevelement, nextelement, chead, obj;
3 16526 obj:= object;
3 16527 chead:= chainhead;
3 16528 prevelement:= d.obj.prev;
3 16529 nextelement:= d.obj.next;
3 16530 d.prevelement.next:= nextelement;
3 16531 d.nextelement.prev:= prevelement;
3 16532 if chead > 0 then <* link into queue *>
3 16533 begin
4 16534 prevelement:= d.chead.prev;
4 16535 d.obj.prev:= prevelement;
4 16536 d.prevelement.next:= obj;
4 16537 d.obj.next:= chead;
4 16538 d.chead.prev:= obj;
4 16539 end else
3 16540 begin <* link onto itself *>
4 16541 d.obj.prev:= obj;
4 16542 d.obj.next:= obj;
4 16543 end;
3 16544 end;
2 16545 \f
2 16545
2 16545 message coroutinemonitor - 27 ;
2 16546
2 16546
2 16546 <***** linkprio *****
2 16547
2 16547 this procedure is used to link coroutines into queues corresponding to
2 16548 the priorities of the actual coroutine and the queue elements.
2 16549 the object is linked immediately before the first coroutine of lower prio-
2 16550 rity. *>
2 16551
2 16551
2 16551 procedure linkprio (object, chainhead);
2 16552 value object, chainhead;
2 16553 integer object, chainhead;
2 16554 begin
3 16555 integer array field currelement, chead, obj;
3 16556 obj:= object;
3 16557 chead:= chainhead;
3 16558 currelement:= d.chead.next;
3 16559 while currelement <> chead
3 16560 and d.currelement.corupriority <= d.obj.corupriority
3 16561 do currelement:= d.currelement.next;
3 16562 link(obj, currelement);
3 16563 end;
2 16564 \f
2 16564
2 16564 message coroutinemonitor - 28 ;
2 16565
2 16565 \f
2 16565
2 16565 message coroutinemonitor - 30a ;
2 16566
2 16566
2 16566 <*************** extention to coroutine monitor procedures **********>
2 16567
2 16567 <***** signalbin *****
2 16568
2 16568 this procedure simulates a binary semaphore on a simple semaphore
2 16569 by testing the value of the semaphore before signaling the
2 16570 semaphore. if the value of the semaphore is one (=open) nothing is
2 16571 done, otherwise a normal signal is carried out. *>
2 16572
2 16572
2 16572 procedure signalbin(semaphore);
2 16573 value semaphore;
2 16574 integer semaphore;
2 16575 begin
3 16576 integer array field sem;
3 16577 integer val;
3 16578 sem:= semaphore;
3 16579 inspect(sem,val);
3 16580 if val<1 then signal(sem);
3 16581 end;
2 16582 \f
2 16582
2 16582 message coroutinemonitor - 30b ;
2 16583
2 16583 <***** coruno *****
2 16584
2 16584 delivers the coroutinenumber for a give coroutine id.
2 16585 if the coroutine does not exists the value 0 is delivered *>
2 16586
2 16586 integer procedure coru_no(coru_id);
2 16587 value coru_id;
2 16588 integer coru_id;
2 16589 begin
3 16590 integer array field cor;
3 16591
3 16591 coru_no:= 0;
3 16592 for cor:= firstcoru step corusize until (coruref-1) do
3 16593 if d.cor.coruident//1000 = coru_id then
3 16594 coru_no:= d.cor.coruident mod 1000;
3 16595 end;
2 16596 \f
2 16596
2 16596 message coroutinemonitor - 30c ;
2 16597
2 16597 <***** coroutine *****
2 16598
2 16598 delivers the referencebyte for the coroutinedescriptor for
2 16599 a coroutine identified by coroutinenumber *>
2 16600
2 16600 integer procedure coroutine(cor_no);
2 16601 value cor_no;
2 16602 integer cor_no;
2 16603 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16604 firstcoru + (cor_no-1)*corusize;
2 16605 \f
2 16605
2 16605 message coroutinemonitor - 30d ;
2 16606
2 16606 <***** curr_coruno *****
2 16607
2 16607 delivers number of calling coroutine
2 16608 curr_coruno:
2 16609 < 0 = -current_coroutine_number in disabled mode
2 16610 = 0 = procedure not called from coroutine
2 16611 > 0 = current_coroutine_number in enabled mode *>
2 16612
2 16612 integer procedure curr_coruno;
2 16613 begin
3 16614 integer i;
3 16615 integer array ia(1:12);
3 16616
3 16616 i:= system(12,0,ia);
3 16617 if i > 0 then
3 16618 begin
4 16619 i:= system(12,1,ia);
4 16620 curr_coruno:= ia(3);
4 16621 end else curr_coruno:= 0;
3 16622 end curr_coruno;
2 16623 \f
2 16623
2 16623 message coroutinemonitor - 30e ;
2 16624
2 16624 <***** curr_coruid *****
2 16625
2 16625 delivers coruident of calling coroutine :
2 16626
2 16626 curr_coruid:
2 16627 > 0 = coruident of calling coroutine
2 16628 = 0 = procedure not called from coroutine *>
2 16629
2 16629 integer procedure curr_coruid;
2 16630 begin
3 16631 integer cor_no;
3 16632 integer array field cor;
3 16633
3 16633 cor_no:= abs curr_coruno;
3 16634 if cor_no <> 0 then
3 16635 begin
4 16636 cor:= coroutine(cor_no);
4 16637 curr_coruid:= d.cor.coruident // 1000;
4 16638 end
3 16639 else curr_coruid:= 0;
3 16640 end curr_coruid;
2 16641 \f
2 16641 message coroutinemonitor - 30f.1 ;
2 16642
2 16642 <**** getch *****
2 16643
2 16643 this procedure searches the queue of operations waiting at 'semaphore'
2 16644 to find an operation that matches the operationstypeset and a set of
2 16645 select-values. each select value is specified by type and fieldvalue
2 16646 in integer array 'type' and by the value in integer array 'val'.
2 16647
2 16647 0: eq 0: not used
2 16648 1: lt 1: boolean
2 16649 2: le 2: integer
2 16650 3: gt 3: long
2 16651 4: ge 4: real
2 16652 5: ne
2 16653 *>
2 16654
2 16654 procedure getch(semaphore,operation,operationtypeset,type,val);
2 16655 value semaphore,operationtypeset;
2 16656 integer semaphore,operation;
2 16657 boolean operationtypeset;
2 16658 integer array type,val;
2 16659 begin
3 16660 integer array field firstop,currop;
3 16661 integer ø,n,i,f,t,rel,i1,i2;
3 16662 boolean field bf,bfval;
3 16663 integer field intf;
3 16664 long field lf,lfval; long l1,l2;
3 16665 real field rf,rfval; real r1,r2;
3 16666
3 16666 boolean match;
3 16667
3 16667 operation:= 0;
3 16668 n:= system(3,ø,type);
3 16669 match:= false;
3 16670 firstop:= semaphore + semop;
3 16671 currop:= d.firstop.next;
3 16672 while currop <> firstop and -,match do
3 16673 begin
4 16674 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16675 begin
5 16676 i:= n;
5 16677 match:= true;
5 16678 \f
5 16678 message coroutinemonitor - 30f.2 ;
5 16679
5 16679 while match and (if i <= ø then type(i) >= 0 else false) do
5 16680 begin
6 16681 rel:= type(i) shift(-18);
6 16682 t:= type(i) shift(-12) extract 6;
6 16683 f:= type(i) extract 12;
6 16684 if f > 2047 then f:= f -4096;
6 16685 case t+1 of
6 16686 begin
7 16687 ; <* not used *>
7 16688
7 16688 begin <*boolean or signed short integer*>
8 16689 bf:= f;
8 16690 bfval:= 2*i;
8 16691 i1:= d.currop.bf extract 12;
8 16692 if i1 > 2047 then i1:= i1-4096;
8 16693 i2:= val.bfval extract 12;
8 16694 if i2 > 2047 then i2:= i2-4096;
8 16695 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16696 end;
7 16697
7 16697 begin <*integer*>
8 16698 intf:= f;
8 16699 i1:= d.currop.intf;
8 16700 i2:= val(i);
8 16701 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16702 end;
7 16703
7 16703 begin <*long*>
8 16704 lf:= f;
8 16705 lfval:= i*2;
8 16706 l1:= d.currop.lf;
8 16707 l2:= val.lfval;
8 16708 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 16709 end;
7 16710
7 16710 begin <*real*>
8 16711 rf:= f;
8 16712 rfval:= i*2;
8 16713 r1:= d.currop.rf;
8 16714 r2:= val.rfval;
8 16715 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 16716 end;
7 16717
7 16717 end;<*case t+1*>
6 16718
6 16718 i:= i+1;
6 16719 end; <*while match and i<=ø and t>=0 *>
5 16720 \f
5 16720 message coroutinemonitor - 30f.3 ;
5 16721
5 16721 end; <* if operationtypeset and ---*>
4 16722 if -,match then currop:= d.currop.next;
4 16723 end; <*while currop <> firstop and -,match*>
3 16724
3 16724 if match then
3 16725 begin
4 16726 link(currop,0);
4 16727 d.current.coruop:= currop;
4 16728 operation:= currop;
4 16729 end;
3 16730 end getch;
2 16731 \f
2 16731
2 16731 message coroutinemonitor - 31 ;
2 16732
2 16732 activity(maxcoru);
2 16733
2 16733 goto initialization;
2 16734
2 16734
2 16734
2 16734 <*************** event handling ***************>
2 16735
2 16735
2 16735
2 16735 takeexternal:
2 16736 currevent:= baseevent;
2 16737 eventqueueempty:= false;
2 16738 repeat
2 16739 current:= 0;
2 16740 prevevent:= currevent;
2 16741 mon(66) test event :(0, 0, currevent, 0);
2 16742 currevent:= monw2;
2 16743 if monw0 < 0 <* no event *> then goto takeinternal;
2 16744 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 16745 cmi:= monw1
2 16746 else
2 16747 cmi:= - monw0;
2 16748
2 16748 if cmi > 0 then
2 16749 begin <* answer to activity zone *>
3 16750 current:= firstcoru + (cmi - 1) * corusize;
3 16751 linkprio(current, readyqueue);
3 16752 baseevent:= 0;
3 16753 end else
2 16754
2 16754 if cmi = 0 then
2 16755 begin <* message arrived *>
3 16756 \f
3 16756
3 16756 message coroutinemonitor - 32 ;
3 16757
3 16757 receiver:= core.currevent(3);
3 16758 if receiver < 0 then receiver:= - receiver;
3 16759 procref(maxprocext):= receiver;
3 16760 procext:= 1;
3 16761 while procref(procext) <> receiver do procext:= procext + 1;
3 16762 if procext = maxprocext then
3 16763 begin <* receiver unknown *>
4 16764 <* leave the message unchanged *>
4 16765 end else
3 16766 if proccode(procext) shift (-12) = 0 then
3 16767 begin <* the receiver is ready for accepting messages *>
4 16768 mon(26) get event :(0, 0, currevent, 0);
4 16769 case proccode(procext) of
4 16770 begin
5 16771 begin <* message received by semwaitmessage *>
6 16772 op:= procop(procext);
6 16773 sem:= d.op(1);
6 16774 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 16775 d.op(9):= currevent;
6 16776 signalch(sem, op, d.op.optype);
6 16777 proccode(procext):= 1 shift 12;
6 16778 end;
5 16779 begin <* message received by cwaitmessage *>
6 16780 current:= procop(procext);
6 16781 procop(procext):= currevent;
6 16782 linkprio(current, readyqueue);
6 16783 link(current + corutimerchain, idlequeue);
6 16784
6 16784
6 16784 end;
5 16785 end; <* case *>
4 16786 currevent:= baseevent;
4 16787 proccode(procext):= 1 shift 12;
4 16788 end;
3 16789 end <* message *> else
2 16790
2 16790 if cmi = -1 then
2 16791 begin <* answer arrived *>
3 16792 \f
3 16792
3 16792 message coroutinemonitor - 33 ;
3 16793
3 16793 if currevent = timermessage then
3 16794 begin
4 16795 mon(26) get event :(0, 0, currevent, 0);
4 16796 coru:= d.timerqueue.next;
4 16797 while coru <> timerqueue do
4 16798 begin
5 16799 current:= coru - corutimerchain;
5 16800 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 16801 coru:= d.coru.next;
5 16802 if d.current.corutimer <= 0 then
5 16803 begin <* timer perion expired *>
6 16804 d.current.corutimer:= -1;
6 16805 linkprio(current, readyqueue);
6 16806 link(current + corutimerchain, idlequeue);
6 16807 end;
5 16808 end;
4 16809 mon(16) send message :(0, clockmess, 0, clock);
4 16810 timermessage:= monw2;
4 16811 currevent:= baseevent;
4 16812 end <* timer answer *> else
3 16813 begin
4 16814 messref(maxmessext):= currevent;
4 16815 messext:= 1;
4 16816 while messref(messext) <> currevent do messext:= messext + 1;
4 16817 if messext = maxmessext then
4 16818 begin <* the answer is unknown *>
5 16819 <* leave the answer unchanged - it may belong to an activity *>
5 16820 end else
4 16821 if messcode(messext) shift (-12) = 0 then
4 16822 begin
5 16823 case messcode(messext) extract 12 of
5 16824 begin
6 16825 \f
6 16825
6 16825 message coroutinemonitor - 34 ;
6 16826 begin <* answer arrived after semsendmessage *>
7 16827 op:= messop(messext);
7 16828 sem:= d.op(1);
7 16829 mon(18) wait answer :(0, d.op, currevent, 0);
7 16830 d.op(9):= monw0;
7 16831 signalch(sem, op, d.op.optype);
7 16832 messref(messext):= 0;
7 16833 baseevent:= 0;
7 16834 end;
6 16835 begin <* answer arrived after csendmessage *>
7 16836 current:= messop(messext);
7 16837 linkprio(current, readyqueue);
7 16838 link(current + corutimerchain, idlequeue);
7 16839
7 16839
7 16839 end;
6 16840 end;
5 16841 end else baseevent:= currevent;
4 16842 end;
3 16843 end;
2 16844 until eventqueueempty;
2 16845 \f
2 16845
2 16845 message coroutinemonitor - 35 ;
2 16846
2 16846
2 16846
2 16846 <*************** coroutine activation ***************>
2 16847
2 16847 takeinternal:
2 16848
2 16848 current:= d.readyqueue.next;
2 16849 if current = readyqueue then
2 16850 begin
3 16851 mon(24) wait event :(0, 0, prevevent, 0);
3 16852 goto takeexternal;
3 16853 end;
2 16854
2 16854 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 16855 <**> begin
3 16856 <**> systime(5,0,r);
3 16857 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 16858 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 16859 <**> d.current.coruident//1000,<: aktiveres:>);
3 16860 <**> end;
2 16861 <*-2*>
2 16862
2 16862 corustate:= activate(d.current.coruident mod 1000);
2 16863 cmi:= corustate extract 24;
2 16864 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 16865 <**> begin
3 16866 <**> systime(5,0,r);
3 16867 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 16868 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 16869 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 16870 <**> end;
2 16871 <*-2*>
2 16872
2 16872 if cmi = 1 then
2 16873 begin <* programmed passivate *>
3 16874 goto takeexternal;
3 16875 end;
2 16876
2 16876 if cmi = 2 then
2 16877 begin <* implicit passivate in activity *>
3 16878
3 16878
3 16878 link(current, idlequeue);
3 16879 goto takeexternal;
3 16880 end;
2 16881 \f
2 16881
2 16881 message coroutinemonitor - 36 ;
2 16882
2 16882 <* coroutine termination (normal or abnormal) *>
2 16883
2 16883 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 16884 coru_term:
2 16885
2 16885 begin
3 16886 if false and alarmcause extract 24 = (-9) <* break *> and
3 16887 alarmcause shift (-24) extract 24 = 0 then
3 16888 begin
4 16889 endaction:= 2;
4 16890 goto program_slut;
4 16891 end;
3 16892 if alarmcause extract 24 = (-9) <* break *> and
3 16893 alarmcause shift (-24) = 8 <* parent *>
3 16894 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 16895 if alarmcause shift (-24) extract 24 <> -2 or
3 16896 alarmcause extract 24 <> -13 then
3 16897 begin
4 16898 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 16899 alarmcause shift (-24),<:,:>,
4 16900 alarmcause extract 24);
4 16901 for i:=1 step 1 until max_coru do
4 16902 j:=activate(-i); <* kill *>
4 16903 <* skriv billede *>
4 16904 end
3 16905 else
3 16906 begin
4 16907 errorbits:= 0; <* ok.yes warning.no *>
4 16908 goto finale;
4 16909 end;
3 16910 end;
2 16911
2 16911 goto dump;
2 16912
2 16912 link(current, idlequeue);
2 16913 goto takeexternal;
2 16914 \f
2 16914
2 16914 message coroutinemonitor - 37 ;
2 16915
2 16915
2 16915
2 16915 initialization:
2 16916
2 16916
2 16916 <*************** initialization ***************>
2 16917
2 16917 <* chain head *>
2 16918
2 16918 prev:= -2; <* -2 prev *>
2 16919 next:= 0; <* +0 next *>
2 16920
2 16920 <* corutine descriptor *>
2 16921
2 16921 <* -2 prev *>
2 16922 <* +0 next *>
2 16923 <* +2 (link field) *>
2 16924 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 16925 <* +6 (link field) *>
2 16926 coruop:= corutimerchain + 4; <* +8 coruop *>
2 16927 corutimer:= coruop + 2; <*+10 corutimer *>
2 16928 coruident:= corutimer + 2; <*+12 coruident *>
2 16929 corupriority:= coruident + 2; <*+14 corupriority *>
2 16930 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 16931 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 16932
2 16932 <* simple semaphore *>
2 16933
2 16933 <* -2 (link field) *>
2 16934 simcoru:= next; <* +0 simcoru *>
2 16935 simvalue:= simcoru + 2; <* +2 simvalue *>
2 16936
2 16936 <* chained semaphore *>
2 16937
2 16937 <* -2 (link field) *>
2 16938 semcoru:= next; <* +0 semcoru *>
2 16939 <* +2 (link field) *>
2 16940 semop:= semcoru + 4; <* +4 semop *>
2 16941 \f
2 16941
2 16941 message coroutinemonitor - 38 ;
2 16942
2 16942 <* operation *>
2 16943
2 16943 opsize:= next - 6; <* -6 opsize *>
2 16944 optype:= opsize + 1; <* -5 optype *>
2 16945 <* -2 prev *>
2 16946 <* +0 next *>
2 16947 <* +2 operation(1) *>
2 16948 <* +4 operation(2) *>
2 16949 <* +6 - *>
2 16950 <* . - *>
2 16951 <* . - *>
2 16952
2 16952 \f
2 16952
2 16952 message coroutinemonitor - 39 ;
2 16953
2 16953 trap(dump);
2 16954 systime(1, 0, starttime);
2 16955 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 16956 clockmess(1):= 0;
2 16957 clockmess(2):= timeinterval;
2 16958 clock(1):= real <:clock:>;
2 16959 clock(2):= real <::>;
2 16960 mon(16) send message :(0, clockmess, 0, clock);
2 16961 timermessage:= monw2;
2 16962 readyqueue:= 4;
2 16963 initchain(readyqueue);
2 16964 idlequeue:= readyqueue + 4;
2 16965 initchain(idlequeue);
2 16966 timerqueue:= idlequeue + 4;
2 16967 initchain(timerqueue);
2 16968 current:= 0;
2 16969 corucount:= 0;
2 16970 proccount:= 0;
2 16971 baseevent:= 0;
2 16972 coruref:= timerqueue + 4;
2 16973 firstcoru:= coruref;
2 16974 simref:= coruref + maxcoru * corusize;
2 16975 firstsim:= simref;
2 16976 semref:= simref + maxsem * simsize;
2 16977 firstsem:= semref;
2 16978 opref:= semref + maxsemch * semsize + 4;
2 16979 firstop:= opref;
2 16980 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 16981 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 16982 reflectcore(core);
2 16983
2 16983 algol list.on;
2 16984
2 16984 \f
2 16984 message sys_initialisering side 1 - 810601/hko;
2 16985
2 16985 trapmode:= 1 shift 15;
2 16986 errorbits:= 1; <* warning.no ok.no *>
2 16987 trap(coru_term);
2 16988
2 16988 open(zbillede,4,<:billede:>,0);
2 16989 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 16990 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 16991 system(2,0,ia);
2 16992 open(zdummy,4,ia,0); close(zdummy,false);
2 16993 monitor(42,zdummy,0,ia);
2 16994 laf:= 0;
2 16995 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 16996 systime(6,ia(6),r)+r/1000000,"nl",2,
2 16997 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 16998
2 16998 open(zrl,4,<:radiolog:>,0);
2 16999 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17000 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17001 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17002 begin
3 17003 ia(1):=1; ia(2):= 3;
3 17004 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17005 monitor(40)create_area:(zrl,0,ia);
3 17006 end;
2 17007
2 17007 for i:=1 step 1 until max_antal_fejltekster do
2 17008 fejltekst(i):= real (case i of (
2 17009 <* 1*><:filsystem:>,
2 17010 <* 2*><:operationskode:>,
2 17011 <* 3*><:programfejl:>,
2 17012 <* 4*><:monitor<'_'>resultat=:>,
2 17013 <* 5*><:læs<'_'>fil:>,
2 17014 <* 6*><:skriv<'_'>fil:>,
2 17015 <* 7*><:modif<'_'>fil:>,
2 17016 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17017 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17018 <*10*><:vogntabel:>,
2 17019 <*11*><:fremmed operation:>,
2 17020 <*12*><:operationstype:>,
2 17021 <*13*><:opret<'_'>fil:>,
2 17022 <*14*><:tilknyt<'_'>fil:>,
2 17023 <*15*><:frigiv<'_'>fil:>,
2 17024 <*16*><:slet<'_'>fil:>,
2 17025 <*17*><:ydre enhed, status=:>,
2 17026 <*18*><:tabelfil:>,
2 17027 <*19*><:radio:>,
2 17028 <*20*><:mobilopkald, bus:>,
2 17029 <*21*><:talevejsswitch:>,
2 17030 <*99*><:ftslut:>));
2 17031
2 17031 for i:= 1 step 1 until max_antal_områder do
2 17032 begin
3 17033 område_navn(i):= long (case i of
3 17034 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17035 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17036 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17037 område_id(i,2):=
3 17038 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17039 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17040 end;
2 17041
2 17041 pabx_id(1):= -1;
2 17042 pabx_id(2):= 1;
2 17043
2 17043 for i:= 1 step 1 until max_antal_radiokanaler do
2 17044 begin
3 17045 radio_id(i):=
3 17046 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17047 end;
2 17048
2 17048 for i:=1 step 1 until max_antal_kanaler do
2 17049 begin
3 17050 kanal_navn(i):= long (case i of (
3 17051 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17052 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17053 kanal_id(i):=
3 17054 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17055 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17056 end;
2 17057
2 17057 for i:= 1 step 1 until op_maske_lgd//2 do
2 17058 ingen_operatører(i):= alle_operatører(i):= 0;
2 17059 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17060 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17061
2 17061 begin
3 17062 long array navn(1:2);
3 17063 long array field doc, ref;
3 17064
3 17064 doc:= 2; iaf:= 0;
3 17065 movestring(navn,1,<:terminal0:>);
3 17066 for i:= 1 step 1 until max_antal_operatører do
3 17067 begin
4 17068 ref:=(i-1)*8; k:=9;
4 17069 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17070 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17071 open(zdummy,8,navn,0); close(zdummy,true);
4 17072 k:= monitor(42,zdummy,0,ia);
4 17073 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17074 else tofrom(terminal_navn.ref,navn,8);
4 17075 operatør_auto_include(i):= false;
4 17076 sætbit_ia(alle_operatører,i,1);
4 17077 end;
3 17078
3 17078 movestring(navn,1,<:garage0:>);
3 17079 for i:= 1 step 1 until max_antal_garageterminaler do
3 17080 begin
4 17081 ref:=(i-1)*8; k:=7;
4 17082 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17083 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17084 open(zdummy,8,navn,0); close(zdummy,true);
4 17085 k:= monitor(42,zdummy,0,ia);
4 17086 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17087 else tofrom(garage_terminal_navn.ref,navn,8);
4 17088 garage_auto_include(i):= false;
4 17089 end;
3 17090 end;
2 17091
2 17091 for i:= 1 step 1 until max_antal_taleveje do
2 17092 sætbit_ia(alle_taleveje,i,1);
2 17093 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17094 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17095 operatør_auto_include(ia(i)):= true;
2 17096 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17097 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17098 garage_auto_include(ia(i)):= true;
2 17099
2 17099
2 17099 \f
2 17099 message fil_init side 1 - 801030/jg;
2 17100
2 17100 begin integer i,antz,tz,s;
3 17101 real array field raf;
3 17102
3 17102 filskrevet:=fillæst:=0; <*fil*>
3 17103 dbsegmax:= 2**18-1;
3 17104
3 17104 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17105 for i:=1 step 1 until dbantez do
3 17106 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17107 for i:=dbantez+1 step 1 until tz do
3 17108 open(fil(i),4,dbsnavn,0);
3 17109 for i:=tz+1 step 1 until antz do
3 17110 open(fil(i),4,dbtnavn,0);
3 17111
3 17111 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17112 dbkatz(i,1):=dbkatz(i,2):=0;
3 17113 for i:=dbantez+1 step 1 until tz do
3 17114 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17115 for i:=tz+1 step 1 until antz do
3 17116 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17117 dbkatz(antz,2):=tz+1;
3 17118 dbsidstetz:=antz;
3 17119 dbsidstesz:=tz;
3 17120
3 17120 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17121 begin integer j;
4 17122 for j:=1,3 step 1 until 6 do
4 17123 dbkate(i,j):=0;
4 17124 dbkate(i,2):=i+1;
4 17125 end;
3 17126 dbkate(dbmaxef,2):=0;
3 17127 dbkatefri:=1;
3 17128 dbantef:=0;
3 17129 \f
3 17129 message fil_init side 2 - 801030/jg;
3 17130
3 17130
3 17130 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17131 begin
4 17132 dbkats(i,1):=0;
4 17133 dbkats(i,2):=i+1;
4 17134 end;
3 17135 dbkats(dbmaxsf,2):=0;
3 17136 dbkatsfri:=1;
3 17137 dbantsf:=0;
3 17138
3 17138 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17139 dbkatb(i):=false add (i+1);
3 17140 dbkatb(dbmaxb):=false;
3 17141 dbkatbfri:=1;
3 17142 dbantb:=0;
3 17143 raf:=4;
3 17144 for i:=1 step 1 until dbmaxtf do
3 17145 begin
4 17146 inrec6(fil(antz),4);
4 17147 dbkatt.raf(i):=fil(antz,1);
4 17148 end;
3 17149 inrec6(fil(antz),4);
3 17150 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17151 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17152 setposition(fil(antz),0,0);
3 17153
3 17153 end filsystem;
2 17154 \f
2 17154 message fil_init side 3 - 810209/cl;
2 17155
2 17155 bs_kats_fri:= nextsem;
2 17156 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17157 <*-3*>
2 17158 bs_kate_fri:= nextsem;
2 17159 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17160 <*-3*>
2 17161 cs_opret_fil:= nextsemch;
2 17162 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17163 <*-3*>
2 17164 cs_tilknyt_fil:= nextsemch;
2 17165 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17166 <*-3*>
2 17167 cs_frigiv_fil:= nextsemch;
2 17168 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17169 <*-3*>
2 17170 cs_slet_fil:= nextsemch;
2 17171 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17172 <*-3*>
2 17173 cs_opret_spoolfil:= nextsemch;
2 17174 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17175 <*-3*>
2 17176 cs_opret_eksternfil:= nextsemch;
2 17177 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17178 <*-3*>
2 17179 \f
2 17179 message fil_init side 4 810209/cl;
2 17180
2 17180
2 17180 <* initialisering af filsystemcoroutiner *>
2 17181
2 17181 i:= nextcoru(001,10,true);
2 17182 j:= newactivity(i,0,opretfil);
2 17183 <*+3*> skriv_newactivity(out,i,j);
2 17184 <*-3*>
2 17185
2 17185 i:= nextcoru(002,10,true);
2 17186 j:= newactivity(i,0,tilknytfil);
2 17187 <*+3*> skriv_newactivity(out,i,j);
2 17188 <*-3*>
2 17189
2 17189 i:= nextcoru(003,10,true);
2 17190 j:= newactivity(i,0,frigivfil);
2 17191 <*+3*> skriv_newactivity(out,i,j);
2 17192 <*-3*>
2 17193
2 17193 i:= nextcoru(004,10,true);
2 17194 j:= newactivity(i,0,sletfil);
2 17195 <*+3*> skriv_newactivity(out,i,j);
2 17196 <*-3*>
2 17197
2 17197 i:= nextcoru(005,10,true);
2 17198 j:= newactivity(i,0,opretspoolfil);
2 17199 <*+3*> skriv_newactivity(out,i,j);
2 17200 <*-3*>
2 17201
2 17201 i:= nextcoru(006,10,true);
2 17202 j:= newactivity(i,0,opreteksternfil);
2 17203 <*+3*> skriv_newactivity(out,i,j);
2 17204 <*-3*>
2 17205 \f
2 17205 message attention_initialisering side 1 - 850820/cl;
2 17206
2 17206 tf_kommandotabel:= 1 shift 10 + 1;
2 17207
2 17207 begin
3 17208 integer i, s, zno;
3 17209 zone z(128,1,stderror);
3 17210 integer array fdim(1:8);
3 17211
3 17211 fdim(4):= tf_kommandotabel;
3 17212 hentfildim(fdim);
3 17213
3 17213 open(z,4,<:htkommando:>,0);
3 17214 for i:= 1 step 1 until fdim(3) do
3 17215 begin
4 17216 inrec6(z,512);
4 17217 s:= skrivfil(tf_kommandotabel,i,zno);
4 17218 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17219 tofrom(fil(zno),z,512);
4 17220 end;
3 17221 close(z,true);
3 17222 end;
2 17223 \f
2 17223 message attention_initialisering side 1a - 810428/hko;
2 17224
2 17224 for j:= system(3,i,terminal_tab) step 1 until i do
2 17225 terminal_tab(j):= 0;
2 17226
2 17226 cs_att_pulje:=next_semch;
2 17227 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17228 <*-3*>
2 17229
2 17229 bs_fortsæt_adgang:= nextsem;
2 17230 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17231 <*-3*>
2 17232 signalbin(bs_fortsæt_adgang);
2 17233
2 17233 for i:= 1,
2 17234 1 step 1 until max_antal_operatører,
2 17235 1 step 1 until max_antal_garageterminaler do
2 17236
2 17236 <* initialisering af pulje med attention_operationer *>
2 17237
2 17237 signalch(cs_att_pulje, <* pulje_semafor *>
2 17238 nextop(data+att_op_længde), <* næste_operation *>
2 17239 gen_optype);
2 17240
2 17240 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17241
2 17241 i:=next_coru(010,<*ident*>
2 17242 2,<*prioritet*>
2 17243 true<*test_maske*>);
2 17244 j:=newactivity( i, <*activityno *>
2 17245 0, <*ikke virtual *>
2 17246 attention);<*ingen parametre*>
2 17247
2 17247 <*+3*>skriv_newactivity(out,i,j);
2 17248 <*-3*>
2 17249 \f
2 17249 message io_initialisering side 1 - 810507/hko;
2 17250
2 17250 io_spoolfil:= 1028;
2 17251 begin
3 17252 integer array fdim(1:8);
3 17253 fdim(4):= io_spoolfil;
3 17254 hent_fildim(fdim);
3 17255 io_spool_postantal:= fdim(1);
3 17256 io_spool_postlængde:= fdim(2);
3 17257 end;
2 17258
2 17258 io_spool_post:= 4;
2 17259
2 17259 cs_io:= next_semch;
2 17260 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17261 <*-3*>
2 17262
2 17262 i:= next_coru(100,<*ident *>
2 17263 5,<*prioritet *>
2 17264 true<*test_maske*>);
2 17265
2 17265 j:= new_activity( i,
2 17266 0,
2 17267 h_io);
2 17268
2 17268 <*+3*>skriv_newactivity(out,i,j);
2 17269 <*-3*>
2 17270 cs_io_komm:= next_semch;
2 17271 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17272 <*-3*>
2 17273
2 17273 i:= next_coru(101,<*ident*>
2 17274 10,<*prioritet*>
2 17275 true <*testmaske*>);
2 17276 j:= new_activity( i,
2 17277 0,
2 17278 io_komm);<*ingen parametre*>
2 17279
2 17279 <*+3*>skriv_newactivity(out,i,j);
2 17280 <*-3*>
2 17281 \f
2 17281 message io_initialisering side 2 - 810520/hko/cl;
2 17282
2 17282 bs_zio_adgang:= next_sem;
2 17283 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17284 <*-3*>
2 17285 signal_bin(bs_zio_adgang);
2 17286
2 17286 cs_io_spool:= next_semch;
2 17287 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17288 <*-3*>
2 17289
2 17289 cs_io_fil:=next_semch;
2 17290 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17291 <*-3*>
2 17292 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17293
2 17293 ss_io_spool_fulde:= next_sem;
2 17294 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17295 <*-3*>
2 17296
2 17296 ss_io_spool_tomme:= next_sem;
2 17297 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17298 <*-3*>
2 17299 for i:= 1 step 1 until io_spool_postantal do
2 17300 signal(ss_io_spool_tomme);
2 17301 \f
2 17301 message io_initialisering side 3 - 880901/cl;
2 17302
2 17302 i:= next_coru(102,
2 17303 5,
2 17304 true);
2 17305 j:= new_activity(i,0,io_spool);
2 17306
2 17306 <*+3*>skriv_newactivity(out,i,j);
2 17307 <*-3*>
2 17308
2 17308 i:= next_coru(103,
2 17309 10,
2 17310 true);
2 17311 j:= new_activity(i,0,io_spon);
2 17312
2 17312 <*+3*>skriv_newactivity(out,i,j);
2 17313 <*-3*>
2 17314
2 17314 cs_io_medd:= next_semch;
2 17315 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17316 <*-3*>
2 17317
2 17317 i:= next_coru(104,<*ident *>
2 17318 10,<*prioritet *>
2 17319 true<*test_maske*>);
2 17320
2 17320 j:= new_activity( i,
2 17321 0,
2 17322 io_medd);
2 17323
2 17323 <*+3*>skriv_newactivity(out,i,j);
2 17324 <*-3*>
2 17325
2 17325 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17326 i:= monitor(8)reserve process:(z_io,0,ia);
2 17327 if i <> 0 then
2 17328 begin
3 17329 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17330 end
2 17331 else
2 17332 begin
3 17333 ref:= 0;
3 17334 terminal_tab.ref.terminal_tilstand:= 0;
3 17335 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17336 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17337 "sp",1,"*",15,"nl",1);
3 17338 setposition(z_io,0,0);
3 17339 end;
2 17340 \f
2 17340 message operatør_initialisering side 1 - 810520/hko;
2 17341
2 17341 top_bpl_gruppe:= 64;
2 17342
2 17342 bpl_navn(0):= long<::>;
2 17343 for i:= 1 step 1 until 127 do
2 17344 begin
3 17345 k:= læsfil(tf_bpl_navne,i,j);
3 17346 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17347 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17348 if i<=max_antal_operatører then
3 17349 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17350 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17351 top_bpl_gruppe:= i;
3 17352 end;
2 17353
2 17353 for i:= 0 step 1 until 64 do
2 17354 begin
3 17355 iaf:= i*op_maske_lgd;
3 17356 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17357 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17358 if 1<=i and i<= max_antal_operatører then
3 17359 begin
4 17360 bpl_tilst(i,2):= 1;
4 17361 sætbit_ia(bpl_def.iaf,i,1);
4 17362 end;
3 17363 end;
2 17364 for i:= 65 step 1 until 127 do
2 17365 begin
3 17366 k:= læsfil(tf_bpl_def,i-64,j);
3 17367 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17368 iaf:= i*op_maske_lgd;
3 17369 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17370 bpl_tilst(i,1):= 0;
3 17371 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17372 end;
2 17373
2 17373 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17374 iaf:= 0;
2 17375 for i:= 1 step 1 until max_antal_operatører do
2 17376 begin
3 17377 k:= læsfil(tf_stoptabel,i,j);
3 17378 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17379 operatør_stop(i,0):= i;
3 17380 for k:= 1,2,3 do
3 17381 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17382 ant_i_opkø(i):= 0;
3 17383 end;
2 17384
2 17384 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17385 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17386 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17387 sidste_tv_brugt:= max_antal_taleveje;
2 17388
2 17388 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17389 opk_alarm(i):= 0;
2 17390 for i:= 1 step 1 until max_antal_operatører do
2 17391 begin
3 17392 integer array field tab;
3 17393
3 17393 k:= læsfil(tf_alarmlgd,i,j);
3 17394 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17395 tab:= (i-1)*opk_alarm_tab_lgd;
3 17396 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17397 opk_alarm.tab.alarm_start:= 0.0;
3 17398 end;
2 17399
2 17399 op_spool_kilde:= 2;
2 17400 op_spool_tid := 6;
2 17401 op_spool_text := 6;
2 17402 begin
3 17403 long array field laf1, laf2;
3 17404 laf2:= 4; laf1:= 0;
3 17405 op_spool_buf.laf1(1):= long<::>;
3 17406 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17407 op_spool_postantal*op_spool_postlgd-4);
3 17408 end;
2 17409
2 17409 k:=læsfil(1033,1,j);
2 17410 systime(1,0.0,r);
2 17411 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17412 for i:= 1 step 1 until max_cqf do
2 17413 begin
3 17414 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17415 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17416 cqf_tabel.ref.cqf_næste_tid:=
3 17417 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17418 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17419 end;
2 17420 op_cqf_tab_ændret:= true;
2 17421
2 17421 laf:= raf:= 0;
2 17422 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17423 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17424 j:= 1;
2 17425 if i<>0 then
2 17426 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17427 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17428 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17429 j:= 1;
2 17430 if i<>0 then
2 17431 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17432
2 17432 ia(1):= 3; <*canonical*>
2 17433 ia(2):= 0; <*no echo*>
2 17434 ia(3):= 0; <*prompt*>
2 17435 ia(4):= 2; <*timeout*>
2 17436 setcspterm(taleswitch_in_navn.laf,ia);
2 17437 setcspterm(taleswitch_out_navn.laf,ia);
2 17438
2 17438 cs_op:= next_semch;
2 17439
2 17439 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17440 <*-3*>
2 17441
2 17441 cs_op_retur:= next_semch;
2 17442
2 17442 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17443 <*-3*>
2 17444
2 17444 i:= nextcoru(200,<*ident*>
2 17445 10,<*prioitet*>
2 17446 true<*test_maske*>);
2 17447
2 17447 j:= new_activity( i,
2 17448 0,
2 17449 h_operatør);
2 17450
2 17450 <*+3*>skriv_newactivity(out,i,j);
2 17451 <*-3*>
2 17452 \f
2 17452 message operatør_initialisering side 2 - 810520/hko;
2 17453
2 17453 for k:= 1 step 1 until max_antal_operatører do
2 17454 begin
3 17455 ref:= (k-1)*8;
3 17456 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17457 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17458 ref:=k*terminal_beskr_længde;
3 17459 if i = 0 then
3 17460 begin
4 17461 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17462 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17463 end
3 17464 else
3 17465 begin
4 17466 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17467 end;
3 17468
3 17468 cs_operatør(k):= next_semch;
3 17469 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17470 <*-3*>
3 17471
3 17471 cs_op_fil(k):= nextsemch;
3 17472 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17473 <*-3*>
3 17474 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17475
3 17475 i:= next_coru(200+k,<*ident*>
3 17476 10,<*prioitet*>
3 17477 true<*testmaske*>);
3 17478 j:= new_activity( i,
3 17479 0,
3 17480 operatør,k);
3 17481
3 17481 <*+3*>skriv_newactivity(out,i,j);
3 17482 <*-3*>
3 17483 end;
2 17484
2 17484 cs_cqf:= next_semch;
2 17485 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17486 <*-3*>
2 17487
2 17487 signalch(cs_cqf,nextop(60),true);
2 17488
2 17488 i:= next_coru(292, <*ident*>
2 17489 10, <*prioritet*>
2 17490 true <*testmaske*>);
2 17491 j:= new_activity( i,
2 17492 0,
2 17493 op_cqftest);
2 17494 <*+3*>skriv_new_activity(out,i,j);
2 17495 <*-3*>
2 17496
2 17496 cs_op_spool:= next_semch;
2 17497 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17498 <*-3*>
2 17499
2 17499 cs_op_medd:= next_semch;
2 17500 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17501 <*-3*>
2 17502
2 17502 ss_op_spool_tomme:= next_sem;
2 17503 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17504 <*-3*>
2 17505 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17506
2 17506 ss_op_spool_fulde:= next_sem;
2 17507 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17508 <*-3*>
2 17509
2 17509 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17510
2 17510 i:= next_coru(293, <*ident*>
2 17511 10, <*prioritet*>
2 17512 true <*testmaske*>);
2 17513 j:= new_activity( i,
2 17514 0,
2 17515 op_spool);
2 17516 <*+3*>skriv_new_activity(out,i,j);
2 17517 <*-3*>
2 17518
2 17518 i:= next_coru(294, <*ident*>
2 17519 10, <*prioritet*>
2 17520 true <*testmaske*>);
2 17521 j:= new_activity( i,
2 17522 0,
2 17523 op_medd);
2 17524 <*+3*>skriv_new_activity(out,i,j);
2 17525 <*-3*>
2 17526
2 17526 cs_op_iomedd:= next_semch;
2 17527 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17528 <*-3*>
2 17529
2 17529 bs_opk_alarm:= next_sem;
2 17530 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17531 <*-3*>
2 17532
2 17532 cs_opk_alarm:= next_semch;
2 17533 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17534 <*-3*>
2 17535
2 17535 cs_opk_alarm_ur:= next_semch;
2 17536 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17537 <*-3*>
2 17538
2 17538 cs_opk_alarm_ur_ret:= next_semch;
2 17539 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17540 <*-3*>
2 17541
2 17541 cs_tvswitch_adgang:= next_semch;
2 17542 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17543 <*-3*>
2 17544
2 17544 cs_tv_switch_input:= next_semch;
2 17545 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17546 <*-3*>
2 17547
2 17547 cs_tv_switch_adm:= next_semch;
2 17548 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17549 <*-3*>
2 17550
2 17550 cs_talevejsswitch:= next_semch;
2 17551 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17552 <*-3*>
2 17553
2 17553 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17554
2 17554 iaf:= nextop(data+128);
2 17555 if testbit22 then
2 17556 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17557 else
2 17558 begin
3 17559 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17560 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17561 end;
2 17562
2 17562 i:= next_coru(295, <*ident*>
2 17563 8, <*prioritet*>
2 17564 true <*testmaske*>);
2 17565 j:= new_activity( i,
2 17566 0,
2 17567 alarmur);
2 17568 <*+3*>skriv_new_activity(out,i,j);
2 17569 <*-3*>
2 17570
2 17570 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17571
2 17571 i:= next_coru(296, <*ident*>
2 17572 8, <*prioritet*>
2 17573 true <*testmaske*>);
2 17574 j:= new_activity( i,
2 17575 0,
2 17576 opkaldsalarmer);
2 17577 <*+3*>skriv_new_activity(out,i,j);
2 17578 <*-3*>
2 17579
2 17579 i:= next_coru(297, <*ident*>
2 17580 3, <*prioritet*>
2 17581 true <*testmaske*>);
2 17582 j:= new_activity( i,
2 17583 0,
2 17584 tv_switch_input);
2 17585 <*+3*>skriv_new_activity(out,i,j);
2 17586 <*-3*>
2 17587
2 17587 for i:= 1,2 do
2 17588 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17589
2 17589 i:= next_coru(298, <*ident*>
2 17590 20, <*prioritet*>
2 17591 true <*testmaske*>);
2 17592 j:= new_activity( i,
2 17593 0,
2 17594 tv_switch_adm);
2 17595 <*+3*>skriv_new_activity(out,i,j);
2 17596 <*-3*>
2 17597
2 17597 i:= next_coru(299, <*ident*>
2 17598 3, <*prioritet*>
2 17599 true <*testmaske*>);
2 17600 j:= new_activity( i,
2 17601 0,
2 17602 talevejsswitch);
2 17603 <*+3*>skriv_new_activity(out,i,j);
2 17604 <*-3*>
2 17605 \f
2 17605 message garage_initialisering side 1 - 810521/hko;
2 17606
2 17606 cs_gar:= next_semch;
2 17607 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 17608 <*-3*>
2 17609
2 17609 i:= next_coru(300,<*ident*>
2 17610 10,<*prioritet*>
2 17611 true<*test_maske*>);
2 17612
2 17612 j:= new_activity( i,
2 17613 0,
2 17614 h_garage);
2 17615
2 17615 <*+3*>skriv_newactivity(out,i,j);
2 17616 <*-3*>
2 17617
2 17617 for k:= 1 step 1 until max_antal_garageterminaler do
2 17618 begin
3 17619 ref:= (k-1)*8;
3 17620 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 17621 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 17622 i:=monitor(4)process address:(z_gar(k),0,ia);
3 17623 if i = 0 then
3 17624 begin
4 17625 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 17626 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17627 end
3 17628 else
3 17629 begin
4 17630 terminal_tab.ref.terminal_tilstand:=
4 17631 if garage_auto_include(k) then 0 else 7 shift 21;
4 17632 if garage_auto_include(k) then
4 17633 monitor(8)reserve:(z_gar(k),0,ia);
4 17634 end;
3 17635 cs_garage(k):= next_semch;
3 17636 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 17637 <*-3*>
3 17638 i:= next_coru(300+k,<*ident*>
3 17639 10,<*prioritet*>
3 17640 true <*testmaske*>);
3 17641 j:= new_activity( i,
3 17642 0,
3 17643 garage,k);
3 17644
3 17644 <*+3*>skriv_newactivity(out,i,j);
3 17645 <*-3*>
3 17646
3 17646 end;
2 17647 \f
2 17647 message radio_initialisering side 1 - 820301/hko;
2 17648
2 17648 cs_rad:= next_semch;
2 17649 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 17650 <*-3*>
2 17651
2 17651 i:= next_coru(400,<*ident*>
2 17652 10,<*prioritet*>
2 17653 true<*test_maske*>);
2 17654 j:= new_activity( i,
2 17655 0,
2 17656 h_radio);
2 17657 <*+3*>skriv_newactivity(out,i,j);
2 17658 <*-3*>
2 17659
2 17659 opkalds_kø_ledige:= max_antal_mobilopkald;
2 17660 nødopkald_brugt:= 0;
2 17661 læsfil(1034,1,i);
2 17662 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 17663
2 17663 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 17664 for i:= system(3,j,opkaldskø) step 1 until j do
2 17665 opkaldskø(i):= 0;
2 17666 første_frie_opkald:=opkaldskø_postlængde;
2 17667 første_opkald:=sidste_opkald:=
2 17668 første_nødopkald:=sidste_nødopkald:=j:=0;
2 17669
2 17669 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 17670 begin
3 17671 ref:=i*opkaldskø_postlængde;
3 17672 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 17673 end;
2 17674 ref:=ref+opkaldskø_postlængde;
2 17675 opkaldskø.ref(1):=j shift 12;
2 17676
2 17676 for ref:= 0 step 512 until (max_linienr//768*512) do
2 17677 begin
3 17678 i:= læs_fil(1035,ref//512+1,j);
3 17679 if i <> 0 then
3 17680 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 17681 tofrom(radio_linietabel.ref,fil(j),
3 17682 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 17683 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 17684 end;
2 17685
2 17685 for i:= system(3,j,kanal_tab) step 1 until j do
2 17686 kanal_tab(i):= 0;
2 17687 kanal_tilstand:= 2;
2 17688 kanal_id1:= 4;
2 17689 kanal_id2:= 6;
2 17690 kanal_spec:= 8;
2 17691 kanal_alt_id1:= 10;
2 17692 kanal_alt_id2:= 12;
2 17693 kanal_mon_maske:= 12;
2 17694 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 17695
2 17695 for i:= 1 step 1 until max_antal_kanaler do
2 17696 begin
3 17697 ref:= (i-1)*kanalbeskrlængde;
3 17698 sæthexciffer(kanal_tab.ref,3,15);
3 17699 if kanal_id(i) shift (-5) extract 3 = 2 or
3 17700 kanal_id(i) shift (-5) extract 3 = 3 and
3 17701 radio_id(kanal_id(i) extract 5)<=3
3 17702 then
3 17703 begin
4 17704 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 17705 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 17706 end;
3 17707 end;
2 17708 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 17709 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 17710 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 17711 optaget_flag:= 0;
2 17712 \f
2 17712 message radio_initialisering side 2 - 810524/hko;
2 17713
2 17713 bs_mobil_opkald:= next_sem;
2 17714
2 17714 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 17715 <*-3*>
2 17716
2 17716 bs_opkaldskø_adgang:= next_sem;
2 17717 signal_bin(bs_opkaldskø_adgang);
2 17718
2 17718 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 17719 <*-3*>
2 17720
2 17720 cs_radio_medd:=next_semch;
2 17721 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 17722
2 17722 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 17723 <*-3*>
2 17724
2 17724 i:= next_coru(403,
2 17725 5,<*prioritet*>
2 17726 true<*testmaske*>);
2 17727
2 17727 j:= new_activity( i,
2 17728 0,
2 17729 radio_medd_opkald);
2 17730
2 17730 <*+3*>skriv_newactivity(out,i,j);
2 17731 <*-3*>
2 17732
2 17732 cs_radio_adm:= nextsemch;
2 17733 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 17734 <*-3*>
2 17735
2 17735 i:= next_coru(404,
2 17736 10,
2 17737 true);
2 17738 j:= new_activity(i,
2 17739 0,
2 17740 radio_adm,next_op(data+radio_op_længde));
2 17741 <*+3*>skriv_new_activity(out,i,j);
2 17742 <*-3*>
2 17743 \f
2 17743 message radio_initialisering side 3 - 810526/hko;
2 17744 for k:= 1 step 1 until max_antal_taleveje do
2 17745 begin
3 17746
3 17746 cs_radio(k):=next_semch;
3 17747
3 17747 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 17748 <*-3*>
3 17749
3 17749 bs_talevej_udkoblet(k):= nextsem;
3 17750 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 17751 <*-3*>
3 17752
3 17752 i:=next_coru(410+k,
3 17753 10,
3 17754 true);
3 17755
3 17755 j:=new_activity( i,
3 17756 0,
3 17757 radio,k,next_op(data + radio_op_længde));
3 17758
3 17758 <*+3*>skriv_newactivity(out,i,j);
3 17759 <*-3*>
3 17760 end;
2 17761
2 17761 cs_radio_pulje:=next_semch;
2 17762
2 17762 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 17763 <*-3*>
2 17764
2 17764 for i:= 1 step 1 until radiopulje_størrelse do
2 17765 signal_ch(cs_radio_pulje,
2 17766 next_op(60),
2 17767 gen_optype or rad_optype);
2 17768
2 17768 cs_radio_kø:= next_semch;
2 17769
2 17769 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 17770 <*-3*>
2 17771
2 17771 mobil_opkald_aktiveret:= true;
2 17772 \f
2 17772 message radio_initialisering side 4 - 810522/hko;
2 17773
2 17773 laf:=raf:=0;
2 17774
2 17774 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 17775 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 17776 j:=1;
2 17777 if i <> 0 then
2 17778 fejlreaktion(4<*monitor resultat*>,i,
2 17779 string radio_fr_navn.raf(increase(j)),1);
2 17780 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 17781 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 17782 j:=1;
2 17783 if i <> 0 then
2 17784 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 17785 ia(1):= 3 <*canonical*>;
2 17786 ia(2):= 0 <*no echo*>;
2 17787 ia(3):= 0 <*prompt*>;
2 17788 ia(4):= 5 <*timeout*>;
2 17789 setcspterm(radio_fr_navn.laf,ia);
2 17790
2 17790 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 17791 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 17792 j:= 1;
2 17793 if i <> 0 then
2 17794 fejlreaktion(4<*monitor resultat*>,i,
2 17795 string radio_rf_navn.raf(increase(j)),1);
2 17796 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 17797 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 17798 j:= 1;
2 17799 if i <> 0 then
2 17800 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 17801 ia(1):= 3 <*canonical*>;
2 17802 ia(2):= 0 <*no echo*>;
2 17803 ia(3):= 0 <*prompt*>;
2 17804 ia(4):= 5 <*timeout*>;
2 17805 setcspterm(radio_rf_navn.laf,ia);
2 17806 \f
2 17806 message radio_initialisering side 5 - 810521/hko;
2 17807 for k:= 1 step 1 until max_antal_kanaler do
2 17808 begin
3 17809
3 17809 ss_radio_aktiver(k):=next_sem;
3 17810 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 17811 <*-3*>
3 17812
3 17812 ss_samtale_nedlagt(k):=next_sem;
3 17813 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 17814 <*-3*>
3 17815 end;
2 17816
2 17816 cs_radio_ind:= next_semch;
2 17817 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 17818 <*-3*>
2 17819
2 17819 i:= next_coru(401,<*ident radio_ind*>
2 17820 3, <*prioritet*>
2 17821 true <*testmaske*>);
2 17822 j:= new_activity( i,
2 17823 0,
2 17824 radio_ind,next_op(data + 64));
2 17825
2 17825 <*+3*>skriv_newactivity(out,i,j);
2 17826 <*-3*>
2 17827
2 17827 cs_radio_ud:=next_semch;
2 17828 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 17829 <*-3*>
2 17830
2 17830 i:= next_coru(402,<*ident radio_out*>
2 17831 10,<*prioritet*>
2 17832 true <*testmaske*>);
2 17833 j:= new_activity( i,
2 17834 0,
2 17835 radio_ud,next_op(data + 64));
2 17836
2 17836 <*+3*>skriv_newactivity(out,i,j);
2 17837 <*-3*>
2 17838 \f
2 17838 message vogntabel initialisering side 1 - 820301;
2 17839
2 17839 sidste_bus:= sidste_linie_løb:= 0;
2 17840
2 17840 tf_vogntabel:= 1 shift 10 + 2;
2 17841 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 17842 tf_gruppeidenter:= 1 shift 10 +6;
2 17843 tf_springdef:= 1 shift 10 +7;
2 17844 hent_fil_dim(ia);
2 17845 max_antal_i_gruppe:= ia(2);
2 17846 if ia(1) < max_antal_grupper then
2 17847 max_antal_grupper:= ia(1);
2 17848
2 17848 <* initialisering af interne vogntabeller *>
2 17849 begin
3 17850 long array field laf1,laf2;
3 17851 integer array fdim(1:8);
3 17852 zone z(128,1,stderror);
3 17853 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 17854 long omr,garageid;
3 17855 integer field ll, bn;
3 17856 boolean binær, test24;
3 17857
3 17857 ll:= 2; bn:= 4;
3 17858
3 17858 <* nulstil tabellerne *>
3 17859 laf1:= -2;
3 17860 laf2:= 2;
3 17861 bustabel1.laf2(0):=
3 17862 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 17863 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 17864 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 17865 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 17866 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 17867 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 17868 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 17869 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 17870 \f
3 17870 message vogntabel initialisering side 1a - 810505/cl;
3 17871
3 17871
3 17871 <* initialisering af intern busnummertabel *>
3 17872 open(z,4,<:busnumre:>,0);
3 17873 busnr:= -1;
3 17874 read(z,busnr);
3 17875 while busnr > 0 do
3 17876 begin
4 17877 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 17878 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 17879 sidste_bus:= sidste_bus+1;
4 17880 if sidste_bus > max_antal_busser then
4 17881 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 17882 repeatchar(z); readchar(z,tegn);
4 17883 garageid:= extend 0; binær:= false; omr:= extend 0;
4 17884 g_nr:= o_nr:= 0;
4 17885 if tegn='!' then
4 17886 begin
5 17887 binær:= true;
5 17888 readchar(z,tegn);
5 17889 end;
4 17890 if tegn='/' then <*garageid*>
4 17891 begin
5 17892 readchar(z,tegn); repeatchar(z);
5 17893 if '0'<=tegn and tegn<='9' then
5 17894 begin
6 17895 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 17896 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 17897 if g_nr<>0 and garageid=long<::> then
6 17898 begin
7 17899 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 17900 g_nr:= 0;
7 17901 end;
6 17902 end
5 17903 else
5 17904 begin
6 17905 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 17906 begin
7 17907 garageid:= garageid shift 8 + tegn;
7 17908 readchar(z,tegn);
7 17909 end;
6 17910 while garageid shift (-40) extract 8 = 0 do
6 17911 garageid:= garageid shift 8;
6 17912 g_nr:= find_bpl(garageid);
6 17913 if g_nr=0 then
6 17914 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 17915 end;
5 17916 repeatchar(z); readchar(z,tegn);
5 17917 end;
4 17918 if tegn=';' then
4 17919 begin
5 17920 readchar(z,tegn); repeatchar(z);
5 17921 if '0'<=tegn and tegn<='9' then
5 17922 begin
6 17923 read(z,o_nr);
6 17924 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 17925 if o_nr<>0 then omr:= område_navn(o_nr);
6 17926 if o_nr<>0 and omr=long<::> then
6 17927 begin
7 17928 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 17929 o_nr:= 0;
7 17930 end;
6 17931 end
5 17932 else
5 17933 begin
6 17934 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 17935 begin
7 17936 omr:= omr shift 8 + tegn;
7 17937 readchar(z,tegn);
7 17938 end;
6 17939 while omr shift (-40) extract 8 = 0 do
6 17940 omr:= omr shift 8;
6 17941 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 17942 i:= 1;
6 17943 while i<=max_antal_områder and o_nr=0 do
6 17944 begin
7 17945 if omr=område_navn(i) then o_nr:= i;
7 17946 i:= i+1;
7 17947 end;
6 17948 if o_nr=0 then
6 17949 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 17950 end;
5 17951 repeatchar(z); readchar(z,tegn);
5 17952 end;
4 17953 if o_nr=0 then o_nr:= 3;
4 17954 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 17955 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 17956
4 17956 busnr:= -1;
4 17957 read(z,busnr);
4 17958 end;
3 17959 close(z,true);
3 17960 \f
3 17960 message vogntabel initialisering side 2 - 820301/cl;
3 17961
3 17961 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 17962 test24:= testbit24;
3 17963 testbit24:= false;
3 17964 i:= 1;
3 17965 s:= læsfil(tf_vogntabel,i,zi);
3 17966 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 17967 while fil(zi).bn<>0 do
3 17968 begin
4 17969 if fil(zi).ll <> 0 then
4 17970 begin <* indsæt linie/løb *>
5 17971 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 17972 fil(zi).ll,j);
5 17973 if res < 0 then j:= j+1;
5 17974 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 17975 <:dobbeltregistrering i vogntabel:>,1)
5 17976 else
5 17977 begin
6 17978 o_nr:= fil(zi).bn shift (-14) extract 8;
6 17979 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 17980 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 17981 <:ukendt bus i vogntabel:>,1)
6 17982 else
6 17983 begin
7 17984 if sidste_linie_løb >= max_antal_linie_løb then
7 17985 fejlreaktion(10,fil(zi).bn extract 14,
7 17986 <:for mange linie/løb i vogntabel:>,0);
7 17987 for ll_nr:= sidste_linie_løb step (-1) until j do
7 17988 begin
8 17989 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 17990 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 17991 end;
7 17992 linie_løb_tabel(j):= fil(zi).ll;
7 17993 bus_indeks(j):= false add b_nr;
7 17994 sidste_linie_løb:= sidste_linie_løb + 1;
7 17995 end;
6 17996 end;
5 17997 end;
4 17998 i:= i+1;
4 17999 s:= læsfil(tf_vogntabel,i,zi);
4 18000 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18001 end;
3 18002 \f
3 18002 message vogntabel initialisering side 3 - 810428/cl;
3 18003
3 18003 <* initialisering af intern linie/løb-indekstabel *>
3 18004 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18005 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18006
3 18006 <* gem ny vogntabel i tabelfil *>
3 18007 for i:= 1 step 1 until sidste_bus do
3 18008 begin
4 18009 s:= skriv_fil(tf_vogntabel,i,zi);
4 18010 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18011 fil(zi).bn:= bustabel(i) extract 14 add
4 18012 (bustabel1(i) extract 8 shift 14);
4 18013 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18014 end;
3 18015 fdim(4):= tf_vogntabel;
3 18016 hent_fil_dim(fdim);
3 18017 pant:= fdim(3) * (256//fdim(2));
3 18018 for i:= sidste_bus+1 step 1 until pant do
3 18019 begin
4 18020 s:= skriv_fil(tf_vogntabel,i,zi);
4 18021 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18022 fil(zi).ll:= fil(zi).bn:= 0;
4 18023 end;
3 18024
3 18024 <* initialisering/nulstilling af gruppetabeller *>
3 18025 for i:= 1 step 1 until max_antal_grupper do
3 18026 begin
4 18027 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18028 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18029 gruppetabel(i):= fil(zi).ll;
4 18030 end;
3 18031 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18032 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18033 testbit24:= test24;
3 18034 end;
2 18035
2 18035
2 18035 <*+2*>
2 18036 <**> if testbit40 then p_vogntabel(out);
2 18037 <**> if testbit43 then p_gruppetabel(out);
2 18038 <*-2*>
2 18039
2 18039 message vogntabel initialisering side 3a -920517/cl;
2 18040
2 18040 <* initialisering for vt_log *>
2 18041
2 18041 v_tid:= 4;
2 18042 v_kode:= 6;
2 18043 v_bus:= 8;
2 18044 v_ll1:= 10;
2 18045 v_ll2:= 12;
2 18046 v_tekst:= 6;
2 18047 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18048 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18049 if vt_log_aktiv then
2 18050 begin
3 18051 integer i;
3 18052 real t;
3 18053 integer array field iaf;
3 18054 integer array
3 18055 tail(1:10),ia(1:10),chead(1:20);
3 18056
3 18056 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18057 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18058 if i=0 then
3 18059 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18060 if i=0 then
3 18061 begin
4 18062 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18063 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18064 end;
3 18065
3 18065 if i=0 then
3 18066 begin
4 18067 iaf:= 2;
4 18068 tofrom(vt_logdisc,tail.iaf,8);
4 18069 i:=slices(vt_logdisc,0,tail,chead);
4 18070 if i > (-2048) then
4 18071 begin
5 18072 vt_log_slicelgd:= chead(15);
5 18073 i:= 0;
5 18074 end;
4 18075 end;
3 18076
3 18076 if i=0 then
3 18077 begin
4 18078 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18079 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18080 if i=0 then
4 18081 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18082 if i=0 then
4 18083 begin
5 18084 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18085 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18086 end;
4 18087
4 18087 if i<>0 then
4 18088 begin
5 18089 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18090 tail(1):= 1;
5 18091 iaf:= 2;
5 18092 tofrom(tail.iaf,vt_logdisc,8);
5 18093 tail(6):=systime(7,0,t);
5 18094 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18095 if i=0 then
5 18096 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18097 end;
4 18098 end;
3 18099
3 18099 if i<>0 then vt_log_aktiv:= false;
3 18100 end;
2 18101
2 18101
2 18101 \f
2 18101 message vogntabel initialisering side 4 - 810520/cl;
2 18102
2 18102 cs_vt:= nextsemch;
2 18103 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18104 <*-3*>
2 18105
2 18105 cs_vt_adgang:= nextsemch;
2 18106 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18107 <*-3*>
2 18108
2 18108 cs_vt_opd:= nextsemch;
2 18109 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18110 <*-3*>
2 18111
2 18111 cs_vt_rap:= nextsemch;
2 18112 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18113 <*-3*>
2 18114
2 18114 cs_vt_tilst:= nextsemch;
2 18115 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18116 <*-3*>
2 18117
2 18117 cs_vt_auto:= nextsemch;
2 18118 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18119 <*-3*>
2 18120
2 18120 cs_vt_grp:= nextsemch;
2 18121 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18122 <*-3*>
2 18123
2 18123 cs_vt_spring:= nextsemch;
2 18124 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18125 <*-3*>
2 18126
2 18126 cs_vt_log:= nextsemch;
2 18127 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18128 <*-3*>
2 18129
2 18129 cs_vt_logpool:= nextsemch;
2 18130 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18131 <*-3*>
2 18132
2 18132 vt_op:= nextop(vt_op_længde);
2 18133 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18134
2 18134 vt_logop(1):= nextop(vt_op_længde);
2 18135 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18136 vt_logop(2):= nextop(vt_op_længde);
2 18137 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18138
2 18138 \f
2 18138 message vogntabel initialisering side 5 - 81-520/cl;
2 18139
2 18139 i:= nextcoru(500, <*ident*>
2 18140 10, <*prioitet*>
2 18141 true <*testmaske*>);
2 18142 j:= new_activity( i,
2 18143 0,
2 18144 h_vogntabel);
2 18145 <*+3*> skriv_newactivity(out,i,j);
2 18146 <*-3*>
2 18147
2 18147 i:= nextcoru(501, <*ident*>
2 18148 10, <*prioritet*>
2 18149 true <*testmaske*>);
2 18150 iaf:= nextop(filop_længde);
2 18151 j:= new_activity(i,
2 18152 0,
2 18153 vt_opdater,iaf);
2 18154 <*+3*> skriv_newactivity(out,i,j);
2 18155 <*-3*>
2 18156
2 18156 i:= nextcoru(502, <*ident*>
2 18157 10, <*prioritet*>
2 18158 true <*testmaske*>);
2 18159 k:= nextsemch;
2 18160 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18161 <*-3*>
2 18162 iaf:= nextop(fil_op_længde);
2 18163 j:= newactivity(i,
2 18164 0,
2 18165 vt_tilstand,
2 18166 k,
2 18167 iaf);
2 18168 <*+3*> skriv_newactivity(out,i,j);
2 18169 <*-3*>
2 18170 \f
2 18170 message vogntabel initialisering side 6 - 810520/cl;
2 18171
2 18171 i:= nextcoru(503, <*ident*>
2 18172 10, <*prioritet*>
2 18173 true <*testmaske*>);
2 18174 k:= nextsemch;
2 18175 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18176 <*-3*>
2 18177 iaf:= nextop(fil_op_længde);
2 18178 j:= newactivity(i,
2 18179 0,
2 18180 vt_rapport,
2 18181 k,
2 18182 iaf);
2 18183 <*+3*> skriv_newactivity(out,i,j);
2 18184 <*-3*>
2 18185
2 18185 i:= nextcoru(504, <*ident*>
2 18186 10, <*prioritet*>
2 18187 true <*testmaske*>);
2 18188 k:= nextsemch;
2 18189 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18190 <*-3*>
2 18191 iaf:= nextop(fil_op_længde);
2 18192 j:= new_activity(i,
2 18193 0,
2 18194 vt_gruppe,
2 18195 k,
2 18196 iaf);
2 18197 <*+3*> skriv_newactivity(out,i,j);
2 18198 <*-3*>
2 18199 \f
2 18199 message vogntabel initialisering side 7 - 810520/cl;
2 18200
2 18200 i:= nextcoru(505, <*ident*>
2 18201 10, <*prioritet*>
2 18202 true <*testmaske*>);
2 18203 k:= nextsemch;
2 18204 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18205 <*-3*>
2 18206 iaf:= nextop(fil_op_længde);
2 18207 j:= newactivity(i,
2 18208 0,
2 18209 vt_spring,
2 18210 k,
2 18211 iaf);
2 18212 <*+3*> skriv_newactivity(out,i,j);
2 18213 <*-3*>
2 18214
2 18214 i:= nextcoru(506, <*ident*>
2 18215 10,
2 18216 true <*testmaske*>);
2 18217 k:= nextsemch;
2 18218 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18219 <*-3*>
2 18220 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18221 j:= newactivity(i,
2 18222 0,
2 18223 vt_auto,
2 18224 k,
2 18225 iaf);
2 18226 <*+3*> skriv_newactivity(out,i,j);
2 18227 <*-3*>
2 18228
2 18228 i:=nextcoru(507, <*ident*>
2 18229 10, <*prioritet*>
2 18230 true <*testmaske*>);
2 18231 j:=newactivity(i,
2 18232 0,
2 18233 vt_log);
2 18234 <*+3*> skriv_newactivity(out,i,j);
2 18235 <*-3*>
2 18236
2 18236 <*+2*>
2 18237 <**> if testbit42 then skriv_vt_variable(out);
2 18238 <*-2*>
2 18239 \f
2 18239 message sysslut initialisering side 1 - 810406/cl;
2 18240 begin
3 18241 zone z(128,1,stderror);
3 18242 integer i,coruid,j,k;
3 18243 integer array field cor;
3 18244
3 18244 open(z,4,<:overvågede:>,0);
3 18245 for i:= read(z,coruid) while i > 0 do
3 18246 begin
4 18247 if coruid = 0 then
4 18248 begin
5 18249 for coruid:= 1 step 1 until maxcoru do
5 18250 begin
6 18251 cor:= coroutine(coruid);
6 18252 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18253 end
5 18254 end
4 18255 else
4 18256 begin
5 18257 cor:= coroutine(coru_no(abs coruid));
5 18258 if cor > 0 then
5 18259 begin
6 18260 d.cor.corutestmask:=
6 18261 (d.cor.corutestmask shift 1 shift (-1)) add
6 18262 ((coruid > 0) extract 1 shift 11);
6 18263 end;
5 18264 end;
4 18265 end;
3 18266 close(z,true);
3 18267
3 18267 læsfil(tf_systællere,1,k);
3 18268 cor:= 0;
3 18269 tofrom(opkalds_tællere,fil(k).cor,max_antal_områder*6);
3 18270
3 18270 end;
2 18271 \f
2 18271 message sysslut initialisering side 2 - 810603/cl;
2 18272
2 18272
2 18272 if låsning > 0 then
2 18273 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18274
2 18274 if låsning > 1 then
2 18275 <* låsning 2 : *> lock(readchar,1,write,2);
2 18276
2 18276 if låsning > 2 then
2 18277 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18278
2 18278
2 18278
2 18278
2 18278 if låsning > 0 then
2 18279 begin
3 18280 i:= locked(ia);
3 18281 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18282 end;
2 18283 \f
2 18283 message sysslut initialisering side 3 - 810406/cl;
2 18284
2 18284 write(z_io,"nl",2,<:initialisering slut:>);
2 18285 system(2)free core:(i,ra);
2 18286 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18287 setposition(z_io,0,0);
2 18288 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18289 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18290 "nl",1);
2 18291 errorbits:= 3; <* ok.no warning.yes *>
2 18292 \f
2 18292
2 18292 algol list.off;
2 18293 message coroutinemonitor - 40 ;
2 18294
2 18294 if simref <> firstsem then initerror(1, false);
2 18295 if semref <> firstop - 4 then initerror(2, false);
2 18296 if coruref <> firstsim then initerror(3, false);
2 18297 if opref <> optop + 6 then initerror(4, false);
2 18298 if proccount <> maxprocext -1 then initerror(5, false);
2 18299 goto takeexternal;
2 18300
2 18300 dump:
2 18301 op:= op;
2 18302 \f
2 18302 message sys trapaktion side 1 - 810521/hko/cl;
2 18303 trap(finale);
2 18304 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18305 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18306 begin
3 18307 k:= 0;
3 18308 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18309 <:timerqueue->:>));
3 18310 iaf:= i;
3 18311 for iaf:= d.iaf.next while iaf<>i do
3 18312 begin
4 18313 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18314 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18315 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18316 end;
3 18317 end;
2 18318 outchar(zbillede,'nl');
2 18319
2 18319 skriv_opkaldstællere(zbillede);
2 18320
2 18320
2 18320 pfilsystem(zbillede);
2 18321
2 18321 \f
2 18321 message operatør trapaktion1 side 1 - 810521/hko;
2 18322 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18323
2 18323 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18324 for i:= 1 step 1 until max_antal_operatører do
2 18325 begin
3 18326 laf:= (i-1)*8;
3 18327 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18328 case operatør_auto_include(i) extract 2 + 1 of (
3 18329 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18330 terminal_navn.laf,"nl",1);
3 18331 end;
2 18332 write(zbillede,"nl",1);
2 18333
2 18333 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18334 <:betjeningspladsgrupper::>,"nl",1);
2 18335 for i:= 1 step 1 until 127 do
2 18336 if bpl_navn(i)<>long<::> then
2 18337 begin
3 18338 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18339 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18340 write(zbillede,"sp",16-k,<:= :>);
3 18341 iaf:= i*op_maske_lgd; j:=0;
3 18342 for k:= 1 step 1 until max_antal_operatører do
3 18343 begin
4 18344 if læsbit_ia(bpl_def.iaf,k) then
4 18345 begin
5 18346 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18347 write(zbillede,true,6,string bpl_navn(k));
5 18348 j:= j+1;
5 18349 end;
4 18350 end;
3 18351 write(zbillede,"nl",1);
3 18352 end;
2 18353
2 18353 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18354 for i:= 1 step 1 until max_antal_operatører do
2 18355 begin
3 18356 write(zbillede,<<dd >,i);
3 18357 for j:= 0 step 1 until 3 do
3 18358 begin
4 18359 k:= operatør_stop(i,j);
4 18360 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18361 else string bpl_navn(k));
4 18362 end;
3 18363 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18364 end;
2 18365
2 18365 skriv_terminal_tab(zbillede);
2 18366 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18367 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18368 skriv_opk_alarm_tab(zbillede);
2 18369 skriv_talevejs_tab(zbillede);
2 18370 skriv_op_spool_buf(zbillede);
2 18371 skriv_cqf_tabel(zbillede,true);
2 18372 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18373
2 18373 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18374 for i:= 1 step 1 until max_antal_garageterminaler do
2 18375 begin
3 18376 laf:= (i-1)*8;
3 18377 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18378 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18379 end;
2 18380 \f
2 18380 message radio trapaktion side 1 - 820301/hko;
2 18381 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18382 skriv_kanal_tab(zbillede);
2 18383 skriv_opkaldskø(zbillede);
2 18384 skriv_radio_linietabel(zbillede);
2 18385 skriv_radio_områdetabel(zbillede);
2 18386
2 18386 \f
2 18386 message vogntabel trapaktion side 1 - 810520/cl;
2 18387 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18388 skriv_vt_variable(zbillede);
2 18389 p_vogntabel(zbillede);
2 18390 p_gruppetabel(zbillede);
2 18391 p_springtabel(zbillede);
2 18392 \f
2 18392 message sysslut trapaktion side 1 - 810519/cl;
2 18393 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18394 corutable(zbillede);
2 18395 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18396 <: ref værdi prev next:>,"nl",1);
2 18397 iaf:= firstsim;
2 18398 repeat
2 18399 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18400 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18401 iaf:= iaf + simsize;
2 18402 until iaf>=simref;
2 18403 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18404 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18405 iaf:= firstsem;
2 18406 repeat
2 18407 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18408 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18409 iaf:= iaf+semsize;
2 18410 until iaf>=semref;
2 18411 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18412 iaf:= firstop;
2 18413 repeat
2 18414 skriv_op(zbillede,iaf);
2 18415 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18416 until iaf>=optop;
2 18417 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18418 <: messref messcode messop:>,"nl",1);
2 18419 for i:= 1 step 1 until maxmessext do
2 18420 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18421 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18422 <: procref proccode procop:>,"nl",1);
2 18423 for i:= 1 step 1 until maxprocext do
2 18424 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18425
2 18425
2 18425 \f
2 18425 message sys_finale side 1 - 810428/hko;
2 18426
2 18426 finale:
2 18427 trap(slut_finale);
2 18428 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18429 endaction:=0;
2 18430 \f
2 18430 message filsystem finale side 1 - 810428/cl;
2 18431
2 18431 <* lukning af zoner *>
2 18432 write(out,<:lukker filsystem:>); ud;
2 18433 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18434 close(fil(i),true);
2 18435 \f
2 18435 message operatør_finale side 1 - 810428/hko;
2 18436
2 18436 goto op_trap2_slut;
2 18437
2 18437 write(out,<:lukker operatører:>); ud;
2 18438 for k:= 1 step 1 until max_antal_operatører do
2 18439 begin
3 18440 close(z_op(k),true);
3 18441 end;
2 18442 op_trap2_slut:
2 18443 k:=k;
2 18444
2 18444 \f
2 18444 message garage_finale side 1 - 810428/hko;
2 18445
2 18445 write(out,<:lukker garager:>); ud;
2 18446 for k:= 1 step 1 until max_antal_garageterminaler do
2 18447 begin
3 18448 close(z_gar(k),true);
3 18449 end;
2 18450 \f
2 18450 message radio_finale side 1 - 810525/hko;
2 18451 write(out,<:lukker radio:>); ud;
2 18452 close(z_fr_in,true);
2 18453 close(z_fr_out,true);
2 18454 close(z_rf_in,true);
2 18455 close(z_rf_out,true);
2 18456 \f
2 18456 message sysslut finale side 1 - 810530/cl;
2 18457
2 18457 slut_finale:
2 18458
2 18458 trap(exit_finale);
2 18459
2 18459 outchar(zrl,'em');
2 18460 close(zrl,true);
2 18461
2 18461 write(zbillede,
2 18462 "nl",2,<:blocksread=:>,blocksread,
2 18463 "nl",1,<:blocksout= :>,blocksout,
2 18464 "nl",1,<:fillæst= :>,fillæst,
2 18465 "nl",1,<:filskrevet=:>,filskrevet,
2 18466 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18467 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18468 close(zbillede,true);
2 18469 monitor(42,zbillede,0,ia);
2 18470 ia(6):= systime(7,0,0.0);
2 18471 monitor(44,zbillede,0,ia);
2 18472 setposition(z_io,0,0);
2 18473 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18474 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18475 close(z_io,true);
2 18476 exit_finale: trapmode:= 1 shift 10;
2 18477
2 18477 end;
1 18478
1 18478
1 18478 algol list.on;
1 18479 message programslut;
1 18480 program_slut:
1 18481 end
\f
1. 5506887 8619356 594 0 0
2. 10098661 11032932 341 0 0
3. 12285472 9571568 407 361 0
4. 14797824 5939216 416 1630 721
5. 12760077 8283890 567 29240 590
6. 6426865 4739765 568 0 0
7. 14752020 1791371 616 0 0
8. 18471 18465 18452 18434 18421 18413 18403 18395 18384 18373
18366 18353 18339 18330 18322 18308 18296 18287 18277 18261
18234 18214 18191 18171 18149 18133 18118 18103 18084 18068
18049 18025 18011 17990 17979 17966 17940 17916 17895 17875
17867 17862 17830 17813 17800 17789 17778 17761 17747 17730
17714 17699 17680 17662 17640 17622 17607 17587 17567 17550
17536 17520 17503 17487 17472 17457 17439 17428 17415 17406
17386 17373 17361 17346 17335 17315 17297 17285 17264 17240
17226 17213 17197 17183 17168 17153 17138 17113 17103 17091
17083 17073 17066 17050 17029 17005 16997 16990 16981 16953
16894 16864 16851 16823 16795 16768 16730 16701 16674 16616
16562 16524 16481 16446 16406 16374 16341 16283 16257 16206
16163 16124 16099 16074 16060 16028 16009 15989 15967 15955
15943 15925 15907 15893 15878 15856 15830 15813 15795 15787
15779 15755 15749 15736 15716 15705 15687 15675 15659 15645
15625 15601 15588 15576 15560 15542 15527 15520 15512 15503
15476 15461 15441 15428 15420 15411 15392 15381 15367 15355
15328 15313 15295 15273 15253 15240 15221 15198 15172 15151
15140 15118 15098 15076 15058 15030 15009 14991 14978 14970
14963 14948 14929 14922 14905 14885 14865 14851 14826 14811
14790 14764 14752 14743 14714 14692 14672 14662 14651 14626
14605 14585 14555 14536 14517 14497 14476 14468 14442 14429
14412 14393 14367 14348 14331 14304 14284 14262 14245 14225
14194 14163 14128 14101 14080 14067 14056 14035 14027 14018
13999 13979 13956 13929 13912 13894 13881 13871 13860 13836
13812 13793 13763 13750 13717 13682 13667 13646 13634 13608
13587 13567 13543 13532 13502 13483 13460 13430 13414 13391
13364 13329 13302 13295 13281 13260 13248 13234 13226 13211
13197 13190 13183 13176 13168 13135 13120 13100 13087 13069
13055 13027 13000 12982 12961 12943 12926 12909 12897 12887
12863 12857 12842 12822 12806 12789 12764 12751 12716 12699
12682 12659 12643 12631 12613 12586 12575 12567 12544 12525
12516 12499 12485 12470 12461 12449 12440 12421 12406 12390
12378 12361 12333 12312 12290 12275 12260 12253 12241 12225
12198 12176 12165 12147 12130 12100 12078 12067 12052 12039
12019 12004 11986 11965 11952 11934 11919 11901 11885 11864
11854 11831 11809 11791 11767 11736 11699 11685 11676 11645
11611 11584 11552 11510 11487 11462 11455 11447 11439 11422
11400 11379 11362 11344 11325 11299 11275 11259 11230 11204
11190 11164 11146 11127 11109 11094 11072 11053 11015 10993
10968 10950 10937 10904 10884 10864 10849 10827 10807 10782
10770 10745 10712 10679 10646 10601 10561 10553 10545 10538
10530 10501 10479 10462 10450 10427 10413 10399 10390 10379
10367 10354 10347 10338 10305 10290 10267 10243 10188 10155
10118 10055 10034 10020 10000 9986 9973 9954 9943 9924
9908 9895 9880 9854 9835 9809 9786 9765 9753 9745
9723 9698 9679 9667 9638 9616 9595 9577 9564 9551
9528 9520 9510 9498 9476 9463 9450 9429 9416 9403
9394 9370 9353 9339 9314 9293 9270 9258 9244 9226
9214 9183 9169 9149 9141 9118 9096 9084 9063 9051
9036 9016 9004 8982 8969 8941 8926 8916 8905 8891
8885 8875 8863 8846 8829 8818 8806 8786 8772 8766
8743 8729 8716 8709 8691 8674 8663 8650 8640 8621
8585 8576 8560 8537 8525 8510 8484 8462 8441 8427
8386 8369 8358 8348 8341 8330 8315 8303 8289 8278
8259 8250 8242 8233 8219 8202 8196 8180 8166 8154
8140 8122 8108 8099 8089 8071 8054 8033 8020 8008
7995 7984 7970 7952 7930 7917 7891 7883 7864 7846
7829 7816 7802 7786 7766 7721 7698 7664 7637 7623
7601 7587 7563 7544 7517 7503 7481 7456 7444 7427
7413 7399 7379 7370 7354 7338 7324 7306 7288 7256
7239 7216 7193 7174 7154 7138 7116 7104 7072 7036
7027 7009 6991 6974 6959 6945 6933 6915 6898 6884
6863 6856 6834 6820 6801 6774 6764 6757 6749 6738
6703 6683 6660 6643 6628 6612 6603 6583 6574 6550
6539 6528 6517 6506 6498 6492 6480 6464 6445 6429
6411 6392 6384 6367 6355 6339 6307 6289 6274 6253
6221 6214 6198 6189 6167 6155 6139 6130 6118 6100
6088 6063 6044 6028 6002 5983 5960 5936 5913 5890
5883 5866 5848 5834 5820 5797 5784 5774 5761 5751
5734 5696 5678 5665 5642 5614 5603 5588 5572 5555
5530 5507 5489 5478 5462 5442 5420 5403 5386 5372
5352 5335 5318 5308 5298 5285 5269 5259 5245 5230
5214 5204 5192 5174 5161 5141 5128 5115 5095 5075
5056 5042 5027 5012 4992 4973 4945 4932 4916 4899
4881 4863 4840 4816 4795 4784 4764 4745 4726 4712
4693 4675 4647 4626 4607 4572 4550 4542 4534 4525
4494 4473 4460 4438 4423 4393 4360 4322 4303 4278
4266 4250 4231 4222 4192 4175 4161 4135 4116 4095
4089 4055 4033 3999 3965 3937 3899 3863 3815 3766
3728 3693 3654 3593 3544 3498 3454 3422 3390 3346
3294 3248 3221 3209 3191 3174 3146 3127 3110 3092
3068 3029 3001 2963 2928 2900 2869 2840 2817 2787
2758 2725 2597 2574 2540 2511 2481 2431 2404 2388
2373 2353 2334 2314 2306 2283 2271 2240 2222 2202
2188 2166 2151 2123 2094 2075 2051 2034 2024 2000
1979 1970 1952 1936 1913 1895 1868 1845 1837 1827
1801 1781 1757 1748 1728 1713 1704 1693 1677 1663
1649 1638 1632 1605 1579 1560 1516 1489 1453 1426
1403 1371 1343 1326 1297 1270 1254 1220 1212 1197
1192 1183 1153 1145 1140 1120 1106 1100 1092 1073
1055 1028 1001 975 944 909 875 850 840 822
789 776 750 724 690 642 614 572 397 339
323 307 280 236 209 195 181 167 1 1
1 1 1
14752020 1791371 943 506070 31003
9. 16 90 16 4 950509 215105 buskom1
7 0 1989 801 algftnrts
0 1 0 2 *version
955 400 955 4 flushout
955 44 955 4 911004 101112 sendmessage
956 106 956 12 910308 134214 copyout
957 244 957 12 890821 163833 getzone6
0 410 0 0 out
958 178 958 12 940411 220029 testbit
961 414 961 18 940411 222629 findfpparam
964 46 964 18 890821 163814 system
967 238 967 18 movestring
967 56 967 18 890821 163907 outdate
968 124 968 18 isotable
969 176 968 18 890821 163656 write
974 310 974 152 intable
975 34 974 152 890821 163503 read
979 24 979 340 890821 163714 tofrom
966 420 964 18 stderror
981 80 981 340 890821 163740 open
985 112 985 340 890821 163754 monitor
982 344 981 340 close
966 378 964 18 increase
983 22 981 340 setposition
973 50 968 18 outchar
988 76 988 340 890821 163802 systime
0 1700 0 0 trapmode
989 302 989 340 trap
989 112 989 340 890821 163915 initzones
990 268 990 340 940411 222959 læsbitia
991 22 991 340 sign
991 28 991 340 890821 163648 ln
992 432 992 340 810409 111908 skrivhele
957 320 957 12 setzone6
1000 52 1000 340 inrec6
1000 28 1000 340 890821 163732 changerec6
1001 228 1001 340 940411 222949 sætbitia
975 36 974 152 readchar
1002 348 1002 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1003 278 1003 340 940411 222636 skrivtegn
1004 384 1004 340 940411 222639 afsluttext
1005 394 1005 340 940411 222952 læsbiti
1006 498 1006 340 940411 222816 systid
1008 28 1008 340 getnumber
1008 18 1008 340 890426 134020 putnumber
968 26 968 18 replacechar
1 656 0 0 errorbits
1015 60 1015 342 940411 222943 sætbiti
1016 354 1016 342 940411 222801 openbs
1018 228 1018 342 940411 222742 hægttekst
1000 54 1000 340 outrec6
0 1704 0 0 alarmcause
1019 332 1019 342 940411 222745 hægtstring
1020 254 1020 342 940411 222749 anbringtal
974 288 974 152 repeatchar
1021 444 1021 342 940411 223002 intg
1022 350 1022 342 940411 222739 binærsøg
991 20 991 340 sgn
1023 380 1023 342 940411 222646 skrivtext
1000 56 1000 340 swoprec6
1027 56 1024 342 passivate
1024 40 1024 342 890821 163947 activity
1029 78 1029 350 260479 150000 mon
1 1043 1029 350 monw2
1 1039 1029 350 monw0
1 1041 1029 350 monw1
1026 56 1024 342 activate
0 1588 0 0 endaction
1029 320 1029 350 reflectcore
1025 50 1024 342 newactivity
1030 372 1030 358 940327 154135 setcspterm
1032 428 1032 358 941030 233200 slices
1036 52 1036 358 890821 163933 lock
1036 258 1036 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1037 162 1037 358 940411 222622 fpparam
1 1049 1038 358 nl
1 1047 1038 358 220978 131500 bel
1039 330 1039 446 940411 222722 ud
1040 252 1040 446 940411 222656 taltekst
1 1045 1029 350 monw3
957 296 957 12 getshare6
957 398 957 12 setshare6
70 474 1043 446 0
algol end 1043
*if ok.no
*if warning.yes
*o c
▶EOF◀