C    Loglan82 Compiler&Interpreter
C     Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
C     Copyright (C)  1993, 1994 LITA, Pau
C     
C     This program is free software; you can redistribute it and/or modify
C     it under the terms of the GNU General Public License as published by
C     the Free Software Foundation; either version 2 of the License, or
C     (at your option) any later version.
C     
C     This program is distributed in the hope that it will be useful,
C     but WITHOUT ANY WARRANTY; without even the implied warranty of
C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details. File: LICENSE.GNU
C  ===============================================================     

      SUBROUTINE DSW
C
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C      ( BYLY ) PROGRAM GLOWNY
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER (A - Z )
C
C
      COMMON /MJLMSG/ IERC,MSG
      integer*4 msg
C
C
C   BUFORY
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
C.....
c$include:'blank.for'

cdeb --------------------- added -------------------
      common /debug/ deb, breakt(500),brnr,maxbr
      logical deb
cdeb ------------------------------------------------
C
      IERC=0
      msg = 'dsw '
C
C
       CALL INITMK
C   SUBROUTINE INIT RENAMED TO INITMK         03.01.84   **********************
       CALL DPASS
C
C
C
      CALL MESS
cdeb      CALL AL1
cdeb ------------- added --------------
       if(deb.and..not.errflg) go to 1000
       call al1
       return
1000   call ts2
cdeb ----------------------------------
       END

      BLOCK DATA  BLKD
      IMPLICIT INTEGER (A-Z)
C
cdeb
      common /pr/ prot(5000),ind
c   prot - tablica na prototypy debuggera
c   ind - ostatnie zajete miejsce w tablicy
cdeb
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw  INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW, INOUT
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEc SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C    INOUT  -     --   --   --   ---           ZMIENNEJ INOUT
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND
     *, MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C    MNOTVIR - WZORZEC DO KASOWANIA BITU "VIRTUAL"
C    MHAND - WZORZEC DLA HANDLERA
C
C
cdeb------------------------------------------
cdeb      COMMON /NAMES/ RESNM,MAINM
      common /names/ resnm,mainm,brenam
cdeb------------------------------------------
C
C   NAZWY ZE SCANNERA
C  * * * * * * * * * * * * * * * * *  * * * * * * * * * * * * *
C
C
C     COMMON  / WYDR /  KD(8), KSP(4)
C     REAL KD,KSP
C
C    BLOK UZYWANY W PROCEDURYCH DRUKUJACYCH.
C    KD(KIND+1)  -  ODPOWIEDNI TEKST DLA PROTOTYPU RODZAJU KIND
C    KSP(KSPEC+1)  -  ODPOWIEDNI TEKST DLA PROTOTYPU RODZAJU KSPEC.
C   **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C
C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C  RODZAJE PROTOTYPOW:
C   1 - BLOK, 2 - REKORD, 3 - PROCEDURA, 4 - FUNKCJA, 5 - PROC. Z BLEDNA PF
C   6 - FUNKCJA Z BLEDNA LISTA PF, 7 - KLASA Z BLEDNA LISTA PF
C   8 - BLOK PREFIKSOWANY, 9 - PROCEDURA VIRTUALNA, 10 I FUNKCJA VIRTUALNA
C   11 - PROC. VIRTUALNA Z BLEDNA PF, 12 - FUNKCJA VIRTUALNA Z BLEDNA PF
C   13 - PROCEDURA FORMALNA, 14 - FUNKCJA FORMALNA, 15 - PROC. FORMALNA
C   Z BLEDNA LISTA PF, 16 - FUNKCJA FORMALNA Z BLEDNA LISTA PF,
C  17 - TYP FORMALNY, 18 - PROCEDURA FORMALNA II-GO RZEDU,
C   19 - FUNKCJA FORMALNA II-GO RZEDU
C   20 - TYP FORMALNY II-GO RZEDU
C   21 - SYGNAL, 22 - SYGNAL Z USZKODZONA LISTA PF, 23 - HANDLER
C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C
      DATA SIZEPR/23,33,28,31,28,31,33,28,30,33,30,33,20,23,20,23,
     * 5,5,7,5,19, 19, 21/
      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/
      DATA CONSTWD,VARWD,VARPOM,INPFW,OUTPFW / 129,113,65,81,97 /
      DATA INOUT /145/
      DATA NOTTP,MPROCES,MCOR,MBLOCK /1,5,7,0 /
C     DATA KD(1) /5HTYP F/
C     DATA KD(2)/4HKLAS/
C     DATA KD(3) / 4HFUN   /
C     DATA KD(4) / 4HPROC/
C     DATA KD(5) / 4HBLOK/
C     DATA KD(6) /4HBLPR/
C     DATA KD(7) /6HSIGNAL/
C     DATA KD(8) /5HHANDL/
C     DATA KSP(1) /4HREK  /
C     DATA KSP(2) / 4HKLAS/
C     DATA KSP(3) / 4HPRSS/
C     DATA KSP(4) / 4HCORO/
      DATA RESNM,MAINM / 2769,819 /
cdeb ------------- added ---------------
      data brenam /7797/
cdeb ----------------------------------
      DATA NULLWD / 1,2,1025,513,9217,8705,8194,257,3073,2561,11265,
     * 10753,1073,545,9265,8737,22,1073,545,22,177,8369,1793/
cdeb
      data prot /5000*-100/
cdeb
      END
      SUBROUTINE DPASS
C
C  * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * *
C    PODPROGRAM REALIZUUACY PRZETWARZANIE PROTOTYPOW
C  * * * * * * * * * * * * * *  * * * * * * * * * * * * * * * * *
C
      IMPLICIT iNTEGER (A-Z)
C
      COMMON  / QUEUE /  BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
cdsw      INTEGER  BQUEUE, EQUEUE
      LOGICAL EMPTY
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
C      BQUEUE  -  POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
C      EQUEUE  -  KONIEC      --      --       --      --      --
C      IFIRST  -  PIERWSZY ELEMENT KOLEJKI
C      LAST  -  OSTATNI ELEMENT KOLEJKI
C      EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
C
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw  INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEc SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C    INOUT  -    --   --   --  --    ---       ZMIENNEJ INOUT
C
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C     IDENTYFIKATORY PROTOTYPOW SYSTEMOWYCH
C             NRINT  - IDENTYFIKATOR PROTOTYPU  INTEGER
C             NRRE   -                          REAL
C             NRBOOL -                          BOOLEAN
C             NRCHR  -                          CHARACTER
C             NRCOR  -                          COROUTINE
C             NRPROC -                          PROCESS
C             NRTEXT -                          STRING (TEXT)
C             NRUNIV - IDENTYFIKATOR PROTOTYPU UNIWERSALNEGO
C             NATTR  - IDENTYFIKATOR PSEUDO-ATRYBUTU (Z NUMEREM -1)
C             NRNONE - IDENTYFIKATOR PROTOTYPU TYPU NONE (UNIWERSALNY
C                      REFERENCYJNY)
C             NBLSYS - IDENTYFIKATOR BLOKU SYSTEMOWEGO
C             NBLUS  -               BLOKU GLOWNEGO UZYTKOWNIKA
C
C             INSYS  - FLAGA SPOSOBU REZERWACJI (PRZEZ  MGETM) PAMIECI
C                      W IPMEM - .TRUE. JESLI REZERWACJA W CZESCI SYSTE-
C                      MOWEJ
C             LOCAL  - FLAGA DOSTEPU DO OBIEKTOW - 2 JESLI OBIEKT
C         BYL LOKALNY, 1 - GDY Z SL, 0 - GDY Z BLOKU GLOWNEGO
C             OWN    - FLAGA DOSTEPU DO OBIEKTOW - .TRUE. JESLI OBIEKT NIE
C                      POCHODZI Z PREFIKSOW (TYLKO Z WLASCIWEGO OBIEKTU)
C             OBJECT - PROTOTYP OBIEKTU, Z KTOREGO POCHODZIL OSTATNIO
C                     SZUKANY IDENTYFIKATOR (OBIEKT POCHODZACY Z CIAGU SL)
C
C

      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W IDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
cdeb       COMMON/NAMES/RESNM,MAINM
cdeb -------------------------------------
       common /names/ resnm, mainm, brenam
cdeb ------------------------------------
C   NAZWY ZE SCANNERA
C
C
      COMMON  /PREFS/  LPREFS
C
C   **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    LPREFS  -  OSTATNIO PRZYDZIELONY NUMER W PREFIXSET
C
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)

c system class prototypes:
      common /syspro/ prgraph, prmouse
C
C
C   UTWORZENIE PROTOTYPU BLOKU GLOWNEGO
      I=IPMEM(LPMEM)
      LINE = IPMEM(I+9)
      LASTPR = NBLSYS
      NBLUS=INITPR(1,0)
C   USTAWIENIE SL BLOKU GLOWNEGO NA SYSTEMOWY
      IPMEM(NBLUS-1) = NBLSYS
cdsw
      ipmem(nblus+2) = prgraph
      ipmem(prgraph+2) = prmouse
      lastpr = prmouse

C   DOLACZENIE NAZWY I ATRYBUTU MAIN
      I=MGETM(6,41)+4
      IPMEM(I)=VARWD
      IPMEM(I+1)=1
      CALL MADATR(I,NBLUS,41)
      IPMEM(I-3)=NRPROC
      IPMEM(I)=IAP(I)
      K=IDPUT(MAINM,IPMEM(NBLUS+10))
      IPMEM(K+2)=I
      CALL DPUTQ(LPMEM,NBLUS)
 100  IF(EMPTY) GO TO 300
      CALL DGETQ
      CALL PROTP1
      CALL PROTP2
      GO TO 100
 300  CONTINUE
C   KONIEC PRZETWARZANIA PROTOTYPOW
      IPMEM(NBLSYS+3) = LPREFS
C       ... PRZECHOWANIE INFORMACJI O LICZBIE KLAS
      RETURN
      END
      SUBROUTINE INITMK
C
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C    INICJALIZACJA LOKALNA
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
C
C
cdsw ------------------------------------------------
      common/signs/nrsig,hliste
cdsw -----------------------------------------------
cdsw  COMMON /SIGNALS/ NRSIG, HLISTE
C
C   NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
C   HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
C
C
C
      COMMON  / QUEUE /  BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
cdsw  INTEGER  BQUEUE, EQUEUE
      LOGICAL EMPTY
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
C      BQUEUE  -  POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
C      EQUEUE  -  KONIEC      --      --       --      --      --
C      IFIRST  -  PIERWSZY ELEMENT KOLEJKI
C      LAST  -  OSTATNI ELEMENT KOLEJKI
C      EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
C
C
      COMMON  /PREFS/  LPREFS
C
C   **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    LPREFS  -  OSTATNIO PRZYDZIELONY NUMER W PREFIXSET
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND
     *, MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C    MNOTVIR - MASKA DO KASOWANIA BITU "VIRTUAL"
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw  INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW, INOUT
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEc SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C    INOUT  -     --   --   --   ---           ZMIENNEJ INOUT
C
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C     IDENTYFIKATORY PROTOTYPOW SYSTEMOWYCH
C             NRINT  - IDENTYFIKATOR PROTOTYPU  INTEGER
C             NRRE   -                          REAL
C             NRBOOL -                          BOOLEAN
C             NRCHR  -                          CHARACTER
C             NRCOR  -                          COROUTINE
C             NRPROC -                          PROCESS
C             NRTEXT -                          STRING (TEXT)
C             NRUNIV - IDENTYFIKATOR PROTOTYPU UNIWERSALNEGO
C             NATTR  - IDENTYFIKATOR PSEUDO-ATRYBUTU (Z NUMEREM -1)
C             NRNONE - IDENTYFIKATOR PROTOTYPU TYPU NONE (UNIWERSALNY
C                      REFERENCYJNY)
C             NBLSYS - IDENTYFIKATOR BLOKU SYSTEMOWEGO
C             NBLUS  -               BLOKU GLOWNEGO UZYTKOWNIKA
C
C             INSYS  - FLAGA SPOSOBU REZERWACJI (PRZEZ  MGETM) PAMIECI
C                      W IPMEM - .TRUE. JESLI REZERWACJA W CZESCI SYSTE-
C                      MOWEJ
C             LOCAL  - FLAGA DOSTEPU DO OBIEKTOW - 2 JESLI OBIEKT
C                   BYL LOKALNY, 1 - JESLI POCHODZIL Z SL, 0 - GDY Z BL. GL.
C             OWN    - FLAGA DOSTEPU DO OBIEKTOW - .TRUE. JESLI OBIEKT NIE
C                      POCHODZI Z PREFIKSOW (TYLKO Z WLASCIWEGO OBIEKTU)
C
C
C
C  INICJALIZACJA ZMIENNYCH Z BLOKOW WSPOLNYCH, KTORE NIE SA
C   INICJALIZOWANE W BLOCK DATA
C
C  COMMON /YNIT/
C    NADANIE APETYTOW DLA TYPOW FORMALNYCH
C    DLA TYPOW FORMALNYCH - BIT 14 JEST ZAPALONY
       MTP = ISHFT (1,14)
       NULLWD(17) = IOR ( NULLWD(17),MTP )
       NULLWD(20) = IOR ( NULLWD(20),MTP )
C   DLA POCEDUR/FUNKCJI FORMALNYCH - BIT 15 JEST ZAPALONY
       MTP = ISHFT (1,15)
       NULLWD(13) = IOR (NULLWD(13),MTP )
       NULLWD(14) = IOR (NULLWD(14),MTP )
       NULLWD(15) = IOR ( NULLWD(15),MTP )
       NULLWD(16) = IOR ( NULLWD(16),MTP )
       NULLWD(18) = IOR ( NULLWD(18),MTP )
       NULLWD(19) = IOR ( NULLWD(19),MTP )
C
C  COMMON / QUEUE /
      BQUEUE=MGETM(LMEM/50,341)
      EQUEUE=LPML-1
      EMPTY=.TRUE.
      LAST=BQUEUE-2
      IFIRST=BQUEUE
C
C   COMMON / PREFS /
cdsw      LPREFS=IPMEM(NBLSYS+3)
cdsw       MAXPF=47
C
C   COMMON / MASKS /
       MTP=15
      MSPR=7
      MOTHERS=ISHFT(7,8)
      MPAR=ISHFT(15,4)
       MASKTP=NOT(MTP)
       MNOTVIR=ISHFT(1,11)
       MNOTVIR=NOT(MNOTVIR)
      MHAND = ISHFT ( 7,8 )
      MERPF = ISHFT (1,13)
C
C   COMMON /SIGNALS/
      NRSIG = 100
C
C   INICJALIZACJA ZMIENNYCH GLOBALNYCH - CHWILOWA
      INSYS=.FALSE.
      RETURN
      END
      SUBROUTINE PROTP1
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   PODPROGRAM SLUZY DO PRZETWARZANIA(OSTATECZNEGO) PROTOTYPU,
C    RAZEM Z PRZETWARZANIEM ZEWNETRZNYM ( WSTEPNYM) JEGO ATRYBUTOW LOKALNYCH.
C   PROTOTYP JEST ZADANY PRZEZ ZMIENNE Z BLOKU /DGLOB/
C   PIERWSZA CZESC PRZETWARZANIA
C  **  **  **  **  **  **  **  **  **  ** *  **  **  **  **  **  **  **
C
       IMPLICIT INTEGER (A-Z)
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw  INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C    INOUT   -     --   --    --   --          ZMIENNEJ INOUT
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
C
C   BUFORY
C
cdeb      COMMON /NAMES/ RESNM, MAINM
cdeb ----------------------------------
      common /names/ resnm, mainm,brenam
cdeb --------------------------------
C
C   NAZWY ZE SCANNERA
C
C
C
C
cbc
      common /option/ opt
cbc
      LOGICAL POM, HAND
C    HAND - CZY TO JEST PROTOTYP HANDLERA
C
C
C   NADANIE WARTOSCI POZOSTALYM ZMIENNYM Z BLOKU /DGLOB/
      INDSPR = IPMEM(INDICT)
      IHBEG = INDPR+10
       I=IPMEM(INDPR)
       HAND = .FALSE.
       IF ( IAND(I,MOTHERS) .EQ. MHAND ) HAND = .TRUE.
       INDPREF = IPMEM(INDPR+21)
C  JESLI BLOK LUB HANDLER - TO ZERO
       IF(IAND(I,MTP).EQ.NOTTP.AND.IAND(I,MOTHERS).EQ.MBLOCK.OR.HAND)
     * INDPREF = 0
C   .  .  .  .
C   PRZEPISANIE INFORMACJI DLA ANDRZEJA
      IPMEM(INDPR+8)=IPMEM(INDSPR-3)
      IPMEM(INDPR+9)=IPMEM(INDSPR-2)
      IPMEM(INDPR+18)=IPMEM(INDSPR-1)
C   EWENTUALNE POPRAWIENIE SPECYFIKACJI - JESLI PREFIKS
C    NIE JEST REKORDEM
      IF(INDPREF.EQ.0) GO TO 50
      IF(BTEST(IPMEM(INDPREF),0)) CALL CHECK(INDPR)
      GO TO 60
C    JESLI JEST LISTA TAKEN - TO BLAD
 50   I=IPMEM(INDSPR+7)
      IF(I.EQ.0) GO TO 60
      LINE=IPMEM(I+1)
      CALL MERR(310,NEMPTY)
 60   INSYS=.FALSE.
      IF(HAND) GO TO 70
