1 C Loglan82 Compiler&Interpreter
2 C Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
3 C Copyright (C) 1993, 1994 LITA, Pau
5 C This program is free software; you can redistribute it and/or modify
6 C it under the terms of the GNU General Public License as published by
7 C the Free Software Foundation; either version 2 of the License, or
8 C (at your option) any later version.
10 C This program is distributed in the hope that it will be useful,
11 C but WITHOUT ANY WARRANTY; without even the implied warranty of
12 C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 C GNU General Public License for more details. File: LICENSE.GNU
14 C ===============================================================
17 C--------------LACZNIK 1-------------------------------
18 C - PRZESYLA CZESC INFORMACJI ZE SCANNERA NA PLIKI
19 C - INICJUJE ZMIENNE DLA POTRZEB ANALIZY DEKLARACJI
20 C I POZNIEJSZYCH PRZEBIEGOW
21 C - SORTUJE TOPOLOGICZNIE DEKLARACJE TYPOW
23 C OPIS W DOKUMENTACJI: D.I.2
24 C WERSJA Z DNIA: 19.01.82
26 C...........................................................
28 IMPLICIT INTEGER (A-Z)
31 C BECAUSE OF TYPECONFLICT 03.01.84
36 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
39 COMMON /BLANK/ COM(278),
40 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
41 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
42 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
43 X LOCAL , OWN , OBJECT,
46 COMMON /MJLMSG/ IERC, MSG
49 cdsw COMMON /SYSPP/ SYSPP
53 cdeb ----------- added ----------------------
54 c new common blockfor the debugger
55 common /debug/ deb,breakt(500),brnr,maxbr
57 c deb = true - compilation with the debugger
58 c breakt - array of static break points
59 c brnr - index in breakt
60 c maxbr - maximal number of static break points
61 cdeb ----------------------------------------
64 cdsw DATA IDENT /4HIT1 /
68 C ---ZBADANIE, CZY MA BYC DZIALANIE W OTOCZENIU SYSPP
69 SYSPP = BTEST(COM(3), 14)
70 C*********** SCIAGNIECIE BUFOROW PLIKOW
71 C --- BUFFERS NEED NOT BE FETCHED IN THE 'ONE-OVERLAY' VERSION
75 C*********** INICJALIZACJA ZMIENNYCH GLOBALNYCH
76 IPMEM(ISFIN-8) = COM(2)
82 C*********** INICJALIZACJA PROTOTYPOW SYSTEMOWYCH
84 C*********** SORTOWANIE TOPOLOGICZNE TYPOW
86 C...........POBRANIE ELEMENTU ZE SLOWNIKA
88 C ... PROT - PROTOTYP, KTOREGO DEKLARACJE SA SORTOWANE
89 IF (PROT.NE. 0) CALL TORD(PROT)
91 IF (I .GE. ISFIN) GOTO 100
92 C************ PRZESLANIE BUFOROW
93 C --- BUFFERS NEED NOT BE SENT IN THE 'ONE-OVERLAY' VERSION
96 IF (SYSPP) CALL MPPMES
98 cdeb ------------- added ---------------
99 if(deb.and..not.errflg) go to 1000
103 cdeb -----------------------------------
108 C------------------DRUKUJE INFORMACJE O PRZYLACZENIU BIBLIOTEKI SYSPP
109 IMPLICIT INTEGER(A-Z)
112 call ffputspaces(6,10)
113 call ffputcs(6,'-- SYSPP LIBRARY ADDED')
120 C---------------PRZESYLA TABLICE HASH-U SCANNERA NA STRUMIEN SC
121 C DO POCZATKOWYCH BLOKOW
123 C OPIS W DOKUMENTACJI: D.I.3
124 C WERSJA Z DNIA: 19.01.82
126 C.............................................................
127 IMPLICIT INTEGER (A-Z)
131 COMMON /BLANK/ COM(278),
132 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
133 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
134 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
135 X LOCAL , OWN , OBJECT,
140 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
144 C------PRZEWINIECIE STRUMIENIA SC
146 C------PRZEPISANIE BLOKOW TWORZACYCH TABLICE HASH-U
147 cdsw ----------------------
148 c dodane przepisywanie tablicy hash2
150 call put (ibuf3,hash(i))
155 C--------------INICJALIZACJA PROTOTYPOW SYSTEMOWYCH
157 C OPIS W DOKUMENTACJI: D.I.4
158 C WERSJA Z DNIA: 19.01.82
160 C...............................................................
162 IMPLICIT INTEGER (A-Z)
165 COMMON /BLANK/ COM(278),
166 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
167 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
168 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
169 X LOCAL , OWN , OBJECT,
174 cdsw COMMON /SYSPP/ SYSPP
177 C.....NAZWY HASH-U ZE SCANNERA
179 COMMON /HNAMES/ INTNM, RENM, BOOLNM, CHRNM, CORNM,
180 X PROCNM, TEXTNM, FILENM
186 c lprefs - ostatnio przydzielony numer w prefixset
188 c grpref - numer prefiksu klasy IIUWGRAPH
189 c mousepref - numer prefiksu klasy MOUSE
191 c system class prototypes:
192 common /syspro/prgraph, prmouse
193 c prgraph - prototype of IIUWGRAPH
194 c prmouse - prototype of MOUSE
196 cdsw DATA INTNM,RENM,BOOLNM,CHRNM,CORNM,PROCNM,TEXTNM,FILENM
197 cdsw X /24,40,8,16,2919,2785,48,56/
198 C NATTR - ATRYBUT "-1" (1 SLOWO, 2 DOMYSLNE)
199 cdsw DATA INHEX1,INHEX2,INHEX3,INHEX4,INHEX5,INHEX6,INHEX7,INHEX8,
200 cdsw XINHEX9,INHEX10,INHEX11,INHEX12,INHEX13,INHEX14,INHEX15,XX
201 cdsw X/Z0008,Z8008,Z000A,Z000B,ZC007,ZC005,Z000C,Z0004,ZC00E,Z8051,
202 cdsw X Z8061,Z0051,Z0061,ZC061,ZC051,Z0004/
203 cdsw --------------------------------------------------------------
204 c #8008 --> -#7ff8, #c007 --> -#3ff9, #c005 --> -#3ffb,
205 c #c00e --> -#3ff2, #8051 --> -#7faf, #8061 --> -#7f9f,
206 c #c061 --> -#3f9f, #c051 --> -#3faf
207 data inhex1,inhex2,inhex3,inhex4,inhex5,inhex6,inhex7,inhex8,
208 * inhex9,inhx10,inhx11,inhx12,inhx13,inhx14,inhx15,xx
209 */x'0008',-x'7ff8', x'000a',x'000b',
210 *-x'3ff9',-x'3ffb', x'000c',x'0004',
211 *-x'3ff2',-x'7faf',-x'7f9f',x'0051',
212 * x'0061',-x'3f9f',-x'3faf',x'0004'/
213 cdeb ------------------- added ----------------
214 data inhx16, inhx17,inhx18 / x'0091', x'8091', x'c091' /
215 cdeb ----------------------------------------
226 cdsw ----------------------------------------------------------------
233 IPMEM(NRINT) = INHEX1
239 NRBOOL = MGETM(3, 41)
240 IPMEM(NRBOOL) = INHEX3
243 NRCHR = MGETM (3, 41)
244 IPMEM(NRCHR) = INHEX3
248 NRFILE = MGETM(3, 41)
249 IPMEM(NRFILE) = INHEX4
252 NRCOR = MGETM(9, 41) + 7
253 IPMEM(NRCOR) = INHEX5
254 C NUMER W ZBIORZE PREFIKSOW ORAZ SLOWO Z TEGO ZBIORU
260 NRPROC = MGETM(9, 41) + 7
261 IPMEM(NRPROC) = INHEX6
263 CALL MSETB(NRPROC, 0)
264 CALL MSETB(NRPROC, 1)
265 CALL MSETB(NRPROC, 2)
268 NRTEXT = MGETM(3, 41)
269 IPMEM(NRTEXT) = INHEX7
272 NRUNIV = MGETM(9, 41) + 7
273 IPMEM(NRUNIV) = INHEX8
280 NRNONE = MGETM(9, 41) + 7
281 IPMEM(NRNONE) = INHEX9
283 CALL MSETB(NRNONE, 2)
287 wrds1 = mgetm(6, 41)+4
288 ipmem(wrds1-3) = nrint
290 ipmem(wrds1) = X'0081'
296 if( btest(opt,12) ) i = 4
299 wrds2 = mgetm(6, 41)+4
300 ipmem(wrds2-3) = nrint
302 ipmem(wrds2) = X'0081'
304 if( btest(opt,12) ) i = 8
308 C......INICJALIZACJA BLOKU SYSTEMOWEGO
309 NBLSYS = MGETM(21, 41) + 2
312 C USTAWIENIE SL DLA COROUTINE I PROCESS
313 IPMEM(NRCOR-1) = NBLSYS
314 IPMEM(NRPROC-1) = NBLSYS
316 C inicjalizacja lprefs
319 C......INICJALIZACJA FUNKCJI I PROCEDUR STANDARDOWYCH
320 C ...PARAMETRY - ICH OPISY
326 C OUTPR - OUTPUT REAL (I RESULT)
327 OUTPR = MGETM(6,41)+4
328 IPMEM(OUTPR-3) = NRRE
330 IPMEM(OUTPR) = INHX11
331 C INPI - INPUT INTEGER
332 INPI = MGETM(6, 41) +4
333 IPMEM(INPI-3) = NRINT
336 C OUTPI - OUTPUT INTEGER (I RESULT)
337 OUTPI = MGETM(6, 41) +4
338 IPMEM(OUTPI-3) = NRINT
340 IPMEM(OUTPI) = INHX13
341 C INPCH - INPUT CHARACTER
342 INPCH = MGETM(6, 41) +4
343 IPMEM(INPCH-3) = NRCHR
345 IPMEM(INPCH) = INHX12
346 C OUTPCH - OUTPUT CHARACTER (I RESULT)
347 OUTPCH = MGETM(6, 41) +4
348 IPMEM(OUTPCH-3) = NRCHR
350 IPMEM(OUTPCH) = INHX13
351 C OUTPB - OUTPUT BOOLEAN (I RESULT)
352 OUTPB = MGETM(6, 41) +4
353 IPMEM(OUTPB-3) = NRBOOL
355 IPMEM(OUTPB) = INHX13
356 C OUTACH - OUTPUT ARRAYOF CHAR (I RESULT)
357 OUTACH = MGETM(6, 41) +4
359 IPMEM(OUTACH-3) = NRCHR
361 IPMEM(OUTACH) = INHX14
362 C#F NOWE OPISY PARAMETROW DLA PLIKOW
364 INPF = MGETM(6, 41) + 4
365 IPMEM(INPF - 3) = NRFILE
368 C INPTX - INPUT TEXT (=STRING)
369 INPTX = MGETM(6, 41) + 4
370 IPMEM(INPTX-3) = NRTEXT
372 IPMEM(INPTX) = INHX12
373 C INPARI - INPUT ARRAYOF INTEGER
374 INPARI = MGETM(6, 41) + 4
376 IPMEM(INPARI-3) = NRINT
378 IPMEM(INPARI) = INHX15
379 cdsw --------------- for exec---
380 c inparch - input arrayof char
381 inparch = mgetm(6,41)+4
382 ipmem(inparch) = inhx15
384 ipmem(inparch-3) = nrchr
388 cdeb --------------- added ------------
389 c inoui - inout integer
390 inoui = mgetm(6,41)+4
391 ipmem(inoui-3) = nrint
393 ipmem(inoui) = inhx16
396 inour = mgetm(6,41)+4
397 ipmem(inour-3) = nrre
399 ipmem(inour) = inhx17
401 c inouari - inout arrayof integer
402 inouari = mgetm(6,41)+4
404 ipmem(inouari-3) = nrint
406 ipmem(inouari) = inhx18
407 cdeb -------------------------------
409 C ...LISTY PARAMETROW FORMALNYCH
410 C FPL1 - (INPUT REAL): REAL
413 IPMEM(FPL1+1) = OUTPR
414 C FPL2 - (INPUT INTEGER, INPUT INTEGER, INPUT INTEGER): INTEGER
419 IPMEM(FPL2+3) = OUTPI
420 C FPL3 - (INPUT REAL): INTEGER
423 IPMEM(FPL3+1) = OUTPI
428 C FPL5 - (INPUT INTEGER): CHARACTER
431 IPMEM(FPL5+1) = OUTPCH
433 C FPL6 - (INPUT CHARACTER): INTEGER
436 IPMEM(FPL6+1) = OUTPI
438 C FPL7 - (OUTPUT INTEGER, INTEGER, INTEGER)
441 IPMEM(FPL7+1) = OUTPI
442 IPMEM(FPL7+2) = OUTPI
443 C FPL8 - (INPUT TEXT, OUTPUT ARRAY OF CHAR)
446 IPMEM(FPL8+1) = OUTACH
447 C#F NOWE LISTY DLA PLIKOW
449 C FPL9 - (INPUT FILE, INPUT INTEGER, INPUT ARRAYOF INTEGER)
453 IPMEM(FPL9+2) = INPARI
455 C FPL10 - (INPUT FILE, INPUT TEXT)
458 IPMEM(FPL10+1) = INPTX
460 cdeb ------------ added --------------
461 c fpl11 - (input integer, inout arrayof integer, integer,
462 c arrayof integer, real, integer)
465 ipmem(fpl11+1) = inouari
466 ipmem(fpl11+2) = inoui
467 ipmem(fpl11+3) = inouari
468 ipmem(fpl11+4) = inour
469 ipmem(fpl11+5) = inoui
471 c fpl12 - (input integer, inout integer, integer,arrayof integer)
474 ipmem(fpl12+1) = inoui
475 ipmem(fpl12+2) = inoui
476 ipmem(fpl12+3) = inouari
478 c fpl18 - (input file,file)
481 ipmem(fpl18+1) = inpf
482 cdeb --------------------------------
483 cdsw ---------- for exec ------
484 c fpl13 - (input arrayof char, input arrayof char):integer
486 ipmem(fpl13) = inparch
487 ipmem(fpl13+1) = outpi
488 c fpl14 - input file, input integer, input integer
491 ipmem(fpl14+1) = inpi
492 ipmem(fpl14+2) = inpi
493 c fpl15 - input integer, input integer, input integer, input integer
496 ipmem(fpl15+1) = inpi
497 ipmem(fpl15+2) = inpi
498 ipmem(fpl15+3) = inpi
499 c fpl16 - input file, output integer
503 ipmem(fpl16+1) = outpi
505 CPS - pozycja w pliku : REAL ??? !
506 ipmem(fpl16+1) = outpr
510 C ...PROTOTYPY FUNKCJI STANDARDOWYCH I ICH WLACZENIE DO LISTY HASHU
511 C INOT: FUNCTION(INPUT X: INTEGER) : INTEGER
512 CALL MSTAFP(2613, FPL2+2, 2, 0, NRINT, OUTPI, -1, nblsys)
513 C IOR: FUNCTION (INPUT X: INTEGER INPUT Y: INTEGER): INTEGER
514 CALL MSTAFP(335, FPL2+1, 3, 0, NRINT, OUTPI, -2, nblsys)
515 C IAND: FUNCTION (INPUT X: INTEGER INPUT Y: INTEGER): INTEGER
516 CALL MSTAFP(307, FPL2+1, 3, 0, NRINT, OUTPI, -3, nblsys)
517 C ISHFT: FUNCTION (INPUT X: INTEGER INPUT Y: INTEGER): INTEGER
518 CALL MSTAFP(2605, FPL2+1, 3, 0, NRINT, OUTPI, -4, nblsys)
519 C EOF: FUNCTION: BOOLEAN
520 cfile CALL MSTAFP(1841, FPL4, 1, 0, NRBOOL, OUTPB, 39, nblsys)
521 C ENTIER: FUNCTION (INPUT X: REAL): INTEGER
522 CALL MSTAFP(2589, FPL3, 2, 0, NRINT, OUTPI, 15, nblsys)
523 C RANDOM: FUNCTION: REAL
524 CALL MSTAFP(2599, FPL1+1, 1, 0, NRRE, OUTPR, 12, nblsys)
525 C TIME: FUNCTION: INTEGER
526 CALL MSTAFP(1731, FPL3+1, 1, 0, NRINT, OUTPI, 13, nblsys)
527 C SQRT: FUNCTION (INPUT X: REAL): REAL
528 CALL MSTAFP(1619, FPL1, 2, 0, NRRE, OUTPR, 14, nblsys)
529 C ROUND: FUNCTION (INPUT X: REAL): INTEGER
530 CALL MSTAFP(1487, FPL3, 2, 0, NRINT, OUTPI, 16, nblsys)
531 C EOLN: FUNCTION: BOOLEAN
532 cfile CALL MSTAFP(2579, FPL4, 1, 0, NRBOOL, OUTPB, 74, nblsys)
533 C ORD: FUNCTION(INPUT X: CHARACTER): INTEGER
534 CALL MSTAFP(2571, FPL6, 2, 0, NRINT, OUTPI, -5, nblsys)
535 C CHR: FUNCTION(INPUT X: INTEGER): CHARACTER
536 CALL MSTAFP(2575, FPL5, 2, 0, NRCHR, OUTPCH, -6, nblsys)
537 C SIN: FUNCTION(INPUT REAL): REAL
538 CALL MSTAFP(2563, FPL1, 2, 0, NRRE, OUTPR, 23, nblsys)
539 C COS: FUNCTION(INPUT REAL): REAL
540 CALL MSTAFP(2559, FPL1, 2, 0, NRRE, OUTPR, 24, nblsys)
541 C TAN: FUNCTION (INPUT REAL): REAL
542 CALL MSTAFP(2555, FPL1, 2, 0, NRRE, OUTPR, 25, nblsys)
543 C EXP: FUNCTION (INPUT REAL): REAL
544 CALL MSTAFP(2551, FPL1, 2, 0, NRRE, OUTPR, 26, nblsys)
545 C LN: FUNCTION (INPUT REAL): REAL
546 CALL MSTAFP(717, FPL1, 2, 0, NRRE, OUTPR, 27, nblsys)
547 C ATAN: FUNCTION (INPUT REAL): REAL
548 CALL MSTAFP(2547, FPL1, 2, 0, NRRE, OUTPR, 28, nblsys)
549 C IMIN: FUNCTION (INUT INTEGER, INPUT INTEGER): INTEGER
550 CALL MSTAFP(331, FPL2+1, 3, 0, NRINT, OUTPI, 19, nblsys)
551 C IMIN3: FUNCTION (INPUT INTEGER, INPUT INTEGER, INPUT INTEGER): INTEGER
552 CALL MSTAFP(2521, FPL2, 4, 0, NRINT, OUTPI, 21, nblsys)
553 C IMAX: FUNCTION (INPUT INTEGER, INPUT INTEGER): INTEGER
554 CALL MSTAFP(2515, FPL2+1, 3, 0, NRINT, OUTPI, 20, nblsys)
555 C IMAX3: FUNCTION (INPUT INTEGER, INPUT INTEGER, INPUT INTEGER): INTEGER
556 CALL MSTAFP(2511, FPL2, 4, 0, NRINT, OUTPI, 22, nblsys)
557 C XOR: FUNCTION(INPUT X,Y: INTEGER): INTEGER
558 CALL MSTAFP(237, FPL2+1, 3, 0, NRINT, OUTPI, -7, nblsys)
559 C PANELKEYS: FUNCTION: INTEGER
560 CALL MSTAFP (1203, FPL3+1, 1, 0, NRINT, OUTPI, 18, nblsys)
562 CALL MSTAFP(2483, 0, 0, 0, 0, 0, 29, nblsys)
563 C RANSET: PROCEDURE(INPUT X: REAL)
564 CALL MSTAFP(2375, FPL1, 1, 0, 0, 0, 30, nblsys)
565 C CLOCK: PROCEDURE(OUTPUT H,M,S: INTEGER)
566 CALL MSTAFP(2369, FPL7, 3, 0, 0, 0, 31, nblsys)
567 C OPTIONS: FUNCTION: INTEGER
568 CALL MSTAFP(1105, FPL3+1, 1, 0, NRINT, OUTPI, 32, nblsys)
569 C DATE: PROCEDURE (OUTPUT Y,M,D: INTEGER)
570 CALL MSTAFP(1685, FPL7, 3, 0, 0, 0, 36, nblsys)
571 C EXECPAR: FUNCTION: ARRAYOF CHAR
572 CALL MSTAFP(2357, FPL8+1, 1, 1, NRCHR, OUTACH, 37, nblsys)
573 C UNPACK: FUNCTION( INPUT TEXT): ARRAYOF CHAR
574 CALL MSTAFP(2247, FPL8, 2, 1, NRCHR, OUTACH, 11, nblsys)
575 cdsw --- removed ------
576 C#F NOWE PROCEDURY DLA PLIKOW
577 C REW: PROCEDURE(INPUT FILE)
578 cdsw CALL MSTAFP(2339, FPL9, 1, 0, 0, 0, 2, nblsys)
579 C AVF: PROCEDURE(INPUT FILE, INPUT INTEGER)
580 cdsw CALL MSTAFP(1343, FPL9, 2, 0, 0, 0, 3, nblsys)
581 C BVF: PROCEDURE(INPUT FILE, INPUT INTEGER)
582 cdsw CALL MSTAFP(1471, FPL9, 2, 0, 0, 0, 4, nblsys)
583 C WEO: PROCEDURE(INPUT FILE)
584 cdsw CALL MSTAFP( 89, FPL9, 1, 0, 0, 0, 5, nblsys)
585 C PUtREC: PROCEDURE(INPUT FILE, INPUT INTEGER, INPUT ARRAYOF INTEGER)
586 cdsw CALL MSTAFP(1243, FPL9, 3, 0, 0, 0, 6, nblsys)
587 C GETREC: PROCEDURE(INPUT FILE, INPUT INTEGER, INPUT ARRAYOF INTEGER)
588 cdsw CALL MSTAFP( 59, FPL9, 3, 0, 0, 0, 7, nblsys)
589 C ASS: PROCEDURE(INPUT FILE, INPUT TEXT)
590 cdsw CALL MSTAFP(2335, FPL10, 2, 0, 0, 0, 8, nblsys)
591 C ASSIN: PROCEDURE(INPUT STRING)
592 cdsw CALL MSTAFP(2241, FPL10+1, 1, 0, 0, 0, 9, nblsys)
593 C ASSOUT: PROCEDURE(INPUT STRING)
594 cdsw CALL MSTAFP(2235, FPL10+1, 1, 0, 0, 0, 10, nblsys)
595 cfile --------------- added ----------------------
596 c reset: procedure(input file)
597 call mstafp(2253,fpl9,1,0,0,0,78, nblsys)
598 c rewrite:procedure(input file)
599 call mstafp(2259,fpl9,1,0,0,0,79, nblsys)
600 c unlink:procedure(input file)
601 call mstafp(2087,fpl9,1,0,0,0,80, nblsys)
602 c seek:procedure(input file,input integer, input integer)
603 call mstafp(2091,fpl14,3,0,0,0,81, nblsys)
604 c position : function(input file):integer
606 call mstafp(2023, fpl16, 2, 0, nrint, outpi, 84, nblsys)
608 call mstafp(2023, fpl16, 2, 0, nrre, outpr, 84, nblsys)
610 c memavail : function:integer
611 call mstafp(7847, fpl2+3, 1, 0, nrint, outpi, 98, nblsys)
612 c exec:function(input arrayof char):integer
613 call mstafp(2101,fpl13,2,0,nrint,outpi,99, nblsys)
615 cdeb ------------ debugger ------------
616 c db01ox:procedure(nr:integer; inout ref1:arrayof integer,
617 c offset:integer, ref2:arrayof integer, realval:real,
619 call mstafp(7759,fpl11,6,0,0,0,150, nblsys)
621 c sccd01ox : procedure(nr:integer; inout max,lp:integer, bufor:arrayof int );
622 call mstafp(7739,fpl12,4,0,0,0,151, nblsys)
624 c scnd01ox:procedure(output s,k,adres:integer);
625 call mstafp(7747,fpl7,3,0,0,0,152, nblsys)
627 c db01of : procedure(input f1,f2:file);
628 call mstafp(7753,fpl18,2,0,0,0,153, nblsys)
630 c db01oe : procedure;
631 call mstafp(7731,0,0,0,0,0, 154, nblsys)
632 cdeb -------------------------------------------
634 cgr ------------- grafika ------------------
636 c utworzenie klasy IIUWGRAPH
637 prgraph = mstacl(323, nblsys)
640 outari = mgetm(6,41)+4
642 ipmem(outari-3) = nrint
644 ipmem(outari) = inhx14
656 ipmem(toto2+1) = inpi
657 ipmem(toto2+2) = inpi
658 ipmem(toto2+3) = inpi
659 ipmem(toto2+4) = inpi
663 ipmem(toto3+1) = inpi
664 ipmem(toto3+2) = inpi
665 ipmem(toto3+3) = inpi
666 ipmem(toto3+4) = inpi
667 ipmem(toto3+5) = inpi
668 ipmem(toto3+6) = inpi
669 ipmem(toto3+7) = inpi
670 ipmem(toto3+8) = inpi
671 ipmem(toto3+9) = outpi
675 ipmem(fpl22+1) = inpi
676 ipmem(fpl22+2) = inpi
677 ipmem(fpl22+3) = inpr
678 ipmem(fpl22+4) = inpr
679 ipmem(fpl22+5) = inpi
680 ipmem(fpl22+6) = inpi
681 ipmem(fpl22+7) = inpi
682 ipmem(fpl22+8) = inpi
686 ipmem(fpl23+1) = inpi
687 ipmem(fpl23+2) = outari
691 ipmem(toto5+1) = inpi
692 ipmem(toto5+2) = inpi
693 ipmem(toto5+3) = inpi
694 ipmem(toto5+4) = inptx
695 ipmem(toto5+5) = inpi
696 ipmem(toto5+6) = inpi
697 ipmem(toto5+7) = inpi
698 ipmem(toto5+8) = outach
702 ipmem(toto6+1) = inpi
703 ipmem(toto6+2) = inptx
704 ipmem(toto6+3) = inpi
705 ipmem(toto6+4) = inpi
709 ipmem(toto7+1) = inpari
710 ipmem(toto7+2) = inpari
711 ipmem(toto7+3) = inpi
712 ipmem(toto7+4) = inpi
716 ipmem(toto8+1) = inpi
717 ipmem(toto8+2) = inpi
718 ipmem(toto8+3) = inpi
719 ipmem(toto8+4) = inpi
720 ipmem(toto8+5) = inpi
721 ipmem(toto8+6) = inpi
722 ipmem(toto8+7) = inpi
724 c gron:procedure(input integer)
725 call mstafp(85,fpl2,1,0,0,0,100, prgraph)
728 call mstafp(2273,0,0,0,0,0,101, prgraph)
731 call mstafp(2335,0,0,0,0,0,102, prgraph)
733 c point: procedure(input integer, input integer)
734 call mstafp(1231,fpl2,2,0,0,0,103, prgraph)
736 c move: procedure(input integer, input integer)
737 call mstafp(2279,fpl2,2,0,0,0,104, prgraph)
739 c draw: procedure(input integer, input integer)
740 call mstafp(1719,fpl2,2,0,0,0,105, prgraph)
742 c hfill: procedure(input integer)
743 call mstafp(189,fpl2,1,0,0,0,106, prgraph)
745 c vfill: procedure(input integer)
746 call mstafp(2237,fpl2,1,0,0,0,107, prgraph)
748 c color: procedure(input integer)
749 call mstafp(2231,fpl2,1,0,0,0,108, prgraph)
751 c style: procedure(input integer)
752 call mstafp(2225,fpl2,1,0,0,0,109, prgraph)
754 c patern: procedure(input integer,input integer,input integer,input integer,
755 c input integer,input boolean)
756 call mstafp(2219,toto,6,0,0,0,110, prgraph)
758 c intens: procedure(input integer,arrayof int,arrayof int,int,int)
759 call mstafp(2213,toto7,5,0,0,0,111, prgraph)
761 c pallet: procedure(input integer)
762 call mstafp(2207,fpl2,1,0,0,0,112, prgraph)
764 c border: procedure(input integer)
765 call mstafp(2201,fpl2,1,0,0,0,113, prgraph)
767 c video: procedure(input array of integer)
768 call mstafp(2195,fpl9+2,1,0,0,0,114, prgraph)
770 c hpage: procedure(input integer, input integer, input integer)
771 call mstafp(209,fpl2,3,0,0,0,115, prgraph)
773 c nocard: function: integer
774 call mstafp(2029,fpl2+3,1,0,nrint,outpi,116, prgraph)
777 call mstafp(2185,0,0,0,0,0,117, prgraph)
780 call mstafp(2179,0,0,0,0,0,118, prgraph)
782 c inxpos: function: integer
783 call mstafp(2173,fpl2+3,1,0,nrint,outpi,119, prgraph)
785 c inypos: function: integer
786 call mstafp(2167,fpl2+3,1,0,nrint,outpi,120, prgraph)
788 c inpix: function(input integer, input integer): integer
789 call mstafp(2161,fpl2+1,3,0,nrint,outpi,121, prgraph)
791 c getmap: function(input integer, input integer): array of integer
792 call mstafp(2155,fpl23,3,1,nrint,outari,122, prgraph)
794 c putmap: procedure(input array of integer)
795 call mstafp(2149,fpl9+2,1,0,0,0,123, prgraph)
797 c ormap: procedure(input array of integer)
798 call mstafp(2143,fpl9+2,1,0,0,0,124, prgraph)
800 c xormap: procedure(input array of integer)
801 call mstafp(2137,fpl9+2,1,0,0,0,125, prgraph)
803 c track: procedure(input integer, input integer,input integer,input integer)
804 call mstafp(2131,toto2,5,0,0,0,126, prgraph)
806 c inkey: function: integer
807 call mstafp(2299,fpl2+3,1,0,nrint,outpi,127, prgraph)
809 c hascii: procedure(input integer)
810 call mstafp(2293,fpl2,1,0,0,0,128, prgraph)
812 c hfont: function(input integer,input integer,input integer,input integer)
813 c (intput integer,input integer,input integer,input integer,input integer):
814 c integer new name : gscnum
815 call mstafp(2125,toto3,10,0,nrint,outpi,129, prgraph)
817 c hfont8: function(input int, input int,input int,input int,input string
818 c intput int,input int,input int) : arrayof char
819 call mstafp(2119,toto5,9,1,nrchr,outari,130, prgraph)
821 c outstring: procedure(input int,input int,input string,input int,input int)
822 call mstafp(2113,toto6,5,0,0,0,131, prgraph)
824 c cirb: procedure(input x,y,rx,ry,start,end,c,motif :integer)
825 call mstafp(1573,toto8,8,0,0,0,132, prgraph)
827 cdsw -------------- mouse ------------------------
828 prmouse = mstacl(7991, nblsys)
831 c fpl30 - output int, output bool
834 ipmem(fpl30+1) = outpb
836 c fpl31 - input integer, output integerl, output integer, output integer,
837 c output integer, output integer, output integer
840 ipmem(fpl31+1) = outpi
841 ipmem(fpl31+2) = outpi
842 ipmem(fpl31+3) = outpi
843 ipmem(fpl31+4) = outpi
844 ipmem(fpl31+5) = outpi
845 ipmem(fpl31+6) = outpb
849 ipmem(toto4+1) = inpi
852 c init : procedure(mouse,keyboard:integer);
853 call mstafp(7985, toto4, 2, 0, 0, 0,200,prmouse)
855 c showcursor : procedure;
856 call mstafp(1601, 0, 0, 0, 0, 0, 201, prmouse)
858 c hidecursor : procedure;
859 call mstafp(7973, 0, 0, 0, 0, 0, 202, prmouse)
861 c status : procedure(output h,v:integer, l, r, c:boolean)
862 call mstafp(7963, fpl31+2, 5, 0, 0, 0, 203, prmouse)
864 c setposition : procedure(h,v:integer);
865 call mstafp(7957, fpl2, 2, 0, 0, 0, 204, prmouse)
867 c getpress : function( output h,v,p,l,r,c : integer) : boolean
868 call mstafp(7945, fpl31, 7, 0, nrbool, outpb, 205, prmouse)
870 c getrelease : function( output h,v,p,l,r,c : integer) : boolean
871 call mstafp(7937, fpl31, 7, 0, nrbool, outpb, 206, prmouse)
873 c setwindow : procedure ( l,r,t,b:integer)
874 call mstafp(7887, fpl15, 4, 0, 0, 0, 207, prmouse)
876 c defcursor : procedure (select, x, y:integer)
877 call mstafp(7917, fpl2, 3, 0, 0, 0, 210, prmouse)
879 c getmovement : procedure ( input mo,ke:integer)
880 call mstafp(7907, toto4, 2, 0, 0, 0, 211, prmouse)
882 c setevent : procedure( m:integer )
883 c call mstafp(7865 , fpl2, 1, 0, 0, 0, 212, prmouse)
885 c setspeed : procedure ( speed:integer)
886 call mstafp(7895, fpl2, 1, 0, 0, 0, 215, prmouse)
888 c setmargins : procedure( l, r, t, b : integer)
889 call mstafp(7927, fpl15, 4, 0, 0, 0, 216, prmouse)
891 c setthreshold : procedure(t:integer)
892 call mstafp(7877, fpl2, 1, 0, 0, 0, 219, prmouse)
895 c call mstasg(7857 , 70, prmouse)
899 C.........UTWORZENIE I WSTAWIENIE DO TABLICY HASHU BLOKU GLOWNEGO
900 C PROTOTYPOW SYGNALOW STANDARDOWYCH
903 CALL MSTASG( 987, 1, nblsys)
905 CALL MSTASG(1635, 2, nblsys)
907 CALL MSTASG(2319, 20, nblsys)
909 CALL MSTASG(1305, 21, nblsys)
911 CALL MSTASG( 827, 22, nblsys)
913 CALL MSTASG(2311, 23, nblsys)
915 CALL MSTASG(1995, 24, nblsys)
919 C.......UZUPELNIENIE TABLICY HASHU BLOKU GLOWNEGO O TYPY STANDARDOWE
920 XX = INSERT(INTNM, IPMEM(I), 41)
922 XX = INSERT(RENM, IPMEM(I), 41)
924 XX = INSERT(BOOLNM, IPMEM(I), 41)
926 XX = INSERT(CHRNM, IPMEM(I), 41)
929 XX = INSERT(FILENM, IPMEM(I), 41)
931 XX = INSERT(CORNM, IPMEM(I), 41)
933 XX = INSERT(PROCNM, IPMEM(I), 41)
935 XX = INSERT(TEXTNM, IPMEM(I), 41)
937 XX = INSERT(NEMPTY, IPMEM(I), 41)
941 xx = insert(2069,ipmem(i),41)
944 xx = insert(2061,ipmem(i),41)
952 C*******INICJALIZACJA SYSPP - W RAZIE POTRZEBY
953 IF (SYSPP) CALL MLSPP
957 cdsw SUBROUTINE MSTASG( HNAME, NRSIG)
958 subroutine mstasg( hname, nrsig, sl)
959 C------------- TWORZENIE PROTOTYPU SYGNALU STANDARDOWEGO
960 C JEST ON SKROCONY I NIE POSIADA TABLICY HASHU
961 C NAZW ATRYBUTOW. OSTATNIM SLOWEM JEST +7.
962 C PROCEDURA WYWOLYWANA JEDYNIE Z INIT
963 C WERSJA Z DN. 16 05 83
965 IMPLICIT INTEGER(A-Z)
968 COMMON /BLANK/ COM(278),
969 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
970 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
971 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
972 X LOCAL , OWN , OBJECT,
975 data msthex /x'00b1'/
977 C GENERACJA I INICJLIZACJA PROTOTYPU
978 IPROT = MGETM(9, 41) + 1
979 cdsw IPMEM(IPROT-1) = NBLSYS
981 IPMEM(IPROT) = MSTHEX
982 IPMEM(IPROT+1) = NRSIG
984 C DODANIE NQZWY SYGNALU DO TBLICY HASHU W NBLYS
985 cdsw XX = INSERT(HNAME, IPMEM(NBLSYS+10), 41)
986 xx = insert(hname, ipmem(sl+10), 41)
987 C NAZWA SYGNALU JEST CLOSED
993 SUBROUTINE MSTAFP( HNAME, FPLIST, FPLENG, NDIM, NTYPE, NRESLT,
996 C----------------PROCEDURA TWORZY PROTOTYP FUNKCJI STANDARDOWEJ
997 C I PROCEDURY STANDARDOWEJ - WTEDY NTYPE=0
998 C HNAME - NAZWA ZE SCANNERA TWORZONEJ FUNKCJI
999 C FPLIST, FPLENG - INDEKS LISTY PAR. FORM. I JEJ DLUGOSC
1000 C NDIM, NTYPE - TYP FUNKCJI
1001 C NRESLT - OPIS ATRYBUTU RESULT
1002 C NRFP - ROZROZNIENIE FUNKCJI - WARTOSC DLA GENERATORA KODU
1003 c sl - adres prototypu obejmujacego
1005 C WERSJA Z DNIA: 19.01.82
1006 C (DLA PROCEDURY INIT)
1008 C..................................................................
1010 IMPLICIT INTEGER (A-Z)
1014 COMMON /BLANK/ COM(278),
1015 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1016 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1017 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1018 X LOCAL , OWN , OBJECT,
1023 CDSW DATA MAFPHEX1,MAFPHEX2 /Z0201,Z0401/
1024 data mafhx1, mafhx2 / x'0201',x'0401'/
1030 IF (NTYPE .EQ. 0) GOTO 100
1032 IPROT = MGETM(10, 41) + 5
1033 IPMEM(IPROT-5) = NRESLT
1034 IPMEM(IPROT-4) = NDIM
1035 IPMEM(IPROT-3) = NTYPE
1036 IPMEM(IPROT) = mafhx1
1039 100 IPROT = MGETM(7, 41) + 2
1040 IPMEM(IPROT) = mafhx2
1042 cdsw 200 IPMEM(IPROT-1) = NBLSYS
1043 200 ipmem(iprot-1) = sl
1045 IPMEM(IPROT+2) = NRFP
1046 IPMEM(IPROT+3) = FPLIST
1047 IPMEM(IPROT+4) = FPLENG
1048 XX = INSERT(HNAME, IPMEM(I), 41)
1055 integer function mstacl ( hname, sl)
1056 implicit integer (a-z)
1060 COMMON /BLANK/ COM(278),
1061 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1062 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1063 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1064 X LOCAL , OWN , OBJECT,
1067 common /prefs/lprefs
1068 c lprefs - ostatnio przydzielony numer w prefixset
1071 prot = mgetm(33,41) + 7
1075 xx = insert(hname, ipmem(sl+10), 41)
1077 c ustawienie prefixset i prefixlist
1084 call msetb(prot,lprefs)
1085 ipmem(prot-6) = lprefs
1086 c inicjalizacja listy atrybutow
1087 ipmem(prot+7 ) = prot+5
1088 ipmem(prot+5) = nattr
1095 C-----------------------INICJUJE PROTOTYPY ANALIZY SEMANTYCZNEJ DLA
1098 IMPLICIT INTEGER (A-Z)
1102 COMMON /BLANK/ COM(278),
1103 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1104 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1105 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1106 X LOCAL , OWN , OBJECT,
1108 cdsw DATA MLSPHEX1,MLSPHEX2,MLSPHEX3 /ZC007,ZC061,ZC051/
1109 c #c007 --> -#3ff9, #c061 --> -#3f9f, #c051 --> -#3faf
1110 data mlphx1, mlphx2, mlphx3 / -x'3ff9', -x'3f9f',-x'3faf' /
1113 C----------POPRAWIENIE SLOW +3 I +4 W BLOKU SYSTEMOWYM
1116 C +3 - OSTATNIO UZYTY NUMER W SENSIE PREFIXSET
1117 IPMEM(NBLSYS+3) = IPMEM(NBLSYS+3)+4
1119 C **** UTWORZENIE KLASY SYSPP
1120 SYSPP = MLINCL (2, 3, NBLSYS, NBLSYS)
1121 IPMEM(NBLSYS+8) = SYSPP
1122 C **** UTWORZENIE KLASY PROCES
1123 PPROC = MLINCL(2469, 4, SYSPP, SYSPP)
1124 C --POPRAWIENIE NA COROUTINE
1125 CALL MSETB(PPROC, 0)
1126 IPMEM(PPROC) = mlphx1
1127 C **** UTWORZENIE KLASY SLOWNIK
1128 SLOW = MLINCL(1609, 5, SYSPP, PPROC)
1129 C **** UTWORZENIE KLASY SEMAFOR
1130 SEM = MLINCL(2477, 6, SYSPP, SLOW)
1132 C****** WNETRZE KLASY PROCES
1133 C ----WAITN: FUNCTION: PROCES
1137 PROT = MLINFP(2431, PFL, 1, 0, PPROC, PPROC, SEM)
1140 PAR = MLPAR(0, PPROC, 2, mlphx2 , PROT)
1143 C ----STOPAR: PROCEDURE(INPUT Z: SEMAFOR)
1147 PROT = MLINFP(2437, PFL, 1, 0, 0, PPROC, PREV)
1150 IPMEM(PFL) = MLPAR(0, SEM, 2, mlphx3 , PROT)
1151 C ----WAITP: FUNCTION(INPUT Y:PROCES): PROCES
1155 PROT = MLINFP(2443, PFL, 2, 0, PPROC, PPROC, PREV)
1158 IPMEM(PFL) = MLPAR(0, PPROC, 2, mlphx3 , PROT)
1159 PAR = MLPAR(0, PPROC, 4, mlphx2 , PROT)
1162 C ----STOPP: PROCEDURE
1163 PROT = MLINFP(2449, 0, 0, 0, 0, PPROC, PREV)
1165 C ----RESUMEP: PROCEDURE(INPUT X: PROCES)
1170 C BEZ TEJ DUPY FTS DAJE ZLY KOD WYNIKOWY
1171 PROT = MLINFP(2457, PFL, 1, 0, 0, PPROC, PREV)
1174 IPMEM(PFL) = MLPAR(0, PPROC, 2, mlphx3 , PROT)
1176 C ***** WNETRZE SLOWNIK (KLASA LINK JEST NIEWIDOCZNA!!!)
1177 C ----AMEMBER: FUNCTION: PROCES
1181 PROT = MLINFP(1325, PFL, 1, 0, PPROC, SLOW, PREV)
1184 PAR = MLPAR(0, PPROC, 2, mlphx2 , PROT)
1187 C ----DELETE: PROCEDURE(INPUT X: PROCES)
1191 PROT = MLINFP(2393, PFL, 1, 0, 0, SLOW, PREV)
1194 IPMEM(PFL) = MLPAR(0, PPROC, 3, Mlphx3 , PROT)
1195 C ----MIN: FUNCTION: PROCES
1199 PROT = MLINFP(835, PFL, 1, 0, PPROC, SLOW, PREV)
1202 PAR = MLPAR(0, PPROC, 2, MLphx2 , PROT)
1205 C ----EMPTY: FUNCTION: BOOLEAN
1209 PROT = MLINFP(1837, PFL, 1, 0, NRBOOL, SLOW, PREV)
1212 PAR = MLPAR(0, NRBOOL, 2,mlphx2 , PROT)
1215 C ----INSERT: PROCEDURE(INPUT X: PROCES)
1219 PROT = MLINFP(2405, PFL, 1, 0, 0, SLOW, PREV)
1222 IPMEM(PFL) = MLPAR(0, PPROC, 2, mlphx3 , PROT)
1224 C ***** WNETRZE SEMAFOR
1225 C ----UNLOCKP: PROCEDURE
1227 PROT = MLINFP(2413, 0, 0, 0, 0, SEM, PREV)
1229 C ----LOCKP: PROCEDURE
1231 PROT = MLINFP(2419, 0, 0, 0, 0, SEM, PREV)
1235 PROT = MLINFP(2421, 0, 0, 0, 0, SEM, PREV)
1237 C ----TSP: FUNCTION: BOOLEAN
1241 PROT =MLINFP(2425, PFL, 1, 0, NRBOOL, SEM, PREV)
1243 PAR = MLPAR(0, NRBOOL, 2, mlphx2 , PROT)
1247 C******I TO JUZ KONIEC INICJALIZACJI
1250 INTEGER FUNCTION MLINCL(HNAME, PREFNR, SL, PREV)
1251 C---------------------INICJUJE PROTOTYPY KLAS BIBLIOTECZNYCH Z SYSPP
1253 IMPLICIT INTEGER (A-Z)
1257 COMMON /BLANK/ COM(278),
1258 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1259 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1260 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1261 X LOCAL , OWN , OBJECT,
1263 cdsw DATA MLCLHEX1,MLCLHEX2,MLCLHEX3 /ZC003,ZA021,Z8000/
1264 c #c003 --> -#3ffd, #a021 --> -#5fdf, #8000 --> undef
1265 data mlchx1, mlchx2 /-x'3ffd', -x'5fdf' /
1266 mlchx2 = ishft(X'0001',15)
1269 MLINCL = MGETM(33, 41)+7
1270 PREFL = MGETM(1, 41)
1271 IPMEM(PREFL) = MLINCL
1272 IPMEM(MLINCL-6) = PREFNR
1274 CALL MSETB(MLINCL, PREFNR)
1275 IPMEM(MLINCL-1) = SL
1276 IPMEM(MLINCL) = mlchx1
1277 IPMEM(MLINCL+1) = mlchx2
1278 IPMEM(MLINCL+9) = mlchx3
1279 IPMEM(MLINCL+22) = PREFL
1280 IPMEM(MLINCL+23) = 1
1281 C----DOLACZENIE DO LISTY NEXTDECL
1282 IPMEM(PREV+2) = MLINCL
1283 XX = INSERT(HNAME, IPMEM(SL+10), 41)
1284 IPMEM(XX+2) = MLINCL
1287 INTEGER FUNCTION MLINFP (HNAME, FPLIST, FPLENG, NDIM, NTYPE,
1289 C-----------------------INICJUJE PROTOTYPY FUNKCJI I PROCEDUR Z SYSPP
1291 IMPLICIT INTEGER (A-Z)
1295 COMMON /BLANK/ COM(278),
1296 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1297 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1298 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1299 X LOCAL , OWN , OBJECT,
1301 cdsw DATA MLFPHEX1,MLFPHEX2/Z0201,Z0401/
1302 data mlfhx1, mlfhx2/x'0201',x'0401'/
1306 IF (NTYPE .EQ. 0) GOTO 100
1308 MLINFP = MGETM(29, 41)+5
1309 IPMEM(MLINFP-4) = NDIM
1310 IPMEM(MLINFP-3) = NTYPE
1311 C ---OPIS ATRYBUTU RESULT POWINIEN BYC WSTAWIONY NA ZEWNATRZ
1312 IPMEM(MLINFP) = mlfhx1
1315 100 MLINFP = MGETM(26, 41)+2
1316 IPMEM(MLINFP) = mlfhx2
1318 200 IPMEM(MLINFP-1) = SL
1320 IPMEM(MLINFP+3) = FPLIST
1321 IPMEM(MLINFP+4) = FPLENG
1322 C----DOLACZENIE DO NEXTDECL
1323 IPMEM(PREV+2) = MLINFP
1324 XX = INSERT(HNAME, IPMEM(I), 41)
1325 IPMEM(XX+2) = MLINFP
1328 INTEGER FUNCTION MLPAR (NDIM, NTYPE, OFF, ZERWRD, SL)
1329 C----------------WPROWADZA OPIS PARAMETRU FORMALNEGO WRAZ Z OFFSETEM
1331 IMPLICIT INTEGER (A-Z)
1335 COMMON /BLANK/ COM(278),
1336 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1337 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1338 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1339 X LOCAL , OWN , OBJECT,
1343 MLPAR = MGETM(6, 41)+4
1344 IPMEM(MLPAR-4) = NDIM
1345 IPMEM(MLPAR-3) = NTYPE
1347 IPMEM(MLPAR) = ZERWRD
1348 IPMEM(MLPAR+1) = OFF
1351 SUBROUTINE TORD (PRNR)
1352 C--------------PROCEDURA PORZADKUJACA TYPY KLASOWE DEKLAROWANE W PROTO-
1353 C TYPIE O ADRESIE PRNR . SORTOWANIE TOPOLOGICZNE ODBYWA SIE
1354 C ZE WZGLEDU NA PREFIKSOWANIE.
1355 C WYJSCIEM Z PROCEDURY JEST UPORZADKOWANA (W PROTOTYPIE PRNR)
1356 C LISTA TYPOW W KOLEJNOSCI OBROBKI DEKLARACJI. EWENTUALNE CYKLE
1358 C SYGNALIZOWANY BLAD:
1359 C 399 - TYPY KLASOWE TWORZA CYKL ZE WZGLEDU NA PREFIKSOWANIE
1361 C 398 - PREFIKS I TYP PREFIKSOWANY JEST TEN SAM
1363 C-----------------------------------------------------------------------------
1364 C POMOCNICZE STRUKTURY DANYCH
1366 C W CZASIE TWORZENIA GRAFU DO SORTOWANIA UZYWANA JEST LOKALNA TABLICA
1367 C HASH'U THASH. ELEMENT LISTY HASH'U BEDACY JEDNOCZESNIE ELEMENTEM
1368 C DO SORTOWANIA MA NASTEPUJACA BUDOWE:
1369 C --> 0 - NAZWA MODULU
1370 C +1 - LICZNIK ODWOLAN W CZSIE SORTOWANIA
1371 C +2 - POCZATEK LISTY NASTEPNIKOW, TZN. ELEMENTOW PREFIKSOWANYCH
1373 C +3 - NASTEPNY ELEMENT W LISCIE HASH-U
1374 C W CZASIE SORTOWANIA - FLAGA "PROCESSED"= 1 GDY ELEMENT JEST
1376 C +4 - NUMER PROTOTYPU W SLOWNIKU ISDICT,
1377 C 0 - GDY NAZWA OPISUJE PROTOTYP NIEZADEKLAROWANY W PRNR
1378 C -1 - GDY TYP DEKLAROWANY BYL WIELOKROTNIE
1379 C +5 - NEXTZERO - INDEKS NASTEPNEGO ELEMENTU Z ZEROWYM LICZNIKIEM
1380 C PO WSORTOWANIU - INDEKS ELEMENTU NASTEPNEGO W UTWORZONYM
1382 C +6 - INDEKS NASTEPNEGO ELEMENTU W LISCIE DO SORTOWANIA
1383 C (UZYWANY DO WYKRYCIA CYKLI)
1384 C +7 - ELEMENT DO SORTOWANIA ODPOWIADAJACY BEZPOSREDNIEMU
1385 C PREFIKSOWI (UZYWANY PRZY ROZRYWANIU CYKLI)
1387 C ELEMENT LISTY NASTEPNIKOW (WSKAZYWANEJ PRZEZ SLOWO +2) MA POSTAC
1388 C --> 0 - ELEMENT DO SORTOWANIA ODPOWIADAJACY TYPOWI PREFIKSOWANEMU,
1389 C 0 - GDY TEN NASTEPNIK ZOSTAL USUNIETY (ROZERWANY CYKL)
1390 C +1 - NASTEPNY ELEMENT LISTY
1392 C ELEMENTY WIELOKROTNIE DEKLAROWANE TWORZA POMOCNICZA LISTE WSKAZY-
1393 C WANA PRZEZ ZMIENNA ELIST POSTACI:
1394 C --> 0 - NUMER PROTOTYPU W SLOWNIKU ISDICT
1395 C +1 - NASTEPNY ELEMENT LISTY
1398 C TE STRUKTURY PRZECHOWYWANE SA W IPMEM ZA CZESCIA PRZEZNACZONA
1399 C NA PROROTYPY SYSTEMOWE. REZERWACJA PAMIECI JEST WYKONYWANA PRZEZ
1402 C-----------------------------------------------------------------------------
1406 C OPIS W DOKUMENTACJI: D.II.4.1
1407 C WERSJA Z DNIA: 19.01.82
1409 C..........................................................................
1411 IMPLICIT INTEGER (A-Z)
1415 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
1418 COMMON /BLANK/ COM(278),
1419 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1420 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1421 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1422 X LOCAL , OWN , OBJECT,
1425 COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1427 C.............................................................................
1428 C WSTEPNE ZBADANIE PROTOTYPU PRNR
1429 C SORTOWANIE NIE JEST WYKONYWANE, GDY LISTA TYPOW ZAWIERA MNIEJ NIZ
1433 IF (ILT .EQ. 0) RETURN
1434 IF ( IPMEM(ILT+1) .EQ. 0) GOTO 300
1436 C.............................................................................
1438 C INICJALIZACJA ZMIENNYCH
1447 C*******************************************
1448 C UTWORZENIE GRAFU POWIAZAN ORAZ LIST TYPOW DO SORTOWANIA
1452 C*******************************************
1453 C SORTOWANIE TOPOLOGICZNE
1455 IF (SNUMB .EQ. 0) GOTO 200
1456 C --LISTA DO SORTOWANIA JEST PUSTA
1459 C -- LACZENIE W LISTE ELEMENTOW Z ZEROWYM LICZNIKIEM
1462 IF (SNUMB .EQ. 0) GOTO 200
1463 C -- GDY SNUMB JEST ROZNE OD ZERA, TO ISTNIEJE CYKL. WOWCZAS
1464 C ROZERWANIE CYKLU I MODYFIKACJA GRAFU ORAZ LISTY ELEMENTOW
1465 C Z ZEROWYM LICZNIKIEM I PONOWNE SORTOWANIE
1470 C********************************************
1471 C ODTWORZENIE LISTY TYPOW W KOLEJNOSCI DO OBROBKI
1474 200 CALL TORDER(PRNR)
1478 C************************************************
1479 C SPRAWDZENIE, CZY TYP DO SORTOWANIA NIE JEST PREFIKSOWANY
1480 C PRZEZ SAMEGO SIEBIE
1481 300 ILT = IPMEM(ILT)
1482 C ILT - NUMER W ISDICT PROTOTYPU SORTOWANEGO
1484 C ILT - PROTOTYP SORTOWANY
1485 IF ( IPMEM(ILT+2) .EQ. NEMPTY) RETURN
1486 C PROTOTYP NIE JEST PREFIKSOWANY - POWROT
1487 NAME = IPMEM(ILT+10)
1488 IF ( NAME .NE. IPMEM(ILT+2) ) RETURN
1489 C NAZWY SA ROZNE - POWROT
1490 C ...SYGNALIZACJA BLEDU
1492 CALL MERR(398, NAME)
1493 IPMEM(ILT+2) = NEMPTY
1495 C ZAMARKOWANIE USZKODZONEJ LISTY PARAMETROW
1499 C--------------UTWORZENIE GRAFU POWIAZAN, LIST TYPOW DO SORTOWANIA
1500 C ORAZ WIELOKROTNIE DEKLAROWANYCH
1502 C OPIS W DOKUMENTACJI: D.II.4.2
1503 C WERSJA Z DNIA: 19.01.82
1505 C......................................................................
1507 IMPLICIT INTEGER (A-Z)
1508 cdsw INTEGER THASH(8)
1510 C POMOCNICZA TABLICA HASH-U
1514 COMMON /BLANK/ COM(278),
1515 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1516 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1517 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1518 X LOCAL , OWN , OBJECT,
1521 COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1524 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
1526 C ZNACZENIE ZMIENNYCH
1527 C ILT - ELEMENT LISTY DEKLAROWANYCH TYPOW
1528 C DICTN - NUMER PROTOTYPU W SLOWNIKU ISDICT
1529 C PRAD - ADRES PROTOTYPU W IPMEM
1531 C IHT - ELEMENT LISTY HASH-U
1538 C*****************************************************************************
1539 C PRZETWARZANIE ELEMENTU ILT Z LISTY TYPOW
1541 1000 DICTN = IPMEM(ILT)
1543 NAME = IPMEM(PRAD+10)
1544 IF (NAME .EQ. NEMPTY) GOTO 2500
1545 C NAZWA PUSTA - SKOK DO WPISANIA TYPU DO LISTY TYPOW ZLE
1547 C---------------------------------------------------------------------------
1548 C SPRAWDZENIE, CZY TYP NIE JEST PREFIKSOWANY SAM SOBA
1549 IF ( NAME .NE. IPMEM(PRAD+2) ) GOTO 1050
1550 LINE = IPMEM(PRAD+9)
1551 CALL MERR(398, NAME)
1552 IPMEM(PRAD+2) = NEMPTY
1555 C-----------------------------------------------------------------------------
1557 IHT = MEMBER(NAME, THASH)
1558 IF (IHT .EQ. 0) GOTO 1100
1559 C.....TU - NAZWA JUZ WYSTEPUJE W LISCIE HASH-U
1560 C SPRAWDZENIE ,CZY POPRZEDNIE WYSTAPIENIE NIE BYLO DEKLARACJA NAZWY,
1561 C JESLI TAK -TO BLAD
1562 IF ( IPMEM(IHT+4) .NE. 0) GOTO 2000
1563 C BYLA WCZESNIEJ DEKLAROWANA, SKOK DO ZLE ZADEKLAROWANEGO TYPU
1566 C-----------------------------------------------------------------------------
1567 C TWORZENIE NOWEGO ELEMENTU LISTY DO SORTOWANIA
1568 1100 IHT = MGETM(8,0)
1570 I = IAND (ISHFT(NAME,-1), 7) + 1
1571 IPMEM(IHT+3) = THASH(I)
1573 C WLACZENIE DO LISTY TYPOW DO SORTOWANIA
1574 IPMEM(IHT+6) = SLIST
1577 C WPISANIE NUMERU PROTOTYPU
1578 1200 IPMEM(IHT+4) = DICTN
1580 C-----------------------------------------------------------------------------
1581 C SPRAWDZENIE PREFIKSOWANIA
1582 C INP - NAZWA BEZPOSREDNIEGO PREFIKSU
1584 IF (INP .EQ. 0) GOTO 5000
1585 C TYP NIE JEST PREFIKSOWANY - SKOK DO POBRANIA NASTEPNEGO
1586 C ELEMENTU LISTY TYPOW
1587 C-----------------------------------------------------------------------------
1588 C WYSZUKANIE NAZWY PREFIKSU
1589 C PRAD - ELEMENT DO SORTOWANIA ODPOWIADAJACY PREFIKSOWI
1590 PRAD = MEMBER (INP, THASH)
1591 IF (PRAD .NE. 0) GOTO 1300
1592 C SKOK, GDY ELEMENT ODPOWIADAJACY PREFIKSOWI JEST JUZ
1593 C W LISCIE DO SORTOWANIA
1594 C WPROWADZENIE NOWEGO OPISU
1597 I = IAND (ISHFT(INP,-1), 7) + 1
1598 IPMEM(PRAD+3) = THASH(I)
1600 IPMEM(PRAD+6) = SLIST
1603 C--------UTWORZENIE POWIAZANIA
1606 IPMEM(I+1) = IPMEM(PRAD+2)
1610 C-------PRZEJSCIE DO POBIERANIA NASTEPNEGO ELEMENTU LISTY TYPOW
1613 C-----------------------------------------------------------------------------
1614 C TYPY ZLE ZADEKLAROWANE
1616 C------TYPY DEKLAROWANE WIELOKROTNIE
1617 2000 IF ( IPMEM(IHT+4) .EQ. -1) GOTO 2500
1618 C-------PRZESUNIECIE TYPU WCZESNIEJ DEKLAROWANEGO DO LISTY TYPOW
1619 C ZLE ZADEKLAROWANYCH
1625 IPMEM(IHT+1) = ELIST
1627 C-------USUNIECIE KRAWEDZI W PREFIKSIE TEGO TYPU
1629 C IHT - GDY ROZNE OD ZERA JEST OPISEM ELEMENTU ODPOWIADAJACEGO
1631 IF (IHT .EQ. 0) GOTO 2500
1632 C.....USUNIECIE KRAWEDZI W LISCIE NASTEPNIKOW PREFIKSU
1634 C IHT - ELEMENT LISTY NASTEPNIKOW
1635 2100 IF (IHT .EQ. 0) GOTO 2500
1636 IF ( IPMEM(IHT) .EQ. INP) GOTO 2200
1637 C TO BYL ELEMENT ODPOWIADAJACY POLACZENIU
1642 C------DOLACZENIE AKTUALNEGO TYPU DO LISTY TYPOW ZLE ADEKLAROWANYCH
1643 2500 IHT = MGETM(2,0)
1645 IPMEM(IHT+1) = ELIST
1647 C-----------------------------------------------------------------------------
1648 C POBRANIE NASTEPNEGO ELEMENTU LISTY TYPOW
1649 5000 ILT = IPMEM(ILT+1)
1650 IF (ILT .NE. 0) GOTO 1000
1651 C*****************************************************************************
1655 C--------------LACZENIE W LISTE ROZPOCZYNAJACA SIE OD ZFIRST
1656 C ELEMENTOW Z ZEROWYM LICZNIKIEM.
1657 C ///PRZY OKAZJI USUNIECIE W PROTOTYPACH PREFIKSOW ODPOWIADAJACYCH
1658 C TYPOM WIELOKROTNIE DEKLAROWANYM
1660 C OPIS W DOKUMENTACJI: D.II.4.3
1661 C WERSJA Z DNIA: 19.01.82
1663 C........................................................................
1665 IMPLICIT INTEGER (A-Z)
1669 COMMON /BLANK/ COM(278),
1670 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1671 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1672 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1673 X LOCAL , OWN , OBJECT,
1676 COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1680 C*****************************************************************************
1681 1000 IPR = IPMEM(I+7)
1682 IF ( IPMEM(IPR+4) .NE. -1) GOTO 1100
1683 C--------USUNIECIE PREFIKSU Z PROTOTYPU , GDY PREFIKS
1684 C BYL TYPEM ZLE ZADEKLAROWANYM
1687 IPMEM(IPR+2) = NEMPTY
1689 C ZAMARKOWANIE BLEDNEJ LISTY PARAMETROW
1691 1100 IF (IPMEM(I+1) .NE. 0) GOTO 1500
1695 C USTAWIENIE FLAGI "PROCESSED"
1696 C------POBRANIE NASTEPNEGO ELEMENTU LISTY DO SORTOWANIA
1698 IF (I .NE. 0) GOTO 1000
1699 C*****************************************************************************
1703 C--------------SORTOWANIE TOPOLOGICZNE - CZESC WLASCIWA
1705 C OPIS W DOKUMENTACJI: D.II.4.4
1706 C WERSJA Z DNIA: 19.01.82
1708 C...................................................................
1710 IMPLICIT INTEGER (A-Z)
1714 COMMON /BLANK/ COM(278),
1715 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1716 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1717 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1718 X LOCAL , OWN , OBJECT,
1721 COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1724 C ILT - ROZPATRYWANY ELEMENT Z ZEROWYM LICZNIKIEM
1726 IF (ILT .EQ. 0) RETURN
1727 ZFIRST = IPMEM(ILT + 5)
1728 IPMEM(OUTORD+5) = ILT
1731 C USTAWIENIE FLAGI "PROCESSED"
1733 C ZMNIEJSZENIE LICZNIKOW ELEMENTOM PREFIKSOWANYM
1735 C ....SPRAWDZENIE, CZY SORTOWANY PROTOTYP NIE JEST PROTOTYPEM
1736 C ZLYCH DEKLARACJI - DLA NIEGO NIE MA ELEMENTOW PREFIKSOWANYCH
1737 IF (IPMEM(ILT+4) .EQ. -1) GOTO 1500
1738 C INE - ELEMENT LISTY NASTEPNIKOW
1740 1100 IF (INE .EQ. 0) GOTO 1500
1742 IF (I .EQ. 0) GOTO 1200
1743 C SKOK, GDY POLACZENIE JEST OMINIETE
1744 C I -ELEMENT ODPOWIADAJACY TYPOWI PREFIKSOWANEMU
1748 C POBRANIE NASTEPNEGO ELEMENTU LISTY NASTEPNIKOW
1749 1200 INE = IPMEM(INE+1)
1751 C-------POBRANIE NASTEPNEGO ELEMENTUU DO SORTOWANIA
1755 C--------------PROCEDURA ROZRYWANIA CYKLI W LISCIE TYPOW DO
1757 C ZNAJDUJE TYP NAJWCZESNIEJ DEKLAROWANY, USUWA MU PREFIKS
1758 C I MODYFIKUJE GRAF DO SORTOWANIA
1759 C SYGNALIZOWANY BLAD:
1760 C 399 - WYSTAPIENIE CYKLU W PREFIKSOWANIU
1762 C OPIS W DOKUMENTACJI: D.II.4.5
1763 C WERSJA Z DNIA: 19.01.82
1765 C..................................................................
1767 IMPLICIT INTEGER (A-Z)
1771 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
1774 COMMON /BLANK/ COM(278),
1775 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1776 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1777 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1778 X LOCAL , OWN , OBJECT,
1781 COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1784 C ILT - ELEMENT LISTY DO SORTOWANIA ODPOWIADAJACY NAJWCZESNIEJ
1785 C DEKLAROWANEMU PROTOTYPOWI
1786 C LMIN - NUMER NAJWCZESNIEJSZEJ LINII
1787 C IE - AKTUALNY ELEMENT LISTY DO SORTOWANIA
1791 C NAJWIEKSZA STALA CALKOWITA
1792 C*****************************************************************************
1794 IF (IPMEM(IE+3) .EQ. 1) GOTO 1500
1795 C SKOK, GDY TEN TYP JEST JUZ PRZETWORZONY
1798 C IPR - PROTOTYP TYPU ODPOWIADAJACEGO IE
1800 IF (LINE .GT. LMIN) GOTO 1500
1801 C....TU POTENCJALNY KANDYDAT NA USUNIECIE CYKLU
1802 C SPRAWDZENIE, CZY TEN ELEMENT WYSTEPUJE W CYKLU
1805 1100 IPMEM(ILOOP+3) = -1
1806 ILOOP = IPMEM(ILOOP+7)
1807 C TO JEST PREFIKS ILOOP
1808 IF (IPMEM(ILOOP+3) .NE. -1) GOTO 1100
1809 IF (ILOOP .NE. IE) GOTO 1200
1810 C --WYSTAPIL W CYKLU
1813 C --PRZYWROCENIE STAREGO MARKOWANIA CYKLU
1815 1300 IPMEM(ILOOP+3) = 0
1816 ILOOP = IPMEM(ILOOP+7)
1817 IF (IPMEM(ILOOP+3) .NE. 0) GOTO 1300
1818 C---------POBRANIE NASTEPNEGO ELEMENTU LISTY DO SORTOWANIA
1819 1500 IE = IPMEM(IE+6)
1820 IF (IE .NE. 0) GOTO 1000
1822 C*****************************************************************************
1823 C ILT JEST PROTOTYPEM TYPU NAJWCZESNIEJ DEKLAROWANEGO
1826 NAME = IPMEM(IPR+10)
1828 C ...SYGNALIZACJA BLEDU
1829 CALL MERR(399, NAME)
1830 C......USUNIECIE PREFIKSU
1832 C......"USZKODZENIE" LISTY PARAMETROW
1834 C.....WSTAWIENIE DO LISTY ELEMENTOW Z ZEROWYM LICZNIKIEM
1836 C------USUNIECIE POWIAZANIA Z PREFIKSEM
1838 C IPR - ELEMENT LISTY DO SORTOWANIA ODPOWIADAJACY PREFIKSOWI
1840 C LISTA NASTEPNIKOW PREFIKSU
1841 2000 IF (IPMEM(IPR) .EQ. ILT) GOTO 2100
1847 SUBROUTINE TORDER (PRNR)
1848 C------------WPISANIE DO LISTY TYPOW PRNR TYPOW TAM DEKLAROWANYCH
1849 C W KOLEJNOSCI OBROBKI DEKLARACJI
1851 C OPIS W DOKUMENTACJI: D.II.4.6
1852 C WERSJA Z DNIA: 19.01.82
1854 C.........................................................................
1857 IMPLICIT INTEGER(A-Z)
1861 COMMON /BLANK/ COM(278),
1862 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1863 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1864 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1865 X LOCAL , OWN , OBJECT,
1868 COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1872 C ILT - ELEMENT LISTY TYPOW DEKLAROWANYCH
1874 C*****************************************************************************
1875 C WPISANIE TYPOW Z LISTY INORD (NA POCZATKU JEST STRAZNIK)
1876 1000 INORD = IPMEM(INORD+5)
1877 IF (INORD .EQ. 0) GOTO 2000
1878 IF (IPMEM(INORD+4) .LE. 0) GOTO 1000
1879 C -OMINIECIE TYPOW NIELOKALNYCH
1880 IPMEM(ILT) = IPMEM(INORD+4)
1883 C*****************************************************************************
1884 C WPISANIE TYPOW Z LISTY TYPOW ZLE ZADEKLAROWANYCH
1885 2000 IF (ELIST .EQ. 0) RETURN
1886 IPMEM(ILT) = IPMEM(ELIST)
1887 ELIST = IPMEM(ELIST+1)