|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 72960 (0x11d00)
Types: TextFileVerbose
Names: »tsdoslst«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »tsdoslst«
\f
tsdoslst 81.03.23. 13.45. page 1
10 1
20 2
30 3
40 4 PROCESS tsopsys(VAR semvector: system_vector);
50 5
60 6 (***************************************************
70 7 *
80 8 * function: the test module is used to initialise buffers,
90 9 * signal them to semaphores, and to write their
100 10 * contents, when they have been handled by another
110 11 *
120 12 * externals: none
130 13 *
140 14 * var params: none
150 15 *
160 16 * semaphores: the module sends to the system semaphore
170 17 * "operatorsem".
180 18 *
190 19 *
200 20 * programmed may 1980 by wib and stb
210 21 *
220 22 ***************************************************)
230 23
240 24 CONST
250 25 version = "vers 4.16 /";
260 26
270 27
280 28
\f
tsdoslst 81.03.23. 13.45. page 2
1010 29 CONST
1020 30 opbufsize = 80; (* no. of bytes in buffers to the operator module *)
1030 31 (*** bufs ***)
1040 32 messbufsize= size_listen; (*words*)
1050 33 testbufsize= size_listen*5;
1060 34 maxbufsize= size_listen*3;
1070 35 minbufsize= 1;
1080 36 noofmodules= 16;
1090 37 noofsemaphores= ts_sem_total;
1100 38 pu= 0; (* processing unit number *)
1110 39 pr= -1; (* timeslicing priority *)
1120 40
1130 41 valparam= "param val ";
1140 42 noparam= " no param ";
1150 43 alreadyexists= " already exists ";
1160 44 doesntexist= " doesn't exist ";
1170 45 illegalno= "illegal no";
1180 46 createerror= "error in createcall ";
1190 47
1200 48 linelength= 80;
1210 49 firstindex= 6 + alfalength;
1220 50 lastindex= firstindex + (linelength - 1);
1230 51 ok= 0; (* result from operator *)
1240 52
1250 53
1260 54 TYPE
1270 55 opbuftype=
1280 56 RECORD
1290 57 ! first,
1300 58 ! last,
1310 59 ! next: integer;
1320 60 ! name: alfa;
1330 61 ! data: ARRAY (firstindex..lastindex) OF char
1340 62 END;
1350 63
1360 64 (*** bufs ***)
1370 65 messbuftype= ARRAY (1..messbufsize) OF integer;
1380 66 testbuftype= ARRAY (1..testbufsize) OF integer;
1390 67 minbuftype = ARRAY (1.. minbufsize) OF integer;
1400 68 maxbuftype = ARRAY (1.. maxbufsize) OF integer;
1410 69
1420 70 createchtype=
1430 71 RECORD
1440 72 ! controlinfo, timeout: byte
1450 73 END;
1460 74
\f
tsdoslst 81.03.23. 13.45. page 3
1470 75 atbuffer= ARRAY (0..1) OF byte;
1480 76
1490 77
1500 78 alfa10= ARRAY (1..10) OF char;
1510 79 alfa20= ARRAY (1..20) OF char;
1520 80
1530 81 (* type necessary to compare sempointers *)
1540 82 point_rec = RECORD
1550 83 ! a: sempointer;
1560 84 END;
1570 85
1580 86 VAR
1590 87 (********* pools *********)
1600 88 opbufpool: pool 3 OF opbuftype;
1610 89 (*** bufs ***)
1620 90 messbufpool: pool no_listen OF messbuftype;
1630 91
1640 92 (********** semaphores **********)
1650 93 countsem, (* used by "t"-command *)
1660 94 wsem, (* buffers written by the operatormodule is
1670 95 returned here *)
1680 96 wrsem (* buffers with content read by the operator
1690 97 module is returned here *)
1700 98 : semaphore;
1710 99 ts_sem : ARRAY (1..ts_sem_total) OF semaphore;
1720 100
1730 101 (********** references **********)
1740 102 countref, (* used by "t"-command *)
1750 103 opinref, (* ref. to buffer from operator *)
1760 104 opoutref, (* ref. to buffer to operator *)
1770 105 cur (* ref. to current buffer *)
1780 106 : reference;
1790 107
1800 108 (********** pointers **********)
1810 109 opsem: sempointer;
1820 110 worksem: sempointer;
1830 111 sem : ts_pointer_vector;
1840 112
1850 113 (********** zones **********)
1860 114 z: zone;
1870 115
1880 116 (********** char **********)
1890 117 command: char; (* the first char the operator typed *)
1900 118
1910 119
1920 120 (********** integers **********)
\f
tsdoslst 81.03.23. 13.45. page 4
1930 121 base, (* number base for input and output *)
1940 122 firstword, (* used by "o"-command *)
1950 123 i,
1960 124 incharsleft, (* no. of not yet read chars in opinbuffer *)
1970 125 j,
1980 126 k,
1990 127 lastword, (* used by "o"-command *)
2000 128 leftbyte, (* used by "p"-command *)
2010 129 moduleno, (* tested module *)
2020 130 noofparams, (* no. of params in operator line *)
2030 131 oldbase, (* used by the "b" command *)
2040 132 rightbyte, (* used by "p"-command *)
2050 133 semno, (* typed semaphore number *)
2060 134 curbufsize, (* in words *)
2070 135 curbuftype, (* 0 - 4 *)
2080 136 st (* storage requirements *)
2090 137 : integer;
2100 138
2110 139 (********** booleans **********)
2120 140 readok, (* indicates if the last call of readinteger
2130 141 yielded a result *)
2140 142 testmode
2150 143 : boolean;
2160 144
2170 145 (********** arrays **********)
2180 146 params: ARRAY(1..50) OF integer; (* holds parameters from operator *)
2190 147 sh: ARRAY(1..noofmodules) OF shadow; (* ref. to process incarn. *)
2200 148
2210 149 (********** param to use in create **********)
2220 150 dc_addr: macroaddr := macroaddr(7,0,0);
2230 151 nc_addr: macroaddr := macroaddr(7,5,0);
2240 152 ts_addr: macroaddr := macroaddr(7,5,4);
2250 153
2260 154 (*** auxiliary to compare sempointers ***)
2270 155 ap,bp : point_rec;
2280 156
\f
tsdoslst 81.03.23. 13.45. page 5
3010 157 (********** externals **********)
3020 158 PROCESS tssuper(
3030 159 op: sempointer;
3040 160 VAR ts_sem : !ts_pointer_vector);
3050 161 EXTERNAL;
3060 162
3070 163 PROCESS vagt(
3080 164 opsem: sempointer;
3090 165 VAR sem: !ts_pointer_vector);
3100 166 EXTERNAL;
3110 167
3120 168 PROCESS dcmodule(
3130 169 opsem: sempointer;
3140 170 VAR sem1,sem2,sem3,sem4: !sempointer;
3150 171 VAR sem5,sem6,sem7,sem8: !ts_pointer);
3160 172 EXTERNAL;
3170 173
3180 174 PROCESS tap(
3190 175 opsem: sempointer;
3200 176 VAR tab_sem: !ts_pointer);
3210 177 EXTERNAL;
3220 178
3230 179 PROCESS ncsup(
3240 180 opsem: sempointer;
3250 181 VAR
3260 182 main,
3270 183 free,
3280 184 done: !ts_pointer;
3290 185 VAR
3300 186 net_sem,
3310 187 timeoutsem: !sempointer);
3320 188 EXTERNAL;
3330 189
3340 190 PROCEDURE setoflowmask( oflow: boolean);
3350 191 EXTERNAL;
3360 192
3370 193
3380 194 (********** forwards **********)
3390 195
3400 196 PROCEDURE getparams;
3410 197 FORWARD;
3420 198
3430 199 PROCEDURE outdecimal(int,positions: integer);
3440 200 FORWARD;
3450 201
3460 202 PROCEDURE outinteger(int,positions: integer);
\f
tsdoslst 81.03.23. 13.45. page 6
3470 203 FORWARD;
3480 204
3490 205 PROCEDURE outstring10(text: alfa10);
3500 206 FORWARD;
3510 207
3520 208 PROCEDURE outstring12(text: alfa);
3530 209 FORWARD;
3540 210
3550 211 PROCEDURE outstring20(text: alfa20);
3560 212 FORWARD;
3570 213
3580 214 FUNCTION readchar: char;
3590 215 FORWARD;
3600 216
3610 217 FUNCTION readinteger: integer;
3620 218 FORWARD;
3630 219
3640 220 PROCEDURE repeatchar;
3650 221 FORWARD;
3660 222
3670 223 PROCEDURE testmodeout (text: alfa20; i: integer);
3680 224 FORWARD;
3690 225
3700 226 PROCEDURE writenl;
3710 227 FORWARD;
3720 228
\f
tsdoslst 81.03.23. 13.45. page 7
4010 229 PROCEDURE get_curbuftype;
4020 230 BEGIN
4030 231 1 ! IF cur^.size < minbufsize THEN
4040 232 2 ! curbuftype:= 0 ELSE
4050 233 3 ! IF cur^.size < messbufsize THEN
4060 234 4 ! curbuftype:= 1 ELSE
4070 235 5 ! IF cur^.size < maxbufsize THEN
4080 236 6 ! curbuftype:= 2 ELSE
4090 237 7 ! IF cur^.size < testbufsize THEN
4100 238 8 ! curbuftype:= 3 ELSE
4110 239 9 ! curbuftype:= 4;
4120 240 10 !
4130 241 11 ! CASE curbuftype OF
4140 242 12 ! ! 0: curbufsize:= 0;
4150 243 13 ! ! 1: curbufsize:= minbufsize;
4160 244 14 ! ! 2: curbufsize:= messbufsize;
4170 245 15 ! ! 3: curbufsize:= maxbufsize;
4180 246 16 ! ! 4: curbufsize:= testbufsize;
4190 247 17 ! END;
4200 248 18 END;
4210 249
\f
tsdoslst 81.03.23. 13.45. page 8
5010 250 PROCEDURE getinput;
5020 251 (* reads input from console into opinref^ *)
5030 252 BEGIN
5040 253 1 !
5050 254 2 ! testmodeout ("getinput called ",0);
5060 255 3 !
5070 256 4 ! REPEAT
5080 257 5 ! ! LOCK opinref AS opbuf: opbuftype DO
5090 258 6 ! ! opbuf.next:= firstindex;
5100 259 7 ! ! signal (opinref, opsem^);
5110 260 8 ! ! wait (opinref, wrsem);
5120 261 9 ! UNTIL opinref^.u2= ok (* 0*);
5130 262 10 !
5140 263 11 ! LOCK opinref AS opbuf: opbuftype DO
5150 264 12 ! WITH opbuf DO
5160 265 13 ! BEGIN
5170 266 14 ! ! incharsleft:= next - first;
5180 267 15 ! ! next:= firstindex;
5190 268 16 ! END;
5200 269 17 ! command:= readchar;
5210 270 18 !
5220 271 19 ! testmodeout ("command read: ",ord(command));
5230 272 20 !
5240 273 21 ! getparams;
5250 274 22 END (* getinput *);
5260 275
\f
tsdoslst 81.03.23. 13.45. page 9
6010 276 PROCEDURE getparams;
6020 277 (* reads integer parameters *)
6030 278 VAR newbase: boolean;
6040 279 BEGIN
6050 280 1 ! testmodeout ("getparams called ",0);
6060 281 2 !
6070 282 3 ! noofparams:= 0;
6080 283 4 !
6090 284 5 ! IF command IN (."a","b","c","e","f","k","o","p","s","t","w","x".)
6100 285 6 ! THEN
6110 286 7 ! BEGIN (* change to decimal *)
6120 287 8 ! ! oldbase:= base;
6130 288 9 ! ! base:= 10;
6140 289 10 ! ! newbase:= true;
6150 290 11 ! END
6160 291 12 ! ELSE
6170 292 13 ! newbase:= false;
6180 293 14 !
6190 294 15 ! REPEAT
6200 295 16 ! ! noofparams:= noofparams + 1;
6210 296 17 ! ! params(noofparams):= readinteger;
6220 297 18 ! ! testmodeout ("parameter read: ",params(noofparams));
6230 298 19 ! ! IF (noofparams=1) THEN
6240 299 20 ! ! IF command IN (."f","p".) THEN
6250 300 21 ! ! BEGIN (* change to old *)
6260 301 22 ! ! ! base:= oldbase;
6270 302 23 ! ! ! newbase:= false;
6280 303 24 ! ! END;
6290 304 25 ! !
6300 305 26 ! UNTIL (NOT readok) OR (noofparams= 50);
6310 306 27 !
6320 307 28 ! noofparams:= noofparams - 1;
6330 308 29 !
6340 309 30 ! IF newbase THEN
6350 310 31 ! (* change back to old base *)
6360 311 32 ! base:= oldbase;
6370 312 33 END (* getparams *);
6380 313
\f
tsdoslst 81.03.23. 13.45. page 10
7010 314 PROCEDURE init_proc(
7020 315 index: integer;
7030 316 name,
7040 317 inc_name : alfa;
7050 318 p : processrec;
7060 319 size,
7070 320 prio : integer);
7080 321 VAR
7090 322 okl,
7100 323 ok : integer;
7110 324 BEGIN
7120 325 1 ! IF NOT nil(sh(index)) THEN
7130 326 2 ! outstring20(alreadyexists) ELSE
7140 327 3 ! BEGIN
7150 328 4 ! ! IF noofparams<2 THEN st:= size;
7160 329 5 ! ! okl:= link(name,p.processref^);
7170 330 6 ! ! ok:= create(inc_name,p,sh(index),st);
7180 331 7 ! ! IF ok=0 THEN
7190 332 8 ! ! start(sh(index),prio) ELSE
7200 333 9 ! ! BEGIN
7210 334 10 ! ! ! ok:= ok*100+okl;
7220 335 11 ! ! ! outstring20(createerror);
7230 336 12 ! ! ! outstring12(inc_name);
7240 337 13 ! ! ! outdecimal(ok,5);
7250 338 14 ! ! ! writenl;
7260 339 15 ! ! ! okl:= unlink(p.processref^);
7270 340 16 ! ! END;
7280 341 17 ! END;
7290 342 18 END;
7300 343
\f
tsdoslst 81.03.23. 13.45. page 11
8010 344 PROCEDURE init_modul(index: integer);
8020 345 CONST
8030 346 n1 = "tssupervisor";
8040 347 n8 = "atvagtsim ";
8050 348 n10= "tap ";
8060 349 n11= "dcmodule ";
8070 350 n13= "ncsupervisor";
8080 351 n14= "vcitc ";
8090 352 n15= "itvagtsim ";
8100 353 n16= "alc ";
8110 354 BEGIN
8120 355 1 ! CASE index OF
8130 356 2 ! ! 1: (* tssup *)
8140 357 3 ! ! init_proc(index, n1, n1,
8150 358 4 ! ! tssuper( opsem, sem),
8160 359 5 ! ! tss_size,tss_pri);
8170 360 6 ! ! 8: (* atvagtsim *)
8180 361 7 ! ! init_proc(index, n8, n8,
8190 362 8 ! ! vagt( opsem, sem),
8200 363 9 ! ! vas_size, vc_sim_pri);
8210 364 10 ! ! 10: (* tap *)
8220 365 11 ! ! init_proc(index, n10, n10,
8230 366 12 ! ! tap( opsem, sem(tap_sem_no)),
8240 367 13 ! ! 512, 0);
8250 368 14 ! ! 11: (* dc *)
8260 369 15 ! ! init_proc(index, n11, n11,
8270 370 16 ! ! dcmodule( opsem, sem(lam_sem_no).s, sem(netc_sem_no).s,
8280 371 17 ! ! sem(com_pool).w, sem(timeout_sem_no).s,
8290 372 18 ! ! sem(dc_sem_no), sem(dc_int1), sem(dc_int2), sem(dc_int3)),
8300 373 19 ! ! dc_sim_size, dc_sim_pri);
8310 374 20 ! ! OTHERWISE
8320 375 21 ! ! BEGIN
8330 376 22 ! ! ! outdecimal(index,4);
8340 377 23 ! ! ! outstring10(illegalno);
8350 378 24 ! ! END;
8360 379 25 ! END (* case *)
8370 380 26 END;
8380 381
8390 382
8400 383
\f
tsdoslst 81.03.23. 13.45. page 12
9010 384 PROCEDURE outchar(ch:char);
9020 385 (* writes ch into the output buffer *)
9030 386 BEGIN
9040 387 1 ! LOCK opoutref AS opbuf: opbuftype DO
9050 388 2 ! WITH opbuf DO
9060 389 3 ! BEGIN
9070 390 4 ! ! last:= last + 1;
9080 391 5 ! ! data (last):= ch;
9090 392 6 ! END;
9100 393 7 END (* outchar *);
9110 394
\f
tsdoslst 81.03.23. 13.45. page 13
10010 395 PROCEDURE outdecimal (int, positions: integer);
10020 396 (* writes the integer "int" decimally into opbuf starting
10030 397 at "last", which is updated accordingly *)
10040 398
10050 399 BEGIN
10060 400 1 ! oldbase:= base;
10070 401 2 ! base:= 10;
10080 402 3 ! outinteger(int,positions);
10090 403 4 ! base:= oldbase;
10100 404 5 END (* outdecimal *);
10110 405
\f
tsdoslst 81.03.23. 13.45. page 14
11010 406 PROCEDURE outinteger(int,positions:integer);
11020 407 (* writes the integer "int" into opbuf starting at
11030 408 "last", which is updated accordingly *)
11040 409 CONST
11050 410 maxpos = 20; (* max number of positions in layout *)
11060 411
11070 412 VAR
11080 413 bits: ARRAY(0..15) OF bit;
11090 414 digits:ARRAY(1..maxpos) OF char;
11100 415 curdigit, (* current pos. in digits-array to be filled out *)
11110 416 curpos, (* cur. pos. in the nunber being computed *)
11120 417 h, i,
11130 418 m, newm,
11140 419 noofdig, (* no. of digits in the resulting number *)
11150 420 noofpos, (* no. of pos. from bits-array for one number *)
11160 421 res, (* resulting number *)
11170 422 used: integer;
11180 423
11190 424 negative, zeroes: boolean;
11200 425
11210 426 BEGIN
11220 427 1 ! used:= 1;
11230 428 2 !
11240 429 3 ! (* first we initialise the digits array *)
11250 430 4 ! FOR i:=1 TO maxpos DO digits(i):=sp;
11260 431 5 !
11270 432 6 ! IF base= 10 THEN
11280 433 7 ! BEGIN
11290 434 8 ! ! i:=maxpos;
11300 435 9 ! !
11310 436 10 ! ! negative:= int<0;
11320 437 11 ! !
11330 438 12 ! ! REPEAT
11340 439 13 ! ! ! (* now we unpack the digits backwards and put them
11350 440 14 ! ! ! into the digits array *)
11360 441 15 ! ! !
11370 442 16 ! ! ! digits(i):= chr (abs(int MOD base) + ord("0"));
11380 443 17 ! ! ! int:=int DIV base;
11390 444 18 ! ! ! i:=i-1;
11400 445 19 ! ! UNTIL (i=1) OR (int=0);
11410 446 20 ! !
11420 447 21 ! ! IF negative THEN
11430 448 22 ! ! BEGIN
11440 449 23 ! ! ! digits(i):="-";
11450 450 24 ! ! ! i:=i-1;
11460 451 25 ! ! END;
\f
tsdoslst 81.03.23. 13.45. page 15
11470 452 26 ! !
11480 453 27 ! ! used:=maxpos-i;
11490 454 28 ! !
11500 455 29 ! ! IF int <> 0 THEN digits(1):= "*";
11510 456 30 ! END (* if base= 10 *)
11520 457 31 !
11530 458 32 ! ELSE (* base= 2, 8, or 16 *)
11540 459 33 ! BEGIN
11550 460 34 ! ! (* initialise bits-array *)
11560 461 35 ! ! IF int>=0 THEN
11570 462 36 ! ! BEGIN
11580 463 37 ! ! ! FOR i:= 15 DOWNTO 1 DO
11590 464 38 ! ! ! BEGIN
11600 465 39 ! ! ! ! bits(i):= int MOD 2;
11610 466 40 ! ! ! ! int:= int DIV 2;
11620 467 41 ! ! ! END;
11630 468 42 ! ! ! bits(0):= int MOD 2;
11640 469 43 ! ! ! int:= int DIV 2;
11650 470 44 ! ! END
11660 471 45 ! ! ELSE
11670 472 46 ! ! (* int<0 *)
11680 473 47 ! ! BEGIN
11690 474 48 ! ! ! (* subtract abs(int) from 1111111...1 *)
11700 475 49 ! ! ! FOR i:= 15 DOWNTO 1 DO
11710 476 50 ! ! ! BEGIN
11720 477 51 ! ! ! ! bits(i):= 1+(int MOD 2);
11730 478 52 ! ! ! ! int:= int DIV 2;
11740 479 53 ! ! ! END;
11750 480 54 ! ! ! bits(0):= 1+(int MOD 2);
11760 481 55 ! ! ! int:= int DIV 2;
11770 482 56 ! ! !
11780 483 57 ! ! ! (* add 1 *)
11790 484 58 ! ! ! m:= 1;
11800 485 59 ! ! ! FOR i:= 15 DOWNTO 1 DO
11810 486 60 ! ! ! BEGIN
11820 487 61 ! ! ! ! newm:= (bits(i)+m) DIV 2;
11830 488 62 ! ! ! ! bits(i):= (bits(i)+m) MOD 2;
11840 489 63 ! ! ! ! m:= newm;
11850 490 64 ! ! ! END;
11860 491 65 ! ! ! newm:= (bits(0)+m) DIV 2;
11870 492 66 ! ! ! bits(0):= (bits(0)+m) MOD 2;
11880 493 67 ! ! ! m:= newm;
11890 494 68 ! ! END (*int<0*);
11900 495 69 ! !
11910 496 70 ! ! (* compute digits-array *)
11920 497 71 ! ! CASE base OF
\f
tsdoslst 81.03.23. 13.45. page 16
11930 498 72 ! ! ! 2: BEGIN
11940 499 73 ! ! ! ! noofpos:= 1;
11950 500 74 ! ! ! ! noofdig:= 16;
11960 501 75 ! ! ! END;
11970 502 76 ! ! !
11980 503 77 ! ! ! 8: BEGIN
11990 504 78 ! ! ! ! noofpos:= 3;
12000 505 79 ! ! ! ! noofdig:= 6;
12010 506 80 ! ! ! END;
12020 507 81 ! ! !
12030 508 82 ! ! ! 16: BEGIN
12040 509 83 ! ! ! ! noofpos:= 4;
12050 510 84 ! ! ! ! noofdig:= 4;
12060 511 85 ! ! ! END;
12070 512 86 ! ! END (* case *);
12080 513 87 ! !
12090 514 88 ! ! curdigit:= maxpos -noofdig +1;
12100 515 89 ! !
12110 516 90 ! ! IF base= 8
12120 517 91 ! ! THEN curpos:= 3
12130 518 92 ! ! ELSE curpos:= 1;
12140 519 93 ! ! res:= 0;
12150 520 94 ! ! zeroes:= true;
12160 521 95 ! !
12170 522 96 ! ! FOR h:= 0 TO 15 DO
12180 523 97 ! ! BEGIN
12190 524 98 ! ! ! res:= res*2 + bits(h);
12200 525 99 ! ! ! IF curpos= noofpos THEN
12210 526 100 ! ! ! BEGIN (* time to fill out a pos. in digits-array *)
12220 527 101 ! ! ! ! IF zeroes AND (res=0) THEN
12230 528 102 ! ! ! ! BEGIN
12240 529 103 ! ! ! ! ! IF curdigit=maxpos
12250 530 104 ! ! ! ! ! THEN digits(curdigit):= "0"
12260 531 105 ! ! ! ! ! (*else digits (curdigit):= " "*);
12270 532 106 ! ! ! ! END
12280 533 107 ! ! ! ! ELSE
12290 534 108 ! ! ! ! IF res<=9
12300 535 109 ! ! ! ! THEN digits(curdigit):= chr (res + ord ("0"))
12310 536 110 ! ! ! ! ELSE digits(curdigit):= chr (res + ord ("7"));
12320 537 111 ! ! ! ! IF (res<>0) AND zeroes THEN
12330 538 112 ! ! ! ! BEGIN
12340 539 113 ! ! ! ! ! zeroes:= false;
12350 540 114 ! ! ! ! ! used:= maxpos - curdigit + 1;
12360 541 115 ! ! ! ! END;
12370 542 116 ! ! ! ! res:= 0;
12380 543 117 ! ! ! ! curpos:= 0;
\f
tsdoslst 81.03.23. 13.45. page 17
12390 544 118 ! ! ! ! curdigit:= curdigit + 1;
12400 545 119 ! ! ! END;
12410 546 120 ! ! ! curpos:= curpos + 1;
12420 547 121 ! ! END;
12430 548 122 ! END (* base= 2, 8, of 16 *);
12440 549 123 !
12450 550 124 ! IF positions<used THEN outchar(sp);
12460 551 125 !
12470 552 126 ! IF (NOT (positions IN (. 1 .. maxpos .)) )
12480 553 127 ! OR (positions < used) THEN
12490 554 128 ! positions:=used;
12500 555 129 !
12510 556 130 ! FOR i:=maxpos+1-positions TO maxpos DO
12520 557 131 ! BEGIN
12530 558 132 ! ! outchar( digits(i) );
12540 559 133 ! END
12550 560 134 !
12560 561 135 END (* out integer *);
12570 562
12580 563
12590 564
\f
tsdoslst 81.03.23. 13.45. page 18
13010 565 PROCEDURE outstring10(text: alfa10);
13020 566 (* writes the text into opbuf starting at outputpointer
13030 567 which is updated accordingly *)
13040 568 VAR
13050 569 i: integer;
13060 570 BEGIN
13070 571 1 ! FOR i:=1 TO 10 DO
13080 572 2 ! outchar( text(i) );
13090 573 3 END (* out string 10 *);
13100 574
13110 575 PROCEDURE outstring12(text: alfa);
13120 576 VAR
13130 577 i: integer;
13140 578 BEGIN
13150 579 1 ! FOR i:=1 TO 12 DO
13160 580 2 ! outchar(text(i));
13170 581 3 END;
13180 582
\f
tsdoslst 81.03.23. 13.45. page 19
14010 583 PROCEDURE outstring20(text: alfa20);
14020 584 (* analogue to outstring10 *)
14030 585 VAR
14040 586 i: integer;
14050 587 BEGIN
14060 588 1 ! FOR i:=1 TO 20 DO
14070 589 2 ! outchar( text(i) );
14080 590 3 END (* out string 20 *);
14090 591
14100 592
14110 593
14120 594
\f
tsdoslst 81.03.23. 13.45. page 20
15010 595 FUNCTION readchar: char;
15020 596 (* reads the next char from opinref^.
15030 597 next is incremented and charsleft is
15040 598 decremented *)
15050 599 BEGIN
15060 600 1 ! LOCK opinref AS opbuf: opbuftype DO
15070 601 2 ! WITH opbuf DO
15080 602 3 ! BEGIN
15090 603 4 ! ! readchar:= data(next);
15100 604 5 ! ! next:= next + 1;
15110 605 6 ! END;
15120 606 7 ! incharsleft:=incharsleft-1;
15130 607 8 END (* readchar *);
15140 608
15150 609
15160 610
15170 611
\f
tsdoslst 81.03.23. 13.45. page 21
16010 612 FUNCTION readinteger : integer;
16020 613 (* reads the next integer from opinref^ starting
16030 614 at "inputpoint". upon return "inputpoint" will be
16040 615 the position just after the last char read.
16050 616
16060 617 the global boolean "readok" will be true if an
16070 618 integer was read and false otherwise *)
16080 619
16090 620 CONST
16100 621 digits = (. "0" .. "9" .);
16110 622 hexdigits = (. "a" .. "f" .);
16120 623 signs = (. "+" , "-" .);
16130 624
16140 625 VAR
16150 626 negative, digit: boolean;
16160 627
16170 628 curdigit, noofdigit,
16180 629 result: integer;
16190 630
16200 631 ch,lastchar: char;
16210 632
16220 633
16230 634 BEGIN
16240 635 1 ! readok:=false;
16250 636 2 ! lastchar:=nul;
16260 637 3 ! ch:=nul;
16270 638 4 ! digit:=false;
16280 639 5 !
16290 640 6 ! (* now skip until a digit is encountered *)
16300 641 7 !
16310 642 8 ! IF incharsleft > 0 THEN
16320 643 9 ! REPEAT
16330 644 10 ! ! lastchar:=ch;
16340 645 11 ! ! ch:=readchar;
16350 646 12 ! ! digit:= (ch IN digits) OR
16360 647 13 ! ! ((base= 16) AND (ch IN hexdigits))
16370 648 14 ! UNTIL digit OR (incharsleft<=0);
16380 649 15 !
16390 650 16 ! result:=0;
16400 651 17 ! IF base= 10 THEN
16410 652 18 ! negative:= lastchar= "-"
16420 653 19 ! ELSE negative:= false;
16430 654 20 !
16440 655 21 !
16450 656 22 ! IF digit THEN
16460 657 23 ! BEGIN
\f
tsdoslst 81.03.23. 13.45. page 22
16470 658 24 ! ! IF ch IN digits
16480 659 25 ! ! THEN result:= ord (ch) - ord ("0")
16490 660 26 ! ! ELSE result:= ord (ch) - 87 (*ord ("W")*);
16500 661 27 ! ! readok:=true;
16510 662 28 ! END;
16520 663 29 !
16530 664 30 ! IF base=10 THEN
16540 665 31 ! BEGIN
16550 666 32 ! ! WHILE digit AND (incharsleft>0) DO
16560 667 33 ! ! BEGIN (* read the digits *)
16570 668 34 ! ! ! ch:= readchar;
16580 669 35 ! ! !
16590 670 36 ! ! ! digit:= (ch IN digits) OR
16600 671 37 ! ! ! ((base= 16) AND (ch IN hexdigits));
16610 672 38 ! ! ! IF digit THEN
16620 673 39 ! ! ! BEGIN
16630 674 40 ! ! ! ! IF negative AND (result=3276) AND (ch="8")
16640 675 41 ! ! ! ! THEN BEGIN
16650 676 42 ! ! ! ! ! result:= -32768;
16660 677 43 ! ! ! ! ! negative:= false;
16670 678 44 ! ! ! ! END
16680 679 45 ! ! ! ! ELSE
16690 680 46 ! ! ! ! BEGIN
16700 681 47 ! ! ! ! ! IF ch IN digits
16710 682 48 ! ! ! ! ! THEN result:= result*base+(ord(ch)-ord("0"))
16720 683 49 ! ! ! ! ! ELSE result:= result*base+(ord(ch)-87(*ord("W")*));
16730 684 50 ! ! ! ! END;
16740 685 51 ! ! ! END;
16750 686 52 ! ! END (* while *);
16760 687 53 ! !
16770 688 54 ! ! IF negative THEN result:= - result;
16780 689 55 ! !
16790 690 56 ! END (* base= 10 *)
16800 691 57 !
16810 692 58 ! ELSE
16820 693 59 ! BEGIN (* base= 2, 8, or 16 *)
16830 694 60 ! !
16840 695 61 ! ! CASE base OF
16850 696 62 ! ! ! 2:BEGIN
16860 697 63 ! ! ! ! IF ch="1" THEN negative:= true;
16870 698 64 ! ! ! ! noofdigit:= 16;
16880 699 65 ! ! ! END;
16890 700 66 ! ! !
16900 701 67 ! ! ! 8: BEGIN
16910 702 68 ! ! ! ! IF ch="1" THEN negative:= true;
16920 703 69 ! ! ! ! noofdigit:= 6;
\f
tsdoslst 81.03.23. 13.45. page 23
16930 704 70 ! ! ! END;
16940 705 71 ! ! !
16950 706 72 ! ! ! 16: BEGIN
16960 707 73 ! ! ! ! IF ch>="8" THEN negative:= true;
16970 708 74 ! ! ! ! noofdigit:= 4;
16980 709 75 ! ! ! END;
16990 710 76 ! ! END (*case*);
17000 711 77 ! ! curdigit:= 1;
17010 712 78 ! !
17020 713 79 ! ! WHILE digit AND (incharsleft>0) DO
17030 714 80 ! ! BEGIN
17040 715 81 ! ! ! ch:= readchar;
17050 716 82 ! ! ! digit:= (ch IN digits) OR
17060 717 83 ! ! ! ((base=16) AND (ch IN hexdigits));
17070 718 84 ! ! ! IF digit
17080 719 85 ! ! ! THEN BEGIN
17090 720 86 ! ! ! ! curdigit:= curdigit+1;
17100 721 87 ! ! ! ! IF (curdigit=noofdigit) AND negative THEN
17110 722 88 ! ! ! ! BEGIN
17120 723 89 ! ! ! ! ! CASE base OF
17130 724 90 ! ! ! ! ! ! 2: result:= result - 16384 (*2^14*);
17140 725 91 ! ! ! ! ! ! 8: result:= result - 4096 (*2^12*);
17150 726 92 ! ! ! ! ! ! 16:result:= result - 2048 (*2^11*);
17160 727 93 ! ! ! ! ! END (*case*)
17170 728 94 ! ! ! ! END;
17180 729 95 ! ! ! ! IF ch IN digits THEN
17190 730 96 ! ! ! ! result:= result*base + (ord(ch)-ord("0"))
17200 731 97 ! ! ! ! ELSE
17210 732 98 ! ! ! ! result:= result*base + (ord(ch)-87 (*ord("W")*));
17220 733 99 ! ! ! ! IF (curdigit=noofdigit) AND negative
17230 734 100 ! ! ! ! THEN BEGIN
17240 735 101 ! ! ! ! ! IF result=0
17250 736 102 ! ! ! ! ! THEN result:= -32768
17260 737 103 ! ! ! ! ! ELSE result:= -((32767-result)+1);
17270 738 104 ! ! ! ! END;
17280 739 105 ! ! ! END (*if digit*);
17290 740 106 ! ! END (*while digit*);
17300 741 107 ! END (* base= 2, 8, or 16 *);
17310 742 108 ! IF incharsleft > 0 THEN
17320 743 109 ! (* we read one char too many - spit it out *)
17330 744 110 ! repeatchar;
17340 745 111 !
17350 746 112 ! readinteger:=result;
17360 747 113 END (* read integer *);
17370 748
\f
tsdoslst 81.03.23. 13.45. page 24
18010 749 PROCEDURE repeatchar;
18020 750 BEGIN
18030 751 1 ! LOCK opinref AS opbuf: opbuftype DO
18040 752 2 ! opbuf.next:= opbuf.next - 1;
18050 753 3 ! incharsleft:= incharsleft + 1;
18060 754 4 END;
18070 755
\f
tsdoslst 81.03.23. 13.45. page 25
19010 756 FUNCTION testinterval (i,first,last: integer): boolean;
19020 757 (* true if first<=i<=last *)
19030 758 BEGIN
19040 759 1 ! IF (i<first) OR (i>last) THEN
19050 760 2 ! BEGIN
19060 761 3 ! ! outstring10(illegalno);
19070 762 4 ! ! outinteger(i,4);
19080 763 5 ! ! writenl;
19090 764 6 ! ! testinterval:= false
19100 765 7 ! END
19110 766 8 ! ELSE
19120 767 9 ! testinterval:= true;
19130 768 10 END;
19140 769
\f
tsdoslst 81.03.23. 13.45. page 26
20010 770 PROCEDURE testmodeout (text: alfa20; i: integer);
20020 771 BEGIN
20030 772 1 ! IF testmode THEN
20040 773 2 ! BEGIN
20050 774 3 ! ! outstring20 (text);
20060 775 4 ! ! outinteger (i, 4);
20070 776 5 ! ! writenl;
20080 777 6 ! END;
20090 778 7 END (* testout *);
20100 779
\f
tsdoslst 81.03.23. 13.45. page 27
21010 780 PROCEDURE testsem(i: integer);
21020 781 (* test the semaphore "sem( semno)", and
21030 782 writes its status on the console if it is
21040 783 non-passive *)
21050 784 VAR more: boolean;
21060 785 BEGIN
21070 786 1 !
21080 787 2 ! ap.a := sem(i).s;
21090 788 3 ! bp.a := sem(i).w;
21100 789 4 ! IF open (ts_sem(i)) THEN
21110 790 5 ! BEGIN (* user semaphore no. i is open *)
21120 791 6 ! ! IF ap=bp THEN
21130 792 7 ! ! outchar(" ") ELSE outchar("^");
21140 793 8 ! ! outdecimal(i,3);
21150 794 9 ! ! outchar(":");
21160 795 10 ! ! more:= true;
21170 796 11 ! !
21180 797 12 ! ! (* now count the no. of buffers on this semaphore *)
21190 798 13 ! ! j:=0; (* j is the counter *)
21200 799 14 ! ! WHILE more DO
21210 800 15 ! ! BEGIN
21220 801 16 ! ! ! sensesem(countref, ts_sem(i));
21230 802 17 ! ! ! IF nil(countref) THEN
21240 803 18 ! ! ! more:= false
21250 804 19 ! ! ! ELSE
21260 805 20 ! ! ! BEGIN
21270 806 21 ! ! ! ! signal(countref,countsem);
21280 807 22 ! ! ! ! j:=j+1;
21290 808 23 ! ! ! END
21300 809 24 ! ! END;
21310 810 25 ! !
21320 811 26 ! ! outdecimal(j,3);
21330 812 27 ! ! WHILE open(countsem) DO
21340 813 28 ! ! BEGIN (* return the buffers to sem(i) *)
21350 814 29 ! ! ! wait(countref,countsem);
21360 815 30 ! ! ! signal(countref, ts_sem(i));
21370 816 31 ! ! END;
21380 817 32 ! !
21390 818 33 ! ! writenl;
21400 819 34 ! END (* open *)
21410 820 35 ! ELSE
21420 821 36 ! IF locked( ts_sem(i)) THEN
21430 822 37 ! BEGIN (* user semaphore no. i is locked *)
21440 823 38 ! ! IF ap=bp THEN
21450 824 39 ! ! outchar(" ") ELSE outchar("^");
21460 825 40 ! ! outdecimal(i,3);
\f
tsdoslst 81.03.23. 13.45. page 28
21470 826 41 ! ! outchar(":");
21480 827 42 ! ! outstring10(" locked ");
21490 828 43 ! ! writenl;
21500 829 44 ! END;
21510 830 45 END (* testsem *);
21520 831
21530 832
21540 833
21550 834
21560 835
\f
tsdoslst 81.03.23. 13.45. page 29
22010 836 PROCEDURE writenl;
22020 837 (* prepares opbuf for output to the operator and signals
22030 838 it to operator module *)
22040 839 BEGIN
22050 840 1 ! IF NOT nil(opoutref) THEN
22060 841 2 ! BEGIN
22070 842 3 ! ! outchar(nl);
22080 843 4 ! ! signal(opoutref, opsem^)
22090 844 5 ! END;
22100 845 6 ! wait(opoutref, wsem);
22110 846 7 ! LOCK opoutref AS opbuf: opbuftype DO
22120 847 8 ! opbuf.last:= firstindex;
22130 848 9 END (* writenl *);
22140 849
22150 850
\f
tsdoslst 81.03.23. 13.45. page 30
23010 851
23020 852
23030 853
23040 854 (****************************************
23050 855 * *
23060 856 * m a i n p r o g r a m *
23070 857 * *
23080 858 ****************************************)
23090 859
23100 860
23110 861
23120 862
23130 863
23140 864
23150 865 BEGIN
23160 866 1 !
23170 867 2 ! opsem:= semvector(operatorsem);
23180 868 3 ! testmode:= false;
23190 869 4 ! testopen (z,"demo-opsys ",opsem);
23200 870 5 ! testout(z,version,al_env_version);
23210 871 6 !
23220 872 7 ! (* initialise pointers *)
23230 873 8 ! FOR i:=1 TO ts_sem_total DO
23240 874 9 ! BEGIN
23250 875 10 ! ! sem(i).s:= ref(ts_sem(i));
23260 876 11 ! ! sem(i).w:= sem(i).s;
23270 877 12 ! END;
23280 878 13 !
23290 879 14 ! (* initialise buffers *)
23300 880 15 ! FOR i:= 1 TO 2 DO
23310 881 16 ! BEGIN
23320 882 17 ! ! alloc (opoutref, opbufpool, wsem);
23330 883 18 ! ! opoutref^.u1:=2; (* write *)
23340 884 19 ! ! LOCK opoutref AS opbuf: opbuftype DO
23350 885 20 ! ! WITH opbuf DO
23360 886 21 ! ! BEGIN
23370 887 22 ! ! ! first:= firstindex;
23380 888 23 ! ! ! name:= "demo ";
23390 889 24 ! ! ! data(firstindex):= "!";
23400 890 25 ! ! END;
23410 891 26 ! ! return (opoutref);
23420 892 27 ! END;
23430 893 28 ! writenl;
23440 894 29 !
23450 895 30 ! alloc(opinref, opbufpool, wrsem);
23460 896 31 !
\f
tsdoslst 81.03.23. 13.45. page 31
23470 897 32 ! opinref^.u1:=1; (* read *)
23480 898 33 !
23490 899 34 ! LOCK opinref AS opbuf: opbuftype DO
23500 900 35 ! WITH opbuf DO
23510 901 36 ! BEGIN
23520 902 37 ! ! first:= firstindex;
23530 903 38 ! ! last:= lastindex;
23540 904 39 ! ! name:= "demo ";
23550 905 40 ! END;
23560 906 41 !
23570 907 42 ! FOR i:= 1 TO no_listen DO
23580 908 43 ! BEGIN
23590 909 44 ! ! alloc(cur,messbufpool,sem(com_pool).s^);
23600 910 45 ! ! return(cur);
23610 911 46 ! END;
23620 912 47 ! st:= 1024;
23630 913 48 ! base:= 10;
23640 914 49 ! firstword:= 1;
23650 915 50 ! lastword:= 10;
23660 916 51 !
23670 917 52 ! setoflowmask(true);
23680 918 53 !
23690 919 54 ! noofparams:= 0;
23700 920 55 ! (* insert auto create with edit here *)
23710 921 56 ! init_modul(8);
23720 922 57 ! init_modul(10);
23730 923 58 ! init_modul(11);
23740 924 59 ! init_modul(1);
23750 925 60 !
23760 926 61 ! REPEAT
23770 927 62 ! ! (* read a line of input from the operator and execute it *)
23780 928 63 ! !
23790 929 64 ! ! getinput;
23800 930 65 ! !
23810 931 66 ! ! CASE command OF
23820 932 67 ! ! !
23830 933 68 ! ! ! ";": (* comment command *)
23840 934 69 ! ! ! BEGIN
23850 935 70 ! ! ! END;
23860 936 71 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 32
24010 937 72 ! ! ! "b": (* base *)
24020 938 73 ! ! ! (* defines the number base for input as well as output *)
24030 939 74 ! ! ! (* the base is always read decimally *)
24040 940 75 ! ! ! BEGIN
24050 941 76 ! ! ! ! IF noofparams < 1 THEN
24060 942 77 ! ! ! ! BEGIN
24070 943 78 ! ! ! ! ! base:= oldbase;
24080 944 79 ! ! ! ! ! outstring10(noparam)
24090 945 80 ! ! ! ! END
24100 946 81 ! ! ! ! ELSE
24110 947 82 ! ! ! !
24120 948 83 ! ! ! ! IF NOT (params(1) IN (. 2, 8, 10, 16 .) ) THEN
24130 949 84 ! ! ! ! BEGIN (* illegal base *)
24140 950 85 ! ! ! ! ! outstring20("illegal base ");
24150 951 86 ! ! ! ! ! base:= oldbase;
24160 952 87 ! ! ! ! END
24170 953 88 ! ! ! ! ELSE
24180 954 89 ! ! ! ! base:= params(1);
24190 955 90 ! ! ! END;
24200 956 91 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 33
25010 957 92 ! ! ! "f": (* fill *)
25020 958 93 ! ! ! (* fills integers into current buffer.
25030 959 94 ! ! ! 1st param: first word no. to be filled,
25040 960 95 ! ! ! following: values to be assigned *)
25050 961 96 ! ! ! BEGIN
25060 962 97 ! ! ! ! IF noofparams < 2 THEN
25070 963 98 ! ! ! ! outstring10("param ")
25080 964 99 ! ! ! ! ELSE
25090 965 100 ! ! ! ! IF (params(1) < 1) THEN
25100 966 101 ! ! ! ! outstring20("illegal start ")
25110 967 102 ! ! ! ! ELSE
25120 968 103 ! ! ! ! IF nil(cur) THEN
25130 969 104 ! ! ! ! outstring10("no buffer ")
25140 970 105 ! ! ! ! ELSE
25150 971 106 ! ! ! ! BEGIN (* params are ok *)
25160 972 107 ! ! ! ! ! i:= params(1); (* i points into the messbuf *)
25170 973 108 ! ! ! ! !
25180 974 109 ! ! ! ! ! FOR j:= 2 TO noofparams DO
25190 975 110 ! ! ! ! ! (* j points into the param list *)
25200 976 111 ! ! ! ! ! IF i <= curbufsize THEN
25210 977 112 ! ! ! ! ! BEGIN
25220 978 113 ! ! ! ! ! ! CASE curbuftype OF
25230 979 114 ! ! ! ! ! ! ! 1: LOCK cur AS minbuf: minbuftype DO
25240 980 115 ! ! ! ! ! ! ! minbuf(i):= params(j);
25250 981 116 ! ! ! ! ! ! ! 2: LOCK cur AS messbuf: messbuftype DO
25260 982 117 ! ! ! ! ! ! ! messbuf(i):= params(j);
25270 983 118 ! ! ! ! ! ! ! 3: LOCK cur AS maxbuf: maxbuftype DO
25280 984 119 ! ! ! ! ! ! ! maxbuf(i):= params(j);
25290 985 120 ! ! ! ! ! ! ! 4: LOCK cur AS testbuf: testbuftype DO
25300 986 121 ! ! ! ! ! ! ! testbuf(i):= params(j);
25310 987 122 ! ! ! ! ! ! ! OTHERWISE
25320 988 123 ! ! ! ! ! ! END;
25330 989 124 ! ! ! ! ! ! i:= i + 1;
25340 990 125 ! ! ! ! ! END;
25350 991 126 ! ! ! ! !
25360 992 127 ! ! ! ! END (* params ok *)
25370 993 128 ! ! ! END (* fill *);
25380 994 129 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 34
26010 995 130 ! ! ! "i": (* initialise pointers *)
26020 996 131 ! ! ! IF noofparams=0 THEN
26030 997 132 ! ! ! FOR i:=1 TO noofsemaphores DO sem(i).w:= sem(i).s ELSE
26040 998 133 ! ! ! IF (params(1)>0) AND (params(1)<=noofsemaphores) THEN
26050 999 134 ! ! ! sem(params(1)).w:= sem(params(1)).s ELSE
26060 1000 135 ! ! ! outstring10(valparam);
26070 1001 136 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 35
27010 1002 137 ! ! ! "m": (* testmode *)
27020 1003 138 ! ! ! testmode:= NOT testmode;
27030 1004 139 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 36
28010 1005 140 ! ! ! "o": (* output *)
28020 1006 141 ! ! ! (* outputs current buffer incl. user parameters
28030 1007 142 ! ! ! 1st param is firstword,
28040 1008 143 ! ! ! 2nd param is lastword *)
28050 1009 144 ! ! ! BEGIN
28060 1010 145 ! ! ! ! IF nil(cur) THEN
28070 1011 146 ! ! ! ! outstring10 ("no buffer ")
28080 1012 147 ! ! ! ! ELSE
28090 1013 148 ! ! ! ! BEGIN
28100 1014 149 ! ! ! ! ! outchar("u");
28110 1015 150 ! ! ! ! ! outchar(":");
28120 1016 151 ! ! ! ! !
28130 1017 152 ! ! ! ! ! outinteger(cur^.u1,4);
28140 1018 153 ! ! ! ! ! outinteger(cur^.u2,4);
28150 1019 154 ! ! ! ! ! outinteger(cur^.u3,4);
28160 1020 155 ! ! ! ! ! outinteger(cur^.u4,4);
28170 1021 156 ! ! ! ! ! writenl;
28180 1022 157 ! ! ! ! !
28190 1023 158 ! ! ! ! ! IF (noofparams>=1) AND (params(1)>=1)
28200 1024 159 ! ! ! ! ! AND (params(1)<= curbufsize) THEN
28210 1025 160 ! ! ! ! ! firstword:= params(1);
28220 1026 161 ! ! ! ! !
28230 1027 162 ! ! ! ! ! IF (noofparams>=2) AND (params(2)<=curbufsize) THEN
28240 1028 163 ! ! ! ! ! lastword:= params(2);
28250 1029 164 ! ! ! ! ! IF lastword>curbufsize THEN
28260 1030 165 ! ! ! ! ! lastword:= curbufsize;
28270 1031 166 ! ! ! ! !
28280 1032 167 ! ! ! ! ! IF cur^.size<curbufsize THEN
28290 1033 168 ! ! ! ! ! outstring20("too small buffer ") ELSE
28300 1034 169 ! ! ! ! ! FOR i:= firstword TO lastword DO
28310 1035 170 ! ! ! ! ! BEGIN
28320 1036 171 ! ! ! ! ! ! outdecimal(i,3);
28330 1037 172 ! ! ! ! ! ! outchar(":");
28340 1038 173 ! ! ! ! ! ! CASE curbuftype OF
28350 1039 174 ! ! ! ! ! ! ! 1: LOCK cur AS minbuf: minbuftype DO
28360 1040 175 ! ! ! ! ! ! ! j:= minbuf(i);
28370 1041 176 ! ! ! ! ! ! ! 2: LOCK cur AS messbuf: messbuftype DO
28380 1042 177 ! ! ! ! ! ! ! j:= messbuf(i);
28390 1043 178 ! ! ! ! ! ! ! 3: LOCK cur AS maxbuf: maxbuftype DO
28400 1044 179 ! ! ! ! ! ! ! j:= maxbuf(i);
28410 1045 180 ! ! ! ! ! ! ! 4: LOCK cur AS testbuf: testbuftype DO
28420 1046 181 ! ! ! ! ! ! ! j:= testbuf(i);
28430 1047 182 ! ! ! ! ! ! ! OTHERWISE
28440 1048 183 ! ! ! ! ! ! ! j:= 0;
28450 1049 184 ! ! ! ! ! ! END;
28460 1050 185 ! ! ! ! ! ! IF base= 2 THEN
\f
tsdoslst 81.03.23. 13.45. page 37
28470 1051 186 ! ! ! ! ! ! outinteger(j,17)
28480 1052 187 ! ! ! ! ! ! ELSE
28490 1053 188 ! ! ! ! ! ! outinteger(j,7);
28500 1054 189 ! ! ! ! ! ! writenl;
28510 1055 190 ! ! ! ! ! END;
28520 1056 191 ! ! ! ! END (* ok *);
28530 1057 192 ! ! ! END (* output *);
28540 1058 193 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 38
29010 1059 194 ! ! ! "r": (* return *)
29020 1060 195 ! ! ! (* returns current buffer *)
29030 1061 196 ! ! ! IF nil(cur)
29040 1062 197 ! ! ! THEN outstring10("no buffer ")
29050 1063 198 ! ! ! ELSE return(cur);
29060 1064 199 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 39
30010 1065 200 ! ! ! "s": (* signal *)
30020 1066 201 ! ! ! (* signals current buffer to one of the predefined semaphores.
30030 1067 202 ! ! ! 1st param is semno *)
30040 1068 203 ! ! ! BEGIN
30050 1069 204 ! ! ! ! semno:= params(1);
30060 1070 205 ! ! ! !
30070 1071 206 ! ! ! ! IF noofparams >= 1 THEN
30080 1072 207 ! ! ! ! IF (1<=semno) AND (semno<=noofsemaphores) THEN
30090 1073 208 ! ! ! ! IF NOT nil(cur) THEN
30100 1074 209 ! ! ! ! signal (cur,sem(semno).s^)
30110 1075 210 ! ! ! ! ELSE outstring10("no buffer ")
30120 1076 211 ! ! ! ! ELSE outstring10(illegalno)
30130 1077 212 ! ! ! ! ELSE outstring10(noparam)
30140 1078 213 ! ! ! END (* signal *);
30150 1079 214 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 40
31010 1080 215 ! ! ! "t": (* testsem *)
31020 1081 216 ! ! ! (* tests the status of the specified semaphores.
31030 1082 217 ! ! ! if none is specified, the status of all the
31040 1083 218 ! ! ! user semaphores is given.
31050 1084 219 ! ! ! in both cases nothing will be written for a semaphore
31060 1085 220 ! ! ! if it is passive. *)
31070 1086 221 ! ! ! BEGIN
31080 1087 222 ! ! ! ! IF noofparams=0 THEN
31090 1088 223 ! ! ! ! BEGIN (* test all semaphores *)
31100 1089 224 ! ! ! ! !
31110 1090 225 ! ! ! ! ! FOR i:=1 TO noofsemaphores DO
31120 1091 226 ! ! ! ! ! testsem(i)
31130 1092 227 ! ! ! ! END (* test all *)
31140 1093 228 ! ! ! ! ELSE
31150 1094 229 ! ! ! ! BEGIN (* test the specified semaphores *)
31160 1095 230 ! ! ! ! !
31170 1096 231 ! ! ! ! ! FOR i:=1 TO noofparams DO
31180 1097 232 ! ! ! ! ! IF (params(i)<1) OR (params(i)>noofsemaphores) THEN
31190 1098 233 ! ! ! ! ! BEGIN (* illegal no. *)
31200 1099 234 ! ! ! ! ! ! outstring20("illegal no.: ");
31210 1100 235 ! ! ! ! ! ! outdecimal(params(i),3);
31220 1101 236 ! ! ! ! ! ! writenl;
31230 1102 237 ! ! ! ! ! END (* illegal no *)
31240 1103 238 ! ! ! ! ! ELSE
31250 1104 239 ! ! ! ! ! testsem( params(i) );
31260 1105 240 ! ! ! ! END (* test the specified semaphores *)
31270 1106 241 ! ! ! END (* testsem *);
31280 1107 242 ! ! !
31290 1108 243 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 41
32010 1109 244 ! ! ! "u": (* user parameters *)
32020 1110 245 ! ! ! (* inserts user param into header of current buffer
32030 1111 246 ! ! ! 1st param is u1
32040 1112 247 ! ! ! 2nd param is u2
32050 1113 248 ! ! ! 3rd param is u3
32060 1114 249 ! ! ! 4th param is u4 *)
32070 1115 250 ! ! ! BEGIN
32080 1116 251 ! ! ! ! IF nil(cur)
32090 1117 252 ! ! ! ! THEN outstring10("no buffer ")
32100 1118 253 ! ! ! ! ELSE
32110 1119 254 ! ! ! ! IF noofparams = 0 THEN
32120 1120 255 ! ! ! ! outstring10(noparam)
32130 1121 256 ! ! ! ! ELSE
32140 1122 257 ! ! ! ! WITH cur^ DO
32150 1123 258 ! ! ! ! BEGIN
32160 1124 259 ! ! ! ! ! IF testinterval (params(1),0,255) THEN u1:= params(1);
32170 1125 260 ! ! ! ! ! IF (noofparams>=2) THEN IF testinterval(params(2),0,255) THEN
32180 1126 261 ! ! ! ! ! u2:= params(2);
32190 1127 262 ! ! ! ! ! IF (noofparams>=3) THEN IF testinterval(params(3),0,255) THEN
32200 1128 263 ! ! ! ! ! u3:= params(3);
32210 1129 264 ! ! ! ! ! IF (noofparams>=4) THEN IF testinterval(params(4),0,255) THEN
32220 1130 265 ! ! ! ! ! u4:= params(4);
32230 1131 266 ! ! ! ! END
32240 1132 267 ! ! ! END; (* end user parameters *)
32250 1133 268 ! ! !
32260 1134 269 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 42
33010 1135 270 ! ! ! "w": (* wait *)
33020 1136 271 ! ! ! (* waits for semaphore semno.
33030 1137 272 ! ! ! 1st param is semno *)
33040 1138 273 ! ! ! BEGIN
33050 1139 274 ! ! ! ! semno:= params(1);
33060 1140 275 ! ! ! !
33070 1141 276 ! ! ! ! IF noofparams >= 1 THEN
33080 1142 277 ! ! ! ! IF nil(cur) THEN
33090 1143 278 ! ! ! ! IF (1<=semno) AND (semno<=noofsemaphores) THEN
33100 1144 279 ! ! ! ! BEGIN
33110 1145 280 ! ! ! ! ! sensesem( cur, sem(semno).w^);
33120 1146 281 ! ! ! ! ! IF nil(cur) THEN
33130 1147 282 ! ! ! ! ! outstring20("semaphore not open ")
33140 1148 283 ! ! ! ! ! ELSE
33150 1149 284 ! ! ! ! ! BEGIN
33160 1150 285 ! ! ! ! ! ! get_curbuftype;
33170 1151 286 ! ! ! ! ! ! outstring10(" bufsize ");
33180 1152 287 ! ! ! ! ! ! outinteger(curbufsize, 5);
33190 1153 288 ! ! ! ! ! ! outinteger(cur^.size, 5)
33200 1154 289 ! ! ! ! ! END;
33210 1155 290 ! ! ! ! END
33220 1156 291 ! ! ! ! ELSE outstring10(illegalno)
33230 1157 292 ! ! ! ! ELSE outstring20("you already have one")
33240 1158 293 ! ! ! ! ELSE outstring10(noparam)
33250 1159 294 ! ! ! END (* wait *);
33260 1160 295 ! ! !
\f
tsdoslst 81.03.23. 13.45. page 43
34010 1161 296 ! ! ! "x": (* exchange pointer *)
34020 1162 297 ! ! ! BEGIN
34030 1163 298 ! ! ! ! IF noofparams >= 2 THEN
34040 1164 299 ! ! ! ! IF (params(1)>0) AND (params(1)<=noofsemaphores) THEN
34050 1165 300 ! ! ! ! IF (params(2)>0) AND (params(2)<=noofsemaphores) THEN
34060 1166 301 ! ! ! ! BEGIN
34070 1167 302 ! ! ! ! ! worksem:= sem(params(1)).w;
34080 1168 303 ! ! ! ! ! sem(params(1)).w:= sem(params(2)).w;
34090 1169 304 ! ! ! ! ! sem(params(2)).w:= worksem;
34100 1170 305 ! ! ! ! END
34110 1171 306 ! ! ! ! ELSE outstring10(valparam)
34120 1172 307 ! ! ! ! ELSE outstring10(valparam)
34130 1173 308 ! ! ! ! ELSE outstring10(noparam)
34140 1174 309 ! ! ! END (* exchange pointer *);
34150 1175 310 ! ! !
34160 1176 311 ! ! !
34170 1177 312 ! ! ! OTHERWISE (* error *)
34180 1178 313 ! ! ! outstring20 ("illegal comm. type h");
34190 1179 314 ! ! END (* case *);
34200 1180 315 ! !
34210 1181 316 ! ! IF command<>";" THEN
34220 1182 317 ! ! writenl;
34230 1183 318 ! !
34240 1184 319 ! UNTIL false;
34250 1185 320 !
34260 1186 321 END.
34270 1187
34280 1188
34290 1189
\f
tsdoslst 81.03.23. 13.45. page 44
0 38* 51* 75* 150* 150* 151* 232 242: 242 254 280 282 331 367 413*
436 445 455 461 468 480 491 492 492 519 522 527 537 542 543
642 648 650 666 713 735 742 798 919 996 998 1048 1087 1119 1124
1125 1127 1129 1164 1165
1 35* 39* 50* 65* 66* 67* 68* 75* 78* 79* 99* 146* 147* 234 243:
295 298 307 356: 390 414* 427 430 444 445 450 455 463 475 477
480 484 485 499 514 518 540 544 546 552 556 571 579 588 604
606 711 720 737 752 753 807 873 880 897 907 914 924 941 948
954 965 965 972 979: 989 997 998 998 999 999 1023 1023 1023 1024
1025 1039: 1069 1071 1072 1090 1096 1097 1124 1124 1139 1141 1143 1164 1164
1167 1168
2 236 244: 328 465 466 468 469 477 478 480 481 487 488 491 492
498: 524 696: 724: 880 883 948 962 974 981: 1027 1027 1028 1041: 1050
1125 1125 1126 1163 1165 1165 1168 1169
3 34* 88* 238 245: 504 517 793 811 825 983: 1036 1043: 1100 1127 1127
1128
4 152* 239 246: 376 509 510 708 762 775 985: 1017 1018 1019 1020 1045:
1129 1129 1130
5 33* 151* 152* 337 1152 1153
6 49* 505 703
7 150* 151* 152* 1053
8 360: 503: 516 701: 725: 921 948
9 534
10 78* 288 364: 401 432 571 651 664 913 915 922 948
11 368: 923
12 579
15 413* 463 475 485 522
16 36* 500 508: 647 671 698 706: 717 726: 948
17 1051
20 79* 410* 588
50 146* 305
80 30* 48*
87 660 683 732
100 334
255 1124 1125 1127 1129
512 367
1024 912
2048 726
3276 674
4096 725
16384 724
32767 737
32768 676 736
a 83* 787= 788=
\f
tsdoslst 81.03.23. 13.45. page 45
abs 442
alfa 60* 208* 317* 575*
alfa10 78* 205* 565*
alfa20 79* 211* 223* 583* 770*
alfalength 49*
alloc 882 895 909
alreadyexists <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
43* 326
al_env_version <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
870
ap 155* 787 791 823
as 257: 263: 387: 600: 751: 846: 884: 899: 979: 981: 983: 985: 1039: 1041: 1043:
1045:
atbuffer 75*
base 121* 287 288= 301= 311= 400 401= 403= 432 442 443 497 516 647 651
664 671 682 683 695 717 723 730 732 913= 943= 951= 954= 1050
bit 413*
bits 413* 465= 468= 477= 480= 487 488= 488 491 492= 492 524
boolean 143* 190* 278* 424* 626* 756* 784*
bp 155* 788 791 823
byte 72* 75*
ch 384* 391 631* 637= 644 645= 646 647 658 659 660 668= 670 671 674
681 682 683 697 702 707 715= 716 717 729 730 732
char 61* 78* 79* 117* 214* 384* 414* 595* 631*
chr 442 535 536
command 117* 269= 271 284 299 931 1181
com_pool 371 909
controlinfo 72*
countref 102* 801 802 806 814 815
countsem 93* 806 812 814
create 330
createchtype 70*
createerror 46* 335
cur 105* 231 233 235 237 909 910 968 979: 981: 983: 985: 1010 1017 1018
1019 1020 1032 1039: 1041: 1043: 1045: 1061 1063 1073 1074 1116 1122 1142 1145
1146 1153
curbufsize 134* 242= 243= 244= 245= 246= 976 1024 1027 1029 1030 1032 1152
curbuftype 135* 232= 234= 236= 238= 239= 241 978 1038
curdigit 415* 514= 529 530 535 536 540 544= 544 628* 711= 720= 720 721 733
curpos 416* 517= 518= 525 543= 546= 546
data 61* 391= 603 889=
dcmodule 168* 370
dc_addr 150*
dc_int1 372
\f
tsdoslst 81.03.23. 13.45. page 46
dc_int2 372
dc_int3 372
dc_sem_no 372
dc_sim_pri 373
dc_sim_size 373
digit 626* 638= 646= 648 656 666 670= 672 713 716= 718
digits 414* 430= 442= 449= 455= 530= 535= 536= 558 621* 646 658 670 681 716
729
doesntexist 44*
done 184*
external 161* 166* 172* 177* 188* 191*
false 292 302 539 635 638 653 677 764 803 868 1184
first 57* 266 756* 759 887= 902=
firstindex 49* 50* 61* 258 267 847 887 889 902
firstword 122* 914= 1025= 1034
free 183*
getinput 250* 929
getparams 196* 273 276*
get_curbuftype <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
229* 1150
h 417* 522= 524
hexdigits 622* 647 671 717
i 123* 223* 417* 430= 430 434= 442 444= 444 445 449 450= 450 453 463=
465 475= 477 485= 487 488 488 556= 558 569* 571= 572 577* 579= 580
586* 588= 589 756* 759 759 762 770* 775 780* 787 788 789 793 801
815 821 825 873= 875 875 876 876 880= 907= 972= 976 980 982 984
986 989= 989 997= 997 997 1034= 1036 1040 1042 1044 1046 1090= 1091 1096=
1097 1097 1100 1104
illegalno 45* 377 761 1076 1156
incharsleft 124* 266= 606= 606 642 648 666 713 742 753= 753
inc_name 317* 330 336
index 315* 325 330 332 344* 355 357 361 365 369 376
init_modul 344* 921 922 923 924
init_proc 314* 357 361 365 369
int 199* 202* 395* 402 406* 436 442 443= 443 445 455 461 465 466= 466
468 469= 469 477 478= 478 480 481= 481
integer 59* 65* 66* 67* 68* 137* 146* 199* 202* 217* 223* 315* 320* 323* 344*
395* 406* 422* 569* 577* 586* 612* 629* 756* 770* 780*
j 125* 798= 807= 807 811 974= 980 982 984 986 1040= 1042= 1044= 1046= 1048=
1051 1053
k 126*
lam_sem_no 370
last 58* 390= 390 391 756* 759 847= 903=
lastchar 631* 636= 644= 652
\f
tsdoslst 81.03.23. 13.45. page 47
lastindex 50* 61* 903
lastword 127* 915= 1028= 1029 1030= 1034
leftbyte 128*
linelength 48* 50*
link 329
lock 257: 263: 387: 600: 751: 846: 884: 899: 979: 981: 983: 985: 1039: 1041: 1043:
1045:
locked 821
m 418* 484= 487 488 489= 491 492 493=
macroaddr 150* 150* 151* 151* 152* 152*
main 182*
maxbuf 983: 984= 1043: 1044
maxbufsize 34* 68* 235 245
maxbuftype 68* 983 1043
maxpos 410* 414* 430 434 453 514 529 540 552 556 556
messbuf 981: 982= 1041: 1042
messbufpool 90* 909
messbufsize 32* 65* 233 244
messbuftype 65* 90* 981 1041
minbuf 979: 980= 1039: 1040
minbufsize 35* 67* 231 243
minbuftype 67* 979 1039
moduleno 129*
more 784* 795= 799 803=
n1 346* 357 357
n10 348* 365 365
n11 349* 369 369
n13 350*
n14 351*
n15 352*
n16 353*
n8 347* 361 361
name 60* 316* 329 888= 904=
ncsup 179*
nc_addr 151*
negative 424* 436= 447 626* 652= 653= 674 677= 688 697= 702= 707= 721 733
netc_sem_no 370
net_sem 186*
newbase 278* 289= 292= 302= 309
newm 418* 487= 489 491= 493
next 59* 258= 266 267= 603 604= 604 752= 752
nl 842
noofdig 419* 500= 505= 510= 514
noofdigit 628* 698= 703= 708= 721 733
\f
tsdoslst 81.03.23. 13.45. page 48
noofmodules 36* 147*
noofparams 130* 282= 295= 295 296 297 298 305 307= 307 328 919= 941 962 974
996 1023 1027 1071 1087 1096 1119 1125 1127 1129 1141 1163
noofpos 420* 499= 504= 509= 525
noofsemaphores <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
37* 997 998 1072 1090 1097 1143 1164 1165
noparam 42* 944 1077 1120 1158 1173
no_listen 90* 907
nul 636 637
oflow 190*
ok 51* 261 323* 330= 331 334= 334 337
okl 322* 329= 334 339=
oldbase 131* 287= 301 311 400= 403 943 951
op 159*
opbuf 257: 258 263: 264 387: 388 600: 601 751: 752 752 846: 847 884: 885
899: 900
opbufpool 88* 882 895
opbufsize 30*
opbuftype 55* 88* 257 263 387 600 751 846 884 899
open 789 812
operatorsem 867
opinref 103* 257: 259 260 261 263: 600: 751: 895 897 899:
opoutref 104* 387: 840 843 845 846: 882 883 884: 891
opsem 109* 164* 169* 175* 180* 259 358 362 366 370 843 867= 869
ord 271 442 535 536 659 659 660 682 682 683 730 730 732
outchar 384* 550 558 572 580 589 792 792 794 824 824 826 842 1014 1015
1037
outdecimal 199* 337 376 395* 793 811 825 1036 1100
outinteger 202* 402 406* 762 775 1017 1018 1019 1020 1051 1053 1152 1153
outstring10 205* 377 565* 761 827 944 963 969 1000 1011 1062 1075 1076 1077 1117
1120 1151 1156 1158 1171 1172 1173
outstring12 208* 336 575*
outstring20 211* 326 335 583* 774 950 966 1033 1099 1147 1157 1178
p 318* 329 330 339
params 146* 296= 297 948 954 965 972 980 982 984 986 998 998 999 999
1023 1024 1025 1027 1028 1069 1097 1097 1100 1104 1124 1124 1125 1126 1127
1128 1129 1130 1139 1164 1164 1165 1165 1167 1168 1168 1169
point_rec 82* 155*
pool 88* 90*
positions 199* 202* 395* 402 406* 550 552 553 554= 556
pr 39*
prio 320* 332
process 4* 158* 163* 168* 174* 179*
processrec 318*
\f
tsdoslst 81.03.23. 13.45. page 49
processref 329 339
pu 38*
readchar 214* 269 595* 603= 645 668 715
readinteger 217* 296 612* 746=
readok 140* 305 635= 661=
ref 875
reference 106*
repeatchar 220* 744 749*
res 421* 519= 524= 524 527 534 535 536 537 542=
result 629* 650= 659= 660= 674 676= 682= 682 683= 683 688= 688 724= 724 725=
725 726= 726 730= 730 732= 732 735 736= 737= 737 746
return 891 910 1063
rightbyte 132*
s 370 370 371 787 875= 876 909 997 999 1074
sem 111* 165* 358 362 366 370 370 371 371 372 372 372 372 787 788
875 876 876 909 997 997 999 999 1074 1145 1167 1168 1168 1169
sem1 170*
sem2 170*
sem3 170*
sem4 170*
sem5 171*
sem6 171*
sem7 171*
sem8 171*
semaphore 98* 99*
semno 133* 1069= 1072 1072 1074 1139= 1143 1143 1145
sempointer 83* 109* 110* 159* 164* 169* 170* 175* 180* 187*
semvector 4* 867
sensesem 801 1145
setoflowmask 190* 917
sh 147* 325 330 332
shadow 147*
signal 259 806 815 843 1074
signs 623*
size 231 233 235 237 319* 328 1032 1153
size_listen 32* 33* 34*
sp 430 550
st 136* 328= 330 912=
start 332
system_vector <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
4*
tab_sem 176*
tap 174* 366
tap_sem_no 366
\f
tsdoslst 81.03.23. 13.45. page 50
testbuf 985: 986= 1045: 1046
testbufsize 33* 66* 237 246
testbuftype 66* 985 1045
testinterval 756* 764= 767= 1124 1125 1127 1129
testmode 142* 772 868= 1003= 1003
testmodeout 223* 254 271 280 297 770*
testopen 869
testout 870
testsem 780* 1091 1104
text 205* 208* 211* 223* 565* 572 575* 580 583* 589 770* 774
timeout 72*
timeoutsem 187*
timeout_sem_no <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
371
true 289 520 661 697 702 707 767 795 917
tsopsys 4*
tssuper 158* 358
tss_pri 359
tss_size 359
ts_addr 152*
ts_pointer 171* 176* 184*
ts_pointer_vector <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
111* 160* 165*
ts_sem 99* 160* 789 801 815 821 875
ts_sem_total 37* 99* 873
u1 883= 897= 1017 1124=
u2 261 1018 1126=
u3 1019 1128=
u4 1020 1130=
unlink 339
used 422* 427= 453= 540= 550 553 554
vagt 163* 362
valparam 41* 1000 1171 1172
vas_size 363
vc_sim_pri 363
version 25* 870
w 371 788 876= 997= 999= 1145 1167 1168= 1168 1169=
wait 260 814 845
worksem 110* 1167= 1169
writenl 226* 338 763 776 818 828 836* 893 1021 1054 1101 1182
wrsem 96* 260 895
wsem 94* 845 882
z 114* 869 870
zeroes 424* 520= 527 537 539=
\f
tsdoslst 81.03.23. 13.45. page 51
zone 114*
\f
tsdoslst 81.03.23. 13.45. page 52
AND 19
ARRAY 13
BEGIN 92
CASE 8
CONST 5
DIV 7
DO 43
DOWNTO 3
ELSE 49
END 103
FOR 17
FORWARD 11
FUNCTION 5
IF 86
IN 13
MOD 7
NIL 10
NOT 7
OF 23
OR 9
OTHERWISE 4
PROCEDURE 25
RECORD 3
REPEAT 5
THEN 86
TO 14
TYPE 1
UNTIL 5
VAR 17
WHILE 4
WITH 6
\f
jg0 1981.03.23 13.46
tsdos program
81.03.23. 13.46. pascal80 version 1981.02.09
name headline beginline endline appetite(words)
get_curbufty 229 232 248 : 2
getinput 250 254 274 : 21
getparams 276 280 312 : 25
init_proc 320 326 342 : 29
init_modul 344 356 380 : 51
outchar 384 387 393 : 9
outdecimal 395 400 404 : 10
outinteger 406 427 561 : 47
outstring10 565 571 573 : 17
outstring12 575 579 581 : 17
outstring20 583 588 590 : 17
readchar 595 600 607 : 11
readinteger 612 635 747 : 17
repeatchar 749 751 754 : 8
testinterval 756 760 768 : 13
testmodeout 770 773 778 : 18
testsem 780 787 830 : 15
writenl 836 841 848 : 11
tsopsys 24 867 1186 : 1087
code: 3 . 1580 = 10580 bytes
end of PASCAL80 compilation
end
blocksread = 53
«eof»