C
C---- ---------------------------------------------------------------
C     PRZETWARZANIE NAGLOWKA
      CALL HEADER
C
C  ----------------------------------------------------------------
C   DLA PROCESU - SPRAWDZENIE, CZY NIE MA PF OUTPUT LUB INOUT
C
cbc check if parameters fit into one message
c
      I = IAND(IPMEM(INDPR),MTP)
      IF(I.NE.MPROCES) GO TO 70
C   PROCES
      I = IPMEM(INDPR+3)
      K = IPMEM(INDPR+4)
      IF(K.EQ.0) GO TO 76
      K = K+I-1
cbc check if first parameter is integer
      j = ipmem(indpr+22)
80    p = ipmem(j)
      tp = iand(ipmem(p), mtp)
      if (tp .eq. mproces) goto 81
      j = j+1
      goto 80
c p = address of first process prototype in prefix sequence
81    l = ipmem(p+4)
      p = ipmem(p+21)
      if (p .eq. 0) goto 82
      if (l .eq. ipmem(p+4)) goto 76
      i = i+ipmem(p+4)
82    continue
c i = address of first parameter of process
      if (ipmem(ipmem(i)-3) .eq. nrint) goto 75
      line = ipmem(indspr+9)
      call merr(370, nempty)
75    continue
      i = ipmem(indpr+3)
C
cbc
      apet = 0
cbc
      DO 77 J = I,K
      NM = IPMEM(J)
C   NM - IDENTYFIKATOR PARAMETRU
CBC
c   check for formal type
      zp = ishft(iand(ipmem(nm), mpar), -4)
      if (zp .eq. 1) goto 74
c   check for formal procedure
      if (zp .eq. 3) goto 73
c   check if not array
      if (ipmem(nm-4) .gt. 0) goto 74
      tp = iand(ipmem(ipmem(nm-3)), mtp)
c   check if formal parameter type is process or int,real,char,bool,string
cpat      if (tp .eq. mproces .or. tp .eq. 8 .or. tp .eq. 10 .or.
cpat     *    tp .eq. 12) goto 78
      goto 78
74    line = ipmem(indspr+9)
      call merr(370 ,nempty)
      goto 77
78    continue
c   compute formal parameter appetite in bytes
      if (zp .eq. 2) goto 73
c   variable
      ap = sapet(0, ipmem(nm-3))
      if (ap .eq. 4) ap = 2
      goto 72
c   formal procedure or function
73    ap = 3
c   sum up appetites
72    apet = apet + ap
cbc      
c      NM = ISHFT(IAND(IPMEM(NM),MPAR),-4)
c      IF(NM.NE.6.AND.NM.NE.9) GO TO 77
c    BLAD - JEST PARAMETR OUTPUT LUB INOUT
c      LINE = IPMEM(INDSPR+9)
c      CALL MERR(370,NEMPTY)
cbc
c
  77  CONTINUE
cbc
      if (.not. btest(opt, 12)) maxap = 34
      if (      btest(opt, 12)) maxap = 15
      if (apet .le. maxap) goto 70
      line = ipmem(indspr+9)
      call merr(370, nempty)
      goto 70
  76  line = ipmem(indspr+9)
      call merr(370, nempty)
c
Cbc
C -----------------------------------------------------------------
C      PRZETWARZANIE WSTEPNE LOKALNYCH PROTOTYPOW -- ETAP I
C
C   POM = FALSE, GDY PRZETWARZAMY TYPY
C   POM = TRUE, GDY PRZETWARZAMY PROCEDURY/FUNKCJE/BLOKI/HANDLERY
 70   POM=.FALSE.
      I=IPMEM(INDSPR+5)
 100  IF(I.EQ.0) GO TO 200
      J=IPMEM(I)
      J=IPMEM(J)
C   J - IDENTYFIKATOR PROTOTYPU LOKALNEGO W ISMEM
C   NM - NAZWA PROTOTYPU
      NM=NEMPTY
      IF(IPMEM(J).NE.1 .AND. IPMEM(J).NE.8) NM=IPMEM(J+10)
C   OKRESLENIE RODZAJU PROTOTYPU ( W SENSIE BLOKU INIT)
      K=IPMEM(J)
C   WYKRYCIE HANDLERA
      IF(K.EQ.8) K=K+15
C      WYKRYCIE BLOKU PREFIKSOWANEGO
      IF(K.EQ.1.AND.IPMEM(J+2).NE.0) K=8
C   WYKRYCIE WIRTUALI
      LINE = IPMEM(J+9)
C        INSERTION OF LAST STATEMENT DUE TO CORRECTION GIVEN TO ME IN WARSAW
C     IF(BTEST(IPMEM(J+8),15)) K=K+6
C   INSERTION OF THE FOLLOWING STATEMENTS DUE TO CORRECTIONS (SEE ABOVE)
      IF (.NOT. BTEST(IPMEM(J+8),15) ) GOTO 110
      IF (K.LT.3.OR.K.GT.6) GOTO 120
      K=K+6
      IF (INDPREF.NE.0) GOTO 110
      IF (IAND(IPMEM(INDPR),MTP).NE.NOTTP) GOTO 110
      CALL MERR(330,NM)
      K=K-6
      GOTO 110
120   CALL MERR(329,NM)
C      END OF INSERTION OF STATEMENTS
C   WYWOLANIE INITPR
C     LINE=IPMEM(J+9)
C     DELETION OF PREVIOUS STATEMENT DUE TO CORRECTION
C     K=INITPR(K,NM)
110   K=INITPR(K,NM)
C     INSERTION OF LABEL 110 DUE TO CORRECTIONS
C   W POLU SL PROTOTYPU (W ISMEM) ZAPAMIETUJEMY JEGO IDENTYFIKATOR
C   W IPMEM
      IPMEM(J+1) = K
C   PRZEJSCIE DO NASTEPNEGO PROTOTYPU W LISCIE
      I=IPMEM(I+1)
      GO TO 100
C   PRZETWARZANIE BLOKOW, FUNKCJI I PROCEDUR
 200  IF(POM) GO TO 300
      POM=.TRUE.
      I=IPMEM(INDSPR+6)
C  JESLI PROTOTYP ZAWIERA BLOKI, FUNKCJE LUB PROCEDURY, TO ZMIENIAMY
C   MU KWALIFIKACJE NA PELNA KLASE
      IF(I.NE.0) CALL CHECK(INDPR)
      GO TO 100
C
C
 300  CONTINUE
C
C  ------------------------------------------------------------------------
C    PRZETWARZANIE LISTY SYGNALOW
C
      I = IPMEM(INDSPR-4)
 350  IF (I.EQ.0) GO TO 500
      NM = IPMEM(I+2)
      LINE = IPMEM(I+1)
      K = IPMEM(I) +12
C   UTWORZENIE PROTOTYPU
      K=INITPR(K,NM)
C   ZAPAMIETANIE IDENTYFIKATORA PROTOTYPU SEMANTYCZNEGO
      IPMEM(I) = K
      I=IPMEM(I+3)
      GO TO 350
C
C
 500  CONTINUE
C
C    JESLI HANDLER TO KONIEC
      IF ( HAND ) GO TO 1100
C  ---  ---  ---  ---  ---  ---  ---  ---  ---  ---  ---  ---   ----  -----
C      PRZETWARZANIE LISTY STALYCH
C
      I=IPMEM(INDSPR+4)
 600  IF(I.EQ.0) GO TO 700
      J=MGETM(6,41)+4
C   J - IDENTYFIKATOR OPISU STALEJ
      IPMEM(J)=CONSTWD
C  THIS AND THE NEXT 3 LINES ARE IRRELEVANT            8.5.84
C   SZUKAMY TYPU STALEJ - ZAKLADAMY POPRAWNOSC TYPU
C       ZERO OZNACZA STALA ZDEFINIOWANA PRZEZ WYRAZENIE
      IF(IPMEM(I+2).EQ.0)GO TO 630
C
C     TYLKO DLA STALEJ TEKSTOWEJ :
      K=MEMBER(IPMEM(I+2),IPMEM(NBLSYS+10))
C LAST STATEMENT CHANGED TO COMMENT DUE TO CORRECTIONS FROM WARSAW   8.5.84
C THIS AND THE NEXT 2 LINES ARE IRRELEVANT 8.5.84
      IPMEM(J-3)=IPMEM(K+2)
C LAST STATEMENT CHANGED TO COMMENT DUE TO CORRECTIONS FROM WARSAW  8.5.84
C   PRZEPISANIE ADRESU STALEJ
 630  IPMEM(J-1)=IPMEM(I+4)
C   WSTAWIENIE STALEJ DO ZBIORU IDENTYFIKATOROW
      LINE=IPMEM(I+1)
      K=IDPUT(IPMEM(I),IPMEM(IHBEG))
      IF(K.EQ.0) GO TO 650
C   NIE MA PODWOJNEJ DEKLARACJI
      IPMEM(K+2) = J
C   USTAWINIE BITU CLOSE
      IPMEM(K+1) = 1
C   PRZEJSCIE DO NASTEPNEGO ELEMENTU LISTY
 650   I=IPMEM(I+5)
      GO TO 600
C
C
 700  CONTINUE
C
C  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----   ----  ----
C    PRZETWARZANIE LISTY ZMIENNYCH
C
C
      I=IPMEM(INDSPR+3)
 800  IF(I.EQ.0) GO TO 1000
      J=MGETM(6,41)+4
C   J- IDENTYFIKATOR OPISU ZMIENNEJ
      IPMEM(J) = VARWD
C   WSTAWIENIE DO ZBIORU IDENTYFIKATOROW
      LINE=IPMEM(I+1)
      K=IDPUT(IPMEM(I),IPMEM(IHBEG))
      IF(K.EQ.0) GO TO 900
C   NIE MA PODWOJNEJ DEKLARACJI
      IPMEM(K+2)=J
C   WSTAWIENIE DO LISTY ATRYBUTOW
 900  CALL MADATR(J,INDPR,41)
C   ZAPAMIETANIE 1 W POLU USED - DLA AIL
      IPMEM(J+1)=1
C   ZAMIAST NAZWY ZMIENNEJ(W ISMEM) ZAPAMIETUJEMY JEJ IDENTYFIKATOR W IPMEM
      IPMEM(I)=J
C   PRZEJSCIE DO NASTEPNEGO ELEMENTU LISTY
      I=IPMEM(I+4)
      GO TO 800
C
C
 1000 CONTINUE
C
C
C  DOLACZENIE DO ZBIORU IDENTYFIKATOROW ID. RESULT DLA FUNKCJI
      I=ISHFT(IAND(IPMEM(INDPR),MOTHERS),-8)
      IF(I.LT.2.OR.I.GT.3) GO TO 1050
      J=MEMBER(RESNM,IPMEM(IHBEG))
      IF(J.NE.0) GO TO 1050
      J=INSERT(RESNM,IPMEM(IHBEG),41)
      IPMEM(J+2)= IPMEM(INDPR-5)
 1050 CONTINUE
C
C
C---- ---- ---- ----- ---- ----- ----- ---- ----- ----- ----- ----- --
C   TWORZENIE ZBIORU IDENTYFIKATOROW
C
C   JESLI JEST PREFIKS, TO UZUPELNIAMY ZBIOR IDENTYFIKATOROW
      IF(INDPREF.EQ.0) GO TO 1100
      CALL MERGEID
C
C
 1100 CONTINUE
      RETURN
      END
      SUBROUTINE PROTP2
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   PODPROGRAM SLUZY DO PRZETWARZANIA(OSTATECZNEGO) PROTOTYPU,
C    RAZEM Z PRZETWARZANIEM ZEWNETRZNYM ( WSTEPNYM) JEGO ATRYBUTOW LOKALNYCH.
C   PROTOTYP JEST ZADANY PRZEZ ZMIENNE Z BLOKU /DGLOB/
C   DRUGA CZESC PRZETWARZANIA
C  **  **  **  **  **  **  **  **  **  ** *  **  **  **  **  **  **  **
C
       IMPLICIT INTEGER (A-Z)
      LOGICAL POM
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
C
      COMMON  / VIRT /  LISTVB,LISTVE,OWNVIR
      LOGICAL OWNVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ROBOCZY BLOK WSPOLNY.
C    LISTVB  -  POCZATEK ROBOCZEJ LISTY VIRTLIST
C    LISTVE  -  KONIEC ROBOCZEJ LISTY  VIRTLIST
C    OWNVIR = TRUE, JESLI W PROTOTYPIE BYLY WLASNE VIRTUALE
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C
C
C.....
C     KOMUNIKACJA Z PROCEDURA MEMPRF
      COMMON /MEM/  NME, NH
C            NME - SZUKANA NAZWA
C            NH - JEJ HASZ
C
C
cdsw  COMMON /SIGNALS/ NRSIG, HLISTE
cdsw     -------------------------------------------------
      common /signs/ nrsig, hliste
cdsw     -------------------------------------------------
C
C   NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
C   HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
C
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7) ,JUNK(260)
C
C
C
C  ----  ------  ------  ------  -------  -------  -------  ------------
C
C   WSTEPNE PRZETWARZANIE PROTOTYPOW LOKALNYCH  --  ETAP  II
C
C
C    -----   ------   ------  -----  -----  -----  -----  -----  -----  -----
C    PRZETWARZANIE SYGNALOW
C
      LN = 0
      I=IPMEM(INDSPR-4)
 100  IF ( I.EQ.0 ) GO TO 500
      CALL SIGNAL(I)
      I = IPMEM(I+3)
      GO TO 100
C
C
 500  CONTINUE
C
C   ------    ------    ------    ------    ------    -------    ------  ----
C   PRZEPISANIE LISTY VIRTLIST Z PREFIKSU
C
       LISTVE=0
      LISTVB=LPML
      IF(INDPREF.EQ.0) GO TO 1200
      I=IPMEM(INDPREF+25)
C   I - DLUGOSC LISTY WIRTLIST Z PREFIKSU
      IF(I.EQ.0) GO TO 1200
      IF(I.LT.0) I=-I
C   JEST LISTY WIRTLIST W PREFIKSIE
      INSYS=.TRUE.
      LISTVB=MGETM(I,41)
      LISTVE=LPML-1
      INSYS=.FALSE.
C   PRZEPISYWANIE
      K=IPMEM(INDPREF+24)
C   K - POCZATEK LISTY VIRTLIST W PREFIKSIE
      DO 1111 J=1,I
      IJ1 = LISTVB+J-1
      IJ2 = K+J-1
 1111 IPMEM(IJ1) = IPMEM(IJ2)
 1200 OWNVIR=.FALSE.
C   PUSTA LISTA LOKALNYCH HANDLEROW
       HLISTE = 0
C   PRZETWARZANIE WSZYSTKICH PROTOTYP6W
       POM=.FALSE.
      I=IPMEM(INDSPR+5)
C   ZACZYNAMY OD TYPOW
 1300 IF(I.EQ.0) GO TO 1400
      CALL BEGPROT(IPMEM(I))
      I=IPMEM(I+1)
      GO TO 1300
 1400 IF(POM) GO TO 1600
      POM=.TRUE.
C   PROCEDURY, FUNKCJE I BLOKI
      I=IPMEM(INDSPR+6)
	GO TO 1300
C
1600  CONTINUE
C   JESLI HANDLER TO KONIEC
      IF ( IAND(IPMEM(INDPR),MOTHERS).EQ.MHAND) GO TO 4000
C
C   UTUPELNIENIE INFORMACJI I WIRTUALACH
      IF(OWNVIR) GO TO 1700
C   NIE BYLO WLASNYCH WIRTUALI
      IF(INDPREF.EQ.0) GO TO 1900
C   DOWIAZUJEMY SIE DO LISTY VIRTLIST Z PREFIKSU, ZMIENIAJAC DLUGOSC NA UJEMNA
      IPMEM(INDPR+24) = IPMEM(INDPREF+24)
      IPMEM(INDPR+25) = -IPMEM(INDPREF+25)
      GO TO 1900
C   BYLY WLSNE WIRTUALE - PRZEPISUJEMY LISTE VIRTLIST
 1700 I=LISTVE-LISTVB+1
      K = MGETM(I,41)
      IPMEM(INDPR+24) = K
      DO 1777 J=1,I
      IJ1=K+J-1
      IJ2=LISTVB+J-1
 1777 IPMEM(IJ1) = IPMEM(IJ2)
      IPMEM(INDPR+25) = I
C   ZWALNIAMY PAMIEC PRZEZNACZONA NA VIRTLIST W CZESCI SYSTEMOWEJ
 1900 CONTINUE
       LPML=LISTVB
C
C
 2000 CONTINUE
C
C  ----  -----   -----  --------   ----------   -------  ----  -----   -------
C        NADAWANIE TYPOW ZMIENNYM
C
      I=IPMEM(INDSPR+3)
      IF(I.EQ.0) GO TO 2400
 2100 J=IPMEM(I)
C  J - IDENTYFIKATOR OPISU ZMIENNEJ W IPMEM
      NM=IPMEM(I+2)
C   NM - NAZWA TYPU
      LINE=IPMEM(I+1)
       K=IFTYPE(NM)
      IPMEM(J-3) = K
      IPMEM(J-4) = IPMEM(I+3)
C   NADANIE APETYTU ZMIENNEJ
      IPMEM(J) = IAP(J)
C   JESLI TO JEST TYP FORMALNY, TO POPRAWIAMY SLOWO ZEROWE OPISU ZMIENNEJ
      IF(IAND(IPMEM(K),MTP).NE.6) GO TO 2350
      IPMEM(J) = IOR(IPMEM(J),ISHFT(1,12))
