|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 89856 (0x15f00)
Types: TextFile
Names: »paposlst«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »paposlst«
\f
paposlst 81.06.19. 11.35. page 1
10 1 PROCESS pax_opsys(VAR semvector: system_vector;
20 2 VAR evavector: appl_vector);
30 3
40 4 (***************************************************
50 5 *
60 6 * function: the test module is used to initialise buffers,
70 7 * signal them to semaphores, and to write their
80 8 * contents, when they have been handled by another
90 9 *
100 10 * externals: none
110 11 *
120 12 * var params: none
130 13 *
140 14 * semaphores: the module sends to the system semaphore
150 15 * "operatorsem".
160 16 *
170 17 *
180 18 * programmed may 1980 by wib and stb
190 19 *
200 20 ***************************************************)
210 21
220 22 CONST
230 23 version = "vers 5.05 /";
240 24
250 25
260 26
\f
paposlst 81.06.19. 11.35. page 2
1010 27 CONST
1020 28
1030 29 ts_sem_total = 40;
1040 30
1050 31 size_listen=50; (************************************** chh *********************************)
1060 32 opbufsize = 80; (* no. of bytes in buffers to the operator module *)
1070 33 messbufsize= size_listen; (*words*)
1080 34 testbufsize= size_listen*4;
1090 35 noofmodules= 20;
1100 36 noofsemaphores= ts_sem_total;
1110 37 pu= 0; (* processing unit number *)
1120 38 pr= -1; (* timeslicing priority *)
1130 39
1140 40 valparam= "param val ";
1150 41 noparam= " no param ";
1160 42 alreadyexists= " already exists ";
1170 43 doesntexist= " doesn't exist ";
1180 44 illegalno= "illegal no";
1190 45 createerror= "error in createcall ";
1200 46 illegalparam='illegal parameters ';
1210 47 proc7ncr='proc 7 not created ';
1220 48
1230 49 firstindex= 6 + alfalength;
1240 50 lastindex= firstindex + (80 - 1);
1250 51 ok= 0; (* result from operator *)
1260 52 nooftaps=3; (********************** jli *********************)
1270 53 noofph=4; (********* jli **********)
1280 54
\f
paposlst 81.06.19. 11.35. page 3
2010 55
2020 56 TYPE
2030 57 pb_type=ARRAY(1..noofph) OF ph_type; (*** jli ***)
2040 58 tap_state_tp=(stopped,started);
2050 59 tap_state_type=ARRAY(1..nooftaps) OF tap_state_tp; (********* jli *******)
2060 60 opbuftype=
2070 61 RECORD
2080 62 ! first,
2090 63 ! last,
2100 64 ! next: integer;
2110 65 ! name: alfa;
2120 66 ! data: ARRAY (firstindex..lastindex) OF char
2130 67 END;
2140 68
2150 69 messbuftype= ARRAY (1..messbufsize) OF integer;
2160 70 testbuftype= ARRAY (1..testbufsize) OF integer;
2170 71
2180 72 atbuffer= ARRAY (0..1) OF byte;
2190 73
2200 74
2210 75 alfa10= ARRAY (1..10) OF char;
2220 76 alfa20= ARRAY (1..20) OF char;
2230 77
2240 78 (* type necessary to compare sempointers *)
2250 79 point_rec = RECORD
2260 80 ! a: sempointer;
2270 81 END;
2280 82
2290 83
\f
paposlst 81.06.19. 11.35. page 4
3010 84 VAR
3020 85 pb:pb_type; (***** jli *****)
3030 86 (********* pools *********)
3040 87 consprotpool: pool 1; (********** jli *****)
3050 88 opbufpool: pool 3 OF opbuftype;
3060 89 messbufpool: pool 20 OF messbuftype;
3070 90
3080 91 (********** semaphores **********)
3090 92 countsem, (* used by "t"-command *)
3100 93 wsem, (* buffers written by the operatormodule is
3110 94 returned here *)
3120 95 wrsem (* buffers with content read by the operator
3130 96 module is returned here *)
3140 97 : semaphore;
3150 98 consoleprot: semaphore; (* ****** jli *****)
3160 99 tap_sem (* snooper semaphore ************* jli **************)
3170 100 : ARRAY(1..nooftaps) OF semaphore;
3180 101 ts_sem : ARRAY (1..ts_sem_total) OF semaphore;
3190 102 tap_semp: ARRAY(1..nooftaps) OF tap_pointer; (* snooper pointer semaphore ************ jli ************)
3200 103
3210 104 (********** references **********)
3220 105 chhref, (************************************* chh ***********************)
3230 106 chhstack, (************************************* chh ***********************)
3240 107 countref, (* used by "t"-command *)
3250 108 opinref, (* ref. to buffer from operator *)
3260 109 opoutref, (* ref. to buffer to operator *)
3270 110 cur (* ref. to current buffer *)
3280 111 : reference;
3290 112
3300 113 (********** pointers **********)
3310 114 opsem: sempointer;
3320 115 worksem: sempointer;
3330 116 sem : ARRAY(1..ts_sem_total) OF tap_pointer; (****** chh **************)
3340 117
3350 118 (********** zones **********)
3360 119 z: zone;
3370 120
3380 121 (********** char **********)
3390 122 command: char; (* the first char the operator typed *)
3400 123
3410 124
\f
paposlst 81.06.19. 11.35. page 5
4010 125 (********** integers **********)
4020 126 base, (* number base for input and output *)
4030 127 firstword, (* used by "o"-command *)
4040 128 i,
4050 129 incharsleft, (* no. of not yet read chars in opinbuffer *)
4060 130 j,
4070 131 k,
4080 132 lastword, (* used by "o"-command *)
4090 133 leftbyte, (* used by "p"-command *)
4100 134 moduleno, (* tested module *)
4110 135 noofparams, (* no. of params in operator line *)
4120 136 oldbase, (* used by the "b" command *)
4130 137 rightbyte, (* used by "p"-command *)
4140 138 semno, (* typed semaphore number *)
4150 139 st (* storage requirements *)
4160 140 : integer;
4170 141
4180 142 tap_index: ARRAY(1..nooftaps) OF integer; (** jli ******)
4190 143 simsignal: ARRAY(1..2) OF integer;
4200 144
4210 145 (********** booleans **********)
4220 146 readok, (* indicates if the last call of readinteger
4230 147 yielded a result *)
4240 148 testmode
4250 149 : boolean;
4260 150
4270 151 (********** arrays **********)
4280 152 params: ARRAY(1..50) OF integer; (* holds parameters from operator *)
4290 153 sh: ARRAY(1..noofmodules) OF shadow; (* ref. to process incarn. *)
4300 154
4310 155
4320 156 (*** auxiliary to compare sempointers ***)
4330 157 ap,bp : point_rec;
4340 158
4350 159 (*** router definitions ************** jli *************)
4360 160 ltrm: ltsmarray;
4370 161 lrec: ltsmarray;
4380 162 ldrv: ltsmarray;
4390 163 ldrv2: ltsmarray;
4400 164
4410 165 (* tap definitions **************** jli ************)
4420 166 tap_state: tap_state_type:=tap_state_type(nooftaps***stopped);
4430 167
\f
paposlst 81.06.19. 11.35. page 6
5010 168 (*------- consts and vars from noah ------*)
5020 169
5030 170 CONST
5040 171
5050 172 nwu_del1=125;
5060 173 nwu_del2=4;
5070 174
5080 175 nwb_del1=120;
5090 176 nwb_del2=11;
5100 177
5110 178 VAR
5120 179 ownadr: nwadr;
5130 180
5140 181 r_lcp_id: integer:= 200;
5150 182 r_transit_ph: integer:= 10;
5160 183 r_nnp_ph: integer:= 20;
5170 184
5180 185 conn_desc: conn_desc_array;
5190 186
5200 187 sh_routsupv: shadow;
5210 188 sh_poolh: shadow;
5220 189 sh_poolnnp: shadow;
5230 190
5240 191 node_no : byte;
5250 192 max_hlcon_no : byte;
5260 193
\f
paposlst 81.06.19. 11.35. page 7
6010 194 (********** externals **********)
6020 195 PROCESS ncp(
6030 196 VAR sys_vector: system_vector;
6040 197 VAR ncp_sem: ! tap_pointer;
6050 198 VAR sc_sem: ! tap_pointer;
6060 199 VAR timeout_sem: ! tap_pointer;
6070 200 ncp_ident: ! integer);
6080 201 EXTERNAL;
6090 202
6100 203 PROCESS timeout(procname: alfa;
6110 204 opsem: ^semaphore;
6120 205 VAR main_sem: semaphore;
6130 206 ticklength,
6140 207 max: integer;
6150 208 hh: integer;
6160 209 mm: integer;
6170 210 ss: integer);
6180 211 EXTERNAL;
6190 212
6200 213 PROCESS pool_handler( VAR sysvec: system_vector;
6210 214 VAR poolh_sem: semaphore;
6220 215 VAR ncp_sem : semaphore;
6230 216 lcp_ident: integer;
6240 217 VAR ph: ph_type);
6250 218 EXTERNAL;
6260 219
6270 220 PROCESS supervisor( VAR sysvec: system_vector;
6280 221 VAR ncp: ! tap_pointer;
6290 222 lcp_ident: integer;
6300 223 VAR ltrm: ! ltsmarray;
6310 224 VAR lrec: ! ltsmarray;
6320 225 VAR ldrv: ! ltsmarray;
6330 226 VAR ldrv2:! ltsmarray;
6340 227 VAR conn_desc: conn_desc_array;
6350 228 VAR supv: ! tap_pointer;
6360 229 VAR poolh,poolnnp: ! tap_pointer;
6370 230 udelay1,udelay2,bdelay1,bdelay2: byte;
6380 231 VAR ownaddr: nwadr);
6390 232 EXTERNAL;
6400 233
6410 234
6420 235
6430 236 PROCESS pxtap(opsem: sempointer;
6440 237 VAR sem: ! tap_pointer;
6450 238 VAR consoleprot: semaphore);
6460 239 EXTERNAL;
\f
paposlst 81.06.19. 11.35. page 8
6470 240
6480 241 PROCESS ncth(VAR sys_vector:system_vector;
6490 242 VAR consoleprot:semaphore;
6500 243 VAR ncth_sem:semaphore;
6510 244 pu,formatter_prio,comint_prio:integer);
6520 245 EXTERNAL;
6530 246
6540 247
6550 248 PROCEDURE readram( VAR result: byte; index: integer);
6560 249 EXTERNAL;
6570 250
6580 251
6590 252
6600 253
6610 254
6620 255
6630 256
6640 257
6650 258
6660 259
6670 260
6680 261
6690 262
6700 263
6710 264
6720 265
6730 266
6740 267
6750 268
6760 269
6770 270
6780 271
6790 272
6800 273
6810 274
6820 275
6830 276
6840 277
\f
paposlst 81.06.19. 11.35. page 9
7010 278 (********** forwards **********)
7020 279
7030 280 PROCEDURE getparams;
7040 281 FORWARD;
7050 282
7060 283 PROCEDURE outdecimal(int,positions: integer);
7070 284 FORWARD;
7080 285
7090 286 PROCEDURE outinteger(int,positions: integer);
7100 287 FORWARD;
7110 288
7120 289 PROCEDURE outstring10(text: alfa10);
7130 290 FORWARD;
7140 291
7150 292 PROCEDURE outstring12(text: alfa);
7160 293 FORWARD;
7170 294
7180 295 PROCEDURE outstring20(text: alfa20);
7190 296 FORWARD;
7200 297
7210 298 FUNCTION readchar: char;
7220 299 FORWARD;
7230 300
7240 301 FUNCTION readinteger: integer;
7250 302 FORWARD;
7260 303
7270 304 PROCEDURE repeatchar;
7280 305 FORWARD;
7290 306
7300 307 PROCEDURE testmodeout (text: alfa20; i: integer);
7310 308 FORWARD;
7320 309
7330 310 PROCEDURE writenl;
7340 311 FORWARD;
7350 312
7360 313 PROCEDURE init_rout_semp;
7370 314 BEGIN
7380 315 1 ! ltrm(1):=sem(11); (* urec1 *)
7390 316 2 ! lrec(1):=sem(12); (* utrm1 *)
7400 317 3 ! ltrm(2):=sem(15);
7410 318 4 ! lrec(2):=sem(16);
7420 319 5 ! ldrv(2):=sem(17); (* hdlc1 driver sem *)
7430 320 6 ! ldrv2(2):=sem(26);
7440 321 7 ! ltrm(3) := sem(19);
7450 322 8 ! lrec(3) := sem(20);
7460 323 9 ! ldrv(3) := sem(21);
\f
paposlst 81.06.19. 11.35. page 10
7470 324 10 ! ldrv2(3):= sem(26);
7480 325 11 ! ltrm(4) := sem(23);
7490 326 12 ! lrec(4) := sem(24);
7500 327 13 ! ldrv(4) := sem(25);
7510 328 14 ! ldrv2(4):= sem(26);
7520 329 15 END;
7530 330
7540 331 PROCEDURE start_tap(i,incno:integer);
7550 332 BEGIN
7560 333 1 ! IF (i=0) OR (i>ts_sem_total) OR (noofparams<2) THEN
7570 334 2 ! outstring20('illegal parameter ') ELSE
7580 335 3 ! BEGIN
7590 336 4 ! ! IF tap_state(incno)=started THEN
7600 337 5 ! ! outstring20('already started ') ELSE
7610 338 6 ! ! BEGIN
7620 339 7 ! ! ! sem(i).s:=ref(tap_sem(incno));
7630 340 8 ! ! ! tap_semp(incno).s:=sem(i).w;
7640 341 9 ! ! ! tap_index(incno):=i;
7650 342 10 ! ! ! tap_state(incno):=started;
7660 343 11 ! ! ! init_rout_semp;
7670 344 12 ! ! END;
7680 345 13 ! END;
7690 346 14 END;
7700 347
7710 348 PROCEDURE stop_tap(incno:integer);
7720 349 BEGIN
7730 350 1 ! IF tap_state(incno)=started THEN
7740 351 2 ! BEGIN
7750 352 3 ! ! sem(tap_index(incno)).s:=ref(ts_sem(tap_index(incno)));
7760 353 4 ! ! tap_state(incno):=stopped;
7770 354 5 ! ! init_rout_semp;
7780 355 6 ! END;
7790 356 7 END;
7800 357
7810 358 PROCEDURE getinput;
7820 359 (* reads input from console into opinref^ *)
7830 360 BEGIN
7840 361 1 !
7850 362 2 ! testmodeout ("getinput called ",0);
7860 363 3 !
7870 364 4 ! REPEAT
7880 365 5 ! ! LOCK opinref AS opbuf: opbuftype DO
7890 366 6 ! ! opbuf.next:= firstindex;
7900 367 7 ! ! signal (opinref, opsem^);
7910 368 8 ! ! wait (opinref, wrsem);
7920 369 9 ! UNTIL opinref^.u2= ok (* 0*);
\f
paposlst 81.06.19. 11.35. page 11
7930 370 10 !
7940 371 11 ! LOCK opinref AS opbuf: opbuftype DO
7950 372 12 ! WITH opbuf DO
7960 373 13 ! BEGIN
7970 374 14 ! ! incharsleft:= next - first;
7980 375 15 ! ! next:= firstindex;
7990 376 16 ! END;
8000 377 17 ! command:= readchar;
8010 378 18 !
8020 379 19 ! testmodeout ("command read: ",ord(command));
8030 380 20 !
8040 381 21 ! getparams;
8050 382 22 END (* getinput *);
8060 383
\f
paposlst 81.06.19. 11.35. page 12
9010 384 PROCEDURE getparams;
9020 385 (* reads integer parameters *)
9030 386 VAR newbase: boolean;
9040 387 BEGIN
9050 388 1 ! testmodeout ("getparams called ",0);
9060 389 2 !
9070 390 3 ! noofparams:= 0;
9080 391 4 !
9090 392 5 ! IF command IN (."a","b","c","e","f","k","o","p","s","t","w","x".)
9100 393 6 ! THEN
9110 394 7 ! BEGIN (* change to decimal *)
9120 395 8 ! ! oldbase:= base;
9130 396 9 ! ! base:= 10;
9140 397 10 ! ! newbase:= true;
9150 398 11 ! END
9160 399 12 ! ELSE
9170 400 13 ! newbase:= false;
9180 401 14 !
9190 402 15 ! REPEAT
9200 403 16 ! ! noofparams:= noofparams + 1;
9210 404 17 ! ! params(noofparams):= readinteger;
9220 405 18 ! ! testmodeout ("parameter read: ",params(noofparams));
9230 406 19 ! ! IF (noofparams=1) THEN
9240 407 20 ! ! IF command IN (."e","f","p".) THEN
9250 408 21 ! ! BEGIN (* change to old *)
9260 409 22 ! ! ! base:= oldbase;
9270 410 23 ! ! ! newbase:= false;
9280 411 24 ! ! END;
9290 412 25 ! !
9300 413 26 ! UNTIL (NOT readok) OR (noofparams= 50);
9310 414 27 !
9320 415 28 ! noofparams:= noofparams - 1;
9330 416 29 !
9340 417 30 ! IF newbase THEN
9350 418 31 ! (* change back to old base *)
9360 419 32 ! base:= oldbase;
9370 420 33 END (* getparams *);
9380 421
\f
paposlst 81.06.19. 11.35. page 13
10010 422 PROCEDURE init_proc(
10020 423 index: integer;
10030 424 name : alfa;
10040 425 p : processrec;
10050 426 size,
10060 427 prio : integer);
10070 428 VAR
10080 429 ok : integer;
10090 430 BEGIN
10100 431 1 ! IF NOT nil(sh(index)) THEN
10110 432 2 ! outstring20(alreadyexists) ELSE
10120 433 3 ! BEGIN
10130 434 4 ! ! IF noofparams<2 THEN st:= size;
10140 435 5 ! ! ok:= link(name,p.processref^);
10150 436 6 ! ! ok:= create(name,p,sh(index),size);
10160 437 7 ! ! IF ok=0 THEN
10170 438 8 ! ! start(sh(index),prio) ELSE
10180 439 9 ! ! BEGIN
10190 440 10 ! ! ! outstring20(createerror);
10200 441 11 ! ! ! outdecimal(ok,4);
10210 442 12 ! ! ! outstring10(" process ");
10220 443 13 ! ! ! outstring12(name);
10230 444 14 ! ! ! writenl;
10240 445 15 ! ! ! ok:= unlink(p.processref^);
10250 446 16 ! ! END;
10260 447 17 ! END;
10270 448 18 END;
10280 449
10290 450 PROCEDURE crtap(index:integer;i:integer; n:alfa);
10300 451 BEGIN
10310 452 1 ! tap_semp(i).w:=ref(tap_sem(i));
10320 453 2 ! start_tap(params(2),i);
10330 454 3 ! init_proc(index,n,
10340 455 4 ! pxtap(semvector(operatorsem),tap_semp(i),consoleprot),
10350 456 5 ! 500,stdpriority);
10360 457 6 END;
10370 458
10380 459
10390 460 PROCEDURE init_modul(index: integer);
10400 461 CONST
10410 462 n1 = "ncp ";
10420 463 n2 = "timeout ";
10430 464 n6 = "ncth ";
10440 465 n7 = "pxtap ";
10450 466 n11= 'pxtap2 ';
10460 467 n12= 'pxtap3 ';
\f
paposlst 81.06.19. 11.35. page 14
10470 468 BEGIN
10480 469 1 ! CASE index OF
10490 470 2 ! !
10500 471 3 ! ! 1: (* ncp *)
10510 472 4 ! ! init_proc(index, n1 ,
10520 473 5 ! ! ncp( semvector, sem(1), sem(2), sem(3), 576),
10530 474 6 ! ! 900, stdpriority);
10540 475 7 ! !
10550 476 8 ! ! 2: (* timeout *)
10560 477 9 ! ! BEGIN
10570 478 10 ! ! ! IF noofparams<>4 THEN
10580 479 11 ! ! ! BEGIN
10590 480 12 ! ! ! ! params(2):= 0;
10600 481 13 ! ! ! ! params(3):= 0;
10610 482 14 ! ! ! ! params(4):= 0;
10620 483 15 ! ! ! END;
10630 484 16 ! ! ! init_proc(index,n2,
10640 485 17 ! ! ! timeout(n2, opsem, sem(3).s^, 900, 0, params(2), params(3), params(4)),
10650 486 18 ! ! ! 600, stdpriority);
10660 487 19 ! ! END;
10670 488 20 ! !
10680 489 21 ! ! 4 : (* supervisor *)
10690 490 22 ! ! BEGIN
10700 491 23 ! ! !
10710 492 24 ! ! ! CASE node_no OF
10720 493 25 ! ! ! ! 4,5,6 : max_hlcon_no := 2;
10730 494 26 ! ! ! ! 2 : max_hlcon_no := 4;
10740 495 27 ! ! ! ! OTHERWISE max_hlcon_no := 3;
10750 496 28 ! ! ! END;
10760 497 29 ! ! !
10770 498 30 ! ! ! conn_desc(1).ctyp := typ_locon;
10780 499 31 ! ! ! conn_desc(1).cparams(1) := node_no;
10790 500 32 ! ! ! conn_desc(1).cparams(2) := 8;
10800 501 33 ! ! ! conn_desc(1).cparams(3) := 8;
10810 502 34 ! ! ! conn_desc(1).cparams(4) := 0;
10820 503 35 ! ! ! conn_desc(1).cparams(5) := 0;
10830 504 36 ! ! !
10840 505 37 ! ! ! FOR i := 2 TO max_hlcon_no DO
10850 506 38 ! ! ! BEGIN
10860 507 39 ! ! ! ! conn_desc(i).ctyp := typ_hlcon;
10870 508 40 ! ! ! ! conn_desc(i).cparams(1) := i-2;
10880 509 41 ! ! ! ! conn_desc(i).cparams(2) := 2;
10890 510 42 ! ! ! ! conn_desc(i).cparams(3) := 1;
10900 511 43 ! ! ! ! conn_desc(i).cparams(4) := 0;
10910 512 44 ! ! ! ! conn_desc(i).cparams(5) := 50;
10920 513 45 ! ! ! ! conn_desc(i).cparams(6) := 5;
\f
paposlst 81.06.19. 11.35. page 15
10930 514 46 ! ! ! END;
10940 515 47 ! ! !
10950 516 48 ! ! ! FOR i := max_hlcon_no+1 TO cmax DO
10960 517 49 ! ! ! conn_desc(i).ctyp := none;
10970 518 50 ! ! !
10980 519 51 ! ! ! i:=link('supervisor ',supervisor);
10990 520 52 ! ! ! IF i <> 0 THEN
11000 521 53 ! ! ! testout(z,"sup lnk nok ",i)
11010 522 54 ! ! ! ELSE
11020 523 55 ! ! ! i:=create('supv ',
11030 524 56 ! ! ! supervisor( semvector, sem(1),r_lcp_id, ltrm,lrec,ldrv,ldrv2,conn_desc,
11040 525 57 ! ! ! sem(10),sem(4),sem(5),nwu_del1,nwu_del2,nwb_del1,nwb_del2,ownadr),
11050 526 58 ! ! ! sh_routsupv, 700);
11060 527 59 ! ! ! IF i <> 0 THEN
11070 528 60 ! ! ! testout(z,"sup crt nok ", i)
11080 529 61 ! ! ! ELSE
11090 530 62 ! ! ! start(sh_routsupv,stdpriority);
11100 531 63 ! ! !
11110 532 64 ! ! ! i:= link('pool_handler',pool_handler);
11120 533 65 ! ! ! IF i <> 0 THEN
11130 534 66 ! ! ! testout(z,"trp lnk nok ", i)
11140 535 67 ! ! ! ELSE
11150 536 68 ! ! ! i:=create('transit-pool',
11160 537 69 ! ! ! pool_handler( semvector,sem(4).w^,sem(1).s^,r_transit_ph, pb(1)),
11170 538 70 ! ! ! sh_poolh, 300);
11180 539 71 ! ! ! IF i <> 0 THEN
11190 540 72 ! ! ! testout(z,"trp crt nok ",i)
11200 541 73 ! ! ! ELSE
11210 542 74 ! ! ! start(sh_poolh, stdpriority);
11220 543 75 ! ! !
11230 544 76 ! ! ! i:= create('nnp pool ',
11240 545 77 ! ! ! pool_handler( semvector, sem(5).w^,sem(1).s^,r_nnp_ph,pb(2)),
11250 546 78 ! ! ! sh_poolnnp, 300);
11260 547 79 ! ! ! IF i <> 0 THEN
11270 548 80 ! ! ! testout(z,"nnp crt nok ", i)
11280 549 81 ! ! ! ELSE
11290 550 82 ! ! ! start( sh_poolnnp, stdpriority);
11300 551 83 ! ! !
11310 552 84 ! ! END;
11320 553 85 ! !
11330 554 86 ! ! 6: (* ncth *)
11340 555 87 ! ! init_proc(index,n6,
11350 556 88 ! ! ncth(semvector,consoleprot,sem(2).w^,0,stdpriority,stdpriority),
11360 557 89 ! ! 500,stdpriority);
11370 558 90 ! !
11380 559 91 ! !
\f
paposlst 81.06.19. 11.35. page 16
11390 560 92 ! ! 7: (* tap1 *)
11400 561 93 ! ! crtap(index,1,n7);
11410 562 94 ! !
11420 563 95 ! !
11430 564 96 ! !
11440 565 97 ! ! 11: (* tap2 *)
11450 566 98 ! ! IF nil(sh(7)) THEN outstring20(proc7ncr) ELSE
11460 567 99 ! ! crtap(index,2,n11);
11470 568 100 ! !
11480 569 101 ! ! 12: (* tap3 *)
11490 570 102 ! ! IF nil(sh(7)) THEN outstring20(proc7ncr) ELSE
11500 571 103 ! ! crtap(index,3,n12);
11510 572 104 ! !
11520 573 105 ! !
11530 574 106 ! !
11540 575 107 ! !
11550 576 108 ! !
11560 577 109 ! ! OTHERWISE
11570 578 110 ! ! BEGIN
11580 579 111 ! ! ! outdecimal(index,4);
11590 580 112 ! ! ! outstring10(illegalno);
11600 581 113 ! ! END;
11610 582 114 ! END (* case *)
11620 583 115 END;
11630 584
\f
paposlst 81.06.19. 11.35. page 17
12010 585 FUNCTION moduleready(moduleno: integer): boolean;
12020 586 (* tests if an incarnation of the module is existing
12030 587 and writes an errormessage if so *)
12040 588 BEGIN
12050 589 1 ! IF nil( sh( moduleno) ) THEN moduleready:=true
12060 590 2 ! ELSE
12070 591 3 ! BEGIN (* module is already existing *)
12080 592 4 ! ! outdecimal(moduleno,4);
12090 593 5 ! ! outstring20(alreadyexists);
12100 594 6 ! ! moduleready:=false;
12110 595 7 ! END;
12120 596 8 END (* module ready *);
12130 597
12140 598
12150 599
\f
paposlst 81.06.19. 11.35. page 18
13010 600 PROCEDURE outchar(ch:char);
13020 601 (* writes ch into the output buffer *)
13030 602 BEGIN
13040 603 1 ! LOCK opoutref AS opbuf: opbuftype DO
13050 604 2 ! WITH opbuf DO
13060 605 3 ! BEGIN
13070 606 4 ! ! last:= last + 1;
13080 607 5 ! ! data (last):= ch;
13090 608 6 ! END;
13100 609 7 END (* outchar *);
13110 610
\f
paposlst 81.06.19. 11.35. page 19
14010 611 PROCEDURE outdecimal (int, positions: integer);
14020 612 (* writes the integer "int" decimally into opbuf starting
14030 613 at "last", which is updated accordingly *)
14040 614
14050 615 BEGIN
14060 616 1 ! oldbase:= base;
14070 617 2 ! base:= 10;
14080 618 3 ! outinteger(int,positions);
14090 619 4 ! base:= oldbase;
14100 620 5 END (* outdecimal *);
14110 621
\f
paposlst 81.06.19. 11.35. page 20
15010 622 PROCEDURE outinteger(int,positions:integer);
15020 623 (* writes the integer "int" into opbuf starting at
15030 624 "last", which is updated accordingly *)
15040 625 CONST
15050 626 maxpos = 20; (* max number of positions in layout *)
15060 627
15070 628 VAR
15080 629 bits: ARRAY(0..15) OF bit;
15090 630 digits:ARRAY(1..maxpos) OF char;
15100 631 curdigit, (* current pos. in digits-array to be filled out *)
15110 632 curpos, (* cur. pos. in the nunber being computed *)
15120 633 h, i,
15130 634 m, newm,
15140 635 noofdig, (* no. of digits in the resulting number *)
15150 636 noofpos, (* no. of pos. from bits-array for one number *)
15160 637 res, (* resulting number *)
15170 638 used: integer;
15180 639
15190 640 negative, zeroes: boolean;
15200 641
15210 642 BEGIN
15220 643 1 ! used:= 1;
15230 644 2 !
15240 645 3 ! (* first we initialise the digits array *)
15250 646 4 ! FOR i:=1 TO maxpos DO digits(i):=sp;
15260 647 5 !
15270 648 6 ! IF base= 10 THEN
15280 649 7 ! BEGIN
15290 650 8 ! ! i:=maxpos;
15300 651 9 ! !
15310 652 10 ! ! negative:= int<0;
15320 653 11 ! !
15330 654 12 ! ! REPEAT
15340 655 13 ! ! ! (* now we unpack the digits backwards and put them
15350 656 14 ! ! ! into the digits array *)
15360 657 15 ! ! !
15370 658 16 ! ! ! digits(i):= chr (abs(int MOD base) + ord("0"));
15380 659 17 ! ! ! int:=int DIV base;
15390 660 18 ! ! ! i:=i-1;
15400 661 19 ! ! UNTIL (i=1) OR (int=0);
15410 662 20 ! !
15420 663 21 ! ! IF negative THEN
15430 664 22 ! ! BEGIN
15440 665 23 ! ! ! digits(i):="-";
15450 666 24 ! ! ! i:=i-1;
15460 667 25 ! ! END;
\f
paposlst 81.06.19. 11.35. page 21
15470 668 26 ! !
15480 669 27 ! ! used:=maxpos-i;
15490 670 28 ! !
15500 671 29 ! ! IF int <> 0 THEN digits(1):= "*";
15510 672 30 ! END (* if base= 10 *)
15520 673 31 !
15530 674 32 ! ELSE (* base= 2, 8, or 16 *)
15540 675 33 ! BEGIN
15550 676 34 ! ! (* initialise bits-array *)
15560 677 35 ! ! IF int>=0 THEN
15570 678 36 ! ! BEGIN
15580 679 37 ! ! ! FOR i:= 15 DOWNTO 1 DO
15590 680 38 ! ! ! BEGIN
15600 681 39 ! ! ! ! bits(i):= int MOD 2;
15610 682 40 ! ! ! ! int:= int DIV 2;
15620 683 41 ! ! ! END;
15630 684 42 ! ! ! bits(0):= int MOD 2;
15640 685 43 ! ! ! int:= int DIV 2;
15650 686 44 ! ! END
15660 687 45 ! ! ELSE
15670 688 46 ! ! (* int<0 *)
15680 689 47 ! ! BEGIN
15690 690 48 ! ! ! (* subtract abs(int) from 1111111...1 *)
15700 691 49 ! ! ! FOR i:= 15 DOWNTO 1 DO
15710 692 50 ! ! ! BEGIN
15720 693 51 ! ! ! ! bits(i):= 1+(int MOD 2);
15730 694 52 ! ! ! ! int:= int DIV 2;
15740 695 53 ! ! ! END;
15750 696 54 ! ! ! bits(0):= 1+(int MOD 2);
15760 697 55 ! ! ! int:= int DIV 2;
15770 698 56 ! ! !
15780 699 57 ! ! ! (* add 1 *)
15790 700 58 ! ! ! m:= 1;
15800 701 59 ! ! ! FOR i:= 15 DOWNTO 1 DO
15810 702 60 ! ! ! BEGIN
15820 703 61 ! ! ! ! newm:= (bits(i)+m) DIV 2;
15830 704 62 ! ! ! ! bits(i):= (bits(i)+m) MOD 2;
15840 705 63 ! ! ! ! m:= newm;
15850 706 64 ! ! ! END;
15860 707 65 ! ! ! newm:= (bits(0)+m) DIV 2;
15870 708 66 ! ! ! bits(0):= (bits(0)+m) MOD 2;
15880 709 67 ! ! ! m:= newm;
15890 710 68 ! ! END (*int<0*);
15900 711 69 ! !
15910 712 70 ! ! (* compute digits-array *)
15920 713 71 ! ! CASE base OF
\f
paposlst 81.06.19. 11.35. page 22
15930 714 72 ! ! ! 2: BEGIN
15940 715 73 ! ! ! ! noofpos:= 1;
15950 716 74 ! ! ! ! noofdig:= 16;
15960 717 75 ! ! ! END;
15970 718 76 ! ! !
15980 719 77 ! ! ! 8: BEGIN
15990 720 78 ! ! ! ! noofpos:= 3;
16000 721 79 ! ! ! ! noofdig:= 6;
16010 722 80 ! ! ! END;
16020 723 81 ! ! !
16030 724 82 ! ! ! 16: BEGIN
16040 725 83 ! ! ! ! noofpos:= 4;
16050 726 84 ! ! ! ! noofdig:= 4;
16060 727 85 ! ! ! END;
16070 728 86 ! ! END (* case *);
16080 729 87 ! !
16090 730 88 ! ! curdigit:= maxpos -noofdig +1;
16100 731 89 ! !
16110 732 90 ! ! IF base= 8
16120 733 91 ! ! THEN curpos:= 3
16130 734 92 ! ! ELSE curpos:= 1;
16140 735 93 ! ! res:= 0;
16150 736 94 ! ! zeroes:= true;
16160 737 95 ! !
16170 738 96 ! ! FOR h:= 0 TO 15 DO
16180 739 97 ! ! BEGIN
16190 740 98 ! ! ! res:= res*2 + bits(h);
16200 741 99 ! ! ! IF curpos= noofpos THEN
16210 742 100 ! ! ! BEGIN (* time to fill out a pos. in digits-array *)
16220 743 101 ! ! ! ! IF zeroes AND (res=0) THEN
16230 744 102 ! ! ! ! BEGIN
16240 745 103 ! ! ! ! ! IF curdigit=maxpos
16250 746 104 ! ! ! ! ! THEN digits(curdigit):= "0"
16260 747 105 ! ! ! ! ! (*else digits (curdigit):= " "*);
16270 748 106 ! ! ! ! END
16280 749 107 ! ! ! ! ELSE
16290 750 108 ! ! ! ! IF res<=9
16300 751 109 ! ! ! ! THEN digits(curdigit):= chr (res + ord ("0"))
16310 752 110 ! ! ! ! ELSE digits(curdigit):= chr (res + ord ("7"));
16320 753 111 ! ! ! ! IF (res<>0) AND zeroes THEN
16330 754 112 ! ! ! ! BEGIN
16340 755 113 ! ! ! ! ! zeroes:= false;
16350 756 114 ! ! ! ! ! used:= maxpos - curdigit + 1;
16360 757 115 ! ! ! ! END;
16370 758 116 ! ! ! ! res:= 0;
16380 759 117 ! ! ! ! curpos:= 0;
\f
paposlst 81.06.19. 11.35. page 23
16390 760 118 ! ! ! ! curdigit:= curdigit + 1;
16400 761 119 ! ! ! END;
16410 762 120 ! ! ! curpos:= curpos + 1;
16420 763 121 ! ! END;
16430 764 122 ! END (* base= 2, 8, of 16 *);
16440 765 123 !
16450 766 124 ! IF positions<used THEN outchar(sp);
16460 767 125 !
16470 768 126 ! IF (NOT (positions IN (. 1 .. maxpos .)) )
16480 769 127 ! OR (positions < used) THEN
16490 770 128 ! positions:=used;
16500 771 129 !
16510 772 130 ! FOR i:=maxpos+1-positions TO maxpos DO
16520 773 131 ! BEGIN
16530 774 132 ! ! outchar( digits(i) );
16540 775 133 ! END
16550 776 134 !
16560 777 135 END (* out integer *);
16570 778
16580 779
16590 780
\f
paposlst 81.06.19. 11.35. page 24
17010 781 PROCEDURE outstring10(text: alfa10);
17020 782 (* writes the text into opbuf starting at outputpointer
17030 783 which is updated accordingly *)
17040 784 VAR
17050 785 i: integer;
17060 786 BEGIN
17070 787 1 ! FOR i:=1 TO 10 DO
17080 788 2 ! outchar( text(i) );
17090 789 3 END (* out string 10 *);
17100 790
17110 791 PROCEDURE outstring12(text: alfa);
17120 792 VAR
17130 793 i: integer;
17140 794 BEGIN
17150 795 1 ! FOR i:=1 TO 12 DO
17160 796 2 ! outchar(text(i));
17170 797 3 END;
17180 798
\f
paposlst 81.06.19. 11.35. page 25
18010 799 PROCEDURE outstring20(text: alfa20);
18020 800 (* analogue to outstring10 *)
18030 801 VAR
18040 802 i: integer;
18050 803 BEGIN
18060 804 1 ! FOR i:=1 TO 20 DO
18070 805 2 ! outchar( text(i) );
18080 806 3 END (* out string 20 *);
18090 807
18100 808
18110 809
18120 810
\f
paposlst 81.06.19. 11.35. page 26
19010 811 FUNCTION readchar: char;
19020 812 (* reads the next char from opinref^.
19030 813 next is incremented and charsleft is
19040 814 decremented *)
19050 815 BEGIN
19060 816 1 ! LOCK opinref AS opbuf: opbuftype DO
19070 817 2 ! WITH opbuf DO
19080 818 3 ! BEGIN
19090 819 4 ! ! readchar:= data(next);
19100 820 5 ! ! next:= next + 1;
19110 821 6 ! END;
19120 822 7 ! incharsleft:=incharsleft-1;
19130 823 8 END (* readchar *);
19140 824
19150 825
19160 826
19170 827
\f
paposlst 81.06.19. 11.35. page 27
20010 828 FUNCTION readinteger : integer;
20020 829 (* reads the next integer from opinref^ starting
20030 830 at "inputpoint". upon return "inputpoint" will be
20040 831 the position just after the last char read.
20050 832
20060 833 the global boolean "readok" will be true if an
20070 834 integer was read and false otherwise *)
20080 835
20090 836 CONST
20100 837 digits = (. "0" .. "9" .);
20110 838 hexdigits = (. "a" .. "f" .);
20120 839 signs = (. "+" , "-" .);
20130 840
20140 841 VAR
20150 842 negative, digit: boolean;
20160 843
20170 844 curdigit, noofdigit,
20180 845 result: integer;
20190 846
20200 847 ch,lastchar: char;
20210 848
20220 849
20230 850 BEGIN
20240 851 1 ! readok:=false;
20250 852 2 ! lastchar:=nul;
20260 853 3 ! ch:=nul;
20270 854 4 ! digit:=false;
20280 855 5 !
20290 856 6 ! (* now skip until a digit is encountered *)
20300 857 7 !
20310 858 8 ! IF incharsleft > 0 THEN
20320 859 9 ! REPEAT
20330 860 10 ! ! lastchar:=ch;
20340 861 11 ! ! ch:=readchar;
20350 862 12 ! ! digit:= (ch IN digits) OR
20360 863 13 ! ! ((base= 16) AND (ch IN hexdigits))
20370 864 14 ! UNTIL digit OR (incharsleft<=0);
20380 865 15 !
20390 866 16 ! result:=0;
20400 867 17 ! IF base= 10 THEN
20410 868 18 ! negative:= lastchar= "-"
20420 869 19 ! ELSE negative:= false;
20430 870 20 !
20440 871 21 !
20450 872 22 ! IF digit THEN
20460 873 23 ! BEGIN
\f
paposlst 81.06.19. 11.35. page 28
20470 874 24 ! ! IF ch IN digits
20480 875 25 ! ! THEN result:= ord (ch) - ord ("0")
20490 876 26 ! ! ELSE result:= ord (ch) - 87 (*ord ("W")*);
20500 877 27 ! ! readok:=true;
20510 878 28 ! END;
20520 879 29 !
20530 880 30 ! IF base=10 THEN
20540 881 31 ! BEGIN
20550 882 32 ! ! WHILE digit AND (incharsleft>0) DO
20560 883 33 ! ! BEGIN (* read the digits *)
20570 884 34 ! ! ! ch:= readchar;
20580 885 35 ! ! !
20590 886 36 ! ! ! digit:= (ch IN digits) OR
20600 887 37 ! ! ! ((base= 16) AND (ch IN hexdigits));
20610 888 38 ! ! ! IF digit THEN
20620 889 39 ! ! ! BEGIN
20630 890 40 ! ! ! ! IF negative AND (result=3276) AND (ch="8")
20640 891 41 ! ! ! ! THEN BEGIN
20650 892 42 ! ! ! ! ! result:= -32768;
20660 893 43 ! ! ! ! ! negative:= false;
20670 894 44 ! ! ! ! END
20680 895 45 ! ! ! ! ELSE
20690 896 46 ! ! ! ! BEGIN
20700 897 47 ! ! ! ! ! IF ch IN digits
20710 898 48 ! ! ! ! ! THEN result:= result*base+(ord(ch)-ord("0"))
20720 899 49 ! ! ! ! ! ELSE result:= result*base+(ord(ch)-87(*ord("W")*));
20730 900 50 ! ! ! ! END;
20740 901 51 ! ! ! END;
20750 902 52 ! ! END (* while *);
20760 903 53 ! !
20770 904 54 ! ! IF negative THEN result:= - result;
20780 905 55 ! !
20790 906 56 ! END (* base= 10 *)
20800 907 57 !
20810 908 58 ! ELSE
20820 909 59 ! BEGIN (* base= 2, 8, or 16 *)
20830 910 60 ! !
20840 911 61 ! ! CASE base OF
20850 912 62 ! ! ! 2:BEGIN
20860 913 63 ! ! ! ! IF ch="1" THEN negative:= true;
20870 914 64 ! ! ! ! noofdigit:= 16;
20880 915 65 ! ! ! END;
20890 916 66 ! ! !
20900 917 67 ! ! ! 8: BEGIN
20910 918 68 ! ! ! ! IF ch="1" THEN negative:= true;
20920 919 69 ! ! ! ! noofdigit:= 6;
\f
paposlst 81.06.19. 11.35. page 29
20930 920 70 ! ! ! END;
20940 921 71 ! ! !
20950 922 72 ! ! ! 16: BEGIN
20960 923 73 ! ! ! ! IF ch>="8" THEN negative:= true;
20970 924 74 ! ! ! ! noofdigit:= 4;
20980 925 75 ! ! ! END;
20990 926 76 ! ! END (*case*);
21000 927 77 ! ! curdigit:= 1;
21010 928 78 ! !
21020 929 79 ! ! WHILE digit AND (incharsleft>0) DO
21030 930 80 ! ! BEGIN
21040 931 81 ! ! ! ch:= readchar;
21050 932 82 ! ! ! digit:= (ch IN digits) OR
21060 933 83 ! ! ! ((base=16) AND (ch IN hexdigits));
21070 934 84 ! ! ! IF digit
21080 935 85 ! ! ! THEN BEGIN
21090 936 86 ! ! ! ! curdigit:= curdigit+1;
21100 937 87 ! ! ! ! IF (curdigit=noofdigit) AND negative THEN
21110 938 88 ! ! ! ! BEGIN
21120 939 89 ! ! ! ! ! CASE base OF
21130 940 90 ! ! ! ! ! ! 2: result:= result - 16384 (*2^14*);
21140 941 91 ! ! ! ! ! ! 8: result:= result - 4096 (*2^12*);
21150 942 92 ! ! ! ! ! ! 16:result:= result - 2048 (*2^11*);
21160 943 93 ! ! ! ! ! END (*case*)
21170 944 94 ! ! ! ! END;
21180 945 95 ! ! ! ! IF ch IN digits THEN
21190 946 96 ! ! ! ! result:= result*base + (ord(ch)-ord("0"))
21200 947 97 ! ! ! ! ELSE
21210 948 98 ! ! ! ! result:= result*base + (ord(ch)-87 (*ord("W")*));
21220 949 99 ! ! ! ! IF (curdigit=noofdigit) AND negative
21230 950 100 ! ! ! ! THEN BEGIN
21240 951 101 ! ! ! ! ! IF result=0
21250 952 102 ! ! ! ! ! THEN result:= -32768
21260 953 103 ! ! ! ! ! ELSE result:= -((32767-result)+1);
21270 954 104 ! ! ! ! END;
21280 955 105 ! ! ! END (*if digit*);
21290 956 106 ! ! END (*while digit*);
21300 957 107 ! END (* base= 2, 8, or 16 *);
21310 958 108 ! IF incharsleft > 0 THEN
21320 959 109 ! (* we read one char too many - spit it out *)
21330 960 110 ! repeatchar;
21340 961 111 !
21350 962 112 ! readinteger:=result;
21360 963 113 END (* read integer *);
21370 964
\f
paposlst 81.06.19. 11.35. page 30
22010 965 PROCEDURE repeatchar;
22020 966 BEGIN
22030 967 1 ! LOCK opinref AS opbuf: opbuftype DO
22040 968 2 ! opbuf.next:= opbuf.next - 1;
22050 969 3 ! incharsleft:= incharsleft + 1;
22060 970 4 END;
22070 971
\f
paposlst 81.06.19. 11.35. page 31
23010 972 FUNCTION testinterval (i,first,last: integer): boolean;
23020 973 (* true if first<=i<=last *)
23030 974 BEGIN
23040 975 1 ! IF (i<first) OR (i>last) THEN
23050 976 2 ! BEGIN
23060 977 3 ! ! outstring10(illegalno);
23070 978 4 ! ! outinteger(i,4);
23080 979 5 ! ! writenl;
23090 980 6 ! ! testinterval:= false
23100 981 7 ! END
23110 982 8 ! ELSE
23120 983 9 ! testinterval:= true;
23130 984 10 END;
23140 985
\f
paposlst 81.06.19. 11.35. page 32
24010 986 PROCEDURE testmodeout (text: alfa20; i: integer);
24020 987 BEGIN
24030 988 1 ! IF testmode THEN
24040 989 2 ! BEGIN
24050 990 3 ! ! outstring20 (text);
24060 991 4 ! ! outinteger (i, 4);
24070 992 5 ! ! writenl;
24080 993 6 ! END;
24090 994 7 END (* testout *);
24100 995
\f
paposlst 81.06.19. 11.35. page 33
25010 996 PROCEDURE testsem(i: integer);
25020 997 (* test the semaphore "sem( semno)", and
25030 998 writes its status on the console if it is
25040 999 non-passive *)
25050 1000 VAR more: boolean;
25060 1001 BEGIN
25070 1002 1 !
25080 1003 2 ! ap.a := sem(i).s;
25090 1004 3 ! bp.a := sem(i).w;
25100 1005 4 ! IF open (ts_sem(i)) THEN
25110 1006 5 ! BEGIN (* user semaphore no. i is open *)
25120 1007 6 ! ! IF ap=bp THEN
25130 1008 7 ! ! outchar(" ") ELSE outchar("^");
25140 1009 8 ! ! outdecimal(i,3);
25150 1010 9 ! ! outchar(":");
25160 1011 10 ! ! more:= true;
25170 1012 11 ! !
25180 1013 12 ! ! (* now count the no. of buffers on this semaphore *)
25190 1014 13 ! ! j:=0; (* j is the counter *)
25200 1015 14 ! ! WHILE more DO
25210 1016 15 ! ! BEGIN
25220 1017 16 ! ! ! sensesem(countref, ts_sem(i));
25230 1018 17 ! ! ! IF nil(countref) THEN
25240 1019 18 ! ! ! more:= false
25250 1020 19 ! ! ! ELSE
25260 1021 20 ! ! ! BEGIN
25270 1022 21 ! ! ! ! signal(countref,countsem);
25280 1023 22 ! ! ! ! j:=j+1;
25290 1024 23 ! ! ! END
25300 1025 24 ! ! END;
25310 1026 25 ! !
25320 1027 26 ! ! outdecimal(j,3);
25330 1028 27 ! ! WHILE open(countsem) DO
25340 1029 28 ! ! BEGIN (* return the buffers to sem(i) *)
25350 1030 29 ! ! ! wait(countref,countsem);
25360 1031 30 ! ! ! signal(countref, ts_sem(i));
25370 1032 31 ! ! END;
25380 1033 32 ! !
25390 1034 33 ! ! writenl;
25400 1035 34 ! END (* open *)
25410 1036 35 ! ELSE
25420 1037 36 ! IF locked( ts_sem(i)) THEN
25430 1038 37 ! BEGIN (* user semaphore no. i is locked *)
25440 1039 38 ! ! IF ap=bp THEN
25450 1040 39 ! ! outchar(" ") ELSE outchar("^");
25460 1041 40 ! ! outdecimal(i,3);
\f
paposlst 81.06.19. 11.35. page 34
25470 1042 41 ! ! outchar(":");
25480 1043 42 ! ! outstring10(" locked ");
25490 1044 43 ! ! writenl;
25500 1045 44 ! END;
25510 1046 45 END (* testsem *);
25520 1047
25530 1048
25540 1049
25550 1050
25560 1051
\f
paposlst 81.06.19. 11.35. page 35
26010 1052 PROCEDURE writenl;
26020 1053 (* prepares opbuf for output to the operator and signals
26030 1054 it to operator module *)
26040 1055 BEGIN
26050 1056 1 ! IF NOT nil(opoutref) THEN
26060 1057 2 ! BEGIN
26070 1058 3 ! ! outchar(nl);
26080 1059 4 ! ! signal(opoutref, opsem^)
26090 1060 5 ! END;
26100 1061 6 ! wait(opoutref, wsem);
26110 1062 7 ! LOCK opoutref AS opbuf: opbuftype DO
26120 1063 8 ! opbuf.last:= firstindex;
26130 1064 9 END (* writenl *);
26140 1065
26150 1066
\f
paposlst 81.06.19. 11.35. page 36
27010 1067
27020 1068
27030 1069
27040 1070 (****************************************
27050 1071 * *
27060 1072 * m a i n p r o g r a m *
27070 1073 * *
27080 1074 ****************************************)
27090 1075
27100 1076
27110 1077
27120 1078
27130 1079
27140 1080
27150 1081 BEGIN
27160 1082 1 !
27170 1083 2 ! opsem:= semvector(operatorsem);
27180 1084 3 ! testmode:= false;
27190 1085 4 ! testopen(z,own.incname,opsem);
27200 1086 5 ! testout(z,version,0);
27210 1087 6 !
27220 1088 7 ! readram( node_no, 10);
27230 1089 8 ! node_no := node_no MOD 16;
27240 1090 9 ! ownadr(1) := node_no;
27250 1091 10 !
27260 1092 11 ! testout(z,"int-pax-node", node_no);
27270 1093 12 !
27280 1094 13 ! (* initialise pointers *)
27290 1095 14 ! FOR i:=1 TO ts_sem_total DO
27300 1096 15 ! BEGIN
27310 1097 16 ! ! sem(i).s:= ref(ts_sem(i));
27320 1098 17 ! ! sem(i).w:= sem(i).s;
27330 1099 18 ! END;
27340 1100 19 !
27350 1101 20 ! (* initialize pointers to eva semaphores *)
27360 1102 21 ! sem(11).s:= ref(evavector(px_urec1));
27370 1103 22 ! sem(11).w:= sem(11).s;
27380 1104 23 ! sem(12).s:= ref(evavector(px_utrm1));
27390 1105 24 ! sem(12).w:= sem(12).s;
27400 1106 25 ! sem(1).s:= ref(evavector(px_ncp));
27410 1107 26 ! sem(1).w:= sem(1).s;
27420 1108 27 ! sem(26).s := ref(evavector(al_lam1));
27430 1109 28 ! sem(26).w := sem(26).s;
27440 1110 29 !
27450 1111 30 ! init_rout_semp;
27460 1112 31 !
\f
paposlst 81.06.19. 11.35. page 37
27470 1113 32 ! (* initialise buffers *)
27480 1114 33 ! alloc(opoutref,consprotpool,wsem); (****** jli ****)
27490 1115 34 ! signal(opoutref,consoleprot); (****** jli ******)
27500 1116 35 ! FOR i:= 1 TO 2 DO
27510 1117 36 ! BEGIN
27520 1118 37 ! ! alloc (opoutref, opbufpool, wsem);
27530 1119 38 ! ! opoutref^.u1:=2; (* write *)
27540 1120 39 ! ! LOCK opoutref AS opbuf: opbuftype DO
27550 1121 40 ! ! WITH opbuf DO
27560 1122 41 ! ! BEGIN
27570 1123 42 ! ! ! first:= firstindex;
27580 1124 43 ! ! ! name:= "pax ";
27590 1125 44 ! ! ! data(firstindex):= "!";
27600 1126 45 ! ! END;
27610 1127 46 ! ! return (opoutref);
27620 1128 47 ! END;
27630 1129 48 ! writenl;
27640 1130 49 !
27650 1131 50 ! alloc(opinref, opbufpool, wrsem);
27660 1132 51 !
27670 1133 52 ! opinref^.u1:=1; (* read *)
27680 1134 53 !
27690 1135 54 ! LOCK opinref AS opbuf: opbuftype DO
27700 1136 55 ! WITH opbuf DO
27710 1137 56 ! BEGIN
27720 1138 57 ! ! first:= firstindex;
27730 1139 58 ! ! last:= lastindex;
27740 1140 59 ! ! name:= "pax ";
27750 1141 60 ! END;
27760 1142 61 !
27770 1143 62 ! <*
27780 1144 63 ! FOR i:= 1 TO no_listen DO
27790 1145 64 ! BEGIN
27800 1146 65 ! alloc(cur,messbufpool,sem(com_pool).s^);
27810 1147 66 ! return(cur);
27820 1148 67 ! END;
27830 1149 68 ! *>
27840 1150 69 ! st:= 1024;
27850 1151 70 ! base:= 10;
27860 1152 71 ! firstword:= 1;
27870 1153 72 ! lastword:= 10;
27880 1154 73 !
27890 1155 74 !
27900 1156 75 ! (* insert auto create with edit here *)
27910 1157 76 ! init_modul(1);
27920 1158 77 ! init_modul(2);
\f
paposlst 81.06.19. 11.35. page 38
27930 1159 78 ! init_modul(4);
27940 1160 79 ! init_modul(6);
27950 1161 80 !
27960 1162 81 ! REPEAT
27970 1163 82 ! ! (* read a line of input from the operator and execute it *)
27980 1164 83 ! !
27990 1165 84 ! ! getinput;
28000 1166 85 ! !
28010 1167 86 ! ! CASE command OF
28020 1168 87 ! ! !
28030 1169 88 ! ! ! ";": (* comment command *)
28040 1170 89 ! ! ! BEGIN
28050 1171 90 ! ! ! END;
28060 1172 91 ! ! !
\f
paposlst 81.06.19. 11.35. page 39
29010 1173 92 ! ! ! "b": (* base *)
29020 1174 93 ! ! ! (* defines the number base for input as well as output *)
29030 1175 94 ! ! ! (* the base is always read decimally *)
29040 1176 95 ! ! ! BEGIN
29050 1177 96 ! ! ! ! IF noofparams < 1 THEN
29060 1178 97 ! ! ! ! BEGIN
29070 1179 98 ! ! ! ! ! base:= oldbase;
29080 1180 99 ! ! ! ! ! outstring10(noparam)
29090 1181 100 ! ! ! ! END
29100 1182 101 ! ! ! ! ELSE
29110 1183 102 ! ! ! !
29120 1184 103 ! ! ! ! IF NOT (params(1) IN (. 2, 8, 10, 16 .) ) THEN
29130 1185 104 ! ! ! ! BEGIN (* illegal base *)
29140 1186 105 ! ! ! ! ! outstring20("illegal base ");
29150 1187 106 ! ! ! ! ! base:= oldbase;
29160 1188 107 ! ! ! ! END
29170 1189 108 ! ! ! ! ELSE
29180 1190 109 ! ! ! ! base:= params(1);
29190 1191 110 ! ! ! END;
29200 1192 111 ! ! !
\f
paposlst 81.06.19. 11.35. page 40
30010 1193 112 ! ! ! "f": (* fill *)
30020 1194 113 ! ! ! (* fills integers into current buffer.
30030 1195 114 ! ! ! 1st param: first word no. to be filled,
30040 1196 115 ! ! ! following: values to be assigned *)
30050 1197 116 ! ! ! BEGIN
30060 1198 117 ! ! ! ! IF noofparams < 2 THEN
30070 1199 118 ! ! ! ! outstring10("param ")
30080 1200 119 ! ! ! ! ELSE
30090 1201 120 ! ! ! ! IF (params(1) < 1) THEN
30100 1202 121 ! ! ! ! outstring20("illegal start ")
30110 1203 122 ! ! ! ! ELSE
30120 1204 123 ! ! ! ! IF nil(cur) THEN
30130 1205 124 ! ! ! ! outstring10("no buffer ")
30140 1206 125 ! ! ! ! ELSE
30150 1207 126 ! ! ! ! BEGIN (* params are ok *)
30160 1208 127 ! ! ! ! ! i:= params(1); (* i points into the messbuf *)
30170 1209 128 ! ! ! ! !
30180 1210 129 ! ! ! ! ! FOR j:= 2 TO noofparams DO
30190 1211 130 ! ! ! ! ! (* j points into the param list *)
30200 1212 131 ! ! ! ! ! IF i <= messbufsize THEN
30210 1213 132 ! ! ! ! ! BEGIN
30220 1214 133 ! ! ! ! ! ! LOCK cur AS messbuf: messbuftype DO
30230 1215 134 ! ! ! ! ! ! messbuf(i):= params(j);
30240 1216 135 ! ! ! ! ! ! i:= i + 1;
30250 1217 136 ! ! ! ! ! END;
30260 1218 137 ! ! ! ! !
30270 1219 138 ! ! ! ! END (* params ok *)
30280 1220 139 ! ! ! END (* fill *);
30290 1221 140 ! ! !
\f
paposlst 81.06.19. 11.35. page 41
31010 1222 141 ! ! ! "i": (* initialise pointers *)
31020 1223 142 ! ! ! BEGIN
31030 1224 143 ! ! ! ! IF noofparams=0 THEN
31040 1225 144 ! ! ! ! FOR i:=1 TO noofsemaphores DO sem(i).w:= sem(i).s ELSE
31050 1226 145 ! ! ! ! IF (params(1)>0) AND (params(1)<=noofsemaphores) THEN
31060 1227 146 ! ! ! ! sem(params(1)).w:= sem(params(1)).s ELSE
31070 1228 147 ! ! ! ! outstring10(valparam);
31080 1229 148 ! ! ! ! init_rout_semp;
31090 1230 149 ! ! ! END;
31100 1231 150 ! ! !
\f
paposlst 81.06.19. 11.35. page 42
32010 1232 151 ! ! ! "k": (* kill *)
32020 1233 152 ! ! ! (* removes incarnation of tested module(s)
32030 1234 153 ! ! ! params are nos. of modules to be removed *)
32040 1235 154 ! ! !
32050 1236 155 ! ! ! IF noofparams >= 1 THEN
32060 1237 156 ! ! ! FOR i:= 1 TO noofparams DO
32070 1238 157 ! ! ! BEGIN
32080 1239 158 ! ! ! ! moduleno:= params(i);
32090 1240 159 ! ! ! ! IF (1<=moduleno) AND (moduleno<=noofmodules) THEN
32100 1241 160 ! ! ! ! IF NOT nil(sh(moduleno)) THEN
32110 1242 161 ! ! ! ! remove (sh(moduleno))
32120 1243 162 ! ! ! ! ELSE
32130 1244 163 ! ! ! ! BEGIN
32140 1245 164 ! ! ! ! ! outdecimal (moduleno, 4);
32150 1246 165 ! ! ! ! ! outstring10(" not alive");
32160 1247 166 ! ! ! ! ! writenl;
32170 1248 167 ! ! ! ! END
32180 1249 168 ! ! ! ! ELSE
32190 1250 169 ! ! ! ! BEGIN
32200 1251 170 ! ! ! ! ! outdecimal (moduleno, 4);
32210 1252 171 ! ! ! ! ! outstring10(illegalno);
32220 1253 172 ! ! ! ! ! writenl;
32230 1254 173 ! ! ! ! END
32240 1255 174 ! ! ! END
32250 1256 175 ! ! ! ELSE outstring10("no params ");
32260 1257 176 ! ! !
\f
paposlst 81.06.19. 11.35. page 43
33010 1258 177 ! ! ! "m": (* testmode *)
33020 1259 178 ! ! ! testmode:= NOT testmode;
33030 1260 179 ! ! !
\f
paposlst 81.06.19. 11.35. page 44
34010 1261 180 ! ! ! "o": (* output *)
34020 1262 181 ! ! ! (* outputs current buffer incl. user parameters
34030 1263 182 ! ! ! 1st param is firstword,
34040 1264 183 ! ! ! 2nd param is lastword *)
34050 1265 184 ! ! ! BEGIN
34060 1266 185 ! ! ! ! IF nil(cur) THEN
34070 1267 186 ! ! ! ! outstring10 ("no buffer ")
34080 1268 187 ! ! ! ! ELSE
34090 1269 188 ! ! ! ! BEGIN
34100 1270 189 ! ! ! ! ! outchar("u");
34110 1271 190 ! ! ! ! ! outchar(":");
34120 1272 191 ! ! ! ! !
34130 1273 192 ! ! ! ! ! outinteger(cur^.u1,4);
34140 1274 193 ! ! ! ! ! outinteger(cur^.u2,4);
34150 1275 194 ! ! ! ! ! outinteger(cur^.u3,4);
34160 1276 195 ! ! ! ! ! outinteger(cur^.u4,4);
34170 1277 196 ! ! ! ! ! writenl;
34180 1278 197 ! ! ! ! !
34190 1279 198 ! ! ! ! ! IF (noofparams>=1) AND (params(1)>=1)
34200 1280 199 ! ! ! ! ! AND (params(1)<= messbufsize) THEN
34210 1281 200 ! ! ! ! ! firstword:= params(1);
34220 1282 201 ! ! ! ! !
34230 1283 202 ! ! ! ! ! IF (noofparams>=2) AND (params(2)<=messbufsize) THEN
34240 1284 203 ! ! ! ! ! lastword:= params(2);
34250 1285 204 ! ! ! ! ! IF lastword>messbufsize
34260 1286 205 ! ! ! ! ! THEN lastword:= messbufsize;
34270 1287 206 ! ! ! ! !
34280 1288 207 ! ! ! ! ! IF cur^.size<messbufsize THEN
34290 1289 208 ! ! ! ! ! outstring20("too small buffer ") ELSE
34300 1290 209 ! ! ! ! ! FOR i:= firstword TO lastword DO
34310 1291 210 ! ! ! ! ! BEGIN
34320 1292 211 ! ! ! ! ! ! outdecimal(i,3);
34330 1293 212 ! ! ! ! ! ! outchar(":");
34340 1294 213 ! ! ! ! ! ! LOCK cur AS messbuf: messbuftype DO
34350 1295 214 ! ! ! ! ! ! IF base= 2 THEN
34360 1296 215 ! ! ! ! ! ! outinteger(messbuf(i),17)
34370 1297 216 ! ! ! ! ! ! ELSE
34380 1298 217 ! ! ! ! ! ! outinteger(messbuf(i),7);
34390 1299 218 ! ! ! ! ! ! writenl;
34400 1300 219 ! ! ! ! ! END;
34410 1301 220 ! ! ! ! END (* ok *);
34420 1302 221 ! ! ! END (* output *);
34430 1303 222 ! ! !
\f
paposlst 81.06.19. 11.35. page 45
35010 1304 223 ! ! ! "r": (* return *)
35020 1305 224 ! ! ! (* returns current buffer *)
35030 1306 225 ! ! ! IF nil(cur)
35040 1307 226 ! ! ! THEN outstring10("no buffer ")
35050 1308 227 ! ! ! ELSE return(cur);
35060 1309 228 ! ! !
\f
paposlst 81.06.19. 11.35. page 46
36010 1310 229 ! ! ! "s": (* signal *)
36020 1311 230 ! ! ! (* signals current buffer to one of the predefined semaphores.
36030 1312 231 ! ! ! 1st param is semno *)
36040 1313 232 ! ! ! BEGIN
36050 1314 233 ! ! ! ! semno:= params(1);
36060 1315 234 ! ! ! !
36070 1316 235 ! ! ! ! IF noofparams >= 1 THEN
36080 1317 236 ! ! ! ! IF (1<=semno) AND (semno<=noofsemaphores) THEN
36090 1318 237 ! ! ! ! IF NOT nil(cur) THEN
36100 1319 238 ! ! ! ! signal (cur,sem(semno).s^)
36110 1320 239 ! ! ! ! ELSE outstring10("no buffer ")
36120 1321 240 ! ! ! ! ELSE outstring10(illegalno)
36130 1322 241 ! ! ! ! ELSE outstring10(noparam)
36140 1323 242 ! ! ! END (* signal *);
36150 1324 243 ! ! !
\f
paposlst 81.06.19. 11.35. page 47
37010 1325 244 ! ! ! "t": (* testsem *)
37020 1326 245 ! ! ! (* tests the status of the specified semaphores.
37030 1327 246 ! ! ! if none is specified, the status of all the
37040 1328 247 ! ! ! user semaphores is given.
37050 1329 248 ! ! ! in both cases nothing will be written for a semaphore
37060 1330 249 ! ! ! if it is passive. *)
37070 1331 250 ! ! ! BEGIN
37080 1332 251 ! ! ! ! IF noofparams=0 THEN
37090 1333 252 ! ! ! ! BEGIN (* test all semaphores *)
37100 1334 253 ! ! ! ! !
37110 1335 254 ! ! ! ! ! FOR i:=1 TO noofsemaphores DO
37120 1336 255 ! ! ! ! ! testsem(i)
37130 1337 256 ! ! ! ! END (* test all *)
37140 1338 257 ! ! ! ! ELSE
37150 1339 258 ! ! ! ! BEGIN (* test the specified semaphores *)
37160 1340 259 ! ! ! ! !
37170 1341 260 ! ! ! ! ! FOR i:=1 TO noofparams DO
37180 1342 261 ! ! ! ! ! IF (params(i)<1) OR (params(i)>noofsemaphores) THEN
37190 1343 262 ! ! ! ! ! BEGIN (* illegal no. *)
37200 1344 263 ! ! ! ! ! ! outstring20("illegal no.: ");
37210 1345 264 ! ! ! ! ! ! outdecimal(params(i),3);
37220 1346 265 ! ! ! ! ! ! writenl;
37230 1347 266 ! ! ! ! ! END (* illegal no *)
37240 1348 267 ! ! ! ! ! ELSE
37250 1349 268 ! ! ! ! ! testsem( params(i) );
37260 1350 269 ! ! ! ! END (* test the specified semaphores *)
37270 1351 270 ! ! ! END (* testsem *);
37280 1352 271 ! ! !
37290 1353 272 ! ! !
\f
paposlst 81.06.19. 11.35. page 48
38010 1354 273 ! ! ! "u": (* user parameters *)
38020 1355 274 ! ! ! (* inserts user param into header of current buffer
38030 1356 275 ! ! ! 1st param is u1
38040 1357 276 ! ! ! 2nd param is u2
38050 1358 277 ! ! ! 3rd param is u3
38060 1359 278 ! ! ! 4th param is u4 *)
38070 1360 279 ! ! ! BEGIN
38080 1361 280 ! ! ! ! IF nil(cur)
38090 1362 281 ! ! ! ! THEN outstring10("no buffer ")
38100 1363 282 ! ! ! ! ELSE
38110 1364 283 ! ! ! ! IF noofparams = 0 THEN
38120 1365 284 ! ! ! ! outstring10(noparam)
38130 1366 285 ! ! ! ! ELSE
38140 1367 286 ! ! ! ! WITH cur^ DO
38150 1368 287 ! ! ! ! BEGIN
38160 1369 288 ! ! ! ! ! IF testinterval (params(1),0,255) THEN u1:= params(1);
38170 1370 289 ! ! ! ! ! IF (noofparams>=2) THEN IF testinterval(params(2),0,255) THEN
38180 1371 290 ! ! ! ! ! u2:= params(2);
38190 1372 291 ! ! ! ! ! IF (noofparams>=3) THEN IF testinterval(params(3),0,255) THEN
38200 1373 292 ! ! ! ! ! u3:= params(3);
38210 1374 293 ! ! ! ! ! IF (noofparams>=4) THEN IF testinterval(params(4),0,255) THEN
38220 1375 294 ! ! ! ! ! u4:= params(4);
38230 1376 295 ! ! ! ! END
38240 1377 296 ! ! ! END; (* end user parameters *)
38250 1378 297 ! ! !
38260 1379 298 ! ! !
\f
paposlst 81.06.19. 11.35. page 49
39010 1380 299 ! ! ! "w": (* wait *)
39020 1381 300 ! ! ! (* waits for semaphore semno.
39030 1382 301 ! ! ! 1st param is semno *)
39040 1383 302 ! ! ! BEGIN
39050 1384 303 ! ! ! ! semno:= params(1);
39060 1385 304 ! ! ! !
39070 1386 305 ! ! ! ! IF noofparams >= 1 THEN
39080 1387 306 ! ! ! ! IF nil(cur) THEN
39090 1388 307 ! ! ! ! IF (1<=semno) AND (semno<=noofsemaphores) THEN
39100 1389 308 ! ! ! ! BEGIN
39110 1390 309 ! ! ! ! ! sensesem( cur, sem(semno).w^);
39120 1391 310 ! ! ! ! ! IF nil(cur) THEN
39130 1392 311 ! ! ! ! ! outstring20("semaphore not open ")
39140 1393 312 ! ! ! ! END
39150 1394 313 ! ! ! ! ELSE outstring10(illegalno)
39160 1395 314 ! ! ! ! ELSE outstring20("you already have one")
39170 1396 315 ! ! ! ! ELSE outstring10(noparam)
39180 1397 316 ! ! ! END (* wait *);
39190 1398 317 ! ! !
\f
paposlst 81.06.19. 11.35. page 50
40010 1399 318 ! ! ! "x": (* exchange pointer *)
40020 1400 319 ! ! ! BEGIN
40030 1401 320 ! ! ! ! IF noofparams >= 2 THEN
40040 1402 321 ! ! ! ! IF (params(1)>0) AND (params(1)<=noofsemaphores) THEN
40050 1403 322 ! ! ! ! IF (params(2)>0) AND (params(2)<=noofsemaphores) THEN
40060 1404 323 ! ! ! ! BEGIN
40070 1405 324 ! ! ! ! ! worksem:= sem(params(1)).w;
40080 1406 325 ! ! ! ! ! sem(params(1)).w:= sem(params(2)).w;
40090 1407 326 ! ! ! ! ! sem(params(2)).w:= worksem;
40100 1408 327 ! ! ! ! ! init_rout_semp;
40110 1409 328 ! ! ! ! END
40120 1410 329 ! ! ! ! ELSE outstring10(valparam)
40130 1411 330 ! ! ! ! ELSE outstring10(valparam)
40140 1412 331 ! ! ! ! ELSE outstring10(noparam)
40150 1413 332 ! ! ! END (* exchange pointer *);
40160 1414 333 ! ! !
40170 1415 334 ! ! ! "g": (* start tap
40180 1416 335 ! ! ! 1st parameter is tap incno
40190 1417 336 ! ! ! 2nd parameter is sem. no. to tap *)
40200 1418 337 ! ! ! IF (params(1)<1) OR (params(1)>3) THEN outstring20(illegalparam) ELSE
40210 1419 338 ! ! ! start_tap(params(2),params(1));
40220 1420 339 ! ! !
40230 1421 340 ! ! ! "q": (* stop tap *)
40240 1422 341 ! ! ! (* 1st parameter is tap incno *)
40250 1423 342 ! ! ! IF (params(1)<1) OR (params(1)>3) THEN outstring20(illegalparam) ELSE
40260 1424 343 ! ! ! stop_tap(params(1));
40270 1425 344 ! ! !
40280 1426 345 ! ! !
40290 1427 346 ! ! ! "^": (* pop *)
40300 1428 347 ! ! ! (* pops from current buffer and saves the popped message in chhstack *)
40310 1429 348 ! ! ! IF NOT nil(cur) THEN
40320 1430 349 ! ! ! BEGIN
40330 1431 350 ! ! ! ! pop(chhref, cur);
40340 1432 351 ! ! ! ! push(chhref, chhstack);
40350 1433 352 ! ! ! END
40360 1434 353 ! ! ! ELSE
40370 1435 354 ! ! ! outstring10("no buffer ");
40380 1436 355 ! ! !
40390 1437 356 ! ! ! "_": (* push *)
40400 1438 357 ! ! ! (* pushes the first message in chhstack onto current buffer *)
40410 1439 358 ! ! ! IF NOT nil(chhstack) THEN
40420 1440 359 ! ! ! BEGIN
40430 1441 360 ! ! ! ! pop(chhref, chhstack);
40440 1442 361 ! ! ! ! push(chhref, cur);
40450 1443 362 ! ! ! END
40460 1444 363 ! ! ! ELSE
\f
paposlst 81.06.19. 11.35. page 51
40470 1445 364 ! ! ! outstring10("not popped");
40480 1446 365 ! ! !
40490 1447 366 ! ! !
40500 1448 367 ! ! !
40510 1449 368 ! ! ! OTHERWISE (* error *)
40520 1450 369 ! ! ! outstring20 ("illegal comm. type h");
40530 1451 370 ! ! END (* case *);
40540 1452 371 ! !
40550 1453 372 ! ! IF command<>";" THEN
40560 1454 373 ! ! writenl;
40570 1455 374 ! !
40580 1456 375 ! UNTIL false;
40590 1457 376 !
40600 1458 377 END.
40610 1459
40620 1460
40630 1461
\f
paposlst 81.06.19. 11.35. page 52
0 37* 51* 72* 333 362 388 390 437 480 481 482 485 502 503 511
520 527 533 539 547 556 629* 652 661 671 677 684 696 707 708
708 735 738 743 753 758 759 858 864 866 882 929 951 958 1014
1086 1224 1226 1332 1364 1369 1370 1372 1374 1402 1403
1 38* 50* 57* 59* 69* 70* 72* 75* 76* 87* 100* 101* 102* 116* 142*
143* 152* 153* 315 316 403 406 415 471: 473 498 499 499 500 501
502 503 508 510 516 524 537 537 545 561 606 630* 643 646 660
661 666 671 679 691 693 696 700 701 715 730 734 756 760 762
768 772 787 795 804 820 822 927 936 953 968 969 1023 1090 1095
1106 1107 1107 1116 1133 1152 1157 1177 1184 1190 1201 1201 1208 1216 1225
1226 1226 1227 1227 1236 1237 1240 1279 1279 1279 1280 1281 1314 1316 1317
1335 1341 1342 1369 1369 1384 1386 1388 1402 1402 1405 1406 1418 1418 1418
1419 1423 1423 1423 1424
2 143* 317 318 319 320 333 434 453 473 476: 480 485 493 494: 500
505 508 509 509 545 556 567 681 682 684 685 693 694 696 697
703 704 707 708 714: 740 912: 940: 1116 1119 1158 1184 1198 1210 1283
1283 1284 1295 1370 1370 1371 1401 1403 1403 1406 1407 1419
3 52* 88* 321 322 323 324 473 481 485 485 495 501 510 571 720
733 1009 1027 1041 1292 1345 1372 1372 1373 1418 1423
4 34* 53* 173* 325 326 327 328 441 478 482 485 489: 493: 494 502
511 525 537 579 592 725 726 924 978 991 1159 1245 1251 1273 1274
1275 1276 1374 1374 1375
5 493: 503 512 513 525 545
6 49* 493: 513 554: 721 919 1160
7 560: 566 570 1298
8 500 501 719: 732 917: 941: 1184
9 750
10 75* 182* 396 525 617 648 787 867 880 1088 1151 1153 1184
11 176* 315 565: 1102 1103 1103
12 316 569: 795 1104 1105 1105
15 317 629* 679 691 701 738
16 318 716 724: 863 887 914 922: 933 942: 1089 1184
17 319 1296
19 321
20 35* 76* 89* 183* 322 626* 804
21 323
23 325
24 326
25 327
26 320 324 328 1108 1109 1109
40 29*
50 31* 152* 413 512
80 32* 50*
87 876 899 948
\f
paposlst 81.06.19. 11.35. page 53
120 175*
125 172*
200 181*
255 1369 1370 1372 1374
300 538 546
500 456 557
576 473
600 486
700 526
900 474 485
1024 1150
2048 942
3276 890
4096 941
16384 940
32767 953
32768 892 952
a 80* 1003= 1004=
abs 658
alfa 65* 203* 292* 424* 450* 791*
alfa10 75* 289* 781*
alfa20 76* 295* 307* 799* 986*
alfalength 49*
alloc 1114 1118 1131
alreadyexists <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
42* 432 593
al_lam1 1108
ap 157* 1003 1007 1039
appl_vector 2*
as 365: 371: 603: 816: 967: 1062: 1120: 1135: 1214: 1294:
atbuffer 72*
base 126* 395 396= 409= 419= 616 617= 619= 648 658 659 713 732 863 867
880 887 898 899 911 933 939 946 948 1151= 1179= 1187= 1190= 1295
bdelay1 230*
bdelay2 230*
bit 629*
bits 629* 681= 684= 693= 696= 703 704= 704 707 708= 708 740
boolean 149* 386* 585* 640* 842* 972* 1000*
bp 157* 1004 1007 1039
byte 72* 191* 192* 230* 248*
ch 600* 607 847* 853= 860 861= 862 863 874 875 876 884= 886 887 890
897 898 899 913 918 923 931= 932 933 945 946 948
char 66* 75* 76* 122* 298* 600* 630* 811* 847*
chhref 105* 1431 1432 1441 1442
\f
paposlst 81.06.19. 11.35. page 54
chhstack 106* 1432 1439 1441
chr 658 751 752
cmax 516
comint_prio 244*
command 122* 377= 379 392 407 1167 1453
conn_desc 185* 227* 498 499 500 501 502 503 507 508 509 510 511 512 513
517 524
conn_desc_array <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
185* 227*
consoleprot 98* 238* 242* 455 556 1115
consprotpool 87* 1114
countref 107* 1017 1018 1022 1030 1031
countsem 92* 1022 1028 1030
cparams 499= 500= 501= 502= 503= 508= 509= 510= 511= 512= 513=
create 436 523 536 544
createerror 45* 440
crtap 450* 561 567 571
ctyp 498= 507= 517=
cur 110* 1204 1214: 1266 1273 1274 1275 1276 1288 1294: 1306 1308 1318 1319 1361
1367 1387 1390 1391 1429 1431 1442
curdigit 631* 730= 745 746 751 752 756 760= 760 844* 927= 936= 936 937 949
curpos 632* 733= 734= 741 759= 762= 762
data 66* 607= 819 1125=
digit 842* 854= 862= 864 872 882 886= 888 929 932= 934
digits 630* 646= 658= 665= 671= 746= 751= 752= 774 837* 862 874 886 897 932
945
doesntexist 43*
evavector 2* 1102 1104 1106 1108
external 201* 211* 218* 232* 239* 245* 249*
false 400 410 594 755 851 854 869 893 980 1019 1084 1456
first 62* 374 972* 975 1123= 1138=
firstindex 49* 50* 66* 366 375 1063 1123 1125 1138
firstword 127* 1152= 1281= 1290
formatter_prio <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
244*
getinput 358* 1165
getparams 280* 381 384*
h 633* 738= 740
hexdigits 838* 863 887 933
hh 208*
i 128* 307* 331* 333 333 339 340 341 450* 452 452 453 455 505= 507
508 508 509 510 511 512 513 516= 517 519= 520 521 523= 527 528
532= 533 534 536= 539 540 544= 547 548 633* 646= 646 650= 658 660=
660 661 665 666= 666 669 679= 681 691= 693 701= 703 704 704 772=
774 785* 787= 788 793* 795= 796 802* 804= 805 972* 975 975 978 986*
991 996* 1003 1004 1005 1009 1017 1031 1037 1041 1095= 1097 1097 1098 1098
\f
paposlst 81.06.19. 11.35. page 55
1116= 1208= 1212 1215 1216= 1216 1225= 1225 1225 1237= 1239 1290= 1292 1296 1298
1335= 1336 1341= 1342 1342 1345 1349
illegalno 44* 580 977 1252 1321 1394
illegalparam 46* 1418 1423
incharsleft 129* 374= 822= 822 858 864 882 929 958 969= 969
incname 1085
incno 331* 336 339 340 341 342 348* 350 352 352 353
index 248* 423* 431 436 438 450* 454 460* 469 472 484 555 561 567 571
579
init_modul 460* 1157 1158 1159 1160
init_proc 422* 454 472 484 555
init_rout_semp <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
313* 343 354 1111 1229 1408
int 283* 286* 611* 618 622* 652 658 659= 659 661 671 677 681 682= 682
684 685= 685 693 694= 694 696 697= 697
integer 64* 69* 70* 140* 142* 143* 152* 181* 182* 183* 200* 207* 208* 209* 210*
216* 222* 244* 248* 283* 286* 301* 307* 331* 348* 423* 427* 429* 450* 450*
460* 585* 611* 622* 638* 785* 793* 802* 828* 845* 972* 986* 996*
j 130* 1014= 1023= 1023 1027 1210= 1215
k 131*
last 63* 606= 606 607 972* 975 1063= 1139=
lastchar 847* 852= 860= 868
lastindex 50* 66* 1139
lastword 132* 1153= 1284= 1285 1286= 1290
lcp_ident 216* 222*
ldrv 162* 225* 319= 323= 327= 524
ldrv2 163* 226* 320= 324= 328= 524
leftbyte 133*
link 435 519 532
lock 365: 371: 603: 816: 967: 1062: 1120: 1135: 1214: 1294:
locked 1037
lrec 161* 224* 316= 318= 322= 326= 524
ltrm 160* 223* 315= 317= 321= 325= 524
ltsmarray 160* 161* 162* 163* 223* 224* 225* 226*
m 634* 700= 703 704 705= 707 708 709=
main_sem 205*
max 207*
maxpos 626* 630* 646 650 669 730 745 756 768 772 772
max_hlcon_no 192* 493= 494= 495= 505 516
messbuf 1214: 1215= 1294: 1296 1298
messbufpool 89*
messbufsize 33* 69* 1212 1280 1283 1285 1286 1288
messbuftype 69* 89* 1214 1294
mm 209*
\f
paposlst 81.06.19. 11.35. page 56
moduleno 134* 585* 589 592 1239= 1240 1240 1241 1242 1245 1251
moduleready 585* 589= 594=
more 1000* 1011= 1015 1019=
n 450* 454
n1 462* 472
n11 466* 567
n12 467* 571
n2 463* 484 485
n6 464* 555
n7 465* 561
name 65* 424* 435 436 443 1124= 1140=
ncp 195* 221* 473
ncp_ident 200*
ncp_sem 197* 215*
ncth 241* 556
ncth_sem 243*
negative 640* 652= 663 842* 868= 869= 890 893= 904 913= 918= 923= 937 949
newbase 386* 397= 400= 410= 417
newm 634* 703= 705 707= 709
next 64* 366= 374 375= 819 820= 820 968= 968
nl 1058
node_no 191* 492 499 1088 1089= 1089 1090 1092
none 517
noofdig 635* 716= 721= 726= 730
noofdigit 844* 914= 919= 924= 937 949
noofmodules 35* 153* 1240
noofparams 135* 333 390= 403= 403 404 405 406 413 415= 415 434 478 1177 1198
1210 1224 1236 1237 1279 1283 1316 1332 1341 1364 1370 1372 1374 1386 1401
noofph 53* 57*
noofpos 636* 715= 720= 725= 741
noofsemaphores <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
36* 1225 1226 1317 1335 1342 1388 1402 1403
nooftaps 52* 59* 100* 102* 142* 166*
noparam 41* 1180 1322 1365 1396 1412
nul 852 853
nwadr 179* 231*
nwb_del1 175* 525
nwb_del2 176* 525
nwu_del1 172* 525
nwu_del2 173* 525
ok 51* 369 429* 435= 436= 437 441 445=
oldbase 136* 395= 409 419 616= 619 1179 1187
opbuf 365: 366 371: 372 603: 604 816: 817 967: 968 968 1062: 1063 1120: 1121
1135: 1136
\f
paposlst 81.06.19. 11.35. page 57
opbufpool 88* 1118 1131
opbufsize 32*
opbuftype 60* 88* 365 371 603 816 967 1062 1120 1135
open 1005 1028
operatorsem 455 1083
opinref 108* 365: 367 368 369 371: 816: 967: 1131 1133 1135:
opoutref 109* 603: 1056 1059 1061 1062: 1114 1115 1118 1119 1120: 1127
opsem 114* 204* 236* 367 485 1059 1083= 1085
ord 379 658 751 752 875 875 876 898 898 899 946 946 948
outchar 600* 766 774 788 796 805 1008 1008 1010 1040 1040 1042 1058 1270 1271
1293
outdecimal 283* 441 579 592 611* 1009 1027 1041 1245 1251 1292 1345
outinteger 286* 618 622* 978 991 1273 1274 1275 1276 1296 1298
outstring10 289* 442 580 781* 977 1043 1180 1199 1205 1228 1246 1252 1256 1267 1307
1320 1321 1322 1362 1365 1394 1396 1410 1411 1412 1435 1445
outstring12 292* 443 791*
outstring20 295* 334 337 432 440 566 570 593 799* 990 1186 1202 1289 1344 1392
1395 1418 1423 1450
own 1085
ownaddr 231*
ownadr 179* 525 1090=
p 425* 435 436 445
params 152* 404= 405 453 480= 481= 482= 485 485 485 1184 1190 1201 1208 1215
1226 1226 1227 1227 1239 1279 1280 1281 1283 1284 1314 1342 1342 1345 1349
1369 1369 1370 1371 1372 1373 1374 1375 1384 1402 1402 1403 1403 1405 1406
1406 1407 1418 1418 1419 1419 1423 1423 1424
pax_opsys 1*
pb 85* 537 545
pb_type 57* 85*
ph 217*
ph_type 57* 217*
point_rec 79* 157*
pool 87* 88* 89*
poolh 229*
poolh_sem 214*
poolnnp 229*
pool_handler 213* 532 537 545
pop 1431 1441
positions 283* 286* 611* 618 622* 766 768 769 770= 772
pr 38*
prio 427* 438
proc7ncr 47* 566 570
process 1* 195* 203* 213* 220* 236* 241*
processrec 425*
\f
paposlst 81.06.19. 11.35. page 58
processref 435 445
procname 203*
pu 37* 244*
push 1432 1442
pxtap 236* 455
px_ncp 1106
px_urec1 1102
px_utrm1 1104
readchar 298* 377 811* 819= 861 884 931
readinteger 301* 404 828* 962=
readok 146* 413 851= 877=
readram 248* 1088
ref 339 352 452 1097 1102 1104 1106 1108
reference 111*
remove 1242
repeatchar 304* 960 965*
res 637* 735= 740= 740 743 750 751 752 753 758=
result 248* 845* 866= 875= 876= 890 892= 898= 898 899= 899 904= 904 940= 940
941= 941 942= 942 946= 946 948= 948 951 952= 953= 953 962
return 1127 1308
rightbyte 137*
r_lcp_id 181* 524
r_nnp_ph 183* 545
r_transit_ph 182* 537
s 339= 340= 352= 485 537 545 1003 1097= 1098 1102= 1103 1104= 1105 1106= 1107
1108= 1109 1225 1227 1319
sc_sem 198*
sem 116* 237* 315 316 317 318 319 320 321 322 323 324 325 326 327
328 339 340 352 473 473 473 485 524 525 525 525 537 537 545
545 556 1003 1004 1097 1098 1098 1102 1103 1103 1104 1105 1105 1106 1107
1107 1108 1109 1109 1225 1225 1227 1227 1319 1390 1405 1406 1406 1407
semaphore 97* 98* 100* 101* 204* 205* 214* 215* 238* 242* 243*
semno 138* 1314= 1317 1317 1319 1384= 1388 1388 1390
sempointer 80* 114* 115* 236*
semvector 1* 455 473 524 537 545 556 1083
sensesem 1017 1390
sh 153* 431 436 438 566 570 589 1241 1242
shadow 153* 187* 188* 189*
sh_poolh 188* 538 542
sh_poolnnp 189* 546 550
sh_routsupv 187* 526 530
signal 367 1022 1031 1059 1115 1319
signs 839*
simsignal 143*
\f
paposlst 81.06.19. 11.35. page 59
size 426* 434 436 1288
size_listen 31* 33* 34*
sp 646 766
ss 210*
st 139* 434= 1150=
start 438 530 542 550
started 58* 336 342 350
start_tap 331* 453 1419
stdpriority 456 474 486 530 542 550 556 556 557
stopped 58* 166* 353
stop_tap 348* 1424
supervisor 220* 519 524
supv 228*
system_vector <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1* 196* 213* 220* 241*
sysvec 213* 220*
sys_vector 196* 241*
tap_index 142* 341= 352 352
tap_pointer 102* 116* 197* 198* 199* 221* 228* 229* 237*
tap_sem 99* 339 452
tap_semp 102* 340 452 455
tap_state 166* 336 342= 350 353=
tap_state_tp 58* 59*
tap_state_type <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
59* 166* 166*
testbufsize 34* 70*
testbuftype 70*
testinterval 972* 980= 983= 1369 1370 1372 1374
testmode 148* 988 1084= 1259= 1259
testmodeout 307* 362 379 388 405 986*
testopen 1085
testout 521 528 534 540 548 1086 1092
testsem 996* 1336 1349
text 289* 292* 295* 307* 781* 788 791* 796 799* 805 986* 990
ticklength 206*
timeout 203* 485
timeout_sem 199*
true 397 589 736 877 913 918 923 983 1011
ts_sem 101* 352 1005 1017 1031 1037 1097
ts_sem_total 29* 36* 101* 116* 333 1095
typ_hlcon 507
typ_locon 498
u1 1119= 1133= 1273 1369=
u2 369 1274 1371=
\f
paposlst 81.06.19. 11.35. page 60
u3 1275 1373=
u4 1276 1375=
udelay1 230*
udelay2 230*
unlink 445
used 638* 643= 669= 756= 766 769 770
valparam 40* 1228 1410 1411
version 23* 1086
w 340 452= 537 545 556 1004 1098= 1103= 1105= 1107= 1109= 1225= 1227= 1390 1405
1406= 1406 1407=
wait 368 1030 1061
worksem 115* 1405= 1407
writenl 310* 444 979 992 1034 1044 1052* 1129 1247 1253 1277 1299 1346 1454
wrsem 95* 368 1131
wsem 93* 1061 1114 1118
z 119* 521 528 534 540 548 1085 1086 1092
zeroes 640* 736= 743 753 755=
zone 119*
\f
paposlst 81.06.19. 11.35. page 61
AND 20
ARRAY 18
BEGIN 108
CASE 6
CONST 6
DIV 7
DO 39
DOWNTO 3
ELSE 61
END 116
FOR 19
FORWARD 11
FUNCTION 6
IF 101
IN 13
MOD 8
NIL 16
NOT 10
OF 26
OR 13
OTHERWISE 3
PROCEDURE 28
RECORD 2
REPEAT 5
THEN 101
TO 16
TYPE 1
UNTIL 5
VAR 37
WHILE 4
WITH 6
\f
oer8 1981.06.19 11.36
81.06.19. 11.36. pascal80 version 1981.04.01
name headline beginline endline appetite(words)
init_rout_se 314 315 329 : 7
start_tap 332 334 346 : 20
stop_tap 349 351 356 : 13
getinput 360 362 382 : 21
getparams 386 388 420 : 25
init_proc 429 432 448 : 28
crtap 451 452 457 : 33
init_modul 462 471 583 : 57
moduleready 588 589 596 : 19
outchar 602 603 609 : 9
outdecimal 615 616 620 : 10
outinteger 626 643 777 : 47
outstring10 785 787 789 : 17
outstring12 793 795 797 : 17
outstring20 802 804 806 : 17
readchar 815 816 823 : 11
readinteger 837 851 963 : 17
repeatchar 966 967 970 : 8
testinterval 974 976 984 : 13
testmodeout 987 989 994 : 18
testsem 1000 1003 1046 : 15
writenl 1055 1057 1064 : 11
pax_opsys 23 1083 1458 : 1153
code: 4 . 2312 = 14312 bytes
end of PASCAL80 compilation
end
blocksread = 53
▶EOF◀