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 ===============================================================
18 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
19 C ( BYLY ) PROGRAM GLOWNY
20 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
22 IMPLICIT INTEGER (A - Z )
25 COMMON /MJLMSG/ IERC,MSG
32 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
34 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
40 cdeb --------------------- added -------------------
41 common /debug/ deb, breakt(500),brnr,maxbr
43 cdeb ------------------------------------------------
50 C SUBROUTINE INIT RENAMED TO INITMK 03.01.84 **********************
57 cdeb ------------- added --------------
58 if(deb.and..not.errflg) go to 1000
62 cdeb ----------------------------------
66 IMPLICIT INTEGER (A-Z)
69 common /pr/ prot(5000),ind
70 c prot - tablica na prototypy debuggera
71 c ind - ostatnie zajete miejsce w tablicy
75 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
76 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
77 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW, INOUT
79 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
80 C NULLWD(I) - WZORZEc SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
81 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
82 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
83 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
84 C VARWD - -- -- -- -- DLA ZMIENNEJ
85 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
86 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
87 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
88 C INOUT - -- -- -- --- ZMIENNEJ INOUT
91 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
92 * MPROCES, MCOR, MERPF, MBLOCK, MHAND
95 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
97 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
98 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
99 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
100 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
101 C MASKTP - ZAPRZECZENIE MASKI MTP
102 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
103 C MPROCES - WZORZEC DLA PROCESU ( 5 )
104 C MCOR - WZORZEC DLA COROUTINY (7)
105 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
106 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
107 C MNOTVIR - WZORZEC DO KASOWANIA BITU "VIRTUAL"
108 C MHAND - WZORZEC DLA HANDLERA
111 cdeb------------------------------------------
112 cdeb COMMON /NAMES/ RESNM,MAINM
113 common /names/ resnm,mainm,brenam
114 cdeb------------------------------------------
117 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
120 C COMMON / WYDR / KD(8), KSP(4)
123 C BLOK UZYWANY W PROCEDURYCH DRUKUJACYCH.
124 C KD(KIND+1) - ODPOWIEDNI TEKST DLA PROTOTYPU RODZAJU KIND
125 C KSP(KSPEC+1) - ODPOWIEDNI TEKST DLA PROTOTYPU RODZAJU KSPEC.
126 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
128 C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
129 C RODZAJE PROTOTYPOW:
130 C 1 - BLOK, 2 - REKORD, 3 - PROCEDURA, 4 - FUNKCJA, 5 - PROC. Z BLEDNA PF
131 C 6 - FUNKCJA Z BLEDNA LISTA PF, 7 - KLASA Z BLEDNA LISTA PF
132 C 8 - BLOK PREFIKSOWANY, 9 - PROCEDURA VIRTUALNA, 10 I FUNKCJA VIRTUALNA
133 C 11 - PROC. VIRTUALNA Z BLEDNA PF, 12 - FUNKCJA VIRTUALNA Z BLEDNA PF
134 C 13 - PROCEDURA FORMALNA, 14 - FUNKCJA FORMALNA, 15 - PROC. FORMALNA
135 C Z BLEDNA LISTA PF, 16 - FUNKCJA FORMALNA Z BLEDNA LISTA PF,
136 C 17 - TYP FORMALNY, 18 - PROCEDURA FORMALNA II-GO RZEDU,
137 C 19 - FUNKCJA FORMALNA II-GO RZEDU
138 C 20 - TYP FORMALNY II-GO RZEDU
139 C 21 - SYGNAL, 22 - SYGNAL Z USZKODZONA LISTA PF, 23 - HANDLER
140 C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
143 DATA SIZEPR/23,33,28,31,28,31,33,28,30,33,30,33,20,23,20,23,
144 * 5,5,7,5,19, 19, 21/
145 DATA NULLPOZ/2,7,2,5,2,5,7,2,2,5,2,5,2,5,2,5,2,2,4,2,1,1,2/
146 DATA CONSTWD,VARWD,VARPOM,INPFW,OUTPFW / 129,113,65,81,97 /
148 DATA NOTTP,MPROCES,MCOR,MBLOCK /1,5,7,0 /
149 C DATA KD(1) /5HTYP F/
151 C DATA KD(3) / 4HFUN /
152 C DATA KD(4) / 4HPROC/
153 C DATA KD(5) / 4HBLOK/
154 C DATA KD(6) /4HBLPR/
155 C DATA KD(7) /6HSIGNAL/
156 C DATA KD(8) /5HHANDL/
157 C DATA KSP(1) /4HREK /
158 C DATA KSP(2) / 4HKLAS/
159 C DATA KSP(3) / 4HPRSS/
160 C DATA KSP(4) / 4HCORO/
161 DATA RESNM,MAINM / 2769,819 /
162 cdeb ------------- added ---------------
164 cdeb ----------------------------------
165 DATA NULLWD / 1,2,1025,513,9217,8705,8194,257,3073,2561,11265,
166 * 10753,1073,545,9265,8737,22,1073,545,22,177,8369,1793/
168 data prot /5000*-100/
173 C * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * *
174 C PODPROGRAM REALIZUUACY PRZETWARZANIE PROTOTYPOW
175 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
177 IMPLICIT iNTEGER (A-Z)
179 COMMON / QUEUE / BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
180 cdsw INTEGER BQUEUE, EQUEUE
183 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
184 C ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
185 C BQUEUE - POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
186 C EQUEUE - KONIEC -- -- -- -- --
187 C IFIRST - PIERWSZY ELEMENT KOLEJKI
188 C LAST - OSTATNI ELEMENT KOLEJKI
189 C EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
193 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
194 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
195 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
197 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
198 C NULLWD(I) - WZORZEc SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
199 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
200 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
201 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
202 C VARWD - -- -- -- -- DLA ZMIENNEJ
203 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
204 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
205 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
206 C INOUT - -- -- -- -- --- ZMIENNEJ INOUT
209 C ..... ZMIENNE GLOBALNE
213 COMMON /BLANK/ COM(278),
214 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
215 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
216 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
217 X LOCAL , OWN , OBJECT,
220 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
221 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
222 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
223 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
224 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
226 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
227 C NACZONEGO NA PROTOTYPY SYSTEMOWE
228 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
229 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
231 C IDENTYFIKATORY PROTOTYPOW SYSTEMOWYCH
232 C NRINT - IDENTYFIKATOR PROTOTYPU INTEGER
238 C NRTEXT - STRING (TEXT)
239 C NRUNIV - IDENTYFIKATOR PROTOTYPU UNIWERSALNEGO
240 C NATTR - IDENTYFIKATOR PSEUDO-ATRYBUTU (Z NUMEREM -1)
241 C NRNONE - IDENTYFIKATOR PROTOTYPU TYPU NONE (UNIWERSALNY
243 C NBLSYS - IDENTYFIKATOR BLOKU SYSTEMOWEGO
244 C NBLUS - BLOKU GLOWNEGO UZYTKOWNIKA
246 C INSYS - FLAGA SPOSOBU REZERWACJI (PRZEZ MGETM) PAMIECI
247 C W IPMEM - .TRUE. JESLI REZERWACJA W CZESCI SYSTE-
249 C LOCAL - FLAGA DOSTEPU DO OBIEKTOW - 2 JESLI OBIEKT
250 C BYL LOKALNY, 1 - GDY Z SL, 0 - GDY Z BLOKU GLOWNEGO
251 C OWN - FLAGA DOSTEPU DO OBIEKTOW - .TRUE. JESLI OBIEKT NIE
252 C POCHODZI Z PREFIKSOW (TYLKO Z WLASCIWEGO OBIEKTU)
253 C OBJECT - PROTOTYP OBIEKTU, Z KTOREGO POCHODZIL OSTATNIO
254 C SZUKANY IDENTYFIKATOR (OBIEKT POCHODZACY Z CIAGU SL)
258 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
260 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
261 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
262 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W IDICT
263 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
264 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
265 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
266 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
268 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
271 cdeb COMMON/NAMES/RESNM,MAINM
272 cdeb -------------------------------------
273 common /names/ resnm, mainm, brenam
274 cdeb ------------------------------------
278 COMMON /PREFS/ LPREFS
280 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
281 C LPREFS - OSTATNIO PRZYDZIELONY NUMER W PREFIXSET
285 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
287 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
289 c system class prototypes:
290 common /syspro/ prgraph, prmouse
293 C UTWORZENIE PROTOTYPU BLOKU GLOWNEGO
298 C USTAWIENIE SL BLOKU GLOWNEGO NA SYSTEMOWY
299 IPMEM(NBLUS-1) = NBLSYS
301 ipmem(nblus+2) = prgraph
302 ipmem(prgraph+2) = prmouse
305 C DOLACZENIE NAZWY I ATRYBUTU MAIN
309 CALL MADATR(I,NBLUS,41)
312 K=IDPUT(MAINM,IPMEM(NBLUS+10))
314 CALL DPUTQ(LPMEM,NBLUS)
315 100 IF(EMPTY) GO TO 300
321 C KONIEC PRZETWARZANIA PROTOTYPOW
322 IPMEM(NBLSYS+3) = LPREFS
323 C ... PRZECHOWANIE INFORMACJI O LICZBIE KLAS
328 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
329 C INICJALIZACJA LOKALNA
330 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
332 IMPLICIT INTEGER(A-Z)
335 cdsw ------------------------------------------------
336 common/signs/nrsig,hliste
337 cdsw -----------------------------------------------
338 cdsw COMMON /SIGNALS/ NRSIG, HLISTE
340 C NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
341 C HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
345 COMMON / QUEUE / BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
346 cdsw INTEGER BQUEUE, EQUEUE
349 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
350 C ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
351 C BQUEUE - POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
352 C EQUEUE - KONIEC -- -- -- -- --
353 C IFIRST - PIERWSZY ELEMENT KOLEJKI
354 C LAST - OSTATNI ELEMENT KOLEJKI
355 C EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
358 COMMON /PREFS/ LPREFS
360 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
361 C LPREFS - OSTATNIO PRZYDZIELONY NUMER W PREFIXSET
364 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
365 * MPROCES, MCOR, MERPF, MBLOCK, MHAND
368 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
370 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
371 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
372 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
373 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
374 C MASKTP - ZAPRZECZENIE MASKI MTP
375 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
376 C MPROCES - WZORZEC DLA PROCESU ( 5 )
377 C MCOR - WZORZEC DLA COROUTINY (7)
378 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
379 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
380 C MNOTVIR - MASKA DO KASOWANIA BITU "VIRTUAL"
383 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
384 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
385 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW, INOUT
387 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
388 C NULLWD(I) - WZORZEc SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
389 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
390 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
391 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
392 C VARWD - -- -- -- -- DLA ZMIENNEJ
393 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
394 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
395 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
396 C INOUT - -- -- -- --- ZMIENNEJ INOUT
399 C ..... ZMIENNE GLOBALNE
403 COMMON /BLANK/ COM(278),
404 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
405 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
406 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
407 X LOCAL , OWN , OBJECT,
410 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
411 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
412 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
413 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
414 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
416 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
417 C NACZONEGO NA PROTOTYPY SYSTEMOWE
418 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
419 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
421 C IDENTYFIKATORY PROTOTYPOW SYSTEMOWYCH
422 C NRINT - IDENTYFIKATOR PROTOTYPU INTEGER
428 C NRTEXT - STRING (TEXT)
429 C NRUNIV - IDENTYFIKATOR PROTOTYPU UNIWERSALNEGO
430 C NATTR - IDENTYFIKATOR PSEUDO-ATRYBUTU (Z NUMEREM -1)
431 C NRNONE - IDENTYFIKATOR PROTOTYPU TYPU NONE (UNIWERSALNY
433 C NBLSYS - IDENTYFIKATOR BLOKU SYSTEMOWEGO
434 C NBLUS - BLOKU GLOWNEGO UZYTKOWNIKA
436 C INSYS - FLAGA SPOSOBU REZERWACJI (PRZEZ MGETM) PAMIECI
437 C W IPMEM - .TRUE. JESLI REZERWACJA W CZESCI SYSTE-
439 C LOCAL - FLAGA DOSTEPU DO OBIEKTOW - 2 JESLI OBIEKT
440 C BYL LOKALNY, 1 - JESLI POCHODZIL Z SL, 0 - GDY Z BL. GL.
441 C OWN - FLAGA DOSTEPU DO OBIEKTOW - .TRUE. JESLI OBIEKT NIE
442 C POCHODZI Z PREFIKSOW (TYLKO Z WLASCIWEGO OBIEKTU)
446 C INICJALIZACJA ZMIENNYCH Z BLOKOW WSPOLNYCH, KTORE NIE SA
447 C INICJALIZOWANE W BLOCK DATA
450 C NADANIE APETYTOW DLA TYPOW FORMALNYCH
451 C DLA TYPOW FORMALNYCH - BIT 14 JEST ZAPALONY
453 NULLWD(17) = IOR ( NULLWD(17),MTP )
454 NULLWD(20) = IOR ( NULLWD(20),MTP )
455 C DLA POCEDUR/FUNKCJI FORMALNYCH - BIT 15 JEST ZAPALONY
457 NULLWD(13) = IOR (NULLWD(13),MTP )
458 NULLWD(14) = IOR (NULLWD(14),MTP )
459 NULLWD(15) = IOR ( NULLWD(15),MTP )
460 NULLWD(16) = IOR ( NULLWD(16),MTP )
461 NULLWD(18) = IOR ( NULLWD(18),MTP )
462 NULLWD(19) = IOR ( NULLWD(19),MTP )
465 BQUEUE=MGETM(LMEM/50,341)
472 cdsw LPREFS=IPMEM(NBLSYS+3)
483 MHAND = ISHFT ( 7,8 )
489 C INICJALIZACJA ZMIENNYCH GLOBALNYCH - CHWILOWA
495 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
496 C PODPROGRAM SLUZY DO PRZETWARZANIA(OSTATECZNEGO) PROTOTYPU,
497 C RAZEM Z PRZETWARZANIEM ZEWNETRZNYM ( WSTEPNYM) JEGO ATRYBUTOW LOKALNYCH.
498 C PROTOTYP JEST ZADANY PRZEZ ZMIENNE Z BLOKU /DGLOB/
499 C PIERWSZA CZESC PRZETWARZANIA
500 C ** ** ** ** ** ** ** ** ** ** * ** ** ** ** ** ** **
502 IMPLICIT INTEGER (A-Z)
505 C BECAUSE OF TYPECONFLICT 03.01.84
507 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
509 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
510 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
511 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
512 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
513 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
514 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
515 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
517 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
520 C ..... ZMIENNE GLOBALNE
524 COMMON /BLANK/ COM(278),
525 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
526 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
527 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
528 X LOCAL , OWN , OBJECT,
534 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
535 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
536 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
538 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
539 C NULLWD(I) - WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
540 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
541 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
542 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
543 C VARWD - -- -- -- -- DLA ZMIENNEJ
544 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
545 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
546 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
547 C INOUT - -- -- -- -- ZMIENNEJ INOUT
550 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
551 * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
553 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
555 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
556 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
557 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
558 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
559 C MASKTP - ZAPRZECZENIE MASKI MTP
560 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
561 C MPROCES - WZORZEC DLA PROCESU ( 5 )
562 C MCOR - WZORZEC DLA COROUTINY (7)
563 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
564 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
568 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
570 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
576 cdeb COMMON /NAMES/ RESNM, MAINM
577 cdeb ----------------------------------
578 common /names/ resnm, mainm,brenam
579 cdeb --------------------------------
590 C HAND - CZY TO JEST PROTOTYP HANDLERA
593 C NADANIE WARTOSCI POZOSTALYM ZMIENNYM Z BLOKU /DGLOB/
594 INDSPR = IPMEM(INDICT)
598 IF ( IAND(I,MOTHERS) .EQ. MHAND ) HAND = .TRUE.
599 INDPREF = IPMEM(INDPR+21)
600 C JESLI BLOK LUB HANDLER - TO ZERO
601 IF(IAND(I,MTP).EQ.NOTTP.AND.IAND(I,MOTHERS).EQ.MBLOCK.OR.HAND)
604 C PRZEPISANIE INFORMACJI DLA ANDRZEJA
605 IPMEM(INDPR+8)=IPMEM(INDSPR-3)
606 IPMEM(INDPR+9)=IPMEM(INDSPR-2)
607 IPMEM(INDPR+18)=IPMEM(INDSPR-1)
608 C EWENTUALNE POPRAWIENIE SPECYFIKACJI - JESLI PREFIKS
610 IF(INDPREF.EQ.0) GO TO 50
611 IF(BTEST(IPMEM(INDPREF),0)) CALL CHECK(INDPR)
613 C JESLI JEST LISTA TAKEN - TO BLAD
617 CALL MERR(310,NEMPTY)
621 C---- ---------------------------------------------------------------
622 C PRZETWARZANIE NAGLOWKA
625 C ----------------------------------------------------------------
626 C DLA PROCESU - SPRAWDZENIE, CZY NIE MA PF OUTPUT LUB INOUT
628 cbc check if parameters fit into one message
630 I = IAND(IPMEM(INDPR),MTP)
631 IF(I.NE.MPROCES) GO TO 70
637 cbc check if first parameter is integer
640 tp = iand(ipmem(p), mtp)
641 if (tp .eq. mproces) goto 81
644 c p = address of first process prototype in prefix sequence
647 if (p .eq. 0) goto 82
648 if (l .eq. ipmem(p+4)) goto 76
651 c i = address of first parameter of process
652 if (ipmem(ipmem(i)-3) .eq. nrint) goto 75
653 line = ipmem(indspr+9)
654 call merr(370, nempty)
663 C NM - IDENTYFIKATOR PARAMETRU
665 c check for formal type
666 zp = ishft(iand(ipmem(nm), mpar), -4)
667 if (zp .eq. 1) goto 74
668 c check for formal procedure
669 if (zp .eq. 3) goto 73
671 if (ipmem(nm-4) .gt. 0) goto 74
672 tp = iand(ipmem(ipmem(nm-3)), mtp)
673 c check if formal parameter type is process or int,real,char,bool,string
674 cpat if (tp .eq. mproces .or. tp .eq. 8 .or. tp .eq. 10 .or.
675 cpat * tp .eq. 12) goto 78
677 74 line = ipmem(indspr+9)
678 call merr(370 ,nempty)
681 c compute formal parameter appetite in bytes
682 if (zp .eq. 2) goto 73
684 ap = sapet(0, ipmem(nm-3))
685 if (ap .eq. 4) ap = 2
687 c formal procedure or function
692 c NM = ISHFT(IAND(IPMEM(NM),MPAR),-4)
693 c IF(NM.NE.6.AND.NM.NE.9) GO TO 77
694 c BLAD - JEST PARAMETR OUTPUT LUB INOUT
695 c LINE = IPMEM(INDSPR+9)
696 c CALL MERR(370,NEMPTY)
701 if (.not. btest(opt, 12)) maxap = 34
702 if ( btest(opt, 12)) maxap = 15
703 if (apet .le. maxap) goto 70
704 line = ipmem(indspr+9)
705 call merr(370, nempty)
707 76 line = ipmem(indspr+9)
708 call merr(370, nempty)
711 C -----------------------------------------------------------------
712 C PRZETWARZANIE WSTEPNE LOKALNYCH PROTOTYPOW -- ETAP I
714 C POM = FALSE, GDY PRZETWARZAMY TYPY
715 C POM = TRUE, GDY PRZETWARZAMY PROCEDURY/FUNKCJE/BLOKI/HANDLERY
718 100 IF(I.EQ.0) GO TO 200
721 C J - IDENTYFIKATOR PROTOTYPU LOKALNEGO W ISMEM
722 C NM - NAZWA PROTOTYPU
724 IF(IPMEM(J).NE.1 .AND. IPMEM(J).NE.8) NM=IPMEM(J+10)
725 C OKRESLENIE RODZAJU PROTOTYPU ( W SENSIE BLOKU INIT)
729 C WYKRYCIE BLOKU PREFIKSOWANEGO
730 IF(K.EQ.1.AND.IPMEM(J+2).NE.0) K=8
733 C INSERTION OF LAST STATEMENT DUE TO CORRECTION GIVEN TO ME IN WARSAW
734 C IF(BTEST(IPMEM(J+8),15)) K=K+6
735 C INSERTION OF THE FOLLOWING STATEMENTS DUE TO CORRECTIONS (SEE ABOVE)
736 IF (.NOT. BTEST(IPMEM(J+8),15) ) GOTO 110
737 IF (K.LT.3.OR.K.GT.6) GOTO 120
739 IF (INDPREF.NE.0) GOTO 110
740 IF (IAND(IPMEM(INDPR),MTP).NE.NOTTP) GOTO 110
744 120 CALL MERR(329,NM)
745 C END OF INSERTION OF STATEMENTS
748 C DELETION OF PREVIOUS STATEMENT DUE TO CORRECTION
751 C INSERTION OF LABEL 110 DUE TO CORRECTIONS
752 C W POLU SL PROTOTYPU (W ISMEM) ZAPAMIETUJEMY JEGO IDENTYFIKATOR
755 C PRZEJSCIE DO NASTEPNEGO PROTOTYPU W LISCIE
758 C PRZETWARZANIE BLOKOW, FUNKCJI I PROCEDUR
759 200 IF(POM) GO TO 300
762 C JESLI PROTOTYP ZAWIERA BLOKI, FUNKCJE LUB PROCEDURY, TO ZMIENIAMY
763 C MU KWALIFIKACJE NA PELNA KLASE
764 IF(I.NE.0) CALL CHECK(INDPR)
770 C ------------------------------------------------------------------------
771 C PRZETWARZANIE LISTY SYGNALOW
774 350 IF (I.EQ.0) GO TO 500
778 C UTWORZENIE PROTOTYPU
780 C ZAPAMIETANIE IDENTYFIKATORA PROTOTYPU SEMANTYCZNEGO
788 C JESLI HANDLER TO KONIEC
789 IF ( HAND ) GO TO 1100
790 C --- --- --- --- --- --- --- --- --- --- --- --- ---- -----
791 C PRZETWARZANIE LISTY STALYCH
794 600 IF(I.EQ.0) GO TO 700
796 C J - IDENTYFIKATOR OPISU STALEJ
798 C THIS AND THE NEXT 3 LINES ARE IRRELEVANT 8.5.84
799 C SZUKAMY TYPU STALEJ - ZAKLADAMY POPRAWNOSC TYPU
800 C ZERO OZNACZA STALA ZDEFINIOWANA PRZEZ WYRAZENIE
801 IF(IPMEM(I+2).EQ.0)GO TO 630
803 C TYLKO DLA STALEJ TEKSTOWEJ :
804 K=MEMBER(IPMEM(I+2),IPMEM(NBLSYS+10))
805 C LAST STATEMENT CHANGED TO COMMENT DUE TO CORRECTIONS FROM WARSAW 8.5.84
806 C THIS AND THE NEXT 2 LINES ARE IRRELEVANT 8.5.84
807 IPMEM(J-3)=IPMEM(K+2)
808 C LAST STATEMENT CHANGED TO COMMENT DUE TO CORRECTIONS FROM WARSAW 8.5.84
809 C PRZEPISANIE ADRESU STALEJ
810 630 IPMEM(J-1)=IPMEM(I+4)
811 C WSTAWIENIE STALEJ DO ZBIORU IDENTYFIKATOROW
813 K=IDPUT(IPMEM(I),IPMEM(IHBEG))
815 C NIE MA PODWOJNEJ DEKLARACJI
817 C USTAWINIE BITU CLOSE
819 C PRZEJSCIE DO NASTEPNEGO ELEMENTU LISTY
826 C ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
827 C PRZETWARZANIE LISTY ZMIENNYCH
831 800 IF(I.EQ.0) GO TO 1000
833 C J- IDENTYFIKATOR OPISU ZMIENNEJ
835 C WSTAWIENIE DO ZBIORU IDENTYFIKATOROW
837 K=IDPUT(IPMEM(I),IPMEM(IHBEG))
839 C NIE MA PODWOJNEJ DEKLARACJI
841 C WSTAWIENIE DO LISTY ATRYBUTOW
842 900 CALL MADATR(J,INDPR,41)
843 C ZAPAMIETANIE 1 W POLU USED - DLA AIL
845 C ZAMIAST NAZWY ZMIENNEJ(W ISMEM) ZAPAMIETUJEMY JEJ IDENTYFIKATOR W IPMEM
847 C PRZEJSCIE DO NASTEPNEGO ELEMENTU LISTY
855 C DOLACZENIE DO ZBIORU IDENTYFIKATOROW ID. RESULT DLA FUNKCJI
856 I=ISHFT(IAND(IPMEM(INDPR),MOTHERS),-8)
857 IF(I.LT.2.OR.I.GT.3) GO TO 1050
858 J=MEMBER(RESNM,IPMEM(IHBEG))
859 IF(J.NE.0) GO TO 1050
860 J=INSERT(RESNM,IPMEM(IHBEG),41)
861 IPMEM(J+2)= IPMEM(INDPR-5)
865 C---- ---- ---- ----- ---- ----- ----- ---- ----- ----- ----- ----- --
866 C TWORZENIE ZBIORU IDENTYFIKATOROW
868 C JESLI JEST PREFIKS, TO UZUPELNIAMY ZBIOR IDENTYFIKATOROW
869 IF(INDPREF.EQ.0) GO TO 1100
878 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
879 C PODPROGRAM SLUZY DO PRZETWARZANIA(OSTATECZNEGO) PROTOTYPU,
880 C RAZEM Z PRZETWARZANIEM ZEWNETRZNYM ( WSTEPNYM) JEGO ATRYBUTOW LOKALNYCH.
881 C PROTOTYP JEST ZADANY PRZEZ ZMIENNE Z BLOKU /DGLOB/
882 C DRUGA CZESC PRZETWARZANIA
883 C ** ** ** ** ** ** ** ** ** ** * ** ** ** ** ** ** **
885 IMPLICIT INTEGER (A-Z)
889 C BECAUSE OF TYPECONFLICT 03.01.84
891 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
893 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
894 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
895 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
896 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
897 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
898 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
899 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
901 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
906 COMMON / VIRT / LISTVB,LISTVE,OWNVIR
909 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
910 C ROBOCZY BLOK WSPOLNY.
911 C LISTVB - POCZATEK ROBOCZEJ LISTY VIRTLIST
912 C LISTVE - KONIEC ROBOCZEJ LISTY VIRTLIST
913 C OWNVIR = TRUE, JESLI W PROTOTYPIE BYLY WLASNE VIRTUALE
915 C ..... ZMIENNE GLOBALNE
919 COMMON /BLANK/ COM(278),
920 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
921 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
922 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
923 X LOCAL , OWN , OBJECT,
929 C KOMUNIKACJA Z PROCEDURA MEMPRF
931 C NME - SZUKANA NAZWA
935 cdsw COMMON /SIGNALS/ NRSIG, HLISTE
936 cdsw -------------------------------------------------
937 common /signs/ nrsig, hliste
938 cdsw -------------------------------------------------
940 C NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
941 C HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
945 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
946 * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
949 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
951 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7) ,JUNK(260)
955 C ---- ------ ------ ------ ------- ------- ------- ------------
957 C WSTEPNE PRZETWARZANIE PROTOTYPOW LOKALNYCH -- ETAP II
960 C ----- ------ ------ ----- ----- ----- ----- ----- ----- -----
961 C PRZETWARZANIE SYGNALOW
965 100 IF ( I.EQ.0 ) GO TO 500
973 C ------ ------ ------ ------ ------ ------- ------ ----
974 C PRZEPISANIE LISTY VIRTLIST Z PREFIKSU
978 IF(INDPREF.EQ.0) GO TO 1200
980 C I - DLUGOSC LISTY WIRTLIST Z PREFIKSU
981 IF(I.EQ.0) GO TO 1200
983 C JEST LISTY WIRTLIST W PREFIKSIE
990 C K - POCZATEK LISTY VIRTLIST W PREFIKSIE
994 1111 IPMEM(IJ1) = IPMEM(IJ2)
996 C PUSTA LISTA LOKALNYCH HANDLEROW
998 C PRZETWARZANIE WSZYSTKICH PROTOTYP6W
1001 C ZACZYNAMY OD TYPOW
1002 1300 IF(I.EQ.0) GO TO 1400
1003 CALL BEGPROT(IPMEM(I))
1006 1400 IF(POM) GO TO 1600
1008 C PROCEDURY, FUNKCJE I BLOKI
1013 C JESLI HANDLER TO KONIEC
1014 IF ( IAND(IPMEM(INDPR),MOTHERS).EQ.MHAND) GO TO 4000
1016 C UTUPELNIENIE INFORMACJI I WIRTUALACH
1017 IF(OWNVIR) GO TO 1700
1018 C NIE BYLO WLASNYCH WIRTUALI
1019 IF(INDPREF.EQ.0) GO TO 1900
1020 C DOWIAZUJEMY SIE DO LISTY VIRTLIST Z PREFIKSU, ZMIENIAJAC DLUGOSC NA UJEMNA
1021 IPMEM(INDPR+24) = IPMEM(INDPREF+24)
1022 IPMEM(INDPR+25) = -IPMEM(INDPREF+25)
1024 C BYLY WLSNE WIRTUALE - PRZEPISUJEMY LISTE VIRTLIST
1025 1700 I=LISTVE-LISTVB+1
1031 1777 IPMEM(IJ1) = IPMEM(IJ2)
1033 C ZWALNIAMY PAMIEC PRZEZNACZONA NA VIRTLIST W CZESCI SYSTEMOWEJ
1040 C ---- ----- ----- -------- ---------- ------- ---- ----- -------
1041 C NADAWANIE TYPOW ZMIENNYM
1044 IF(I.EQ.0) GO TO 2400
1046 C J - IDENTYFIKATOR OPISU ZMIENNEJ W IPMEM
1052 IPMEM(J-4) = IPMEM(I+3)
1053 C NADANIE APETYTU ZMIENNEJ
1055 C JESLI TO JEST TYP FORMALNY, TO POPRAWIAMY SLOWO ZEROWE OPISU ZMIENNEJ
1056 IF(IAND(IPMEM(K),MTP).NE.6) GO TO 2350
1057 IPMEM(J) = IOR(IPMEM(J),ISHFT(1,12))
1058 C JESLI TYP FORMALNY JEST NIELOKALNY, TO ZMIENIAMY RODZAJ PROTOTYPU
1060 IF(LOCAL.EQ.2) GO TO 2350
1063 IF(I.NE.0) GO TO 2100
1068 C ---- ------ ----- --- ---- ------ ----- ------ ----------
1069 C SPRAWDZENIE POPRAWNOSCI LIST HIDDEN I CLOSE I UZUPELNIENIE INFORMACJI
1071 C JESLI PROTOTYP NIE JEST KLASA TO PRZECHODZIMY DALEJ
1072 IF(IPMEM(INDSPR).NE.2.AND.IPMEM(INDSPR).NE.7) GO TO 3000
1074 C K = 0 -- CLOSE, K=1 -- HIDDEN
1076 2500 IF(I.EQ.0) GO TO 2700
1080 C NME - NAZWA W LISCIE HIDDEN(CLOSE)
1081 NH=IAND(ISHFT(NME,-1),7)+1
1083 IF(J.EQ.0) GO TO 2600
1084 C NAZWA JEST ZADEKLAROWANA
1085 C JESLI NAZWA JEST HIDDEN LUB NOT TAKEN, TO BLAD
1087 IF(BTEST(NM,2)) GO TO 2660
1089 IF(BTEST(NM,1)) GO TO 2650
1090 C NAZWA POCHODZI Z PREFIKSU
1091 NM=INSERT(NME,IPMEM(IHBEG),41)
1092 IPMEM(NM+2) = IPMEM(J+2)
1093 IPMEM(NM+1)= IPMEM(J+1)
1095 C USTAWIAMY BIT K W ELEMENCIE LISTY HASHU
1096 2550 IPMEM(J+1) = IOR(IPMEM(J+1),ISHFT(1,K))
1097 C PRZECHODZIMY DO NASTEPNEGO ELEMENTU LISTY
1100 C NAZWA NIEZADEKLAROWANA
1101 2600 J=INSERT(NME,IPMEM(IHBEG),41)
1104 C NAZWA HIDDEN - NIEDOSTEPNA
1105 2650 CALL MERR(319,NME)
1107 C NAZWA NOT TAKEN - NIEDOSTEPNA
1108 2660 CALL MERR(320,NME)
1110 2700 IF(K.EQ.0) GO TO 3000
1118 C---- ------ ------ ------ ------- ------- -------- -------
1119 C KOMPATYBILNOSC VIRTUALI
1121 IF(.NOT.BTEST(IPMEM(INDPR),11)) GO TO 4000
1122 C PROTOTYP JEST VIRTUALEM
1123 C SPRAWDZAMY, CZY ISTNIEJE WYZSZY VIRTUAL
1125 IF(IPMEM(INDPR+26).EQ.0) GO TO 4000
1131 C ------ ------ ------ ------ ------ ------ ------------- ---
1132 C ZAKONCZENIE - ZAPAMIETUJEMY IDENTYFIKATOR PROTOTYPU W SLOWNIKU
1135 IPMEM(INDICT) = INDPR
1139 INTEGER FUNCTION IAP(IND)
1141 C WYLICZA APETYT ATRYBUTU IND :
1142 C 0 (00) - INTEGER,BOOLEAN,CHAR,STRING
1143 C 1 (01) - REAL, FORMAL TYPE
1144 C 2 (10) - FORMAL PROCEDURE,FORMAL FUNCTION
1145 C 3 (11) - REFERENCE
1146 C W WYNIKU ZMIENIA SLOWO ZEROWE
1148 IMPLICIT INTEGER(A-Z)
1152 COMMON /BLANK/ COM(278),
1153 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1154 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1155 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1156 X LOCAL , OWN , OBJECT,
1160 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
1161 * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
1166 I=IAND(IPMEM(J),MTP)
1168 IF(I.LT.8.OR.I.EQ.11) IAP = 3
1170 IF(IPMEM(IND-4).NE.0) IAP=3
1171 C ZMIANA SLOWA ZEROWEGO
1172 IAP=IOR(IPMEM(IND),ISHFT(IAP,14))
1175 SUBROUTINE BEGPROT(NRSDIC)
1177 C * * * * * * * * * * * * * * * * * * *
1178 C PODPROGRAM SLUZY DO WSTEPNEGO PRZETWARZANIA PROTOTYPOW LOKALNYCH
1179 C W PROTOTYPIE IDENTYFIKOWANYM PRZEZ INDPR.
1180 C DLA KAZDEGO PROTOTYPU:
1181 C - ANALIZUJE JEGO PREFIKS
1182 C - UZUPELNIA INFORMACJE O RODZAJU PROTOTYPU
1183 C - JESLI PROTOTYP JEST PROCEDURA LUB FUNKCJA VIRTUALNA, TO SZUKA
1184 C BEZPOSREDNIO WYZSZEGO VIRTUALA I WSTAWIA IDENTYFIKATOR PROTOTYPU
1185 C DO LISTY VIRTLIST PROTOTYPU OBEJMUJACEGO.
1186 C - DLA FUNKCJI -- ZNAJDUJE JEJ TYP.
1187 C PODPROGRAM WSTAWIA PARE ( NRSDIC, IDENT. W IPMEM) DO KOLEJKI
1189 C NRSDIC - INDEKS PROTOTYPU W IPMEM.
1190 C W IPMEM W POLU SL ZAPAMIETANY JEST IDENTYFIKATOR TEGO PROTOTYPU W
1192 C * * * * * * * * * * * * * * * * *
1195 IMPLICIT INTEGER(A-Z)
1198 LOGICAL IFCLASS,BPREF,ONLY
1202 C BECAUSE OF TYPECONFLICT 03.01.84
1207 COMMON /BLANK/ COM(278),
1208 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1209 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1210 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1211 X LOCAL , OWN , OBJECT,
1215 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
1217 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
1218 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
1219 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
1220 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
1221 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
1222 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
1223 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
1225 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
1228 COMMON / VIRT / LISTVB,LISTVE,OWNVIR
1231 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1232 C ROBOCZY BLOK WSPOLNY.
1233 C LISTVB - POCZATEK ROBOCZEJ LISTY VIRTLIST
1234 C LISTVE - KONIEC ROBOCZEJ LISTY VIRTLIST
1235 C OWNVIR = TRUE, JESLI W PROTOTYPIE BYLY WLASNE VIRTUALE
1238 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
1239 * MPROCES, MCOR, MERPF, MBLOCK, MHAND
1243 COMMON /PREFS/ LPREFS
1245 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1246 C LPREFS - OSTATNIO PRZYDZIELONY NUMER W PREFIXSET
1249 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
1251 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
1254 COMMON / DONLY / IONLY,ONIL
1257 C ROBOCZY BLOK,UZYWANY PRZY TWORZENIU ZBIORU IDENTYFIKAROROW
1258 C IONLY - POCZATEK LISTY TAKEN
1259 C ONIL - TRUE, GDY JEST TAKEN NONE
1264 C * * * * * * * * * * * * *
1265 C NADANIE WARTOSCI ZMIENNYM.
1266 C IDSMEM - IDENTYFIKATOR W IPMEM PRZETWARZANEGO PROTOTYPU.
1267 C IDPMEM - IDENTYFIKATOR PROTOTYPU W IPMEM.
1268 C ISYS = 1 DLA COROUTINE, ISYS = 2 DLA PROCESS.
1269 C LINE - NR LINII DEKLARACJI PROTOTYPU.
1270 C * * * * * * * * * * * * *
1273 IDSMEM = IPMEM(NRSDIC)
1274 IDPMEM = IPMEM(IDSMEM+1)
1275 C JESLI HANDLER - TO DO PRZETWARZANIE HANDLERA
1276 IF(IPMEM(IDSMEM).EQ.8) GO TO 2500
1277 ISYS=IAND(IPMEM(IDSMEM+8),MSPR)
1278 LINE = IPMEM(IDSMEM+9)
1281 C * * * * * * * * * * * * * * *
1282 C PRZETWARZANIE PREFIKSU
1283 C * * * * * * * * * * * * * *
1285 C I - NAZWA PREFIKSU
1287 C IDPR - BEDZIE IDENTYFIKATOREM PREFIKSU
1289 IF( I.EQ.0) GO TO 500
1291 IDPR = MEMSL(I,INDPR)
1292 IF(IDPR.NE.0) GO TO 50
1293 C PREFIKS JEST NIEZADEKLAROWANY
1296 C BADAMY, CZY PREFIKS JEST DOSTEPNY
1297 50 IRODZ=IPMEM(IDPR+1)
1298 IF(BTEST(IRODZ,2)) GO TO 60
1299 IF(.NOT.BTEST(IRODZ,1) .OR.OWN)GO TO 100
1300 C NAZWA PROFIKSU JEST HIDDEN - BLAD
1303 C NAZWA PREFIKSU JEST NOT-TAKEN
1306 C BADAMY, CZY PREFIKS JEST KLASA
1307 100 IDPR = IPMEM(IDPR+2)
1308 IF(IDPR.EQ.NRUNIV) GO TO 150
1309 C IRODZ - CZESC T W SLOWIE ZEROWYM PREFIKSU
1310 IRODZ=IAND(IPMEM(IDPR),MTP)
1311 IF(IFCLASS(IRODZ)) GO TO 200
1312 C PREFIKS NIE JEST KLASA
1317 C PREFIKS JEST POPRAWNY
1319 C JESLI PREFIKS MIAL BLEDNA LISTE PF, TO POPRAWIAMY
1321 IF(IAND(IPMEM(IDPR),MERPF).EQ.0) GO TO 250
1322 C POPRAWIAMY SLOWO ZEROWE
1323 210 IPMEM(IDPMEM) = IOR(IPMEM(IDPMEM),MERPF)
1325 IF(IDPR.EQ.0) GO TO 500
1326 C WSTAWIAMY IDENTYFIKATOR BEZPOSREDMIEGO PREFIKSU DO OPISU PROTOTYPU
1327 IPMEM(IDPMEM+21) = IDPR
1328 C PRZEPISANIE LISTY PREFIKSLIST Z PREFIKSU I DOLACZENIE SIEBIE
1330 C I - DLUGOSC LISTY PREFIKSLIST Z PREFIKSU - 1
1331 C J - POCZATEK PREFIXLIST Z PREFIKSU
1332 C J1 - POCZATEK TWORZONEJ LISTY PREFIKSLIST
1339 222 IPMEM(IJ1) = IPMEM(IJ2)
1340 C DOLOCZAMY SIEBIE DO LISTY PREFIXLIST I WSTAWIAMY PREFIXLIST DO
1345 IPMEM(IDPMEM+23) = I+1
1347 C SPRAWDZENIE POPRAWNOSCI PREFIKSOW SYSTEMOWYCH
1348 C TWORZENIE PREFIXSET
1352 C I=1 JESLI PREFIKS JEST COROUTINA
1353 C I=2 JESLI PREFIKS JEST PRECESEM
1354 C I=0 W PRZECIWNYM PRZYPADKU
1356 IF(BPREF(IDPR,IPMEM(NRCOR-6))) I=1
1357 IF(BPREF(IDPR,IPMEM(NRPROC-6))) I=2
1358 C JESLI PROTOTYP NIE JEST KLASA, TO PRZECHODZIMY DO BADANIA POPRAWNOSCI
1360 J=IAND(IPMEM(IDPMEM),MTP)
1361 IF(J.EQ.NOTTP) GO TO 800
1362 C PRZEPISANIE PREFIXSET Z PREFIKSU
1363 IPMEM(IDPMEM-3) = IPMEM(IDPR-3)
1364 IPMEM(IDPMEM-4) = IPMEM(IDPR-4)
1365 IPMEM(IDPMEM-5) = IPMEM(IDPR-5)
1366 C ROZPOZNAMIE RODZAJU PROTOTYPU
1367 IF(ISYS.LT.I) ISYS=I
1368 300 IF(ISYS.EQ.0) GO TO 400
1370 C PROTOTYP JEST COROUTINA LUB PROCESEM
1372 C USTAWIAMY ODPOWIEDNIE BITY W PREFIXSET
1374 CALL MSETB(IDPMEM,IPMEM(NRCOR-6))
1375 IF(ISYS.NE.2) GO TO 350
1376 CALL MSETB(IDPMEM,IPMEM(NRPROC-6))
1377 C POPRAWIAMY SLOWO ZEROWE PROTOTYPU - TO JEST PROCES
1378 IPMEM(IDPMEM) = IOR(IAND(I,MASKTP),MPROCES)
1380 C POPRAWIAMY SLOWO ZEROWE - TO JEST COROUTINA
1381 350 IPMEM(IDPMEM) = IOR(IAND(I,MASKTP),MCOR)
1382 C PRZYDZIELENIE NUMERU W SENSIE PREFIXSET
1383 400 LPREFS = LPREFS+1
1384 CALL MSETB(IDPMEM,LPREFS)
1385 IPMEM(IDPMEM-6) = LPREFS
1386 C JESLI KLASA MA BLEDNA LISTE PF, TO POPRAWIAMY NA PELNA
1387 IF(IAND(IPMEM(IDPMEM),MERPF).NE.0)
1388 * CALL CHECK(IDPMEM)
1389 C JESLI W KLASIE BYLY INSTRUKCJE, TO POPRAWIAMY NA KLASE PELNA
1390 IF(BTEST(IPMEM(IDSMEM+8),13)) CALL CHECK(IDPMEM)
1393 C NIE BYLO PREFIKSU, LUB BYL BLEDNY PREFIKS.
1394 C JESLI PROTOTYP JEST BLOKIEM, TO KONCZYMY PRZETWARZANIE PREFIKSOW
1397 IF(IAND(J1,MTP).EQ.NOTTP.AND.IAND(J1,MOTHERS).EQ.MBLOCK)
1399 C DOLOCZAMY SIEBIE JAKO JEDYNY ELEMENT LISTY PREFIKSOW
1402 IPMEM(IDPMEM+22) = J
1403 IPMEM(IDPMEM+23) = 1
1404 C JESLI PROTOTYP NIE JEST KLASA, TO KONIEC PRZETWARZANIA PREFIKSOW
1405 IF(IAND(J1,MTP).EQ.NOTTP) GO TO 1000
1406 C USTAWIAMY BIT 2 W PREFIKSSET NA 1 I PRZECHODZIMY DO USTALENIA RODZAJU
1408 CALL MSETB(IDPMEM,2)
1411 C SPRAWDZENIE POPRAWNOSCI PREFIKSOW SYSTEMOWYCH
1412 800 IF(I.EQ.0) GO TO 1000
1413 C COROUTINE LUB PROCES NIE PREFIKSUJE KLASY
1414 CALL MERR(303,IPMEM(IDSMEM+2))
1417 C --- --- --- --- --- --- --- --- --- --- --- ---
1418 C PRZETWARZANIE INFORMACJI O WIRTUALACH
1422 C JESLI TO NIE JEST WIRTUAL, TO PRZECHODZIMY DALEJ
1423 IF(.NOT.BTEST(IPMEM(IDSMEM+8),15)) GO TO 2000
1425 C JESLI PROTOTYP OBEJMUJACY JEST BLOKIEM NIEPREFIKSOWANYM, TO KASUJEMY
1427 IF(IPMEM(INDPR).NE.1) GO TO 1001
1428 IPMEM(IDPMEM)=IAND(IPMEM(IDPMEM),MNOTVIR)
1431 C BIT NR 11 W SLOWIE ZEROWYM JEST JUZ USTAWIONY PRZEZ PODPROGRAM INITPR
1432 C OWNVIR = .TRUE., JESLI W PROTOTYPIE INDPR SA WLASNE WIRTUALE
1435 C CZUKA,Y BEZPOSREDNIO WYZSZEGO VIRTUALA
1436 IF(INDPREF.EQ.0) GO TO 1300
1437 C PROTOTYP OBEJMUJACY MA PREFIKS
1438 C I - NAZWA VIRTUALA
1440 C SPRAWDZAMY,CZY WIRTUAL JEST NA LISCIE TAKEN Z PREFIKSU
1441 IONLY=IPMEM(INDSPR+7)
1442 ONIL=BTEST(IPMEM(INDSPR+8),14)
1443 IF(.NOT.ONLY(I)) GO TO 1300
1445 IF(J.EQ.0) GO TO 1300
1446 IF(LOCAL.NE.2.OR.BTEST(IPMEM(J+1),1)) GO TO 1300
1447 IF(BTEST(IPMEM(J+1),2)) GO TO 1300
1449 C SPRAWDZAMY,CZY TO JEST WIRTUAL
1450 IF(.NOT.BTEST(IPMEM(J),11)) GO TO 1300
1451 C ZNALEZLISMY BEZPOSREDNIO WYZSZY WIRTUAL
1452 C J - IDENTYFIKATOR BEZPOSREDNIO WYZSZEGO WIRTUALA
1453 C I - NUMER WIRTUALNY
1455 IPMEM(IDPMEM+26) = J
1456 IPMEM(IDPMEM+27) = I
1457 C WSTAWIAMY WIRTUAL DO VIRTLIST (ROBOCZEJ) PROTOTYPU OBEJMUJACEGO
1462 C NIE BYLO BEZPOSREDNIO WYZSZEGO WIRTUALA
1465 LISTVE = MGETM(1,41)
1466 C DOKLADAMY NUMER WIRTUALNY
1467 IPMEM(IDPMEM+27) = LISTVE-LISTVB
1469 IPMEM(LISTVE)=IDPMEM
1472 C -- -- -- -- -- -- -- -- --- -- -- -- --- -- --
1473 C DLA FUNKCJI -- PRZETWARZANIE JEJ TYPU
1477 C BADAMY, CZY PROTOTYP JEST FUNKCJA
1478 I = ISHFT(IAND(IPMEM(IDPMEM),MOTHERS),-8)
1479 IF(I.NE.2) GO TO 3000
1480 C SZUKAMY TYPU; J - NAZWA TYPU
1481 J = IPMEM(IDSMEM+12)
1483 C SPRAWDZAMY, CZY TO JEST TYP FORMALNY
1484 C I - IDENTYFIKATOR TYPU
1485 IF(IAND(IPMEM(I),MTP).NE.6) GO TO 2100
1486 C TO JEST TYP FORMALBY - ZMIANA SLOWA ZEROWEGO W PROTOTYPIE FUNKCJI
1487 IPMEM(IDPMEM)= IOR(IPMEM(IDPMEM),ISHFT(1,12))
1489 2100 IPMEM(IDPMEM-3) = I
1490 IPMEM(IDPMEM-4) = IPMEM(IDSMEM+13)
1496 C --- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
1497 C PRZETWARZANIE HANDLERA
1499 CALL HANDLER ( IDSMEM )
1503 C ---- ---- ---- ---- ---- ---- ---- ----
1504 C WSTAWINEI PARY (NRSDIC,IDPMEM) DO KOLEJKI PROTOTYPIOW
1507 CALL DPUTQ(NRSDIC,IDPMEM)
1510 LOGICAL FUNCTION IFCLASS(IX)
1513 C FUNKCJA DAJE ODPOWIEDZ, CZY DANY PROTOTYP JEST KLASA
1514 C IX - CZESC T ZE SLOWA ZEROWEGO PROTOTYPU
1518 IFCLASS=IX.EQ.2 .OR. IX.EQ.3 .OR. IX.EQ.5 .OR. IX.EQ.7
1521 INTEGER FUNCTION INITPR(KIND,NAME)
1523 C * * * * * * * * * * * * * * * * *
1524 C FUNKCJA WYKONUJE WSTEPNE CZYNNOSCI ( REZERWACJA MIEJSCA,USTAWIENIE
1525 C LISTY ATRYBUTOW I TABLICY HASHU ) DLA PROTOTYPU.
1526 C NAME - NAZWA PROTOTYPU
1527 C KIND - RODZAJ PROTOTYPU
1528 C WARTOSCIA FUNKCJI JEST IDENTYFIKATOR UTWORZONEGO PROTOTYPU.
1529 C * * * * * * * * * * * * * * * * *
1532 IMPLICIT INTEGER(A-Z)
1535 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
1536 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
1537 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
1539 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1540 C NULLWD(I) - WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
1541 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
1542 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
1543 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
1544 C VARWD - -- -- -- -- DLA ZMIENNEJ
1545 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
1546 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
1547 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
1548 C INOUT - -- -- -- -- ZMIENNEJ INOUT
1552 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
1554 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
1555 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
1556 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
1557 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
1558 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
1559 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
1560 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
1562 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
1564 C ..... ZMIENNE GLOBALNE
1569 COMMON /BLANK/ COM(278),
1570 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1571 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1572 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1573 X LOCAL , OWN , OBJECT,
1576 cdeb ----------- added ---------------------
1577 common /names/ resnm, mainm, brenam
1580 common /brid/ breaklid
1581 c numer w displayu (dla interpretera) prototypu breakl
1582 cdeb ---------------------------------------
1585 C REZERWACJA MIEJSCA I USTAWIENIE SLOWA ZEROWEGO
1586 IF(KIND.GE.13 .AND.KIND.LE. 16) INSYS=.TRUE.
1587 INITPR = MGETM(SIZEPR(KIND),341)
1589 INITPR=INITPR+NULLPOZ(KIND)
1590 IPMEM(INITPR) = NULLWD(KIND)
1591 C DOLACZENIE DO LISTY NEXTDECL
1592 IPMEM(LASTPR+2) = INITPR
1594 cdeb ----------- added --------------------
1595 if(name.ne.brenam) go to 82
1596 c przekazanie na zmiennej breaklid numeru prototypu
1598 c obliczenie numeru prototypu
1602 c formaLNE i sygnaly sa pomijane
1603 if(iand(ishft(k,-4),15).ne.0) go to 81
1604 if(i.eq.lastpr) go to 82
1605 breaklid = breaklid+1
1609 cdeb ---------------------------------------
1610 IF ( KIND .GE.17.AND.KIND.LE.20) GO TO 100
1611 C INICJALIZACJA LISTY ATRYBUTOW
1612 IPMEM(INITPR+7) = INITPR+5
1613 IPMEM(INITPR+5) = NATTR
1615 100 IPMEM(INITPR-1) = INDPR
1616 C WSTAWIENIE 1 DO POLA USED - DLA AIL
1618 C DLA BLOKOW I HANDLEROW - KONIEC
1619 IF(KIND.EQ.1.OR. KIND.EQ.8 .OR. KIND.EQ.23) RETURN
1620 C WSTAWIENIE NAZWY PROTOTYPU DO TABLICY HASH'U
1621 C JESLI TO JEST PROTOTYP FORMALNY II-GO RZEDU, TO ELEMENTY LISTY HASH'U SA
1622 C TWORZONE W CZESCI SYSTEMOWEJ
1623 IF( KIND.GE.18 .AND. KIND.LE.20 ) INSYS = .TRUE.
1624 IF( NAME .EQ.NEMPTY) GO TO 200
1625 I = IDPUT(NAME,IPMEM(IHBEG))
1626 IF ( I.EQ.0) GO TO 200
1628 C DLA SYGNALOW - KONIEC
1629 200 IF ( KIND.GE.21 ) RETURN
1630 C WSTAWIENIE DO LISTY ATRYBUTOW ( PROTOTYPU INDPR )
1631 C JESLI INDPR JEST FORMALNY, TO LISTA ATRYBUTOW JEST TWORZONA
1632 C W CZESCI SYSTEMOWEJ
1633 CALL MADATR(INITPR,INDPR,41)
1639 C * * * * * * * * * * * * * * * * *
1640 C PODPROGRAM DOKLADA DO ZBIORU IDENTYFIKATOROW PROTOTYPU INDPR
1641 C IDENTYFIKATORY Z PREFIKSU TAKIE,ZE:
1642 C - JESZCZE ICH NIE MA
1643 C - NIE MA ICH NA LISCIE TAKEN
1644 C PODPROGRAM JEST WYWOLYWANY O ILE BYL PREFIKS.
1645 C * * * * * * * * * * * * * * * * *
1647 IMPLICIT INTEGER (A-Z)
1653 C BECAUSE OF TYPECONFLICT 03.01.84
1654 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
1656 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
1657 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
1658 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
1659 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
1660 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
1661 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
1662 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
1664 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
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,
1677 COMMON/STREAM/ERRFLG,LINE,IBUF2(265),IBUF3(7),JUNK(260)
1679 COMMON/DONLY/IONLY,ONIL
1682 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1683 C ROBOCZY BLOK, UZYWANY PRZY TWORZENIU ZBIORU IDENTYFIKATOROW
1684 C IONLY - POCZATEK LISTY TAKEN W ISMEM
1685 C ONIL=TRUE, GDY JEST TAKEN NIL
1689 C SPRAWDZAMY, CZY BYLO TAKEN NIL
1690 ONIL=BTEST(IPMEM(INDSPR+8),14)
1694 C SPRAWDZENIE POPRAWNOSCI LISTY TAKEN
1697 C IHBEGP -- POCZATEK LISTY IDENTYFIKATOROW W PREFIKSIE
1699 IONLY=IPMEM(INDSPR+7)
1700 IF(IONLY .EQ.0) GO TO 500
1701 C J - POPRZEDNI ELEMENT LISTY
1702 C I - BIEZACY ELEMENT LISTY
1707 NH=IAND(ISHFT(NM,-1),7)+1
1709 C M - ELEMENT LISTY HASHU, JESLI NAZWA NM JEST ZADEKLAROWANA W PREFIKSACH
1710 IF(M .EQ. 0) GO TO 400
1711 C SPRAWDZAMY, CZY NAZWA JEST HIDDEN
1712 IF(BTEST(IPMEM(M+1),1)) GO TO 300
1713 C SPRAWDZAMY,CZY NAZWA JEST NOT TAKEN
1714 IF(BTEST(IPMEM(M+1),2)) GO TO 250
1715 C POPRAWNY ELEMENT LISTY TAKEN
1718 IF(I.NE.0) GO TO 100
1720 C NAZWA JEST NOT TAKEN - USUWAMY Z LISTY TAKEN
1721 250 CALL MERR(321,NM)
1724 300 CALL MERR(304,NM)
1726 C NAZWA NIEZADEKLAROWANA
1727 400 CALL MERR(305,NM)
1728 C DOKLADAMY NAZWE DO ZBIORU IDENTYFIKATOROW
1729 M = MEMBER(NM,IPMEM(IHBEG))
1730 IF(M.NE.0) GO TO 200
1731 M=INSERT(NM,IPMEM(IHBEG),341)
1735 C LACZENIE ZBIOROW IDENTYFIKATOROW
1739 C PRZEGLADAMY KOLEJNE PREFIKSY
1742 C IE - KONIEC TABLICY IDENTYFIKATOROW W PREFIKSIE
1744 C IHBEGP - POCZATEK LISTY IDENTYFIKATOROW W PREFIKSIE
1746 DO 555 I=IHBEGP,IE,1
1747 C I - INDEKS KOLEJNEGO ELEMENTU TABLICY HASHU
1748 C J - ELEMENT TABLICY HASHU
1750 IF(J.EQ.0) GO TO 555
1752 C JESLI NAZWA JEST HIDDEN - TO DALEJ
1753 IF(BTEST(IPMEM(J+1),1)) GO TO 700
1754 C JESLI NAZWA JEST NOT TAKEN - TO DALEJ
1755 IF(BTEST(IPMEM(J+1),2)) GO TO 700
1757 IF(ONLY(NM)) GO TO 700
1758 C NAZWY NIE MA NA LISCIE TAKEN
1759 NH=IAND(ISHFT(NM,-1),7)+1
1760 C SZUKAMY NAZWY OD INDPR PO PREFIKSACH
1764 620 IF(M.EQ.0) GO TO 650
1765 IF(IPMEM(M).EQ.NM) GO TO 670
1768 650 IND = IPMEM(IND+21)
1770 C NAZWA MUSI ZOSTAC ZNALEZIONA
1771 C JESLI NAZWA BYLA ZNALEZIONA PONIZEJ IDP, TO
1772 C ALBO BYLA JUZ ROZPATRYWANA, ALBO BYLA JUZ NOT TAKEN,
1773 C ALBO JEST LOKALNA W INDPR
1774 670 IF(IND.NE.IDP) GO TO 700
1775 C NAZWE TRZEBA DOSTAWIC
1776 M=INSERT(NM,IPMEM(IHBEG),341)
1778 IPMEM(M+2) = IPMEM(J+2)
1780 IF(J.NE.0) GO TO 600
1782 C PRZECHODZIMY DO NATEPNEGO PREFIKSU
1784 IF(IDP.NE.0) GO TO 800
1787 LOGICAL FUNCTION ONLY(NAME)
1789 C * * * * * * * * * * * * * * * * * * * * * *
1790 C FUNKCJA SPRAWDZA, CZY NAZWA NAME JEST NA LISCIE TAKEN
1791 C POCZATEK LISTY TAKEN - IONLY
1792 C * * * * * * * * * * * * * * * * *
1795 IMPLICIT INTEGER(A-Z)
1799 COMMON /BLANK/ COM(278),
1800 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1801 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1802 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1803 X LOCAL , OWN , OBJECT,
1807 COMMON / DONLY / IONLY,ONIL
1810 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1811 C ROBOCZY BLOK, UZYWANY PRZY TWORZENIU ZBIORU IDENTYFIKATOROW
1812 C IONLY - POCZATEK LISTY TAKEN W ISMEM
1813 C ONIL=TRUE, GDY JEST TAKEN NIL
1816 C JESLI LISTA TAKEN JEST PUSTA, TO ZAKLADAMY, ZE SA W NIEJ WSZYSTKIE
1821 IF(IONLY.EQ.0) GO TO 200
1823 100 IF(IPMEM(I).EQ.NAME) GO TO 200
1825 IF(I.NE.0) GO TO 100
1826 C NAZWY NIE MA NA LISCIE TAKEN
1828 C NAZWA JEST NA LISCIE TAKEN
1832 SUBROUTINE CHECK ( IND )
1834 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1835 C POPRAWIA BIT OZNACZAJACY PELNA KLASE POCZAWSZY OD PROTOTYPU IND
1836 C KONCZY, JESLI TEN BIT JEST 1
1837 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1839 IMPLICIT INTEGER(A-Z)
1843 C BECAUSE OF TYPECONFLICT 03.01.84
1847 COMMON /BLANK/ COM(278),
1848 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1849 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1850 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1851 X LOCAL , OWN , OBJECT,
1854 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
1855 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
1856 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
1857 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
1858 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
1860 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
1861 C NACZONEGO NA PROTOTYPY SYSTEMOWE
1862 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
1863 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
1869 IF(BTEST(I,0)) RETURN
1874 INTEGER FUNCTION IDPUT(NAME,THASH)
1876 C * * * * * * * * * * * * * * * * *
1877 C FUNKCJA WSTAWIA NAZWE NAME DO TABLICY THASH UPRZEDNIO SPRWDZAJAC,
1878 C CZY NAZWA JUZ TAM JEST.
1879 C JESLI JEST, TO WARTOSCIA FUNKCJI JEST 0 I WYKONYWANE SA REAKCJE NA BLAD
1880 C ( BLAD NIE JEST SYGNALIZOWANY )
1881 C JESLI NIE MA , TO WARTOSCIA FUNKCJI JEST WSTAWIANY ELEMENT
1883 C * * * * * * * * * * * * * * * * *
1886 IMPLICIT INTEGER(A-Z)
1890 COMMON /BLANK/ COM(278),
1891 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1892 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1893 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1894 X LOCAL , OWN , OBJECT,
1897 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
1898 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
1899 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
1900 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
1901 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
1903 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
1904 C NACZONEGO NA PROTOTYPY SYSTEMOWE
1905 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
1906 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
1909 cdsw INTEGER THASH(8)
1913 C SPRAWDZENIE, CZY NAZWA JEST W TABLICY
1914 I=MEMBER(NAME,THASH)
1915 IF(I.NE.0) GO TO 100
1916 C NAZWY NIE MA - WSTAWIAMY
1917 IDPUT = INSERT ( NAME,THASH,341)
1920 C NAZWA JEST - PODWOJNA DEKLARACJA
1923 C SKASOWANIE W ELEMENCIE LISTY HASHU INFORMACJI O HIDDEN I CLOSE
1925 C DOWIAZANIE NAZWY DO OBIEKTU UNIVERSAL
1929 INTEGER FUNCTION IFTYPE ( NAME)
1931 C * * * * * * * * * * * * * * * * *
1932 C FUNKCJA ZNAJDUJE NAZWE NAME W PROTOTYPIE O IDENTYFIKATORZE INDPR
1933 C I DALEJ O SL-ACH. SPRAWDZA,CZY JEST TO NAZWA TYPU.
1934 C IFTYPE = IDENTYFIKATOR TYPU, JESLI TYP JEST POPRAWNY
1935 C IFTYPE = NRUNIV, GDY TYP JEST NIEZADEKLAROWANY LUB NIEDOSTEPNY
1936 C * * * * * * * * * * * * * * * * *
1938 IMPLICIT INTEGER(A-Z)
1942 C BECAUSE OF TYPECONFLICT 03.01.84
1946 COMMON /BLANK/ COM(278),
1947 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
1948 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1949 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1950 X LOCAL , OWN , OBJECT,
1953 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
1954 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
1955 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
1956 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
1957 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
1959 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
1960 C NACZONEGO NA PROTOTYPY SYSTEMOWE
1961 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
1962 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
1966 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
1968 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
1969 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
1970 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
1971 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
1972 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
1973 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
1974 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
1976 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
1979 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
1980 * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
1982 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1984 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
1985 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
1986 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
1987 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
1988 C MASKTP - ZAPRZECZENIE MASKI MTP
1989 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
1990 C MPROCES - WZORZEC DLA PROCESU ( 5 )
1991 C MCOR - WZORZEC DLA COROUTINY (7)
1992 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
1993 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
1998 IFTYPE=MEMSL(NAME,INDPR)
1999 IF(IFTYPE.EQ.0) GO TO 200
2001 IF(BTEST(I,2)) GO TO 100
2002 IF(.NOT.BTEST(I,1) .OR. OWN) GO TO 400
2006 C NAZWA JEST NOT TAKEN
2007 100 CALL MERR(318,NAME)
2010 C NAZWA JEST ZADEKLAROWANA
2011 400 IFTYPE = IPMEM(IFTYPE + 2)
2012 C SPRAWDZENIE, CZY TO JEST NAZWA TYPU
2013 IF(IAND(IPMEM(IFTYPE),MTP).NE.NOTTP) RETURN
2014 C TO NIE JEST NAZWA TYPU
2018 C NAZWA JEST NIEZADEKLAROWANA - DKLADAMY JA DO BIEZACEGO PROTOTYPU
2019 200 CALL MERR(306,NAME)
2020 IFTYPE = INSERT(NAME,IPMEM(IHBEG),341)
2024 SUBROUTINE DPUTQ (NSDIC,IDPMEM)
2026 C * * * * * * * * * * * * * * * * *
2027 C PODPROGRAM WSTAWIA PARE (NSDIC,IDPMEM) DO KOLEJKI PROTOTYPOW
2028 C * * * * * * * * * * * * * * * * *
2030 IMPLICIT INTEGER(A-Z)
2033 COMMON / QUEUE / BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
2034 cdsw INTEGER BQUEUE, EQUEUE
2037 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2038 C ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
2039 C BQUEUE - POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
2040 C EQUEUE - KONIEC -- -- -- -- --
2041 C IFIRST - PIERWSZY ELEMENT KOLEJKI
2042 C LAST - OSTATNI ELEMENT KOLEJKI
2043 C EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
2048 COMMON /BLANK/ COM(278),
2049 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2050 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2051 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2052 X LOCAL , OWN , OBJECT,
2055 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2056 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2057 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2058 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2059 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2061 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2062 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2063 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2064 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2068 C JESLI DOSZLISMY DO KONCA OBSZARU PRZEZNACZONEGO NA KOLJKE, TO
2069 C ZACZYNAMY OD POCZATKU
2070 IF ( LAST.EQ.EQUEUE-1) LAST=BQUEUE-2
2071 IF(LAST.EQ.IFIRST-2.AND..NOT.EMPTY) GO TO 100
2072 C JEST MIEJSCE NA DOSTAWIANIE ELEMENTU DO KOLEJKI
2076 IPMEM(LAST+1) = IDPMEM
2079 C PRZEPELNIENIE OBSZARU PRZEZNACZONEGO NA KOLEJKE
2080 C PRZERWANIE KOMPILACJI
2087 C * * * * * * * * * * * * * * * * *
2088 C PODPROGRAM POBIERA PIERWSZY ELEMENT Z KOLEJKI PROTOTYPOW I
2089 C WSTAWIA NA ZMIENNE INDICT I INDPR Z BLOKU DGLOB.
2090 C NIE SPRAWDZA, CZY KOLEJKA JEST PUSTA.
2091 C JESLI NA SKUTEK WYKONANIA OPERACJI KOLEJKA BEDZIE PUSTA, TO ZMIENNA
2092 C EMPTY DOSTAJE WARTOSC TRUE .
2093 C * * * * * * * * * * * * * * * * *
2096 IMPLICIT INTEGER(A-Z)
2100 COMMON /BLANK/ COM(278),
2101 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2102 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2103 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2104 X LOCAL , OWN , OBJECT,
2107 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2108 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2109 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2110 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2111 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2113 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2114 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2115 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2116 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2120 COMMON / QUEUE / BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
2121 cdsw INTEGER BQUEUE, EQUEUE
2124 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2125 C ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
2126 C BQUEUE - POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
2127 C EQUEUE - KONIEC -- -- -- -- --
2128 C IFIRST - PIERWSZY ELEMENT KOLEJKI
2129 C LAST - OSTATNI ELEMENT KOLEJKI
2130 C EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
2132 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
2134 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
2135 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
2136 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
2137 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
2138 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
2139 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
2140 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
2142 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
2146 INDICT = IPMEM(IFIRST)
2147 INDPR = IPMEM(IFIRST+1)
2148 IF(LAST.EQ.IFIRST) GO TO 100
2149 C KOLEJKA MA CO NAJMNIEJ 2 ELEMENTY
2150 IF(IFIRST.EQ.EQUEUE-1) GO TO 50
2156 C KOLEJKA BEDZIE PUSTA
2165 C**********************************************C
2166 C PODPROGRAM PRZETWARZA LISTE PARAMETROW FORMALNYCH
2168 C **********************************************
2170 IMPLICIT INTEGER(A-Z)
2171 LOGICAL PQ,ISTPF,FORM2
2174 C BECAUSE OF TYPECONFLICT 03.01.84
2176 C ..... ZMIENNE GLOBALNE
2180 COMMON /BLANK/ COM(278),
2181 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2182 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2183 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2184 X LOCAL , OWN , OBJECT,
2187 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2188 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2189 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2190 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2191 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2193 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2194 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2195 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2196 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2200 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
2202 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
2203 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
2204 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
2205 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
2206 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
2207 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
2208 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
2210 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
2213 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
2216 C * * * * * * * * * * * * * * * * * * * *
2217 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
2218 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
2219 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
2220 C SYGN = TRUE, GDY SA TO PARAMETRY SYGNALU
2223 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
2224 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
2226 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2228 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
2229 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
2230 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
2231 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
2232 C MASKTP - ZAPRZECZENIE MASKI MTP
2233 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
2234 C MPROCES - WZORZEC DLA PROCESU ( 5 )
2235 C MCOR - WZORZEC DLA COROUTINY (7)
2236 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW/
2237 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
2238 C MNOTVIR - WZORZEC DO KASOWANIA BITU "WIRTUAL"
2239 C MHAND - MASKA DLA HANDLERA
2243 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
2244 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
2245 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
2247 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2248 C NULLWD(I) - WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
2249 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
2250 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
2251 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
2252 C VARWD - -- -- -- -- DLA ZMIENNEJ
2253 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
2254 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
2255 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
2256 C INOUT - --- -- -- --- ZMIENNEJ INOUT
2258 C - - - - - - - - - - - - - - - -
2260 C SPRAWDZENIE,CZY TYP FORMALNY NIE WYSTEPUJE PO UZYCIU
2261 C JESLI BLOK - TO IDZIEMY DALEJ
2262 IF(IPMEM(INDSPR).EQ.1) GO TO 1000
2263 SYGN = ISHFT(IAND(IPMEM(INDPR),MPAR),-4).EQ.11
2264 IDPAR = IPMEM(INDSPR+11)
2265 IF(SYGN) IDPAR = IPMEM(INDSPR+4)
2267 100 IF(IDPAR.EQ.0) GO TO 1000
2269 150 IF (FORM2) GO TO 350
2270 IF(K.EQ.7) GO TO 900
2271 IF(K.EQ.3.OR.K.EQ.5) GO TO 200
2273 IF(K.GE.8) I1=IDPAR+4
2275 C I - NAZWA TYPU PARAMETRU
2276 C SPRAWDZAMY,CZY TEN TYP JEST POZNIEJ W LISCIE PARAMETROW
2277 C OD IDPAR DO KONCA LISTY
2279 IF(PQ) IPMEM(I1)=NEMPTY
2280 IF(K.GE.8) GO TO 900
2281 C TERAZ SPRAWDZAMY PARAMETRY II-GO RZEDU
2284 IDPAR=IPMEM(LFORMB+4)
2285 300 IF(IDPAR.EQ.0) GO TO 800
2288 350 IF(K.LT.8) GO TO 700
2290 C SZUKAMY TYPU OD IDPAR DO KONCA LISTY II-GO RZEDU
2292 IF(.NOT.PQ) GO TO 400
2293 IPMEM(IDPAR+4) = NEMPTY
2295 C SZUKAMY TYPU WCZESNIEJ W LISCIE II-GO RZEDU BEZ
2296 C SYGNALIZACJI BLEDU
2297 400 PQ = ISTPF(I,.FALSE.)
2299 C SZUKAMY W ZEWNETRZNEJ LISCIE PF OD PRZERABIANEJ
2300 C PROCEDURY/FUNKCJI DO KONCA
2303 PQ = ISTPF(I,.TRUE.)
2304 IF(PQ) IPMEM(K+4) = NEMPTY
2306 700 IDPAR = IPMEM(IDPAR+3)
2310 900 IDPAR = IPMEM(IDPAR+3)
2313 C - - - - - - - - - - - - - - - - -
2315 C PRZETWARZANIE PARAMETROW
2319 C PRZYGOTOWANIA DO PRZETWARZANIA LISTY PF
2326 C JESLI BLOK TO NIE POSIADA PARAMETROW
2327 IF(IPMEM(INDSPR).EQ.1) GO TO 1500
2329 C PRZETWARZANIE PARAMETROW
2330 IDPAR=IPMEM(INDSPR+11)
2331 IF(SYGN) IDPAR = IPMEM(INDSPR+4)
2332 1100 IF(IDPAR.EQ.0) GO TO 1500
2334 IF(K.EQ.7) GO TO 1200
2335 IF(K.GE.8) GO TO 1300
2336 C PROCEDURA / FUNKCJA FORMALNA
2345 1400 IDPAR=IPMEM(IDPAR+3)
2350 C JESLI TO JEST FUNKCJA
2351 C UWAGA - NAZWA RESULT DOLACZANA W PROTP1
2352 IF(IPMEM(INDSPR).NE.4.AND.IPMEM(INDSPR).NE.6) GO TO 2000
2356 CALL MADATR(I,INDPR,341)
2357 C ZAPAMIETANIE 1 W POLU USED - DLA AIL
2361 IPMEM(I-4) = IPMEM(INDPR-4)
2362 IPMEM(I-3) = IPMEM(INDPR-3)
2363 C WYLICZENIE APETYTU RESULT
2365 C JESLI TO BYL TYP FORMALNY, TO ZMIANA SLOWA ZEROWEGO
2366 IF(BTEST(IPMEM(INDPR),12))
2367 * IPMEM(I) = IOR(IPMEM(I),ISHFT(1,12 ))
2372 IF(INDPREF.EQ.0) GO TO 1700
2373 C JESLI PREFIKS MIAL BLEDNA LISTE PF, TO NIE DOKLADAMY WLASNEJ
2374 IF (IAND(IPMEM(INDPREF),MERPF).NE.0) GO TO 1850
2375 C DOPISANIE SWOJEJ LISTY PF
2377 C DOLACZENIE LISTY PF Z PREFIKSU
2378 IF(INDPREF.EQ.0) GO TO 3000
2379 1850 I=IPMEM(INDPREF+3)
2381 IF(J.EQ.0) GO TO 3000
2386 1666 IPMEM(I2) = IPMEM(I3)
2388 IPMEM(INDPR+4) = IPMEM(INDPR+4)+J
2394 LOGICAL FUNCTION ISTPF(NM,PQ)
2396 C * * * * * * * * * * * * * * * * * * * * * * * *
2397 C FUNKCJA SPRAWDZA,CZY TYP O NAZWIE NM WYSTEPUJE JAKO
2398 C FORMALNY W LISCIE PARAMETROW.
2399 C JESLI PQ=.TRUE., TO SZUKAMY OD IDPAR DO KONCA LISTY
2400 C I W RAZIE ZNALEZIENIA SYGNALIZUJEMY BLAD.
2401 C JESLI PQ=.FALSE., TO SZUKAMY OD POCZATKU LOKALNEJ LISTY
2402 C PARAMETROW(LFORMAB) DO IDPAR I NIE SYBNALIZUJEMY BLEDU.
2403 C * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2405 IMPLICIT INTEGER(A-Z)
2408 C ..... ZMIENNE GLOBALNE
2412 COMMON /BLANK/ COM(278),
2413 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2414 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2415 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2416 X LOCAL , OWN , OBJECT,
2419 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2420 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2421 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2422 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2423 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2425 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2426 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2427 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2428 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2430 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
2433 C * * * * * * * * * * * * * * * * * * * *
2434 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W IPMEM
2435 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
2436 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
2437 C SYNG = TRUE, GDY SA TO PARAMETRY SYGNALU
2440 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
2442 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
2448 IF(.NOT. PQ) K=IDPAR
2450 IF(.NOT.PQ) I=IPMEM(LFORMB+4)
2452 100 IF(I.EQ.K) RETURN
2453 IF(IPMEM(I).NE.7) GO TO 200
2455 IF(IPMEM(I+2) .EQ. NM) GO TO 400
2465 SUBROUTINE PUTPF(ID)
2467 C * * * * * * * * * * * * * * * * * * * * * * * * *
2468 C WSTAWIA PARAMETR O IDENTYFIKATORZE ID DO LISTY PF
2469 C * * * * * * * * * * * * * * * * * * * * * * * ***
2471 IMPLICIT INTEGER(A-Z)
2473 C ..... ZMIENNE GLOBALNE
2477 COMMON /BLANK/ COM(278),
2478 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2479 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2480 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2481 X LOCAL , OWN , OBJECT,
2484 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2485 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2486 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2487 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2488 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2490 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2491 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2492 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2493 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2497 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
2500 C * * * * * * * * * * * * * * * * * * * *
2501 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
2502 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
2503 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
2504 C SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
2519 C * * * * * * * * * * * * * * * * * * * * * * * * *
2520 C KOPIUJE LISTE PF DO PAMIECI UZYTKOWNIKA
2521 C I DOWIAZUJE DO PROTOTYPU INDPR
2522 C * * * * * * * * * * * * * * * * * * * ** * * * *
2524 IMPLICIT INTEGER(A-Z)
2526 C ..... ZMIENNE GLOBALNE
2530 COMMON /BLANK/ COM(278),
2531 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2532 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2533 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2534 X LOCAL , OWN , OBJECT,
2537 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2538 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2539 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2540 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2541 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2543 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2544 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2545 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2546 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2550 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
2553 C * * * * * * * * * * * * * * * * * * * *
2554 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
2555 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
2556 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
2557 C SYN = TRUE, GDY TO SA PARAMETRY SYGNALU
2560 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
2562 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
2563 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
2564 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
2565 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
2566 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
2567 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
2568 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
2570 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
2579 IF(I.EQ.0) GO TO 400
2584 C JESLI TO SA PARAMETRY II-GO RZEDU,TO POPRAWIAMY SL NA INDPR
2585 IF(FORM2) IPMEM(X-1) = INDPR
2588 IF(I.EQ.0) GO TO 200
2592 C L - PIERWSZY PARAMETR
2593 C J - OSTATNI PARAMETR
2594 C TRZEBA ZAMIENIC ICH KOLEJNOSC
2597 300 IF (I1.GE.I2) GO TO 400
2604 400 IPMEM(INDPR+3) = J
2610 C * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2611 C PRZETWARZA TYP FORMALNY.
2612 C INFORMACJE O PARAMETRZE - W BLOKU DWORK
2613 C * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2615 IMPLICIT INTEGER(A-Z)
2617 C ..... ZMIENNE GLOBALNE
2621 COMMON /BLANK/ COM(278),
2622 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2623 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2624 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2625 X LOCAL , OWN , OBJECT,
2628 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2629 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2630 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2631 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2632 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2634 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2635 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2636 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2637 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2641 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
2644 C * * * * * * * * * * * * * * * * * * * *
2645 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
2646 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
2647 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
2648 C SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
2652 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
2654 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
2661 ID=INITPR(KIND,IPMEM(IDPAR+2))
2662 C WSTAWIENIE DO LISTY PF
2668 C * * * * * * * * * * * * * * * * * * * * * * ** * * * *
2669 C PRZETWARZA PARAMETR BEDACY ZMIENNA
2670 C INFORMACJE O PARAMETRZE - W BLOKU DWORK
2671 C * * * * * * * * * * * * * * * * * * * * * * * * * * *
2673 IMPLICIT INTEGER(A-Z)
2675 C ..... ZMIENNE GLOBALNE
2679 COMMON /BLANK/ COM(278),
2680 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2681 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2682 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2683 X LOCAL , OWN , OBJECT,
2686 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2687 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2688 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2689 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2690 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2692 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2693 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2694 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2695 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2699 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
2702 C * * * * * * * * * * * * * * * * * * * *
2703 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
2704 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
2705 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
2706 C SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
2710 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
2712 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
2713 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
2714 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
2715 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
2716 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
2717 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
2718 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
2720 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
2723 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
2724 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
2726 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2728 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
2729 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
2730 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
2731 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
2732 C MASKTP - ZAPRZECZENIE MASKI MTP
2733 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
2734 C MPROCES - WZORZEC DLA PROCESU ( 5 )
2735 C MCOR - WZORZEC DLA COROUTINY
2736 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
2737 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
2741 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
2742 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
2743 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
2745 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2746 C NULLWD(I) - WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
2747 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
2748 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
2749 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
2750 C VARWD - -- -- -- -- DLA ZMIENNEJ
2751 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
2752 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
2753 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
2754 C INOUT - -- -- --- -- ZMIENNEJ INOUT
2757 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
2759 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
2762 LINE = IPMEM(IDPAR+1)
2765 C UTWORZENIE OBIEKTU
2768 IF(IPMEM(IDPAR).EQ.9) IPMEM(ID)=OUTPFW
2769 IF(IPMEM(IDPAR).EQ.10) IPMEM(ID)=INOUT
2770 C WSTAWIENIE DO ZBIORU IDENTYFIKATOROW
2771 IF(FORM2) INSYS=.TRUE.
2772 K=IDPUT(NM,IPMEM(IHBEG))
2773 IF(K.EQ.0) GO TO 200
2775 C WSTAWIENIE DO LISTY ATRYBUTOW
2776 200 CALL MADATR(ID,INDPR,341)
2777 C ZAPAMIETANIE 1 W POLU USED - DLA AIL
2779 C WSTAWIENIE DO LISTY PF
2786 IPMEM(ID-4) = IPMEM(IDPAR+5)
2787 C WSTAWIENIE APETYTU
2789 C JESLI TYP JEST FORMALNY, TO POPRAWIAMY SLOWO ZEROWE
2790 IF(IAND(IPMEM(K),MTP) .NE. 6) RETURN
2791 IPMEM(ID) = IOR(IPMEM(ID),ISHFT(1,12))
2792 C JESLI TYP FORMALNY JEST NIELOKALNY, TO POPRAWIAMY SPECYFIKACJE
2794 IF(LOCAL.EQ.2) RETURN
2797 C JESLI SYGNAL - TO BLAD
2798 250 IF(SYGN) CALL MERR(361,NM)
2800 C JESLI TYP POCHODZI Z TEJ SAMEJ LISTY PARAMETROW CO PROCEDUURA FORMALNA,
2802 300 IF(IPMEM(K-1).EQ.IPMEM(INDPR-1)) RETURN
2807 C * * * * * * ** * * * * * * * * * * * * * * * * * * * * *
2808 C PRZETWARZA PROCEDURE LUB FUNKCJE FORMALNA I-GO RZEDU
2809 C INFORMACJE O PARAMETRZE W BLOKU DWORK
2810 C * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2812 IMPLICIT INTEGER(A-Z)
2814 C ..... ZMIENNE GLOBALNE
2818 COMMON /BLANK/ COM(278),
2819 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
2820 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
2821 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
2822 X LOCAL , OWN , OBJECT,
2825 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
2826 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
2827 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
2828 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
2829 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
2831 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
2832 C NACZONEGO NA PROTOTYPY SYSTEMOWE
2833 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
2834 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
2838 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
2840 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
2841 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
2842 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
2843 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
2844 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
2845 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
2846 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
2848 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
2852 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
2855 C * * * * * * * * * * * * * * * * * * * *
2856 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
2857 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
2858 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
2859 C SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
2862 COMMON /DCOPIES/ INDPRC,IHBEGC, IDPARC,LFBC,LFEC
2864 C * * * * * * * * * * * * * * * * * * * * * *
2865 C KOPIE ZMIENNYCH Z DGLOB I DWORK
2866 C INDPRC - KOPIA INDPR
2867 C IHBEGC - KOPIA IHBEG
2868 C IDPARC - KOPIA IDPAR
2869 C LFBC - KOPIA LFORMB
2870 C LFEC - KOPIA LFORME
2873 COMMON / YNIT / NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
2874 * VARWD,VARPOM,INPFW,OUTPFW, INOUT
2875 cdsw INTEGER SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
2877 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2878 C NULLWD(I) - WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
2879 C SIZEPR(I) - ROZMIAR POLA W IPMEM -- -- --
2880 C NULLPOZ(I) - POZYCJA SLOWA ZEROWEGO -- -- --
2881 C CONSTWD - WZORZEC SLOWA ZEROWEGO DLA CONST
2882 C VARWD - -- -- -- -- DLA ZMIENNEJ
2883 C VARPOM - -- -- -- -- ZMIENNEJ POMOCNICZEJ
2884 C INPFW - -- -- -- -- ZMIEMNEJ INPUT
2885 C OUTPFW - -- -- -- -- ZMIENNEJ OUTPUT
2886 C INOUT - -- -- -- --- ZMIENNEJ INOUT
2889 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
2890 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
2892 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
2894 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
2895 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
2896 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
2897 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
2898 C MASKTP - ZAPRZECZENIE MASKI MTP
2899 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
2900 C MPROCES - WZORZEC DLA PROCESU ( 5 )
2901 C MCOR - WZORZEC DLA COROUTINY (7)
2902 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
2903 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
2905 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
2907 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
2916 C BEGM - POCZATEK WOLNEGO POLA W PAMIECI SYSTEMOWEJ
2919 C UTWORZENIE OPISU PARAMETRU
2922 C ZAPAMIETANIE KOPII
2928 C ZAMIANA ZMIENNYCH OKRESLAJACYCH PRZETWARZANY PROTOTYP
2936 C - - - - - - - - - - - - - - - - - - -
2937 C PRZETWARZANIE LISTY PF II-GO RZEDU
2941 IDPAR=IPMEM(IDPAR+4)
2942 100 IF(IDPAR.EQ.0) GO TO 500
2944 IF(KD.EQ.7) GO TO 200
2945 IF(KD.GE.8) GO TO 300
2946 C PROCEDURA/FUNKCJA II-GO RZEDU
2954 400 IDPAR = IPMEM(IDPAR+3)
2959 C - - - - - - - - - - - - - - - - -
2960 C CZYNNOSCI ORGANIZACYJNE(PAMIEC) I ZAKONCZENIE
2961 C PRZETWARZANIA PROCEDURY/FUNKCJI
2964 C DOLACZENIE RESULT - JESLI TO JEST FUNKCJA
2965 IF(K.EQ.13.OR.K.EQ.15) GO TO 700
2968 CALL MADATR(I,INDPR,341)
2970 C ZAPAMIETANIE IDENTYFIKATORA RESULT
2972 C UWAGA - NAZWY RESULT NIE TRZEBA ZAPAMIETYWAC
2974 C PRZEPISANIE PROTOTYPU DO CZESCI UZYTKOWNIKA
2975 IF(K.EQ.14 .OR. K.EQ.16) GO TO 750
2989 888 IPMEM(I1) = IPMEM(I2)
2990 C ZMIANA DOWIAZANIA NEXTDECL W PROTOTYPIE POPRZEDZAJACYM ( LP )
2992 IF(IPMEM(INDPR+2).EQ.0) LASTPR = INDPR
2993 C PRZEPISANIE LISTY PF
2995 C POPRAWIENIE ID PROTOTY@PU W TABLICY HASH
2996 I=MEMBER(NM,IPMEM(IHBEGC))
2998 C POPRAWIENIE ID PROTOTYPU W LISCIE ATRYBUTOW
3000 C I - NUMER ATRYBUTU
3003 IF(IPMEM(J-2).EQ.I) GO TO 950
3007 950 IPMEM(KD) = INDPR
3008 C COFNIECIE PAMIECI SYSTEMOWEJ
3010 C COFNIECIE ZMIENNYCH Z DWORK
3015 C DOLACZENIE SIEBIE DO LISTY PF
3017 C COFNIECIE ZMIENNYCH Z DGLOB
3022 C JESLI FUNKCJA - TO NADANIE TYPU
3023 IF(K.EQ.13 .OR. K.EQ.15) GO TO 1000
3027 IPMEM(I-4) = IPMEM(IDPAR+6)
3029 IPMEM(K-4) = IPMEM(I-4)
3031 C JESLI TO JEST TYP FORMALNY, TO POPRAWIAMY SLOWO ZEROWE
3032 IF(IAND(IPMEM(J),MTP).NE.6) GO TO 1000
3033 IPMEM(I) = IOR(IPMEM(I),ISHFT(1,12))
3034 IPMEM(K) = IOR(IPMEM(K),ISHFT(1,12))
3035 C JESLI TYP FORMALNY JEST NIELOKALNY, TO ZLE DLA SYGNALU
3036 IF(LOCAL.EQ.2 .OR. .NOT.SYGN) GO TO 1000
3039 C WYPISUJEMY INFORMACJE O PARAMETRACH II-GO RZEDU
3041 C IF(IPMEM(I+4).EQ.0)RETURN
3045 C NM=ISHFT(IAND(IPMEM(I),MPAR),-4)
3046 C IF(NM.GE.4) GO TO 1112
3047 C CALL ffwrite(BO(2),"IDENTYFIKATOR =",17)
3048 C CALL ffwrint(BO(2),I)
3058 C ** ** ** ** * * * * * * * * * * * * * * * * *
3059 C PRZETWARZA PROCEDURE/FUNKCJE FORMALNA II-GO RZEDU
3060 C PARAMETR DANY PRZEZ ZMIENNE Z BLOKU DWORK
3061 C * * * * * * * * * * * * * * * * * * * * * * *** *
3063 IMPLICIT INTEGER(A-Z)
3066 C ..... ZMIENNE GLOBALNE
3070 COMMON /BLANK/ COM(278),
3071 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3072 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3073 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3074 X LOCAL , OWN , OBJECT,
3077 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3078 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3079 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3080 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3081 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3083 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3084 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3085 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
3086 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
3091 COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
3094 C * * * * * * * * * * * * * * * * * * * *
3095 C IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
3096 C LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
3097 C FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
3098 C SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
3101 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
3103 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
3108 C DOLACZENIE DO LISTY PF ATRYBUTU DODATKOWEGO(BRAK)
3109 C UTWORZENIE PROTOTYPU
3112 C DOLACZENIE DO LISTY PF
3114 C EWENTUALNIE TYP FUNKCJI - BRAK
3121 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3122 C SPRAWDZA KOMPATYBILNOSC WIRTUALI
3124 C * * * * * * * * * * * * * * * * * ** * * * * * * * * * * *
3126 IMPLICIT INTEGER (A-Z)
3129 C ..... ZMIENNE GLOBALNE
3133 COMMON /BLANK/ COM(278),
3134 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3135 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3136 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3137 X LOCAL , OWN , OBJECT,
3140 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3141 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3142 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3143 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3144 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3146 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3147 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3148 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
3149 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
3153 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
3155 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
3156 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
3157 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
3158 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
3159 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
3160 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
3161 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
3163 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
3167 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
3168 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
3170 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
3172 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
3173 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
3174 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
3175 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
3176 C MASKTP - ZAPRZECZENIE MASKI MTP
3177 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
3178 C MPROCES - WZORZEC DLA PROCESU ( 5 )
3179 C MCOR - WZORZEC DLA COROUTINY (7)
3180 C MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
3181 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
3185 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
3187 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
3190 COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
3193 C ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
3194 C ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
3195 C NM - NAZWA WIRTUALA
3196 C INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
3197 C FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
3198 C TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
3199 C INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
3205 INDV=IPMEM(INDPR+26)
3207 LINE=IPMEM(INDSPR+9)
3208 C KONTROLA RODZAJOW WIRTUALI
3209 IRU=ISHFT(IAND(IPMEM(INDV),MOTHERS),-8)
3210 IRL=ISHFT(IAND(IPMEM(INDPR),MOTHERS),-8)
3211 IF (IRU.EQ.IRL) GO TO 50
3214 C JESLI TO SA FUNKCJE - TO SPRAWDZAMY TYPY
3215 50 IF(IRL.EQ.4 .OR. IRU.EQ.4) GO TO 100
3217 CALL TYPECOM(INDV,INDPR)
3219 100 I=IPMEM(INDPR+3)
3221 C DLA FUNKCJI TRZEBA POMINAC RESULT
3222 IF(IRL.EQ.2) IL=IL-1
3225 IF(IRU.EQ.2) JU=JU-1
3226 C I,IL - POCZATEK I DLUGOSC LISTY PF DLA INDPR
3227 C J,JU - POCZATEK I DLUGOSC LISTY PF DLA INDV
3228 IF(IL+JU.EQ.0) GO TO 1000
3229 IF(IL.NE.JU) GO TO 800
3230 C ZGODNA LICZBA PARAMETROW
3234 C SPRAWDZENIE ZGODNOSCI PARAMETROW
3235 C PROCEDURA PARCOM DAJE TRUE, GDY TRZEBA
3236 C DALEJ SPRAWDZAC ZGODNOSC PF II-GO RZEDU
3237 C (TZN. SA TO PROCEDURY/FUNKCJE)
3238 300 IF(.NOT.PARCOM(IPMEM(J),IPMEM(I))) GO TO 700
3239 C SPRAWDZAMY ZGODNOSC PF II-GO RZEDU
3243 IRL1=ISHFT(IAND(IPMEM(INDPR1),MOTHERS),-8)
3244 IRU1=ISHFT(IAND(IPMEM(INDV1),MOTHERS),-8)
3247 C DLA FUNKCJI - POMIJAMY RESULT
3248 IF(IRL1.EQ.2) IL1 = IL1-1
3251 IF(IRU1.EQ.2) JU1 = JU1-1
3252 IF(IL1+JU1.EQ.0) GO TO 600
3253 IF(IL1.NE.JU1) GO TO 500
3256 C SPRAWDZANIE ZGODNOSCI PARAMETROW II-GO RZEDU
3257 400 P=PARCOM(IPMEM(J1),IPMEM(I1))
3260 IF(I1.LE.IL1.AND.J1.LE.JU1) GO TO 400
3262 C NIEZGODNA LICZBA PARAMETROW
3264 IF(IL1.LT.JU1) GO TO 530
3265 C SPRAWDZAMY,CZY LISTA KROTSZA JEST BLEDNA
3266 IF(IAND(IPMEM(INDV1),MERPF).NE.0) GO TO 550
3269 530 IF(IAND(IPMEM(INDPR1),MERPF).NE.0) GO TO 550
3271 550 IF(IL1*JU1.NE.0) GO TO 350
3273 C KONIEC SPRAWDZANIA PARAMETROW II-GO RZEDU
3277 IF(I.LE.IL.AND.J.LE.JU) GO TO 300
3280 C NIEZGODNA LICZBA PARAMETROW
3281 800 IF(IL.LT.JU) GO TO 850
3282 IF(IAND(IPMEM(INDV),MERPF).NE.0) GO TO 900
3283 C KROTSZA LISTA PF NIE JEST BLEDNA
3286 850 IF(IAND(IPMEM(INDPR),MERPF).NE.0) GO TO 900
3288 900 IF(IL*JU.NE.0) GO TO 200
3294 LOGICAL FUNCTION PARCOM(PARU,PARL)
3296 C * * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * *
3297 C SPRAWDZA ZGODNOSCI PARAMETROW O IDENTYFIKATORACH PARU I PARL
3298 C PARCOM=.TRUE., GDY OBA PARAMETRY SA PROCEDURA LUB FUNKCJA
3299 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3301 IMPLICIT INTEGER(A-Z)
3303 C ..... ZMIENNE GLOBALNE
3307 COMMON /BLANK/ COM(278),
3308 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3309 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3310 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3311 X LOCAL , OWN , OBJECT,
3314 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3315 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3316 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3317 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3318 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3320 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3321 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3322 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
3323 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
3327 COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
3330 C ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
3331 C ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
3332 C NM - NAZWA WIRTUALA
3333 C INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
3334 C FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
3335 C TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
3336 C INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
3341 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
3342 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
3344 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
3346 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
3347 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
3348 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
3349 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
3350 C MASKTP - ZAPRZECZENIE MASKI MTP
3351 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
3352 C MPROCES - WZORZEC DLA PROCESU ( 5 )
3353 C MCOR - WZORZEC DLA COROUTINY (7)
3354 C MERPF - MASKA DO ROZPOZNANIA BLEDNYCH LIST PF
3355 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
3359 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
3361 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
3364 IDU=ISHFT(IAND(IPMEM(PARU),MPAR),-4)
3365 IDL=ISHFT(IAND(IPMEM(PARL),MPAR),-4)
3369 IF(IDU.EQ.IDL) GO TO 100
3374 C JESLI OBA PARAMETRY SA ZMIENNYMI, TO KONTROLA TYPOW
3375 100 IF((IDU.EQ.5.OR.IDU.EQ.6.OR.IDU.EQ.9)
3376 * .AND. (IDL.EQ.5.OR.IDL.EQ.6.OR.IDL.EQ.9)) GO TO 300
3377 IF(IDU.NE.2.AND.IDU.NE.3 .OR. IDL.NE.2.AND.IDL.NE.3)
3380 C JESLI OBIE FUNKCJE I-GO RZEDU - TO KONTROLA TYPOW
3381 IF(IDU.NE.2.OR.IDL.NE.2) RETURN
3384 300 CALL TYPECOM(PARU,PARL)
3387 SUBROUTINE TYPECOM (TPU,TPL)
3389 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3390 C KONTROLA ZGODNOSCI TYPOW
3391 C TPU,TPL - IDENTYFIKATORY ZMIENNYCH(FUNKCJI)
3392 C TPVI=.TRUE., GDY TO SA TYPY FUNKCJI VIRTUALNYCH
3393 C * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3395 IMPLICIT INTEGER(A-Z)
3396 LOGICAL POMU,POML,BPREF
3398 C ..... ZMIENNE GLOBALNE
3402 COMMON /BLANK/ COM(278),
3403 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3404 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3405 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3406 X LOCAL , OWN , OBJECT,
3409 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3410 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3411 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3412 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3413 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3415 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3416 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3417 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
3418 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
3422 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
3423 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
3425 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
3427 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
3428 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
3429 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
3430 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
3431 C MASKTP - ZAPRZECZENIE MASKI MTP
3432 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
3433 C MPROCES - WZORZEC DLA PROCESU ( 5 )
3435 C MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
3436 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
3440 COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
3443 C ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
3444 C ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
3445 C NM - NAZWA WIRTUALA
3446 C INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
3447 C FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
3448 C TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
3449 C INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
3455 C IARU,IARL - ILOSC ARRAY OF
3456 C ITU,ITL - IDENTYFIKATORY TYPOW
3457 C IDENU,IDNEL - WARTOSCI MTP ZE SLOWA ZEROWEGO TYPOW
3462 C JESLI TYPY SA IDENTYCZNE, TO DOBRZE
3463 IF(IARU.EQ.IARL.AND.ITL.EQ.ITU) RETURN
3464 C JESLI JEDEN Z TYPOW JEST UNIWERSALNY, TO DOBRZE
3465 IF(ITL.EQ.NRUNIV.OR.ITU.EQ.NRUNIV) RETURN
3466 C JESLI TYPY ROZNIA SIE TYLKO ARRAY OF , TO ZLE
3467 IF(IARU.NE.IARL.AND.ITL.EQ.ITU) GO TO 999
3468 IDENU=IAND(IPMEM(ITU),MTP)
3469 IDENL=IAND(IPMEM(ITL),MTP)
3470 IF(IDENU.EQ.6) GO TO 500
3471 C TYP WYZSZY NIE JEST FORMALNY
3472 C JESLI NIE ZGADZA SIE ARRAY OF , TO BLAD
3473 IF(IARU.NE.IARL) GO TO 999
3474 C JESLI SA TABLICOWE, TO MUSZA BYC ROWNE
3475 IF(IARU.NE.0.AND.ITU.NE.ITL) GO TO 999
3476 C JESLI JESZCZE SA TU TYPY PRYMITYWNE, TO BLAD(MUSZA BYC ROWNE)
3477 IF(IDENU.GE.8 .AND. IDENU.LT.13) GO TO 999
3478 IF(IDENL .GE. 8 .AND. IDENL .LT. 13) GO TO 999
3479 IF(ITU.EQ.NRCOR) GO TO 200
3480 IF(ITU.EQ.NRPROC) GO TO 300
3481 C TYP WYZSZY JEST KLASOWY
3482 C TYPY MAJA BYC W SEKWENCJI PREFIKSOWEJ
3483 IF(IDENL.EQ.6) GO TO 999
3486 IF(BPREF(ITL,I)) RETURN
3488 IF(BPREF(ITU,J)) RETURN
3490 C WYZSZY - SAMA COROUTINA
3491 200 IF(IDENL.EQ.5 .OR. IDENL.EQ.7) RETURN
3492 IF(BPREF(ITL,IPMEM(NRCOR-6))) RETURN
3493 IF(BPREF(ITL,IPMEM(NRPROC-6))) RETURN
3495 C WYZSZY - SAM PROCESS
3496 300 IF(IDENL.EQ.5) RETURN
3497 IF(BPREF(ITL,IPMEM(NRPROC-6))) RETURN
3500 C WYZSZY - TYP FORMALNY
3503 J=NRPAR(ITL,.FALSE.)
3504 C I,J - NUMERY TYPOW W LISCIE INDV(INDPR)
3505 C JESLI TO SA PARAMETRY II-GO RZEDU, TO TAKZE
3506 C W LISCIE PF INDV1(INDPR1)
3507 IF(I+J.EQ.0) GO TO 700
3508 IF(I.NE.J) GO TO 999
3509 IF(IARU.NE.IARL) GO TO 999
3510 C TRZEBA SPARWDZIC, CZY OBA TYPY SA PARAMETRAMI
3515 POMU=IAND(IPMEM(I),MPAR).NE.0
3516 POML=IAND(IPMEM(J),MPAR).NE.0
3517 IF(POMU.AND.POML.OR..NOT.(POMU.OR.POML))RETURN
3520 C TO NIE JEST WLASNY PARAMETR
3522 IF(IARU.NE.0) GO TO 800
3523 C JESLI WYZSZY NIE JEST TABLICOWY, TO ZLE, GDY
3524 C NIZSZY JEST PRYMITYWNY NIETABLICOWY
3525 IF(IARL.NE.0) RETURN
3526 IF(IDENL.GE.8.AND.IDENL.LT.13) GO TO 999
3528 C WYZSZY JEST TYPEM TABLICOWYM
3529 800 IF(IDENL.EQ.6) RETURN
3530 IF(IARU.LE.IARL) RETURN
3531 C SYGNALIZACJA BLEDOW
3538 INTEGER FUNCTION NRPAR(IDT,UP)
3540 C * * * * * * *** * * * * * * * * * * * * * * * * * * * * *
3541 C SPRAWDZA,CZY TYP IDT JEST PARAMETREM INDPR(INDV)
3542 C UP=.TRUE. - CHODZI O WIRTUAL WYZSZY (INDV)
3543 C NRPAR - NUMER IDT JAKO PARAMETRU ( LUB 0)
3544 C JESLI FORM2=.TRUE., TO BADA TEZ, CZY TYP JEST PARAMETREM/
3545 C INDV1(ODP. INDPR1)
3546 C * * * * * * * * * * * * * * * * * * * * * * * * * ** * * *
3548 IMPLICIT INTEGER(A-Z)
3551 C ..... ZMIENNE GLOBALNE
3555 COMMON /BLANK/ COM(278),
3556 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3557 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3558 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3559 X LOCAL , OWN , OBJECT,
3562 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3563 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3564 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3565 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3566 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3568 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3569 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3570 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
3571 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
3575 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
3577 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
3578 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
3579 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
3580 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
3581 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
3582 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
3583 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
3585 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
3589 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
3590 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
3592 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
3594 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
3595 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
3596 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
3597 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
3598 C MASKTP - ZAPRZECZENIE MASKI MTP
3599 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
3600 C MPROCES - WZORZEC DLA PROCESU ( 5 )
3601 C MCOR - WZORZEC DLA COROUTINY (7)
3602 C MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
3603 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
3607 COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
3610 C ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
3611 C ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
3612 C NM - NAZWA WIRTUALA
3613 C INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
3614 C FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
3615 C TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
3616 C INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
3623 C JESLI TYP NIE JEST FORMALNY, TO KONIEC
3624 I=IAND(IPMEM(IDT),MTP)
3626 C IND - TU SZUKAMY PARAMETRU
3632 C SPRAWDZAMY, CZY I=IND LUB JEGO PREFIKS
3633 IF(IS.EQ.IND) GO TO 100
3634 C JESLI IS NIE JEST KLASA, TO KONIEC
3635 IF(IAND(IPMEM(IS),MTP).EQ.1) RETURN
3636 IF(.NOT.BPREF(IND,IPMEM(IS-6))) RETURN
3640 IF(IPMEM(I).EQ.IDT) RETURN
3643 C SZUKAMY W LISCIE II-GO RZEDU
3646 IF(IS.NE.IND) GO TO 300
3649 SUBROUTINE SIGNAL ( IDSIG )
3651 IMPLICIT INTEGER (A-Z)
3653 C * * * * * * ** * * * * * * * * * * ** * * * * * * * * * * * * * * * * *
3654 C PRZETWARZA SYGNAL O IDENTYFIKATORZE ( SYNTAKTYCZNYM ) IDSIG
3655 C TWORZY DLA NIEGO KOMPLETNY PROTOTYP
3656 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3661 COMMON /BLANK/ COM(278),
3662 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3663 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3664 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3665 X LOCAL , OWN , OBJECT,
3668 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3669 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3670 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3671 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3672 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3674 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3675 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3676 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
3677 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
3680 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
3682 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
3683 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
3684 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
3685 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
3686 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
3687 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
3688 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
3690 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
3694 cdsw COMMON /SIGNALS/ NRSIG, HLISTE
3695 cdsw -----------------------------------------------------
3696 common /signs/ nrsig, hliste
3697 cdsw -----------------------------------------------------
3699 C NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
3700 C HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
3702 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
3704 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
3707 C NRPR - NUMER PROTOTYPU SEMANTYCZNEGO
3710 LINE = IPMEM(IDSIG+1)
3711 C USTAWIENIE BITU CLOSE
3712 I = MEMSL (NM, INDPR )
3714 C PRZYDZIELENIE NUMERU SYGNALU
3716 IPMEM(NRPR+1) = NRSIG
3717 C ZAPAMIETANIE SYNTAKTYCZNEJ LISTY PARAMETROW W PROTOTYIE SYGNALU (KONTROLA)
3718 IPMEM(NRPR+8) = IPMEM(IDSIG+4)
3720 C PRZETWARZANIE NAGLOWKA
3721 C ZAPAMIETANIE KOPII ZMIENNYZCH OKRESLAJACYCH PRZETWARZANY PROTOTYP
3726 C NADANIE NOWYCH WARTOSCI
3731 C PRZETWARZANIE NAGLOWKA
3733 C PRZYWROCENIE WARTOSCI ZMIENNYM
3741 SUBROUTINE HANDLER ( IDSMEM )
3743 IMPLICIT INTEGER ( A-Z )
3746 C BECAUSE OF TYPECONFLICT 03.01.84
3748 C ** * * * * ** * * * * * * * * * ** * * * * * ** ** ** * ** * * *** * **
3749 C PRZETWARZA PROTOTYP HANDLERA
3750 C IDSMEM - IDENTYFIKATOR PROTOTYPU SYNTAKTYCZNEGO
3751 C * * * * * * * * * * * * * * * * *** * * * * * * * * * *** * * * * * *
3756 COMMON /BLANK/ COM(278),
3757 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3758 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3759 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3760 X LOCAL , OWN , OBJECT,
3763 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3764 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3765 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3766 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3767 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3769 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3770 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3771 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
3772 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
3776 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
3778 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
3779 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
3780 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
3781 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
3782 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
3783 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
3784 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
3786 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
3790 cdsw COMMON /SIGNALS/ NRSIG, HLISTE
3791 cdsw ----------------------------------------------------------
3792 common /signs/ nrsig, hliste
3793 cdsw ----------------------------------------------------------
3795 C NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
3796 C HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
3800 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
3801 * MPROCES, MCOR, MERPF, MBLOCK, MHAND,MNOTVIR
3803 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
3805 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
3806 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
3807 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
3808 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
3809 C MASKTP - ZAPRZECZENIE MASKI MTP
3810 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
3811 C MPROCES - WZORZEC DLA PROCESU ( 5 )
3812 C MCOR - WZORZEC DLA COROUTINY (7)
3813 C MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
3814 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
3815 C MNOTVIR - WZORZEC DO KASOWANIA BITU "VIRTUAL"
3818 COMMON /COPSIG/ BEGADR, IDHAND
3820 C BLOK SLUZACY DO KOMUNIKACJI Z PROCEDURA KOPIUJACA POSZCZEGOLNE PROTOTYPY
3821 C IDHAND - IDENTYFIKATOR HANDLERA
3822 C BEGADR - PIERWSZY ELEMENT SLOWNIKA ZAMIANY STARYCH ADRESOW NA NOWE
3823 C KAZDY ELEMENT SLOWNIKA ZAJMUJE 2 SLOWA: STARY ADRES, NOWY ADRES.
3824 C OSTATNI ELEMENT SLOWNIKA - LPML-2
3827 C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
3829 COMMON /STREAM/ ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
3833 IDHAND = IPMEM(IDSMEM+1)
3834 LINE = IPMEM(IDSMEM+9)
3836 C PRZEJSCIE PO LISCIE NAZW SYGNALOW
3837 C ODNALEZIENIE SYGNALOW, SPRAWDZENIE ICH POPRAWNOSCI, UTWORZENIE LISTY
3839 C LS - KOLEJNY ELEMENT LISTY
3840 C POR - ELEMENT LISTY Z KTORYM BEDZIEMY POROWNYWAC
3841 C NAGLOWKI KOLEJNYCH SYGNALOW
3842 LS = IPMEM(IDSMEM+10)
3844 IF(LS.EQ.0) GO TO 810
3845 C TO NIE JEST HANDLER OTHERS
3849 I = MEMSL(NM, INDPR)
3850 IF (I.EQ.0) GO TO 100
3851 IF ( BTEST(IPMEM(I+1),2)) GO TO 150
3852 IF ( .NOT. BTEST(IPMEM(I+1),1) .OR. OWN ) GO TO 300
3856 C NAZWA JEST NOT TAKEN
3857 150 CALL MERR (352, NM)
3859 C NAZWA NIEZADEKLAROWANA
3860 100 CALL MERR (350, NM)
3861 C JESLI TO JEST ELEMENT, Z KTORYM MAMY POROWNYWAC, TO GO PRZESUWAMY
3862 200 IF(POR.EQ.LS) POR = IPMEM(LS+1)
3865 C NAZWA JEST ZADEKLAROWANA
3866 C SPRAWDZAMY, CZY TO JEST NAZWA SYGNALU
3867 300 IDSIG = IPMEM(I+2)
3869 J = ISHFT(IAND(J,MPAR),-4)
3870 IF(J.NE.11) GO TO 250
3871 C TO JEST PROTOTYP SYGNALU
3872 C JESLI TO JEST PIERWSZY, TO PRZECHODZIMY DO NASTEPNEGO
3873 IF(LS.EQ.IPMEM(IDSMEM+10)) GO TO 800
3874 IF(LS.EQ.POR) GO TO 800
3875 C SPRAWDZAMY ZGODNOSC PARAMETROW
3876 IF(IAND(IPMEM(IDSIG),MERPF).NE.0) GO TO 400
3877 C JESLI LS MA DOBRA LISTE PARAMETROW, A POR ZLA - TO ZMIENIAMY POR
3879 IF(IAND(IPMEM(J),MERPF).EQ.0) GO TO 400
3882 C TO NIE JEST PROTOTYP SYGNALU
3883 250 CALL MERR ( 353,NM )
3886 C SPRAWDZAMY ZGODNOSC LISTY PARAMETROW
3887 400 CALL SPRPAR ( IDSIG, IPMEM(POR), NM)
3888 C DOLACZAMY DO LISTY HANDLEROW
3889 800 I = IPMEM(IDSIG+1)
3890 C SPRAWDZAMY, CZY HANDLER SI NIE POWTARZA
3891 810 IF(HLISTE.EQ.0) GO TO 830
3893 820 IF(IPMEM(J).NE.I) GO TO 840
3897 IF(J.NE.0) GO TO 820
3898 830 J = MGETM(3,341)
3902 IF(HLISTE.EQ.0) GO TO 850
3905 850 IPMEM(INDPR+20) = J
3907 IPMEM(INDPR+19) = IPMEM(INDPR+19) + 1
3908 C JESLI HANDLER OTHERS, TO KONIEC
3910 C ZAPAMIETUJEMY IDENTYFIKATOR PROTOTYPU W POLU NAZWY
3911 950 IPMEM(LS) = IDSIG
3912 1000 LS = IPMEM(LS+1)
3913 IF(LS.NE.0) GO TO 50
3915 C KOPIOWANIE ATRYBUTOW
3916 C POR - Z TEGO SIE KOPIUJE DO HANDLERA
3917 C POR = 0 - NIE BYLO ANI JEDNEGO POPRAWNEGO SYGNALU
3921 C WSTAWIENIE DO HANDLERA DOWIAZANIA DO SYGNALU
3922 IPMEM(IDHAND+3) = IDSIG
3924 C KOPIOWANIE LISTY ATRYBUTOW RAZEM Z KOPIOWANIEM PROTOTYPOW
3927 C I - KOLEJNY ELEMENT LISTY ATRYBUTOW PROTOTYPU IDSIG
3928 C J - OSTATNIO SKOPIOWANY ELEMENT LISTY PROTOTYPU IDHAND
3930 1100 IPMEM(J+1) = MGETM(2,341)
3932 IPMEM(J) = ICPROT(IPMEM(I))
3934 IF(I.NE.0) GO TO 1100
3935 C USTAWIENIE OSTATNIEGO ATRYBUTU PROTOTYPU IDHAND
3938 C KOPIOWANIE TABLICY HASH'U
3940 C LPML - OSTATNI ELEMENT SLOWNIKA ZAMIANY ADRESOW
3945 C I - KOLEJNY ELEMENT TABLICY HASH'U PROTOTYPU IDSIG
3948 C J - KOLEJNY ELEMENT LISTY HASH'U PROTOTYPU IDSIG
3949 IF(J.EQ.0) GO TO 1500
3951 C K - OSTATNIO SKOPIOWANY ELEMENT LISTY HASH'U PROTOTYPU IDHAND
3952 1200 IPMEM(K+3) = MGETM(4,341)
3955 IPMEM(K+1) = IPMEM(J+1)
3956 C SZUKANIE ODPOWIEDNIEGO ADRESU
3958 DO 1300 IJ = BEGADR, LPML, 2
3959 IF(IPMEM(IJ).EQ.II) GO TO 1400
3961 1400 IPMEM(K+2) = IPMEM(IJ+1)
3963 IF(J.NE.0) GO TO 1200
3966 C KONIEC KOPIOWANIA - ZWALNIAMY PAMIEC PRZEZNACZONA NA SLOWNIK
3970 SUBROUTINE SPRPAR ( EL, ELPOR, NM )
3972 C * * * * * * * * * ** * * * * ** * * * * * * * * * * * * * * * * * * * *
3973 C POROWNUJE LISTY PARAMETROW SYGNALU O IDENTYFIKATORZE EL I SYGNALU
3974 C O ODENTYFIKATORZE ELPOR
3975 C ELPOR - WZORCOWY SYGNAL DO POOWNYWANIA
3976 C NM - NAZWA SYGNALU EL
3977 C * * * * * * * * * * * * **** * * * * * ** * * * ** * * * * * * ** ***
3979 IMPLICIT INTEGER ( A - Z )
3984 COMMON /BLANK/ COM(278),
3985 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
3986 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
3987 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
3988 X LOCAL , OWN , OBJECT,
3991 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
3992 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
3993 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
3994 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
3995 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
3997 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
3998 C NACZONEGO NA PROTOTYPY SYSTEMOWE
3999 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
4000 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
4003 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
4004 * MPROCES, MCOR, MERPF, MBLOCK, MHAND,MNOTVIR
4006 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
4008 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
4009 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
4010 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
4011 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
4012 C MASKTP - ZAPRZECZENIE MASKI MTP
4013 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
4014 C MPROCES - WZORZEC DLA PROCESU ( 5 )
4015 C MCOR - WZORZEC DLA COROUTINY (7)
4016 C MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
4017 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
4018 C MNOTVIR - WZORZEC DO KASOWANIA BITU "VIRTUAL"
4022 C LISTE - LISTA PARAMETROW ( SYNTAKTYCZNA! ) SYGNALU EL
4023 C LPOR - LISTA PARAMETROW SYGNALU ELPOR
4024 C LISTY SA PRZECHOWANE W SLOWIE +8 PROTOTYPU SYGNALU
4027 LPOR = IPMEM(ELPOR+8)
4028 50 IF ( LISTE + LPOR .EQ.0 ) RETURN
4029 IF ( LISTE*LPOR.EQ.0) GO TO 900
4033 NMP = IPMEM(LISTE+2)
4034 C NMP - NAZWA PARAMETRU LISTE
4036 IF(KD.EQ.KIND) GO TO 70
4037 C MOZE SA NIEZGODNE RODZAJE
4038 IF ( KIND.GE.7 .OR. KD.GE.7 ) GO TO 100
4039 C SPRAWDZAMY, CZY RODZAJE SA ZGODNE Z DOKLADNOSCIA DO BLEDNYCH LIST PF
4040 IF(IABS(KIND-KD).NE.2) GO TO 100
4042 70 IF ( NMP.NE.IPMEM(LPOR+2) ) GO TO 200
4043 IF (KIND.LE.6) GO TO 300
4044 IF (KIND.EQ.7) GO TO 400
4045 C ZMIENNE - POROWNUJEMY TYPY
4046 IF(IPMEM(LISTE+4).NE.IPMEM(LPOR+4)) GO TO 250
4047 IF(IPMEM(LISTE+5).NE.IPMEM(LPOR+5)) GO TO 250
4048 C NIE MA BLEDU - NASTEPNY ELEMENT LISTY
4049 400 LISTE = IPMEM(LISTE+3)
4050 LPOR = IPMEM(LPOR+3)
4054 100 CALL MERR (355,NMP)
4057 200 CALL MERR (356,NMP)
4060 250 CALL MERR(354,NMP)
4064 C SPRAWDZAMY PARAMETRY II-GO RZEDU
4065 300 I = IPMEM(LISTE+4)
4067 C I - ELEMENTY LISTY II-GO RZEDU PARAMETRU LISTE
4068 C K - ELEMENTY LISTY II-GO RZEDU PARAMETRU LPOR
4069 350 IF ( I+K.EQ.0) GO TO 800
4070 IF ( I*K.EQ.0 ) GO TO 700
4072 IF ( IPMEM(I).NE.IPMEM(K) ) GO TO 500
4073 C NIE KONTROLUJE SIE NAZW
4074 IF ( IPMEM(I).LE.7 ) GO TO 600
4076 IF ( IPMEM(I+4).NE.IPMEM(K+4) ) GO TO 550
4077 IF ( IPMEM(I+5).NE.IPMEM(K+5) ) GO TO 550
4083 500 CALL MERR ( 357,IPMEM(I+2) )
4086 550 CALL MERR ( 358, IPMEM(I+2) )
4088 C ROZNE DLUGOSCI LIST PARAMETROW II-GO RZEDU
4089 C JESLI KROTSZA LISTA JEST BLEDNA, TO NIE MA SYGNALIZACJI
4090 700 IF ( I.EQ.0 ) GO TO 750
4093 710 IF ( KD.EQ.5.OR.KD.EQ.6) GO TO 800
4096 750 KD = IPMEM(LISTE)
4099 C KONIE LIST II-GO RZEDU
4100 C KONTROLA TYPOW - JESLI FUNKCJE
4101 800 IF ( KIND.EQ.3 .OR. KIND.EQ.5 ) GO TO 400
4102 IF(IPMEM(LISTE+5).NE.IPMEM(LPOR+5)) GO TO 250
4103 IF(IPMEM(LISTE+6).NE.IPMEM(LPOR+6)) GO TO 250
4106 C NIEZGODNE DLUGOSCI LIST PARAMETROW I-GO RZEDU
4107 C JESLI LISTA KROTSZA JEST BLEDNA, TO NIE MA SYGNALIZACJI
4108 900 IF ( LISTE.EQ.0 ) GO TO 950
4109 IF(IAND(IPMEM(ELPOR),MERPF).EQ.0) CALL MERR(360,NM)
4111 950 IF(IAND(IPMEM(EL),MERPF).EQ.0) CALL MERR(360,NM)
4114 INTEGER FUNCTION ICPROT ( IDPR )
4116 C ** * * * * * * * ** *** ** * * * * * * * * * * ** * * * * * * *
4117 C KOPIUJE PROTOTYP IDPR ( PROTOTYP PARAMETRU FORMALNEGO).
4118 C UAKTUALNIA SLOWNIK ZAMIANY ADRESOW PROTOTYPOW.
4119 C WYNIKIEM FUNKCJI JEST IDENTYFIKATOR UTWORZONEGO PROTOTYPU.
4120 C * * * * * * * * * ** * * * * * * * * * ** * * * * * * * * * * *
4122 IMPLICIT INTEGER ( A - Z )
4125 C ..... ZMIENNE GLOBALNE
4129 COMMON /BLANK/ COM(278),
4130 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
4131 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
4132 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
4133 X LOCAL , OWN , OBJECT,
4136 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
4137 C LMEM - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
4138 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
4139 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
4140 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
4142 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
4143 C NACZONEGO NA PROTOTYPY SYSTEMOWE
4144 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
4145 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
4149 COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
4151 C ** ** ** ** *** ** ** ** ** ** ** ** ** ** ** ** **
4152 C BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
4153 C INDICT - INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
4154 C INDSPR - IDENTYFIKATOR PROTOTYPU W ISMEM
4155 C INDPR - IDENTYFIKATOR PROTOTYPU W IPMEM
4156 C IHBEG - ADRES PIERWSZEGO SLOWA TABLICY HASHU
4157 C IDPREF - IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
4159 C LASTPR - IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
4163 COMMON / MASKS / MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
4164 * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
4166 C ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
4168 C MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
4169 C MOTHERS - -- -- -- -- -- INNYCH PROTOTYPOW
4170 C MPAR - -- -- -- -- -- -- ZMIENNYCH I PARAMETROW
4171 C MSPR - MASKA DLA SYSPREF ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
4172 C MASKTP - ZAPRZECZENIE MASKI MTP
4173 C NOTTP - WZORZEC DLA NIE-TYPU ( 1 )
4174 C MPROCES - WZORZEC DLA PROCESU ( 5 )
4175 C MCOR - WZORZEC DLA COROUTINY (7)
4176 C MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
4177 C MBLOCK - WZORZEC DLA BLOKU ( 0 PRZY PRZECIECIU Z MOTHERS )
4181 COMMON /COPSIG/ BEGADR, IDHAND
4183 C BLOK SLUZACY DO KOMUNIKACJI Z PROCEDURA KOPIUJACA POSZCZEGOLNE PROTOTYPY
4184 C IDHAND - IDENTYFIKATOR HANDLERA
4185 C BEGADR - PIERWSZY ELEMENT SLOWNIKA ZAMIANY STARYCH ADRESOW NA NOWE
4186 C KAZDY ELEMENT SLOWNIKA ZAJMUJE 2 SLOWA: STARY ADRES, NOWY ADRES.
4187 C OSTATNI ELEMENT SLOWNIKA - LPML-2
4191 KIND = ISHFT ( IAND(IPMEM(IDPR),MPAR),-4)
4192 IF(KIND.GT.3) GO TO 400
4193 GO TO (100,200,300), KIND
4196 100 ICPROT = MGETM(5,341) + 2
4197 C DOLACZENIE DO LISTY NEXTDECL
4198 IPMEM(LASTPR+2) = ICPROT
4203 200 ICPROT = MGETM(10,341) + 5
4206 C PROCEDURA FORMALNA
4207 300 ICPROT = MGETM(7,341) + 2
4209 C KOPIOWAIE LISTY PARAMETROW II-GO RZEDU
4210 500 J = IPMEM(IDPR+4)
4211 IPMEM(ICPROT+3) = MGETM(J,341)
4213 IF(J.EQ.0) GO TO 1000
4216 II = IPMEM(IDPR+3) +K-1
4218 C II - IDENTYFIKATOR STAREGO PARAMETRU
4219 C I - ROZMIAR PROTOTYPU
4222 KD=ISHFT(IAND(IPMEM(II),MPAR),-4)
4223 IF(KD.GT.4) GO TO 520
4224 IF(KD.EQ.2) GO TO 510
4230 C IJ - IDENTYFIKATOR NOWEGO PROTOTYPU
4231 520 IJ = MGETM(I,341) + IJ
4232 IPMEM(IJ) = IPMEM(II)
4233 IPMEM(IJ-1) = ICPROT
4234 IPMEM(IJ-2) = IPMEM(II-2)
4235 IPMEM(IJ+1) = IPMEM(II+1)
4236 IF(KD.LT.5) GO TO 650
4237 C DLA ZMIENNEJ - WPISANIE TYPU
4239 IPMEM(IJ-4) = IPMEM(II-4)
4241 C SPRAWDZENIE, CZY JEST TO FORMALNY TYP LOKALNY
4243 IF(I2.LT.BEGADR) GO TO 690
4244 DO 600 I1 = BEGADR,I2,2
4245 IF(IPMEM(I1).EQ.I) GO TO 610
4249 610 IPMEM(IJ-3) = IPMEM(I1+1)
4251 C DOLOZENIE ADRESU DO SLOWNIKA ( DLA ZMIENNEJ NIE WARTO )
4257 C WSTAWIENIE ADRESU PROTOTYPU DO LISTY PARAMETROW
4258 690 I1 = IPMEM(ICPROT+3) +K-1
4262 IF(KIND.EQ.3) GO TO 1000
4263 C FUNKCJA - USTAWIENIE IDENTYFIKATORA RESULT
4264 IPMEM(ICPROT-5) = IJ
4268 400 ICPROT = MGETM(6,341) + 4
4269 C KOPIOWANIE TYPU ZMIENNEJ LUB FUNKCJI
4270 800 IPMEM(ICPROT-4) = IPMEM(IDPR-4)
4273 C SPRAWDZAMY, CZY TO JET TYP FORMALNY LOKALNY
4275 IF(K.LT.BEGADR) GO TO 1000
4276 C JEST NIEPUSTY SLOWNIK ZAMIANY ADRESOW
4277 DO 820 J=BEGADR, K,2
4278 IF(IPMEM(J).EQ.I) GO TO 850
4280 C NIE MA TAKIEGO TYPU
4282 850 IPMEM(ICPROT-3) = IPMEM(J+1)
4283 C JESLI ZMIENNA TO NIE WSTAWIAMY DO NEXTDECL
4284 870 IF(KIND.GE.5) GO TO 1000
4285 C DLA FUNKCJI - WSTAWIENIE TYPU DO ATRYBUTU RESULT
4287 IPMEM(K-4) = IPMEM(ICPROT-4)
4288 IPMEM(K-3) = IPMEM(ICPROT-3)
4290 C UZUPELNIENIE SLOWA ZEROWEGO, ADRESU ATRUBUTU I USED
4291 1000 IPMEM(ICPROT-2) = IPMEM(IDPR-2)
4292 IPMEM(ICPROT-1) = IDHAND
4293 IPMEM(ICPROT) = IPMEM(IDPR)
4294 IPMEM(ICPROT+1) = IPMEM(IDPR+1)
4296 C UZUPELNIENIE SLOWNIKA ZAMIANY ADRESOW