C    JESLI TYP FORMALNY JEST NIELOKALNY, TO ZMIENIAMY RODZAJ PROTOTYPU
C    NA KLASE PELNA
      IF(LOCAL.EQ.2) GO TO 2350
      CALL CHECK(INDPR)
 2350  I=IPMEM(I+4)
      IF(I.NE.0) GO TO 2100
C
C
 2400 CONTINUE
C
C  ----  ------  -----  ---  ----  ------  -----   ------  ----------
C      SPRAWDZENIE POPRAWNOSCI LIST HIDDEN I CLOSE I UZUPELNIENIE INFORMACJI
C
C   JESLI PROTOTYP NIE JEST KLASA TO PRZECHODZIMY DALEJ
      IF(IPMEM(INDSPR).NE.2.AND.IPMEM(INDSPR).NE.7) GO TO 3000
      I=IPMEM(INDSPR+12)
C   K = 0 -- CLOSE, K=1 -- HIDDEN
       K=1
 2500 IF(I.EQ.0) GO TO 2700
      NME=IPMEM(I)
      LN=LINE
      LINE=IPMEM(I+1)
C  NME - NAZWA W LISCIE HIDDEN(CLOSE)
      NH=IAND(ISHFT(NME,-1),7)+1
      J=MEMPRF(INDPR)
      IF(J.EQ.0) GO TO 2600
C  NAZWA JEST ZADEKLAROWANA
C   JESLI NAZWA JEST HIDDEN LUB NOT TAKEN, TO BLAD
      NM=IPMEM(J+1)
      IF(BTEST(NM,2)) GO TO 2660
      IF(OWN) GO TO 2550
      IF(BTEST(NM,1)) GO TO 2650
C   NAZWA POCHODZI Z PREFIKSU
      NM=INSERT(NME,IPMEM(IHBEG),41)
      IPMEM(NM+2) = IPMEM(J+2)
      IPMEM(NM+1)= IPMEM(J+1)
      J=NM
C   USTAWIAMY BIT K W ELEMENCIE LISTY HASHU
 2550 IPMEM(J+1) = IOR(IPMEM(J+1),ISHFT(1,K))
C   PRZECHODZIMY DO NASTEPNEGO ELEMENTU LISTY
 2560 I=IPMEM(I+2)
      GO TO 2500
C   NAZWA NIEZADEKLAROWANA
 2600 J=INSERT(NME,IPMEM(IHBEG),41)
      CALL MERR(305,NME)
      GO TO 2550
C   NAZWA HIDDEN - NIEDOSTEPNA
 2650 CALL MERR(319,NME)
      GO TO 2560
C   NAZWA NOT TAKEN - NIEDOSTEPNA
 2660 CALL MERR(320,NME)
      GO TO 2560
 2700 IF(K.EQ.0) GO TO 3000
      K=0
      I=IPMEM(INDSPR+13)
      GO TO 2500
C
C
 3000 CONTINUE
C
C----   ------   ------  ------  -------  -------  --------  -------
C    KOMPATYBILNOSC VIRTUALI
C
      IF(.NOT.BTEST(IPMEM(INDPR),11)) GO TO 4000
C   PROTOTYP JEST VIRTUALEM
C   SPRAWDZAMY, CZY ISTNIEJE WYZSZY VIRTUAL
      LINE=LN
      IF(IPMEM(INDPR+26).EQ.0) GO TO 4000
      CALL VIRTCOM
C
C
 4000 CONTINUE
C
C  ------  ------  ------   ------  ------  ------  -------------  ---
C     ZAKONCZENIE - ZAPAMIETUJEMY IDENTYFIKATOR PROTOTYPU W SLOWNIKU
C    ISDICT
C
      IPMEM(INDICT) = INDPR
C
      RETURN
      END
      INTEGER FUNCTION IAP(IND)
C
C   WYLICZA APETYT ATRYBUTU IND :
C           0  (00) - INTEGER,BOOLEAN,CHAR,STRING
C           1  (01) - REAL, FORMAL TYPE
C           2  (10) - FORMAL PROCEDURE,FORMAL FUNCTION
C           3  (11) - REFERENCE
C   W WYNIKU ZMIENIA SLOWO ZEROWE
C
      IMPLICIT INTEGER(A-Z)
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
C
C
      J=IPMEM(IND-3)
C   J - IDENT TYPU
      I=IAND(IPMEM(J),MTP)
      IAP=0
      IF(I.LT.8.OR.I.EQ.11) IAP = 3
      IF(J.EQ.NRRE) IAP=1
      IF(IPMEM(IND-4).NE.0)  IAP=3
C   ZMIANA SLOWA ZEROWEGO
      IAP=IOR(IPMEM(IND),ISHFT(IAP,14))
      RETURN
      END
      SUBROUTINE BEGPROT(NRSDIC)
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C   PODPROGRAM SLUZY DO WSTEPNEGO PRZETWARZANIA PROTOTYPOW LOKALNYCH
C   W PROTOTYPIE IDENTYFIKOWANYM PRZEZ  INDPR.
C   DLA KAZDEGO PROTOTYPU:
C        - ANALIZUJE JEGO PREFIKS
C        - UZUPELNIA INFORMACJE O RODZAJU PROTOTYPU
C        - JESLI PROTOTYP JEST PROCEDURA LUB FUNKCJA VIRTUALNA, TO SZUKA
C          BEZPOSREDNIO WYZSZEGO VIRTUALA I WSTAWIA IDENTYFIKATOR PROTOTYPU
C          DO LISTY VIRTLIST PROTOTYPU OBEJMUJACEGO.
C        - DLA FUNKCJI  --  ZNAJDUJE JEJ TYP.
C   PODPROGRAM WSTAWIA PARE  ( NRSDIC, IDENT. W IPMEM)  DO KOLEJKI
C    PROTOTYPOW.
C   NRSDIC - INDEKS PROTOTYPU W IPMEM.
C   W  IPMEM  W POLU  SL  ZAPAMIETANY JEST IDENTYFIKATOR TEGO PROTOTYPU W
C      IPMEM.
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
C
      IMPLICIT INTEGER(A-Z)
C
C
      LOGICAL IFCLASS,BPREF,ONLY
C
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
C
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
      COMMON  / VIRT /  LISTVB,LISTVE,OWNVIR
      LOGICAL OWNVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ROBOCZY BLOK WSPOLNY.
C    LISTVB  -  POCZATEK ROBOCZEJ LISTY VIRTLIST
C    LISTVE  -  KONIEC ROBOCZEJ LISTY  VIRTLIST
C    OWNVIR = TRUE, JESLI W PROTOTYPIE BYLY WLASNE VIRTUALE
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND
     *, MNOTVIR
C
C
      COMMON  /PREFS/  LPREFS
C
C   **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    LPREFS  -  OSTATNIO PRZYDZIELONY NUMER W PREFIXSET
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
      COMMON / DONLY / IONLY,ONIL
      LOGICAL ONIL
C
C  ROBOCZY BLOK,UZYWANY PRZY TWORZENIU ZBIORU IDENTYFIKAROROW
C   IONLY  - POCZATEK LISTY TAKEN
C   ONIL - TRUE, GDY JEST TAKEN NONE
C
C
C
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *
C   NADANIE WARTOSCI ZMIENNYM.
C   IDSMEM - IDENTYFIKATOR W IPMEM PRZETWARZANEGO PROTOTYPU.
C   IDPMEM - IDENTYFIKATOR PROTOTYPU W IPMEM.
C   ISYS = 1  DLA COROUTINE, ISYS = 2 DLA PROCESS.
C  LINE - NR LINII DEKLARACJI PROTOTYPU.
C   *   *   *   *   *   *   *   *   *   *   *   *   *
C
C
      IDSMEM = IPMEM(NRSDIC)
      IDPMEM = IPMEM(IDSMEM+1)
C   JESLI HANDLER - TO DO PRZETWARZANIE HANDLERA
      IF(IPMEM(IDSMEM).EQ.8) GO TO 2500
      ISYS=IAND(IPMEM(IDSMEM+8),MSPR)
      LINE = IPMEM(IDSMEM+9)
C
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C    PRZETWARZANIE PREFIKSU
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
C   I - NAZWA PREFIKSU
      I = IPMEM(IDSMEM+2)
C        IDPR - BEDZIE IDENTYFIKATOREM PREFIKSU
      IDPR = 0
      IF( I.EQ.0) GO TO 500
C         JEST PREFIKS
      IDPR = MEMSL(I,INDPR)
      IF(IDPR.NE.0) GO TO 50
C        PREFIKS JEST NIEZADEKLAROWANY
      CALL MERR(308,I)
      GO TO 500
C   BADAMY, CZY PREFIKS JEST DOSTEPNY
 50   IRODZ=IPMEM(IDPR+1)
      IF(BTEST(IRODZ,2)) GO TO 60
      IF(.NOT.BTEST(IRODZ,1)  .OR.OWN)GO TO 100
C   NAZWA PROFIKSU JEST HIDDEN - BLAD
      CALL MERR(322,I)
      GO TO 150
C   NAZWA PREFIKSU JEST NOT-TAKEN
 60   CALL MERR(323,I)
      GO TO 150
C        BADAMY, CZY PREFIKS JEST KLASA
 100  IDPR = IPMEM(IDPR+2)
      IF(IDPR.EQ.NRUNIV) GO TO 150
C        IRODZ - CZESC T W SLOWIE ZEROWYM PREFIKSU
      IRODZ=IAND(IPMEM(IDPR),MTP)
      IF(IFCLASS(IRODZ)) GO TO 200
C        PREFIKS NIE JEST KLASA
      CALL MERR(301,I)
 150  IDPR=0
      GO TO 210
C
C   PREFIKS JEST POPRAWNY
 200  CONTINUE
C   JESLI PREFIKS MIAL BLEDNA LISTE PF, TO POPRAWIAMY
C    SLOWO ZEROWE
      IF(IAND(IPMEM(IDPR),MERPF).EQ.0) GO TO 250
C   POPRAWIAMY SLOWO ZEROWE
 210  IPMEM(IDPMEM) = IOR(IPMEM(IDPMEM),MERPF)
 250  CONTINUE
      IF(IDPR.EQ.0) GO TO 500
C        WSTAWIAMY IDENTYFIKATOR BEZPOSREDMIEGO PREFIKSU DO OPISU PROTOTYPU
       IPMEM(IDPMEM+21) = IDPR
C        PRZEPISANIE LISTY PREFIKSLIST Z PREFIKSU I DOLACZENIE SIEBIE
C        NA KONCU LISTY
C        I - DLUGOSC LISTY PREFIKSLIST Z PREFIKSU - 1
C        J - POCZATEK PREFIXLIST Z PREFIKSU
C        J1 - POCZATEK TWORZONEJ LISTY PREFIKSLIST
	I=IPMEM(IDPR+23)
      J = IPMEM(IDPR+22)
      J1 = MGETM(I+1,41)
      DO 222 II=1,I
      IJ1=J1+II-1
      IJ2=J+II-1
 222  IPMEM(IJ1) = IPMEM(IJ2)
C  DOLOCZAMY SIEBIE DO LISTY PREFIXLIST I WSTAWIAMY PREFIXLIST DO
C      OPISU PROTOTYPU
      IJ1=J1+I
      IPMEM(IJ1) = IDPMEM
      IPMEM(IDPMEM+22)=J1
      IPMEM(IDPMEM+23) = I+1
C
C  SPRAWDZENIE POPRAWNOSCI PREFIKSOW SYSTEMOWYCH
C  TWORZENIE PREFIXSET
C
C
C
C  I=1  JESLI PREFIKS JEST COROUTINA
C  I=2  JESLI PREFIKS JEST PRECESEM
C  I=0  W PRZECIWNYM PRZYPADKU
      I=0
      IF(BPREF(IDPR,IPMEM(NRCOR-6))) I=1
      IF(BPREF(IDPR,IPMEM(NRPROC-6))) I=2
C  JESLI PROTOTYP NIE JEST KLASA, TO PRZECHODZIMY DO BADANIA POPRAWNOSCI
C     PREFIKSOWANIA
      J=IAND(IPMEM(IDPMEM),MTP)
      IF(J.EQ.NOTTP) GO TO 800
C  PRZEPISANIE PREFIXSET Z PREFIKSU
      IPMEM(IDPMEM-3) = IPMEM(IDPR-3)
      IPMEM(IDPMEM-4) = IPMEM(IDPR-4)
      IPMEM(IDPMEM-5) = IPMEM(IDPR-5)
C   ROZPOZNAMIE RODZAJU PROTOTYPU
      IF(ISYS.LT.I) ISYS=I
 300  IF(ISYS.EQ.0) GO TO 400
C
C   PROTOTYP JEST COROUTINA LUB PROCESEM
      CALL CHECK(INDPR)
C  USTAWIAMY ODPOWIEDNIE BITY W PREFIXSET
      I=IPMEM(IDPMEM)
      CALL MSETB(IDPMEM,IPMEM(NRCOR-6))
      IF(ISYS.NE.2) GO TO 350
      CALL MSETB(IDPMEM,IPMEM(NRPROC-6))
C  POPRAWIAMY SLOWO ZEROWE PROTOTYPU - TO JEST PROCES
      IPMEM(IDPMEM) = IOR(IAND(I,MASKTP),MPROCES)
      GO TO 400
C  POPRAWIAMY SLOWO ZEROWE - TO JEST COROUTINA
 350  IPMEM(IDPMEM) = IOR(IAND(I,MASKTP),MCOR)
C  PRZYDZIELENIE NUMERU W SENSIE PREFIXSET
 400  LPREFS = LPREFS+1
      CALL MSETB(IDPMEM,LPREFS)
      IPMEM(IDPMEM-6) = LPREFS
C   JESLI KLASA MA BLEDNA LISTE PF, TO POPRAWIAMY NA PELNA
      IF(IAND(IPMEM(IDPMEM),MERPF).NE.0)
     * CALL CHECK(IDPMEM)
C   JESLI W KLASIE BYLY INSTRUKCJE, TO POPRAWIAMY NA KLASE PELNA
      IF(BTEST(IPMEM(IDSMEM+8),13))  CALL CHECK(IDPMEM)
      GO TO 1000
C
C  NIE BYLO PREFIKSU, LUB BYL BLEDNY PREFIKS.
C  JESLI PROTOTYP JEST BLOKIEM, TO KONCZYMY PRZETWARZANIE PREFIKSOW
 500  CONTINUE
      J1 = IPMEM(IDPMEM)
      IF(IAND(J1,MTP).EQ.NOTTP.AND.IAND(J1,MOTHERS).EQ.MBLOCK)
     *   GO TO 1000
C  DOLOCZAMY SIEBIE JAKO JEDYNY ELEMENT LISTY PREFIKSOW
      J = MGETM(1,41)
      IPMEM(J) = IDPMEM
      IPMEM(IDPMEM+22) = J
      IPMEM(IDPMEM+23) = 1
C  JESLI PROTOTYP NIE JEST KLASA, TO KONIEC PRZETWARZANIA PREFIKSOW
       IF(IAND(J1,MTP).EQ.NOTTP) GO TO 1000
C  USTAWIAMY BIT 2 W PREFIKSSET NA 1 I PRZECHODZIMY DO USTALENIA RODZAJU
C   KLASY
      CALL MSETB(IDPMEM,2)
      GO TO 300
C
C  SPRAWDZENIE POPRAWNOSCI PREFIKSOW SYSTEMOWYCH
 800  IF(I.EQ.0) GO TO 1000
C   COROUTINE LUB PROCES NIE PREFIKSUJE KLASY
      CALL MERR(303,IPMEM(IDSMEM+2))
C
C
C --- --- --- --- --- --- --- --- --- --- --- ---
C     PRZETWARZANIE INFORMACJI O WIRTUALACH
C
 1000 CONTINUE
C
C  JESLI TO NIE JEST WIRTUAL, TO PRZECHODZIMY DALEJ
      IF(.NOT.BTEST(IPMEM(IDSMEM+8),15)) GO TO 2000
C   TO JEST WIRTUAL.
C   JESLI PROTOTYP OBEJMUJACY JEST BLOKIEM NIEPREFIKSOWANYM, TO KASUJEMY
C      WIRTUALE
       IF(IPMEM(INDPR).NE.1) GO TO 1001
       IPMEM(IDPMEM)=IAND(IPMEM(IDPMEM),MNOTVIR)
       GO TO 2000
C
C  BIT NR 11 W SLOWIE ZEROWYM JEST JUZ USTAWIONY PRZEZ PODPROGRAM INITPR
C  OWNVIR = .TRUE., JESLI W PROTOTYPIE INDPR SA WLASNE WIRTUALE
C
 1001 OWNVIR=.TRUE.
C   CZUKA,Y BEZPOSREDNIO WYZSZEGO VIRTUALA
       IF(INDPREF.EQ.0) GO TO 1300
C  PROTOTYP OBEJMUJACY MA PREFIKS
C  I - NAZWA VIRTUALA
      I=IPMEM(IDSMEM+10)
C   SPRAWDZAMY,CZY WIRTUAL JEST NA LISCIE TAKEN Z PREFIKSU
      IONLY=IPMEM(INDSPR+7)
      ONIL=BTEST(IPMEM(INDSPR+8),14)
      IF(.NOT.ONLY(I)) GO TO 1300
      J=MEMSL(I,INDPREF)
      IF(J.EQ.0) GO TO 1300
      IF(LOCAL.NE.2.OR.BTEST(IPMEM(J+1),1)) GO TO 1300
      IF(BTEST(IPMEM(J+1),2)) GO TO 1300
      J = IPMEM(J+2)
