|
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: 970752 (0xed000)
Types: TextFile
Names: »buskomudx07 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »buskomudx07 «
*mode 8.no 9.no
*buskom1=algol buskom1text list.yes blocks.yes xref.no details,
* .8.9 message.yes
buskom1text d.950731.2035
0 1 begin algol list.off;
1 2
1 2 <* variables for claiming (accumulating) basic entities *>
1 3 integer maxsem, maxsemch, maxop, maxcoru, maxmessext, maxprocext, maxnettoop;
1 4
1 4 <* fields defining current position in pools af basic entities
1 5 during initialization *>
1 6 integer array field firstsem, firstsim, firstcoru, firstop, optop;
1 7
1 7 <* variables used as pointers to 'current object' (work variables) *>
1 8 integer messext, procext, timeinterval, testbuffering;
1 9 integer array field timermessage, coru, sem, op, receiver, currevent,
1 10 baseevent, prevevent;
1 11
1 11 <* variables defining the size of basic entities (descriptors) *>
1 12 integer corusize, semsize, simsize, opheadsize;
1 13 integer array clockmess(1:2);
1 14 real array clock(1:3);
1 15 boolean eventqueueempty;
1 16 algol list.on;
1 17
1 17 \f
1 17 message sys_parametererklæringer side 1 - 810127/cl;
1 18
1 18 boolean testbit0 ,testbit1 ,testbit2 ,testbit3 ,testbit4 ,testbit5 ,
1 19 testbit6 ,testbit7 ,testbit8 ,testbit9 ,testbit10,testbit11,
1 20 testbit12,testbit13,testbit14,testbit15,testbit16,testbit17,
1 21 testbit18,testbit19,testbit20,testbit21,testbit22,testbit23,
1 22 testbit24,testbit25,testbit26,testbit27,testbit28,testbit29,
1 23 testbit30,testbit31,testbit32,testbit33,testbit34,testbit35,
1 24 testbit36,testbit37,testbit38,testbit39,testbit40,testbit41,
1 25 testbit42,testbit43,testbit44,testbit45,testbit46,testbit47;
1 26 boolean cl_overvåget,out_tw_lp,
1 27 cm_test;
1 28
1 28 integer låsning;
1 29 \f
1 29 message sys_parametererklæringer side 2 - 810310.hko;
1 30
1 30 <* hjælpevariable *>
1 31
1 31 integer i,j,k;
1 32 integer array ia(1:32);
1 33 integer array field iaf,ref;
1 34
1 34 real r;
1 35 real array ra(1:3);
1 36 real array field raf;
1 37
1 37 long array la(1:2);
1 38 long array field laf;
1 39
1 39 procedure ud;
1 40 begin
2 41 <*
2 42 outchar(out,'nl');
2 43 if out_tw_lp then setposition(out,0,0);
2 44 *>
2 45 flushout('nl');
2 46 end;
1 47 \f
1 47 message sys_parametererklæringer side 3 - 810310/hko;
1 48
1 48 <* hovedmodul_parametre *>
1 49
1 49 integer
1 50 sys_mod,
1 51 io_mod,
1 52 op_mod,
1 53 gar_mod,
1 54 rad_mod,
1 55 vt_mod;
1 56
1 56 <* operations_parametre *>
1 57
1 57 integer field
1 58 kilde,
1 59 retur,
1 60 resultat,
1 61 opkode;
1 62
1 62 real field
1 63 tid;
1 64
1 64 integer array field
1 65 data;
1 66
1 66 boolean
1 67 sys_optype,
1 68 io_optype,
1 69 op_optype,
1 70 gar_optype,
1 71 rad_optype,
1 72 vt_optype,
1 73 gen_optype;
1 74 \f
1 74 message sys_parametererklæringer side 4 - 820301/hko,cl;
1 75
1 75 <* trimme-variable *>
1 76
1 76 integer
1 77 max_antal_operatører,
1 78 max_antal_taleveje,
1 79 max_antal_garageterminaler,
1 80 max_antal_garager,
1 81 max_antal_områder,
1 82 max_antal_radiokanaler,
1 83 max_antal_pabx,
1 84 max_antal_kanaler,
1 85 max_antal_mobilopkald,
1 86 min_antal_nødopkald,
1 87 max_antal_grupper,
1 88 max_antal_gruppeopkald,
1 89 max_antal_spring,
1 90 max_antal_busser,
1 91 max_antal_linie_løb,
1 92 max_antal_fejltekster,
1 93 max_linienr,
1 94 op_maske_lgd,
1 95 tv_maske_lgd;
1 96
1 96 integer array
1 97 konsol_navn,
1 98 taleswitch_in_navn,
1 99 taleswitch_out_navn,
1 100 radio_fr_navn,
1 101 radio_rf_navn(1:4),
1 102 alfabet(0:255);
1 103
1 103 integer
1 104 tf_systællere,
1 105 tf_stoptabel,
1 106 tf_bplnavne,
1 107 tf_bpldef,
1 108 tf_alarmlgd;
1 109 \f
1 109 message filparm side 1 - 800529/jg/cl;
1 110
1 110 integer
1 111 fil_op_længde,
1 112 dbantez,dbantsz,dbanttz,
1 113 dbmaxtf, dbmaxsf, dbblokt,
1 114 dbmaxb,dbbidlængde,dbbidmax,
1 115 dbmaxef;
1 116 long array
1 117 dbsnavn, dbtnavn(1:2);
1 118
1 118 message attention parametererklæringer side 1 - 810318/hko;
1 119
1 119 integer
1 120 att_op_længde,
1 121 att_maske_lgd,
1 122 terminal_beskr_længde;
1 123 integer field
1 124 terminal_tilstand,
1 125 terminal_suppl;
1 126
1 126 message io_parametererklæringer side 1 - 820301/hko;
1 127
1 127 message operatør_parametererklæringer side 1 - 810422/hko;
1 128
1 128 integer field
1 129 cqf_bus, cqf_fejl,
1 130 alarm_kmdo, alarm_tilst, alarm_gtilst, alarm_lgd;
1 131 real field
1 132 cqf_ok_tid, cqf_næste_tid,
1 133 alarm_start;
1 134 long field
1 135 cqf_id;
1 136
1 136 integer
1 137 max_cqf, cqf_lgd,
1 138 op_spool_postlgd,
1 139 op_spool_postantal,
1 140 opk_alarm_tab_lgd;
1 141
1 141
1 141 \f
1 141 message procedure radio_parametererklæringer side 1 - 810524/hko;
1 142
1 142 integer
1 143 radio_giveup,
1 144 opkaldskø_postlængde,
1 145 kanal_beskr_længde,
1 146 radio_op_længde,
1 147 radio_pulje_størrelse;
1 148
1 148
1 148 \f
1 148 message vogntabel parametererklæringer side 1 - 810309/cl;
1 149
1 149 integer vt_op_længde, vt_logskift;
1 150 boolean vt_log_aktiv;
1 151
1 151 \f
1 151
1 151 algol list.off;
1 152 message coroutinemonitor - 2 ;
1 153
1 153 maxsem:= maxsemch:= maxop:= maxcoru:= maxnettoop:= 0;
1 154 maxmessext:= maxprocext:= 1;
1 155 corusize:= 20;
1 156 simsize:= 6;
1 157 semsize:= 8;
1 158 opheadsize:= 8;
1 159 testbuffering:= 1;
1 160 timeinterval:= 5;
1 161 algol list.on;
1 162 algol list.on;
1 163
1 163 \f
1 163 message sys_parameterinitialisering side 1 - 810305/hko;
1 164
1 164 copyout;
1 165
1 165 cl_overvåget:= false;
1 166 getzone6(out,ia);
1 167 out_tw_lp:= ia(1) extract 12 = 8 or ia(1) extract 12 = 14;
1 168
1 168 testbit0 :=testbit( 0);
1 169 testbit1 :=testbit( 1);
1 170 testbit2 :=testbit( 2);
1 171 testbit3 :=testbit( 3);
1 172 testbit4 :=testbit( 4);
1 173 testbit5 :=testbit( 5);
1 174 testbit6 :=testbit( 6);
1 175 testbit7 :=testbit( 7);
1 176 testbit8 :=testbit( 8);
1 177 testbit9 :=testbit( 9);
1 178 testbit10:=testbit(10);
1 179 testbit11:=testbit(11);
1 180 testbit12:=testbit(12);
1 181 testbit13:=testbit(13);
1 182 testbit14:=testbit(14);
1 183 testbit15:=testbit(15);
1 184 testbit16:=testbit(16);
1 185 testbit17:=testbit(17);
1 186 testbit18:=testbit(18);
1 187 testbit19:=testbit(19);
1 188 testbit20:=testbit(20);
1 189 testbit21:=testbit(21);
1 190 testbit22:=testbit(22);
1 191 testbit23:=testbit(23);
1 192 \f
1 192 message sys_parameterinitialisering side 2 - 810316/cl;
1 193
1 193 testbit24:=testbit(24);
1 194 testbit25:=testbit(25);
1 195 testbit26:=testbit(26);
1 196 testbit27:=testbit(27);
1 197 testbit28:=testbit(28);
1 198 testbit29:=testbit(29);
1 199 testbit30:=testbit(30);
1 200 testbit31:=testbit(31);
1 201 testbit32:=testbit(32);
1 202 testbit33:=testbit(33);
1 203 testbit34:=testbit(34);
1 204 testbit35:=testbit(35);
1 205 testbit36:=testbit(36);
1 206 testbit37:=testbit(37);
1 207 testbit38:=testbit(38);
1 208 testbit39:=testbit(39);
1 209 testbit40:=testbit(40);
1 210 testbit41:=testbit(41);
1 211 testbit42:=testbit(42);
1 212 testbit43:=testbit(43);
1 213 testbit44:=testbit(44);
1 214 testbit45:=testbit(45);
1 215 testbit46:=testbit(46);
1 216 testbit47:=testbit(47);
1 217 cm_test:= false;
1 218 \f
1 218 message sys_parameterinitialisering side 3 - 810409/cl,hko;
1 219
1 219 timeinterval:=1; <* tidsinterval for cmon's timeoutinspection *>
1 220
1 220 if findfpparam(<:låsning:>,true,ia) > 0 then låsning:= ia(1)
1 221 else låsning:= 0;
1 222 \f
1 222 message sys_parameterinitialisering side 4 - 820301/hko/cl;
1 223
1 223 <* initialisering af hovedmodul_parametre *>
1 224
1 224 i:=0; sys_mod:=i;
1 225 i:=i+1; io_mod:=i;
1 226 i:=i+1; op_mod:=i;
1 227 i:=i+1; gar_mod:=i;
1 228 i:=i+1; rad_mod:=i;
1 229 i:=i+1; vt_mod:=i;
1 230
1 230 <* initialisering af operationstyper *>
1 231
1 231 sys_optype:=false add (1 shift sys_mod);
1 232 io_optype:= false add (1 shift io_mod);
1 233 op_optype:= false add (1 shift op_mod);
1 234 gar_optype:=false add (1 shift gar_mod);
1 235 rad_optype:=false add (1 shift rad_mod);
1 236 vt_optype:= false add (1 shift vt_mod);
1 237 gen_optype:=false add (1 shift 11);
1 238
1 238 <* initialisering af fieldvariable for operationer *>
1 239
1 239 i:=2; kilde:=i;
1 240 i:=i+4; tid:=i;
1 241 i:=i+2; retur:=i;
1 242 i:=i+2; opkode:=i;
1 243 i:=i+2; resultat:=i;
1 244 i:=i+0; data:=i;
1 245
1 245 <* initialisering af trimme-variable *>
1 246
1 246 max_antal_operatører:=28;
1 247 max_antal_taleveje:=12;
1 248 max_antal_garageterminaler:=3;
1 249 max_antal_garager:=99;
1 250 max_antal_radiokanaler:=16;
1 251 max_antal_pabx:=2;
1 252 max_antal_kanaler:=14; <* 1 pabx + 13 radio *>
1 253 max_antal_områder:=11;
1 254 max_antal_mobilopkald:=100;
1 255 min_antal_nødopkald:=20;
1 256 max_antal_grupper:=16;
1 257 max_antal_gruppeopkald:=16;
1 258 max_antal_spring:=16;
1 259 max_antal_busser:=2000;
1 260 max_antal_linie_løb:=2000;
1 261 max_antal_fejltekster:=21;
1 262 max_linienr:=999; <*<=999*>
1 263
1 263 op_maske_lgd:= ((1+max_antal_operatører+23)//24)*2;
1 264 tv_maske_lgd:= ((1+max_antal_taleveje+23)//24)*2;
1 265 \f
1 265 message sys_parameterinitialisering side 5 - 880901/cl;
1 266
1 266 <* initialisering af konsol-navn *>
1 267 raf:= 0;
1 268 if findfpparam(<:io:>,false,ia)>0 then
1 269 begin
2 270 for i:= 1 step 1 until 4 do konsol_navn(i):= ia(i);
2 271 end
1 272 else
1 273 system(7,0,konsol_navn);
1 274 <*
1 275 movestring(konsol_navn.raf,1,<:console1:>);
1 276 *>
1 277
1 277 raf:= 0;
1 278
1 278 <* intialiserning af talevejsswitchens navn *>
1 279
1 279 movestring(taleswitch_in_navn.raf,1,<:taleswitchi:>);
1 280 movestring(taleswitch_out_navn.raf,1,<:taleswitch:>);
1 281
1 281 <* initialisering af radiokanalnavne *>
1 282
1 282 movestring(radio_fr_navn.raf,1,<:radiofr:>);
1 283 movestring(radio_rf_navn.raf,1,<:radiorf:>);
1 284
1 284 <* initialisering af 'input'-alfabet *>
1 285
1 285 isotable(alfabet);
1 286 alfabet('esc'):= 8 shift 12 + 'esc';
1 287 <* for i:='a' step 1 until 'å' do alfabet(i):=alfabet(i)-32; *>
1 288 for i:= 128 step 1 until 255 do alfabet(i):= 0 shift 12 + i;
1 289 intable(alfabet);
1 290
1 290 <* initialsering af tf_systællere *>
1 291
1 291 tf_systællere:= 1024<*tabelfil*> + 8;
1 292 tf_stoptabel := 1024<*tabelfil*> + 5;
1 293 tf_bpl_navne := 1024<*tabelfil*> + 12;
1 294 tf_bpl_def := 1024<*tabelfil*> + 13;
1 295 tf_alarmlgd := 1024<*tabelfil*> + 14;
1 296
1 296 \f
1 296 message filparminit side 1 - 801030/jg;
1 297
1 297 fil_op_længde:= data + 18 <*halvord*>;
1 298
1 298
1 298 dbantez:= 1;
1 299 dbantsz:= 2;
1 300 dbanttz:= 3; <* >=2 aht. samtidig tilgang*>
1 301 dbblokt:= 8;
1 302 dbmaxsf:= 7;
1 303 dbbidlængde:= 3;
1 304 dbbidmax:= 5;
1 305 dbmaxb:= dbmaxsf * dbbidmax;
1 306 dbmaxef:= 12;
1 307 movestring(dbsnavn,1,<:spoolfil:>);
1 308 movestring(dbtnavn,1,<:tabelfil:>);
1 309 if findfpparam(<:tabelfil:>,false,ia)>0 then
1 310 tofrom(dbtnavn,ia,8);
1 311 \f
1 311 message filparminit side 2 - 801030/jg;
1 312
1 312
1 312 <* reserver og check spoolfil og tabelfil *>
1 313 begin integer s,i,funk,f;
2 314 zone z(128,1,stderror); integer array tail(1:10);
2 315
2 315 for f:=1,2 do
2 316 begin
3 317 <*open(z,4,string (case f of(dbsnavn,dbtnavn)),0);*>
3 318 case f of
3 319 begin
4 320 open(z,4,dbsnavn,0);
4 321 open(z,4,dbtnavn,0);
4 322 end;
3 323 for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do
3 324 begin
4 325 s:=monitor(funk,z,i,tail);
4 326 if s<>0 then system(9,funk*100+s,
4 327 case f of(<:<10>spoolfil:>,<:<10>tabelfil:>));
4 328 end;
3 329 case f of begin
4 330 begin integer antseg; <*spoolfil*>
5 331 antseg:=dbmaxb * dbbidlængde;
5 332 if tail(1) < antseg then
5 333 begin
6 334 tail(1):=antseg;
6 335 s:=monitor(44<*change*>,z,i,tail);
6 336 if s<>0 then
6 337 system(9,44*100+s,<:<10>spoolfil:>);
6 338 end;
5 339 end;
4 340 begin <*tabelfil*>
5 341 dbmaxtf:=tail(10);
5 342 if dbmaxtf<1 or dbmaxtf>1023 then
5 343 system(9,dbmaxtf,<:<10>tabelfil:>);
5 344 end
4 345 end case;
3 346 close(z,false);
3 347 end for;
2 348 end;
1 349 \f
1 349 message attention parameterinitialisering side 1 - 810318/hko;
1 350
1 350 att_op_længde:= 40;
1 351 att_maske_lgd:=
1 352 (1+max_antal_operatører+max_antal_garageterminaler+1+23)//24*2;
1 353 terminal_beskr_længde:=6;
1 354 terminal_tilstand:= 2;
1 355 terminal_suppl:=4;
1 356
1 356 message io_parameterinitialisering side 1 - 810421/hko;
1 357
1 357
1 357 message operatør_parameterinitialisering side 1 - 810422/hko;
1 358
1 358 <* felter i cqf_tabel *>
1 359 cqf_lgd:=
1 360 cqf_næste_tid:= 16;
1 361 cqf_ok_tid := 12;
1 362 cqf_id := 8;
1 363 cqf_fejl := 4;
1 364 cqf_bus := 2;
1 365
1 365 max_cqf:= 64;
1 366
1 366 <* felter i opkaldsalarmtabel *>
1 367 alarm_kmdo := 2;
1 368 alarm_tilst := 4;
1 369 alarm_gtilst:= 6;
1 370 alarm_lgd := 8;
1 371 alarm_start := 12;
1 372
1 372 opk_alarm_tab_lgd:= 12;
1 373 op_spool_postantal:= 16;
1 374 op_spool_postlgd:= 64;
1 375
1 375
1 375 \f
1 375 message procedure radio_parameterinitialisering side 1 - 810601/hko;
1 376
1 376 radio_giveup:= 1 shift 21 + 1 shift 9;
1 377 opkaldskø_postlængde:= 10+op_maske_lgd;
1 378 kanal_beskr_længde:= 12+op_maske_lgd+tv_maske_lgd;
1 379 radio_op_længde:= 30*2;
1 380 radio_pulje_størrelse:= 1+max_antal_taleveje;
1 381
1 381 \f
1 381 message vogntabel parameterinitialisering side 1 - 810309/cl;
1 382
1 382 vt_op_længde:= data + 16; <* halvord *>
1 383
1 383 if findfpparam(<:vtlogskift:>,true,ia) > 0 then
1 384 vt_logskift:= ia(1) else vt_logskift:= -1;
1 385
1 385 vt_log_aktiv:= (vt_logskift >= 0) and (vt_logskift < 240000);
1 386
1 386
1 386 \f
1 386 message filclaim, side 1 - 810202/cl;
1 387
1 387 maxcoru:= maxcoru+6;
1 388 maxsem:= maxsem+2;
1 389 maxsemch:= maxsemch+6;
1 390 \f
1 390 message attention_claiming side 1 - 810318/hko;
1 391
1 391
1 391 maxcoru:=maxcoru+1;
1 392
1 392 max_op:=max_op +1
1 393 +max_antal_operatører
1 394 +max_antal_garageterminaler;
1 395
1 395 max_nettoop:=maxnettoop+(data+att_op_længde)
1 396 *(1+max_antal_operatører
1 397 +max_antal_garageterminaler);
1 398
1 398 max_procext:=max_procext+1;
1 399
1 399 max_sem:= max_sem+1;
1 400
1 400 max_semch:=maxsemch+1;
1 401
1 401
1 401 \f
1 401 message io_claiming side 1 - 810421/hko;
1 402
1 402 max_coru:= max_coru
1 403 + 1 <* hovedmodul io *>
1 404 + 1 <* io kommando *>
1 405 + 1 <* io operatørmeddelelser *>
1 406 + 1 <* io spontane meddelelser *>
1 407 + 1; <* io spoolkorutine *>
1 408
1 408 max_semch:= max_semch
1 409 + 1 <* cs_io *>
1 410 + 1 <* cs_io_komm *>
1 411 + 1 <* cs_io_fil *>
1 412 + 1 <* cs_io_medd *>
1 413 + 1; <* cs_io_spool *>
1 414
1 414 max_sem:= max_sem
1 415 + 1 <* ss_io_spool_fulde *>
1 416 + 1 <* ss_io_spool_tomme *>
1 417 + 1; <* bs_zio_adgang *>
1 418
1 418 max_op:=max_op
1 419 + 1; <* fil-operation *>
1 420
1 420 max_nettoop:=max_nettoop
1 421 + (data+18); <* fil-operation *>
1 422
1 422 \f
1 422 message operatør_claiming side 1 - 810520/hko;
1 423
1 423 max_coru:= max_coru +1 <* h_op *>
1 424 +1 <* alarmur *>
1 425 +1 <* opkaldsalarmer *>
1 426 +1 <* talevejsswitch *>
1 427 +1 <* tv_switch_adm *>
1 428 +1 <* tv_switch_input *>
1 429 +1 <* op_spool *>
1 430 +1 <* op_medd *>
1 431 +1 <* op_cqftest *>
1 432 +max_antal_operatører;
1 433
1 433 max_sem:= 1 <* bs_opk_alarm *>
1 434 +1 <* ss_op_spool_tomme *>
1 435 +1 <* ss_op_spool_fulde *>
1 436 +max_sem;
1 437
1 437 max_semch:= max_semch +1 <* cs_op *>
1 438 +1 <* cs_op_retur *>
1 439 +1 <* cs_opk_alarm_ur *>
1 440 +1 <* cs_opk_alarm_ur_ret *>
1 441 +1 <* cs_opk_alarm *>
1 442 +1 <* cs_talevejsswitch *>
1 443 +1 <* cs_tv_switch_adm *>
1 444 +1 <* cs_tvswitch_adgang *>
1 445 +1 <* cs_tvswitch_input *>
1 446 +1 <* cs_op_iomedd *>
1 447 +1 <* cs_op_spool *>
1 448 +1 <* cs_op_medd *>
1 449 +1 <* cs_cqf *>
1 450 +max_antal_operatører<* cs_operatør *>
1 451 +max_antal_operatører<* cs_op_fil *>;
1 452
1 452 max_op:= max_op + 1 <* talevejsoperation *>
1 453 + 2 <* tv_switch_input *>
1 454 + 1 <* op_iomedd *>
1 455 + 1 <* opk_alarm_ur *>
1 456 + 1 <* op_spool_medd *>
1 457 + 1 <* op_cqftest *>
1 458 + max_antal_operatører;
1 459
1 459 max_netto_op:= filoplængde*max_antal_operatører
1 460 + data+128 <* talevejsoperation *>
1 461 + 2*(data+256) <* tv_switch_input *>
1 462 + 60 <* op_iomedd *>
1 463 + data <* opk_alarm_ur *>
1 464 + data+op_spool_postlgd <* op_spool_med *>
1 465 + 60 <* op_cqftest *>
1 466 + max_netto_op;
1 467
1 467 \f
1 467 message garage_claiming side 1 -810226/hko;
1 468
1 468 max_coru:= max_coru +1
1 469 +max_antal_garageterminaler;
1 470
1 470 max_semch:= max_semch +1
1 471 +max_antal_garageterminaler;
1 472
1 472 \f
1 472 message procedure radio_claiming side 1 - 810526/hko;
1 473
1 473 max_coru:= max_coru
1 474 +1 <* hovedmodul radio *>
1 475 +1 <* opkaldskø_meddelelse *>
1 476 +1 <* radio_adm *>
1 477 +max_antal_taleveje <* radio *>
1 478 +2; <* radio ind/-ud*>
1 479
1 479 max_semch:= max_semch
1 480 +1 <* cs_rad *>
1 481 +max_antal_taleveje <* cs_radio *>
1 482 +1 <* cs_radio_pulje *>
1 483 +1 <* cs_radio_kø *>
1 484 +1 <* cs_radio_medd *>
1 485 +1 <* cs_radio_adm *>
1 486 +2 ; <* cs_radio_ind/-ud *>
1 487
1 487 max_sem:=
1 488 +1 <* bs_mobil_opkald *>
1 489 +1 <* bs_opkaldskø_adgang *>
1 490 +max_antal_kanaler <* ss_radio_aktiver *>
1 491 +max_antal_kanaler <* ss_samtale_nedlagt *>
1 492 +max_antal_taleveje <* bs_talevej_udkoblet *>
1 493 +max_sem;
1 494
1 494 max_op:=
1 495 + radio_pulje_størrelse <* radio_pulje_operationer *>
1 496 + 1 <* radio_medd *>
1 497 + 1 <* radio_adm *>
1 498 + max_antal_taleveje <* operationer for radio *>
1 499 + 2 <* operationer for radio_ind/-ud *>
1 500 + max_op;
1 501
1 501 max_netto_op:=
1 502 + radio_pulje_størrelse * 60 <* radio_pulje_operationer *>
1 503 + data + 6 <* radio_medd *>
1 504 + max_antal_taleveje <* operationer for radio *>
1 505 * (data + radio_op_længde)
1 506 + data + radio_op_længde <* operation for radio_adm *>
1 507 + 2*(data + 64) <* operationer for radio_ind/-ud *>
1 508 + max_netto_op;
1 509 \f
1 509 message vogntabel_claiming side 1 - 810413/cl;
1 510
1 510 maxcoru:= 1 <* coroutine h_vogntabel (hovedmodulcoroutine) *>
1 511 + 1 <* coroutine vt_opdater *>
1 512 + 1 <* coroutine vt_tilstand *>
1 513 + 1 <* coroutine vt_rapport *>
1 514 + 1 <* coroutine vt_gruppe *>
1 515 + 1 <* coroutine vt_spring *>
1 516 + 1 <* coroutine vt_auto *>
1 517 + 1 <* coroutine vt_log *>
1 518 + maxcoru;
1 519
1 519 maxsemch:= 1 <* cs_vt *>
1 520 + 1 <* cs_vt_adgang *>
1 521 + 1 <* cs_vt_logpool *>
1 522 + 1 <* cs_vt_opd *>
1 523 + 1 <* cs_vt_rap *>
1 524 + 1 <* cs_vt_tilst *>
1 525 + 1 <* cs_vtt_auto *>
1 526 + 1 <* cs_vt_grp *>
1 527 + 1 <* cs_vt_spring *>
1 528 + 1 <* cs_vt_log *>
1 529 + 5 <* cs_vt_filretur(coru) *>
1 530 + maxsemch;
1 531
1 531 maxop:= 1 <* vt_op *>
1 532 + 2 <* vt_log_op *>
1 533 + 6 <* vt_fil_op + radop *>
1 534 + maxop;
1 535
1 535 maxnettoop:= vt_op_længde * 3 <* vt_op + vt_log_op *>
1 536 + 5*fil_op_længde
1 537 + (if fil_op_længde>(data+20) then fil_op_længde else (data+20))
1 538 + maxnettoop;
1 539
1 539 \f
1 539
1 539 algol list.off;
1 540 message coroutinemonitor - 3 ;
1 541
1 541 begin
2 542
2 542 <* work variables - primarily used during initialization *>
2 543 integer array field simref, semref, coruref, opref;
2 544 integer proccount, corucount, messcount, cmi, cmj;
2 545 integer array zoneia(1:20);
2 546
2 546 <* field variables describing the format of basic entities *>
2 547 integer field
2 548 <* chain head *>
2 549 next, prev,
2 550 <* simple semaphore *>
2 551 simvalue, simcoru,
2 552 <* chained semaphore *>
2 553 semop, semcoru,
2 554 <* coroutine *>
2 555 coruop, corutimerchain, corutimer, corupriority, coruident,
2 556 <* operation head *>
2 557 opnext, opsize;
2 558
2 558 \f
2 558
2 558 message coroutinemonitor - 4 ;
2 559
2 559 boolean field
2 560 corutypeset, corutestmask, optype;
2 561 real starttime;
2 562 long corustate;
2 563
2 563 <* field variables used as queue identifiers (addresses) *>
2 564 integer array field current, readyqueue, idlequeue, timerqueue;
2 565
2 565 <* extensions (message- and process- extensions) *>
2 566 integer array messref, messcode, messop (1:maxmessext);
2 567 integer array procref, proccode, procop (1:maxprocext);
2 568
2 568 <* core array used for accessing the core using addresses as field
2 569 variables (as delivered by the monitor functions)
2 570 - descriptor array 'd' in which all basic entities are allocated
2 571 (except for extensions) *>
2 572 integer array core (1:1), d (1:(4 <* readyqueue *> +
2 573 4 <* idlequeue *> +
2 574 4 <* timerqueue *> +
2 575 maxcoru * corusize +
2 576 maxsem * simsize +
2 577 maxsemch * semsize +
2 578 maxop * opheadsize +
2 579 maxnettoop)/2);
2 580 \f
2 580
2 580 message coroutinemonitor - 5 ;
2 581
2 581
2 581
2 581 <*************** initialization procedures ***************>
2 582
2 582
2 582
2 582 procedure initchain (chainref);
2 583 value chainref;
2 584 integer array field chainref;
2 585 begin
3 586 integer array field cref;
3 587 cref:= chainref;
3 588 d.cref.next:= d.cref.prev:= cref;
3 589 end;
2 590 \f
2 590
2 590 message coroutinemonitor - 6 ;
2 591
2 591
2 591 <***** nextsem *****
2 592
2 592 this procedure allocates and initializes the next simple semaphore in the
2 593 pool of claimed semaphores.
2 594 the procedure returns the identification (the address) of the semaphore to
2 595 be used when calling 'signal', 'wait' and 'inspect'. *>
2 596
2 596 integer procedure nextsem;
2 597 begin
3 598 nextsem:= simref;
3 599 if simref >= firstsem then initerror(1, true);
3 600 initchain(simref + simcoru);
3 601 d.simref.simvalue:= 0;
3 602 simref:= simref + simsize;
3 603 end;
2 604
2 604
2 604 <***** nextsemch *****
2 605
2 605 this procedure allocates and initializes the next simple semaphore in the
2 606 pool of claimed semaphores.
2 607 the procedure returns the identification (the address) of the semaphore to
2 608 be used when calling 'signalch', 'waitch' and 'inspectch'. *>
2 609
2 609 integer procedure nextsemch;
2 610 begin
3 611 nextsemch:= semref;
3 612 if semref >= firstop-4 then initerror(2, true);
3 613 initchain(semref + semcoru);
3 614 initchain(semref + semop);
3 615 semref:= semref + semsize;
3 616 end;
2 617 \f
2 617
2 617 message coroutinemonitor - 7 ;
2 618
2 618
2 618 <***** nextcoru *****
2 619
2 619 this procedure initializes the next coroutine description in the pool of
2 620 claimed coroutine descriptions.
2 621 at initialization is defined the priority (an integer value), an identi-
2 622 fication (an integer value 0..8000) and a test pattern (a boolean). *>
2 623
2 623 integer procedure nextcoru(ident, priority, testmask);
2 624 value ident, priority, testmask;
2 625 integer ident, priority;
2 626 boolean testmask;
2 627 begin
3 628 corucount:= corucount + 1;
3 629 if corucount > maxcoru then initerror(3, true);
3 630 nextcoru:= corucount;
3 631 initchain(coruref + next);
3 632 initchain(coruref + corutimerchain);
3 633 initchain(coruref + coruop);
3 634 d.coruref.corupriority:= priority;
3 635 d.coruref.coruident:= ident * 1000 + corucount;
3 636 d.coruref.corutypeset:= false;
3 637 d.coruref.corutimer:= 0;
3 638 d.coruref.corutestmask:= testmask;
3 639 linkprio(coruref, readyqueue);
3 640 current:= coruref;
3 641 coruref:= coruref + corusize;
3 642 end;
2 643 \f
2 643
2 643 message coroutinemonitor - 8 ;
2 644
2 644
2 644 <***** nextop *****
2 645
2 645 this procedure initializes the next operation in the pool of claimed ope-
2 646 rations (heads and buffers).
2 647 the head is allocated and immediately following the head is allocated 'size'
2 648 halfwords forming the operation buffer.
2 649 the procedure returns an identification of the operation (an address) and
2 650 in case this address is held in a field variable 'op', the buffer area may
2 651 be accessed as: d.op(1), d.op(2), d.op(3) ... *>
2 652
2 652 integer procedure nextop (size);
2 653 value size;
2 654 integer size;
2 655 begin
3 656 nextop:= opref;
3 657 if opref >= optop then initerror(4, true);
3 658 initchain(opref + next);
3 659 d.opref.opsize:= size;
3 660 opref:= opref + size + opheadsize;
3 661 end;
2 662 \f
2 662
2 662 message coroutinemonitor - 9 ;
2 663
2 663
2 663 <***** nextprocext *****
2 664
2 664 this procedure initializes the next process extension in the series of
2 665 claimed process extensions.
2 666 the process description address is put into the process extension and the
2 667 state of the extension is initialized to be closed. *>
2 668
2 668 integer procedure nextprocext (processref);
2 669 value processref;
2 670 integer processref;
2 671 begin
3 672 proccount:= proccount + 1;
3 673 if proccount >= maxprocext then initerror(5, true);
3 674 nextprocext:= proccount;
3 675 procref(proccount):= processref;
3 676 proccode(proccount):= 1 shift 12;
3 677 end;
2 678 \f
2 678
2 678 message coroutinemonitor - 10 ;
2 679
2 679
2 679 <***** initerror *****
2 680
2 680 this procedure is activated in case the initialized set of resources does
2 681 not match the claimed set.
2 682 in case more resources are claimed than used, a warning is written,
2 683 in case too few resources are claimed, an error message is written and
2 684 the execution is terminated. *>
2 685
2 685 procedure initerror (resource, exceeded);
2 686 value resource, exceeded;
2 687 integer resource; boolean exceeded;
2 688 begin
3 689 write(out, false add 10, 1,
3 690 if exceeded then <:more :> else <:less :>,
3 691 case resource of (
3 692 <:simple semaphores:>,
3 693 <:chained semaphores:>,
3 694 <:coroutines:>,
3 695 <:operations:>,
3 696 <:process extensions:>),
3 697 <: initialized than claimed:>,
3 698 false add 10, 1);
3 699 if exceeded then goto dump;
3 700 end;
2 701
2 701
2 701 <***** stackclaim *****
2 702
2 702 this procedure is used by a coroutine from its first activation to it
2 703 arrives its first waiting point. the procedure is used to claim an addi-
2 704 tional amount of stack space. this must be done because the maximum
2 705 stack space for a coroutine is set to be the max amount used during its
2 706 very first activation. *>
2 707
2 707
2 707 procedure stackclaim (size);
2 708 value size; integer size;
2 709 begin
3 710 boolean array stackspace (1:size);
3 711 end;
2 712 algol list.on;
2 713
2 713 \f
2 713 message sys_erklæringer side 1 - 810406/cl,hko;
2 714
2 714 zone
2 715 zdummy(1,1,stderror),
2 716 zrl(128,1,stderror),
2 717 zbillede(128,1,stderror);
2 718
2 718 real array
2 719 fejltekst(1:max_antal_fejltekster);
2 720
2 720 integer
2 721 top_bpl_gruppe;
2 722
2 722 integer array
2 723 ingen_operatører, alle_operatører(1:(op_maske_lgd//2)),
2 724 ingen_taleveje, alle_taleveje(1:(tv_maske_lgd//2)),
2 725 bpl_def(1:(128*(op_maske_lgd//2))),
2 726 bpl_tilst(0:127,1:2),
2 727 operatør_stop(0:max_antal_operatører,0:3),
2 728 område_id(1:max_antal_områder,1:2),
2 729 pabx_id(1:max_antal_pabx),
2 730 radio_id(1:max_antal_radiokanaler),
2 731 kanal_id(1:max_antal_kanaler),
2 732 opkalds_tællere(1:(max_antal_områder*3));
2 733
2 733 boolean array
2 734 operatør_auto_include(1:max_antal_operatører),
2 735 garage_auto_include(1:max_antal_garageterminaler);
2 736
2 736 long array
2 737 terminal_navn(1:(2*max_antal_operatører)),
2 738 garage_terminal_navn(1:(2*max_antal_garageterminaler)),
2 739 bpl_navn(0:127),
2 740 område_navn(1:max_antal_områder),
2 741 kanal_navn(1:max_antal_kanaler);
2 742 \f
2 742 message procedure findområde side 1 - 880901/cl;
2 743
2 743 integer procedure find_bpl(navn);
2 744 value navn;
2 745 long navn;
2 746 begin
3 747 integer i;
3 748
3 748 find_bpl:= 0;
3 749 for i:= 0 step 1 until 127 do
3 750 if navn = bpl_navn(i) then find_bpl:= i;
3 751 end;
2 752
2 752 integer procedure findområde(omr);
2 753 value omr;
2 754 integer omr;
2 755 begin
3 756 integer i;
3 757
3 757 if omr = '*' shift 16 then findområde:= -1 else
3 758 begin
4 759 findområde:= 0;
4 760 for i:= 1 step 1 until max_antal_områder do
4 761 if (extend omr) shift 24=område_navn(i) then findområde:= i;
4 762 end;
3 763 end;
2 764 \f
2 764 message procedure tæl_opkald side 1 - 880926/cl;
2 765
2 765 procedure tæl_opkald(område,type);
2 766 value område,type;
2 767 integer område,type;
2 768 begin
3 769 integer zi;
3 770 integer array field iaf;
3 771
3 771 iaf:= 0;
3 772 increase(opkalds_tællere((område-1)*3+type));
3 773
3 773 disable begin
4 774 skrivfil(tf_systællere,1,zi);
4 775 tofrom(fil(zi).iaf,opkalds_tællere,max_antal_områder*6);
4 776 setposition(fil(zi),0,0);
4 777 end;
3 778 end;
2 779
2 779 procedure skriv_opkaldstællere(z);
2 780 zone z;
2 781 begin
3 782 integer omr,typ;
3 783
3 783 write(z,"nl",2,<:+++++ opkaldstællere +++++:>,"nl",2,
3 784 <:omr ud ind-alm ind-nød:>,"nl",1);
3 785 for omr:= 1 step 1 until max_antal_områder do
3 786 begin
4 787 write(z,true,6,string område_navn(omr),":",1);
4 788 for typ:= 1 step 1 until 3 do
4 789 write(z,<< ddddddd>,opkalds_tællere((omr-1)*3+typ));
4 790 outchar(z,'nl');
4 791 end;
3 792 end;
2 793 \f
2 793 message procedure start_operation side 1 - 810521/hko;
2 794
2 794 procedure start_operation(op_ref,kor,ret_sem,kode);
2 795 value kor,ret_sem,kode;
2 796 integer array field op_ref;
2 797 integer kor,ret_sem,kode;
2 798 <*
2 799 op_ref: kald, reference til operation
2 800
2 800 kor: kald, kilde= hovedmodulnr*100 +løbenr
2 801 = korutineident.
2 802 ret_sem: kald, retursemafor
2 803
2 803 kode: kald, suppl shift 12 + operationskode
2 804
2 804 proceduren initialiserer en operations hoved med
2 805 parameterværdierne samt tidfeltet med aktueltid.
2 806 resultatfelt og datafelter nulstilles.
2 807
2 807 *>
2 808 begin
3 809 integer i;
3 810 d.op_ref.kilde:= kor;
3 811 systime(1,0,d.op_ref.tid);
3 812 d.op_ref.retur:=ret_sem;
3 813 d.op_ref.op_kode:=kode;
3 814 d.op_ref.resultat:=0;
3 815 for i:=(d.op_ref.opsize-data)//2 step -1 until 1 do
3 816 d.op_ref.data(i):=0;
3 817 end start_operation;
2 818 \f
2 818 message procedure afslut_operation side 1 - 810331/hko;
2 819
2 819 procedure afslut_operation(op_ref,sem);
2 820 value op_ref,sem;
2 821 integer op_ref,sem;
2 822 begin
3 823 integer array field op;
3 824 op:=op_ref;
3 825 if sem>0 then signal_ch(sem,op,d.op.optype) else
3 826 if sem=-1 then signal_ch(d.op.retur,op,d.op.optype) else
3 827 ;
3 828 end afslut_operation;
2 829 \f
2 829 message procedure fejlreaktion - side 1 - 810424/cl,hko;
2 830
2 830 procedure fejlreaktion(nr,værdi,str,måde);
2 831 value nr,værdi,måde;
2 832 integer nr,værdi,måde;
2 833 string str;
2 834 begin
3 835 disable begin
4 836 write(out,<:<10>!!! :>);
4 837 if nr>0 and nr <=max_antal_fejltekster then
4 838 write(out,string fejltekst(nr))
4 839 else write(out,<:fejl nr.:>,nr);
4 840 outchar(out,'sp');
4 841 if måde shift (-12) extract 2=1 then
4 842 outintbits(out,værdi)
4 843 else
4 844 if måde shift (-12) extract 2=2 then
4 845 write(out,<:":>,false add værdi,1,<:":>)
4 846 else
4 847 write(out,værdi);
4 848 write(out,"sp",1,str,"nl",1,<< zddddd>,systime(5,0,r),r,
4 849 <: korutine nr=:>,<<d>, abs curr_coruno,
4 850 <: ident=:>,curr_coruid,"nl",0);
4 851 if testbit27 and måde extract 12=1 then
4 852 trace(1);
4 853 ud;
4 854 end;<*disable*>
3 855 if måde extract 12 =2 then trapmode:=1 shift 13;
3 856 if måde extract 12= 0 then trap(-1)
3 857 else if måde extract 12 = 2 then trap(-2);
3 858 end fejlreaktion;
2 859
2 859 procedure trace(n);
2 860 value n;
2 861 integer n;
2 862 begin
3 863 trap(finis);
3 864 trap(n);
3 865 finis:
3 866 end trace;
2 867 \f
2 867 message procedure overvåget side 1 - 810413/cl;
2 868
2 868 boolean procedure overvåget;
2 869 begin
3 870 disable begin
4 871 integer i,måde;
4 872 integer array field cor;
4 873 integer array ia(1:12);
4 874
4 874 i:= system(12,0,ia);
4 875 if i > 0 then
4 876 begin
5 877 i:= system(12,1,ia);
5 878 måde:= ia(3);
5 879 end
4 880 else måde:= 0;
4 881
4 881 if måde<>0 then
4 882 begin
5 883 cor:= coroutine(abs ia(3));
5 884 overvåget:= d.cor.corutestmask shift (-11);
5 885 end
4 886 else overvåget:= cl_overvåget;
4 887 end;
3 888 end;
2 889 \f
2 889 message procedure antal_bits_ia side 1 - 940424/cl;
2 890
2 890 integer procedure antal_bits_ia(ia,n,ø);
2 891 value n,ø;
2 892 integer array ia;
2 893 integer n,ø;
2 894 begin
3 895 integer i, ant;
3 896
3 896 ant:= 0;
3 897 for i:= n step 1 until ø do
3 898 if læsbit_ia(ia,i) then ant:= ant+1;
3 899 end;
2 900
2 900 message procedure trunk_til_omr side 1 - 881006/cl;
2 901
2 901 integer procedure trunk_til_omr(trunk);
2 902 value trunk; integer trunk;
2 903 begin
3 904 integer i,j;
3 905
3 905 j:=0;
3 906 for i:= 1 step 1 until max_antal_områder do
3 907 if område_id(i,2) extract 12 = trunk extract 12 then j:=i;
3 908 trunk_til_omr:=j;
3 909 end;
2 910
2 910 integer procedure omr_til_trunk(omr);
2 911 value omr; integer omr;
2 912 begin
3 913 omr_til_trunk:= område_id(omr,2) extract 12;
3 914 end;
2 915
2 915 integer procedure port_til_omr(port);
2 916 value port; integer port;
2 917 begin
3 918 if port shift (-6) extract 6 = 2 then
3 919 port_til_omr:= pabx_id(port extract 6)
3 920 else
3 921 if port shift (-6) extract 6 = 3 then
3 922 port_til_omr:= radio_id(port extract 6)
3 923 else
3 924 port_til_omr:= 0;
3 925 end;
2 926
2 926 integer procedure kanal_til_port(kanal);
2 927 value kanal; integer kanal;
2 928 begin
3 929 kanal_til_port:= kanal_id(kanal) shift (-5) extract 3 shift 6 +
3 930 kanal_id(kanal) extract 5;
3 931 end;
2 932
2 932 integer procedure port_til_kanal(port);
2 933 value port; integer port;
2 934 begin
3 935 integer i,j;
3 936
3 936 j:=0;
3 937 for i:= 1 step 1 until max_antal_kanaler do
3 938 if kanal_id(i) = port shift (-6) shift 5 + port extract 5 then j:=i;
3 939 port_til_kanal:= j;
3 940 end;
2 941
2 941 integer procedure kanal_til_omr(kanal);
2 942 value kanal; integer kanal;
2 943 begin
3 944 kanal_til_omr:= port_til_omr( kanal_til_port(kanal) );
3 945 end;
2 946
2 946 \f
2 946 message procedure out_xxx_bits side 1 - 810406/cl;
2 947
2 947 procedure outboolbits(zud,b);
2 948 value b;
2 949 zone zud;
2 950 boolean b;
2 951 begin
3 952 integer i;
3 953
3 953 for i:= -11 step 1 until 0 do
3 954 outchar(zud,if b shift i then '1' else '.');
3 955 end;
2 956
2 956 procedure outintbits(zud,j);
2 957 value j;
2 958 zone zud;
2 959 integer j;
2 960 begin
3 961 integer i;
3 962
3 962 for i:= -23 step 1 until 0 do
3 963 begin
4 964 outchar(zud,if j shift i extract 1 = 1 then '1' else '.');
4 965 if i<>0 and abs(i) mod 6 = 0 then outchar(zud,'sp');
4 966 end;
3 967 end;
2 968
2 968 procedure outintbits_ia(zud,ia,n,ø);
2 969 value n,ø;
2 970 zone zud;
2 971 integer array ia;
2 972 integer n,ø;
2 973 begin
3 974 integer i;
3 975
3 975 for i:= n step 1 until ø do
3 976 begin
4 977 outintbits(zud,ia(i));
4 978 outchar(zud,'nl');
4 979 end;
3 980 end;
2 981
2 981 real procedure now;
2 982 begin
3 983 real f,r,r1; long l;
3 984
3 984 systime(1,0,r); l:=r*100; f:=(l mod 100)/100;
3 985 systime(4,r,r1);
3 986 now:= r1+f;
3 987 end;
2 988 \f
2 988 message procedure skriv_id side 1 - 820301/cl;
2 989
2 989 procedure skriv_id(z,id,lgd);
2 990 value id,lgd;
2 991 integer id,lgd;
2 992 zone z;
2 993 begin
3 994 integer type,p,li,lø,bo;
3 995
3 995 type:= id shift (-22);
3 996 case type+1 of
3 997 begin
4 998 <* 1: bus *>
4 999 begin
5 1000 p:= write(z,<<d>,id extract 14);
5 1001 if id shift (-14) <> 0 then
5 1002 p:= p + write(z,".",1,string bpl_navn(id shift (-14)));
5 1003 end;
4 1004
4 1004 <* 2: linie/løb *>
4 1005 begin
5 1006 li:= id shift (-12) extract 10;
5 1007 bo:= id shift (-7) extract 5;
5 1008 if bo<>0 then bo:= bo + 'A' - 1;
5 1009 lø:= id extract 7;
5 1010 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1,"/",1,lø);
5 1011 end;
4 1012
4 1012 <* 3: gruppe *>
4 1013 begin
5 1014 if id shift (-21) = 4 <* linie-gruppe *> then
5 1015 begin
6 1016 li:= id shift (-5) extract 10;
6 1017 bo:= id extract 5;
6 1018 if bo<>0 then bo:= bo + 'A' - 1;
6 1019 p:= write(z,<<d>,li,false add bo,(bo<>0) extract 1);
6 1020 end
5 1021 else <* special-gruppe *>
5 1022 p:= write(z,"G",1,<<d>,id extract 7);
5 1023 end;
4 1024
4 1024 <* 4: telefon *>
4 1025 begin
5 1026 bo:= id shift (-20) extract 2;
5 1027 li:= id extract 20;
5 1028 case bo+1 of
5 1029 begin
6 1030 p:= write(z,string kanalnavn(li));
6 1031 p:= write(z,<:K*:>);
6 1032 p:= write(z,<:OMR :>,string områdenavn(li));
6 1033 p:= write(z,<:OMR*:>);
6 1034 end;
5 1035 end;
4 1036 end case;
3 1037 write(z,"sp",lgd-p);
3 1038 end skriv_id;
2 1039 <*+3*>
2 1040 \f
2 1040 message skriv_new_sem side 1 - 810520/cl;
2 1041
2 1041 procedure skriv_new_sem(z,type,ref,navn);
2 1042 value type,ref;
2 1043 zone z;
2 1044 integer type,ref;
2 1045 string navn;
2 1046 <* skriver en identifikation af en semafor 'ref' i zonen z.
2 1047
2 1047 type: 1=binær sem
2 1048 2=simpel sem
2 1049 3=kædet sem
2 1050
2 1050 ref: semaforreference
2 1051
2 1051 navn: semafornavn, max 18 tegn
2 1052 *>
2 1053 begin
3 1054 disable if testbit29 then
3 1055 write(z,"nl",1,"sp",26*(type-1),case type of(<:bs:>,<:ss:>,<:cs:>),
3 1056 true,5,<<zddd>,ref,true,19,navn);
3 1057 end;
2 1058 \f
2 1058 message procedure skriv_newactivity side 1 - 810520/hko/cl;
2 1059
2 1059 <**> procedure skriv_newactivity(zud,actno,cause);
2 1060 <**> value actno,cause;
2 1061 <**> zone zud;
2 1062 <**> integer actno,cause;
2 1063 <**> begin
3 1064 <*+2*>
3 1065 <**> if testbit28 then
3 1066 <**> begin integer array field cor;
4 1067 <**> cor:= coroutine(actno);
4 1068 <**> write(zud,<: coroutine::>,<< dd>,actno,<: ident::>,
4 1069 <**> << zdd>,d.cor.coruident//1000);
4 1070 <**> end;
3 1071 <**> if -, testbit23 then goto skriv_newact_slut;
3 1072 <*-2*>
3 1073 <**> write(zud,"nl",1,<:newactivity(:>,<<d>,actno,
3 1074 <**> <:) cause=:>,<<-d>,cause);
3 1075 <**> if cause<1 then write(zud,<: !!!:>);
3 1076 <**> skriv_coru(zud,actno);
3 1077 <**> skriv_newact_slut:
3 1078 <**> end skriv_newactivity;
2 1079 <*-3*>
2 1080 <*+99*>
2 1081 \f
2 1081 message procedure skriv_activity side 1 - 810313/hko;
2 1082
2 1082 <**> procedure skriv_activity(zud,actno);
2 1083 <**> value actno;
2 1084 <**> zone zud;
2 1085 <**> integer actno;
2 1086 <**> begin
3 1087 <**> integer i;
3 1088 <**> integer array iact(1:12);
3 1089 <**>
3 1090 <**> i:=system(12,actno,iact);
3 1091 <**> write(zud,"nl",1,<: activity(:>,<<d>,actno,<:) af :>,i,"sp",1,
3 1092 <**> if i=0 then <:neutral:> else (case sign(iact(3))+2 of
3 1093 <**> (<:disable:>,<:monitor:>,<:activity:>)),<: mode:>);
3 1094 <**> if i>0 and actno>0 and actno<=i then
3 1095 <**> begin
4 1096 <**> write(zud,"nl",1,"sp",4,<:tilstand= :>,case iact(8)+1 of
4 1097 <**> (<:tom:>,<:passivate:>,
4 1098 <**> <:implicit passivate:>,<:activate:>));
4 1099 <**> if iact(1)<>0 then
4 1100 <**> write(zud,<: ventende på message:>,iact(1));
4 1101 <**> if iact(7)>0 then
4 1102 <**> write(zud,"nl",1,"sp",4,<:virtuel stak::>,iact(7),"sp",2,
4 1103 <**> <:hovedlager stak benyttes af activity(:>,<<d>,
4 1104 <**> iact(2));
4 1105 <**> write(zud,"nl",1,"sp",4,<:stak(top,bund,sidst,csr,cza)=:>,
4 1106 <**> iact(4),iact(5),iact(6),iact(10),iact(11));
4 1107 <**> if iact(9)<> 1 shift 22 then
4 1108 <**> write(zud,"nl",1,"sp",4,<:'head of zonechain'=:>,iact(9));
4 1109 <**> write(zud,"nl",1,"sp",4,<:'trap chain'=:>,iact(12));
4 1110 <**> end;
3 1111 <**> end skriv_activity
2 1112 <*-99*>
2 1113 <*+98*>
2 1114 \f
2 1114 message procedure identificer side 1 - 810520/cl;
2 1115
2 1115 procedure identificer(z);
2 1116 zone z;
2 1117 begin
3 1118 disable write(z,<:coroutine::>,<< dd>,curr_coruno,
3 1119 <: ident::>,<< zdd >,curr_coruid);
3 1120 end;
2 1121 \f
2 1121 message procedure skriv_coru side 1 - 810317/cl;
2 1122
2 1122 <**> procedure skriv_coru(zud,cor_no);
2 1123 <**> value cor_no;
2 1124 <**> zone zud;
2 1125 <**> integer cor_no;
2 1126 <**> begin
3 1127 <**> integer i;
3 1128 <**> integer array field cor;
3 1129 <**>
3 1130 <**>
3 1131 <**> write(zud,"nl",1,<: coroutine: :>,<<d>,cor_no);
3 1132 <**>
3 1133 <**> cor:= coroutine(cor_no);
3 1134 <**> if cor = -1 then
3 1135 <**> write(zud,<: eksisterer ikke !!!:>)
3 1136 <**> else
3 1137 <**> begin
4 1138 <**> write(zud,<:; ident = :>,<<zdd>,d.cor.coruident//1000,
4 1139 <**> <: refbyte: :>,<<d>,cor,"nl",1,
4 1140 <**> <: prev: :>,<<dddd>,d.cor.prev,"nl",1,
4 1141 <**> <: next: :>,d.cor.next,"nl",1,
4 1142 <**> <: timerchain.prev: :>,d.cor(corutimerchain//2-1),"nl",1,
4 1143 <**> <: timerchain.next: :>,d.cor.corutimerchain,"nl",1,
4 1144 <**> <: opchain.prev: :>,d.cor(coruop//2-1),"nl",1,
4 1145 <**> <: opchain.next: :>,d.cor.coruop,"nl",1,
4 1146 <**> <: timer: :>,d.cor.corutimer,"nl",1,
4 1147 <**> <: priority: :>,d.cor.corupriority,"nl",1,
4 1148 <**> <: typeset: :>);
4 1149 <**> for i:= -11 step 1 until 0 do
4 1150 <**> write(zud,if d.cor.corutypeset shift i then <:1:> else <:.:>);
4 1151 <**> write(zud,"nl",1,<: testmask: :>);
4 1152 <**> for i:= -11 step 1 until 0 do
4 1153 <**> write(zud,if d.cor.corutestmask shift i then <:1:> else <:.:>);
4 1154 <*+99*>
4 1155 <**> skriv_activity(zud,cor_no);
4 1156 <*-99*>
4 1157 <**> end;
3 1158 <**> end skriv_coru;
2 1159 <*-98*>
2 1160 <*+98*>
2 1161 \f
2 1161 message procedure skriv_op side 1 - 810409/cl;
2 1162
2 1162 <**> procedure skriv_op(zud,opref);
2 1163 <**> value opref;
2 1164 <**> integer opref;
2 1165 <**> zone zud;
2 1166 <**> begin
3 1167 <**> integer array field op;
3 1168 <**> real array field raf;
3 1169 <**> integer lgd,i;
3 1170 <**> real t;
3 1171 <**>
3 1172 <**> raf:= data;
3 1173 <**> op:= opref;
3 1174 <**> write(zud,"nl",1,<:op:>,<<d>,opref,<:::>);
3 1175 <**> if opref<first_op ! optop<=opref then
3 1176 <**> begin
4 1177 <**> write(zud,<: !!! illegal reference !!!:>,"nl",1);
4 1178 <**> goto slut_skriv_op;
4 1179 <**> end;
3 1180 <**>
3 1181 <**> lgd:= d.op.opsize;
3 1182 <**> write(zud,"nl",1,<<d>,
3 1183 <**> <: opsize :>,d.op.opsize,"nl",1,
3 1184 <**> <: optype :>);
3 1185 <**> for i:= -11 step 1 until 0 do
3 1186 <**> write(zud,if d.op.optype shift i then <:1:> else <:.:>);
3 1187 <**> write(zud,"nl",1,<<d>,
3 1188 <**> <: prev :>,d.op.prev,"nl",1,
3 1189 <**> <: next :>,d.op.next);
3 1190 <**> if lgd=0 then goto slut_skriv_op;
3 1191 <**> write(zud,"nl",1,<<d>,
3 1192 <**> <: kilde :>,d.op.kilde extract 10,"nl",1,
3 1193 <**> <: tid :>,<<zddddd>,systime(4,d.op.tid,t),<:.:>,t,"nl",1,<<d>,
3 1194 <**> <: retur-sem :>,if d.op.retur<>0 then <:cs:> else <:--:>,<<b>,
3 1195 d.op.retur,"nl",1,
3 1196 <**> <: opkode :>,<<b>,d.op.opkode shift (-12),"sp",1,<<d>,
3 1197 <**> d.op.opkode extract 12,"nl",1,
3 1198 <**> <: resultat :>,d.op.resultat,"nl",2,
3 1199 <**> <:data::>);
3 1200 <**> skriv_hele(zud,d.op.raf,lgd-data,1278);
3 1201 <**>slut_skriv_op:
3 1202 <**> end skriv_op;
2 1203 <*-98*>
2 1204 \f
2 1204 message procedure corutable side 1 - 810406/cl;
2 1205
2 1205 procedure corutable(zud);
2 1206 zone zud;
2 1207 begin
3 1208 integer i;
3 1209 integer array field cor;
3 1210
3 1210 write(zud,"ff",1,<:***** coroutines *****:>,"nl",2,
3 1211 <:no id ref chain timerch opchain timer pr:>,
3 1212 <: typeset testmask:>,"nl",2);
3 1213 for i:= 1 step 1 until maxcoru do
3 1214 begin
4 1215 cor:= coroutine(i);
4 1216 write(zud,<<zd>,i,<< zdd>,d.cor.coruident//1000,<< dddd>,cor,
4 1217 d.cor.prev,d.cor.next,d.cor(corutimerchain//2-1),
4 1218 d.cor.corutimerchain,d.cor(coruop//2-1),d.cor.coruop,<< ddddd>,
4 1219 d.cor.corutimer,<< dd>,d.cor.corupriority);
4 1220 outchar(zud,'sp');
4 1221 outboolbits(zud,d.cor.corutypeset);
4 1222 outchar(zud,'sp');
4 1223 outboolbits(zud,d.cor.corutestmask);
4 1224 outchar(zud,'nl');
4 1225 end;
3 1226 end;
2 1227 \f
2 1227 message filglobal side 1 - 790302/jg;
2 1228
2 1228 integer
2 1229 dbantsf,dbkatsfri,
2 1230 dbantb,dbkatbfri,
2 1231 dbantef,dbkatefri,
2 1232 dbsidstesz,dbsidstetz,
2 1233 dbsegmax,
2 1234 filskrevet,fillæst;
2 1235 integer
2 1236 bs_kats_fri, bs_kate_fri,
2 1237 cs_opret_fil, cs_tilknyt_fil,
2 1238 cs_frigiv_fil, cs_slet_fil,
2 1239 cs_opret_spoolfil, cs_opret_eksternfil;
2 1240 integer array
2 1241 dbkatt(1:dbmaxtf,1:2),
2 1242 dbkats(1:dbmaxsf,1:2),
2 1243 dbkate(1:dbmaxef,1:6),
2 1244 dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
2 1245 boolean array
2 1246 dbkatb(1:dbmaxb);
2 1247 zone array
2 1248 fil(dbantez+dbantsz+dbanttz,128,1,stderror);
2 1249 \f
2 1249 message hentfildim side 1 - 781120/jg;
2 1250
2 1250
2 1250 integer procedure hentfildim(fdim);
2 1251 integer array fdim;
2 1252 <*inddata filref i fdim(4),uddata fdim(1:8)*>
2 1253
2 1253 begin integer ftype,fno,katf,i,s;
3 1254 ftype:=fdim(4) shift (-10);
3 1255 fno:=fdim(4) extract 10;
3 1256 if ftype>3 or ftype=0 or fno=0 then
3 1257 begin s:=1; goto udgang; end;
3 1258 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
3 1259 begin s:=1; goto udgang end; <*paramfejl*>
3 1260 katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
3 1261 if katf extract 9 = 0 then
3 1262 begin s:=2; goto udgang end; <*tom indgang*>
3 1263
3 1263 fdim(1):=katf shift (-9); <*post antal*>
3 1264 fdim(2):=katf extract 9; <*post længde*>
3 1265 fdim(3):=case ftype of( <*seg antal*>
3 1266 dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
3 1267 extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
3 1268 dbkate(fno,2) extract 18);
3 1269 for i:=5 step 1 until 8 do <*externt filnavn*>
3 1270 fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
3 1271 s:=0;
3 1272 udgang:
3 1273 hentfildim:=s;
3 1274 <*+2*>
3 1275 <*tz*> if testbit24 and overvåget then <*zt*>
3 1276 <*tz*> begin <*zt*>
4 1277 <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*>
4 1278 <*tz*> pfdim(fdim); <*zt*>
4 1279 <*tz*> ud; <*zt*>
4 1280 <*tz*> end; <*zt*>
3 1281 <*-2*>
3 1282 end hentfildim;
2 1283 \f
2 1283 message sætfildim side 1 - 780916/jg;
2 1284
2 1284 integer procedure sætfildim(fdim);
2 1285 integer array fdim;
2 1286 <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>
2 1287
2 1287 begin
3 1288 integer ftype,fno,katf,s,pl;
3 1289 integer array gdim(1:8);
3 1290 gdim(4):=fdim(4);
3 1291 s:=hentfildim(gdim);
3 1292 if s>0 then
3 1293 goto udgang;
3 1294 fno:=fdim(4) extract 10;
3 1295 ftype:=fdim(4) shift (-10);
3 1296 pl:= fdim(2) extract 12;
3 1297 if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
3 1298 begin
4 1299 s:=1; <*parameter fejl*>
4 1300 goto udgang
4 1301 end;
3 1302 if fdim(1)>256//pl*fdim(3) then
3 1303 begin
4 1304 s:=1;
4 1305 goto udgang;
4 1306 end;
3 1307
3 1307 <*segant*>
3 1308 if ftype=3 then
3 1309 begin integer segant;
4 1310 segant:= fdim(3);
4 1311 if segant > dbsegmax then
4 1312 begin
5 1313 s:=4; <*ingen plads*>
5 1314 goto udgang
5 1315 end;
4 1316 \f
4 1316 message sætfildim side 2 - 780916/jg;
4 1317
4 1317
4 1317 if segant<>gdim(3) then
4 1318 begin integer i,z,s; array field enavn; integer array tail(1:10);
5 1319 z:=dbkate(fno,2) shift (-19); if z>0 then begin
6 1320 if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
6 1321 begin integer array zd(1:20);
7 1322 getzone6(fil(z),zd);
7 1323 if zd(13)>5 and zd(9)>=segant then
7 1324 begin <*dødt segment skal ikke udskrives*>
8 1325 zd(13):=5;
8 1326 setzone6(fil(z),zd)
8 1327 end
7 1328 end end;
5 1329 \f
5 1329 message sætfildim side 3 - 801031/jg;
5 1330
5 1330
5 1330 enavn:=8; <*ændr fil størrelse*>
5 1331 i:=1;
5 1332 open(zdummy,0,string gdim.enavn(increase(i)),0);
5 1333 s:=monitor(42,zdummy,0,tail); <*lookup*>
5 1334 if s>0 then
5 1335 fejlreaktion(1,s,<:lookup entry:>,0);
5 1336 tail(1):=segant;
5 1337 s:=monitor(44,zdummy,0,tail); <*change entry*>
5 1338 close(zdummy,false);
5 1339 if s<>0 then
5 1340 begin
6 1341 if s=6 then
6 1342 begin <*ingen plads*>
7 1343 s:=4; goto udgang
7 1344 end
6 1345 else fejlreaktion(1,s,<:change entry:>,0);
6 1346 end;
5 1347 dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
5 1348 add segant;
5 1349 \f
5 1349 message sætfildim side 4 - 801013/jg;
5 1350
5 1350
5 1350 end;
4 1351 fdim(3):=segant
4 1352 end
3 1353 else
3 1354 if fdim(3)>gdim(3) then
3 1355 begin
4 1356 s:=4; <*altid ingen plads*>
4 1357 goto udgang
4 1358 end
3 1359 else fdim(3):=gdim(3); <*samme længde*>
3 1360 <*postantal,postlængde*>
3 1361 katf:=fdim(1) shift 9 add pl;
3 1362 case ftype of begin
4 1363 dbkatt(fno,1):=katf;
4 1364 dbkats(fno,1):=katf;
4 1365 dbkate(fno,1):=katf end;
3 1366 udgang:
3 1367 sætfildim:=s;
3 1368 <*+2*>
3 1369 <*tz*> if testbit24 and overvåget then <*zt*>
3 1370 <*tz*> begin integer i; <*zt*>
4 1371 <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*>
4 1372 <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*>
4 1373 <*tz*> pfdim(gdim); <*zt*>
4 1374 <*tz*> ud; <*zt*>
4 1375 <*tz*> end; <*zt*>
3 1376 <*-2*>
3 1377 end sætfildim;
2 1378 \f
2 1378 message findfilenavn side 1 - 780916/jg;
2 1379
2 1379 integer procedure findfilenavn(navn);
2 1380 real array navn;
2 1381
2 1381 begin
3 1382 integer fno; array field enavn;
3 1383 for fno:=1 step 1 until dbmaxef do
3 1384 if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
3 1385 begin
4 1386 enavn:=fno*12+4;
4 1387 if navn(1)=dbkate.enavn(1) and
4 1388 navn(2)=dbkate.enavn(2) then
4 1389 begin
5 1390 findfilenavn:=fno;
5 1391 goto udgang
5 1392 end
4 1393 end;
3 1394 findfilenavn:=0;
3 1395 udgang:
3 1396 end findfilenavn;
2 1397 \f
2 1397 message læsfil side 1 - 781120/jg;
2 1398
2 1398 integer procedure læsfil(filref,postindex,zoneno);
2 1399 value filref,postindex;
2 1400 integer filref,postindex,zoneno;
2 1401 <*+2*>
2 1402 <*tz*> begin integer i,o,s; <*zt*>
3 1403 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1404 <*-2*>
3 1405
3 1405 læsfil:=tilgangfil(filref,postindex,zoneno,5);
3 1406
3 1406 <*+2*>
3 1407 <*tz*> if testbit24 and overvåget then <*zt*>
3 1408 <*tz*> begin <*zt*>
4 1409 <*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*>
4 1410 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1411 <*tz*> end; <*zt*>
3 1412 <*tz*> end procedure; <*zt*>
2 1413 <*-2*>
2 1414 \f
2 1414 message skrivfil side 1 - 781120/jg;
2 1415
2 1415 integer procedure skrivfil(filref,postindex,zoneno);
2 1416 value filref,postindex;
2 1417 integer filref,postindex,zoneno;
2 1418 <*+2*>
2 1419 <*tz*> begin integer i,o,s; <*zt*>
3 1420 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1421 <*-2*>
3 1422
3 1422 skrivfil:=tilgangfil(filref,postindex,zoneno,6);
3 1423
3 1423 <*+2*>
3 1424 <*tz*> if testbit24 and overvåget then <*zt*>
3 1425 <*tz*> begin <*zt*>
4 1426 <*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
4 1427 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1428 <*tz*> end; <*zt*>
3 1429 <*tz*> end procedure; <*zt*>
2 1430 <*-2*>
2 1431 \f
2 1431 message modiffil side 1 - 781120/jg;
2 1432
2 1432 integer procedure modiffil(filref,postindex,zoneno);
2 1433 value filref,postindex;
2 1434 integer filref,postindex,zoneno;
2 1435 <*+2*>
2 1436 <*tz*> begin integer i,o,s; <*zt*>
3 1437 <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*>
3 1438 <*-2*>
3 1439
3 1439 modiffil:=tilgangfil(filref,postindex,zoneno,7);
3 1440
3 1440 <*+2*>
3 1441 <*tz*> if testbit24 and overvåget then <*zt*>
3 1442 <*tz*> begin <*zt*>
4 1443 <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
4 1444 <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*>
4 1445 <*tz*> end; <*zt*>
3 1446 <*tz*> end procedure; <*zt*>
2 1447 <*-2*>
2 1448 \f
2 1448 message tilgangfil side 1 - 781003/jg;
2 1449
2 1449 integer procedure tilgangfil(filref,postindex,zoneno,operation);
2 1450 value filref,postindex,operation;
2 1451 integer filref,postindex,zoneno,operation;
2 1452 <*proceduren kaldes fra læsfil,skrivfil og modiffil*>
2 1453
2 1453 begin
3 1454 integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
3 1455 integer array zd(1:20),fdim(1:8);
3 1456
3 1456
3 1456
3 1456 <*hent katalog*>
3 1457
3 1457 fdim(4):=filref;
3 1458 st:=hentfildim(fdim);
3 1459 if st<>0 then
3 1460 goto udgang; <*parameter fejl eller fil findes ikke*>
3 1461 fno:=filref extract 10;
3 1462 ftype:=filref shift (-10);
3 1463 pl:=fdim(2);
3 1464 katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
3 1465 \f
3 1465 message tilgangfil side 2 - 781003/jg;
3 1466
3 1466
3 1466
3 1466 <*find segment adr og check postindex*>
3 1467
3 1467 pps:=256//pl; <*poster pr segment*>
3 1468 seg:=(postindex-1)//pps; <*relativt segment*>
3 1469 pr:=(postindex-1) mod pps; <*post relativ til seg*>
3 1470 if postindex <1 then
3 1471 begin <*parameter fejl*>
4 1472 st:=1;
4 1473 goto udgang
4 1474 end;
3 1475 if seg>=fdim(3) then
3 1476 begin <*post findes ikke*>
4 1477 st:=3;
4 1478 goto udgang
4 1479 end;
3 1480 case ftype of
3 1481 begin <*find absolut segment*>
4 1482
4 1482 <*tabelfil*>
4 1483 seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);
4 1484
4 1484 begin <*spoolfil*>
5 1485 integer i,bidno;
5 1486 bidno:=katf extract 12;
5 1487 for i:=seg//dbbidlængde step -1 until 1 do
5 1488 bidno:=dbkatb(bidno) extract 12;
5 1489 seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
5 1490 end;
4 1491
4 1491 <*extern fil,seg ok*>
4 1492
4 1492 end case find abs seg;
3 1493 \f
3 1493 message tilgangfil side 3 - 801030/jg;
3 1494
3 1494 <*alloker zone*>
3 1495
3 1495 zno:=katf shift(-19);
3 1496 case ftype of begin
4 1497
4 1497 begin <*tabelfil*>
5 1498 integer førstetz;
5 1499 førstetz:=dbkatz(dbsidstetz,2);
5 1500 if zno=0 then
5 1501 zno:=førstetz
5 1502 else if dbkatz(zno,1)<>filref then
5 1503 zno:=førstetz
5 1504 else if zno <> førstetz and zno <> dbsidstetz then
5 1505 begin integer z;
6 1506 for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
6 1507 dbkatz(z,2):=dbkatz(zno,2);
6 1508 dbkatz(zno,2):=førstetz;
6 1509 dbkatz(dbsidstetz,2):=zno;
6 1510 end;
5 1511 dbsidstetz:=zno
5 1512 end;
4 1513 \f
4 1513 message tilgangfil side 4 - 801030/jg;
4 1514
4 1514
4 1514 begin <*spoolfil*>
5 1515 integer p,zslut,z;
5 1516 if zno>0 then begin if dbkatz(zno,1) =filref then
6 1517 goto udgangs end; <*strategi 1*>
5 1518 p:=0;
5 1519 zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
5 1520 zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
5 1521 for z:=dbantez+dbantsz step -1 until zslut do
5 1522 begin integer zfref;
6 1523 zfref:=dbkatz(z,1);
6 1524 if zfref extract 10=0 then <*fri zone*>
6 1525 begin <*strategi 2*>
7 1526 zno:=z;
7 1527 goto udgangs
7 1528 end
6 1529 else
6 1530 if zfref shift (-10)=2 then
6 1531 begin <*zone tilknyttet spoolfil*>
7 1532 integer q;
7 1533 q:=dbkatz(z,2); <*prioritet*>
7 1534 if q>p then
7 1535 begin <*strategi 3*>
8 1536 p:=q;
8 1537 zno:=z
8 1538 end
7 1539 end;
6 1540 end z;
5 1541 udgangs:
5 1542 if zno> dbantez then dbsidstesz:=zno;
5 1543 end;
4 1544 \f
4 1544 message tilgangfil side 5 - 780916/jg;
4 1545
4 1545 begin <*extern fil*>
5 1546 integer z;
5 1547 if zno=0 then
5 1548 zno:=1
5 1549 else if dbkatz(zno,1) = filref then
5 1550 goto udgange; <*strategi 1*>
5 1551 for z:=1 step 1 until dbantez do
5 1552 begin integer zfref;
6 1553 zfref:=dbkatz(z,1);
6 1554 if zfref=0 then <*zone fri*>
6 1555 begin zno:=z; goto udgange end <*strategi 2*>
6 1556 else if zfref shift (-10) =2 then <*spoolfil*>
6 1557 zno:=z; <*strategi 3*> <*else strategi 4-5*>
6 1558 end z;
5 1559 udgange:
5 1560 end
4 1561 end case alloker zone;
3 1562
3 1562
3 1562
3 1562 <*åbn zone*>
3 1563
3 1563 if zno<=dbantez then
3 1564 begin <*extern zone;spool og tabel zoner altid åbne*>
4 1565 integer zfref;
4 1566 zfref:=dbkatz(zno,1);
4 1567 if zfref<>0 and zfref<>filref and ftype=3 then
4 1568 begin <*luk hvis ny extern fil*>
5 1569 getzone6(fil(zno),zd);
5 1570 if zd(13)>5 then filskrevet:=filskrevet+1;
5 1571 zfref:=0;
5 1572 close(fil(zno),false);
5 1573 end;
4 1574 if zfref=0 then
4 1575 begin <*åbn zone*>
5 1576 array field enavn; integer i;
5 1577 enavn:=4*2; i:=1;
5 1578 open(fil(zno),4,case ftype-1 of(string dbsnavn(increase(i)),
5 1579 string fdim.enavn(increase(i))),0)
5 1580 end
4 1581 end;
3 1582 \f
3 1582 message tilgangfil side 6 - 780916/jg;
3 1583
3 1583
3 1583
3 1583 <*hent segment og sæt zone descriptor*>
3 1584
3 1584 getzone6(fil(zno),zd);
3 1585 zstate:=zd(13);
3 1586 if zstate=0 or zd(9)<>seg then
3 1587 begin <*positioner*>
4 1588 if zstate>5 then
4 1589 filskrevet:=filskrevet+1;
4 1590 setposition(fil(zno),0,seg);
4 1591 if -,(operation=6 and pr=0) then
4 1592 begin <*læs seg medmindre op er skriv første post*>
5 1593 inrec6(fil(zno),512);
5 1594 fillæst:=fillæst+1
5 1595 end;
4 1596 zstate:=operation
4 1597 end
3 1598 else <*zstate:=max(operation,zone state)*>
3 1599 if operation>zstate then
3 1600 zstate:=operation;
3 1601 zd(9):=seg;
3 1602 zd(13):=zstate;
3 1603 zd(16):=pl shift 1;
3 1604 zd(14):=zd(19)+pr*zd(16);
3 1605 setzone6(fil(zno),zd);
3 1606 \f
3 1606 message tilgangfil side 7 - 780916/jg;
3 1607
3 1607
3 1607
3 1607 <*opdater kataloger*>
3 1608
3 1608 katf:=zno shift 19 add (katf extract 19);
3 1609 case ftype of
3 1610 begin
4 1611 dbkatt(fno,2):=katf;
4 1612 dbkats(fno,2):=katf;
4 1613 dbkate(fno,2):=katf
4 1614 end;
3 1615 dbkatz(zno,1):= filref;
3 1616 if ftype=3 then dbkatz(zno,2):=0 else
3 1617 <*if ftype=1 then allerede opd under zoneallokering*>
3 1618 if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
3 1619 if zstate=5 then (if pr=pps-1 then 2 else 1)
3 1620 else if zstate=6 and pr=pps-1 then 3 else 0;
3 1621
3 1621
3 1621
3 1621 <*udgang*>
3 1622
3 1622 udgang:
3 1623 if st=0 then
3 1624 zoneno:=zno
3 1625 else zoneno:=0; <*fejl*>
3 1626 tilgangfil:=st;
3 1627 end tilgangfil;
2 1628 \f
2 1628
2 1628 message pfilsystem side 1 - 781003/jg;
2 1629
2 1629 procedure pfilparm(z);
2 1630 zone z;
2 1631 write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
2 1632 dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
2 1633 <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>,
2 1634 dbbidmax,<:<10>dbmaxef=:>,dbmaxef);
2 1635
2 1635 procedure pfilglobal(z);
2 1636 zone z;
2 1637 write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
2 1638 <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri,
2 1639 <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
2 1640 <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
2 1641 <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
2 1642 <:<10>dbsnavn=:>,dbsnavn,<: dbtnavn=:>,dbtnavn);
2 1643
2 1643
2 1643 procedure pdbkate(z,i);
2 1644 value i; integer i;
2 1645 zone z;
2 1646 begin integer j; array field navn;
3 1647 navn:=i*12+4; j:=1;
3 1648 write(z,<:<10>dbkate(:>,i,<:)=:>,
3 1649 dbkate(i,1) shift (-9),
3 1650 dbkate(i,1) extract 9,
3 1651 dbkate(i,2) shift (-19),
3 1652 dbkate(i,2) shift (-18) extract 1,
3 1653 dbkate(i,2) extract 18,
3 1654 <: :>,string dbkate.navn(increase(j)));
3 1655 end;
2 1656 \f
2 1656 message pfilsystem side 2 - 781003/jg;
2 1657
2 1657
2 1657
2 1657 procedure pdbkats(z,i);
2 1658 value i; integer i;
2 1659 zone z;
2 1660 write(z,<:<10>dbkats(:>,i,<:)=:>,
2 1661 dbkats(i,1) shift (-9),
2 1662 dbkats(i,1) extract 9,
2 1663 dbkats(i,2) shift (-19),
2 1664 dbkats(i,2) shift (-18) extract 1,
2 1665 dbkats(i,2) shift (-12) extract 6,
2 1666 dbkats(i,2) extract 12);
2 1667
2 1667 procedure pdbkatb(z,i);
2 1668 value i;integer i;
2 1669 zone z;
2 1670 write(z,<:<10>dbkatb(:>,i,<:)=:>,
2 1671 dbkatb(i) extract 12);
2 1672
2 1672 procedure pdbkatt(z,i);
2 1673 value i; integer i;
2 1674 zone z;
2 1675 write(z,<:<10>dbkatt(:>,i,<:)=:>,
2 1676 dbkatt(i,1) shift (-9),
2 1677 dbkatt(i,1) extract 9,
2 1678 dbkatt(i,2) shift (-19),
2 1679 dbkatt(i,2) shift (-18) extract 1,
2 1680 dbkatt(i,2) extract 18);
2 1681
2 1681 procedure pdbkatz(z,i);
2 1682 value i; integer i;
2 1683 zone z;
2 1684 write(z,<:<10>dbkatz(:>,i,<:)=:>,
2 1685 dbkatz(i,1),dbkatz(i,2));
2 1686 \f
2 1686 message pfilsystem side 3 - 781003/jg;
2 1687
2 1687
2 1687
2 1687 procedure pfil(z,i);
2 1688 value i; integer i;
2 1689 zone z;
2 1690 begin integer j,k; array field navn; integer array zd(1:20);
3 1691 navn:=2; k:=1;
3 1692 getzone6(fil(i),zd);
3 1693 write(z,<:<10>fil(:>,i,<:)=:>,
3 1694 zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
3 1695 string zd.navn(increase(k)));
3 1696 for j:=6 step 1 until 10 do write(z,zd(j));
3 1697 write(z,<:<10>:>);
3 1698 for j:=11 step 1 until 20 do write(z,zd(j));
3 1699 end;
2 1700
2 1700 procedure pfilsystem(z);
2 1701 zone z;
2 1702 begin integer i;
3 1703
3 1703 write(z,<:<12>udskrift af variable i filsystem:>);
3 1704 write(z,<:<10><10>filparm::>);
3 1705 pfilparm(z);
3 1706 write(z,<:<10><10>filglobal::>);
3 1707 pfilglobal(z);
3 1708 write(z,<:<10><10>fil: zone descriptor:>);
3 1709 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
3 1710 write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
3 1711 for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
3 1712 write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
3 1713 for i :=1 step 1 until dbmaxef do pdbkate(z,i);
3 1714 write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
3 1715 for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
3 1716 write(z,<:<10><10>dbkatb: katbref:>);
3 1717 for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
3 1718 write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
3 1719 for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
3 1720 end pfilsystem;
2 1721 \f
2 1721 message pfilsystem side 4 - 781003/jg;
2 1722
2 1722
2 1722
2 1722 procedure pfdim(fdim);
2 1723 integer array fdim;
2 1724 begin
3 1725 integer i;
3 1726 array field navn;
3 1727 i:=1;navn:=8;
3 1728 write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
3 1729 string fdim.navn(increase(i)));
3 1730 end pfdim;
2 1731 \f
2 1731 message opretfil side 0 - 810529/cl;
2 1732
2 1732 procedure opretfil;
2 1733 <* checker parametre og vidresender operation
2 1734 til opret_spoolfil eller opret_eksternfil *>
2 1735
2 1735 begin
3 1736 integer array field op;
3 1737 integer status,pant,pl,segant,p_nøgle,fno,ftype;
3 1738
3 1738 procedure skriv_opret_fil(z,omfang);
3 1739 value omfang;
3 1740 zone z;
3 1741 integer omfang;
3 1742 begin
4 1743 write(z,"nl",1,<:+++ opret fil :>);
4 1744 if omfang > 0 then
4 1745 disable
4 1746 begin
5 1747 skriv_coru(z,abs curr_coruno);
5 1748 write(z,"nl",1,<<d>,
5 1749 <:op :>,op,"nl",1,
5 1750 <:status :>,status,"nl",1,
5 1751 <:pant :>,pant,"nl",1,
5 1752 <:pl :>,pl,"nl",1,
5 1753 <:segant :>,segant,"nl",1,
5 1754 <:p-nøgle:>,p_nøgle,"nl",1,
5 1755 <:fno :>,fno,"nl",1,
5 1756 <:ftype :>,ftype,"nl",1,
5 1757 <::>);
5 1758 end;
4 1759 end skriv_opret_fil;
3 1760 \f
3 1760 message opretfil side 1 - 810526/cl;
3 1761
3 1761 trap(opretfil_trap);
3 1762 <*+2*>
3 1763 <**> disable if testbit28 then
3 1764 <**> skriv_opret_fil(out,0);
3 1765 <*-2*>
3 1766
3 1766 stack_claim(if cm_test then 200 else 150);
3 1767
3 1767 <*+2*>
3 1768 <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>);
3 1769 <*-2*>
3 1770
3 1770 trin1:
3 1771 waitch(cs_opret_fil,op,true,-1);
3 1772
3 1772 trin2: <* check parametre *>
3 1773 disable begin
4 1774
4 1774 ftype:= d.op.data(4) shift (-10);
4 1775 fno:= d.op.data(4) extract 10;
4 1776 if ftype<2 or ftype>3 or fno<>0 then
4 1777 begin
5 1778 status:= 1; <*parameterfejl*>
5 1779 goto returner;
5 1780 end;
4 1781
4 1781 pant:= d.op.data(1);
4 1782 pl:= d.op.data(2);
4 1783 segant:= d.op.data(3);
4 1784 p_nøgle:= d.op.opkode shift (-12);
4 1785 if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
4 1786 or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
4 1787 status:= 1 <*parameterfejl *>
4 1788 else
4 1789 if pant>256//pl*segant then status:= 1 else
4 1790 if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
4 1791 status:= 4 <*ingen plads*>
4 1792 else
4 1793 status:=0;
4 1794 \f
4 1794 message opretfil side 2 - 810526/cl;
4 1795
4 1795
4 1795 returner:
4 1796
4 1796 d.op.data(9):= status;
4 1797
4 1797 <*+2*>
4 1798 <*tz*> if testbit24 and overvåget and status<>0 then <*zt*>
4 1799 <*tz*> begin <*zt*>
5 1800 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 1801 <*tz*> pfdim(d.op.data); <*zt*>
5 1802 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1803 <*tz*> end; <*zt*>
4 1804 <*-2*>
4 1805
4 1805 <*returner eller vidresend operation*>
4 1806 signalch(if status>0 then d.op.retur else
4 1807 case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
4 1808 op,d.op.optype);
4 1809 end;
3 1810 goto trin1;
3 1811 opretfil_trap:
3 1812 disable skriv_opret_fil(zbillede,1);
3 1813
3 1813 end opretfil;
2 1814 \f
2 1814 message tilknytfil side 0 - 810526/cl;
2 1815
2 1815 procedure tilknytfil;
2 1816 <* tilknytter ekstern fil og returnerer intern filid *>
2 1817
2 1817 begin
3 1818 integer array field op;
3 1819 integer status,i,fno,segant,pa,pl,sliceant,s;
3 1820 array field enavn;
3 1821 integer array tail(1:10);
3 1822
3 1822 procedure skriv_tilknyt_fil(z,omfang);
3 1823 value omfang;
3 1824 zone z;
3 1825 integer omfang;
3 1826 begin
4 1827 write(z,"nl",1,<:+++ tilknyt fil :>);
4 1828 if omfang > 0 then
4 1829 disable
4 1830 begin real array field raf;
5 1831 skriv_coru(z,abs curr_coruno);
5 1832 write(z,"nl",1,<<d>,
5 1833 <:op :>,op,"nl",1,
5 1834 <:status :>,status,"nl",1,
5 1835 <:i :>,i,"nl",1,
5 1836 <:fno :>,fno,"nl",1,
5 1837 <:segant :>,segant,"nl",1,
5 1838 <:pa :>,pa,"nl",1,
5 1839 <:pl :>,pl,"nl",1,
5 1840 <:sliceant:>,sliceant,"nl",1,
5 1841 <:s :>,s,"nl",1,
5 1842 <::>);
5 1843 raf:= 0;
5 1844 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 1845 write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
5 1846 end;
4 1847 end skriv_tilknyt_fil;
3 1848 \f
3 1848 message tilknytfil side 1 - 810529/cl;
3 1849
3 1849 stack_claim(if cm_test then 200 else 150);
3 1850 trap(tilknytfil_trap);
3 1851
3 1851 <*+2*>
3 1852 <**> if testbit28 then
3 1853 <**> skriv_tilknyt_fil(out,0);
3 1854 <*-2*>
3 1855
3 1855 trin1:
3 1856 waitch(cs_tilknyt_fil,op,true,-1);
3 1857
3 1857 trin2:
3 1858 wait(bs_kate_fri);
3 1859
3 1859 trin3:
3 1860 disable begin
4 1861
4 1861 <* find ekstern rapportfil *>
4 1862 enavn:= 8;
4 1863 if find_fil_enavn(d.op.data.enavn)>0 then
4 1864 begin
5 1865 status:= 6; <* fil i brug *>
5 1866 goto returner;
5 1867 end;
4 1868 open(zdummy,0,d.op.data.enavn,0);
4 1869 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 1870 if s<>0 then
4 1871 begin
5 1872 if s=3 then status:= 2 <* fil findes ikke *>
5 1873 else if s=6 then status:= 1 <* parameterfejl, navn *>
5 1874 else fejlreaktion(1,s,<:lookup entry:>,0);
5 1875 goto returner;
5 1876 end;
4 1877 if tail(9)<>d.op.data(4) <* contentskey,subno *> then
4 1878 begin
5 1879 status:= 5; <* forkert indhold *> goto returner;
5 1880 end;
4 1881 segant:= tail(1);
4 1882 if segant>db_seg_max then
4 1883 segant:= db_seg_max;
4 1884 pa:= tail(10);
4 1885 pl:= tail(7) extract 12;
4 1886 if pl < 1 or pl > 256 then
4 1887 begin status:= 7; goto returner; end;
4 1888 \f
4 1888 message tilknytfil side 2 - 810529/cl;
4 1889 if pa>256//pl*segant then
4 1890 begin status:= 7; goto returner; end;
4 1891
4 1891 <* reserver *>
4 1892 s:= monitor(52)create area:(zdummy,0,ia);
4 1893 if s<>0 then
4 1894 begin
5 1895 if s=3 then status:= 2 <* fil findes ikke *>
5 1896 else if s=1 <* areaclaims exeeded *> then
5 1897 begin
6 1898 status:= 4;
6 1899 fejlreaktion(1,s,<:create area:>,1);
6 1900 end
5 1901 else fejlreaktion(1,s,<:create area:>,0);
5 1902 goto returner;
5 1903 end;
4 1904
4 1904 s:= monitor(8)reserve:(zdummy,0,ia);
4 1905 if s<>0 then
4 1906 begin
5 1907 if s<3 then status:= 6 <* i brug *>
5 1908 else fejlreaktion(1,s,<:reserve:>,0);
5 1909 monitor(64)remove area:(zdummy,0,ia);
5 1910 goto returner;
5 1911 end;
4 1912
4 1912 tail(7):= 1 shift 12 +pl; <* tilknyttet *>
4 1913 s:= monitor(44)change entry:(zdummy,0,tail);
4 1914 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 1915
4 1915 <* opdater katalog *>
4 1916 dbantef:= dbantef+1;
4 1917 fno:= dbkatefri;
4 1918 dbkatefri:= dbkate(fno,2);
4 1919 dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
4 1920 dbkate(fno,2):= segant;
4 1921 for i:= 5 step 1 until 8 do
4 1922 dbkate(fno,i-2):= d.op.data(i);
4 1923
4 1923 <* returparametre *>
4 1924 d.op.data(1):= pa;
4 1925 d.op.data(2):= pl;
4 1926 d.op.data(3):= segant;
4 1927 d.op.data(4):= 3 shift 10 +fno;
4 1928 status:= 0;
4 1929 \f
4 1929 message tilknytfil side 3 - 810526/cl;
4 1930
4 1930
4 1930 returner:
4 1931 close(zdummy,false);
4 1932 d.op.data(9):= status;
4 1933
4 1933
4 1933 <*+2*>
4 1934 <*tz*> if testbit24 and overvåget then <*zt*>
4 1935 <*tz*> begin <*zt*>
5 1936 <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*>
5 1937 <*tz*> pfdim(d.op.data); <*zt*>
5 1938 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 1939 <*tz*> end; <*zt*>
4 1940 <*-2*>
4 1941
4 1941 signalch(d.op.retur,op,d.op.optype);
4 1942 if dbantef < dbmaxef then
4 1943 signalbin(bs_kate_fri);
4 1944 end;
3 1945 goto trin1;
3 1946 tilknytfil_trap:
3 1947 disable skriv_tilknyt_fil(zbillede,1);
3 1948 end tilknyt_fil;
2 1949 \f
2 1949 message frigivfil side 0 - 810529/cl;
2 1950
2 1950 procedure frigivfil;
2 1951 <* frigiver en tilknyttet ekstern fil *>
2 1952
2 1952 begin
3 1953 integer array field op;
3 1954 integer status,fref,ftype,fno,s,i,z;
3 1955 array field enavn;
3 1956 integer array tail(1:10);
3 1957
3 1957 procedure skriv_frigiv_fil(zud,omfang);
3 1958 value omfang;
3 1959 zone zud;
3 1960 integer omfang;
3 1961 begin
4 1962 write(zud,"nl",1,<:+++ frigiv fil :>);
4 1963 if omfang > 0 then
4 1964 disable
4 1965 begin real array field raf;
5 1966 skriv_coru(zud,abs curr_coruno);
5 1967 write(zud,"nl",1,<<d>,
5 1968 <:op :>,op,"nl",1,
5 1969 <:status:>,status,"nl",1,
5 1970 <:fref :>,fref,"nl",1,
5 1971 <:ftype :>,ftype,"nl",1,
5 1972 <:fno :>,fno,"nl",1,
5 1973 <:s :>,s,"nl",1,
5 1974 <:i :>,i,"nl",1,
5 1975 <:z :>,z,"nl",1,
5 1976 <::>);
5 1977 raf:= 0;
5 1978 write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
5 1979 end;
4 1980 end skriv_frigiv_fil;
3 1981 \f
3 1981 message frigivfil side 1 - 810526/cl;
3 1982
3 1982
3 1982 stack_claim(if cm_test then 200 else 150);
3 1983 trap(frigivfil_trap);
3 1984
3 1984 <*+2*>
3 1985 <**> disable if testbit28 then
3 1986 <**> skriv_frigiv_fil(out,0);
3 1987 <*-2*>
3 1988
3 1988 trin1:
3 1989 waitch(cs_frigiv_fil,op,true,-1);
3 1990
3 1990 trin2:
3 1991 disable begin
4 1992
4 1992 <* find fil *>
4 1993 fref:= d.op.data(4);
4 1994 ftype:= fref shift (-10);
4 1995 fno:= fref extract 10;
4 1996 if ftype=0 or ftype>3 or fno=0 then
4 1997 begin status:= 1; goto returner; end;
4 1998 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 1999 begin status:= 1; goto returner; end;
4 2000 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2001 extract 9 = 0 then
4 2002 begin
5 2003 status:= 2; <* fil findes ikke *>
5 2004 goto returner;
5 2005 end;
4 2006 if ftype <> 3 then
4 2007 begin status:= 5; goto returner; end;
4 2008
4 2008 <* frigiv evt. tilknyttet zone og areaprocess *>
4 2009 z:= dbkate(fno,2) shift (-19);
4 2010 if z > 0 then
4 2011 begin
5 2012 if dbkatz(z,1)=fref then
5 2013 begin integer array zd(1:20);
6 2014 getzone6(fil(z),zd);
6 2015 if zd(13)>5 then filskrevet:= filskrevet +1;
6 2016 close(fil(z),true);
6 2017 dbkatz(z,1):= 0;
6 2018 end;
5 2019 end;
4 2020 \f
4 2020 message frigivfil side 2 - 810526/cl;
4 2021
4 2021 <* opdater tail *>
4 2022 enavn:= fno*12+4;
4 2023 open(zdummy,0,dbkate.enavn,0);
4 2024 s:= monitor(42)lookup entry:(zdummy,0,tail);
4 2025 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
4 2026 tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
4 2027 tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
4 2028 s:= monitor(44)change entry:(zdummy,0,tail);
4 2029 if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
4 2030 monitor(64)remove process:(zdummy,0,tail);
4 2031 close(zdummy,true);
4 2032
4 2032 <* frigiv indgang *>
4 2033 for i:= 1, 3 step 1 until 6 do
4 2034 dbkate(fno,1):= 0;
4 2035 dbkate(fno,2):= dbkatefri;
4 2036 dbkatefri:= fno;
4 2037 dbantef:= dbantef -1;
4 2038 signalbin(bs_kate_fri);
4 2039 d.op.data(4):= 0; <* filref null *>
4 2040 status:= 0;
4 2041
4 2041 returner:
4 2042 d.op.data(9):= status;
4 2043 <*+2*>
4 2044 <*tz*> if testbit24 and overvåget then <*zt*>
4 2045 <*tz*> begin <*zt*>
5 2046 <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*>
5 2047 <*tz*> pfdim(d.op.data); <*zt*>
5 2048 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2049 <*tz*> end; <*zt*>
4 2050 <*-2*>
4 2051
4 2051 signalch(d.op.retur,op,d.op.optype);
4 2052 end;
3 2053 goto trin1;
3 2054 frigiv_fil_trap:
3 2055 disable skriv_frigiv_fil(zbillede,1);
3 2056 end frigivfil;
2 2057 \f
2 2057 message sletfil side 0 - 810526/cl;
2 2058
2 2058 procedure sletfil;
2 2059 <* sletter en spool- eller ekstern fil *>
2 2060
2 2060 begin
3 2061 integer array field op;
3 2062 integer fref,fno,ftype,status;
3 2063
3 2063 procedure skriv_slet_fil(z,omfang);
3 2064 value omfang;
3 2065 zone z;
3 2066 integer omfang;
3 2067 begin
4 2068 write(z,"nl",1,<:+++ slet fil :>);
4 2069 if omfang > 0 then
4 2070 disable
4 2071 begin
5 2072 skriv_coru(z,abs curr_coruno);
5 2073 write(z,"nl",1,<<d>,
5 2074 <:op :>,op,"nl",1,
5 2075 <:fref :>,fref,"nl",1,
5 2076 <:fno :>,fno,"nl",1,
5 2077 <:ftype :>,ftype,"nl",1,
5 2078 <:status:>,status,"nl",1,
5 2079 <::>);
5 2080 end;
4 2081 end skriv_slet_fil;
3 2082 \f
3 2082 message sletfil side 1 - 810526/cl;
3 2083
3 2083 stack_claim(if cm_test then 200 else 150);
3 2084
3 2084 trap(sletfil_trap);
3 2085 <*+2*>
3 2086 <**> disable if testbit28 then
3 2087 <**> skriv_slet_fil(out,0);
3 2088 <*-2*>
3 2089
3 2089 trin1:
3 2090 waitch(cs_slet_fil,op,true,-1);
3 2091
3 2091 trin2:
3 2092 disable begin
4 2093
4 2093 <* find fil *>
4 2094 fref:= d.op.data(4);
4 2095 ftype:= fref shift (-10);
4 2096 fno:= fref extract 10;
4 2097 if ftype=0 or ftype>3 or fno=0 then
4 2098 begin status:= 1; goto returner; end;
4 2099 if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
4 2100 begin status:= 1; goto returner; end;
4 2101 if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
4 2102 extract 9 = 0 then
4 2103 begin
5 2104 status:= 2; <* fil findes ikke *>
5 2105 goto returner;
5 2106 end;
4 2107
4 2107
4 2107 <* slet spool- eller ekstern fil *>
4 2108 case ftype of
4 2109 begin
5 2110
5 2110 <* tabelfil - ingen aktion *>
5 2111 ;
5 2112 \f
5 2112 message sletfil side 2 - 810203/cl;
5 2113
5 2113 <* spoolfil *>
5 2114 begin
6 2115 integer z,bidno,bf,bidant,i;
6 2116
6 2116 <* hvis tilknyttet så frigiv *>
6 2117 z:= dbkats(fno,2) shift (-19);
6 2118 if z>0 then
6 2119 begin
7 2120 if dbkatz(z,1)=fref then
7 2121 begin integer array zd(1:20);
8 2122 dbkatz(z,1):= 2 shift 10;
8 2123 getzone6(fil(z),zd); <*annuler evt. udskrivning*>
8 2124 if zd(13)>5 then
8 2125 begin zd(13):= 0; setzone6(fil(z),zd); end;
8 2126 end;
7 2127 end;
6 2128
6 2128 <* frigiv bidder *>
6 2129 bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
6 2130 bidant:= dbkats(fno,2) shift (-12) extract 6;
6 2131 for i:= bidant -1 step -1 until 1 do
6 2132 bidno:= dbkatb(bidno) extract 12;
6 2133 dbkatb(bidno):= false add dbkatbfri;
6 2134 dbkatbfri:= bf;
6 2135 dbantb:= dbantb-bidant;
6 2136
6 2136 <* frigiv indgang *>
6 2137 dbkats(fno,1):= 0;
6 2138 dbkats(fno,2):= dbkatsfri;
6 2139 dbkatsfri:= fno;
6 2140 dbantsf:= dbantsf -1;
6 2141 signalbin(bs_kats_fri);
6 2142 end spoolfil;
5 2143 \f
5 2143 message sletfil side 3 - 810203/cl;
5 2144
5 2144 <* extern fil *>
5 2145 begin
6 2146 integer i,s,z;
6 2147 real array field enavn;
6 2148 integer array tail(1:10);
6 2149
6 2149 <* find head and tail *>
6 2150 enavn:= fno*12+4;
6 2151 open(zdummy,0,dbkate.enavn,0);
6 2152 s:= monitor(42)lookup entry:(zdummy,0,tail);
6 2153 if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
6 2154
6 2154 <*frigiv evt. tilknyttet zone og areaprocess*>
6 2155 z:=dbkate(fno,2) shift (-19);
6 2156 if z>0 then
6 2157 begin
7 2158 if dbkatz(z,1)=fref then
7 2159 begin integer array zd(1:20);
8 2160 getzone6(fil(z),zd);
8 2161 if zd(13)>5 then <* udskrivning *>
8 2162 begin <*annuler*>
9 2163 zd(13):= 0;
9 2164 setzone6(fil(z),zd);
9 2165 end;
8 2166 close(fil(z),true);
8 2167 dbkatz(z,1):= 0;
8 2168 end;
7 2169 end;
6 2170
6 2170 <* fjern entry *>
6 2171 s:= monitor(48)remove entry:(zdummy,0,tail);
6 2172 if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
6 2173 close(zdummy,true);
6 2174
6 2174 <* frigiv indgang *>
6 2175 for i:=1, 3 step 1 until 6 do
6 2176 dbkate(fno,i):= 0;
6 2177 dbkate(fno,2):= dbkatefri;
6 2178 dbkatefri:= fno;
6 2179 dbantef:= dbantef -1;
6 2180 signalbin(bs_kate_fri);
6 2181 end eksternfil;
5 2182
5 2182 end ftype;
4 2183 \f
4 2183 message sletfil side 4 - 810526/cl;
4 2184
4 2184
4 2184 status:= 0;
4 2185 if ftype > 1 then
4 2186 d.op.data(4):= 0; <*filref null*>
4 2187
4 2187 returner:
4 2188 d.op.data(9):= status;
4 2189
4 2189 <*+2*>
4 2190 <*tz*> if testbit24 and overvåget then <*zt*>
4 2191 <*tz*> begin <*zt*>
5 2192 <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*>
5 2193 <*tz*> pfdim(d.op.data); <*zt*>
5 2194 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2195 <*tz*> end; <*zt*>
4 2196 <*-2*>
4 2197
4 2197 signalch(d.op.retur,op,d.op.optype);
4 2198 end;
3 2199 goto trin1;
3 2200 sletfil_trap:
3 2201 disable skriv_slet_fil(zbillede,1);
3 2202 end sletfil;
2 2203 \f
2 2203 message opretspoolfil side 0 - 810526/cl;
2 2204
2 2204 procedure opretspoolfil;
2 2205 <* opretter en spoolfil og returnerer intern filid *>
2 2206
2 2206 begin
3 2207 integer array field op;
3 2208 integer bidantal,fno,i,bs,bidstart;
3 2209
3 2209 procedure skriv_opret_spoolfil(z,omfang);
3 2210 value omfang;
3 2211 zone z;
3 2212 integer omfang;
3 2213 begin
4 2214 write(z,"nl",1,<:+++ opret spoolfil :>);
4 2215 if omfang > 0 then
4 2216 disable
4 2217 begin
5 2218 skriv_coru(z,abs curr_coruno);
5 2219 write(z,"nl",1,<<d>,
5 2220 <:op :>,op,"nl",1,
5 2221 <:bidantal:>,bidantal,"nl",1,
5 2222 <:fno :>,fno,"nl",1,
5 2223 <:i :>,i,"nl",1,
5 2224 <:bs :>,bs,"nl",1,
5 2225 <:bidstart:>,bidstart,"nl",1,
5 2226 <::>);
5 2227 end;
4 2228 end skriv_opret_spoolfil;
3 2229 \f
3 2229 message opretspoolfil side 1 - 810526/cl;
3 2230
3 2230 stack_claim(if cm_test then 200 else 150);
3 2231
3 2231 signalbin(bs_kats_fri); <*initialiseres til åben*>
3 2232
3 2232 trap(opretspool_trap);
3 2233 <*+2*>
3 2234 <**> disable if testbit28 then
3 2235 <**> skriv_opret_spoolfil(out,0);
3 2236 <*-2*>
3 2237 trin1:
3 2238 waitch(cs_opret_spoolfil,op,true,-1);
3 2239
3 2239 trin2:
3 2240 bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
3 2241 wait(bs_kats_fri);
3 2242
3 2242 trin3:
3 2243 if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
3 2244 begin
4 2245 wait(bs_kats_fri);
4 2246 goto trin3;
4 2247 end;
3 2248 disable begin
4 2249
4 2249 <*alloker bidder*>
4 2250 bs:= bidstart:= dbkatbfri;
4 2251 for i:= bidantal-1 step -1 until 1 do
4 2252 bs:= dbkatb(bs) extract 12;
4 2253 dbkatbfri:= dbkatb(bs) extract 12;
4 2254 dbkatb(bs):= false; <*sidste ref null*>
4 2255 dbantb:= dbantb+bidantal;
4 2256
4 2256 <*alloker indgang*>
4 2257 fno:= dbkatsfri;
4 2258 dbkatsfri:= dbkats(fno,2);
4 2259 dbantsf:= dbantsf +1;
4 2260 dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
4 2261 d.op.data(2) extract 9; <*postlængde*>
4 2262 dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
4 2263 \f
4 2263 message opretspoolfil side 2 - 810526/cl;
4 2264
4 2264 <*returner*>
4 2265 d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
4 2266 d.op.data(4):= 2 shift 10 add fno; <*filref*>
4 2267 for i:= 5 step 1 until 8 do <*filnavn null*>
4 2268 d.op.data(i):= 0;
4 2269 d.op.data(9):= 0; <*status ok*>
4 2270
4 2270 <*+2*>
4 2271 <*tz*> if testbit24 and overvåget then <*zt*>
4 2272 <*tz*> begin <*zt*>
5 2273 <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*>
5 2274 <*tz*> pfdim(d.op.data); <*zt*>
5 2275 <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*>
5 2276 <*tz*> end; <*zt*>
4 2277 <*-2*>
4 2278
4 2278 signalch(d.op.retur,op,d.op.optype);
4 2279 if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
4 2280 end;
3 2281 goto trin1;
3 2282
3 2282 opretspool_trap:
3 2283 disable skriv_opret_spoolfil(zbillede,1);
3 2284
3 2284 end opretspoolfil;
2 2285 \f
2 2285 message opreteksternfil side 0 - 810526/cl;
2 2286
2 2286 procedure opreteksternfil;
2 2287 <* opretter og knytter en ekstern fil *>
2 2288
2 2288 begin
3 2289 integer array field op;
3 2290 integer status,s,i,fno,p_nøgle;
3 2291 integer array tail(1:10),zd(1:20);
3 2292 real r;
3 2293 real array field enavn;
3 2294
3 2294 procedure skriv_opret_ekstfil(z,omfang);
3 2295 value omfang;
3 2296 zone z;
3 2297 integer omfang;
3 2298 begin
4 2299 write(z,"nl",1,<:+++ opret ekstern fil :>);
4 2300 if omfang > 0 then
4 2301 disable
4 2302 begin real array field raf;
5 2303 skriv_coru(z,abs curr_coruno);
5 2304 write(z,"nl",1,<<d>,
5 2305 <:op :>,op,"nl",1,
5 2306 <:status :>,status,"nl",1,
5 2307 <:s :>,s,"nl",1,
5 2308 <:i :>,i,"nl",1,
5 2309 <:fno :>,fno,"nl",1,
5 2310 <:p-nøgle:>,p_nøgle,"nl",1,
5 2311 <::>);
5 2312 raf:= 0;
5 2313 write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
5 2314 write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
5 2315 end;
4 2316 end skriv_opret_ekstfil;
3 2317 \f
3 2317 message opreteksternfil side 1 - 810526/cl;
3 2318
3 2318 stack_claim(if cm_test then 200 else 150);
3 2319
3 2319 signalbin(bs_kate_fri); <*initialiseres til åben*>
3 2320
3 2320 trap(opretekst_trap);
3 2321 <*+2*>
3 2322 <**> disable if testbit28 then
3 2323 <**> skriv_opret_ekstfil(out,0);
3 2324 <*-2*>
3 2325 trin1:
3 2326 waitch(cs_opret_eksternfil,op,true,-1);
3 2327
3 2327 trin2:
3 2328 wait(bs_kate_fri);
3 2329
3 2329 trin3:
3 2330 <*opret temporær fil og tilknyt den*>
3 2331 disable begin
4 2332
4 2332 enavn:= 8;
4 2333 <*opret*>
4 2334 open(zdummy,0,d.op.data.enavn,0);
4 2335 tail(1):= d.op.data(3); <*segant*>
4 2336 tail(2):= 1;
4 2337 tail(6):= systime(7,0,r); <*shortclock*>
4 2338 tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
4 2339 tail(8):= 0;
4 2340 tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
4 2341 tail(10):= d.op.data(1); <*postantal*>
4 2342 s:= monitor(40)create entry:(zdummy,0,tail);
4 2343 if s<>0 then
4 2344 begin
5 2345 if s=4 <*claims exeeded*> then
5 2346 begin
6 2347 status:= 4;
6 2348 fejlreaktion(1,s,<:create entry:>,1);
6 2349 goto returner;
6 2350 end;
5 2351 if s=3 <*navn ikke unikt*> then
5 2352 begin status:= 6; goto returner; end;
5 2353 fejlreaktion(1,s,<:create entry:>,0);
5 2354 end;
4 2355 \f
4 2355 message opreteksternfil side 2 - 810203/cl;
4 2356
4 2356 p_nøgle:= d.op.opkode shift (-12);
4 2357 s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
4 2358 if s<>0 then
4 2359 begin
5 2360 if s=6 then
5 2361 begin <*claims exeeded*>
6 2362 status:= 4;
6 2363 fejlreaktion(1,s,<:permanent entry:>,1);
6 2364 monitor(48)remove entry:(zdummy,0,tail);
6 2365 goto returner;
6 2366 end
5 2367 else fejlreaktion(1,s,<:permanent entry:>,0);
5 2368 end;
4 2369
4 2369 <*reserver*>
4 2370 s:= monitor(52)create areaprocess:(zdummy,0,zd);
4 2371 if s<>0 then
4 2372 begin
5 2373 fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
5 2374 status:= 4;
5 2375 monitor(48)remove entry:(zdummy,0,zd);
5 2376 goto returner;
5 2377 end;
4 2378
4 2378 s:= monitor(8)reserve:(zdummy,0,zd);
4 2379 if s<>0 then fejlreaktion(1,s,<:reserve:>,0);
4 2380
4 2380 <*tilknyt*>
4 2381 dbantef:= dbantef +1;
4 2382 fno:= dbkatefri;
4 2383 dbkatefri:= dbkate(fno,2);
4 2384 dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
4 2385 dbkate(fno,2):= tail(1);
4 2386 getzone6(zdummy,zd);
4 2387 for i:= 2 step 1 until 5 do
4 2388 dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
4 2389 d.op.data(3):= tail(1);
4 2390 d.op.data(4):= 3 shift 10 +fno;
4 2391 status:= 0;
4 2392 \f
4 2392 message opreteksternfil side 3 - 810526/cl;
4 2393
4 2393 returner:
4 2394
4 2394 close(zdummy,false);
4 2395 d.op.data(9):= status;
4 2396
4 2396 <*+2*>
4 2397 <*tz*> if testbit24 and overvåget then <*zt*>
4 2398 <*tz*> begin <*zt*>
5 2399 <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*>
5 2400 <*tz*> pfdim(d.op.data); <*zt*>
5 2401 <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*>
5 2402 <*tz*> end; <*zt*>
4 2403 <*-2*>
4 2404
4 2404 signalch(d.op.retur,op,d.op.optype);
4 2405 if dbantef<dbmaxef then signalbin(bs_kate_fri);
4 2406 end;
3 2407 goto trin1;
3 2408
3 2408 opretekst_trap:
3 2409 disable skriv_opret_ekstfil(zbillede,1);
3 2410
3 2410 end opreteksternfil;
2 2411
2 2411 \f
2 2411 message attention_erklæringer side 1 - 850820/cl;
2 2412
2 2412 integer
2 2413 tf_kommandotabel,
2 2414 cs_att_pulje,
2 2415 bs_fortsæt_adgang,
2 2416 att_proc_ref;
2 2417
2 2417 integer array
2 2418 att_flag,
2 2419 att_signal(1:att_maske_lgd//2);
2 2420
2 2420 integer array
2 2421 terminal_tab(1:terminal_beskr_længde//2*(1<*io*>+
2 2422 max_antal_operatører+max_antal_garageterminaler)),
2 2423 fortsæt(1:32);
2 2424 \f
2 2424 message procedure afslut_kommando side 1 - 810507/hko;
2 2425
2 2425 procedure afslut_kommando(op_ref);
2 2426 integer array field op_ref;
2 2427 begin integer nr,i,sem;
3 2428 i:= d.op_ref.kilde;
3 2429 nr:= if i=299 then max_antal_operatører+max_antal_garageterminaler+1
3 2430 else case i//100 of (0,i mod 100,max_antal_operatører+(i mod 100));
3 2431 sætbit_ia(att_flag,nr,0);
3 2432 d.op_ref.optype:=gen_optype;
3 2433 <* "husket" attention disabled ****************
3 2434 if sætbit_ia(att_signal,nr,0)=1 then
3 2435 begin
3 2436 sem:=if i=299 then cs_talevejsswitch else
3 2437 case i//100 of (cs_io_komm,cs_operatør(i mod 100),
3 2438 cs_garage(i mod 100));
3 2439 afslut_operation(op_ref,0);
3 2440 start_operation(op_ref,i,cs_att_pulje,0);
3 2441 signal_ch(sem,op_ref,gen_optype);
3 2442 end
3 2443 else
3 2444 ********************* disable "husket" attention *>
3 2445 afslut_operation(op_ref,cs_att_pulje);
3 2446 end;
2 2447 \f
2 2447 message procedure læs_store side 1 - 880919/cl;
2 2448
2 2448 integer procedure læs_store(z,c);
2 2449 zone z;
2 2450 integer c;
2 2451 begin
3 2452 læs_store:= readchar(z,c);
3 2453 if 'a' <= c and c <= 'å' then c:= c - 'a' + 'A';
3 2454 end;
2 2455 \f
2 2455 message procedure param side 1 - 810226/cl;
2 2456
2 2456
2 2456
2 2456 integer procedure param(txt,pos,spec,tabel_id,type,værdi,sep);
2 2457 value tabel_id;
2 2458 integer pos, tabel_id, type, sep;
2 2459 integer array txt, spec, værdi;
2 2460
2 2460
2 2460
2 2460 <*************************************>
2 2461 <* *>
2 2462 <* CLAUS LARSEN: 15.07.77 *>
2 2463 <* *>
2 2464 <*************************************>
2 2465
2 2465
2 2465
2 2465
2 2465 <* param syntax-analyserer en parameterliste, og *>
2 2466 <* bestemmer næste parameter og den separator der *>
2 2467 <* afslutter parameteren *>
2 2468
2 2468
2 2468
2 2468 begin
3 2469 integer array klasse(0:127), aktuel_param(1:4), fdim(1:8);
3 2470 real array indgang(1:2);
3 2471 integer i, j, tegn, tegn_pos, tal, hashnøgle,
3 2472 zone_nr, top, max_segm, start_segm, lpos;
3 2473 boolean minus, separator;
3 2474 lpos := pos;
3 2475 type:=-1;
3 2476 for i:=1 step 1 until 4 do værdi(i):=0;
3 2477 \f
3 2477 message procedure param side 2 - 810428/cl,hko;
3 2478
3 2478
3 2478
3 2478 <* grænsecheck for pos *>
3 2479 begin
4 2480 integer nedre, øvre;
4 2481
4 2481 nedre := system(3,øvre,txt);
4 2482 nedre := nedre * 3 - 2;
4 2483 øvre := øvre * 3;
4 2484 if lpos < (nedre - 1) or øvre < lpos then
4 2485 begin
5 2486 sep:= -1;
5 2487 param:= 5;
5 2488 goto slut;
5 2489 end;
4 2490
4 2490 <* er parameterlisten slut *>
4 2491 lpos:= lpos+1;
4 2492 læs_tegn(txt,lpos,tegn);
4 2493 if tegn = 'em' or tegn = 'nl' or tegn = 'nul' then
4 2494 begin
5 2495 lpos := lpos - 2;
5 2496 sep := tegn;
5 2497 param := 5;
5 2498
5 2498 goto slut;
5 2499 end else lpos:= lpos-1;
4 2500 end;
3 2501 \f
3 2501 message procedure param side 3 - 810428/cl;
3 2502
3 2502
3 2502 <* initialisering *>
3 2503 for i := 1 step 1 until 4 do
3 2504 aktuel_param(i) := 0;
3 2505 minus := separator := false;
3 2506
3 2506 <* initialiser klassetabel *>
3 2507 for i := 65 step 1 until 93,
3 2508 97 step 1 until 125 do klasse(i) := 1;
3 2509 for i := 48 step 1 until 57 do klasse(i) := 2;
3 2510 for i := 0 step 1 until 47, 58 step 1 until 64,
3 2511 94, 95, 96, 126, 127 do klasse(i) := 4;
3 2512
3 2512
3 2512 <* sæt specialtegn *>
3 2513 i := 1;
3 2514 læs_tegn(spec,i,tegn);
3 2515 while tegn <> 0 do
3 2516 begin
4 2517 if klasse(tegn) = 4 and tegn <> 'sp' and tegn <> 'nl' then
4 2518 klasse(tegn) := 3;
4 2519 læs_tegn(spec,i,tegn);
4 2520 end;
3 2521 \f
3 2521 message procedure param side 4 - 810226/cl;
3 2522
3 2522
3 2522 <* læs første tegn i ny parameter og bestem typen *>
3 2523 læs_tegn(txt,lpos,tegn);
3 2524
3 2524 case klasse(tegn) of
3 2525 begin
4 2526
4 2526 <* case 1 - bogstav *>
4 2527 begin
5 2528 type := 0;
5 2529 param := 0;
5 2530 tegn_pos := 1;
5 2531 hashnøgle := 0;
5 2532
5 2532 <* læs parameter *>
5 2533 while tegn_pos < 12 and klasse(tegn) <> 4 do
5 2534 begin
6 2535 hashnøgle := hashnøgle + tegn;
6 2536 skriv_tegn(aktuel_param,tegn_pos,tegn);
6 2537 læs_tegn(txt,lpos,tegn);
6 2538 end;
5 2539
5 2539 <* find separator *>
5 2540 while klasse(tegn) <> 4 do læs_tegn(txt,lpos,tegn);
5 2541 sep := tegn;
5 2542 \f
5 2542 message procedure param side 5 - 810226/cl;
5 2543
5 2543 <* tabelopslag *>
5 2544 if tabel_id <> 0 then
5 2545 begin
6 2546 <* hent max_segm *>
6 2547
6 2547 fdim(4) := tabel_id;
6 2548 j := hent_fil_dim(fdim);
6 2549 if j > 0 then
6 2550 begin
7 2551 param := 4;
7 2552 for i := 1 step 1 until 4 do
7 2553 værdi(i) := aktuel_param(i);
7 2554 goto slut;
7 2555 end;
6 2556 max_segm := fdim(3);
6 2557
6 2557 <* forbered opslag *>
6 2558 start_segm := (hashnøgle mod max_segm) + 1;
6 2559 indgang(1) := 0.0 shift 48 add aktuel_param(1)
6 2560 shift 24 add aktuel_param(2);
6 2561 indgang(2) := 0.0 shift 48 add aktuel_param(3)
6 2562 shift 24 add aktuel_param(4);
6 2563 hashnøgle := start_segm;
6 2564 \f
6 2564 message procedure param side 6 - 810226/cl;
6 2565
6 2565 <* søg navn *>
6 2566 repeat
6 2567 <* læs segment *>
6 2568 læs_fil(tabel_id,hashnøgle,zone_nr);
6 2569
6 2569 <* beregn sidste element *>
6 2570 top := fil(zone_nr,1) extract 24;
6 2571 top := (top - 1) * 4 + 2;
6 2572
6 2572 <* søg *>
6 2573 for i := 2 step 4 until top do
6 2574 if fil(zone_nr,i) = indgang(1) and
6 2575 fil(zone_nr,i+1) = indgang(2) then
6 2576 begin
7 2577 <* fundet *>
7 2578 værdi(1) := fil(zone_nr,i+2) shift (-24)
7 2579 extract 24;
7 2580 værdi(2) := fil(zone_nr,i+2) extract 24;
7 2581 værdi(3) := fil(zone_nr,i+3) shift (-24)
7 2582 extract 24;
7 2583 værdi(4) := fil(zone_nr,i+3) extract 24;
7 2584 goto fundet;
7 2585 end;
6 2586
6 2586 if top = 122 then <*overløb *>
6 2587 hashnøgle := (hashnøgle mod max_segm) + 1;
6 2588 until top < 122 or hashnøgle = start_segm;
6 2589
6 2589 <* navn findes ikke *>
6 2590 param := 2;
6 2591 for j := 1 step 1 until 4 do
6 2592 værdi(j) := aktuel_param(j);
6 2593 fundet: ;
6 2594 end <*tabel_id <> 0 *>
5 2595 else
5 2596 for i := 1 step 1 until 4 do
5 2597 værdi(i) := aktuel_param(i);
5 2598 end <* case 1 *>;
4 2599 \f
4 2599 message procedure param side 7 - 810310/cl,hko;
4 2600
4 2600 <* case 2 - ciffer *>
4 2601 cif: begin
5 2602 type:=tal := 0;
5 2603 while klasse(tegn) = 2 do
5 2604 begin
6 2605 type:=type+1;
6 2606 tal := tal * 10 + (tegn - 48);
6 2607 læs_tegn(txt,lpos,tegn);
6 2608 end;
5 2609 if minus then tal := -tal;
5 2610 værdi(1) := tal;
5 2611 sep := tegn;
5 2612 param := 0;
5 2613 end <* case 2 *>;
4 2614 \f
4 2614 message procedure param side 8 - 810428/cl;
4 2615
4 2615 <* case 3 - specialtegn *>
4 2616 spc: begin
5 2617 if tegn = '-' then
5 2618 begin
6 2619 læs_tegn(txt,lpos,tegn);
6 2620 if klasse(tegn) = 2 then
6 2621 begin
7 2622 minus := true;
7 2623 goto cif;
7 2624 end
6 2625 else
6 2626 begin
7 2627 tegn := '-';
7 2628 lpos := lpos - 1;
7 2629 end;
6 2630 end;
5 2631 <* syntaxfejl *>
5 2632 param := if separator then 1 else 3;
5 2633 sep := tegn;
5 2634 end <* case 3 *>;
4 2635
4 2635 <* case 4 - separator *>
4 2636 begin
5 2637 separator := true;
5 2638 goto spc;
5 2639 end <* case 4 *>;
4 2640
4 2640 end <* case *>;
3 2641
3 2641 lpos := lpos - 1;
3 2642 slut:
3 2643 pos := lpos;
3 2644 end;
2 2645 \f
2 2645 message procedure læs_param_sæt side 1 - 830310/cl;
2 2646
2 2646 integer procedure læs_param_sæt(tekst,pos,ant,parm,term,res);
2 2647 integer array tekst, parm;
2 2648 integer pos,ant, term,res;
2 2649
2 2649 <* proceduren læser et sammenhørende sæt parametre
2 2650 afsluttet med (sp),(nl),(;),(,) eller (nul)
2 2651
2 2651 læs_param_sæt returstatus eller 'typen' af det læste parametersæt
2 2652 (retur,int)
2 2653 type ant parm indeholder:
2 2654 <0: x (ingenting) 'læs_param_sæt= nr på fejlkvit.'
2 2655 0: 0 (ingenting) 'rest kommando er tom'
2 2656 1: 1 (tekst) 'indtil 11 tegn'
2 2657 2: 1 (pos.tal)
2 2658 3: 1 (neg.tal)
2 2659 4: 1 (pos.tal<1000)(bogstav) 'linienummer'
2 2660 5: 1 G(pos.tal<100) 'gruppe_ident'
2 2661 6: 2 (linie)/(løb) 'vogn_ident'
2 2662 7: 3 (bus)/(linie)/(løb)
2 2663 8: 3 (linie).(indeks):(løb)
2 2664 9: 2 (linie).(indeks)
2 2665 10: 2 (pos.tal).(pos.tal)
2 2666 11: 2-3 G(pos.tal<100):(vogn) '(vogn)::=(bus)!(linie)/(løb)'
2 2667 12: 3 D.(dato).(tid)
2 2668
2 2668 tekst indeholder teksten hvori parametersættet
2 2669 (kald,int.arr.) skal søges.
2 2670
2 2670 pos
2 2671 (kald/retur,int.) position efter hvilken søgningen starter, og
2 2672 ved retur positionen for afsluttende tegn.
2 2673 (ikke ændret ved fejl)
2 2674
2 2674 ant hvis kaldeværdien er >0 skal parametersættet
2 2675 (kald/retur,int) indeholde det angivne antal enkeltparametre,
2 2676 i modsat fald returneres med fejltype -26
2 2677 (skilletegn) eller -25 (parameter mangler).
2 2678 ellers læses op til 3 enkeltparametre. retur-
2 2679 værdien afhænger af det læste parametersæts
2 2680 type, se ovenfor under læs_param_sæt.
2 2681 \f
2 2681 message procedure læs_param_sæt side 2 - 810428/hko;
2 2682
2 2682 parm skal omfatte elementerne 1 til 4.
2 2683 (retur,int.arr.) ved returstatus<=0 indeholder alle elemen-
2 2684 terne værdien 0.
2 2685
2 2685 type (element,indhold)
2 2686 1: 1-4,teksten
2 2687 2-3: 1, talværdien
2 2688 4: 1, tal shift 5 +tegnværdi (A=1,B=2,--,Å=29)
2 2689 5: 1, talværdi (uden G)
2 2690 6: 1, (som'4') shift 7 + løb
2 2691 7: 1, bus
2 2692 2, linie/løb som '6'
2 2693 8: 1, tal shift 5 eller som '4'
2 2694 2, tekst (1-3 bogstaver)
2 2695 3, løb
2 2696 9: 1 og 2, som '8'
2 2697 10: 1, talværdi
2 2698 2, talværdi
2 2699 11: 1, som '5'
2 2700 2, vogn (bus eller linie/løb)
2 2701 12: 1, dato
2 2702 2, tid
2 2703
2 2703 term iso-tegnværdien for tegnet der afslutter
2 2704 (retur,int) parameter_sættet.
2 2705
2 2705 res som læs_param_sæt.
2 2706 (retur,int)
2 2707
2 2707 *>
2 2708 \f
2 2708 message procedure læs_param_sæt side 3 - 810310/hko;
2 2709
2 2709 begin
3 2710 integer max_ant;
3 2711
3 2711 max_ant:= 3;
3 2712
3 2712 begin
4 2713 integer
4 2714 i,j,k, <* hjælpe variable *>
4 2715 nr, <* nummer på parameter i sættet *>
4 2716 apos, <* aktuel tegnposition *>
4 2717 cifre, <* parametertype (param: 0=tekst, >1=tal) *>
4 2718 sep; <* afsluttende skilletegn ved param *>
4 2719
4 2719 integer array field
4 2720 iaf; <* hjælpe variabel *>
4 2721
4 2721 integer array
4 2722 par(1:4*max_ant), <* 4 elementer for hver aktuel parameter *>
4 2723 s, <* 1 element med separator for hver parameter *>
4 2724 t(1:max_ant), <* 1 element med typen for hver parameter *>
4 2725 værdi(1:4), <* værdi af aktuel parameter jvf. param *>
4 2726 spec(1:1); <* specialtegn i navne jvf. param *>
4 2727
4 2727 <* de interne typer af enkeltparametre er
4 2728
4 2728 type parameter
4 2729
4 2729 1: 1-3 tegn tekst (1 ord)
4 2730 2: 4-6 tegn (2 ord)
4 2731 3: 7-9 tegn (3 ord)
4 2732 4:10-11 tegn (4 ord)
4 2733 5: positivt heltal
4 2734 6: negativt heltal
4 2735 7: positivt heltal<1000 efterfulgt af stort bogstav
4 2736 8: G efterfulgt af positivt heltal<100
4 2737
4 2737 *>
4 2738 \f
4 2738 message procedure læs_param_sæt side 4 - 810408/hko;
4 2739
4 2739 nr:= 0;
4 2740 res:= -1;
4 2741 spec(1):= 0; <* ingen specialtegn *>
4 2742 apos:= pos;
4 2743 for i:= 1 step 1 until 4 do parm(i):= 0;
4 2744 for i:= 1 step 1 until max_ant do
4 2745 begin
5 2746 s(i):= t(i):= 0;
5 2747 for j:= 1 step 1 until 4 do par((i-1)*4+j):= 0;
5 2748 end;
4 2749 repeat
4 2750 <* skip foranstillede sp-tegn *>
4 2751 for i:= param(tekst,apos,spec,0<*intet tabelopslag*>,cifre,værdi,sep)
4 2752 while i=1 and sep='sp' do;
4 2753 <*+2*>
4 2754 begin
5 2755 if testbit25 and testbit26 then
5 2756 disable begin
6 2757 write(out,"nl",1,<:param (apos,cifre,sep):>,<< -dddd>,
6 2758 i,apos,cifre,sep);
6 2759 laf:=0;
6 2760 if cifre<>0 then
6 2761 write(out,<: værdi(1-4)::>,
6 2762 << -dddd>,værdi(1),værdi(2),værdi(3),værdi(4))
6 2763 else write(out,<: værdi::>,værdi.laf);
6 2764 ud;
6 2765 end;
5 2766 end;
4 2767 <*-2*>
4 2768 ;
4 2769 if i<>0 then <* ikke ok *>
4 2770 begin
5 2771 if i=1 and (sep=',' or sep=';') then <* slut_tegn*>
5 2772 begin
6 2773 apos:= apos -1;
6 2774 res:= 0;
6 2775 end
5 2776 else if i=1 then res:=-26 <* skilletegn *>
5 2777 else <* i=5 *> res:= -25 <* parameter mangler *>
5 2778 end
4 2779 else <* i=0 *>
4 2780 begin
5 2781 if sep=',' or sep=';' then apos:=apos-1;
5 2782 iaf:= nr*8;
5 2783 nr:= nr +1;
5 2784 \f
5 2784 message procedure læs_param_sæt side 5 - 810520/hko/cl;
5 2785
5 2785 if cifre=0 <* navne_parameter *> then
5 2786 begin
6 2787 if værdi(2)=0
6 2788 and læstegn(værdi,1,i)='G'
6 2789 and læstegn(værdi,2,j)>'0' and j<='9'
6 2790 and (læstegn(værdi,3,k)=0 or (k>='0' and k<='9'))
6 2791 then
6 2792 begin <* gruppenavn, repræsenteres som tal *>
7 2793 t(nr):= 8;
7 2794 j:= j -'0';
7 2795 par.iaf(1):= if k=0 then j else (j*10+(k-'0'));
7 2796 s(nr):= sep;
7 2797 end
6 2798 else
6 2799 begin <* generel tekst *>
7 2800 i:= 0;
7 2801 for i:= i +1 while i<=4 do
7 2802 begin
8 2803 if værdi(i)<>0 then
8 2804 begin
9 2805 t(nr):= i;
9 2806 par.iaf(i):= værdi(i);
9 2807 end
8 2808 else i:= 4;
8 2809 end;
7 2810 s(nr):= sep;
7 2811 end <* generel tekst *>
6 2812 end <* navne_parameter *>
5 2813 else
5 2814 begin <* talparameter *>
6 2815 i:= if værdi(1)<0 then 6 <* neg.tal *>
6 2816 else if værdi(1)>0 and værdi(1)<1000
6 2817 and sep>='A' and sep<='Å' then 7
6 2818 else 5 <* positivt tal *>;
6 2819 t(nr):= i;
6 2820 par.iaf(1):= if i<>7 then værdi(1)
6 2821 else værdi(1) shift 5 +(sep+1-'A');
6 2822 par.iaf(2):= cifre;
6 2823 apos:= apos+1;
6 2824 s(nr):= if i=7 then læstegn(tekst,apos,sep) else sep;
6 2825 apos:= apos-1;
6 2826 end;
5 2827 end;<* i=0 *>
4 2828 until (ant>0 and nr=ant)
4 2829 or nr=max_ant
4 2830 or res<> -1
4 2831 or sep='sp' or sep=';' or sep='em'
4 2832 or sep=',' or sep='nl' or sep='nul';
4 2833 \f
4 2833 message procedure læs_param_sæt side 6 - 810508/hko;
4 2834
4 2834 if ant>nr then res:= -25 <*parameter mangler*>
4 2835 else
4 2836 if nr=0 or t(1)=0 then
4 2837 begin <* ingen parameter før skilletegn *>
5 2838 if res=-25 then res:= 0;
5 2839 end
4 2840 else if sep<>'sp' and sep<>'nl' and sep <> 'em'
4 2841 and sep<>';' and sep<>',' then
4 2842 begin <* ulovligt afsluttende skilletegn *>
5 2843 res:= -26;
5 2844 end
4 2845 else
4 2846 begin <* en eller flere lovligt afsluttede parametre *>
5 2847 if t(1)<5 and nr=1 then
5 2848
5 2848 <* 1 navne_parameter *>
5 2849
5 2849 begin
6 2850 res:= 1;
6 2851 tofrom(parm,par,8);
6 2852 end
5 2853 else if <*t(1)<9 and *> nr=1 then
5 2854
5 2854 <* 1 parameter af anden type *>
5 2855
5 2855 begin <*tal,linie eller gruppe *>
6 2856 res:= t(1) -3;
6 2857 parm(1):= par(1);
6 2858 end
5 2859 else if t(1)=5 <* pos.tal *> or t(1)=7 <*linie*> then
5 2860
5 2860 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
5 2861
5 2861 begin
6 2862 i:= par(1); <* lovlige parametre er alle repræsenteret i et ord *>
6 2863 j:= par(5); <* internt *>
6 2864 k:= par(9); <* *>
6 2865 if nr=2 then
6 2866 <* 2 parametre i sættet *>
6 2867 begin
7 2868 res:= if (s(1)='/' or s(1)='.') and t(2)=5 <*pos.tal*> then 6
7 2869 else if s(1)='.' and t(2)=1 then 9
7 2870 else if s(1)='-' and t(1)=5 and t(2)=5 then 10
7 2871 else if s(1)<>'/' and s(1)<>'.'
7 2872 and s(1)<>'-' then -26 <* skilletegn *>
7 2873 else -27;<* parametertype*>
7 2874 \f
7 2874 message procedure læs_param_sæt side 7 - 810501/hko;
7 2875
7 2875 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2876
7 2876 <* 2 parametre i sættet *>
7 2877 if res=6 then
7 2878 begin
8 2879 if (i<1 or i>999) and t(1)=5 then
8 2880 res:= -5 <* ulovligt linienr *>
8 2881 else if (j<1 or j>99) then
8 2882 res:= -6 <* ulovligt løbsnr *>
8 2883 else
8 2884 begin
9 2885 if t(1)=5 then i:= i shift 5;
9 2886 parm(1):= i shift 7 +j;
9 2887 end;
8 2888 end <* res=6 *>
7 2889 else if res=9 then
7 2890 begin
8 2891 if t(1)=5 and (i<1 or 999<i) then
8 2892 res:= -5 <*ulovligt linienr*>
8 2893 else
8 2894 begin
9 2895 if t(1)=5 then i:=i shift 5;
9 2896 parm(1):= i;
9 2897 parm(2):= j;
9 2898 end;
8 2899 end <* res=9 *>
7 2900 else if res=10 then
7 2901 begin
8 2902 begin
9 2903 parm(1):= i;
9 2904 parm(2):= j;
9 2905 end;
8 2906 end; <* res=10 *>
7 2907 end <* nr=2 *>
6 2908 else
6 2909 if nr=3 then
6 2910 <* 3 paramtre i sættet *>
6 2911 begin
7 2912 res:= if (s(1)='/' or s(1)='.') and
7 2913 (s(2)='/' or s(2)='.') then 7
7 2914 else if s(1)='.' and s(2)=':' then 8
7 2915 else -26; <* skilletegn *>
7 2916 \f
7 2916 message procedure læs_param_sæt side 8 - 810501/hko;
7 2917
7 2917 <* mere end 1 parameter, hvoraf 1. er pos.tal eller linienr *>
7 2918 <* 3 parametre i sættet *>
7 2919 if res=7 then
7 2920 begin
8 2921 if t(1)<>5 or (t(2)<>5 and t(2)<>7)
8 2922 or t(3)<>5 then
8 2923 res:= -27 <* parametertype *>
8 2924 else
8 2925 if i<1 or i>9999 then res:= -7 <* ulovligt busnr *>
8 2926 else if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
8 2927 else if k<1 or k>99 then res:= -6 <* løb *>
8 2928 else
8 2929 begin <* ok *>
9 2930 parm(1):= i;
9 2931 if t(2)=5 then j:= j shift 5;
9 2932 parm(2):= j shift 7 +k;
9 2933 end;
8 2934 end
7 2935 else if res=8 then
7 2936 begin
8 2937 if t(2)<>1 or t(3)<>5 then res:= -27
8 2938 else if t(1)=5 and (i<1 or i>999) then res:= -5
8 2939 else if k<1 or k>99 then res:= -6
8 2940 else
8 2941 begin
9 2942 if t(1)=5 then i:= i shift 5;
9 2943 parm(1):= i;
9 2944 parm(2):= j;
9 2945 parm(3):= k;
9 2946 end;
8 2947 end;
7 2948 end <* nr=3 *>
6 2949 else res:=-24; <* syntaks *>
6 2950 \f
6 2950 message procedure læs_param_sæt side 9 - 810428/hko;
6 2951
6 2951 end <* mere end 1 parameter,hvoraf 1. er pos.tal eller linienr *>
5 2952 else if t(1)=8 <* gruppe_id *> then
5 2953 begin
6 2954 <* mere end 1 parameter , hvoraf den første
6 2955 er en gruppe_identifikation ved navn.
6 2956 lovlige parametre er alle internt repræsenteret i et ord *>
6 2957
6 2957 i:=par(1);
6 2958 j:=par(5);
6 2959 k:=par(9);
6 2960
6 2960 if nr=2 then
6 2961 <* 2 parametre *>
6 2962 begin
7 2963 res:=if s(1)=':' and t(2)=5 then 11
7 2964 else if s(1)<>':' then -26 <* skilletegn *>
7 2965 else -27; <*param.type *>
7 2966 if res=11 then
7 2967 begin
8 2968 if j<1 or j>9999 then res:=-7 <* ulovligt busnr *>
8 2969 else
8 2970 begin
9 2971 parm(1):=i;
9 2972 parm(2):=j;
9 2973 end;
8 2974 end;
7 2975 \f
7 2975 message procedure læs_param_sæt side 10 - 810428/hko;
7 2976
7 2976 <* mere end 1 parameter, hvoraf 1. er en gruppeidentifikation ved navn *>
7 2977
7 2977 end <*nr=2*>
6 2978 else if nr=3 then
6 2979 <* 3 parametre *>
6 2980 begin
7 2981 res:=if s(1)=':' and s(2)='/' then 11
7 2982 else -26; <* skilletegn *>
7 2983 if res=11 then
7 2984 begin
8 2985 if (t(2)<>5 and t(2)<>7) or t(3)<>5 then res:=-27 <*param.type*>
8 2986 else
8 2987 begin
9 2988 if t(2)=5 and (j<1 or j>999) then res:=-5 <* linie *>
9 2989 else
9 2990 begin
10 2991 parm(1):=i;
10 2992 if t(2)=5 then j:=j shift 5;
10 2993 parm(2):= 1 shift 22 +j shift 7 +k;
10 2994 end;
9 2995 end;
8 2996 end;
7 2997 end <* nr=3 *>
6 2998 else res:=-24; <* syntaks *>
6 2999 \f
6 2999 message procedure læs_param_sæt side 11 - 810501/hko;
6 3000
6 3000 end <* t(1)=8 *>
5 3001 else if t(1)=1 and par(1)= 'D' shift 16 then
5 3002 begin
6 3003 <* mere end 1 parameter i sættet og 1. parameter er et 'D'.
6 3004 lovlige parametre er alle internt repræsenteret i et ord. *>
6 3005 i:=par(1);
6 3006 j:=par(5);
6 3007 k:=par(9);
6 3008
6 3008 if nr=3 then
6 3009 begin
7 3010 res:=if s(1)='.' and s(2)='.' then 12
7 3011 else -26; <* skilletegn *>
7 3012 if res=12 then
7 3013 begin
8 3014 if t(2)<>5 or t(3)<>5 then res:=-27 <* param. type *>
8 3015 else
8 3016 begin
9 3017 integer år,md,dg,tt,mm,ss;
9 3018 real dato,tid;
9 3019 år:=j//10000;
9 3020 md:=(j//100) mod 100;
9 3021 dg:=j mod 100;
9 3022 cifre:= par(10);
9 3023 tt:=if cifre>4 then k//10000 else if cifre>2 then k//100
9 3024 else k;
9 3025 mm:=if cifre>4 then (k//100) mod 100
9 3026 else if cifre>2 then k mod 100 else 0;
9 3027 ss:=if cifre>4 then k mod 100 else 0;
9 3028 \f
9 3028 message procedure læs_param_sæt side 12 - 810501/hko;
9 3029
9 3029 dato:=systime(5,0.0,tid);
9 3030 if j=0 then dg:=round dato mod 100;
9 3031 if år=0 and md=0 then md:=(round dato//100) mod 100;
9 3032 if år=0 then år:=round dato//10000;
9 3033 if år>99 or md<1 or md>12 or tt>23 or mm>59 or ss>59 then
9 3034 res:=-24 <* syntaks *>
9 3035 else if dg<1 or dg > (case md of (
9 3036 31,(if år mod 4=0 then 29 else 28),31, 30,31,30,
9 3037 31,31,30, 31,30,31)) then res:=-24
9 3038 else
9 3039 begin
10 3040 parm(1):=år*10000+md*100+dg;
10 3041 parm(2):=tt*10000+mm*100+ss;
10 3042 end;
9 3043 end;
8 3044
8 3044 end; <* res=12 *>
7 3045 end <* nr=3 *>
6 3046 else res:=-24; <*syntaks*>
6 3047 end <* t(1)=1 and par(1)='D' shift 16 *>
5 3048
5 3048 else res:=-27;<*parametertype*>
5 3049 end; <* en eller flere parametre *>
4 3050
4 3050 læs_param_sæt:= res;
4 3051 term:= sep;
4 3052 if res>= 0 then pos:= apos;
4 3053 end;
3 3054 end læs_param_sæt;
2 3055 \f
2 3055 message procedure læs_kommando side 1 - 810428/hko;
2 3056
2 3056 integer procedure læs_kommando(z,kilde,op_ref,pos,indeks,sep,slut_tegn);
2 3057 value kilde;
2 3058 zone z;
2 3059 integer kilde, pos,indeks,sep,slut_tegn;
2 3060 integer array field op_ref;
2 3061
2 3061 <* proceduren indlæser er kommmando fra en terminal (telex,
2 3062 skærm eller skrivemaskine). ved indlæsning fra skærm eller
2 3063 skrivemaskine inviteres først ved udskrivning af '>'-tegn.
2 3064 for terminalers vedkommendeslettes linie 23 og 24 og 'cursor' positioneres til
2 3065 23'ende linie inden invitation.
2 3066 *>
2 3067 \f
2 3067 message procedure læs_kommando side 2 - 810428/hko;
2 3068
2 3068 begin
3 3069 integer
3 3070 a_pos,
3 3071 a_res,res,
3 3072 i,j,k;
3 3073 boolean
3 3074 skip;
3 3075
3 3075 <*V*>setposition(z,0,0);
3 3076
3 3076 case kilde//100 of
3 3077 begin
4 3078 begin <* io *>
5 3079 write(z,"nl",1,">",1);
5 3080 end;
4 3081
4 3081 begin <* operatør *>
5 3082 cursor(z,24,1);
5 3083 write(z,"esc" add 128,1,<:ÆK:>);
5 3084 cursor(z,23,1);
5 3085 write(z,"esc" add 128,1,<:ÆK:>);
5 3086 outchar(z,'>');
5 3087 end;
4 3088
4 3088 begin <* garageterminal *> ;
5 3089 outchar(z,'nl');
5 3090 end
4 3091 end;
3 3092
3 3092 <*V*>setposition(z,0,0);
3 3093 \f
3 3093 message procedure læs_kommando side 3 - 810921/hko,cl;
3 3094
3 3094 res:=0;
3 3095 skip:= false;
3 3096 <*V*>
3 3097 k:=læs_store(z,i);
3 3098
3 3098 apos:= 1;
3 3099 while k<=6 <*klasse=bogstav*> do
3 3100 begin
4 3101 if a_pos<3 then skriv_tegn(d.op_ref.data,apos,i);
4 3102 <*V*> k:= læs_store(z,i);
4 3103 end;
3 3104
3 3104 skip:= skip or i='?' or (a_pos=1 and (i=',' or i=';'));
3 3105
3 3105 if i=',' and a_pos>1 then
3 3106 begin
4 3107 skrivtegn(d.op_ref.data,a_pos,i);
4 3108 repeat
4 3109 <*V*> k:= læs_store(z,i);
4 3110 if a_pos=4 and k=6 then skriv_tegn(d.op_ref.data,a_pos,i);
4 3111 until k>=7;
4 3112 end;
3 3113
3 3113 pos:=a_pos;
3 3114 while k<8 do
3 3115 begin
4 3116 if a_pos< (att_op_længde//2*3-2) then
4 3117 skriv_tegn(d.op_ref.data,a_pos,i);
4 3118 skip:= skip or i='?';
4 3119 <*V*> k:= læs_store(z,i);
4 3120 pos:=pos+1;
4 3121 end;
3 3122
3 3122 skip:= skip or i='?' or i='esc';
3 3123 slut_tegn:= i;
3 3124 skrivtegn(d.op_ref.data,apos,'em');
3 3125 afslut_text(d.op_ref.data,apos);
3 3126 \f
3 3126 message procedure læs_kommando side 4 - 820301/hko/cl;
3 3127
3 3127 disable
3 3128 begin
4 3129 integer
4 3130 i1,
4 3131 nr,
4 3132 partype,
4 3133 cifre;
4 3134 integer array
4 3135 spec(1:1),
4 3136 værdi(1:4);
4 3137
4 3137 <*+2*>
4 3138 if testbit25 and overvåget then
4 3139 disable begin
5 3140 real array field raf;
5 3141 write(out,"nl",1,<:kommando læst::>);
5 3142 laf:=data;
5 3143 write(out,d.op_ref.laf,<:<'<'>sluttegn<'>'>=:>,<<d>,sluttegn,
5 3144 <: skip=:>,if skip then <:true:> else <:false:>);
5 3145 ud;
5 3146 end;
4 3147 <*-2*>
4 3148
4 3148 for i:=1 step 1 until 32 do ia(i):=0;
4 3149
4 3149 if skip then
4 3150 begin
5 3151 res:=53; <*annulleret*>
5 3152 pos:= -1;
5 3153 goto slut_læskommando;
5 3154 end;
4 3155 \f
4 3155 message procedure læs_kommando side 5 - 850820/cl;
4 3156
4 3156 i:= kilde//100; <* hovedmodul *>
4 3157 k:= kilde mod 100; <* løbenr *>
4 3158 <* if pos>79 then linieoverløb; *>
4 3159 pos:=a_pos:=0;
4 3160 spec(1):= ',' shift 16;
4 3161
4 3161 <*+4*>
4 3162 if k<1 or k>(case i of (1,max_antal_operatører,
4 3163 max_antal_garageterminaler)) then
4 3164 begin
5 3165 fejlreaktion(3<*programfejl*>,kilde,<:ukendt kilde til kommando:>,1);
5 3166 res:=31;
5 3167 end
4 3168 else
4 3169 <*-4*>
4 3170 if i>0 and i<4 then <* io, operatør eller garageterminal *>
4 3171 begin
5 3172 <* læs operationskode *>
5 3173 j:=param(d.op_ref.data,apos,spec,tf_kommandotabel,cifre,værdi,sep);
5 3174
5 3174 res:= if j=1 and sep='.' and i=2<*operatør*> then -1 <* skærmopdatering *>
5 3175 else if cifre>0 or j=1 or j=3 or j=5 then 24 <* syntaks *>
5 3176 else if j=2 then 4 <*ukendt kommando*>
5 3177 else if j=4 then 31 <*systemfejl: ukendt tabelfil*>
5 3178 else if sep<>'sp' and sep<>','
5 3179 and sep<>'nl' and sep<>';'
5 3180 and sep<>'nul' and sep<>'em' then 26
5 3181 <*skilletegn*>
5 3182 else if -, læsbit_i(værdi(4),i-1) then 4
5 3183 <* logand(extend 0 add værdi(4)
5 3184 extend 1 shift (case i of (0,k,8+k)))=0 then 4
5 3185 *> <*ukendt kommando*>
5 3186 else 1;
5 3187 \f
5 3187 message procedure læs_kommando side 5a- 810409/hko;
5 3188
5 3188 <*+2*>if testbit25 and overvåget then
5 3189 begin
6 3190 write(out,"nl",0,<:funk opslag: param,apos,cifre,sep,res::>,
6 3191 << -dddd>,j,apos,cifre,sep,res,
6 3192 <: værdi(1-4)::>,værdi(1),værdi(2),værdi(3),værdi(4),
6 3193 "nl",0);
6 3194 if j<>0 then skriv_op(out,op_ref);
6 3195 ud;
6 3196 end;
5 3197 <*-2*>
5 3198
5 3198 if res=31 then fejlreaktion(18<*tabelfil*>,j,
5 3199 <:=res, filnr 1025, læskommando:>,0);
5 3200
5 3200 if res=1 then <* operationskode ok *>
5 3201 begin
6 3202 if sep<>'sp' then apos:=apos-1;
6 3203 d.op_ref.opkode:=værdi(1);
6 3204 indeks:=værdi(2);
6 3205 partype:= værdi(3);
6 3206 nr:= 0;
6 3207 pos:= apos;
6 3208 \f
6 3208 message procedure læs_kommando side 6 - 810409/hko;
6 3209
6 3209 while res=1 do
6 3210 begin
7 3211 læs_param_sæt(d.op_ref.data,apos,0<*indtil 3 enkeltparametre*>,
7 3212 værdi,sep,a_res);
7 3213 nr:= nr +1;
7 3214 i1:= værdi(1);
7 3215 <*+2*> if testbit25 and overvåget then
7 3216 begin
8 3217 write(out,"nl",1,<:param sæt: apos,sep,ares::>,<< -dddddd>,
8 3218 apos,sep,ares,<: værdi(1-4)::>,
8 3219 værdi(1),værdi(2),værdi(3),værdi(4),
8 3220 "nl",0);
8 3221 ud;
8 3222 end;
7 3223 <*-2*>
7 3224 case par_type of
7 3225 begin
8 3226
8 3226 <*1: (<ingenting>!<busnr> (<omr>)!<linienr>/<løbnr> (<omr>)) *>
8 3227
8 3227 begin
9 3228 if nr=1 then
9 3229 begin
10 3230 if a_res=0 then res:=2 <*godkendt*>
10 3231 else if a_res=2 and (i1<1 or i1>9999)
10 3232 then res:=7 <*busnr ulovligt*>
10 3233 else if a_res=2 or a_res=6 then
10 3234 begin
11 3235 ia(1):= if a_res=2 then i1
11 3236 else 1 shift 22 +i1;
11 3237 end
10 3238 else res:= 27; <*parametertype*>
10 3239 if res<4 then pos:= apos;
10 3240 end <*nr=1*>
9 3241 else
9 3242 if nr=2 then
9 3243 begin
10 3244 if ares=0 then res:= 2 <*godkendt*>
10 3245 else if ares=1 then
10 3246 begin
11 3247 ia(2):= find_område(i1);
11 3248 if ia(2)=0 then res:= 17; <* kanal-nr ukendt *>
11 3249 end
10 3250 else res:= 27; <* syntaks, parametertype *>
10 3251 end
9 3252 else
9 3253 if ares=0 then res:= 2<*godkendt*> else res:= 24 <* syntaks *>;
9 3254 end;
8 3255 \f
8 3255 message procedure læs_kommando side 7 - 810226/hko;
8 3256
8 3256 <*2: (<busnr> (<område>)!<linie>/<løbnr>) *>
8 3257
8 3257 begin
9 3258 if nr=1 then
9 3259 begin
10 3260 if a_res=0 then res:=25 <*parameter mangler*>
10 3261 else if a_res=2 and (i1<1 or i1>9999)
10 3262 then res:=7 <*busnr ulovligt*>
10 3263 else if a_res=2 or a_res=6 then
10 3264 begin
11 3265 ia(1):=if a_res=2 then i1
11 3266 else 1 shift 22 +i1;
11 3267 end
10 3268 else res:= 27; <*parametertype*>
10 3269 if res<4 then pos:=a_pos;
10 3270 end
9 3271 else
9 3272 if nr=2 then
9 3273 begin
10 3274 if ares=0 then res:= 2 <*godkendt*> else
10 3275 if ares=1 and ia(1) shift (-21) = 0 then
10 3276 begin
11 3277 ia(2):= findområde(i1);
11 3278 if ia(2)=0 then res:= 56; <*område ukendt*>
11 3279 end
10 3280 else res:= 27;
10 3281 if res<4 then pos:= apos;
10 3282 end
9 3283 else
9 3284 if ares=0 then res:= 2 else res:= 24<*syntaks*>;
9 3285 end;
8 3286 \f
8 3286 message procedure læs_kommando side 8 - 810223/hko;
8 3287
8 3287 <*3: (<linie>!G<nr>) *>
8 3288
8 3288 begin
9 3289 if nr=1 then
9 3290 begin
10 3291 if a_res=0 then res:=25 <*parameter mangler*>
10 3292 else if a_res=2 and (i1<1 or i1>999) then res:=5
10 3293 <*linienr ulovligt*>
10 3294 else if a_res=2 or a_res=4 or a_res=5 then
10 3295 begin
11 3296 ia(1):=
11 3297 if a_res=2 then 4 shift 21 +i1 shift 5
11 3298 else if a_res=4 then 4 shift 21 +i1
11 3299 else <* a_res=5 *> 5 shift 21 +i1;
11 3300 end
10 3301 else res:=27; <* parametertype *>
10 3302 if res<4 then pos:= a_pos;
10 3303 end
9 3304 else
9 3305 res:= if nr=2 and a_res<>0 then 24<*syntaks*>
9 3306 else 2;<*godkendt*>
9 3307 end;
8 3308
8 3308 <*4: <ingenting> *>
8 3309
8 3309 begin
9 3310 res:= if a_res<>0 then 24<*syntaks*>
9 3311 else 2;<*godkendt*>
9 3312 end;
8 3313 \f
8 3313 message procedure læs_kommando side 9 - 810226/hko;
8 3314
8 3314 <*5: (<kanalnr>) *>
8 3315
8 3315 begin
9 3316 long field lf;
9 3317
9 3317 if nr=1 then
9 3318 begin
10 3319 if a_res=0 then res:= 25
10 3320 else if a_res<>1 then res:=27<*parametertype*>
10 3321 else
10 3322 begin
11 3323 j:= 0; lf:= 4;
11 3324 for i:= 1 step 1 until max_antal_kanaler do
11 3325 if kanal_navn(i)=værdi.lf then j:= i;
11 3326 if j<>0 then
11 3327 begin
12 3328 ia(1):= 3 shift 22 + j;
12 3329 res:= 2;
12 3330 end
11 3331 else
11 3332 res:= 17; <* kanal ukendt *>
11 3333 end;
10 3334 if res<4 then pos:= a_pos;
10 3335 end
9 3336 else
9 3337 res:=if nr=2 and a_res<>0 then 24<*syntaks*>
9 3338 else 2;<*godkendt*>
9 3339 end;
8 3340 \f
8 3340 message procedure læs_kommando side 10 - 810415/hko;
8 3341
8 3341 <*6: <busnr>/<linie>/<løb> (<område>) *>
8 3342
8 3342 begin
9 3343 if nr=1 then
9 3344 begin
10 3345 if a_res=0 then res:=25<*parameter mangler*>
10 3346 else if a_res=7 then
10 3347 begin
11 3348 ia(1):= i1;
11 3349 ia(2):= 1 shift 22 + værdi(2);
11 3350 end
10 3351 else res:=27;<*parametertype*>
10 3352 if res<4 then pos:= apos;
10 3353 end
9 3354 else
9 3355 if nr=2 then
9 3356 begin
10 3357 if ares=0 then res:= 2 <*godkendt*> else
10 3358 if ares=1 then
10 3359 begin
11 3360 ia(3):= findområde(i1);
11 3361 if ia(3)=0 then res:= 56; <* område ukendt *>
11 3362 end
10 3363 else res:= 27; <*parametertype*>
10 3364 if res<4 then pos:= apos;
10 3365 end
9 3366 else
9 3367 if ares=0 then res:= 2 else res:= 24;
9 3368 end;
8 3369 \f
8 3369 message procedure læs_kommando side 11 - 810512/hko/cl;
8 3370
8 3370
8 3370 <* att_op_længde//2-2 *>
8 3371 <*7: <linienr>.<indeks>:<løbnr> (<interval>.<løb>) *>
8 3372 <* 1 *>
8 3373
8 3373 begin
9 3374 if nr=1 then
9 3375 begin
10 3376 if a_res=0 then res:=25 <*parameter mangler*>
10 3377 else if a_res=8 then
10 3378 begin
11 3379 ia(1):= 4 shift 21 + i1;
11 3380 ia(2):= værdi(2);
11 3381 ia(3):= værdi(3);
11 3382 indeks:= 3;
11 3383 end
10 3384 else res:=27;<*parametertype*>
10 3385 end
9 3386 else if nr<=att_op_længde//2-2 then
9 3387 begin
10 3388 if a_res=0 and (sep=',' or nr>2) then res:=2<*godkendt*>
10 3389 else if a_res=0 then res:=25 <* parameter mangler *>
10 3390 else if a_res=10 then
10 3391 begin
11 3392 if i1>0 and i1<100 and værdi(2)>0 and værdi(2)<100 then
11 3393 begin
12 3394 ia(nr+2):= i1 shift 12 + værdi(2);
12 3395 indeks:= nr +2;
12 3396 end
11 3397 else if i1<1 or i1>99 then res:=44 <*intervalstr. ulovlig*>
11 3398 else res:=6; <*løb-nr ulovligt*>
11 3399 end
10 3400 else res:=27;<*parametertype*>
10 3401 end
9 3402 else
9 3403 res:= if a_res=0 then 2 else 24;<* syntaks *>
9 3404 if res<4 then pos:=a_pos;
9 3405 end;
8 3406 \f
8 3406 message procedure læs_kommando side 12 - 810306/hko;
8 3407
8 3407 <*8: (<operatør>!<radiokanal>!<garageterminal>) *>
8 3408
8 3408 begin
9 3409 if nr=1 then
9 3410 begin
10 3411 if a_res=0 then res:=25 <* parameter mangler *>
10 3412 else if a_res=2 then
10 3413 begin
11 3414 j:=d.op_ref.opkode;
11 3415 ia(1):=i1;
11 3416 k:=(j+1)//2;
11 3417 if k<1 or k=3 or k>4 then
11 3418 fejlreaktion(3<*programfejl*>,j,<:opkode, partype=8:>,1)
11 3419 else
11 3420 begin
12 3421 if k=4 then k:=3;
12 3422 if i1<1 or i1> (case k of
12 3423 (max_antal_operatører,max_antal_radiokanaler,
12 3424 max_antal_garageterminaler))
12 3425 then res:=case k of (28,29,17);
12 3426 end;
11 3427 end
10 3428 else if a_res=1 and (d.op_ref.opkode+1)//2=1 then
10 3429 begin
11 3430 laf:= 0;
11 3431 ia(1):= find_bpl(værdi.laf(1));
11 3432 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3433 end
10 3434 else res:=27; <*parametertype*>
10 3435 end
9 3436 else
9 3437 if nr=2 and d.opref.opkode=1 then
9 3438 begin
10 3439 <* åbningstilstand for operatørplads *>
10 3440 if a_res=0 then res:= 2 <*godkendt*>
10 3441 else if a_res<>1 then res:= 27 <*parametertype*>
10 3442 else begin
11 3443 res:= 2<*godkendt*>;
11 3444 j:= værdi(1) shift (-16);
11 3445 if j='S' then ia(2):= 3 else
11 3446 if j<>'Å' then res:= 24; <*syntaks*>
11 3447 end;
10 3448 end
9 3449 else
9 3450 begin
10 3451 res:=if a_res=0 then 2 <* godkendt *>
10 3452 else 24;<* syntaks *>
10 3453 end;
9 3454 if res<4 then pos:=a_pos;
9 3455 end; <* partype 8 *>
8 3456 \f
8 3456 message procedure læs_kommando side 13 - 810306/hko;
8 3457
8 3457
8 3457 <* att_op_længde//2 *>
8 3458 <*9: <operatør>((+!-)<linienr>) *>
8 3459 <* 1 *>
8 3460
8 3460 begin
9 3461 if nr=1 then
9 3462 begin
10 3463 if a_res=0 then res:=25 <* parameter mangler *>
10 3464 else if a_res=2 then
10 3465 begin
11 3466 ia(1):=i1;
11 3467 if i1<1 or i1>max_antal_operatører then res:=28;
11 3468 end
10 3469 else if a_res=1 then
10 3470 begin
11 3471 laf:= 0;
11 3472 ia(1):= find_bpl(værdi.laf(1));
11 3473 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3474 end
10 3475 else res:=27; <* parametertype *>
10 3476 end
9 3477 else if nr<=att_op_længde//2 then
9 3478 begin <* nr>1 *>
10 3479 if a_res=0 then res:=(if nr>2 then 2 else 25)
10 3480 else if a_res=2 or a_res=3 then
10 3481 begin
11 3482 ia(nr):=i1; indeks:= nr;
11 3483 if i1=0 or abs(i1)>999 then res:=5;
11 3484 end
10 3485 else res:=27; <* parametertype *>
10 3486 if res<4 then pos:=a_pos;
10 3487 end
9 3488 else
9 3489 res:=if a_res<>0 then 24 <* syntaks (for mange parametre) *>
9 3490 else 2;
9 3491 end; <* partype 9 *>
8 3492 \f
8 3492 message procedure læs_kommando side 14 - 810428/hko;
8 3493
8 3493 <* 2 *>
8 3494 <*10: (bus) *>
8 3495 <* 1 *>
8 3496
8 3496 begin
9 3497 if a_res=0 and nr=1 then res:=25 <* parameter mangler *>
9 3498 else if a_res<>0 and nr>2 then res:=24 <* syntaks (for mange) *>
9 3499 else if a_res=0 then res:=2 <* godkendt *>
9 3500 else if a_res<>2 then res:=27 <* parametertype *>
9 3501 else if i1<1 or i1>9999 then res:=7 <*ulovligt busnr *>
9 3502 else
9 3503 ia(nr):=i1;
9 3504 end;
8 3505
8 3505 <* 5 *>
8 3506 <*11: (<linie>) *>
8 3507 <* 1 *>
8 3508
8 3508 begin
9 3509 if a_res=0 and nr=1 then res:=25
9 3510 else if a_res<>0 and nr>5 then res:=24
9 3511 else if a_res=0 then res:=2
9 3512 else if a_res<>2 and a_res<>4 then res:=27
9 3513 else if a_res=2 and (i1<1 or i1>999) then res:=5 <* ulovl.linie *>
9 3514 else
9 3515 ia(nr):=
9 3516 (if a_res=4 then i1 else i1 shift 5) + 4 shift 21;
9 3517 end;
8 3518 \f
8 3518 message procedure læs_kommando side 15 - 810306/hko;
8 3519
8 3519 <*12: (<ingenting>!<navn>) *>
8 3520
8 3520 begin
9 3521 if nr=1 then
9 3522 begin
10 3523 if a_res=0 then res:=2 <*godkendt*>
10 3524 else if a_res=1 then
10 3525 tofrom(ia,værdi,8)
10 3526 else res:=27; <* parametertype *>
10 3527 end
9 3528 else
9 3529 res:=if a_res<>0 then 24 <* syntaks (for mange) *>
9 3530 else 2;
9 3531 end; <* partype 12 *>
8 3532 \f
8 3532 message procedure læs_kommando side 16 - 810512/hko/cl;
8 3533
8 3533 <* 15 *>
8 3534 <*13: G<grp.nr>:(<bus>!<linie>/<løb>) (<bus>!<linie>/<løb>) *>
8 3535 <* 1 *>
8 3536
8 3536 begin
9 3537 if nr=1 then
9 3538 begin
10 3539 if a_res=0 then res:=25 <* parameter mangler *>
10 3540 else
10 3541 if a_res=11 then
10 3542 begin
11 3543 ia(1):= 5 shift 21 + i1;
11 3544 ia(2):=værdi(2);
11 3545 indeks:= 2;
11 3546 end
10 3547 else res:=27; <* parametertype *>
10 3548 end
9 3549 else if nr<= att_op_længde//2-1 then
9 3550 begin
10 3551 if a_res=0 and(sep=',' or nr>2)then res:=2 <* godkendt *>
10 3552 else if a_res=0 then res:=25 <* parameter mangler *>
10 3553 else if ares=2 and (i1<1 or i1>9999) then
10 3554 res:= 7 <*busnr ulovligt*>
10 3555 else if a_res=2 or a_res=6 then
10 3556 begin
11 3557 ia(nr+1):=i1+ (if a_res=6 then 1 shift 22 else 0);
11 3558 indeks:= nr+1;
11 3559 end
10 3560 else res:=27; <* parametertype *>
10 3561 end
9 3562 else
9 3563 res:=if a_res=0 then 2 <*godkendt *>
9 3564 else 24;<* syntaks *>
9 3565 if res<4 then pos:=a_pos;
9 3566 end; <* partype 13 *>
8 3567 \f
8 3567 message procedure læs_kommando side 17 - 810311/hko;
8 3568
8 3568 <*14: <linie>.<indeks> *>
8 3569
8 3569 begin
9 3570 if nr=1 then
9 3571 begin
10 3572 if a_res=0 then res:=25 <* parameter mangler *>
10 3573 else if a_res=9 then
10 3574 begin
11 3575 ia(1):= 1 shift 23 +i1;
11 3576 ia(2):= værdi(2);
11 3577 end
10 3578 else res:=27; <* parametertype *>
10 3579 end
9 3580 else <* nr>1 *>
9 3581 res:= if a_res=0 then 2 <* godkendt *>
9 3582 else 24;<* syntaks *>
9 3583 end; <* partype 14 *>
8 3584 \f
8 3584 message procedure læs_kommando side 18 - 810313/hko;
8 3585
8 3585 <*15: <linie>.<indeks> <bus> *>
8 3586
8 3586 begin
9 3587 if nr=1 then
9 3588 begin
10 3589 if a_res=0 then res:= 25 <* parameter mangler *>
10 3590 else if a_res=9 then
10 3591 begin
11 3592 ia(1):= 1 shift 23 +i1;
11 3593 ia(2):= værdi(2);
11 3594 end
10 3595 else res:=27; <* parametertype *>
10 3596 end
9 3597 else if nr=2 then
9 3598 begin
10 3599 if a_res=0 then res:=25
10 3600 else if a_res=2 then
10 3601 begin
11 3602 if i1<1 or i1>9999 then res:=7 <* ulovligt busnr *>
11 3603 else ia(3):= i1;
11 3604 end
10 3605 else res:=27; <*parametertype *>
10 3606 end
9 3607 else
9 3608 res:=if a_res=0 then 2 <* godkendt *>
9 3609 else 24;<* syntaks *>
9 3610 if res<4 then pos:=a_pos;
9 3611 end; <* partype 15 *>
8 3612 \f
8 3612 message procedure læs_kommando side 19 - 810311/hko;
8 3613
8 3613 <*16: (<ingenting>!D.<dato>.<klokkeslet> *>
8 3614
8 3614 begin
9 3615 if nr=1 then
9 3616 begin
10 3617 if a_res=0 then res:=2 <* godkendt *>
10 3618 else if a_res=12 then
10 3619 begin
11 3620 raf:=0;
11 3621 ia.raf(1):= systid(i1,værdi(2));
11 3622 end
10 3623 else res:=27; <* parametertype *>
10 3624 end
9 3625 else
9 3626 res:= if a_res=0 then 2 <* godkendt *>
9 3627 else 24;<* syntaks *>
9 3628 if res<4 then pos:=a_pos;
9 3629 end; <* partype 16 *>
8 3630 \f
8 3630 message procedure læs_kommando side 20 - 810511/hko;
8 3631
8 3631 <*17: G<grp.nr> *>
8 3632
8 3632 begin
9 3633 if nr=1 then
9 3634 begin
10 3635 if a_res=0 then res:=25 <*parameter mangler *>
10 3636 else if a_res=5 then
10 3637 begin
11 3638 ia(1):= 5 shift 21 +i1;
11 3639 end
10 3640 else res:=27; <* parametertype *>
10 3641 end
9 3642 else
9 3643 res:= if a_res=0 then 2 <* godkendt *>
9 3644 else 24;<* syntaks *>
9 3645 end; <* partype 17 *>
8 3646
8 3646 <* att_op_længde//2 *>
8 3647 <*18: (<heltal>) *>
8 3648 <* 1 *>
8 3649
8 3649 begin
9 3650 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3651 else
9 3652 if nr<=att_op_længde//2 then
9 3653 begin
10 3654 if a_res=2 or a_res=3 <* pos/neg heltal *> then
10 3655 begin
11 3656 ia(nr):= i1; indeks:= nr;
11 3657 end
10 3658 else if a_res=0 then res:= 2
10 3659 else res:= 27; <*parametertype*>
10 3660 end
9 3661 else
9 3662 res:= if a_res=0 then 2 else 24;<*syntaks (for mange)*>
9 3663 end;
8 3664 \f
8 3664 message procedure læs_kommando side 21 - 820302/cl;
8 3665
8 3665 <*19: <linie>/<løb> <linie>/<løb> *>
8 3666
8 3666 begin
9 3667 if nr<3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3668 else if nr<3 and a_res<>6 then res:= 27 <*parametertype*>
9 3669 else if nr<3 then
9 3670 begin
10 3671 ia(nr):=i1 + 1 shift 22;
10 3672 end
9 3673 else
9 3674 res:= if a_res=0 then 2 <*godkendt*>
9 3675 else 24;<*syntaks (for mange)*>
9 3676 if res<4 then pos:= a_pos;
9 3677 end; <* partype 19 *>
8 3678
8 3678 <*20: <busnr> <kortnavn> *>
8 3679 begin
9 3680 if nr=1 then
9 3681 begin
10 3682 if ares=0 then res:= 25 else
10 3683 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3684 if ares<>2 then res:= 27 else ia(1):= i1;
10 3685 end
9 3686 else
9 3687 if nr=2 then
9 3688 begin
10 3689 if ares=1 and værdi(2) extract 8 = 0 then
10 3690 begin
11 3691 ia(2):= værdi(1); ia(3):= værdi(2);
11 3692 end
10 3693 else res:= if ares=0 then 25 else if ares=1 then 62 else 27;
10 3694 end
9 3695 else
9 3696 if ares=0 then res:= 2 else res:= 24;
9 3697 end; <* partype 20 *>
8 3698 \f
8 3698 message procedure læs_kommando side 22 - 851001/cl;
8 3699
8 3699 <* 2 *>
8 3700 <*21: ( <linie> ) (<garage> ! OMR (ALL ! <område>)) *>
8 3701 <* 0 *>
8 3702
8 3702 begin
9 3703 laf:= 0;
9 3704 if nr=1 and a_res=0 then res:= 25 <*parameter mangler*>
9 3705 else if a_res=0 and (ia(3)=-2 or ia(3)=0) then res:= 25
9 3706 else if a_res<>0 and nr>4 then res:= 24 <*syntaks (for mange)*>
9 3707 else if a_res=0 then res:= 2 <*godkendt*>
9 3708 else if a_res=2 and (i1<1 or i1>999) then res:= 5 <*ulovligt*>
9 3709 else if (a_res=2 or a_res=4) and nr<=2 then
9 3710 begin
10 3711 if ia(3)<>0 then res:= 27 else
10 3712 ia(nr):= (4 shift 21) + (if a_res=2 then i1 shift 5 else i1);
10 3713 end
9 3714 else
9 3715 if ares=1 then
9 3716 begin
10 3717 if nr=1 then
10 3718 begin
11 3719 ia(1):= (4 shift 21) + (1 shift 5);
11 3720 ia(2):= (4 shift 21) + (999 shift 5);
11 3721 end;
10 3722 if ia(3)=-2 then
10 3723 begin
11 3724 if i1=long<:ALL:> shift (-24) extract 24 then
11 3725 ia(3):= -1
11 3726 else
11 3727 begin
12 3728 ia(3):= findområde(i1);
12 3729 if ia(3)=0 then res:= 56 else
12 3730 ia(3):= 14 shift 20 + ia(3);
12 3731 end;
11 3732 end
10 3733 else
10 3734 if ia(3) = 0 then
10 3735 begin
11 3736 if i1 = long<:OMR:> shift (-24) extract (24) then
11 3737 ia(3):= -2
11 3738 else
11 3739 ia(3):= find_bpl(værdi.laf(1));
11 3740 if ia(3)=0 then res:= 55;
11 3741 end
10 3742 else res:= 24;
10 3743 end
9 3744 else res:= 27; <*parametertype*>
9 3745 if res<4 then pos:= apos;
9 3746 end;
8 3747
8 3747 <*22: (<busnr> (<område) ! <linie>/<løb> (<område>) ) *>
8 3748
8 3748 begin
9 3749 if nr=1 then
9 3750 begin
10 3751 if ares=0 then res:= 25 <*parameter mangler*>
10 3752 else if ares=2 and (i1<1 or i1>9999)
10 3753 then res:= 7 <* busnr ulovligt *>
10 3754 else if ares=2 or ares=6 then
10 3755 begin
11 3756 ia(1):= if ares=2 then i1 else 1 shift 22 + i1;
11 3757 end
10 3758 else res:= 27 <* parametertype *>
10 3759 end
9 3760 else
9 3761 if nr=2 then
9 3762 begin
10 3763 if ares=0 then res:= 2 <* godkendt *>
10 3764 else if ares=1 then
10 3765 begin
11 3766 ia(2):= findområde(i1);
11 3767 if ia(2)=0 then res:= 17 <*kanal ukendt*>
11 3768 end
10 3769 else
10 3770 res:= 27; <* parametertype *>
10 3771 end
9 3772 else if ares=0 then res:= 2 <*godkendt*>
9 3773 else res:= 24; <*syntaks*>
9 3774 if res < 4 then pos:= apos;
9 3775 end;
8 3776
8 3776 <*23: ( <linie> (<område>) ! G<nr> (<område>) ) *>
8 3777
8 3777 begin
9 3778 if nr=1 then
9 3779 begin
10 3780 if ares=0 then res:= 25 else
10 3781 if ares=2 and (i1<1 or i1>999) then res:= 5 else
10 3782 if ares=2 or ares=4 or ares=5 then
10 3783 begin
11 3784 ia(1):=
11 3785 if ares=2 then 4 shift 21 + i1 shift 5 else
11 3786 if ares=4 then 4 shift 21 + i1 else
11 3787 5 shift 21 + i1;
11 3788 end
10 3789 else res:= 27;
10 3790 if res < 4 then pos:= apos;
10 3791 end
9 3792 else
9 3793 if nr=2 then
9 3794 begin
10 3795 if ares=0 then res:= 2 else
10 3796 if ares=1 then
10 3797 begin
11 3798 ia(2):= findområde(i1);
11 3799 if ia(2)=0 then res:= 17;
11 3800 end
10 3801 else res:= 27;
10 3802 end
9 3803 else
9 3804 if ares=0 then res:= 2 else res:= 24;
9 3805 end;
8 3806
8 3806 <*24: ( <ingenting> ! <område> ! * ) *>
8 3807
8 3807 begin
9 3808 if nr=1 then
9 3809 begin
10 3810 if ares=0 then res:= 2 else
10 3811 if ares=1 then
10 3812 begin
11 3813 if i1=long<:ALL:> shift (-24) extract 24 then
11 3814 ia(1):= (-1) shift (-3) shift 3
11 3815 else
11 3816 begin
12 3817 k:= findområde(i1);
12 3818 if k=0 then res:= 17 else
12 3819 ia(1):= 14 shift 20 + k;
12 3820 end;
11 3821 end
10 3822 else res:= 27;
10 3823 end
9 3824 else
9 3825 if ares=0 then res:= 2 else res:= 24;
9 3826 if res < 4 then pos:= apos;
9 3827 end;
8 3828
8 3828 <*25: <område> *>
8 3829
8 3829 begin
9 3830 if nr=1 then
9 3831 begin
10 3832 if ares=0 then res:= 25 else
10 3833 if ares=1 then
10 3834 begin
11 3835 if i1 = '*' shift 16 then ia(1):= -1 else
11 3836 ia(1):= findområde(i1);
11 3837 if ia(1)=0 then res:= 17;
11 3838 end
10 3839 else res:= 27;
10 3840 end
9 3841 else
9 3842 if ares=0 then res:= 2 else res:= 24;
9 3843 if res < 4 then pos:= apos;
9 3844 end;
8 3845
8 3845 <*26: <busnr> *>
8 3846 begin
9 3847 if nr=1 then
9 3848 begin
10 3849 if ares=0 then res:= 25 else
10 3850 if ares=2 and (i1<1 or 9999<i1) then res:= 24 else
10 3851 if ares<>2 then res:= 27 else ia(1):= i1;
10 3852 end
9 3853 else
9 3854 if ares=0 then res:= 2 else res:= 24;
9 3855 end;
8 3856
8 3856 <* 8 *>
8 3857 <*27: <operatørnr> (<område>) *>
8 3858 <* 1 *>
8 3859 begin
9 3860 if nr < 3 and a_res=0 then res:= 25 <*parameter mangler*>
9 3861 else if nr=1 then
9 3862 begin
10 3863 if a_res=2 then
10 3864 begin
11 3865 ia(1):= i1;
11 3866 if i1 < 0 or max_antal_operatører < i1 then res:= 28;
11 3867 end
10 3868 else if a_res=1 then
10 3869 begin
11 3870 laf:= 0;
11 3871 ia(1):= find_bpl(værdi.laf(1));
11 3872 if ia(1)<1 or ia(1)>max_antal_operatører then res:=28;
11 3873 end
10 3874 else res:= 27; <*parametertype*>
10 3875 end
9 3876 else
9 3877 begin
10 3878 if a_res=0 then res:= (if nr > 2 then 2 else 25)
10 3879 else if nr > 9 then res:= 24
10 3880 else if a_res=1 then
10 3881 begin
11 3882 ia(nr):= find_område(i1);
11 3883 indeks:= nr;
11 3884 if ia(nr)=0 then res:= 56;
11 3885 end
10 3886 else res:= 27;
10 3887 end;
9 3888 if res < 4 then pos:= a_pos;
9 3889 end <* partype 27 *>;
8 3890
8 3890 <*28: (<ingenting>!<kanalnr>) *>
8 3891 begin
9 3892 long field lf;
9 3893
9 3893 if nr=1 then
9 3894 begin
10 3895 if ares=0 then res:= 2 else
10 3896 if ares=1 then
10 3897 begin
11 3898 j:= 0; lf:= 4;
11 3899 for i:= 1 step 1 until max_antal_kanaler do
11 3900 if kanal_navn(i)=værdi.lf then j:= i;
11 3901 if j<>0 then
11 3902 begin
12 3903 ia(1):= 3 shift 22 + j;
12 3904 res:= 2;
12 3905 end
11 3906 else
11 3907 res:= 17; <*kanal ukendt*>
11 3908 end
10 3909 else
10 3910 res:= 27; <*parametertype*>
10 3911 if res < 4 then pos:= apos;
10 3912 end
9 3913 else
9 3914 res:= if nr=2 and ares<>0 then 24 <*syntaks*> else 2 <*ok*>;
9 3915 end;
8 3916
8 3916 <* n *>
8 3917 <*29: <btj.pl.navn> ( <operatørnavn>) *>
8 3918 <* 0 *>
8 3919 begin
9 3920 laf:= 0;
9 3921 if nr=1 then
9 3922 begin
10 3923 if a_res=0 then res:= 25 <*parameter mangler*>
10 3924 else if a_res<>1 or værdi(2) extract 8 <>0 then res:= 27
10 3925 else begin
11 3926 indeks:= 2;
11 3927 ia(1):= værdi(1); ia(2):= værdi(2);
11 3928 j:= find_bpl(værdi.laf(1));
11 3929 if 0<j and j<=max_antal_operatører then
11 3930 res:= 62; <*ulovligt navn*>
11 3931 end;
10 3932 end
9 3933 else
9 3934 begin
10 3935 if a_res=0 then res:= 2 <*godkendt*>
10 3936 else if a_res<>1 then res:= 27 <*parametertype*>
10 3937 else begin
11 3938 indeks:= indeks+1;
11 3939 ia(indeks):= find_bpl(værdi.laf(1));
11 3940 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3941 res:= 28; <*ukendt operatør*>
11 3942 end;
10 3943 end;
9 3944 if res<4 then pos:= a_pos;
9 3945 end;
8 3946
8 3946 <* 3 *>
8 3947 <*30: (<operatørnavn>) ( <btj.pl.navn>) *>
8 3948 <* io 0 *>
8 3949
8 3949 begin
9 3950 boolean io;
9 3951
9 3951 io:= (kilde//100 = 1);
9 3952 laf:= 0;
9 3953 if -,io and nr=1 then
9 3954 begin
10 3955 indeks:= 1;
10 3956 ia(1):= kilde mod 100; <*egen operatørplads*>
10 3957 end;
9 3958
9 3958 if io and nr=1 then
9 3959 begin
10 3960 if a_res=0 then res:= 25 <*parameter mangler*>
10 3961 else if a_res<>1 then res:= 27 <*parametertype*>
10 3962 else begin
11 3963 indeks:= nr;
11 3964 ia(indeks):= find_bpl(værdi.laf(1));
11 3965 if ia(indeks)=0 or ia(indeks)>max_antal_operatører then
11 3966 res:= 28; <*ukendt operatør*>
11 3967 end;
10 3968 end
9 3969 else
9 3970 begin
10 3971 if a_res=0 then res:= 2<*godkendt*>
10 3972 else if indeks=4 then res:= 24 <*syntaks, for mange*>
10 3973 else if a_res<>1 then res:= 27 <*parametertype*>
10 3974 else begin
11 3975 indeks:= indeks+1;
11 3976 ia(indeks):= find_bpl(værdi.laf(1));
11 3977 if ia(indeks)=0 then res:= 46 <*navn ukendt*>
11 3978 else if ia(indeks)=ia(1) then res:= 62; <*ulovligt navn*>
11 3979 end;
10 3980 end;
9 3981 if res<4 then pos:= a_pos;
9 3982 end;
8 3983
8 3983 <* *>
8 3984 <*31: <operatørnr> ( <navn> (<ingenting>!Å!S) ) *>
8 3985 <* *>
8 3986
8 3986 begin
9 3987 laf:= 0;
9 3988 if nr<2 and a_res=0 then res:= 25 <*parameter mangler*>
9 3989 else
9 3990 if nr=1 then
9 3991 begin
10 3992 if a_res=2 then
10 3993 begin
11 3994 ia(1):= i1;
11 3995 if i1<=0 or max_antal_operatører<i1 then res:= 28; <*ukendt*>
11 3996 end else res:= 27; <*parametertype*>
10 3997 end
9 3998 else
9 3999 if nr=2 then
9 4000 begin
10 4001 if a_res=1 and værdi(2) extract 8 = 0 then
10 4002 begin
11 4003 ia(2):= værdi(1); ia(3):= værdi(2);
11 4004 j:= find_bpl(værdi.laf(1));
11 4005 if j>0 and j<>ia(1) then res:= 48 <*i brug*>;
11 4006 end
10 4007 else res:= if a_res=0 then 2 <*godkendt*>
10 4008 else 27 <*parametertype*>;
10 4009 end
9 4010 else
9 4011 if nr=3 then
9 4012 begin
10 4013 if a_res=0 then res:=2 <*godkendt*>
10 4014 else if a_res<>1 then res:= 27 <*parametertype*>
10 4015 else begin
11 4016 j:= værdi(1) shift (-16);
11 4017 if j='Å' then ia(4):= 1 else
11 4018 if j='S' then ia(4):= 3 else res:= 24 <*syntaks*>;
11 4019 end;
10 4020 end
9 4021 else res:= if a_res=0 then 2 <*godkendt*> else 24 <*syntaks*>;
9 4022 if res<4 then pos:= a_pos;
9 4023 end;
8 4024
8 4024 <* 1 *>
8 4025 <*32: (heltal) *>
8 4026 <* 0 *>
8 4027 begin
9 4028 if nr=1 then
9 4029 begin
10 4030 if ares=0 then res:= 2 else
10 4031 if ares=2 or ares=3 then
10 4032 begin
11 4033 ia(nr):= i1; indeks:= nr;
11 4034 end
10 4035 else res:=27; <*parametertype*>
10 4036 end
9 4037 else
9 4038 res:= (if ares<>0 then 24 <*syntaks, for mange*> else 2);
9 4039 if res < 4 then pos:= a_pos;
9 4040 end;
8 4041
8 4041 <*33 generel tekst*>
8 4042 begin
9 4043 integer p,p1,ch,lgd;
9 4044
9 4044 if nr=1 and a_res<>0 then
9 4045 begin
10 4046 p:=pos; p1:=1;
10 4047 lgd:= (op_spool_postlgd-op_spool_text)//2*3-1;
10 4048 if 95<lgd then lgd:=95;
10 4049 repeat læstegn(d.opref.data,p,ch) until ch<>' ';
10 4050 while ch<>'nl' and ch<>'em' and ch<>0 and p1<lgd do
10 4051 begin
11 4052 skrivtegn(ia,p1,ch);
11 4053 læstegn(d.opref.data,p,ch);
11 4054 end;
10 4055 if p1=1 then res:= 25 else res:= 2;
10 4056 repeat skrivtegn(ia,p1,0) until (p1 mod 6)=1;
10 4057 end
9 4058 else
9 4059 if a_res=0 then res:= 25 else res:= 24;
9 4060 end;
8 4061
8 4061 <*+4*> begin
9 4062 fejlreaktion(4<*systemfejl*>,partype,
9 4063 <:parametertype fejl i kommandofil:>,1);
9 4064 res:=31;
9 4065 end
8 4066 <*-4*>
8 4067 end;<*case partype*>
7 4068 end;<* while læs_param_sæt *>
6 4069 end; <* operationskode ok *>
5 4070 end
4 4071 else
4 4072 begin
5 4073 fejlreaktion(3<*programfejl*>,kilde,<:kilde:>,1);
5 4074 end;
4 4075
4 4075 if a_res<0 then res:= -a_res;
4 4076 slut_læskommando:
4 4077
4 4077 læs_kommando:=d.op_ref.resultat:= res;
4 4078 end;<* disable-blok*>
3 4079 end læs_kommando;
2 4080 \f
2 4080 message procedure skriv_kvittering side 1 - 820301/hko/cl;
2 4081
2 4081 procedure skriv_kvittering(z,ref,pos,res);
2 4082 value ref,pos,res;
2 4083 zone z;
2 4084 integer ref,pos,res;
2 4085 begin
3 4086 integer array field op;
3 4087 integer pos1,tegn;
3 4088 op:=ref;
3 4089 if res<1 or res>3 then write(z,<:*** :>);
3 4090 write(z,case res+1 of (
3 4091 <* 0*><:ubehandlet:>,
3 4092 <* 1*><:ok:>,
3 4093 <* 2*><:godkendt:>,
3 4094 <* 3*><:udført:>,
3 4095 <* 4*><:kommando ukendt:>,
3 4096
3 4096 <* 5*><:linie-nr ulovligt:>,
3 4097 <* 6*><:løb-nr ulovligt:>,
3 4098 <* 7*><:bus-nr ulovligt:>,
3 4099 <* 8*><:gruppe ukendt:>,
3 4100 <* 9*><:linie/løb ukendt:>,
3 4101
3 4101 <*10*><:bus-nr ukendt:>,
3 4102 <*11*><:bus allerede indsat på :>,
3 4103 <*12*><:linie/løb allerede besat af :>,
3 4104 <*13*><:bus ikke indsat:>,
3 4105 <*14*><:bus optaget:>,
3 4106
3 4106 <*15*><:gruppe optaget:>,
3 4107 <*16*><:skærm optaget:>,
3 4108 <*17*><:kanal ukendt:>,
3 4109 <*18*><:bus i kø:>,
3 4110 <*19*><:kø er tom:>,
3 4111
3 4111 <*20*><:ej forbindelse :>,
3 4112 <*21*><:ingen at gennemstille til:>,
3 4113 <*22*><:ingen samtale at nedlægge:>,
3 4114 <*23*><:ingen samtale at monitere:>,
3 4115 <*24*><:syntaks:>,
3 4116
3 4116 <*25*><:syntaks, parameter mangler:>,
3 4117 <*26*><:syntaks, skilletegn:>,
3 4118 <*27*><:syntaks, parametertype:>,
3 4119 <*28*><:operatør ukendt:>,
3 4120 <*29*><:garageterminal ukendt:>,
3 4121 \f
3 4121
3 4121 <*30*><:rapport kan ikke dannes:>,
3 4122 <*31*><:systemfejl:>,
3 4123 <*32*><:ingen fri plads:>,
3 4124 <*33*><:gruppe for stor:>,
3 4125 <*34*><:gruppe allerede defineret:>,
3 4126
3 4126 <*35*><:springsekvens for stor:>,
3 4127 <*36*><:spring allerede defineret:>,
3 4128 <*37*><:spring ukendt:>,
3 4129 <*38*><:spring allerede igangsat:>,
3 4130 <*39*><:bus ikke reserveret:>,
3 4131
3 4131 <*40*><:gruppe ikke reserveret:>,
3 4132 <*41*><:spring ikke igangsat:>,
3 4133 <*42*><:intet frit linie/løb:>,
3 4134 <*43*><:ændring af dato/tid ikke lovlig:>,
3 4135 <*44*><:interval-størrelse ulovlig:>,
3 4136
3 4136 <*45*><:ikke implementeret:>,
3 4137 <*46*><:navn ukendt:>,
3 4138 <*47*><:forkert indhold:>,
3 4139 <*48*><:i brug:>,
3 4140 <*49*><:ingen samtale igang:>,
3 4141
3 4141 <*50*><:kanal:>,
3 4142 <*51*><:afvist:>,
3 4143 <*52*><:kanal optaget :>,
3 4144 <*53*><:annulleret:>,
3 4145 <*54*><:ingen busser at kalde op:>,
3 4146
3 4146 <*55*><:garagenavn ukendt:>,
3 4147 <*56*><:område ukendt:>,
3 4148 <*57*><:område nødvendigt:>,
3 4149 <*58*><:ulovligt område for bus:>,
3 4150 <*59*><:radiofejl :>,
3 4151
3 4151 <*60*><:område kan ikke opdateres:>,
3 4152 <*61*><:ingen talevej:>,
3 4153 <*62*><:ulovligt navn:>,
3 4154 <*63*><:alarmlængde: :>,
3 4155
3 4155 <*99*><:- <'?'> -:>));
3 4156 \f
3 4156 message procedure skriv_kvittering side 3 - 820301/hko;
3 4157 if res=3 and op<>0 then
3 4158 begin
4 4159 if d.op.opkode=20 or d.op.opkode=11 then <*vogntabel,flyt -,indsæt*>
4 4160 begin
5 4161 i:= d.op.data(if d.op.opkode=20 then 4 else 3) extract 14;
5 4162 if i<>0 then write(z,i,<: udtaget:>);
5 4163 end;
4 4164 end;
3 4165 if res = 11 or res = 12 then
3 4166 i:=ref;
3 4167 if res=11 then write(z,i shift(-12) extract 10,
3 4168 if i shift(-7) extract 5 =0 then false
3 4169 else "A" add (i shift(-7) extract 5 -1),1,
3 4170 <:/:>,<<d>,i extract 7) else
3 4171 if res=12 then write(z,i extract 14) else
3 4172 if res = 20 or res = 52 or res = 59 then
3 4173 begin
4 4174 i:= d.op.data(12);
4 4175 if i <> 0 then skriv_id(z,i,8);
4 4176 i:=d.op.data(2);
4 4177 if i=0 then i:=d.op.data(9);
4 4178 if i=0 then i:=d.op.data(8);
4 4179 skriv_id(z,i,8);
4 4180 end;
3 4181 if res=63 then
3 4182 begin
4 4183 i:= ref;
4 4184 if i<0 then write(z,<:uendelig:>) else write(z,<<d>,i,<: sek.:>);
4 4185 end;
3 4186
3 4186 if pos>=0 then
3 4187 begin
4 4188 pos:=pos+1;
4 4189 outchar(z,':');
4 4190 tegn:=-1;
4 4191 while tegn<>10 and tegn<>0 do
4 4192 outchar(z,læs_tegn(d.op.data,pos,tegn));
4 4193 end;
3 4194 <*V*>setposition(z,0,0);
3 4195 end skriv_kvittering;
2 4196 \f
2 4196 message procedure cursor, side 1 - 810213/hko;
2 4197
2 4197 procedure cursor(z,linie,pos);
2 4198 value linie,pos;
2 4199 zone z;
2 4200 integer linie,pos;
2 4201 begin
3 4202 if linie>0 and linie<25
3 4203 and pos>0 and pos<81 then
3 4204 begin
4 4205 write(z,"esc" add 128,1,<:Æ:>,
4 4206 <<d>,linie,<:;:>,pos,<:H:>);
4 4207 end;
3 4208 end cursor;
2 4209 \f
2 4209 message procedure attention side 1 - 810529/hko;
2 4210
2 4210 procedure attention;
2 4211 begin
3 4212 integer i, j, k;
3 4213 integer array field op_ref,mess_ref;
3 4214 integer array att_message(1:9);
3 4215 long array field laf1, laf2;
3 4216 boolean optaget;
3 4217 procedure skriv_attention(zud,omfang);
3 4218 integer omfang;
3 4219 zone zud;
3 4220 begin
4 4221 write(zud,"nl",1,<:+++ attention :>);
4 4222 if omfang <> 0 then
4 4223 disable begin integer x;
5 4224 trap(slut);
5 4225 write(zud,"nl",1,
5 4226 <: i: :>,i,"nl",1,
5 4227 <: j: :>,j,"nl",1,
5 4228 <: k: :>,k,"nl",1,
5 4229 <: op-ref: :>,op_ref,"nl",1,
5 4230 <: mess-ref: :>,mess_ref,"nl",1,
5 4231 <: optaget: :>,if optaget then <:true:>else<:false:>,"nl",1,
5 4232 <: laf2 :>,laf2,"nl",1,
5 4233 <: att-message::>,"nl",1,
5 4234 <::>);
5 4235 raf:= 0;
5 4236 skriv_hele(zud,att_message.raf,18,127);
5 4237 skriv_coru(zud,coru_no(010));
5 4238 slut:
5 4239 end;
4 4240 end skriv_attention;
3 4241
3 4241 integer procedure udtag_tal(tekst,pos);
3 4242 long array tekst;
3 4243 integer pos;
3 4244 begin
4 4245 integer i;
4 4246
4 4246 if getnumber(tekst,pos,i) >= 0 then
4 4247 udtag_tal:= i
4 4248 else
4 4249 udtag_tal:= 0;
4 4250 end;
3 4251
3 4251 for i:= 1 step 1 until att_maske_lgd//2 do
3 4252 att_signal(i):=att_flag(i):=0;
3 4253 trap(att_trap);
3 4254 stack_claim((if cm_test then 198 else 146)+50);
3 4255 <*+2*>
3 4256 if testbit26 and overvåget or testbit28 then
3 4257 skriv_attention(out,0);
3 4258 <*-2*>
3 4259 \f
3 4259 message procedure attention side 2 - 810406/hko;
3 4260
3 4260 repeat
3 4261
3 4261 wait_ch(cs_att_pulje,opref,true,-1<*vent ubegrænset*>);
3 4262
3 4262 repeat
3 4263 <*V*> c_wait_message(att_proc_ref,att_message,mess_ref,-1<*vent ubegrænset*>);
3 4264 raf:= laf1:= 0;
3 4265 laf:=core.mess_ref(4)+2; <* reference til sender-procesnavn *>
3 4266
3 4266 <*+2*>if testbit7 and overvåget then
3 4267 disable begin
4 4268 laf2:= abs(laf);
4 4269 write(out,"nl",1,<:attention - :>);
4 4270 if laf<=0 then write(out,<:Regrettet :>);
4 4271 write(out,<:Message modtaget fra :>);
4 4272 if laf2 > 0 then write(out,core.laf2) else write(out,<:???:>);
4 4273 skriv_hele(out,att_message.raf,16,127);
4 4274 ud;
4 4275 end;
3 4276 <*-2*>
3 4277 \f
3 4277 message procedure attention side 3 - 830310/cl;
3 4278
3 4278 if laf <= 0 then
3 4279 i:= -1
3 4280 else
3 4281 if core.laf(1)=konsol_navn.laf1(1)
3 4282 and core.laf(2)=konsol_navn.laf1(2) then
3 4283 i:= 101
3 4284 else
3 4285 begin
4 4286 i:= -1; j:= 1;
4 4287 while i=(-1) and (j <= max_antal_operatører) do
4 4288 begin
5 4289 laf2:= (j-1)*8;
5 4290 if core.laf(1) = terminal_navn.laf2(1)
5 4291 and core.laf(2) = terminal_navn.laf2(2) then i:= 200+j;
5 4292 j:= j+1;
5 4293 end;
4 4294 j:= 1;
4 4295 while i=(-1) and (j<=max_antal_garageterminaler) do
4 4296 begin
5 4297 laf2:= (j-1)*8;
5 4298 if core.laf(1) = garage_terminal_navn.laf2(1)
5 4299 and core.laf(2) = garage_terminal_navn.laf2(2) then i:= 300+j;
5 4300 j:= j+1;
5 4301 end;
4 4302 end;
3 4303
3 4303 if i=101 or (201<=i and i<=200+max_antal_operatører)
3 4304 <* or (301<=i and i<=300+max_antal_garageterminaler) *>
3 4305 then
3 4306 begin
4 4307
4 4307 j:= if i=101 then 0
4 4308 else max_antal_operatører*(i//100-2)+i mod 100;
4 4309
4 4309 ref:=j*terminal_beskr_længde;
4 4310 att_message(9):=
4 4311 if terminal_tab.ref.terminal_tilstand>=0 then 1 <*normal*>
4 4312 else 4 <*disconnected*>;
4 4313 optaget:=læsbit_ia(att_flag,j);
4 4314 if optaget and att_message(9)=1 then
4 4315 sætbit_ia(att_signal,j,0<*1 for 'husket' attention*>)
4 4316 else optaget:=optaget or att_message(9)<>1;
4 4317 if i//100=2 and terminal_tab.ref.terminal_tilstand < 0 then
4 4318 begin <* att fra ekskluderet operatør - inkluder *>
5 4319 start_operation(op_ref,010,cs_att_pulje,1<*IN,O*>);
5 4320 d.op_ref.data(1):= i mod 100;
5 4321 signalch(cs_rad,op_ref,gen_optype);
5 4322 waitch(cs_att_pulje,op_ref,true,-1);
5 4323 end;
4 4324 end
3 4325 else
3 4326 begin
4 4327 optaget:= true;
4 4328 att_message(9):= 2 <*rejected*>;
4 4329 end;
3 4330
3 4330 monitor(22)send_answer:(zdummy,mess_ref,att_message);
3 4331
3 4331 until -,optaget;
3 4332 \f
3 4332 message procedure attention side 4 - 810424/hko;
3 4333
3 4333 sætbit_ia(att_flag,j,1);
3 4334
3 4334 start_operation(op_ref,i,cs_att_pulje,0);
3 4335
3 4335 signal_ch(case i//100 of (cs_io,cs_op,cs_gar),op_ref,gen_optype);
3 4336
3 4336 until false;
3 4337
3 4337 att_trap:
3 4338
3 4338 skriv_attention(zbillede,1);
3 4339
3 4339
3 4339 end attention;
2 4340
2 4340 \f
2 4340 message io_erklæringer side 1 - 810421/hko;
2 4341
2 4341 integer
2 4342 cs_io,
2 4343 cs_io_komm,
2 4344 cs_io_fil,
2 4345 cs_io_spool,
2 4346 cs_io_medd,
2 4347 ss_io_spool_tomme,
2 4348 ss_io_spool_fulde,
2 4349 bs_zio_adgang,
2 4350 io_spool_fil,
2 4351 io_spool_postantal,
2 4352 io_spool_postlængde;
2 4353
2 4353 integer array field
2 4354 io_spool_post;
2 4355
2 4355 zone z_io(32,1,io_fejl);
2 4356
2 4356 procedure io_fejl(z,s,b);
2 4357 integer s,b;
2 4358 zone z;
2 4359 begin
3 4360 disable begin
4 4361 integer array iz(1:20);
4 4362 integer i,j,k;
4 4363 integer array field iaf;
4 4364 real array field raf;
4 4365 if s<>(1 shift 21 + 2) then
4 4366 begin
5 4367 getzone6(z,iz);
5 4368 raf:=2;
5 4369 iaf:=0;
5 4370 k:=1;
5 4371
5 4371 j:= terminal_tab.iaf.terminal_tilstand;
5 4372 if j shift(-21)<>6 then
5 4373 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
5 4374 1 shift 12 <*binært*> +1 <*fortsæt*>);
5 4375 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
5 4376 + terminal_tab.iaf.terminal_tilstand extract 21;
5 4377 end;
4 4378 z(1):=real <:<'?'><'?'><'em'>:>;
4 4379 b:=2;
4 4380 end; <*disable*>
3 4381 end io_fejl;
2 4382 \f
2 4382 message procedure skriv_auto_spring_medd side 1 - 820301/hko;
2 4383
2 4383 procedure skriv_auto_spring_medd(z,medd,tid);
2 4384 value tid;
2 4385 zone z;
2 4386 real tid;
2 4387 integer array medd;
2 4388 begin
3 4389 disable begin
4 4390 real t;
4 4391 integer kode,bus,linie,bogst,løb,dato,kl;
4 4392 long array indeks(1:1);
4 4393 kode:= medd(1);
4 4394 indeks(1):= extend medd(5) shift 24;
4 4395 if kode > 0 and kode < 10 then
4 4396 begin
5 4397 write(z,"nl",0,<:-<'>'>:>,case kode of(
5 4398 <*1*><:linie/løb ikke indsat :>,<*sletning/omkodning/spring *>
5 4399 <*2*><:linie/løb allerede indsat:>,<*omkodning/spring *>
5 4400 <*3*><:vogn i kø:>, <*påmindelse i forb. omkod./spring*>
5 4401 <*4*><:vogn optaget:>, <* - i - - / - *>
5 4402 <*5*><:spring annulleret:>, <*udløb af ventetid *>
5 4403 <*6*><::>, <* - af springliste *>
5 4404 <*7*><::>, <*start af springsekvens *>
5 4405 <*8*><::>, <*afvikling af springsekvens *>
5 4406 <*9*><:område kan ikke opdateres:>,<*vt-ændring*>
5 4407 <::>));
5 4408 <* if kode = 5 then
5 4409 begin
5 4410 bogst:= medd(4);
5 4411 linie:= bogst shift(-5) extract 10;
5 4412 bogst:= bogst extract 5;
5 4413 if bogst > 0 then bogst:= bogst +'A'-1;
5 4414 write(z,"sp",1,<<z>,linie,false add bogst,1,
5 4415 ".",1,indeks);
5 4416 end;
5 4417 *>
5 4418 outchar(z,'sp');
5 4419 bus:= medd(2) extract 14;
5 4420 if bus > 0 then
5 4421 write(z,<<z>,bus,"/",1);
5 4422 løb:= medd(3);
5 4423 <*+4*> if løb shift(-22) <> 1 and løb <> 0 then
5 4424 fejlreaktion(3<*programfejl*>,løb,<:ikke linie id, spon.medd.:>,1);
5 4425 <*-4*>
5 4426 \f
5 4426 message procedure skriv_auto_spring_medd side 2 - 810507/hko;
5 4427
5 4427 linie:= løb shift(-12) extract 10;
5 4428 bogst:= løb shift(-7) extract 5;
5 4429 if bogst > 0 then bogst:= bogst +'A'-1;
5 4430 løb:= løb extract 7;
5 4431 if medd(3) <> 0 or kode <> 5 then
5 4432 begin
6 4433 write(z,<<z>,linie,false add bogst,1,"/",1,løb,"sp",1);
6 4434 if kode = 5 or kode = 6 then write(z,<:er frit :>);
6 4435 end;
5 4436 if kode = 7 or kode = 8 then
5 4437 write(z,<*indeks,"sp",1,*>
5 4438 if kode=7 then <:udtaget :> else <:indsat :>);
5 4439
5 4439 dato:= systime(4,tid,t);
5 4440 kl:= t/100.0;
5 4441 løb:= replace_char(1<*space in number*>,'.');
5 4442 write(z,<<zd_dd_dd>,dato,<< zd_dd>,kl);
5 4443 replace_char(1,løb);
5 4444 end
4 4445 else <*kode < 1 or kode > 8*>
4 4446 fejlreaktion(3<*programfejl*>,kode,<:spon.medd. kode:>,1);
4 4447 end; <*disable*>
3 4448 end skriv_auto_spring_medd;
2 4449 \f
2 4449 message procedure h_io side 1 - 810507/hko;
2 4450
2 4450 <* hovedmodulkorutine for io *>
2 4451 procedure h_io;
2 4452 begin
3 4453 integer array field op_ref;
3 4454 integer k,dest_sem;
3 4455 procedure skriv_hio(zud,omfang);
3 4456 value omfang;
3 4457 zone zud;
3 4458 integer omfang;
3 4459 begin
4 4460
4 4460 write(zud,"nl",1,<:+++ hovedmodul io :>);
4 4461 if omfang>0 then
4 4462 disable begin integer x;
5 4463 trap(slut);
5 4464 write(zud,"nl",1,
5 4465 <: op_ref: :>,op_ref,"nl",1,
5 4466 <: k: :>,k,"nl",1,
5 4467 <: dest_sem: :>,dest_sem,"nl",1,
5 4468 <::>);
5 4469 skriv_coru(zud,coru_no(100));
5 4470 slut:
5 4471 end;
4 4472 end skriv_hio;
3 4473
3 4473 trap(hio_trap);
3 4474 stack_claim(if cm_test then 198 else 146);
3 4475
3 4475 <*+2*>
3 4476 if testbit0 and overvåget or testbit28 then
3 4477 skriv_hio(out,0);
3 4478 <*-2*>
3 4479 \f
3 4479 message procedure h_io side 2 - 810507/hko;
3 4480
3 4480 repeat
3 4481 wait_ch(cs_io,op_ref,true,-1);
3 4482 <*+4*>
3 4483 if (d.op_ref.optype and (io_optype or gen_optype)) extract 12 =0
3 4484 then fejlreaktion(12<*operationstype*>,op_ref,<:operation til io:>,1);
3 4485 <*-4*>
3 4486
3 4486 k:=d.op_ref.opkode extract 12;
3 4487 dest_sem:=
3 4488 if k = 0 <*attention*> then cs_io_komm else
3 4489
3 4489 if k = 22 <*auto vt opdatering*>
3 4490 or k = 23 <*generel meddelelse*>
3 4491 or k = 36 <*spring meddelelse*>
3 4492 or k = 44 <*udeladt i gruppeopkald*>
3 4493 or k = 45 <*nødopkald modtaget*>
3 4494 or k = 46 <*nødopkald besvaret*> then cs_io_spool else
3 4495
3 4495 if k = 38 <*meddelelse til alle skærme*> then cs_io_medd else
3 4496 0;
3 4497 <*+4*>
3 4498 if dest_sem = 0 then
3 4499 begin
4 4500 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul io:>,1);
4 4501 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 4502 end
3 4503 else
3 4504 <*-4*>
3 4505 begin
4 4506 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 4507 end;
3 4508 until false;
3 4509
3 4509 hio_trap:
3 4510 disable skriv_hio(zbillede,1);
3 4511 end h_io;
2 4512 \f
2 4512 message procedure io_komm side 1 - 810507/hko;
2 4513
2 4513 procedure io_komm;
2 4514 begin
3 4515 integer array field op_ref,ref,vt_op,iaf;
3 4516 integer kode,aktion,status,opgave,dest_sem,vogn,ll,omr,
3 4517 pos,indeks,sep,sluttegn,operatør,i,j,k;
3 4518 long navn;
3 4519
3 4519 procedure skriv_io_komm(zud,omfang);
3 4520 value omfang;
3 4521 zone zud;
3 4522 integer omfang;
3 4523 begin
4 4524
4 4524 disable
4 4525
4 4525 write(zud,"nl",1,<:+++ io_komm :>);
4 4526 if omfang > 0 then
4 4527 disable begin integer x;
5 4528 trap(slut);
5 4529 write(zud,"nl",1,
5 4530 <: op-ref: :>,op_ref,"nl",1,
5 4531 <: kode: :>,kode,"nl",1,
5 4532 <: aktion: :>,aktion,"nl",1,
5 4533 <: ref: :>,ref,"nl",1,
5 4534 <: vt_op: :>,vt_op,"nl",1,
5 4535 <: status: :>,status,"nl",1,
5 4536 <: opgave: :>,opgave,"nl",1,
5 4537 <: dest-sem: :>,dest_sem,"nl",1,
5 4538 <: iaf: :>,iaf,"nl",1,
5 4539 <: i: :>,i,"nl",1,
5 4540 <: j: :>,j,"nl",1,
5 4541 <: k: :>,k,"nl",1,
5 4542 <: navn: :>,string navn,"nl",1,
5 4543 <: pos: :>,pos,"nl",1,
5 4544 <: indeks: :>,indeks,"nl",1,
5 4545 <: sep: :>,sep,"nl",1,
5 4546 <: sluttegn: :>,sluttegn,"nl",1,
5 4547 <: vogn: :>,vogn,"nl",1,
5 4548 <: ll: :>,ll,"nl",1,
5 4549 <: omr: :>,omr,"nl",1,
5 4550 <: operatør: :>,operatør,"nl",1,
5 4551 <::>);
5 4552 skriv_coru(zud,coru_no(101));
5 4553 slut:
5 4554 end;
4 4555 end skriv_io_komm;
3 4556 \f
3 4556 message procedure io_komm side 2 - 810424/hko;
3 4557
3 4557 trap(io_komm_trap);
3 4558 stack_claim((if cm_test then 200 else 146)+24+200);
3 4559
3 4559 ref:=0;
3 4560 navn:= long<::>;
3 4561
3 4561 <*+2*>
3 4562 if testbit0 and overvåget or testbit28 then
3 4563 skriv_io_komm(out,0);
3 4564 <*-2*>
3 4565
3 4565 repeat
3 4566
3 4566 <*V*> wait_ch(cs_io_komm,
3 4567 op_ref,
3 4568 true,
3 4569 -1<*timeout*>);
3 4570 <*+2*>
3 4571 if testbit1 and overvåget then
3 4572 disable begin
4 4573 skriv_io_komm(out,0);
4 4574 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_io,
4 4575 <: til io :>);
4 4576 skriv_op(out,op_ref);
4 4577 end;
3 4578 <*-2*>
3 4579
3 4579 kode:= d.op_ref.op_kode;
3 4580 i:= terminal_tab.ref.terminal_tilstand;
3 4581 status:= i shift(-21);
3 4582 opgave:=
3 4583 if kode=0 then 1 <* indlæs kommando *> else
3 4584 0; <* afvises *>
3 4585
3 4585 aktion:= if opgave = 0 then 0 else
3 4586 (case status +1 of(
3 4587 <* status *>
3 4588 <* 0 klar *>(1),
3 4589 <* 1 - *>(-1),<* ulovlig tilstand *>
3 4590 <* 2 - *>(-1),<* ulovlig tilstand *>
3 4591 <* 3 stoppet *>(2),
3 4592 <* 4 noneksist *>(-1),<* ulovlig tilstand *>
3 4593 <* 5 - *>(-1),<* ulovlig tilstand *>
3 4594 <* 6 - *>(-1),<* ulovlig tilstand *>
3 4595 <* 7 ej knyttet *>(-1),<* ulovlig tilstand *>
3 4596 -1));
3 4597 \f
3 4597 message procedure io_komm side 3 - 810428/hko;
3 4598
3 4598 case aktion+6 of
3 4599 begin
4 4600 begin
5 4601 <*-5: terminal optaget *>
5 4602
5 4602 d.op_ref.resultat:= 16;
5 4603 afslut_operation(op_ref,-1);
5 4604 end;
4 4605
4 4605 begin
5 4606 <*-4: operation uden virkning *>
5 4607
5 4607 afslut_operation(op_ref,-1);
5 4608 end;
4 4609
4 4609 begin
5 4610 <*-3: ulovlig operationskode *>
5 4611
5 4611 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 4612 afslut_operation(op_ref,-1);
5 4613 end;
4 4614
4 4614 begin
5 4615 <*-2: ulovlig aktion *>
5 4616
5 4616 fejl_reaktion(3<*programfejl*>,-2,<: ulovlig aktion:>,0);
5 4617 afslut_operation(op_ref,-1);
5 4618 end;
4 4619
4 4619 begin
5 4620 <*-1: ulovlig io_tilstand *>
5 4621
5 4621 fejl_reaktion(3<*programfejl*>,status,<: ulovlig io-status:>,0);
5 4622 afslut_operation(op_ref,-1);
5 4623 end;
4 4624
4 4624 begin
5 4625 <* 0: ikke implementeret *>
5 4626
5 4626 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 4627 afslut_operation(op_ref,-1);
5 4628 end;
4 4629
4 4629 begin
5 4630 \f
5 4630 message procedure io_komm side 4 - 851001/cl;
5 4631
5 4631 <* 1: indlæs kommando *>
5 4632 <*V*> wait(bs_zio_adgang);
5 4633
5 4633 <*V*> læs_kommando(z_io,101,op_ref,pos,indeks,sep,sluttegn);
5 4634
5 4634 if d.op_ref.resultat > 3 then
5 4635 begin
6 4636 <*V*> setposition(z_io,0,0);
6 4637 if sluttegn<>'nl' then outchar(z_io,'nl');
6 4638 skriv_kvittering(z_io,op_ref,pos,
6 4639 d.op_ref.resultat);
6 4640 end
5 4641 else if d.op_ref.resultat>0 then
5 4642 begin <*godkendt*>
6 4643 kode:=d.op_ref.opkode;
6 4644 i:= kode extract 12;
6 4645 j:= if kode < 5 or
6 4646 kode=7 or kode=8 or
6 4647 kode=72 or kode=73 or kode=74 then 1 <*IN,x/EK,x*>else
6 4648 if kode=5 or kode=77 then 9 <*FO,L/FO,O*>else
6 4649 if kode = 9 or kode=10 then 3 <*VO,B/VO,L*>else
6 4650 if kode =11 or kode=12 or kode=19 or <*VO,I/VO,U/VO,S*>
6 4651 kode=20 or kode=24 then 4<*VO,F/VO,R*>else
6 4652 if kode =21 then 5 <*AU*> else
6 4653 if kode =25 then 6 <*GR,D*> else
6 4654 if kode =26 then 5 <*GR,S*> else
6 4655 if kode =27 or kode =28 then 7 <*GR,V/GR,O*>else
6 4656 if kode =30 then 10 <*SP,D*> else
6 4657 if kode =31 then 5 <*SP*> else
6 4658 if kode =32 or kode =33 then 8 <*SP,V/SP,O*>else
6 4659 if kode =34 or kode =35 then 5 <*SP,R/SP,A*>else
6 4660 if kode=71 then 11 <*FO,V*> else
6 4661 if kode =75 then 12 <*TÆ,V *>else
6 4662 if kode =76 then 12 <*TÆ,N *>else
6 4663 if kode =65 then 13 <*BE,N *>else
6 4664 if kode =66 then 14 <*BE,G *>else
6 4665 if kode =67 then 15 <*BE,V *>else
6 4666 if kode =68 then 16 <*ST,D *>else
6 4667 if kode =69 then 17 <*ST,V *>else
6 4668 if kode =36 then 18 <*AL *>else
6 4669 if kode =37 then 19 <*CC *>else
6 4670 if kode>=80 and kode <=88 then 2 <*sys-spec.*>else
6 4671 if kode>=90 and kode <=92 then 20 <*CQF,I/U/V*>else
6 4672 0;
6 4673 if j > 0 then
6 4674 begin
7 4675 case j of
7 4676 begin
8 4677 begin
9 4678 \f
9 4678 message procedure io_komm side 5 - 810424/hko;
9 4679
9 4679 <* 1: inkluder/ekskluder ydre enhed *>
9 4680
9 4680 d.op_ref.retur:= cs_io_komm;
9 4681 if kode=1 then d.opref.opkode:=
9 4682 ia(2) shift 12 + d.opref.opkode extract 12;
9 4683 d.op_ref.data(1):= ia(1);
9 4684 signal_ch(if kode < 5 or kode>=72 then cs_rad
9 4685 else cs_gar,
9 4686 op_ref,gen_optype or io_optype);
9 4687 indeks:= op_ref;
9 4688 wait_ch(cs_io_komm,
9 4689 op_ref,
9 4690 true,
9 4691 -1<*timeout*>);
9 4692 <*+4*> if op_ref <> indeks then
9 4693 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4694 <*-4*>
9 4695 <*V*> setposition(z_io,0,0);
9 4696 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4697 skriv_kvittering(z_io,op_ref,-1,
9 4698 d.op_ref.resultat);
9 4699 end;
8 4700
8 4700 begin
9 4701 \f
9 4701 message procedure io_komm side 6 - 810501/hko;
9 4702
9 4702 <* 2: tid/attention,ja/attention,nej
9 4703 slut/slut med billede *>
9 4704
9 4704 case d.op_ref.opkode -79 of
9 4705 begin
10 4706
10 4706 <* 80: TI *> begin
11 4707 setposition(z_io,0,0);
11 4708 if sluttegn<>'nl' then outchar(z_io,'nl');
11 4709 if ia(1) <> 0 or ia(2) <> 0 then
11 4710 begin real field rf;
12 4711 rf:= 4;
12 4712 trap(forbudt);
12 4713 <*V*> setposition(z_io,0,0);
12 4714 systime(3,ia.rf,0.0);
12 4715 if false then
12 4716 begin
13 4717 forbudt: skriv_kvittering(z_io,0,-1,
13 4718 43<*ændring af dato/tid ikke lovlig*>);
13 4719 end
12 4720 else
12 4721 skriv_kvittering(z_io,0,-1,3);
12 4722 end
11 4723 else
11 4724 begin
12 4725 setposition(z_io,0,0);
12 4726 write(z_io,<<zddddd>,systime(5,0,r),".",1,r);
12 4727 end;
11 4728 end TI;
10 4729 \f
10 4729 message procedure io_komm side 7 - 810424/hko;
10 4730
10 4730 <*81: AT,J*> begin
11 4731 <*V*> setposition(z_io,0,0);
11 4732 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4733 monitor(10)release process:(z_io,0,ia);
11 4734 skriv_kvittering(z_io,0,-1,3);
11 4735 end;
10 4736
10 4736 <* 82: AT,N*> begin
11 4737 i:= monitor(8)reserve process:(z_io,0,ia);
11 4738 <*V*> setposition(z_io,0,0);
11 4739 if sluttegn <> 'nl' then outchar(zio,'nl');
11 4740 skriv_kvittering(z_io,0,-1,
11 4741 if i = 0 then 3 else 0);
11 4742 end;
10 4743
10 4743 <* 83: SL *> begin
11 4744 errorbits:=0; <* warning.no ok.yes *>
11 4745 trapmode:= 1 shift 13;
11 4746 trap(-2);
11 4747 end;
10 4748
10 4748 <* 84: SL,B *>begin
11 4749 errorbits:=1; <* warning.no ok.no *>
11 4750 trap(-3);
11 4751 end;
10 4752 <* 85: SL,K *>begin
11 4753 errorbits:=1; <* warning.no ok.no *>
11 4754 disable sæt_bit_i(trapmode,15,0);
11 4755 trap(-3);
11 4756 end;
10 4757 \f
10 4757 message procedure io_komm side 7a - 810511/cl;
10 4758
10 4758 <* 86: TE,J *>begin
11 4759 setposition(z_io,0,0);
11 4760 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4761 for i:= 1 step 1 until indeks do
11 4762 if 0<=ia(i) and ia(i)<=47 then
11 4763 begin
12 4764 case (ia(i)+1) of
12 4765 begin
13 4766 testbit0 := true;testbit1 := true;testbit2 := true;
13 4767 testbit3 := true;testbit4 := true;testbit5 := true;
13 4768 testbit6 := true;testbit7 := true;testbit8 := true;
13 4769 testbit9 := true;testbit10:= true;testbit11:= true;
13 4770 testbit12:= true;testbit13:= true;testbit14:= true;
13 4771 testbit15:= true;testbit16:= true;testbit17:= true;
13 4772 testbit18:= true;testbit19:= true;testbit20:= true;
13 4773 testbit21:= true;testbit22:= true;testbit23:= true;
13 4774 testbit24:= true;testbit25:= true;testbit26:= true;
13 4775 testbit27:= true;testbit28:= true;testbit29:= true;
13 4776 testbit30:= true;testbit31:= true;testbit32:= true;
13 4777 testbit33:= true;testbit34:= true;testbit35:= true;
13 4778 testbit36:= true;testbit37:= true;testbit38:= true;
13 4779 testbit39:= true;testbit40:= true;testbit41:= true;
13 4780 testbit42:= true;testbit43:= true;testbit44:= true;
13 4781 testbit45:= true;testbit46:= true;testbit47:= true;
13 4782 end;
12 4783 end;
11 4784 skriv_kvittering(z_io,0,-1,3);
11 4785 end;
10 4786 \f
10 4786 message procedure io_komm side 7b - 810511/cl;
10 4787
10 4787 <* 87: TE,N *>begin
11 4788 setposition(z_io,0,0);
11 4789 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 4790 for i:= 1 step 1 until indeks do
11 4791 if 0<=ia(i) and ia(i)<=47 then
11 4792 begin
12 4793 case (ia(i)+1) of
12 4794 begin
13 4795 testbit0 := false;testbit1 := false;testbit2 := false;
13 4796 testbit3 := false;testbit4 := false;testbit5 := false;
13 4797 testbit6 := false;testbit7 := false;testbit8 := false;
13 4798 testbit9 := false;testbit10:= false;testbit11:= false;
13 4799 testbit12:= false;testbit13:= false;testbit14:= false;
13 4800 testbit15:= false;testbit16:= false;testbit17:= false;
13 4801 testbit18:= false;testbit19:= false;testbit20:= false;
13 4802 testbit21:= false;testbit22:= false;testbit23:= false;
13 4803 testbit24:= false;testbit25:= false;testbit26:= false;
13 4804 testbit27:= false;testbit28:= false;testbit29:= false;
13 4805 testbit30:= false;testbit31:= false;testbit32:= false;
13 4806 testbit33:= false;testbit34:= false;testbit35:= false;
13 4807 testbit36:= false;testbit37:= false;testbit38:= false;
13 4808 testbit39:= false;testbit40:= false;testbit41:= false;
13 4809 testbit42:= false;testbit43:= false;testbit44:= false;
13 4810 testbit45:= false;testbit46:= false;testbit47:= false;
13 4811 end;
12 4812 end;
11 4813 skriv_kvittering(z_io,0,-1,3);
11 4814 end;
10 4815
10 4815 <* 88: O *> begin
11 4816 integer array odescr,zdescr(1:20);
11 4817 long array field laf;
11 4818 integer res, i, j;
11 4819
11 4819 i:= j:= 1;
11 4820 while læstegn(ia,i,res)<>0 do
11 4821 begin
12 4822 if 'A'<=res and res<='Å' then res:= res - 'A' + 'a';
12 4823 skrivtegn(ia,j,res);
12 4824 end;
11 4825
11 4825 laf:= 2;
11 4826 getzone6(out,odescr);
11 4827 getzone6(z_io,zdescr);
11 4828 close(out,zdescr.laf(1)<>odescr.laf(1) or
11 4829 zdescr.laf(2)<>odescr.laf(2));
11 4830 laf:= 0;
11 4831
11 4831 if ia(1)=0 then
11 4832 begin
12 4833 res:= 3;
12 4834 j:= 0;
12 4835 end
11 4836 else
11 4837 begin
12 4838 j:= res:= openbs(out,j,ia,0);
12 4839 if res<>0 then
12 4840 res:= 46;
12 4841 end;
11 4842 if res<>0 then
11 4843 begin
12 4844 open(out,8,konsol_navn,0);
12 4845 if j<>0 then
12 4846 begin
13 4847 i:= 1;
13 4848 fejlreaktion(4,j,string ia.laf(increase(i)),1);
13 4849 end;
12 4850 end
11 4851 else res:= 3;
11 4852 setposition(z_io,0,0);
11 4853 skriv_kvittering(z_io,0,-1,res);
11 4854 end;
10 4855 end;<*case d.op_ref.opkode -79*>
9 4856 end;<*case 2*>
8 4857 begin
9 4858 \f
9 4858 message procedure io_komm side 8 - 810424/hko;
9 4859
9 4859 <* 3: vogntabel,linienr/-,busnr*>
9 4860
9 4860 d.op_ref.retur:= cs_io_komm;
9 4861 tofrom(d.op_ref.data,ia,10);
9 4862 indeks:= op_ref;
9 4863 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 4864 wait_ch(cs_io_komm,
9 4865 op_ref,
9 4866 io_optype,
9 4867 -1<*timeout*>);
9 4868 <*+2*> if testbit2 and overvåget then
9 4869 disable begin
10 4870 skriv_io_komm(out,0);
10 4871 write(out,"nl",1,<:io operation retur fra vt:>);
10 4872 skriv_op(out,op_ref);
10 4873 end;
9 4874 <*-2*>
9 4875 <*+4*> if indeks <> op_ref then
9 4876 fejlreaktion(11<*fremmed post*>,op_ref,<:io_kommando:>,0);
9 4877 <*-4*>
9 4878
9 4878 i:=d.op_ref.resultat;
9 4879 if i<1 or i>3 then
9 4880 begin
10 4881 <*V*> setposition(z_io,0,0);
10 4882 if sluttegn<>'nl' then outchar(z_io,'nl');
10 4883 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 4884 end
9 4885 else
9 4886 begin
10 4887 \f
10 4887 message procedure io_komm side 9 - 820301/hko,cl;
10 4888
10 4888 integer antal,filref;
10 4889
10 4889 antal:= d.op_ref.data(6);
10 4890 fil_ref:= d.op_ref.data(7);
10 4891 pos:= 0;
10 4892 <*V*> setposition(zio,0,0);
10 4893 if sluttegn <> 'nl' then outchar(z_io,'nl');
10 4894 for pos:= pos +1 while pos <= antal do
10 4895 begin
11 4896 integer bogst,løb;
11 4897
11 4897 disable i:= læsfil(fil_ref,pos,j);
11 4898 if i <> 0 then
11 4899 fejlreaktion(5<*læs_fel*>,i,<:io komm., vo,l/vo,b:>,0);
11 4900 vogn:= fil(j,1) shift (-24) extract 24;
11 4901 løb:= fil(j,1) extract 24;
11 4902 if d.op_ref.opkode=9 then
11 4903 begin i:=vogn; vogn:=løb; løb:=i; end;
11 4904 ll:= løb shift(-12) extract 10;
11 4905 bogst:= løb shift(-7) extract 5;
11 4906 if bogst > 0 then bogst:= bogst+'A'-1;
11 4907 løb:= løb extract 7;
11 4908 vogn:= vogn extract 14;
11 4909 i:= d.op_ref.opkode -8;
11 4910 for i:= i,i +1 do
11 4911 begin
12 4912 j:= (i+1) extract 1;
12 4913 case j+1 of
12 4914 begin
13 4915 write(zio,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 4916 false add bogst,1,"/",1,true,3,<<d>,løb);
13 4917 write(zio,<<dddd>,vogn,"sp",1);
13 4918 end;
12 4919 end;
11 4920 if pos mod 5 = 0 then
11 4921 begin
12 4922 outchar(zio,'nl');
12 4923 <*V*> setposition(zio,0,0);
12 4924 end
11 4925 else write(zio,"sp",3);
11 4926 end;
10 4927 write(zio,"*",1);
10 4928 \f
10 4928 message procedure io_komm side 9a - 810505/hko;
10 4929
10 4929 d.op_ref.opkode:=104;<*slet fil*>
10 4930 d.op_ref.data(4):=filref;
10 4931 indeks:=op_ref;
10 4932 signal_ch(cs_slet_fil,op_ref,genoptype or iooptype);
10 4933 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
10 4934
10 4934 <*+2*> if testbit2 and overvåget then
10 4935 disable begin
11 4936 skriv_io_komm(out,0);
11 4937 write(out,"nl",1,<:io operation retur fra sletfil:>);
11 4938 skriv_op(out,op_ref);
11 4939 end;
10 4940 <*-2*>
10 4941
10 4941 <*+4*> if op_ref<>indeks then
10 4942 fejlreaktion(11<*fr.post*>,op_ref,<:io-komm, sletfil:>,0);
10 4943 <*-4*>
10 4944 if d.op_ref.data(9)<>0 then
10 4945 fejlreaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 4946 <:io-komm, sletfil:>,1);
10 4947 end;
9 4948 end;
8 4949
8 4949 begin
9 4950 \f
9 4950 message procedure io_komm side 10 - 820301/hko;
9 4951
9 4951 <* 4 indsæt/udtag/flyt bus i vogntabel, slet vogntabel *>
9 4952
9 4952 vogn:=ia(1);
9 4953 ll:=ia(2);
9 4954 omr:= if kode=11 or kode=19 then ia(3) else
9 4955 if kode=12 then ia(2) else 0;
9 4956 if kode=19 and omr<=0 then
9 4957 begin
10 4958 if omr=-1 then omr:= 0
10 4959 else omr:= 14 shift 20 + 3; <*OMR TCT*>
10 4960 end;
9 4961 <*V*> wait_ch(cs_vt_adgang,
9 4962 vt_op,
9 4963 gen_optype,
9 4964 -1<*timeout sek*>);
9 4965 start_operation(vtop,101,cs_io_komm,
9 4966 kode);
9 4967 d.vt_op.data(1):=vogn;
9 4968 d.vt_op.data(2):=ll;
9 4969 d.vt_op.data(if kode=19 then 3 else 4):= omr;
9 4970 indeks:= vt_op;
9 4971 signal_ch(cs_vt,
9 4972 vt_op,
9 4973 gen_optype or io_optype);
9 4974
9 4974 <*V*> wait_ch(cs_io_komm,
9 4975 vt_op,
9 4976 io_optype,
9 4977 -1<*timeout sek*>);
9 4978 <*+2*> if testbit2 and overvåget then
9 4979 disable begin
10 4980 skriv_io_komm(out,0);
10 4981 write(out,"nl",1,
10 4982 <:iooperation retur fra vt:>);
10 4983 skriv_op(out,vt_op);
10 4984 end;
9 4985 <*-2*>
9 4986 <*+4*> if vt_op<>indeks then
9 4987 fejl_reaktion(11<*fremmede op*>,op_ref,
9 4988 <:io-kommando:>,0);
9 4989 <*-4*>
9 4990 <*V*> setposition(z_io,0,0);
9 4991 if sluttegn<>'nl' then outchar(z_io,'nl');
9 4992 skriv_kvittering(z_io,if d.vt_op.resultat = 11 or
9 4993 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 4994 else vt_op,-1,d.vt_op.resultat);
9 4995 d.vt_op.optype:= genoptype or vt_optype;
9 4996 disable afslut_operation(vt_op,cs_vt_adgang);
9 4997 end;
8 4998
8 4998 begin
9 4999 \f
9 4999 message procedure io_komm side 11 - 810428/hko;
9 5000
9 5000 <* 5 autofil-skift
9 5001 gruppe,slet
9 5002 spring (igangsæt)
9 5003 spring,annuler
9 5004 spring,reserve *>
9 5005
9 5005 tofrom(d.op_ref.data,ia,8);
9 5006 d.op_ref.retur:=cs_io_komm;
9 5007 indeks:=op_ref;
9 5008 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5009 <*V*> wait_ch(cs_io_komm,
9 5010 op_ref,
9 5011 io_optype,
9 5012 -1<*timeout*>);
9 5013 <*+2*> if testbit2 and overvåget then
9 5014 disable begin
10 5015 skriv_io_komm(out,0);
10 5016 write(out,"nl",1,<:io operation retur fra vt:>);
10 5017 skriv_op(out,op_ref);
10 5018 end;
9 5019 <*-2*>
9 5020 <*+4*> if indeks<>op_ref then
9 5021 fejlreaktion(11<*fremmed post*>,op_ref,
9 5022 <:io-kommando(autofil):>,0);
9 5023 <*-4*>
9 5024
9 5024 <*V*> setposition(z_io,0,0);
9 5025 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5026 skriv_kvittering(z_io,if (d.op_ref.resultat=11 or
9 5027 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 5028 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 5029 end;
8 5030
8 5030 begin
9 5031 \f
9 5031 message procedure io_komm side 12 - 820301/hko/cl;
9 5032
9 5032 <* 6 gruppedefinition *>
9 5033
9 5033 tofrom(d.op_ref.data,ia,indeks*2);
9 5034 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5035 start_operation(vt_op,101,cs_io_komm,
9 5036 101<*opret fil*>);
9 5037 d.vt_op.data(1):=256;<*postantal*>
9 5038 d.vt_op.data(2):=1; <*postlængde*>
9 5039 d.vt_op.data(3):=1; <*segmentantal*>
9 5040 d.vt_op.data(4):=
9 5041 2 shift 10; <*spool fil*>
9 5042 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5043 pos:=vt_op;<*variabel lånes*>
9 5044 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5045 <*+4*> if vt_op<>pos then
9 5046 fejlreaktion(11<*fremmed post*>,vt_op,<:gruppedef:>,0);
9 5047 if d.vt_op.data(9)<>0 then
9 5048 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5049 <:io-kommando(gruppedefinition):>,0);
9 5050 <*-4*>
9 5051 iaf:=0;
9 5052 for i:=1 step 1 until indeks-1 do
9 5053 begin
10 5054 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5055 if k<>0 then
10 5056 fejlreaktion(7<*modif-fil*>,k,
10 5057 <:io kommando(gruppe-def):>,0);
10 5058 fil(j).iaf(1):=d.op_ref.data(i+1);
10 5059 end;
9 5060 while sep = ',' do
9 5061 begin
10 5062 wait(bs_fortsæt_adgang);
10 5063 pos:= 1; j:= 0;
10 5064 while læs_store(z_io,i) < 8 do
10 5065 begin
11 5066 skrivtegn(fortsæt,pos,i);
11 5067 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5068 end;
10 5069 skrivtegn(fortsæt,pos,'em');
10 5070 afsluttext(fortsæt,pos);
10 5071 sluttegn:= i;
10 5072 if j<>0 then
10 5073 begin
11 5074 setposition(z_io,0,0);
11 5075 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5076 skriv_kvittering(zio,opref,-1,53);<*annulleret*>
11 5077 goto gr_ann;
11 5078 end;
10 5079 \f
10 5079 message procedure io_komm side 13 - 810512/hko/cl;
10 5080
10 5080 disable begin
11 5081 integer array værdi(1:4);
11 5082 integer a_pos,res;
11 5083 pos:= 0;
11 5084 repeat
11 5085 apos:= pos;
11 5086 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5087 if res >= 0 then
11 5088 begin
12 5089 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5090 else if res=0 then res:= -25 <*parameter mangler*>
12 5091 else if res=2 and (værdi(1)<1 or værdi(1)>9999) then
12 5092 res:= -7 <*busnr ulovligt*>
12 5093 else if res=2 or res=6 then
12 5094 begin
13 5095 k:=modiffil(d.vt_op.data(4),indeks,j);
13 5096 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5097 <:io kommando(gruppe-def):>,0);
13 5098 iaf:= 0;
13 5099 fil(j).iaf(1):= værdi(1) +
13 5100 (if res=6 then 1 shift 22 else 0);
13 5101 indeks:= indeks+1;
13 5102 if sep = ',' then res:= 0;
13 5103 end
12 5104 else res:= -27; <*parametertype*>
12 5105 end;
11 5106 if res>0 then pos:= a_pos;
11 5107 until sep<>'sp' or res<=0;
11 5108
11 5108 if res<0 then
11 5109 begin
12 5110 d.op_ref.resultat:= -res;
12 5111 i:=1;
12 5112 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5113 afsluttext(d.op_ref.data,i);
12 5114 end;
11 5115 end;
10 5116 \f
10 5116 message procedure io_komm side 13a - 810512/hko/cl;
10 5117
10 5117 if d.op_ref.resultat > 3 then
10 5118 begin
11 5119 setposition(z_io,0,0);
11 5120 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5121 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5122 goto gr_ann;
11 5123 end;
10 5124 signalbin(bs_fortsæt_adgang);
10 5125 end while sep = ',';
9 5126 d.op_ref.data(2):= d.vt_op.data(1):=indeks-1;
9 5127 k:= sætfildim(d.vt_op.data);
9 5128 if k<>0 then fejlreaktion(9,k,<:io kommando(gruppe-def):>,0);
9 5129 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5130 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5131 d.op_ref.retur:=cs_io_komm;
9 5132 pos:=op_ref;
9 5133 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5134 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5135 <*+4*> if pos<>op_ref then
9 5136 fejlreaktion(11<*fremmed post*>,op_ref,
9 5137 <:io kommando(gruppedef retur fra vt):>,0);
9 5138 <*-4*>
9 5139
9 5139 <*V*> setposition(z_io,0,0);
9 5140 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5141 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5142
9 5142 if false then
9 5143 begin
10 5144 gr_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5145 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5146 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5147 end;
9 5148
9 5148 end;
8 5149
8 5149 begin
9 5150 \f
9 5150 message procedure io_komm side 14 - 810525/hko/cl;
9 5151
9 5151 <* 7 gruppe(-oversigts-)rapport *>
9 5152
9 5152 d.op_ref.retur:=cs_io_komm;
9 5153 d.op_ref.data(1):=ia(1);
9 5154 indeks:=op_ref;
9 5155 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5156 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5157
9 5157 <*+4*> if op_ref<>indeks then
9 5158 fejlreaktion(11<*fremmed post*>,op_ref,
9 5159 <:io-kommando(gruppe-rapport):>,0);
9 5160 <*-4*>
9 5161
9 5161 <*V*> setposition(z_io,0,0);
9 5162 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5163 if d.op_ref.resultat<>3 then
9 5164 begin
10 5165 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5166 end
9 5167 else
9 5168 begin
10 5169 integer bogst,løb;
10 5170
10 5170 if kode = 27 then <* gruppe,vis *>
10 5171 begin
11 5172 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:gruppe: :>,
11 5173 "G",1,<<z>,d.op_ref.data(1) extract 7,
11 5174 "sp",2,"-",5,"nl",1);
11 5175 \f
11 5175 message procedure io_komm side 15 - 820301/hko;
11 5176
11 5176 for pos:=1 step 1 until d.op_ref.data(2) do
11 5177 begin
12 5178 disable i:=læsfil(d.op_ref.data(3),pos,j);
12 5179 if i<>0 then
12 5180 fejlreaktion(5<*læsfil*>,i,
12 5181 <:io_kommando(gruppe,vis):>,0);
12 5182 iaf:=0;
12 5183 vogn:=fil(j).iaf(1);
12 5184 if vogn shift(-22) =0 then
12 5185 write(z_io,<<ddddddd>,vogn extract 14)
12 5186 else
12 5187 begin
13 5188 løb:=vogn extract 7;
13 5189 bogst:=vogn shift(-7) extract 5;
13 5190 if bogst>0 then bogst:=bogst+'A'-1;
13 5191 ll:=vogn shift(-12) extract 10;
13 5192 write(z_io,"sp",if bogst=0 then 1 else 0,<<ddd>,ll,
13 5193 false add bogst,1,"/",1,true,3,<<d>,løb);
13 5194 end;
12 5195 if pos mod 8 =0 then outchar(z_io,'nl')
12 5196 else write(z_io,"sp",2);
12 5197 end;
11 5198 write(z_io,"*",1);
11 5199 \f
11 5199 message procedure io_komm side 16 - 810512/hko/cl;
11 5200
11 5200 end
10 5201 else if kode=28 then <* gruppe,oversigt *>
10 5202 begin
11 5203 write(z_io,"nl",1,"-",5,"sp",2,<:gruppe oversigt:>,
11 5204 "sp",2,"-",5,"nl",2);
11 5205 for pos:=1 step 1 until d.op_ref.data(1) do
11 5206 begin
12 5207 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5208 if i<>0 then
12 5209 fejlreaktion(5<*læsfil*>,i,
12 5210 <:io-kommando(gruppe-oversigt):>,0);
12 5211 iaf:=0;
12 5212 ll:=fil(j).iaf(1);
12 5213 write(z_io,"G",1,<<z>,true,3,ll extract 7);
12 5214 if pos mod 10 =0 then outchar(z_io,'nl')
12 5215 else write(z_io,"sp",3);
12 5216 end;
11 5217 write(z_io,"*",1);
11 5218 end;
10 5219 <* slet fil *>
10 5220 d.op_ref.opkode:= 104;
10 5221 d.op_ref.data(4):= d.op_ref.data(if kode=28 then 2 else 3);
10 5222 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5223 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5224 end; <* resultat=3 *>
9 5225
9 5225 end;
8 5226
8 5226 begin
9 5227 \f
9 5227 message procedure io_komm side 17 - 810525/cl;
9 5228
9 5228 <* 8 spring(-oversigts-)rapport *>
9 5229
9 5229 d.op_ref.retur:=cs_io_komm;
9 5230 tofrom(d.op_ref.data,ia,4);
9 5231 indeks:=op_ref;
9 5232 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5233 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5234
9 5234 <*+4*> if op_ref<>indeks then
9 5235 fejlreaktion(11<*fremmed post*>,op_ref,
9 5236 <:io-kommando(spring-rapport):>,0);
9 5237 <*-4*>
9 5238
9 5238 <*V*> setposition(z_io,0,0);
9 5239 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5240 if d.op_ref.resultat<>3 then
9 5241 begin
10 5242 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
10 5243 end
9 5244 else
9 5245 begin
10 5246 boolean p_skrevet;
10 5247 integer bogst,løb;
10 5248
10 5248 if kode = 32 then <* spring,vis *>
10 5249 begin
11 5250 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 5251 bogst:= d.op_ref.data(1) extract 5;
11 5252 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 5253 <*V*> write(z_io,"nl",1,"-",5,"sp",2,<:spring: :>,
11 5254 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 5255 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 5256 raf:= data+8;
11 5257 if d.op_ref.raf(1)<>0.0 then
11 5258 write(z_io,<:, startet :>,<<zddddd>,round
11 5259 systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 5260 else
11 5261 write(z_io,<:, ikke startet:>);
11 5262 write(z_io,"sp",2,"-",5,"nl",1);
11 5263 \f
11 5263 message procedure io_komm side 18 - 810518/cl;
11 5264
11 5264 p_skrevet:= false;
11 5265 for pos:=1 step 1 until d.op_ref.data(3) do
11 5266 begin
12 5267 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 5268 if i<>0 then
12 5269 fejlreaktion(5<*læsfil*>,i,
12 5270 <:io_kommando(spring,vis):>,0);
12 5271 iaf:=0;
12 5272 i:= fil(j).iaf(1);
12 5273 if i < 0 and -, p_skrevet then
12 5274 begin
13 5275 outchar(z_io,'('); p_skrevet:= true;
13 5276 end;
12 5277 if i > 0 and p_skrevet then
12 5278 begin
13 5279 outchar(z_io,')'); p_skrevet:= false;
13 5280 end;
12 5281 if pos mod 2 = 0 then
12 5282 write(z_io,<< dd>,abs i,<:.:>)
12 5283 else
12 5284 write(z_io,true,3,<<d>,abs i);
12 5285 if pos mod 21 = 0 then outchar(z_io,'nl');
12 5286 end;
11 5287 write(z_io,"*",1);
11 5288 \f
11 5288 message procedure io_komm side 19 - 810525/cl;
11 5289
11 5289 end
10 5290 else if kode=33 then <* spring,oversigt *>
10 5291 begin
11 5292 write(z_io,"nl",1,"-",5,"sp",2,<:spring oversigt:>,
11 5293 "sp",2,"-",5,"nl",2);
11 5294 for pos:=1 step 1 until d.op_ref.data(1) do
11 5295 begin
12 5296 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 5297 if i<>0 then
12 5298 fejlreaktion(5<*læsfil*>,i,
12 5299 <:io-kommando(spring-oversigt):>,0);
12 5300 iaf:=0;
12 5301 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 5302 bogst:=fil(j).iaf(1) extract 5;
12 5303 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 5304 write(z_io,"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 5305 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 5306 string (extend fil(j).iaf(2) shift 24));
12 5307 if fil(j,2)<>0.0 then
12 5308 write(z_io,<:startet :>,<<zddddd>,
12 5309 round systime(4,fil(j,2),r),<:.:>,round r);
12 5310 outchar(z_io,'nl');
12 5311 end;
11 5312 write(z_io,"*",1);
11 5313 end;
10 5314 <* slet fil *>
10 5315 d.op_ref.opkode:= 104;
10 5316 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 5317 signalch(cs_slet_fil,op_ref,gen_optype or io_optype);
10 5318 waitch(cs_io_komm,op_ref,io_optype or gen_optype,-1);
10 5319 end; <* resultat=3 *>
9 5320
9 5320 end;
8 5321
8 5321 begin
9 5322 \f
9 5322 message procedure io_komm side 20 - 820302/hko;
9 5323
9 5323 <* 9 fordeling af linier/områder på operatører *>
9 5324
9 5324 d.op_ref.retur:=cs_io_komm;
9 5325 disable
9 5326 if kode=5 then
9 5327 begin
10 5328 integer array io_linietabel(1:max_linienr//3+1);
10 5329
10 5329 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5330 begin
11 5331 i:= læs_fil(1035,ref//512+1,j);
11 5332 if i <> 0 then
11 5333 fejlreaktion(5,i,<:liniefordelingstabel:>,0);
11 5334 tofrom(io_linietabel.ref,fil(j),
11 5335 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
11 5336 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
11 5337 end;
10 5338 ref:=0;
10 5339 operatør:=ia(1);
10 5340 for j:=2 step 1 until indeks do
10 5341 begin
11 5342 ll:=ia(j);
11 5343 if ll<>0 then
11 5344 skrivtegn(io_linietabel,abs(ll)+1,
11 5345 if ll>0 then operatør else 0);
11 5346 end;
10 5347 for ref:= 0 step 512 until (max_linienr//768*512) do
10 5348 begin
11 5349 i:= skriv_fil(1035,ref//512+1,j);
11 5350 if i <> 0 then
11 5351 fejlreaktion(6,i,<:liniefordelingstabel:>,0);
11 5352 tofrom(fil(j),io_linietabel.ref,
11 5353 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512
11 5354 then 512 else ((max_linienr+1 - (ref//2*3))+2)//3*2
11 5355 );
11 5356 end;
10 5357 ref:=0;
10 5358 end
9 5359 else
9 5360 begin
10 5361 modiffil(1034,1,i);
10 5362 ref:=0;
10 5363 operatør:=ia(1);
10 5364 for j:=2 step 1 until indeks do
10 5365 begin
11 5366 ll:=ia(j);
11 5367 fil(i).ref(ll):= if ll>0 then operatør else 0;
11 5368 end;
10 5369 end;
9 5370 indeks:=op_ref;
9 5371 signal_ch(cs_rad,op_ref,gen_optype or io_optype);
9 5372 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1);
9 5373
9 5373 <*+4*> if op_ref<>indeks then
9 5374 fejlreaktion(11<*fr.post*>,op_ref,
9 5375 <:io-komm,liniefordeling retur fra rad:>,0);
9 5376 <*-4*>
9 5377
9 5377 <*V*> setposition(z_io,0,0);
9 5378 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5379 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5380
9 5380 end;
8 5381
8 5381 begin
9 5382 \f
9 5382 message procedure io_komm side 21 - 820301/cl;
9 5383
9 5383 <* 10 springdefinition *>
9 5384
9 5384 tofrom(d.op_ref.data,ia,indeks*2);
9 5385 <*V*> wait_ch(cs_io_fil,vt_op,true,-1<*timeout*>);
9 5386 start_operation(vt_op,101,cs_io_komm,
9 5387 101<*opret fil*>);
9 5388 d.vt_op.data(1):=128;<*postantal*>
9 5389 d.vt_op.data(2):=2; <*postlængde*>
9 5390 d.vt_op.data(3):=1; <*segmentantal*>
9 5391 d.vt_op.data(4):=
9 5392 2 shift 10; <*spool fil*>
9 5393 signal_ch(cs_opret_fil,vt_op,io_optype);
9 5394 pos:=vt_op;<*variabel lånes*>
9 5395 <*V*> wait_ch(cs_io_komm,vt_op,io_optype,-1<*timeout*>);
9 5396 <*+4*> if vt_op<>pos then
9 5397 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 5398 if d.vt_op.data(9)<>0 then
9 5399 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 5400 <:io-kommando(springdefinition):>,0);
9 5401 <*-4*>
9 5402 iaf:=0;
9 5403 for i:=1 step 1 until indeks-2 do
9 5404 begin
10 5405 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 5406 if k<>0 then
10 5407 fejlreaktion(7<*modif-fil*>,k,
10 5408 <:io kommando(spring-def):>,0);
10 5409 fil(j).iaf(1):=d.op_ref.data(i+2);
10 5410 end;
9 5411 while sep = ',' do
9 5412 begin
10 5413 wait(bs_fortsæt_adgang);
10 5414 pos:= 1; j:= 0;
10 5415 while læs_store(z_io,i) < 8 do
10 5416 begin
11 5417 skrivtegn(fortsæt,pos,i);
11 5418 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 5419 end;
10 5420 skrivtegn(fortsæt,pos,'em');
10 5421 afsluttext(fortsæt,pos);
10 5422 sluttegn:= i;
10 5423 if j<>0 then
10 5424 begin
11 5425 setposition(z_io,0,0);
11 5426 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5427 skriv_kvittering(z_io,opref,-1,53);<*annulleret*>
11 5428 goto sp_ann;
11 5429 end;
10 5430 \f
10 5430 message procedure io_komm side 22 - 810519/cl;
10 5431
10 5431 disable begin
11 5432 integer array værdi(1:4);
11 5433 integer a_pos,res;
11 5434 pos:= 0;
11 5435 repeat
11 5436 apos:= pos;
11 5437 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 5438 if res >= 0 then
11 5439 begin
12 5440 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 5441 else if res=0 then res:= -25 <*parameter mangler*>
12 5442 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 5443 res:= -44 <*intervalstørrelse ulovlig*>
12 5444 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 5445 res:= -6 <*løbnr ulovligt*>
12 5446 else if res=10 then
12 5447 begin
13 5448 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 5449 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 5450 <:io kommando(spring-def):>,0);
13 5451 iaf:= 0;
13 5452 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 5453 indeks:= indeks+1;
13 5454 if sep = ',' then res:= 0;
13 5455 end
12 5456 else res:= -27; <*parametertype*>
12 5457 end;
11 5458 if res>0 then pos:= a_pos;
11 5459 until sep<>'sp' or res<=0;
11 5460
11 5460 if res<0 then
11 5461 begin
12 5462 d.op_ref.resultat:= -res;
12 5463 i:=1;
12 5464 hægt_tekst(d.op_ref.data,i,fortsæt,1);
12 5465 afsluttext(d.op_ref.data,i);
12 5466 end;
11 5467 end;
10 5468 \f
10 5468 message procedure io_komm side 23 - 810519/cl;
10 5469
10 5469 if d.op_ref.resultat > 3 then
10 5470 begin
11 5471 setposition(z_io,0,0);
11 5472 if sluttegn <> 'nl' then outchar(z_io,'nl');
11 5473 skriv_kvittering(z_io,op_ref,pos,d.opref.resultat);
11 5474 goto sp_ann;
11 5475 end;
10 5476 signalbin(bs_fortsæt_adgang);
10 5477 end while sep = ',';
9 5478 d.vt_op.data(1):= indeks-2;
9 5479 k:= sætfildim(d.vt_op.data);
9 5480 if k<>0 then fejlreaktion(9,k,<:io kommando(spring-def):>,0);
9 5481 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 5482 signalch(cs_io_fil,vt_op,io_optype or gen_optype);
9 5483 d.op_ref.retur:=cs_io_komm;
9 5484 pos:=op_ref;
9 5485 signal_ch(cs_vt,op_ref,gen_optype or io_optype);
9 5486 <*V*> wait_ch(cs_io_komm,op_ref,io_optype,-1<*timeout*>);
9 5487 <*+4*> if pos<>op_ref then
9 5488 fejlreaktion(11<*fremmed post*>,op_ref,
9 5489 <:io kommando(springdef retur fra vt):>,0);
9 5490 <*-4*>
9 5491
9 5491 <*V*> setposition(z_io,0,0);
9 5492 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5493 skriv_kvittering(z_io,op_ref,-1,d.op_ref.resultat);
9 5494
9 5494 if false then
9 5495 begin
10 5496 sp_ann: signalch(cs_slet_fil,vt_op,io_optype);
10 5497 waitch(cs_io_komm,vt_op,io_optype,-1);
10 5498 signalch(cs_io_fil,vt_op,io_optype or vt_optype);
10 5499 signalbin(bs_fortsæt_adgang);
10 5500 end;
9 5501
9 5501 end;
8 5502 begin
9 5503 integer i,j,k,opr,lin,max_lin;
9 5504 boolean o_ud, t_ud;
9 5505 \f
9 5505 message procedure io_komm side 23a - 820301/cl;
9 5506
9 5506 <* 11 fordelingsrapport *>
9 5507
9 5507 <*V*> setposition(z_io,0,0);
9 5508 if sluttegn <> 'nl' then outchar(z_io,'nl');
9 5509
9 5509 max_lin:= max_linienr;
9 5510 for opr:= 1 step 1 until max_antal_operatører, 0 do
9 5511 begin
10 5512 o_ud:= t_ud:= false;
10 5513 k:= 0;
10 5514
10 5514 if opr<>0 then
10 5515 begin
11 5516 j:= k:= 0;
11 5517 for lin:= 1 step 1 until max_lin do
11 5518 begin
12 5519 læs_tegn(radio_linietabel,lin+1,i);
12 5520 if i<>0 then j:= lin;
12 5521 if opr=i and opr<>0 then
12 5522 begin
13 5523 if -, o_ud then
13 5524 begin
14 5525 o_ud:= true;
14 5526 if opr<>0 then
14 5527 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
14 5528 "sp",2,string bpl_navn(opr))
14 5529 else
14 5530 write(z_io,"nl",1,<:ikke fordelte:>);
14 5531 end;
13 5532 if -, t_ud then
13 5533 begin
14 5534 write(z_io,<:<'nl'> linier: :>);
14 5535 t_ud:= true;
14 5536 end;
13 5537 k:=k+1;
13 5538 if k>1 and k mod 10 = 1 then
13 5539 write(z_io,"nl",1,"sp",13);
13 5540 write(z_io,<<ddd >,lin);
13 5541 end;
12 5542 if lin=max_lin then max_lin:= j;
12 5543 end;
11 5544 end;
10 5545
10 5545 k:= 0; t_ud:= false;
10 5546 for i:= 1 step 1 until max_antal_områder do
10 5547 begin
11 5548 if radio_områdetabel(i)= opr then
11 5549 begin
12 5550 if -, o_ud then
12 5551 begin
13 5552 o_ud:= true;
13 5553 if opr<>0 then
13 5554 write(z_io,"nl",1,<:operatør:>,<< dd>,opr,
13 5555 "sp",2,string bpl_navn(opr))
13 5556 else
13 5557 write(z_io,"nl",1,<:ikke fordelte:>);
13 5558 end;
12 5559 if -, t_ud then
12 5560 begin
13 5561 write(z_io,<:<'nl'> områder: :>);
13 5562 t_ud:= true;
13 5563 end;
12 5564 k:= k+1;
12 5565 if k>1 and k mod 10 = 1 then
12 5566 write(z_io,"nl",1,"sp",13);
12 5567 write(z_io,true,4,string område_navn(i));
12 5568 end;
11 5569 end;
10 5570 if o_ud then write(z_io,"nl",1);
10 5571 end;
9 5572 write(z_io,"*",1);
9 5573 end;
8 5574
8 5574 begin
9 5575 integer omr,typ,sum;
9 5576 integer array ialt(1:3);
9 5577 \f
9 5577 message procedure io_komm side 24 - 810501/hko;
9 5578
9 5578 <* 12 vis/nulstil opkaldstællere *>
9 5579
9 5579 setposition(z_io,0,0);
9 5580 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5581 for typ:= 1 step 1 until 3 do ialt(typ):= 0;
9 5582
9 5582 write(z_io,
9 5583 <:område udgående alm. ind nød ind:>,
9 5584 <: ind ialt total:>,"nl",1);
9 5585 for omr := 1 step 1 until max_antal_områder do
9 5586 begin
10 5587 sum:= 0;
10 5588 write(z_io,true,6,string område_navn(omr),":",1);
10 5589 for typ:= 1 step 1 until 3 do
10 5590 begin
11 5591 write(z_io,<< ddddddd>,opkalds_tællere((omr-1)*3+typ));
11 5592 sum:= sum + opkalds_tællere((omr-1)*3+typ);
11 5593 ialt(typ):= ialt(typ)+opkalds_tællere((omr-1)*3+typ);
11 5594 end;
10 5595 write(z_io,<< ddddddd>,
10 5596 sum-opkalds_tællere((omr-1)*3+1),sum,"nl",1);
10 5597 end;
9 5598 sum:= 0;
9 5599 write(z_io,"nl",1,<:ialt ::>);
9 5600 for typ:= 1 step 1 until 3 do
9 5601 begin
10 5602 write(z_io,<< ddddddd>,ialt(typ));
10 5603 sum:= sum+ialt(typ);
10 5604 end;
9 5605 write(z_io,<< ddddddd>,sum-ialt(1),sum,"nl",1);
9 5606 write(z_io,"*",1,"nl",1);
9 5607 setposition(z_io,0,0);
9 5608
9 5608 if kode = 76 <* nulstil tællere *> then
9 5609 disable begin
10 5610 for omr:= 1 step 1 until max_antal_områder*3 do
10 5611 opkalds_tællere(omr):= 0;
10 5612 skrivfil(tf_systællere,1,omr);
10 5613 tofrom(fil(omr),opkaldstællere,max_antal_områder*6);
10 5614 setposition(fil(omr),0,0);
10 5615 write(z_io,<:!!! tabeller nulstillet !!!:>,"nl",1);
10 5616 end;
9 5617 end;
8 5618
8 5618 begin
9 5619 \f
9 5619 message procedure io_komm side 25 - 940522/cl;
9 5620
9 5620 <* 13 navngiv betjeningsplads *>
9 5621 boolean incl;
9 5622 long field lf;
9 5623
9 5623 lf:=6;
9 5624 operatør:= ia(1);
9 5625 navn:= ia.lf;
9 5626 incl:= false add (ia(4) extract 8);
9 5627
9 5627 if navn=long<::> then
9 5628 begin
10 5629 <* nedlæg navn - check for i brug *>
10 5630 iaf:= operatør*terminal_beskr_længde;
10 5631 if terminal_tab.iaf.terminal_tilstand shift (-21)<>7 then
10 5632 d.opref.resultat:= 48 <*i brug*>
10 5633 else
10 5634 begin
11 5635 for i:= 65 step 1 until top_bpl_gruppe do
11 5636 begin
12 5637 iaf:= i*op_maske_lgd;
12 5638 if læsbit_ia(bpl_def.iaf,operatør) then
12 5639 d.opref.resultat:= 48<*i brug*>;
12 5640 end;
11 5641 end;
10 5642 if d.opref.resultat <= 3 then
10 5643 begin
11 5644 for i:= 1 step 1 until sidste_bus do
11 5645 if bustabel(i) shift (-14) extract 8 = operatør then
11 5646 d.opref.resultat:= 48<*i brug*>;
11 5647 end;
10 5648 end
9 5649 else
9 5650 begin
10 5651 <* opret/omdøb *>
10 5652 i:= find_bpl(navn);
10 5653 if i<>0 and i<>operatør then
10 5654 d.opref.resultat:= 48 <*i brug*>;
10 5655 end;
9 5656 if d.opref.resultat<=3 then
9 5657 begin
10 5658 bpl_navn(operatør):= navn;
10 5659 operatør_auto_include(operatør):= incl;
10 5660 k:= modif_fil(tf_bpl_navne,operatør,ll);
10 5661 if k<>0 then
10 5662 fejlreaktion(7,k,<:betjeningsplads,navngiv:>,0);
10 5663 lf:= 4;
10 5664 fil(ll).lf:= navn add (incl extract 8);
10 5665 setposition(fil(ll),0,0);
10 5666
10 5666 <* skriv bplnavne *>
10 5667 disable begin
11 5668 zone z(128,1,stderror);
11 5669 long array field laf;
11 5670 integer array ia(1:10);
11 5671
11 5671 open(z,4,<:bplnavne:>,0);
11 5672 laf:= 0;
11 5673 outrec6(z,512);
11 5674 for i:= 1 step 1 until 127 do
11 5675 z.laf(i):= bpl_navn(i);
11 5676 close(z,true);
11 5677 monitor(42,z,0,ia);
11 5678 ia(6):= systime(7,0,0.0);
11 5679 monitor(44,z,0,ia);
11 5680 end;
10 5681 d.opref.resultat:= 3;<*udført*>
10 5682 end;
9 5683
9 5683 setposition(z_io,0,0);
9 5684 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5685 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5686 end;
8 5687
8 5687 begin
9 5688 \f
9 5688 message procedure io_komm side 26 - 940522/cl;
9 5689
9 5689 <* 14 betjeningsplads - gruppe *>
9 5690 integer ant_i_gruppe;
9 5691 long field lf;
9 5692 integer array maske(1:op_maske_lgd//2);
9 5693
9 5693 lf:= 4; ant_i_gruppe:= 0;
9 5694 tofrom(maske,ingen_operatører,op_maske_lgd);
9 5695 navn:= ia.lf;
9 5696 operatør:= find_bpl(navn);
9 5697 for i:= 3 step 1 until indeks do
9 5698 if sætbit_ia(maske,ia(i),1)=0 then
9 5699 ant_i_gruppe:= ant_i_gruppe+1;
9 5700 if ant_i_gruppe=0 then
9 5701 begin
10 5702 <* slet gruppe *>
10 5703 if operatør<=64 then
10 5704 d.opref.resultat:= (if operatør=0 then 46<*navn ukendt*>
10 5705 else 62<*navn ulovligt*>)
10 5706 else
10 5707 begin
11 5708 for i:= 1 step 1 until max_antal_operatører do
11 5709 for j:= 1 step 1 until 3 do
11 5710 if operatør_stop(i,j)=operatør then
11 5711 d.opref.resultat:= 48<*i brug*>;
11 5712 end;
10 5713 navn:= long<::>;
10 5714 end
9 5715 else
9 5716 begin
10 5717 if 1<=operatør and operatør<=64 then
10 5718 d.opref.resultat:= 62<*navn ulovligt*>
10 5719 else
10 5720 if operatør=0 then
10 5721 begin
11 5722 i:=65;
11 5723 while i<=127 and operatør=0 do
11 5724 begin
12 5725 if bpl_navn(i)=long<::> then operatør:=i;
12 5726 i:= i+1;
12 5727 end;
11 5728 if operatør=0 then
11 5729 d.opref.resultat:= 32<*ikke plads*>
11 5730 else if operatør>top_bpl_gruppe then
11 5731 top_bpl_gruppe:= operatør;
11 5732 end;
10 5733 end;
9 5734 if d.opref.resultat<=3 then
9 5735 begin
10 5736 bpl_navn(operatør):= navn;
10 5737 iaf:= operatør*op_maske_lgd;
10 5738 tofrom(bpl_def.iaf,maske,op_maske_lgd);
10 5739 bpl_tilst(operatør,1):= bpl_tilst(operatør,2):= 0;
10 5740 for i:= 1 step 1 until max_antal_operatører do
10 5741 begin
11 5742 if læsbit_ia(maske,i) then
11 5743 begin
12 5744 bpl_tilst(operatør,2):= bpl_tilst(operatør,2)+1;
12 5745 if læsbit_ia(operatør_maske,i) then
12 5746 bpl_tilst(operatør,1):= bpl_tilst(operatør,1)+1;
12 5747 end;
11 5748 end;
10 5749 k:=modif_fil(tf_bplnavne,operatør,ll);
10 5750 if k<>0 then
10 5751 fejlreaktion(7,k,<:btj.plads,gruppenavn:>,0);
10 5752 lf:= 4;
10 5753 fil(ll).lf:= navn;
10 5754 setposition(fil(ll),0,0);
10 5755 iaf:= 0;
10 5756 k:= modif_fil(tf_bpl_def,operatør-64,ll);
10 5757 if k<>0 then
10 5758 fejlreaktion(7,k,<:btj.plads,gruppedef:>,0);
10 5759 for i:= 1 step 1 until op_maske_lgd//2 do
10 5760 fil(ll).iaf(i):= maske(i);
10 5761 fil(ll).iaf(4):= bpl_tilst(operatør,2);
10 5762 setposition(fil(ll),0,0);
10 5763 d.opref.resultat:= 3;
10 5764 end;
9 5765
9 5765 setposition(z_io,0,0);
9 5766 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5767 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5768 end;
8 5769
8 5769 begin
9 5770 \f
9 5770 message procedure io_komm side 27 - 940522/cl;
9 5771
9 5771 <* 15 vis betjeningspladsdefinitioner *>
9 5772
9 5772 setposition(z_io,0,0);
9 5773 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5774 write(z_io,"nl",1,<:operatørpladser::>,"nl",1);
9 5775 for i:= 1 step 1 until max_antal_operatører do
9 5776 begin
10 5777 write(z_io,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
10 5778 case operatør_auto_include(i) extract 2 + 1 of(
10 5779 <:(--):>,<:(ÅB):>,<:(??):>,<:(ST):>));
10 5780 if i mod 4 = 0 then write(z_io,"nl",1)
10 5781 else write(z_io,"sp",5);
10 5782 end;
9 5783 if max_antal_operatører mod 4 <> 0 then write(z_io,"nl",1);
9 5784 write(z_io,"nl",1,<:grupper::>,"nl",1);
9 5785 for i:= 65 step 1 until top_bpl_gruppe do
9 5786 begin
10 5787 ll:=0; iaf:= i*op_maske_lgd;
10 5788 if bpl_navn(i)<>long<::> then
10 5789 begin
11 5790 write(z_io,true,6,string bpl_navn(i),":",1);
11 5791 for j:= 1 step 1 until max_antal_operatører do
11 5792 begin
12 5793 if læsbit_ia(bpl_def.iaf,j) then
12 5794 begin
13 5795 if ll mod 8 = 0 and ll<>0 then
13 5796 write(z_io,"nl",1,"sp",7);
13 5797 write(z_io,"sp",2,string bpl_navn(j));
13 5798 ll:=ll+1;
13 5799 end;
12 5800 end;
11 5801 write(z_io,"nl",1);
11 5802 end;
10 5803 end;
9 5804 write(z_io,"*",1);
9 5805 end;
8 5806
8 5806 begin
9 5807 \f
9 5807 message procedure io_komm side 28 - 940522/cl;
9 5808
9 5808 <* 16 stopniveau,definer *>
9 5809
9 5809 operatør:= ia(1);
9 5810 iaf:= operatør*terminal_beskr_længde;
9 5811 for i:= 1 step 1 until 3 do
9 5812 operatør_stop(operatør,i):= ia(i+1);
9 5813 if -,læsbit_ia(operatørmaske,operatør) then
9 5814 begin
10 5815 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
10 5816 signal_bin(bs_mobilopkald);
10 5817 end;
9 5818 k:=modif_fil(tf_stoptabel,operatør,ll);
9 5819 if k<>0 then
9 5820 fejlreaktion(7,k,<:stopniveau,definer:>,0);
9 5821 iaf:= 0;
9 5822 for i:= 0 step 1 until 3 do
9 5823 fil(ll).iaf(i+1):= operatør_stop(operatør,i);
9 5824 setposition(fil(ll),0,0);
9 5825 setposition(z_io,0,0);
9 5826 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5827 skriv_kvittering(z_io,0,-1,3);
9 5828 end;
8 5829
8 5829 begin
9 5830 \f
9 5830 message procedure io_komm side 29 - 940522/cl;
9 5831
9 5831 <* 17 stopniveauer,vis *>
9 5832
9 5832 setposition(z_io,0,0);
9 5833 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5834
9 5834 for operatør:= 1 step 1 until max_antal_operatører do
9 5835 begin
10 5836 iaf:=operatør*terminal_beskr_længde;
10 5837 ll:=0;
10 5838 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 5839 string bpl_navn(operatør),<:(:>,
10 5840 case terminal_tab.iaf.terminal_tilstand shift (-21)
10 5841 + 1 of (<:AKTIV:>,<:AKTIV:>,<:AKTIV:>,<:PAUSE:>,
10 5842 <:EKSKL:>,<:EKSKL:>,<:EKSKL:>,<:EKSKL:>), <:) :>);
10 5843 for i:= 1 step 1 until 3 do
10 5844 ll:= ll+write(z_io,if i=1 then "sp" else "/",1,
10 5845 if operatør_stop(operatør,i)=0 then <:ALLE:>
10 5846 else string bpl_navn(operatør_stop(operatør,i)));
10 5847 if operatør mod 2 = 1 then
10 5848 write(z_io,"sp",40-ll)
10 5849 else
10 5850 write(z_io,"nl",1);
10 5851 end;
9 5852 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 5853 write(z_io,"*",1);
9 5854 end;
8 5855
8 5855 begin
9 5856 \f
9 5856 message procedure io_komm side 30 - 941007/cl;
9 5857
9 5857 <* 18 alarmlængder *>
9 5858
9 5858 setposition(z_io,0,0);
9 5859 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5860
9 5860 for operatør:= 1 step 1 until max_antal_operatører do
9 5861 begin
10 5862 ll:=0;
10 5863 ll:=write(z_io,<<dd>,operatør,<:: :>,true,6,
10 5864 string bpl_navn(operatør));
10 5865 iaf:=(operatør-1)*opk_alarm_tab_lgd;
10 5866 if opk_alarm.iaf.alarm_lgd < 0 then
10 5867 ll:= ll+write(z_io,<:uendelig:>)
10 5868 else
10 5869 ll:= ll+write(z_io,<<ddddddd>,
10 5870 opk_alarm.iaf.alarm_lgd,<: sek.:>);
10 5871
10 5871 if operatør mod 2 = 1 then
10 5872 write(z_io,"sp",40-ll)
10 5873 else
10 5874 write(z_io,"nl",1);
10 5875 end;
9 5876 if max_antal_operatører mod 2 <> 0 then write(z_io,"nl",1);
9 5877 write(z_io,"*",1);
9 5878 end;
8 5879
8 5879 begin
9 5880 <* 19 CC *>
9 5881 integer i, c;
9 5882
9 5882 i:= 1;
9 5883 while læstegn(ia,i+0,c)<>0 and
9 5884 i<(op_spool_postlgd-op_spool_text)//2*3
9 5885 do skrivtegn(d.opref.data,i,c);
9 5886 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 5887
9 5887 d.opref.retur:= cs_io_komm;
9 5888 signalch(cs_op,opref,io_optype or gen_optype);
9 5889 <*V*> waitch(cs_io_komm,opref,io_optype,-1);
9 5890
9 5890 setposition(z_io,0,0);
9 5891 if sluttegn<>'nl' then outchar(z_io,'nl');
9 5892 skriv_kvittering(z_io,opref,-1,d.opref.resultat);
9 5893 end;
8 5894
8 5894 begin
9 5895 <* 20: CQF,I CQF,U CQF,V *>
9 5896 integer kode, res, i, j;
9 5897 integer array field iaf, iaf1;
9 5898 long field navn;
9 5899
9 5899 kode:= d.opref.opkode extract 12;
9 5900 navn:= 6; res:= 0;
9 5901 if kode=90 <*CQF,I*> then
9 5902 begin
10 5903 if søg_omr_bus(ia(1),0,0,0,0,0) < 0 then
10 5904 res:= 10 <*busnr ukendt*>
10 5905 else
10 5906 begin
11 5907 j:= -1;
11 5908 for i:= 1 step 1 until max_cqf do
11 5909 begin
12 5910 iaf:= (i-1)*cqf_lgd;
12 5911 if ia(1) = cqf_tabel.iaf.cqf_bus or
12 5912 ia.navn = cqf_tabel.iaf.cqf_id
12 5913 then res:= 48; <*i brug*>
12 5914 if j<0 and cqf_tabel.iaf.cqf_bus=0 then j:= i;
12 5915 end;
11 5916 if res=0 and j<0 then res:= 32; <*ingen fri plads*>
11 5917 if res=0 then
11 5918 begin
12 5919 iaf:= (j-1)*cqf_lgd;
12 5920 cqf_tabel.iaf.cqf_bus:= ia(1);
12 5921 cqf_tabel.iaf.cqf_fejl:= 0;
12 5922 cqf_tabel.iaf.cqf_id:= ia.navn;
12 5923 cqf_tabel.iaf.cqf_ok_tid:= real <::>;
12 5924 cqf_tabel.iaf.cqf_næste_tid:= d.opref.tid + 15*60.0;
12 5925 res:= 3;
12 5926 end;
11 5927 end;
10 5928 setposition(z_io,0,0);
10 5929 if sluttegn<>'nl' then outchar(z_io,'nl');
10 5930 skriv_kvittering(z_io,opref,-1,res);
10 5931 end
9 5932 else
9 5933 if kode=91 <*CQF,U*> then
9 5934 begin
10 5935 j:= -1;
10 5936 for i:= 1 step 1 until max_cqf do
10 5937 begin
11 5938 iaf:= (i-1)*cqf_lgd;
11 5939 if ia(1) = cqf_tabel.iaf.cqf_bus then j:= i;
11 5940 end;
10 5941 if j>=0 then
10 5942 begin
11 5943 iaf:= (j-1)*cqf_lgd;
11 5944 for i:= 1 step 1 until cqf_lgd//2 do
11 5945 cqf_tabel.iaf(i):= 0;
11 5946 res:= 3;
11 5947 end
10 5948 else res:= 13; <*bus ikke indsat*>
10 5949 setposition(z_io,0,0);
10 5950 if sluttegn<>'nl' then outchar(z_io,'nl');
10 5951 skriv_kvittering(z_io,opref,-1,res);
10 5952 end
9 5953 else
9 5954 begin
10 5955 setposition(z_io,0,0);
10 5956 skriv_cqf_tabel(z_io,false);
10 5957 outchar(z_io,'*');
10 5958 setposition(z_io,0,0);
10 5959 end;
9 5960
9 5960 if kode=90 or kode=91 then
9 5961 begin
10 5962 j:= skrivfil(1033,1,i);
10 5963 if j<>0 then
10 5964 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
10 5965 for k:= 1 step 1 until max_cqf do
10 5966 begin
11 5967 iaf1:= (k-1)*cqf_lgd;
11 5968 iaf := (k-1)*cqf_id;
11 5969 tofrom(fil(i).iaf,cqf_tabel.iaf1,cqf_id);
11 5970 end;
10 5971 op_cqf_tab_ændret:= true;
10 5972 end;
9 5973 end;<*CQF*>
8 5974
8 5974
8 5974 begin
9 5975 \f
9 5975 message procedure io_komm side xx - 940522/cl;
9 5976
9 5976
9 5976
9 5976 <*+3*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
9 5977 <*-3*>
9 5978 end
8 5979 end;<*case j *>
7 5980 end <* j > 0 *>
6 5981 else
6 5982 begin
7 5983 <*V*> setposition(z_io,0,0);
7 5984 if sluttegn<>'nl' then outchar(z_io,'nl');
7 5985 skriv_kvittering(z_io,op_ref,-1,
7 5986 45 <* ikke implementeret *>);
7 5987 end;
6 5988 end;<* godkendt *>
5 5989
5 5989 <*V*> setposition(z_io,0,0);
5 5990 signal_bin(bs_zio_adgang);
5 5991 d.op_ref.retur:=cs_att_pulje;
5 5992 disable afslut_kommando(op_ref);
5 5993 end; <* indlæs kommando *>
4 5994
4 5994 begin
5 5995 \f
5 5995 message procedure io_komm side xx+1 - 810428/hko;
5 5996
5 5996 <* 2: aktiver efter stop *>
5 5997 terminal_tab.ref.terminal_tilstand:= 0 shift 21 +
5 5998 terminal_tab.ref.terminal_tilstand extract 21;
5 5999 afslut_operation(op_ref,-1);
5 6000 signal_bin(bs_zio_adgang);
5 6001 end;
4 6002
4 6002 <*+3*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2)
4 6003 <*-3*>
4 6004 end; <* case aktion+6 *>
3 6005
3 6005 until false;
3 6006 io_komm_trap:
3 6007 if -,(alarmcause shift (-24) extract 24 = (-2) and
3 6008 alarmcause extract 24 = (-13)) then
3 6009 disable skriv_io_komm(zbillede,1);
3 6010 end io_komm;
2 6011 \f
2 6011 message procedure io_spool side 1 - 810507/hko;
2 6012
2 6012 procedure io_spool;
2 6013 begin
3 6014 integer
3 6015 næste_tomme,nr;
3 6016 integer array field
3 6017 op_ref;
3 6018
3 6018 procedure skriv_io_spool(zud,omfang);
3 6019 value omfang;
3 6020 zone zud;
3 6021 integer omfang;
3 6022 begin
4 6023 disable write(zud,"nl",1,<:+++ io_spool :>);
4 6024 if omfang > 0 then
4 6025 disable begin integer x;
5 6026 trap(slut);
5 6027 write(zud,"nl",1,
5 6028 <: opref: :>,op_ref,"nl",1,
5 6029 <: næstetomme::>,næste_tomme,"nl",1,
5 6030 <: nr :>,nr,"nl",1,
5 6031 <::>);
5 6032 skriv_coru(zud,coru_no(102));
5 6033 slut:
5 6034 end;<*disable*>
4 6035 end skriv_io_spool;
3 6036
3 6036 trap(io_spool_trap);
3 6037 næste_tomme:= 1;
3 6038 stack_claim((if cm_test then 200 else 146)+24 +48);
3 6039 <*+2*>
3 6040 if testbit0 and overvåget or testbit28 then
3 6041 skriv_io_spool(out,0);
3 6042 <*-2*>
3 6043 \f
3 6043 message procedure io_spool side 2 - 810602/hko;
3 6044
3 6044 repeat
3 6045
3 6045 wait_ch(cs_io_spool,
3 6046 op_ref,
3 6047 true,
3 6048 -1<*timeout*>);
3 6049
3 6049 i:= d.op_ref.opkode;
3 6050 if i = 22 or i = 23 or i = 36 or i = 45 or i = 46 then
3 6051 begin
4 6052 wait(ss_io_spool_tomme);
4 6053 disable modif_fil(io_spoolfil,næste_tomme,nr);
4 6054 næste_tomme:= (næste_tomme mod io_spool_postantal) +1;
4 6055
4 6055 i:= d.op_ref.opsize;
4 6056 <*+4*> if i > io_spool_postlængde*2 -io_spool_post then
4 6057 begin
5 6058 <* fejlreaktion(3,i,<:postlængde,io spool:>,1); *>
5 6059 i:= io_spool_postlængde*2 -io_spool_post;
5 6060 end;
4 6061 <*-4*>
4 6062 fil(nr,1):= real(extend d.op_ref.opsize shift 24);
4 6063 tofrom(fil(nr).io_spool_post,d.op_ref,i);
4 6064 signal(ss_io_spool_fulde);
4 6065 d.op_ref.resultat:= 1;
4 6066 end
3 6067 else
3 6068 begin
4 6069 fejlreaktion(2<*operationskode*>,d.op_ref.opkode,
4 6070 <:io_spool_korutine:>,1);
4 6071 end;
3 6072
3 6072 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
3 6073
3 6073 until false;
3 6074
3 6074 io_spool_trap:
3 6075
3 6075 disable skriv_io_spool(zbillede,1);
3 6076 end io_spool;
2 6077 \f
2 6077 message procedure io_spon side 1 - 810507/hko;
2 6078
2 6078 procedure io_spon;
2 6079 begin
3 6080 integer
3 6081 næste_fulde,nr,i,dato,kl;
3 6082 real t;
3 6083
3 6083 procedure skriv_io_spon(zud,omfang);
3 6084 value omfang;
3 6085 zone zud;
3 6086 integer omfang;
3 6087 begin
4 6088 disable write(zud,"nl",1,<:+++ io_spon :>);
4 6089 if omfang > 0 then
4 6090 disable begin integer x;
5 6091 trap(slut);
5 6092 write(zud,"nl",1,
5 6093 <: næste-fulde::>,næste_fulde,"nl",1,
5 6094 <: nr :>,nr,"nl",1,
5 6095 <::>);
5 6096 skriv_coru(zud,coru_no(103));
5 6097 slut:
5 6098 end;<*disable*>
4 6099 end skriv_io_spon;
3 6100
3 6100 trap(io_spon_trap);
3 6101 næste_fulde:= 1;
3 6102 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6103 <*+2*>
3 6104 if testbit0 and overvåget or testbit28 then
3 6105 skriv_io_spon(out,0);
3 6106 <*-2*>
3 6107 \f
3 6107 message procedure io_spon side 2 - 810602/hko/cl;
3 6108
3 6108 repeat
3 6109
3 6109 <*V*> wait(ss_io_spool_fulde);
3 6110 <*V*> wait(bs_zio_adgang);
3 6111
3 6111 <*V*> setposition(zio,0,0);
3 6112
3 6112 disable modif_fil(io_spool_fil,næste_fulde,nr);
3 6113 næste_fulde:= (næste_fulde mod io_spool_postantal) +1;
3 6114
3 6114 laf:=data;
3 6115 k:= fil(nr).io_spool_post.opkode;
3 6116 if k = 22 or k = 36 then
3 6117 disable begin
4 6118 write(z_io,"nl",1,if k=22 then <:auto:> else <:spring:>);
4 6119 if k=36 then
4 6120 begin
5 6121 i:= fil(nr).io_spool_post.data(4);
5 6122 j:= i extract 5;
5 6123 if j<>0 then j:=j+'A'-1;
5 6124 i:= i shift (-5) extract 10;
5 6125 write(z_io,"sp",(j=0) extract 1 + 1,<<ddd>,i,false add j,1,".",1,
5 6126 true,4,string(extend fil(nr).io_spool_post.data(5) shift 24));
5 6127 end;
4 6128 skriv_auto_spring_medd(zio,fil(nr).io_spool_post.data,
4 6129 fil(nr).io_spool_post.tid)
4 6130 end
3 6131 else if k = 23 then
3 6132 disable
3 6133 begin
4 6134 write(zio,"nl",1,<:-<'>'>:>,fil(nr).io_spool_post.laf);
4 6135 dato:= systime(4,fil(nr).io_spool_post.tid,t);
4 6136 kl:= round t;
4 6137 i:= replace_char(1<*space in number*>,'.');
4 6138 write(z_io,"sp",2,<<zd_dd_dd>,dato,<< zd_dd_dd>,kl);
4 6139 replace_char(1,i);
4 6140 end
3 6141 else if k = 45 or k = 46 then
3 6142 disable begin
4 6143 integer vogn,linie,bogst,løb,t;
4 6144
4 6144 t:=fil(nr).io_spool_post.data(2);
4 6145 outchar(z_io,'nl');
4 6146 if k = 45 then
4 6147 write(zio,<<zd.dd>,t/100.0,"sp",1);
4 6148
4 6148 write(zio,<:nødopkald fra :>);
4 6149 vogn:= fil(nr).io_spool_post.data(1);
4 6150 i:= vogn shift (-22);
4 6151 if i < 2 then
4 6152 skrivid(zio,vogn,9)
4 6153 else
4 6154 begin
5 6155 fejlreaktion(3<*programfejl*>,vogn,<:vogn.id, spon.medd:>,1);
5 6156 write(zio,<:!!!:>,vogn);
5 6157 end;
4 6158 \f
4 6158 message procedure io_spon side 3 - 810507/hko;
4 6159
4 6159 if fil(nr).io_spool_post.data(3)<>0 then
4 6160 write(z_io," ",1,string område_navn(fil(nr).io_spool_post.data(3)));
4 6161
4 6161 if k = 46 then
4 6162 begin
5 6163 write(zio,<: besvaret:>,<< zd.dd>,t/100.0);
5 6164 end;
4 6165 end <*disable*>
3 6166 else
3 6167 fejlreaktion(2<*operationskode*>,k,<:io_spon_medd:>,1);
3 6168
3 6168 fil(nr,1):= fil(nr,1) add 1;
3 6169
3 6169 <*V*> setposition(zio,0,0);
3 6170
3 6170 signal_bin(bs_zio_adgang);
3 6171
3 6171 signal(ss_io_spool_tomme);
3 6172
3 6172 until false;
3 6173
3 6173 io_spon_trap:
3 6174 skriv_io_spon(zbillede,1);
3 6175
3 6175 end io_spon;
2 6176 \f
2 6176 message procedure io_medd side 1;
2 6177
2 6177 procedure io_medd;
2 6178 begin
3 6179 integer array field opref;
3 6180 integer afs, kl, i;
3 6181 real dato, t;
3 6182
3 6182
3 6182 procedure skriv_io_medd(zud,omfang);
3 6183 value omfang;
3 6184 zone zud;
3 6185 integer omfang;
3 6186 begin
4 6187 disable write(zud,"nl",1,<:+++ io_medd :>);
4 6188 if omfang > 0 then
4 6189 disable begin integer x;
5 6190 trap(slut);
5 6191 write(zud,"nl",1,
5 6192 <: opref: :>,opref,"nl",1,
5 6193 <: afs: :>,afs,"nl",1,
5 6194 <: kl: :>,kl,"nl",1,
5 6195 <: i: :>,i,"nl",1,
5 6196 <: dato: :>,<<zddddd>,dato,"nl",1,
5 6197 <: t: :>,t,"nl",1,
5 6198 <::>);
5 6199 skriv_coru(zud,coru_no(104));
5 6200 slut:
5 6201 end;<*disable*>
4 6202 end skriv_io_medd;
3 6203
3 6203 trap(io_medd_trap);
3 6204 stack_claim((if cm_test then 200 else 146) +24 +48);
3 6205 <*+2*>
3 6206 if testbit0 and overvåget or testbit28 then
3 6207 skriv_io_medd(out,0);
3 6208 <*-2*>
3 6209 \f
3 6209 message procedure io_medd side 2;
3 6210
3 6210 repeat
3 6211 <*V*> waitch(cs_io_medd,opref,gen_optype,-1);
3 6212 <*V*> wait(bs_zio_adgang);
3 6213
3 6213 afs:= d.opref.data.op_spool_kilde;
3 6214 dato:= systime(4,d.opref.data.op_spool_tid,t);
3 6215 kl:= round t;
3 6216 write(z_io,"nl",1,<:! fra op:>,<<d>,afs,"sp",1,
3 6217 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
3 6218 i:= replacechar(1,'.');
3 6219 disable write(z_io,"sp",1,<<zd_dd_dd>,kl,"nl",1);
3 6220 replacechar(1,i);
3 6221 write(z_io,d.opref.data.op_spool_text);
3 6222 setposition(z_io,0,0);
3 6223
3 6223 signalbin(bs_zio_adgang);
3 6224 signalch((if afs=0 then d.opref.retur else cs_op),opref,d.opref.optype);
3 6225 until false;
3 6226
3 6226 io_medd_trap:
3 6227 skriv_io_medd(zbillede,1);
3 6228
3 6228 end io_medd;
2 6229 \f
2 6229 message operatør_erklæringer side 1 - 810602/hko;
2 6230 integer
2 6231 cs_op,cs_op_retur,cs_talevejsswitch,cs_tvswitch_adgang,cs_tv_switch_adm,
2 6232 cs_tvswitch_input, cs_op_iomedd, bs_opk_alarm, cs_opk_alarm, cs_cqf,
2 6233 cs_op_spool, cs_op_medd, ss_op_spool_tomme, ss_op_spool_fulde,
2 6234 cs_opk_alarm_ur, cs_opk_alarm_ur_ret, sidste_tv_brugt;
2 6235 integer array
2 6236 cqf_tabel(1:max_cqf*cqf_lgd//2),
2 6237 operatørmaske(1:op_maske_lgd//2),
2 6238 op_talevej(0:max_antal_operatører),
2 6239 tv_operatør(0:max_antal_taleveje),
2 6240 opk_alarm(1:max_antal_operatører*(opk_alarm_tab_lgd//2)),
2 6241 op_spool_buf(1:op_spool_postantal*(op_spool_postlgd//2)),
2 6242 ant_i_opkø,
2 6243 cs_operatør,
2 6244 cs_op_fil(1:max_antal_operatører);
2 6245 boolean
2 6246 op_cqf_tab_ændret;
2 6247 integer field
2 6248 op_spool_kilde;
2 6249 real field
2 6250 op_spool_tid;
2 6251 long array field
2 6252 op_spool_text;
2 6253 zone z_tv_in, z_tv_out(128,1,tvswitch_fejl);
2 6254 zone array z_op(max_antal_operatører,320,1,op_fejl);
2 6255 \f
2 6255 message procedure op_fejl side 1 - 830310/hko;
2 6256
2 6256 procedure op_fejl(z,s,b);
2 6257 integer s,b;
2 6258 zone z;
2 6259 begin
3 6260 disable begin
4 6261 integer array iz(1:20);
4 6262 integer i,j,k,n;
4 6263 integer array field iaf,iaf1,msk;
4 6264 boolean input;
4 6265 real array field laf,laf1;
4 6266
4 6266 getzone6(z,iz);
4 6267 iaf:=laf:=2;
4 6268 input:= iz(13) = 1;
4 6269 for laf1:= 0 step 8 until (max_antal_operatører-1)*8 do
4 6270 if iz.laf(1)=terminal_navn.laf1(1) and
4 6271 iz.laf(2)=terminal_navn.laf1(2) then j:= laf1//8 + 1;
4 6272
4 6272 <*+2*> if testbit31 then
4 6273 <**> begin
5 6274 <**> write(out,"nl",1,<:blockprocedure: opfejl, operatørnr::>,j,"nl",1,
5 6275 <**> <:s=:>); outintbits(out,s);
5 6276 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6277 <**> else <:output:>,"nl",1);
5 6278 <**> setposition(out,0,0);
5 6279 <**> end;
4 6280 <*-2*>
4 6281 iaf:=j*terminal_beskr_længde;
4 6282 k:=1;
4 6283
4 6283 i:= terminal_tab.iaf.terminal_tilstand;
4 6284 if i shift(-21) < 4 and (s <> (1 shift 21 +2) <*or -,input*>) then
4 6285 fejlreaktion(17<*ydre enhed status*>,s,string iz.laf(increase(k)),
4 6286 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6287 if s <> (1 shift 21 +2) then
4 6288 begin
5 6289 terminal_tab.iaf.terminal_tilstand:= 1 shift 23
5 6290 + terminal_tab.iaf.terminal_tilstand extract 23;
5 6291 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 6292 sæt_bit_ia(opkaldsflag,j,0);
5 6293 if sæt_bit_ia(operatørmaske,j,0)=1 then
5 6294 for k:= j, 65 step 1 until top_bpl_gruppe do
5 6295 begin
6 6296 msk:= k*op_maske_lgd;
6 6297 if læsbit_ia(bpl_def.msk,j) then
6 6298 <**> begin
7 6299 n:= 0;
7 6300 for i:= 1 step 1 until max_antal_operatører do
7 6301 if læsbit_ia(bpl_def.msk,i) then
7 6302 begin
8 6303 iaf1:= i*terminal_beskr_længde;
8 6304 if terminal_tab.iaf1.terminal_tilstand shift (-21) < 3 then
8 6305 n:= n+1;
8 6306 end;
7 6307 bpl_tilst(j,1):= n;
7 6308 end;
6 6309 <**> <*
6 6310 bpl_tilst(j,1):= bpl_tilst(j,1)-1;
6 6311 *> end;
5 6312 signal_bin(bs_mobil_opkald);
5 6313 end;
4 6314
4 6314 if input or -,input then
4 6315 begin
5 6316 z(1):=real <:<'?'><'?'><'em'>:>;
5 6317 b:=2;
5 6318 end;
4 6319 end; <*disable*>
3 6320 end op_fejl;
2 6321 \f
2 6321 message procedure tvswitch_fejl side 1 - 940426/cl;
2 6322
2 6322 procedure tvswitch_fejl(z,s,b);
2 6323 integer s,b;
2 6324 zone z;
2 6325 begin
3 6326 disable begin
4 6327 integer array iz(1:20);
4 6328 integer i,j,k;
4 6329 integer array field iaf;
4 6330 boolean input;
4 6331 real array field raf;
4 6332
4 6332 getzone6(z,iz);
4 6333 iaf:=raf:=2;
4 6334 input:= iz(13) = 1;
4 6335 <*+2*> if testbit31 then
4 6336 <**> begin
5 6337 <**> write(out,"nl",1,<:blockprocedure: tvswitch:>,"nl",1,
5 6338 <**> <:s=:>); outintbits(out,s);
5 6339 <**> write(out,"nl",1,<:b=:>,b,"sp",1,if input then <:input:>
5 6340 <**> else <:output:>,"nl",1);
5 6341 <**> skrivhele(out,z,b,5);
5 6342 <**> setposition(out,0,0);
5 6343 <**> end;
4 6344 <*-2*>
4 6345 k:=1;
4 6346 if s <> (1 shift 21 +2) then
4 6347 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 6348 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 6349
4 6349 if input or -,input then
4 6350 begin
5 6351 z(1):=real <:<'em'>:>;
5 6352 b:=2;
5 6353 end;
4 6354 end; <*disable*>
3 6355 if testbit22 and (s <> (1 shift 21 +2)) then delay(60);
3 6356 end tvswitch_fejl;
2 6357
2 6357 procedure skriv_talevejs_tab(z);
2 6358 zone z;
2 6359 begin
3 6360 write(z,"nl",2,<:talevejsswitch::>);
3 6361 write(z,"nl",1,<: operatører::>,"nl",1);
3 6362 for i:= 1 step 1 until max_antal_operatører do
3 6363 begin
4 6364 write(z,<< dd>,i,":",1,op_talevej(i));
4 6365 if i mod 8=0 then outchar(z,'nl');
4 6366 end;
3 6367 write(z,"nl",1,<: taleveje::>,"nl",1);
3 6368 for i:= 1 step 1 until max_antal_taleveje do
3 6369 begin
4 6370 write(z,<< dd>,i,":",1,tv_operatør(i));
4 6371 if i mod 8=0 then outchar(z,'nl');
4 6372 end;
3 6373 write(z,"nl",3);
3 6374 end;
2 6375 \f
2 6375 message procedure skriv_opk_alarm_tab side 1;
2 6376
2 6376 procedure skriv_opk_alarm_tab(z);
2 6377 zone z;
2 6378 begin
3 6379 integer nr;
3 6380 integer array field tab;
3 6381 real t;
3 6382
3 6382 write(z,"nl",2,<:opkaldsalarmtabel::>,"nl",1,
3 6383 <:operatør kmdo tilst gl.tilst længde start:>,"nl",1);
3 6384 for nr:=1 step 1 until max_antal_operatører do
3 6385 begin
4 6386 tab:= (nr-1)*opk_alarm_tab_lgd;
4 6387 write(z,<< dd >,nr,true,6,string bpl_navn(nr),<:: :>,
4 6388 case opk_alarm.tab.alarm_kmdo+1 of ("-","B","C","F"),1,"sp",5,
4 6389 case opk_alarm.tab.alarm_tilst+1 of ("-","B","C","?"),1,"sp",8,
4 6390 case opk_alarm.tab.alarm_gtilst+1 of ("-","B","C","?"),1,"sp",2,
4 6391 <<-dddd>,opk_alarm.tab.alarm_lgd,"sp",1,
4 6392 << zddddd>,systime(4,opk_alarm.tab.alarm_start,t),t,
4 6393 "nl",1);
4 6394 end;
3 6395 end;
2 6396 \f
2 6396 message procedure skriv_op_spool_buf side 1;
2 6397
2 6397 procedure skriv_op_spool_buf(z);
2 6398 zone z;
2 6399 begin
3 6400 integer array field ref;
3 6401 integer nr, kilde;
3 6402 real dato, kl;
3 6403
3 6403 write(z,"nl",2,<:op<'_'>spool<'_'>buffer::>,"nl",1);
3 6404 for nr:= 1 step 1 until op_spool_postantal do
3 6405 begin
4 6406 write(z,"nl",1,<:nr.::>,<< dd>,nr);
4 6407 ref:= (nr-1)*op_spool_postlgd;
4 6408 if op_spool_buf.ref.op_spool_tid <> real<::> then
4 6409 begin
5 6410 kilde:= op_spool_buf.ref.op_spool_kilde;
5 6411 dato:= systime(4,op_spool_buf.ref.op_spool_tid,kl);
5 6412 write(z,<: fra op:>,<<d>,kilde,"sp",1,
5 6413 if kilde=0 then <:SYSOP:> else string bplnavn(kilde),
5 6414 "sp",1,<<zddddd.dddddd>,dato+kl/1000000,"nl",1,
5 6415 op_spool_buf.ref.op_spool_text);
5 6416 end;
4 6417 outchar(z,'nl');
4 6418 end;
3 6419 end;
2 6420
2 6420 procedure skriv_cqf_tabel(z,lang);
2 6421 value lang;
2 6422 zone z;
2 6423 boolean lang;
2 6424 begin
3 6425 integer array field ref;
3 6426 integer i,ant;
3 6427 real dato, kl;
3 6428
3 6428 ant:= 0;
3 6429 write(z,"nl",1,<:CQF testbus-tabel::>,"nl",2,(
3 6430 if -,lang then
3 6431 <: tnr. navn fejl sidste_ok tnr. navn fejl sidste_ok:>
3 6432 <* 9900 XXxxx 1 yymmdd.ttmmss 9900 XXxxx 1 yymmdd.ttmmss*>
3 6433 else
3 6434 <:nr: tnr. navn fejl sidste_ok næste_test:>),"nl",1);
3 6435 <*01: 9900 XXxxx 1 yymmdd.ttmmss yymmdd.hhttmm*>
3 6436 for i:= 1 step 1 until max_cqf do
3 6437 begin
4 6438 ref:= (i-1)*cqf_lgd;
4 6439 if cqf_tabel.ref.cqf_bus<>0 or lang then
4 6440 begin
5 6441 ant:= ant+1;
5 6442 if lang then
5 6443 write(z,<<dd>,i,":",1);
5 6444 write(z,<< dddd>,cqf_tabel.ref.cqf_bus,"sp",1,true,6,
5 6445 string cqf_tabel.ref.cqf_id,<<dddd>,cqf_tabel.ref.cqf_fejl);
5 6446 if cqf_tabel.ref.cqf_ok_tid<>real<::> then
5 6447 begin
6 6448 dato:= systime(4,cqf_tabel.ref.cqf_ok_tid,kl);
6 6449 write(z,<< zddddd.dddddd>,dato+kl/1000000);
6 6450 end
5 6451 else
5 6452 write(z,"sp",14,"?",1);
5 6453 if lang then
5 6454 begin
6 6455 if cqf_tabel.ref.cqf_næste_tid<>real<::> then
6 6456 begin
7 6457 dato:= systime(4,cqf_tabel.ref.cqf_næste_tid,kl);
7 6458 write(z,<< zddddd.dddddd>,dato+kl/1000000);
7 6459 end
6 6460 else
6 6461 write(z,"sp",14,"?",1);
6 6462 end
5 6463 else
5 6464 write(z,"sp",2);
5 6465 if lang or (ant mod 2)=0 then outchar(z,'nl');
5 6466 end;
4 6467 end;
3 6468 if -,lang and (ant mod 2)=1 then outchar(z,'nl');
3 6469 end;
2 6470
2 6470 procedure sorter_cqftab(l,u);
2 6471 value l,u;
2 6472 integer l,u;
2 6473 begin
3 6474 integer array field ii,jj;
3 6475 integer array ww,xx(1:(cqf_lgd+1)//2);
3 6476
3 6476 ii:= ((l+u)//2 - 1)*cqf_lgd;
3 6477 tofrom(xx,cqf_tabel.ii,cqf_lgd);
3 6478 ii:= (l-1)*cqf_lgd; jj:= (u-1)*cqf_lgd;
3 6479 repeat
3 6480 while (cqf_tabel.ii(1) < xx(1)) do ii:= ii+cqf_lgd;
3 6481 while (xx(1) < cqf_tabel.jj(1)) do jj:= jj-cqf_lgd;
3 6482 if ii <= jj then
3 6483 begin
4 6484 tofrom(ww,cqf_tabel.ii,cqf_lgd);
4 6485 tofrom(cqf_tabel.ii,cqf_tabel.jj,cqf_lgd);
4 6486 tofrom(cqf_tabel.jj,ww,cqf_lgd);
4 6487 ii:= ii+cqf_lgd;
4 6488 jj:= jj-cqf_lgd;
4 6489 end;
3 6490 until ii>jj;
3 6491 if l < jj//cqf_lgd+1 then sorter_cqftab(l,jj//cqf_lgd+1);
3 6492 if ii//cqf_lgd+1 < u then sorter_cqftab(ii//cqf_lgd+1,u);
3 6493 end;
2 6494 \f
2 6494 message procedure ht_symbol side 1 - 851001/cl;
2 6495
2 6495 procedure ht_symbol(z);
2 6496 zone z;
2 6497 write(z,"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,<:
2 6498
2 6498
2 6498
2 6498
2 6498 @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
2 6498 @@ @@ @@
2 6498 @@ @@ @@
2 6498 @@ @@ @@
2 6498 @@ @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6498 @@ @@
2 6498 @@ @@
2 6498 @@ @@
2 6498 @@ @@@@@@@@@@@@@ @@
2 6498 @@ @@ @@ @@
2 6498 @@ @@ @@ @@
2 6498 @@ @@ @@ @@
2 6498 @@@@@@@@@@@@@ @@@@@@@@@@@@@
2 6498 :>,"esc" add 128,1,<:Æ24;1H:>);
2 6499 \f
2 6499 message procedure definer_taster side 1 - 891214,cl;
2 6500
2 6500 procedure definer_taster(nr);
2 6501 value nr;
2 6502 integer nr;
2 6503 begin
3 6504
3 6504 setposition(z_op(nr),0,0);
3 6505 write(z_op(nr),
3 6506 "esc" add 128,1, <:P1;2;0ø58/1B4E450D:>,
3 6507 "esc" add 128,1, <:Ø:>, <* f1 = <esc>NE<cr> *>
3 6508 "esc" add 128,1, <:P1;2;0ø59/1B4F500D:>,
3 6509 "esc" add 128,1, <:Ø:>, <* f2 = <esc>OP<cr> *>
3 6510 "esc" add 128,1, <:P1;2;0ø5A/1B4F502C560D:>,
3 6511 "esc" add 128,1, <:Ø:>, <* f3 = <esc>OP,V<cr> *>
3 6512 "esc" add 128,1, <:P1;2;0ø5B/1B4F502C5420:>,
3 6513 "esc" add 128,1, <:Ø:>, <* f4 = <esc>OP,T<sp> *>
3 6514 "esc" add 128,1, <:P1;2;0ø5C/1B4F502C4120:>,
3 6515 "esc" add 128,1, <:Ø:>, <* f5 = <esc>OP,A<sp> *>
3 6516 "esc" add 128,1, <:P1;2;1ø5C/1B4F502C4120:>,
3 6517 "esc" add 128,1, <:Ø:>, <* s-f5 = <esc>OP,A<sp> *>
3 6518 "esc" add 128,1, <:P1;2;0ø5D/1B4D452C4120:>,
3 6519 "esc" add 128,1, <:Ø:>, <* f6 = <esc>ME,A<sp> *>
3 6520 "esc" add 128,1, <:P1;2;1ø5D/1B4D452C4120:>,
3 6521 "esc" add 128,1, <:Ø:>, <* s-f6 = <esc>ME,A<sp> *>
3 6522 "esc" add 128,1, <:P1;2;0ø5E/1B4F5020:>,
3 6523 "esc" add 128,1, <:Ø:>, <* f7 = <esc>OP<sp> *>
3 6524 "esc" add 128,1, <:P1;2;0ø5F/1B56450D:>,
3 6525 "esc" add 128,1, <:Ø:>, <* f8 = <esc>VE<cr> *>
3 6526 "esc" add 128,1, <:P1;2;0ø60/1B4D4F20:>,
3 6527 "esc" add 128,1, <:Ø:>, <* f9 = <esc>MO<sp> *>
3 6528 "esc" add 128,1, <:P1;2;1ø60/1B520D:>,
3 6529 "esc" add 128,1, <:Ø:>, <* s-f9 = <esc>R<cr> *>
3 6530 "esc" add 128,1, <:P1;2;0ø61/1B53540D:>,
3 6531 "esc" add 128,1, <:Ø:>, <* f10 = <esc>ST<cr> *>
3 6532 "esc" add 128,1, <:P1;2;0ø62/1B474520:>,
3 6533 "esc" add 128,1, <:Ø:>, <* f11 = <esc>GE<sp> *>
3 6534 "esc" add 128,1, <:P1;2;1ø62/1B47452C4720:>,
3 6535 "esc" add 128,1, <:Ø:>, <* s-f11 = <esc>GE,G<sp> *>
3 6536 "esc" add 128,1, <:P1;2;0ø63/1B47452C560D:>,
3 6537 "esc" add 128,1, <:Ø:>, <* f12 = <esc>GE,V<cr> *>
3 6538 "esc" add 128,1, <:P1;2;1ø63/1B47452C540D:>,
3 6539 "esc" add 128,1, <:Ø:>, <* s-f12 = <esc>GE,T<sp> *>
3 6540 "esc" add 128,1, <:P1;2;0ø7B/1B564F2C4920:>,
3 6541 "esc" add 128,1, <:Ø:>, <* Ins = <esc>VO,I<sp> *>
3 6542 "esc" add 128,1, <:P1;2;0ø79/1B564F2C5520:>,
3 6543 "esc" add 128,1, <:Ø:>, <* Del = <esc>VO,U<sp> *>
3 6544 "esc" add 128,1, <:P1;2;0ø7F/1B564F2C4620:>,
3 6545 "esc" add 128,1, <:Ø:>, <* Home = <esc>VO,F<sp> *>
3 6546 "esc" add 128,1, <:P1;2;0ø7A/1B564F2C5220:>,
3 6547 "esc" add 128,1, <:Ø:>, <* End = <esc>VO,R<sp> *>
3 6548 "esc" add 128,1, <:P1;2;0ø6F/1B564F2C4C20:>,
3 6549 "esc" add 128,1, <:Ø:>, <* PgUp = <esc>VO,L<sp> *>
3 6550 "esc" add 128,1, <:P1;2;0ø7E/1B564F2C4220:>,
3 6551 "esc" add 128,1, <:Ø:>, <* PgDn = <esc>VO,B<sp> *>
3 6552 "esc" add 128,1, <:P1;2;0ø0E/082008:>,
3 6553 "esc" add 128,1, <:Ø:>, <* Back = <bs><sp><bs> *>
3 6554 <::>);
3 6555 end;
2 6556 \f
2 6556 message procedure skriv_terminal_tab side 1 - 820301/hko;
2 6557
2 6557 procedure skriv_terminal_tab(z);
2 6558 zone z;
2 6559 begin
3 6560 integer array field ref;
3 6561 integer t1,i,j,id,k;
3 6562
3 6562 write(z,"ff",1,<:
3 6563 ******* terminalbeskrivelser ********
3 6564
3 6564 # a k l p m m n o
3 6565 1 l a y a o o ø p
3 6566 nr tilst - vnt R 0 l t t s n b d t type ident id i kø:>);
3 6567 <*
3 6568 01 15 .... .... X X X X X X X X X X MEDD 9999.abc 888B/77
3 6569 *>
3 6570 for i:=1 step 1 until max_antal_operatører do
3 6571 begin
4 6572 ref:=i*terminal_beskr_længde;
4 6573 t1:=terminal_tab.ref(1);
4 6574 id:=terminal_tab.ref(2);
4 6575 k:=terminal_tab.ref(3);
4 6576 write(z,"nl",1,"sp",4,<<dd>,i,<< dddd>,t1 shift(-21),
4 6577 t1 shift(-16) extract 5,t1 shift(-12) extract 4,
4 6578 "sp",1);
4 6579 for j:=11 step -1 until 2 do
4 6580 write(z,if læs_bit_i(t1,j) then "X" else "sp",1,"sp",1);
4 6581 write(z,case t1 extract 2 +1 of (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 6582 "sp",1);
4 6583 skriv_id(z,id,9);
4 6584 skriv_id(z,k,9);
4 6585 end;
3 6586 write(z,"nl",2,<:samtaleflag::>,"nl",1);
3 6587 outintbits_ia(z,samtaleflag,1,op_maske_lgd//2);
3 6588 write(z,"nl",1);
3 6589 end skriv_terminal_tab;
2 6590 \f
2 6590 message procedure h_operatør side 1 - 810520/hko;
2 6591
2 6591 <* hovedmodulkorutine for operatørterminaler *>
2 6592 procedure h_operatør;
2 6593 begin
3 6594 integer array field op_ref;
3 6595 integer k,nr,ant,ref,dest_sem;
3 6596 procedure skriv_hoperatør(zud,omfang);
3 6597 value omfang;
3 6598 zone zud;
3 6599 integer omfang;
3 6600 begin
4 6601
4 6601 write(zud,"nl",1,<:+++ hovedmodul operatør :>);
4 6602 if omfang>0 then
4 6603 disable begin integer x;
5 6604 trap(slut);
5 6605 write(zud,"nl",1,
5 6606 <: op_ref: :>,op_ref,"nl",1,
5 6607 <: nr: :>,nr,"nl",1,
5 6608 <: ant: :>,ant,"nl",1,
5 6609 <: ref: :>,ref,"nl",1,
5 6610 <: k: :>,k,"nl",1,
5 6611 <: dest_sem: :>,dest_sem,"nl",1,
5 6612 <::>);
5 6613 skriv_coru(zud,coru_no(200));
5 6614 slut:
5 6615 end;
4 6616 end skriv_hoperatør;
3 6617
3 6617 trap(hop_trap);
3 6618 stack_claim(if cm_test then 198 else 146);
3 6619
3 6619 <*+2*>
3 6620 if testbit8 and overvåget or testbit28 then
3 6621 skriv_hoperatør(out,0);
3 6622 <*-2*>
3 6623 \f
3 6623 message procedure h_operatør side 2 - 820304/hko;
3 6624
3 6624 repeat
3 6625 wait_ch(cs_op,op_ref,true,-1);
3 6626 <*+4*>
3 6627 if (d.op_ref.optype and (op_optype or gen_optype)) extract 12 =0
3 6628 then fejlreaktion(12<*operationstype*>,op_ref,<:operatør:>,1);
3 6629 <*-4*>
3 6630
3 6630 k:=d.op_ref.opkode extract 12;
3 6631 dest_sem:=
3 6632 if k=0 and d.opref.kilde=299 then cs_talevejsswitch else
3 6633 if k=0 then cs_operatør(d.op_ref.kilde mod 100) else
3 6634 if k=1 or k=2 or k=43 then cs_operatør(d.op_ref.data(1)) else
3 6635 if k=4 then cs_operatør(d.op_ref.data(2)) else
3 6636 if k=37 then cs_op_spool else
3 6637 if k=40 or k=38 then 0
3 6638 else -1;
3 6639 <*+4*>
3 6640 if dest_sem=-1 then
3 6641 begin
4 6642 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul operatør:>,1);
4 6643 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 6644 end
3 6645 else
3 6646 <*-4*>
3 6647 if k=40 then
3 6648 begin
4 6649 dest_sem:= d.op_ref.retur;
4 6650 d.op_ref.retur:= cs_op_retur;
4 6651 for nr:= 1 step 1 until max_antal_operatører do
4 6652 begin
5 6653 inspect_ch(cs_operatør(nr),genoptype,ant);
5 6654 if ant < 0 and (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr)
5 6655 or læsbit_ia(samtaleflag,nr))
5 6656 and læsbit_ia(operatørmaske,nr) then
5 6657 begin
6 6658 ref:= op_ref;
6 6659 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6660 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6661 <*+4*> if op_ref <> ref then
6 6662 fejlreaktion(11<*fr.post*>,op_ref,
6 6663 <:opdater opkaldskø,retur:>,0);
6 6664 <*-4*>
6 6665 end;
5 6666 end;
4 6667 d.op_ref.retur:= dest_sem;
4 6668 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6669 end
3 6670 else
3 6671 if k=38 then
3 6672 begin
4 6673 dest_sem:= d.opref.retur;
4 6674 d.op_ref.retur:= cs_op_retur;
4 6675 for nr:= 1 step 1 until max_antal_operatører do
4 6676 begin
5 6677 if d.opref.data.op_spool_kilde <> nr then
5 6678 begin
6 6679 ref:= op_ref;
6 6680 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
6 6681 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
6 6682 <*+4*> if op_ref <> ref then
6 6683 fejlreaktion(11<*fr.post*>,op_ref,
6 6684 <:opdater opkaldskø,retur:>,0);
6 6685 <*-4*>
6 6686 end;
5 6687 end;
4 6688 if d.opref.data.op_spool_kilde<>0 then
4 6689 begin
5 6690 ref:= op_ref;
5 6691 nr:= d.opref.data.op_spool_kilde;
5 6692 signal_ch(cs_operatør(nr),opref,d.op_ref.optype);
5 6693 <*V*> wait_ch(cs_op_retur,op_ref,true,-1);
5 6694 <*+4*> if op_ref <> ref then
5 6695 fejlreaktion(11<*fr.post*>,op_ref,
5 6696 <:operatørmedddelelse, retur:>,0);
5 6697 <*-4*>
5 6698 d.op_ref.retur:= dest_sem;
5 6699 signal_ch(dest_sem,op_ref,d.op_ref.optype);
5 6700 end
4 6701 else
4 6702 begin
5 6703 d.op_ref.retur:= dest_sem;
5 6704 signal_ch(cs_io,op_ref,d.op_ref.optype);
5 6705 end;
4 6706 end
3 6707 else
3 6708 begin
4 6709 \f
4 6709 message procedure h_operatør side 3 - 810601/hko;
4 6710
4 6710 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
4 6711 begin
5 6712 iaf:=d.op_ref.data(1)*terminal_beskr_længde;
5 6713 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
5 6714 +terminal_tab.iaf.terminal_tilstand extract 21;
5 6715 end;
4 6716 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 6717 end;
3 6718 until false;
3 6719
3 6719 hop_trap:
3 6720 disable skriv_hoperatør(zbillede,1);
3 6721 end h_operatør;
2 6722 \f
2 6722 message procedure operatør side 1 - 820304/hko;
2 6723
2 6723 procedure operatør(nr);
2 6724 value nr;
2 6725 integer nr;
2 6726 begin
3 6727 integer array field op_ref,ref,vt_op,iaf,tab;
3 6728 integer i,kode,aktion,status,tilstand,bv,bs,bs_tilst,
3 6729 kanal,opgave,pos,indeks,sep,sluttegn,rkom, par1, par2,
3 6730 vogn,ll,garage,skærmmåde,res,s_kanal,v_kanal;
3 6731 real kommstart,kommslut;
3 6732 \f
3 6732 message procedure operatør side 1a - 820301/hko;
3 6733
3 6733 procedure skriv_operatør(zud,omfang);
3 6734 value omfang;
3 6735 zone zud;
3 6736 integer omfang;
3 6737 begin integer i;
4 6738
4 6738 i:= write(zud,"nl",1,<:+++ operatør nr::>,nr);
4 6739 write(zud,"sp",26-i);
4 6740 if omfang > 0 then
4 6741 disable begin
5 6742 integer x;
5 6743 trap(slut);
5 6744 write(zud,"nl",1,
5 6745 <: op-ref: :>,op_ref,"nl",1,
5 6746 <: kode: :>,kode,"nl",1,
5 6747 <: aktion: :>,aktion,"nl",1,
5 6748 <: ref: :>,ref,"nl",1,
5 6749 <: vt_op: :>,vt_op,"nl",1,
5 6750 <: iaf: :>,iaf,"nl",1,
5 6751 <: status: :>,status,"nl",1,
5 6752 <: tilstand: :>,tilstand,"nl",1,
5 6753 <: bv: :>,bv,"nl",1,
5 6754 <: bs: :>,bs,"nl",1,
5 6755 <: bs-tilst: :>,bs_tilst,"nl",1,
5 6756 <: kanal: :>,kanal,"nl",1,
5 6757 <: opgave: :>,opgave,"nl",1,
5 6758 <: pos: :>,pos,"nl",1,
5 6759 <: indeks: :>,indeks,"nl",1,
5 6760 <: sep: :>,sep,"nl",1,
5 6761 <: sluttegn: :>,sluttegn,"nl",1,
5 6762 <: vogn: :>,vogn,"nl",1,
5 6763 <: ll: :>,ll,"nl",1,
5 6764 <: garage: :>,garage,"nl",1,
5 6765 <: skærmmåde: :>,skærmmåde,"nl",1,
5 6766 <: res: :>,res,"nl",1,
5 6767 <: tab: :>,tab,"nl",1,
5 6768 <: rkom: :>,rkom,"nl",1,
5 6769 <: par1: :>,par1,"nl",1,
5 6770 <: par2: :>,par2,"nl",1,
5 6771 <::>);
5 6772 skriv_coru(zud,coru_no(200+nr));
5 6773 slut:
5 6774 end;
4 6775 end skriv_operatør;
3 6776 \f
3 6776 message procedure skærmstatus side 1 - 810518/hko;
3 6777
3 6777 integer
3 6778 procedure skærmstatus(tilstand,b_v,b_s,b_s_tilst);
3 6779 integer tilstand,b_v,b_s,b_s_tilst;
3 6780 begin
4 6781 integer i,j;
4 6782
4 6782 i:= terminal_tab.ref(1);
4 6783 b_s:= terminal_tab.ref(2);
4 6784 b_s_tilst:= i extract 12;
4 6785 j:= b_s_tilst extract 3;
4 6786 b_v:= i shift (-12) extract 4;
4 6787 tilstand:= i shift (-21);
4 6788
4 6788 skærmstatus:= if b_v = 0 and b_s = 0 then 0 else
4 6789 if b_v = 0 and j = 1<*opkald*> then 1 else
4 6790 if b_v = 0 and j = 2<*specialopkald*> then 2 else
4 6791 if (bv<>0) and (bs<>0) and (j=3) then 4 else 3;
4 6792 end skærmstatus;
3 6793 \f
3 6793 message procedure skriv_skærm side 1 - 810522/hko;
3 6794
3 6794 procedure skriv_skærm(nr);
3 6795 value nr;
3 6796 integer nr;
3 6797 begin
4 6798 integer i;
4 6799
4 6799 disable definer_taster(nr);
4 6800
4 6800 skriv_skærm_maske(nr);
4 6801 skriv_skærm_opkaldskø(nr);
4 6802 skriv_skærm_b_v_s(nr);
4 6803 for i:= 1 step 1 until max_antal_kanaler do
4 6804 skriv_skærm_kanal(nr,i);
4 6805 cursor(z_op(nr),1,1);
4 6806 <*V*> setposition(z_op(nr),0,0);
4 6807 end skriv_skærm;
3 6808 \f
3 6808 message procedure skriv_skærm_id side 1 - 830310/hko;
3 6809
3 6809 procedure skriv_skærm_id(nr,id,nød);
3 6810 value nr,id,nød;
3 6811 integer nr,id;
3 6812 boolean nød;
3 6813 begin
4 6814 integer linie,løb,bogst,i,p;
4 6815
4 6815 i:= id shift (-22);
4 6816
4 6816 case i+1 of
4 6817 begin
5 6818 begin <* busnr *>
6 6819 p:= write(z_op(nr),if nød then "*" else "sp",1,<<bddd>,
6 6820 (id extract 14) mod 10000);
6 6821 if id shift (-14) extract 8 > 0 then
6 6822 p:= p+write(z_op(nr),".",1,
6 6823 string bpl_navn(id shift (-14) extract 8));
6 6824 write(z_op(nr),"sp",11-p);
6 6825 end;
5 6826
5 6826 begin <*linie/løb*>
6 6827 linie:= id shift (-12) extract 10;
6 6828 bogst:= id shift (-7) extract 5;
6 6829 if bogst > 0 then bogst:= bogst +'A'-1;
6 6830 løb:= id extract 7;
6 6831 write(z_op(nr),if nød then "*" else "sp",1,
6 6832 "sp",if bogst=0 then 1 else 0,<<ddd>,linie,<<d>,
6 6833 false add bogst,1,"/",1,løb,
6 6834 "sp",if løb > 9 then 3 else 4);
6 6835 end;
5 6836
5 6836 begin <*gruppe*>
6 6837 write(z_op(nr),<:GRP :>);
6 6838 if id shift (-21) extract 1 = 1 then
6 6839 begin <*specialgruppe*>
7 6840 løb:= id extract 7;
7 6841 write(z_op(nr),"sp",if løb > 9 then 1 else 2,<:G:>,
7 6842 <<d>,løb,"sp",2);
7 6843 end
6 6844 else
6 6845 begin
7 6846 linie:= id shift (-5) extract 10;
7 6847 bogst:= id extract 5;
7 6848 if bogst > 0 then bogst:= bogst +'A'-1;
7 6849 write(z_op(nr),"sp",if bogst > 0 then 1 else 0,<<ddd>,linie,
7 6850 false add bogst,1,"sp",2);
7 6851 end;
6 6852 end;
5 6853
5 6853 <* kanal eller område *>
5 6854 begin
6 6855 linie:= (id shift (-20) extract 2) + 1;
6 6856 case linie of
6 6857 begin
7 6858 write(z_op(nr),"sp",11-write(z_op(nr),
7 6859 string kanal_navn(id extract 20)));
7 6860 write(z_op(nr),<:K*:>,"sp",9);
7 6861 write(z_op(nr),"sp",11-write(z_op(nr),
7 6862 <:OMR :>,string område_navn(id extract 20)));
7 6863 write(z_op(nr),<:ALLE:>,"sp",7);
7 6864 end;
6 6865 end;
5 6866
5 6866 end <* case i *>
4 6867 end skriv_skærm_id;
3 6868 \f
3 6868 message procedure skriv_skærm_kanal side 1 - 820301/hko;
3 6869
3 6869 procedure skriv_skærm_kanal(nr,kanal);
3 6870 value nr,kanal;
3 6871 integer nr,kanal;
3 6872 begin
4 6873 integer i,j,k,t,omr;
4 6874 integer array field tref,kref;
4 6875 boolean nød;
4 6876
4 6876 tref:= nr*terminal_beskr_længde;
4 6877 kref:= (kanal-1)*kanal_beskr_længde;
4 6878 t:= kanaltab.kref.kanal_tilstand;
4 6879 j:= terminal_tab.tref(1) shift (-12) extract 4; <* b_v kanalnr *>
4 6880 k:= terminal_tab.tref(2); <* 3 shift 22 +kanal, hvis samtale *>
4 6881 cursor(z_op(nr),kanal+2,28);
4 6882 write(z_op(nr),if læsbit_i(kanaltab.kref.kanal_tilstand,10) then "*" else
4 6883 if læsbit_i(kanaltab.kref.kanal_tilstand,11) then "+" else
4 6884 " ",1," ",1);
4 6885 write(z_op(nr),true,6,string kanal_navn(kanal));
4 6886 omr:= if kanal_id(kanal) shift (-5) extract 3 = 2 then
4 6887 pabx_id(kanal_id(kanal) extract 5)
4 6888 else
4 6889 radio_id(kanal_id(kanal) extract 5);
4 6890 for i:= -2 step 1 until 0 do
4 6891 begin
5 6892 write(z_op(nr),
5 6893 if område_id(omr,1) shift (8*i) extract 8 = 0 then " "
5 6894 else false add (område_id(omr,1) shift (8*i) extract 8),1);
5 6895 end;
4 6896 write(z_op(nr),<:: :>);
4 6897 i:= tv_operatør(kanaltab.kref.kanal_tilstand shift (-16));<*operatør*>
4 6898 if læsbit_ia(kanaltab.kref.kanal_alarm, nr) then
4 6899 begin
5 6900 sætbit_ia(kanaltab.kref.kanal_alarm, nr, 0);
5 6901 <* write(z_op(nr),<:ALARM !:>,"bel",1); *>
5 6902 end
4 6903 else
4 6904 if kanaltab.kref.kanal_tilstand shift (-12) extract 4 = 15 then
4 6905 write(z_op(nr),<:-:><*UDE AF DRIFT*>)
4 6906 else
4 6907 if i > 0 and
4 6908 ( i <> nr
4 6909 or j = kanal <* kanal = kanalnr for ventepos *>
4 6910 or (terminal_tab.tref.terminal_tilstand shift (-21) = 1
4 6911 <*tilst=samtale*> and k extract 22 = kanal) ) then
4 6912 begin
5 6913 write(z_op(nr),<:OPT :>);
5 6914 if bpl_navn(i)=long<::> then write(z_op(nr),<:op:>,<<d>,i)
5 6915 else write(z_op(nr),string bpl_navn(i));
5 6916 end
4 6917 else
4 6918 if false then
4 6919 begin
5 6920 i:= kanaltab.kref.kanal_id1;
5 6921 nød:= læsbit_i(kanaltab.kref.kanal_tilstand,3);
5 6922 skriv_skærm_id(nr,i,nød);
5 6923 write(z_op(nr),if t extract 2 = 3 then <:GNM :> else <:OPKALDT:>);
5 6924 i:= kanaltab.kref.kanal_id2;
5 6925 if i<>0 then skriv_skærm_id(nr,i,false);
5 6926 end;
4 6927 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6928 end skriv_skærm_kanal;
3 6929 \f
3 6929 message procedure skriv_skærm_b_v_s side 1 - 810601/hko;
3 6930
3 6930 procedure skriv_skærm_b_v_s(nr);
3 6931 value nr;
3 6932 integer nr;
3 6933 begin
4 6934 integer i,j,k,kv,ks,t;
4 6935 integer array field tref,kref;
4 6936
4 6936 tref:= nr*terminal_beskr_længde;
4 6937 i:= terminal_tab.tref.terminal_tilstand;
4 6938 kv:= i shift (-12) extract 4;
4 6939 ks:= terminaltab.tref(2) extract 20;
4 6940 <*V*> setposition(z_op(nr),0,0);
4 6941 cursor(z_op(nr),18,28);
4 6942 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6943 cursor(z_op(nr),20,28);
4 6944 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6945 cursor(z_op(nr),21,28);
4 6946 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
4 6947 cursor(z_op(nr),20,28);
4 6948 if op_talevej(nr)<>0 then
4 6949 begin
5 6950 cursor(z_op(nr),18,28);
5 6951 write(z_op(nr),<:talevej: :>,<<d>,op_talevej(nr));
5 6952 end;
4 6953 if kv <> 0 then
4 6954 begin
5 6955 kref:= (kv-1)*kanal_beskr_længde;
5 6956 j:= if kv<>ks then kanaltab.kref.kanal_id1
5 6957 else kanaltab.kref.kanal_id2;
5 6958 k:= if kv<>ks then kanaltab.kref.kanal_alt_id1
5 6959 else kanaltab.kref.kanal_alt_id2;
5 6960 write(z_op(nr),true,6,string kanal_navn(kv));
5 6961 skriv_skærm_id(nr,j,kanaltab.kref.kanaltilstand shift(-3) extract 1=1);
5 6962 skriv_skærm_id(nr,k,false);
5 6963 write(z_op(nr),if i extract 2 = 3 then <:GNM:> else <:VNT:>);
5 6964 end;
4 6965
4 6965 cursor(z_op(nr),21,28);
4 6966 j:= terminal_tab.tref(2);
4 6967 if i shift (-21) <> 0 <*ikke ledig*> then
4 6968 begin
5 6969 \f
5 6969 message procedure skriv_skærm_b_v_s side 2 - 841210/cl;
5 6970
5 6970 if i shift (-21) = 1 <*samtale*> then
5 6971 begin
6 6972 if j shift (-20) = 12 then
6 6973 begin
7 6974 write(z_op(nr),true,6,string kanal_navn(ks));
7 6975 end
6 6976 else
6 6977 begin
7 6978 write(z_op(nr),true,6,<:K*:>);
7 6979 k:= 0;
7 6980 while ks shift (-k) extract 1 = 0 and k<max_antal_kanaler do
7 6981 k:= k+1;
7 6982 ks:= k;
7 6983 end;
6 6984 kref:= (ks-1)*kanal_beskr_længde;
6 6985 t:= kanaltab.kref.kanaltilstand;
6 6986 skriv_skærm_id(nr,kanaltab.kref.kanal_id1,
6 6987 t shift (-3) extract 1 = 1);
6 6988 skriv_skærm_id(nr,kanaltab.kref.kanal_alt_id1,false);
6 6989 write(z_op(nr),if i shift (-11) extract 1 = 1 then <:-P-:> else
6 6990 if t shift (-5) extract 1 = 1 then <:MON :> else
6 6991 if t shift (-4) extract 1 = 1 then <:BSV :> else
6 6992 if t shift (-6) extract 1 = 1 then <:PAS :> else
6 6993 if t shift (-7) extract 1 = 1 then <:LYT :> else <:TAL :>);
6 6994 if t shift (-9) extract 1 = 1 then
6 6995 write(z_op(nr),<:ALLE :>);
6 6996 if t shift (-8) extract 1 = 1 then
6 6997 write(z_op(nr),<:KATASTROFE :>);
6 6998 k:= kanaltab.kref.kanal_spec;
6 6999 if t extract 2 <> 3 and t shift (-4) extract 1 = 1 then
6 7000 write(z_op(nr),<<zd.dd>,(k extract 12)/100);
6 7001 end
5 7002 else <* if i shift (-21) = 2 <+optaget+> then *>
5 7003 begin
6 7004 write(z_op(nr),<:K-:>,"sp",3);
6 7005 if j <> 0 then
6 7006 skriv_skærm_id(nr,j,false)
6 7007 else
6 7008 begin
7 7009 j:=terminal_tab.tref(3);
7 7010 skriv_skærm_id(nr,j,
7 7011 false add (if i shift(-4) extract 1 = 1 then 2 <* mobil opk. *>
7 7012 else 0));
7 7013 end;
6 7014 write(z_op(nr),<:OPT:>);
6 7015 end;
5 7016 end;
4 7017 <*V*> setposition(z_op(nr),0,0);
4 7018 end skriv_skærm_b_v_s;
3 7019 \f
3 7019 message procedure skriv_skærm_maske side 1 - 810511/hko;
3 7020
3 7020 procedure skriv_skærm_maske(nr);
3 7021 value nr;
3 7022 integer nr;
3 7023 begin
4 7024 integer i;
4 7025 <*V*> setposition(z_op(nr),0,0);
4 7026 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
4 7027 "sp",26,"*",5,<: operatør :>,<<d>,nr,"sp",1,string bpl_navn(nr),
4 7028 "sp",1,"*",5,"nl",1,"-",80);
4 7029
4 7029 for i:= 3 step 1 until 21 do
4 7030 begin
5 7031 cursor(z_op(nr),i,26);
5 7032 outchar(z_op(nr),'!');
5 7033 end;
4 7034 cursor(z_op(nr),22,1);
4 7035 write(z_op(nr),"-",80);
4 7036 cursor(z_op(nr),1,1);
4 7037 <*V*> setposition(z_op(nr),0,0);
4 7038 end skriv_skærm_maske;
3 7039 \f
3 7039 message procedure skal_udskrives side 1 - 940522/cl;
3 7040
3 7040 boolean procedure skal_udskrives(fordelt_til,aktuel_skærm);
3 7041 value fordelt_til,aktuel_skærm;
3 7042 integer fordelt_til,aktuel_skærm;
3 7043 begin
4 7044 boolean skal_ud;
4 7045 integer n;
4 7046 integer array field iaf;
4 7047
4 7047 skal_ud:= true;
4 7048 if fordelt_til > 0 and fordelt_til<>aktuel_skærm then
4 7049 begin
5 7050 for n:= 0 step 1 until 3 do
5 7051 begin
6 7052 if bpl_tilst(operatør_stop(fordelt_til,n),1) > 0 then
6 7053 begin
7 7054 iaf:= operatør_stop(fordelt_til,n)*op_maske_lgd;
7 7055 skal_ud:= læsbit_ia(bpl_def.iaf,aktuel_skærm);
7 7056 goto returner;
7 7057 end;
6 7058 end;
5 7059 end;
4 7060 returner:
4 7061 skal_udskrives:= skal_ud;
4 7062 end;
3 7063
3 7063 message procedure skriv_skærm_opkaldskø side 1 - 820301/hko;
3 7064
3 7064 procedure skriv_skærm_opkaldskø(nr);
3 7065 value nr;
3 7066 integer nr;
3 7067 begin
4 7068 integer i,ant,vogn,type,operatør,ttmm,linie,bogst,løb,kmdo;
4 7069 integer array field ref,iaf,tab;
4 7070 boolean skal_ud;
4 7071
4 7071 <*V*> wait(bs_opkaldskø_adgang);
4 7072 setposition(z_op(nr),0,0);
4 7073 ant:= 0; kmdo:= 0;
4 7074 tab:= (nr-1)*opk_alarm_tab_lgd;
4 7075 ref:= første_nødopkald;
4 7076 if ref=0 then ref:=første_opkald;
4 7077 while ref <> 0 do
4 7078 begin
5 7079 i:= opkaldskø.ref(4);
5 7080 operatør:= i extract 8;
5 7081 type:=i shift (-8) extract 4;
5 7082
5 7082 <* skal_ud:= operatør = nr or -,læsbit_ia(operatørmaske,operatør);
5 7083 *>
5 7084 if operatør > 64 then
5 7085 begin
6 7086 <* fordelt til gruppe af betjeningspladser *>
6 7087 i:= 0; skal_ud:= true; iaf:= operatør*op_maske_lgd;
6 7088 while skal_ud and i<max_antal_operatører do
6 7089 begin
7 7090 i:=i+1;
7 7091 if læsbit_ia(bpl_def.iaf,i) then
7 7092 skal_ud:= skal_ud and skal_udskrives(i,nr);
7 7093 end;
6 7094 end
5 7095 else
5 7096 skal_ud:= skal_udskrives(operatør,nr);
5 7097 if skal_ud then
5 7098 begin
6 7099 ant:= ant +1;
6 7100 if ant < 6 then
6 7101 begin
7 7102 <*V*> cursor(z_op(nr),ant*2+1,3);
7 7103 ttmm:= i shift (-12);
7 7104 vogn:= opkaldskø.ref(3);
7 7105 if vogn = 0 then vogn:= opkaldskø.ref(2) extract 22;
7 7106 skriv_skærm_id(nr,vogn,type=2);
7 7107 write(z_op(nr),true,4,
7 7108 string område_navn(opkaldskø.ref(5) extract 4),
7 7109 <<zd.dd>,ttmm/100.0);
7 7110 if -, læsbit_ia(opkaldskø.ref.opkald_meldt,nr) then
7 7111 begin
8 7112 if opkaldskø.ref(5) extract 4 <= 2 or
8 7113 opk_alarm.tab.alarm_lgd = 0 then
8 7114 begin
9 7115 if type=2 then
9 7116 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1)
9 7117 else
9 7118 write(z_op(nr),"bel",1);
9 7119 end
8 7120 else if type>kmdo then kmdo:= type;
8 7121 sætbit_ia(opkaldskø.ref.opkald_meldt,nr,1);
8 7122 end;
7 7123 end;<* ant < 6 *>
6 7124 end;<* operatør ok *>
5 7125
5 7125 ref:= opkaldskø.ref(1) extract 12;
5 7126 if ref = 0 and type = 2<*nød*> then ref:= første_opkald;
5 7127 end;
4 7128 \f
4 7128 message procedure skriv_skærm_opkaldskø side 2 - 820301/hko;
4 7129
4 7129 signal_bin(bs_opkaldskø_adgang);
4 7130 if kmdo > opk_alarm.tab.alarm_tilst and
4 7131 kmdo > opk_alarm.tab.alarm_kmdo then
4 7132 begin
5 7133 opk_alarm.tab.alarm_kmdo:= kmdo;
5 7134 signal_bin(bs_opk_alarm);
5 7135 end;
4 7136 if ant > 5 then
4 7137 begin
5 7138 cursor(z_op(nr),13,9);
5 7139 write(z_op(nr),<<+ddd>,ant-5);
5 7140 end
4 7141 else
4 7142 begin
5 7143 for i:= ant +1 step 1 until 6 do
5 7144 begin
6 7145 cursor(z_op(nr),i*2+1,1);
6 7146 write(z_op(nr),"sp",25);
6 7147 end;
5 7148 end;
4 7149 ant_i_opkø(nr):= ant;
4 7150 cursor(z_op(nr),1,1);
4 7151 <*V*> setposition(z_op(nr),0,0);
4 7152 end skriv_skærm_opkaldskø;
3 7153 \f
3 7153 message procedure operatør side 2 - 810522/hko;
3 7154
3 7154 trap(op_trap);
3 7155 stack_claim((if cm_test then 200 else 146)+24+48+80+175);
3 7156
3 7156 ref:= nr*terminal_beskr_længde;
3 7157 tab:= (nr-1)*opk_alarm_tab_lgd;
3 7158 skærmmåde:= 0; <*normal*>
3 7159
3 7159 if operatør_auto_include(nr) then
3 7160 begin
4 7161 waitch(cs_att_pulje,opref,true,-1);
4 7162 i:= operatør_auto_include(nr) extract 2;
4 7163 if i<>3 then i:= 0;
4 7164 start_operation(opref,101,cs_att_pulje,i shift 12 +1);
4 7165 d.opref.data(1):= nr;
4 7166 signalch(cs_rad,opref,gen_optype or io_optype);
4 7167 end;
3 7168
3 7168 <*+2*>
3 7169 if testbit8 and overvåget or testbit28 then
3 7170 skriv_operatør(out,0);
3 7171 <*-2*>
3 7172 \f
3 7172 message procedure operatør side 3 - 810602/hko;
3 7173
3 7173 repeat
3 7174
3 7174 <*V*> wait_ch(cs_operatør(nr),
3 7175 op_ref,
3 7176 true,
3 7177 -1<*timeout*>);
3 7178 <*+2*>
3 7179 if testbit9 and overvåget then
3 7180 disable begin
4 7181 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_operatør(nr),
4 7182 <: til operatør :>,nr);
4 7183 skriv_op(out,op_ref);
4 7184 end;
3 7185 <*-2*>
3 7186 monitor(8)reserve process:(z_op(nr),0,ia);
3 7187 kode:= d.op_ref.op_kode extract 12;
3 7188 i:= terminal_tab.ref.terminal_tilstand;
3 7189 status:= i shift(-21);
3 7190 opgave:=
3 7191 if kode=0 then 1 <* indlæs kommando *> else
3 7192 if kode=1 then 2 <* inkluder *> else
3 7193 if kode=2 then 3 <* ekskluder *> else
3 7194 if kode=40 then 4 <* opdater skærm *> else
3 7195 if kode=43 then 5 <* opkald etableret *> else
3 7196 if kode=4 then 6 <* radiokanal ekskluderet *> else
3 7197 if kode=38 then 7 <* operatør meddelelse *> else
3 7198 0; <* afvises *>
3 7199
3 7199 aktion:= case status +1 of(
3 7200 <* status *> <* opgave: 0 1 2 3 4 5 6 7 *>
3 7201 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3, 4, -4, 6, 7)),
3 7202 <* 1 samtale *>(case opgave+1 of( 0, 1, -4, -5, 4, -4, 6, 7)),
3 7203 <* 2 optaget *>(case opgave+1 of( 0, 1, -4, -5, 4, 5, 6, 7)),
3 7204 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3, -4, -4, -4, 7)),
3 7205 <* 4 klar (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7206 <* 5 samt.(fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, -4, 6, -4)),
3 7207 <* 6 opt. (fejl) *>(case opgave+1 of( 0, -4, 2, 3, -4, 5, -4, -4)),
3 7208 <* 7 ej knyttet *>(case opgave+1 of( 0, -4, 2, -4, -4, -4, -4, -4)),
3 7209 -1);
3 7210 \f
3 7210 message procedure operatør side 4 - 810424/hko;
3 7211
3 7211 case aktion+6 of
3 7212 begin
4 7213 begin
5 7214 <*-5: terminal optaget *>
5 7215
5 7215 d.op_ref.resultat:= 16;
5 7216 afslut_operation(op_ref,-1);
5 7217 end;
4 7218
4 7218 begin
5 7219 <*-4: operation uden virkning *>
5 7220
5 7220 afslut_operation(op_ref,-1);
5 7221 end;
4 7222
4 7222 begin
5 7223 <*-3: ulovlig operationskode *>
5 7224
5 7224 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 7225 afslut_operation(op_ref,-1);
5 7226 end;
4 7227
4 7227 begin
5 7228 <*-2: ulovligt operatørterminal_nr *>
5 7229
5 7229 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende operatør:>,1);
5 7230 afslut_operation(op_ref,-1);
5 7231 end;
4 7232
4 7232 begin
5 7233 <*-1: ulovlig operatørtilstand *>
5 7234
5 7234 fejl_reaktion(3<*programfejl*>,status,<: ulovlig operatør-status:>,1);
5 7235 afslut_operation(op_ref,-1);
5 7236 end;
4 7237
4 7237 begin
5 7238 <* 0: ikke implementeret *>
5 7239
5 7239 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 7240 afslut_operation(op_ref,-1);
5 7241 end;
4 7242
4 7242 begin
5 7243 \f
5 7243 message procedure operatør side 5 - 851001/cl;
5 7244
5 7244 <* 1: indlæs kommando *>
5 7245
5 7245
5 7245 <*V*> læs_kommando(z_op(nr),200+nr,op_ref,pos,indeks,sep,sluttegn);
5 7246 if opk_alarm.tab.alarm_tilst > 0 then
5 7247 begin
6 7248 opk_alarm.tab.alarm_kmdo:= 3;
6 7249 signal_bin(bs_opk_alarm);
6 7250 pass;
6 7251 end;
5 7252 if d.op_ref.resultat > 3 then
5 7253 begin
6 7254 <*V*> setposition(z_op(nr),0,0);
6 7255 cursor(z_op(nr),24,1);
6 7256 skriv_kvittering(z_op(nr),op_ref,pos,
6 7257 d.op_ref.resultat);
6 7258 end
5 7259 else if d.op_ref.resultat = -1 then
5 7260 begin
6 7261 skærmmåde:= 0;
6 7262 skrivskærm(nr);
6 7263 end
5 7264 else if d.op_ref.resultat>0 then
5 7265 begin <*godkendt*>
6 7266 kode:=d.op_ref.opkode;
6 7267 i:= kode extract 12;
6 7268 j:= if kode = 11 or kode = 12 then 1 <*VO,I/VO,U*> else
6 7269 if kode = 19 then 1 <*VO,S *> else
6 7270 if kode = 20 or kode = 24 then 1 <*VO,F/VO,R*> else
6 7271 if kode = 9 or kode = 10 then 2 <*VO,L/VO,B*> else
6 7272 if kode = 6 then 4 <*STop*> else
6 7273 if 45<=kode and kode<=63 then 3 <*radiokom.*> else
6 7274 if kode = 30 then 5 <*SP,D*> else
6 7275 if kode = 31 then 6 <*SP*> else
6 7276 if kode = 32 or kode = 33 then 7 <*SP,V/SP,O*> else
6 7277 if kode = 34 or kode = 35 then 6 <*SP,R/SP,A*> else
6 7278 if kode = 83 then 8 <*SL*> else
6 7279 if kode = 68 then 9 <*ST,D*> else
6 7280 if kode = 69 then 10 <*ST,V*> else
6 7281 if kode = 36 then 11 <*AL*> else
6 7282 if kode = 37 then 12 <*CC*> else
6 7283 if kode = 2 then 13 <*EX*> else
6 7284 if kode = 92 then 14 <*CQF,V*> else
6 7285 0;
6 7286 if j > 0 then
6 7287 begin
7 7288 case j of
7 7289 begin
8 7290 begin
9 7291 \f
9 7291 message procedure operatør side 6 - 851001/cl;
9 7292
9 7292 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 7293
9 7293 vogn:=ia(1);
9 7294 ll:=ia(2);
9 7295 kanal:= if kode=11 or kode=19 then ia(3) else
9 7296 if kode=12 then ia(2) else 0;
9 7297 <*V*> wait_ch(cs_vt_adgang,
9 7298 vt_op,
9 7299 gen_optype,
9 7300 -1<*timeout sek*>);
9 7301 start_operation(vtop,200+nr,cs_operatør(nr),
9 7302 kode);
9 7303 d.vt_op.data(1):=vogn;
9 7304 if kode=11 or kode=19 or kode=20 or kode=24 then
9 7305 d.vt_op.data(2):=ll;
9 7306 if kode=19 then d.vt_op.data(3):= kanal else
9 7307 if kode=11 or kode=12 then d.vt_op.data(4):= kanal;
9 7308 indeks:= vt_op;
9 7309 signal_ch(cs_vt,
9 7310 vt_op,
9 7311 gen_optype or op_optype);
9 7312
9 7312 <*V*> wait_ch(cs_operatør(nr),
9 7313 vt_op,
9 7314 op_optype,
9 7315 -1<*timeout sek*>);
9 7316 <*+2*> if testbit10 and overvåget then
9 7317 disable begin
10 7318 write(out,"nl",1,<:operatør :>,<<d>,nr,
10 7319 <:: operation retur fra vt:>);
10 7320 skriv_op(out,vt_op);
10 7321 end;
9 7322 <*-2*>
9 7323 <*+4*> if vt_op<>indeks then
9 7324 fejl_reaktion(11<*fremmede op*>,op_ref,
9 7325 <:operatør-kommando:>,0);
9 7326 <*-4*>
9 7327 <*V*> setposition(z_op(nr),0,0);
9 7328 cursor(z_op(nr),24,1);
9 7329 <*V*> skriv_kvittering(z_op(nr),if d.vt_op.resultat = 11 or
9 7330 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 7331 else vt_op,-1,d.vt_op.resultat);
9 7332 d.vt_op.optype:= gen_optype or vt_optype;
9 7333 disable afslut_operation(vt_op,cs_vt_adgang);
9 7334 end;
8 7335 begin
9 7336 \f
9 7336 message procedure operatør side 7 - 810921/hko,cl;
9 7337
9 7337 <* 2 vogntabel,linienr/-,busnr *>
9 7338
9 7338 d.op_ref.retur:= cs_operatør(nr);
9 7339 tofrom(d.op_ref.data,ia,10);
9 7340 indeks:= op_ref;
9 7341 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 7342 wait_ch(cs_operatør(nr),
9 7343 op_ref,
9 7344 op_optype,
9 7345 -1<*timeout*>);
9 7346 <*+2*> if testbit10 and overvåget then
9 7347 disable begin
10 7348 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 7349 skriv_op(out,op_ref);
10 7350 end;
9 7351 <*-2*>
9 7352 <*+4*>
9 7353 if indeks <> op_ref then
9 7354 fejlreaktion(11<*fremmed post*>,op_ref,<:operatør komm:>,0);
9 7355 <*-4*>
9 7356 i:= d.op_ref.resultat;
9 7357 if i = 0 or i > 3 then
9 7358 begin
10 7359 <*V*> setposition(z_op(nr),0,0);
10 7360 cursor(z_op(nr),24,1);
10 7361 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 7362 end
9 7363 else
9 7364 begin
10 7365 integer antal,fil_ref;
10 7366
10 7366 skærm_måde:= 1;
10 7367 antal:= d.op_ref.data(6);
10 7368 fil_ref:= d.op_ref.data(7);
10 7369 <*V*> setposition(z_op(nr),0,0);
10 7370 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
10 7371 "sp",14,"*",10,"sp",6,
10 7372 <:vogntabeludskrift:>,"sp",6,"*",10,"nl",2);
10 7373 <*V*> setposition(z_op(nr),0,0);
10 7374 \f
10 7374 message procedure operatør side 8 - 841213/cl;
10 7375
10 7375 pos:= 1;
10 7376 while pos <= antal do
10 7377 begin
11 7378 integer bogst,løb;
11 7379
11 7379 disable i:= læs_fil(fil_ref,pos,j);
11 7380 if i <> 0 then
11 7381 fejlreaktion(5<*læs_fil*>,i,<:operatør: vo,l/vo,b:>,0)
11 7382 else
11 7383 begin
12 7384 vogn:= fil(j,1) shift (-24) extract 24;
12 7385 løb:= fil(j,1) extract 24;
12 7386 if d.op_ref.opkode=9 then
12 7387 begin i:=vogn; vogn:=løb; løb:=i; end;
12 7388 ll:= løb shift (-12) extract 10;
12 7389 bogst:= løb shift (-7) extract 5;
12 7390 if bogst > 0 then bogst:= bogst +'A'-1;
12 7391 løb:= løb extract 7;
12 7392 vogn:= vogn extract 14;
12 7393 i:= d.op_ref.opkode-8;
12 7394 for i:= i,i+1 do
12 7395 begin
13 7396 j:= (i+1) extract 1;
13 7397 case j +1 of
13 7398 begin
14 7399 write(z_op(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 7400 false add bogst,1,"/",1,<<d__>,løb);
14 7401 write(z_op(nr),<<dddd>,vogn,"sp",1);
14 7402 end;
13 7403 end;
12 7404 if pos mod 5 = 0 then
12 7405 begin
13 7406 outchar(z_op(nr),'nl');
13 7407 <*V*> setposition(z_op(nr),0,0);
13 7408 end
12 7409 else write(z_op(nr),"sp",3);
12 7410 end;
11 7411 pos:=pos+1;
11 7412 end;
10 7413 write(z_op(nr),"*",1,"nl",1);
10 7414 \f
10 7414 message procedure operatør side 8a- 810507/hko;
10 7415
10 7415 d.opref.opkode:=104; <*slet-fil*>
10 7416 d.op_ref.data(4):=filref;
10 7417 indeks:=op_ref;
10 7418 signal_ch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 7419 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7420
10 7420 <*+2*> if testbit10 and overvåget then
10 7421 disable begin
11 7422 write(out,"nl",1,<:operatør, slet-fil retur:>);
11 7423 skriv_op(out,op_ref);
11 7424 end;
10 7425 <*-2*>
10 7426
10 7426 <*+4*> if op_ref<>indeks then
10 7427 fejlreaktion(11<*fr.post*>,op_ref,<:operatør,slet-fil:>,0);
10 7428 <*-4*>
10 7429 if d.op_ref.data(9)<>0 then
10 7430 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 7431 <:operatør, slet_fil:>,1);
10 7432 end;
9 7433 end;
8 7434
8 7434 begin
9 7435 \f
9 7435 message procedure operatør side 9 - 830310/hko;
9 7436
9 7436 <* 3 radio_kommandoer *>
9 7437
9 7437 kode:= d.op_ref.opkode;
9 7438 rkom:= kode-44; par1:=ia(1); par2:=ia(2);
9 7439 disable if testbit14 then
9 7440 begin
10 7441 integer i; <*lav en trap-bar blok*>
10 7442
10 7442 trap(test14_trap);
10 7443 systime(1,0,kommstart);
10 7444 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7445 string bpl_navn(nr),<: start :>,case rkom of (
10 7446 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7447 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7448 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7449 <:GE,T:>),<: :>);
10 7450 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7451 rkom=16 or rkom=17 or rkom=19)
10 7452 then
10 7453 begin
11 7454 if par1<>0 then skriv_id(zrl,par1,0);
11 7455 if par2<>0 and rkom<>13 and rkom<>14 and rkom<>19 then
11 7456 write(zrl,"sp",1,string områdenavn(par2));
11 7457 end
10 7458 else
10 7459 if rkom=10 and par1<>0 then
10 7460 write(zrl,string kanalnavn(par1 extract 20))
10 7461 else
10 7462 if rkom=5 or rkom=6 then
10 7463 begin
11 7464 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7465 if par1 shift (-20)=14 then
11 7466 write(zrl,string områdenavn(par1 extract 20));
11 7467 end;
10 7468 test14_trap: outchar(zrl,'nl');
10 7469 end;
9 7470 d.op_ref.data(4):= nr; <*operatør*>
9 7471 opgave:=
9 7472 if kode = 45 <*OP *> then 1 else
9 7473 if kode = 46 <*ME *> then 2 else
9 7474 if kode = 47 <*OP,G*> then 3 else
9 7475 if kode = 48 <*ME,G*> then 4 else
9 7476 if kode = 49 <*OP,A*> then 5 else
9 7477 if kode = 50 <*ME,A*> then 6 else
9 7478 if kode = 51 <*KA,C*> then 7 else
9 7479 if kode = 52 <*KA,P*> then 8 else
9 7480 if kode = 53 <*OP,L*> then 9 else
9 7481 if kode = 54 <*MO *> then (if ia(1)=0 then 11 else 10) else
9 7482 if kode = 55 <*VE *> then 14 else
9 7483 if kode = 56 <*NE *> then 12 else
9 7484 if kode = 57 <*OP,V*> then 1 else
9 7485 if kode = 58 <*OP,T*> then 1 else
9 7486 if kode = 59 <*R *> then 13 else
9 7487 if kode = 60 <*GE *> then 15 else
9 7488 if kode = 61 <*GE,G*> then 16 else
9 7489 if kode = 62 <*GE,V*> then 15 else
9 7490 if kode = 63 <*GE,T*> then 15 else
9 7491 -1;
9 7492 <*+4*> if opgave < 0 then
9 7493 fejlreaktion(2<*operationskode*>,kode,
9 7494 <:operatør, radio-kommando :>,0);
9 7495 <*-4*>
9 7496 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7497 i:= d.op_ref.data(2):= ia(1); <* ident.*>
9 7498 if 5<=opgave and opgave<=8 then
9 7499 d.opref.data(2):= -1;
9 7500 if opgave=13 then d.opref.data(2):=
9 7501 (if læsbit_i(terminaltab.ref.terminaltilstand,11)
9 7502 then 0 else 1);
9 7503 if opgave = 14 then d.opref.data(2):= 1;
9 7504 if opgave=7 or opgave=8 then
9 7505 d.opref.data(3):= -1
9 7506 else
9 7507 if opgave=5 or opgave=6 then
9 7508 begin
10 7509 if ia(1) shift (-20) = 15 then
10 7510 begin
11 7511 d.opref.data(3):= 15 shift 20;
11 7512 for j:= 1 step 1 until max_antal_kanaler do
11 7513 begin
12 7514 iaf:= (j-1)*kanalbeskrlængde;
12 7515 if læsbit_i(kanaltab.iaf.kanal_tilstand,11) and
12 7516 læsbit_i(ia(1),kanal_til_omr(j)) then
12 7517 sætbit_i(d.opref.data(3),kanal_til_omr(j),1);
12 7518 end;
11 7519 end
10 7520 else
10 7521 d.opref.data(3):= if ia(1)=0 then 14 shift 20 + 3
10 7522 else ia(1);
10 7523 end
9 7524 else
9 7525 if kode = 57 then d.opref.data(3):= 2 else
9 7526 if kode = 58 then d.opref.data(3):= 1 else
9 7527 if kode = 62 then d.opref.data(3):= 2 else
9 7528 if kode = 63 then d.opref.data(3):= 1 else
9 7529 d.opref.data(3):= ia(2);
9 7530
9 7530 <* !!! i første if-sætning nedenfor er 'status>1'
9 7531 rettet til 'status>0' for at forhindre
9 7532 at opkald nr. 2 kan udføres med et allerede
9 7533 etableret opkald i skærmens s-felt,
9 7534 jvf. ulykke d. 7/2-1995
9 7535 !!! *>
9 7536 res:=
9 7537 if (opgave=1 or opgave=3) and status>0
9 7538 then 16 <*skærm optaget*> else
9 7539 if (opgave=15 or opgave=16) and
9 7540 status>1 then 16 <*skærm optaget*> else
9 7541 if (opgave=1 or opgave=3) and status=0 then 1 else
9 7542 if (opgave=15 or opgave=16) and status=0 then 21 else
9 7543 if (opgave=1 or opgave=3 or opgave=15 or opgave=16) then
9 7544 (if (d.opref.data(3)=1 or d.opref.data(3)=2) and
9 7545 d.opref.data(3) = kanal_til_omr(bs extract 6)
9 7546 then 52 else 1) else
9 7547 if opgave<11 and status>0 then 16 else
9 7548 if opgave=11 and status<2 then 21 else
9 7549 if opgave=12 and status=0 then 22 else
9 7550 if opgave=13 and status=0 then 49 else
9 7551 if opgave=14 and status<>3 then 21 else 1;
9 7552 if res=1 and (d.opref.data(3)=1 or d.opref.data(3)=2) then
9 7553 begin <* specialbetingelser for TLF og VHF *>
10 7554 if (1<opgave and opgave<9) or opgave=16 then res:= 51;
10 7555 end;
9 7556 if skærmmåde<>0 then
9 7557 begin skærm_måde:= 0; skriv_skærm(nr); end;
9 7558 kode:= opgave;
9 7559 if opgave = 15 then opgave:= 1 else
9 7560 if opgave = 16 then opgave:= 3;
9 7561 \f
9 7561 message procedure operatør side 10 - 810616/hko;
9 7562
9 7562 <* tilknyt talevej (om nødvendigt) *>
9 7563 if res = 1 and op_talevej(nr)=0 then
9 7564 begin
10 7565 i:= sidste_tv_brugt;
10 7566 repeat
10 7567 i:= (i mod max_antal_taleveje)+1;
10 7568 if tv_operatør(i)=0 then
10 7569 begin
11 7570 tv_operatør(i):= nr;
11 7571 op_talevej(nr):= i;
11 7572 end;
10 7573 until op_talevej(nr)<>0 or i=sidste_tv_brugt;
10 7574 if op_talevej(nr)=0 then
10 7575 res:=61
10 7576 else
10 7577 begin
11 7578 sidste_tv_brugt:=
11 7579 (sidste_tv_brugt mod max_antal_taleveje)+1;
11 7580
11 7580 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
11 7581 start_operation(iaf,200+nr,cs_operatør(nr),
11 7582 'A' shift 12 + 44);
11 7583 d.iaf.data(1):= op_talevej(nr);
11 7584 d.iaf.data(2):= nr+16;
11 7585 ll:= 0;
11 7586 repeat
11 7587 signalch(cs_talevejsswitch,iaf,op_optype);
11 7588 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7589 ll:= ll+1;
11 7590 until ll=3 or d.iaf.resultat=3;
11 7591 res:= if d.iaf.resultat=3 then 1 else 61;
11 7592 <* ********* *>
11 7593 delay(1);
11 7594 start_operation(iaf,200+nr,cs_operatør(nr),
11 7595 'R' shift 12 + 44);
11 7596 ll:= 0;
11 7597 repeat
11 7598 signalch(cs_talevejsswitch,iaf,op_optype);
11 7599 waitch(cs_operatør(nr),iaf,op_optype,-1);
11 7600 ll:= ll+1;
11 7601 until ll=3 or d.iaf.resultat=3;
11 7602 <* ********* *>
11 7603 signalch(cs_tvswitch_adgang,iaf,op_optype);
11 7604 if res<>1 then
11 7605 op_talevej(nr):=tv_operatør(op_talevej(nr)):= 0;
11 7606 end;
10 7607 end;
9 7608 if op_talevej(nr)=0 then res:= 61;
9 7609 d.op_ref.data(1):= op_talevej(nr);
9 7610
9 7610 if res <= 1 then
9 7611 begin
10 7612 til_radio: <* send operation til radiomodul *>
10 7613 d.op_ref.opkode:= opgave shift 12 + 41;
10 7614 d.op_ref.data(5):= if b_v<>0 then 12 shift 20 + b_v
10 7615 else 0;
10 7616 d.op_ref.data(6):= b_s;
10 7617 d.op_ref.resultat:=0;
10 7618 d.op_ref.retur:= cs_operatør(nr);
10 7619 indeks:= op_ref;
10 7620 <*+2*> if testbit11 and overvåget then
10 7621 disable begin
11 7622 skriv_operatør(out,0);
11 7623 write(out,<: operation til radio:>);
11 7624 skriv_op(out,op_ref); ud;
11 7625 end;
10 7626 <*-2*>
10 7627 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7628 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7629
10 7629 <*+2*> if testbit12 and overvåget then
10 7630 disable begin
11 7631 skriv_operatør(out,0);
11 7632 write(out,<: operation retur fra radio:>);
11 7633 skriv_op(out,op_ref); ud;
11 7634 end;
10 7635 <*-2*>
10 7636 <*+4*> if op_ref <> indeks then
10 7637 fejlreaktion(11<*fr.post*>,op_ref,
10 7638 <:operatør, retur fra radio:>,0);
10 7639 <*-4*>
10 7640 \f
10 7640 message procedure operatør side 11 - 810529/hko;
10 7641
10 7641 res:= d.op_ref.resultat;
10 7642 if res < 2 or (res > 3 and (res<>49 or opgave<>11)) then
10 7643 begin
11 7644 <*+4*> if res < 2 then
11 7645 fejlreaktion(3<*prg.fejl*>,res,
11 7646 <: operatør,radio_op,resultat:>,1);
11 7647 <*-4*>
11 7648 if res = 1 then res:= 0;
11 7649 end
10 7650 else
10 7651 begin <* res = 2 eller 3 *>
11 7652 s_kanal:= v_kanal:= 0;
11 7653 opgave:= d.opref.opkode shift (-12);
11 7654 bv:= d.op_ref.data(5) extract 4;
11 7655 bs:= d.op_ref.data(6);
11 7656 if opgave < 10 then
11 7657 begin
12 7658 j:= d.op_ref.data(7) <*type*>;
12 7659 i:= terminal_tab.ref(1) shift (-12) shift 12 extract 21;
12 7660 i:= i + (if opgave=2 or opgave>3 then 2 else 1);
12 7661 terminal_tab.ref(1):= i
12 7662 +(if res=2 then 4 <*optaget*> else 0)
12 7663 +(if (opgave=1 or opgave=9) and j = 2 <*nødopkald*>
12 7664 then 8 <*nød*> else 0)
12 7665 +(if opgave=1 and j > 0 and j < 3 <*mobilopkald*>
12 7666 then 16 else 0)
12 7667 + (if opgave mod 2 = 0 then 64 <*pas*> else 0)
12 7668 + (if opgave=9 then 128 else
12 7669 if opgave>=7 then 256 else
12 7670 if opgave>=5 then 512 else 0)
12 7671 + (if res = 2 then 2 shift 21 <*tilstand = optaget *>
12 7672 else if b_s = 0 then 0 <*tilstand = ledig *>
12 7673 else 1 shift 21 <*tilstand = samtale*>);
12 7674 end
11 7675 else if opgave=10 <*monitering*> or
11 7676 opgave=14 <*ventepos *> then
11 7677 begin
12 7678 <*+4*> if res = 2 then
12 7679 fejlreaktion(3<*prg.fejl*>,res,
12 7680 <: operatør,moniter,res:>,1);
12 7681 <*-4*>
12 7682 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
12 7683 i:= if bs<0 then
12 7684 kanaltab.iaf.kanal_tilstand extract 12 else 0;
12 7685 terminal_tab.ref(1):= i +
12 7686 (if bs < 0 then (1 shift 21) else 0);
12 7687 if opgave=10 then
12 7688 begin
13 7689 s_kanal:= bs;
13 7690 v_kanal:= d.opref.data(5);
13 7691 end;
12 7692 \f
12 7692 message procedure operatør side 12 - 810603/hko;
12 7693 end
11 7694 else if opgave=11 or opgave=12 then
11 7695 begin
12 7696 <*+4*> if res = 2 then
12 7697 fejlreaktion(3<*prg.fejl*>,res,
12 7698 <: operatør,ge/ne,res:>,1);
12 7699 <*-4*>
12 7700 if opgave=11 <*GE*> and res<>49 then
12 7701 begin
13 7702 s_kanal:= terminal_tab.ref(2);
13 7703 v_kanal:= 12 shift 20 +
13 7704 (terminal_tab.ref(1) shift (-12) extract 4);
13 7705 end;
12 7706 terminal_tab.ref(1):= 0; <* s og v felt nedlagt *>
12 7707 end
11 7708 else
11 7709 if opgave=13 then
11 7710 begin
12 7711 if res=2 then
12 7712 fejlreaktion(3<*prg.fejl*>,res,
12 7713 <:operatør,R,res:>,1);
12 7714 sætbit_i(terminaltab.ref.terminaltilstand,11,
12 7715 d.opref.data(2));
12 7716 end
11 7717 <*+4*> else fejlreaktion(3,opgave,<:operatør, opgave:>,0)
11 7718 <*-4*>
11 7719 ;
11 7720 <*indsæt kanal_nr for b_v_felt i terminalbeskr.*>
11 7721
11 7721 sæt_hex_ciffer(terminal_tab.ref,3,b_v extract 4);
11 7722 terminal_tab.ref(2):= b_s;
11 7723 terminal_tab.ref(3):= d.op_ref.data(11);
11 7724 if (opgave<10 or opgave=14) and res=3 then
11 7725 <*så henviser b_s til radiokanal*>
11 7726 begin
12 7727 if bs shift (-20) = 12 then
12 7728 begin
13 7729 iaf:= (bs extract 4 -1)*kanal_beskr_længde;
13 7730 kanaltab.iaf.kanal_tilstand:=
13 7731 kanaltab.iaf.kanal_tilstand shift(-10) shift 10
13 7732 +terminal_tab.ref(1) extract 10;
13 7733 end
12 7734 else
12 7735 begin
13 7736 for i:= 1 step 1 until max_antal_kanaler do
13 7737 begin
14 7738 if læsbit_i(bs,i) then
14 7739 begin
15 7740 iaf:= (i-1)*kanal_beskr_længde;
15 7741 kanaltab.iaf.kanaltilstand:=
15 7742 kanaltab.iaf.kanaltilstand shift (-10) shift 10
15 7743 + terminal_tab.ref(1) extract 10;
15 7744 end;
14 7745 end;
13 7746 end;
12 7747 end;
11 7748 if kode=15 or kode=16 then
11 7749 begin
12 7750 if opgave<10 then
12 7751 begin
13 7752 opgave:= 11;
13 7753 kanal:= (12 shift 20) +
13 7754 d.opref.data(6) extract 20;
13 7755 goto til_radio;
13 7756 end
12 7757 else
12 7758 if opgave=11 then
12 7759 begin
13 7760 opgave:= 10;
13 7761 d.opref.data(2):= kanal;
13 7762 goto til_radio;
13 7763 end;
12 7764 end
11 7765 else
11 7766 if (kode=1 or kode=3) then
11 7767 begin
12 7768 if opgave<10 and bv<>0 then
12 7769 begin
13 7770 opgave:= 14;
13 7771 d.opref.data(2):= 2;
13 7772 goto til_radio;
13 7773 end;
12 7774 end;
11 7775 <*V*> skriv_skærm_b_v_s(nr);
11 7776 <*V*> if sætbit_ia(opkaldsflag,nr,0) = 1 then
11 7777 skriv_skærm_opkaldskø(nr);
11 7778 for i:= s_kanal, v_kanal do
11 7779 if i<0 then skriv_skærm_kanal(nr,i extract 4);
11 7780 tofrom(kanalflag,alle_operatører,op_maske_lgd);
11 7781 signalbin(bs_mobilopkald);
11 7782 <*V*> setposition(z_op(nr),0,0);
11 7783 end; <* res = 2 eller 3 *>
10 7784 end; <* res <= 1 *>
9 7785 <* frigiv talevej (om nødvendigt) *>
9 7786 if læs_hex_ciffer(terminal_tab.ref,3,b_v)=0
9 7787 and terminal_tab.ref(2)=0 <*b_s*>
9 7788 and op_talevej(nr)<>0
9 7789 then
9 7790 begin
10 7791 <*V*> waitch(cs_tvswitch_adgang,iaf,op_optype,-1);
10 7792 start_operation(iaf,200+nr,cs_operatør(nr),
10 7793 'D' shift 12 + 44);
10 7794 d.iaf.data(1):= op_talevej(nr);
10 7795 d.iaf.data(2):= nr+16;
10 7796 ll:= 0;
10 7797 repeat
10 7798 signalch(cs_talevejsswitch,iaf,op_optype);
10 7799 <*V*> waitch(cs_operatør(nr),iaf,op_optype,-1);
10 7800 ll:= ll+1;
10 7801 until ll=3 or d.iaf.resultat=3;
10 7802 ll:= d.iaf.resultat;
10 7803 signalch(cs_tvswitch_adgang,iaf,op_optype);
10 7804 if ll<>3 then
10 7805 fejlreaktion(21,op_talevej(nr)*100+nr,
10 7806 <:frigiv operatør fejlet:>,1)
10 7807 else
10 7808 op_talevej(nr):= tv_operatør(op_talevej(nr)):= 0;
10 7809 skriv_skærm_b_v_s(nr);
10 7810 end;
9 7811 disable if testbit14 then
9 7812 begin
10 7813 integer t; <*lav en trap-bar blok*>
10 7814
10 7814 trap(test14_trap);
10 7815 systime(1,0,kommslut);
10 7816 write(zrl,<<zd dd dd.dd >,now,<:op:>,<<d__>,nr,
10 7817 string bpl_navn(nr),<: slut :>,case rkom of (
10 7818 <:OP:>,<:ME:>,<:OP,G:>,<:ME,G:>,<:OP,A:>,<:ME,A:>,
10 7819 <:KA,C:>,<:KA,P:>,<:OP,L:>,<:MO:>,<:VE:>,<:NE:>,
10 7820 <:OP,V:>,<:OP,T:>,<:R:>,<:GE:>,<:GE,G:>,<:GE,V:>,
10 7821 <:GE,T:>),<: :>);
10 7822 if (rkom<5 or rkom=9 or rkom=13 or rkom=14 or
10 7823 rkom=16 or rkom=17 or rkom=19)
10 7824 then
10 7825 begin
11 7826 if d.opref.data(7)=2 then outchar(zrl,'*');
11 7827 if d.opref.data(9)<>0 then
11 7828 begin
12 7829 skriv_id(zrl,d.opref.data(9),0);
12 7830 outchar(zrl,' ');
12 7831 end;
11 7832 if d.opref.data(8)<>0 then
11 7833 begin
12 7834 skriv_id(zrl,d.opref.data(8),0);
12 7835 outchar(zrl,' ');
12 7836 end;
11 7837 if d.opref.data(8)=0 and d.opref.data(9)=0 and
11 7838 d.opref.data(2)<>0 then
11 7839 begin
12 7840 skriv_id(zrl,d.opref.data(2),0);
12 7841 outchar(zrl,' ');
12 7842 end;
11 7843 if d.opref.data(12)<>0 then
11 7844 begin
12 7845 if d.opref.data(12) shift (-20) = 15 then
12 7846 write(zrl,<:OMR*:>)
12 7847 else
12 7848 if d.opref.data(12) shift (-20) = 14 then
12 7849 write(zrl,
12 7850 string områdenavn(d.opref.data(12) extract 20))
12 7851 else
12 7852 skriv_id(zrl,d.opref.data(12),0);
12 7853 outchar(zrl,' ');
12 7854 end;
11 7855 t:= terminal_tab.ref.terminaltilstand extract 10;
11 7856 if res=3 and rkom=1 and
11 7857 (t shift (-4) extract 1 = 1) and
11 7858 (t extract 2 <> 3)
11 7859 then
11 7860 begin
12 7861 iaf:= (terminal_tab.ref(2) extract 20 - 1)*
12 7862 kanal_beskr_længde;
12 7863 write(zrl,<<zd.dd>,(kanal_tab.iaf.kanal_spec
12 7864 extract 12)/100," ",1);
12 7865 end;
11 7866 if d.opref.data(10)<>0 then
11 7867 begin
12 7868 skriv_id(zrl,d.opref.data(10),0);
12 7869 outchar(zrl,' ');
12 7870 end;
11 7871 end
10 7872 else
10 7873 if rkom=10 and par1<>0 then
10 7874 write(zrl,string kanalnavn(par1 extract 20),"sp",1)
10 7875 else
10 7876 if rkom=5 or rkom=6 then
10 7877 begin
11 7878 if par1 shift (-20)=15 then write(zrl,<:ALLE:>) else
11 7879 if par1 shift (-20)=14 then
11 7880 write(zrl,string områdenavn(par1 extract 20));
11 7881 outchar(zrl,' ');
11 7882 end;
10 7883 if op_talevej(nr) > 0 then
10 7884 write(zrl,<:T:>,<<d>,op_talevej(nr)," ",1);
10 7885 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
10 7886 <<dd.dd>,kommslut-kommstart);
10 7887 test14_trap: outchar(zrl,'nl');
10 7888 end;
9 7889 <*V*> setposition(z_op(nr),0,0);
9 7890 cursor(z_op(nr),24,1);
9 7891 <*V*> skriv_kvittering(z_op(nr),op_ref,-1,res);
9 7892 end; <* radio-kommando *>
8 7893 begin
9 7894 \f
9 7894 message procedure operatør side 13 - 810518/hko;
9 7895
9 7895 <* 4 stop kommando *>
9 7896
9 7896 status:= skærm_status(tilstand,b_v,b_s,b_s_tilst);
9 7897 if tilstand <> 0 then
9 7898 begin
10 7899 d.op_ref.resultat:= 16; <*skærm optaget*>
10 7900 end
9 7901 else
9 7902 begin
10 7903 d.op_ref.retur:= cs_operatør(nr);
10 7904 d.op_ref.resultat:= 0;
10 7905 d.op_ref.data(1):= nr;
10 7906 indeks:= op_ref;
10 7907 <*+2*> if testbit11 and overvåget then
10 7908 disable begin
11 7909 skriv_operatør(out,0);
11 7910 write(out,<: stop_operation til radio:>);
11 7911 skriv_op(out,op_ref); ud;
11 7912 end;
10 7913 <*-2*>
10 7914 if opk_alarm.tab.alarm_tilst > 0 then
10 7915 begin
11 7916 opk_alarm.tab.alarm_kmdo:= 3;
11 7917 signal_bin(bs_opk_alarm);
11 7918 end;
10 7919
10 7919 signal_ch(cs_rad,op_ref,gen_optype or op_optype);
10 7920 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1);
10 7921 <*+2*> if testbit12 and overvåget then
10 7922 disable begin
11 7923 skriv_operatør(out,0);
11 7924 write(out,<: operation retur fra radio:>);
11 7925 skriv_op(out,op_ref); ud;
11 7926 end;
10 7927 <*-2*>
10 7928 <*+4*> if indeks <> op_ref then
10 7929 fejlreaktion(11<*fr.post*>,op_ref,
10 7930 <: operatør, retur fra radio:>,0);
10 7931 <*-4*>
10 7932 \f
10 7932 message procedure operatør side 14 - 810527/hko;
10 7933
10 7933 if d.op_ref.resultat = 3 then
10 7934 begin
11 7935 integer k,n;
11 7936 integer array field msk,iaf1;
11 7937
11 7937 terminal_tab.ref.terminal_tilstand:= 3 shift 21
11 7938 +terminal_tab.ref.terminal_tilstand extract 21;
11 7939 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
11 7940 if sæt_bit_ia(operatørmaske,nr,0)=1 then
11 7941 for k:= nr, 65 step 1 until top_bpl_gruppe do
11 7942 begin
12 7943 msk:= k*op_maske_lgd;
12 7944 if læsbit_ia(bpl_def.msk,nr) then
12 7945 <**> begin
13 7946 n:= 0;
13 7947 for i:= 1 step 1 until max_antal_operatører do
13 7948 if læsbit_ia(bpl_def.msk,i) then
13 7949 begin
14 7950 iaf1:= i*terminal_beskr_længde;
14 7951 if terminal_tab.iaf1.terminal_tilstand
14 7952 shift (-21) < 3 then
14 7953 n:= n+1;
14 7954 end;
13 7955 bpl_tilst(k,1):= n;
13 7956 end;
12 7957 <**> <*
12 7958 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
12 7959 *> end;
11 7960 signal_bin(bs_mobil_opkald);
11 7961 <*V*> setposition(z_op(nr),0,0);
11 7962 ht_symbol(z_op(nr));
11 7963 end;
10 7964 end;
9 7965 <*V*> setposition(z_op(nr),0,0);
9 7966 cursor(z_op(nr),24,1);
9 7967 if d.op_ref.resultat<> 3 then
9 7968 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 7969 end;
8 7970 begin
9 7971 boolean l22;
9 7972 \f
9 7972 message procedure operatør side 15 - 810521/cl;
9 7973
9 7973 <* 5 springdefinition *>
9 7974 l22:= false;
9 7975 if sep=',' then
9 7976 disable begin
10 7977 setposition(z_op(nr),0,0);
10 7978 cursor(z_op(nr),22,1);
10 7979 write(z_op(nr),"esc" add 128,1,<:ÆK:>,">",1);
10 7980 l22:= true; pos:= 1;
10 7981 while læstegn(d.op_ref.data,pos,i)<>0 do
10 7982 outchar(z_op(nr),i);
10 7983 end;
9 7984
9 7984 tofrom(d.op_ref.data,ia,indeks*2);
9 7985 <*V*> wait_ch(cs_op_fil(nr),vt_op,true,-1<*timeout*>);
9 7986 start_operation(vt_op,200+nr,cs_operatør(nr),
9 7987 101<*opret fil*>);
9 7988 d.vt_op.data(1):=128;<*postantal*>
9 7989 d.vt_op.data(2):=2; <*postlængde*>
9 7990 d.vt_op.data(3):=1; <*segmentantal*>
9 7991 d.vt_op.data(4):=
9 7992 2 shift 10; <*spool fil*>
9 7993 signal_ch(cs_opret_fil,vt_op,op_optype);
9 7994 pos:=vt_op;<*variabel lånes*>
9 7995 <*V*> wait_ch(cs_operatør(nr),vt_op,op_optype,-1<*timeout*>);
9 7996 <*+4*> if vt_op<>pos then
9 7997 fejlreaktion(11<*fremmed post*>,vt_op,<:springdef:>,0);
9 7998 if d.vt_op.data(9)<>0 then
9 7999 fejlreaktion(13<*opret-fil*>,d.vt_op.data(9),
9 8000 <:op kommando(springdefinition):>,0);
9 8001 <*-4*>
9 8002 iaf:=0;
9 8003 for i:=1 step 1 until indeks-2 do
9 8004 begin
10 8005 disable k:=modif_fil(d.vt_op.data(4),i,j);
10 8006 if k<>0 then
10 8007 fejlreaktion(7<*modif-fil*>,k,
10 8008 <:op kommando(spring-def):>,0);
10 8009 fil(j).iaf(1):=d.op_ref.data(i+2);
10 8010 end;
9 8011 \f
9 8011 message procedure operatør side 15a - 820301/cl;
9 8012
9 8012 while sep = ',' do
9 8013 begin
10 8014 setposition(z_op(nr),0,0);
10 8015 cursor(z_op(nr),23,1);
10 8016 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
10 8017 setposition(z_op(nr),0,0);
10 8018 wait(bs_fortsæt_adgang);
10 8019 pos:= 1; j:= 0;
10 8020 while læs_store(z_op(nr),i) < 8 do
10 8021 begin
11 8022 skrivtegn(fortsæt,pos,i);
11 8023 if i = '?' or i = 'esc' then j:= 1; <* skip kommando *>
11 8024 end;
10 8025 skrivtegn(fortsæt,pos,'em');
10 8026 afsluttext(fortsæt,pos);
10 8027 sluttegn:= i;
10 8028 if j<>0 then
10 8029 begin
11 8030 setposition(z_op(nr),0,0);
11 8031 cursor(z_op(nr),24,1);
11 8032 skriv_kvittering(z_op(nr),opref,-1,53);<*annulleret*>
11 8033 cursor(z_op(nr),1,1);
11 8034 goto sp_ann;
11 8035 end;
10 8036 \f
10 8036 message procedure operatør side 16 - 810521/cl;
10 8037
10 8037 disable begin
11 8038 integer array værdi(1:4);
11 8039 integer a_pos,res;
11 8040 pos:= 0;
11 8041 repeat
11 8042 apos:= pos;
11 8043 læs_paramsæt(fortsæt,a_pos,0,værdi,sep,res);
11 8044 if res >= 0 then
11 8045 begin
12 8046 if res=0 and (sep=',' or indeks>2) then <*ok*>
12 8047 else if res=0 then res:= -25 <*parameter mangler*>
12 8048 else if res=10 and (værdi(1)<1 or værdi(1)>99) then
12 8049 res:= -44 <*intervalstørrelse ulovlig*>
12 8050 else if res=10 and (værdi(2)<1 or værdi(2)>99) then
12 8051 res:= -6 <*løbnr ulovligt*>
12 8052 else if res=10 then
12 8053 begin
13 8054 k:=modiffil(d.vt_op.data(4),indeks-1,j);
13 8055 if k<>0 then fejlreaktion(7<*modiffil*>,k,
13 8056 <:op kommando(spring-def):>,0);
13 8057 iaf:= 0;
13 8058 fil(j).iaf(1):= værdi(1) shift 12 + værdi(2);
13 8059 indeks:= indeks+1;
13 8060 if sep = ',' then res:= 0;
13 8061 end
12 8062 else res:= -27; <*parametertype*>
12 8063 end;
11 8064 if res>0 then pos:= a_pos;
11 8065 until sep<>'sp' or res<=0;
11 8066
11 8066 if res<0 then
11 8067 begin
12 8068 d.op_ref.resultat:= -res;
12 8069 i:=1; j:= 1;
12 8070 hægt_tekst(d.op_ref.data,i,fortsæt,j);
12 8071 afsluttext(d.op_ref.data,i);
12 8072 end;
11 8073 end;
10 8074 \f
10 8074 message procedure operatør side 17 - 810521/cl;
10 8075
10 8075 if d.op_ref.resultat > 3 then
10 8076 begin
11 8077 setposition(z_op(nr),0,0);
11 8078 if l22 then
11 8079 begin
12 8080 cursor(z_op(nr),22,1); l22:= false;
12 8081 write(z_op(nr),"-",80);
12 8082 end;
11 8083 cursor(z_op(nr),24,1);
11 8084 skriv_kvittering(z_op(nr),op_ref,pos,d.opref.resultat);
11 8085 goto sp_ann;
11 8086 end;
10 8087 if sep=',' then
10 8088 begin
11 8089 setposition(z_op(nr),0,0);
11 8090 cursor(z_op(nr),22,1);
11 8091 write(z_op(nr),"esc" add 128,1,<:ÆK:>,<:+>:>);
11 8092 pos:= 1; l22:= true;
11 8093 while læstegn(fortsæt,pos,i)<>0 do
11 8094 outchar(z_op(nr),i);
11 8095 end;
10 8096 signalbin(bs_fortsæt_adgang);
10 8097 end while sep = ',';
9 8098 d.vt_op.data(1):= indeks-2;
9 8099 k:= sætfildim(d.vt_op.data);
9 8100 if k<>0 then fejlreaktion(9,k,<:op kommando(spring-def):>,0);
9 8101 d.op_ref.data(3):= d.vt_op.data(4); <*filref*>
9 8102 signalch(cs_op_fil(nr),vt_op,op_optype or gen_optype);
9 8103 d.op_ref.retur:=cs_operatør(nr);
9 8104 pos:=op_ref;
9 8105 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8106 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8107 <*+4*> if pos<>op_ref then
9 8108 fejlreaktion(11<*fremmed post*>,op_ref,
9 8109 <:op kommando(springdef retur fra vt):>,0);
9 8110 <*-4*>
9 8111 \f
9 8111 message procedure operatør side 18 - 810521/cl;
9 8112
9 8112 <*V*> setposition(z_op(nr),0,0);
9 8113 if l22 then
9 8114 begin
10 8115 cursor(z_op(nr),22,1);
10 8116 write(z_op(nr),"-",80);
10 8117 end;
9 8118 cursor(z_op(nr),24,1);
9 8119 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8120
9 8120 if false then
9 8121 begin
10 8122 sp_ann: signalch(cs_slet_fil,vt_op,op_optype);
10 8123 waitch(cs_operatør(nr),vt_op,op_optype,-1);
10 8124 signalch(cs_op_fil(nr),vt_op,op_optype or vt_optype);
10 8125 signalbin(bs_fortsæt_adgang);
10 8126 end;
9 8127
9 8127 end;
8 8128
8 8128 begin
9 8129 \f
9 8129 message procedure operatør side 19 - 810522/cl;
9 8130
9 8130 <* 6 spring (igangsæt)
9 8131 spring,annuler
9 8132 spring,reserve *>
9 8133
9 8133 tofrom(d.op_ref.data,ia,6);
9 8134 d.op_ref.retur:=cs_operatør(nr);
9 8135 indeks:=op_ref;
9 8136 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8137 <*V*> wait_ch(cs_operatør(nr),
9 8138 op_ref,
9 8139 op_optype,
9 8140 -1<*timeout*>);
9 8141 <*+2*> if testbit10 and overvåget then
9 8142 disable begin
10 8143 skriv_operatør(out,0);
10 8144 write(out,"nl",1,<:op operation retur fra vt:>);
10 8145 skriv_op(out,op_ref);
10 8146 end;
9 8147 <*-2*>
9 8148 <*+4*> if indeks<>op_ref then
9 8149 fejlreaktion(11<*fremmed post*>,op_ref,
9 8150 <:op kommando(spring):>,0);
9 8151 <*-4*>
9 8152
9 8152 <*V*> setposition(z_op(nr),0,0);
9 8153 cursor(z_op(nr),24,1);
9 8154 skriv_kvittering(z_op(nr),if (d.op_ref.resultat=11 or
9 8155 d.op_ref.resultat=12) and kode=34 <*SP,R*> then
9 8156 d.op_ref.data(4) else op_ref,-1,d.op_ref.resultat);
9 8157 end;
8 8158
8 8158 begin
9 8159 \f
9 8159 message procedure operatør side 20 - 810525/cl;
9 8160
9 8160 <* 7 spring(-oversigts-)rapport *>
9 8161
9 8161 d.op_ref.retur:=cs_operatør(nr);
9 8162 tofrom(d.op_ref.data,ia,4);
9 8163 indeks:=op_ref;
9 8164 signal_ch(cs_vt,op_ref,gen_optype or op_optype);
9 8165 <*V*> wait_ch(cs_operatør(nr),op_ref,op_optype,-1<*timeout*>);
9 8166 <*+2*> disable if testbit10 and overvåget then
9 8167 begin
10 8168 write(out,"nl",1,<:operatør operation retur fra vt:>);
10 8169 skriv_op(out,op_ref);
10 8170 end;
9 8171 <*-2*>
9 8172
9 8172 <*+4*> if op_ref<>indeks then
9 8173 fejlreaktion(11<*fremmed post*>,op_ref,
9 8174 <:op kommando(spring-rapport):>,0);
9 8175 <*-4*>
9 8176
9 8176 <*V*> setposition(z_op(nr),0,0);
9 8177 if d.op_ref.resultat<>3 then
9 8178 begin
10 8179 cursor(z_op(nr),24,1);
10 8180 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
10 8181 end
9 8182 else
9 8183 begin
10 8184 boolean p_skrevet;
10 8185 integer bogst,løb;
10 8186
10 8186 skærmmåde:= 1;
10 8187
10 8187 if kode = 32 then <* spring,vis *>
10 8188 begin
11 8189 ll:= d.op_ref.data(1) shift (-5) extract 10;
11 8190 bogst:= d.op_ref.data(1) extract 5;
11 8191 if bogst<>0 then bogst:= bogst + 'A' - 1;
11 8192 <*V*> write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8193 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8194 <:spring: :>,
11 8195 <<d>,ll,false add bogst,(bogst<>0) extract 1,
11 8196 <:.:>,string (extend d.op_ref.data(2) shift 24));
11 8197 raf:= data+8;
11 8198 if d.op_ref.raf(1)<>0.0 then
11 8199 write(z_op(nr),<:, startet :>,<<zddddd>,
11 8200 round systime(4,d.op_ref.raf(1),r),<:.:>,round r)
11 8201 else write(z_op(nr),<:, ikke startet:>);
11 8202 write(z_op(nr),"sp",5,"*",5,"nl",2);
11 8203 \f
11 8203 message procedure operatør side 21 - 810522/cl;
11 8204
11 8204 p_skrevet:= false;
11 8205 for pos:=1 step 1 until d.op_ref.data(3) do
11 8206 begin
12 8207 disable i:=læsfil(d.op_ref.data(4),pos,j);
12 8208 if i<>0 then
12 8209 fejlreaktion(5<*læsfil*>,i,
12 8210 <:op kommando(spring,vis):>,0);
12 8211 iaf:=0;
12 8212 i:= fil(j).iaf(1);
12 8213 if i < 0 and -, p_skrevet then
12 8214 begin
13 8215 outchar(z_op(nr),'('); p_skrevet:= true;
13 8216 end;
12 8217 if i > 0 and p_skrevet then
12 8218 begin
13 8219 outchar(z_op(nr),')'); p_skrevet:= false;
13 8220 end;
12 8221 if pos mod 2 = 0 then
12 8222 write(z_op(nr),<< dd>,abs i,<:.:>)
12 8223 else
12 8224 write(z_op(nr),true,3,<<d>,abs i);
12 8225 if pos mod 21 = 0 then outchar(z_op(nr),'nl');
12 8226 end;
11 8227 write(z_op(nr),"*",1);
11 8228 \f
11 8228 message procedure operatør side 22 - 810522/cl;
11 8229
11 8229 end
10 8230 else if kode=33 then <* spring,oversigt *>
10 8231 begin
11 8232 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
11 8233 "esc" add 128,1,<:ÆJ:>,"sp",10,"*",5,"sp",5,
11 8234 <:spring oversigt:>,"sp",5,"*",5,"nl",2);
11 8235
11 8235 for pos:=1 step 1 until d.op_ref.data(1) do
11 8236 begin
12 8237 disable i:=læsfil(d.op_ref.data(2),pos,j);
12 8238 if i<>0 then
12 8239 fejlreaktion(5<*læsfil*>,i,
12 8240 <:op kommando(spring-oversigt):>,0);
12 8241 iaf:=0;
12 8242 ll:=fil(j).iaf(1) shift (-5) extract 10;
12 8243 bogst:=fil(j).iaf(1) extract 5;
12 8244 if bogst<>0 then bogst:=bogst + 'A' - 1;
12 8245 write(z_op(nr),"sp",(bogst=0) extract 1 + 1,<<ddd>,ll,
12 8246 false add bogst,(bogst<>0) extract 1,<:.:>,true,4,
12 8247 string (extend fil(j).iaf(2) shift 24));
12 8248 if fil(j,2)<>0.0 then
12 8249 write(z_op(nr),<:startet :>,<<zddddd>,
12 8250 round systime(4,fil(j,2),r),<:.:>,round r);
12 8251 outchar(z_op(nr),'nl');
12 8252 end;
11 8253 write(z_op(nr),"*",1);
11 8254 end;
10 8255 <* slet fil *>
10 8256 d.op_ref.opkode:= 104;
10 8257 if kode=33 then d.op_ref.data(4):= d.op_ref.data(2);
10 8258 signalch(cs_slet_fil,op_ref,gen_optype or op_optype);
10 8259 waitch(cs_operatør(nr),op_ref,op_optype or gen_optype,-1);
10 8260 end; <* resultat=3 *>
9 8261
9 8261 end;
8 8262
8 8262 begin
9 8263 \f
9 8263 message procedure operatør side 23 - 940522/cl;
9 8264
9 8264
9 8264 <* 8 SLUT *>
9 8265 trapmode:= 1 shift 13;
9 8266 trap(-2);
9 8267 end;
8 8268
8 8268 begin
9 8269 <* 9 stopniveauer,definer *>
9 8270 integer fno;
9 8271
9 8271 for i:= 1 step 1 until 3 do
9 8272 operatør_stop(nr,i):= ia(i+1);
9 8273 i:= modif_fil(tf_stoptabel,nr,fno);
9 8274 if i<>0 then fejlreaktion(7,i,<:stoptabel:>,0);
9 8275 iaf:=0;
9 8276 for i:= 0,1,2,3 do
9 8277 fil(fno).iaf(i+1):= operatør_stop(nr,i);
9 8278 setposition(fil(fno),0,0);
9 8279 setposition(z_op(nr),0,0);
9 8280 cursor(z_op(nr),24,1);
9 8281 skriv_kvittering(z_op(nr),0,-1,3);
9 8282 end;
8 8283
8 8283 begin
9 8284 \f
9 8284 message procedure operatør side 24 - 940522/cl;
9 8285
9 8285 <* 10 stopniveauer,vis *>
9 8286 integer bpl,j,k;
9 8287
9 8287 skærm_måde:= 1;
9 8288 setposition(z_op(nr),0,0);
9 8289 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>,
9 8290 <:stopniveauer: :>);
9 8291 for i:= 0 step 1 until 3 do
9 8292 begin
10 8293 bpl:= operatør_stop(nr,i);
10 8294 write(z_op(nr),if i=0 then <: :> else <: -> :>,
10 8295 if bpl=0 then <:ALLE:> else string bpl_navn(bpl));
10 8296 end;
9 8297 write(z_op(nr),"nl",2,<:operatørpladser: :>);
9 8298 j:=0;
9 8299 for bpl:= 1 step 1 until max_antal_operatører do
9 8300 if bpl_navn(bpl)<>long<::> then
9 8301 begin
10 8302 if j mod 8 = 0 and j > 0 then
10 8303 write(z_op(nr),"nl",1,"sp",18);
10 8304 iaf:= bpl*terminal_beskr_længde;
10 8305 write(z_op(nr),if bpl_tilst(bpl,1) > 0 then "*" else " ",1,
10 8306 true,6,string bpl_navn(bpl));
10 8307 j:=j+1;
10 8308 end;
9 8309 write(z_op(nr),"nl",2,<:operatørgrupper: :>);
9 8310 j:=0;
9 8311 for bpl:= 65 step 1 until top_bpl_gruppe do
9 8312 if bpl_navn(bpl)<>long<::> then
9 8313 begin
10 8314 if j mod 8 = 0 and j > 0 then
10 8315 write(z_op(nr),"nl",1,"sp",19);
10 8316 write(z_op(nr),true,7,string bpl_navn(bpl));
10 8317 j:=j+1;
10 8318 end;
9 8319 write(z_op(nr),"nl",1,"*",1);
9 8320 end;
8 8321
8 8321 begin
9 8322 <* 11 alarmlængde *>
9 8323 integer fno;
9 8324
9 8324 if indeks > 0 then
9 8325 begin
10 8326 opk_alarm.tab.alarm_lgd:= ia(1);
10 8327 i:= modiffil(tf_alarmlgd,nr,fno);
10 8328 if i<>0 then fejlreaktion(7,i,<:alarmlgd:>,0);
10 8329 iaf:= 0;
10 8330 fil(fno).iaf(1):= opk_alarm.tab.alarm_lgd;
10 8331 setposition(fil(fno),0,0);
10 8332 end;
9 8333
9 8333 setposition(z_op(nr),0,0);
9 8334 cursor(z_op(nr),24,1);
9 8335 skriv_kvittering(z_op(nr),opk_alarm.tab.alarm_lgd,-1,63);
9 8336 end;
8 8337
8 8337 begin
9 8338 <* 12 CC *>
9 8339 integer i, c;
9 8340
9 8340 i:= 1;
9 8341 while læstegn(ia,i+0,c)<>0 and
9 8342 i<(op_spool_postlgd-op_spool_text)//2*3
9 8343 do skrivtegn(d.opref.data,i,c);
9 8344 repeat skrivtegn(d.opref.data,i,0) until (i mod 6)=1;
9 8345
9 8345 d.opref.retur:= cs_operatør(nr);
9 8346 signalch(cs_op_spool,opref,op_optype);
9 8347 <*V*> waitch(cs_operatør(nr),opref,op_optype,-1);
9 8348
9 8348 setposition(z_op(nr),0,0);
9 8349 cursor(z_op(nr),24,1);
9 8350 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8351 end;
8 8352
8 8352 <* 13 EXkluder skærmen *>
8 8353 begin
9 8354 d.opref.resultat:= 2;
9 8355 setposition(z_op(nr),0,0);
9 8356 cursor(z_op(nr),24,1);
9 8357 skriv_kvittering(z_op(nr),opref,-1,d.opref.resultat);
9 8358
9 8358 waitch(cs_op_fil(nr),vt_op,true,-1);
9 8359 start_operation(vt_op,curr_coruid,cs_op_fil(nr),2);
9 8360 d.vt_op.data(1):= nr;
9 8361 signalch(cs_rad,vt_op,gen_optype);
9 8362 end;
8 8363
8 8363 begin
9 8364 <* 14 CQF-tabel,vis *>
9 8365
9 8365 skærm_måde:= 1;
9 8366 setposition(z_op(nr),0,0);
9 8367 write(z_op(nr),"esc" add 128,1,<:ÆH:>,
9 8368 "esc" add 128,1,<:ÆJ:>);
9 8369 skriv_cqf_tabel(z_op(nr),false);
9 8370 write(z_op(nr),"*",1);
9 8371 end;
8 8372
8 8372 begin
9 8373 d.op_ref.resultat:= 45; <*ikke implementeret*>
9 8374 setposition(z_op(nr),0,0);
9 8375 cursor(z_op(nr),24,1);
9 8376 skriv_kvittering(z_op(nr),op_ref,-1,d.op_ref.resultat);
9 8377 end;
8 8378 \f
8 8378 message procedure operatør side x - 810522/hko;
8 8379
8 8379 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2)
8 8380 <*-4*>
8 8381 end;<*case j *>
7 8382 end <* j > 0 *>
6 8383 else
6 8384 begin
7 8385 <*V*> setposition(z_op(nr),0,0);
7 8386 if sluttegn<>'nl' then outchar(z_op(nr),'nl');
7 8387 skriv_kvittering(z_op(nr),op_ref,-1,
7 8388 45 <*ikke implementeret *>);
7 8389 end;
6 8390 end;<* godkendt *>
5 8391
5 8391 <*V*> setposition(z_op(nr),0,0);
5 8392 <*???*>
5 8393 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8394 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8395 skærmmåde = 0 do
5 8396 begin
6 8397 if sætbit_ia(samtaleflag,nr,0)=1 then
6 8398 begin
7 8399 skriv_skærm_bvs(nr);
7 8400 <*940920 if op_talevej(nr)=0 then status:= 0
7 8401 else inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8402 if status>0 then
7 8403 begin
7 8404 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8405 terminaltab.ref(ll):= 0;
7 8406 skriv_skærm_bvs(nr);
7 8407 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8408 end;
7 8409 for i:= 1 step 1 until max_antal_kanaler do
7 8410 begin
7 8411 iaf:= (i-1)*kanalbeskrlængde;
7 8412 inspect(ss_samtale_nedlagt(i),status);
7 8413 if status>0 and
7 8414 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8415 begin
7 8416 kanaltab.iaf.kanal_tilstand:=
7 8417 kanaltab.iaf(1) shift (-10) extract 6 shift 10;
7 8418 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8419 kanaltab.iaf(ll):= 0;
7 8420 skriv_skærm_kanal(nr,i);
7 8421 repeat
7 8422 wait(ss_samtale_nedlagt(i));
7 8423 inspect(ss_samtale_nedlagt(i),status);
7 8424 until status=0;
7 8425 end;
7 8426 end;
7 8427 940920*> cursor(z_op(nr),1,1);
7 8428 setposition(z_op(nr),0,0);
7 8429 end;
6 8430 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8431 and skærmmåde = 0
6 8432 and læsbit_ia(operatørmaske,nr) then
6 8433 begin
7 8434 if sætbit_ia(opkaldsflag,nr,0) = 1 then
7 8435 skriv_skærm_opkaldskø(nr);
7 8436 if sætbit_ia(kanalflag,nr,0) = 1 then
7 8437 begin
8 8438 for i:= 1 step 1 until max_antal_kanaler do
8 8439 skriv_skærm_kanal(nr,i);
8 8440 end;
7 8441 cursor(z_op(nr),1,1);
7 8442 <*V*> setposition(z_op(nr),0,0);
7 8443 end;
6 8444 end;
5 8445 d.op_ref.retur:=cs_att_pulje;
5 8446 disable afslut_kommando(op_ref);
5 8447 end; <* indlæs kommando *>
4 8448
4 8448 begin
5 8449 \f
5 8449 message procedure operatør side x+1 - 810617/hko;
5 8450
5 8450 <* 2: inkluder *>
5 8451 integer k,n;
5 8452 integer array field msk,iaf1;
5 8453
5 8453 i:=monitor(4) process address:(z_op(nr),0,ia);
5 8454 if i=0 then
5 8455 begin
6 8456 fejlreaktion(3<*programfejl*>,nr,
6 8457 <:operatør(nr) eksisterer ikke:>,1);
6 8458 d.op_ref.resultat:=28;
6 8459 end
5 8460 else
5 8461 begin
6 8462 i:=monitor(8) reserve process:(z_op(nr),0,ia);
6 8463 d.op_ref.resultat:=if i<>0 then 16 <*skærm optaget*>
6 8464 else if d.op_ref.opkode = 0 then 0
6 8465 else 3;<*udført*>
6 8466 if i > 0 then
6 8467 fejlreaktion(4<*monitor res*>,nr*100 +i,
6 8468 <:operatørskærm reservation:>,1)
6 8469 else
6 8470 begin
7 8471 i:=terminal_tab.ref.terminal_tilstand;
7 8472 <*940418/cl inkluderet sættes i stop - start *>
7 8473 kode:= d.opref.opkode extract 12;
7 8474 if kode <> 0 then
7 8475 terminal_tab.ref.terminal_tilstand:=
7 8476 (d.opref.opkode shift (-12) shift 21) + (i extract 21)
7 8477 else
7 8478 <*940418/cl inkluderet sættes i stop - slut *>
7 8479 terminal_tab.ref.terminal_tilstand:= i extract
7 8480 (if i shift(-21) extract 2 = 3 then 21 else 23);
7 8481 for i:= 1 step 1 until max_antal_kanaler do
7 8482 begin
8 8483 iaf:= (i-1)*kanalbeskrlængde;
8 8484 sætbit_ia(kanaltab.iaf.kanal_alarm,nr,0);
8 8485 end;
7 8486 skærm_måde:= 0;
7 8487 sætbit_ia(operatørmaske,nr,
7 8488 (if terminal_tab.ref.terminal_tilstand shift (-21) = 3
7 8489 then 0 else 1));
7 8490 for k:= nr, 65 step 1 until top_bpl_gruppe do
7 8491 begin
8 8492 msk:= k*op_maske_lgd;
8 8493 if læsbit_ia(bpl_def.msk,nr) then
8 8494 <**> begin
9 8495 n:= 0;
9 8496 for i:= 1 step 1 until max_antal_operatører do
9 8497 if læsbit_ia(bpl_def.msk,i) then
9 8498 begin
10 8499 iaf1:= i*terminal_beskr_længde;
10 8500 if terminal_tab.iaf1.terminal_tilstand
10 8501 shift (-21) < 3 then
10 8502 n:= n+1;
10 8503 end;
9 8504 bpl_tilst(k,1):= n;
9 8505 end;
8 8506 <**> <*
8 8507 bpl_tilst(k,1):= bpl_tilst(k,1) +
8 8508 (if læsbit_ia(operatørmaske,nr) then 1 else 0);
8 8509 *> end;
7 8510 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
7 8511 sætbit_ia(opkaldsflag,nr,0);
7 8512 signal_bin(bs_mobil_opkald);
7 8513 <*940418/cl inkluderet sættes i stop - start *>
7 8514 if terminal_tab.ref.terminal_tilstand shift (-21) = 3 then
7 8515 <*V*> ht_symbol(z_op(nr))
7 8516 else
7 8517 <*940418/cl inkluderet sættes i stop - slut *>
7 8518 <*V*> skriv_skærm(nr);
7 8519 cursor(z_op(nr),24,1);
7 8520 <*V*> setposition(z_op(nr),0,0);
7 8521 end;
6 8522 end;
5 8523 if d.op_ref.opkode = 0 then
5 8524 signal_ch(cs_operatør(nr),op_ref,d.op_ref.optype)
5 8525 else
5 8526 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8527 end;
4 8528
4 8528 begin
5 8529 \f
5 8529 message procedure operatør side x+2 - 820304/hko;
5 8530
5 8530 <* 3: ekskluder *>
5 8531 integer k,n;
5 8532 integer array field iaf1,msk;
5 8533
5 8533 write(z_op(nr),"esc" add 128,1,<:ÆH:>,"esc" add 128,1,<:ÆJ:>);
5 8534 <*V*> setposition(z_op(nr),0,0);
5 8535 monitor(10) release process:(z_op(nr),0,ia);
5 8536 d.op_ref.resultat:=3;
5 8537 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8538 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 8539 terminal_tab.ref.terminal_tilstand extract 21;
5 8540 if sæt_bit_ia(operatørmaske,nr,0)=1 then
5 8541 for k:= nr, 65 step 1 until top_bpl_gruppe do
5 8542 begin
6 8543 msk:= k*op_maske_lgd;
6 8544 if læsbit_ia(bpl_def.msk,nr) then
6 8545 <**> begin
7 8546 n:= 0;
7 8547 for i:= 1 step 1 until max_antal_operatører do
7 8548 if læsbit_ia(bpl_def.msk,i) then
7 8549 begin
8 8550 iaf1:= i*terminal_beskr_længde;
8 8551 if terminal_tab.iaf1.terminal_tilstand
8 8552 shift (-21) < 3 then
8 8553 n:= n+1;
8 8554 end;
7 8555 bpl_tilst(k,1):= n;
7 8556 end;
6 8557 <**> <*
6 8558 bpl_tilst(k,1):= bpl_tilst(k,1)-1;
6 8559 *> end;
5 8560 signal_bin(bs_mobil_opkald);
5 8561 if opk_alarm.tab.alarm_tilst > 0 then
5 8562 begin
6 8563 opk_alarm.tab.alarm_kmdo:= 3;
6 8564 signal_bin(bs_opk_alarm);
6 8565 end;
5 8566 end;
4 8567 begin
5 8568
5 8568 <* 4: opdater skærm *>
5 8569
5 8569 signal_ch(cs_op_retur,op_ref,d.op_ref.optype);
5 8570 while (læsbit_ia(samtaleflag,nr) or læsbit_ia(opkaldsflag,nr) or
5 8571 læsbit_ia(kanalflag,nr) ) and læsbit_ia(operatørmaske,nr) and
5 8572 skærmmåde=0 do
5 8573 begin
6 8574
6 8574 <*+2*> if testbit13 and overvåget then
6 8575 disable begin
7 8576 write(out,"nl",1,<:opdater skærm(:>,<<d>,nr,
7 8577 <:) opkaldsflag::>,"nl",1);
7 8578 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
7 8579 write(out,<: operatørmaske::>,"nl",1);
7 8580 outintbits_ia(out,operatørmaske,1,op_maske_lgd//2);
7 8581 write(out,<: skærmmåde=:>,skærmmåde,"nl",0);
7 8582 ud;
7 8583 end;
6 8584 <*-2*>
6 8585 if sætbit_ia(samtaleflag,nr,0)=1 and op_talevej(nr)<>0 then
6 8586 begin
7 8587 skriv_skærm_bvs(nr);
7 8588 <*940920 inspect(bs_talevej_udkoblet(op_talevej(nr)),status);
7 8589 if status>0 then
7 8590 begin
7 8591 for ll:= 1 step 1 until terminalbeskrlængde//2 do
7 8592 terminaltab.ref(ll):= 0;
7 8593 skriv_skærm_bvs(nr);
7 8594 wait(bs_talevej_udkoblet(op_talevej(nr)));
7 8595 end;
7 8596 for i:= 1 step 1 until max_antal_kanaler do
7 8597 begin
7 8598 iaf:= (i-1)*kanalbeskrlængde;
7 8599 inspect(ss_samtale_nedlagt(i),status);
7 8600 if status>0 and
7 8601 tv_operatør(kanaltab.iaf.kanal_tilstand shift (-16))=nr then
7 8602 begin
7 8603 kanaltab.iaf.kanal_tilstand:=
7 8604 kanaltab.iaf.kanal_tilstand shift (-10) extract 6 shift 10;
7 8605 for ll:= 2 step 1 until kanalbeskrlængde//2 do
7 8606 kanaltab.iaf(ll):= 0;
7 8607 skriv_skærm_kanal(nr,i);
7 8608 repeat
7 8609 wait(ss_samtale_nedlagt(i));
7 8610 inspect(ss_samtale_nedlagt(i),status);
7 8611 until status=0;
7 8612 end;
7 8613 end;
7 8614 940920*> cursor(z_op(nr),1,1);
7 8615 setposition(z_op(nr),0,0);
7 8616 end;
6 8617 if (læsbit_ia(opkaldsflag,nr) or læsbit_ia(kanalflag,nr))
6 8618 and læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8619 begin
7 8620 <*V*> setposition(z_op(nr),0,0);
7 8621 if sætbit_ia(opkaldsflag,nr,0) =1 then
7 8622 skriv_skærm_opkaldskø(nr);
7 8623 if sætbit_ia(kanalflag,nr,0) =1 then
7 8624 begin
8 8625 for i:=1 step 1 until max_antal_kanaler do
8 8626 skriv_skærm_kanal(nr,i);
8 8627 end;
7 8628 cursor(z_op(nr),1,1);
7 8629 <*V*> setposition(z_op(nr),0,0);
7 8630 end;
6 8631 end;
5 8632 end;
4 8633 begin
5 8634 \f
5 8634 message procedure operatør side x+3 - 830310/hko;
5 8635
5 8635 <* 5: samtale etableret *>
5 8636
5 8636 res:= d.op_ref.resultat;
5 8637 b_v:= d.op_ref.data(3) extract 4;
5 8638 b_s:= d.op_ref.data(4);
5 8639 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8640 if res = 3 and terminal_tab.ref(1) shift(-21) = 2 then
5 8641 begin
6 8642 sætbit_i(terminal_tab.ref(1),21,1);
6 8643 sætbit_i(terminal_tab.ref(1),22,0);
6 8644 sætbit_i(terminal_tab.ref(1),2,0);
6 8645 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 8646 terminal_tab.ref(2):= b_s;
6 8647 sæt_bit_i(terminal_tab.ref(1),2<* opt. *>,0);
6 8648 iaf:= (b_s extract 4 - 1)*kanal_beskr_længde;
6 8649 kanaltab.iaf.kanal_tilstand:= kanaltab.iaf.kanal_tilstand
6 8650 shift (-10) shift 10 + terminal_tab.ref(1) extract 10;
6 8651
6 8651 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8652 begin
7 8653 <*V*> setposition(z_op(nr),0,0);
7 8654 skriv_skærm_b_v_s(nr);
7 8655 <*V*> setposition(z_op(nr),0,0);
7 8656 end;
6 8657 end
5 8658 else
5 8659 if terminal_tab.ref(1) shift(-21) = 2 then
5 8660 begin
6 8661 sætbit_i(terminal_tab.ref(1),22,0);
6 8662 sætbit_i(terminal_tab.ref(1),2,0);
6 8663 sæt_hex_ciffer(terminal_tab.ref,3,b_v);
6 8664 terminal_tab.ref(2):= 0;
6 8665 if læsbit_ia(operatørmaske,nr) and skærmmåde = 0 then
6 8666 begin
7 8667 <*V*> setposition(z_op(nr),0,0);
7 8668 cursor(z_op(nr),21,17);
7 8669 write(z_op(nr),<:EJ FORB:>);
7 8670 <*V*> setposition(z_op(nr),0,0);
7 8671 end;
6 8672 end
5 8673 else fejlreaktion(3<*prg.fejl*>,terminal_tab.ref(1) shift(-21),
5 8674 <:terminal tilstand:>,1);
5 8675 end;
4 8676
4 8676 begin
5 8677 \f
5 8677 message procedure operatør side x+4 - 810602/hko;
5 8678
5 8678 <* 6: radiokanal ekskluderet *>
5 8679
5 8679 læs_hex_ciffer(terminal_tab.ref,3,b_v);
5 8680 pos:= d.op_ref.data(1);
5 8681 signalch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 8682 indeks:= terminal_tab.ref(2);
5 8683 b_s:= if indeks shift (-22) = 3 and indeks extract 22 = pos
5 8684 then indeks extract 4 else 0;
5 8685 if b_v = pos then
5 8686 sæt_hex_ciffer(terminal_tab.ref,3,0);
5 8687 if b_s = pos then
5 8688 begin
6 8689 terminal_tab.ref(2):= 0;
6 8690 sætbit_i(terminal_tab.ref(1),21,0);
6 8691 sætbit_i(terminal_tab.ref(1),22,0);
6 8692 sætbit_i(terminal_tab.ref(1),2,0);
6 8693 end;
5 8694 if skærmmåde=0 then
5 8695 begin
6 8696 if b_v = pos or b_s = pos then
6 8697 <*V*> skriv_skærm_b_v_s(nr);
6 8698 <*V*> skriv_skærm_kanal(nr,pos);
6 8699 cursor(z_op(nr),1,1);
6 8700 setposition(z_op(nr),0,0);
6 8701 end;
5 8702 end;
4 8703
4 8703 begin
5 8704 \f
5 8704 message procedure operatør side x+5 - 950118/cl;
5 8705
5 8705 <* 7: operatørmeddelelse *>
5 8706 integer afs, kl, i;
5 8707 real dato, t;
5 8708
5 8708 cursor(z_op(nr),24,1);
5 8709 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 8710 cursor(z_op(nr),23,1);
5 8711 write(z_op(nr),"esc" add 128,1,<:ÆK:>);
5 8712
5 8712 afs:= d.opref.data.op_spool_kilde;
5 8713 dato:= systime(4,d.opref.data.op_spool_tid,t);
5 8714 kl:= round t;
5 8715 write(z_op(nr),<:! fra op:>,<<d>,afs,"sp",1,
5 8716 if afs=0 then <:SYSOP:> else string bpl_navn(afs));
5 8717 i:= replacechar(1,'.');
5 8718 disable write(z_op(nr),"sp",1,<<zd_dd_dd>,kl,"nl",1);
5 8719 replacechar(1,i);
5 8720 write(z_op(nr),d.opref.data.op_spool_text);
5 8721
5 8721 if terminal_tab.ref.terminal_tilstand shift (-21) <> 3 then
5 8722 begin
6 8723 if opk_alarm.tab.alarm_lgd > 0 and
6 8724 opk_alarm.tab.alarm_tilst < 1 and
6 8725 opk_alarm.tab.alarm_kmdo < 1
6 8726 then
6 8727 begin
7 8728 opk_alarm.tab.alarm_kmdo := 1;
7 8729 signalbin(bs_opk_alarm);
7 8730 end
6 8731 else
6 8732 if opk_alarm.tab.alarm_lgd = 0 then
6 8733 write(z_op(nr),"bel",1,"del",8,"bel",1,"del",8,"bel",1);
6 8734 end;
5 8735
5 8735 setposition(z_op(nr),0,0);
5 8736
5 8736 signalch(d.opref.retur,opref,d.opref.optype);
5 8737 end;
4 8738
4 8738 begin
5 8739
5 8739 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
5 8740 <*-4*>
5 8741 end
4 8742 end; <* case aktion+6 *>
3 8743
3 8743 until false;
3 8744 op_trap:
3 8745 skriv_operatør(zbillede,1);
3 8746 end operatør;
2 8747
2 8747 \f
2 8747 message procedure op_cqftest side 1;
2 8748
2 8748 procedure op_cqftest;
2 8749 begin
3 8750 integer array field opref, ref, ref1;
3 8751 integer i, j, tv, cqf, res, pausetid;
3 8752 real nu, næstetid, kommstart, kommslut;
3 8753
3 8753 procedure skriv_op_cqftest(zud,omfang);
3 8754 value omfang;
3 8755 zone zud;
3 8756 integer omfang;
3 8757 begin
4 8758 write(zud,"nl",1,<:+++ op-cqftest:>);
4 8759 if omfang > 0 then
4 8760 disable begin
5 8761 real t;
5 8762
5 8762 trap(slut);
5 8763 write(zud,"nl",1,
5 8764 <: opref: :>,opref,"nl",1,
5 8765 <: ref: :>,ref,"nl",1,
5 8766 <: i: :>,i,"nl",1,
5 8767 <: tv: :>,tv,"nl",1,
5 8768 <: cqf: :>,cqf,"nl",1,
5 8769 <: res: :>,res,"nl",1,
5 8770 <: pausetid: :>,pausetid,"nl",1,
5 8771 <: nu: :>,<<zddddd.dddddd>,systime(4,nu,t)+t/1000000,"nl",1,
5 8772 <: næste-tid: :>,systime(4,næstetid,t)+t/1000000,"nl",1,
5 8773 <::>);
5 8774 skriv_coru(zud,coru_no(292));
5 8775 slut:
5 8776 end;
4 8777 end skriv_op_cqftest;
3 8778
3 8778 trap(op_cqf_trap);
3 8779 stackclaim(1000);
3 8780
3 8780
3 8780 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 8781 skriv_op_cqftest(out,0);
3 8782 <*-4*>
3 8783
3 8783 <*V*> waitch(cs_cqf,opref,op_optype,-1);
3 8784 repeat
3 8785 i:= sidste_tv_brugt; tv:= 0;
3 8786 repeat
3 8787 i:= (i mod max_antal_taleveje) + 1;
3 8788 if tv_operatør(i) = 0 then tv:= i;
3 8789 until (tv<>0) or (i=sidste_tv_brugt);
3 8790
3 8790 if tv<>0 then
3 8791 begin
4 8792 tv_operatør(tv):= -1;
4 8793 systime(1,0.0,nu); næste_tid:= nu + 60*60.0;
4 8794 for cqf:= 1 step 1 until max_cqf do
4 8795 begin
5 8796 ref:= (cqf-1)*cqf_lgd;
5 8797 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_næste_tid < nu then
5 8798 begin
6 8799 startoperation(opref,292,cs_cqf,1 shift 12 + 41);
6 8800 d.opref.data(1):= tv;
6 8801 d.opref.data(2):= cqf_tabel.ref.cqf_bus;
6 8802 disable if testbit19 then
6 8803 begin
7 8804 integer i; <*lav en trap-bar blok*>
7 8805
7 8805 trap(test19_trap);
7 8806 systime(1,0,kommstart);
7 8807 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start OP :>);
7 8808 skriv_id(zrl,d.opref.data(2),0);
7 8809 test19_trap: outchar(zrl,'nl');
7 8810 end;
6 8811 signalch(cs_rad,opref,op_optype or gen_optype);
6 8812 <*V*> waitch(cs_cqf,opref,op_optype,-1);
6 8813 res:= d.opref.resultat;
6 8814 <*+2*>
6 8815 disable if testbit19 then
6 8816 begin
7 8817 integer i; <*lav en trap-bar blok*>
7 8818
7 8818 trap(test19_trap);
7 8819 systime(1,0,kommslut);
7 8820 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut OP :>);
7 8821 if d.opref.data(7)=2 then outchar(zrl,'*');
7 8822 if d.opref.data(9)<>0 then
7 8823 begin
8 8824 skriv_id(zrl,d.opref.data(9),0);
8 8825 outchar(zrl,' ');
8 8826 end;
7 8827 if d.opref.data(8)<>0 then
7 8828 begin
8 8829 skriv_id(zrl,d.opref.data(8),0);
8 8830 outchar(zrl,' ');
8 8831 end;
7 8832 if d.opref.data(12)<>0 then
7 8833 begin
8 8834 if d.opref.data(12) shift (-20) = 15 then
8 8835 write(zrl,<:OMR*:>)
8 8836 else
8 8837 if d.opref.data(12) shift (-20) = 14 then
8 8838 write(zrl,
8 8839 string områdenavn(d.opref.data(12) extract 20))
8 8840 else
8 8841 skriv_id(zrl,d.opref.data(12),0);
8 8842 outchar(zrl,' ');
8 8843 end;
7 8844 if d.opref.data(10)<>0 then
7 8845 begin
8 8846 skriv_id(zrl,d.opref.data(10),0);
8 8847 outchar(zrl,' ');
8 8848 end;
7 8849 write(zrl,<:res=:>,<<d>,res,<: btid=:>,
7 8850 <<dd.dd>,kommslut-kommstart);
7 8851 test19_trap: outchar(zrl,'nl');
7 8852 end;
6 8853 <*-2*>
6 8854 if res=3 and cqf_tabel.ref.cqf_bus > 0 then
6 8855 begin
7 8856 delay(3);
7 8857 d.opref.opkode:= 12 shift 12 + 41;
7 8858 d.opref.resultat:= 0;
7 8859 disable if testbit19 then
7 8860 begin
8 8861 integer i; <*lav en trap-bar blok*>
8 8862
8 8862 trap(test19_trap);
8 8863 systime(1,0,kommstart);
8 8864 write(zrl,<<zd dd dd.dd >,now,<:CQF-test start NE :>);
8 8865 test19_trap: outchar(zrl,'nl');
8 8866 end;
7 8867 signalch(cs_rad,opref,op_optype or gen_optype);
7 8868 <*V*> waitch(cs_cqf,opref,op_optype,-1);
7 8869 <*+2*>
7 8870 disable if testbit19 then
7 8871 begin
8 8872 integer i; <*lav en trap-bar blok*>
8 8873
8 8873 trap(test19_trap);
8 8874 systime(1,0,kommslut);
8 8875 write(zrl,<<zd dd dd.dd >,now,<:CQF-test slut NE :>);
8 8876 write(zrl,<:res=:>,<<d>,d.opref.resultat,<: btid=:>,
8 8877 <<dd.dd>,kommslut-kommstart);
8 8878 test19_trap: outchar(zrl,'nl');
8 8879 end;
7 8880 <*-2*>
7 8881 if d.opref.resultat <> 3 then
7 8882 fejlreaktion(19,d.opref.resultat,<:CQF-test nedlæg resultat:>,1);
7 8883 if cqf_tabel.ref.cqf_bus > 0 and cqf_tabel.ref.cqf_fejl > 0 then
7 8884 begin
8 8885 startoperation(opref,292,cs_cqf,23);
8 8886 i:= 1;
8 8887 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 8888 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 8889 skriv_tegn(d.opref.data,i,' ');
8 8890 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 8891 hægtstring(d.opref.data,i,<: ok!:>);
8 8892 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 8893 signalch(cs_io,opref,gen_optype);
8 8894 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 8895 end;
7 8896 if cqf_tabel.ref.cqf_bus > 0 then
7 8897 begin
8 8898 cqf_tabel.ref.cqf_fejl:= 0;
8 8899 systime(1,0.0,cqf_tabel.ref.cqf_ok_tid);
8 8900 cqf_tabel.ref.cqf_næste_tid:= nu+60*60.0;
8 8901 end;
7 8902 end <*res=3*>
6 8903 else
6 8904 if (res=20<*ej forb.*> or res=59<*radiofejl*>) and
6 8905 cqf_tabel.ref.cqf_bus > 0
6 8906 then
6 8907 begin
7 8908 cqf_tabel.ref.cqf_næste_tid:= nu + 60*60.0;
7 8909 cqf_tabel.ref.cqf_fejl:= cqf_tabel.ref.cqf_fejl + 1;
7 8910 if cqf_tabel.ref.cqf_fejl >= 2 then
7 8911 begin
8 8912 startoperation(opref,292,cs_cqf,23);
8 8913 i:= 1;
8 8914 hægtstring(d.opref.data,i,<:CQF-test bus :>);
8 8915 anbringtal(d.opref.data,i,cqf_tabel.ref.cqf_bus,4);
8 8916 skriv_tegn(d.opref.data,i,' ');
8 8917 hægtstring(d.opref.data,i,string cqf_tabel.ref.cqf_id);
8 8918 hægtstring(d.opref.data,i,<: ingen forbindelse!:>);
8 8919 repeat afsluttext(d.opref.data,i) until (i mod 6) = 1;
8 8920 signalch(cs_io,opref,gen_optype);
8 8921 <*V*> waitch(cs_cqf,opref,gen_optype,-1);
8 8922 end;
7 8923 end;
6 8924 delay(10);
6 8925 end;
5 8926 if cqf_tabel.ref.cqf_bus > 0 and
5 8927 cqf_tabel.ref.cqf_næste_tid < næste_tid
5 8928 then næste_tid:= cqf_tabel.ref.cqf_næste_tid;
5 8929 end; <*for cqf*>
4 8930
4 8930 tv_operatør(tv):= 0; tv:= 0;
4 8931 if op_cqf_tab_ændret then
4 8932 begin
5 8933 j:= skrivfil(1033,1,i);
5 8934 if j<>0 then
5 8935 fejlreaktion(6,j,<:CQF-test cqf-tabel:>,1);
5 8936 sorter_cqftab(1,max_cqf);
5 8937 for cqf:= 1 step 1 until max_cqf do
5 8938 begin
6 8939 ref:= (cqf-1)*cqf_lgd;
6 8940 ref1:= (cqf-1)*cqf_id;
6 8941 tofrom(fil(i).ref1,cqf_tabel.ref,cqf_id);
6 8942 end;
5 8943 op_cqf_tab_ændret:= false;
5 8944 end;
4 8945 end; <*tv*>
3 8946
3 8946 systime(1,0.0,nu);
3 8947 pausetid:= round(næste_tid - nu);
3 8948 if pausetid < 30 then pausetid:= 30;
3 8949
3 8949 <*V*> delay(pausetid);
3 8950
3 8950 until false;
3 8951
3 8951 op_cqf_trap:
3 8952 disable skriv_op_cqftest(zbillede,1);
3 8953 end op_cqftest;
2 8954 \f
2 8954 message procedure op_spool side 1;
2 8955
2 8955 procedure op_spool;
2 8956 begin
3 8957 integer array field opref, ref;
3 8958 integer næste_tomme, i;
3 8959
3 8959 procedure skriv_op_spool(zud,omfang);
3 8960 value omfang;
3 8961 zone zud;
3 8962 integer omfang;
3 8963 begin
4 8964 write(zud,"nl",1,<:+++ op-spool:>);
4 8965 if omfang > 0 then
4 8966 disable begin
5 8967 real t;
5 8968
5 8968 trap(slut);
5 8969 write(zud,"nl",1,
5 8970 <: opref: :>,opref,"nl",1,
5 8971 <: næste-tomme: :>,næste_tomme,"nl",1,
5 8972 <: ref: :>,ref,"nl",1,
5 8973 <: i: :>,i,"nl",1,
5 8974 <::>);
5 8975 skriv_coru(zud,coru_no(293));
5 8976 slut:
5 8977 end;
4 8978 end skriv_op_spool;
3 8979
3 8979 trap(op_spool_trap);
3 8980 stackclaim(400);
3 8981
3 8981 næste_tomme:= 0;
3 8982
3 8982 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 8983 skriv_op_spool(out,0);
3 8984 <*-4*>
3 8985
3 8985 repeat
3 8986 <*V*> waitch(cs_op_spool,opref,true,-1);
3 8987 inspect(ss_op_spool_tomme,i);
3 8988
3 8988 if d.opref.opkode extract 12 <> 37 then
3 8989 begin
4 8990 d.opref.resultat:= 31;
4 8991 fejlreaktion(2<*opkode*>,d.opref.opkode extract 12,<:op_spool:>,1);
4 8992 end
3 8993 else
3 8994 if i<=0 then
3 8995 d.opref.resultat:= 32 <*ingen fri plads*>
3 8996 else
3 8997 begin
4 8998 <*V*> wait(ss_op_spool_tomme);
4 8999 ref:= næste_tomme*op_spool_postlgd;
4 9000 næste_tomme:= (næste_tomme+1) mod op_spool_postantal;
4 9001 i:= d.opref.opsize - data;
4 9002 if i > (op_spool_postlgd - op_spool_text) then
4 9003 i:= (op_spool_postlgd - op_spool_text);
4 9004 op_spool_buf.ref.op_spool_kilde:=
4 9005 (if d.opref.kilde//100 = 2 then d.opref.kilde mod 100 else 0);
4 9006 op_spool_buf.ref.op_spool_tid:= d.opref.tid;
4 9007 tofrom(op_spool_buf.ref.op_spool_text,d.opref.data,i);
4 9008 op_spool_buf.ref(op_spool_postlgd//2):=
4 9009 op_spool_buf.ref(op_spool_postlgd//2) shift (-8) shift 8;
4 9010 d.opref.resultat:= 3;
4 9011
4 9011 signal(ss_op_spool_fulde);
4 9012 end;
3 9013
3 9013 signalch(d.opref.retur,opref,d.opref.optype);
3 9014 until false;
3 9015
3 9015 op_spool_trap:
3 9016 disable skriv_op_spool(zbillede,1);
3 9017 end op_spool;
2 9018 \f
2 9018 message procedure op_medd side 1;
2 9019
2 9019 procedure op_medd;
2 9020 begin
3 9021 integer array field opref, ref;
3 9022 integer næste_fulde, i;
3 9023
3 9023 procedure skriv_op_medd(zud,omfang);
3 9024 value omfang;
3 9025 zone zud;
3 9026 integer omfang;
3 9027 begin
4 9028 write(zud,"nl",1,<:+++ op-medd:>);
4 9029 if omfang > 0 then
4 9030 disable begin
5 9031 real t;
5 9032
5 9032 trap(slut);
5 9033 write(zud,"nl",1,
5 9034 <: opref: :>,opref,"nl",1,
5 9035 <: næste-fulde: :>,næste_fulde,"nl",1,
5 9036 <: ref: :>,ref,"nl",1,
5 9037 <: i: :>,i,"nl",1,
5 9038 <::>);
5 9039 skriv_coru(zud,coru_no(294));
5 9040 slut:
5 9041 end;
4 9042 end skriv_op_medd;
3 9043
3 9043 trap(op_medd_trap);
3 9044 næste_fulde:= 0;
3 9045 stackclaim(400);
3 9046
3 9046 <*+4*>if (testbit8 and overvåget) or testbit28 then
3 9047 skriv_op_medd(out,0);
3 9048 <*-4*>
3 9049
3 9049 repeat
3 9050 <*V*> wait(ss_op_spool_fulde);
3 9051 <*V*> waitch(cs_op_medd,opref,true,-1);
3 9052
3 9052 ref:= næste_fulde*op_spool_postlgd;
3 9053 næste_fulde:= (næste_fulde+1) mod op_spool_postantal;
3 9054
3 9054 startoperation(opref,curr_coruid,cs_op_medd,38);
3 9055 d.opref.resultat:= 0;
3 9056 tofrom(d.opref.data,op_spool_buf.ref,op_spool_postlgd);
3 9057 signalch((if op_spool_buf.ref.op_spool_kilde = 0 then cs_op else cs_io),
3 9058 opref,gen_optype);
3 9059 signal(ss_op_spool_tomme);
3 9060 until false;
3 9061
3 9061 op_medd_trap:
3 9062 disable skriv_op_medd(zbillede,1);
3 9063 end op_medd;
2 9064 \f
2 9064 message procedure alarmur side 1;
2 9065
2 9065 procedure alarmur;
2 9066 begin
3 9067 integer ventetid, nr;
3 9068 integer array field opref, tab;
3 9069 real nu;
3 9070
3 9070 procedure skriv_alarmur(zud,omfang);
3 9071 value omfang;
3 9072 zone zud;
3 9073 integer omfang;
3 9074 begin
4 9075 write(zud,"nl",1,<:+++ alarmur:>);
4 9076 if omfang > 0 then
4 9077 disable begin
5 9078 real t;
5 9079
5 9079 trap(slut);
5 9080 write(zud,"nl",1,
5 9081 <: ventetid: :>,ventetid,"nl",1,
5 9082 <: nr: :>,nr,"nl",1,
5 9083 <: opref: :>,opref,"nl",1,
5 9084 <: tab: :>,tab,"nl",1,
5 9085 <: nu: :>,<< zddddd>,systime(4,nu,t),t,"nl",1,
5 9086 <::>);
5 9087 skriv_coru(zud,coru_no(295));
5 9088 slut:
5 9089 end;
4 9090 end skriv_alarmur;
3 9091
3 9091 trap(alarmur_trap);
3 9092 stackclaim(400);
3 9093
3 9093 systime(1,0.0,nu);
3 9094 ventetid:= -1;
3 9095 repeat
3 9096 waitch(cs_opk_alarm_ur,opref,op_optype,ventetid);
3 9097 if opref > 0 then
3 9098 signalch(d.opref.retur,opref,op_optype);
3 9099
3 9099 ventetid:= -1;
3 9100 systime(1,0.0,nu);
3 9101 for nr:= 1 step 1 until max_antal_operatører do
3 9102 begin
4 9103 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9104 if opk_alarm.tab.alarm_tilst > 0 and
4 9105 opk_alarm.tab.alarm_lgd >= 0 then
4 9106 begin
5 9107 if (nu - opk_alarm.tab.alarm_start) >= opk_alarm.tab.alarm_lgd then
5 9108 begin
6 9109 opk_alarm.tab.alarm_kmdo:= 3;
6 9110 signalbin(bs_opk_alarm);
6 9111 if ventetid > 2 or ventetid=(-1) then ventetid:= 2;
6 9112 end
5 9113 else
5 9114 if (nu - opk_alarm.tab.alarm_start) < ventetid or ventetid = (-1) then
5 9115 ventetid:= (nu - opk_alarm.tab.alarm_start);
5 9116 end;
4 9117 end;
3 9118 if ventetid=0 then ventetid:= 1;
3 9119 until false;
3 9120
3 9120 alarmur_trap:
3 9121 disable skriv_alarmur(zbillede,1);
3 9122 end alarmur;
2 9123 \f
2 9123 message procedure opkaldsalarmer side 1;
2 9124
2 9124 procedure opkaldsalarmer;
2 9125 begin
3 9126 integer nr, ny_kommando, tilst, aktion, tt;
3 9127 integer array field tab, opref, alarmop;
3 9128
3 9128 procedure skriv_opkaldsalarmer(zud,omfang);
3 9129 value omfang;
3 9130 zone zud;
3 9131 integer omfang;
3 9132 begin
4 9133 write(zud,"nl",1,<:+++ opkaldsalarmer:>);
4 9134 if omfang>0 then
4 9135 disable begin
5 9136 real array field raf;
5 9137 trap(slut);
5 9138 raf:=0;
5 9139 write(zud,"nl",1,
5 9140 <: nr: :>,nr,"nl",1,
5 9141 <: ny-kommando: :>,ny_kommando,"nl",1,
5 9142 <: tilst: :>,tilst,"nl",1,
5 9143 <: aktion: :>,aktion,"nl",1,
5 9144 <: tt: :>,false add tt,1,"nl",1,
5 9145 <: tab: :>,tab,"nl",1,
5 9146 <: opref: :>,opref,"nl",1,
5 9147 <: alarmop: :>,alarmop,"nl",1,
5 9148 <::>);
5 9149 skriv_coru(zud,coru_no(296));
5 9150 slut:
5 9151 end;
4 9152 end skriv_opkaldsalarmer;
3 9153
3 9153 trap(opk_alarm_trap);
3 9154 stackclaim(400);
3 9155
3 9155 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9156 skriv_opkaldsalarmer(out,0);
3 9157 <*-2*>
3 9158
3 9158 repeat
3 9159 wait(bs_opk_alarm);
3 9160 alarmop:= 0;
3 9161 for nr:= 1 step 1 until max_antal_operatører do
3 9162 begin
4 9163 tab:= (nr-1)*opk_alarm_tab_lgd;
4 9164 ny_kommando:= opk_alarm.tab.alarm_kmdo;
4 9165 tilst:= opk_alarm.tab.alarm_tilst;
4 9166 aktion:= case ny_kommando+1 of (
4 9167 <*ingenting*> case tilst+1 of (4,4,4),
4 9168 <*normal *> case tilst+1 of (1,4,4),
4 9169 <*nød *> case tilst+1 of (2,2,4),
4 9170 <*sluk *> case tilst+1 of (4,3,3));
4 9171 tt:= case aktion of ('B','C','F','-');
4 9172 if tt<>'-' then
4 9173 begin
5 9174 <*V*> waitch(cs_tvswitch_adgang,opref,op_optype,-1);
5 9175 startoperation(opref,296,cs_opk_alarm,tt shift 12 + 44);
5 9176 d.opref.data(1):= nr+16;
5 9177 signalch(cs_talevejsswitch,opref,op_optype);
5 9178 <*V*> waitch(cs_opk_alarm,opref,op_optype,-1);
5 9179 if d.opref.resultat = 3 then
5 9180 begin
6 9181 opk_alarm.tab.alarm_kmdo:= 0;
6 9182 opk_alarm.tab.alarm_gtilst:= opk_alarm.tab.alarm_tilst;
6 9183 opk_alarm.tab.alarm_tilst:= case aktion of (1,2,0);
6 9184 if aktion < 3 then
6 9185 begin
7 9186 systime(1,0.0,opk_alarm.tab.alarm_start);
7 9187 if alarmop = 0 then
7 9188 waitch(cs_opk_alarm_ur_ret,alarmop,op_optype,-1);
7 9189 end;
6 9190 end;
5 9191 signalch(cs_tvswitch_adgang,opref,op_optype or gen_optype);
5 9192 end;
4 9193 end;
3 9194 if alarmop<>0 then
3 9195 begin
4 9196 startoperation(alarmop,296,cs_opk_alarm_ur_ret,0);
4 9197 signalch(cs_opk_alarm_ur,alarmop,op_optype);
4 9198 end;
3 9199 until false;
3 9200
3 9200 opk_alarm_trap:
3 9201 disable skriv_opkaldsalarmer(zbillede,1);
3 9202 end;
2 9203
2 9203 \f
2 9203 message procedure tvswitch_input side 1 - 940810/cl;
2 9204
2 9204 procedure tv_switch_input;
2 9205 begin
3 9206 integer array field opref;
3 9207 integer tt,ant;
3 9208 boolean ok;
3 9209 integer array ia(1:128);
3 9210
3 9210 procedure skriv_tvswitch_input(zud,omfang);
3 9211 value omfang;
3 9212 zone zud;
3 9213 integer omfang;
3 9214 begin
4 9215 write(zud,"nl",1,<:+++ tvswitch-input:>);
4 9216 if omfang>0 then
4 9217 disable begin
5 9218 real array field raf;
5 9219 trap(slut);
5 9220 raf:=0;
5 9221 write(zud,"nl",1,
5 9222 <: opref: :>,opref,"nl",1,
5 9223 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9224 <: ant: :>,ant,"nl",1,
5 9225 <: tt: :>,tt,"nl",1,
5 9226 <::>);
5 9227 write(zud,"nl",1,<:ia: :>);
5 9228 skrivhele(zud,ia.raf,256,2);
5 9229 skriv_coru(zud,coru_no(297));
5 9230 slut:
5 9231 end;
4 9232 end skriv_tvswitch_input;
3 9233 \f
3 9233 boolean procedure læs_tlgr;
3 9234 begin
4 9235 integer kl,ch,i,pos,p;
4 9236 long field lf;
4 9237 boolean ok;
4 9238
4 9238 integer procedure readch(z,c);
4 9239 zone z; integer c;
4 9240 begin
5 9241 readch:= readchar(z,c);
5 9242 <*+2*> if testbit15 and overvåget then
5 9243 disable begin
6 9244 if ' ' <= c and c <= 'ü' then outchar(zrl,c)
6 9245 else write(zrl,"<",1,<<d>,c,">",1);
6 9246 if c='em' then write(zrl,<: *timeout*:>);
6 9247 end;
5 9248 <*-2*>
5 9249 end;
4 9250
4 9250 ok:= false; tt:=' ';
4 9251 repeat
4 9252 readchar(z_tv_in,ch);
4 9253 until ch<>'em';
4 9254 repeatchar(z_tv_in);
4 9255
4 9255 <*+2*>if testbit15 and overvåget then
4 9256 disable write(zrl,<<zd dd dd.dd >,now,<:switch-ind: :>);
4 9257 <*-2*>
4 9258
4 9258 for kl:=readch(z_tv_in,ch) while ch<>'%' and ch<>'nl' and ch<>'em' do ;
4 9259 if ch='%' then
4 9260 begin
5 9261 ant:= 0; pos:= 1; lf:= 4;
5 9262 ok:= true;
5 9263 for i:= 1 step 1 until 128 do ia(i):= 0;
5 9264
5 9264 for kl:=readch(z_tv_in,ch) while kl = 6 do
5 9265 skrivtegn(ia,pos,ch);
5 9266
5 9266 p:=pos;
5 9267 repeat afsluttext(ia,p) until p mod 6 = 1;
5 9268
5 9268 if ia.lf=long<:ACK:> and ch='nl' then tt:= '+' else
5 9269 if ia.lf=long<:NACK:> and ch='nl' then tt:= '-' else
5 9270 if pos=2 and ch=' ' then tt:= ia(1) shift (-16) else ok:= false;
5 9271
5 9271 if ok and ch=' ' then
5 9272 for kl:=readch(z_tv_in,ch) while ch=' ' do ;
5 9273
5 9273 while kl = 2 do
5 9274 begin
6 9275 i:= ch - '0';
6 9276 for kl:=readch(z_tv_in,ch) while kl = 2 do i:= i*10 + ch-'0';
6 9277 if ant < 128 then
6 9278 begin
7 9279 ant:= ant+1;
7 9280 ia(ant):= i;
7 9281 end
6 9282 else
6 9283 ok:= false;
6 9284 while ch=' ' do kl:=readch(z_tv_in,ch);
6 9285 end;
5 9286 if ch<>'nl' then ok:= false;
5 9287 while ch<>'nl' and ch<>'em' do kl:=readch(z_tv_in,ch);
5 9288 <* !! setposition(z_tv_in,0,0); !! *>
5 9289 <*+2*> if testbit15 and overvåget then disable outchar(zrl,'nl');
5 9290 <*-2*>
5 9291
5 9291 if tt='+' or tt='-' or tt='Q' or tt='E' then
5 9292 ok:= ok
5 9293 else if tt='C' or tt='N' or
5 9294 tt='P' or tt='U' or tt='S' or tt='Z' then
5 9295 ok:= ok and ant=1
5 9296 else if tt='X' or tt='Y' then
5 9297 ok:= ok and ant=2
5 9298 else if tt='T' or tt='W' then
5 9299 ok:= ok and ant=64
5 9300 else if tt='R' then
5 9301 ok:= ok and ant extract 1 = 0
5 9302 else
5 9303 begin
6 9304 ok:= false;
6 9305 fejlreaktion(21,tt,<:Ukendt telegramtype:>,2 shift 12 + 1);
6 9306 end;
5 9307
5 9307 end; <* if ch='%' *>
4 9308 læs_tlgr:= ok;
4 9309 end læs_tlgr;
3 9310 \f
3 9310 trap(tvswitch_input_trap);
3 9311 stackclaim(400);
3 9312 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9313
3 9313 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9314 skriv_tvswitch_input(out,0);
3 9315 <*-2*>
3 9316
3 9316 repeat
3 9317 ok:= læs_tlgr;
3 9318 if ok then
3 9319 begin
4 9320 <*V*> waitch(cs_tvswitch_input,opref,op_optype,-1);
4 9321 start_operation(opref,297,cs_tvswitch_input,0);
4 9322 d.opref.resultat:= tt shift 12 + ant;
4 9323 tofrom(d.opref.data,ia,ant*2);
4 9324 signalch(cs_talevejsswitch,opref,op_optype);
4 9325 end;
3 9326 until false;
3 9327
3 9327 tvswitch_input_trap:
3 9328
3 9328 disable skriv_tvswitch_input(zbillede,1);
3 9329
3 9329 end tvswitch_input;
2 9330 \f
2 9330 message procedure tv_switch_adm side 1 - 940502/cl;
2 9331
2 9331 procedure tv_switch_adm;
2 9332 begin
3 9333 integer array field opref;
3 9334 integer rc;
3 9335
3 9335 procedure skriv_tv_switch_adm(zud,omfang);
3 9336 value omfang;
3 9337 zone zud;
3 9338 integer omfang;
3 9339 begin
4 9340 write(zud,"nl",1,<:+++ tv-switch-adm:>);
4 9341 if omfang>0 then
4 9342 disable begin
5 9343 trap(slut);
5 9344 write(zud,"nl",1,
5 9345 <: opref: :>,opref,"nl",1,
5 9346 <: rc: :>,rc,"nl",1,
5 9347 <::>);
5 9348 skriv_coru(zud,coru_no(298));
5 9349 slut:
5 9350 end;
4 9351 end skriv_tv_switch_adm;
3 9352
3 9352 trap(tv_switch_adm_trap);
3 9353 stackclaim(400);
3 9354
3 9354 <*+2*> if (testbit8 and overvåget) or testbit28 then
3 9355 disable skriv_tv_switch_adm(out,0);
3 9356 <*-2*>
3 9357
3 9357
3 9357
3 9357 <* !!!!!!! PASSIVER KORUTINEN - cs_tvswitch_adm SIGNALERES ALDRIG !!!!!!!
3 9358 waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9359 *>
3 9360
3 9360 repeat
3 9361 waitch(cs_tvswitch_adgang,opref,op_optype,-1);
3 9362 start_operation(opref,298,cs_tvswitch_adm,'R' shift 12 + 44);
3 9363 rc:= 0;
3 9364 repeat
3 9365 signalch(cs_talevejsswitch,opref,op_optype);
3 9366 <*V*> waitch(cs_tvswitch_adm,opref,op_optype,-1);
3 9367 rc:= rc+1;
3 9368 until rc=3 or d.opref.resultat=3;
3 9369
3 9369 signalch(cs_tvswitch_adgang,opref,op_optype);
3 9370
3 9370 <*V*> delay(15*60);
3 9371 until false;
3 9372 tv_switch_adm_trap:
3 9373 disable skriv_tv_switch_adm(zbillede,1);
3 9374 end;
2 9375 \f
2 9375 message procedure talevejsswitch side 1 -940426/cl;
2 9376
2 9376 procedure talevejsswitch;
2 9377 begin
3 9378 integer tt, ant, ventetid;
3 9379 integer array field opref, gemt_op, tab;
3 9380 boolean ok;
3 9381 integer array ia(1:128);
3 9382
3 9382 procedure skriv_talevejsswitch(zud,omfang);
3 9383 value omfang;
3 9384 zone zud;
3 9385 integer omfang;
3 9386 begin
4 9387 write(zud,"nl",1,<:+++ talevejsswitch:>);
4 9388 if omfang>0 then
4 9389 disable begin
5 9390 real array field raf;
5 9391 trap(slut);
5 9392 raf:= 0;
5 9393 write(zud,"nl",1,
5 9394 <: tt: :>,tt,"nl",1,
5 9395 <: ant: :>,ant,"nl",1,
5 9396 <: ventetid: :>,ventetid,"nl",1,
5 9397 <: opref: :>,opref,"nl",1,
5 9398 <: gemt-op: :>,gemt_op,"nl",1,
5 9399 <: tab: :>,tab,"nl",1,
5 9400 <: ok: :>,(if ok then <:TRUE:> else <:FALSE:>),"nl",1,
5 9401 <::>);
5 9402 write(zud,"nl",1,<:ia: :>);
5 9403 skriv_hele(zud,ia.raf,256,2);
5 9404 skriv_coru(zud,coru_no(299));
5 9405 slut:
5 9406 end;
4 9407 end skriv_talevejsswitch;
3 9408 \f
3 9408 trap(tvswitch_trap);
3 9409 stackclaim(400);
3 9410 for ant:= 1 step 1 until 128 do ia(ant):= 0;
3 9411
3 9411 <*+2*>if (testbit8 and overvåget) or testbit28 then
3 9412 skriv_talevejsswitch(out,0);
3 9413 <*-2*>
3 9414
3 9414 ventetid:= -1; ant:= 0; tt:= ' ';
3 9415 repeat
3 9416 waitch(cs_talevejsswitch,opref,gen_optype or op_optype,ventetid);
3 9417 if opref > 0 then
3 9418 begin
4 9419 if d.opref.opkode extract 12 = 0 then
4 9420 begin <*input fra talevejsswitchen *>
5 9421 for ant:= 1 step 1 until 128 do ia(ant):= 0;
5 9422 tt:= d.opref.resultat shift (-12) extract 12;
5 9423 ant:= d.opref.resultat extract 12;
5 9424 tofrom(ia,d.opref.data,ant*2);
5 9425 signalch(d.opref.retur,opref,d.opref.optype);
5 9426
5 9426 if tt<>'+' and tt<>'-' then
5 9427 begin
6 9428 write(z_tv_out,"%",1,<:ACK:>,"cr",1);
6 9429 setposition(z_tv_out,0,0);
6 9430 <*+2*> if testbit15 and overvåget then
6 9431 disable begin
7 9432 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: :>,<:%ACK:>);
7 9433 outchar(zrl,'nl');
7 9434 end;
6 9435 <*-2*>
6 9436 end;
5 9437 if (tt='+' or tt='-') and gemt_op<>0 then
5 9438 begin
6 9439 d.gemt_op.resultat:= (if tt='+' then 3 else 0);
6 9440 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
6 9441 gemt_op:= 0;
6 9442 ventetid:= -1;
6 9443 end
5 9444 else
5 9445 if tt='R' then
5 9446 begin
6 9447 for i:= 1 step 2 until ant do
6 9448 begin
7 9449 if ia(i) <= max_antal_taleveje and
7 9450 17 <= ia(i+1) and ia(i+1) <= max_antal_operatører+16
7 9451 then
7 9452 begin
8 9453 if op_talevej(ia(i+1)-16)<>ia(i) then
8 9454 tv_operatør(op_talevej(ia(i+1)-16)):= 0;
8 9455 if tv_operatør(ia(i))<>ia(i+1)-16 then
8 9456 op_talevej(tv_operatør(ia(i))):= 0;
8 9457 tv_operatør(ia(i)):= ia(i+1)-16;
8 9458 op_talevej(ia(i+1)-16):= ia(i);
8 9459 sætbit_ia(samtaleflag,ia(i+1)-16,1);
8 9460 end
7 9461 else
7 9462 if ia(i+1) <= max_antal_taleveje and
7 9463 17 <= ia(i) and ia(i) <= max_antal_operatører+16
7 9464 then
7 9465 begin
8 9466 if op_talevej(ia(i))<>ia(i+1)-16 then
8 9467 tv_operatør(op_talevej(ia(i))):= 0;
8 9468 if tv_operatør(ia(i+1)-16)<>ia(i) then
8 9469 op_talevej(tv_operatør(ia(i+1)-16)):= 0;
8 9470 tv_operatør(ia(i+1)):= ia(i)-16;
8 9471 op_talevej(ia(i)-16):= ia(i+1);
8 9472 sætbit_ia(samtaleflag,ia(i)-16,1);
8 9473 end;
7 9474 end;
6 9475 signal_bin(bs_mobil_opkald);
6 9476 <*+2*> if testbit15 and testbit16 and overvåget then
6 9477 disable begin
7 9478 skriv_talevejs_tab(zrl); outchar(zrl,'nl');
7 9479 end;
6 9480 <*-2*>
6 9481 end <* tt='R' and ant>0 *>
5 9482 else
5 9483 if tt='Y' then
5 9484 begin
6 9485 if ia(1) <= max_antal_taleveje and
6 9486 17 <= ia(2) and ia(2) <= max_antal_operatører+16
6 9487 then
6 9488 begin
7 9489 if tv_operatør(ia(1))=ia(2)-16 and
7 9490 op_talevej(ia(2)-16)=ia(1)
7 9491 then tv_operatør(ia(1)):= op_talevej(ia(2)-16):= 0;
7 9492 end
6 9493 else
6 9494 if ia(2) <= max_antal_taleveje and
6 9495 17 <= ia(1) and ia(1) <= max_antal_operatører+16
6 9496 then
6 9497 begin
7 9498 if tv_operatør(ia(2))=ia(1)-16 and
7 9499 op_talevej(ia(1)-16)=ia(2)
7 9500 then tv_operatør(ia(2)):= op_talevej(ia(1)-16):= 0;
7 9501 end;
6 9502 end
5 9503 else
5 9504 if tt='C' or tt='N' or tt='P' or tt='U' then
5 9505 begin
6 9506 waitch(cs_op_iomedd,opref,gen_optype,-1);
6 9507 startoperation(opref,299,cs_op_iomedd,23);
6 9508 ant:= 1;
6 9509 hægtstring(d.opref.data,ant,<:switch - port :>);
6 9510 anbringtal(d.opref.data,ant,ia(1),2);
6 9511 if 17<=ia(1) and ia(1)<=16+max_antal_operatører then
6 9512 begin
7 9513 hægtstring(d.opref.data,ant,<: (:>);
7 9514 if bpl_navn(ia(1)-16)=long<::> then
7 9515 begin
8 9516 hægtstring(d.opref.data,ant,<:op:>);
8 9517 anbringtal(d.opref.data,ant,ia(1)-16,
8 9518 if ia(1)-16 > 9 then 2 else 1);
8 9519 end
7 9520 else hægtstring(d.opref.data,ant,string bpl_navn(ia(1)-16));
7 9521 skrivtegn(d.opref.data,ant,')');
7 9522 end;
6 9523 hægtstring(d.opref.data,ant,
6 9524 if tt='C' then <: Kontakt med kontrolbox etableret:> else
6 9525 if tt='N' then <: Kontakt med kontrolbox tabt:> else
6 9526 if tt='P' then <: Tilgængelig:> else
6 9527 if tt='U' then <: Ikke tilgængelig:> else <::>);
6 9528 repeat afsluttext(d.opref.data,ant) until ant mod 6 = 1;
6 9529 signalch(cs_io,opref,gen_optype);
6 9530 end
5 9531 else
5 9532 if tt='Z' then
5 9533 begin
6 9534 tab:= (ia(1)-16-1)*opk_alarm_tab_lgd;
6 9535 opk_alarm.tab.alarm_tilst:= opk_alarm.tab.alarm_gtilst;
6 9536 end
5 9537 else
5 9538 begin
6 9539 <* ikke implementeret *>
6 9540 end;
5 9541 end
4 9542 else
4 9543 if d.opref.opkode extract 12 = 44 then
4 9544 begin
5 9545 tt:= d.opref.opkode shift (-12);
5 9546 ok:= true;
5 9547 if tt='E' or tt='Q' or tt='R' or tt='W' or tt='S' or tt='I' then
5 9548 begin
6 9549 <*+2*> if testbit15 and overvåget then
6 9550 disable begin
7 9551 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1);
7 9552 outchar(zrl,'nl');
7 9553 end;
6 9554 <*-2*>
6 9555 write(z_tv_out,"%",1,false add tt,1,"cr",1);
6 9556 setposition(z_tv_out,0,0);
6 9557 end
5 9558 else
5 9559 if tt='B' or tt='C' or tt='F' then
5 9560 begin
6 9561 <*+2*> if testbit15 and overvåget then
6 9562 disable begin
7 9563 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9564 " ",1,<<d>,d.opref.data(1));
7 9565 outchar(zrl,'nl');
7 9566 end;
6 9567 <*-2*>
6 9568 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9569 d.opref.data(1),"cr",1);
6 9570 setposition(z_tv_out,0,0);
6 9571 end
5 9572 else
5 9573 if tt='A' or tt='D' or tt='T' then
5 9574 begin
6 9575 <*+2*> if testbit15 and overvåget then
6 9576 disable begin
7 9577 write(zrl,<<zd dd dd.dd >,now,<:switch-ud: %:>,false add tt,1,
7 9578 " ",1,<<d>,d.opref.data(1)," ",1,d.opref.data(2));
7 9579 outchar(zrl,'nl');
7 9580 end;
6 9581 <*-2*>
6 9582 write(z_tv_out,"%",1,false add tt,1," ",1,<<d>,
6 9583 d.opref.data(1)," ",1,d.opref.data(2),"cr",1);
6 9584 setposition(z_tv_out,0,0);
6 9585 end
5 9586 else
5 9587 ok:= false;
5 9588 if ok then
5 9589 begin
6 9590 gemt_op:= opref;
6 9591 ventetid:= 2;
6 9592 end
5 9593 else
5 9594 begin
6 9595 d.opref.resultat:= 4;
6 9596 signalch(d.opref.retur,opref,d.opref.optype);
6 9597 end;
5 9598 end;
4 9599 end
3 9600 else
3 9601 if gemt_op<>0 then
3 9602 begin <*timeout*>
4 9603 d.gemt_op.resultat:= 0;
4 9604 signalch(d.gemt_op.retur,gemt_op,d.gemt_op.optype);
4 9605 gemt_op:= 0;
4 9606 ventetid:= -1;
4 9607 <*+2*> if testbit15 and overvåget then
4 9608 disable begin
5 9609 write(zrl,<<zd dd dd.dd >,now,<:switch: *Operation Timeout*:>);
5 9610 outchar(zrl,'nl');
5 9611 end;
4 9612 <*-2*>
4 9613 end;
3 9614 until false;
3 9615 tvswitch_trap:
3 9616 disable skriv_talevejsswitch(zbillede,1);
3 9617 end talevejsswitch;
2 9618
2 9618 \f
2 9618 message garage_erklæringer side 1 - 810415/hko;
2 9619
2 9619 zone array z_gar(max_antal_garageterminaler,16,1,gar_fejl);
2 9620
2 9620 procedure gar_fejl(z,s,b);
2 9621 integer s,b;
2 9622 zone z;
2 9623 begin
3 9624 disable begin
4 9625 integer array iz(1:20);
4 9626 integer i,j,k;
4 9627 integer array field iaf;
4 9628 real array field raf;
4 9629
4 9629 getzone6(z,iz);
4 9630 iaf:=raf:=2;
4 9631 getnumber(iz.raf,7,j);
4 9632
4 9632 iaf:=(max_antal_operatører+j)*terminal_beskr_længde;
4 9633 k:=1;
4 9634
4 9634 j:= terminal_tab.iaf.terminal_tilstand;
4 9635 if j shift(-21) < 6 and s <> (1 shift 21 +2) then
4 9636 fejlreaktion(17<*ydre enhed status*>,s,string iz.raf(increase(k)),
4 9637 1 shift 12 <*binært*> +1 <*fortsæt*>);
4 9638 if s <> (1 shift 21 +2) then
4 9639 terminal_tab.iaf.terminal_tilstand:= 6 shift 21
4 9640 + terminal_tab.iaf.terminal_tilstand extract 21;
4 9641 if terminal_tab.iaf.terminal_tilstand shift(-21)<>0 then
4 9642 begin
5 9643 z(1):=real <:<'?'><'em'>:>;
5 9644 b:=2;
5 9645 end;
4 9646 end; <*disable*>
3 9647 end gar_fejl;
2 9648
2 9648 integer cs_gar;
2 9649 integer array cs_garage(1:max_antal_garageterminaler);
2 9650 \f
2 9650 message procedure h_garage side 1 - 810520/hko;
2 9651
2 9651 <* hovedmodulkorutine for garageterminaler *>
2 9652 procedure h_garage;
2 9653 begin
3 9654 integer array field op_ref;
3 9655 integer k,dest_sem;
3 9656 procedure skriv_hgarage(zud,omfang);
3 9657 value omfang;
3 9658 zone zud;
3 9659 integer omfang;
3 9660 begin integer i;
4 9661
4 9661 i:=write(zud,"nl",1,<:+++ hovedmodul garage:>);
4 9662 write(zud,"sp",26-i);
4 9663 if omfang>0 then
4 9664 disable begin
5 9665 integer x;
5 9666 trap(slut);
5 9667 write(zud,"nl",1,
5 9668 <: op_ref: :>,op_ref,"nl",1,
5 9669 <: k: :>,k,"nl",1,
5 9670 <: dest_sem: :>,dest_sem,"nl",1,
5 9671 <::>);
5 9672 skriv_coru(zud,coru_no(300));
5 9673 slut:
5 9674 end;
4 9675 end skriv_hgarage;
3 9676
3 9676 trap(hgar_trap);
3 9677 stack_claim(if cm_test then 198 else 146);
3 9678
3 9678 <*+2*>
3 9679 if testbit16 and overvåget or testbit28 then
3 9680 skriv_hgarage(out,0);
3 9681 <*-2*>
3 9682 \f
3 9682 message procedure h_garage side 2 - 811105/hko;
3 9683
3 9683 repeat
3 9684 wait_ch(cs_gar,op_ref,true,-1);
3 9685 <*+4*>
3 9686 if (d.op_ref.optype and (gar_optype or gen_optype)) extract 12 =0
3 9687 then fejlreaktion(12<*operationstype*>,op_ref,<:garage:>,1);
3 9688 <*-4*>
3 9689
3 9689 k:=d.op_ref.opkode extract 12;
3 9690 dest_sem:=
3 9691 if k=0 then cs_garage(d.op_ref.kilde mod 100) else
3 9692 if k=7 or k=8 then cs_garage(d.op_ref.data(1))
3 9693 else -1;
3 9694 <*+4*>
3 9695 if dest_sem=-1 then
3 9696 begin
4 9697 fejl_reaktion(2<*operationskode*>,k,<:hovedmodul garage:>,1);
4 9698 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 9699 end
3 9700 else
3 9701 <*-4*>
3 9702 if k=7<*inkluder*> then
3 9703 begin
4 9704 iaf:=(max_antal_operatører+ d.op_ref.data(1))*terminal_beskr_længde;
4 9705 if terminal_tab.iaf.terminal_tilstand shift(-21)=0 then
4 9706 begin
5 9707 d.op_ref.resultat:=3;
5 9708 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
5 9709 dest_sem:=-2;
5 9710 end;
4 9711 end
3 9712 else
3 9713 if k=8<*ekskluder*> then <*afbryd kommando v. timeout*>
3 9714 begin
4 9715 iaf:=(max_antal_operatører+d.op_ref.data(1))*terminal_beskr_længde;
4 9716 terminal_tab.iaf.terminal_tilstand:= 7 shift 21
4 9717 +terminal_tab.iaf.terminal_tilstand extract 21;
4 9718 end;
3 9719 if dest_sem>0 then
3 9720 signal_ch(dest_sem,op_ref,d.op_ref.optype);
3 9721 until false;
3 9722
3 9722 hgar_trap:
3 9723 disable skriv_hgarage(zbillede,1);
3 9724 end h_garage;
2 9725 \f
2 9725 message procedure garage side 1 - 830310/cl;
2 9726
2 9726 procedure garage(nr);
2 9727 value nr;
2 9728 integer nr;
2 9729 begin
3 9730 integer array field op_ref,ref;
3 9731 integer i,kode,aktion,status,opgave,retur_sem,
3 9732 pos,indeks,sep,sluttegn,vogn,ll;
3 9733
3 9733 procedure skriv_garage(zud,omfang);
3 9734 value omfang;
3 9735 zone zud;
3 9736 integer omfang;
3 9737 begin integer i;
4 9738
4 9738 i:=write(zud,"nl",1,<:+++ garage nr::>,nr);
4 9739 write(zud,"sp",26-i);
4 9740 if omfang > 0 then
4 9741 disable begin integer x;
5 9742 trap(slut);
5 9743 write(zud,"nl",1,
5 9744 <: op-ref: :>,op_ref,"nl",1,
5 9745 <: kode: :>,kode,"nl",1,
5 9746 <: ref: :>,ref,"nl",1,
5 9747 <: i: :>,i,"nl",1,
5 9748 <: aktion: :>,aktion,"nl",1,
5 9749 <: retur-sem: :>,retur_sem,"nl",1,
5 9750 <: vogn: :>,vogn,"nl",1,
5 9751 <: ll: :>,ll,"nl",1,
5 9752 <: status: :>,status,"nl",1,
5 9753 <: opgave: :>,opgave,"nl",1,
5 9754 <: pos: :>,pos,"nl",1,
5 9755 <: indeks: :>,indeks,"nl",1,
5 9756 <: sep: :>,sep,"nl",1,
5 9757 <: sluttegn: :>,sluttegn,"nl",1,
5 9758 <::>);
5 9759 skriv_coru(zud,coru_no(300+nr));
5 9760 slut:
5 9761 end;
4 9762 end skriv_garage;
3 9763 \f
3 9763 message procedure garage side 2 - 830310/hko;
3 9764
3 9764 trap(gar_trap);
3 9765 stack_claim((if cm_test then 200 else 146)+24+48+80+75);
3 9766
3 9766 ref:= (max_antal_operatører+nr)*terminal_beskr_længde;
3 9767
3 9767 <*+2*>
3 9768 if testbit16 and overvåget or testbit28 then
3 9769 skriv_garage(out,0);
3 9770 <*-2*>
3 9771
3 9771 <* attention simulering
3 9772 *>
3 9773 if terminal_tab.ref.terminal_tilstand shift (-21) = 0 then
3 9774 begin
4 9775 wait_ch(cs_att_pulje,op_ref,true,-1);
4 9776 start_operation(op_ref,300+nr,cs_garage(nr),0);
4 9777 signal_ch(cs_garage(nr),op_ref,gen_optype);
4 9778 end;
3 9779 <*
3 9780 *>
3 9781 \f
3 9781 message procedure garage side 3 - 830310/hko;
3 9782
3 9782 repeat
3 9783
3 9783 <*V*> wait_ch(cs_garage(nr),
3 9784 op_ref,
3 9785 true,
3 9786 -1<*timeout*>);
3 9787 <*+2*>
3 9788 if testbit17 and overvåget then
3 9789 disable begin
4 9790 write(out,"nl",1,<:operation fra cs:>,<<d>,cs_garage(nr),
4 9791 <: til garage :>,nr);
4 9792 skriv_op(out,op_ref);
4 9793 end;
3 9794 <*-2*>
3 9795
3 9795 kode:= d.op_ref.op_kode;
3 9796 retur_sem:= d.op_ref.retur;
3 9797 i:= terminal_tab.ref.terminal_tilstand;
3 9798 status:= i shift(-21);
3 9799 opgave:=
3 9800 if kode=0 then 1 <* indlæs kommando *> else
3 9801 if kode=7 then 2 <* inkluder *> else
3 9802 if kode=8 then 3 <* ekskluder *> else
3 9803 0; <* afvises *>
3 9804
3 9804 aktion:= case status +1 of(
3 9805 <* status *> <* opgave: 0 1 2 3 *>
3 9806 <* 0 klar *>(case opgave+1 of( 0, 1, -4, 3)),
3 9807 <* 1 - *>(-1),<* ulovlig tilstand *>
3 9808 <* 2 - *>(-1),<* ulovlig tilstand *>
3 9809 <* 3 stoppet *>(case opgave+1 of( 0, 2, 2, 3)),
3 9810 <* 4 noneksist *>(-2),<* ulovligt garageterminalnr *>
3 9811 <* 5 - *>(-1),<* ulovlig tilstand *>
3 9812 <* 6 stop v. fejl *>(case opgave+1 of( 0, -5, 2, 3)),
3 9813 <* 7 ej knyttet *>(case opgave+1 of( 0, -5, 2, 3)),
3 9814 -1);
3 9815 \f
3 9815 message procedure garage side 4 - 810424/hko;
3 9816
3 9816 case aktion+6 of
3 9817 begin
4 9818 begin
5 9819 <*-5: terminal optaget *>
5 9820
5 9820 d.op_ref.resultat:= 16;
5 9821 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 9822 end;
4 9823
4 9823 begin
5 9824 <*-4: operation uden virkning *>
5 9825
5 9825 afslut_operation(op_ref,-1);
5 9826 end;
4 9827
4 9827 begin
5 9828 <*-3: ulovlig operationskode *>
5 9829
5 9829 fejl_reaktion(2<*operationskode*>,kode,<:ulovlig:>,1);
5 9830 afslut_operation(op_ref,-1);
5 9831 end;
4 9832
4 9832 begin
5 9833 <*-2: ulovligt garageterminal_nr *>
5 9834
5 9834 fejl_reaktion(3<*programfejl*>,nr,<: ikke eksisterende garage:>,1);
5 9835 afslut_operation(op_ref,cs_att_pulje); <*telex*>
5 9836 end;
4 9837
4 9837 begin
5 9838 <*-1: ulovlig operatørtilstand *>
5 9839
5 9839 fejl_reaktion(3<*programfejl*>,status,<: ulovlig garage-status:>,1);
5 9840 afslut_operation(op_ref,-1);
5 9841 end;
4 9842
4 9842 begin
5 9843 <* 0: ikke implementeret *>
5 9844
5 9844 fejl_reaktion(2<*operationskode*>,kode,<: ikke implementeret:>,1);
5 9845 afslut_operation(op_ref,-1);
5 9846 end;
4 9847
4 9847 begin
5 9848 \f
5 9848 message procedure garage side 5 - 851001/cl;
5 9849
5 9849 <* 1: indlæs kommando *>
5 9850
5 9850
5 9850 <*V*> læs_kommando(z_gar(nr),300+nr,op_ref,pos,indeks,sep,sluttegn);
5 9851
5 9851 if d.op_ref.resultat > 3 then
5 9852 begin
6 9853 <*V*> setposition(z_gar(nr),0,0);
6 9854 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
6 9855 skriv_kvittering(z_gar(nr),op_ref,pos,
6 9856 d.op_ref.resultat);
6 9857 end
5 9858 else if d.op_ref.resultat>0 then
5 9859 begin <*godkendt*>
6 9860 kode:=d.op_ref.opkode;
6 9861 i:= kode extract 12;
6 9862 j:= if kode=11 or kode=12 or kode=20 or kode=24 then 1
6 9863 else if kode=9 or kode=10 then 2
6 9864 else 0;
6 9865 if j > 0 then
6 9866 begin
7 9867 case j of
7 9868 begin
8 9869 begin
9 9870 \f
9 9870 message procedure garage side 6 - 851001/cl;
9 9871
9 9871 <* 1 indsæt/udtag/flyt bus i vogntabel *>
9 9872 integer vogn,ll;
9 9873 integer array field vtop;
9 9874
9 9874 vogn:=ia(1);
9 9875 ll:=ia(2);
9 9876 <*V*> wait_ch(cs_vt_adgang,
9 9877 vt_op,
9 9878 gen_optype,
9 9879 -1<*timeout sek*>);
9 9880 start_operation(vtop,300+nr,cs_garage(nr),
9 9881 kode);
9 9882 d.vt_op.data(1):=vogn;
9 9883 if kode=11 or kode=20 or kode=24 then d.vt_op.data(2):=ll;
9 9884 indeks:= vt_op;
9 9885 signal_ch(cs_vt,
9 9886 vt_op,
9 9887 gen_optype or gar_optype);
9 9888
9 9888 <*V*> wait_ch(cs_garage(nr),
9 9889 vt_op,
9 9890 gar_optype,
9 9891 -1<*timeout sek*>);
9 9892 <*+2*> if testbit18 and overvåget then
9 9893 disable begin
10 9894 write(out,"nl",1,<:garage :>,<<d>,nr,
10 9895 <:: operation retur fra vt:>);
10 9896 skriv_op(out,vt_op);
10 9897 end;
9 9898 <*-2*>
9 9899 <*+4*> if vt_op<>indeks then
9 9900 fejl_reaktion(11<*fremmede op*>,op_ref,
9 9901 <:garage-kommando:>,0);
9 9902 <*-4*>
9 9903 <*V*> setposition(z_gar(nr),0,0);
9 9904 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
9 9905 skriv_kvittering(z_gar(nr),if d.vt_op.resultat = 11 or
9 9906 d.vt_op.resultat = 12 then d.vt_op.data(3)
9 9907 else vt_op,-1,d.vt_op.resultat);
9 9908 d.vt_op.optype:=gen_optype or vtoptype;
9 9909 disable afslut_operation(vt_op,cs_vt_adgang);
9 9910 end;
8 9911
8 9911 begin
9 9912 \f
9 9912 message procedure garage side 6a - 830310/cl;
9 9913
9 9913 <* 2 vogntabel,linienr/-,busnr *>
9 9914
9 9914 d.op_ref.retur:= cs_garage(nr);
9 9915 tofrom(d.op_ref.data,ia,10);
9 9916 indeks:= op_ref;
9 9917 signal_ch(cs_vt,op_ref,gen_optype or gar_optype);
9 9918 wait_ch(cs_garage(nr),
9 9919 op_ref,
9 9920 gar_optype,
9 9921 -1<*timeout*>);
9 9922 <*+2*> if testbit18 and overvåget then
9 9923 disable begin
10 9924 write(out,"nl",1,<:garage operation retur fra vt:>);
10 9925 skriv_op(out,op_ref);
10 9926 end;
9 9927 <*-2*>
9 9928 <*+4*>
9 9929 if indeks <> op_ref then
9 9930 fejlreaktion(11<*fremmed post*>,op_ref,<:garage komm:>,0);
9 9931 <*-4*>
9 9932 i:= d.op_ref.resultat;
9 9933 if i = 0 or i > 3 then
9 9934 begin
10 9935 <*V*> setposition(z_gar(nr),0,0);
10 9936 skriv_kvittering(z_gar(nr),op_ref,-1,d.op_ref.resultat);
10 9937 end
9 9938 else
9 9939 begin
10 9940 integer antal,fil_ref;
10 9941 antal:= d.op_ref.data(6);
10 9942 fil_ref:= d.op_ref.data(7);
10 9943 <*V*> setposition(z_gar(nr),0,0);
10 9944 write(z_gar(nr),"*",24,"sp",6,
10 9945 <:vogntabeludskrift:>,"sp",6,"*",24,"nl",2);
10 9946 <*V*> setposition(z_gar(nr),0,0);
10 9947 \f
10 9947 message procedure garage side 6c - 841213/cl;
10 9948
10 9948 pos:= 1;
10 9949 while pos <= antal do
10 9950 begin
11 9951 integer bogst,løb;
11 9952
11 9952 disable i:= læs_fil(fil_ref,pos,j);
11 9953 if i <> 0 then
11 9954 fejlreaktion(5<*læs_fil*>,i,<:garage: vo,l/vo,b:>,0)
11 9955 else
11 9956 begin
12 9957 vogn:= fil(j,1) shift (-24) extract 24;
12 9958 løb:= fil(j,1) extract 24;
12 9959 if d.op_ref.opkode=9 then
12 9960 begin i:=vogn; vogn:=løb; løb:=i; end;
12 9961 ll:= løb shift (-12) extract 10;
12 9962 bogst:= løb shift (-7) extract 5;
12 9963 if bogst > 0 then bogst:= bogst +'A'-1;
12 9964 løb:= løb extract 7;
12 9965 vogn:= vogn extract 14;
12 9966 i:= d.op_ref.opkode-8;
12 9967 for i:= i,i+1 do
12 9968 begin
13 9969 j:= (i+1) extract 1;
13 9970 case j +1 of
13 9971 begin
14 9972 write(z_gar(nr),"sp",(bogst=0) extract 1,<<ddd>,ll,
14 9973 false add bogst,1,"/",1,<<d__>,løb);
14 9974 write(z_gar(nr),<<dddd>,vogn,"sp",1);
14 9975 end;
13 9976 end;
12 9977 if pos mod 5 = 0 then
12 9978 begin
13 9979 write(z_gar(nr),"nl",1);
13 9980 <*V*> setposition(z_gar(nr),0,0);
13 9981 end
12 9982 else write(z_gar(nr),"sp",3);
12 9983 end;
11 9984 pos:=pos+1;
11 9985 end;
10 9986 write(z_gar(nr),"nl",1,"*",77,"nl",1);
10 9987 \f
10 9987 message procedure garage side 6d- 830310/cl;
10 9988
10 9988 d.opref.opkode:=104; <*slet-fil*>
10 9989 d.op_ref.data(4):=filref;
10 9990 indeks:=op_ref;
10 9991 signal_ch(cs_slet_fil,op_ref,gen_optype or gar_optype);
10 9992 <*V*> wait_ch(cs_garage(nr),op_ref,gar_optype,-1);
10 9993
10 9993 <*+2*> if testbit18 and overvåget then
10 9994 disable begin
11 9995 write(out,"nl",1,<:garage, slet-fil retur:>);
11 9996 skriv_op(out,op_ref);
11 9997 end;
10 9998 <*-2*>
10 9999
10 9999 <*+4*> if op_ref<>indeks then
10 10000 fejlreaktion(11<*fr.post*>,op_ref,<:garage,slet-fil:>,0);
10 10001 <*-4*>
10 10002 if d.op_ref.data(9)<>0 then
10 10003 fejl_reaktion(3<*prg.fejl*>,d.op_ref.data(9),
10 10004 <:garage, slet_fil:>,1);
10 10005 end;
9 10006 \f
9 10006 message procedure garage side 7 -810424/hko;
9 10007
9 10007 end;
8 10008
8 10008 <*+4*> fejl_reaktion(3<*programfejl*>,j,<:case 'opkode':>,2);
8 10009 <*-4*>
8 10010 end;<*case j *>
7 10011 end <* j > 0 *>
6 10012 else
6 10013 begin
7 10014 <*V*> setposition(z_gar(nr),0,0);
7 10015 if sluttegn<>'nl' then outchar(z_gar(nr),'nl');
7 10016 skriv_kvittering(z_gar(nr),op_ref,pos,
7 10017 4 <*kommando ukendt *>);
7 10018 end;
6 10019 end;<* godkendt *>
5 10020
5 10020 <*V*> setposition(z_gar(nr),0,0);
5 10021
5 10021 d.op_ref.opkode:=0; <*telex*>
5 10022
5 10022 disable afslut_operation(op_ref,cs_gar);
5 10023 end; <* indlæs kommando *>
4 10024
4 10024 begin
5 10025 \f
5 10025 message procedure garage side 8 - 841213/cl;
5 10026
5 10026 <* 2: inkluder *>
5 10027
5 10027 d.op_ref.resultat:=3;
5 10028 afslut_operation(op_ref,-1);
5 10029 monitor(8)reserve:(z_gar(nr),0,ia);
5 10030 terminal_tab.ref.terminal_tilstand:=
5 10031 terminal_tab.ref.terminal_tilstand extract 21;
5 10032 <*V*> wait_ch(cs_att_pulje,op_ref,true,-1);
5 10033 start_operation(op_ref,300+nr,cs_att_pulje,0);
5 10034 signal_ch(cs_garage(nr),op_ref,gen_optype);
5 10035 end;
4 10036
4 10036 begin
5 10037
5 10037 <* 3: ekskluder *>
5 10038 d.op_ref.resultat:= 3;
5 10039 terminal_tab.ref.terminal_tilstand:= 7 shift 21 +
5 10040 terminal_tab.ref.terminal_tilstand extract 21;
5 10041 monitor(10)release:(z_gar(nr),0,ia);
5 10042 afslut_operation(op_ref,-1);
5 10043
5 10043 end;
4 10044
4 10044 <*+4*> fejl_reaktion(3<*programfejl *>,aktion,<:case aktion:>,2);
4 10045 <*-4*>
4 10046 end; <* case aktion+6 *>
3 10047
3 10047 until false;
3 10048 gar_trap:
3 10049 skriv_garage(zbillede,1);
3 10050 end garage;
2 10051
2 10051 \f
2 10051 message procedure radio_erklæringer side 1 - 820304/hko;
2 10052
2 10052 zone z_fr_in(14,1,rad_in_fejl),
2 10053 z_rf_in(14,1,rad_in_fejl),
2 10054 z_fr_out(14,1,rad_out_fejl),
2 10055 z_rf_out(14,1,rad_out_fejl);
2 10056
2 10056 integer array
2 10057 radiofejl,
2 10058 ss_samtale_nedlagt,
2 10059 ss_radio_aktiver(1:max_antal_kanaler),
2 10060 bs_talevej_udkoblet,
2 10061 cs_radio(1:max_antal_taleveje),
2 10062 radio_linietabel(1:max_linienr//3+1),
2 10063 radio_områdetabel(0:max_antal_områder),
2 10064 opkaldskø(opkaldskø_postlængde//2+1:
2 10065 (max_antal_mobilopkald+1)*opkaldskø_postlængde//2),
2 10066 kanal_tab(1:max_antal_kanaler*kanal_beskr_længde//2),
2 10067 hookoff_maske(1:(tv_maske_lgd//2)),
2 10068 samtaleflag, kanalflag, opkaldsflag(1:(op_maske_lgd//2));
2 10069
2 10069 integer field
2 10070 kanal_tilstand,
2 10071 kanal_id1,
2 10072 kanal_id2,
2 10073 kanal_spec,
2 10074 kanal_alt_id1,
2 10075 kanal_alt_id2;
2 10076 integer array field
2 10077 kanal_mon_maske,
2 10078 kanal_alarm,
2 10079 opkald_meldt;
2 10080
2 10080 integer
2 10081 cs_rad,
2 10082 cs_radio_medd,
2 10083 cs_radio_adm,
2 10084 cs_radio_ind,
2 10085 cs_radio_ud,
2 10086 cs_radio_pulje,
2 10087 cs_radio_kø,
2 10088 bs_mobil_opkald,
2 10089 bs_opkaldskø_adgang,
2 10090 opkaldskø_ledige,
2 10091 nødopkald_brugt,
2 10092 første_frie_opkald,
2 10093 første_opkald,
2 10094 sidste_opkald,
2 10095 første_nødopkald,
2 10096 sidste_nødopkald,
2 10097 optaget_flag;
2 10098
2 10098 boolean
2 10099 mobil_opkald_aktiveret;
2 10100 \f
2 10100 message procedure læs_hex_ciffer side 1 - 810428/hko;
2 10101
2 10101 integer
2 10102 procedure læs_hex_ciffer(tabel,linie,op);
2 10103 value linie;
2 10104 integer array tabel;
2 10105 integer linie,op;
2 10106 begin
3 10107 integer i,j;
3 10108
3 10108 i:=(if linie>=0 then linie+6 else linie)//6;
3 10109 j:=((i-1)*6-linie)*4;
3 10110 læs_hex_ciffer:=op:=tabel(i) shift j extract 4;
3 10111 end læs_hex_ciffer;
2 10112
2 10112 message procedure sæt_hex_ciffer side 1 - 810505/hko;
2 10113
2 10113 integer
2 10114 procedure sæt_hex_ciffer(tabel,linie,op);
2 10115 value linie;
2 10116 integer array tabel;
2 10117 integer linie,op;
2 10118 begin
3 10119 integer i,j;
3 10120
3 10120 i:=(if linie>=0 then linie+6 else linie)//6;
3 10121 j:=(linie-(i-1)*6)*4;
3 10122 sæt_hex_ciffer:= tabel(i) shift (-j) extract 4;
3 10123 tabel(i):=tabel(i) shift (-4-j) shift 4 add (op extract 4)
3 10124 shift j add (tabel(i) extract j);
3 10125 end sæt_hex_ciffer;
2 10126
2 10126 message procedure hex_to_dec side 1 - 900108/cl;
2 10127
2 10127 integer procedure hex_to_dec(hex);
2 10128 value hex;
2 10129 integer hex;
2 10130 begin
3 10131 hex_to_dec:= if 'A'<=hex and hex<='F' then (hex-'A'+10)
3 10132 else (hex-'0');
3 10133 end;
2 10134
2 10134 message procedure dec_to_hex side 1 - 900108/cl;
2 10135
2 10135 integer procedure dec_to_hex(dec);
2 10136 value dec;
2 10137 integer dec;
2 10138 begin
3 10139 dec_to_hex:= if 0<=dec and dec<=9 then ('0'+dec)
3 10140 else ('A'+dec-10);
3 10141 end;
2 10142
2 10142 message procedure rad_out_fejl side 1 - 820304/hko;
2 10143
2 10143 procedure rad_out_fejl(z,s,b);
2 10144 value s;
2 10145 zone z;
2 10146 integer s,b;
2 10147 begin
3 10148 integer array field iaf;
3 10149 integer pos,tegn,max,i;
3 10150 integer array ia(1:20);
3 10151 long array field laf;
3 10152
3 10152 disable begin
4 10153 laf:= iaf:= 2;
4 10154 tegn:= 1;
4 10155 getzone6(z,ia);
4 10156 max:= ia(16)//2*3;
4 10157 if s = 1 shift 21 + 2 then
4 10158 begin
5 10159 z(1):= real<:<'em'>:>;
5 10160 b:= 2;
5 10161 end
4 10162 else
4 10163 begin
5 10164 pos:= 0;
5 10165 for i:= 1 step 1 until max_antal_kanaler do
5 10166 begin
6 10167 iaf:= (i-1)*kanalbeskr_længde;
6 10168 if sæt_hex_ciffer(kanal_tab.iaf,3,15)<>15 then pos:= pos+1;
6 10169 if pos>0 then
6 10170 begin
7 10171 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 10172 signalbin(bs_mobilopkald);
7 10173 fejlreaktion(17<*y.e.status*>,s,string ia.laf(increase(tegn)),
7 10174 1 shift 12<*binært*> +1<*fortsæt*>);
7 10175 end;
6 10176 end;
5 10177 end;
4 10178 end;
3 10179 end;
2 10180 \f
2 10180 message procedure rad_in_fejl side 1 - 810601/hko;
2 10181
2 10181 procedure rad_in_fejl(z,s,b);
2 10182 value s;
2 10183 zone z;
2 10184 integer s,b;
2 10185 begin
3 10186 integer array field iaf;
3 10187 integer pos,tegn,max,i;
3 10188 integer array ia(1:20);
3 10189 long array field laf;
3 10190
3 10190 disable begin
4 10191 laf:= iaf:= 2;
4 10192 i:= 1;
4 10193 getzone6(z,ia);
4 10194 max:= ia(16)//2*3;
4 10195 if s shift (-21) extract 1 = 0
4 10196 and s shift(-19) extract 1 = 0 then
4 10197 begin
5 10198 if b = 0 then
5 10199 begin
6 10200 z(1):= real<:!:>;
6 10201 b:= 2;
6 10202 end;
5 10203 end;
4 10204 \f
4 10204 message procedure rad_in_fejl side 2 - 820304/hko;
4 10205
4 10205 if (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0) then
4 10206 begin
5 10207 fejlreaktion(17<*ydre enhed status*>,s,string ia.laf(increase(i)),
5 10208 1 shift 12<*binær*> +1<*fortsæt*>);
5 10209 end
4 10210 else
4 10211 if s shift (-19) extract 1 = 1 then
4 10212 begin
5 10213 z(1):= real<:!<'nl'>:>;
5 10214 b:= 2;
5 10215 end
4 10216 else
4 10217 if s = 1 shift 21 +2 or s shift(-19) extract 1 =1 then
4 10218 begin
5 10219 <*
5 10220 if b = 0 then
5 10221 begin
5 10222 *>
5 10223 z(1):= real <:<'em'>:>;
5 10224 b:= 2;
5 10225 <*
5 10226 end
5 10227 else
5 10228 begin
5 10229 tegn:= -1;
5 10230 iaf:= 0;
5 10231 pos:= b//2*3-2;
5 10232 while pos < max and tegn <> 0 do læstegn(z.iaf,pos,tegn);
5 10233 skriv_tegn(z.iaf,pos,'?');
5 10234 if pos<=max then
5 10235 afslut_text(z.iaf,pos);
5 10236 b:= (pos-1)//3*2;
5 10237 end;
5 10238 *>
5 10239 end;<* s=1 shift 21+2 *>
4 10240 end;
3 10241 if testbit22 and
3 10242 (s <> 1 shift 21 +2 and s shift(-19) extract 1 = 0)
3 10243 then
3 10244 delay(60);
3 10245 end rad_in_fejl;
2 10246 \f
2 10246 message procedure afvent_radioinput side 1 - 880901/cl;
2 10247
2 10247 integer procedure afvent_radioinput(z_in,tlgr,rf);
2 10248 value rf;
2 10249 zone z_in;
2 10250 integer array tlgr;
2 10251 boolean rf;
2 10252 begin
3 10253 integer i, p, pos, tegn, ac, sum, csum, lgd;
3 10254 long array field laf;
3 10255
3 10255 laf:= 0;
3 10256 pos:= 1;
3 10257 repeat
3 10258 i:=readchar(z_in,tegn);
3 10259 if i<>8 and pos<80 then skrivtegn(tlgr,pos,tegn);
3 10260 until (i=8 and pos>1) or (tegn='em') or (pos>=80);
3 10261 p:=pos;
3 10262 repeat afsluttext(tlgr,p) until p mod 6 = 1;
3 10263 <*+2*>if overvåget and (testbit36 or ((-,rf) and testbit38) or
3 10264 (rf and testbit39)) then
3 10265 disable begin
4 10266 write(zrl,<<zd dd dd.dd >,now,
4 10267 (if -,rf then <:fr-tlgr: :> else <:rf-answ: :>),tlgr.laf,
4 10268 if tegn='em' then <:*timeout*:> else
4 10269 if pos>=80 then <:*for langt*:> else <::>);
4 10270 outchar(zrl,'nl');
4 10271 end;
3 10272 <*-2*>
3 10273 ac:= -1;
3 10274 if pos >= 80 then
3 10275 begin <* telegram for langt *>
4 10276 repeat readchar(z_in,tegn)
4 10277 until tegn='nl' or tegn='em';
4 10278 end
3 10279 else
3 10280 if pos>1 and tegn='nl' then
3 10281 begin
4 10282 lgd:= 1;
4 10283 while læstegn(tlgr,lgd,tegn)<>0 do ;
4 10284 lgd:= lgd-2;
4 10285 if lgd >= 5 then
4 10286 begin
5 10287 lgd:= lgd-2; <* se bort fra checksum *>
5 10288 i:= lgd + 1;
5 10289 csum:= (læstegn(tlgr,i,tegn) - '@')*16;
5 10290 csum:= csum + (læstegn(tlgr,i,tegn) - '@');
5 10291 i:= lgd + 1;
5 10292 skrivtegn(tlgr,i,0);
5 10293 skrivtegn(tlgr,i,0);
5 10294 i:= 1; sum:= 0;
5 10295 while i <= lgd do
5 10296 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
5 10297 if csum >= 0 and csum <> sum then
5 10298 begin
6 10299 <*+2*> if overvåget and (testbit36 or
6 10300 ((-,rf) and testbit38) or (rf and testbit39)) then
6 10301 disable begin
7 10302 write(zrl,<<zd dd dd.dd >,now,
7 10303 (if rf then <:rf:> else <:fr:>),
7 10304 <:-tlgr-checksumfejl: :>,csum,sum); outchar(zrl,'nl');
7 10305 end;
6 10306 <*-2*>
6 10307 ac:= 6 <* checksumfejl *>
6 10308 end
5 10309 else
5 10310 ac:= 0;
5 10311 end
4 10312 else ac:= 6; <* for kort telegram - retransmitter *>
4 10313 end;
3 10314 afvent_radioinput:= ac;
3 10315 end;
2 10316 \f
2 10316 message procedure skriv_kanal_tab side 1 - 820304/hko;
2 10317
2 10317 procedure skriv_kanal_tab(z);
2 10318 zone z;
2 10319 begin
3 10320 integer array field ref;
3 10321 integer i,j,t,op,id1,id2;
3 10322
3 10322 write(z,"ff",1,"nl",1,<:
3 10323 ******** kanal-beskrivelser *******
3 10324
3 10324 a k l p m b n
3 10325 l a y a o s ø
3 10326 nr tv tilst + * l t t s n v d - type id1 id2 ttmm/ant -ej.op:>,
3 10327 <*
3 10328 01 ..... ..... x x x x x x x x x x .... ........ ........ .... .... ----
3 10329 *>
3 10330 "nl",1);
3 10331 for i:=1 step 1 until max_antal_kanaler do
3 10332 begin
4 10333 ref:=(i-1)*kanal_beskr_længde;
4 10334 t:=kanal_tab.ref.kanal_tilstand;
4 10335 id1:=kanal_tab.ref.kanal_id1;
4 10336 id2:=kanal_tab.ref.kanal_id2;
4 10337 write(z,"nl",1,"sp",4,
4 10338 <<dd>,i,<<-ddddd>,t shift(-16),t shift(-12) extract 4,"sp",1);
4 10339 for j:=11 step -1 until 2 do
4 10340 write(z,if læsbit_i(t,j) then "X" else "sp",1,"sp",1);
4 10341 write(z,case t extract 2 +1 of
4 10342 (<:- :>,<:OPK :>,<:MEDD:>,<:GNM :>),
4 10343 "sp",1);
4 10344 skriv_id(z,id1,9);
4 10345 skriv_id(z,id2,9);
4 10346 t:=kanal_tab.ref.kanal_spec;
4 10347 write(z,"sp",1,<<-dddd>,t,t shift(-16),"sp",1,-(t extract 8));
4 10348 write(z,"nl",1,"sp",14,<:mon: :>);
4 10349 for j:= max_antal_taleveje step -1 until 1 do
4 10350 write(z,(if læs_bit_ia(kanal_tab.ref.kanal_mon_maske,j) then "1"
4 10351 else "."),1);
4 10352 write(z,"sp",25-max_antal_taleveje);
4 10353 skriv_id(z,kanal_tab.ref.kanal_alt_id1,9);
4 10354 skriv_id(z,kanal_tab.ref.kanal_alt_id2,9);
4 10355 end;
3 10356 write(z,"nl",2,<:kanalflag::>,"nl",1);
3 10357 outintbits_ia(z,kanalflag,1,op_maske_lgd//2);
3 10358 write(z,"nl",2);
3 10359 end skriv_kanal_tab;
2 10360 \f
2 10360 message procedure skriv_opkaldskø side 1 - 820301/hko;
2 10361
2 10361 procedure skriv_opkaldskø(z);
2 10362 zone z;
2 10363 begin
3 10364 integer i,bogst,løb,j;
3 10365 integer array field ref;
3 10366 write(z,"nl",2,"*",5,<: opkaldskø :>,"*",5,"nl",2,
3 10367 <: ref næste foreg X bus linie/løb tid - op type :>,
3 10368 <: sig omr :>,"nl",1);
3 10369 for i:= 1 step 1 until max_antal_mobilopkald do
3 10370 begin
4 10371 ref:= i*opkaldskø_postlængde;
4 10372 j:= opkaldskø.ref(1);
4 10373 write(z,<< dddd>,ref,<< ddddd>,j extract 12,j shift (-12));
4 10374 j:= opkaldskø.ref(2);
4 10375 write(z,"sp",1,if j < 0 then "X" else "sp",1,"sp",1);
4 10376 skriv_id(z,j extract 23,9);
4 10377 j:= opkaldskø.ref(3);
4 10378 skriv_id(z,j,7);
4 10379 j:= opkaldskø.ref(4);
4 10380 write(z,<< zd.dd>,(j shift (-12))/100.0,
4 10381 << zd>,j extract 8);
4 10382 j:= j shift (-8) extract 4;
4 10383 if j = 1 or j = 2 then
4 10384 write(z,if j=1 then <: normal:> else <: nød :>)
4 10385 else write(z,<<dddd>,j,"sp",3);
4 10386 j:= opkaldskø.ref(5);
4 10387 write(z,if j shift (-20) <> 0 then <: B :> else <: S :>,
4 10388 true,4,if 1<=(j extract 8) and (j extract 8)<=max_antal_områder then
4 10389 string område_navn(j extract 8) else <:---:>);
4 10390 outchar(z,'nl');
4 10391 end;
3 10392
3 10392 write(z,"nl",1,<<z>,
3 10393 <:første_frie_opkald=:>,første_frie_opkald,"nl",1,
3 10394 <:første_opkald=:>,første_opkald,"nl",1,
3 10395 <:sidste_opkald=:>,sidste_opkald,"nl",1,
3 10396 <:første_nødopkald=:>,første_nødopkald,"nl",1,
3 10397 <:sidste_nødopkald=:>,sidste_nødopkald,"nl",1,
3 10398 <:opkaldskø_ledige=:>,opkaldskø_ledige,"nl",1,
3 10399 <:nødopkald_brugt= :>,nødopkald_brugt,"nl",1,
3 10400 "nl",1,<:opkaldsflag::>,"nl",1);
3 10401 outintbits_ia(z,opkaldsflag,1,op_maske_lgd//2);
3 10402 write(z,"nl",2);
3 10403 end skriv_opkaldskø;
2 10404 \f
2 10404 message procedure skriv_radio_linietabel side 1 - 820301/hko;
2 10405
2 10405 procedure skriv_radio_linie_tabel(z);
2 10406 zone z;
2 10407 begin
3 10408 integer i,j,k;
3 10409
3 10409 write(z,"nl",2,"*",5,<: liniefordeling for operatører :>,"*",5,"nl",2);
3 10410 k:= 0;
3 10411 for i:= 1 step 1 until max_linienr do
3 10412 begin
4 10413 læstegn(radio_linietabel,i+1,j);
4 10414 if j > 0 then
4 10415 begin
5 10416 k:= k +1;
5 10417 write(z,<<dddd>,i,":",1,<<zd_>,j,"sp",if k mod 5=0 then 0 else 4,
5 10418 "nl",if k mod 5=0 then 1 else 0);
5 10419 end;
4 10420 end;
3 10421 write(z,"nl",if k mod 5=0 then 1 else 2);
3 10422 end skriv_radio_linietabel;
2 10423
2 10423 procedure skriv_radio_områdetabel(z);
2 10424 zone z;
2 10425 begin
3 10426 integer i;
3 10427
3 10427 write(z,"nl",2,"*",5,<: områdefordeling for operatører :>,"*",5,"nl",2);
3 10428 for i:= 1 step 1 until max_antal_områder do
3 10429 begin
4 10430 laf:= (i-1)*4;
4 10431 if radio_områdetabel(i)<>0 then
4 10432 write(z,<<dd>,i,<:. :>,områdenavn.laf,<:: :>,
4 10433 radio_områdetabel(i),"nl",1);
4 10434 end;
3 10435 end skriv_radio_områdetabel;
2 10436 \f
2 10436 message procedure h_radio side 1 - 810520/hko;
2 10437
2 10437 <* hovedmodulkorutine for radiokanaler *>
2 10438 procedure h_radio;
2 10439 begin
3 10440 integer array field op_ref;
3 10441 integer k,dest_sem;
3 10442 procedure skriv_hradio(z,omfang);
3 10443 value omfang;
3 10444 zone z;
3 10445 integer omfang;
3 10446 begin integer i;
4 10447 disable i:= write(z,"nl",1,<:+++ hovedmodul radio:>);
4 10448 write(z,"sp",26-i);
4 10449 if omfang >0 then
4 10450 disable begin integer x;
5 10451 trap(slut);
5 10452 write(z,"nl",1,
5 10453 <: op_ref: :>,op_ref,"nl",1,
5 10454 <: k: :>,k,"nl",1,
5 10455 <: dest_sem: :>,dest_sem,"nl",1,
5 10456 <::>);
5 10457 skriv_coru(z,coru_no(400));
5 10458 slut:
5 10459 end;
4 10460 end skriv_hradio;
3 10461
3 10461 trap(hrad_trap);
3 10462 stack_claim(if cm_test then 198 else 146);
3 10463
3 10463 <*+2*> if testbit32 and overvåget or testbit28 then
3 10464 skriv_hradio(out,0);
3 10465 <*-2*>
3 10466 \f
3 10466 message procedure h_radio side 2 - 820304/hko;
3 10467
3 10467 repeat
3 10468 wait_ch(cs_rad,op_ref,true,-1);
3 10469 <*+2*>if testbit33 and overvåget then
3 10470 disable begin
4 10471 skriv_h_radio(out,0);
4 10472 write(out,<: operation modtaget:>);
4 10473 skriv_op(out,op_ref);
4 10474 end;
3 10475 <*-2*>
3 10476 <*+4*>
3 10477 if (d.op_ref.optype and
3 10478 (gen_optype or rad_optype or vt_optype)) extract 12 =0
3 10479 then fejlreaktion(12<*operationstype*>,op_ref,<:h<'_'>radio:>,1);
3 10480 <*-4*>
3 10481
3 10481 k:=d.op_ref.op_kode extract 12;
3 10482 dest_sem:=
3 10483 if k > 0 and k < 7
3 10484 or k=11 or k=12 or k=19
3 10485 or (72<=k and k<=74) or k = 77
3 10486 <*IN,O/EK,O/IN,R/EK,R/FO,L/ST/EK,K/IN,K/RA,I/FO,O*>
3 10487 then cs_radio_adm
3 10488 else if k=41 <* radiokommando fra operatør *>
3 10489 then cs_radio(d.opref.data(1)) else -1;
3 10490 <*+4*>
3 10491 if dest_sem<1 then
3 10492 begin
4 10493 if dest_sem<0 then
4 10494 fejlreaktion(2<*operationskode*>,k,<:hovedmodul radio:>,1);
4 10495 d.op_ref.resultat:= if dest_sem=0 then 45 else 31;
4 10496 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 10497 end
3 10498 else
3 10499 <*-4*>
3 10500 begin <* operationskode ok *>
4 10501 signal_ch(dest_sem,op_ref,d.op_ref.optype);
4 10502 end;
3 10503 until false;
3 10504
3 10504 hrad_trap:
3 10505 disable skriv_hradio(zbillede,1);
3 10506 end h_radio;
2 10507 \f
2 10507 message procedure radio side 1 - 820301/hko;
2 10508
2 10508 procedure radio(talevej,op);
2 10509 value talevej,op;
2 10510 integer talevej,op;
2 10511 begin
3 10512 integer array field opref, rad_op, vt_op, opref1, iaf, iaf1;
3 10513 integer nr,i,j,k,res,opgave,tilst,tekn_inf, vtop2, vtop3,
3 10514 sig,omr,type,bus,ll,ttmm,vogn,garage,operatør;
3 10515 integer array felt,værdi(1:8);
3 10516 boolean byt,nød,frigiv_samtale;
3 10517 real kl;
3 10518 real field rf;
3 10519
3 10519 procedure skriv_radio(z,omfang);
3 10520 value omfang;
3 10521 zone z;
3 10522 integer omfang;
3 10523 begin integer i1;
4 10524 disable i1:= write(z,"nl",1,<:+++ radio:>);
4 10525 write(z,"sp",26-i1);
4 10526 if omfang > 0 then
4 10527 disable begin real x;
5 10528 trap(slut);
5 10529 \f
5 10529 message procedure radio side 1a- 820301/hko;
5 10530
5 10530 write(z,"nl",1,
5 10531 <: op_ref: :>,op_ref,"nl",1,
5 10532 <: opref1: :>,opref1,"nl",1,
5 10533 <: iaf: :>,iaf,"nl",1,
5 10534 <: iaf1: :>,iaf1,"nl",1,
5 10535 <: vt-op: :>,vt_op,"nl",1,
5 10536 <: rad-op: :>,rad_op,"nl",1,
5 10537 <: rf: :>,rf,"nl",1,
5 10538 <: nr: :>,nr,"nl",1,
5 10539 <: i: :>,i,"nl",1,
5 10540 <: j: :>,j,"nl",1,
5 10541 <: k: :>,k,"nl",1,
5 10542 <: operatør: :>,operatør,"nl",1,
5 10543 <: tilst: :>,tilst,"nl",1,
5 10544 <: res: :>,res,"nl",1,
5 10545 <: opgave: :>,opgave,"nl",1,
5 10546 <: type: :>,type,"nl",1,
5 10547 <: bus: :>,bus,"nl",1,
5 10548 <: ll: :>,ll,"nl",1,
5 10549 <: ttmm: :>,ttmm,"nl",1,
5 10550 <: vogn: :>,vogn,"nl",1,
5 10551 <: tekn-inf: :>,tekn_inf,"nl",1,
5 10552 <: vtop2: :>,vtop2,"nl",1,
5 10553 <: vtop3: :>,vtop3,"nl",1,
5 10554 <: sig: :>,sig,"nl",1,
5 10555 <: omr: :>,omr,"nl",1,
5 10556 <: garage: :>,garage,"nl",1,
5 10557 <<-dddddd'-dd>,
5 10558 <: kl: :>,kl,systime(4,kl,x),x,"nl",1,
5 10559 <:samtaleflag: :>,"nl",1);
5 10560 out_intbits_ia(z,samtaleflag,1,op_maske_lgd//2);
5 10561 skriv_coru(z,coru_no(410+talevej));
5 10562 slut:
5 10563 end;<*disable*>
4 10564 end skriv_radio;
3 10565 \f
3 10565 message procedure udtag_opkald side 1 - 820301/hko;
3 10566
3 10566 integer
3 10567 procedure udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
3 10568 value vogn, operatør;
3 10569 integer vogn,type,operatør,bus,garage,omr,sig,ll,ttmm;
3 10570 begin
4 10571 integer res,tilst,nr,i,j,t,o,b,l,tm;
4 10572 integer array field vt_op,ref,næste,forrige;
4 10573 integer array field iaf1;
4 10574 boolean skal_ud;
4 10575
4 10575 boolean procedure skal_udskrives(fordelt,aktuel);
4 10576 value fordelt,aktuel;
4 10577 integer fordelt,aktuel;
4 10578 begin
5 10579 boolean skal;
5 10580 integer n;
5 10581 integer array field iaf;
5 10582
5 10582 skal:= true;
5 10583 if fordelt > 0 and fordelt<>aktuel then
5 10584 begin
6 10585 for n:= 0 step 1 until 3 do
6 10586 begin
7 10587 if bpl_tilst(operatør_stop(fordelt,n),1) > 0 then
7 10588 begin
8 10589 iaf:= operatør_stop(fordelt,n)*op_maske_lgd;
8 10590 skal:= læsbit_ia(bpl_def.iaf,aktuel);
8 10591 goto returner;
8 10592 end;
7 10593 end;
6 10594 end;
5 10595 returner:
5 10596 skal_udskrives:= skal;
5 10597 end;
4 10598
4 10598 l:= b:= tm:= t:= 0;
4 10599 garage:= sig:= 0;
4 10600 res:= -1;
4 10601 <*V*> wait(bs_opkaldskø_adgang);
4 10602 ref:= første_nødopkald;
4 10603 if ref <> 0 then
4 10604 t:= 2
4 10605 else
4 10606 begin
5 10607 ref:= første_opkald;
5 10608 t:= if ref = 0 then 0 else 1;
5 10609 end;
4 10610 if t = 0 then res:= +19 <*kø er tom*> else
4 10611 if vogn=0 and omr=0 then
4 10612 begin
5 10613 while ref <> 0 and res = -1 do
5 10614 begin
6 10615 nr:= opkaldskø.ref(4) extract 8;
6 10616 if nr>64 then
6 10617 begin
7 10618 <*opk. primærfordelt til gruppe af btj.pl.*>
7 10619 i:=0; skal_ud:=true; iaf1:=nr*op_maske_lgd;
7 10620 while skal_ud and i<max_antal_operatører do
7 10621 begin
8 10622 i:=i+1;
8 10623 if læsbit_ia(bpl_def.iaf1,i) then
8 10624 skal_ud:= skal_ud and skal_udskrives(i,operatør);
8 10625 end;
7 10626 end
6 10627 else
6 10628 skal_ud:= skal_udskrives(nr,operatør);
6 10629
6 10629 if skal_ud then
6 10630 <* if nr=0 or -,læsbit_ia(operatørmaske,nr) or nr=operatør then
6 10631 *>
6 10632 res:= 0
6 10633 else
6 10634 begin
7 10635 ref:= opkaldskø.ref(1) extract 12;
7 10636 if ref = 0 and t = 2 then
7 10637 begin
8 10638 ref:= første_opkald;
8 10639 t:= if ref = 0 then 0 else 1;
8 10640 end else if ref = 0 then t:= 0;
7 10641 end;
6 10642 end; <*while*>
5 10643 \f
5 10643 message procedure udtag_opkald side 2 - 820304/hko;
5 10644
5 10644 if ref <> 0 then
5 10645 begin
6 10646 b:= opkaldskø.ref(2);
6 10647 <*+4*> if b < 0 then
6 10648 fejlreaktion(19<*mobilopkald*>,bus extract 14,
6 10649 <:nødopkald(besvaret/ej meldt):>,1);
6 10650 <*-4*>
6 10651 garage:=b shift(-14) extract 8;
6 10652 b:= b extract 14;
6 10653 l:= opkaldskø.ref(3);
6 10654 tm:= opkaldskø.ref(4);
6 10655 o:= tm extract 8;
6 10656 tm:= tm shift(-12);
6 10657 omr:= opkaldskø.ref(5) extract 8;
6 10658 sig:= opkaldskø.ref(5) shift (-20);
6 10659 end
5 10660 else res:=19; <* kø er tom *>
5 10661 end <*vogn=0 and omr=0 *>
4 10662 else
4 10663 begin
5 10664 <* vogn<>0 or omr<>0 *>
5 10665 i:= 0; tilst:= -1;
5 10666 if vogn shift(-22) = 1 then
5 10667 begin
6 10668 i:= find_busnr(vogn,nr,garage,tilst);
6 10669 l:= vogn;
6 10670 end
5 10671 else
5 10672 if vogn<>0 and (omr=0 or omr>2) then
5 10673 begin
6 10674 o:= 0;
6 10675 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
6 10676 if i=(-2) then
6 10677 begin
7 10678 o:= omr;
7 10679 i:= søg_omr_bus(vogn,l,garage,o,sig,tilst);
7 10680 end;
6 10681 nr:= vogn extract 14;
6 10682 end
5 10683 else nr:= vogn extract 14;
5 10684 if i<0 then ref:= 0;
5 10685 while ref <> 0 and res = -1 do
5 10686 begin
6 10687 i:= opkaldskø.ref(2) extract 14;
6 10688 j:= opkaldskø.ref(4) extract 8; <*operatør*>
6 10689 if nr = i and
6 10690 (omr=0 or omr=opkaldskø.ref(5) extract 8) then res:= 0
6 10691 else
6 10692 begin
7 10693 ref:= opkaldskø.ref(1) extract 12;
7 10694 if ref = 0 and t = 2 then
7 10695 begin
8 10696 ref:= første_opkald;
8 10697 t:= if ref = 0 then 0 else 1;
8 10698 end else if ref = 0 then t:= 0;
7 10699 end;
6 10700 end; <*while*>
5 10701 \f
5 10701 message procedure udtag_opkald side 3 - 810603/hko;
5 10702
5 10702 if ref <> 0 then
5 10703 begin
6 10704 b:= nr;
6 10705 tm:= opkaldskø.ref(4);
6 10706 o:= tm extract 8;
6 10707 tm:= tm shift(-12);
6 10708 omr:= opkaldskø.ref(5) extract 4;
6 10709 sig:= opkaldskø.ref(5) shift (-20);
6 10710
6 10710 <*+4*> if tilst <> -1 then
6 10711 fejlreaktion(3<*prg.fejl*>,tilst,
6 10712 <:vogntabel_tilstand for vogn i kø:>,1);
6 10713 <*-4*>
6 10714 end;
5 10715 end;
4 10716
4 10716 if ref <> 0 then
4 10717 begin
5 10718 næste:= opkaldskø.ref(1);
5 10719 forrige:= næste shift(-12);
5 10720 næste:= næste extract 12;
5 10721 if forrige <> 0 then
5 10722 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift(-12) shift 12
5 10723 + næste
5 10724 else if t = 1 then første_opkald:= næste
5 10725 else <*if t = 2 then*> første_nødopkald:= næste;
5 10726
5 10726 if næste <> 0 then
5 10727 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
5 10728 + forrige shift 12
5 10729 else if t = 1 then sidste_opkald:= forrige
5 10730 else <* if t = 2 then*> sidste_nødopkald:= forrige;
5 10731
5 10731 opkaldskø.ref(1):=første_frie_opkald;
5 10732 første_frie_opkald:=ref;
5 10733
5 10733 opkaldskø_ledige:=opkaldskø_ledige + 1;
5 10734 if t=2 then nødopkald_brugt:=nødopkald_brugt - 1;
5 10735 if -,læsbit_ia(operatør_maske,o) or o = 0 then
5 10736 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
5 10737 else
5 10738 begin
6 10739 sætbit_ia(opkaldsflag,operatør,1);
6 10740 sætbit_ia(opkaldsflag,o,1);
6 10741 end;
5 10742 signal_bin(bs_mobil_opkald);
5 10743 end;
4 10744 \f
4 10744 message procedure udtag_opkald side 4 - 810531/hko;
4 10745
4 10745 signal_bin(bs_opkaldskø_adgang);
4 10746 bus:= b;
4 10747 type:= t;
4 10748 ll:= l;
4 10749 ttmm:= tm;
4 10750 udtag_opkald:= res;
4 10751 end udtag opkald;
3 10752 \f
3 10752 message procedure frigiv_kanal side 1 - 810603/hko;
3 10753
3 10753 procedure frigiv_kanal(nr);
3 10754 value nr;
3 10755 integer nr;
3 10756 begin
4 10757 integer id1, id2, omr, i;
4 10758 integer array field iaf, vt_op;
4 10759
4 10759 iaf:= (nr-1)*kanal_beskrlængde;
4 10760 id1:= kanal_tab.iaf.kanal_id1;
4 10761 id2:= kanal_tab.iaf.kanal_id2;
4 10762 omr:= kanal_til_omr(nr);
4 10763 if id1 <> 0 then
4 10764 wait(ss_samtale_nedlagt(nr));
4 10765 if id1 shift (-22) < 3 and omr > 2 then
4 10766 begin
5 10767 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 10768 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10769 if id1 shift (-22) = 2 then 18 else 17);
5 10770 d.vt_op.data(1):= id1;
5 10771 d.vt_op.data(4):= omr;
5 10772 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 10773 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 10774 signalch(cs_vt_adgang,vt_op,true);
5 10775 end;
4 10776
4 10776 if id2 <> 0 and id2 shift(-20) <> 12 then
4 10777 wait(ss_samtale_nedlagt(nr));
4 10778 if id2 shift (-22) < 3 and omr > 2 then
4 10779 begin
5 10780 <*V*> waitch(cs_vt_adgang,vt_op,true,-1);
5 10781 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10782 if id2 shift (-22) = 2 then 18 else 17);
5 10783 d.vt_op.data(1):= id2;
5 10784 d.vt_op.data(4):= omr;
5 10785 signalch(cs_vt,vt_op,vt_optype or genoptype);
5 10786 <*V*> waitch(cs_radio(talevej),vt_op,vt_optype,-1);
5 10787 signalch(cs_vt_adgang,vt_op,true);
5 10788 end;
4 10789
4 10789 kanal_tab.iaf.kanal_id1:= kanal_tab.iaf.kanal_id2:=
4 10790 kanal_tab.iaf.kanal_alt_id1:= kanal_tab.iaf.kanal_alt_id2:= 0;
4 10791 kanal_tab.iaf.kanal_tilstand:= kanal_tab.iaf.kanal_tilstand
4 10792 shift (-10) extract 6 shift 10;
4 10793 <* repeat
4 10794 inspect(ss_samtale_nedlagt(nr),i);
4 10795 if i>0 then wait(ss_samtale_nedlagt(nr));
4 10796 until i<=0;
4 10797 *>
4 10798 end frigiv_kanal;
3 10799 \f
3 10799 message procedure hookoff side 1 - 880901/cl;
3 10800
3 10800 integer procedure hookoff(talevej,op,retursem,flash);
3 10801 value talevej,op,retursem,flash;
3 10802 integer talevej,op,retursem;
3 10803 boolean flash;
3 10804 begin
4 10805 integer array field opref;
4 10806
4 10806 opref:= op;
4 10807 start_operation(opref,410+talevej,retursem,'A' shift 12 + 60);
4 10808 d.opref.data(1):= talevej;
4 10809 d.opref.data(2):= if flash then 2 else 1;
4 10810 signalch(cs_radio_ud,opref,rad_optype);
4 10811 <*V*> waitch(retursem,opref,rad_optype,-1);
4 10812 hookoff:= d.opref.resultat;
4 10813 end;
3 10814 \f
3 10814 message procedure hookon side 1 - 880901/cl;
3 10815
3 10815 integer procedure hookon(talevej,op,retursem);
3 10816 value talevej,op,retursem;
3 10817 integer talevej,op,retursem;
3 10818 begin
4 10819 integer i,res;
4 10820 integer array field opref;
4 10821
4 10821 if læsbit_ia(hookoff_maske,talevej) then
4 10822 begin
5 10823 inspect(bs_talevej_udkoblet(talevej),i);
5 10824 if i<=0 then
5 10825 begin
6 10826 opref:= op;
6 10827 start_operation(opref,410+talevej,retursem,'D' shift 12 + 60);
6 10828 d.opref.data(1):= talevej;
6 10829 signalch(cs_radio_ud,opref,rad_optype);
6 10830 <*V*> waitch(retursem,opref,rad_optype,-1);
6 10831 res:= d.opref.resultat;
6 10832 end
5 10833 else
5 10834 res:= 0;
5 10835
5 10835 if res=0 then wait(bs_talevej_udkoblet(talevej));
5 10836 end
4 10837 else
4 10838 res:= 0;
4 10839
4 10839 sætbit_ia(hookoff_maske,talevej,0);
4 10840 hookon:= res;
4 10841 end;
3 10842 \f
3 10842 message procedure radio side 2 - 820304/hko;
3 10843
3 10843 rad_op:= op;
3 10844
3 10844 trap(radio_trap);
3 10845 stack_claim((if cm_test then 200 else 150) +200);
3 10846
3 10846 <*+2*>if testbit32 and overvåget or testbit28 then
3 10847 skriv_radio(out,0);
3 10848 <*-2*>
3 10849 repeat
3 10850 waitch(cs_radio(talevej),opref,true,-1);
3 10851 <*+2*>
3 10852 if testbit33 and overvåget then
3 10853 disable begin
4 10854 skriv_radio(out,0);
4 10855 write(out,<: operation modtaget på cs:>,<<d>,cs_radio(talevej));
4 10856 skriv_op(out,opref);
4 10857 end;
3 10858 <*-2*>
3 10859
3 10859 k:= d.op_ref.opkode extract 12;
3 10860 opgave:= d.opref.opkode shift (-12);
3 10861 operatør:= d.op_ref.data(4);
3 10862
3 10862 <*+4*> if (d.op_ref.optype and (gen_optype or io_optype or op_optype))
3 10863 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 10864 <:radio:>,0);
3 10865 <*-4*>
3 10866 \f
3 10866 message procedure radio side 3 - 880930/cl;
3 10867 if k=41 <*radiokommando fra operatør*> then
3 10868 begin
4 10869 vogn:= d.opref.data(2);
4 10870 res:= -1;
4 10871 for i:= 7 step 1 until 12 do d.opref.data(i):= 0;
4 10872 sig:= 0; omr:= d.opref.data(3) extract 8;
4 10873 bus:= garage:= ll:= 0;
4 10874
4 10874 if opgave=1 or opgave=9 then
4 10875 begin <* opkald til enkelt vogn (CHF) *>
5 10876 res:= udtag_opkald(vogn,type,operatør,bus,garage,omr,sig,ll,ttmm);
5 10877 if res=19 and (vogn<>0 or d.opref.data(3)=2) then res:= -1;
5 10878 <* ok at kø er tom når vogn er angivet eller VHF *>
5 10879
5 10879 d.opref.data(11):= if res=0 then
5 10880 (if ll<>0 then ll else bus) else vogn;
5 10881
5 10881 if type=2 <*nød*> then
5 10882 begin
6 10883 waitch(cs_radio_pulje,opref1,true,-1);
6 10884 start_operation(opref1,410+talevej,cs_radio_pulje,46);
6 10885 d.opref1.data(1):= if ll<>0 then ll else bus;
6 10886 systime(5,0,kl);
6 10887 d.opref1.data(2):= entier(kl/100.0);
6 10888 d.opref1.data(3):= omr;
6 10889 signalch(cs_io,opref1,gen_optype or rad_optype);
6 10890 end
5 10891 end; <* enkeltvogn (CHF) *>
4 10892
4 10892 <* check enkeltvogn for ledig *>
4 10893 if res<=0 and omr=2<*VHF*> and bus=0 and
4 10894 (opgave=1 or opgave=9) then
4 10895 begin
5 10896 for i:= 1 step 1 until max_antal_kanaler do
5 10897 if kanal_til_omr(i)=2 then nr:= i;
5 10898 iaf:= (nr-1)*kanalbeskrlængde;
5 10899 if kanal_tab.iaf.kanal_tilstand extract 2<>0 and
5 10900 kanal_tab.iaf.kanal_id1 extract 20 = 10000
5 10901 then res:= 52;
5 10902 end;
4 10903 if res < 0 and (d.opref.data(3) > 2 <* ej TLF, VHF *> or
4 10904 d.opref.data(3)=0 <*std. omr*>) and
4 10905 (opgave <= 2 <* OP elller ME *> or opgave = 9 <* OP,L *>)
4 10906 then
4 10907 begin
5 10908 type:= ttmm:= 0; omr:= 0; sig:= 0;
5 10909 if vogn shift (-22) = 1 then
5 10910 begin
6 10911 find_busnr(vogn,bus,garage,res);
6 10912 ll:= vogn;
6 10913 end
5 10914 else
5 10915 if vogn shift (-22) = 0 then
5 10916 begin
6 10917 søg_omr_bus(vogn,ll,garage,omr,sig,res);
6 10918 bus:= vogn;
6 10919 end
5 10920 else
5 10921 fejlreaktion(31,vogn,<:vognident i enkeltvognsopk.:>,0);
5 10922 res:= if res=(-1) then 18 <* i kø *> else
5 10923 (if res<>0 then 14 <*opt*> else 0);
5 10924 end
4 10925 else
4 10926 if res<0 and (d.opref.data(3)=1 or d.opref.data(3)=2) and
4 10927 opgave <= 2 then
4 10928 begin
5 10929 bus:= vogn; garage:= type:= ttmm:= 0;
5 10930 res:= 0; omr:= 0; sig:= 0;
5 10931 end
4 10932 else
4 10933 if opgave>1 and opgave<>9 then
4 10934 type:= ttmm:= res:= 0;
4 10935 \f
4 10935 message procedure radio side 4 - 880930/cl;
4 10936
4 10936 if res=0 and (opgave<=4 or opgave=9) and
4 10937 (omr<1 or 2<omr) and
4 10938 (d.opref.data(3)>2 or d.opref.data(3)=0) then
4 10939 begin <* reserver i vogntabel *>
5 10940 waitch(cs_vt_adgang,vt_op,true,-1);
5 10941 start_operation(vt_op,410+talevej,cs_radio(talevej),
5 10942 if opgave <=2 or opgave=9 then 15 else 16);
5 10943 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
5 10944 (if vogn=0 then garage shift 14 + bus else
5 10945 if ll<>0 then ll else garage shift 14 + bus)
5 10946 else vogn <*gruppeid*>;
5 10947 d.vt_op.data(4):= if d.opref.data(3)<>0 then
5 10948 d.opref.data(3) extract 8
5 10949 else omr extract 8;
5 10950 signalch(cs_vt,vt_op,gen_optype or rad_optype);
5 10951 <*V*> waitch(cs_radio(talevej),vt_op,rad_optype,-1);
5 10952
5 10952 res:= d.vt_op.resultat;
5 10953 if res=3 then res:= 0;
5 10954 vtop2:= d.vt_op.data(2);
5 10955 vtop3:= d.vt_op.data(3);
5 10956 tekn_inf:= d.vt_op.data(4);
5 10957 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
5 10958 end;
4 10959
4 10959 if res<>0 then
4 10960 begin
5 10961 d.opref.resultat:= res;
5 10962 signalch(d.opref.retur,opref,d.opref.optype);
5 10963 end
4 10964 else
4 10965
4 10965 if opgave <= 9 then
4 10966 begin <* opkald *>
5 10967 res:= hookoff(talevej,rad_op,cs_radio(talevej),
5 10968 opgave<>9 and d.opref.data(6)<>0);
5 10969
5 10969 if res<>0 then
5 10970 goto returner_op;
5 10971
5 10971 if opgave=7 or opgave=8 then <* KATASTROFEOPKALD *>
5 10972 begin
6 10973 start_operation(rad_op,410+talevej,cs_radio(talevej),
6 10974 'H' shift 12 + 60);
6 10975 d.rad_op.data(1):= talevej;
6 10976 d.rad_op.data(2):= 'D';
6 10977 d.rad_op.data(3):= 6; <* rear *>
6 10978 d.rad_op.data(4):= 1; <* rear no *>
6 10979 d.rad_op.data(5):= 0; <* disconnect *>
6 10980 signalch(cs_radio_ud,rad_op,rad_optype);
6 10981 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
6 10982 if d.rad_op.resultat<>0 then
6 10983 begin
7 10984 res:= d.rad_op.resultat;
7 10985 goto returner_op;
7 10986 end;
6 10987 <*
6 10988 while optaget_flag shift (-1) <> 0 do
6 10989 delay(1);
6 10990 *>
6 10991 end;
5 10992 \f
5 10992 message procedure radio side 5 - 880930/cl;
5 10993
5 10993 start_operation(rad_op,410+talevej,cs_radio(talevej),
5 10994 'B' shift 12 + 60);
5 10995 d.rad_op.data(1):= talevej;
5 10996 d.rad_op.data(2):= 'D';
5 10997 d.rad_op.data(3):= if opgave=9 then 3 else
5 10998 (2 - (opgave extract 1)); <* højttalerkode *>
5 10999
5 10999 if 5<=opgave and opgave <=8 then <* ALLE KALD *>
5 11000 begin
6 11001 j:= 0;
6 11002 for i:= 2 step 1 until max_antal_områder do
6 11003 begin
7 11004 if opgave > 6 or
7 11005 (d.opref.data(3) shift (-20) = 15 and
7 11006 læsbiti(d.opref.data(3),i)) or
7 11007 (d.opref.data(3) shift (-20) = 14 and
7 11008 d.opref.data(3) extract 20 = i)
7 11009 then
7 11010 begin
8 11011 for k:= 1 step 1 until (if i=3 then 2 else 1) do
8 11012 begin
9 11013 j:= j+1;
9 11014 d.rad_op.data(10+(j-1)*2):=
9 11015 område_id(i,2) shift 12 + <* tkt, tkn *>
9 11016 (if i=2<*VHF*> then 4 else k)
9 11017 shift 8 + <* signal type *>
9 11018 1; <* antal tno *>
9 11019 d.rad_op.data(11+(j-1)*2):= 0; <* tno alle *>
9 11020 end;
8 11021 end;
7 11022 end;
6 11023 d.rad_op.data(4):= j;
6 11024 d.rad_op.data(5):= 0;
6 11025 end
5 11026 else
5 11027 if opgave>2 and opgave <= 4 then <* gruppekald *>
5 11028 begin
6 11029 d.rad_op.data(4):= vtop2;
6 11030 d.rad_op.data(5):= vtop3;
6 11031 end
5 11032 else
5 11033 begin <* enkeltvogn *>
6 11034 if omr=0 then
6 11035 begin
7 11036 sig:= tekn_inf shift (-23);
7 11037 omr:= if d.opref.data(3)<>0 then d.opref.data(3)
7 11038 else tekn_inf extract 8;
7 11039 end
6 11040 else
6 11041 if d.opref.data(3)<>0 then omr:= d.opref.data(3);
6 11042
6 11042 <* lytte-kald til nød i TCT, VHF og TLF *>
6 11043 <* tvinges til alm. opkald *>
6 11044 if (opgave=9) and (type=2) and (omr<=3) then
6 11045 begin
7 11046 d.opref.opkode:= 1 shift 12 + d.opref.opkode extract 12;
7 11047 opgave:= 1;
7 11048 d.radop.data(3):= 1;
7 11049 end;
6 11050
6 11050 if omr=2 <*VHF*> then sig:= 4 else
6 11051 if omr=1 <*TLF*> then sig:= 7 else
6 11052 <*UHF*> sig:= sig+1;
6 11053 d.rad_op.data(4):= 1;
6 11054 d.rad_op.data(5):= 0;
6 11055 d.rad_op.data(10):=
6 11056 (område_id(omr,2) extract 12) shift 12 +
6 11057 sig shift 8 +
6 11058 1;
6 11059 d.rad_op.data(11):= bus;
6 11060 end;
5 11061 \f
5 11061 message procedure radio side 6 - 880930/cl;
5 11062
5 11062 signalch(cs_radio_ud,rad_op,rad_optype);
5 11063 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11064 res:= d.rad_op.resultat;
5 11065
5 11065 d.rad_op.data(6):= 0;
5 11066 for i:= 1 step 1 until max_antal_områder do
5 11067 if læsbiti(d.rad_op.data(7),i) then
5 11068 increase(d.rad_op.data(6));
5 11069 returner_op:
5 11070 if d.rad_op.data(6)=1 then
5 11071 begin
6 11072 for i:= 1 step 1 until max_antal_områder do
6 11073 if d.rad_op.data(7) extract 20 = 1 shift i then
6 11074 d.opref.data(12):= 14 shift 20 + i;
6 11075 end
5 11076 else
5 11077 d.opref.data(12):= 15 shift 20 + d.rad_op.data(7) extract 20;
5 11078 d.opref.data(7):= type;
5 11079 d.opref.data(8):= garage shift 14 + bus;
5 11080 d.opref.data(9):= ll;
5 11081 if res=0 then
5 11082 begin
6 11083 d.opref.resultat:= 3;
6 11084 d.opref.data(5):= d.opref.data(6);
6 11085 j:= 0;
6 11086 for i:= 1 step 1 until max_antal_kanaler do
6 11087 if læsbiti(d.rad_op.data(9),i) then j:= j+1;
6 11088 if j>1 then
6 11089 d.opref.data(6):= 3 shift 22 + 1 shift 20 + d.rad_op.data(9)
6 11090 else
6 11091 begin
7 11092 j:= 0;
7 11093 for i:= 1 step 1 until max_antal_kanaler do
7 11094 if læsbiti(d.rad_op.data(9),i) then j:= i;
7 11095 d.opref.data(6):= 3 shift 22 + j;
7 11096 end;
6 11097 d.opref.data(7):= type;
6 11098 d.opref.data(8):= garage shift 14 + bus;
6 11099 d.opref.data(9):= ll;
6 11100 d.opref.data(10):= d.opref.data(6);
6 11101 for i:= 1 step 1 until max_antal_kanaler do
6 11102 begin
7 11103 if læsbiti(d.rad_op.data(9),i) then
7 11104 begin
8 11105 if kanal_id(i) shift (-5) extract 5 = 2 then
8 11106 j:= pabx_id( kanal_id(i) extract 5 )
8 11107 else
8 11108 j:= radio_id( kanal_id(i) extract 5 );
8 11109 if j>0 and type=0 then tæl_opkald(j,1);
8 11110
8 11110 iaf:= (i-1)*kanalbeskrlængde;
8 11111 skrivtegn(kanal_tab.iaf,1,talevej);
8 11112 kanal_tab.iaf.kanal_id2:= kanal_tab.iaf.kanal_id1;
8 11113 kanal_tab.iaf.kanal_alt_id2:= kanal_tab.iaf.kanal_alt_id1;
8 11114 kanal_tab.iaf.kanal_id1:=
8 11115 if opgave<=2 or opgave=9 then
8 11116 d.opref.data(if d.opref.data(9)<>0 then 9 else 8)
8 11117 else
8 11118 d.opref.data(2);
8 11119 kanal_tab.iaf.kanal_alt_id1:=
8 11120 if opgave<=2 or opgave=9 then
8 11121 d.opref.data(if d.opref.data(9)<>0 then 8 else 9)
8 11122 else
8 11123 0;
8 11124 if kanal_tab.iaf.kanal_id1=0 then
8 11125 kanal_tab.iaf.kanal_id1:= 10000;
8 11126 kanal_tab.iaf.kanal_spec:=
8 11127 if opgave <= 2 or opgave = 9 then ttmm else 0;
8 11128 end;
7 11129 end;
6 11130 if 5<=opgave and opgave<=8 <*alle-/katastrofekald*> then
6 11131 sætbit_ia(kanalflag,operatør,1);
6 11132 \f
6 11132 message procedure radio side 7 - 880930/cl;
6 11133
6 11133 end
5 11134 else
5 11135 begin
6 11136 d.opref.resultat:= res;
6 11137 if d.opref.data(6)=0 then
6 11138 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11139 <* frigiv fra vogntabel hvis reserveret *>
6 11140 if (opgave<=4 or opgave=9) and
6 11141 (d.opref.data(3)=0 or d.opref.data(3)>2) then
6 11142 begin
7 11143 waitch(cs_vt_adgang,vt_op,true,-1);
7 11144 startoperation(vt_op,410+talevej,cs_radio(talevej),
7 11145 if opgave<=2 or opgave=9 then 17 else 18);
7 11146 d.vt_op.data(1):= if opgave<=2 or opgave=9 then
7 11147 (if vogn=0 then garage shift 14 + bus else
7 11148 if ll<>0 then ll else garage shift 14 + bus)
7 11149 else vogn;
7 11150 d.vt_op.data(4):= omr;
7 11151 signalch(cs_vt,vt_op,gen_optype or vt_optype);
7 11152 waitch(cs_radio(talevej),vt_op,vt_optype,-1);
7 11153 signalch(cs_vt_adgang,vt_op,true);
7 11154 end;
6 11155 end;
5 11156 signalch(d.opref.retur,opref,d.opref.optype);
5 11157 \f
5 11157 message procedure radio side 8 - 880930/cl;
5 11158
5 11158 end <* opkald *>
4 11159 else
4 11160 if opgave = 10 <* MONITER *> then
4 11161 begin
5 11162 nr:= d.opref.data(2);
5 11163 if nr shift (-20) <> 12 then
5 11164 fejlreaktion(3,nr,<: moniter, kanalnr:>,0);
5 11165 nr:= nr extract 20;
5 11166 iaf:= (nr-1)*kanalbeskrlængde;
5 11167 inspect(ss_samtale_nedlagt(nr),i);
5 11168 k:= if kanal_tab.iaf.kanal_id2 shift (-20) = 12 then
5 11169 kanal_tab.iaf.kanal_id2 extract 20
5 11170 else
5 11171 if kanal_tab.iaf.kanal_id2<>0 then nr else 0;
5 11172 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11173 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej and
5 11174 (i<>0 or j<>0) then
5 11175 begin
6 11176 res:= 0;
6 11177 d.opref.data(5):= 12 shift 20 + k;
6 11178 d.opref.data(6):= 12 shift 20 + nr;
6 11179 sætbit_ia(kanalflag,operatør,1);
6 11180 goto radio_nedlæg;
6 11181 end
5 11182 else
5 11183 if i<>0 or j<>0 then
5 11184 res:= 49
5 11185 else
5 11186 if kanal_tab.iaf.kanal_tilstand extract 2 = 0 then
5 11187 res:= 49 <* ingen samtale igang *>
5 11188 else
5 11189 begin
6 11190 res:= hookoff(talevej,rad_op,cs_radio(talevej),false);
6 11191 if res=0 then
6 11192 begin
7 11193 start_operation(rad_op,410+talevej,cs_radio(talevej),
7 11194 'B' shift 12 + 60);
7 11195 d.rad_op.data(1):= talevej;
7 11196 d.rad_op.data(2):= 'V';
7 11197 d.rad_op.data(3):= 0;
7 11198 d.rad_op.data(4):= 1;
7 11199 d.rad_op.data(5):= 0;
7 11200 d.rad_op.data(10):=
7 11201 (kanal_id(nr) shift (-5) shift 18) +
7 11202 (kanal_id(nr) extract 5 shift 12) + 0;
7 11203 signalch(cs_radio_ud,rad_op,rad_optype);
7 11204 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
7 11205 res:= d.rad_op.resultat;
7 11206 if res=0 then
7 11207 begin
8 11208 d.opref.data(5):= 0;
8 11209 d.opref.data(6):= 3 shift 22 + 0 shift 20 + nr;
8 11210 d.opref.data(7):= kanal_tab.iaf.kanal_tilstand extract 10;
8 11211 res:= 3;
8 11212 end;
7 11213 end;
6 11214 end;
5 11215 \f
5 11215 message procedure radio side 9 - 880930/cl;
5 11216 if res=3 then
5 11217 begin
6 11218 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
6 11219 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1) <* monbit *>
6 11220 else
6 11221 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
6 11222 d.opref.data(6):= 12 shift 20 + nr;
6 11223 i:= kanal_tab.iaf.kanal_id2;
6 11224 if i<>0 then
6 11225 begin
7 11226 if i shift (-20) = 12 then
7 11227 begin <* ident2 henviser til anden kanal *>
8 11228 iaf1:= ((i extract 20)-1)*kanalbeskrlængde;
8 11229 if kanal_tab.iaf1.kanal_tilstand shift (-16) = talevej then
8 11230 sætbiti(kanal_tab.iaf.kanal_tilstand,5,1)
8 11231 else
8 11232 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,1);
8 11233 d.opref.data(5):= 12 shift 20 + i;
8 11234 end
7 11235 else
7 11236 d.opref.data(5):= 12 shift 20 + nr;
7 11237 end
6 11238 else
6 11239 d.opref.data(5):= 0;
6 11240 end;
5 11241
5 11241 if res<>3 then
5 11242 begin
6 11243 res:= 0;
6 11244 sætbit_ia(kanalflag,operatør,1);
6 11245 goto radio_nedlæg;
6 11246 end;
5 11247 d.opref.resultat:= res;
5 11248 signalch(d.opref.retur,opref,d.opref.optype);
5 11249 \f
5 11249 message procedure radio side 10 - 880930/cl;
5 11250
5 11250 end <* MONITERING *>
4 11251 else
4 11252 if opgave = 11 then <* GENNEMSTILLING *>
4 11253 begin
5 11254 nr:= d.opref.data(6) extract 20;
5 11255 k:= if d.opref.data(5) shift (-20) = 12 then
5 11256 d.opref.data(5) extract 20
5 11257 else
5 11258 0;
5 11259 inspect(ss_samtale_nedlagt(nr),i);
5 11260 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:=0;
5 11261 if i<>0 and j<>0 then
5 11262 begin
6 11263 res:= hookon(talevej,rad_op,cs_radio(talevej));
6 11264 goto radio_nedlæg;
6 11265 end;
5 11266
5 11266 iaf:= (nr-1)*kanal_beskr_længde;
5 11267 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
5 11268 begin
6 11269 if læsbiti(kanal_tab.iaf.kanal_tilstand,5) and
6 11270 kanal_tab.iaf.kanal_tilstand extract 2 = 3
6 11271 then
6 11272 res:= hookoff(talevej,rad_op,cs_radio(talevej),true)
6 11273 else
6 11274 if kanal_tab.iaf.kanal_tilstand extract 2 = 1 and
6 11275 d.opref.data(5)<>0
6 11276 then
6 11277 res:= 0
6 11278 else
6 11279 res:= 21; <* ingen at gennemstille til *>
6 11280 end
5 11281 else
5 11282 res:= 50; <* kanalnr *>
5 11283
5 11283 if res=0 then
5 11284 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11285 if res=0 then
5 11286 begin
6 11287 sætbiti(kanal_tab.iaf.kanal_tilstand,5,0);
6 11288 kanal_tab.iaf.kanal_tilstand:=
6 11289 kanal_tab.iaf.kanal_tilstand shift (-2) shift 2 + 3;
6 11290 d.opref.data(6):= 0;
6 11291 if kanal_tab.iaf.kanal_id2=0 then
6 11292 kanal_tab.iaf.kanal_id2:= d.opref.data(5);
6 11293
6 11293 if kanal_tab.iaf.kanal_id2 shift (-22) = 3 then
6 11294 begin <* gennemstillet til anden kanal *>
7 11295 iaf1:= ((kanal_tab.iaf.kanal_id2 extract 20) - 1)
7 11296 *kanalbeskrlængde;
7 11297 sætbiti(kanal_tab.iaf1.kanal_tilstand,5,0);
7 11298 kanal_tab.iaf1.kanal_tilstand:=
7 11299 kanal_tab.iaf1.kanal_tilstand shift (-2) shift 2 + 3;
7 11300 if kanal_tab.iaf1.kanal_id2=0 then
7 11301 kanal_tab.iaf1.kanal_id2:= 12 shift 20 + nr;
7 11302 end;
6 11303 d.opref.data(5):= 0;
6 11304
6 11304 res:= 3;
6 11305 end;
5 11306
5 11306 d.opref.resultat:= res;
5 11307 signalch(d.opref.retur,opref,d.opref.optype);
5 11308 \f
5 11308 message procedure radio side 11 - 880930/cl;
5 11309
5 11309 end
4 11310 else
4 11311 if opgave = 12 then <* NEDLÆG *>
4 11312 begin
5 11313 res:= hookon(talevej,rad_op,cs_radio(talevej));
5 11314 radio_nedlæg:
5 11315 if res=0 then
5 11316 begin
6 11317 for k:= 5, 6 do
6 11318 begin
7 11319 if d.opref.data(k) shift (-20) = 12 then
7 11320 begin
8 11321 i:= d.opref.data(k) extract 20;
8 11322 iaf:= (i-1)*kanalbeskrlængde;
8 11323 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
8 11324 frigiv_kanal(d.opref.data(k) extract 20)
8 11325 else
8 11326 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
8 11327 end
7 11328 else
7 11329 if d.opref.data(k) shift (-20) = 13 then
7 11330 begin
8 11331 for i:= 1 step 1 until max_antal_kanaler do
8 11332 if læsbiti(d.opref.data(k),i) then
8 11333 begin
9 11334 iaf:= (i-1)*kanalbeskrlængde;
9 11335 if kanal_tab.iaf.kanal_tilstand shift (-16) = talevej then
9 11336 frigiv_kanal(i)
9 11337 else
9 11338 sætbit_ia(kanal_tab.iaf.kanal_mon_maske,talevej,0);
9 11339 end;
8 11340 sætbit_ia(kanalflag,operatør,1);
8 11341 end;
7 11342 end;
6 11343 d.opref.data(5):= 0;
6 11344 d.opref.data(6):= 0;
6 11345 d.opref.data(9):= 0;
6 11346 res:= if opgave=12 then 3 else 49;
6 11347 end;
5 11348 d.opref.resultat:= res;
5 11349 signalch(d.opref.retur,opref,d.opref.optype);
5 11350 end
4 11351 else
4 11352 if opgave=13 then <* R *>
4 11353 begin
5 11354 startoperation(rad_op,410+talevej,cs_radio(talevej),
5 11355 'H' shift 12 + 60);
5 11356 d.rad_op.data(1):= talevej;
5 11357 d.rad_op.data(2):= 'M';
5 11358 d.rad_op.data(3):= 0; <*tkt*>
5 11359 d.rad_op.data(4):= 0; <*tkn*>
5 11360 d.rad_op.data(5):= 1 - (d.opref.data(2) extract 1);
5 11361 signalch(cs_radio_ud,rad_op,rad_optype);
5 11362 <*V*> waitch(cs_radio(talevej),rad_op,rad_optype,-1);
5 11363 res:= d.rad_op.resultat;
5 11364 d.opref.resultat:= if res=0 then 3 else res;
5 11365 signalch(d.opref.retur,opref,d.opref.optype);
5 11366 end
4 11367 else
4 11368 if opgave=14 <* VENTEPOS *> then
4 11369 begin
5 11370 res:= 0;
5 11371 while (res<=3 and d.opref.data(2)>0) do
5 11372 begin
6 11373 nr:= d.opref.data(6) extract 20;
6 11374 k:= if d.opref.data(5) shift (-20) = 12 then
6 11375 d.opref.data(5) extract 20
6 11376 else
6 11377 0;
6 11378 inspect(ss_samtale_nedlagt(nr),i);
6 11379 if k<>0 then inspect(ss_samtale_nedlagt(k),j) else j:= 0;
6 11380 if i<>0 or j<>0 then
6 11381 begin
7 11382 res:= hookon(talevej,radop,cs_radio(talevej));
7 11383 goto radio_nedlæg;
7 11384 end;
6 11385
6 11385 res:= hookoff(talevej,radop,cs_radio(talevej),true);
6 11386
6 11386 if res=0 then
6 11387 begin
7 11388 i:= d.opref.data(5);
7 11389 d.opref.data(5):= d.opref.data(6);
7 11390 d.opref.data(6):= i;
7 11391 res:= 3;
7 11392 end;
6 11393
6 11393 d.opref.data(2):= d.opref.data(2)-1;
6 11394 end;
5 11395 d.opref.resultat:= res;
5 11396 signalch(d.opref.retur,opref,d.opref.optype);
5 11397 end
4 11398 else
4 11399 begin
5 11400 fejlreaktion(2,opgave,<: radioopgave fra operatør:>,1);
5 11401 d.opref.resultat:= 31;
5 11402 signalch(d.opref.retur,opref,d.opref.optype);
5 11403 end;
4 11404
4 11404 end <* radiokommando fra operatør *>
3 11405 else
3 11406 begin
4 11407
4 11407 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 11408
4 11408 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 11409
4 11409 end;
3 11410
3 11410 until false;
3 11411 radio_trap:
3 11412 disable skriv_radio(zbillede,1);
3 11413 end radio;
2 11414 \f
2 11414 message procedure radio_ind side 1 - 810521/hko;
2 11415
2 11415 procedure radio_ind(op);
2 11416 value op;
2 11417 integer op;
2 11418 begin
3 11419 integer array field op_ref,ref,io_opref;
3 11420 integer ac, lgd, ttyp, ptyp, pnum, pos, tegn, bs, b_pt, b_pn,
3 11421 antal_sendt, antal_spec, sum, csum, i, j, k, filref, zno;
3 11422 integer array typ, val(1:6), answ, tlgr(1:32);
3 11423 integer array field spec;
3 11424 real field rf;
3 11425 long array field laf;
3 11426
3 11426 procedure skriv_radio_ind(zud,omfang);
3 11427 value omfang;
3 11428 zone zud;
3 11429 integer omfang;
3 11430 begin integer ii;
4 11431 disable ii:=write(zud,"nl",1,<:+++ radio-ind ::>);
4 11432 if omfang > 0 then
4 11433 disable begin integer x; long array field tx;
5 11434 tx:= 0;
5 11435 trap(slut);
5 11436 write(zud,"nl",1,
5 11437 <: op-ref: :>,op_ref,"nl",1,
5 11438 <: ref: :>,ref,"nl",1,
5 11439 <: io-opref: :>,io_opref,"nl",1,
5 11440 <: ac: :>,ac,"nl",1,
5 11441 <: lgd: :>,lgd,"nl",1,
5 11442 <: ttyp: :>,ttyp,"nl",1,
5 11443 <: ptyp: :>,ptyp,"nl",1,
5 11444 <: pnum: :>,pnum,"nl",1,
5 11445 <: pos: :>,pos,"nl",1,
5 11446 <: tegn: :>,tegn,"nl",1,
5 11447 <: bs: :>,bs,"nl",1,
5 11448 <: b-pt: :>,b_pt,"nl",1,
5 11449 <: b-pn: :>,b_pn,"nl",1,
5 11450 <: antal-sendt: :>,antal_sendt,"nl",1,
5 11451 <: antal-spec: :>,antal_spec,"nl",1,
5 11452 <: sum: :>,sum,"nl",1,
5 11453 <: csum: :>,csum,"nl",1,
5 11454 <: i: :>,i,"nl",1,
5 11455 <: j: :>,j,"nl",1,
5 11456 <: k: :>,k,"nl",1,
5 11457 <: filref :>,filref,"nl",1,
5 11458 <: zno: :>,zno,"nl",1,
5 11459 <: answ: :>,answ.tx,"nl",1,
5 11460 <: tlgr: :>,tlgr.tx,"nl",1,
5 11461 <: spec: :>,spec,"nl",1);
5 11462 trap(slut);
5 11463 slut:
5 11464 end; <*disable*>
4 11465 end skriv_radio_ind;
3 11466 \f
3 11466 message procedure indsæt_opkald side 1 - 811105/hko;
3 11467
3 11467 integer procedure indsæt_opkald(bus,type,omr,sig);
3 11468 value bus,type,omr,sig;
3 11469 integer bus,type,omr,sig;
3 11470 begin
4 11471 integer res,tilst,ll,operatør;
4 11472 integer array field vt_op,ref,næste,forrige;
4 11473 real r;
4 11474
4 11474 res:= -1;
4 11475 begin
5 11476 <*V*> waitch(cs_vt_adgang,vt_op,true,if type=2 then -1 else 10);
5 11477 if vt_op <> 0 then
5 11478 begin
6 11479 wait(bs_opkaldskø_adgang);
6 11480 if omr>2 then
6 11481 begin
7 11482 start_operation(vt_op,401,cs_radio_ind,14<*bus i kø*>);
7 11483 d.vt_op.data(1):= bus;
7 11484 d.vt_op.data(4):= omr;
7 11485 tilst:= vt_op;
7 11486 signal_ch(cs_vt,vt_op,gen_optype or vt_optype);
7 11487 <*V*> wait_ch(cs_radio_ind,vt_op,vt_optype,-1);
7 11488 <*+4*> if tilst <> vt_op then
7 11489 fejlreaktion(11<*fremmed post*>,vt_op,<:radio,indsæt opkald:>,0);
7 11490 <*-4*>
7 11491 <*+2*> if testbit34 and overvåget then
7 11492 disable begin
8 11493 write(out,"nl",1,<:radio_ind,indsæt.reservation retur:>);
8 11494 skriv_op(out,vt_op);
8 11495 ud;
8 11496 end;
7 11497 end
6 11498 else
6 11499 begin
7 11500 d.vt_op.data(1):= bus;
7 11501 d.vt_op.data(2):= 0;
7 11502 d.vt_op.data(3):= bus;
7 11503 d.vt_op.data(4):= omr;
7 11504 d.vt_op.resultat:= 0;
7 11505 ref:= første_nødopkald;
7 11506 if ref<>0 then tilst:= 2
7 11507 else
7 11508 begin
8 11509 ref:= første_opkald;
8 11510 tilst:= if ref=0 then 0 else 1;
8 11511 end;
7 11512 if tilst=0 then
7 11513 d.vt_op.resultat:= 3
7 11514 else
7 11515 begin
8 11516 while ref<>0 and d.vt_op.resultat=0 do
8 11517 begin
9 11518 if opkaldskø.ref(2) extract 14 = bus and
9 11519 opkaldskø.ref(5) extract 8 = omr
9 11520 then
9 11521 d.vt_op.resultat:= 18
9 11522 else
9 11523 begin
10 11524 ref:= opkaldskø.ref(1) extract 12;
10 11525 if ref=0 and tilst=2 then
10 11526 begin
11 11527 ref:= første_opkald;
11 11528 tilst:= if ref=0 then 0 else 1;
11 11529 end
10 11530 else
10 11531 if ref=0 then tilst:= 0;
10 11532 end;
9 11533 end;
8 11534 if d.vt_op.resultat=0 then d.vt_op.resultat:= 3;
8 11535 end;
7 11536 end;
6 11537 <*-2*>
6 11538 \f
6 11538 message procedure indsæt_opkald side 1a- 820301/hko;
6 11539
6 11539 if d.vt_op.resultat=18<*bus i kø*> and type=2<*nød*> then
6 11540 begin
7 11541 ref:=første_opkald;
7 11542 tilst:=-1;
7 11543 while ref<>0 and tilst=-1 do
7 11544 begin
8 11545 if opkaldskø.ref(2) extract 14 = bus extract 14 then
8 11546 begin <* udtag normalopkald *>
9 11547 næste:=opkaldskø.ref(1);
9 11548 forrige:=næste shift(-12);
9 11549 næste:=næste extract 12;
9 11550 if forrige<>0 then
9 11551 opkaldskø.forrige(1):=
9 11552 opkaldskø.forrige(1) shift(-12) shift 12 +næste
9 11553 else
9 11554 første_opkald:=næste;
9 11555 if næste<>0 then
9 11556 opkaldskø.næste(1):=
9 11557 opkaldskø.næste(1) extract 12 + forrige shift 12
9 11558 else
9 11559 sidste_opkald:=forrige;
9 11560 opkaldskø.ref(1):=første_frie_opkald;
9 11561 første_frie_opkald:=ref;
9 11562 opkaldskø_ledige:=opkaldskø_ledige +1;
9 11563 tilst:=0;
9 11564 end
8 11565 else
8 11566 ref:=opkaldskø.ref(1) extract 12;
8 11567 end; <*while*>
7 11568 if tilst=0 then
7 11569 d.vt_op.resultat:=3;
7 11570 end; <*nødopkald bus i kø*>
6 11571 \f
6 11571 message procedure indsæt_opkald side 2 - 820304/hko;
6 11572
6 11572 if d.vt_op.resultat = 3 then
6 11573 begin
7 11574 ll:= d.vt_op.data(2);
7 11575 tilst:= d.vt_op.data(3);
7 11576 læstegn(radio_linietabel,(ll shift (-12) extract 10)+1,operatør);
7 11577 if operatør < 0 or max_antal_operatører < operatør then
7 11578 operatør:= 0;
7 11579 if operatør=0 then
7 11580 operatør:= (tilst shift (-14) extract 8);
7 11581 if operatør=0 then
7 11582 operatør:= radio_områdetabel(d.vt_op.data(4) extract 8);
7 11583 if operatør=0 or -,læsbit_ia(operatørmaske,operatør) then
7 11584 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
7 11585 else sæt_bit_ia(opkaldsflag,operatør,1);
7 11586 ref:= første_frie_opkald; <* forudsættes <> 0 *>
7 11587 første_frie_opkald:=opkaldskø.ref(1) extract 12; <*hægt ud*>
7 11588 forrige:= (if type = 1 then sidste_opkald
7 11589 else sidste_nødopkald);
7 11590 opkaldskø.ref(1):= forrige shift 12;
7 11591 if type = 1 then
7 11592 begin
8 11593 if første_opkald = 0 then første_opkald:= ref;
8 11594 sidste_opkald:= ref;
8 11595 end
7 11596 else
7 11597 begin <*type = 2*>
8 11598 if første_nødopkald = 0 then første_nødopkald:= ref;
8 11599 sidste_nødopkald:= ref;
8 11600 end;
7 11601 if forrige <> 0 then
7 11602 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12)
7 11603 shift 12 +ref;
7 11604
7 11604 opkaldskø.ref(2):= tilst extract 22 add
7 11605 (if type=2 then 1 shift 23 else 0);
7 11606 opkaldskø.ref(3):= ll;
7 11607 systime(5,0.0,r);
7 11608 ll:= round r//100;<*ttmm*>
7 11609 opkaldskø.ref(4):= ll shift 12 +type shift 8 +operatør extract 8;
7 11610 opkaldskø.ref(5):= sig shift 20 + omr;
7 11611 tofrom(opkaldskø.ref.opkald_meldt,ingen_operatører,op_maske_lgd);
7 11612 res:= 0;
7 11613 if type=2 then nød_opkald_brugt:=nødopkald_brugt + 1;
7 11614 opkaldskø_ledige:= opkaldskø_ledige -1;
7 11615 <*meddel opkald til berørte operatører *>
7 11616 signal_bin(bs_mobil_opkald);
7 11617 tæl_opkald(omr,type+1);
7 11618 end <* resultat = 3 *>
6 11619 else
6 11620 begin
7 11621 \f
7 11621 message procedure indsæt_opkald side 3 - 810601/hko;
7 11622
7 11622 <* d.vt_op.resultat <> 3 *>
7 11623
7 11623 res:= d.vt_op.resultat;
7 11624 if res = 10 then
7 11625 fejlreaktion(20<*mobilopkald, bus *>,bus,
7 11626 <:er ikke i bustabel:>,1)
7 11627 else
7 11628 <*+4*> if res <> 14 and res <> 18 then
7 11629 fejlreaktion(19<*radio*>,res,<:busreservationsresultat:>,1);
7 11630 <*-4*>
7 11631 ;
7 11632 end;
6 11633 signalbin(bs_opkaldskø_adgang);
6 11634 signal_ch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
6 11635 end
5 11636 else
5 11637 res:= -2; <*timeout for cs_vt_adgang*>
5 11638 end;
4 11639 indsæt_opkald:= res;
4 11640 end indsæt_opkald;
3 11641 \f
3 11641 message procedure afvent_telegram side 1 - 880901/cl;
3 11642
3 11642 integer procedure afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 11643 integer array tlgr;
3 11644 integer lgd,ttyp,ptyp,pnum;
3 11645 begin
4 11646 integer i, pos, tegn, ac, sum, csum;
4 11647
4 11647 pos:= 1;
4 11648 lgd:= 0;
4 11649 ttyp:= 'Z';
4 11650 <*V*> ac:= afvent_radioinput(z_fr_in,tlgr,false);
4 11651 if ac >= 0 then
4 11652 begin
5 11653 lgd:= 1;
5 11654 while læstegn(tlgr,lgd,tegn)<>0 do ;
5 11655 lgd:= lgd-2;
5 11656 if lgd >= 3 then
5 11657 begin
6 11658 i:= 1;
6 11659 ttyp:= læstegn(tlgr,i,tegn);
6 11660 ptyp:= læstegn(tlgr,i,tegn) - '@';
6 11661 pnum:= læstegn(tlgr,i,tegn) - '@';
6 11662 end
5 11663 else ac:= 6; <* for kort telegram - retransmitter *>
5 11664 end;
4 11665
4 11665 afvent_telegram:= ac;
4 11666 end;
3 11667 \f
3 11667 message procedure b_answ side 1 - 880901/cl;
3 11668
3 11668 procedure b_answ(answ,ht,spec,more,ac);
3 11669 value ht, more,ac;
3 11670 integer array answ, spec;
3 11671 boolean more;
3 11672 integer ht, ac;
3 11673 begin
4 11674 integer pos, i, sum, tegn;
4 11675
4 11675 pos:= 1;
4 11676 skrivtegn(answ,pos,'B');
4 11677 skrivtegn(answ,pos,if more then 'B' else ' ');
4 11678 skrivtegn(answ,pos,ac+'@');
4 11679 skrivtegn(answ,pos,spec(1) shift (-18) extract 6+'@');
4 11680 skrivtegn(answ,pos,spec(1) shift (-12) extract 6+'@');
4 11681 skrivtegn(answ,pos,'@');
4 11682 skrivtegn(answ,pos,spec(1) shift (-8) extract 4+'@');
4 11683 skrivtegn(answ,pos,spec(1) extract 8+'@');
4 11684 for i:= 1 step 1 until spec(1) extract 8 do
4 11685 if spec(1+i)=0 then skrivtegn(answ,pos,'@')
4 11686 else
4 11687 begin
5 11688 skrivtegn(answ,pos,'D');
5 11689 anbringtal(answ,pos,spec(1+i),-4);
5 11690 end;
4 11691 for i:= 1 step 1 until 4 do
4 11692 skrivtegn(answ,pos,'@');
4 11693 skrivtegn(answ,pos,ht+'@');
4 11694 skrivtegn(answ,pos,'@');
4 11695
4 11695 i:= 1; sum:= 0;
4 11696 while i < pos do
4 11697 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
4 11698 skrivtegn(answ,pos,(sum shift (-4)) extract 4 + '@');
4 11699 skrivtegn(answ,pos,sum extract 4 + '@');
4 11700 repeat skrivtegn(answ,pos,0) until (pos mod 6)=1;
4 11701 end;
3 11702 \f
3 11702 message procedure ann_opkald side 1 - 881108/cl;
3 11703
3 11703 integer procedure ann_opkald(vogn,omr);
3 11704 value vogn,omr;
3 11705 integer vogn,omr;
3 11706 begin
4 11707 integer array field vt_op,ref,næste,forrige;
4 11708 integer res, t, i, o;
4 11709
4 11709 waitch(cs_vt_adgang,vt_op,true,-1);
4 11710 res:= -1;
4 11711 wait(bs_opkaldskø_adgang);
4 11712 ref:= første_nødopkald;
4 11713 if ref <> 0 then
4 11714 t:= 2
4 11715 else
4 11716 begin
5 11717 ref:= første_opkald;
5 11718 t:= if ref<>0 then 1 else 0;
5 11719 end;
4 11720
4 11720 if t=0 then
4 11721 res:= 19 <* kø tom *>
4 11722 else
4 11723 begin
5 11724 while ref<>0 and res=(-1) do
5 11725 begin
6 11726 if vogn=opkaldskø.ref(2) extract 14 and
6 11727 omr=opkaldskø.ref(5) extract 8
6 11728 then
6 11729 res:= 0
6 11730 else
6 11731 begin
7 11732 ref:= opkaldskø.ref(1) extract 12;
7 11733 if ref=0 and t=2 then
7 11734 begin
8 11735 ref:= første_opkald;
8 11736 t:= if ref=0 then 0 else 1;
8 11737 end;
7 11738 end;
6 11739 end; <*while*>
5 11740 \f
5 11740 message procedure ann_opkald side 2 - 881108/cl;
5 11741
5 11741 if ref<>0 then
5 11742 begin
6 11743 start_operation(vt_op,401,cs_radio_ind,17);
6 11744 d.vt_op.data(1):= vogn;
6 11745 d.vt_op.data(4):= omr;
6 11746 signalch(cs_vt,vt_op,gen_optype or vt_optype);
6 11747 waitch(cs_radio_ind,vt_op,vt_optype,-1);
6 11748
6 11748 o:= opkaldskø.ref(4) extract 8;
6 11749 næste:= opkaldskø.ref(1);
6 11750 forrige:= næste shift (-12);
6 11751 næste:= næste extract 12;
6 11752 if forrige<>0 then
6 11753 opkaldskø.forrige(1):= opkaldskø.forrige(1) shift (-12) shift 12
6 11754 + næste
6 11755 else
6 11756 if t=2 then første_nødopkald:= næste
6 11757 else første_opkald:= næste;
6 11758
6 11758 if næste<>0 then
6 11759 opkaldskø.næste(1):= opkaldskø.næste(1) extract 12
6 11760 + forrige shift 12
6 11761 else
6 11762 if t=2 then sidste_nødopkald:= forrige
6 11763 else sidste_opkald:= forrige;
6 11764
6 11764 opkaldskø.ref(1):= første_frie_opkald;
6 11765 første_frie_opkald:= ref;
6 11766 opkaldskø_ledige:= opkaldskø_ledige + 1;
6 11767 if t=2 then nødopkald_brugt:= nødopkald_brugt - 1;
6 11768
6 11768 if -, læsbit_ia(operatør_maske,o) or o=0 then
6 11769 tofrom(opkaldsflag,alle_operatører,op_maske_lgd)
6 11770 else
6 11771 begin
7 11772 sætbit_ia(opkaldsflag,o,1);
7 11773 end;
6 11774 signalbin(bs_mobilopkald);
6 11775 end;
5 11776 end;
4 11777
4 11777 signalbin(bs_opkaldskø_adgang);
4 11778 signalch(cs_vt_adgang, vt_op, true);
4 11779 ann_opkald:= res;
4 11780 end;
3 11781 \f
3 11781 message procedure frigiv_id side 1 - 881114/cl;
3 11782
3 11782 integer procedure frigiv_id(id,omr);
3 11783 value id,omr;
3 11784 integer id,omr;
3 11785 begin
4 11786 integer array field vt_op;
4 11787
4 11787 if id shift (-22) < 3 and omr > 2 then
4 11788 begin
5 11789 waitch(cs_vt_adgang,vt_op,true,-1);
5 11790 start_operation(vt_op,401,cs_radio_ind,
5 11791 if id shift (-22) = 2 then 18 else 17);
5 11792 d.vt_op.data(1):= id;
5 11793 d.vt_op.data(4):= omr;
5 11794 signalch(cs_vt,vt_op,vt_optype or gen_optype);
5 11795 waitch(cs_radio_ind,vt_op,vt_optype,-1);
5 11796 frigiv_id:= d.vt_op.resultat;
5 11797 signalch(cs_vt_adgang,vt_op,true);
5 11798 end;
4 11799 end;
3 11800 \f
3 11800 message procedure radio_ind side 2 - 810524/hko;
3 11801 trap(radio_ind_trap);
3 11802 laf:= 0;
3 11803 stack_claim((if cm_test then 200 else 150) +135+75);
3 11804
3 11804 <*+2*>if testbit32 and overvåget or testbit28 then
3 11805 skriv_radio_ind(out,0);
3 11806 <*-2*>
3 11807 answ.laf(1):= long<:<'nl'>:>;
3 11808 io_opref:= op;
3 11809
3 11809 repeat
3 11810 ac:= afvent_telegram(tlgr,lgd,ttyp,ptyp,pnum);
3 11811 pos:= 4;
3 11812 if ac = 0 then
3 11813 begin
4 11814 \f
4 11814 message procedure radio_ind side 3 - 881107/cl;
4 11815 if ttyp = 'A' then
4 11816 begin
5 11817 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 11818 ac:= 1
5 11819 else
5 11820 begin
6 11821 typ(1):= 1 shift 12 + (opkode - 1); <* eq shortint opgave *>
6 11822 val(1):= ttyp;
6 11823 typ(2):= 2 shift 12 + (data + 2); <* eq integer data(1) *>
6 11824 val(2):= pnum;
6 11825 typ(3):= -1;
6 11826 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 11827 if opref>0 then
6 11828 begin
7 11829 if læstegn(tlgr,pos,tegn)<>'@' <*BST*> or
7 11830 læstegn(tlgr,pos,tegn)<>'A' <*PET*> or
7 11831 læstegn(tlgr,pos,tegn)<>d.opref.data(2)+'@' <*CTYP*> or
7 11832 læstegn(tlgr,pos,tegn)<>'@' <*TNO*>
7 11833 then
7 11834 begin
8 11835 ac:= 1; d.opref.resultat:= 31; <* systemfejl *>
8 11836 end
7 11837 else
7 11838 begin
8 11839 ac:= 0;
8 11840 d.opref.resultat:= 0;
8 11841 sætbit_ia(hookoff_maske,pnum,1);
8 11842 end;
7 11843 signalch(d.opref.retur,opref,d.opref.optype);
7 11844 end
6 11845 else
6 11846 ac:= 2;
6 11847 end;
5 11848 pos:= 1;
5 11849 skrivtegn(answ,pos,'A');
5 11850 skrivtegn(answ,pos,' ');
5 11851 skrivtegn(answ,pos,ac+'@');
5 11852 for i:= 1 step 1 until 5 do
5 11853 skrivtegn(answ,pos,'@');
5 11854 skrivtegn(answ,pos,'0');
5 11855 i:= 1; sum:= 0;
5 11856 while i < pos do
5 11857 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 11858 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 11859 skrivtegn(answ,pos,sum extract 4 + '@');
5 11860 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 11861 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 11862 <*+2*> if (testbit36 or testbit38) and overvåget then
5 11863 disable begin
6 11864 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 11865 outchar(zrl,'nl');
6 11866 end;
5 11867 <*-2*>
5 11868 disable setposition(z_fr_out,0,0);
5 11869 ac:= -1;
5 11870 \f
5 11870 message procedure radio_ind side 4 - 881107/cl;
5 11871 end <* ttyp=A *>
4 11872 else
4 11873 if ttyp = 'B' then
4 11874 begin
5 11875 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 11876 ac:= 1
5 11877 else
5 11878 begin
6 11879 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'B';
6 11880 typ(2):= 2 shift 12 + (data+2); val(2):= pnum;
6 11881 typ(3):= -1;
6 11882 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 11883 if opref > 0 then
6 11884 begin
7 11885 <*+2*> if testbit37 and overvåget then
7 11886 disable begin
8 11887 skriv_radio_ind(out,0);
8 11888 write(out,<:radio-ind B-op udtaget fra cs:>,<<d>,cs_radio_ind);
8 11889 skriv_op(out,opref);
8 11890 end;
7 11891 <*-2*>
7 11892 læstegn(tlgr,pos,bs);
7 11893 if bs = 'V' then
7 11894 begin
8 11895 b_pt:= læstegn(tlgr,pos,tegn) - '@';
8 11896 b_pn:= læstegn(tlgr,pos,tegn) - '@';
8 11897 end;
7 11898 if bs<>'Z' and bs<>d.opref.data(2) or bs='V' and
7 11899 (b_pt<>d.opref.data(10) shift (-18) extract 6 or
7 11900 b_pn<>d.opref.data(10) shift (-12) extract 6)
7 11901 then
7 11902 begin
8 11903 ac:= 1;
8 11904 d.opref.resultat:= 31; <* systemfejl *>
8 11905 signalch(d.opref.retur,opref,d.opref.optype);
8 11906 end
7 11907 else
7 11908 if bs='V' then
7 11909 begin
8 11910 ac:= 0;
8 11911 d.opref.resultat:= 1;
8 11912 d.opref.data(4):= 0;
8 11913 d.opref.data(7):=
8 11914 1 shift (if b_pt=2 then pabx_id(b_pn) else
8 11915 radio_id(b_pn));
8 11916 systime(1,0.0,d.opref.tid);
8 11917 signalch(cs_radio_ind,opref,d.opref.optype);
8 11918 spec:= data+18;
8 11919 b_answ(answ,0,d.opref.spec,false,ac);
8 11920 <*+2*> if (testbit36 or testbit38) and overvåget then
8 11921 disable begin
9 11922 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
9 11923 outchar(zrl,'nl');
9 11924 end;
8 11925 <*-2*>
8 11926 write(z_fr_out,"nl",1,answ.laf,"cr",1);
8 11927 disable setposition(z_fr_out,0,0);
8 11928 ac:= -1;
8 11929 \f
8 11929 message procedure radio_ind side 5 - 881107/cl;
8 11930 end
7 11931 else
7 11932 begin
8 11933 integer sig_type;
8 11934
8 11934 ac:= 0;
8 11935 antal_spec:= d.opref.data(4);
8 11936 filref:= d.opref.data(5);
8 11937 spec:= d.opref.data(6);
8 11938 if antal_spec>0 then
8 11939 begin
9 11940 antal_spec:= antal_spec-1;
9 11941 if filref<>0 then
9 11942 begin
10 11943 læsfil(filref,1,zno);
10 11944 b_pt:= fil(zno).spec(1) shift (-12);
10 11945 sig_type:= fil(zno).spec(1) shift (-8) extract 4;
10 11946 b_answ(answ,d.opref.data(3),fil(zno).spec,
10 11947 antal_spec>0,ac);
10 11948 spec:= spec + (fil(zno).spec(1) extract 8 + 1)*2;
10 11949 end
9 11950 else
9 11951 begin
10 11952 b_pt:= d.opref.spec(1) shift (-12);
10 11953 sig_type:= d.opref.spec(1) shift (-8) extract 4;
10 11954 b_answ(answ,d.opref.data(3),d.opref.spec,
10 11955 antal_spec>0,ac);
10 11956 spec:= spec + d.opref.spec(1) extract 8*2 + 2;
10 11957 end;
9 11958
9 11958 <* send answer *>
9 11959 <*+2*> if (testbit36 or testbit38) and overvåget then
9 11960 disable begin
10 11961 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
10 11962 outchar(zrl,'nl');
10 11963 end;
9 11964 <*-2*>
9 11965 write(z_fr_out,"nl",1,answ.laf,"cr",1);
9 11966 disable setposition(z_fr_out,0,0);
9 11967 if ac<>0 then
9 11968 begin
10 11969 antal_spec:= 0;
10 11970 ac:= -1;
10 11971 end
9 11972 else
9 11973 begin
10 11974 for i:= 1 step 1 until max_antal_områder do
10 11975 if område_id(i,2)=b_pt then
10 11976 begin
11 11977 j:= (if b_pt=3 and sig_type=2 then 0 else i);
11 11978 if sætbiti(d.opref.data(7),j,1)=0 then
11 11979 d.opref.resultat:= d.opref.resultat + 1;
11 11980 end;
10 11981 end;
9 11982 end;
8 11983 \f
8 11983 message procedure radio_ind side 6 - 881107/cl;
8 11984
8 11984 <* afvent nyt telegram *>
8 11985 d.opref.data(4):= antal_spec;
8 11986 d.opref.data(6):= spec;
8 11987 ac:= -1;
8 11988 systime(1,0.0,d.opref.tid);
8 11989 <*+2*> if testbit37 and overvåget then
8 11990 disable begin
9 11991 skriv_radio_ind(out,0);
9 11992 write(out,<:radio-ind B-op retur på cs:>,<<d>,cs_radio_ind); skriv_op(out,opref);
9 11993 ud;
9 11994 end;
8 11995 <*-2*>
8 11996 signalch(cs_radio_ind,opref,d.opref.optype);
8 11997 end;
7 11998 end
6 11999 else ac:= 2;
6 12000 end;
5 12001 if ac > 0 then
5 12002 begin
6 12003 for i:= 1 step 1 until 6 do val(i):= 0;
6 12004 b_answ(answ,0,val,false,ac);
6 12005 <*+2*>
6 12006 if (testbit36 or testbit38) and overvåget then
6 12007 disable begin
7 12008 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12009 outchar(zrl,'nl');
7 12010 end;
6 12011 <*-2*>
6 12012 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12013 disable setposition(z_fr_out,0,0);
6 12014 ac:= -1;
6 12015 end;
5 12016 \f
5 12016 message procedure radio_ind side 7 - 881107/cl;
5 12017 end <* ttyp = 'B' *>
4 12018 else
4 12019 if ttyp='C' or ttyp='J' then
4 12020 begin
5 12021 if ptyp<>4 or pnum<1 or pnum>max_antal_taleveje then
5 12022 ac:= 1
5 12023 else
5 12024 begin
6 12025 typ(1):= 1 shift 12 + (opkode - 1); val(1):= 'B';
6 12026 typ(2):= 2 shift 12 + (data + 2); val(2):= pnum;
6 12027 typ(3):= -1;
6 12028 getch(cs_radio_ind,opref,rad_optype,typ,val);
6 12029 if opref > 0 then
6 12030 begin
7 12031 d.opref.resultat:= d.opref.resultat - 1;
7 12032 if ttyp = 'C' then
7 12033 begin
8 12034 b_pt:= læstegn(tlgr,4,tegn)-'@'; <* ????? *>
8 12035 b_pn:= læstegn(tlgr,5,tegn)-'@'; <* ????? *>
8 12036 j:= 0;
8 12037 for i:= 1 step 1 until max_antal_kanaler do
8 12038 if kanal_id(i)=b_pt shift 5 + b_pn then j:= i;
8 12039 if kanal_til_omr(j)=3 and d.opref.resultat>0 then
8 12040 d.opref.resultat:= d.opref.resultat-1;
8 12041 sætbiti(optaget_flag,j,1);
8 12042 sætbiti(d.opref.data(9),j,1);
8 12043 end
7 12044 else
7 12045 begin <* INGEN FORBINDELSE *>
8 12046 sætbiti(d.opref.data(8),læstegn(tlgr,4,tegn)-'@',1);
8 12047 end;
7 12048 ac:= 0;
7 12049 if d.opref.resultat<>0 or d.opref.data(4)<>0 then
7 12050 begin
8 12051 systime(1,0,d.opref.tid);
8 12052 signal_ch(cs_radio_ind,opref,d.opref.op_type);
8 12053 end
7 12054 else
7 12055 begin
8 12056 d.opref.resultat:= if d.opref.data(9)<>0 then 0 else
8 12057 if læsbiti(d.opref.data(8),9) then 52 else
8 12058 if læsbiti(d.opref.data(8),10) then 20 else
8 12059 if læsbiti(d.opref.data(8),2) then 52 else 59;
8 12060 signalch(d.opref.retur, opref, d.opref.optype);
8 12061 end;
7 12062 end
6 12063 else
6 12064 ac:= 2;
6 12065 end;
5 12066 pos:= 1;
5 12067 skrivtegn(answ,pos,ttyp);
5 12068 skrivtegn(answ,pos,' ');
5 12069 skrivtegn(answ,pos,ac+'@');
5 12070 i:= 1; sum:= 0;
5 12071 while i < pos do
5 12072 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12073 skrivtegn(answ,pos,sum shift (-4) + '@');
5 12074 skrivtegn(answ,pos,sum extract 4 + '@');
5 12075 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12076 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12077 disable begin
6 12078 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12079 outchar(zrl,'nl');
6 12080 end;
5 12081 <*-2*>
5 12082 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12083 disable setposition(z_fr_out,0,0);
5 12084 ac:= -1;
5 12085 \f
5 12085 message procedure radio_ind side 8 - 881107/cl;
5 12086 end <* ttyp = 'C' or 'J' *>
4 12087 else
4 12088 if ttyp = 'D' then
4 12089 begin
5 12090 if ptyp = 4 <* VDU *> then
5 12091 begin
6 12092 if pnum<1 or pnum>max_antal_taleveje then
6 12093 ac:= 1
6 12094 else
6 12095 begin
7 12096 inspect(bs_talevej_udkoblet(pnum),j);
7 12097 if j>=0 then
7 12098 begin
8 12099 sætbit_ia(samtaleflag,pnum,1);
8 12100 signal_bin(bs_mobil_opkald);
8 12101 end;
7 12102 if læsbit_ia(hookoff_maske,pnum) then
7 12103 signalbin(bs_talevej_udkoblet(pnum));
7 12104 ac:= 0;
7 12105 end
6 12106 end
5 12107 else
5 12108 if ptyp=3 or ptyp=2 then
5 12109 begin
6 12110 if ptyp=3 and (pnum<1 or max_antal_radiokanaler<pnum) or
6 12111 ptyp=2 and pnum<>2
6 12112 then
6 12113 ac:= 1
6 12114 else
6 12115 begin
7 12116 if læstegn(tlgr,5,tegn)='D' then
7 12117 begin <* teknisk nr i telegram *>
8 12118 b_pn:= 0;
8 12119 for i:= 1 step 1 until 4 do
8 12120 b_pn:= b_pn*10 + læstegn(tlgr,5+i,tegn)-'0';
8 12121 end
7 12122 else
7 12123 b_pn:= 0;
7 12124 b_pt:= port_til_omr(ptyp shift 6 + pnum);
7 12125 i:= 0;
7 12126 for j:= 1 step 1 until max_antal_kanaler do
7 12127 if kanal_id(j) = ptyp shift 5 + pnum then i:= j;
7 12128 if i<>0 then
7 12129 begin
8 12130 ref:= (i-1)*kanalbeskrlængde;
8 12131 inspect(ss_samtale_nedlagt(i),j);
8 12132 if j>=0 then
8 12133 begin
9 12134 sætbit_ia(samtaleflag,
9 12135 tv_operatør(kanal_tab.ref.kanal_tilstand shift (-16)),1);
9 12136 signalbin(bs_mobil_opkald);
9 12137 end;
8 12138 signal(ss_samtale_nedlagt(i));
8 12139 if b_pn<>0 then frigiv_id(b_pn,b_pt);
8 12140 begin
9 12141 if kanal_tab.ref.kanal_id1<>0 and
9 12142 (kanal_tab.ref.kanal_id1 shift (-22)<>0 or
9 12143 kanal_tab.ref.kanal_id1 extract 14<>b_pn) then
9 12144 frigiv_id(kanal_tab.ref.kanal_id1,b_pt);
9 12145 if kanal_tab.ref.kanal_id2<>0 and
9 12146 (kanal_tab.ref.kanal_id2 shift (-22)<>0 or
9 12147 kanal_tab.ref.kanal_id2 extract 14<>b_pn) then
9 12148 frigiv_id(kanal_tab.ref.kanal_id2,b_pt);
9 12149 end;
8 12150 sætbiti(optaget_flag,i,0);
8 12151 end;
7 12152 ac:= 0;
7 12153 end;
6 12154 end
5 12155 else ac:= 1;
5 12156 if ac>=0 then
5 12157 begin
6 12158 pos:= i:= 1; sum:= 0;
6 12159 skrivtegn(answ,pos,'D');
6 12160 skrivtegn(answ,pos,' ');
6 12161 skrivtegn(answ,pos,ac+'@');
6 12162 skrivtegn(answ,pos,'@');
6 12163 while i<pos do
6 12164 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
6 12165 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
6 12166 skrivtegn(answ,pos, sum extract 4 + '@');
6 12167 repeat afsluttext(answ,pos) until pos mod 6 = 1;
6 12168 <*+2*>
6 12169 if (testbit36 or testbit38) and overvåget then
6 12170 disable begin
7 12171 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
7 12172 outchar(zrl,'nl');
7 12173 end;
6 12174 <*-2*>
6 12175 write(z_fr_out,"nl",1,answ.laf,"cr",1);
6 12176 disable setposition(z_fr_out,0,0);
6 12177 ac:= -1;
6 12178 end;
5 12179 \f
5 12179 message procedure radio_ind side 9 - 881107/cl;
5 12180 end <* ttyp = D *>
4 12181 else
4 12182 if ttyp='H' then
4 12183 begin
5 12184 integer htyp;
5 12185
5 12185 htyp:= læstegn(tlgr,7+læstegn(tlgr,6,tegn)-'@',tegn);
5 12186
5 12186 if htyp='A' then
5 12187 begin <*mobilopkald*>
6 12188 if (ptyp=2 and pnum<>2) or (ptyp=3 and
6 12189 (pnum<1 or pnum>max_antal_radiokanaler)) then
6 12190 ac:= 1
6 12191 else
6 12192 begin
7 12193 b_pt:= læstegn(tlgr,5,tegn)-'@';
7 12194 if læstegn(tlgr,6,tegn)='D' then
7 12195 begin <*teknisk nr. i telegram*>
8 12196 b_pn:= 0;
8 12197 for i:= 1 step 1 until 4 do
8 12198 b_pn:= b_pn*10 + læstegn(tlgr,6+i,tegn)-'0';
8 12199 end
7 12200 else b_pn:= 0;
7 12201 bs:= læstegn(tlgr,9+læstegn(tlgr,6,tegn)-'@',tegn)-'@'+1;
7 12202 <* opkaldstype *>
7 12203 j:= (if ptyp=2 then pabx_id(pnum) else radio_id(pnum));
7 12204 if j>0 then
7 12205 begin
8 12206 if bs=10 then
8 12207 ann_opkald(b_pn,j)
8 12208 else
8 12209 indsæt_opkald(b_pn,bs,j,if b_pt>1 then 1 else 0);
8 12210 ac:= 0;
8 12211 end else ac:= 1;
7 12212 end;
6 12213 \f
6 12213 message procedure radio_ind side 10 - 881107/cl;
6 12214 end
5 12215 else
5 12216 if htyp='E' then
5 12217 begin <* radiokanal status *>
6 12218 long onavn;
6 12219
6 12219 ac:= 0;
6 12220 j:= 0;
6 12221 for i:= 1 step 1 until max_antal_kanaler do
6 12222 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12223
6 12223 <* Alarmer for K12 = GLX ignoreres *>
6 12224 <* 94.06.14/CL *>
6 12225 <* Alarmer for K15 = HG ignoreres *>
6 12226 <* 95.07.31/CL *>
6 12227 if j>0 then
6 12228 begin
7 12229 onavn:= områdenavn(port_til_omr(ptyp shift 6 + pnum));
7 12230 j:= (if (onavn = long<:GLX:>) or (onavn = long<:HG:>)
7 12231 then 0 else j);
7 12232 end;
6 12233
6 12233 læstegn(tlgr,9,tegn);
6 12234 if j<>0 and (tegn='A' or tegn='E') then
6 12235 begin
7 12236 ref:= (j-1)*kanalbeskrlængde;
7 12237 bs:= if tegn='E' then 0 else 15;
7 12238 if bs<>sæt_hex_ciffer(kanal_tab.ref,3,bs) then
7 12239 begin
8 12240 tofrom(kanalflag,alle_operatører,op_maske_lgd);
8 12241 signalbin(bs_mobil_opkald);
8 12242 end;
7 12243 end;
6 12244 if tegn<>'A' and tegn<>'E' and j<>0 then
6 12245 begin
7 12246 waitch(cs_radio_pulje,opref,true,-1);
7 12247 startoperation(opref,401,cs_radio_pulje,23);
7 12248 i:= 1;
7 12249 hægtstring(d.opref.data,i,<:radiofejl :>);
7 12250 if læstegn(tlgr,4,k)<>'@' then
7 12251 begin
8 12252 if k-'@' = 17 then
8 12253 hægtstring(d.opref.data,i,<: AMV:>)
8 12254 else
8 12255 if k-'@' = 18 then
8 12256 hægtstring(d.opref.data,i,<: BHV:>)
8 12257 else
8 12258 begin
9 12259 hægtstring(d.opref.data,i,<: BST:>);
9 12260 anbringtal(d.opref.data,i,k-'@',1);
9 12261 end;
8 12262 end;
7 12263 skrivtegn(d.opref.data,i,' ');
7 12264 hægtstring(d.opref.data,i,string kanal_navn(j));
7 12265 skrivtegn(d.opref.data,i,' ');
7 12266 hægtstring(d.opref.data,i,
7 12267 string område_navn(kanal_til_omr(j)));
7 12268 if '@'<=tegn and tegn<='F' then
7 12269 hægtstring(d.opref.data,i,case (tegn-'@'+1) of (
7 12270 <*@*> <:: ukendt fejl:>,
7 12271 <*A*> <:: compad-fejl:>,
7 12272 <*B*> <:: ladefejl:>,
7 12273 <*C*> <:: dør åben:>,
7 12274 <*D*> <:: senderfejl:>,
7 12275 <*E*> <:: compad ok:>,
7 12276 <*F*> <:: liniefejl:>,
7 12277 <::>))
7 12278 else
7 12279 begin
8 12280 hægtstring(d.opref.data,i,<:: fejlkode :>);
8 12281 skrivtegn(d.opref.data,i,tegn);
8 12282 end;
7 12283 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
7 12284 signalch(cs_io,opref,gen_optype or rad_optype);
7 12285 ref:= (j-1)*kanalbeskrlængde;
7 12286 tofrom(kanal_tab.ref.kanal_alarm,alle_operatører,op_maske_lgd);
7 12287 tofrom(kanalflag,alle_operatører,op_maske_lgd);
7 12288 signalbin(bs_mobilopkald);
7 12289 end;
6 12290 \f
6 12290 message procedure radio_ind side 11 - 881107/cl;
6 12291 end
5 12292 else
5 12293 if htyp='G' then
5 12294 begin <* fjerninkludering/-ekskludering af område *>
6 12295 bs:= læstegn(tlgr,9,tegn)-'@';
6 12296 j:= 0;
6 12297 for i:= 1 step 1 until max_antal_kanaler do
6 12298 if kanal_id(i) = ptyp shift 5 + pnum then j:= i;
6 12299 if j<>0 then
6 12300 begin
7 12301 ref:= (j-1)*kanalbeskrlængde;
7 12302 sætbiti(kanal_tab.ref.kanal_tilstand,11,bs extract 1);
7 12303 end;
6 12304 tofrom(kanalflag,alle_operatører,op_maske_lgd);
6 12305 signalbin(bs_mobilopkald);
6 12306 ac:= 0;
6 12307 end
5 12308 else
5 12309 if htyp='L' then
5 12310 begin <* vogntabelændringer *>
6 12311 long field ll;
6 12312
6 12312 ll:= 10;
6 12313 ac:= 0;
6 12314 zno:= port_til_omr(ptyp shift 6 + pnum);
6 12315 læstegn(tlgr,9,tegn);
6 12316 if (tegn='N') or (tegn='O') then
6 12317 begin
7 12318 typ(1):= 1 shift 12 + (opkode-1); val(1):= 'H';
7 12319 typ(2):= -1;
7 12320 getch(cs_radio_ind,opref,rad_optype,typ,val);
7 12321 if opref>0 then
7 12322 begin
8 12323 d.opref.resultat:= if tegn='N' then 3 else 60;
8 12324 signalch(d.opref.retur,opref,d.opref.optype);
8 12325 end;
7 12326 ac:= -1;
7 12327 end
6 12328 else
6 12329 if (tegn='G') and (tlgr.ll=(long<:FFFFF:> add 'F')) then
6 12330 ac:= -1
6 12331 else
6 12332 if tegn='G' then <*indkodning*>
6 12333 begin
7 12334 pos:= 10; i:= 0;
7 12335 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12336 i:= i*10 + (tegn-'0');
7 12337 i:= i mod 1000;
7 12338 b_pn:= (1 shift 22) + (i shift 12);
7 12339 if pos=14 and 'A'<=tegn and tegn<='Å' then
7 12340 b_pn:= b_pn + ((tegn-'@') shift 7);
7 12341 pos:= 14; i:= 0;
7 12342 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=16 do
7 12343 i:= i*10 + (tegn-'0');
7 12344 b_pn:= b_pn + i;
7 12345 pos:= 16; i:= 0;
7 12346 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=20 do
7 12347 i:= i*10 + (tegn-'0');
7 12348 b_pt:= i;
7 12349 bs:= 11;
7 12350 \f
7 12350 message procedure radio_ind side 12 - 881107/cl;
7 12351 end
6 12352 else
6 12353 if tegn='H' then <*udkodning*>
6 12354 begin
7 12355 pos:= 10; i:= 0;
7 12356 while læstegn(tlgr,pos,tegn)>='0' and tegn<='9' and pos<=14 do
7 12357 i:= i*10 + (tegn-'0');
7 12358 b_pt:= i;
7 12359 b_pn:= 0;
7 12360 bs:= 12;
7 12361 end
6 12362 else
6 12363 if tegn='I' then <*slet tabel*>
6 12364 begin
7 12365 b_pt:= 1; b_pn:= 999; bs:= 19;
7 12366 pos:= 10; i:= 0;
7 12367 i:= hex_to_dec(læstegn(tlgr,pos,tegn))*16 +
7 12368 hex_to_dec(læstegn(tlgr,pos,tegn));
7 12369 zno:= i;
7 12370 end
6 12371 else ac:= 2;
6 12372 if ac<0 then
6 12373 ac:= 0
6 12374 else
6 12375
6 12375 if ac=0 then
6 12376 begin
7 12377 waitch(cs_vt_adgang,opref,true,-1);
7 12378 startoperation(opref,401,cs_vt_adgang,bs);
7 12379 d.opref.data(1):= b_pt;
7 12380 d.opref.data(2):= b_pn;
7 12381 d.opref.data(if bs=19 then 3 else 4):= zno;
7 12382 signalch(cs_vt,opref,gen_optype or vt_optype);
7 12383 end;
6 12384 end
5 12385 else
5 12386 ac:= 2;
5 12387
5 12387 pos:= 1;
5 12388 skrivtegn(answ,pos,'H');
5 12389 skrivtegn(answ,pos,' ');
5 12390 skrivtegn(answ,pos,ac+'@');
5 12391 i:= 1; sum:= 0;
5 12392 while i < pos do
5 12393 sum:= (sum + læstegn(answ,i,tegn)) mod 256;
5 12394 skriv_tegn(answ,pos, sum shift (-4) extract 4 +'@');
5 12395 skriv_tegn(answ,pos, sum extract 4 +'@');
5 12396 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12397 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12398 disable begin
6 12399 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12400 outchar(zrl,'nl');
6 12401 end;
5 12402 <*-2*>
5 12403 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12404 disable setposition(z_fr_out,0,0);
5 12405 ac:= -1;
5 12406 \f
5 12406 message procedure radio_ind side 13 - 881107/cl;
5 12407 end
4 12408 else
4 12409 if ttyp = 'I' then
4 12410 begin
5 12411 typ(1):= -1;
5 12412 repeat
5 12413 getch(cs_radio_ind,opref,true,typ,val);
5 12414 if opref<>0 then
5 12415 begin
6 12416 d.opref.resultat:= 31;
6 12417 signalch(d.opref.retur,opref,d.opref.op_type);
6 12418 end;
5 12419 until opref=0;
5 12420 for i:= 1 step 1 until max_antal_taleveje do
5 12421 if læsbit_ia(hookoff_maske,i) then
5 12422 begin
6 12423 signalbin(bs_talevej_udkoblet(i));
6 12424 sætbit_ia(samtaleflag,tv_operatør(i),1);
6 12425 end;
5 12426 if antal_bits_ia(samtaleflag,1,max_antal_operatører)<>0 then
5 12427 signal_bin(bs_mobil_opkald);
5 12428 for i:= 1 step 1 until max_antal_kanaler do
5 12429 begin
6 12430 ref:= (i-1)*kanalbeskrlængde;
6 12431 if kanal_tab.ref.kanal_tilstand extract 2 <> 0 then
6 12432 begin
7 12433 if kanal_tab.ref.kanal_id2<>0 and
7 12434 kanal_tab.ref.kanal_id2 shift (-22)<>3
7 12435 then
7 12436 begin
8 12437 signal(ss_samtale_nedlagt(i));
8 12438 frigiv_id(kanal_tab.ref.kanal_id2,kanal_til_omr(i));
8 12439 end;
7 12440 if kanal_tab.ref.kanal_id1<>0 then
7 12441 begin
8 12442 signal(ss_samtale_nedlagt(i));
8 12443 frigiv_id(kanal_tab.ref.kanal_id1,kanal_til_omr(i));
8 12444 end;
7 12445 end;
6 12446 sæt_hex_ciffer(kanal_tab.ref,3,15);
6 12447 end;
5 12448 <*V*> waitch(cs_radio_pulje,opref,true,-1);
5 12449 startoperation(opref,401,cs_radio_pulje,23);
5 12450 i:= 1;
5 12451 hægtstring(d.opref.data,i,<:radio-info: :>);
5 12452 j:= 4;
5 12453 while j<=lgd and i<(d.opref.opsize - data - 2)//2*3 do
5 12454 begin
6 12455 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
6 12456 end;
5 12457 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
5 12458 signalch(cs_io,opref,gen_optype or rad_optype);
5 12459 optaget_flag:= 0;
5 12460 pos:= i:= 1; sum:= 0;
5 12461 skrivtegn(answ,pos,'I');
5 12462 skrivtegn(answ,pos,' ');
5 12463 skrivtegn(answ,pos,'@');
5 12464 while i<pos do
5 12465 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
5 12466 skrivtegn(answ,pos,sum shift (-4) extract 4 + '@');
5 12467 skrivtegn(answ,pos,sum extract 4 + '@');
5 12468 repeat afsluttext(answ,pos) until pos mod 6 = 1;
5 12469 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12470 disable begin
6 12471 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12472 outchar(zrl,'nl');
6 12473 end;
5 12474 <*-2*>
5 12475 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12476 disable setposition(z_fr_out,0,0);
5 12477 ac:= -1;
5 12478 \f
5 12478 message procedure radio_ind side 14 - 881107/cl;
5 12479 end
4 12480 else
4 12481 if ttyp='L' then
4 12482 begin
5 12483 ac:= 0;
5 12484 <****** RADIO-INFO meddelelser til hovedkonsol afhængig af testbi21 ******>
5 12485 if testbit21 then
5 12486 begin
6 12487 waitch(cs_radio_pulje,opref,true,-1);
6 12488 startoperation(opref,401,cs_radio_pulje,23);
6 12489 i:= 1;
6 12490 hægtstring(d.opref.data,i,<:radio-info: :>);
6 12491 j:= 4;
6 12492 while j<=lgd and i<(d.opref.opsize-data-2)//2*3 do
6 12493 begin
7 12494 skrivtegn(d.opref.data,i,læstegn(tlgr,j,tegn));
7 12495 end;
6 12496 repeat afsluttext(d.opref.data,i) until i mod 6 = 1;
6 12497 signalch(cs_io,opref,gen_optype or rad_optype);
6 12498 end; <*testbit21*>
5 12499 end
4 12500 else
4 12501 if ttyp='Z' then
4 12502 begin
5 12503 <*+2*> if (testbit36 or testbit38) and overvåget then
5 12504 disable begin
6 12505 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
6 12506 outchar(zrl,'nl');
6 12507 end;
5 12508 <*-2*>
5 12509 write(z_fr_out,"nl",1,answ.laf,"cr",1);
5 12510 disable setposition(z_fr_out,0,0);
5 12511 ac:= -1;
5 12512 end
4 12513 else
4 12514 ac:= 1;
4 12515 end; <* telegram modtaget ok *>
3 12516 \f
3 12516 message procedure radio_ind side 15 - 881107/cl;
3 12517 if ac>=0 then
3 12518 begin
4 12519 pos:= i:= 1; sum:= 0;
4 12520 skrivtegn(answ,pos,ttyp);
4 12521 skrivtegn(answ,pos,' ');
4 12522 skrivtegn(answ,pos,ac+'@');
4 12523 while i<pos do
4 12524 sum:= (sum+læstegn(answ,i,tegn)) mod 256;
4 12525 skrivtegn(answ,pos, sum shift (-4) extract 4 + '@');
4 12526 skrivtegn(answ,pos, sum extract 4 + '@');
4 12527 repeat afsluttext(answ,pos) until pos mod 6 = 1;
4 12528 <*+2*> if (testbit36 or testbit38) and overvåget then
4 12529 disable begin
5 12530 write(zrl,<<zd dd dd.dd >,now,<:fr-answ: :>,answ.laf);
5 12531 outchar(zrl,'nl');
5 12532 end;
4 12533 <*-2*>
4 12534 write(z_fr_out,"nl",1,answ.laf,"cr",1);
4 12535 disable setposition(z_fr_out,0,0);
4 12536 ac:= -1;
4 12537 end;
3 12538
3 12538 typ(1):= 0;
3 12539 typ(2):= 1 shift 18 + 4 shift 12 + tid; <* lt real tid *>
3 12540 rf:= 4;
3 12541 systime(1,0.0,val.rf);
3 12542 val.rf:= val.rf - 30.0;
3 12543 typ(3):= -1;
3 12544 repeat
3 12545 getch(cs_radio_ind,opref,true,typ,val);
3 12546 if opref>0 then
3 12547 begin
4 12548 d.opref.resultat:= 53; <*annuleret*>
4 12549 signalch(d.opref.retur,opref,d.opref.optype);
4 12550 end;
3 12551 until opref=0;
3 12552
3 12552 until false;
3 12553
3 12553 radio_ind_trap:
3 12554
3 12554 disable skriv_radio_ind(zbillede,1);
3 12555
3 12555 end radio_ind;
2 12556 \f
2 12556 message procedure radio_ud side 1 - 820301/hko;
2 12557
2 12557 procedure radio_ud(op);
2 12558 value op;
2 12559 integer op;
2 12560 begin
3 12561 integer array field opref,io_opref;
3 12562 integer opgave, kode, pos, tegn, i, sum, rc, svar_status;
3 12563 integer array answ, tlgr(1:32);
3 12564 long array field laf;
3 12565
3 12565 procedure skriv_radio_ud(z,omfang);
3 12566 value omfang;
3 12567 zone z;
3 12568 integer omfang;
3 12569 begin integer i1;
4 12570 disable i1:= write(z,"nl",1,<:+++ radio-ud ::>);
4 12571 if omfang > 0 then
4 12572 disable begin real x; long array field tx;
5 12573 tx:= 0;
5 12574 trap(slut);
5 12575 write(z,"nl",1,
5 12576 <: opref: :>,opref,"nl",1,
5 12577 <: io-opref: :>,io_opref,"nl",1,
5 12578 <: opgave: :>,opgave,"nl",1,
5 12579 <: kode: :>,kode,"nl",1,
5 12580 <: pos: :>,pos,"nl",1,
5 12581 <: tegn: :>,tegn,"nl",1,
5 12582 <: i: :>,i,"nl",1,
5 12583 <: sum: :>,sum,"nl",1,
5 12584 <: rc: :>,rc,"nl",1,
5 12585 <: svar-status: :>,svar_status,"nl",1,
5 12586 <: tlgr: ":>,tlgr.tx,<:":>,"nl",1,
5 12587 <: answ: ":>,answ.tx,<:":>,"nl",1,
5 12588 <::>);
5 12589 skriv_coru(z,coru_no(402));
5 12590 slut:
5 12591 end; <*disable*>
4 12592 end skriv_radio_ud;
3 12593
3 12593 trap(radio_ud_trap);
3 12594 laf:= 0;
3 12595 stack_claim((if cm_test then 200 else 150) +35+100);
3 12596
3 12596 <*+2*>if testbit32 and overvåget or testbit28 then
3 12597 skriv_radio_ud(out,0);
3 12598 <*-2*>
3 12599
3 12599 io_opref:= op;
3 12600 \f
3 12600 message procedure radio_ud side 2 - 810529/hko;
3 12601
3 12601 repeat
3 12602
3 12602 <*V*> wait_ch(cs_radio_ud,op_ref,gen_optype or rad_optype,-1);
3 12603 kode:= d.op_ref.opkode;
3 12604 opgave:= kode shift(-12);
3 12605 kode:= kode extract 12;
3 12606 if opgave < 'A' or opgave > 'I' then
3 12607 begin
4 12608 d.opref.resultat:= 31;
4 12609 end
3 12610 else
3 12611 begin
4 12612 pos:= 1;
4 12613 if opgave='A' or opgave='B' or opgave='D' or opgave='H' then
4 12614 begin
5 12615 skrivtegn(tlgr,pos,opgave);
5 12616 if d.opref.data(1) = 0 then
5 12617 begin
6 12618 skrivtegn(tlgr,pos,'G');
6 12619 skrivtegn(tlgr,pos,'A');
6 12620 end
5 12621 else
5 12622 begin
6 12623 skrivtegn(tlgr,pos,'D');
6 12624 skrivtegn(tlgr,pos,d.opref.data(1)+'@'); <*talevejsnr*>
6 12625 end;
5 12626 if opgave='A' then
5 12627 begin
6 12628 skrivtegn(tlgr,pos,d.opref.data(2)+'@'); <*calltype*>
6 12629 end
5 12630 else
5 12631 if opgave='B' then
5 12632 begin
6 12633 skrivtegn(tlgr,pos,d.opref.data(2));
6 12634 if d.opref.data(2)='V' then
6 12635 begin
7 12636 skrivtegn(tlgr,pos,
7 12637 d.opref.data(10) shift (-18) extract 6+'@'); <*trunktype*>
7 12638 skrivtegn(tlgr,pos,
7 12639 d.opref.data(10) shift (-12) extract 6+'@'); <*trunknum.*>
7 12640 end;
6 12641 d.opref.data(7):= d.opref.data(8):= d.opref.data(9):= 0;
6 12642 d.opref.data(6):= if d.opref.data(5)<>0 then 2 else data+18;
6 12643 end
5 12644 else
5 12645 if opgave='H' then
5 12646 begin
6 12647 skrivtegn(tlgr,pos,d.opref.data(3)+'@'); <*trunktype*>
6 12648 skrivtegn(tlgr,pos,d.opref.data(4)+'@'); <*trunknum.*>
6 12649 hægtstring(tlgr,pos,<:@@@:>);
6 12650 skrivtegn(tlgr,pos,d.opref.data(2)); <*H_tlgr_type*>
6 12651 skrivtegn(tlgr,pos,'A');
6 12652 skrivtegn(tlgr,pos,(if d.opref.data(2)='L' and
6 12653 d.opref.data(5)=8 then 7 else d.opref.data(5))+'@');
6 12654 if d.opref.data(2)='L' then
6 12655 begin
7 12656 if d.opref.data(5)=7 then
7 12657 begin
8 12658 anbringtal(tlgr,pos,
8 12659 d.opref.data(8) shift (-12) extract 10,-4);
8 12660 anbringtal(tlgr,pos,
8 12661 d.opref.data(8) extract 7,-2);
8 12662 end
7 12663 else
7 12664 if d.opref.data(5)=8 then
7 12665 begin
8 12666 hægtstring(tlgr,pos,<:FFFFFF:>);
8 12667 end;
7 12668 if d.opref.data(5)<>9 then
7 12669 anbringtal(tlgr,pos,d.opref.data(7),-4);
7 12670 skrivtegn(tlgr,pos,
7 12671 dec_to_hex(d.opref.data(6) shift (-4) extract 4));
7 12672 skrivtegn(tlgr,pos,
7 12673 dec_to_hex(d.opref.data(6) extract 4));
7 12674 skrivtegn(tlgr,10,pos-11+'@');
7 12675 end;
6 12676 end;
5 12677 end
4 12678 else
4 12679 if opgave='I' then
4 12680 begin
5 12681 hægtstring(tlgr,pos,<:IGA:>);
5 12682 end
4 12683 else d.opref.resultat:= 31; <*systemfejl*>
4 12684 end;
3 12685 \f
3 12685 message procedure radio_ud side 3 - 881107/cl;
3 12686
3 12686 if d.opref.resultat=0 then
3 12687 begin
4 12688 if (opgave <= 'B')
4 12689 <* or (opgave='H' and d.opref.data(2)='L') *> then
4 12690 begin
5 12691 systime(1,0,d.opref.tid);
5 12692 signalch(cs_radio_ind,opref,d.opref.optype);
5 12693 opref:= 0;
5 12694 end;
4 12695 <* beregn checksum og send *>
4 12696 i:= 1; sum:= 0;
4 12697 while i < pos do
4 12698 sum:= (sum + læstegn(tlgr,i,tegn)) mod 256;
4 12699 skrivtegn(tlgr,pos,sum shift (-4) + '@');
4 12700 skrivtegn(tlgr,pos,sum extract 4 + '@');
4 12701 repeat skrivtegn(tlgr,pos,0) until pos mod 6 = 1;
4 12702 <**********************************************>
4 12703 <* specialaktion p.g.a. modtagebesvær i COMET *>
4 12704
4 12704 if opgave='B' then delay(1);
4 12705
4 12705 <* 94.04.19/cl *>
4 12706 <**********************************************>
4 12707
4 12707 <*+2*> if (testbit36 or testbit39) and overvåget then
4 12708 disable begin
5 12709 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,tlgr.laf);
5 12710 outchar(zrl,'nl');
5 12711 end;
4 12712 <*-2*>
4 12713 setposition(z_rf_in,0,0);
4 12714 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
4 12715 disable setposition(z_rf_out,0,0);
4 12716 rc:= 0;
4 12717
4 12717 <* afvent svar*>
4 12718 repeat
4 12719 <*V*> svar_status:= afvent_radioinput(z_rf_in,answ,true);
4 12720 if svar_status=6 then
4 12721 begin
5 12722 svar_status:= -3;
5 12723 goto radio_ud_check;
5 12724 end;
4 12725 pos:= 1;
4 12726 while læstegn(answ,pos,i)<>0 do ;
4 12727 pos:= pos-2;
4 12728 if pos > 0 then
4 12729 begin
5 12730 if pos<3 then
5 12731 svar_status:= -2 <*format error*>
5 12732 else
5 12733 begin
6 12734 if læstegn(answ,3,tegn)<>'@' then
6 12735 svar_status:= tegn - '@'
6 12736 else
6 12737 begin
7 12738 pos:= 1;
7 12739 læstegn(answ,pos,tegn);
7 12740 if tegn<>opgave then
7 12741 svar_status:= -4 <*gal type*>
7 12742 else
7 12743 if læstegn(answ,pos,tegn)<>' ' then
7 12744 svar_status:= -tegn <*fejl*>
7 12745 else
7 12746 svar_status:= læstegn(answ,pos,tegn)-'@';
7 12747 end;
6 12748 end;
5 12749 end
4 12750 else
4 12751 svar_status:= -1;
4 12752 \f
4 12752 message procedure radio_ud side 5 - 881107/cl;
4 12753
4 12753 radio_ud_check:
4 12754 rc:= rc+1;
4 12755 if -3<=svar_status and svar_status< -1 then
4 12756 disable begin
5 12757 write(z_rf_out,<:<'nl'>Z@@MJ<'cr'>:>);
5 12758 setposition(z_rf_out,0,0);
5 12759 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12760 begin
6 12761 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: Z@@MJ:>);
6 12762 outchar(zrl,'nl');
6 12763 end;
5 12764 <*-2*>
5 12765 end
4 12766 else
4 12767 if svar_status=6 or svar_status=(-4) or svar_status=(-1) then
4 12768 disable begin
5 12769 write(z_rf_out,"nl",1,tlgr.laf,"cr",1);
5 12770 setposition(z_rf_out,0,0);
5 12771 <*+2*> if (testbit36 or testbit39) and overvåget then
5 12772 begin
6 12773 write(zrl,<<zd dd dd.dd >,now,<:rf-tlgr: :>,
6 12774 tlgr.laf,<: (repeat):>); outchar(zrl,'nl');
6 12775 end;
5 12776 <*-2*>
5 12777 end
4 12778 else
4 12779 if svar_status=0 and opref<>0 then
4 12780 d.opref.resultat:= 0
4 12781 else
4 12782 if opref<>0 then
4 12783 d.opref.resultat:= 31;
4 12784 until svar_status=0 or rc>3;
4 12785 end;
3 12786 if opref<>0 then
3 12787 begin
4 12788 if svar_status<>0 and rc>3 then
4 12789 d.opref.resultat:= 53; <* annulleret *>
4 12790 signalch(d.opref.retur,opref,d.opref.optype);
4 12791 opref:= 0;
4 12792 end;
3 12793 until false;
3 12794
3 12794 radio_ud_trap:
3 12795
3 12795 disable skriv_radio_ud(zbillede,1);
3 12796
3 12796 end radio_ud;
2 12797 \f
2 12797 message procedure radio_medd_opkald side 1 - 810610/hko;
2 12798
2 12798 procedure radio_medd_opkald;
2 12799 begin
3 12800 integer array field ref,op_ref;
3 12801 integer i;
3 12802
3 12802 procedure skriv_radio_medd_opkald(z,omfang);
3 12803 value omfang;
3 12804 zone z;
3 12805 integer omfang;
3 12806 begin integer x;
4 12807 disable x:= write(z,"nl",1,<:+++ radio-medd-opkald:>);
4 12808 write(z,"sp",26-x);
4 12809 if omfang > 0 then
4 12810 disable begin
5 12811 trap(slut);
5 12812 write(z,"nl",1,
5 12813 <: ref: :>,ref,"nl",1,
5 12814 <: opref: :>,op_ref,"nl",1,
5 12815 <: i: :>,i,"nl",1,
5 12816 <::>);
5 12817 skriv_coru(z,abs curr_coruno);
5 12818 slut:
5 12819 end;<*disable*>
4 12820 end skriv_radio_medd_opkald;
3 12821
3 12821 trap(radio_medd_opkald_trap);
3 12822
3 12822 stack_claim((if cm_test then 200 else 150) +1);
3 12823
3 12823 <*+2*>if testbit32 and overvåget or testbit28 then
3 12824 disable skriv_radio_medd_opkald(out,0);
3 12825 <*-2*>
3 12826 \f
3 12826 message procedure radio_medd_opkald side 2 - 820301/hko;
3 12827
3 12827 repeat
3 12828
3 12828 <*V*> wait(bs_mobil_opkald);
3 12829 <*V*> wait_ch(cs_radio_medd,op_ref,genoptype or rad_optype,-1);
3 12830 <*V*> wait(bs_opkaldskø_adgang);
3 12831
3 12831 ref:= første_nød_opkald;
3 12832 while ref <> 0 do <* meld ikke meldt nødopkald til io *>
3 12833 begin
4 12834 i:= opkaldskø.ref(2);
4 12835 if i < 0 then
4 12836 begin
5 12837 <* nødopkald ikke meldt *>
5 12838
5 12838 start_operation(op_ref,403,cs_radio_medd,45<*nødop.modt.*>);
5 12839 d.op_ref.data(1):= <* vogn_id *>
5 12840 if opkaldskø.ref(3)<>0 then opkaldskø.ref(3) else i extract 22;
5 12841 opkaldskø.ref(2):= i extract 22;
5 12842 d.op_ref.data(2):= opkaldskø.ref(4) shift(-12); <* ttmm *>
5 12843 d.op_ref.data(3):= opkaldskø.ref(5) extract 20;
5 12844 i:= op_ref;
5 12845 <*+2*> if testbit35 and overvåget then
5 12846 disable begin
6 12847 write(out,"nl",1,<:radio nød-medd:>);
6 12848 skriv_op(out,op_ref);
6 12849 ud;
6 12850 end;
5 12851 <*-2*>
5 12852 signal_ch(cs_io,op_ref,gen_optype or rad_optype);
5 12853 <*V*> wait_ch(cs_radio_medd,op_ref,rad_optype,-1);
5 12854 <*+4*> if i <> op_ref then
5 12855 fejlreaktion(11<*fremmed post*>,i,<:radio io/medd:>,0);
5 12856 <*-4*>
5 12857 end;<*nødopkald ikke meldt*>
4 12858
4 12858 ref:= opkaldskø.ref(1) extract 12;
4 12859 end; <* melding til io *>
3 12860 \f
3 12860 message procedure radio_medd_opkald side 3 - 820304/hko;
3 12861
3 12861 start_operation(op_ref,403,cs_radio_medd,
3 12862 40<*opdater opkaldskøbill*>);
3 12863 signal_bin(bs_opkaldskø_adgang);
3 12864 <*+2*> if testbit35 and overvåget then
3 12865 disable begin
4 12866 write(out,"nl",1,<:radio opdater opkaldskø-billede:>);
4 12867 skriv_op(out,op_ref);
4 12868 write(out, <:opkaldsflag: :>,"nl",1);
4 12869 outintbits_ia(out,opkaldsflag,1,op_maske_lgd//2);
4 12870 write(out,"nl",1,<:kanalflag: :>,"nl",1);
4 12871 outintbits_ia(out,kanalflag,1,op_maske_lgd//2);
4 12872 write(out,"nl",1,<:samtaleflag: :>,"nl",1);
4 12873 outintbits_ia(out,samtaleflag,1,op_maske_lgd//2);
4 12874 ud;
4 12875 end;
3 12876 <*-2*>
3 12877 signal_ch(cs_op,op_ref,gen_optype or rad_optype);
3 12878
3 12878 until false;
3 12879
3 12879 radio_medd_opkald_trap:
3 12880
3 12880 disable skriv_radio_medd_opkald(zbillede,1);
3 12881
3 12881 end radio_medd_opkald;
2 12882 \f
2 12882 message procedure radio_adm side 1 - 820301/hko;
2 12883
2 12883 procedure radio_adm(op);
2 12884 value op;
2 12885 integer op;
2 12886 begin
3 12887 integer array field opref, rad_op, iaf;
3 12888 integer nr,i,j,k,res,opgave,tilst,operatør;
3 12889
3 12889 procedure skriv_radio_adm(z,omfang);
3 12890 value omfang;
3 12891 zone z;
3 12892 integer omfang;
3 12893 begin integer i1;
4 12894 disable i1:= write(z,"nl",1,<:+++ radio-adm:>);
4 12895 write(z,"sp",26-i1);
4 12896 if omfang > 0 then
4 12897 disable begin real x;
5 12898 trap(slut);
5 12899 \f
5 12899 message procedure radio_adm side 2- 820301/hko;
5 12900
5 12900 write(z,"nl",1,
5 12901 <: op_ref: :>,op_ref,"nl",1,
5 12902 <: iaf: :>,iaf,"nl",1,
5 12903 <: rad-op: :>,rad_op,"nl",1,
5 12904 <: nr: :>,nr,"nl",1,
5 12905 <: i: :>,i,"nl",1,
5 12906 <: j: :>,j,"nl",1,
5 12907 <: k: :>,k,"nl",1,
5 12908 <: tilst: :>,tilst,"nl",1,
5 12909 <: res: :>,res,"nl",1,
5 12910 <: opgave: :>,opgave,"nl",1,
5 12911 <: operatør: :>,operatør,"nl",1);
5 12912 skriv_coru(z,coru_no(404));
5 12913 slut:
5 12914 end;<*disable*>
4 12915 end skriv_radio_adm;
3 12916 \f
3 12916 message procedure radio_adm side 3 - 820304/hko;
3 12917
3 12917 rad_op:= op;
3 12918
3 12918 trap(radio_adm_trap);
3 12919 stack_claim((if cm_test then 200 else 150) +50);
3 12920
3 12920 <*+2*>if testbit32 and overvåget or testbit28 then
3 12921 skriv_radio_adm(out,0);
3 12922 <*-2*>
3 12923
3 12923 pass;
3 12924 if -,testbit22 then
3 12925 begin
4 12926 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 12927 signalch(cs_radio_ud,rad_op,rad_optype);
4 12928 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 12929 end;
3 12930 repeat
3 12931 waitch(cs_radio_adm,opref,true,-1);
3 12932 <*+2*>
3 12933 if testbit33 and overvåget then
3 12934 disable begin
4 12935 skriv_radio_adm(out,0);
4 12936 write(out,<: operation modtaget på cs:>,<<d>,cs_radio_adm);
4 12937 skriv_op(out,opref);
4 12938 end;
3 12939 <*-2*>
3 12940
3 12940 k:= d.op_ref.opkode extract 12;
3 12941 opgave:= d.opref.opkode shift (-12);
3 12942 nr:=operatør:=d.op_ref.data(1);
3 12943
3 12943 <*+4*> if (d.op_ref.optype and
3 12944 (gen_optype or io_optype or op_optype or vt_optype))
3 12945 extract 12 = 0 then fejlreaktion(12<*operationstype*>,op_ref,
3 12946 <:radio_adm:>,0);
3 12947 <*-4*>
3 12948 if k = 74 <* RA,I *> then
3 12949 begin
4 12950 startoperation(rad_op,404,cs_radio_adm,'I' shift 12 + 60);
4 12951 signalch(cs_radio_ud,rad_op,rad_optype);
4 12952 waitch(cs_radio_adm,rad_op,rad_optype,-1);
4 12953 d.opref.resultat:= if d.rad_op.resultat=0 then 3
4 12954 else d.rad_op.resultat;
4 12955 signalch(d.opref.retur,opref,d.opref.optype);
4 12956 \f
4 12956 message procedure radio_adm side 4 - 820301/hko;
4 12957 end
3 12958 else
3 12959
3 12959 if k = 1<*IN,O*> or k = 2<*EK,O*> or k = 77<*FO,O*> or
3 12960 k = 5<*FO,L*> or k = 6<*ST *> then
3 12961 begin
4 12962 if k = 5 or k=77 then
4 12963 begin
5 12964
5 12964 <*V*> wait(bs_opkaldskø_adgang);
5 12965 if k=5 then
5 12966 begin
6 12967 disable for iaf:= 0 step 512 until (max_linienr//768*512) do
6 12968 begin
7 12969 i:= læs_fil(1035,iaf//512+1,nr);
7 12970 if i <> 0 then
7 12971 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
7 12972 tofrom(radio_linietabel.iaf,fil(nr),
7 12973 if (((max_linienr+1 - (iaf//2*3))+2)//3*2) > 512 then 512
7 12974 else ((max_linienr+1 - (iaf//2*3))+2)//3*2);
7 12975 end;
6 12976
6 12976 for i:= 1 step 1 until max_antal_mobilopkald do
6 12977 begin
7 12978 iaf:= i*opkaldskø_postlængde;
7 12979 nr:= opkaldskø.iaf(3) shift (-12) extract 10; <*linienr*>
7 12980 if nr>0 then
7 12981 begin
8 12982 læs_tegn(radio_linietabel,nr+1,operatør);
8 12983 if operatør>max_antal_operatører then operatør:= 0;
8 12984 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
8 12985 operatør;
8 12986 end;
7 12987 end;
6 12988 end
5 12989 else
5 12990 if k=77 then
5 12991 begin
6 12992 disable i:= læsfil(1034,1,nr);
6 12993 if i<>0 then fejlreaktion(5,i,<:områdefordelingstabel:>,0);
6 12994 tofrom(radio_områdetabel,fil(nr),max_antal_områder*2);
6 12995 for i:= 1 step 1 until max_antal_mobilopkald do
6 12996 begin
7 12997 iaf:= i*opkaldskø_postlængde;
7 12998 nr:= opkaldskø.iaf(5) extract 4;
7 12999 operatør:= radio_områdetabel(nr);
7 13000 if operatør < 0 or max_antal_operatører < operatør then
7 13001 operatør:= 0;
7 13002 if opkaldskø.iaf(4) extract 8=0 and
7 13003 opkaldskø.iaf(3) shift (-12) extract 10 = 0 then
7 13004 opkaldskø.iaf(4):= opkaldskø.iaf(4) shift(-8) shift 8 +
7 13005 operatør;
7 13006 end;
6 13007 end;
5 13008
5 13008 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13009 signal_bin(bs_opkaldskø_adgang);
5 13010
5 13010 signal_bin(bs_mobil_opkald);
5 13011
5 13011 d.op_ref.resultat:= res:= 3;
5 13012 \f
5 13012 message procedure radio_adm side 5 - 820304/hko;
5 13013
5 13013 end <*k = 5 / k = 77*>
4 13014 else
4 13015 begin <*k =1,2 eller 6 (IN,O - EK,O eller ST) *>
5 13016 res:= 3;
5 13017 for nr:= 1 step 1 until max_antal_kanaler do
5 13018 begin
6 13019 iaf:= (nr-1)*kanal_beskr_længde;
6 13020 if kanal_tab.iaf.kanal_tilstand shift (-16) =
6 13021 op_talevej(operatør) then
6 13022 begin
7 13023 tilst:= kanal_tab.iaf.kanal_tilstand extract 2;
7 13024 if tilst <> 0 then
7 13025 res:= 16; <*skærm optaget*>
7 13026 end; <* kanal_tab(operatør) = operatør*>
6 13027 end;
5 13028 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
5 13029 sæt_bit_ia(opkaldsflag,operatør,k extract 1);
5 13030 signal_bin(bs_mobil_opkald);
5 13031 d.op_ref.resultat:= res;
5 13032 end;<*k=1,2 eller 6 *>
4 13033
4 13033 <*+2*> if testbit35 and overvåget then
4 13034 disable begin
5 13035 skriv_radio_adm(out,0);
5 13036 write(out,<: sender til :>,
5 13037 if k=5 or k=6 or k=77 or res > 3 then d.op_ref.retur
5 13038 else cs_op);
5 13039 skriv_op(out,op_ref);
5 13040 end;
4 13041 <*-2*>
4 13042
4 13042 if k=5 or k=6 or k=77 or res > 3 then
4 13043 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype)
4 13044 else
4 13045 begin <*k = (1 eller 2) og res = 3 *>
5 13046 d.op_ref.resultat:=0;
5 13047 signal_ch(cs_op,op_ref,d.op_ref.optype);
5 13048 end;
4 13049 \f
4 13049 message procedure radio_adm side 6 - 816610/hko;
4 13050
4 13050 end <*k=1,2,5 eller 6*>
3 13051 else
3 13052 if k=3 <*IN,R*> or k=4 <*EK,R*> then
3 13053 begin
4 13054 nr:= d.op_ref.data(1);
4 13055 res:= 3;
4 13056
4 13056 if nr<=3 then
4 13057 res:= 51 <* afvist *>
4 13058 else
4 13059 begin
5 13060
5 13060 <* gennemstilling af område *>
5 13061 j:= 1;
5 13062 for i:= 1 step 1 until max_antal_kanaler do
5 13063 begin
6 13064 if kanal_id(i) shift (-5) extract 3 = 3 and
6 13065 radio_id(kanal_id(i) extract 5) = nr then j:= i;
6 13066 end;
5 13067 nr:= j;
5 13068 iaf:= (nr-1)*kanalbeskrlængde;
5 13069 if læsbiti(kanal_tab.iaf.kanal_tilstand,11) == (k=4) then
5 13070 begin
6 13071 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
6 13072 d.rad_op.data(1):= 0;
6 13073 d.rad_op.data(2):= 'G'; <* gennemstil område *>
6 13074 d.rad_op.data(3):= kanal_id(nr) shift (-5) extract 3;
6 13075 d.rad_op.data(4):= kanal_id(nr) extract 5;
6 13076 d.rad_op.data(5):= k extract 1; <* set/slet gennemstilling *>
6 13077 signalch(cs_radio_ud,rad_op,rad_optype);
6 13078 waitch(cs_radio_adm,rad_op,rad_optype,-1);
6 13079 res:= d.rad_op.resultat;
6 13080 if res=0 then res:= 3;
6 13081 sætbiti(kanal_tab.iaf.kanal_tilstand,11,k extract 1);
6 13082 sætbiti(kanal_tab.iaf.kanal_tilstand,10,k extract 1);
6 13083 end;
5 13084 end;
4 13085 d.op_ref.resultat:=res;
4 13086 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13087 tofrom(kanalflag,alle_operatører,op_maske_lgd);
4 13088 signal_bin(bs_mobil_opkald);
4 13089 \f
4 13089 message procedure radio_adm side 7 - 880930/cl;
4 13090
4 13090
4 13090 end <* k=3 eller 4 *>
3 13091 else
3 13092 if k=72<*EK,K*> or k=73<*IN,K*> then
3 13093 begin
4 13094 nr:= d.opref.data(1) extract 22;
4 13095 res:= 3;
4 13096 iaf:= (nr-1)*kanalbeskrlængde;
4 13097 start_operation(radop,404,cs_radio_adm,'H' shift 12 + 60);
4 13098 d.rad_op.data(1):= 0;
4 13099 d.rad_op.data(2):= 'C'; <* kanal inkluder/ekskluder *>
4 13100 d.rad_op.data(3):= kanalid(nr) shift (-5) extract 3;
4 13101 d.rad_op.data(4):= kanalid(nr) extract 5;
4 13102 d.rad_op.data(5):= k extract 1;
4 13103 signalch(cs_radio_ud,radop,rad_optype);
4 13104 waitch(cs_radio_adm,radop,rad_optype,-1);
4 13105 res:= d.radop.resultat;
4 13106 if res=0 then res:= 3;
4 13107 j:= if k=72 then 15 else 0;
4 13108 if res=3 and j<>sæt_hex_ciffer(kanal_tab.iaf,3,j) then
4 13109 begin
5 13110 tofrom(kanalflag,alle_operatører,op_maske_lgd);
5 13111 signalbin(bs_mobilopkald);
5 13112 end;
4 13113 d.opref.resultat:= res;
4 13114 signalch(d.opref.retur,opref,d.opref.optype);
4 13115 end
3 13116 else
3 13117 if k=11 or k=12 or k=19 then <*vt_opd*>
3 13118 begin
4 13119 nr:= d.opref.data(1) extract 8;
4 13120 opgave:= if k=19 then 9 else (k-4);
4 13121 if nr<=3 then
4 13122 res:= 51 <*afvist*>
4 13123 else
4 13124 begin
5 13125 startoperation(radop,404,cs_radio_adm,'H' shift 12 + 60);
5 13126 d.radop.data(1):= 0;
5 13127 d.radop.data(2):= 'L';
5 13128 d.radop.data(3):= omr_til_trunk(nr) shift (-6);
5 13129 d.radop.data(4):= omr_til_trunk(nr) extract 6;
5 13130 d.radop.data(5):= opgave;
5 13131 d.radop.data(6):= d.opref.data(1) shift (-8) extract 8;
5 13132 d.radop.data(7):= d.opref.data(2);
5 13133 d.radop.data(8):= d.opref.data(3);
5 13134 signalch(cs_radio_ud,radop,rad_optype);
5 13135 <*V*> waitch(cs_radio_adm,radop,rad_optype,-1);
5 13136 res:= d.radop.resultat;
5 13137 if res=0 then res:= 3;
5 13138 end;
4 13139 d.opref.resultat:= res;
4 13140 signalch(d.opref.retur,opref,d.opref.optype);
4 13141 end
3 13142 else
3 13143
3 13143 begin
4 13144
4 13144 d.op_ref.resultat:= 45; <* ikke implementeret *>
4 13145
4 13145 signal_ch(d.op_ref.retur,op_ref,d.op_ref.optype);
4 13146
4 13146 end;
3 13147
3 13147 until false;
3 13148 radio_adm_trap:
3 13149 disable skriv_radio_adm(zbillede,1);
3 13150 end radio_adm;
2 13151
2 13151 \f
2 13151 message vogntabel erklæringer side 1 - 820301/cl;
2 13152
2 13152 integer cs_vt, cs_vt_adgang,cs_vt_logpool,cs_vt_opd,cs_vt_rap,
2 13153 cs_vt_tilst,cs_vt_auto,cs_vt_grp,cs_vt_spring,vt_op,
2 13154 cs_vt_log;
2 13155 integer sidste_bus,sidste_linie_løb,tf_vogntabel,
2 13156 max_antal_i_gruppe,tf_gruppedef,tf_gruppeidenter,tf_springdef,
2 13157 vt_log_slicelgd;
2 13158 integer array bustabel,bustabel1(0:max_antal_busser),
2 13159 linie_løb_tabel(0:max_antal_linie_løb),
2 13160 springtabel(1:max_antal_spring,1:3),
2 13161 gruppetabel(1:max_antal_grupper),
2 13162 gruppeopkald(1:max_antal_gruppeopkald,1:2), <* ident , filref *>
2 13163 vt_logop(1:2),
2 13164 vt_logdisc(1:4),
2 13165 vt_log_tail(1:10);
2 13166 boolean array busindeks(-1:max_antal_linie_løb),
2 13167 bustilstand(-1:max_antal_busser),
2 13168 linie_løb_indeks(-1:max_antal_busser);
2 13169 real array springtid,springstart(1:max_antal_spring);
2 13170 real vt_logstart;
2 13171 integer field v_kode,v_bus,v_ll1,v_ll2;
2 13172 integer array field v_tekst;
2 13173 real field v_tid;
2 13174
2 13174 zone zvtlog(128,1,stderror);
2 13175
2 13175 \f
2 13175 message vogntabel erklæringer side 2 - 851001/cl;
2 13176
2 13176 procedure skriv_vt_variable(zud);
2 13177 zone zud;
2 13178 begin integer i; long array field laf;
3 13179 laf:= 0;
3 13180 write(zud,"nl",1,<:+++++ vogntabel variable::>,"nl",1,<<d>,
3 13181 <:vt-op-længde :>,vt_op_længde,"nl",1,
3 13182 <:cs-vt :>,cs_vt,"nl",1,
3 13183 <:cs-vt-adgang :>,cs_vt_adgang,"nl",1,
3 13184 <:cs-vt-logpool :>,cs_vt_logpool,"nl",1,
3 13185 <:cs-vt-opd :>,cs_vt_opd,"nl",1,
3 13186 <:cs-vt-rap :>,cs_vt_rap,"nl",1,
3 13187 <:cs-vt-tilst :>,cs_vt_tilst,"nl",1,
3 13188 <:cs-vt-auto :>,cs_vt_auto,"nl",1,
3 13189 <:cs-vt-grp :>,cs_vt_grp,"nl",1,
3 13190 <:cs-vt-spring :>,cs_vt_spring,"nl",1,
3 13191 <:cs-vt-log :>,cs_vt_log,"nl",1,
3 13192 <:vt-op :>,vt_op,"nl",1,
3 13193 <:vt-logop(1) :>,vt_logop(1),"nl",1,
3 13194 <:vt-logop(2) :>,vt_logop(2),"nl",1,
3 13195 <:sidste-bus :>,sidste_bus,"nl",1,
3 13196 <:sidste-linie-løb :>,sidste_linie_løb,"nl",1,
3 13197 <:max-antal-i-gruppe :>,max_antal_i_gruppe,"nl",1,
3 13198 <:tf-vogntabel :>,tf_vogntabel,"nl",1,
3 13199 <:tf-gruppedef :>,tf_gruppedef,"nl",1,
3 13200 <:tf-gruppeidenter :>,tf_gruppeidenter,"nl",1,
3 13201 <:tf-springdef :>,tf_springdef,"nl",1,
3 13202 <:vt-logskift :>,vt_logskift,"nl",1,
3 13203 <:vt-logdisc :>,vt_logdisc.laf,"nl",1,
3 13204 <:vt-log-slicelgd :>,vt_log_slicelgd,"nl",1,
3 13205 <:vt-log-aktiv :>,
3 13206 if vt_log_aktiv then <:true:> else <:false:>,"nl",1,
3 13207 <:vt-logstart :>,<<zdddddd.dd>,vt_logstart,"nl",1,
3 13208 <::>);
3 13209 write(zud,"nl",1,<:vt-logtail:<'nl'>:>);
3 13210 laf:= 2;
3 13211 write(zud,"sp",2,<<d>,vt_logtail(1),"sp",1,vt_logtail.laf);
3 13212 for i:= 6 step 1 until 10 do
3 13213 write(zud,"sp",1,<<d>,vt_logtail(i));
3 13214 write(zud,"nl",1);
3 13215 end;
2 13216 \f
2 13216 message procedure p_vogntabel side 1 - 820301/cl;
2 13217
2 13217 procedure p_vogntabel(z);
2 13218 zone z;
2 13219 begin
3 13220 integer i,b,s,o,t,li,lb,lø,g;
3 13221 write(z,<:<10>***** udskrift af vogntabel *****<10>:>,
3 13222 <:<10>max-antal-busser =:>,max_antal_busser,<: sidste-bus =:>,
3 13223 sidste_bus,<:<10>max-antal-linie-løb =:>,max_antal_linie_løb,
3 13224 <: sidste-linie-løb =:>,sidste_linie_løb,"nl",1);
3 13225
3 13225 for i:= 1 step 1 until sidste_bus do
3 13226 begin
4 13227 b:= bustabel(i) extract 14;
4 13228 g:= bustabel(i) shift (-14);
4 13229 s:= bustabel1(i) shift (-23);
4 13230 o:= bustabel1(i) extract 8;
4 13231 t:= intg(bustilstand(i));
4 13232 li:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13233 lø:= li extract 7;
4 13234 lb:= li shift (-7) extract 5;
4 13235 lb:= if lb=0 then 32 else lb+64;
4 13236 li:= li shift (-12) extract 10;
4 13237 write(z,if i mod 2 = 1 then <:<10>:> else <: :>,
4 13238 <<zddd>,b,if s=1 then <:B:> else <: :>,"sp",1,
4 13239 if g > 0 then string bpl_navn(g) else <: :>,
4 13240 ";",1,true,4,string område_navn(o),
4 13241 <:(:>,<<-dd>,t,<:) :>," ",if lb=' ' then 1 else 0,<<ddd>,
4 13242 li,false add lb,if lb=' ' then 0 else 1,<:/:>,<<zd>,lø);
4 13243 end;
3 13244 end p_vogntabel;
2 13245 \f
2 13245 message procedure p_gruppetabel side 1 - 810531/cl;
2 13246
2 13246 procedure p_gruppetabel(z);
2 13247 zone z;
2 13248 begin
3 13249 integer i,nr,bogst;
3 13250 boolean spc_gr;
3 13251 write(z,"nl",2,<:***** udskrift af gruppetabel *****:>,"nl",1,
3 13252 <:max-antal-grupper =:>,max_antal_grupper,
3 13253 <: max-antal-i-gruppe =:>,max_antal_i_gruppe,
3 13254 <: max-antal-gruppeopkald =:>,max_antal_gruppeopkald,"nl",2,
3 13255 <:gruppetabel::>);
3 13256 for i:= 1 step 1 until max_antal_grupper do
3 13257 write(z,if i mod 10 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1,
3 13258 if gruppetabel(i) <> 0 then "G" else " ",1,true,2,<<b>,
3 13259 gruppetabel(i) extract 7);
3 13260 write(z,"nl",2,<:gruppeopkald::>);
3 13261 for i:= 1 step 1 until max_antal_gruppeopkald do
3 13262 begin
4 13263 write(z,if i mod 4 = 1 then <:<10>:> else <: :>,<<dd>,i,":",1);
4 13264 if gruppeopkald(i,1) = 0 then
4 13265 write(z,"sp",11)
4 13266 else
4 13267 begin
5 13268 spc_gr:= gruppeopkald(i,1) shift (-21) = 5;
5 13269 if spc_gr then nr:= gruppeopkald(i,1) extract 7
5 13270 else
5 13271 begin
6 13272 nr:= gruppeopkald(i,1) shift (-5) extract 10;
6 13273 bogst:= gruppeopkald(i,1) extract 5 +'@';
6 13274 if bogst = '@' then bogst:= 'sp';
6 13275 end;
5 13276 if spc_gr then
5 13277 write(z,<:(G:>,<<d>,true,3,nr)
5 13278 else
5 13279 write(z,"(",1,<<ddd>,nr,false add bogst,1);
5 13280 write(z,",",1,<<dddd>,gruppeopkald(i,2),")",1);
5 13281 end;
4 13282 end;
3 13283 end p_gruppetabel;
2 13284 \f
2 13284 message procedure p_springtabel side 1 - 810519/cl;
2 13285
2 13285 procedure p_springtabel(z);
2 13286 zone z;
2 13287 begin
3 13288 integer li,bo,max,st,nr;
3 13289 long indeks;
3 13290 real t;
3 13291
3 13291 write(z,"nl",2,<:***** springtabel *****:>,"nl",1,
3 13292 <:max-antal-spring =:>,max_antal_spring,"nl",2,
3 13293 <:nr spring-id max status næste-tid:>,"nl",1);
3 13294 for nr:= 1 step 1 until max_antal_spring do
3 13295 begin
4 13296 write(z,<<dd>,nr);
4 13297 <* if springtabel(nr,1)<>0 then *>
4 13298 begin
5 13299 li:= springtabel(nr,1) shift (-5) extract 10;
5 13300 bo:= springtabel(nr,1) extract 5;
5 13301 if bo<>0 then bo:= bo + 'A' - 1;
5 13302 indeks:= extend springtabel(nr,2) shift 24;
5 13303 st:= extend springtabel(nr,3) shift (-12) extract 24;
5 13304 max:= springtabel(nr,3) extract 12;
5 13305 write(z,"sp",(bo=0) extract 1 + 2,<<ddd>,li,false add bo,1,<:.:>);
5 13306 write(z,"sp",4-write(z,string indeks),<< dd>,max,<< -dd>,st);
5 13307 if springtid(nr)<>0.0 then
5 13308 write(z,<< zddddd.dddd>,systime(4,springtid(nr),t)+t/1000000)
5 13309 else
5 13310 write(z,<< d.d >,0.0);
5 13311 if springstart(nr)<>0.0 then
5 13312 write(z,<< zddddd.dddd>,systime(4,springstart(nr),t)+t/1000000)
5 13313 else
5 13314 write(z,<< d.d >,0.0);
5 13315 end
4 13316 <* else
4 13317 write(z,<: --------:>)*>;
4 13318 write(z,"nl",1);
4 13319 end;
3 13320 end p_springtabel;
2 13321 \f
2 13321 message procedure find_busnr side 1 - 820301/cl;
2 13322
2 13322 integer procedure findbusnr(ll_id,busnr,garage,tilst);
2 13323 value ll_id;
2 13324 integer ll_id, busnr, garage, tilst;
2 13325 begin
3 13326 integer i,j;
3 13327
3 13327 j:= binærsøg(sidste_linie_løb,
3 13328 (linie_løb_tabel(i) - ll_id), i);
3 13329 if j<>0 then <* linie/løb findes ikke *>
3 13330 begin
4 13331 find_busnr:= -1;
4 13332 busnr:= 0;
4 13333 garage:= 0;
4 13334 tilst:= 0;
4 13335 end
3 13336 else
3 13337 begin
4 13338 busnr:= bustabel(busindeks(i) extract 12);
4 13339 tilst:= intg(bustilstand(intg(busindeks(i))));
4 13340 garage:= busnr shift (-14);
4 13341 busnr:= busnr extract 14;
4 13342 find_busnr:= busindeks(i) extract 12;
4 13343 end;
3 13344 end find_busnr;
2 13345 \f
2 13345 message procedure søg_omr_bus side 1 - 881027/cl;
2 13346
2 13346
2 13346 integer procedure søg_omr_bus(bus,ll,gar,omr,sig,tilst);
2 13347 value bus;
2 13348 integer bus,ll,gar,omr,sig,tilst;
2 13349 begin
3 13350 integer i,j,nr,bu,bi,bl;
3 13351
3 13351 j:= binærsøg(sidste_bus,((bustabel(bi) extract 14) - (bus extract 14)),bi);
3 13352 nr:= -1;
3 13353 if j=0 then
3 13354 begin
4 13355 bl:= bu:= bi;
4 13356 while bl>1 and bustabel(bl-1) extract 14 = bus extract 14 do bl:=bl-1;
4 13357 while bu<sidste_bus and
4 13358 bustabel(bu+1) extract 14 = bus extract 14 do bu:= bu+1;
4 13359
4 13359 if bl<>bu then
4 13360 begin
5 13361 <* flere busser med samme tekniske nr. omr skal passe *>
5 13362 nr:= -2;
5 13363 for bi:= bl step 1 until bu do
5 13364 if bustabel1(bi) extract 8 = omr extract 8 then nr:= bi;
5 13365 end
4 13366 else
4 13367 nr:= bi;
4 13368 end;
3 13369
3 13369 if nr<0 then
3 13370 begin
4 13371 <* bus findes ikke *>
4 13372 ll:= gar:= tilst:= sig:= 0;
4 13373 end
3 13374 else
3 13375 begin
4 13376 tilst:= intg(bustilstand(nr));
4 13377 gar:= bustabel(nr) shift (-14);
4 13378 ll:= linie_løb_tabel( linie_løb_indeks(nr) extract 12 );
4 13379 if omr=0 then omr:= bustabel1(nr) extract 8;
4 13380 sig:= bustabel1(nr) shift (-23);
4 13381 end;
3 13382 søg_omr_bus:= nr;
3 13383 end;
2 13384 \f
2 13384 message procedure find_linie_løb side 1 - 820301/cl;
2 13385
2 13385 integer procedure find_linie_løb(busnr,linie_løb,garage,tilst);
2 13386 value busnr;
2 13387 integer busnr, linie_løb, garage, tilst;
2 13388 begin
3 13389 integer i,j;
3 13390
3 13390 j:= binærsøg(sidste_bus,((bustabel(i) extract 14) - (busnr extract 14)), i);
3 13391
3 13391 if j<>0 then <* bus findes ikke *>
3 13392 begin
4 13393 find_linie_løb:= -1;
4 13394 linie_løb:= 0;
4 13395 garage:= 0;
4 13396 tilst:= 0;
4 13397 end
3 13398 else
3 13399 begin
4 13400 tilst:= intg(bustilstand(i));
4 13401 garage:= bustabel(i) shift (-14);
4 13402 linie_løb:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 13403 find_linie_løb:= linie_løb_indeks(i) extract 12;
4 13404 end;
3 13405 end find_linie_løb;
2 13406 \f
2 13406 message procedure h_vogntabel side 1 - 810413/cl;
2 13407
2 13407 <* hovedmodulcorutine for vogntabelmodul *>
2 13408
2 13408 procedure h_vogntabel;
2 13409 begin
3 13410 integer array field op;
3 13411 integer dest_sem,k;
3 13412
3 13412 procedure skriv_h_vogntabel(zud,omfang);
3 13413 value omfang;
3 13414 zone zud;
3 13415 integer omfang;
3 13416 begin
4 13417 write(zud,"nl",1,<:+++ hovedmodul vogntabel :>);
4 13418 if omfang<>0 then
4 13419 disable
4 13420 begin
5 13421 skriv_coru(zud,abs curr_coruno);
5 13422 write(zud,"nl",1,<<d>,
5 13423 <:cs-vt :>,cs_vt,"nl",1,
5 13424 <:op :>,op,"nl",1,
5 13425 <:dest-sem :>,dest_sem,"nl",1,
5 13426 <:k :>,k,"nl",1,
5 13427 <::>);
5 13428 end;
4 13429 end;
3 13430 \f
3 13430 message procedure h_vogntabel side 2 - 820301/cl;
3 13431
3 13431 stackclaim(if cm_test then 198 else 146);
3 13432 trap(h_vt_trap);
3 13433
3 13433 <*+2*>
3 13434 <**> disable if testbit47 and overvåget or testbit28 then
3 13435 <**> skriv_h_vogntabel(out,0);
3 13436 <*-2*>
3 13437
3 13437 repeat
3 13438 waitch(cs_vt,op,true,-1);
3 13439 <*+4*>
3 13440 if (d.op.optype and gen_optype) extract 12 = 0 and
3 13441 (d.op.optype and vt_optype) extract 12 = 0 then
3 13442 fejlreaktion(12,op,<:vogntabel:>,0);
3 13443 <*-4*>
3 13444 disable
3 13445 begin
4 13446
4 13446 k:= d.op.opkode extract 12;
4 13447 dest_sem:=
4 13448 if k = 9 then cs_vt_rap else
4 13449 if k = 10 then cs_vt_rap else
4 13450 if k = 11 then cs_vt_opd else
4 13451 if k = 12 then cs_vt_opd else
4 13452 if k = 13 then cs_vt_opd else
4 13453 if k = 14 then cs_vt_tilst else
4 13454 if k = 15 then cs_vt_tilst else
4 13455 if k = 16 then cs_vt_tilst else
4 13456 if k = 17 then cs_vt_tilst else
4 13457 if k = 18 then cs_vt_tilst else
4 13458 if k = 19 then cs_vt_opd else
4 13459 if k = 20 then cs_vt_opd else
4 13460 if k = 21 then cs_vt_auto else
4 13461 if k = 24 then cs_vt_opd else
4 13462 if k = 25 then cs_vt_grp else
4 13463 if k = 26 then cs_vt_grp else
4 13464 if k = 27 then cs_vt_grp else
4 13465 if k = 28 then cs_vt_grp else
4 13466 if k = 30 then cs_vt_spring else
4 13467 if k = 31 then cs_vt_spring else
4 13468 if k = 32 then cs_vt_spring else
4 13469 if k = 33 then cs_vt_spring else
4 13470 if k = 34 then cs_vt_spring else
4 13471 if k = 35 then cs_vt_spring else
4 13472 -1;
4 13473 \f
4 13473 message procedure h_vogntabel side 3 - 810422/cl;
4 13474
4 13474 <*+2*>
4 13475 <**> if testbit41 and overvåget then
4 13476 <**> begin
5 13477 <**> skriv_h_vogntabel(out,0); write(out,<: modtaget operation:>);
5 13478 <**> skriv_op(out,op);
5 13479 <**> end;
4 13480 <*-2*>
4 13481 end;
3 13482
3 13482 if dest_sem = -1 then
3 13483 fejlreaktion(2,k,<:vogntabel:>,0);
3 13484 disable signalch(dest_sem,op,d.op.optype);
3 13485 until false;
3 13486 h_vt_trap:
3 13487 disable skriv_h_vogntabel(zbillede,1);
3 13488 end h_vogntabel;
2 13489 \f
2 13489 message procedure vt_opdater side 1 - 810317/cl;
2 13490
2 13490 procedure vt_opdater(op1);
2 13491 value op1;
2 13492 integer op1;
2 13493 begin
3 13494 integer array field op,radop;
3 13495 integer funk,res,busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi,
3 13496 format,ll_id1,ll_id2,inf1,inf2,i,bi1,bi2,li1,li2,pm1,
3 13497 flin,slin,finx,sinx;
3 13498 integer field bn,ll;
3 13499
3 13499 procedure skriv_vt_opd(zud,omfang);
3 13500 value omfang; integer omfang;
3 13501 zone zud;
3 13502 begin
4 13503 write(zud,"nl",1,<:+++ vt_opdater :>);
4 13504 if omfang <> 0 then
4 13505 disable
4 13506 begin
5 13507 skriv_coru(zud,abs curr_coruno);
5 13508 write(zud,"nl",1,
5 13509 <: op: :>,op,"nl",1,
5 13510 <: radop::>,radop,"nl",1,
5 13511 <: funk: :>,funk,"nl",1,
5 13512 <: res: :>,res,"nl",1,
5 13513 <::>);
5 13514 end;
4 13515 end skriv_vt_opd;
3 13516
3 13516 integer procedure opd_omr(fnk,omr,bus,ll);
3 13517 value fnk,omr,bus,ll;
3 13518 integer fnk,omr,bus,ll;
3 13519 begin
4 13520 opd_omr:= 3;
4 13521 <*GØR PROCEDUREN TIL DUMMYPROCEDURE -
4 13522 ændringer skal ikke længere meldes til yderområder *>
4 13523 goto dummy_retur;
4 13524
4 13524 if omr extract 8 > 3 then
4 13525 begin
5 13526 startoperation(radop,501,cs_vt_opd,fnk);
5 13527 d.radop.data(1):= omr;
5 13528 d.radop.data(2):= bus;
5 13529 d.radop.data(3):= ll;
5 13530 signalch(cs_rad,radop,vt_optype);
5 13531 <*V*> waitch(cs_vt_opd,radop,vt_optype,-1);
5 13532 opd_omr:= d.radop.resultat;
5 13533 end
4 13534 else
4 13535 opd_omr:= 0;
4 13536 dummy_retur:
4 13537 end;
3 13538 message procedure vt_opdater side 1a - 920517/cl;
3 13539
3 13539 procedure opd_log(kilde,kode,bus,ll1,ll2);
3 13540 value kilde,kode,bus,ll1,ll2;
3 13541 integer kilde,kode,bus,ll1,ll2;
3 13542 begin
4 13543 integer array field op;
4 13544
4 13544 <*V*> waitch(cs_vt_logpool,op,vt_optype,-1);
4 13545
4 13545 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 13546 systime(1,0.0,d.op.data.v_tid);
4 13547 d.op.data.v_kode:= kode + (if kilde=506 <*vt_auto*> then 0 else 4);
4 13548 d.op.data.v_bus:= bus;
4 13549 d.op.data.v_ll1:= ll1;
4 13550 d.op.data.v_ll2:= ll2;
4 13551 signalch(cs_vt_log,op,vt_optype);
4 13552 end;
3 13553
3 13553 stackclaim((if cm_test then 198 else 146)+125);
3 13554
3 13554 bn:= 4; ll:= 2;
3 13555 radop:= op1;
3 13556 trap(vt_opd_trap);
3 13557
3 13557 <*+2*>
3 13558 <**> disable if testbit47 and overvåget or testbit28 then
3 13559 <**> skriv_vt_opd(out,0);
3 13560 <*-2*>
3 13561 \f
3 13561 message procedure vt_opdater side 2 - 851001/cl;
3 13562
3 13562 vent_op:
3 13563 waitch(cs_vt_opd,op,gen_optype or vt_optype,-1);
3 13564
3 13564 <*+2*>
3 13565 <**> disable
3 13566 <**> if testbit41 and overvåget then
3 13567 <**> begin
4 13568 <**> skriv_vt_opd(out,0);
4 13569 <**> write(out,<: modtaget operation:>);
4 13570 <**> skriv_op(out,op);
4 13571 <**> end;
3 13572 <*-2*>
3 13573
3 13573 <*+4*>
3 13574 <**>if op<>vt_op then
3 13575 <**>begin
4 13576 <**> disable begin
5 13577 <**> fejlreaktion(11,op,<:vt-opdater:>,1);
5 13578 <**> d.op.resultat:= 31; <*systemfejl*>
5 13579 <**> signalch(d.op.retur,op,d.op.optype);
5 13580 <**> end;
4 13581 <**> goto vent_op;
4 13582 <**>end;
3 13583 <*-4*>
3 13584 disable
3 13585 begin integer opk;
4 13586
4 13586 opk:= d.op.opkode extract 12;
4 13587 funk:= if opk=11 then 1 else
4 13588 if opk=12 then 2 else
4 13589 if opk=13 then 3 else
4 13590 if opk=19 then 4 else
4 13591 if opk=20 then 5 else
4 13592 if opk=24 then 6 else
4 13593 0;
4 13594 if funk=0 then fejlreaktion( 2,opk,<:vt_opdater:>,0);
4 13595 end;
3 13596 res:= 0;
3 13597 goto case funk of (indsæt,udtag,omkod,slet,flyt,roker);
3 13598 \f
3 13598 message procedure vt_opdater side 3 - 820301/cl;
3 13599
3 13599 indsæt:
3 13600 begin
4 13601 integer busnr,ll_id,ll1,omr,gar,sig,tilst,bi,li,s,zi;
4 13602 <*+4*>
4 13603 <**> if d.op.data(1) shift (-22) <> 0 then
4 13604 <**> begin
5 13605 <**> res:= 31; fejlreaktion(10,d.op.data(1),<:indsæt busnr:>,1);
5 13606 <**> goto slut_indsæt;
5 13607 <**> end;
4 13608 <*-4*>
4 13609 busnr:= d.op.data(1) extract 14;
4 13610 <*+4*>
4 13611 <**> if d.op.data(2) shift (-22) <> 1 then
4 13612 <**> begin
5 13613 <**> res:= 31; fejlreaktion(10,d.op.data(2),<:indsæt linie/løb:>,1);
5 13614 <**> goto slut_indsæt;
5 13615 <**> end;
4 13616 <*-4*>
4 13617 ll_id:= d.op.data(2);
4 13618 s:= omr:= d.op.data(4) extract 8;
4 13619 bi:= søg_omr_bus(busnr,ll1,gar,omr,sig,tilst);
4 13620 if bi<0 then
4 13621 begin
5 13622 if bi=(-1) then res:=10 <*bus ukendt*> else
5 13623 if s<>0 then res:= 58 <*ulovligt omr*> else res:= 57 <*omr nødv.*>;
5 13624 end
4 13625 else
4 13626 if s<>0 and s<>omr then
4 13627 res:= 58 <* ulovligt område for bus *>
4 13628 else
4 13629 if intg(bustilstand(bi)) <> 0 then
4 13630 res:=(if intg(bustilstand(bi))=(-1) then 18 <* i kø *>
4 13631 else 14 <* optaget *>)
4 13632 else
4 13633 begin
5 13634 if linie_løb_indeks(bi) extract 12 <> 0 then
5 13635 begin <* linie/løb allerede indsat *>
6 13636 res:= 11;
6 13637 d.op.data(3):= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
6 13638 end
5 13639 else
5 13640 begin
6 13641 \f
6 13641 message procedure vt_opdater side 3a - 900108/cl;
6 13642
6 13642 if d.op.kilde//100 <> 4 then
6 13643 res:= opd_omr(11,gar shift 8 +
6 13644 bustabel1(bi) extract 8,busnr,ll_id);
6 13645 if res>3 then goto slut_indsæt;
6 13646 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li) - ll_id,li);
6 13647 if s=0 then <* linie/løb findes allerede *>
6 13648 begin
7 13649 sig:= busindeks(li) extract 12;
7 13650 d.op.data(3):= bustabel(sig);
7 13651 linie_løb_indeks(sig):= false;
7 13652 disable modiffil(tf_vogntabel,sig,zi);
7 13653 fil(zi).ll:= 0;
7 13654 fil(zi).bn:= bustabel(sig) extract 14 add
7 13655 (bustabel1(sig) extract 8 shift 14);
7 13656 opd_log(d.op.kilde,2,bustabel(sig),ll_id,0);
7 13657
7 13657 linie_løb_indeks(bi):= false add li;
7 13658 busindeks(li):= false add bi;
7 13659 disable modiffil(tf_vogntabel,bi,zi);
7 13660 fil(zi).ll:= ll_id;
7 13661 fil(zi).bn:= bustabel(bi) extract 14 add
7 13662 (bustabel1(bi) extract 8 shift 14);
7 13663 opd_log(d.op.kilde,1,busnr,0,ll_id);
7 13664 res:= 3;
7 13665 end
6 13666 else
6 13667 begin
7 13668 \f
7 13668 message procedure vt_opdater side 4 - 810527/cl;
7 13669
7 13669 if s<0 then li:= li +1;
7 13670 if sidste_linie_løb=max_antal_linie_løb then
7 13671 begin
8 13672 fejlreaktion(10,max_antal_linie_løb,<:for mange linie/løb:>,1);
8 13673 res:= 31;
8 13674 end
7 13675 else
7 13676 begin
8 13677 for i:= sidste_linie_løb step -1 until li do
8 13678 begin
9 13679 linie_løb_tabel(i+1):=linie_løb_tabel(i);
9 13680 linie_løb_indeks(bus_indeks(i) extract 12):=false add (i+1);
9 13681 bus_indeks(i+1):=bus_indeks(i);
9 13682 end;
8 13683 sidste_linie_løb:= sidste_linie_løb +1;
8 13684 linie_løb_tabel(li):= ll_id;
8 13685 linie_løb_indeks(bi):= false add li;
8 13686 busindeks(li):= false add bi;
8 13687 disable s:= modiffil(tf_vogntabel,bi,zi);
8 13688 if s<>0 then fejlreaktion(7,s,<:vt_indsæt:>,0);
8 13689 fil(zi).bn:= busnr extract 14 add
8 13690 (bustabel1(bi) extract 8 shift 14);
8 13691 fil(zi).ll:= ll_id;
8 13692 opd_log(d.op.kilde,1,busnr,0,ll_id);
8 13693 res:= 3; <* ok *>
8 13694 end;
7 13695 end;
6 13696 end;
5 13697 end;
4 13698 slut_indsæt:
4 13699 d.op.resultat:= res;
4 13700 end;
3 13701 goto returner;
3 13702 \f
3 13702 message procedure vt_opdater side 5 - 820301/cl;
3 13703
3 13703 udtag:
3 13704 begin
4 13705 integer busnr,ll_id,omr,gar,sig,bi,li,s,format,tilst,zi;
4 13706
4 13706 busnr:= ll_id:= 0;
4 13707 omr:= s:= d.op.data(2) extract 8;
4 13708 format:= d.op.data(1) shift (-22);
4 13709 if format=0 then <*busnr*>
4 13710 begin
5 13711 busnr:= d.op.data(1) extract 14;
5 13712 bi:= søg_omr_bus(busnr,ll_id,gar,omr,sig,tilst);
5 13713 if bi<0 then
5 13714 begin
6 13715 if bi=-1 then res:= 10 else
6 13716 if s<>0 then res:= 58 else res:= 57;
6 13717 goto slut_udtag;
6 13718 end;
5 13719 if bi>0 and s<>0 and s<>omr then
5 13720 begin
6 13721 res:= 58; goto slut_udtag;
6 13722 end;
5 13723 li:= linie_løb_indeks(bi) extract 12;
5 13724 busnr:= bustabel(bi);
5 13725 if li=0 or linie_løb_tabel(li)=0 then
5 13726 begin <* bus ej indsat *>
6 13727 res:= 13;
6 13728 goto slut_udtag;
6 13729 end;
5 13730 ll_id:= linie_løb_tabel(li);
5 13731 end
4 13732 else
4 13733 if format=1 then <* linie_løb *>
4 13734 begin
5 13735 ll_id:= d.op.data(1);
5 13736 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li)-ll_id,li);
5 13737 if s<>0 then
5 13738 begin <* linie/løb findes ikke *>
6 13739 res:= 9;
6 13740 goto slut_udtag;
6 13741 end;
5 13742 bi:= busindeks(li) extract 12;
5 13743 busnr:= bustabel(bi);
5 13744 end
4 13745 else <* ulovlig identifikation *>
4 13746 begin
5 13747 res:= 31;
5 13748 fejlreaktion(10,d.op.data(1),<:udtag ident:>,1);
5 13749 goto slut_udtag;
5 13750 end;
4 13751 \f
4 13751 message procedure vt_opdater side 6 - 820301/cl;
4 13752
4 13752 tilst:= intg(bustilstand(bi));
4 13753 if tilst<>0 then
4 13754 begin
5 13755 res:= if tilst = -1 then 18<*i kø*> else 14<*optaget*>;
5 13756 goto slut_udtag;
5 13757 end;
4 13758 if d.op.kilde//100 <> 4 then
4 13759 res:= opd_omr(12, bustabel(bi) shift (-14) extract 8 shift 8 +
4 13760 bustabel1(bi) extract 8,bustabel(bi) extract 14,0);
4 13761 if res>3 then goto slut_udtag;
4 13762 linie_løb_indeks(bi):= false;
4 13763 for i:= li step 1 until sidste_linie_løb -1 do
4 13764 begin
5 13765 linie_løb_tabel(i):= linie_løb_tabel(i+1);
5 13766 linie_løb_indeks(bus_indeks(i+1) extract 12):= false add i;
5 13767 bus_indeks(i):= bus_indeks(i+1);
5 13768 end;
4 13769 linie_løb_tabel(sidste_linie_løb):= 0;
4 13770 bus_indeks(sidste_linie_løb):= false;
4 13771 sidste_linie_løb:= sidste_linie_løb -1;
4 13772 disable s:= modif_fil(tf_vogntabel,bi,zi);
4 13773 if s<>0 then fejlreaktion(7,s,<:vt_udtag:>,0);
4 13774 fil(zi).ll:= 0;
4 13775 fil(zi).bn:= busnr add (bustabel1(bi) extract 8 shift 14);
4 13776 opd_log(d.op.kilde,2,busnr,ll_id,0);
4 13777 res:= 3; <* ok *>
4 13778 slut_udtag:
4 13779 d.op.resultat:= res;
4 13780 d.op.data(2):= ll_id;
4 13781 d.op.data(3):= busnr;
4 13782 end;
3 13783 goto returner;
3 13784 \f
3 13784 message procedure vt_opdater side 7 - 851001/cl;
3 13785
3 13785 omkod:
3 13786 flyt:
3 13787 roker:
3 13788 begin
4 13789 integer ll_id1,ll_id2,inf1,inf2,i,s,bi1,bi2,li1,li2,tilst,zi,pm1;
4 13790
4 13790 inf1:= inf2:= 0;
4 13791 ll_id1:= d.op.data(1);
4 13792 ll_id2:= d.op.data(2);
4 13793 if ll_id1=ll_id2 then
4 13794 begin
5 13795 res:= 24; inf1:= ll_id2;
5 13796 goto slut_flyt;
5 13797 end;
4 13798 <*+4*>
4 13799 <**> for i:= 1,2 do
4 13800 <**> if d.op.data(i) shift (-22) <> 1 then
4 13801 <**> begin
5 13802 <**> res:= 31;
5 13803 <**> fejlreaktion(10,d.op.data(i),case i of (
5 13804 <**> <:omkod/flyt/roker ident1:>,<:omkod/flyt/roker ident2:>),1);
5 13805 <**> goto slut_flyt;
5 13806 <**> end;
4 13807 <*-4*>
4 13808
4 13808 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
4 13809 if s<>0 and funk=6 <* roker *> then
4 13810 begin
5 13811 i:= ll_id1; ll_id1:= ll_id2; ll_id2:= i;
5 13812 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li1) - ll_id1,li1);
5 13813 end;
4 13814 if s<>0 then
4 13815 begin
5 13816 res:= 9; <* ukendt linie/løb *>
5 13817 goto slut_flyt;
5 13818 end;
4 13819 bi1:= busindeks(li1) extract 12;
4 13820 inf1:= bustabel(bi1);
4 13821 tilst:= intg(bustilstand(bi1));
4 13822 if tilst<>0 then <* bus ikke fri *>
4 13823 begin
5 13824 res:= if tilst=-1 then 18 <* i kø *> else 14 <*optaget*>;
5 13825 goto slut_flyt;
5 13826 end;
4 13827 \f
4 13827 message procedure vt_opdater side 7a- 851001/cl;
4 13828 if d.op.kilde//100 <> 4 then
4 13829
4 13829 res:= opd_omr(11, bustabel(bi1) shift (-14) extract 8 shift 8 +
4 13830 bustabel1(bi1) extract 8, inf1 extract 14, ll_id2);
4 13831 if res>3 then goto slut_flyt;
4 13832
4 13832 s:= binærsøg(sidste_linie_løb,linie_løb_tabel(li2) - ll_id2,li2);
4 13833 if s=0 then
4 13834 begin <* ll_id2 er indkodet *>
5 13835 bi2:= busindeks(li2) extract 12;
5 13836 inf2:= bustabel(bi2);
5 13837 tilst:= intg(bustilstand(bi2));
5 13838 if funk=3 then res:= 12 <* ulovlig ved omkod *> else
5 13839 if tilst=-1 then res:= 18 else if tilst<>0 then res:= 14;
5 13840 if res>3 then
5 13841 begin
6 13842 inf1:= inf2; inf2:= 0;
6 13843 goto slut_flyt;
6 13844 end;
5 13845
5 13845 if d.op.kilde//100 <> 4 then
5 13846 res:= opd_omr(11, bustabel(bi2) shift (-14) extract 8 shift 8 +
5 13847 bustabel1(bi2) extract 8, inf2 extract 14, ll_id1);
5 13848 if res>3 then goto slut_flyt;
5 13849
5 13849 <* flyt bus *>
5 13850 if funk=6 then
5 13851 linie_løb_indeks(bi2):= false add li1
5 13852 else
5 13853 linie_løb_indeks(bi2):= false;
5 13854 linie_løb_indeks(bi1):= false add li2;
5 13855 if funk=6 then
5 13856 busindeks(li1):= false add bi2
5 13857 else
5 13858 busindeks(li1):= false;
5 13859 busindeks(li2):= false add bi1;
5 13860
5 13860 if funk<>6 then
5 13861 begin
6 13862 <* fjern ll_id1 *>
6 13863 for i:= li1 step 1 until sidste_linie_løb - 1 do
6 13864 begin
7 13865 linie_løb_tabel(i):= linie_løb_tabel(i+1);
7 13866 linie_løb_indeks(intg(busindeks(i+1))):= false add i;
7 13867 busindeks(i):= busindeks(i+1);
7 13868 end;
6 13869 linie_løb_tabel(sidste_linie_løb):= 0;
6 13870 bus_indeks(sidste_linie_løb):= false;
6 13871 sidste_linie_løb:= sidste_linie_løb-1;
6 13872 end;
5 13873
5 13873 <* opdater vogntabelfil *>
5 13874 disable s:= modiffil(tf_vogntabel,bi2,zi);
5 13875 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13876 fil(zi).ll:= if funk=6 then ll_id1 else 0;
5 13877 fil(zi).bn:= inf2 extract 14 add (bustabel1(bi2) extract 8 shift 14);
5 13878 if funk=6 then
5 13879 opd_log(d.op.kilde,3,bustabel(bi2),ll_id2,ll_id1)
5 13880 else
5 13881 opd_log(d.op.kilde,2,bustabel(bi2),ll_id2,0);
5 13882 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 13883 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13884 fil(zi).ll:= ll_id2;
5 13885 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 13886 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 13887 \f
5 13887 message procedure vt_opdater side 8 - 820301/cl;
5 13888
5 13888 end <* ll_id2 indkodet *>
4 13889 else
4 13890 begin
5 13891 if sign(s)=sign(li2-li1) then li2:=li2-sign(s);
5 13892 <* li2 skal være indeks for sidste linie/løb der skal flyttes i vt *>
5 13893 pm1:= sgn(li2-li1);
5 13894 for i:= li1 step pm1 until li2-pm1 do
5 13895 begin
6 13896 linie_løb_tabel(i):= linie_løb_tabel(i+pm1);
6 13897 busindeks(i):= busindeks(i+pm1);
6 13898 linie_løb_indeks(intg(busindeks(i+pm1))):= false add i;
6 13899 end;
5 13900 linie_løb_tabel(li2):= ll_id2;
5 13901 busindeks(li2):= false add bi1;
5 13902 linie_løb_indeks(bi1):= false add li2;
5 13903 disable s:= modiffil(tf_vogntabel,bi1,zi);
5 13904 if s<>0 then fejlreaktion(7,s,<:vt-omkod/flyt:>,0);
5 13905 fil(zi).ll:= ll_id2;
5 13906 fil(zi).bn:= inf1 extract 14 add (bustabel1(bi1) extract 8 shift 14);
5 13907 opd_log(d.op.kilde,3,bustabel(bi1),ll_id1,ll_id2);
5 13908 end;
4 13909 res:= 3; <*udført*>
4 13910 slut_flyt:
4 13911 d.op.resultat:= res;
4 13912 d.op.data(3):= inf1;
4 13913 if funk=5 then d.op.data(4):= inf2;
4 13914 end;
3 13915 goto returner;
3 13916 \f
3 13916 message procedure vt_opdater side 9 - 851001/cl;
3 13917
3 13917 slet:
3 13918 begin
4 13919 integer flin,slin,finx,sinx,s,li,bi,omr,gar;
4 13920 boolean test24;
4 13921
4 13921 if d.op.data(2)=0 then d.op.data(2):= d.op.data(1);
4 13922 omr:= d.op.data(3);
4 13923
4 13923 if d.op.data(1) > d.op.data(2) then
4 13924 begin
5 13925 res:= 44; <* intervalstørrelse ulovlig *>
5 13926 goto slut_slet;
5 13927 end;
4 13928
4 13928 flin:= (1 shift 22) + (d.op.data(1) extract 21 shift 7);
4 13929 slin:= (1 shift 22) + (d.op.data(2) extract 21 shift 7) + 127;
4 13930
4 13930 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(finx)-flin), finx);
4 13931 if s<0 then finx:= finx+1;
4 13932 s:= binærsøg(sidste_linie_løb, (linie_løb_tabel(sinx)-slin), sinx);
4 13933 if s>0 then sinx:= sinx-1;
4 13934
4 13934 for li:= finx step 1 until sinx do
4 13935 begin
5 13936 bi:= busindeks(li) extract 12;
5 13937 gar:= bustabel(bi) shift (-14) extract 8;
5 13938 if intg(bustilstand(bi))=0 and
5 13939 (omr = 0 or (omr > 0 and omr = gar) or
5 13940 (omr < 0 and omr extract 8 = bustabel1(bi) extract 8)) then
5 13941 begin
6 13942 opd_log(d.op.kilde,2,bustabel(bi),linie_løb_tabel(li),0);
6 13943 linie_løb_indeks(bi):= busindeks(li):= false;
6 13944 linie_løb_tabel(li):= 0;
6 13945 end;
5 13946 end;
4 13947 \f
4 13947 message procedure vt_opdater side 10 - 850820/cl;
4 13948
4 13948 sinx:= finx-1;
4 13949 for li:= finx step 1 until sidste_linie_løb do
4 13950 begin
5 13951 if linie_løb_tabel(li)<>0 then
5 13952 begin
6 13953 sinx:= sinx+1;
6 13954 if sinx<>li then
6 13955 begin
7 13956 linie_løb_tabel(sinx):= linie_løb_tabel(li);
7 13957 busindeks(sinx):= busindeks(li);
7 13958 linie_løb_indeks(busindeks(sinx) extract 12):= false add sinx;
7 13959 linie_løb_tabel(li):= 0;
7 13960 busindeks(li):= false;
7 13961 end;
6 13962 end;
5 13963 end;
4 13964 sidste_linie_løb:= sinx;
4 13965
4 13965 test24:= testbit24; testbit24:= false;
4 13966 for bi:= 1 step 1 until sidste_bus do
4 13967 disable
4 13968 begin
5 13969 s:= modiffil(tf_vogntabel,bi,finx);
5 13970 if s<>0 then fejlreaktion(7,s,<:vt-slet:>,0);
5 13971 fil(finx).bn:= bustabel(bi) extract 14 add
5 13972 (bustabel1(bi) extract 8 shift 14);
5 13973 fil(finx).ll:= linie_løb_tabel(linie_løb_indeks(bi) extract 12);
5 13974 end;
4 13975 testbit24:= test24;
4 13976 res:= 3;
4 13977
4 13977 slut_slet:
4 13978 d.op.resultat:= res;
4 13979 end;
3 13980 goto returner;
3 13981 \f
3 13981 message procedure vt_opdater side 11 - 810409/cl;
3 13982
3 13982 returner:
3 13983 disable
3 13984 begin
4 13985
4 13985 <*+2*>
4 13986 <**> if testbit40 and overvåget then
4 13987 <**> begin
5 13988 <**> skriv_vt_opd(out,0);
5 13989 <**> write(out,<: vogntabel efter ændring:>);
5 13990 <**> p_vogntabel(out);
5 13991 <**> end;
4 13992 <**> if testbit41 and overvåget then
4 13993 <**> begin
5 13994 <**> skriv_vt_opd(out,0);
5 13995 <**> write(out,<: returner operation:>);
5 13996 <**> skriv_op(out,op);
5 13997 <**> end;
4 13998 <*-2*>
4 13999
4 13999 signalch(d.op.retur,op,d.op.optype);
4 14000 end;
3 14001 goto vent_op;
3 14002
3 14002 vt_opd_trap:
3 14003 disable skriv_vt_opd(zbillede,1);
3 14004
3 14004 end vt_opdater;
2 14005 \f
2 14005 message procedure vt_tilstand side 1 - 810424/cl;
2 14006
2 14006 procedure vt_tilstand(cs_fil,fil_opref);
2 14007 value cs_fil,fil_opref;
2 14008 integer cs_fil,fil_opref;
2 14009 begin
3 14010 integer array field op,filop;
3 14011 integer funk,format,busid,res,bi,tilst,opk,opk_indeks,
3 14012 g_type,gr,antal,ej_res,zi,li,filref;
3 14013 integer array identer(1:max_antal_i_gruppe);
3 14014
3 14014 procedure skriv_vt_tilst(zud,omfang);
3 14015 value omfang;
3 14016 zone zud;
3 14017 integer omfang;
3 14018 begin
4 14019 real array field raf;
4 14020 raf:= 0;
4 14021 write(zud,"nl",1,<:+++ vt_tilstand :>);
4 14022 if omfang <> 0 then
4 14023 begin
5 14024 skriv_coru(zud,abs curr_coruno);
5 14025 write(zud,"nl",1,<<d>,
5 14026 <:cs-fil :>,cs_fil,"nl",1,
5 14027 <:filop :>,filop,"nl",1,
5 14028 <:op :>,op,"nl",1,
5 14029 <:funk :>,funk,"nl",1,
5 14030 <:format :>,format,"nl",1,
5 14031 <:busid :>,busid,"nl",1,
5 14032 <:res :>,res,"nl",1,
5 14033 <:bi :>,bi,"nl",1,
5 14034 <:tilst :>,tilst,"nl",1,
5 14035 <:opk :>,opk,"nl",1,
5 14036 <:opk-indeks :>,opk_indeks,"nl",1,
5 14037 <:g-type :>,g_type,"nl",1,
5 14038 <:gr :>,gr,"nl",1,
5 14039 <:antal :>,antal,"nl",1,
5 14040 <:ej-res :>,ej_res,"nl",1,
5 14041 <:zi :>,zi,"nl",1,
5 14042 <:li :>,li,"nl",1,
5 14043 <::>);
5 14044 write(zud,"nl",1,<:identer:>);
5 14045 skriv_hele(zud,identer.raf,max_antal_i_gruppe*2,2);
5 14046 end;
4 14047 end;
3 14048
3 14048 procedure sorter_gruppe(tab,l,u);
3 14049 value l,u;
3 14050 integer array tab;
3 14051 integer l,u;
3 14052 begin
4 14053 integer array field ii,jj;
4 14054 integer array ww, xx(1:2);
4 14055
4 14055 integer procedure sml(a,b);
4 14056 integer array a,b;
4 14057 begin
5 14058 integer res;
5 14059
5 14059 res:= sign((a(1) shift (-8) extract 4) - (b(1) shift (-8) extract 4));
5 14060 if res = 0 then
5 14061 res:= sign((b(1) shift (-18)) - (a(1) shift (-18)));
5 14062 if res = 0 then
5 14063 res:=
5 14064 sign((a(1) shift (-12) extract 6) - (b(1) shift (-12) extract 6));
5 14065 if res = 0 then
5 14066 res:= sign((a(2) extract 14) - (b(2) extract 14));
5 14067 sml:= res;
5 14068 end;
4 14069
4 14069 ii:= ((l+u)//2 - 1)*4;
4 14070 tofrom(xx,tab.ii,4);
4 14071 ii:= (l-1)*4; jj:= (u-1)*4;
4 14072 repeat
4 14073 while sml(tab.ii,xx) < 0 do ii:= ii+4;
4 14074 while sml(xx,tab.jj) < 0 do jj:= jj-4;
4 14075 if ii <= jj then
4 14076 begin
5 14077 tofrom(ww,tab.ii,4);
5 14078 tofrom(tab.ii,tab.jj,4);
5 14079 tofrom(tab.jj,ww,4);
5 14080 ii:= ii+4;
5 14081 jj:= jj-4;
5 14082 end;
4 14083 until ii>jj;
4 14084 if l < jj//4+1 then sorter_gruppe(tab,l,jj//4+1);
4 14085 if ii//4+1 < u then sorter_gruppe(tab,ii//4+1,u);
4 14086 end;
3 14087 \f
3 14087 message procedure vt_tilstand side 2 - 820301/cl;
3 14088
3 14088 filop:= filopref;
3 14089 stackclaim(if cm_test then 550 else 500);
3 14090 trap(vt_tilst_trap);
3 14091
3 14091 <*+2*>
3 14092 <**> disable if testbit47 and overvåget or testbit28 then
3 14093 <**> skriv_vt_tilst(out,0);
3 14094 <*-2*>
3 14095
3 14095 vent_op:
3 14096 waitch(cs_vt_tilst,op,vt_optype or gen_optype,-1);
3 14097 <*+2*>disable
3 14098 <**> if (testbit41 and overvåget) or
3 14099 (testbit46 and overvåget and
3 14100 (d.op.opkode extract 12 = 16 or d.op.opkode extract 12 = 18))
3 14101 then
3 14102 <**> begin
4 14103 <**> skriv_vt_tilst(out,0);
4 14104 <**> write(out,<: modtaget operation:>);
4 14105 <**> skriv_op(out,op);
4 14106 <**> end;
3 14107 <*-2*>
3 14108
3 14108 <*+4*>
3 14109 <**> if op <> vt_op then
3 14110 <**> begin
4 14111 <**> disable begin
5 14112 <**> d.op.resultat:= 31;
5 14113 <**> fejlreaktion(11,op,<:vt-tilstand:>,1);
5 14114 <**> end;
4 14115 <**> goto returner;
4 14116 <**> end;
3 14117 <*-4*>
3 14118
3 14118 opk:= d.op.opkode extract 12;
3 14119 funk:= if opk = 14 <*bus i kø*> then 1 else
3 14120 if opk = 15 <*bus res *> then 2 else
3 14121 if opk = 16 <*grp res *> then 4 else
3 14122 if opk = 17 <*bus fri *> then 3 else
3 14123 if opk = 18 <*grp fri *> then 5 else
3 14124 0;
3 14125 if funk = 0 then fejlreaktion(2,opk,<:vt_tilstand:>,0);
3 14126 res:= 0;
3 14127 format:= d.op.data(1) shift (-22);
3 14128
3 14128 goto case funk of(enkelt_bus,enkelt_bus,enkelt_bus,grp_res,grp_fri);
3 14129 \f
3 14129 message procedure vt_tilstand side 3 - 820301/cl;
3 14130
3 14130 enkelt_bus:
3 14131 <* sæt enkelt bus i kø, reserver eller frigiv enkelt bus *>
3 14132 disable
3 14133 begin integer busnr,i,s,tilst,ll,gar,omr,sig;
4 14134 <*+4*>
4 14135 <**>if format <> 0 and format <> 1 then
4 14136 <**>begin
5 14137 <**> res:= 31;
5 14138 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14139 <**> goto slut_enkelt_bus;
5 14140 <**>end;
4 14141 <*-4*>
4 14142 <* find busnr og tilstand *>
4 14143 case format+1 of
4 14144 begin
5 14145 <* 0: budident *>
5 14146 begin
6 14147 busnr:= d.op.data(1) extract 14;
6 14148 s:= omr:= d.op.data(4) extract 8;
6 14149 bi:= søg_omr_bus(busnr,ll,gar,omr,sig,tilst);
6 14150 if bi<0 then
6 14151 begin
7 14152 res:= if bi=(-1) then 10 else (if s<>0 then 58 else 57);
7 14153 goto slut_enkelt_bus;
7 14154 end
6 14155 else
6 14156 begin
7 14157 tilst:= intg(bustilstand(bi));
7 14158 end;
6 14159 end;
5 14160
5 14160 <* 1: linie_løb_ident *>
5 14161 begin
6 14162 bi:= findbusnr(d.op.data(1),busnr,i,tilst);
6 14163 if bi < 0 then <* ukendt linie_løb *>
6 14164 begin
7 14165 res:= 9;
7 14166 goto slut_enkelt_bus;
7 14167 end;
6 14168 end;
5 14169 end case;
4 14170 \f
4 14170 message procedure vt_tilstand side 4 - 830310/cl;
4 14171
4 14171 if funk < 3 then
4 14172 begin
5 14173 d.op.data(2):= if linie_løb_indeks(bi) extract 12 <> 0 then
5 14174 linie_løb_tabel(linie_løb_indeks(bi) extract 12)
5 14175 else 0;
5 14176 d.op.data(3):= bustabel(bi);
5 14177 d.op.data(4):= bustabel1(bi);
5 14178 end;
4 14179
4 14179 <* check tilstand *>
4 14180 if funk = 3 <*frigiv*> and tilst >= 0 <*fri/optaget_i_gruppe*> then
4 14181 res:= 39 <* bus ikke reserveret *>
4 14182 else
4 14183 if tilst <> 0 and tilst <> (-1) and funk < 3 then
4 14184 res:= 14 <* bus optaget *>
4 14185 else
4 14186 if funk = 1 <* i kø *> and tilst = (-1) then
4 14187 res:= 18 <* i kø *>
4 14188 else
4 14189 res:= 3; <*udført*>
4 14190
4 14190 if res = 3 then
4 14191 bustilstand(bi):= false add (case funk of (-1,-2,0));
4 14192
4 14192 slut_enkelt_bus:
4 14193 d.op.resultat:= res;
4 14194 end <*disable*>;
3 14195 goto returner;
3 14196 \f
3 14196 message procedure vt_tilstand side 5 - 810424/cl;
3 14197
3 14197 grp_res: <* reserver gruppe *>
3 14198 disable
3 14199 begin
4 14200
4 14200 <*+4*>
4 14201 <**> if format <> 2 then
4 14202 <**> begin
5 14203 <**> res:= 31;
5 14204 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14205 <**> goto slut_grp_res_1;
5 14206 <**> end;
4 14207 <*-4*>
4 14208
4 14208 <* find frit indeks i opkaldstabel *>
4 14209 opk_indeks:= 0;
4 14210 for i:= max_antal_gruppeopkald step -1 until 1 do
4 14211 begin
5 14212 if gruppeopkald(i,1)=0 then opk_indeks:= i <*fri plads*> else
5 14213 if gruppeopkald(i,1)=d.op.data(1) then res:= 15 <*optaget*>;
5 14214 end;
4 14215 if opk_indeks = 0 then res:= 32; <* ingen plads *>
4 14216 if res <> 0 then goto slut_grp_res_1;
4 14217 g_type:= d.op.data(1) shift (-21) extract 1;
4 14218 if g_type = 1 <*special gruppe*> then
4 14219 begin <*check eksistens*>
5 14220 gr:= 0;
5 14221 for i:= 1 step 1 until max_antal_grupper do
5 14222 if gruppetabel(i) = d.op.data(1) then gr:= i;
5 14223 if gr = 0 then <*gruppe ukendt*>
5 14224 begin
6 14225 res:= 8;
6 14226 goto slut_grp_res_1;
6 14227 end;
5 14228 end;
4 14229
4 14229 <* reserver i opkaldstabel *>
4 14230 gruppeopkald(opk_indeks,1):= d.op.data(1);
4 14231 \f
4 14231 message procedure vt_tilstand side 6 - 810428/cl;
4 14232
4 14232 <* tilknyt fil *>
4 14233 start_operation(filop,curr_coruid,cs_fil,101);
4 14234 d.filop.data(1):= 0; <*postantal*>
4 14235 d.filop.data(2):= 256; <*postlængde*>
4 14236 d.filop.data(3):= 1; <*segmentantal*>
4 14237 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14238 signalch(cs_opret_fil,filop,vt_optype);
4 14239
4 14239 slut_grp_res_1:
4 14240 if res <> 0 then d.op.resultat:= res;
4 14241 end;
3 14242 if res <> 0 then goto returner;
3 14243
3 14243 waitch(cs_fil,filop,vt_optype,-1);
3 14244
3 14244 <* check filsys-resultat *>
3 14245 if d.filop.data(9) <> 0 then
3 14246 fejlreaktion(13,d.filop.data(9),<:gruppe,res:>,0);
3 14247 filref:= d.filop.data(4);
3 14248 \f
3 14248 message procedure vt_tilstand side 7 - 820301/cl;
3 14249 disable if g_type = 0 <*linie-gruppe*> then
3 14250 begin
4 14251 integer s,i,ll_id;
4 14252 integer array field iaf1;
4 14253
4 14253 ll_id:= 1 shift 22 + d.op.data(1) shift 7;
4 14254 iaf1:= 2;
4 14255 s:= binærsøg(sidste_linie_løb,
4 14256 linie_løb_tabel(i) - ll_id, i);
4 14257 if s < 0 then i:= i +1;
4 14258 antal:= ej_res:= 0;
4 14259 skrivfil(filref,1,zi);
4 14260 if i <= sidste_linie_løb then
4 14261 begin
5 14262 while linie_løb_tabel(i) shift (-7) shift 7 = ll_id do
5 14263 begin
6 14264 if (intg(bustilstand(intg(busindeks(i))))<>0) or
6 14265 (bustabel1(intg(busindeks(i))) extract 8 <> 3) then
6 14266 ej_res:= ej_res+1
6 14267 else
6 14268 begin
7 14269 antal:= antal+1;
7 14270 bi:= busindeks(i) extract 12;
7 14271 fil(zi).iaf1(1):=
7 14272 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
7 14273 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
7 14274 fil(zi).iaf1(2):= bustabel(bi);
7 14275 iaf1:= iaf1+4;
7 14276 bustilstand(bi):= false add opk_indeks;
7 14277 end;
6 14278 i:= i +1;
6 14279 if i > sidste_linie_løb then goto slut_l_grp;
6 14280 end;
5 14281 end;
4 14282 \f
4 14282 message procedure vt_tilstand side 8 - 820301/cl;
4 14283
4 14283 slut_l_grp:
4 14284 end
3 14285 else
3 14286 begin <*special gruppe*>
4 14287 integer i,s,li,omr,gar,tilst;
4 14288 integer array field iaf1;
4 14289
4 14289 iaf1:= 2;
4 14290 antal:= ej_res:= 0;
4 14291 s:= læsfil(tf_gruppedef,gr,zi);
4 14292 if s <> 0 then fejlreaktion(5,s,<:gruppe,res:>,0);
4 14293 tofrom(identer,fil(zi),max_antal_i_gruppe*2);
4 14294 s:= skrivfil(filref,1,zi);
4 14295 if s<>0 then fejlreaktion(6,s,<:gruppe,res:>,0);
4 14296 i:= 1;
4 14297 while identer(i) <> 0 do
4 14298 begin
5 14299 if identer(i) shift (-22) = 0 then
5 14300 begin <*busident*>
6 14301 omr:= 0;
6 14302 bi:= søg_omr_bus(identer(i),li,gar,omr,s,tilst);
6 14303 if bi<0 then goto næste_ident;
6 14304 li:= linie_løb_indeks(bi) extract 12;
6 14305 end
5 14306 else
5 14307 begin <*linie/løb ident*>
6 14308 s:= binærsøg(sidste_linie_løb,
6 14309 linie_løb_tabel(li) - identer(i), li);
6 14310 if s <> 0 then goto næste_ident;
6 14311 bi:= busindeks(li) extract 12;
6 14312 end;
5 14313 if (intg(bustilstand(bi))<>0) or
5 14314 (bustabel1(bi) extract 8 <> 3) then
5 14315 ej_res:= ej_res+1
5 14316 else
5 14317 begin
6 14318 antal:= antal +1;
6 14319 fil(zi).iaf1(1):=
6 14320 område_id( bustabel1(bi) extract 8, 2) extract 12 shift 12 +
6 14321 (bustabel1(bi) shift (-23) + 1) shift 8 + 1;
6 14322 fil(zi).iaf1(2):= bustabel(bi);
6 14323 iaf1:= iaf1+4;
6 14324 bustilstand(bi):= false add opk_indeks;
6 14325 end;
5 14326 næste_ident:
5 14327 i:= i +1;
5 14328 if i > max_antal_i_gruppe then goto slut_s_grp;
5 14329 end;
4 14330 slut_s_grp:
4 14331 end;
3 14332 \f
3 14332 message procedure vt_tilstand side 9 - 820301/cl;
3 14333
3 14333 if antal > 0 then <*ok*>
3 14334 disable begin
4 14335 integer array field spec,akt;
4 14336 integer a;
4 14337 integer field antal_spec;
4 14338
4 14338 antal_spec:= 2; a:= 0;
4 14339 spec:= 2; akt:= 2;
4 14340 sorter_gruppe(fil(zi).spec,1,antal);
4 14341 fil(zi).antal_spec:= 0;
4 14342 while akt//4 < antal do
4 14343 begin
5 14344 fil(zi).spec(1):= fil(zi).akt(1) shift (-8) shift 8;
5 14345 a:= 0;
5 14346 while fil(zi).akt(1) shift (-8) = fil(zi).spec(1) shift (-8)
5 14347 and a<15 do
5 14348 begin
6 14349 a:= a+1;
6 14350 fil(zi).spec(1+a):= fil(zi).akt(2) extract 14;
6 14351 akt:= akt+4;
6 14352 end;
5 14353 fil(zi).spec(1):= fil(zi).spec(1) + a;
5 14354 fil(zi).antal_spec:= fil(zi).antal_spec+1;
5 14355 spec:= spec + 2*a + 2;
5 14356 end;
4 14357 antal:= fil(zi).antal_spec;
4 14358 gruppeopkald(opk_indeks,2):= filref;
4 14359 d.op.resultat:= 3;
4 14360 d.op.data(2):= antal;
4 14361 d.op.data(3):= filref;
4 14362 d.op.data(4):= ej_res;
4 14363 end
3 14364 else
3 14365 begin
4 14366 disable begin
5 14367 d.filop.opkode:= 104; <*slet fil*>
5 14368 signalch(cs_slet_fil,filop,vt_optype);
5 14369 gruppeopkald(opk_indeks,1):= 0; <*fri*>
5 14370 d.op.resultat:= 54;
5 14371 d.op.data(2):= antal;
5 14372 d.op.data(3):= 0;
5 14373 d.op.data(4):= ej_res;
5 14374 end;
4 14375 waitch(cs_fil,filop,vt_optype,-1);
4 14376 if d.filop.data(9) <> 0 then
4 14377 fejlreaktion(16,d.filop.data(9),<:gruppe,res:>,0);
4 14378 end;
3 14379 goto returner;
3 14380 \f
3 14380 message procedure vt_tilstand side 10 - 820301/cl;
3 14381
3 14381 grp_fri: <* frigiv gruppe *>
3 14382 disable
3 14383 begin integer i,j,s,ll,gar,omr,tilst;
4 14384 integer array field spec;
4 14385
4 14385 <*+4*>
4 14386 <**> if format <> 2 then
4 14387 <**> begin
5 14388 <**> res:= 31;
5 14389 <**> fejlreaktion(10,d.op.data(1),<:tilstand ident:>,1);
5 14390 <**> goto slut_grp_fri;
5 14391 <**> end;
4 14392 <*-4*>
4 14393
4 14393 <* find indeks i opkaldstabel *>
4 14394 opk_indeks:= 0;
4 14395 for i:= 1 step 1 until max_antal_gruppeopkald do
4 14396 if gruppeopkald(i,1) = d.op.data(1) then opk_indeks:= i;
4 14397 if opk_indeks = 0 <*ikke fundet*> then
4 14398 begin
5 14399 res:= 40; <*gruppe ej reserveret*>
5 14400 goto slut_grp_fri;
5 14401 end;
4 14402 filref:= gruppeopkald(opk_indeks,2);
4 14403 start_operation(filop,curr_coruid,cs_fil,104);
4 14404 d.filop.data(4):= filref;
4 14405 hentfildim(d.filop.data);
4 14406 læsfil(filref,1,zi);
4 14407 spec:= 0;
4 14408 antal:= fil(zi).spec(1);
4 14409 spec:= spec+2;
4 14410 for i:= 1 step 1 until antal do
4 14411 begin
5 14412 for j:= 1 step 1 until fil(zi).spec(1) extract 8 do
5 14413 begin
6 14414 busid:= fil(zi).spec(1+j) extract 14;
6 14415 omr:= 0;
6 14416 bi:= søg_omr_bus(busid,ll,gar,omr,s,tilst);
6 14417 if bi>=0 then bustilstand(bi):= false;
6 14418 end;
5 14419 spec:= spec + 2*(fil(zi).spec(1) extract 8) + 2;
5 14420 end;
4 14421
4 14421 slut_grp_fri:
4 14422 d.op.resultat:= res;
4 14423 end;
3 14424 if res <> 0 then goto returner;
3 14425 gruppeopkald(opk_indeks,1):= gruppeopkald(opk_indeks,2):= 0;
3 14426 signalch(cs_slet_fil,filop,vt_optype);
3 14427 \f
3 14427 message procedure vt_tilstand side 11 - 810424/cl;
3 14428
3 14428 waitch(cs_fil,filop,vt_optype,-1);
3 14429
3 14429 if d.filop.data(9) <> 0 then
3 14430 fejlreaktion(16,d.filop.data(9),<:gruppe,fri:>,0);
3 14431 d.op.resultat:= 3;
3 14432
3 14432 returner:
3 14433 disable
3 14434 begin
4 14435 <*+2*>
4 14436 <**> if testbit40 and overvåget then
4 14437 <**> begin
5 14438 <**> skriv_vt_tilst(out,0);
5 14439 <**> write(out,<: vogntabel efter ændring:>);
5 14440 <**> p_vogntabel(out);
5 14441 <**> end;
4 14442 <**> if testbit43 and overvåget and (funk=4 or funk=5) then
4 14443 <**> begin
5 14444 <**> skriv_vt_tilst(out,0); write(out,<: gruppetabel efter ændring:>);
5 14445 <**> p_gruppetabel(out);
5 14446 <**> end;
4 14447 <**> if (testbit41 and overvåget) or
4 14448 <**> (testbit46 and overvåget and (funk=4 or funk=5)) then
4 14449 <**> begin
5 14450 <**> skriv_vt_tilst(out,0);
5 14451 <**> write(out,<: returner operation:>);
5 14452 <**> skriv_op(out,op);
5 14453 <**> end;
4 14454 <*-2*>
4 14455 signalch(d.op.retur,op,d.op.optype);
4 14456 end;
3 14457 goto vent_op;
3 14458
3 14458 vt_tilst_trap:
3 14459 disable skriv_vt_tilst(zbillede,1);
3 14460
3 14460 end vt_tilstand;
2 14461 \f
2 14461 message procedure vt_rapport side 1 - 810428/cl;
2 14462
2 14462 procedure vt_rapport(cs_fil,fil_opref);
2 14463 value cs_fil,fil_opref;
2 14464 integer cs_fil,fil_opref;
2 14465 begin
3 14466 integer array field op,filop;
3 14467 integer funk,filref,antal,id_ant,res;
3 14468 integer field i1,i2;
3 14469
3 14469 procedure skriv_vt_rap(z,omfang);
3 14470 value omfang;
3 14471 zone z;
3 14472 integer omfang;
3 14473 begin
4 14474 write(z,"nl",1,<:+++ vt_rapport :>);
4 14475 if omfang <> 0 then
4 14476 begin
5 14477 skriv_coru(z,abs curr_coruno);
5 14478 write(z,"nl",1,<<d>,
5 14479 <: cs_fil :>,cs_fil,"nl",1,
5 14480 <: filop :>,filop,"nl",1,
5 14481 <: op :>,op,"nl",1,
5 14482 <: funk :>,funk,"nl",1,
5 14483 <: filref :>,filref,"nl",1,
5 14484 <: antal :>,antal,"nl",1,
5 14485 <: id-ant :>,id_ant,"nl",1,
5 14486 <: res :>,res,"nl",1,
5 14487 <::>);
5 14488
5 14488 end;
4 14489 end skriv_vt_rap;
3 14490
3 14490 stackclaim(if cm_test then 198 else 146);
3 14491 filop:= fil_opref;
3 14492 i1:= 2; i2:= 4;
3 14493 trap(vt_rap_trap);
3 14494
3 14494 <*+2*>
3 14495 <**> disable if testbit47 and overvåget or testbit28 then
3 14496 <**> skriv_vt_rap(out,0);
3 14497 <*-2*>
3 14498 \f
3 14498 message procedure vt_rapport side 2 - 810505/cl;
3 14499
3 14499 vent_op:
3 14500 waitch(cs_vt_rap,op,gen_optype or vt_optype,-1);
3 14501
3 14501 <*+2*>
3 14502 <**> disable begin
4 14503 <**> if testbit41 and overvåget then
4 14504 <**> begin
5 14505 <**> skriv_vt_rap(out,0);
5 14506 <**> write(out,<: modtaget operation:>);
5 14507 <**> skriv_op(out,op);
5 14508 <**> ud;
5 14509 <**> end;
4 14510 <**> end;<*disable*>
3 14511 <*-2*>
3 14512
3 14512 disable
3 14513 begin
4 14514 integer opk;
4 14515
4 14515 opk:= d.op.opkode extract 12;
4 14516 funk:= if opk = 9 then 1 else
4 14517 if opk =10 then 2 else
4 14518 0;
4 14519 if funk = 0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14520
4 14520 <* opret og tilknyt fil *>
4 14521 start_operation(filop,curr_coruid,cs_fil,101);
4 14522 d.filop.data(1):= 0; <*postantal(midlertidigt)*>
4 14523 d.filop.data(2):= 2; <*postlængde*>
4 14524 d.filop.data(3):=10; <*segmenter*>
4 14525 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14526 signalch(cs_opretfil,filop,vt_optype);
4 14527 end;
3 14528
3 14528 waitch(cs_fil,filop,vt_optype,-1);
3 14529
3 14529 <* check resultat *>
3 14530 if d.filop.data(9) <> 0 then
3 14531 fejlreaktion(13,d.filop.data(9),<:vt-rapport:>,0);
3 14532 filref:= d.filop.data(4);
3 14533 antal:= 0;
3 14534 goto case funk of (l_rapport,b_rapport);
3 14535 \f
3 14535 message procedure vt_rapport side 3 - 850820/cl;
3 14536
3 14536 l_rapport:
3 14537 disable
3 14538 begin
4 14539 integer i,j,s,ll,zi;
4 14540 idant:= 0;
4 14541 for id_ant:= id_ant+1 while d.op.data(id_ant)<>0 and id_ant<5 do
4 14542 <*+4*>
4 14543 <**> if d.op.data(id_ant) shift (-22) <> 2 then
4 14544 <**> begin
5 14545 <**> res:= 31;
5 14546 <**> fejlreaktion(10,d.op.data(id_ant),<:l-rapport ident:>,1);
5 14547 <**> goto l_rap_slut;
5 14548 <**> end;
4 14549 <*-4*>
4 14550 ;
4 14551
4 14551 for i:= 1 step 1 until id_ant do
4 14552 begin
5 14553 ll:= (1 shift 22) + d.op.data(i) extract 15 shift 7;
5 14554 s:= binærsøg(sidste_linie_løb,
5 14555 linie_løb_tabel(j) - ll, j);
5 14556 if s < 0 then j:= j +1;
5 14557
5 14557 if j<= sidste_linie_løb then
5 14558 begin <* skriv identer *>
6 14559 while linie_løb_tabel(j) shift (-7) shift 7 = ll do
6 14560 begin
7 14561 antal:= antal +1;
7 14562 s:= skrivfil(filref,antal,zi);
7 14563 if s <> 0 then fejlreaktion(6,s,<:vt_rapport:>,0);
7 14564 fil(zi).i1:= linie_løb_tabel(j);
7 14565 fil(zi).i2:= bustabel(busindeks(j) extract 12);
7 14566 j:= j +1;
7 14567 if j > sidste_bus then goto linie_slut;
7 14568 end;
6 14569 end;
5 14570 linie_slut:
5 14571 end;
4 14572 res:= 3;
4 14573 l_rap_slut:
4 14574 end <*disable*>;
3 14575 goto returner;
3 14576 \f
3 14576 message procedure vt_rapport side 4 - 820301/cl;
3 14577
3 14577 b_rapport:
3 14578 disable
3 14579 begin
4 14580 integer i,j,s,zi,busnr1,busnr2;
4 14581 <*+4*>
4 14582 <**> for i:= 1,2 do
4 14583 <**> if d.op.data(i) shift (-14) <> 0 then
4 14584 <**> begin
5 14585 <**> res:= 31;
5 14586 <**> fejlreaktion(10,d.op.data(i),<:b-rapport ident:>,1);
5 14587 <**> goto bus_slut;
5 14588 <**> end;
4 14589 <*-4*>
4 14590
4 14590 busnr1:= d.op.data(1) extract 14;
4 14591 busnr2:= if d.op.data(2) = 0 then busnr1 else d.op.data(2) extract 14;
4 14592 if busnr1 = 0 or busnr2 < busnr1 then
4 14593 begin
5 14594 res:= 7; <* fejl i busnr *>
5 14595 goto bus_slut;
5 14596 end;
4 14597
4 14597 s:= binærsøg(sidste_bus,bustabel(j) extract 14
4 14598 - busnr1,j);
4 14599 if s < 0 then j:= j +1;
4 14600 while j>1 and bustabel(j-1) extract 14 >= busnr1 do j:= j-1;
4 14601 if j <= sidste_bus then
4 14602 begin <* skriv identer *>
5 14603 while bustabel(j) extract 14 <= busnr2 do
5 14604 begin
6 14605 i:= linie_løb_indeks(j) extract 12;
6 14606 if i<>0 then
6 14607 begin
7 14608 antal:= antal +1;
7 14609 s:= skriv_fil(filref,antal,zi);
7 14610 if s <> 0 then fejlreaktion(6,s,<:vt-rapport:>,0);
7 14611 fil(zi).i1:= bustabel(j);
7 14612 fil(zi).i2:= linie_løb_tabel(i);
7 14613 end;
6 14614 j:= j +1;
6 14615 if j > sidste_bus then goto bus_slut;
6 14616 end;
5 14617 end;
4 14618 bus_slut:
4 14619 end <*disable*>;
3 14620 res:= 3; <*ok*>
3 14621 \f
3 14621 message procedure vt_rapport side 5 - 810409/cl;
3 14622
3 14622 returner:
3 14623 disable
3 14624 begin
4 14625 d.op.resultat:= res;
4 14626 d.op.data(6):= antal;
4 14627 d.op.data(7):= filref;
4 14628 d.filop.data(1):= antal;
4 14629 d.filop.data(3):= (antal*d.filop.data(2) -1)//256 +1;
4 14630 i:= sæt_fil_dim(d.filop.data);
4 14631 if i <> 0 then fejlreaktion(9,i,<:vt-rapport:>,0);
4 14632 <*+2*>
4 14633 <**> if testbit41 and overvåget then
4 14634 <**> begin
5 14635 <**> skriv_vt_rap(out,0);
5 14636 <**> write(out,<: returner operation:>);
5 14637 <**> skriv_op(out,op);
5 14638 <**> end;
4 14639 <*-2*>
4 14640 signalch(d.op.retur,op,d.op.optype);
4 14641 end;
3 14642 goto vent_op;
3 14643
3 14643 vt_rap_trap:
3 14644 disable skriv_vt_rap(zbillede,1);
3 14645
3 14645 end vt_rapport;
2 14646 \f
2 14646 message procedure vt_gruppe side 1 - 810428/cl;
2 14647
2 14647 procedure vt_gruppe(cs_fil,fil_opref);
2 14648
2 14648 value cs_fil,fil_opref;
2 14649 integer cs_fil,fil_opref;
2 14650 begin
3 14651 integer array field op, fil_op, iaf;
3 14652 integer funk, res, filref, gr, i, antal, zi, s;
3 14653 integer array identer(1:(if max_antal_grupper>max_antal_i_gruppe then
3 14654 max_antal_grupper else max_antal_i_gruppe));
3 14655
3 14655 procedure skriv_vt_gruppe(zud,omfang);
3 14656 value omfang;
3 14657 integer omfang;
3 14658 zone zud;
3 14659 begin
4 14660 integer øg;
4 14661
4 14661 write(zud,"nl",1,<:+++ vt_gruppe :>);
4 14662 if omfang <> 0 then
4 14663 disable
4 14664 begin
5 14665 skriv_coru(zud,abs curr_coruno);
5 14666 write(zud,"nl",1,<<d>,
5 14667 <: cs_fil :>,cs_fil,"nl",1,
5 14668 <: op :>,op,"nl",1,
5 14669 <: filop :>,filop,"nl",1,
5 14670 <: funk :>,funk,"nl",1,
5 14671 <: res :>,res,"nl",1,
5 14672 <: filref :>,filref,"nl",1,
5 14673 <: gr :>,gr,"nl",1,
5 14674 <: i :>,i,"nl",1,
5 14675 <: antal :>,antal,"nl",1,
5 14676 <: zi :>,zi,"nl",1,
5 14677 <: s :>,s,"nl",1,
5 14678 <::>);
5 14679 raf:= 0;
5 14680 system(3,øg,identer);
5 14681 write(zud,"nl",1,<:identer::>);
5 14682 skriv_hele(zud,identer.raf,øg*2,2);
5 14683 end;
4 14684 end;
3 14685
3 14685 stackclaim(if cm_test then 198 else 146);
3 14686 filop:= fil_opref;
3 14687 trap(vt_grp_trap);
3 14688 iaf:= 0;
3 14689 \f
3 14689 message procedure vt_gruppe side 2 - 810409/cl;
3 14690
3 14690 <*+2*>
3 14691 <**> disable if testbit47 and overvåget or testbit28 then
3 14692 <**> skriv_vt_gruppe(out,0);
3 14693 <*-2*>
3 14694
3 14694 vent_op:
3 14695 waitch(cs_vt_grp,op,gen_optype or vt_optype,-1);
3 14696 <*+2*>
3 14697 <**>disable
3 14698 <**>begin
4 14699 <**> if testbit41 and overvåget then
4 14700 <**> begin
5 14701 <**> skriv_vt_gruppe(out,0);
5 14702 <**> write(out,<: modtaget operation:>);
5 14703 <**> skriv_op(out,op);
5 14704 <**> ud;
5 14705 <**> end;
4 14706 <**>end;
3 14707 <*-2*>
3 14708
3 14708 disable
3 14709 begin
4 14710 integer opk;
4 14711
4 14711 opk:= d.op.opkode extract 12;
4 14712 funk:= if opk=25 then 1 else
4 14713 if opk=26 then 2 else
4 14714 if opk=27 then 3 else
4 14715 if opk=28 then 4 else
4 14716 0;
4 14717 if funk=0 then fejlreaktion(2,opk,<:vt_gruppe:>,0);
4 14718 end;
3 14719 <*+4*>
3 14720 <**> if funk<4 and d.op.data(1) shift (-21) <> 5 then
3 14721 <**> begin
4 14722 <**> disable begin
5 14723 <**> d.op.resultat:= 31;
5 14724 <**> fejlreaktion(10,d.op.data(1),<:gruppe ident:>,1);
5 14725 <**> end;
4 14726 <**> goto returner;
4 14727 <**> end;
3 14728 <*-4*>
3 14729
3 14729 goto case funk of(definer,slet,vis,oversigt);
3 14730 \f
3 14730 message procedure vt_gruppe side 3 - 810505/cl;
3 14731
3 14731 definer:
3 14732 disable
3 14733 begin
4 14734 gr:= 0; res:= 0;
4 14735 for i:= max_antal_grupper step -1 until 1 do
4 14736 begin
5 14737 if gruppetabel(i)=0 then gr:= i <*fri plads*> else
5 14738 if gruppetabel(i)=d.op.data(1) then res:= 34; <*allerede defineret*>
5 14739 end;
4 14740 if gr=0 then res:= 32; <*ingen plads*>
4 14741 end;
3 14742 if res<>0 then goto slut_definer;
3 14743 disable
3 14744 begin <*fri plads fundet*>
4 14745 antal:= d.op.data(2);
4 14746 if antal <=0 or max_antal_i_gruppe<antal then
4 14747 res:= 33 <*fejl i gruppestørrelse*>
4 14748 else
4 14749 begin
5 14750 for i:= 1 step 1 until antal do
5 14751 begin
6 14752 s:= læsfil(d.op.data(3),i,zi);
6 14753 if s<>0 then fejlreaktion(5,s,<:gruppe,def:>,0);
6 14754 identer(i):= fil(zi).iaf(1);
6 14755 end;
5 14756 s:= modif_fil(tf_gruppedef,gr,zi);
5 14757 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14758 tofrom(fil(zi).iaf,identer,antal*2);
5 14759 for i:= antal+1 step 1 until max_antal_i_gruppe do
5 14760 fil(zi).iaf(i):= 0;
5 14761 gruppetabel(gr):= d.op.data(1);
5 14762 s:= modiffil(tf_gruppeidenter,gr,zi);
5 14763 if s<>0 then fejlreaktion(7,s,<:gruppe,def:>,0);
5 14764 fil(zi).iaf(1):= gruppetabel(gr);
5 14765 res:= 3;
5 14766 end;
4 14767 end;
3 14768 slut_definer:
3 14769 <*slet fil*>
3 14770 start_operation(fil_op,curr_coruid,cs_fil,104);
3 14771 d.filop.data(4):= d.op.data(3);
3 14772 signalch(cs_slet_fil,filop,vt_optype);
3 14773 waitch(cs_fil,filop,vt_optype,-1);
3 14774 if d.filop.data(9)<>0 then fejlreaktion(16,d.filop.data(9),<:gruppe,def:>,0);
3 14775 d.op.resultat:= res;
3 14776 goto returner;
3 14777 \f
3 14777 message procedure vt_gruppe side 4 - 810409/cl;
3 14778
3 14778 slet:
3 14779 disable
3 14780 begin
4 14781 gr:= 0; res:= 0;
4 14782 for i:= 1 step 1 until max_antal_grupper do
4 14783 begin
5 14784 if gruppetabel(i)=d.op.data(1) then gr:= i;
5 14785 end;
4 14786 if gr = 0 then res:= 8 <*gruppe ej defineret*>
4 14787 else
4 14788 begin
5 14789 for i:= 1 step 1 until max_antal_gruppeopkald do
5 14790 if gruppeopkald(i,1)=d.op.data(1) then res:=15; <*gruppe optaget*>
5 14791 if res = 0 then
5 14792 begin
6 14793 gruppetabel(gr):= 0;
6 14794 s:= modif_fil(tf_gruppeidenter,gr,zi);
6 14795 if s<>0 then fejlreaktion(7,s,<:gruppe,slet:>,0);
6 14796 fil(zi).iaf(1):= gruppetabel(gr);
6 14797 res:= 3;
6 14798 end;
5 14799 end;
4 14800 d.op.resultat:= res;
4 14801 end;
3 14802 goto returner;
3 14803 \f
3 14803 message procedure vt_gruppe side 5 - 810505/cl;
3 14804
3 14804 vis:
3 14805 disable
3 14806 begin
4 14807 res:= 0; gr:= 0; antal:= 0; filref:= 0;
4 14808 for i:= 1 step 1 until max_antal_grupper do
4 14809 if gruppetabel(i) = d.op.data(1) then gr:= i;
4 14810 if gr = 0 then res:= 8
4 14811 else
4 14812 begin
5 14813 s:= læsfil(tf_gruppedef,gr,zi);
5 14814 if s<>0 then fejlreaktion(5,s,<:gruppe,vis:>,0);
5 14815 for i:= 1 step 1 until max_antal_i_gruppe do
5 14816 begin
6 14817 identer(i):= fil(zi).iaf(i);
6 14818 if identer(i) <> 0 then antal:= antal +1;
6 14819 end;
5 14820 start_operation(filop,curr_coruid,cs_fil,101);
5 14821 d.filop.data(1):= antal; <*postantal*>
5 14822 d.filop.data(2):= 1; <*postlængde*>
5 14823 d.filop.data(3):= (antal-1)//256 + 1; <*segmenter*>
5 14824 d.filop.data(4):= 2 shift 10; <*spool fil*>
5 14825 d.filop.data(5):= d.filop.data(6):=
5 14826 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
5 14827 signalch(cs_opret_fil,filop,vt_optype);
5 14828 end;
4 14829 end;
3 14830 if res <> 0 then goto slut_vis;
3 14831 waitch(cs_fil,filop,vt_optype,-1);
3 14832 disable
3 14833 begin
4 14834 if d.filop.data(9) <> 0 then
4 14835 fejlreaktion(13,d.filop.data(9),<:gruppe,vis:>,0);
4 14836 filref:= d.filop.data(4);
4 14837 for i:= 1 step 1 until antal do
4 14838 begin
5 14839 s:= skrivfil(filref,i,zi);
5 14840 if s <> 0 then fejlreaktion(6,s,<:gruppe,vis:>,0);
5 14841 fil(zi).iaf(1):= identer(i);
5 14842 end;
4 14843 res:= 3;
4 14844 end;
3 14845 slut_vis:
3 14846 d.op.resultat:= res; d.op.data(2):= antal; d.op.data(3):= filref;
3 14847 goto returner;
3 14848 \f
3 14848 message procedure vt_gruppe side 6 - 810508/cl;
3 14849
3 14849 oversigt:
3 14850 disable
3 14851 begin
4 14852 res:= 0; antal:= 0; filref:= 0; iaf:= 0;
4 14853 for i:= 1 step 1 until max_antal_grupper do
4 14854 begin
5 14855 if gruppetabel(i) <> 0 then
5 14856 begin
6 14857 antal:= antal +1;
6 14858 identer(antal):= gruppetabel(i);
6 14859 end;
5 14860 end;
4 14861 start_operation(filop,curr_coruid,cs_fil,101);
4 14862 d.filop.data(1):= antal; <*postantal*>
4 14863 d.filop.data(2):= 1; <*postlængde*>
4 14864 d.filop.data(3):= if antal = 0 then 1 else
4 14865 (antal-1)//256 +1; <*segm.antal*>
4 14866 d.filop.data(4):= 2 shift 10; <*spool fil*>
4 14867 d.filop.data(5):= d.filop.data(6):=
4 14868 d.filop.data(7):= d.filop.data(8):= 0; <*navn*>
4 14869 signalch(cs_opretfil,filop,vt_optype);
4 14870 end;
3 14871 waitch(cs_fil,filop,vt_optype,-1);
3 14872 disable
3 14873 begin
4 14874 if d.filop.data(9) <> 0 then
4 14875 fejlreaktion(13,d.filop.data(9),<:grupper,over:>,0);
4 14876 filref:= d.filop.data(4);
4 14877 for i:= 1 step 1 until antal do
4 14878 begin
5 14879 s:= skriv_fil(filref,i,zi);
5 14880 if s <> 0 then fejlreaktion(6,s,<:gruppe,over:>,0);
5 14881 fil(zi).iaf(1):= identer(i);
5 14882 end;
4 14883 d.op.resultat:= 3; <*ok*>
4 14884 d.op.data(1):= antal;
4 14885 d.op.data(2):= filref;
4 14886 end;
3 14887 \f
3 14887 message procedure vt_gruppe side 7 - 810505/cl;
3 14888
3 14888 returner:
3 14889 disable
3 14890 begin
4 14891 <*+2*>
4 14892 <**> if testbit43 and overvåget and (funk=1 or funk=2) then
4 14893 <**> begin
5 14894 <**> skriv_vt_gruppe(out,0);
5 14895 <**> write(out,<: gruppetabel efter ændring:>);
5 14896 <**> p_gruppetabel(out);
5 14897 <**> end;
4 14898 <**> if testbit41 and overvåget then
4 14899 <**> begin
5 14900 <**> skriv_vt_gruppe(out,0);
5 14901 <**> write(out,<: returner operation:>);
5 14902 <**> skriv_op(out,op);
5 14903 <**> end;
4 14904 <*-2*>
4 14905 signalch(d.op.retur,op,d.op.optype);
4 14906 end;
3 14907 goto vent_op;
3 14908
3 14908 vt_grp_trap:
3 14909 disable skriv_vt_gruppe(zbillede,1);
3 14910
3 14910 end vt_gruppe;
2 14911 \f
2 14911 message procedure vt_spring side 1 - 810506/cl;
2 14912
2 14912 procedure vt_spring(cs_spring_retur,spr_opref);
2 14913 value cs_spring_retur,spr_opref;
2 14914 integer cs_spring_retur,spr_opref;
2 14915 begin
3 14916 integer array field komm_op,spr_op,iaf;
3 14917 real nu;
3 14918 integer funk,interval,nr,i,s,id1,id2,res,res_inf,medd_kode,zi;
3 14919
3 14919 procedure skriv_vt_spring(zud,omfang);
3 14920 value omfang;
3 14921 zone zud;
3 14922 integer omfang;
3 14923 begin
4 14924 write(zud,"nl",1,<:+++ vt_spring :>);
4 14925 if omfang <> 0 then
4 14926 begin
5 14927 skriv_coru(zud,abs curr_coruno);
5 14928 write(zud,"nl",1,<<d>,
5 14929 <:cs-spring-retur:>,cs_spring_retur,"nl",1,
5 14930 <:spr-op :>,spr_op,"nl",1,
5 14931 <:komm-op :>,komm_op,"nl",1,
5 14932 <:funk :>,funk,"nl",1,
5 14933 <:interval :>,interval,"nl",1,
5 14934 <:nr :>,nr,"nl",1,
5 14935 <:i :>,i,"nl",1,
5 14936 <:s :>,s,"nl",1,
5 14937 <:id1 :>,id1,"nl",1,
5 14938 <:id2 :>,id2,"nl",1,
5 14939 <:res :>,res,"nl",1,
5 14940 <:res-inf :>,res_inf,"nl",1,
5 14941 <:medd-kode :>,medd_kode,"nl",1,
5 14942 <:zi :>,zi,"nl",1,
5 14943 <:nu :>,<<zddddd.dddd>,nu,"nl",1,
5 14944 <::>);
5 14945 end;
4 14946 end;
3 14947 \f
3 14947 message procedure vt_spring side 2 - 810506/cl;
3 14948
3 14948 procedure vt_operation(aktion,id1,id2,res,res_inf);
3 14949 value aktion,id1,id2;
3 14950 integer aktion,id1,id2,res,res_inf;
3 14951 begin <* aktion: 11=indsæt, 12=udtag, 13=omkod *>
4 14952 integer array field akt_op;
4 14953
4 14953 <* vent på adgang til vogntabel *>
4 14954 waitch(cs_vt_adgang,akt_op,true,-1);
4 14955
4 14955 <* start operation *>
4 14956 disable
4 14957 begin
5 14958 start_operation(akt_op,curr_coruid,cs_spring_retur,aktion);
5 14959 d.akt_op.data(1):= id1;
5 14960 d.akt_op.data(2):= id2;
5 14961 signalch(cs_vt_opd,akt_op,vt_optype);
5 14962 end;
4 14963
4 14963 <* afvent svar *>
4 14964 waitch(cs_spring_retur,akt_op,vt_optype,-1);
4 14965 res:= d.akt_op.resultat;
4 14966 res_inf:= d.akt_op.data(3);
4 14967 <*+2*>
4 14968 <**> disable
4 14969 <**> if testbit45 and overvåget then
4 14970 <**> begin
5 14971 <**> real t;
5 14972 <**> skriv_vt_spring(out,0);
5 14973 <**> write(out,"nl",1,<<zddddd>,systime(4,d.akt_op.tid,t),<:.:>,t);
5 14974 <**> skriv_id(out,springtabel(nr,1),0);
5 14975 <**> write(out,<:.:>,string(extend springtabel(nr,2) shift 24),<:(:>,
5 14976 <**> <<d>,extend springtabel(nr,3) shift (-12) extract 24,<:)::>,
5 14977 <**> if aktion=11 then <:indsæt:> else if aktion=12 then <:udtag:> else
5 14978 <**> if aktion=13 then <:omkod:> else <:***:>,<: - res=:>,
5 14979 <**> d.akt_op.resultat,"sp",2);
5 14980 <**> skriv_id(out,d.akt_op.data(1),8);
5 14981 <**> skriv_id(out,d.akt_op.data(2),8);
5 14982 <**> skriv_id(out,d.akt_op.data(3),8);
5 14983 <**> systime(4,springtid(nr),t);
5 14984 <**> write(out,<: springtid: :>,<<zd.dd>,entier(t/100),"nl",1);
5 14985 <**> end;
4 14986 <*-2*>
4 14987
4 14987 <* åbn adgang til vogntabel *>
4 14988 disable signalch(cs_vt_adgang,akt_op,gen_optype or vt_optype);
4 14989 end vt_operation;
3 14990 \f
3 14990 message procedure vt_spring side 2a - 810506/cl;
3 14991
3 14991 procedure io_meddelelse(medd_no,bus,linie,springno);
3 14992 value medd_no,bus,linie,springno;
3 14993 integer medd_no,bus,linie,springno;
3 14994 begin
4 14995 disable start_operation(spr_op,curr_coruid,cs_spring_retur,36);
4 14996 d.spr_op.data(1):= medd_no;
4 14997 d.spr_op.data(2):= bus;
4 14998 d.spr_op.data(3):= linie;
4 14999 d.spr_op.data(4):= springtabel(springno,1);
4 15000 d.spr_op.data(5):= springtabel(springno,2);
4 15001 disable signalch(cs_io,spr_op,io_optype or gen_optype);
4 15002 waitch(cs_spring_retur,spr_op,io_optype or gen_optype,-1);
4 15003 end;
3 15004
3 15004 procedure returner_op(op,res);
3 15005 value res;
3 15006 integer array field op;
3 15007 integer res;
3 15008 begin
4 15009 <*+2*>
4 15010 <**> disable
4 15011 <**> if testbit41 and overvåget then
4 15012 <**> begin
5 15013 <**> skriv_vt_spring(out,0); write(out,<: returner operation::>);
5 15014 <**> skriv_op(out,op);
5 15015 <**> end;
4 15016 <*-2*>
4 15017 d.op.resultat:= res;
4 15018 signalch(d.op.retur,op,d.op.optype);
4 15019 end;
3 15020 \f
3 15020 message procedure vt_spring side 3 - 810603/cl;
3 15021
3 15021 iaf:= 0;
3 15022 spr_op:= spr_opref;
3 15023 stack_claim((if cm_test then 198 else 146) + 24);
3 15024
3 15024 trap(vt_spring_trap);
3 15025
3 15025 for i:= 1 step 1 until max_antal_spring do
3 15026 begin
4 15027 springtabel(i,1):= springtabel(i,2):= springtabel(i,3):= 0;
4 15028 springtid(i):= springstart(i):= 0.0;
4 15029 end;
3 15030
3 15030 <*+2*>
3 15031 <**> disable
3 15032 <**> if testbit44 and overvåget then
3 15033 <**> begin
4 15034 <**> skriv_vt_spring(out,0);
4 15035 <**> write(out,<: springtabel efter initialisering:>);
4 15036 <**> p_springtabel(out); ud;
4 15037 <**> end;
3 15038 <*-2*>
3 15039
3 15039 <*+2*>
3 15040 <**> disable if testbit47 and overvåget or testbit28 then
3 15041 <**> skriv_vt_spring(out,0);
3 15042 <*-2*>
3 15043 \f
3 15043 message procedure vt_spring side 4 - 810609/cl;
3 15044
3 15044 næste_tid: <* find næste tid *>
3 15045 disable
3 15046 begin
4 15047 interval:= -1; <*vent uendeligt*>
4 15048 systime(1,0.0,nu);
4 15049 for i:= 1 step 1 until max_antal_spring do
4 15050 if springtabel(i,3) < 0 then
4 15051 interval:= 5
4 15052 else
4 15053 if springtid(i) <> 0.0 and
4 15054 ( (springtid(i)-nu) < interval or interval < 0 ) then
4 15055 interval:= (if springtid(i) <= nu then 0 else
4 15056 round(springtid(i) -nu));
4 15057 if interval=0 then interval:= 1;
4 15058 end;
3 15059 \f
3 15059 message procedure vt_spring side 4a - 810525/cl;
3 15060
3 15060 <* afvent operation eller timeout *>
3 15061 waitch(cs_vt_spring,komm_op,vt_optype or gen_optype,interval);
3 15062 if komm_op <> 0 then goto afkod_operation;
3 15063
3 15063 <* timeout *>
3 15064 systime(1,0.0,nu);
3 15065 nr:= 1;
3 15066 næste_sekv:
3 15067 if nr > max_antal_spring then goto næste_tid;
3 15068 if springtid(nr) > nu and springtabel(nr,3) > 0 or springstart(nr)=0.0 then
3 15069 begin
4 15070 nr:= nr +1;
4 15071 goto næste_sekv;
4 15072 end;
3 15073 disable s:= modif_fil(tf_springdef,nr,zi);
3 15074 if s <> 0 then fejlreaktion(7,s,<:spring:>,0);
3 15075 if springtabel(nr,3) < 0 then
3 15076 begin <* hængende spring *>
4 15077 if springtid(nr) <= nu then
4 15078 begin <* spring ikke udført indenfor angivet interval - annuler *>
5 15079 <* find frit løb *>
5 15080 disable
5 15081 begin
6 15082 id2:= 0;
6 15083 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
6 15084 if fil(zi).iaf(2+i) shift (-22) = 1 then
6 15085 id2:= fil(zi).iaf(1) extract 15 shift 7
6 15086 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
6 15087 end;
5 15088 <* send meddelelse til io *>
5 15089 io_meddelelse(5,0,id2,nr);
5 15090
5 15090 <* annuler spring*>
5 15091 for i:= 1,2,3 do springtabel(nr,i):= 0;
5 15092 springtid(nr):= springstart(nr):= 0.0;
5 15093 end
4 15094 else
4 15095 begin <* forsøg igen *>
5 15096 \f
5 15096 message procedure vt_spring side 5 - 810525/cl;
5 15097
5 15097 i:= abs(extend springtabel(nr,3) shift (-12) extract 24);
5 15098 if i = 2 <* første spring ej udført *> then
5 15099 begin
6 15100 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15101 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
6 15102 id2:= id1;
6 15103 vt_operation(12<*udtag*>,id1,id2,res,res_inf);
6 15104 end
5 15105 else
5 15106 begin
6 15107 id1:= fil(zi).iaf(1) extract 15 shift 7
6 15108 + fil(zi).iaf(2+i-1) shift (-12) extract 7 +1 shift 22;
6 15109 id2:= id1 shift (-7) shift 7
6 15110 + fil(zi).iaf(2+i-2) shift (-12) extract 7;
6 15111 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
6 15112 end;
5 15113
5 15113 <* check resultat *>
5 15114 medd_kode:= if res = 3 and i = 2 then 7 else
5 15115 if res = 3 and i > 2 then 8 else
5 15116 <* if res = 9 then 1 else
5 15117 if res =12 then 2 else
5 15118 if res =14 then 4 else
5 15119 if res =18 then 3 else *>
5 15120 0;
5 15121 if medd_kode > 0 then
5 15122 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then
5 15123 id2 else id1,nr);
5 15124 if res = 3 then
5 15125 begin <* spring udført *>
6 15126 disable s:= modiffil(tf_springdef,nr,zi);
6 15127 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
6 15128 springtabel(nr,3):= i shift 12 +springtabel(nr,3) extract 12;
6 15129 fil(zi).iaf(2+i-1):= 1 shift 22 +fil(zi).iaf(2+i-1) extract 22;
6 15130 if i > 2 then fil(zi).iaf(2+i-2):=
6 15131 fil(zi).iaf(2+i-2) extract 22 add (1 shift 23);
6 15132 end;
5 15133 end;
4 15134 end <* hængende spring *>
3 15135 else
3 15136 begin
4 15137 i:= spring_tabel(nr,3) shift (-12);
4 15138 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15139 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15140 id2:= fil(zi).iaf(2+i-1) shift (-12) extract 7
4 15141 + id1 shift (-7) shift 7;
4 15142 vt_operation(13<*omkod*>,id1,id2,res,res_inf);
4 15143 \f
4 15143 message procedure vt_spring side 6 - 820304/cl;
4 15144
4 15144 <* check resultat *>
4 15145 medd_kode:= if res = 3 then 8 else
4 15146 if res = 9 then 1 else
4 15147 if res =12 then 2 else
4 15148 if res =14 then 4 else
4 15149 if res =18 then 3 else
4 15150 if res =60 then 9 else 0;
4 15151 if medd_kode > 0 then
4 15152 io_meddelelse(medd_kode,res_inf,if res=3 or res=12 then id2 else id1,nr);
4 15153
4 15153 <* opdater springtabel *>
4 15154 disable s:= modiffil(tf_springdef,nr,zi);
4 15155 if s<>0 then fejlreaktion(7,s,<:spring:>,0);
4 15156 if fil(zi).iaf(2+i) extract 12 = 0 <*sidste løb*> then
4 15157 begin
5 15158 io_meddelelse(if res=3 then 6 else 5,0,
5 15159 if res=3 then id1 else id2,nr);
5 15160 for i:= 1,2,3 do springtabel(nr,i):= 0; <*annuleret*>
5 15161 springtid(nr):= springstart(nr):= 0.0;
5 15162 end
4 15163 else
4 15164 begin
5 15165 springtid(nr):= springtid(nr) +(fil(zi).iaf(2+i) extract 12)*60.0;
5 15166 if res = 3 then
5 15167 begin
6 15168 fil(zi).iaf(2+i-1):= (1 shift 23) add
6 15169 (fil(zi).iaf(2+i-1) extract 22);
6 15170 fil(zi).iaf(2+i) := (1 shift 22) add
6 15171 (fil(zi).iaf(2+i) extract 22);
6 15172 springtabel(nr,3):=(i+1) shift 12 add (springtabel(nr,3) extract 12);
6 15173 end
5 15174 else
5 15175 springtabel(nr,3):= (-i-1) shift 12 add (springtabel(nr,3) extract 12);
5 15176 end;
4 15177 end;
3 15178 <*+2*>
3 15179 <**> disable
3 15180 <**> if testbit44 and overvåget then
3 15181 <**> begin
4 15182 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15183 <**> p_springtabel(out); ud;
4 15184 <**> end;
3 15185 <*-2*>
3 15186
3 15186 nr:= nr +1;
3 15187 goto næste_sekv;
3 15188 \f
3 15188 message procedure vt_spring side 7 - 810506/cl;
3 15189
3 15189 afkod_operation:
3 15190 <*+2*>
3 15191 <**> disable
3 15192 <**> if testbit41 and overvåget then
3 15193 <**> begin
4 15194 <**> skriv_vt_spring(out,0); write(out,<: modtaget operation:>);
4 15195 <**> skriv_op(out,komm_op);
4 15196 <**> end;
3 15197 <*-2*>
3 15198
3 15198 disable
3 15199 begin integer opk;
4 15200
4 15200 opk:= d.komm_op.opkode extract 12;
4 15201 funk:= if opk = 30 <*sp,d*> then 5 else
4 15202 if opk = 31 <*sp. *> then 1 else
4 15203 if opk = 32 <*sp,v*> then 4 else
4 15204 if opk = 33 <*sp,o*> then 6 else
4 15205 if opk = 34 <*sp,r*> then 2 else
4 15206 if opk = 35 <*sp,a*> then 3 else
4 15207 0;
4 15208 if funk = 0 then fejlreaktion(2,opk,<:vt_spring:>,0);
4 15209
4 15209 if funk <> 6 <*sp,o*> then
4 15210 begin <* find nr i springtabel *>
5 15211 nr:= 0;
5 15212 for i:= 1 step 1 until max_antal_spring do
5 15213 if springtabel(i,1) = d.komm_op.data(1) and
5 15214 springtabel(i,2) = d.komm_op.data(2) then nr:= i;
5 15215 end;
4 15216 end;
3 15217 if funk = 6 then goto oversigt;
3 15218 if funk = 5 then goto definer;
3 15219
3 15219 if nr = 0 then
3 15220 begin
4 15221 returner_op(komm_op,37<*spring ukendt*>);
4 15222 goto næste_tid;
4 15223 end;
3 15224
3 15224 goto case funk of(start,indsæt,annuler,vis);
3 15225 \f
3 15225 message procedure vt_spring side 8 - 810525/cl;
3 15226
3 15226 start:
3 15227 if springtabel(nr,3) shift (-12) <> 0 then
3 15228 begin returner_op(komm_op,38); goto næste_tid; end;
3 15229 disable
3 15230 begin <* find linie_løb_og_udtag *>
4 15231 s:= modif_fil(tf_springdef,nr,zi);
4 15232 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15233 id1:= fil(zi).iaf(1) extract 15 shift 7
4 15234 + fil(zi).iaf(3) shift (-12) extract 7 +1 shift 22;
4 15235 id2:= 0;
4 15236 end;
3 15237 vt_operation(12,id1,id2,res,res_inf);
3 15238
3 15238 disable <* check resultat *>
3 15239 medd_kode:= if res = 3 <*ok*> then 7 else
3 15240 if res = 9 <*linie/løb ukendt*> then 1 else
3 15241 if res =14 <*optaget*> then 4 else
3 15242 if res =18 <*i kø*> then 3 else 0;
3 15243 returner_op(komm_op,3);
3 15244 if medd_kode = 0 then goto næste_tid;
3 15245
3 15245 <* send spring-meddelelse til io *>
3 15246 io_meddelelse(medd_kode,res_inf,id1,nr);
3 15247
3 15247 <* opdater springtabel *>
3 15248 disable
3 15249 begin
4 15250 s:= modif_fil(tf_springdef,nr,zi);
4 15251 if s <> 0 then fejlreaktion(7,s,<:spring,start:>,0);
4 15252 springtabel(nr,3):= (if res = 3 then 2 else (-2)) shift 12
4 15253 add (springtabel(nr,3) extract 12);
4 15254 systime(1,0.0,nu);
4 15255 springstart(nr):= nu;
4 15256 springtid(nr):= nu +fil(zi).iaf(3) extract 12 *60.0;
4 15257 if res = 3 then fil(zi).iaf(3):= fil(zi).iaf(3) add (1 shift 22);
4 15258 end;
3 15259 <*+2*>
3 15260 <**> disable
3 15261 <**> if testbit44 and overvåget then
3 15262 <**> begin
4 15263 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15264 <**> p_springtabel(out); ud;
4 15265 <**> end;
3 15266 <*-2*>
3 15267
3 15267 goto næste_tid;
3 15268 \f
3 15268 message procedure vt_spring side 9 - 810506/cl;
3 15269
3 15269 indsæt:
3 15270 if springtabel(nr,3) shift (-12) = 0 then
3 15271 begin <* ikke igangsat *>
4 15272 returner_op(komm_op,41);
4 15273 goto næste_tid;
4 15274 end;
3 15275 <* find frie linie/løb *>
3 15276 disable
3 15277 begin
4 15278 s:= læs_fil(tf_springdef,nr,zi);
4 15279 if s <> 0 then fejlreaktion(5,s,<:spring,reserve:>,0);
4 15280 id2:= 0;
4 15281 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15282 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15283 id2:= 1 shift 22 +fil(zi).iaf(1) extract 15 shift 7
4 15284 +fil(zi).iaf(2+i) shift (-12) extract 7;
4 15285 id1:= d.komm_op.data(3);
4 15286 end;
3 15287
3 15287 if id2<>0 then
3 15288 vt_operation(11,id1,id2,res,res_inf)
3 15289 else
3 15290 res:= 42;
3 15291
3 15291 disable <* check resultat *>
3 15292 medd_kode:= if res = 3 <*ok*> then 8 else
3 15293 if res =10 <*bus ukendt*> then 0 else
3 15294 if res =11 <*bus allerede indsat*> then 0 else
3 15295 if res =12 <*linie/løb allerede besat*> then 2 else
3 15296 if res =42 <*intet frit linie/løb*> then 5 else 0;
3 15297 if res = 11 or res = 12 then d.komm_op.data(4):= res_inf;
3 15298 returner_op(komm_op,res);
3 15299 if medd_kode = 0 then goto næste_tid;
3 15300
3 15300 <* send springmeddelelse til io *>
3 15301 if res<>42 then io_meddelelse(medd_kode,id1,id2,nr);
3 15302 io_meddelelse(5,0,0,nr);
3 15303 \f
3 15303 message procedure vt_spring side 9a - 810525/cl;
3 15304
3 15304 <* annuler springtabel *>
3 15305 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15306 springtid(nr):= springstart(nr):= 0.0;
3 15307 <*+2*>
3 15308 <**> disable
3 15309 <**> if testbit44 and overvåget then
3 15310 <**> begin
4 15311 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15312 <**> p_springtabel(out); ud;
4 15313 <**> end;
3 15314 <*-2*>
3 15315
3 15315 goto næste_tid;
3 15316 \f
3 15316 message procedure vt_spring side 10 - 810525/cl;
3 15317
3 15317 annuler:
3 15318 disable
3 15319 begin <* find evt. frit linie/løb *>
4 15320 s:= læs_fil(tf_springdef,nr,zi);
4 15321 if s <> 0 then fejlreaktion(5,s,<:spring,annuler:>,0);
4 15322 id1:= id2:= 0;
4 15323 for i:= 1 step 1 until springtabel(nr,3) extract 12 do
4 15324 if fil(zi).iaf(2+i) shift (-22) = 1 then
4 15325 id2:= fil(zi).iaf(1) extract 15 shift 7
4 15326 + fil(zi).iaf(2+i) shift (-12) extract 7 +1 shift 22;
4 15327 returner_op(komm_op,3);
4 15328 end;
3 15329
3 15329 <* send springmeddelelse til io *>
3 15330 io_meddelelse(5,id1,id2,nr);
3 15331
3 15331 <* annuler springtabel *>
3 15332 for i:= 1,2,3 do springtabel(nr,i):= 0;
3 15333 springtid(nr):= springstart(nr):= 0.0;
3 15334 <*+2*>
3 15335 <**> disable
3 15336 <**> if testbit44 and overvåget then
3 15337 <**> begin
4 15338 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15339 <**> p_springtabel(out); ud;
4 15340 <**> end;
3 15341 <*-2*>
3 15342
3 15342 goto næste_tid;
3 15343
3 15343 definer:
3 15344 if nr <> 0 then <* allerede defineret *>
3 15345 begin
4 15346 res:= 36;
4 15347 goto slut_definer;
4 15348 end;
3 15349
3 15349 <* find frit nr *>
3 15350 i:= 0;
3 15351 for i:= i+1 while i<= max_antal_spring and nr = 0 do
3 15352 if springtabel(i,1) = 0 then nr:= i;
3 15353 if nr = 0 then
3 15354 begin
4 15355 res:= 32; <* ingen fri plads *>
4 15356 goto slut_definer;
4 15357 end;
3 15358 \f
3 15358 message procedure vt_spring side 11 - 810525/cl;
3 15359
3 15359 disable
3 15360 begin integer array fdim(1:8),ia(1:32);
4 15361 <* læs sekvens *>
4 15362 fdim(4):= d.komm_op.data(3);
4 15363 s:= hent_fil_dim(fdim);
4 15364 if s <> 0 then fejlreaktion(8,s,<:spring,def:>,0);
4 15365 if fdim(1) > 30 then
4 15366 res:= 35 <* springsekvens for stor *>
4 15367 else
4 15368 begin
5 15369 for i:= 1 step 1 until fdim(1) do
5 15370 begin
6 15371 s:= læs_fil(fdim(4),i,zi);
6 15372 if s <> 0 then fejlreaktion(5,s,<:spring,def:>,0);
6 15373 ia(i):= fil(zi).iaf(1) shift 12;
6 15374 if i>1 then ia(i-1):= ia(i-1) + fil(zi).iaf(1) shift (-12);
6 15375 end;
5 15376 s:= modif_fil(tf_springdef,nr,zi);
5 15377 if s <> 0 then fejlreaktion(7,s,<:spring,def:>,0);
5 15378 fil(zi).iaf(1):= springtabel(nr,1):= d.komm_op.data(1);
5 15379 fil(zi).iaf(2):= springtabel(nr,2):= d.komm_op.data(2);
5 15380 iaf:= 4;
5 15381 tofrom(fil(zi).iaf,ia,60);
5 15382 iaf:= 0;
5 15383 springtabel(nr,3):= fdim(1);
5 15384 springtid(nr):= springstart(nr):= 0.0;
5 15385 res:= 3;
5 15386 end;
4 15387 end;
3 15388 \f
3 15388 message procedure vt_spring side 11a - 81-525/cl;
3 15389
3 15389 slut_definer:
3 15390
3 15390 <* slet fil *>
3 15391 start_operation(spr_op,curr_coruid,cs_spring_retur,104);
3 15392 d.spr_op.data(4):= d.komm_op.data(3); <* filref *>
3 15393 signalch(cs_slet_fil,spr_op,vt_optype);
3 15394 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15395 if d.spr_op.data(9) <> 0 then
3 15396 fejlreaktion(16,d.spr_op.data(9),<:spring,def:>,0);
3 15397 returner_op(komm_op,res);
3 15398 <*+2*>
3 15399 <**> disable
3 15400 <**> if testbit44 and overvåget then
3 15401 <**> begin
4 15402 <**> skriv_vt_spring(out,0); write(out,<: springtabel efter ændring:>);
4 15403 <**> p_springtabel(out); ud;
4 15404 <**> end;
3 15405 <*-2*>
3 15406 goto næste_tid;
3 15407 \f
3 15407 message procedure vt_spring side 12 - 810525/cl;
3 15408
3 15408 vis:
3 15409 disable
3 15410 begin
4 15411 <* tilknyt fil *>
4 15412 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15413 d.spr_op.data(1):= (springtabel(nr,3) extract 12)*2;
4 15414 d.spr_op.data(2):= 1;
4 15415 d.spr_op.data(3):= (d.spr_op.data(1) -1)//256 +1;
4 15416 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15417 signalch(cs_opret_fil,spr_op,vt_optype);
4 15418 end;
3 15419
3 15419 <* afvent svar *>
3 15420 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15421 if d.spr_op.data(9) <> 0 then
3 15422 fejlreaktion(13,d.spr_op.data(9),<:spring,vis:>,0);
3 15423 disable
3 15424 begin integer array ia(1:30);
4 15425 s:= læs_fil(tf_springdef,nr,zi);
4 15426 if s <> 0 then fejlreaktion(5,s,<:spring,vis:>,0);
4 15427 iaf:= 4;
4 15428 tofrom(ia,fil(zi).iaf,60);
4 15429 iaf:= 0;
4 15430 for i:= 1 step 1 until d.spr_op.data(1) do
4 15431 begin
5 15432 s:= skriv_fil(d.spr_op.data(4),(i-1)*2+1,zi);
5 15433 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15434 fil(zi).iaf(1):= if ia(i) shift (-22) = 0 then
5 15435 ia(i) shift (-12) extract 7
5 15436 else -(ia(i) shift (-12) extract 7);
5 15437 s:= skriv_fil(d.spr_op.data(4),2*i,zi);
5 15438 if s <> 0 then fejlreaktion(6,s,<:spring,vis:>,0);
5 15439 fil(zi).iaf(1):= if i < d.spr_op.data(1) then
5 15440 (if ia(i+1) shift (-22) <> 0 then -(ia(i) extract 12)
5 15441 else ia(i) extract 12)
5 15442 else 0;
5 15443 end;
4 15444 d.spr_op.data(1):= d.spr_op.data(1) - 1;
4 15445 sæt_fil_dim(d.spr_op.data);
4 15446 d.komm_op.data(3):= d.spr_op.data(1);
4 15447 d.komm_op.data(4):= d.spr_op.data(4);
4 15448 raf:= data+8;
4 15449 d.komm_op.raf(1):= springstart(nr);
4 15450 returner_op(komm_op,3);
4 15451 end;
3 15452 goto næste_tid;
3 15453 \f
3 15453 message procedure vt_spring side 13 - 810525/cl;
3 15454
3 15454 oversigt:
3 15455 disable
3 15456 begin
4 15457 <* opret fil *>
4 15458 start_operation(spr_op,curr_coruid,cs_spring_retur,101);
4 15459 d.spr_op.data(1):= max_antal_spring;
4 15460 d.spr_op.data(2):= 4;
4 15461 d.spr_op.data(3):= (max_antal_spring -1)//64 +1;
4 15462 d.spr_op.data(4):= 2 shift 10; <* spoolfil *>
4 15463 signalch(cs_opret_fil,spr_op,vt_optype);
4 15464 end;
3 15465
3 15465 <* afvent svar *>
3 15466 waitch(cs_spring_retur,spr_op,vt_optype,-1);
3 15467 if d.spr_op.data(9) <> 0 then
3 15468 fejlreaktion(13,d.spr_op.data(9),<:spring,over:>,0);
3 15469 disable
3 15470 begin
4 15471 nr:= 0;
4 15472 for i:= 1 step 1 until max_antal_spring do
4 15473 begin
5 15474 if springtabel(i,1) <> 0 then
5 15475 begin
6 15476 nr:= nr +1;
6 15477 s:= skriv_fil(d.spr_op.data(4),nr,zi);
6 15478 if s <> 0 then fejlreaktion(6,s,<:spring,over:>,0);
6 15479 fil(zi).iaf(1):= springtabel(i,1);
6 15480 fil(zi).iaf(2):= springtabel(i,2);
6 15481 fil(zi,2):= springstart(i);
6 15482 end;
5 15483 end;
4 15484 d.spr_op.data(1):= nr;
4 15485 s:= sæt_fil_dim(d.spr_op.data);
4 15486 if s <> 0 then fejlreaktion(9,s,<:spring,over:>,0);
4 15487 d.komm_op.data(1):= nr;
4 15488 d.komm_op.data(2):= d.spr_op.data(4);
4 15489 returner_op(komm_op,3);
4 15490 end;
3 15491 goto næste_tid;
3 15492
3 15492 vt_spring_trap:
3 15493 disable skriv_vt_spring(zbillede,1);
3 15494
3 15494 end vt_spring;
2 15495 \f
2 15495 message procedure vt_auto side 1 - 810505/cl;
2 15496
2 15496 procedure vt_auto(cs_auto_retur,auto_opref);
2 15497 value cs_auto_retur,auto_opref;
2 15498 integer cs_auto_retur,auto_opref;
2 15499 begin
3 15500 integer array field op,auto_op,iaf;
3 15501 integer filref,id1,id2,aktion,postnr,sidste_post,interval,res,
3 15502 res_inf,i,s,zi,kl,døgnstart;
3 15503 real t,nu,næste_tid;
3 15504 boolean optaget;
3 15505 integer array filnavn,nytnavn(1:4);
3 15506
3 15506 procedure skriv_vt_auto(zud,omfang);
3 15507 value omfang;
3 15508 zone zud;
3 15509 integer omfang;
3 15510 begin
4 15511 long array field laf;
4 15512
4 15512 laf:= 0;
4 15513 write(zud,"nl",1,<:+++ vt_auto :>);
4 15514 if omfang<>0 then
4 15515 begin
5 15516 skriv_coru(zud,abs curr_coruno);
5 15517 write(zud,"nl",1,<<d>,
5 15518 <:cs-auto-retur :>,cs_auto_retur,"nl",1,
5 15519 <:op :>,op,"nl",1,
5 15520 <:auto-op :>,auto_op,"nl",1,
5 15521 <:filref :>,filref,"nl",1,
5 15522 <:id1 :>,id1,"nl",1,
5 15523 <:id2 :>,id2,"nl",1,
5 15524 <:aktion :>,aktion,"nl",1,
5 15525 <:postnr :>,postnr,"nl",1,
5 15526 <:sidste-post :>,sidste_post,"nl",1,
5 15527 <:interval :>,interval,"nl",1,
5 15528 <:res :>,res,"nl",1,
5 15529 <:res-inf :>,res_inf,"nl",1,
5 15530 <:i :>,i,"nl",1,
5 15531 <:s :>,s,"nl",1,
5 15532 <:zi :>,zi,"nl",1,
5 15533 <:kl :>,kl,"nl",1,
5 15534 <:døgnstart :>,døgnstart,"nl",1,
5 15535 <:optaget :>,if optaget then <:true:> else <:false:>,"nl",1,
5 15536 <:t :>,<<zddddd.dddd>,t,"nl",1,
5 15537 <:nu :>,nu,"nl",1,
5 15538 <:næste-tid :>,næste_tid,"nl",1,
5 15539 <:filnavn :>,filnavn.laf,"nl",1,
5 15540 <:nytnavn :>,nytnavn.laf,"nl",1,
5 15541 <::>);
5 15542 end;
4 15543 end skriv_vt_auto;
3 15544 \f
3 15544 message procedure vt_auto side 2 - 810507/cl;
3 15545
3 15545 iaf:= 0;
3 15546 auto_op:= auto_opref;
3 15547 filref:= id1:= id2:= aktion:= postnr:= sidste_post:= 0;
3 15548 optaget:= false;
3 15549 næste_tid:= 0.0;
3 15550 for i:= 1,2,3,4 do filnavn(i):=nytnavn(i):=0;
3 15551 stack_claim(if cm_test then 298 else 246);
3 15552 trap(vt_auto_trap);
3 15553
3 15553 <*+2*>
3 15554 <**> disable if testbit47 and overvåget or testbit28 then
3 15555 <**> skriv_vt_auto(out,0);
3 15556 <*-2*>
3 15557
3 15557 vent:
3 15558
3 15558 systime(1,0.0,nu);
3 15559 interval:= if filref=0 then (-1) <*uendeligt*> else
3 15560 if næste_tid > nu then round(næste_tid-nu) else
3 15561 if optaget then 5 else 0;
3 15562 if interval=0 then interval:= 1;
3 15563
3 15563 <*v*> waitch(cs_vt_auto,op,vt_optype or gen_optype,interval);
3 15564
3 15564 if op<>0 then goto filskift;
3 15565
3 15565 <* vent på adgang til vogntabel *>
3 15566 <*v*> waitch(cs_vt_adgang,op,vt_optype,-1);
3 15567
3 15567 <* afsend relevant operation til opdatering af vogntabel *>
3 15568 start_operation(op,curr_coruid,cs_auto_retur,aktion);
3 15569 d.op.data(1):= id1;
3 15570 d.op.data(2):= id2;
3 15571 signalch(cs_vt_opd,op,vt_optype);
3 15572 <*v*> waitch(cs_auto_retur,op,vt_optype,-1);
3 15573 res:= d.op.resultat;
3 15574 id2:= d.op.data(2);
3 15575 res_inf:= d.op.data(3);
3 15576
3 15576 <* åbn for vogntabel *>
3 15577 signalch(cs_vt_adgang,op,vt_optype or gen_optype);
3 15578 \f
3 15578 message procedure vt_auto side 3 - 810507/cl;
3 15579
3 15579 <* behandl svar fra opdatering *>
3 15580 <*+2*>
3 15581 <**> disable
3 15582 <**> if testbit45 and overvåget then
3 15583 <**> begin
4 15584 <**> integer li,lø,bo;
4 15585 <**> skriv_vt_auto(out,0);
4 15586 <**> write(out,"nl",1,<<zddddd>,systime(4,d.op.tid,t),<:.:>,entier t,
4 15587 <**> <: POSTNR. :>,<<d>,postnr,if aktion=12 then <:: SLET:> else
4 15588 <**> <:: OMKOD:>,<: - RES=:>,res);
4 15589 <**> for i:= 1,2 do
4 15590 <**> begin
5 15591 <**> li:= d.op.data(i);
5 15592 <**> lø:= li extract 7; bo:= li shift (-7) extract 5;
5 15593 <**> if bo<>0 then bo:= bo + 'A' - 1;
5 15594 <**> li:= li shift (-12) extract 10;
5 15595 <**> write(out,<< ddd>,li,false add bo,1,"/",1,<<d>,lø);
5 15596 <**> end;
4 15597 <**> systime(4,næste_tid,t);
4 15598 <**> write(out,<< zddd>,d.op.data(3) extract 14,<: - AUTOTID::>,
4 15599 <**> << zd.dd>,t/10000,"nl",1);
4 15600 <**> end;
3 15601 <*-2*>
3 15602 if res=31 then
3 15603 fejlreaktion(10,aktion,<:AUTO: SYSTEMFEJL:>,1)
3 15604 else
3 15605 if res<>3 then
3 15606 begin
4 15607 if -, optaget then
4 15608 begin
5 15609 disable start_operation(auto_op,curr_coruid,cs_auto_retur,22);
5 15610 d.auto_op.data(1):= if res=9 then 1 else if res=12 then 2 else
5 15611 if res=18 then 3 else if res=60 then 9 else 4;
5 15612 d.auto_op.data(2):= res_inf;
5 15613 d.auto_op.data(3):= if res=12 then id2 else id1;
5 15614 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15615 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
5 15616 end;
4 15617 if res=14 or res=18 then <* i kø eller optaget *>
4 15618 begin
5 15619 optaget:= true;
5 15620 goto vent;
5 15621 end;
4 15622 end;
3 15623 optaget:= false;
3 15624 \f
3 15624 message procedure vt_auto side 4 - 810507/cl;
3 15625
3 15625 <* find næste post *>
3 15626 disable
3 15627 begin
4 15628 if postnr=sidste_post then
4 15629 begin <* døgnskift *>
5 15630 postnr:= 1;
5 15631 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15632 end
4 15633 else postnr:= postnr+1;
4 15634 s:= læsfil(filref,postnr,zi);
4 15635 if s<>0 then fejlreaktion(5,s,<:auto:>,0);
4 15636 aktion:= fil(zi).iaf(1);
4 15637 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
4 15638 id1:= fil(zi).iaf(3);
4 15639 id2:= fil(zi).iaf(4);
4 15640 end;
3 15641 goto vent;
3 15642 \f
3 15642 message procedure vt_auto side 5 - 810507/cl;
3 15643
3 15643 filskift:
3 15644
3 15644 <*+2*>
3 15645 <**> disable
3 15646 <**> if testbit41 and overvåget then
3 15647 <**> begin
4 15648 <**> skriv_vt_auto(out,0);
4 15649 <**> write(out,<: modtaget operation::>);
4 15650 <**> skriv_op(out,op);
4 15651 <**> end;
3 15652 <*-2*>
3 15653 for i:= 1 step 1 until 4 do filnavn(i):=nytnavn(i):= 0;
3 15654 res:= 46;
3 15655 if d.op.opkode extract 12 <> 21 then
3 15656 fejlreaktion(2,d.op.opkode extract 12,<:auto,filskift:>,0);
3 15657 if filref = 0 then goto knyt;
3 15658
3 15658 <* gem filnavn til io-meddelelse *>
3 15659 disable begin
4 15660 integer array fdim(1:8);
4 15661 integer array field navn;
4 15662 fdim(4):= filref;
4 15663 hentfildim(fdim);
4 15664 navn:= 8;
4 15665 tofrom(filnavn,fdim.navn,8);
4 15666 end;
3 15667
3 15667 <* frivgiv tilknyttet autofil *>
3 15668 disable start_operation(auto_op,curr_coruid,cs_auto_retur,103);
3 15669 d.auto_op.data(4):= filref;
3 15670 signalch(cs_frigiv_fil,auto_op,vt_optype);
3 15671 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
3 15672 if d.auto_op.data(9) <> 0 then
3 15673 fejlreaktion(15,d.auto_op.data(9),<:auto,filskift:>,0);
3 15674 filref:= aktion:= id1:= id2:= postnr:= sidste_post:= 0;
3 15675 optaget:= false;
3 15676 næste_tid:= 0.0;
3 15677 res:= 3;
3 15678 \f
3 15678 message procedure vt_auto side 6 - 810507/cl;
3 15679
3 15679 <* tilknyt evt. ny autofil *>
3 15680 knyt:
3 15681 if d.op.data(1)<>0 then
3 15682 begin
4 15683 disable startoperation(auto_op,curr_coruid,cs_auto_retur,102);
4 15684 d.auto_op.data(4):= 30 shift 12; <* contentskey,subno *>
4 15685 for i:= 1,2,3,4 do d.auto_op.data(4+i):= d.op.data(i);
4 15686 disable
4 15687 begin integer pos1,pos2;
5 15688 pos1:= pos2:= 13;
5 15689 while læstegn(d.auto_op.data,pos1,i)<>0 do
5 15690 begin
6 15691 if 'A'<=i and i<='Å' then i:= i - 'A' + 'a';
6 15692 skrivtegn(d.auto_op.data,pos2,i);
6 15693 end;
5 15694 end;
4 15695 signalch(cs_tilknyt_fil,auto_op,vt_optype);
4 15696 <*v*> waitch(cs_auto_retur,auto_op,vt_optype,-1);
4 15697 s:= d.auto_op.data(9);
4 15698 if s=0 then res:= 3 <* ok *> else
4 15699 if s=1 or s=2 then res:= 46 <* ukendt navn *> else
4 15700 if s=5 or s=7 then res:= 47 <* galt indhold *> else
4 15701 if s=6 then res:= 48 <* i brug *> else
4 15702 fejlreaktion(14,2,<:auto,filskift:>,0);
4 15703 if res<>3 then goto returner;
4 15704
4 15704 tofrom(nytnavn,d.op.data,8);
4 15705
4 15705 <* find første post *>
4 15706 disable
4 15707 begin
5 15708 døgnstart:= systime(5,0.0,t);
5 15709 kl:= round t;
5 15710 filref:= d.auto_op.data(4);
5 15711 sidste_post:= d.auto_op.data(1);
5 15712 postnr:= 0;
5 15713 for postnr:= postnr+1 while postnr <= sidste_post do
5 15714 begin
6 15715 s:= læsfil(filref,postnr,zi);
6 15716 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
6 15717 if fil(zi).iaf(2) > kl then goto post_fundet;
6 15718 end;
5 15719 postnr:= 1;
5 15720 døgnstart:= systime(4,systid(døgnstart+1,120000),t);
5 15721 \f
5 15721 message procedure vt_auto side 7 - 810507/cl;
5 15722
5 15722 post_fundet:
5 15723 s:= læsfil(filref,postnr,zi);
5 15724 if s<>0 then fejlreaktion(5,s,<:auto,filskift:>,0);
5 15725 aktion:= fil(zi).iaf(1);
5 15726 næste_tid:= systid(døgnstart,fil(zi).iaf(2));
5 15727 id1:= fil(zi).iaf(3);
5 15728 id2:= fil(zi).iaf(4);
5 15729 res:= 3;
5 15730 end;
4 15731 end ny fil;
3 15732
3 15732 returner:
3 15733 d.op.resultat:= res;
3 15734 <*+2*>
3 15735 <**> disable
3 15736 <**> if testbit41 and overvåget then
3 15737 <**> begin
4 15738 <**> skriv_vt_auto(out,0);
4 15739 <**> write(out,<: returner operation::>);
4 15740 <**> skriv_op(out,op);
4 15741 <**> end;
3 15742 <*-2*>
3 15743 signalch(d.op.retur,op,d.op.optype);
3 15744
3 15744 if vt_log_aktiv then
3 15745 begin
4 15746 waitch(cs_vt_logpool,op,vt_optype,-1);
4 15747 startoperation(op,curr_coruid,cs_vt_logpool,0);
4 15748 if nytnavn(1)=0 then
4 15749 hægtstring(d.op.data.v_tekst,1,<:ophør:>)
4 15750 else
4 15751 skriv_text(d.op.data.v_tekst,1,nytnavn);
4 15752 d.op.data.v_kode:= 4; <*PS (PlanSkift)*>
4 15753 systime(1,0.0,d.op.data.v_tid);
4 15754 signalch(cs_vt_log,op,vt_optype);
4 15755 end;
3 15756
3 15756 if filnavn(1)<>0 then
3 15757 begin <* meddelelse til io om annulering *>
4 15758 disable begin
5 15759 start_operation(auto_op,curr_coruid,cs_auto_retur,23<*io_gen_medd*>);
5 15760 i:= 1;
5 15761 hægtstring(d.auto_op.data,i,<:auto :>);
5 15762 skriv_text(d.auto_op.data,i,filnavn);
5 15763 hægtstring(d.auto_op.data,i,<: annuleret:>);
5 15764 repeat skrivtegn(d.auto_op.data,i,'nul') until (i-1) mod 6 = 0;
5 15765 signalch(cs_io,auto_op,io_optype or gen_optype);
5 15766 end;
4 15767 waitch(cs_auto_retur,auto_op,io_optype or gen_optype,-1);
4 15768 end;
3 15769 goto vent;
3 15770
3 15770 vt_auto_trap:
3 15771 disable skriv_vt_auto(zbillede,1);
3 15772
3 15772 end vt_auto;
2 15773 message procedure vt_log side 1 - 920517/cl;
2 15774
2 15774 procedure vt_log;
2 15775 begin
3 15776 integer i,j,ventetid;
3 15777 real dg,t,nu,skiftetid;
3 15778 boolean fil_åben;
3 15779 integer array ia(1:10),dp,dp1(1:8);
3 15780 integer array field op, iaf;
3 15781
3 15781 procedure skriv_vt_log(zud,omfang);
3 15782 value omfang;
3 15783 zone zud;
3 15784 integer omfang;
3 15785 begin
4 15786 write(zud,"nl",1,<:+++ vt-log :>);
4 15787 if omfang<>0 then
4 15788 begin
5 15789 skriv_coru(zud, abs curr_coruno);
5 15790 write(zud,"nl",1,<<d>,
5 15791 <:i :>,i,"nl",1,
5 15792 <:j :>,j,"nl",1,
5 15793 <:ventetid :>,ventetid,"nl",1,
5 15794 <:dg :>,<<zddddd.dd>,dg,"nl",1,
5 15795 <:t :>,t,"nl",1,
5 15796 <:nu :>,nu,"nl",1,
5 15797 <:skiftetid :>,skiftetid,"nl",1,
5 15798 <:filåben :>,if fil_åben then <:true:> else <:false:>,"nl",1,
5 15799 <:op :>,<<d>,op,"nl",1,
5 15800 <::>);
5 15801 raf:= 0;
5 15802 write(zud,"nl",1,<:ia::>);
5 15803 skrivhele(zud,ia.raf,20,2);
5 15804 write(zud,"nl",2,<:dp::>);
5 15805 skrivhele(zud,dp.raf,16,2);
5 15806 write(zud,"nl",2,<:dp1::>);
5 15807 skrivhele(zud,dp1.raf,16,2);
5 15808 end;
4 15809 end;
3 15810
3 15810 message procedure vt_log side 2 - 920517/cl;
3 15811
3 15811 procedure slet_fil;
3 15812 begin
4 15813 integer segm,res;
4 15814 integer array tail(1:10);
4 15815
4 15815 res:= monitor(42)lookup_entry:(zvtlog,0,tail);
4 15816 if res=0 then
4 15817 begin
5 15818 segm:= tail(10);
5 15819 res:=monitor(48)remove_entry:(zvtlog,0,tail);
5 15820 if res=0 then
5 15821 begin
6 15822 close(zvtlog,true);
6 15823 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
6 15824 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 15825 if res=0 then
6 15826 begin
7 15827 tail(1):= tail(1)+segm;
7 15828 monitor(44)change_entry:(zvtlog,0,tail);
7 15829 end;
6 15830 end;
5 15831 end;
4 15832 end;
3 15833
3 15833 boolean procedure udvid_fil;
3 15834 begin
4 15835 integer res,spos;
4 15836 integer array tail(1:10);
4 15837 zone z(1,1,stderror);
4 15838
4 15838 udvid_fil:= false;
4 15839 open(z,0,<:vtlogpool:>,0); close(z,true);
4 15840 res:= monitor(42)lookup_entry:(z,0,tail);
4 15841 if (res=0) and (tail(1) >= vt_log_slicelgd) then
4 15842 begin
5 15843 tail(1):=tail(1) - vt_log_slicelgd;
5 15844 res:=monitor(44)change_entry:(z,0,tail);
5 15845 if res=0 then
5 15846 begin
6 15847 spos:= vt_logtail(1);
6 15848 vt_logtail(1):= vt_logtail(1)+vt_log_slicelgd;
6 15849 res:=monitor(44)change_entry:(zvtlog,0,vt_logtail);
6 15850 if res<>0 then
6 15851 begin
7 15852 vt_logtail(1):= vt_logtail(1) - vt_log_slicelgd;
7 15853 tail(1):= tail(1) + vt_log_slicelgd;
7 15854 monitor(44)change_entry:(z,0,tail);
7 15855 end
6 15856 else
6 15857 begin
7 15858 setposition(zvtlog,0,spos);
7 15859 udvid_fil:= true;
7 15860 end;
6 15861 end;
5 15862 end;
4 15863 end;
3 15864
3 15864 message procedure vt_log side 3 - 920517/cl;
3 15865
3 15865 boolean procedure ny_fil;
3 15866 begin
4 15867 integer res,i,j;
4 15868 integer array nyt(1:4), ia,tail(1:10);
4 15869 long array field navn;
4 15870 real t;
4 15871
4 15871 navn:=0;
4 15872 if fil_åben then
4 15873 begin
5 15874 close(zvtlog,true);
5 15875 fil_åben:= false;
5 15876 nyt.navn(1):= long<:vtlo:>;
5 15877 nyt.navn(2):= long<::>;
5 15878 anbringtal(nyt,5,round systime(4,vt_logstart,t),-6);
5 15879 j:= 'a' - 1;
5 15880 repeat
5 15881 res:=monitor(46)rename_entry:(zvtlog,0,nyt);
5 15882 if res=3 then
5 15883 begin
6 15884 j:= j+1;
6 15885 if j <= 'å' then skrivtegn(nyt,11,j);
6 15886 end;
5 15887 until (res<>3) or (j > 'å');
5 15888
5 15888 if res=0 then
5 15889 begin
6 15890 open(zvtlog,4,<:vtlogklar:>,0);
6 15891 res:=monitor(42)lookup_entry:(zvtlog,0,tail);
6 15892 if res=0 then
6 15893 res:=monitor(52)create_areaproc:(zvtlog,0,ia);
6 15894 if res=0 then
6 15895 begin
7 15896 res:=monitor(8)reserve_process:(zvtlog,0,ia);
7 15897 if res<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
7 15898 end;
6 15899
6 15899 if res=0 then
6 15900 begin
7 15901 setposition(zvtlog,0,tail(10)//64);
7 15902 navn:= (tail(10) mod 64)*8;
7 15903 if (tail(1) <= tail(10)//64) then
7 15904 outrec6(zvtlog,512)
7 15905 else
7 15906 swoprec6(zvtlog,512);
7 15907 tofrom(zvtlog.navn,nyt,8);
7 15908 tail(10):= tail(10)+1;
7 15909 setposition(zvtlog,0,tail(10)//64);
7 15910 monitor(44)change_entry:(zvtlog,0,tail);
7 15911 close(zvtlog,true);
7 15912 end
6 15913 else
6 15914 begin
7 15915 navn:= 0;
7 15916 close(zvtlog,true);
7 15917 open(zvtlog,4,<:vtlog:>,0);
7 15918 slet_fil;
7 15919 end;
6 15920 end
5 15921 else
5 15922 slet_fil;
5 15923 end;
4 15924
4 15924 <* logfilen er nu omdøbt og indskrevet i vtlogklar *>
4 15925 <* eller den er blevet slettet. *>
4 15926
4 15926 open(zvtlog,4,<:vtlog:>,0);
4 15927 for i:= 1 step 1 until 10 do vt_logtail(i):= 0;
4 15928 iaf:= 2; tofrom(vt_logtail.iaf,vt_logdisc,8);
4 15929 vt_logtail(6):= systime(7,0,t);
4 15930
4 15930 res:=monitor(40)create_entry:(z_vtlog,0,vt_logtail);
4 15931 if res=0 then
4 15932 begin
5 15933 monitor(50)permanent_entry:(zvtlog,3,ia);
5 15934 if res<>0 then
5 15935 monitor(48)remove_entry:(zvtlog,0,ia);
5 15936 end;
4 15937
4 15937 if res=0 then fil_åben:= true;
4 15938
4 15938 ny_fil:= fil_åben;
4 15939 end ny_fil;
3 15940
3 15940 message procedure vt_log side 4 - 920517/cl;
3 15941
3 15941 procedure skriv_post(logpost);
3 15942 integer array logpost;
3 15943 begin
4 15944 integer array field post;
4 15945 real t;
4 15946
4 15946 if vt_logtail(10)//32 < vt_logtail(1) then
4 15947 begin
5 15948 outrec6(zvtlog,512);
5 15949 post:= (vt_logtail(10) mod 32)*16;
5 15950 tofrom(zvtlog.post,logpost,16);
5 15951 vt_logtail(10):= vt_logtail(10)+1;
5 15952 setposition(zvtlog,0,vt_logtail(10)//32);
5 15953 vt_logtail(6):= systime(7,0,t);
5 15954 monitor(44)change_entry:(zvtlog,0,vt_logtail);
5 15955 end;
4 15956 end;
3 15957
3 15957 procedure sletsendte;
3 15958 begin
4 15959 zone z(128,1,stderror), zpool,zlog(1,1,stderror);
4 15960 integer array pooltail,tail,ia(1:10);
4 15961 integer i,res;
4 15962
4 15962 open(zpool,0,<:vtlogpool:>,0); close(zpool,true);
4 15963 res:=monitor(42,zpool,0,pooltail);
4 15964
4 15964 open(z,4,<:vtlogslet:>,0);
4 15965 if monitor(42,z,0,tail)=0 and tail(10)>0 then
4 15966 begin
5 15967 if monitor(52,z,0,tail)=0 then
5 15968 begin
6 15969 if monitor(8,z,0,tail)=0 then
6 15970 begin
7 15971 for i:=1 step 1 until tail(10) do
7 15972 begin
8 15973 inrec6(z,8);
8 15974 open(zlog,0,z,0); close(zlog,true);
8 15975 if monitor(42,zlog,0,ia)=0 then
8 15976 begin
9 15977 if monitor(48,zlog,0,ia)=0 then
9 15978 begin
10 15979 pooltail(1):=pooltail(1)+ia(1);
10 15980 end;
9 15981 end;
8 15982 end;
7 15983 tail(10):=0;
7 15984 monitor(44,z,0,tail);
7 15985 end
6 15986 else
6 15987 monitor(64,z,0,tail);
6 15988 end;
5 15989 if res=0 then monitor(44,zpool,0,pooltail);
5 15990 end;
4 15991 close(z,true);
4 15992 end;
3 15993
3 15993 message procedure vt_log side 5 - 920517/cl;
3 15994
3 15994 trap(vt_log_trap);
3 15995 stack_claim(200);
3 15996
3 15996 fil_åben:= false;
3 15997 if -, vt_log_aktiv then goto init_slut;
3 15998 open(zvtlog,4,<:vtlog:>,0);
3 15999 i:=monitor(42)lookup_entry:(zvtlog,0,vt_logtail);
3 16000 if i=0 then
3 16001 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 16002 if i=0 then
3 16003 begin
4 16004 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 16005 if i<>0 then monitor(64)remove_areaproc:(zvtlog,0,ia);
4 16006 end;
3 16007
3 16007 if (i=0) and (vt_logtail(1)=0) then
3 16008 begin
4 16009 close(zvtlog,true);
4 16010 monitor(48)remove_entry:(zvtlog,0,ia);
4 16011 i:= 1;
4 16012 end;
3 16013
3 16013 disable
3 16014 if i=0 then
3 16015 begin
4 16016 fil_åben:= true;
4 16017 inrec6(zvtlog,512);
4 16018 vt_logstart:= zvtlog.v_tid;
4 16019 systime(1,0.0,nu);
4 16020 if (nu - vt_logstart) < 24*60*60.0 then
4 16021 begin
5 16022 setposition(zvtlog,0,vt_logtail(10)//32);
5 16023 if (vt_logtail(10)//32) < vt_logtail(1) then
5 16024 begin
6 16025 inrec6(zvtlog,512);
6 16026 setposition(zvtlog,0,vt_logtail(10)//32);
6 16027 end;
5 16028 end
4 16029 else
4 16030 begin
5 16031 if ny_fil then
5 16032 begin
6 16033 if udvid_fil then
6 16034 begin
7 16035 systime(1,0.0,dp.v_tid);
7 16036 vt_logstart:= dp.v_tid;
7 16037 dp.v_kode:=0;
7 16038 skriv_post(dp);
7 16039 end
6 16040 else
6 16041 begin
7 16042 close(zvtlog,true);
7 16043 monitor(48)remove_entry:(zvtlog,0,ia);
7 16044 fil_åben:= false;
7 16045 end;
6 16046 end;
5 16047 end;
4 16048 end
3 16049 else
3 16050 begin
4 16051 close(zvtlog,true);
4 16052 if ny_fil then
4 16053 begin
5 16054 if udvid_fil then
5 16055 begin
6 16056 systime(1,0.0,dp.v_tid);
6 16057 vt_logstart:= dp.v_tid;
6 16058 dp.v_kode:=0;
6 16059 skriv_post(dp);
6 16060 end
5 16061 else
5 16062 begin
6 16063 close(zvtlog,true);
6 16064 monitor(48)remove_entry:(zvtlog,0,ia);
6 16065 fil_åben:= false;
6 16066 end;
5 16067 end;
4 16068 end;
3 16069
3 16069 init_slut:
3 16070
3 16070 dg:= systime(5,0,t);
3 16071 if t < vt_logskift then
3 16072 skiftetid:= systid(dg,vt_logskift)
3 16073 else
3 16074 skiftetid:= systid(dg+1,vt_logskift);
3 16075
3 16075 message procedure vt_log side 6 - 920517/cl;
3 16076
3 16076 vent:
3 16077
3 16077 systime(1,0.0,nu); dg:= systime(5,0.0,t);
3 16078 ventetid:= round(skiftetid - nu);
3 16079 if ventetid < 1 then ventetid:= 1;
3 16080
3 16080 <*V*> waitch(cs_vt_log,op,vt_optype,ventetid);
3 16081
3 16081 systime(1,0.0,nu); dg:=systime(4,nu,t);
3 16082 if op <> 0 then
3 16083 begin
4 16084 tofrom(dp,d.op.data,16);
4 16085 signalch(cs_vt_logpool,op,vt_optype);
4 16086 end;
3 16087
3 16087 if -, vt_log_aktiv then goto vent;
3 16088
3 16088 disable if (op=0) or (nu > skiftetid) then
3 16089 begin
4 16090 if fil_åben then
4 16091 begin
5 16092 dp1.v_tid:= systid(dg,vt_logskift);
5 16093 dp1.v_kode:= 1;
5 16094 if (vt_logtail(10)//32) >= vt_logtail(1) then
5 16095 begin
6 16096 if udvid_fil then
6 16097 skriv_post(dp1);
6 16098 end
5 16099 else
5 16100 skriv_post(dp1);
5 16101 end;
4 16102
4 16102 if (op=0) or (nu > skiftetid) then
4 16103 skiftetid:= skiftetid + 24*60*60.0;
4 16104
4 16104 sletsendte;
4 16105
4 16105 if ny_fil then
4 16106 begin
5 16107 if udvid_fil then
5 16108 begin
6 16109 vt_logstart:=dp1.v_tid:= systid(dg,vt_logskift);
6 16110 dp1.v_kode:= 0;
6 16111 skriv_post(dp1);
6 16112 end
5 16113 else
5 16114 begin
6 16115 close(zvtlog,true);
6 16116 monitor(48)remove_entry:(zvtlog,0,ia);
6 16117 fil_åben:= false;
6 16118 end;
5 16119 end;
4 16120 end;
3 16121
3 16121 disable if op<>0 and fil_åben then
3 16122 begin
4 16123 if (vt_logtail(10)//32) >= vt_logtail(1) then
4 16124 begin
5 16125 if -, udvid_fil then
5 16126 begin
6 16127 if ny_fil then
6 16128 begin
7 16129 if udvid_fil then
7 16130 begin
8 16131 systime(1,0.0,dp1.v_tid);
8 16132 vt_logstart:= dp1.v_tid;
8 16133 dp1.v_kode:= 0;
8 16134 skriv_post(dp1);
8 16135 end
7 16136 else
7 16137 begin
8 16138 close(zvtlog,true);
8 16139 monitor(48)remove_entry:(zvtlog,0,ia);
8 16140 fil_åben:= false;
8 16141 end;
7 16142 end;
6 16143 end;
5 16144 end;
4 16145
4 16145 if fil_åben then skriv_post(dp);
4 16146 end;
3 16147
3 16147 goto vent;
3 16148
3 16148 vt_log_trap:
3 16149 disable skriv_vt_log(zbillede,1);
3 16150 end vt_log;
2 16151 \f
2 16151
2 16151 algol list.off;
2 16152 message coroutinemonitor - 11 ;
2 16153
2 16153
2 16153 <*************** coroutine monitor procedures ***************>
2 16154
2 16154
2 16154 <***** delay *****
2 16155
2 16155 this procedure links the calling coroutine into the timerqueue and sets
2 16156 the timeout value to 'timeout'. *>
2 16157
2 16157
2 16157 procedure delay (timeout);
2 16158 value timeout;
2 16159 integer timeout;
2 16160 begin
3 16161 link(current, idlequeue);
3 16162 link(current + corutimerchain, timerqueue);
3 16163 d.current.corutimer:= timeout;
3 16164
3 16164
3 16164 passivate;
3 16165 d.current.corutimer:= 0;
3 16166 end;
2 16167 \f
2 16167
2 16167 message coroutinemonitor - 12 ;
2 16168
2 16168
2 16168 <***** pass *****
2 16169
2 16169 this procedure moves the calling coroutine from the head of the ready
2 16170 queue down below all coroutines of lower or equal priority. *>
2 16171
2 16171
2 16171 procedure pass;
2 16172 begin
3 16173 linkprio(current, readyqueue);
3 16174
3 16174
3 16174 passivate;
3 16175 end;
2 16176
2 16176
2 16176 <***** signal ****
2 16177
2 16177 this procedure increases the value af 'semaphore' by 1.
2 16178 in case some coroutine is already waiting, it is linked into the ready
2 16179 queue for activation. the calling coroutine continues execution. *>
2 16180
2 16180
2 16180 procedure signal (semaphore);
2 16181 value semaphore;
2 16182 integer semaphore;
2 16183 begin
3 16184 integer array field sem;
3 16185 sem:= semaphore;
3 16186 if d.sem.simvalue < 0 then linkprio(d.sem.simcoru, readyqueue);
3 16187 d.sem.simvalue:= d.sem.simvalue + 1;
3 16188
3 16188
3 16188 end;
2 16189 \f
2 16189
2 16189 message coroutinemonitor - 13 ;
2 16190
2 16190
2 16190 <***** wait *****
2 16191
2 16191 this procedure decreases the value of 'semaphore' by 1.
2 16192 in case the value of the semaphore is negative after the decrease, the
2 16193 calling coroutine is linked into the semaphore queue waiting for a
2 16194 coroutine to signal this semaphore. *>
2 16195
2 16195
2 16195 procedure wait (semaphore);
2 16196 value semaphore;
2 16197 integer semaphore;
2 16198 begin
3 16199 integer array field sem;
3 16200 sem:= semaphore;
3 16201 d.sem.simvalue:= d.sem.simvalue - 1;
3 16202
3 16202
3 16202 linkprio(current, if d.sem.simvalue < 0 then sem+simcoru else readyqueue);
3 16203 passivate;
3 16204 end;
2 16205 \f
2 16205
2 16205 message coroutinemonitor - 14 ;
2 16206
2 16206
2 16206 <***** inspect *****
2 16207
2 16207 this procedure inspects the value of the semaphore and returns it in
2 16208 'elements'.
2 16209 the semaphore is left unchanged. *>
2 16210
2 16210
2 16210 procedure inspect (semaphore, elements);
2 16211 value semaphore;
2 16212 integer semaphore, elements;
2 16213 begin
3 16214 integer array field sem;
3 16215 sem:= semaphore;
3 16216 elements:= d.sem.simvalue;
3 16217
3 16217
3 16217 end;
2 16218 \f
2 16218
2 16218 message coroutinemonitor - 15 ;
2 16219
2 16219
2 16219 <***** signalch *****
2 16220
2 16220 this procedure delivers an operation at 'semaphore'.
2 16221 in case another coroutine is already waiting for an operation of the
2 16222 kind 'operationtype' this coroutine will get the operation and it will
2 16223 be put into the ready queue for activation.
2 16224 in case no coroutine is waiting for the actial kind of operation it is
2 16225 linked into the semaphore queue, at the end of the queue
2 16226 if operation is positive and at the beginning if operation is negative.
2 16227 the calling coroutine continues execution. *>
2 16228
2 16228
2 16228 procedure signalch (semaphore, operation, operationtype);
2 16229 value semaphore, operation, operationtype;
2 16230 integer semaphore, operation;
2 16231 boolean operationtype;
2 16232 begin
3 16233 integer array field firstcoru, currcoru, op,currop;
3 16234 op:= abs operation;
3 16235 d.op.optype:= operationtype;
3 16236 firstcoru:= semaphore + semcoru;
3 16237 currcoru:= d.firstcoru.next;
3 16238 while currcoru <> firstcoru do
3 16239 begin
4 16240 if (d.currcoru.corutypeset and operationtype) extract 12 <> 0 then
4 16241 begin
5 16242 link(operation, 0);
5 16243 d.currcoru.coruop:= operation;
5 16244 linkprio(currcoru, readyqueue);
5 16245 link(currcoru + corutimerchain, idlequeue);
5 16246 goto exit;
5 16247 end else currcoru:= d.currcoru.next;
4 16248 end;
3 16249 currop:=semaphore + semop;
3 16250 if operation < 0 then currop:=d.currop.next;
3 16251 link(op, currop);
3 16252 exit:
3 16253
3 16253
3 16253 end;
2 16254 \f
2 16254
2 16254 message coroutinemonitor - 16 ;
2 16255
2 16255
2 16255 <***** waitch *****
2 16256
2 16256 this procedure fetches an operation from a semaphore.
2 16257 in case an operation matching 'operationtypeset' is already waiting at
2 16258 'semaphore' it is handed over to the calling coroutine.
2 16259 in case no matching operation is waiting, the calling coroutine is
2 16260 linked to the semaphore.
2 16261 in any case the calling coroutine will be stopped and all corouti-
2 16262 nes are rescheduled. *>
2 16263
2 16263
2 16263 procedure waitch (semaphore, operation, operationtypeset, timeout);
2 16264 value semaphore, operationtypeset, timeout;
2 16265 integer semaphore, operation, timeout;
2 16266 boolean operationtypeset;
2 16267 begin
3 16268 integer array field firstop, currop;
3 16269 firstop:= semaphore + semop;
3 16270 currop:= d.firstop.next;
3 16271
3 16271
3 16271 while currop <> firstop do
3 16272 begin
4 16273 if (d.currop.optype and operationtypeset) extract 12 <> 0 then
4 16274 begin
5 16275 link(currop, 0);
5 16276 d.current.coruop:= currop;
5 16277 operation:= currop;
5 16278 \f
5 16278
5 16278 message coroutinemonitor - 17 ;
5 16279
5 16279 linkprio(current, readyqueue);
5 16280 passivate;
5 16281 goto exit;
5 16282 end else currop:= d.currop.next;
4 16283 end;
3 16284 linkprio(current, semaphore + semcoru);
3 16285 if timeout > 0 then
3 16286 begin
4 16287 link(current + corutimerchain, timerqueue);
4 16288 d.current.corutimer:= timeout;
4 16289 end else d.current.corutimer:= 0;
3 16290 d.current.corutypeset:= operationtypeset;
3 16291 passivate;
3 16292 if d.current.corutimer < 0 then operation:= 0
3 16293 else operation:= d.current.coruop;
3 16294 d.current.corutimer:= 0;
3 16295 currop:= operation;
3 16296 d.current.coruop:= currop;
3 16297 link(current+corutimerchain, idlequeue);
3 16298 exit:
3 16299
3 16299
3 16299 end;
2 16300 \f
2 16300
2 16300 message coroutinemonitor - 18 ;
2 16301
2 16301
2 16301 <***** inspectch *****
2 16302
2 16302 this procedure inspects the queue of operations waiting at 'semaphore'.
2 16303 the number of matching operations are counted and delivered in 'elements'.
2 16304 if no operations are found the number of coroutines waiting
2 16305 for operations of the typeset are counted and delivered as
2 16306 negative value in 'elements'.
2 16307 the semaphore is left unchanged. *>
2 16308
2 16308
2 16308 procedure inspectch (semaphore, operationtypeset, elements);
2 16309 value semaphore, operationtypeset;
2 16310 integer semaphore, elements;
2 16311 boolean operationtypeset;
2 16312 begin
3 16313 integer array field firstop, currop,firstcoru,currcoru;
3 16314 integer counter;
3 16315 counter:= 0;
3 16316 firstop:= semaphore + semop;
3 16317 currop:= d.firstop.next;
3 16318 while currop <> firstop do
3 16319 begin
4 16320 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16321 counter:= counter + 1;
4 16322 currop:= d.currop.next;
4 16323 end;
3 16324 if counter=0 then
3 16325 begin
4 16326 firstcoru:=semaphore + sem_coru;
4 16327 curr_coru:=d.firstcoru.next;
4 16328 while curr_coru<>first_coru do
4 16329 begin
5 16330 if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
5 16331 counter:=counter - 1;
5 16332 curr_coru:=d.curr_coru.next;
5 16333 end;
4 16334 end;
3 16335 elements:= counter;
3 16336
3 16336
3 16336 end;
2 16337 \f
2 16337
2 16337 message coroutinemonitor - 19 ;
2 16338
2 16338
2 16338 <***** csendmessage *****
2 16339
2 16339 this procedure sends the message in 'mess' to the process defined by the name
2 16340 in 'receiver', and returns an identification of the message extension used
2 16341 for sending the message (this identification is to be used for calling 'cwait-
2 16342 answer' or 'cregretmessage'. *>
2 16343
2 16343
2 16343 procedure csendmessage (receiver, mess, messextension);
2 16344 real array receiver;
2 16345 integer array mess;
2 16346 integer messextension;
2 16347 begin
3 16348 integer bufref, messext;
3 16349 messref(maxmessext):= 0;
3 16350 messext:= 1;
3 16351 while messref(messext) <> 0 do messext:= messext + 1;
3 16352 if messext = maxmessext then <* no resources *> messext:= 0 else
3 16353 begin
4 16354 messcode(messext):= 1 shift 12 add 2;
4 16355 mon(16) send message :(0, mess, 0, receiver);
4 16356 messref(messext):= monw2;
4 16357 if monw2 > 0 then messextension:= messext else messextension:= 0;
4 16358 end;
3 16359
3 16359
3 16359 end;
2 16360 \f
2 16360
2 16360 message coroutinemonitor - 20 ;
2 16361
2 16361
2 16361 <***** cwaitanswer *****
2 16362
2 16362 this procedure asks the coroutine monitor to get an answer to the message
2 16363 corresponding to 'messextension'. in case the answer has already arrived
2 16364 it stays in the eventqueue until 'cwaitanswer' is called.
2 16365 in case 'timeout' is positive, the coroutine is linked into the timer
2 16366 queue, and in case the answer does not arrive within 'timout' seconds the
2 16367 coroutine is restarted with result = 0. *>
2 16368
2 16368
2 16368 procedure cwaitanswer (messextension, answer, result, timeout);
2 16369 value messextension, timeout;
2 16370 integer messextension, result, timeout;
2 16371 integer array answer;
2 16372 begin
3 16373 integer messext;
3 16374 messext:= messextension;
3 16375 messcode(messext):= messcode(messext) extract 12;
3 16376 link(current, idlequeue);
3 16377 messop(messext):= current;
3 16378 if timeout > 0 then
3 16379 begin
4 16380 link(current + corutimerchain, timerqueue);
4 16381 d.current.corutimer:= timeout;
4 16382 end else d.current.corutimer:= 0;
3 16383
3 16383
3 16383 passivate;
3 16384 if d.current.corutimer < 0 then result:= 0 else
3 16385 begin
4 16386 mon(18) wait answer :(0, answer, messref(messextension), 0);
4 16387 result:= monw0;
4 16388 baseevent:= 0;
4 16389 messref(messextension):= 0;
4 16390 end;
3 16391 d.current.corutimer:= 0;
3 16392 link(current+corutimerchain, idlequeue);
3 16393 end;
2 16394 \f
2 16394
2 16394 message coroutinemonitor - 21 ;
2 16395
2 16395
2 16395 <***** cwaitmessage *****
2 16396
2 16396 this procedure asks the coroutine monitor to give it a message, when some-
2 16397 one arrives. in case a message has arrived already it stays at the event queue
2 16398 until 'cwaitmessage' is called.
2 16399 in case 'timeout' is positive, the coroutine is linked into the timer queue,
2 16400 if no message arrives within 'timeout' seconds, the coroutine is restarted
2 16401 with messbufferref = 0. *>
2 16402
2 16402
2 16402 procedure cwaitmessage (processextension, mess, messbufferref, timeout);
2 16403 value timeout, processextension;
2 16404 integer processextension, messbufferref, timeout;
2 16405 integer array mess;
2 16406 begin
3 16407 integer i;
3 16408 integer array field messbuf;
3 16409 proccode(processextension):= 2;
3 16410 procop(processextension):= current;
3 16411 link(current, idlequeue);
3 16412 if timeout > 0 then
3 16413 begin
4 16414 link(current + corutimerchain, timerqueue);
4 16415 d.current.corutimer:= timeout;
4 16416 end else d.current.corutimer:= 0;
3 16417
3 16417
3 16417 passivate;
3 16418 if d.current.corutimer < 0 then messbufferref:= 0 else
3 16419 begin
4 16420 messbuf:= procop(processextension);
4 16421 for i:=1 step 1 until 8 do mess(i):= core.messbuf(4+i);
4 16422 proccode(procext):= 1 shift 12;
4 16423 messbufferref:= messbuf;
4 16424 baseevent:= 0;
4 16425 end;
3 16426 d.current.corutimer:= 0;
3 16427 link(current+corutimerchain, idlequeue);
3 16428 end;
2 16429 \f
2 16429
2 16429 message coroutinemonitor - 22 ;
2 16430
2 16430
2 16430 <***** cregretmessage *****
2 16431
2 16431 this procedure regrets the message corresponding to messageexten-
2 16432 sion, to release message buffer and message extension.
2 16433 i/o messages are not regretable. *>
2 16434
2 16434
2 16434
2 16434 procedure cregretmessage (messageextension);
2 16435 value messageextension;
2 16436 integer messageextension;
2 16437 begin
3 16438 integer array field messbuf;
3 16439 messbuf:= messref(messageextension);
3 16440 mon(82) regret message :(0, 0, messbuf, 0);
3 16441 messref(messageextension):= 0;
3 16442
3 16442
3 16442 end;
2 16443 \f
2 16443
2 16443 message coroutinemonitor - 23 ;
2 16444
2 16444
2 16444 <***** semsendmessage *****
2 16445
2 16445 this procedure sends the message 'mess' to 'receiver' and at the same time it
2 16446 defines a 'signalch(semaphore, operation, operationtype)' to be performed
2 16447 by the monitor, when the answer arrives.
2 16448 in case there are too few resources to send the message, the operation is
2 16449 returned immediately with the result field set to zero. *>
2 16450
2 16450
2 16450 procedure semsendmessage (receiver, mess, semaphore, operation, operationtype);
2 16451 value semaphore, operation, operationtype;
2 16452 real array receiver;
2 16453 integer array mess;
2 16454 integer semaphore, operation;
2 16455 boolean operationtype;
2 16456 begin
3 16457 integer array field op;
3 16458 integer messext;
3 16459 op:= operation;
3 16460 messref(maxmessext):= 0;
3 16461 messext:= 1;
3 16462 while messref(messext) <> 0 do messext:= messext + 1;
3 16463 if messext < maxmessext then
3 16464 begin
4 16465 messop(messext):= op;
4 16466 messcode(messext):=1;
4 16467 d.op(1):= semaphore;
4 16468 d.op.optype:= operationtype;
4 16469 mon(16) send message :(0, mess, 0, receiver);
4 16470 messref(messext):= monw2;
4 16471 end;
3 16472
3 16472
3 16472 if messext = maxmessext or messref(messext) = 0 <* no resources *> then
3 16473 begin <* return the operation immediately with result = 0 *>
4 16474 d.op(9):= 0;
4 16475 signalch(semaphore, op, operationtype);
4 16476 end;
3 16477 end;
2 16478 \f
2 16478
2 16478 message coroutinemonitor - 24 ;
2 16479
2 16479
2 16479 <***** semwaitmessage *****
2 16480
2 16480 this procedure defines a 'signalch(semaphore, operation, operationtype)' to
2 16481 be performed by the coroutine monitor when a message arrives to the process
2 16482 corresponding to 'processextension'. *>
2 16483
2 16483
2 16483 procedure semwaitmessage (processextension, semaphore, operation, operationtype);
2 16484 value processextension, semaphore, operation, operationtype;
2 16485 integer processextension, semaphore, operation;
2 16486 boolean operationtype;
2 16487 begin
3 16488 integer array field op;
3 16489 op:= operation;
3 16490 procop(processextension):= operation;
3 16491 d.op(1):= semaphore;
3 16492 d.op.optype:= operationtype;
3 16493 proccode(processextension):= 1;
3 16494
3 16494
3 16494 end;
2 16495 \f
2 16495
2 16495 message coroutinemonitor - 25 ;
2 16496
2 16496
2 16496 <***** semregretmessage *****
2 16497
2 16497 this procedure regrets a message sent by semsendmessage.
2 16498 the message is identified by the operation in which the answer should be
2 16499 returned.
2 16500 the procedure sets the result field of the operation to zero, and then
2 16501 returns it by performing a signalch. *>
2 16502
2 16502
2 16502 procedure semregretmessage (operation);
2 16503 value operation;
2 16504 integer operation;
2 16505 begin
3 16506 integer i, j;
3 16507 integer array field op, sem;
3 16508 op:= operation;
3 16509 i:= 1;
3 16510 while i < maxmessext do
3 16511 begin
4 16512 if messref(i) > 0 and (messcode(i) = 1 and messop(i) = op) then
4 16513 begin
5 16514 mon(82) regret message :(0, 0, messref(i), 0);
5 16515 messref(i):= 0;
5 16516 sem:= d.op(1);
5 16517 for j:=1 step 1 until 9 do d.op(j):= 0;
5 16518 signalch(sem, op, d.op.optype);
5 16519 i:= maxmessext;
5 16520 end;
4 16521 i:= i + 1;
4 16522 end;
3 16523
3 16523
3 16523 end;
2 16524 \f
2 16524
2 16524 message coroutinemonitor - 26 ;
2 16525
2 16525
2 16525 <***** link *****
2 16526
2 16526 this procedure links an object (allocated in the descriptor array 'd') into
2 16527 a queue of alements (allocated in the descriptor array 'd'). the queues
2 16528 are all double chained, and the chainhead is of the same format as the chain
2 16529 fields of the objects.
2 16530 the procedure links the object immediately after the head. *>
2 16531
2 16531
2 16531 procedure link (object, chainhead);
2 16532 value object, chainhead;
2 16533 integer object, chainhead;
2 16534 begin
3 16535 integer array field prevelement, nextelement, chead, obj;
3 16536 obj:= object;
3 16537 chead:= chainhead;
3 16538 prevelement:= d.obj.prev;
3 16539 nextelement:= d.obj.next;
3 16540 d.prevelement.next:= nextelement;
3 16541 d.nextelement.prev:= prevelement;
3 16542 if chead > 0 then <* link into queue *>
3 16543 begin
4 16544 prevelement:= d.chead.prev;
4 16545 d.obj.prev:= prevelement;
4 16546 d.prevelement.next:= obj;
4 16547 d.obj.next:= chead;
4 16548 d.chead.prev:= obj;
4 16549 end else
3 16550 begin <* link onto itself *>
4 16551 d.obj.prev:= obj;
4 16552 d.obj.next:= obj;
4 16553 end;
3 16554 end;
2 16555 \f
2 16555
2 16555 message coroutinemonitor - 27 ;
2 16556
2 16556
2 16556 <***** linkprio *****
2 16557
2 16557 this procedure is used to link coroutines into queues corresponding to
2 16558 the priorities of the actual coroutine and the queue elements.
2 16559 the object is linked immediately before the first coroutine of lower prio-
2 16560 rity. *>
2 16561
2 16561
2 16561 procedure linkprio (object, chainhead);
2 16562 value object, chainhead;
2 16563 integer object, chainhead;
2 16564 begin
3 16565 integer array field currelement, chead, obj;
3 16566 obj:= object;
3 16567 chead:= chainhead;
3 16568 currelement:= d.chead.next;
3 16569 while currelement <> chead
3 16570 and d.currelement.corupriority <= d.obj.corupriority
3 16571 do currelement:= d.currelement.next;
3 16572 link(obj, currelement);
3 16573 end;
2 16574 \f
2 16574
2 16574 message coroutinemonitor - 28 ;
2 16575
2 16575 \f
2 16575
2 16575 message coroutinemonitor - 30a ;
2 16576
2 16576
2 16576 <*************** extention to coroutine monitor procedures **********>
2 16577
2 16577 <***** signalbin *****
2 16578
2 16578 this procedure simulates a binary semaphore on a simple semaphore
2 16579 by testing the value of the semaphore before signaling the
2 16580 semaphore. if the value of the semaphore is one (=open) nothing is
2 16581 done, otherwise a normal signal is carried out. *>
2 16582
2 16582
2 16582 procedure signalbin(semaphore);
2 16583 value semaphore;
2 16584 integer semaphore;
2 16585 begin
3 16586 integer array field sem;
3 16587 integer val;
3 16588 sem:= semaphore;
3 16589 inspect(sem,val);
3 16590 if val<1 then signal(sem);
3 16591 end;
2 16592 \f
2 16592
2 16592 message coroutinemonitor - 30b ;
2 16593
2 16593 <***** coruno *****
2 16594
2 16594 delivers the coroutinenumber for a give coroutine id.
2 16595 if the coroutine does not exists the value 0 is delivered *>
2 16596
2 16596 integer procedure coru_no(coru_id);
2 16597 value coru_id;
2 16598 integer coru_id;
2 16599 begin
3 16600 integer array field cor;
3 16601
3 16601 coru_no:= 0;
3 16602 for cor:= firstcoru step corusize until (coruref-1) do
3 16603 if d.cor.coruident//1000 = coru_id then
3 16604 coru_no:= d.cor.coruident mod 1000;
3 16605 end;
2 16606 \f
2 16606
2 16606 message coroutinemonitor - 30c ;
2 16607
2 16607 <***** coroutine *****
2 16608
2 16608 delivers the referencebyte for the coroutinedescriptor for
2 16609 a coroutine identified by coroutinenumber *>
2 16610
2 16610 integer procedure coroutine(cor_no);
2 16611 value cor_no;
2 16612 integer cor_no;
2 16613 coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
2 16614 firstcoru + (cor_no-1)*corusize;
2 16615 \f
2 16615
2 16615 message coroutinemonitor - 30d ;
2 16616
2 16616 <***** curr_coruno *****
2 16617
2 16617 delivers number of calling coroutine
2 16618 curr_coruno:
2 16619 < 0 = -current_coroutine_number in disabled mode
2 16620 = 0 = procedure not called from coroutine
2 16621 > 0 = current_coroutine_number in enabled mode *>
2 16622
2 16622 integer procedure curr_coruno;
2 16623 begin
3 16624 integer i;
3 16625 integer array ia(1:12);
3 16626
3 16626 i:= system(12,0,ia);
3 16627 if i > 0 then
3 16628 begin
4 16629 i:= system(12,1,ia);
4 16630 curr_coruno:= ia(3);
4 16631 end else curr_coruno:= 0;
3 16632 end curr_coruno;
2 16633 \f
2 16633
2 16633 message coroutinemonitor - 30e ;
2 16634
2 16634 <***** curr_coruid *****
2 16635
2 16635 delivers coruident of calling coroutine :
2 16636
2 16636 curr_coruid:
2 16637 > 0 = coruident of calling coroutine
2 16638 = 0 = procedure not called from coroutine *>
2 16639
2 16639 integer procedure curr_coruid;
2 16640 begin
3 16641 integer cor_no;
3 16642 integer array field cor;
3 16643
3 16643 cor_no:= abs curr_coruno;
3 16644 if cor_no <> 0 then
3 16645 begin
4 16646 cor:= coroutine(cor_no);
4 16647 curr_coruid:= d.cor.coruident // 1000;
4 16648 end
3 16649 else curr_coruid:= 0;
3 16650 end curr_coruid;
2 16651 \f
2 16651 message coroutinemonitor - 30f.1 ;
2 16652
2 16652 <**** getch *****
2 16653
2 16653 this procedure searches the queue of operations waiting at 'semaphore'
2 16654 to find an operation that matches the operationstypeset and a set of
2 16655 select-values. each select value is specified by type and fieldvalue
2 16656 in integer array 'type' and by the value in integer array 'val'.
2 16657
2 16657 0: eq 0: not used
2 16658 1: lt 1: boolean
2 16659 2: le 2: integer
2 16660 3: gt 3: long
2 16661 4: ge 4: real
2 16662 5: ne
2 16663 *>
2 16664
2 16664 procedure getch(semaphore,operation,operationtypeset,type,val);
2 16665 value semaphore,operationtypeset;
2 16666 integer semaphore,operation;
2 16667 boolean operationtypeset;
2 16668 integer array type,val;
2 16669 begin
3 16670 integer array field firstop,currop;
3 16671 integer ø,n,i,f,t,rel,i1,i2;
3 16672 boolean field bf,bfval;
3 16673 integer field intf;
3 16674 long field lf,lfval; long l1,l2;
3 16675 real field rf,rfval; real r1,r2;
3 16676
3 16676 boolean match;
3 16677
3 16677 operation:= 0;
3 16678 n:= system(3,ø,type);
3 16679 match:= false;
3 16680 firstop:= semaphore + semop;
3 16681 currop:= d.firstop.next;
3 16682 while currop <> firstop and -,match do
3 16683 begin
4 16684 if (operationtypeset and d.currop.optype) extract 12 <> 0 then
4 16685 begin
5 16686 i:= n;
5 16687 match:= true;
5 16688 \f
5 16688 message coroutinemonitor - 30f.2 ;
5 16689
5 16689 while match and (if i <= ø then type(i) >= 0 else false) do
5 16690 begin
6 16691 rel:= type(i) shift(-18);
6 16692 t:= type(i) shift(-12) extract 6;
6 16693 f:= type(i) extract 12;
6 16694 if f > 2047 then f:= f -4096;
6 16695 case t+1 of
6 16696 begin
7 16697 ; <* not used *>
7 16698
7 16698 begin <*boolean or signed short integer*>
8 16699 bf:= f;
8 16700 bfval:= 2*i;
8 16701 i1:= d.currop.bf extract 12;
8 16702 if i1 > 2047 then i1:= i1-4096;
8 16703 i2:= val.bfval extract 12;
8 16704 if i2 > 2047 then i2:= i2-4096;
8 16705 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16706 end;
7 16707
7 16707 begin <*integer*>
8 16708 intf:= f;
8 16709 i1:= d.currop.intf;
8 16710 i2:= val(i);
8 16711 match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
8 16712 end;
7 16713
7 16713 begin <*long*>
8 16714 lf:= f;
8 16715 lfval:= i*2;
8 16716 l1:= d.currop.lf;
8 16717 l2:= val.lfval;
8 16718 match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
8 16719 end;
7 16720
7 16720 begin <*real*>
8 16721 rf:= f;
8 16722 rfval:= i*2;
8 16723 r1:= d.currop.rf;
8 16724 r2:= val.rfval;
8 16725 match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
8 16726 end;
7 16727
7 16727 end;<*case t+1*>
6 16728
6 16728 i:= i+1;
6 16729 end; <*while match and i<=ø and t>=0 *>
5 16730 \f
5 16730 message coroutinemonitor - 30f.3 ;
5 16731
5 16731 end; <* if operationtypeset and ---*>
4 16732 if -,match then currop:= d.currop.next;
4 16733 end; <*while currop <> firstop and -,match*>
3 16734
3 16734 if match then
3 16735 begin
4 16736 link(currop,0);
4 16737 d.current.coruop:= currop;
4 16738 operation:= currop;
4 16739 end;
3 16740 end getch;
2 16741 \f
2 16741
2 16741 message coroutinemonitor - 31 ;
2 16742
2 16742 activity(maxcoru);
2 16743
2 16743 goto initialization;
2 16744
2 16744
2 16744
2 16744 <*************** event handling ***************>
2 16745
2 16745
2 16745
2 16745 takeexternal:
2 16746 currevent:= baseevent;
2 16747 eventqueueempty:= false;
2 16748 repeat
2 16749 current:= 0;
2 16750 prevevent:= currevent;
2 16751 mon(66) test event :(0, 0, currevent, 0);
2 16752 currevent:= monw2;
2 16753 if monw0 < 0 <* no event *> then goto takeinternal;
2 16754 if monw0 = 1 and monw1 > 0 and monw1 <= maxcoru then
2 16755 cmi:= monw1
2 16756 else
2 16757 cmi:= - monw0;
2 16758
2 16758 if cmi > 0 then
2 16759 begin <* answer to activity zone *>
3 16760 current:= firstcoru + (cmi - 1) * corusize;
3 16761 linkprio(current, readyqueue);
3 16762 baseevent:= 0;
3 16763 end else
2 16764
2 16764 if cmi = 0 then
2 16765 begin <* message arrived *>
3 16766 \f
3 16766
3 16766 message coroutinemonitor - 32 ;
3 16767
3 16767 receiver:= core.currevent(3);
3 16768 if receiver < 0 then receiver:= - receiver;
3 16769 procref(maxprocext):= receiver;
3 16770 procext:= 1;
3 16771 while procref(procext) <> receiver do procext:= procext + 1;
3 16772 if procext = maxprocext then
3 16773 begin <* receiver unknown *>
4 16774 <* leave the message unchanged *>
4 16775 end else
3 16776 if proccode(procext) shift (-12) = 0 then
3 16777 begin <* the receiver is ready for accepting messages *>
4 16778 mon(26) get event :(0, 0, currevent, 0);
4 16779 case proccode(procext) of
4 16780 begin
5 16781 begin <* message received by semwaitmessage *>
6 16782 op:= procop(procext);
6 16783 sem:= d.op(1);
6 16784 for cmj:=1 step 1 until 8 do d.op(cmj):= core.currevent(4+cmj);
6 16785 d.op(9):= currevent;
6 16786 signalch(sem, op, d.op.optype);
6 16787 proccode(procext):= 1 shift 12;
6 16788 end;
5 16789 begin <* message received by cwaitmessage *>
6 16790 current:= procop(procext);
6 16791 procop(procext):= currevent;
6 16792 linkprio(current, readyqueue);
6 16793 link(current + corutimerchain, idlequeue);
6 16794
6 16794
6 16794 end;
5 16795 end; <* case *>
4 16796 currevent:= baseevent;
4 16797 proccode(procext):= 1 shift 12;
4 16798 end;
3 16799 end <* message *> else
2 16800
2 16800 if cmi = -1 then
2 16801 begin <* answer arrived *>
3 16802 \f
3 16802
3 16802 message coroutinemonitor - 33 ;
3 16803
3 16803 if currevent = timermessage then
3 16804 begin
4 16805 mon(26) get event :(0, 0, currevent, 0);
4 16806 coru:= d.timerqueue.next;
4 16807 while coru <> timerqueue do
4 16808 begin
5 16809 current:= coru - corutimerchain;
5 16810 d.current.corutimer:= d.current.corutimer - clockmess(2);
5 16811 coru:= d.coru.next;
5 16812 if d.current.corutimer <= 0 then
5 16813 begin <* timer perion expired *>
6 16814 d.current.corutimer:= -1;
6 16815 linkprio(current, readyqueue);
6 16816 link(current + corutimerchain, idlequeue);
6 16817 end;
5 16818 end;
4 16819 mon(16) send message :(0, clockmess, 0, clock);
4 16820 timermessage:= monw2;
4 16821 currevent:= baseevent;
4 16822 end <* timer answer *> else
3 16823 begin
4 16824 messref(maxmessext):= currevent;
4 16825 messext:= 1;
4 16826 while messref(messext) <> currevent do messext:= messext + 1;
4 16827 if messext = maxmessext then
4 16828 begin <* the answer is unknown *>
5 16829 <* leave the answer unchanged - it may belong to an activity *>
5 16830 end else
4 16831 if messcode(messext) shift (-12) = 0 then
4 16832 begin
5 16833 case messcode(messext) extract 12 of
5 16834 begin
6 16835 \f
6 16835
6 16835 message coroutinemonitor - 34 ;
6 16836 begin <* answer arrived after semsendmessage *>
7 16837 op:= messop(messext);
7 16838 sem:= d.op(1);
7 16839 mon(18) wait answer :(0, d.op, currevent, 0);
7 16840 d.op(9):= monw0;
7 16841 signalch(sem, op, d.op.optype);
7 16842 messref(messext):= 0;
7 16843 baseevent:= 0;
7 16844 end;
6 16845 begin <* answer arrived after csendmessage *>
7 16846 current:= messop(messext);
7 16847 linkprio(current, readyqueue);
7 16848 link(current + corutimerchain, idlequeue);
7 16849
7 16849
7 16849 end;
6 16850 end;
5 16851 end else baseevent:= currevent;
4 16852 end;
3 16853 end;
2 16854 until eventqueueempty;
2 16855 \f
2 16855
2 16855 message coroutinemonitor - 35 ;
2 16856
2 16856
2 16856
2 16856 <*************** coroutine activation ***************>
2 16857
2 16857 takeinternal:
2 16858
2 16858 current:= d.readyqueue.next;
2 16859 if current = readyqueue then
2 16860 begin
3 16861 mon(24) wait event :(0, 0, prevevent, 0);
3 16862 goto takeexternal;
3 16863 end;
2 16864
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,<: aktiveres:>);
3 16870 <**> end;
2 16871 <*-2*>
2 16872
2 16872 corustate:= activate(d.current.coruident mod 1000);
2 16873 cmi:= corustate extract 24;
2 16874 <*+2*> if testbit30 and d.current.corutestmask shift(-11) then
2 16875 <**> begin
3 16876 <**> systime(5,0,r);
3 16877 <**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
3 16878 <**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
3 16879 <**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
3 16880 <**> end;
2 16881 <*-2*>
2 16882
2 16882 if cmi = 1 then
2 16883 begin <* programmed passivate *>
3 16884 goto takeexternal;
3 16885 end;
2 16886
2 16886 if cmi = 2 then
2 16887 begin <* implicit passivate in activity *>
3 16888
3 16888
3 16888 link(current, idlequeue);
3 16889 goto takeexternal;
3 16890 end;
2 16891 \f
2 16891
2 16891 message coroutinemonitor - 36 ;
2 16892
2 16892 <* coroutine termination (normal or abnormal) *>
2 16893
2 16893 <* aktioner ved normal og unormal coroutineterminering insættes her *>
2 16894 coru_term:
2 16895
2 16895 begin
3 16896 if false and alarmcause extract 24 = (-9) <* break *> and
3 16897 alarmcause shift (-24) extract 24 = 0 then
3 16898 begin
4 16899 endaction:= 2;
4 16900 goto program_slut;
4 16901 end;
3 16902 if alarmcause extract 24 = (-9) <* break *> and
3 16903 alarmcause shift (-24) = 8 <* parent *>
3 16904 then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
3 16905 if alarmcause shift (-24) extract 24 <> -2 or
3 16906 alarmcause extract 24 <> -13 then
3 16907 begin
4 16908 write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
4 16909 alarmcause shift (-24),<:,:>,
4 16910 alarmcause extract 24);
4 16911 for i:=1 step 1 until max_coru do
4 16912 j:=activate(-i); <* kill *>
4 16913 <* skriv billede *>
4 16914 end
3 16915 else
3 16916 begin
4 16917 errorbits:= 0; <* ok.yes warning.no *>
4 16918 goto finale;
4 16919 end;
3 16920 end;
2 16921
2 16921 goto dump;
2 16922
2 16922 link(current, idlequeue);
2 16923 goto takeexternal;
2 16924 \f
2 16924
2 16924 message coroutinemonitor - 37 ;
2 16925
2 16925
2 16925
2 16925 initialization:
2 16926
2 16926
2 16926 <*************** initialization ***************>
2 16927
2 16927 <* chain head *>
2 16928
2 16928 prev:= -2; <* -2 prev *>
2 16929 next:= 0; <* +0 next *>
2 16930
2 16930 <* corutine descriptor *>
2 16931
2 16931 <* -2 prev *>
2 16932 <* +0 next *>
2 16933 <* +2 (link field) *>
2 16934 corutimerchain:= next + 4; <* +4 corutimerchain *>
2 16935 <* +6 (link field) *>
2 16936 coruop:= corutimerchain + 4; <* +8 coruop *>
2 16937 corutimer:= coruop + 2; <*+10 corutimer *>
2 16938 coruident:= corutimer + 2; <*+12 coruident *>
2 16939 corupriority:= coruident + 2; <*+14 corupriority *>
2 16940 corutypeset:= corupriority + 1; <*+15 corutypeset *>
2 16941 corutestmask:= corutypeset + 1; <*+16 corutestmask *>
2 16942
2 16942 <* simple semaphore *>
2 16943
2 16943 <* -2 (link field) *>
2 16944 simcoru:= next; <* +0 simcoru *>
2 16945 simvalue:= simcoru + 2; <* +2 simvalue *>
2 16946
2 16946 <* chained semaphore *>
2 16947
2 16947 <* -2 (link field) *>
2 16948 semcoru:= next; <* +0 semcoru *>
2 16949 <* +2 (link field) *>
2 16950 semop:= semcoru + 4; <* +4 semop *>
2 16951 \f
2 16951
2 16951 message coroutinemonitor - 38 ;
2 16952
2 16952 <* operation *>
2 16953
2 16953 opsize:= next - 6; <* -6 opsize *>
2 16954 optype:= opsize + 1; <* -5 optype *>
2 16955 <* -2 prev *>
2 16956 <* +0 next *>
2 16957 <* +2 operation(1) *>
2 16958 <* +4 operation(2) *>
2 16959 <* +6 - *>
2 16960 <* . - *>
2 16961 <* . - *>
2 16962
2 16962 \f
2 16962
2 16962 message coroutinemonitor - 39 ;
2 16963
2 16963 trap(dump);
2 16964 systime(1, 0, starttime);
2 16965 for cmi:= 1 step 1 until maxmessext do messref(cmi):= 0;
2 16966 clockmess(1):= 0;
2 16967 clockmess(2):= timeinterval;
2 16968 clock(1):= real <:clock:>;
2 16969 clock(2):= real <::>;
2 16970 mon(16) send message :(0, clockmess, 0, clock);
2 16971 timermessage:= monw2;
2 16972 readyqueue:= 4;
2 16973 initchain(readyqueue);
2 16974 idlequeue:= readyqueue + 4;
2 16975 initchain(idlequeue);
2 16976 timerqueue:= idlequeue + 4;
2 16977 initchain(timerqueue);
2 16978 current:= 0;
2 16979 corucount:= 0;
2 16980 proccount:= 0;
2 16981 baseevent:= 0;
2 16982 coruref:= timerqueue + 4;
2 16983 firstcoru:= coruref;
2 16984 simref:= coruref + maxcoru * corusize;
2 16985 firstsim:= simref;
2 16986 semref:= simref + maxsem * simsize;
2 16987 firstsem:= semref;
2 16988 opref:= semref + maxsemch * semsize + 4;
2 16989 firstop:= opref;
2 16990 optop:= opref + maxop * opheadsize + maxnettoop - 6;
2 16991 for cmi:= coruref step 2 until optop - 2 do d(cmi/2):= 0;
2 16992 reflectcore(core);
2 16993
2 16993 algol list.on;
2 16994
2 16994 \f
2 16994 message sys_initialisering side 1 - 810601/hko;
2 16995
2 16995 trapmode:= 1 shift 15;
2 16996 errorbits:= 1; <* warning.no ok.no *>
2 16997 trap(coru_term);
2 16998
2 16998 open(zbillede,4,<:billede:>,0);
2 16999 write(zbillede,"ff",1,"nl",2,<:********** billede for kørsel startet :>,
2 17000 <<zddddd>,systime(5,0,r),".",1,r,<: **********:>,"nl",1);
2 17001 system(2,0,ia);
2 17002 open(zdummy,4,ia,0); close(zdummy,false);
2 17003 monitor(42,zdummy,0,ia);
2 17004 laf:= 0;
2 17005 write(zbillede,"nl",1,<:prog.vers. :>,<<dddddd.dddd>,
2 17006 systime(6,ia(6),r)+r/1000000,"nl",2,
2 17007 <:konsolnavn: :>,konsol_navn.laf,"nl",1);
2 17008
2 17008 open(zrl,4,<:radiolog:>,0);
2 17009 if monitor(42)lookup_entry:(zrl,0,ia)<>0 or
2 17010 monitor(52)create_areaproc:(zrl,0,ia)<>0 or
2 17011 monitor(8)reserve_process:(zrl,0,ia)<>0 then
2 17012 begin
3 17013 ia(1):=1; ia(2):= 3;
3 17014 for i:= 3 step 1 until 10 do ia(i):= 0;
3 17015 monitor(40)create_area:(zrl,0,ia);
3 17016 end;
2 17017
2 17017 for i:=1 step 1 until max_antal_fejltekster do
2 17018 fejltekst(i):= real (case i of (
2 17019 <* 1*><:filsystem:>,
2 17020 <* 2*><:operationskode:>,
2 17021 <* 3*><:programfejl:>,
2 17022 <* 4*><:monitor<'_'>resultat=:>,
2 17023 <* 5*><:læs<'_'>fil:>,
2 17024 <* 6*><:skriv<'_'>fil:>,
2 17025 <* 7*><:modif<'_'>fil:>,
2 17026 <* 8*><:hent<'_'>fil<'_'>dim:>,
2 17027 <* 9*><:sæt<'_'>fil<'_'>dim:>,
2 17028 <*10*><:vogntabel:>,
2 17029 <*11*><:fremmed operation:>,
2 17030 <*12*><:operationstype:>,
2 17031 <*13*><:opret<'_'>fil:>,
2 17032 <*14*><:tilknyt<'_'>fil:>,
2 17033 <*15*><:frigiv<'_'>fil:>,
2 17034 <*16*><:slet<'_'>fil:>,
2 17035 <*17*><:ydre enhed, status=:>,
2 17036 <*18*><:tabelfil:>,
2 17037 <*19*><:radio:>,
2 17038 <*20*><:mobilopkald, bus:>,
2 17039 <*21*><:talevejsswitch:>,
2 17040 <*99*><:ftslut:>));
2 17041
2 17041 for i:= 1 step 1 until max_antal_områder do
2 17042 begin
3 17043 område_navn(i):= long (case i of
3 17044 (<:TLF:>,<:VHF:>,<:KBH:>,<:RO:>,<:FS:>,<:HHL:>,<:GLX:>,
3 17045 <:KJ:>,<:HI:>,<:HG:>,<:BA:>) );
3 17046 område_id(i,1):= område_navn(i) shift (-24) extract 24;
3 17047 område_id(i,2):=
3 17048 (case i of ( 2, 3, 13, 3, 3, 3, 3, 3, 3, 3, 3)) shift 6 add
3 17049 (case i of ( 2, 5, 2, 9, 10, 11, 12, 13, 14, 15, 16));
3 17050 end;
2 17051
2 17051 pabx_id(1):= -1;
2 17052 pabx_id(2):= 1;
2 17053
2 17053 for i:= 1 step 1 until max_antal_radiokanaler do
2 17054 begin
3 17055 radio_id(i):=
3 17056 case i of ( 3, 3, 3, 3, 2, -1, -1, -1, 4, 5, 6, 7, 8, 9, 10, 11);
3 17057 end;
2 17058
2 17058 for i:=1 step 1 until max_antal_kanaler do
2 17059 begin
3 17060 kanal_navn(i):= long (case i of (
3 17061 <:K1:>,<:K2:>,<:K3:>,<:K4:>,<:K5:>,<:K9:>,<:K10:>,<:K11:>,<:K12:>,
3 17062 <:K13:>,<:K14:>,<:K15:>,<:K16:>,<:L4190:>) );
3 17063 kanal_id(i):=
3 17064 (case i of ( 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2)) shift 5 +
3 17065 (case i of ( 2, 3, 4, 1, 5, 9,10,11,12,13,14,15,16, 2));
3 17066 end;
2 17067
2 17067 for i:= 1 step 1 until op_maske_lgd//2 do
2 17068 ingen_operatører(i):= alle_operatører(i):= 0;
2 17069 for i:= 1 step 1 until tv_maske_lgd//2 do
2 17070 ingen_taleveje(i):= alle_taleveje(i):= 0;
2 17071
2 17071 begin
3 17072 long array navn(1:2);
3 17073 long array field doc, ref;
3 17074
3 17074 doc:= 2; iaf:= 0;
3 17075 movestring(navn,1,<:terminal0:>);
3 17076 for i:= 1 step 1 until max_antal_operatører do
3 17077 begin
4 17078 ref:=(i-1)*8; k:=9;
4 17079 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17080 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17081 open(zdummy,8,navn,0); close(zdummy,true);
4 17082 k:= monitor(42,zdummy,0,ia);
4 17083 if k=0 then tofrom(terminal_navn.ref,ia.doc,8)
4 17084 else tofrom(terminal_navn.ref,navn,8);
4 17085 operatør_auto_include(i):= false;
4 17086 sætbit_ia(alle_operatører,i,1);
4 17087 end;
3 17088
3 17088 movestring(navn,1,<:garage0:>);
3 17089 for i:= 1 step 1 until max_antal_garageterminaler do
3 17090 begin
4 17091 ref:=(i-1)*8; k:=7;
4 17092 if i>9 then skrivtegn(navn.iaf, k, '0' + i//10);
4 17093 skrivtegn(navn.iaf,k,'0'+ i mod 10);
4 17094 open(zdummy,8,navn,0); close(zdummy,true);
4 17095 k:= monitor(42,zdummy,0,ia);
4 17096 if k=0 then tofrom(garage_terminal_navn.ref,ia.doc,8)
4 17097 else tofrom(garage_terminal_navn.ref,navn,8);
4 17098 garage_auto_include(i):= false;
4 17099 end;
3 17100 end;
2 17101
2 17101 for i:= 1 step 1 until max_antal_taleveje do
2 17102 sætbit_ia(alle_taleveje,i,1);
2 17103 for i:= 1 step 1 until findfpparam(<:operatør:>,true,ia) do
2 17104 if 1<=ia(i) and ia(i)<=max_antal_operatører then
2 17105 operatør_auto_include(ia(i)):= true;
2 17106 for i:= 1 step 1 until findfpparam(<:garage:>,true,ia) do
2 17107 if 1<=ia(i) and ia(i)<=max_antal_garageterminaler then
2 17108 garage_auto_include(ia(i)):= true;
2 17109
2 17109
2 17109 \f
2 17109 message fil_init side 1 - 801030/jg;
2 17110
2 17110 begin integer i,antz,tz,s;
3 17111 real array field raf;
3 17112
3 17112 filskrevet:=fillæst:=0; <*fil*>
3 17113 dbsegmax:= 2**18-1;
3 17114
3 17114 tz:=dbantez+dbantsz; antz:=tz+dbanttz;
3 17115 for i:=1 step 1 until dbantez do
3 17116 begin open(fil(i),4,<::>,0); close(fil(i),false) end;
3 17117 for i:=dbantez+1 step 1 until tz do
3 17118 open(fil(i),4,dbsnavn,0);
3 17119 for i:=tz+1 step 1 until antz do
3 17120 open(fil(i),4,dbtnavn,0);
3 17121
3 17121 for i:=1 step 1 until dbantez do <*dbkatz*>
3 17122 dbkatz(i,1):=dbkatz(i,2):=0;
3 17123 for i:=dbantez+1 step 1 until tz do
3 17124 begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
3 17125 for i:=tz+1 step 1 until antz do
3 17126 begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
3 17127 dbkatz(antz,2):=tz+1;
3 17128 dbsidstetz:=antz;
3 17129 dbsidstesz:=tz;
3 17130
3 17130 for i:=1 step 1 until dbmaxef do <*dbkate*>
3 17131 begin integer j;
4 17132 for j:=1,3 step 1 until 6 do
4 17133 dbkate(i,j):=0;
4 17134 dbkate(i,2):=i+1;
4 17135 end;
3 17136 dbkate(dbmaxef,2):=0;
3 17137 dbkatefri:=1;
3 17138 dbantef:=0;
3 17139 \f
3 17139 message fil_init side 2 - 801030/jg;
3 17140
3 17140
3 17140 for i:= 1 step 1 until dbmaxsf do <*dbkats*>
3 17141 begin
4 17142 dbkats(i,1):=0;
4 17143 dbkats(i,2):=i+1;
4 17144 end;
3 17145 dbkats(dbmaxsf,2):=0;
3 17146 dbkatsfri:=1;
3 17147 dbantsf:=0;
3 17148
3 17148 for i:=1 step 1 until dbmaxb do <*dbkatb*>
3 17149 dbkatb(i):=false add (i+1);
3 17150 dbkatb(dbmaxb):=false;
3 17151 dbkatbfri:=1;
3 17152 dbantb:=0;
3 17153 raf:=4;
3 17154 for i:=1 step 1 until dbmaxtf do
3 17155 begin
4 17156 inrec6(fil(antz),4);
4 17157 dbkatt.raf(i):=fil(antz,1);
4 17158 end;
3 17159 inrec6(fil(antz),4);
3 17160 if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
3 17161 fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
3 17162 setposition(fil(antz),0,0);
3 17163
3 17163 end filsystem;
2 17164 \f
2 17164 message fil_init side 3 - 810209/cl;
2 17165
2 17165 bs_kats_fri:= nextsem;
2 17166 <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
2 17167 <*-3*>
2 17168 bs_kate_fri:= nextsem;
2 17169 <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
2 17170 <*-3*>
2 17171 cs_opret_fil:= nextsemch;
2 17172 <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
2 17173 <*-3*>
2 17174 cs_tilknyt_fil:= nextsemch;
2 17175 <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
2 17176 <*-3*>
2 17177 cs_frigiv_fil:= nextsemch;
2 17178 <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
2 17179 <*-3*>
2 17180 cs_slet_fil:= nextsemch;
2 17181 <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
2 17182 <*-3*>
2 17183 cs_opret_spoolfil:= nextsemch;
2 17184 <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
2 17185 <*-3*>
2 17186 cs_opret_eksternfil:= nextsemch;
2 17187 <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
2 17188 <*-3*>
2 17189 \f
2 17189 message fil_init side 4 810209/cl;
2 17190
2 17190
2 17190 <* initialisering af filsystemcoroutiner *>
2 17191
2 17191 i:= nextcoru(001,10,true);
2 17192 j:= newactivity(i,0,opretfil);
2 17193 <*+3*> skriv_newactivity(out,i,j);
2 17194 <*-3*>
2 17195
2 17195 i:= nextcoru(002,10,true);
2 17196 j:= newactivity(i,0,tilknytfil);
2 17197 <*+3*> skriv_newactivity(out,i,j);
2 17198 <*-3*>
2 17199
2 17199 i:= nextcoru(003,10,true);
2 17200 j:= newactivity(i,0,frigivfil);
2 17201 <*+3*> skriv_newactivity(out,i,j);
2 17202 <*-3*>
2 17203
2 17203 i:= nextcoru(004,10,true);
2 17204 j:= newactivity(i,0,sletfil);
2 17205 <*+3*> skriv_newactivity(out,i,j);
2 17206 <*-3*>
2 17207
2 17207 i:= nextcoru(005,10,true);
2 17208 j:= newactivity(i,0,opretspoolfil);
2 17209 <*+3*> skriv_newactivity(out,i,j);
2 17210 <*-3*>
2 17211
2 17211 i:= nextcoru(006,10,true);
2 17212 j:= newactivity(i,0,opreteksternfil);
2 17213 <*+3*> skriv_newactivity(out,i,j);
2 17214 <*-3*>
2 17215 \f
2 17215 message attention_initialisering side 1 - 850820/cl;
2 17216
2 17216 tf_kommandotabel:= 1 shift 10 + 1;
2 17217
2 17217 begin
3 17218 integer i, s, zno;
3 17219 zone z(128,1,stderror);
3 17220 integer array fdim(1:8);
3 17221
3 17221 fdim(4):= tf_kommandotabel;
3 17222 hentfildim(fdim);
3 17223
3 17223 open(z,4,<:htkommando:>,0);
3 17224 for i:= 1 step 1 until fdim(3) do
3 17225 begin
4 17226 inrec6(z,512);
4 17227 s:= skrivfil(tf_kommandotabel,i,zno);
4 17228 if s<>0 then fejlreaktion(6,s,<:kommandotabelinit:>,0);
4 17229 tofrom(fil(zno),z,512);
4 17230 end;
3 17231 close(z,true);
3 17232 end;
2 17233 \f
2 17233 message attention_initialisering side 1a - 810428/hko;
2 17234
2 17234 for j:= system(3,i,terminal_tab) step 1 until i do
2 17235 terminal_tab(j):= 0;
2 17236
2 17236 cs_att_pulje:=next_semch;
2 17237 <*+3*> skriv_new_sem(out,3,cs_att_pulje,<:cs-att-pulje:>);
2 17238 <*-3*>
2 17239
2 17239 bs_fortsæt_adgang:= nextsem;
2 17240 <*+3*> skriv_new_sem(out,1,bs_fortsæt_adgang,<:bs-fortsæt-adgang:>);
2 17241 <*-3*>
2 17242 signalbin(bs_fortsæt_adgang);
2 17243
2 17243 for i:= 1,
2 17244 1 step 1 until max_antal_operatører,
2 17245 1 step 1 until max_antal_garageterminaler do
2 17246
2 17246 <* initialisering af pulje med attention_operationer *>
2 17247
2 17247 signalch(cs_att_pulje, <* pulje_semafor *>
2 17248 nextop(data+att_op_længde), <* næste_operation *>
2 17249 gen_optype);
2 17250
2 17250 att_proc_ref:=next_proc_ext(system(6<* own process*>,i,ra));
2 17251
2 17251 i:=next_coru(010,<*ident*>
2 17252 2,<*prioritet*>
2 17253 true<*test_maske*>);
2 17254 j:=newactivity( i, <*activityno *>
2 17255 0, <*ikke virtual *>
2 17256 attention);<*ingen parametre*>
2 17257
2 17257 <*+3*>skriv_newactivity(out,i,j);
2 17258 <*-3*>
2 17259 \f
2 17259 message io_initialisering side 1 - 810507/hko;
2 17260
2 17260 io_spoolfil:= 1028;
2 17261 begin
3 17262 integer array fdim(1:8);
3 17263 fdim(4):= io_spoolfil;
3 17264 hent_fildim(fdim);
3 17265 io_spool_postantal:= fdim(1);
3 17266 io_spool_postlængde:= fdim(2);
3 17267 end;
2 17268
2 17268 io_spool_post:= 4;
2 17269
2 17269 cs_io:= next_semch;
2 17270 <*+3*> skriv_new_sem(out,3,cs_io,<:cs-io:>);
2 17271 <*-3*>
2 17272
2 17272 i:= next_coru(100,<*ident *>
2 17273 5,<*prioritet *>
2 17274 true<*test_maske*>);
2 17275
2 17275 j:= new_activity( i,
2 17276 0,
2 17277 h_io);
2 17278
2 17278 <*+3*>skriv_newactivity(out,i,j);
2 17279 <*-3*>
2 17280 cs_io_komm:= next_semch;
2 17281 <*+3*> skriv_new_sem(out,3,cs_io_komm,<:cs-io-komm:>);
2 17282 <*-3*>
2 17283
2 17283 i:= next_coru(101,<*ident*>
2 17284 10,<*prioritet*>
2 17285 true <*testmaske*>);
2 17286 j:= new_activity( i,
2 17287 0,
2 17288 io_komm);<*ingen parametre*>
2 17289
2 17289 <*+3*>skriv_newactivity(out,i,j);
2 17290 <*-3*>
2 17291 \f
2 17291 message io_initialisering side 2 - 810520/hko/cl;
2 17292
2 17292 bs_zio_adgang:= next_sem;
2 17293 <*+3*> skriv_new_sem(out,1,bs_zio_adgang,<:bs-zio-adgang:>);
2 17294 <*-3*>
2 17295 signal_bin(bs_zio_adgang);
2 17296
2 17296 cs_io_spool:= next_semch;
2 17297 <*+3*> skriv_new_sem(out,3,cs_io_spool,<:cs-io-spool:>);
2 17298 <*-3*>
2 17299
2 17299 cs_io_fil:=next_semch;
2 17300 <*+3*> skriv_new_sem(out,3,cs_io_fil,<:cs-io-fil:>);
2 17301 <*-3*>
2 17302 signal_ch(cs_io_fil,next_op(data+18),gen_optype);
2 17303
2 17303 ss_io_spool_fulde:= next_sem;
2 17304 <*+3*> skriv_new_sem(out,2,ss_io_spool_fulde,<:ss-io-spool-fulde:>);
2 17305 <*-3*>
2 17306
2 17306 ss_io_spool_tomme:= next_sem;
2 17307 <*+3*> skriv_new_sem(out,2,ss_io_spool_tomme,<:ss-io-spool-tomme:>);
2 17308 <*-3*>
2 17309 for i:= 1 step 1 until io_spool_postantal do
2 17310 signal(ss_io_spool_tomme);
2 17311 \f
2 17311 message io_initialisering side 3 - 880901/cl;
2 17312
2 17312 i:= next_coru(102,
2 17313 5,
2 17314 true);
2 17315 j:= new_activity(i,0,io_spool);
2 17316
2 17316 <*+3*>skriv_newactivity(out,i,j);
2 17317 <*-3*>
2 17318
2 17318 i:= next_coru(103,
2 17319 10,
2 17320 true);
2 17321 j:= new_activity(i,0,io_spon);
2 17322
2 17322 <*+3*>skriv_newactivity(out,i,j);
2 17323 <*-3*>
2 17324
2 17324 cs_io_medd:= next_semch;
2 17325 <*+3*> skriv_new_sem(out,3,cs_io_medd,<:cs-io-medd:>);
2 17326 <*-3*>
2 17327
2 17327 i:= next_coru(104,<*ident *>
2 17328 10,<*prioritet *>
2 17329 true<*test_maske*>);
2 17330
2 17330 j:= new_activity( i,
2 17331 0,
2 17332 io_medd);
2 17333
2 17333 <*+3*>skriv_newactivity(out,i,j);
2 17334 <*-3*>
2 17335
2 17335 open(z_io,8,konsol_navn,1 shift 21 + 1 shift 9);
2 17336 i:= monitor(8)reserve process:(z_io,0,ia);
2 17337 if i <> 0 then
2 17338 begin
3 17339 fejlreaktion(4<*monitor result*>,+i,<:io reservation:>,0);
3 17340 end
2 17341 else
2 17342 begin
3 17343 ref:= 0;
3 17344 terminal_tab.ref.terminal_tilstand:= 0;
3 17345 write(z_io,"nl",3,"sp",10,"*",15,<: busradio startet :>,
3 17346 <<zddddd>,systime(5,0.0,r),".",1,r,
3 17347 "sp",1,"*",15,"nl",1);
3 17348 setposition(z_io,0,0);
3 17349 end;
2 17350 \f
2 17350 message operatør_initialisering side 1 - 810520/hko;
2 17351
2 17351 top_bpl_gruppe:= 64;
2 17352
2 17352 bpl_navn(0):= long<::>;
2 17353 for i:= 1 step 1 until 127 do
2 17354 begin
3 17355 k:= læsfil(tf_bpl_navne,i,j);
3 17356 if k<>0 then fejlreaktion(5,k,<:bplnavne init:>,0);
3 17357 bpl_navn(i):= (long fil(j,1)) shift (-8) shift 8;
3 17358 if i<=max_antal_operatører then
3 17359 operatør_auto_include(i):= false add (fil(j,1) extract 8);
3 17360 if i>64 and fil(j,1)<>real<::> and i>top_bpl_gruppe then
3 17361 top_bpl_gruppe:= i;
3 17362 end;
2 17363
2 17363 for i:= 0 step 1 until 64 do
2 17364 begin
3 17365 iaf:= i*op_maske_lgd;
3 17366 tofrom(bpl_def.iaf,ingen_operatører,op_maske_lgd);
3 17367 bpl_tilst(i,1):= bpl_tilst(i,2):= 0;
3 17368 if 1<=i and i<= max_antal_operatører then
3 17369 begin
4 17370 bpl_tilst(i,2):= 1;
4 17371 sætbit_ia(bpl_def.iaf,i,1);
4 17372 end;
3 17373 end;
2 17374 for i:= 65 step 1 until 127 do
2 17375 begin
3 17376 k:= læsfil(tf_bpl_def,i-64,j);
3 17377 if k<>0 then fejlreaktion(5,k,<:bpldef init:>,0);
3 17378 iaf:= i*op_maske_lgd;
3 17379 tofrom(bpl_def.iaf,fil(j),op_maske_lgd);
3 17380 bpl_tilst(i,1):= 0;
3 17381 bpl_tilst(i,2):= fil(j,2) extract 24;
3 17382 end;
2 17383
2 17383 for k:= 0,1,2,3 do operatør_stop(0,k):= 0;
2 17384 iaf:= 0;
2 17385 for i:= 1 step 1 until max_antal_operatører do
2 17386 begin
3 17387 k:= læsfil(tf_stoptabel,i,j);
3 17388 if k<>0 then fejlreaktion(5,k,<:stoptabel init:>,0);
3 17389 operatør_stop(i,0):= i;
3 17390 for k:= 1,2,3 do
3 17391 operatør_stop(i,k):= fil(j).iaf(k+1);
3 17392 ant_i_opkø(i):= 0;
3 17393 end;
2 17394
2 17394 tofrom(operatørmaske,ingen_operatører,op_maske_lgd);
2 17395 for i:= 0 step 1 until max_antal_operatører do op_talevej(i):= 0;
2 17396 for i:= 0 step 1 until max_antal_taleveje do tv_operatør(i):= 0;
2 17397 sidste_tv_brugt:= max_antal_taleveje;
2 17398
2 17398 for i:= 1 step 1 until max_antal_operatører*(opk_alarm_tab_lgd//2) do
2 17399 opk_alarm(i):= 0;
2 17400 for i:= 1 step 1 until max_antal_operatører do
2 17401 begin
3 17402 integer array field tab;
3 17403
3 17403 k:= læsfil(tf_alarmlgd,i,j);
3 17404 if k<>0 then fejlreaktion(5,k,<:alarmlængde init:>,0);
3 17405 tab:= (i-1)*opk_alarm_tab_lgd;
3 17406 opk_alarm.tab.alarm_lgd:= fil(j).iaf(1);
3 17407 opk_alarm.tab.alarm_start:= 0.0;
3 17408 end;
2 17409
2 17409 op_spool_kilde:= 2;
2 17410 op_spool_tid := 6;
2 17411 op_spool_text := 6;
2 17412 begin
3 17413 long array field laf1, laf2;
3 17414 laf2:= 4; laf1:= 0;
3 17415 op_spool_buf.laf1(1):= long<::>;
3 17416 tofrom(op_spool_buf.laf2,op_spool_buf.laf1,
3 17417 op_spool_postantal*op_spool_postlgd-4);
3 17418 end;
2 17419
2 17419 k:=læsfil(1033,1,j);
2 17420 systime(1,0.0,r);
2 17421 if k<>0 then fejlreaktion(5,k,<:CQF-tabel init:>,0);
2 17422 for i:= 1 step 1 until max_cqf do
2 17423 begin
3 17424 ref:= (i-1)*cqf_lgd; iaf:= (i-1)*8;
3 17425 tofrom(cqf_tabel.ref,fil(j).iaf,8);
3 17426 cqf_tabel.ref.cqf_næste_tid:=
3 17427 (if cqf_tabel.ref.cqf_bus > 0 then (r + 5*60.0) else real<::>);
3 17428 cqf_tabel.ref.cqf_ok_tid:= real<::>;
3 17429 end;
2 17430 op_cqf_tab_ændret:= true;
2 17431
2 17431 laf:= raf:= 0;
2 17432 open(z_tv_in,8,taleswitch_in_navn,1 shift 21 + 1 shift 9);
2 17433 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17434 j:= 1;
2 17435 if i<>0 then
2 17436 fejlreaktion(4,i,string taleswitch_in_navn.raf(increase(j)),1);
2 17437 open(z_tv_out,4 shift 12 + 8,taleswitch_out_navn,1 shift 9);
2 17438 i:= monitor(8)reserve_process:(z_tv_in,0,ia);
2 17439 j:= 1;
2 17440 if i<>0 then
2 17441 fejlreaktion(4,i,string taleswitch_out_navn.raf(increase(j)),1);
2 17442
2 17442 ia(1):= 3; <*canonical*>
2 17443 ia(2):= 0; <*no echo*>
2 17444 ia(3):= 0; <*prompt*>
2 17445 ia(4):= 2; <*timeout*>
2 17446 setcspterm(taleswitch_in_navn.laf,ia);
2 17447 setcspterm(taleswitch_out_navn.laf,ia);
2 17448
2 17448 cs_op:= next_semch;
2 17449
2 17449 <*+3*>skriv_new_sem(out,3,cs_op,<:cs-op(hovedmodul):>);
2 17450 <*-3*>
2 17451
2 17451 cs_op_retur:= next_semch;
2 17452
2 17452 <*+3*>skriv_new_sem(out,3,cs_op_retur,<:cs_op_retur:>);
2 17453 <*-3*>
2 17454
2 17454 i:= nextcoru(200,<*ident*>
2 17455 10,<*prioitet*>
2 17456 true<*test_maske*>);
2 17457
2 17457 j:= new_activity( i,
2 17458 0,
2 17459 h_operatør);
2 17460
2 17460 <*+3*>skriv_newactivity(out,i,j);
2 17461 <*-3*>
2 17462 \f
2 17462 message operatør_initialisering side 2 - 810520/hko;
2 17463
2 17463 for k:= 1 step 1 until max_antal_operatører do
2 17464 begin
3 17465 ref:= (k-1)*8;
3 17466 open(z_op(k),8,terminal_navn.ref,1 shift 21 +1 shift 9);
3 17467 i:= monitor(4) processaddress:(z_op(k),0,ia);
3 17468 ref:=k*terminal_beskr_længde;
3 17469 if i = 0 then
3 17470 begin
4 17471 fejlreaktion(3<*programfejl*>,k,<:skærm eksisterer ikke:>,1);
4 17472 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17473 end
3 17474 else
3 17475 begin
4 17476 terminal_tab.ref.terminal_tilstand:= 7 shift 21;<*ej knyttet*>
4 17477 end;
3 17478
3 17478 cs_operatør(k):= next_semch;
3 17479 <*+3*>skriv_new_sem(out,3,cs_operatør(k),<:cs-operatør( ):>);
3 17480 <*-3*>
3 17481
3 17481 cs_op_fil(k):= nextsemch;
3 17482 <*+3*> skriv_new_sem(out,3,cs_op_fil(k),<:cs-op-fil( ):>);
3 17483 <*-3*>
3 17484 signalch(cs_op_fil(k),nextop(filoplængde),op_optype);
3 17485
3 17485 i:= next_coru(200+k,<*ident*>
3 17486 10,<*prioitet*>
3 17487 true<*testmaske*>);
3 17488 j:= new_activity( i,
3 17489 0,
3 17490 operatør,k);
3 17491
3 17491 <*+3*>skriv_newactivity(out,i,j);
3 17492 <*-3*>
3 17493 end;
2 17494
2 17494 cs_cqf:= next_semch;
2 17495 <*+3*>skriv_new_sem(out,3,cs_cqf,<:cs-cqf:>);
2 17496 <*-3*>
2 17497
2 17497 signalch(cs_cqf,nextop(60),true);
2 17498
2 17498 i:= next_coru(292, <*ident*>
2 17499 10, <*prioritet*>
2 17500 true <*testmaske*>);
2 17501 j:= new_activity( i,
2 17502 0,
2 17503 op_cqftest);
2 17504 <*+3*>skriv_new_activity(out,i,j);
2 17505 <*-3*>
2 17506
2 17506 cs_op_spool:= next_semch;
2 17507 <*+3*>skriv_new_sem(out,3,cs_op_spool,<:cs-op-spool:>);
2 17508 <*-3*>
2 17509
2 17509 cs_op_medd:= next_semch;
2 17510 <*+3*>skriv_new_sem(out,3,cs_op_medd,<:cs-op-medd:>);
2 17511 <*-3*>
2 17512
2 17512 ss_op_spool_tomme:= next_sem;
2 17513 <*+3*>skriv_new_sem(out,2,ss_op_spool_tomme,<:ss-op-spool-tomme:>);
2 17514 <*-3*>
2 17515 for i:= 1 step 1 until op_spool_postantal do signal(ss_op_spool_tomme);
2 17516
2 17516 ss_op_spool_fulde:= next_sem;
2 17517 <*+3*>skriv_new_sem(out,2,ss_op_spool_fulde,<:ss-op-spool-fulde:>);
2 17518 <*-3*>
2 17519
2 17519 signalch(cs_op_medd,nextop(data+op_spool_postlgd),gen_optype);
2 17520
2 17520 i:= next_coru(293, <*ident*>
2 17521 10, <*prioritet*>
2 17522 true <*testmaske*>);
2 17523 j:= new_activity( i,
2 17524 0,
2 17525 op_spool);
2 17526 <*+3*>skriv_new_activity(out,i,j);
2 17527 <*-3*>
2 17528
2 17528 i:= next_coru(294, <*ident*>
2 17529 10, <*prioritet*>
2 17530 true <*testmaske*>);
2 17531 j:= new_activity( i,
2 17532 0,
2 17533 op_medd);
2 17534 <*+3*>skriv_new_activity(out,i,j);
2 17535 <*-3*>
2 17536
2 17536 cs_op_iomedd:= next_semch;
2 17537 <*+3*>skriv_new_sem(out,3,cs_op_iomedd,<:cs-op-iomedd:>);
2 17538 <*-3*>
2 17539
2 17539 bs_opk_alarm:= next_sem;
2 17540 <*+3*>skriv_new_sem(out,1,bs_opk_alarm,<:bs-opk-alarm:>);
2 17541 <*-3*>
2 17542
2 17542 cs_opk_alarm:= next_semch;
2 17543 <*+3*>skriv_new_sem(out,3,cs_opk_alarm,<:cs-opk-alarm:>);
2 17544 <*-3*>
2 17545
2 17545 cs_opk_alarm_ur:= next_semch;
2 17546 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur,<:cs-opk-alarm-ur:>);
2 17547 <*-3*>
2 17548
2 17548 cs_opk_alarm_ur_ret:= next_semch;
2 17549 <*+3*>skriv_new_sem(out,3,cs_opk_alarm_ur_ret,<:cs-opk-alarm-ur-ret:>);
2 17550 <*-3*>
2 17551
2 17551 cs_tvswitch_adgang:= next_semch;
2 17552 <*+3*>skriv_new_sem(out,3,cs_tvswitch_adgang,<:cs-tvswitch-adgang:>);
2 17553 <*-3*>
2 17554
2 17554 cs_tv_switch_input:= next_semch;
2 17555 <*+3*>skriv_new_sem(out,3,cs_tv_switch_input,<:cs-tvswitch-input:>);
2 17556 <*-3*>
2 17557
2 17557 cs_tv_switch_adm:= next_semch;
2 17558 <*+3*>skriv_new_sem(out,3,cs_tv_switch_adm,<:cs-tvswitch-adm:>);
2 17559 <*-3*>
2 17560
2 17560 cs_talevejsswitch:= next_semch;
2 17561 <*+3*>skriv_new_sem(out,3,cs_talevejsswitch,<:cs-talevejsswitch:>);
2 17562 <*-3*>
2 17563
2 17563 signalch(cs_op_iomedd,nextop(60),gen_optype);
2 17564
2 17564 iaf:= nextop(data+128);
2 17565 if testbit22 then
2 17566 signal_ch(cs_tv_switch_adgang,iaf,op_optype)
2 17567 else
2 17568 begin
3 17569 startoperation(iaf,298,cs_tv_switch_adgang,'I' shift 12 + 44);
3 17570 signal_ch(cs_talevejsswitch,iaf,op_optype);
3 17571 end;
2 17572
2 17572 i:= next_coru(295, <*ident*>
2 17573 8, <*prioritet*>
2 17574 true <*testmaske*>);
2 17575 j:= new_activity( i,
2 17576 0,
2 17577 alarmur);
2 17578 <*+3*>skriv_new_activity(out,i,j);
2 17579 <*-3*>
2 17580
2 17580 signal_ch(cs_opk_alarm_ur_ret,nextop(data),op_optype);
2 17581
2 17581 i:= next_coru(296, <*ident*>
2 17582 8, <*prioritet*>
2 17583 true <*testmaske*>);
2 17584 j:= new_activity( i,
2 17585 0,
2 17586 opkaldsalarmer);
2 17587 <*+3*>skriv_new_activity(out,i,j);
2 17588 <*-3*>
2 17589
2 17589 i:= next_coru(297, <*ident*>
2 17590 3, <*prioritet*>
2 17591 true <*testmaske*>);
2 17592 j:= new_activity( i,
2 17593 0,
2 17594 tv_switch_input);
2 17595 <*+3*>skriv_new_activity(out,i,j);
2 17596 <*-3*>
2 17597
2 17597 for i:= 1,2 do
2 17598 signalch(cs_tvswitch_input,nextop(data+256),op_optype);
2 17599
2 17599 i:= next_coru(298, <*ident*>
2 17600 20, <*prioritet*>
2 17601 true <*testmaske*>);
2 17602 j:= new_activity( i,
2 17603 0,
2 17604 tv_switch_adm);
2 17605 <*+3*>skriv_new_activity(out,i,j);
2 17606 <*-3*>
2 17607
2 17607 i:= next_coru(299, <*ident*>
2 17608 3, <*prioritet*>
2 17609 true <*testmaske*>);
2 17610 j:= new_activity( i,
2 17611 0,
2 17612 talevejsswitch);
2 17613 <*+3*>skriv_new_activity(out,i,j);
2 17614 <*-3*>
2 17615 \f
2 17615 message garage_initialisering side 1 - 810521/hko;
2 17616
2 17616 cs_gar:= next_semch;
2 17617 <*+3*>skriv_new_sem(out,3,cs_gar,<:cs-gar(hovedmodul):>);
2 17618 <*-3*>
2 17619
2 17619 i:= next_coru(300,<*ident*>
2 17620 10,<*prioritet*>
2 17621 true<*test_maske*>);
2 17622
2 17622 j:= new_activity( i,
2 17623 0,
2 17624 h_garage);
2 17625
2 17625 <*+3*>skriv_newactivity(out,i,j);
2 17626 <*-3*>
2 17627
2 17627 for k:= 1 step 1 until max_antal_garageterminaler do
2 17628 begin
3 17629 ref:= (k-1)*8;
3 17630 open(z_gar(k),8,garage_terminal_navn.raf,1 shift 21 + 1 shift 9);
3 17631 ref:= (max_antal_operatører+k)*terminal_beskr_længde;
3 17632 i:=monitor(4)process address:(z_gar(k),0,ia);
3 17633 if i = 0 then
3 17634 begin
4 17635 fejlreaktion(4<*monitor result*>,k,<:garageterminal eksisterer ikke:>,1);
4 17636 terminal_tab.ref.terminal_tilstand:= 4 shift 21;
4 17637 end
3 17638 else
3 17639 begin
4 17640 terminal_tab.ref.terminal_tilstand:=
4 17641 if garage_auto_include(k) then 0 else 7 shift 21;
4 17642 if garage_auto_include(k) then
4 17643 monitor(8)reserve:(z_gar(k),0,ia);
4 17644 end;
3 17645 cs_garage(k):= next_semch;
3 17646 <*+3*>skriv_new_sem(out,3,cs_garage(k),<:cs-garage( ):>);
3 17647 <*-3*>
3 17648 i:= next_coru(300+k,<*ident*>
3 17649 10,<*prioritet*>
3 17650 true <*testmaske*>);
3 17651 j:= new_activity( i,
3 17652 0,
3 17653 garage,k);
3 17654
3 17654 <*+3*>skriv_newactivity(out,i,j);
3 17655 <*-3*>
3 17656
3 17656 end;
2 17657 \f
2 17657 message radio_initialisering side 1 - 820301/hko;
2 17658
2 17658 cs_rad:= next_semch;
2 17659 <*+3*>skriv_new_sem(out,3,cs_rad,<:cs_rad(h_mod):>);
2 17660 <*-3*>
2 17661
2 17661 i:= next_coru(400,<*ident*>
2 17662 10,<*prioritet*>
2 17663 true<*test_maske*>);
2 17664 j:= new_activity( i,
2 17665 0,
2 17666 h_radio);
2 17667 <*+3*>skriv_newactivity(out,i,j);
2 17668 <*-3*>
2 17669
2 17669 opkalds_kø_ledige:= max_antal_mobilopkald;
2 17670 nødopkald_brugt:= 0;
2 17671 læsfil(1034,1,i);
2 17672 tofrom(radio_områdetabel,fil(i),max_antal_områder*2);
2 17673
2 17673 opkald_meldt:= opkaldskø_postlængde - op_maske_lgd;
2 17674 for i:= system(3,j,opkaldskø) step 1 until j do
2 17675 opkaldskø(i):= 0;
2 17676 første_frie_opkald:=opkaldskø_postlængde;
2 17677 første_opkald:=sidste_opkald:=
2 17678 første_nødopkald:=sidste_nødopkald:=j:=0;
2 17679
2 17679 for i:=1 step 1 until max_antal_mobil_opkald -1 do
2 17680 begin
3 17681 ref:=i*opkaldskø_postlængde;
3 17682 opkaldskø.ref(1):=j:=j shift 12 +ref +opkaldskø_postlængde;
3 17683 end;
2 17684 ref:=ref+opkaldskø_postlængde;
2 17685 opkaldskø.ref(1):=j shift 12;
2 17686
2 17686 for ref:= 0 step 512 until (max_linienr//768*512) do
2 17687 begin
3 17688 i:= læs_fil(1035,ref//512+1,j);
3 17689 if i <> 0 then
3 17690 fejlreaktion(5<*læs_fil*>,i,<:liniefordelingstabel:>,0);
3 17691 tofrom(radio_linietabel.ref,fil(j),
3 17692 if (((max_linienr+1 - (ref//2*3))+2)//3*2) > 512 then 512
3 17693 else ((max_linienr+1 - (ref//2*3))+2)//3*2);
3 17694 end;
2 17695
2 17695 for i:= system(3,j,kanal_tab) step 1 until j do
2 17696 kanal_tab(i):= 0;
2 17697 kanal_tilstand:= 2;
2 17698 kanal_id1:= 4;
2 17699 kanal_id2:= 6;
2 17700 kanal_spec:= 8;
2 17701 kanal_alt_id1:= 10;
2 17702 kanal_alt_id2:= 12;
2 17703 kanal_mon_maske:= 12;
2 17704 kanal_alarm:= kanal_mon_maske+tv_maske_lgd;
2 17705
2 17705 for i:= 1 step 1 until max_antal_kanaler do
2 17706 begin
3 17707 ref:= (i-1)*kanalbeskrlængde;
3 17708 sæthexciffer(kanal_tab.ref,3,15);
3 17709 if kanal_id(i) shift (-5) extract 3 = 2 or
3 17710 kanal_id(i) shift (-5) extract 3 = 3 and
3 17711 radio_id(kanal_id(i) extract 5)<=3
3 17712 then
3 17713 begin
4 17714 sætbiti(kanal_tab.ref.kanal_tilstand,11,1);
4 17715 sætbiti(kanal_tab.ref.kanal_tilstand,10,1);
4 17716 end;
3 17717 end;
2 17718 tofrom(opkaldsflag,alle_operatører,op_maske_lgd);
2 17719 tofrom(samtaleflag,ingen_operatører,op_maske_lgd);
2 17720 tofrom(hookoff_maske,ingen_taleveje,tv_maske_lgd);
2 17721 optaget_flag:= 0;
2 17722 \f
2 17722 message radio_initialisering side 2 - 810524/hko;
2 17723
2 17723 bs_mobil_opkald:= next_sem;
2 17724
2 17724 <*+3*>skriv_new_sem(out,1,bs_mobil_opkald,<:bs_mobil_opkald:>);
2 17725 <*-3*>
2 17726
2 17726 bs_opkaldskø_adgang:= next_sem;
2 17727 signal_bin(bs_opkaldskø_adgang);
2 17728
2 17728 <*+3*>skriv_new_sem(out,1,bs_opkaldskø_adgang,<:bs_opk.kø_adgang:>);
2 17729 <*-3*>
2 17730
2 17730 cs_radio_medd:=next_semch;
2 17731 signal_ch(cs_radio_medd,nextop(data+6),gen_optype or rad_optype);
2 17732
2 17732 <*+3*>skriv_new_sem(out,3,cs_radio_medd,<:cs_radio_medd:>);
2 17733 <*-3*>
2 17734
2 17734 i:= next_coru(403,
2 17735 5,<*prioritet*>
2 17736 true<*testmaske*>);
2 17737
2 17737 j:= new_activity( i,
2 17738 0,
2 17739 radio_medd_opkald);
2 17740
2 17740 <*+3*>skriv_newactivity(out,i,j);
2 17741 <*-3*>
2 17742
2 17742 cs_radio_adm:= nextsemch;
2 17743 <*+3*>skriv_new_sem(out,3,cs_radio_adm,<:cs_radio_adm:>);
2 17744 <*-3*>
2 17745
2 17745 i:= next_coru(404,
2 17746 10,
2 17747 true);
2 17748 j:= new_activity(i,
2 17749 0,
2 17750 radio_adm,next_op(data+radio_op_længde));
2 17751 <*+3*>skriv_new_activity(out,i,j);
2 17752 <*-3*>
2 17753 \f
2 17753 message radio_initialisering side 3 - 810526/hko;
2 17754 for k:= 1 step 1 until max_antal_taleveje do
2 17755 begin
3 17756
3 17756 cs_radio(k):=next_semch;
3 17757
3 17757 <*+3*>skriv_new_sem(out,3,cs_radio(k),<:cs_radio( ):>);
3 17758 <*-3*>
3 17759
3 17759 bs_talevej_udkoblet(k):= nextsem;
3 17760 <*+3*>skriv_new_sem(out,1,bs_talevej_udkoblet(k),<:bs_talevej_udkoblet( ):>);
3 17761 <*-3*>
3 17762
3 17762 i:=next_coru(410+k,
3 17763 10,
3 17764 true);
3 17765
3 17765 j:=new_activity( i,
3 17766 0,
3 17767 radio,k,next_op(data + radio_op_længde));
3 17768
3 17768 <*+3*>skriv_newactivity(out,i,j);
3 17769 <*-3*>
3 17770 end;
2 17771
2 17771 cs_radio_pulje:=next_semch;
2 17772
2 17772 <*+3*>skriv_new_sem(out,3,cs_radio_pulje,<:cs-radio-pulje:>);
2 17773 <*-3*>
2 17774
2 17774 for i:= 1 step 1 until radiopulje_størrelse do
2 17775 signal_ch(cs_radio_pulje,
2 17776 next_op(60),
2 17777 gen_optype or rad_optype);
2 17778
2 17778 cs_radio_kø:= next_semch;
2 17779
2 17779 <*+3*>skriv_new_sem(out,3,cs_radio_kø,<:cs_radio_kø:>);
2 17780 <*-3*>
2 17781
2 17781 mobil_opkald_aktiveret:= true;
2 17782 \f
2 17782 message radio_initialisering side 4 - 810522/hko;
2 17783
2 17783 laf:=raf:=0;
2 17784
2 17784 open(z_fr_in,8,radio_fr_navn,radio_giveup);
2 17785 i:= monitor(8)reserve process:(z_fr_in,0,ia);
2 17786 j:=1;
2 17787 if i <> 0 then
2 17788 fejlreaktion(4<*monitor resultat*>,i,
2 17789 string radio_fr_navn.raf(increase(j)),1);
2 17790 open(z_fr_out,4 shift 12 + 8,radio_fr_navn,radio_giveup);
2 17791 i:= monitor(8)reserve process:(z_fr_out,0,ia);
2 17792 j:=1;
2 17793 if i <> 0 then
2 17794 fejlreaktion(4,i,string radio_fr_navn.raf(increase(j)),1);
2 17795 ia(1):= 3 <*canonical*>;
2 17796 ia(2):= 0 <*no echo*>;
2 17797 ia(3):= 0 <*prompt*>;
2 17798 ia(4):= 5 <*timeout*>;
2 17799 setcspterm(radio_fr_navn.laf,ia);
2 17800
2 17800 open(z_rf_in,8,radio_rf_navn,radio_giveup);
2 17801 i:= monitor(8)reserve process:(z_rf_in,0,ia);
2 17802 j:= 1;
2 17803 if i <> 0 then
2 17804 fejlreaktion(4<*monitor resultat*>,i,
2 17805 string radio_rf_navn.raf(increase(j)),1);
2 17806 open(z_rf_out,4 shift 12 + 8,radio_rf_navn,radio_giveup);
2 17807 i:= monitor(8)reserve process:(z_rf_out,0,ia);
2 17808 j:= 1;
2 17809 if i <> 0 then
2 17810 fejlreaktion(4,i,string radio_rf_navn.raf(increase(j)),1);
2 17811 ia(1):= 3 <*canonical*>;
2 17812 ia(2):= 0 <*no echo*>;
2 17813 ia(3):= 0 <*prompt*>;
2 17814 ia(4):= 5 <*timeout*>;
2 17815 setcspterm(radio_rf_navn.laf,ia);
2 17816 \f
2 17816 message radio_initialisering side 5 - 810521/hko;
2 17817 for k:= 1 step 1 until max_antal_kanaler do
2 17818 begin
3 17819
3 17819 ss_radio_aktiver(k):=next_sem;
3 17820 <*+3*>skriv_new_sem(out,2,ss_radio_aktiver(k),<:ss_rad_aktiver( ):>);
3 17821 <*-3*>
3 17822
3 17822 ss_samtale_nedlagt(k):=next_sem;
3 17823 <*+3*>skriv_new_sem(out,2,ss_samtale_nedlagt(k),<:ss_samtale_nedlagt( ):>);
3 17824 <*-3*>
3 17825 end;
2 17826
2 17826 cs_radio_ind:= next_semch;
2 17827 <*+3*>skriv_new_sem(out,3,cs_radio_ind,<:cs_radio_ind:>);
2 17828 <*-3*>
2 17829
2 17829 i:= next_coru(401,<*ident radio_ind*>
2 17830 3, <*prioritet*>
2 17831 true <*testmaske*>);
2 17832 j:= new_activity( i,
2 17833 0,
2 17834 radio_ind,next_op(data + 64));
2 17835
2 17835 <*+3*>skriv_newactivity(out,i,j);
2 17836 <*-3*>
2 17837
2 17837 cs_radio_ud:=next_semch;
2 17838 <*+3*>skriv_new_sem(out,3,cs_radio_ud,<:cs_radio_ud:>);
2 17839 <*-3*>
2 17840
2 17840 i:= next_coru(402,<*ident radio_out*>
2 17841 10,<*prioritet*>
2 17842 true <*testmaske*>);
2 17843 j:= new_activity( i,
2 17844 0,
2 17845 radio_ud,next_op(data + 64));
2 17846
2 17846 <*+3*>skriv_newactivity(out,i,j);
2 17847 <*-3*>
2 17848 \f
2 17848 message vogntabel initialisering side 1 - 820301;
2 17849
2 17849 sidste_bus:= sidste_linie_løb:= 0;
2 17850
2 17850 tf_vogntabel:= 1 shift 10 + 2;
2 17851 tf_gruppedef:= ia(4):= 1 shift 10 +3;
2 17852 tf_gruppeidenter:= 1 shift 10 +6;
2 17853 tf_springdef:= 1 shift 10 +7;
2 17854 hent_fil_dim(ia);
2 17855 max_antal_i_gruppe:= ia(2);
2 17856 if ia(1) < max_antal_grupper then
2 17857 max_antal_grupper:= ia(1);
2 17858
2 17858 <* initialisering af interne vogntabeller *>
2 17859 begin
3 17860 long array field laf1,laf2;
3 17861 integer array fdim(1:8);
3 17862 zone z(128,1,stderror);
3 17863 integer busnr,i,j,zi,s,pant,ll_nr,b_nr,res,tegn,g_nr,o_nr;
3 17864 long omr,garageid;
3 17865 integer field ll, bn;
3 17866 boolean binær, test24;
3 17867
3 17867 ll:= 2; bn:= 4;
3 17868
3 17868 <* nulstil tabellerne *>
3 17869 laf1:= -2;
3 17870 laf2:= 2;
3 17871 bustabel1.laf2(0):=
3 17872 bustabel.laf2(0):= bustilstand.laf2(0):= linie_løb_tabel.laf2(0):=
3 17873 bus_indeks.laf2(0):= linie_løb_indeks.laf2(0):= extend 0;
3 17874 tofrom(bustabel.laf2,bustabel.laf1,(max_antal_busser+1)*2-4);
3 17875 tofrom(bustabel1.laf2,bustabel1.laf1,(max_antal_busser+1)*2-4);
3 17876 tofrom(linie_løb_tabel.laf2,linie_løb_tabel.laf1,(max_antal_linie_løb+1)*2-4);
3 17877 tofrom(busindeks.laf2,busindeks.laf1,max_antal_linie_løb-4);
3 17878 tofrom(linie_løb_indeks.laf2,linie_løb_indeks.laf1,max_antal_busser-4);
3 17879 tofrom(bustilstand.laf2,bustilstand.laf1,max_antal_busser-4);
3 17880 \f
3 17880 message vogntabel initialisering side 1a - 810505/cl;
3 17881
3 17881
3 17881 <* initialisering af intern busnummertabel *>
3 17882 open(z,4,<:busnumre:>,0);
3 17883 busnr:= -1;
3 17884 read(z,busnr);
3 17885 while busnr > 0 do
3 17886 begin
4 17887 if busnr < bustabel(sidste_bus) extract 14 or busnr >= 1 shift 14 then
4 17888 fejlreaktion(10,busnr,<:fejl i busnrfil:>,0);
4 17889 sidste_bus:= sidste_bus+1;
4 17890 if sidste_bus > max_antal_busser then
4 17891 fejlreaktion(10,busnr,<:for mange busser i busnrfil:>,0);
4 17892 repeatchar(z); readchar(z,tegn);
4 17893 garageid:= extend 0; binær:= false; omr:= extend 0;
4 17894 g_nr:= o_nr:= 0;
4 17895 if tegn='!' then
4 17896 begin
5 17897 binær:= true;
5 17898 readchar(z,tegn);
5 17899 end;
4 17900 if tegn='/' then <*garageid*>
4 17901 begin
5 17902 readchar(z,tegn); repeatchar(z);
5 17903 if '0'<=tegn and tegn<='9' then
5 17904 begin
6 17905 read(z,g_nr); if g_nr<1 or g_nr>max_antal_operatører then g_nr:= 0;
6 17906 if g_nr<>0 then garageid:=bpl_navn(g_nr);
6 17907 if g_nr<>0 and garageid=long<::> then
6 17908 begin
7 17909 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
7 17910 g_nr:= 0;
7 17911 end;
6 17912 end
5 17913 else
5 17914 begin
6 17915 while ('A'<= tegn and tegn <='Å') or ('0'<=tegn and tegn<='9') do
6 17916 begin
7 17917 garageid:= garageid shift 8 + tegn;
7 17918 readchar(z,tegn);
7 17919 end;
6 17920 while garageid shift (-40) extract 8 = 0 do
6 17921 garageid:= garageid shift 8;
6 17922 g_nr:= find_bpl(garageid);
6 17923 if g_nr=0 then
6 17924 fejlreaktion(10,busnr,<:ukendt garageidentifikation for bus:>,1);
6 17925 end;
5 17926 repeatchar(z); readchar(z,tegn);
5 17927 end;
4 17928 if tegn=';' then
4 17929 begin
5 17930 readchar(z,tegn); repeatchar(z);
5 17931 if '0'<=tegn and tegn<='9' then
5 17932 begin
6 17933 read(z,o_nr);
6 17934 if o_nr<1 or max_antal_områder<o_nr then o_nr:= 0;
6 17935 if o_nr<>0 then omr:= område_navn(o_nr);
6 17936 if o_nr<>0 and omr=long<::> then
6 17937 begin
7 17938 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
7 17939 o_nr:= 0;
7 17940 end;
6 17941 end
5 17942 else
5 17943 begin
6 17944 while ('A'<=tegn and tegn<='Å') or ('0'<=tegn and tegn<='9') do
6 17945 begin
7 17946 omr:= omr shift 8 + tegn;
7 17947 readchar(z,tegn);
7 17948 end;
6 17949 while omr shift (-40) extract 8 = 0 do
6 17950 omr:= omr shift 8;
6 17951 if omr=long<:TCT:> then omr:=long<:KBH:>;
6 17952 i:= 1;
6 17953 while i<=max_antal_områder and o_nr=0 do
6 17954 begin
7 17955 if omr=område_navn(i) then o_nr:= i;
7 17956 i:= i+1;
7 17957 end;
6 17958 if o_nr=0 then
6 17959 fejlreaktion(10,busnr,<:ukendt områdeidentifikation for bus:>,1);
6 17960 end;
5 17961 repeatchar(z); readchar(z,tegn);
5 17962 end;
4 17963 if o_nr=0 then o_nr:= 3;
4 17964 bustabel (sidste_bus):= g_nr shift 14 + busnr;
4 17965 bustabel1(sidste_bus):= (binær extract 1) shift 23 + o_nr;
4 17966
4 17966 busnr:= -1;
4 17967 read(z,busnr);
4 17968 end;
3 17969 close(z,true);
3 17970 \f
3 17970 message vogntabel initialisering side 2 - 820301/cl;
3 17971
3 17971 <* initialisering af intern linie/løbs-tabel og bus-indekstabel *>
3 17972 test24:= testbit24;
3 17973 testbit24:= false;
3 17974 i:= 1;
3 17975 s:= læsfil(tf_vogntabel,i,zi);
3 17976 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
3 17977 while fil(zi).bn<>0 do
3 17978 begin
4 17979 if fil(zi).ll <> 0 then
4 17980 begin <* indsæt linie/løb *>
5 17981 res:= binærsøg(sidste_linie_løb,linie_løb_tabel(j) -
5 17982 fil(zi).ll,j);
5 17983 if res < 0 then j:= j+1;
5 17984 if res = 0 then fejlreaktion(10,fil(zi).bn,
5 17985 <:dobbeltregistrering i vogntabel:>,1)
5 17986 else
5 17987 begin
6 17988 o_nr:= fil(zi).bn shift (-14) extract 8;
6 17989 b_nr:= søg_omr_bus(fil(zi).bn extract 14,ll_nr,g_nr,o_nr,s,tegn);
6 17990 if b_nr<0 then fejlreaktion(10,fil(zi).bn extract 14,
6 17991 <:ukendt bus i vogntabel:>,1)
6 17992 else
6 17993 begin
7 17994 if sidste_linie_løb >= max_antal_linie_løb then
7 17995 fejlreaktion(10,fil(zi).bn extract 14,
7 17996 <:for mange linie/løb i vogntabel:>,0);
7 17997 for ll_nr:= sidste_linie_løb step (-1) until j do
7 17998 begin
8 17999 linie_løb_tabel(ll_nr+1):= linie_løb_tabel(ll_nr);
8 18000 bus_indeks(ll_nr+1):= bus_indeks(ll_nr);
8 18001 end;
7 18002 linie_løb_tabel(j):= fil(zi).ll;
7 18003 bus_indeks(j):= false add b_nr;
7 18004 sidste_linie_løb:= sidste_linie_løb + 1;
7 18005 end;
6 18006 end;
5 18007 end;
4 18008 i:= i+1;
4 18009 s:= læsfil(tf_vogntabel,i,zi);
4 18010 if s<>0 then fejlreaktion(5,s,<:vogntabelinit:>,0);
4 18011 end;
3 18012 \f
3 18012 message vogntabel initialisering side 3 - 810428/cl;
3 18013
3 18013 <* initialisering af intern linie/løb-indekstabel *>
3 18014 for ll_nr:= 1 step 1 until sidste_linie_løb do
3 18015 linie_løb_indeks(bus_indeks(ll_nr) extract 12):= false add ll_nr;
3 18016
3 18016 <* gem ny vogntabel i tabelfil *>
3 18017 for i:= 1 step 1 until sidste_bus do
3 18018 begin
4 18019 s:= skriv_fil(tf_vogntabel,i,zi);
4 18020 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18021 fil(zi).bn:= bustabel(i) extract 14 add
4 18022 (bustabel1(i) extract 8 shift 14);
4 18023 fil(zi).ll:= linie_løb_tabel(linie_løb_indeks(i) extract 12);
4 18024 end;
3 18025 fdim(4):= tf_vogntabel;
3 18026 hent_fil_dim(fdim);
3 18027 pant:= fdim(3) * (256//fdim(2));
3 18028 for i:= sidste_bus+1 step 1 until pant do
3 18029 begin
4 18030 s:= skriv_fil(tf_vogntabel,i,zi);
4 18031 if s<>0 then fejlreaktion(6,s,<:vogntabelinit:>,0);
4 18032 fil(zi).ll:= fil(zi).bn:= 0;
4 18033 end;
3 18034
3 18034 <* initialisering/nulstilling af gruppetabeller *>
3 18035 for i:= 1 step 1 until max_antal_grupper do
3 18036 begin
4 18037 s:= læs_fil(tf_gruppeidenter,i,zi);
4 18038 if s <> 0 then fejlreaktion(5,s,<:gruppetabelinit:>,0);
4 18039 gruppetabel(i):= fil(zi).ll;
4 18040 end;
3 18041 for i:= 1 step 1 until max_antal_gruppeopkald do
3 18042 gruppeopkald(i,1):= gruppeopkald(i,2):= 0;
3 18043 testbit24:= test24;
3 18044 end;
2 18045
2 18045
2 18045 <*+2*>
2 18046 <**> if testbit40 then p_vogntabel(out);
2 18047 <**> if testbit43 then p_gruppetabel(out);
2 18048 <*-2*>
2 18049
2 18049 message vogntabel initialisering side 3a -920517/cl;
2 18050
2 18050 <* initialisering for vt_log *>
2 18051
2 18051 v_tid:= 4;
2 18052 v_kode:= 6;
2 18053 v_bus:= 8;
2 18054 v_ll1:= 10;
2 18055 v_ll2:= 12;
2 18056 v_tekst:= 6;
2 18057 for i:= 1 step 1 until 4 do vt_logdisc(i):= 0;
2 18058 for i:= 1 step 1 until 10 do vt_log_tail(i):= 0;
2 18059 if vt_log_aktiv then
2 18060 begin
3 18061 integer i;
3 18062 real t;
3 18063 integer array field iaf;
3 18064 integer array
3 18065 tail(1:10),ia(1:10),chead(1:20);
3 18066
3 18066 open(zvtlog,4,<:vtlogpool:>,0); close(zvtlog,true);
3 18067 i:= monitor(42)lookup_entry:(zvtlog,0,tail);
3 18068 if i=0 then
3 18069 i:=monitor(52)create_areaproc:(zvtlog,0,ia);
3 18070 if i=0 then
3 18071 begin
4 18072 i:=monitor(8)reserve_process:(zvtlog,0,ia);
4 18073 monitor(64)remove_areaproc:(zvtlog,0,ia);
4 18074 end;
3 18075
3 18075 if i=0 then
3 18076 begin
4 18077 iaf:= 2;
4 18078 tofrom(vt_logdisc,tail.iaf,8);
4 18079 i:=slices(vt_logdisc,0,tail,chead);
4 18080 if i > (-2048) then
4 18081 begin
5 18082 vt_log_slicelgd:= chead(15);
5 18083 i:= 0;
5 18084 end;
4 18085 end;
3 18086
3 18086 if i=0 then
3 18087 begin
4 18088 open(zvtlog,4,<:vtlogklar:>,0); close(zvtlog,true);
4 18089 i:=monitor(42)lookup_entry:(zvtlog,0,tail);
4 18090 if i=0 then
4 18091 i:= monitor(52)create_areapproc:(zvtlog,0,ia);
4 18092 if i=0 then
4 18093 begin
5 18094 i:=monitor(8)reserve_process:(zvtlog,0,ia);
5 18095 monitor(64)remove_areaproc:(zvtlog,0,ia);
5 18096 end;
4 18097
4 18097 if i<>0 then
4 18098 begin
5 18099 for i:= 1 step 1 until 10 do tail(i):= 0;
5 18100 tail(1):= 1;
5 18101 iaf:= 2;
5 18102 tofrom(tail.iaf,vt_logdisc,8);
5 18103 tail(6):=systime(7,0,t);
5 18104 i:=monitor(40)create_entry:(zvtlog,0,tail);
5 18105 if i=0 then
5 18106 i:=monitor(50)permanent_entry:(zvtlog,3,ia);
5 18107 end;
4 18108 end;
3 18109
3 18109 if i<>0 then vt_log_aktiv:= false;
3 18110 end;
2 18111
2 18111
2 18111 \f
2 18111 message vogntabel initialisering side 4 - 810520/cl;
2 18112
2 18112 cs_vt:= nextsemch;
2 18113 <*+3*> skriv_new_sem(out,3,cs_vt,<:cs-vt:>);
2 18114 <*-3*>
2 18115
2 18115 cs_vt_adgang:= nextsemch;
2 18116 <*+3*> skriv_new_sem(out,3,cs_vt_adgang,<:cs-vt-adgang:>);
2 18117 <*-3*>
2 18118
2 18118 cs_vt_opd:= nextsemch;
2 18119 <*+3*> skriv_new_sem(out,3,cs_vt_opd,<:cs-vt-opd:>);
2 18120 <*-3*>
2 18121
2 18121 cs_vt_rap:= nextsemch;
2 18122 <*+3*> skriv_new_sem(out,3,cs_vt_rap,<:cs-vt-rap:>);
2 18123 <*-3*>
2 18124
2 18124 cs_vt_tilst:= nextsemch;
2 18125 <*+3*> skriv_new_sem(out,3,cs_vt_tilst,<:cs-vt-tilst:>);
2 18126 <*-3*>
2 18127
2 18127 cs_vt_auto:= nextsemch;
2 18128 <*+3*> skriv_new_sem(out,3,cs_vt_auto,<:cs-vt-auto:>);
2 18129 <*-3*>
2 18130
2 18130 cs_vt_grp:= nextsemch;
2 18131 <*+3*> skriv_new_sem(out,3,cs_vt_grp,<:cs-vt-grp:>);
2 18132 <*-3*>
2 18133
2 18133 cs_vt_spring:= nextsemch;
2 18134 <*+3*> skriv_new_sem(out,3,cs_vt_spring,<:cs-vt-spring:>);
2 18135 <*-3*>
2 18136
2 18136 cs_vt_log:= nextsemch;
2 18137 <*+3*> skriv_new_sem(out,3,cs_vt_log,<:cs-vt-log:>);
2 18138 <*-3*>
2 18139
2 18139 cs_vt_logpool:= nextsemch;
2 18140 <*+3*> skriv_new_sem(out,3,cs_vt_logpool,<:cs-vt-logpool:>);
2 18141 <*-3*>
2 18142
2 18142 vt_op:= nextop(vt_op_længde);
2 18143 signalch(cs_vt_adgang,vt_op,gen_optype or vt_optype);
2 18144
2 18144 vt_logop(1):= nextop(vt_op_længde);
2 18145 signalch(cs_vt_logpool,vt_logop(1),vt_optype);
2 18146 vt_logop(2):= nextop(vt_op_længde);
2 18147 signalch(cs_vt_logpool,vt_logop(2),vt_optype);
2 18148
2 18148 \f
2 18148 message vogntabel initialisering side 5 - 81-520/cl;
2 18149
2 18149 i:= nextcoru(500, <*ident*>
2 18150 10, <*prioitet*>
2 18151 true <*testmaske*>);
2 18152 j:= new_activity( i,
2 18153 0,
2 18154 h_vogntabel);
2 18155 <*+3*> skriv_newactivity(out,i,j);
2 18156 <*-3*>
2 18157
2 18157 i:= nextcoru(501, <*ident*>
2 18158 10, <*prioritet*>
2 18159 true <*testmaske*>);
2 18160 iaf:= nextop(filop_længde);
2 18161 j:= new_activity(i,
2 18162 0,
2 18163 vt_opdater,iaf);
2 18164 <*+3*> skriv_newactivity(out,i,j);
2 18165 <*-3*>
2 18166
2 18166 i:= nextcoru(502, <*ident*>
2 18167 10, <*prioritet*>
2 18168 true <*testmaske*>);
2 18169 k:= nextsemch;
2 18170 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-tilst):>);
2 18171 <*-3*>
2 18172 iaf:= nextop(fil_op_længde);
2 18173 j:= newactivity(i,
2 18174 0,
2 18175 vt_tilstand,
2 18176 k,
2 18177 iaf);
2 18178 <*+3*> skriv_newactivity(out,i,j);
2 18179 <*-3*>
2 18180 \f
2 18180 message vogntabel initialisering side 6 - 810520/cl;
2 18181
2 18181 i:= nextcoru(503, <*ident*>
2 18182 10, <*prioritet*>
2 18183 true <*testmaske*>);
2 18184 k:= nextsemch;
2 18185 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-rapport):>);
2 18186 <*-3*>
2 18187 iaf:= nextop(fil_op_længde);
2 18188 j:= newactivity(i,
2 18189 0,
2 18190 vt_rapport,
2 18191 k,
2 18192 iaf);
2 18193 <*+3*> skriv_newactivity(out,i,j);
2 18194 <*-3*>
2 18195
2 18195 i:= nextcoru(504, <*ident*>
2 18196 10, <*prioritet*>
2 18197 true <*testmaske*>);
2 18198 k:= nextsemch;
2 18199 <*+3*> skriv_new_sem(out,3,k,<:cs-fil(vt-gruppe):>);
2 18200 <*-3*>
2 18201 iaf:= nextop(fil_op_længde);
2 18202 j:= new_activity(i,
2 18203 0,
2 18204 vt_gruppe,
2 18205 k,
2 18206 iaf);
2 18207 <*+3*> skriv_newactivity(out,i,j);
2 18208 <*-3*>
2 18209 \f
2 18209 message vogntabel initialisering side 7 - 810520/cl;
2 18210
2 18210 i:= nextcoru(505, <*ident*>
2 18211 10, <*prioritet*>
2 18212 true <*testmaske*>);
2 18213 k:= nextsemch;
2 18214 <*+3*> skriv_new_sem(out,3,k,<:cs-spring-retur:>);
2 18215 <*-3*>
2 18216 iaf:= nextop(fil_op_længde);
2 18217 j:= newactivity(i,
2 18218 0,
2 18219 vt_spring,
2 18220 k,
2 18221 iaf);
2 18222 <*+3*> skriv_newactivity(out,i,j);
2 18223 <*-3*>
2 18224
2 18224 i:= nextcoru(506, <*ident*>
2 18225 10,
2 18226 true <*testmaske*>);
2 18227 k:= nextsemch;
2 18228 <*+3*> skriv_new_sem(out,3,k,<:cs-auto-retur:>);
2 18229 <*-3*>
2 18230 iaf:= nextop(if fil_op_længde>(data+20) then fil_op_længde else (data+20));
2 18231 j:= newactivity(i,
2 18232 0,
2 18233 vt_auto,
2 18234 k,
2 18235 iaf);
2 18236 <*+3*> skriv_newactivity(out,i,j);
2 18237 <*-3*>
2 18238
2 18238 i:=nextcoru(507, <*ident*>
2 18239 10, <*prioritet*>
2 18240 true <*testmaske*>);
2 18241 j:=newactivity(i,
2 18242 0,
2 18243 vt_log);
2 18244 <*+3*> skriv_newactivity(out,i,j);
2 18245 <*-3*>
2 18246
2 18246 <*+2*>
2 18247 <**> if testbit42 then skriv_vt_variable(out);
2 18248 <*-2*>
2 18249 \f
2 18249 message sysslut initialisering side 1 - 810406/cl;
2 18250 begin
3 18251 zone z(128,1,stderror);
3 18252 integer i,coruid,j,k;
3 18253 integer array field cor;
3 18254
3 18254 open(z,4,<:overvågede:>,0);
3 18255 for i:= read(z,coruid) while i > 0 do
3 18256 begin
4 18257 if coruid = 0 then
4 18258 begin
5 18259 for coruid:= 1 step 1 until maxcoru do
5 18260 begin
6 18261 cor:= coroutine(coruid);
6 18262 d.cor.corutestmask:= d.cor.corutestmask shift 1 shift (-1);
6 18263 end
5 18264 end
4 18265 else
4 18266 begin
5 18267 cor:= coroutine(coru_no(abs coruid));
5 18268 if cor > 0 then
5 18269 begin
6 18270 d.cor.corutestmask:=
6 18271 (d.cor.corutestmask shift 1 shift (-1)) add
6 18272 ((coruid > 0) extract 1 shift 11);
6 18273 end;
5 18274 end;
4 18275 end;
3 18276 close(z,true);
3 18277
3 18277 læsfil(tf_systællere,1,k);
3 18278 cor:= 0;
3 18279 tofrom(opkalds_tællere,fil(k).cor,max_antal_områder*6);
3 18280
3 18280 end;
2 18281 \f
2 18281 message sysslut initialisering side 2 - 810603/cl;
2 18282
2 18282
2 18282 if låsning > 0 then
2 18283 <* låsning 1 : *> lock(takeexternal,coru_term,mon,1); <* centrallogik *>
2 18284
2 18284 if låsning > 1 then
2 18285 <* låsning 2 : *> lock(readchar,1,write,2);
2 18286
2 18286 if låsning > 2 then
2 18287 <* låsning 3 : *> lock(activate,1,link,1,setposition,1);
2 18288
2 18288
2 18288
2 18288
2 18288 if låsning > 0 then
2 18289 begin
3 18290 i:= locked(ia);
3 18291 write(z_io,"nl",2,<:låsning::>,låsning,"nl",1,i,<: segmenter er låst:>);
3 18292 end;
2 18293 \f
2 18293 message sysslut initialisering side 3 - 810406/cl;
2 18294
2 18294 write(z_io,"nl",2,<:initialisering slut:>);
2 18295 system(2)free core:(i,ra);
2 18296 write(z_io,"nl",1,<:free core =:>,i,"nl",1);
2 18297 setposition(z_io,0,0);
2 18298 write(zbillede,"ff",0,"nl",1,<:initialisering slut :>,<<zddddd>,
2 18299 systime(5,0,r),".",1,r,"nl",1,<:free core=:>,i,
2 18300 "nl",1);
2 18301 errorbits:= 3; <* ok.no warning.yes *>
2 18302 \f
2 18302
2 18302 algol list.off;
2 18303 message coroutinemonitor - 40 ;
2 18304
2 18304 if simref <> firstsem then initerror(1, false);
2 18305 if semref <> firstop - 4 then initerror(2, false);
2 18306 if coruref <> firstsim then initerror(3, false);
2 18307 if opref <> optop + 6 then initerror(4, false);
2 18308 if proccount <> maxprocext -1 then initerror(5, false);
2 18309 goto takeexternal;
2 18310
2 18310 dump:
2 18311 op:= op;
2 18312 \f
2 18312 message sys trapaktion side 1 - 810521/hko/cl;
2 18313 trap(finale);
2 18314 write(zbillede,"ff",1,"nl",1,<:***** coroutine-monitor køer *****:>);
2 18315 for i:= 4<*readyqueue*>, 8<*idlequeue*>, 12<*timerqueue*> do
2 18316 begin
3 18317 k:= 0;
3 18318 write(zbillede,"nl",2,case i//4 of(<:readyqueue->:>,<:idlequeue ->:>,
3 18319 <:timerqueue->:>));
3 18320 iaf:= i;
3 18321 for iaf:= d.iaf.next while iaf<>i do
3 18322 begin
4 18323 ref:= firstcoru + (iaf-firstcoru)//corusize*corusize;
4 18324 write(zbillede,<: cr:>,<<zdd>,d.ref.coruident//1000);
4 18325 k:=k+1; if k mod 10 = 0 then write(zbillede,"nl",1,"sp",12);
4 18326 end;
3 18327 end;
2 18328 outchar(zbillede,'nl');
2 18329
2 18329 skriv_opkaldstællere(zbillede);
2 18330
2 18330
2 18330 pfilsystem(zbillede);
2 18331
2 18331 \f
2 18331 message operatør trapaktion1 side 1 - 810521/hko;
2 18332 write(zbillede,"nl",2,"=",20,<: operatørmodul :>,"=",20,"nl",1);
2 18333
2 18333 write(zbillede,"nl",1,<:betjeningspladsnavne::>,"nl",1);
2 18334 for i:= 1 step 1 until max_antal_operatører do
2 18335 begin
3 18336 laf:= (i-1)*8;
3 18337 write(zbillede,<<dd>,i,<:: :>,true,6,string bpl_navn(i),
3 18338 case operatør_auto_include(i) extract 2 + 1 of (
3 18339 <:EK :>,<:IN(ÅB):>,<:?? :>,<:IN(ST):>),<: :>,
3 18340 terminal_navn.laf,"nl",1);
3 18341 end;
2 18342 write(zbillede,"nl",1);
2 18343
2 18343 write(zbillede,"nl",1,<:top-bpl-gruppe: :>,<<d>,top_bpl_gruppe,"nl",1,
2 18344 <:betjeningspladsgrupper::>,"nl",1);
2 18345 for i:= 1 step 1 until 127 do
2 18346 if bpl_navn(i)<>long<::> then
2 18347 begin
3 18348 k:= write(zbillede,<<dd >,i,true,6,string bpl_navn(i),<:(:>,<<d>,
3 18349 bpl_tilst(i,1),<:/:>,bpl_tilst(i,2),<:):>);
3 18350 write(zbillede,"sp",16-k,<:= :>);
3 18351 iaf:= i*op_maske_lgd; j:=0;
3 18352 for k:= 1 step 1 until max_antal_operatører do
3 18353 begin
4 18354 if læsbit_ia(bpl_def.iaf,k) then
4 18355 begin
5 18356 if j mod 6 = 0 and j > 0 then write(zbillede,"nl",1,"sp",18);
5 18357 write(zbillede,true,6,string bpl_navn(k));
5 18358 j:= j+1;
5 18359 end;
4 18360 end;
3 18361 write(zbillede,"nl",1);
3 18362 end;
2 18363
2 18363 write(zbillede,"nl",1,<:stoptabel::>,"nl",1);
2 18364 for i:= 1 step 1 until max_antal_operatører do
2 18365 begin
3 18366 write(zbillede,<<dd >,i);
3 18367 for j:= 0 step 1 until 3 do
3 18368 begin
4 18369 k:= operatør_stop(i,j);
4 18370 write(zbillede,if j=0 then <: :> else <:->:>,if k=0 then <:ALLE:>
4 18371 else string bpl_navn(k));
4 18372 end;
3 18373 write(zbillede,<: (:>,<<d>,ant_i_opkø(i),<:):>,"nl",1);
3 18374 end;
2 18375
2 18375 skriv_terminal_tab(zbillede);
2 18376 write(zbillede,"nl",1,<:operatør-maske::>,"nl",1);
2 18377 outintbits_ia(zbillede,operatørmaske,1,op_maske_lgd//2);
2 18378 skriv_opk_alarm_tab(zbillede);
2 18379 skriv_talevejs_tab(zbillede);
2 18380 skriv_op_spool_buf(zbillede);
2 18381 skriv_cqf_tabel(zbillede,true);
2 18382 write(zbillede,"nl",2,"=",20,<: garagemodul :>,"=",20,"nl",1);
2 18383
2 18383 write(zbillede,"nl",1,<:garageterminaler::>,"nl",1);
2 18384 for i:= 1 step 1 until max_antal_garageterminaler do
2 18385 begin
3 18386 laf:= (i-1)*8;
3 18387 write(zbillede,<<dd>,i,<:: :>, if garage_auto_include(i) then
3 18388 <:IN,G :> else <:EK,G :>,garage_terminal_navn.laf,"nl",1);
3 18389 end;
2 18390 \f
2 18390 message radio trapaktion side 1 - 820301/hko;
2 18391 write(zbillede,"nl",2,"=",20,<: radiomodul :>,"=",20,"nl",1);
2 18392 skriv_kanal_tab(zbillede);
2 18393 skriv_opkaldskø(zbillede);
2 18394 skriv_radio_linietabel(zbillede);
2 18395 skriv_radio_områdetabel(zbillede);
2 18396
2 18396 \f
2 18396 message vogntabel trapaktion side 1 - 810520/cl;
2 18397 write(zbillede,"nl",2,"=",20,<: vogntabelmodul :>,"=",20,"nl",1);
2 18398 skriv_vt_variable(zbillede);
2 18399 p_vogntabel(zbillede);
2 18400 p_gruppetabel(zbillede);
2 18401 p_springtabel(zbillede);
2 18402 \f
2 18402 message sysslut trapaktion side 1 - 810519/cl;
2 18403 write(zbillede,"nl",2,"=",20,<: corutinemonitor :>,"=",20,"nl",1);
2 18404 corutable(zbillede);
2 18405 write(zbillede,"ff",1,<:***** simple semaphores *****:>,"nl",2,
2 18406 <: ref værdi prev next:>,"nl",1);
2 18407 iaf:= firstsim;
2 18408 repeat
2 18409 write(zbillede,<<dddd>,iaf,<< -dddd>,d.iaf.simvalue,<< dddd>,
2 18410 d.iaf(simcoru//2-1),d.iaf.simcoru,"nl",1);
2 18411 iaf:= iaf + simsize;
2 18412 until iaf>=simref;
2 18413 write(zbillede,"ff",1,<:***** chained semaphores *****:>,"nl",2,
2 18414 <: ref prev.coru next.coru prev.op next.op:>,"nl",1);
2 18415 iaf:= firstsem;
2 18416 repeat
2 18417 write(zbillede,<<dddd>,iaf,<<______dddd>,d.iaf(semcoru//2-1),
2 18418 d.iaf.semcoru,d.iaf(semop//2-1),d.iaf.semop,"nl",1);
2 18419 iaf:= iaf+semsize;
2 18420 until iaf>=semref;
2 18421 write(zbillede,"ff",1,<:***** operations *****:>,"nl",2);
2 18422 iaf:= firstop;
2 18423 repeat
2 18424 skriv_op(zbillede,iaf);
2 18425 iaf:= iaf+opheadsize+d.iaf.opsize;
2 18426 until iaf>=optop;
2 18427 write(zbillede,"ff",1,<:***** message extentions *****:>,"nl",2,
2 18428 <: messref messcode messop:>,"nl",1);
2 18429 for i:= 1 step 1 until maxmessext do
2 18430 write(zbillede,<< dddddddd>,messref(i),messcode(i),messop(i),"nl",1);
2 18431 write(zbillede,"nl",4,<:***** process extentions *****:>,"nl",2,
2 18432 <: procref proccode procop:>,"nl",1);
2 18433 for i:= 1 step 1 until maxprocext do
2 18434 write(zbillede,<< dddddddd>,procref(i),proccode(i),procop(i),"nl",1);
2 18435
2 18435
2 18435 \f
2 18435 message sys_finale side 1 - 810428/hko;
2 18436
2 18436 finale:
2 18437 trap(slut_finale);
2 18438 <* algol_pause:=algol_pause shift 24 shift (-24); *>
2 18439 endaction:=0;
2 18440 \f
2 18440 message filsystem finale side 1 - 810428/cl;
2 18441
2 18441 <* lukning af zoner *>
2 18442 write(out,<:lukker filsystem:>); ud;
2 18443 for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
2 18444 close(fil(i),true);
2 18445 \f
2 18445 message operatør_finale side 1 - 810428/hko;
2 18446
2 18446 goto op_trap2_slut;
2 18447
2 18447 write(out,<:lukker operatører:>); ud;
2 18448 for k:= 1 step 1 until max_antal_operatører do
2 18449 begin
3 18450 close(z_op(k),true);
3 18451 end;
2 18452 op_trap2_slut:
2 18453 k:=k;
2 18454
2 18454 \f
2 18454 message garage_finale side 1 - 810428/hko;
2 18455
2 18455 write(out,<:lukker garager:>); ud;
2 18456 for k:= 1 step 1 until max_antal_garageterminaler do
2 18457 begin
3 18458 close(z_gar(k),true);
3 18459 end;
2 18460 \f
2 18460 message radio_finale side 1 - 810525/hko;
2 18461 write(out,<:lukker radio:>); ud;
2 18462 close(z_fr_in,true);
2 18463 close(z_fr_out,true);
2 18464 close(z_rf_in,true);
2 18465 close(z_rf_out,true);
2 18466 \f
2 18466 message sysslut finale side 1 - 810530/cl;
2 18467
2 18467 slut_finale:
2 18468
2 18468 trap(exit_finale);
2 18469
2 18469 outchar(zrl,'em');
2 18470 close(zrl,true);
2 18471
2 18471 write(zbillede,
2 18472 "nl",2,<:blocksread=:>,blocksread,
2 18473 "nl",1,<:blocksout= :>,blocksout,
2 18474 "nl",1,<:fillæst= :>,fillæst,
2 18475 "nl",1,<:filskrevet=:>,filskrevet,
2 18476 "nl",3,<:********** billede genereret :>,<<zddddd>,
2 18477 systime(5,0,r),".",1,r,<: **********:>,"nl",1,"em",1);
2 18478 close(zbillede,true);
2 18479 monitor(42,zbillede,0,ia);
2 18480 ia(6):= systime(7,0,0.0);
2 18481 monitor(44,zbillede,0,ia);
2 18482 setposition(z_io,0,0);
2 18483 write(z_io,"nl",3,"sp",10,"*",15,<: busradio afsluttet :>,<<zddddd>,
2 18484 systime(5,0,r),".",1,r,"sp",1,"*",15,"nl",1,"em",1);
2 18485 close(z_io,true);
2 18486 exit_finale: trapmode:= 1 shift 10;
2 18487
2 18487 end;
1 18488
1 18488
1 18488 algol list.on;
1 18489 message programslut;
1 18490 program_slut:
1 18491 end
\f
1. 5514448 4605152 594 0 0
2. 10123322 3684071 341 0 0
3. 12326475 16148847 407 362 0
4. 14864464 15016082 417 1630 721
5. 12875118 12958772 567 29244 590
6. 6583910 16231490 568 0 0
7. 14968945 5223819 616 0 0
8. 18481 18475 18462 18444 18431 18423 18413 18405 18394 18383
18376 18363 18349 18340 18332 18318 18306 18297 18287 18271
18244 18224 18201 18181 18159 18143 18128 18113 18094 18078
18059 18035 18021 18000 17989 17976 17950 17926 17905 17885
17877 17872 17840 17823 17810 17799 17788 17771 17757 17740
17724 17709 17690 17672 17650 17632 17617 17597 17577 17560
17546 17530 17513 17497 17482 17467 17449 17438 17425 17416
17396 17383 17371 17356 17345 17325 17307 17295 17274 17250
17236 17223 17207 17193 17178 17163 17148 17123 17113 17101
17093 17083 17076 17060 17039 17015 17007 17000 16991 16963
16904 16874 16861 16833 16805 16778 16740 16711 16684 16626
16572 16534 16491 16456 16416 16384 16351 16293 16267 16216
16173 16134 16109 16084 16070 16038 16019 15999 15977 15965
15953 15935 15917 15903 15888 15866 15840 15823 15805 15797
15789 15765 15759 15746 15726 15715 15697 15685 15669 15655
15635 15611 15598 15586 15570 15552 15537 15530 15522 15513
15486 15471 15451 15438 15430 15421 15402 15391 15377 15365
15338 15323 15305 15283 15263 15250 15231 15208 15182 15161
15150 15128 15108 15086 15068 15040 15019 15001 14988 14980
14973 14958 14939 14932 14915 14895 14875 14861 14836 14821
14800 14774 14762 14753 14724 14702 14682 14672 14661 14636
14615 14595 14565 14546 14527 14507 14486 14478 14452 14439
14422 14403 14377 14358 14341 14314 14294 14272 14255 14235
14204 14173 14138 14111 14090 14077 14066 14045 14037 14028
14009 13989 13966 13939 13922 13904 13891 13881 13870 13846
13822 13803 13773 13760 13727 13692 13677 13656 13644 13618
13597 13577 13553 13542 13512 13493 13470 13440 13424 13401
13374 13339 13312 13305 13291 13270 13258 13244 13236 13221
13207 13200 13193 13186 13178 13145 13130 13110 13097 13079
13065 13037 13010 12992 12971 12953 12936 12919 12907 12897
12873 12867 12852 12832 12816 12799 12774 12761 12726 12709
12692 12669 12653 12641 12623 12596 12585 12577 12554 12535
12526 12509 12494 12476 12467 12455 12446 12428 12412 12397
12386 12367 12339 12318 12297 12281 12267 12260 12248 12231
12201 12182 12167 12148 12134 12103 12079 12069 12056 12041
12025 12007 11989 11965 11954 11938 11921 11905 11888 11864
11857 11839 11812 11794 11769 11744 11700 11689 11678 11650
11617 11587 11560 11518 11491 11470 11457 11449 11441 11431
11402 11385 11364 11349 11329 11306 11284 11260 11232 11210
11193 11168 11151 11136 11112 11097 11077 11058 11023 10995
10973 10951 10938 10911 10886 10871 10850 10830 10809 10785
10772 10751 10722 10687 10649 10613 10570 10555 10548 10540
10532 10511 10485 10467 10453 10432 10417 10401 10394 10384
10373 10357 10349 10340 10324 10296 10270 10259 10205 10168
10130 10066 10042 10028 10008 9992 9979 9960 9945 9932
9915 9903 9885 9860 9844 9820 9790 9773 9755 9747
9738 9707 9687 9670 9653 9629 9604 9582 9569 9556
9542 9521 9513 9504 9486 9468 9455 9433 9424 9406
9398 9386 9361 9344 9322 9305 9284 9267 9252 9229
9222 9196 9176 9158 9144 9133 9105 9087 9080 9056
9043 9032 9008 8991 8975 8963 8935 8919 8914 8894
8888 8881 8868 8854 8840 8824 8810 8799 8779 8770
8760 8735 8720 8713 8699 8683 8669 8659 8645 8629
8617 8579 8570 8544 8533 8519 8493 8473 8453 8432
8393 8376 8365 8355 8344 8334 8320 8309 8295 8281
8273 8253 8246 8235 8224 8209 8200 8192 8173 8161
8145 8127 8116 8102 8092 8081 8060 8046 8027 8015
8000 7987 7979 7965 7941 7923 7907 7886 7874 7852
7837 7821 7808 7794 7779 7738 7714 7680 7654 7631
7617 7595 7581 7551 7537 7516 7496 7466 7450 7438
7420 7407 7390 7372 7361 7346 7330 7318 7300 7271
7249 7229 7206 7183 7166 7150 7127 7110 7092 7055
7032 7025 7000 6988 6965 6951 6942 6923 6911 6894
6882 6861 6849 6831 6813 6791 6769 6761 6754 6746
6720 6694 6675 6655 6637 6621 6609 6589 6580 6563
6546 6535 6524 6513 6503 6498 6486 6476 6457 6444
6417 6406 6390 6382 6364 6348 6337 6301 6285 6271
6239 6219 6211 6196 6187 6163 6149 6138 6126 6114
6096 6076 6063 6038 6026 5999 5971 5956 5929 5903
5888 5876 5863 5844 5827 5815 5793 5781 5772 5759
5746 5723 5694 5677 5662 5638 5613 5602 5588 5570
5554 5529 5502 5487 5473 5454 5440 5417 5399 5385
5371 5351 5334 5317 5307 5296 5284 5267 5258 5242
5225 5213 5203 5186 5173 5158 5140 5128 5113 5095
5074 5054 5039 5025 5008 4990 4969 4942 4929 4915
4897 4876 4861 4831 4813 4793 4772 4760 4737 4722
4707 4685 4662 4638 4621 4585 4562 4547 4539 4531
4508 4483 4466 4446 4433 4401 4376 4335 4317 4291
4272 4261 4237 4228 4208 4189 4170 4150 4128 4108
4090 4073 4049 4016 3978 3955 3926 3882 3842 3790
3749 3709 3683 3621 3560 3515 3479 3432 3414 3377
3325 3277 3233 3217 3199 3182 3165 3143 3124 3107
3084 3041 3023 2988 2949 2923 2889 2863 2832 2801
2769 2752 2643 2583 2562 2528 2507 2469 2422 2399
2383 2365 2342 2323 2312 2303 2275 2260 2230 2219
2194 2173 2158 2134 2108 2081 2068 2047 2029 2016
1993 1974 1966 1941 1922 1907 1877 1856 1841 1833
1808 1790 1768 1752 1742 1717 1710 1697 1685 1671
1655 1642 1634 1624 1593 1577 1545 1506 1475 1443
1419 1387 1363 1336 1322 1291 1266 1244 1218 1210
1195 1190 1181 1151 1144 1138 1118 1105 1096 1091
1068 1053 1019 996 965 937 899 869 848 838
815 787 775 740 715 677 635 610 541 383
335 320 289 279 221 206 191 178 159 1
1 1 1
14968945 5223819 943 506071 31003
9. 16 192 16 4 950731 203944 buskom1
7 0 1989 801 algftnrts
0 1 0 2 *version
956 400 956 4 flushout
956 44 956 4 911004 101112 sendmessage
957 106 957 12 910308 134214 copyout
958 244 958 12 890821 163833 getzone6
0 410 0 0 out
959 178 959 12 940411 220029 testbit
962 414 962 18 940411 222629 findfpparam
965 46 965 18 890821 163814 system
968 238 968 18 movestring
968 56 968 18 890821 163907 outdate
969 124 969 18 isotable
970 176 969 18 890821 163656 write
975 310 975 152 intable
976 34 975 152 890821 163503 read
980 24 980 340 890821 163714 tofrom
967 420 965 18 stderror
982 80 982 340 890821 163740 open
986 112 986 340 890821 163754 monitor
983 344 982 340 close
967 378 965 18 increase
984 22 982 340 setposition
974 50 969 18 outchar
989 76 989 340 890821 163802 systime
0 1700 0 0 trapmode
990 302 990 340 trap
990 112 990 340 890821 163915 initzones
991 268 991 340 940411 222959 læsbitia
992 22 992 340 sign
992 28 992 340 890821 163648 ln
993 432 993 340 810409 111908 skrivhele
958 320 958 12 setzone6
1001 52 1001 340 inrec6
1001 28 1001 340 890821 163732 changerec6
1002 228 1002 340 940411 222949 sætbitia
976 36 975 152 readchar
1003 348 1003 340 940411 222633 læstegn
1699 0 0 0 000003 rs proc
1004 278 1004 340 940411 222636 skrivtegn
1005 384 1005 340 940411 222639 afsluttext
1006 394 1006 340 940411 222952 læsbiti
1007 498 1007 340 940411 222816 systid
1009 28 1009 340 getnumber
1009 18 1009 340 890426 134020 putnumber
969 26 969 18 replacechar
1 656 0 0 errorbits
1016 60 1016 342 940411 222943 sætbiti
1017 354 1017 342 940411 222801 openbs
1019 228 1019 342 940411 222742 hægttekst
1001 54 1001 340 outrec6
0 1704 0 0 alarmcause
1020 332 1020 342 940411 222745 hægtstring
1021 254 1021 342 940411 222749 anbringtal
975 288 975 152 repeatchar
1022 444 1022 342 940411 223002 intg
1023 350 1023 342 940411 222739 binærsøg
992 20 992 340 sgn
1024 380 1024 342 940411 222646 skrivtext
1001 56 1001 340 swoprec6
1028 56 1025 342 passivate
1025 40 1025 342 890821 163947 activity
1030 78 1030 350 260479 150000 mon
1 1043 1030 350 monw2
1 1039 1030 350 monw0
1 1041 1030 350 monw1
1027 56 1025 342 activate
0 1588 0 0 endaction
1030 320 1030 350 reflectcore
1026 50 1025 342 newactivity
1031 372 1031 358 940327 154135 setcspterm
1033 428 1033 358 941030 233200 slices
1037 52 1037 358 890821 163933 lock
1037 258 1037 358 locked
0 1612 0 0 blocksread
0 1642 0 0 blocksout
1038 162 1038 358 940411 222622 fpparam
1 1049 1039 358 nl
1 1047 1039 358 220978 131500 bel
1040 330 1040 446 940411 222722 ud
1041 252 1041 446 940411 222656 taltekst
1 1045 1030 350 monw3
958 296 958 12 getshare6
958 398 958 12 setshare6
70 474 1044 446 0
algol end 1044
*if ok.no
*if warning.yes
*o c
▶EOF◀