C   SPRAWDZAMY,CZY TO JEST WIRTUAL
      IF(.NOT.BTEST(IPMEM(J),11))  GO TO 1300
C   ZNALEZLISMY BEZPOSREDNIO WYZSZY WIRTUAL
C  J - IDENTYFIKATOR BEZPOSREDNIO WYZSZEGO WIRTUALA
C  I  - NUMER WIRTUALNY
      I = IPMEM(J+27)
      IPMEM(IDPMEM+26) = J
      IPMEM(IDPMEM+27) = I
C  WSTAWIAMY WIRTUAL DO VIRTLIST (ROBOCZEJ) PROTOTYPU OBEJMUJACEGO
      IJ1=LISTVB+I
      IPMEM(IJ1) = IDPMEM
      GO TO 2000
C
C  NIE BYLO BEZPOSREDNIO WYZSZEGO WIRTUALA
 1300 CONTINUE
      INSYS = .TRUE.
      LISTVE = MGETM(1,41)
C  DOKLADAMY NUMER WIRTUALNY
      IPMEM(IDPMEM+27) = LISTVE-LISTVB
      INSYS=.FALSE.
      IPMEM(LISTVE)=IDPMEM
C
C
C -- -- -- -- -- -- -- -- --- -- -- -- --- -- --
C     DLA FUNKCJI  --  PRZETWARZANIE JEJ TYPU
C
 2000 CONTINUE
C
C  BADAMY, CZY PROTOTYP JEST FUNKCJA
      I = ISHFT(IAND(IPMEM(IDPMEM),MOTHERS),-8)
      IF(I.NE.2) GO TO 3000
C   SZUKAMY TYPU;  J - NAZWA TYPU
      J = IPMEM(IDSMEM+12)
      I=IFTYPE(J)
C  SPRAWDZAMY, CZY TO JEST TYP FORMALNY
C  I - IDENTYFIKATOR TYPU
      IF(IAND(IPMEM(I),MTP).NE.6) GO TO 2100
C  TO JEST TYP FORMALBY - ZMIANA SLOWA ZEROWEGO W PROTOTYPIE FUNKCJI
      IPMEM(IDPMEM)= IOR(IPMEM(IDPMEM),ISHFT(1,12))
C  WSTAWIENIE TYPU
 2100 IPMEM(IDPMEM-3) = I
      IPMEM(IDPMEM-4) = IPMEM(IDSMEM+13)
      GO TO 3000
C
C
 2500 CONTINUE
C
C  ---  ----  ----  ----  ----   ----  ----  ----  ----  ----  ----  ----  ----
C  PRZETWARZANIE HANDLERA
C
      CALL HANDLER ( IDSMEM )
C
C
C
C  ----  ----  ----  ----  ----  ----  ----  ----
C     WSTAWINEI PARY  (NRSDIC,IDPMEM)  DO KOLEJKI PROTOTYPIOW
C
 3000 CONTINUE
      CALL DPUTQ(NRSDIC,IDPMEM)
      RETURN
      END
      LOGICAL FUNCTION IFCLASS(IX)

C  *****************
C   FUNKCJA DAJE ODPOWIEDZ, CZY DANY PROTOTYP JEST KLASA
C   IX - CZESC T ZE SLOWA ZEROWEGO PROTOTYPU
C
C   ****************
C
      IFCLASS=IX.EQ.2 .OR. IX.EQ.3 .OR. IX.EQ.5 .OR. IX.EQ.7
      RETURN
      END
      INTEGER FUNCTION INITPR(KIND,NAME)
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C   FUNKCJA WYKONUJE WSTEPNE CZYNNOSCI  ( REZERWACJA MIEJSCA,USTAWIENIE
C   LISTY ATRYBUTOW I TABLICY HASHU ) DLA PROTOTYPU.
C      NAME - NAZWA PROTOTYPU
C      KIND - RODZAJ PROTOTYPU
C   WARTOSCIA FUNKCJI JEST IDENTYFIKATOR UTWORZONEGO PROTOTYPU.
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
C
      IMPLICIT INTEGER(A-Z)
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw  INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C    INOUT   -     --   --   --   --           ZMIENNEJ INOUT
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C ..... ZMIENNE GLOBALNE
C
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
cdeb ----------- added ---------------------
      common /names/ resnm, mainm, brenam
c   nazwy ze scannera

      common /brid/ breaklid
c   numer w displayu (dla interpretera) prototypu breakl
cdeb ---------------------------------------
C
C
C        REZERWACJA MIEJSCA I USTAWIENIE SLOWA ZEROWEGO
       IF(KIND.GE.13 .AND.KIND.LE. 16) INSYS=.TRUE.
      INITPR = MGETM(SIZEPR(KIND),341)
      INSYS=.FALSE.
      INITPR=INITPR+NULLPOZ(KIND)
      IPMEM(INITPR) = NULLWD(KIND)
C   DOLACZENIE DO LISTY NEXTDECL
      IPMEM(LASTPR+2) = INITPR
      LASTPR = INITPR
cdeb ----------- added --------------------
      if(name.ne.brenam) go to 82
c  przekazanie na zmiennej breaklid numeru prototypu
c procedury breakl
c  obliczenie numeru prototypu
      i = nblus
      breaklid = 0
  80  k = ipmem(i)
c  formaLNE i sygnaly sa pomijane
      if(iand(ishft(k,-4),15).ne.0) go to 81
      if(i.eq.lastpr) go to 82
      breaklid = breaklid+1
 81   i = ipmem(i+2)
      if(i.ne.0) go to 80
 82   continue
cdeb ---------------------------------------
      IF ( KIND .GE.17.AND.KIND.LE.20) GO TO 100
C   INICJALIZACJA LISTY ATRYBUTOW
      IPMEM(INITPR+7) = INITPR+5
      IPMEM(INITPR+5) = NATTR
C   USTAWIENIE SL
 100  IPMEM(INITPR-1) = INDPR
C   WSTAWIENIE 1 DO POLA USED - DLA AIL
      IPMEM(INITPR+1) = 1
C   DLA BLOKOW I HANDLEROW - KONIEC
      IF(KIND.EQ.1.OR. KIND.EQ.8 .OR. KIND.EQ.23) RETURN
C   WSTAWIENIE NAZWY PROTOTYPU DO TABLICY HASH'U
C   JESLI TO JEST PROTOTYP FORMALNY II-GO RZEDU, TO ELEMENTY LISTY HASH'U SA
C   TWORZONE W CZESCI SYSTEMOWEJ
      IF( KIND.GE.18 .AND. KIND.LE.20 ) INSYS = .TRUE.
      IF( NAME .EQ.NEMPTY) GO TO 200
      I = IDPUT(NAME,IPMEM(IHBEG))
      IF ( I.EQ.0) GO TO 200
      IPMEM(I+2) = INITPR
C    DLA SYGNALOW - KONIEC
 200  IF ( KIND.GE.21 ) RETURN
C        WSTAWIENIE DO LISTY ATRYBUTOW ( PROTOTYPU INDPR )
C        JESLI INDPR JEST FORMALNY, TO LISTA ATRYBUTOW JEST TWORZONA
C          W CZESCI SYSTEMOWEJ
      CALL MADATR(INITPR,INDPR,41)
      INSYS = .FALSE.
      RETURN
      END
      SUBROUTINE MERGEID
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C  PODPROGRAM DOKLADA DO ZBIORU IDENTYFIKATOROW PROTOTYPU INDPR
C   IDENTYFIKATORY Z PREFIKSU TAKIE,ZE:
C         -   JESZCZE ICH NIE MA
C          - NIE MA ICH NA LISCIE TAKEN
C  PODPROGRAM JEST WYWOLYWANY O ILE BYL PREFIKS.
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
       IMPLICIT INTEGER (A-Z)
C
      LOGICAL ONLY
C
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
      LOGICAL ERRFLG
      COMMON/STREAM/ERRFLG,LINE,IBUF2(265),IBUF3(7),JUNK(260)
      COMMON/MEM/NM,NH
      COMMON/DONLY/IONLY,ONIL
      LOGICAL ONIL
C
C   **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ROBOCZY BLOK, UZYWANY PRZY TWORZENIU ZBIORU IDENTYFIKATOROW
C    IONLY  -  POCZATEK LISTY TAKEN W ISMEM
C   ONIL=TRUE, GDY JEST TAKEN NIL
C
C
C
C   SPRAWDZAMY, CZY BYLO  TAKEN NIL
      ONIL=BTEST(IPMEM(INDSPR+8),14)
      IF(ONIL) GO TO 500
C
C   *   *   *   *   *   *
C  SPRAWDZENIE POPRAWNOSCI LISTY TAKEN
C   *   *   *   *   *   *
C
C  IHBEGP  --  POCZATEK LISTY IDENTYFIKATOROW W PREFIKSIE
      IHBEGP=INDPREF+10
      IONLY=IPMEM(INDSPR+7)
      IF(IONLY .EQ.0) GO TO 500
C  J - POPRZEDNI ELEMENT LISTY
C  I - BIEZACY ELEMENT LISTY
      J=0
      I=IONLY
 100  NM=IPMEM(I)
      LINE=IPMEM(I+1)
      NH=IAND(ISHFT(NM,-1),7)+1
      M=MEMPRF(INDPREF)
C  M - ELEMENT LISTY HASHU, JESLI NAZWA NM JEST ZADEKLAROWANA W PREFIKSACH
      IF(M .EQ. 0) GO TO 400
C  SPRAWDZAMY, CZY NAZWA JEST HIDDEN
      IF(BTEST(IPMEM(M+1),1))  GO TO 300
C   SPRAWDZAMY,CZY NAZWA JEST NOT TAKEN
      IF(BTEST(IPMEM(M+1),2)) GO TO 250
C        POPRAWNY ELEMENT LISTY TAKEN
      J=I
 200  I=IPMEM(I+2)
      IF(I.NE.0) GO TO 100
      GO TO 500
C   NAZWA JEST NOT TAKEN - USUWAMY Z LISTY TAKEN
 250  CALL MERR(321,NM)
      GO TO 200
C  NAZWA JEST HIDDEN
 300  CALL MERR(304,NM)
      GO TO 200
C  NAZWA NIEZADEKLAROWANA
 400  CALL MERR(305,NM)
C  DOKLADAMY NAZWE DO ZBIORU IDENTYFIKATOROW
      M = MEMBER(NM,IPMEM(IHBEG))
      IF(M.NE.0) GO TO 200
      M=INSERT(NM,IPMEM(IHBEG),341)
      GO TO 200
C
C  *   *   *   *   *   *
C       LACZENIE ZBIOROW IDENTYFIKATOROW
C  *  *   *   *   *  *
C
 500  CONTINUE
C   PRZEGLADAMY KOLEJNE PREFIKSY
      IDP= INDPREF
 800  CONTINUE
C        IE - KONIEC TABLICY IDENTYFIKATOROW W PREFIKSIE
      IE= IDP+17
C   IHBEGP - POCZATEK LISTY IDENTYFIKATOROW W PREFIKSIE
      IHBEGP=IDP+10
      DO 555 I=IHBEGP,IE,1
C        I - INDEKS KOLEJNEGO ELEMENTU TABLICY HASHU
C        J - ELEMENT TABLICY HASHU
      J=IPMEM(I)
      IF(J.EQ.0) GO TO 555
 600   CONTINUE
C   JESLI NAZWA JEST HIDDEN - TO DALEJ
      IF(BTEST(IPMEM(J+1),1)) GO TO 700
C JESLI NAZWA JEST NOT TAKEN - TO DALEJ
      IF(BTEST(IPMEM(J+1),2)) GO TO 700
      NM=IPMEM(J)
      IF(ONLY(NM)) GO TO 700
C   NAZWY NIE MA NA LISCIE TAKEN
      NH=IAND(ISHFT(NM,-1),7)+1
C   SZUKAMY NAZWY OD INDPR PO PREFIKSACH
      IND = INDPR
 610  M = IND+9+NH
      M = IPMEM(M)
 620  IF(M.EQ.0) GO TO 650
      IF(IPMEM(M).EQ.NM) GO TO 670
      M = IPMEM(M+3)
      GO TO 620
 650  IND = IPMEM(IND+21)
      GO TO 610
C   NAZWA MUSI ZOSTAC ZNALEZIONA
C   JESLI NAZWA BYLA ZNALEZIONA PONIZEJ IDP, TO
C   ALBO BYLA JUZ ROZPATRYWANA, ALBO BYLA JUZ NOT TAKEN,
C   ALBO JEST LOKALNA W INDPR
 670  IF(IND.NE.IDP) GO TO 700
C   NAZWE TRZEBA DOSTAWIC
       M=INSERT(NM,IPMEM(IHBEG),341)
      IPMEM(M+1) = 4
      IPMEM(M+2) = IPMEM(J+2)
 700  J=IPMEM(J+3)
      IF(J.NE.0) GO TO 600
 555  CONTINUE
C   PRZECHODZIMY DO NATEPNEGO PREFIKSU
      IDP=IPMEM(IDP+21)
      IF(IDP.NE.0) GO TO 800
      RETURN
      END
      LOGICAL FUNCTION ONLY(NAME)
C
C   *  *  *  *   *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
C     FUNKCJA SPRAWDZA, CZY NAZWA NAME JEST NA LISCIE TAKEN
C    POCZATEK LISTY TAKEN - IONLY
C  *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
C
      IMPLICIT INTEGER(A-Z)
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C
      COMMON  / DONLY /  IONLY,ONIL
      LOGICAL ONIL
C
C   **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ROBOCZY BLOK, UZYWANY PRZY TWORZENIU ZBIORU IDENTYFIKATOROW
C    IONLY  -  POCZATEK LISTY TAKEN W ISMEM
C   ONIL=TRUE, GDY JEST TAKEN NIL

C
C   JESLI LISTA TAKEN JEST PUSTA, TO ZAKLADAMY, ZE SA W NIEJ WSZYSTKIE
C            NAZWY
C
       ONLY=.FALSE.
       IF(ONIL) RETURN
       IF(IONLY.EQ.0) GO TO 200
       I=IONLY
 100   IF(IPMEM(I).EQ.NAME) GO TO 200
       I=IPMEM(I+2)
       IF(I.NE.0) GO TO 100
C   NAZWY NIE MA NA LISCIE TAKEN
       RETURN
C  NAZWA JEST NA LISCIE TAKEN
 200   ONLY=.TRUE.
       RETURN
       END
      SUBROUTINE CHECK ( IND )
C
C   * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C   POPRAWIA BIT OZNACZAJACY PELNA KLASE POCZAWSZY OD PROTOTYPU  IND
C   KONCZY, JESLI TEN BIT JEST 1
C  * * * * * * * * * * * * * * * * *  *  * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
C
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      J=IND
 100  I=IPMEM(J)
      IF(BTEST(I,0)) RETURN
      IPMEM(J) = IOR(I,1)
      J=IPMEM(J-1)
      GO TO 100
       END
      INTEGER FUNCTION IDPUT(NAME,THASH)
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C  FUNKCJA WSTAWIA NAZWE NAME DO TABLICY THASH UPRZEDNIO SPRWDZAJAC,
C   CZY NAZWA JUZ TAM JEST.
C   JESLI JEST, TO WARTOSCIA FUNKCJI JEST 0 I WYKONYWANE SA REAKCJE NA BLAD
C     ( BLAD NIE JEST SYGNALIZOWANY )
C   JESLI NIE MA , TO WARTOSCIA FUNKCJI JEST WSTAWIANY ELEMENT
C   LISTY HASHU.
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
C
      IMPLICIT INTEGER(A-Z)
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
cdsw  INTEGER THASH(8)
      dimension thash(8)
C
C
C        SPRAWDZENIE, CZY NAZWA JEST W TABLICY
      I=MEMBER(NAME,THASH)
      IF(I.NE.0) GO TO 100
C        NAZWY NIE MA - WSTAWIAMY
      IDPUT = INSERT ( NAME,THASH,341)
      RETURN
C
C        NAZWA JEST - PODWOJNA DEKLARACJA
 100  IDPUT = 0
      CALL MERR(309,NAME)
C        SKASOWANIE W ELEMENCIE LISTY HASHU INFORMACJI O HIDDEN I CLOSE
      IPMEM(I+1) = 0
C        DOWIAZANIE NAZWY DO OBIEKTU UNIVERSAL
      IPMEM(I+2) = NRUNIV
      RETURN
      END
      INTEGER FUNCTION IFTYPE ( NAME)
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C   FUNKCJA ZNAJDUJE NAZWE NAME W PROTOTYPIE O IDENTYFIKATORZE  INDPR
C   I DALEJ O SL-ACH.  SPRAWDZA,CZY JEST TO NAZWA TYPU.
C   IFTYPE =   IDENTYFIKATOR TYPU, JESLI TYP JEST POPRAWNY
C      IFTYPE = NRUNIV, GDY TYP JEST NIEZADEKLAROWANY LUB NIEDOSTEPNY
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
      IMPLICIT INTEGER(A-Z)
C
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND, MNOTVIRT
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
C
      IFTYPE=MEMSL(NAME,INDPR)
      IF(IFTYPE.EQ.0) GO TO 200
      I=IPMEM(IFTYPE+1)
      IF(BTEST(I,2)) GO TO  100
      IF(.NOT.BTEST(I,1) .OR. OWN) GO TO 400
C   NAZWA JEST HIDDEN
      CALL MERR(317,NAME)
      GO TO 150
C   NAZWA JEST NOT TAKEN
 100  CALL MERR(318,NAME)
 150  IFTYPE=NRUNIV
      RETURN
C        NAZWA JEST ZADEKLAROWANA
 400  IFTYPE = IPMEM(IFTYPE + 2)
C        SPRAWDZENIE, CZY TO JEST NAZWA TYPU
      IF(IAND(IPMEM(IFTYPE),MTP).NE.NOTTP) RETURN
C        TO NIE JEST NAZWA TYPU
      IFTYPE = NRUNIV
      CALL MERR(307,NAME)
      RETURN
C        NAZWA JEST NIEZADEKLAROWANA - DKLADAMY JA DO BIEZACEGO PROTOTYPU
 200  CALL MERR(306,NAME)
      IFTYPE = INSERT(NAME,IPMEM(IHBEG),341)
      IFTYPE = NRUNIV
      RETURN
      END
      SUBROUTINE DPUTQ (NSDIC,IDPMEM)
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C   PODPROGRAM WSTAWIA PARE (NSDIC,IDPMEM)  DO KOLEJKI PROTOTYPOW
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
      IMPLICIT INTEGER(A-Z)
C
C
      COMMON  / QUEUE /  BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
cdsw  INTEGER  BQUEUE, EQUEUE
      LOGICAL EMPTY
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
C      BQUEUE  -  POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
C      EQUEUE  -  KONIEC      --      --       --      --      --
C      IFIRST  -  PIERWSZY ELEMENT KOLEJKI
C      LAST  -  OSTATNI ELEMENT KOLEJKI
C      EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
C
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
C        JESLI DOSZLISMY DO KONCA OBSZARU PRZEZNACZONEGO NA KOLJKE, TO
C        ZACZYNAMY OD POCZATKU
      IF ( LAST.EQ.EQUEUE-1) LAST=BQUEUE-2
       IF(LAST.EQ.IFIRST-2.AND..NOT.EMPTY) GO TO 100
C        JEST MIEJSCE NA DOSTAWIANIE ELEMENTU DO KOLEJKI
      EMPTY=.FALSE.
      LAST = LAST+2
      IPMEM(LAST) = NSDIC
      IPMEM(LAST+1) = IDPMEM
      RETURN
C
C        PRZEPELNIENIE OBSZARU PRZEZNACZONEGO NA KOLEJKE
C        PRZERWANIE KOMPILACJI
 100  CALL MDROP(343)
      RETURN
      END
      SUBROUTINE DGETQ
C
C
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C   PODPROGRAM POBIERA PIERWSZY ELEMENT Z KOLEJKI PROTOTYPOW I
C   WSTAWIA NA ZMIENNE INDICT I INDPR Z BLOKU  DGLOB.
C   NIE SPRAWDZA, CZY KOLEJKA JEST PUSTA.
C   JESLI NA SKUTEK WYKONANIA OPERACJI KOLEJKA BEDZIE PUSTA, TO ZMIENNA
C   EMPTY DOSTAJE WARTOSC  TRUE  .
C   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *
C
C
      IMPLICIT INTEGER(A-Z)
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON  / QUEUE /  BQUEUE, EQUEUE, IFIRST, LAST, EMPTY
cdsw  INTEGER  BQUEUE, EQUEUE
      LOGICAL EMPTY
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    ZMIENNE SLUZACE DO ORGANIZACJI KOLEJKI PROTOTYPOW
C      BQUEUE  -  POCZATEK POLA W IPMEM PRZEZNACZONEGO NA KOLEJKE
C      EQUEUE  -  KONIEC      --      --       --      --      --
C      IFIRST  -  PIERWSZY ELEMENT KOLEJKI
C      LAST  -  OSTATNI ELEMENT KOLEJKI
C      EMPTY = TRUE, GDY KOLEJKA JEST PUSTA
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
      INDICT = IPMEM(IFIRST)
      INDPR = IPMEM(IFIRST+1)
      IF(LAST.EQ.IFIRST) GO TO 100
C        KOLEJKA MA CO NAJMNIEJ 2 ELEMENTY
      IF(IFIRST.EQ.EQUEUE-1) GO TO 50
      IFIRST = IFIRST+2
      RETURN
 50   IFIRST = BQUEUE
      RETURN
C
C        KOLEJKA BEDZIE PUSTA
 100  EMPTY = .TRUE.
      IFIRST=BQUEUE
      LAST=BQUEUE-2
      RETURN
      END
      SUBROUTINE HEADER
C
C
C**********************************************C
C   PODPROGRAM PRZETWARZA LISTE PARAMETROW FORMALNYCH
C   PROTOTYPU INDPR
C **********************************************
C
      IMPLICIT INTEGER(A-Z)
      LOGICAL PQ,ISTPF,FORM2
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYGN = TRUE, GDY SA TO PARAMETRY SYGNALU
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW/
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C    MNOTVIR - WZORZEC DO KASOWANIA BITU "WIRTUAL"
C    MHAND - MASKA DLA HANDLERA
C
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw  INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C    INOUT   -     ---  --   --   ---          ZMIENNEJ INOUT
C
C  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
C
C   SPRAWDZENIE,CZY TYP FORMALNY NIE WYSTEPUJE PO UZYCIU
C   JESLI BLOK - TO IDZIEMY DALEJ
      IF(IPMEM(INDSPR).EQ.1) GO TO 1000
      SYGN = ISHFT(IAND(IPMEM(INDPR),MPAR),-4).EQ.11
      IDPAR = IPMEM(INDSPR+11)
      IF(SYGN) IDPAR = IPMEM(INDSPR+4)
      FORM2=.FALSE.
 100  IF(IDPAR.EQ.0) GO TO 1000
      K=IPMEM(IDPAR)
 150  IF (FORM2) GO TO 350
      IF(K.EQ.7) GO TO 900
      IF(K.EQ.3.OR.K.EQ.5) GO TO 200
      I1=IDPAR+5
      IF(K.GE.8) I1=IDPAR+4
      I=IPMEM(I1)
C  I - NAZWA TYPU PARAMETRU
C  SPRAWDZAMY,CZY TEN TYP JEST POZNIEJ W LISCIE PARAMETROW
C   OD IDPAR DO KONCA LISTY
      PQ=ISTPF(I,.TRUE.)
      IF(PQ) IPMEM(I1)=NEMPTY
      IF(K.GE.8) GO TO 900
C  TERAZ SPRAWDZAMY PARAMETRY II-GO RZEDU
 200  LFORMB=IDPAR
      FORM2=.TRUE.
      IDPAR=IPMEM(LFORMB+4)
 300  IF(IDPAR.EQ.0) GO TO 800
      K=IPMEM(IDPAR)
      GO TO 150
 350  IF(K.LT.8) GO TO 700
      I=IPMEM(IDPAR+4)
C  SZUKAMY TYPU OD IDPAR DO KONCA LISTY II-GO RZEDU
      PQ=ISTPF(I,.TRUE.)
      IF(.NOT.PQ) GO TO 400
      IPMEM(IDPAR+4) = NEMPTY
      GO TO 700
C  SZUKAMY TYPU WCZESNIEJ W LISCIE II-GO RZEDU BEZ
C   SYGNALIZACJI BLEDU
 400  PQ = ISTPF(I,.FALSE.)
      IF( PQ ) GO TO 700
C  SZUKAMY W ZEWNETRZNEJ LISCIE PF OD PRZERABIANEJ
C   PROCEDURY/FUNKCJI DO KONCA
      K=IDPAR
      IDPAR=LFORMB
      PQ = ISTPF(I,.TRUE.)
      IF(PQ) IPMEM(K+4) = NEMPTY
      IDPAR=K
 700  IDPAR = IPMEM(IDPAR+3)
      GO TO 300
 800  FORM2=.FALSE.
      IDPAR=LFORMB
 900  IDPAR = IPMEM(IDPAR+3)
      GO TO 100
C
C  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
C
C              PRZETWARZANIE PARAMETROW
C
 1000 CONTINUE
C
C   PRZYGOTOWANIA DO PRZETWARZANIA LISTY PF
      BEGM=LPML
      INSYS=.TRUE.
      LFORMB=MGETM(2,341)
      LFORME=LFORMB
      FORM2=.FALSE.
      INSYS=.FALSE.
C  JESLI BLOK TO NIE POSIADA PARAMETROW
      IF(IPMEM(INDSPR).EQ.1) GO TO 1500
C
C   PRZETWARZANIE PARAMETROW
      IDPAR=IPMEM(INDSPR+11)
      IF(SYGN) IDPAR = IPMEM(INDSPR+4)
 1100 IF(IDPAR.EQ.0) GO TO 1500
      K=IPMEM(IDPAR)
      IF(K.EQ.7) GO TO 1200
      IF(K.GE.8) GO TO 1300
C  PROCEDURA / FUNKCJA FORMALNA
      CALL CHECK(INDPR)
      CALL PROCFUN
      GO TO 1400
C   TYP FORMALNY
 1200 CALL TYPEF
      GO TO 1400
C   ZMIENNA
 1300 CALL VARIAB
 1400 IDPAR=IPMEM(IDPAR+3)
      GO TO 1100
C
 1500 CONTINUE
C  DOLACZENIE RESULT
C JESLI TO JEST FUNKCJA
C   UWAGA - NAZWA RESULT DOLACZANA W PROTP1
      IF(IPMEM(INDSPR).NE.4.AND.IPMEM(INDSPR).NE.6) GO TO 2000
      I=MGETM(6,341) + 4
      IPMEM(I) = OUTPFW
      CALL PUTPF(I)
      CALL MADATR(I,INDPR,341)
C   ZAPAMIETANIE 1 W POLU USED - DLA AIL
      IPMEM(I+1)=1
      IPMEM(INDPR-5) = I
C  DOLACZENIE TYPU
      IPMEM(I-4) = IPMEM(INDPR-4)
      IPMEM(I-3) = IPMEM(INDPR-3)
C   WYLICZENIE APETYTU RESULT
      IPMEM(I) = IAP(I)
C   JESLI TO BYL TYP FORMALNY, TO ZMIANA SLOWA ZEROWEGO
      IF(BTEST(IPMEM(INDPR),12))
     * IPMEM(I) = IOR(IPMEM(I),ISHFT(1,12 ))
C
C
 2000 CONTINUE
      FORM2=.FALSE.
      IF(INDPREF.EQ.0) GO TO 1700
C   JESLI PREFIKS MIAL BLEDNA LISTE PF, TO NIE DOKLADAMY WLASNEJ
      IF (IAND(IPMEM(INDPREF),MERPF).NE.0) GO TO 1850
C   DOPISANIE SWOJEJ LISTY PF
 1700  CALL COPY
C   DOLACZENIE LISTY PF Z PREFIKSU
      IF(INDPREF.EQ.0) GO TO 3000
 1850 I=IPMEM(INDPREF+3)
      J=IPMEM(INDPREF+4)
      IF(J.EQ.0) GO TO 3000
      K=MGETM(J,341)
      DO 1666 I1=1,J
      I2=K+I1-1
      I3=I+I1-1
 1666 IPMEM(I2) = IPMEM(I3)
      IPMEM(INDPR+3) = K
      IPMEM(INDPR+4) = IPMEM(INDPR+4)+J
 3000 CONTINUE
C   ZAKONCZENIE
      LPML=BEGM
      RETURN
      END
      LOGICAL FUNCTION ISTPF(NM,PQ)
C
C * * * * * * * * * * * * * * * * * * * * * * * *
C   FUNKCJA SPRAWDZA,CZY TYP O NAZWIE NM WYSTEPUJE JAKO
C   FORMALNY W LISCIE PARAMETROW.
C   JESLI PQ=.TRUE., TO SZUKAMY OD IDPAR DO KONCA LISTY
C   I W RAZIE ZNALEZIENIA SYGNALIZUJEMY BLAD.
C   JESLI PQ=.FALSE., TO SZUKAMY OD POCZATKU LOKALNEJ LISTY
C   PARAMETROW(LFORMAB) DO IDPAR I NIE SYBNALIZUJEMY BLEDU.
C   * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
      LOGICAL PQ
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL FORM2, SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W IPMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYNG = TRUE, GDY SA TO PARAMETRY SYGNALU
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
C
C
      K=0
      IF(.NOT. PQ) K=IDPAR
      I=IPMEM(IDPAR+3)
      IF(.NOT.PQ) I=IPMEM(LFORMB+4)
      ISTPF=.FALSE.
 100  IF(I.EQ.K) RETURN
      IF(IPMEM(I).NE.7) GO TO 200
C   TYP FORMALNY
      IF(IPMEM(I+2) .EQ. NM) GO TO 400
 200  I=IPMEM(I+3)
      GO TO 100
C  ZNALEZIONY TYP
 400  ISTPF=.TRUE.
      IF(.NOT.PQ)RETURN
      LINE=IPMEM(IDPAR+1)
      CALL MERR(316,NM)
      RETURN
      END
      SUBROUTINE PUTPF(ID)
C
C  * * * * * * * * * * * * * * * * * * * * * * * * *
C   WSTAWIA PARAMETR O IDENTYFIKATORZE ID DO LISTY PF
C  * * * * * * * * * * * * * * * * * * * * * * * ***
C
      IMPLICIT INTEGER(A-Z)
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL FORM2, SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
C
C
C
C
      INSYS=.TRUE.
      K=MGETM(2,341)
      IPMEM(K) = ID
      IPMEM(LFORME+1) = K
      LFORME=K
      INSYS=.FALSE.
      RETURN
      END
      SUBROUTINE COPY
C
C  * * * * * * * * * * * * * * * * * * * * * * * * *
C   KOPIUJE LISTE PF DO PAMIECI UZYTKOWNIKA
C   I DOWIAZUJE DO PROTOTYPU INDPR
C  * * * * * * * * * * * * * * * * * * * ** * * *  *
C
      IMPLICIT INTEGER(A-Z)
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL FORM2, SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYN = TRUE, GDY TO SA PARAMETRY SYGNALU
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
C
      I=IPMEM(LFORMB+1)
      K=0
      L=0
      J=0
      IF(I.EQ.0) GO TO 400
      L=MGETM(1,341)
      J=L
 100  X=IPMEM(I)
      IPMEM(J) = X
C   JESLI TO SA PARAMETRY II-GO RZEDU,TO POPRAWIAMY SL NA INDPR
      IF(FORM2) IPMEM(X-1) = INDPR
      I=IPMEM(I+1)
      K=K+1
      IF(I.EQ.0) GO TO 200
      J=MGETM(1,341)
      GO TO 100
 200  CONTINUE
C   L - PIERWSZY PARAMETR
C   J - OSTATNI PARAMETR
C   TRZEBA ZAMIENIC ICH KOLEJNOSC
      I1=J
      I2=L
 300  IF (I1.GE.I2) GO TO 400
      X=IPMEM(I1)
      IPMEM(I1)=IPMEM(I2)
      IPMEM(I2)=X
      I1=I1+1
      I2=I2-1
      GO TO 300
 400  IPMEM(INDPR+3) = J
      IPMEM(INDPR+4) = K
      RETURN
      END
      SUBROUTINE TYPEF
C
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C   PRZETWARZA TYP FORMALNY.
C   INFORMACJE O PARAMETRZE - W BLOKU DWORK
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL FORM2, SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
C
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
C   UTWORZENIE OPISU
      LINE=IPMEM(IDPAR+1)
      KIND=17
      IF(FORM2) KIND=20
      ID=INITPR(KIND,IPMEM(IDPAR+2))
C   WSTAWIENIE DO LISTY PF
      CALL PUTPF(ID)
      RETURN
      END
      SUBROUTINE VARIAB
C
C  * * * * * * * * * * * * * * * * * * * * * * ** * * * *
C   PRZETWARZA PARAMETR BEDACY ZMIENNA
C   INFORMACJE O PARAMETRZE - W BLOKU DWORK
C  * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL FORM2, SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C    INOUT   -     --    --     ---   --       ZMIENNEJ INOUT
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
      LINE = IPMEM(IDPAR+1)
      NM=IPMEM(IDPAR+2)
C   .  .  .
C   UTWORZENIE OBIEKTU
      ID=MGETM(6,341)+4
      IPMEM(ID) = INPFW
      IF(IPMEM(IDPAR).EQ.9) IPMEM(ID)=OUTPFW
      IF(IPMEM(IDPAR).EQ.10) IPMEM(ID)=INOUT
C   WSTAWIENIE DO ZBIORU IDENTYFIKATOROW
      IF(FORM2) INSYS=.TRUE.
      K=IDPUT(NM,IPMEM(IHBEG))
      IF(K.EQ.0) GO TO 200
      IPMEM(K+2) = ID
C   WSTAWIENIE DO LISTY ATRYBUTOW
 200  CALL MADATR(ID,INDPR,341)
C   ZAPAMIETANIE 1 W POLU USED - DLA AIL
      IPMEM(ID+1)=1
C   WSTAWIENIE DO LISTY PF
      CALL PUTPF(ID)
C
C   ROZPOZNANIE TYPU
      NM=IPMEM(IDPAR+4)
      K=IFTYPE(NM)
      IPMEM(ID-3) = K
      IPMEM(ID-4) = IPMEM(IDPAR+5)
C   WSTAWIENIE APETYTU
      IPMEM(ID) = IAP(ID)
C   JESLI TYP JEST FORMALNY, TO POPRAWIAMY SLOWO ZEROWE
      IF(IAND(IPMEM(K),MTP) .NE. 6) RETURN
      IPMEM(ID) = IOR(IPMEM(ID),ISHFT(1,12))
C   JESLI TYP FORMALNY JEST NIELOKALNY, TO POPRAWIAMY SPECYFIKACJE
C   PROTOTYPU
      IF(LOCAL.EQ.2) RETURN
      IF(FORM2) GO TO 300
      CALL CHECK(INDPR)
C   JESLI SYGNAL - TO BLAD
 250  IF(SYGN) CALL MERR(361,NM)
      RETURN
C   JESLI TYP POCHODZI Z TEJ SAMEJ LISTY PARAMETROW CO PROCEDUURA FORMALNA,
C   TO DOBRZE
 300  IF(IPMEM(K-1).EQ.IPMEM(INDPR-1)) RETURN
      GO TO 250
      END
      SUBROUTINE PROCFUN
C
C  * * * * * * ** * * * * * * * * * * * * * * * * * * * * *
C   PRZETWARZA PROCEDURE LUB FUNKCJE FORMALNA I-GO RZEDU
C   INFORMACJE O PARAMETRZE W BLOKU DWORK
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL FORM2, SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
C
C
      COMMON /DCOPIES/ INDPRC,IHBEGC, IDPARC,LFBC,LFEC
C
C  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
C   KOPIE ZMIENNYCH Z DGLOB I DWORK
C   INDPRC - KOPIA INDPR
C   IHBEGC - KOPIA IHBEG
C   IDPARC - KOPIA IDPAR
C   LFBC - KOPIA LFORMB
C   LFEC - KOPIA LFORME
C
C
      COMMON  / YNIT /  NULLWD(23), SIZEPR(23), NULLPOZ(23), CONSTWD,
     *  VARWD,VARPOM,INPFW,OUTPFW, INOUT
cdsw  INTEGER  SIZEPR, CONSTWD, VARWD, VARPOM, OUTPFW
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C    NULLWD(I)  -  WZORZEC SLOWA ZEROWEGO DLA PROTOTYPU RODZAJU I
C    SIZEPR(I)  -  ROZMIAR POLA W IPMEM   --   --   --
C    NULLPOZ(I)  -  POZYCJA SLOWA ZEROWEGO  --   --    --
C    CONSTWD  -  WZORZEC SLOWA ZEROWEGO DLA    CONST
C    VARWD  -     --   --   --   --          DLA ZMIENNEJ
C    VARPOM  -     --   --   --   --           ZMIENNEJ POMOCNICZEJ
C    INPFW  -     --   --    --    --          ZMIEMNEJ INPUT
C    OUTPFW  -     --   --    --    --         ZMIENNEJ OUTPUT
C   INOUT    -       --   --   --   ---        ZMIENNEJ INOUT
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
C
C
      NM=IPMEM(IDPAR+2)
      LN=IPMEM(IDPAR+1)
      LINE=LN
C   .  .  .
C   BEGM - POCZATEK WOLNEGO POLA W PAMIECI SYSTEMOWEJ
      BEGM=LPML
      LP=LASTPR
C   UTWORZENIE OPISU PARAMETRU
      K=IPMEM(IDPAR) + 10
      I=INITPR(K,NM)
C   ZAPAMIETANIE KOPII
      INDPRC=INDPR
      IHBEGC=IHBEG
      IDPARC=IDPAR
      LFBC=LFORMB
      LFEC=LFORME
C   ZAMIANA ZMIENNYCH OKRESLAJACYCH PRZETWARZANY PROTOTYP
      INDPR=I
      IHBEG=I+10
      INSYS=.TRUE.
      LFORMB=MGETM(2,341)
      LFORME=LFORMB
      FORM2=.TRUE.
C
C  -  -  -  -  -  -  -  -  -  -  -   -  -  -  -  -  - -  -
C   PRZETWARZANIE LISTY PF II-GO RZEDU
C
C
      INSYS=.FALSE.
      IDPAR=IPMEM(IDPAR+4)
 100  IF(IDPAR.EQ.0) GO TO 500
      KD=IPMEM(IDPAR)
      IF(KD.EQ.7) GO TO 200
      IF(KD.GE.8) GO TO 300
C  PROCEDURA/FUNKCJA II-GO RZEDU
      CALL PROCF2
      GO TO 400
C  TYP FORMALNY
 200  CALL TYPEF
      GO TO 400
C  ZMIENNA
 300  CALL VARIAB
 400  IDPAR = IPMEM(IDPAR+3)
      GO TO 100
C
 500  CONTINUE
C
C   -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
C   CZYNNOSCI ORGANIZACYJNE(PAMIEC) I ZAKONCZENIE
C   PRZETWARZANIA  PROCEDURY/FUNKCJI
C
      LINE=LN
C   DOLACZENIE RESULT - JESLI TO JEST FUNKCJA
      IF(K.EQ.13.OR.K.EQ.15) GO TO 700
      I=MGETM(6,341) +4
      IPMEM(I) = OUTPFW
      CALL MADATR(I,INDPR,341)
      CALL PUTPF(I)
C   ZAPAMIETANIE IDENTYFIKATORA RESULT
      IPMEM(INDPR-5)=I
C  UWAGA - NAZWY RESULT NIE TRZEBA ZAPAMIETYWAC
 700  CONTINUE
C  PRZEPISANIE PROTOTYPU DO CZESCI UZYTKOWNIKA
      IF(K.EQ.14 .OR. K.EQ.16) GO TO 750
      I=INDPR-2
      J=7
      KD=MGETM(7,341)
      INDPR=KD+2
      GO TO 800
 750  I=INDPR-5
      J=10
      KD=MGETM(10,341)
      INDPR=KD+5
 800  CONTINUE
      DO 888 II=1,J
      I1=KD+II-1
      I2=I+II-1
 888  IPMEM(I1) = IPMEM(I2)
C   ZMIANA DOWIAZANIA NEXTDECL W PROTOTYPIE POPRZEDZAJACYM ( LP )
      IPMEM(LP+2) = INDPR
      IF(IPMEM(INDPR+2).EQ.0) LASTPR = INDPR
C   PRZEPISANIE LISTY PF
      CALL COPY
C   POPRAWIENIE ID PROTOTY@PU W TABLICY HASH
      I=MEMBER(NM,IPMEM(IHBEGC))
      IPMEM(I+2) = INDPR
C   POPRAWIENIE ID PROTOTYPU W LISCIE ATRYBUTOW
      I=IPMEM(INDPR-2)
C  I - NUMER ATRYBUTU
      KD=IPMEM(INDPRC+6)
 920  J=IPMEM(KD)
      IF(IPMEM(J-2).EQ.I) GO TO 950
       KD=IPMEM(KD+1)
      GO TO 920
C  KD - ATRYBUT
 950  IPMEM(KD) = INDPR
C   COFNIECIE PAMIECI SYSTEMOWEJ
      LPML=BEGM
C   COFNIECIE ZMIENNYCH Z DWORK
      LFORMB=LFBC
      LFORME=LFEC
      IDPAR=IDPARC
      FORM2=.FALSE.
C   DOLACZENIE SIEBIE DO LISTY PF
      CALL PUTPF(INDPR)
C   COFNIECIE ZMIENNYCH Z DGLOB
      I=INDPR
      INDPR=INDPRC
      IHBEG=IHBEGC
C
C   JESLI FUNKCJA - TO NADANIE TYPU
      IF(K.EQ.13 .OR. K.EQ.15) GO TO 1000
      NM=IPMEM(IDPAR+5)
      J=IFTYPE(NM)
      IPMEM(I-3) = J
      IPMEM(I-4) = IPMEM(IDPAR+6)
      K=IPMEM(I-5)
      IPMEM(K-4) = IPMEM(I-4)
      IPMEM(K-3) = J
C   JESLI TO JEST TYP FORMALNY, TO POPRAWIAMY SLOWO ZEROWE
      IF(IAND(IPMEM(J),MTP).NE.6)  GO TO 1000
      IPMEM(I) = IOR(IPMEM(I),ISHFT(1,12))
      IPMEM(K) = IOR(IPMEM(K),ISHFT(1,12))
C   JESLI TYP FORMALNY JEST NIELOKALNY, TO ZLE DLA SYGNALU
      IF(LOCAL.EQ.2 .OR. .NOT.SYGN) GO TO 1000
      CALL MERR(361,NM)
 1000 CONTINUE
C   WYPISUJEMY INFORMACJE O PARAMETRACH II-GO RZEDU
C     K=IPMEM(I+3)
C     IF(IPMEM(I+4).EQ.0)RETURN
C     J=IPMEM(I+4)+K-1
C     DO 1111 II=K,J
C     I=IPMEM(II)
C     NM=ISHFT(IAND(IPMEM(I),MPAR),-4)
C     IF(NM.GE.4) GO TO 1112
C     CALL ffwrite(BO(2),"IDENTYFIKATOR =",17)
C     CALL ffwrint(BO(2),I)
C     CALL WRITEPR(I)
C     GO TO 1111
C1112 CALL WATTR(I)
C1111 CONTINUE
C  .  .  .
      RETURN
      END
	SUBROUTINE PROCF2
C
C  **  **  **  ** * * * * * * * * * * * * * * * * *
C   PRZETWARZA PROCEDURE/FUNKCJE FORMALNA II-GO RZEDU
C   PARAMETR DANY PRZEZ ZMIENNE Z BLOKU DWORK
C  * * * * * * * * * * * * * * * * * * * * * * *** *
C
	IMPLICIT INTEGER(A-Z)
C
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
C
      COMMON /DWORK/ IDPAR,LFORMB,LFORME,FORM2,SYGN
      LOGICAL FORM2, SYGN
C
C  *  *  *  *  *  *   *  *  *  *  *  *  *  *  *  *  *   *  *  *
C   IDPAR - INDEKS SLOWA ZEROWEGO BIEZACEGO PARAMETRU W ISMEM
C   LFORMB,LFORME - PIERWSZY I OSTATNI ELEMENT ROBOCZEJ LISTY PF
C   FORM2=TRUE, GDY PRZETWAEZAMY PARAMETRY II-GO RZEDU
C   SYGN = TRUE, GDY TO SA PARAMETRY SYGNALU
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
	LINE=IPMEM(IDPAR+1)
	NM=IPMEM(IDPAR+2)
C   DOLACZENIE DO LISTY PF ATRYBUTU DODATKOWEGO(BRAK)
C   UTWORZENIE PROTOTYPU
	K=IPMEM(IDPAR)+15
	I=INITPR(K,NM)
C   DOLACZENIE DO LISTY PF
	CALL PUTPF(I)
C   EWENTUALNIE TYP FUNKCJI - BRAK
       IF(K.EQ.18) RETURN
      IPMEM(I-3)=NRUNIV
	RETURN
	END
      SUBROUTINE VIRTCOM
C
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C   SPRAWDZA KOMPATYBILNOSC WIRTUALI

C   * * * * * * * * * * * * * * * * * ** * * * * * * * * * * *
C
      IMPLICIT INTEGER (A-Z)
      LOGICAL PARCOM,P
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO WYKRYWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
      COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
      LOGICAL FORM2,TPVI
C
C   ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
C  ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
C   NM - NAZWA WIRTUALA
C   INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
C   FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
C   TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
C   INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
C     FORMALNYCH
C
C
      TPVI=.FALSE.
      FORM2=.FALSE.
      INDV=IPMEM(INDPR+26)
      NM=IPMEM(INDSPR+10)
      LINE=IPMEM(INDSPR+9)
C   KONTROLA RODZAJOW WIRTUALI
      IRU=ISHFT(IAND(IPMEM(INDV),MOTHERS),-8)
      IRL=ISHFT(IAND(IPMEM(INDPR),MOTHERS),-8)
      IF (IRU.EQ.IRL) GO TO 50
C   BLAD RODZAJOW
      CALL MERR(331,NM)
C   JESLI TO SA FUNKCJE - TO SPRAWDZAMY TYPY
 50   IF(IRL.EQ.4 .OR. IRU.EQ.4) GO TO 100
      TPVI=.TRUE.
      CALL TYPECOM(INDV,INDPR)
      TPVI = .FALSE.
 100  I=IPMEM(INDPR+3)
      IL=IPMEM(INDPR+4)
C   DLA FUNKCJI TRZEBA POMINAC RESULT
      IF(IRL.EQ.2) IL=IL-1
      J=IPMEM(INDV+3)
      JU=IPMEM(INDV+4)
      IF(IRU.EQ.2) JU=JU-1
C  I,IL - POCZATEK I DLUGOSC LISTY PF DLA INDPR
C  J,JU - POCZATEK I DLUGOSC LISTY PF DLA INDV
      IF(IL+JU.EQ.0) GO TO 1000
      IF(IL.NE.JU) GO TO 800
C   ZGODNA LICZBA PARAMETROW
 200  IL=IL+I-1
      JU=JU+J-1
      NM=NEMPTY
C   SPRAWDZENIE ZGODNOSCI PARAMETROW
C   PROCEDURA PARCOM DAJE TRUE, GDY TRZEBA
C   DALEJ SPRAWDZAC ZGODNOSC PF II-GO RZEDU
C  (TZN. SA TO PROCEDURY/FUNKCJE)
 300  IF(.NOT.PARCOM(IPMEM(J),IPMEM(I))) GO TO 700
C   SPRAWDZAMY ZGODNOSC PF II-GO RZEDU
      FORM2=.TRUE.
      INDPR1=IPMEM(I)
      INDV1=IPMEM(J)
      IRL1=ISHFT(IAND(IPMEM(INDPR1),MOTHERS),-8)
      IRU1=ISHFT(IAND(IPMEM(INDV1),MOTHERS),-8)
      I1=IPMEM(INDPR1+3)
      IL1=IPMEM(INDPR1+4)
C   DLA FUNKCJI - POMIJAMY RESULT
      IF(IRL1.EQ.2) IL1 = IL1-1
      J1=IPMEM(INDV1+3)
      JU1=IPMEM(INDV1+4)
      IF(IRU1.EQ.2) JU1 = JU1-1
      IF(IL1+JU1.EQ.0) GO TO 600
      IF(IL1.NE.JU1) GO TO 500
 350  IL1=IL1+I1-1
      JU1=JU1+J1-1
C   SPRAWDZANIE ZGODNOSCI PARAMETROW II-GO RZEDU
 400  P=PARCOM(IPMEM(J1),IPMEM(I1))
      I1=I1+1
      J1=J1+1
      IF(I1.LE.IL1.AND.J1.LE.JU1) GO TO 400
      GO TO 600
C   NIEZGODNA LICZBA PARAMETROW
 500  CONTINUE
      IF(IL1.LT.JU1) GO TO 530
C   SPRAWDZAMY,CZY LISTA KROTSZA JEST BLEDNA
      IF(IAND(IPMEM(INDV1),MERPF).NE.0) GO TO 550
      CALL MERR(336,NM)
      GO TO 550
 530  IF(IAND(IPMEM(INDPR1),MERPF).NE.0) GO TO 550
      CALL MERR(336,NM)
 550  IF(IL1*JU1.NE.0) GO TO 350
 600  CONTINUE
C   KONIEC SPRAWDZANIA PARAMETROW II-GO RZEDU
      FORM2=.FALSE.
 700  I=I+1
      J=J+1
      IF(I.LE.IL.AND.J.LE.JU) GO TO 300
C   KONIEC PARAMETROW
      GO TO 1000
C  NIEZGODNA LICZBA PARAMETROW
 800  IF(IL.LT.JU) GO TO 850
      IF(IAND(IPMEM(INDV),MERPF).NE.0) GO TO 900
C   KROTSZA LISTA PF NIE JEST BLEDNA
      CALL MERR(333,NM)
      GO TO 900
 850  IF(IAND(IPMEM(INDPR),MERPF).NE.0) GO TO 900
      CALL MERR(333,NM)
 900  IF(IL*JU.NE.0) GO TO 200
C
 1000 CONTINUE
C   ZAKONCZENIE
      RETURN
      END
      LOGICAL FUNCTION PARCOM(PARU,PARL)
C
C  * * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * *
C   SPRAWDZA ZGODNOSCI PARAMETROW O IDENTYFIKATORACH PARU I PARL
C   PARCOM=.TRUE., GDY OBA PARAMETRY SA PROCEDURA LUB FUNKCJA
C   * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
      LOGICAL FORM2,TPVI
C
C   ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
C  ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
C   NM - NAZWA WIRTUALA
C   INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
C   FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
C   TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
C   INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
C     FORMALNYCH
C
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO ROZPOZNANIA BLEDNYCH LIST PF
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
      IDU=ISHFT(IAND(IPMEM(PARU),MPAR),-4)
      IDL=ISHFT(IAND(IPMEM(PARL),MPAR),-4)
      PARCOM=.FALSE.
C   .  .  .
C   KONTROLA RODZAJOW
      IF(IDU.EQ.IDL) GO TO 100
C   NIEZGODNE RODZAJE
      I=334
      IF (FORM2) I=337
      CALL MERR(I,NM)
C   JESLI OBA PARAMETRY SA ZMIENNYMI, TO KONTROLA TYPOW
 100  IF((IDU.EQ.5.OR.IDU.EQ.6.OR.IDU.EQ.9)
     * .AND. (IDL.EQ.5.OR.IDL.EQ.6.OR.IDL.EQ.9)) GO TO 300
      IF(IDU.NE.2.AND.IDU.NE.3 .OR. IDL.NE.2.AND.IDL.NE.3)
     *  RETURN
      PARCOM=.TRUE.
C   JESLI OBIE FUNKCJE I-GO RZEDU - TO KONTROLA TYPOW
      IF(IDU.NE.2.OR.IDL.NE.2) RETURN
      IF(FORM2) RETURN
C   KONTROLA TYPOW
 300  CALL TYPECOM(PARU,PARL)
      RETURN
      END
      SUBROUTINE TYPECOM (TPU,TPL)
C
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C   KONTROLA ZGODNOSCI TYPOW
C   TPU,TPL - IDENTYFIKATORY ZMIENNYCH(FUNKCJI)
C   TPVI=.TRUE., GDY TO SA TYPY FUNKCJI VIRTUALNYCH
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
      IMPLICIT INTEGER(A-Z)
      LOGICAL POMU,POML,BPREF
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )

C    MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
      COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
      LOGICAL FORM2,TPVI
C
C   ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
C  ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
C   NM - NAZWA WIRTUALA
C   INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
C   FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
C   TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
C   INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
C     FORMALNYCH
C
C
C
C  U - TYP WYZSZY
C   IARU,IARL - ILOSC ARRAY OF
C  ITU,ITL - IDENTYFIKATORY TYPOW
C   IDENU,IDNEL - WARTOSCI MTP ZE SLOWA ZEROWEGO TYPOW
      ITU=IPMEM(TPU-3)
      ITL=IPMEM(TPL-3)
      IARU=IPMEM(TPU-4)
      IARL=IPMEM(TPL-4)
C   JESLI TYPY SA IDENTYCZNE, TO DOBRZE
      IF(IARU.EQ.IARL.AND.ITL.EQ.ITU) RETURN
C   JESLI JEDEN Z TYPOW JEST UNIWERSALNY, TO DOBRZE
      IF(ITL.EQ.NRUNIV.OR.ITU.EQ.NRUNIV) RETURN
C   JESLI TYPY ROZNIA SIE TYLKO ARRAY OF , TO ZLE
      IF(IARU.NE.IARL.AND.ITL.EQ.ITU) GO TO 999
      IDENU=IAND(IPMEM(ITU),MTP)
      IDENL=IAND(IPMEM(ITL),MTP)
      IF(IDENU.EQ.6) GO TO 500
C   TYP WYZSZY NIE JEST FORMALNY
C   JESLI NIE ZGADZA SIE ARRAY OF , TO BLAD
      IF(IARU.NE.IARL) GO TO 999
C   JESLI SA TABLICOWE, TO MUSZA BYC ROWNE
      IF(IARU.NE.0.AND.ITU.NE.ITL) GO TO 999
C   JESLI JESZCZE SA TU TYPY PRYMITYWNE, TO BLAD(MUSZA BYC ROWNE)
      IF(IDENU.GE.8 .AND. IDENU.LT.13) GO TO 999
      IF(IDENL .GE. 8 .AND. IDENL .LT. 13) GO TO 999
      IF(ITU.EQ.NRCOR) GO TO 200
      IF(ITU.EQ.NRPROC) GO TO 300
C   TYP WYZSZY JEST KLASOWY
C   TYPY MAJA BYC W SEKWENCJI PREFIKSOWEJ
      IF(IDENL.EQ.6) GO TO 999
      I=IPMEM(ITU-6)
      J=IPMEM(ITL-6 )
      IF(BPREF(ITL,I)) RETURN
      IF(TPVI) GO TO 999
      IF(BPREF(ITU,J)) RETURN
      GO TO 999
C   WYZSZY - SAMA COROUTINA
 200  IF(IDENL.EQ.5 .OR. IDENL.EQ.7) RETURN
      IF(BPREF(ITL,IPMEM(NRCOR-6))) RETURN
      IF(BPREF(ITL,IPMEM(NRPROC-6))) RETURN
      GO TO 999
C   WYZSZY - SAM PROCESS
 300  IF(IDENL.EQ.5) RETURN
      IF(BPREF(ITL,IPMEM(NRPROC-6))) RETURN
      GO TO 999
C
C   WYZSZY - TYP FORMALNY
 500  CONTINUE
      I=NRPAR(ITU,.TRUE.)
      J=NRPAR(ITL,.FALSE.)
C   I,J - NUMERY TYPOW W LISCIE INDV(INDPR)
C   JESLI TO SA PARAMETRY II-GO RZEDU, TO TAKZE
C   W LISCIE PF INDV1(INDPR1)
      IF(I+J.EQ.0) GO TO 700
      IF(I.NE.J) GO TO 999
      IF(IARU.NE.IARL) GO TO 999
C   TRZEBA SPARWDZIC, CZY OBA TYPY SA PARAMETRAMI
C    TEGO SAMEGO RZEDU
      I=IPMEM(ITU-1)
      J=IPMEM(ITL-1)
C  I,J - SLE
      POMU=IAND(IPMEM(I),MPAR).NE.0
      POML=IAND(IPMEM(J),MPAR).NE.0
      IF(POMU.AND.POML.OR..NOT.(POMU.OR.POML))RETURN
      GO TO 999
C
C   TO NIE JEST WLASNY PARAMETR
 700  CONTINUE
      IF(IARU.NE.0) GO TO 800
C  JESLI WYZSZY NIE JEST TABLICOWY, TO ZLE, GDY
C   NIZSZY JEST PRYMITYWNY NIETABLICOWY
      IF(IARL.NE.0) RETURN
      IF(IDENL.GE.8.AND.IDENL.LT.13) GO TO 999
      RETURN
C   WYZSZY JEST TYPEM TABLICOWYM
 800  IF(IDENL.EQ.6) RETURN
      IF(IARU.LE.IARL) RETURN
C  SYGNALIZACJA BLEDOW
 999  I=335
      IF (TPVI) I=332
      IF(FORM2) I=338
      CALL MERR(I,NM)
      RETURN
      END
      INTEGER FUNCTION NRPAR(IDT,UP)
C
C  * * * * * * *** * * * * * * * * * * * * * * * * * * * * *
C   SPRAWDZA,CZY TYP IDT JEST PARAMETREM INDPR(INDV)
C   UP=.TRUE. - CHODZI O WIRTUAL WYZSZY (INDV)
C   NRPAR - NUMER IDT JAKO PARAMETRU ( LUB 0)
C   JESLI FORM2=.TRUE., TO  BADA TEZ, CZY TYP JEST PARAMETREM/
C   INDV1(ODP. INDPR1)
C   * * * * * * * * * * * * * * * * * * * * * * * * * ** * * *
C
      IMPLICIT INTEGER(A-Z)
      LOGICAL UP,BPREF
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
      COMMON /DWV/ NM,INDV,FORM2,TPVI,INDPR1,INDV1
      LOGICAL FORM2,TPVI
C
C   ** ** ** ** ** ** ** ** ** ** *** ** ** ** ** ** **
C  ROBOCZY BLOK DO KOMPATYBILNOSCI VIRTUALI
C   NM - NAZWA WIRTUALA
C   INDV - IDENTYFIKATOR WYZSZEGO VIRTUALA
C   FORM2 - TRUE, GDY PRZETWARZAMY PF II-GO RZEDU
C   TPVI - GDY CHODZI O TYP FUNKCJI WIRTUALNEJ
C   INDPR1,INDV1 - IDENTYFIKATORY PRZETWARZANYCH PROCEDUR/FUNKCJI
C     FORMALNYCH
C
C
C
C
      NRPAR=0
C   JESLI TYP NIE JEST FORMALNY, TO KONIEC
      I=IAND(IPMEM(IDT),MTP)
      IF(I.NE.6) RETURN
C  IND - TU SZUKAMY PARAMETRU
      IF(FORM2) GO TO 500
 300  IND=INDPR
      IF(UP) IND=INDV
      IS=IPMEM(IDT-1)
C   IS - SL TYPU
C   SPRAWDZAMY, CZY I=IND LUB JEGO PREFIKS
      IF(IS.EQ.IND) GO TO 100
C   JESLI IS NIE JEST KLASA, TO KONIEC
      IF(IAND(IPMEM(IS),MTP).EQ.1) RETURN
      IF(.NOT.BPREF(IND,IPMEM(IS-6))) RETURN
C   TO JEST PARAMETR
 100  I=IPMEM(IND+3)
 200  NRPAR=NRPAR+1
      IF(IPMEM(I).EQ.IDT) RETURN
      I=I+1
      GO TO 200
C   SZUKAMY W LISCIE II-GO RZEDU
 500  IND=INDPR1
      IF(UP) IND=INDV1
      IF(IS.NE.IND) GO TO 300
      GO TO 100
      END
      SUBROUTINE SIGNAL ( IDSIG )
C
      IMPLICIT INTEGER (A-Z)
C
C  * * * * * * ** * * * * * * * * * * ** * * * * * * * * * * * * * * * * *
C   PRZETWARZA SYGNAL O IDENTYFIKATORZE ( SYNTAKTYCZNYM ) IDSIG
C    TWORZY DLA NIEGO KOMPLETNY PROTOTYP
C  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
cdsw  COMMON /SIGNALS/ NRSIG, HLISTE
cdsw   -----------------------------------------------------
      common /signs/ nrsig, hliste
cdsw   -----------------------------------------------------
C
C   NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
C   HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C  . . .
C
C   NRPR - NUMER PROTOTYPU SEMANTYCZNEGO
      NRPR = IPMEM(IDSIG)
      NM = IPMEM(IDSIG+2)
      LINE = IPMEM(IDSIG+1)
C   USTAWIENIE BITU CLOSE
      I = MEMSL (NM, INDPR )
      IPMEM(I+1) = 1
C   PRZYDZIELENIE NUMERU SYGNALU
      NRSIG = NRSIG+1
      IPMEM(NRPR+1) = NRSIG
C   ZAPAMIETANIE SYNTAKTYCZNEJ LISTY PARAMETROW W PROTOTYIE SYGNALU (KONTROLA)
      IPMEM(NRPR+8) = IPMEM(IDSIG+4)
C
C   PRZETWARZANIE NAGLOWKA
C   ZAPAMIETANIE KOPII ZMIENNYZCH OKRESLAJACYCH PRZETWARZANY PROTOTYP
      INDC = INDSPR
      INDPRC = INDPR
      PREFC = INDPREF
      IHBEGC = IHBEG
C   NADANIE NOWYCH WARTOSCI
      INDPR = NRPR
      INDSPR = IDSIG
      IHBEG = INDPR+10
      INDPREF = 0
C   PRZETWARZANIE NAGLOWKA
      CALL HEADER
C   PRZYWROCENIE WARTOSCI ZMIENNYM
      INDPR = INDPRC
      INDSPR = INDC
      IHBEG = IHBEGC
      INDPREF = PREFC
C  .  .  .
      RETURN
      END
      SUBROUTINE HANDLER ( IDSMEM )
C
      IMPLICIT INTEGER ( A-Z )
C     INSERTION OF
      LOGICAL BTEST
C     BECAUSE OF TYPECONFLICT 03.01.84
C
C   ** * * * * ** * * * * * * * * * ** * * * * * ** ** ** * ** * * *** * **
C   PRZETWARZA PROTOTYP HANDLERA
C   IDSMEM - IDENTYFIKATOR PROTOTYPU SYNTAKTYCZNEGO
C   * * * * * * * * * * * * * * * * *** * * * * * * * * * *** * * * * * *
C
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
cdsw  COMMON /SIGNALS/ NRSIG, HLISTE
cdsw  ----------------------------------------------------------
      common /signs/ nrsig, hliste
cdsw  ----------------------------------------------------------
C
C   NRSIG - OSTATNIO PRZYDZIELONY NUMER SYGNALU
C   HLISTE - OSTATNI ELEMENT LISTY SYGNALOW (W KAZDYM MODULE )
C
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C    MNOTVIR - WZORZEC DO KASOWANIA BITU "VIRTUAL"
C
C
      COMMON /COPSIG/ BEGADR, IDHAND
C
C   BLOK SLUZACY DO KOMUNIKACJI Z PROCEDURA KOPIUJACA POSZCZEGOLNE PROTOTYPY
C   IDHAND - IDENTYFIKATOR HANDLERA
C   BEGADR - PIERWSZY ELEMENT SLOWNIKA ZAMIANY STARYCH ADRESOW NA NOWE
C    KAZDY ELEMENT SLOWNIKA ZAJMUJE 2 SLOWA: STARY ADRES, NOWY ADRES.
C    OSTATNI ELEMENT SLOWNIKA - LPML-2
C
C
C.....BLOK KOMUNIKACJI ZE STRUMIENIAMI
      LOGICAL  ERRFLG
      COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
C
C
C
      IDHAND = IPMEM(IDSMEM+1)
      LINE = IPMEM(IDSMEM+9)
C
C   PRZEJSCIE PO LISCIE NAZW SYGNALOW
C   ODNALEZIENIE SYGNALOW, SPRAWDZENIE ICH POPRAWNOSCI, UTWORZENIE LISTY
C     HANDLEROW
C   LS - KOLEJNY ELEMENT LISTY
C   POR - ELEMENT LISTY Z KTORYM BEDZIEMY POROWNYWAC
C     NAGLOWKI KOLEJNYCH SYGNALOW
      LS = IPMEM(IDSMEM+10)
      I = 0
      IF(LS.EQ.0) GO TO 810
C   TO NIE JEST HANDLER OTHERS
      POR = LS
 50   NM = IPMEM(LS)
C   .  .  .
      I = MEMSL(NM, INDPR)
      IF (I.EQ.0) GO TO 100
      IF ( BTEST(IPMEM(I+1),2)) GO TO 150
      IF ( .NOT. BTEST(IPMEM(I+1),1) .OR. OWN ) GO TO 300
C   NAZWA JEST HIDDEN
      CALL MERR(351,NM)
      GO TO 200
C   NAZWA JEST NOT TAKEN
 150  CALL MERR (352, NM)
      GO TO 200
C   NAZWA NIEZADEKLAROWANA
 100  CALL MERR (350, NM)
C   JESLI TO JEST ELEMENT, Z KTORYM MAMY POROWNYWAC, TO GO PRZESUWAMY
 200  IF(POR.EQ.LS) POR = IPMEM(LS+1)
      GO TO 1000
C
C    NAZWA JEST ZADEKLAROWANA
C    SPRAWDZAMY, CZY TO JEST NAZWA SYGNALU
 300  IDSIG = IPMEM(I+2)
      J = IPMEM(IDSIG)
      J = ISHFT(IAND(J,MPAR),-4)
      IF(J.NE.11) GO TO 250
C   TO JEST PROTOTYP SYGNALU
C   JESLI TO JEST PIERWSZY, TO PRZECHODZIMY DO NASTEPNEGO
      IF(LS.EQ.IPMEM(IDSMEM+10)) GO TO 800
      IF(LS.EQ.POR) GO TO 800
C   SPRAWDZAMY ZGODNOSC PARAMETROW
      IF(IAND(IPMEM(IDSIG),MERPF).NE.0) GO TO 400
C   JESLI LS MA DOBRA LISTE PARAMETROW, A POR ZLA - TO ZMIENIAMY POR
      J = IPMEM(POR)
      IF(IAND(IPMEM(J),MERPF).EQ.0) GO TO 400
      POR = LS
      GO TO 800
C     TO NIE JEST PROTOTYP SYGNALU
 250  CALL MERR ( 353,NM )
      GO TO 200
C
C   SPRAWDZAMY ZGODNOSC LISTY PARAMETROW
 400  CALL SPRPAR ( IDSIG, IPMEM(POR), NM)
C     DOLACZAMY DO LISTY HANDLEROW
 800  I = IPMEM(IDSIG+1)
C   SPRAWDZAMY, CZY HANDLER SI NIE POWTARZA
 810   IF(HLISTE.EQ.0) GO TO 830
      J=IPMEM(INDPR+20)
 820  IF(IPMEM(J).NE.I) GO TO 840
      CALL MERR(362,NM)
      GO TO 950
 840  J=IPMEM(J+2)
      IF(J.NE.0) GO TO 820
 830  J = MGETM(3,341)
      IPMEM(J) = I
      IPMEM(J+1) = IDHAND
C   .  .  .
      IF(HLISTE.EQ.0) GO TO 850
      IPMEM(HLISTE+2)=J
      GO TO 900
 850  IPMEM(INDPR+20) = J
 900  HLISTE = J
      IPMEM(INDPR+19) = IPMEM(INDPR+19) + 1
C   JESLI HANDLER OTHERS, TO KONIEC
      IF(I.EQ.0) RETURN
C   ZAPAMIETUJEMY IDENTYFIKATOR PROTOTYPU W POLU NAZWY
 950  IPMEM(LS) = IDSIG
 1000 LS = IPMEM(LS+1)
      IF(LS.NE.0) GO TO 50
C
C   KOPIOWANIE ATRYBUTOW
C    POR - Z TEGO SIE KOPIUJE DO HANDLERA
C    POR = 0  -  NIE BYLO ANI JEDNEGO POPRAWNEGO SYGNALU
      IF(POR.EQ.0) RETURN
      BEGADR = LPML
      IDSIG = IPMEM(POR)
C   WSTAWIENIE DO HANDLERA DOWIAZANIA DO SYGNALU
      IPMEM(IDHAND+3) = IDSIG
C
C   KOPIOWANIE LISTY ATRYBUTOW RAZEM Z KOPIOWANIEM PROTOTYPOW
      I = IPMEM(IDSIG+6)
      J = IDHAND+5
C   I - KOLEJNY ELEMENT LISTY ATRYBUTOW PROTOTYPU IDSIG
C   J - OSTATNIO SKOPIOWANY ELEMENT LISTY PROTOTYPU IDHAND
      IF(I.EQ.0) RETURN
 1100 IPMEM(J+1) = MGETM(2,341)
      J = IPMEM(J+1)
      IPMEM(J) = ICPROT(IPMEM(I))
      I = IPMEM(I+1)
      IF(I.NE.0) GO TO 1100
C   USTAWIENIE OSTATNIEGO ATRYBUTU PROTOTYPU IDHAND
      IPMEM(IDHAND+7) = J
C
C   KOPIOWANIE TABLICY HASH'U
      LPML = LPML-2
C   LPML - OSTATNI ELEMENT SLOWNIKA ZAMIANY ADRESOW
      IHSIG = IDSIG+9
      IHHAND = IDHAND+9
C
      DO 1500 I=1,8
C   I - KOLEJNY ELEMENT TABLICY HASH'U PROTOTYPU IDSIG
      J = IHSIG+I
      J = IPMEM(J)
C   J - KOLEJNY ELEMENT LISTY HASH'U PROTOTYPU IDSIG
      IF(J.EQ.0) GO TO 1500
      K = IHHAND+I-3
C   K - OSTATNIO SKOPIOWANY ELEMENT LISTY HASH'U PROTOTYPU IDHAND
 1200 IPMEM(K+3) = MGETM(4,341)
      K = IPMEM(K+3)
      IPMEM(K) = IPMEM(J)
      IPMEM(K+1) = IPMEM(J+1)
C   SZUKANIE ODPOWIEDNIEGO ADRESU
      II = IPMEM(J+2)
      DO 1300 IJ = BEGADR, LPML, 2
      IF(IPMEM(IJ).EQ.II) GO TO 1400
 1300 CONTINUE
 1400 IPMEM(K+2) = IPMEM(IJ+1)
      J = IPMEM(J+3)
      IF(J.NE.0) GO TO 1200
 1500 CONTINUE
C
C   KONIEC KOPIOWANIA - ZWALNIAMY PAMIEC PRZEZNACZONA NA SLOWNIK
      LPML = BEGADR
      RETURN
      END
      SUBROUTINE SPRPAR ( EL, ELPOR, NM )
C
C   * * * * * * * * * ** * * * * ** * * * * * * * * * * * * * * * * * * * *
C    POROWNUJE LISTY PARAMETROW SYGNALU O IDENTYFIKATORZE EL I SYGNALU
C    O ODENTYFIKATORZE ELPOR
C     ELPOR - WZORCOWY SYGNAL DO POOWNYWANIA
C    NM - NAZWA SYGNALU EL
C     * * * * * * * * * * * * **** * * * * * ** * * * ** * * * * * * ** ***
C
      IMPLICIT INTEGER ( A - Z )
C
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK, MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C    MNOTVIR - WZORZEC DO KASOWANIA BITU "VIRTUAL"
C
C
C
C    LISTE - LISTA PARAMETROW ( SYNTAKTYCZNA! ) SYGNALU EL
C    LPOR - LISTA PARAMETROW SYGNALU ELPOR
C    LISTY SA PRZECHOWANE W SLOWIE +8 PROTOTYPU SYGNALU
C
      LISTE = IPMEM(EL+8)
      LPOR = IPMEM(ELPOR+8)
 50   IF ( LISTE + LPOR .EQ.0 ) RETURN
      IF ( LISTE*LPOR.EQ.0) GO TO 900
C   POROWNYWANIE
      KIND = IPMEM(LPOR)
      KD = IPMEM(LISTE)
      NMP = IPMEM(LISTE+2)
C   NMP - NAZWA PARAMETRU LISTE
C  KONTROLA RODZAJOW
      IF(KD.EQ.KIND) GO TO 70
C   MOZE SA NIEZGODNE RODZAJE
      IF ( KIND.GE.7 .OR. KD.GE.7 ) GO TO 100
C   SPRAWDZAMY, CZY RODZAJE SA ZGODNE Z DOKLADNOSCIA DO BLEDNYCH LIST PF
      IF(IABS(KIND-KD).NE.2) GO TO 100
C    KONTROLA NAZW
 70   IF ( NMP.NE.IPMEM(LPOR+2) ) GO TO 200
      IF (KIND.LE.6) GO TO 300
      IF (KIND.EQ.7) GO TO 400
C   ZMIENNE - POROWNUJEMY TYPY
      IF(IPMEM(LISTE+4).NE.IPMEM(LPOR+4)) GO TO 250
      IF(IPMEM(LISTE+5).NE.IPMEM(LPOR+5)) GO TO 250
C   NIE MA BLEDU - NASTEPNY ELEMENT LISTY
 400  LISTE = IPMEM(LISTE+3)
      LPOR = IPMEM(LPOR+3)
      GO TO 50
C
C   NIEZGODNE RODZAJE
 100  CALL MERR (355,NMP)
      GO TO 400
C   ROZNE NAZWY
 200  CALL MERR (356,NMP)
      GO TO 400
C   ROZNE TYPY
 250  CALL MERR(354,NMP)
      GO TO 400
C
C   PROCEDURY/FUNKCJE
C   SPRAWDZAMY PARAMETRY II-GO RZEDU
 300  I = IPMEM(LISTE+4)
      K = IPMEM(LPOR+4)
C   I - ELEMENTY LISTY II-GO RZEDU  PARAMETRU LISTE
C   K - ELEMENTY LISTY II-GO RZEDU PARAMETRU LPOR
 350  IF ( I+K.EQ.0) GO TO 800
      IF ( I*K.EQ.0 ) GO TO 700
C   KONTROLA
      IF ( IPMEM(I).NE.IPMEM(K) ) GO TO 500
C   NIE KONTROLUJE SIE NAZW
      IF ( IPMEM(I).LE.7 ) GO TO 600
C   KONTROLA TYPOW
      IF ( IPMEM(I+4).NE.IPMEM(K+4) ) GO TO 550
      IF ( IPMEM(I+5).NE.IPMEM(K+5) ) GO TO 550
C   NIE MA BLEDOW
 600  I = IPMEM(I+3)
      K = IPMEM(K+3)
      GO TO 350
C   NIEZGODNE RODZAJE
 500  CALL MERR ( 357,IPMEM(I+2) )
      GO TO 600
C   ROZNE TYPY
 550  CALL MERR ( 358, IPMEM(I+2) )
      GO TO 600
C   ROZNE DLUGOSCI LIST PARAMETROW II-GO RZEDU
C   JESLI KROTSZA LISTA JEST BLEDNA, TO NIE MA SYGNALIZACJI
 700  IF ( I.EQ.0 ) GO TO 750
C  K - KROTSZA
      KD = IPMEM(LPOR)
 710   IF ( KD.EQ.5.OR.KD.EQ.6) GO TO 800
       CALL MERR(359,NMP)
      GO TO 800
 750  KD = IPMEM(LISTE)
      GO TO 710
C
C   KONIE LIST II-GO RZEDU
C   KONTROLA TYPOW - JESLI FUNKCJE
 800  IF ( KIND.EQ.3 .OR. KIND.EQ.5 ) GO TO 400
      IF(IPMEM(LISTE+5).NE.IPMEM(LPOR+5)) GO TO 250
      IF(IPMEM(LISTE+6).NE.IPMEM(LPOR+6)) GO TO 250
      GO TO 400
C
C   NIEZGODNE DLUGOSCI LIST PARAMETROW I-GO RZEDU
C   JESLI LISTA KROTSZA JEST BLEDNA, TO NIE MA SYGNALIZACJI
 900  IF ( LISTE.EQ.0 ) GO TO 950
      IF(IAND(IPMEM(ELPOR),MERPF).EQ.0) CALL MERR(360,NM)
      RETURN
 950  IF(IAND(IPMEM(EL),MERPF).EQ.0) CALL MERR(360,NM)
       RETURN
      END
       INTEGER FUNCTION ICPROT ( IDPR )
C
C  ** * * * * * * * ** *** ** * * * * * * * * * * ** * * * * * * *
C    KOPIUJE PROTOTYP IDPR ( PROTOTYP PARAMETRU FORMALNEGO).
C    UAKTUALNIA SLOWNIK ZAMIANY ADRESOW PROTOTYPOW.
C    WYNIKIEM FUNKCJI JEST IDENTYFIKATOR UTWORZONEGO PROTOTYPU.
C   * * * * * * * * * ** * * * * * * * * * ** * * * * * * * * * * *
C
      IMPLICIT INTEGER ( A - Z )
C
C
C ..... ZMIENNE GLOBALNE
C
C.....
      LOGICAL  INSYS,  OWN
      COMMON /BLANK/ COM(278),
     X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X        LOCAL , OWN   , OBJECT,
     X        IPMEM(5000)
C
C             COM    - OBSZAR KOMUNIKACYJNY STRUMIENI
C             LMEM   - (=5000) ROZMIAR CALEJ PAMIECI GLOWNEJ
C             LPMEM  - PODZIAL PAMIECI NA CZESCI  IPMEM  I  ISMEM
C             IRECN  - INDEKS SZCZYTU STOSU STALYCH REAL
C             ISFIN  - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
C
C             LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
C                      NACZONEGO NA PROTOTYPY SYSTEMOWE
C             LPML   - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
C             LPMF   - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
C
C
C
      COMMON / DGLOB/ INDICT,INDSPR,INDPR,IHBEG,LASTPR,INDPREF
C
C  **  **  **  **  ***  **  **  **  **  **  **  **  **  **  **  **  **
C    BLOK ZAWIERA DANE O PRZETWARZANYM PROTOTYPIE
C        INDICT  -  INDEKS PRZETWARZANEGO PROTTYPU W ISDICT
C        INDSPR  -  IDENTYFIKATOR PROTOTYPU W ISMEM
C        INDPR  -  IDENTYFIKATOR PROTOTYPU W IPMEM
C        IHBEG  -  ADRES PIERWSZEGO SLOWA TABLICY HASHU
C        IDPREF  -  IDENTYFIKATOR BEZPOSREDNIEGO PREFIKSU PRZETWARZANEGO
C                  PROTOTYPU
C        LASTPR  -  IDENTYFIKATOR POPRZEDNIO PRZETWARZANEGO PROTOTYPU
C
C
C
      COMMON  / MASKS /  MTP,MSPR,MOTHERS,MPAR,MASKTP,NOTTP,
     * MPROCES, MCOR, MERPF, MBLOCK,MHAND,MNOTVIR
C
C  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **  **
C   MASKI I WZORCE:
C    MTP - MASKA DO WYCINANIA INFORMACJI DOTYCZACYCH TYPOW ZE SLOWA ZEROWEGO
C    MOTHERS -      --     --      --      --     --  INNYCH PROTOTYPOW
C    MPAR -    --    --    --    --    --    --       ZMIENNYCH I PARAMETROW
C    MSPR - MASKA DLA SYSPREF  ( DLA PROTOTYPOW SYNTAKTYCZNYCH )
C    MASKTP - ZAPRZECZENIE MASKI  MTP
C    NOTTP - WZORZEC DLA NIE-TYPU  ( 1 )
C    MPROCES - WZORZEC DLA PROCESU  ( 5 )
C    MCOR - WZORZEC DLA COROUTINY (7)
C    MERPF - MASKA DO ROZPOZNAWANIA BLEDNYCH LIST PARAMETROW
C    MBLOCK - WZORZEC DLA BLOKU  ( 0 PRZY PRZECIECIU Z  MOTHERS )
C
C
C
      COMMON /COPSIG/ BEGADR, IDHAND
C
C   BLOK SLUZACY DO KOMUNIKACJI Z PROCEDURA KOPIUJACA POSZCZEGOLNE PROTOTYPY
C   IDHAND - IDENTYFIKATOR HANDLERA
C   BEGADR - PIERWSZY ELEMENT SLOWNIKA ZAMIANY STARYCH ADRESOW NA NOWE
C    KAZDY ELEMENT SLOWNIKA ZAJMUJE 2 SLOWA: STARY ADRES, NOWY ADRES.
C    OSTATNI ELEMENT SLOWNIKA - LPML-2
C
C
C
      KIND = ISHFT ( IAND(IPMEM(IDPR),MPAR),-4)
      IF(KIND.GT.3) GO TO 400
      GO TO (100,200,300), KIND
C
C   TYP FORMALNY
 100  ICPROT = MGETM(5,341) + 2
C   DOLACZENIE DO LISTY NEXTDECL
      IPMEM(LASTPR+2) = ICPROT
      LASTPR = ICPROT
      GO TO 1000
C
C   FUNKCJA FORMALNA
 200  ICPROT = MGETM(10,341) + 5
      GO TO 500
C
C   PROCEDURA FORMALNA
 300  ICPROT = MGETM(7,341) + 2
C
C   KOPIOWAIE LISTY PARAMETROW II-GO RZEDU
 500  J = IPMEM(IDPR+4)
      IPMEM(ICPROT+3) = MGETM(J,341)
      IPMEM(ICPROT+4) = J
      IF(J.EQ.0) GO TO 1000
C
      DO 700 K=1,J
      II = IPMEM(IDPR+3) +K-1
      II = IPMEM(II)
C   II - IDENTYFIKATOR STAREGO PARAMETRU
C   I - ROZMIAR PROTOTYPU
      I = 6
      IJ=4
      KD=ISHFT(IAND(IPMEM(II),MPAR),-4)
      IF(KD.GT.4) GO TO 520
      IF(KD.EQ.2) GO TO 510
C   PROCEDURA LUB TYP
      I=5
      IJ=2
      GO TO 520
 510  I=7
C   IJ - IDENTYFIKATOR NOWEGO PROTOTYPU
 520  IJ = MGETM(I,341) + IJ
      IPMEM(IJ) = IPMEM(II)
      IPMEM(IJ-1) = ICPROT
      IPMEM(IJ-2) = IPMEM(II-2)
      IPMEM(IJ+1) = IPMEM(II+1)
      IF(KD.LT.5) GO TO  650
C   DLA ZMIENNEJ - WPISANIE TYPU
 550  I = IPMEM(II-3)
      IPMEM(IJ-4) = IPMEM(II-4)
      IPMEM(IJ-3) = I
C  SPRAWDZENIE, CZY JEST TO FORMALNY TYP LOKALNY
      I2 = LPML-2
      IF(I2.LT.BEGADR) GO TO 690
      DO 600 I1 = BEGADR,I2,2
      IF(IPMEM(I1).EQ.I) GO TO 610
 600  CONTINUE
C   NIE MA TYPU
      GO TO 690
 610  IPMEM(IJ-3) = IPMEM(I1+1)
      GO TO 690
C   DOLOZENIE ADRESU DO SLOWNIKA ( DLA ZMIENNEJ NIE WARTO )
 650  INSYS = .TRUE.
      I1 = MGETM(2,341)
      IPMEM(I1) = II
      IPMEM(I1+1) = IJ
      INSYS = .FALSE.
C   WSTAWIENIE ADRESU PROTOTYPU DO LISTY PARAMETROW
 690  I1 = IPMEM(ICPROT+3) +K-1
      IPMEM(I1) = IJ
 700  CONTINUE
C
      IF(KIND.EQ.3) GO TO 1000
C   FUNKCJA - USTAWIENIE IDENTYFIKATORA RESULT
      IPMEM(ICPROT-5) = IJ
      GO TO 800
C
C   ZMIENNE
 400  ICPROT = MGETM(6,341) + 4
C   KOPIOWANIE TYPU ZMIENNEJ LUB FUNKCJI
 800  IPMEM(ICPROT-4) = IPMEM(IDPR-4)
      I = IPMEM(IDPR-3)
      IPMEM(ICPROT-3) = I
C   SPRAWDZAMY, CZY TO JET TYP FORMALNY LOKALNY
      K = LPML-2
      IF(K.LT.BEGADR) GO TO 1000
C   JEST NIEPUSTY SLOWNIK ZAMIANY ADRESOW
      DO  820 J=BEGADR, K,2
      IF(IPMEM(J).EQ.I) GO TO 850
 820  CONTINUE
C   NIE MA TAKIEGO TYPU
      GO TO 870
 850  IPMEM(ICPROT-3) = IPMEM(J+1)
C   JESLI ZMIENNA TO NIE WSTAWIAMY DO NEXTDECL
 870  IF(KIND.GE.5) GO TO 1000
C   DLA FUNKCJI - WSTAWIENIE TYPU DO ATRYBUTU RESULT
      K = IPMEM(ICPROT-5)
      IPMEM(K-4) = IPMEM(ICPROT-4)
      IPMEM(K-3) = IPMEM(ICPROT-3)
C
C   UZUPELNIENIE SLOWA ZEROWEGO, ADRESU ATRUBUTU I USED
 1000 IPMEM(ICPROT-2) = IPMEM(IDPR-2)
      IPMEM(ICPROT-1) = IDHAND
      IPMEM(ICPROT)  = IPMEM(IDPR)
      IPMEM(ICPROT+1) = IPMEM(IDPR+1)
C
C   UZUPELNIENIE SLOWNIKA ZAMIANY ADRESOW
      INSYS = .TRUE.
      K = MGETM(2,341)
      IPMEM(K) = IDPR
      IPMEM(K+1) = ICPROT
      INSYS = .FALSE.
C
      RETURN
      END

