sources/pass1/it1.ff

   1 C    Loglan82 Compiler&Interpreter
   2 C     Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
   3 C     Copyright (C)  1993, 1994 LITA, Pau
   4 C
   5 C     This program is free software; you can redistribute it and/or modify
   6 C     it under the terms of the GNU General Public License as published by
   7 C     the Free Software Foundation; either version 2 of the License, or
   8 C     (at your option) any later version.
   9 C
  10 C     This program is distributed in the hope that it will be useful,
  11 C     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 C     GNU General Public License for more details. File: LICENSE.GNU
  14 C  ===============================================================
  15
  16       subroutine it1
  17 C--------------LACZNIK 1-------------------------------
  18 C             - PRZESYLA CZESC INFORMACJI ZE SCANNERA NA PLIKI
  19 C             - INICJUJE ZMIENNE DLA POTRZEB ANALIZY DEKLARACJI
  20 C               I POZNIEJSZYCH PRZEBIEGOW
  21 C             - SORTUJE TOPOLOGICZNIE DEKLARACJE TYPOW
  22 C
  23 C             OPIS W DOKUMENTACJI:       D.I.2
  24 C             WERSJA Z DNIA:             19.01.82
  25 C             DLUGOSC KODU:       116
  26 C...........................................................
  27 C
  28       IMPLICIT INTEGER  (A-Z)
  29 C     INSERTION OF
  30       LOGICAL BTEST
  31 C     BECAUSE OF TYPECONFLICT    03.01.84
  32 C+
  33 C-
  34 CALL STREAM
  35       LOGICAL  ERRFLG
  36       COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
  37 CALL BLANK
  38       LOGICAL  INSYS, OWN
  39       COMMON /BLANK/ COM(278),
  40      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
  41      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
  42      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
  43      X        LOCAL , OWN   , OBJECT,
  44      X        IPMEM(5000)
  45       integer*4 msg
  46       COMMON /MJLMSG/ IERC, MSG
  47 CALL #
  48       LOGICAL  SYSPP
  49 cdsw  COMMON /SYSPP/ SYSPP
  50       common /sysppc/ syspp
  51
  52
  53 cdeb ----------- added ----------------------
  54 c  new common blockfor the debugger
  55       common /debug/ deb,breakt(500),brnr,maxbr
  56       logical deb
  57 c  deb = true - compilation with the debugger
  58 c  breakt - array of static break points
  59 c  brnr - index in breakt
  60 c  maxbr - maximal number of static break points
  61 cdeb ----------------------------------------
  62
  63 C
  64 cdsw  DATA IDENT /4HIT1 /
  65 C
  66       IERC = 0
  67       MSG = 'it1 '
  68 C    ---ZBADANIE, CZY MA BYC DZIALANIE W OTOCZENIU SYSPP
  69       SYSPP = BTEST(COM(3), 14)
  70 C*********** SCIAGNIECIE BUFOROW PLIKOW
  71 C --- BUFFERS NEED NOT BE FETCHED IN THE 'ONE-OVERLAY' VERSION
  72 C     CALL  MGTBUF
  73       NEMPTY = 0
  74       CALL  APARS
  75 C*********** INICJALIZACJA ZMIENNYCH GLOBALNYCH
  76       IPMEM(ISFIN-8) = COM(2)
  77       LPMF = ISFIN -9
  78 C
  79       LPML = 1
  80       COM(4) = LPMEM
  81       INSYS = .TRUE.
  82 C*********** INICJALIZACJA PROTOTYPOW SYSTEMOWYCH
  83       CALL  INIT
  84 C*********** SORTOWANIE TOPOLOGICZNE TYPOW
  85       I = LPMEM
  86 C...........POBRANIE ELEMENTU ZE SLOWNIKA
  87   100 PROT = IPMEM(I)
  88 C     ... PROT - PROTOTYP, KTOREGO DEKLARACJE SA SORTOWANE
  89       IF (PROT.NE. 0)    CALL  TORD(PROT)
  90       I = I-1
  91       IF (I .GE. ISFIN)    GOTO  100
  92 C************ PRZESLANIE BUFOROW
  93 C --- BUFFERS NEED NOT BE SENT IN THE 'ONE-OVERLAY' VERSION
  94 C     CALL  MPTBUF
  95       CALL  MESS
  96       IF (SYSPP)    CALL  MPPMES
  97 cdeb      CALL DSW
  98 cdeb ------------- added ---------------
  99       if(deb.and..not.errflg) go to 1000
 100       call dsw
 101       return
 102 1000  call ts1
 103 cdeb -----------------------------------
 104       END
 105
 106
 107       SUBROUTINE  MPPMES
 108 C------------------DRUKUJE INFORMACJE O PRZYLACZENIU BIBLIOTEKI SYSPP
 109       IMPLICIT INTEGER(A-Z)
 110 CALL STREAM
 111 CALL #
 112       call ffputspaces(6,10)
 113       call ffputcs(6,'-- SYSPP LIBRARY ADDED')
 114       call ffputnl(6)
 115       RETURN
 116       END
 117
 118
 119       SUBROUTINE  APARS
 120 C---------------PRZESYLA TABLICE HASH-U SCANNERA NA STRUMIEN SC
 121 C               DO POCZATKOWYCH BLOKOW
 122 C
 123 C             OPIS W DOKUMENTACJI:         D.I.3
 124 C             WERSJA Z DNIA:               19.01.82
 125 C             DLUGOSC KODU:        338
 126 C.............................................................
 127       IMPLICIT INTEGER (A-Z)
 128 C
 129 CALL BLANK
 130       LOGICAL  INSYS, OWN
 131       COMMON /BLANK/ COM(278),
 132      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
 133      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
 134      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
 135      X        LOCAL , OWN   , OBJECT,
 136      x        hash(8000)
 137 cdsw X        IPMEM(5000)
 138 CALL STREAM
 139       LOGICAL  ERRFLG
 140       COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
 141
 142 CALL #
 143 C
 144 C------PRZEWINIECIE STRUMIENIA  SC
 145       CALL  SEEK(IBUF3, 0)
 146 C------PRZEPISANIE BLOKOW TWORZACYCH TABLICE HASH-U
 147 cdsw  ----------------------
 148 c  dodane przepisywanie tablicy hash2
 149       do 100 i=1,8000,256
 150       call put  (ibuf3,hash(i))
 151 100   continue
 152       RETURN
 153       END
 154       SUBROUTINE  INIT
 155 C--------------INICJALIZACJA PROTOTYPOW SYSTEMOWYCH
 156 C
 157 C             OPIS W DOKUMENTACJI:             D.I.4
 158 C             WERSJA Z DNIA:                   19.01.82
 159 C             DLUGOSC KODU:        1079
 160 C...............................................................
 161 C
 162       IMPLICIT INTEGER (A-Z)
 163 CALL BLANK
 164       LOGICAL  INSYS, OWN
 165       COMMON /BLANK/ COM(278),
 166      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
 167      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
 168      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
 169      X        LOCAL , OWN   , OBJECT,
 170      X        IPMEM(5000)
 171 CALL #
 172       logical btest
 173       LOGICAL  SYSPP
 174 cdsw  COMMON /SYSPP/ SYSPP
 175       common /sysppc/syspp
 176 C
 177 C.....NAZWY HASH-U ZE SCANNERA
 178 C#F
 179       COMMON /HNAMES/ INTNM, RENM, BOOLNM, CHRNM, CORNM,
 180      X           PROCNM, TEXTNM, FILENM
 181
 182 C
 183       common /option/opt
 184
 185       common /prefs/lprefs
 186 c  lprefs - ostatnio przydzielony numer w prefixset
 187
 188 c  grpref - numer prefiksu klasy IIUWGRAPH
 189 c  mousepref - numer prefiksu klasy MOUSE
 190
 191 c  system class prototypes:
 192       common /syspro/prgraph, prmouse
 193 c  prgraph - prototype of IIUWGRAPH
 194 c  prmouse - prototype of MOUSE
 195
 196 cdsw  DATA INTNM,RENM,BOOLNM,CHRNM,CORNM,PROCNM,TEXTNM,FILENM
 197 cdsw X /24,40,8,16,2919,2785,48,56/
 198 C NATTR - ATRYBUT "-1" (1 SLOWO, 2 DOMYSLNE)
 199 cdsw  DATA    INHEX1,INHEX2,INHEX3,INHEX4,INHEX5,INHEX6,INHEX7,INHEX8,
 200 cdsw XINHEX9,INHEX10,INHEX11,INHEX12,INHEX13,INHEX14,INHEX15,XX
 201 cdsw X/Z0008,Z8008,Z000A,Z000B,ZC007,ZC005,Z000C,Z0004,ZC00E,Z8051,
 202 cdsw X Z8061,Z0051,Z0061,ZC061,ZC051,Z0004/
 203 cdsw  --------------------------------------------------------------
 204 c    #8008 --> -#7ff8, #c007 --> -#3ff9, #c005 --> -#3ffb,
 205 c    #c00e --> -#3ff2, #8051 -->   -#7faf, #8061 -->  -#7f9f,
 206 c    #c061 --> -#3f9f, #c051 -->  -#3faf
 207       data inhex1,inhex2,inhex3,inhex4,inhex5,inhex6,inhex7,inhex8,
 208      * inhex9,inhx10,inhx11,inhx12,inhx13,inhx14,inhx15,xx
 209      */x'0008',-x'7ff8', x'000a',x'000b',
 210      *-x'3ff9',-x'3ffb', x'000c',x'0004',
 211      *-x'3ff2',-x'7faf',-x'7f9f',x'0051',
 212      * x'0061',-x'3f9f',-x'3faf',x'0004'/
 213 cdeb ------------------- added ----------------
 214       data inhx16, inhx17,inhx18 / x'0091', x'8091', x'c091' /
 215 cdeb ----------------------------------------
 216
 217       intnm=24
 218       renm=40
 219       boolnm = 8
 220       chrnm = 16
 221       cornm = 2919
 222       procnm = 2785
 223       textnm = 48
 224       filenm = 56
 225
 226 cdsw  ----------------------------------------------------------------
 227       NATTR = LPML+2
 228       IPMEM(LPML) = -1
 229       LPML = LPML+1
 230 C
 231 C NRINT
 232       NRINT = MGETM(3, 41)
 233       IPMEM(NRINT) = INHEX1
 234 C NRRE
 235       NRRE = MGETM(3,41)
 236       IPMEM(NRRE) = INHEX2
 237 C
 238 C NRBOOL
 239       NRBOOL = MGETM(3, 41)
 240       IPMEM(NRBOOL) = INHEX3
 241 C
 242 C NRCHR
 243       NRCHR = MGETM (3, 41)
 244       IPMEM(NRCHR) = INHEX3
 245 C#F
 246 C
 247 C NRFILE
 248         NRFILE = MGETM(3, 41)
 249         IPMEM(NRFILE) = INHEX4
 250 C
 251 C NRCOR
 252       NRCOR = MGETM(9, 41) + 7
 253       IPMEM(NRCOR) = INHEX5
 254 C         NUMER W ZBIORZE PREFIKSOW ORAZ SLOWO Z TEGO ZBIORU
 255       IPMEM(NRCOR-1) = 0
 256       CALL  MSETB(NRCOR, 0)
 257       CALL  MSETB(NRCOR, 2)
 258 C
 259 C NRPROC
 260       NRPROC = MGETM(9, 41) + 7
 261       IPMEM(NRPROC) = INHEX6
 262       IPMEM(NRPROC-6) = 1
 263       CALL  MSETB(NRPROC, 0)
 264       CALL  MSETB(NRPROC, 1)
 265       CALL  MSETB(NRPROC, 2)
 266 C
 267 C NRTEXT
 268       NRTEXT = MGETM(3, 41)
 269       IPMEM(NRTEXT) = INHEX7
 270 C
 271 C NRUNIV
 272       NRUNIV = MGETM(9, 41) + 7
 273       IPMEM(NRUNIV) = INHEX8
 274       IPMEM(NRUNIV-6) = 2
 275       IPMEM(NRUNIV-5) = XX
 276       IPMEM(NRUNIV-4) = XX
 277       IPMEM(NRUNIV-3) = XX
 278 C
 279 C NRNONE
 280       NRNONE = MGETM(9, 41) + 7
 281       IPMEM(NRNONE) = INHEX9
 282       IPMEM(NRNONE-6) = 2
 283       CALL  MSETB(NRNONE, 2)
 284 C
 285 cdsw
 286 c  stala intsize
 287       wrds1 = mgetm(6, 41)+4
 288       ipmem(wrds1-3) = nrint
 289       ipmem(wrds1+1) = 1
 290       ipmem(wrds1) = X'0081'
 291 #if ( WSIZE == 4 )
 292       i = 4
 293 #else
 294       i = 2
 295 #endif
 296       if( btest(opt,12) ) i = 4
 297       ipmem(wrds1-1) = i
 298 c  stala realsize
 299       wrds2 = mgetm(6, 41)+4
 300       ipmem(wrds2-3) = nrint
 301       ipmem(wrds2+1) = 1
 302       ipmem(wrds2) = X'0081'
 303       i = 4
 304       if( btest(opt,12) ) i = 8
 305       ipmem(wrds2-1) = i
 306
 307 C
 308 C......INICJALIZACJA BLOKU SYSTEMOWEGO
 309       NBLSYS = MGETM(21, 41) + 2
 310       IPMEM(NBLSYS) = 1
 311       IPMEM(NBLSYS+3) = 2
 312 C     USTAWIENIE SL DLA COROUTINE I PROCESS
 313       IPMEM(NRCOR-1) = NBLSYS
 314       IPMEM(NRPROC-1) = NBLSYS
 315
 316 C  inicjalizacja lprefs
 317       lprefs = 2
 318 C
 319 C......INICJALIZACJA FUNKCJI I PROCEDUR STANDARDOWYCH
 320 C   ...PARAMETRY - ICH OPISY
 321 C INPR - INPUT REAL
 322       INPR = MGETM(6,41)+4
 323       IPMEM(INPR-3) = NRRE
 324       IPMEM(INPR+1) = 1
 325       IPMEM(INPR) = INHX10
 326 C OUTPR - OUTPUT REAL (I RESULT)
 327       OUTPR = MGETM(6,41)+4
 328       IPMEM(OUTPR-3) = NRRE
 329       IPMEM(OUTPR+1) = 1
 330       IPMEM(OUTPR) = INHX11
 331 C INPI - INPUT INTEGER
 332       INPI = MGETM(6, 41) +4
 333       IPMEM(INPI-3) = NRINT
 334       IPMEM(INPI+1) = 1
 335       IPMEM(INPI) = INHX12
 336 C OUTPI - OUTPUT INTEGER (I RESULT)
 337       OUTPI = MGETM(6, 41) +4
 338       IPMEM(OUTPI-3) = NRINT
 339       IPMEM(OUTPI+1) = 1
 340       IPMEM(OUTPI) = INHX13
 341 C INPCH - INPUT CHARACTER
 342       INPCH = MGETM(6, 41) +4
 343       IPMEM(INPCH-3) = NRCHR
 344       IPMEM(INPCH+1) = 1
 345       IPMEM(INPCH) = INHX12
 346 C OUTPCH - OUTPUT CHARACTER (I RESULT)
 347       OUTPCH = MGETM(6, 41) +4
 348       IPMEM(OUTPCH-3) = NRCHR
 349       IPMEM(OUTPCH+1) = 1
 350       IPMEM(OUTPCH) = INHX13
 351 C OUTPB - OUTPUT BOOLEAN (I RESULT)
 352       OUTPB = MGETM(6, 41) +4
 353       IPMEM(OUTPB-3) = NRBOOL
 354       IPMEM(OUTPB+1) = 1
 355       IPMEM(OUTPB) = INHX13
 356 C OUTACH - OUTPUT ARRAYOF CHAR (I RESULT)
 357       OUTACH = MGETM(6, 41) +4
 358       IPMEM(OUTACH-4) = 1
 359       IPMEM(OUTACH-3) = NRCHR
 360       IPMEM(OUTACH+1) = 1
 361       IPMEM(OUTACH) = INHX14
 362 C#F  NOWE OPISY PARAMETROW DLA PLIKOW
 363 C INPF - INPUT FILE
 364       INPF = MGETM(6, 41) + 4
 365       IPMEM(INPF - 3) = NRFILE
 366       IPMEM(INPF+1) = 1
 367       IPMEM(INPF) = INHX15
 368 C INPTX - INPUT TEXT (=STRING)
 369       INPTX = MGETM(6, 41) + 4
 370       IPMEM(INPTX-3) = NRTEXT
 371       IPMEM(INPTX+1) = 1
 372       IPMEM(INPTX) = INHX12
 373 C INPARI - INPUT ARRAYOF INTEGER
 374       INPARI = MGETM(6, 41) + 4
 375       IPMEM(INPARI-4) = 1
 376       IPMEM(INPARI-3) = NRINT
 377       IPMEM(INPARI+1) = 1
 378       IPMEM(INPARI) = INHX15
 379 cdsw --------------- for exec---
 380 c inparch - input arrayof char
 381       inparch = mgetm(6,41)+4
 382       ipmem(inparch) = inhx15
 383       ipmem(inparch+1) = 1
 384       ipmem(inparch-3) = nrchr
 385       ipmem(inparch-4) = 1
 386 c
 387 c
 388 cdeb --------------- added ------------
 389 c  inoui - inout integer
 390       inoui = mgetm(6,41)+4
 391       ipmem(inoui-3) = nrint
 392       ipmem(inoui+1) = 1
 393       ipmem(inoui) = inhx16
 394
 395 c  inour - inout  real
 396       inour = mgetm(6,41)+4
 397       ipmem(inour-3) = nrre
 398       ipmem(inour+1) = 1
 399       ipmem(inour) = inhx17
 400
 401 c  inouari - inout arrayof integer
 402       inouari = mgetm(6,41)+4
 403       ipmem(inouari-4) = 1
 404       ipmem(inouari-3) = nrint
 405       ipmem(inouari+1) = 1
 406       ipmem(inouari) = inhx18
 407 cdeb -------------------------------
 408 C
 409 C   ...LISTY PARAMETROW FORMALNYCH
 410 C   FPL1 - (INPUT REAL): REAL
 411       FPL1 = MGETM(2, 41)
 412       IPMEM(FPL1) = INPR
 413       IPMEM(FPL1+1) = OUTPR
 414 C   FPL2 - (INPUT INTEGER, INPUT INTEGER, INPUT INTEGER): INTEGER
 415       FPL2 = MGETM(4, 41)
 416       IPMEM(FPL2) = INPI
 417       IPMEM(FPL2+1) = INPI
 418       IPMEM(FPL2+2) = INPI
 419       IPMEM(FPL2+3) = OUTPI
 420 C   FPL3 - (INPUT REAL): INTEGER
 421       FPL3 = MGETM(2, 41)
 422       IPMEM(FPL3) = INPR
 423       IPMEM(FPL3+1) = OUTPI
 424 C   FPL4 - :BOOLEAN
 425       FPL4 = MGETM(1, 41)
 426       IPMEM(FPL4) = OUTPB
 427 C
 428 C   FPL5 - (INPUT INTEGER): CHARACTER
 429       FPL5 = MGETM(2, 41)
 430       IPMEM(FPL5) = INPI
 431       IPMEM(FPL5+1) = OUTPCH
 432 C
 433 C   FPL6 - (INPUT CHARACTER): INTEGER
 434       FPL6 = MGETM(2, 41)
 435       IPMEM(FPL6) = INPCH
 436       IPMEM(FPL6+1) = OUTPI
 437 C
 438 C   FPL7 - (OUTPUT INTEGER, INTEGER, INTEGER)
 439       FPL7 = MGETM(3, 41)
 440       IPMEM(FPL7) = OUTPI
 441       IPMEM(FPL7+1) = OUTPI
 442       IPMEM(FPL7+2) = OUTPI
 443 C   FPL8 - (INPUT TEXT, OUTPUT ARRAY OF CHAR)
 444       FPL8 = MGETM(2, 41)
 445       IPMEM(FPL8) = INPTX
 446       IPMEM(FPL8+1) = OUTACH
 447 C#F  NOWE LISTY DLA PLIKOW
 448 C
 449 C   FPL9 - (INPUT FILE, INPUT INTEGER, INPUT ARRAYOF INTEGER)
 450       FPL9 = MGETM(3, 41)
 451       IPMEM(FPL9) = INPF
 452       IPMEM(FPL9+1) = INPI
 453       IPMEM(FPL9+2) = INPARI
 454 C
 455 C   FPL10 - (INPUT FILE, INPUT TEXT)
 456       FPL10 = MGETM(2, 41)
 457       IPMEM(FPL10) = INPF
 458       IPMEM(FPL10+1) = INPTX
 459
 460 cdeb ------------ added --------------
 461 c  fpl11 - (input integer, inout arrayof integer, integer,
 462 c                 arrayof integer, real, integer)
 463       fpl11 = mgetm(6,41)
 464       ipmem(fpl11) = inpi
 465       ipmem(fpl11+1) = inouari
 466       ipmem(fpl11+2) = inoui
 467       ipmem(fpl11+3) = inouari
 468       ipmem(fpl11+4) = inour
 469       ipmem(fpl11+5) = inoui
 470
 471 c  fpl12 - (input integer, inout integer, integer,arrayof integer)
 472       fpl12 = mgetm(4,41)
 473       ipmem(fpl12) = inpi
 474       ipmem(fpl12+1) = inoui
 475       ipmem(fpl12+2) = inoui
 476       ipmem(fpl12+3) = inouari
 477
 478 c  fpl18 - (input file,file)
 479       fpl18 = mgetm(2,41)
 480       ipmem(fpl18) = inpf
 481       ipmem(fpl18+1) = inpf
 482 cdeb --------------------------------
 483 cdsw ---------- for exec ------
 484 c  fpl13 - (input arrayof char, input arrayof char):integer
 485       fpl13 = mgetm(2,41)
 486       ipmem(fpl13) = inparch
 487       ipmem(fpl13+1) = outpi
 488 c fpl14 - input file, input integer, input integer
 489       fpl14 = mgetm(3,41)
 490       ipmem(fpl14) = inpf
 491       ipmem(fpl14+1) = inpi
 492       ipmem(fpl14+2) = inpi
 493 c fpl15 - input integer, input integer, input integer, input integer
 494       fpl15 = mgetm(4,41)
 495       ipmem(fpl15) = inpi
 496       ipmem(fpl15+1) = inpi
 497       ipmem(fpl15+2) = inpi
 498       ipmem(fpl15+3) = inpi
 499 c fpl16 - input file, output integer
 500       fpl16 = mgetm(2,41)
 501       ipmem(fpl16) = inpf
 502 #if ( WSIZE == 4 )
 503       ipmem(fpl16+1) = outpi
 504 #else
 505 CPS - pozycja w pliku : REAL ??? !
 506       ipmem(fpl16+1) = outpr
 507 #endif
 508
 509
 510 C   ...PROTOTYPY FUNKCJI STANDARDOWYCH I ICH WLACZENIE DO LISTY HASHU
 511 C INOT: FUNCTION(INPUT X: INTEGER) : INTEGER
 512       CALL  MSTAFP(2613, FPL2+2, 2, 0, NRINT, OUTPI, -1, nblsys)
 513 C IOR: FUNCTION (INPUT X: INTEGER INPUT Y: INTEGER): INTEGER
 514       CALL  MSTAFP(335, FPL2+1, 3, 0, NRINT, OUTPI, -2, nblsys)
 515 C IAND:  FUNCTION (INPUT X: INTEGER INPUT Y: INTEGER): INTEGER
 516       CALL  MSTAFP(307, FPL2+1, 3, 0, NRINT, OUTPI, -3, nblsys)
 517 C ISHFT: FUNCTION (INPUT X: INTEGER INPUT Y: INTEGER): INTEGER
 518       CALL  MSTAFP(2605, FPL2+1, 3, 0, NRINT, OUTPI, -4, nblsys)
 519 C EOF: FUNCTION: BOOLEAN
 520 cfile CALL  MSTAFP(1841, FPL4, 1, 0, NRBOOL, OUTPB, 39, nblsys)
 521 C ENTIER: FUNCTION (INPUT X: REAL): INTEGER
 522       CALL  MSTAFP(2589, FPL3, 2, 0, NRINT, OUTPI, 15, nblsys)
 523 C RANDOM: FUNCTION: REAL
 524       CALL  MSTAFP(2599, FPL1+1, 1, 0, NRRE, OUTPR, 12, nblsys)
 525 C TIME: FUNCTION: INTEGER
 526       CALL  MSTAFP(1731, FPL3+1, 1, 0, NRINT, OUTPI, 13, nblsys)
 527 C SQRT: FUNCTION (INPUT X: REAL): REAL
 528       CALL  MSTAFP(1619, FPL1, 2, 0, NRRE, OUTPR, 14, nblsys)
 529 C ROUND: FUNCTION (INPUT X: REAL): INTEGER
 530       CALL  MSTAFP(1487, FPL3, 2, 0, NRINT, OUTPI, 16, nblsys)
 531 C EOLN: FUNCTION: BOOLEAN
 532 cfile CALL  MSTAFP(2579, FPL4, 1, 0, NRBOOL, OUTPB, 74, nblsys)
 533 C ORD: FUNCTION(INPUT X: CHARACTER): INTEGER
 534       CALL  MSTAFP(2571, FPL6, 2, 0, NRINT, OUTPI, -5, nblsys)
 535 C CHR: FUNCTION(INPUT X: INTEGER): CHARACTER
 536       CALL  MSTAFP(2575, FPL5, 2, 0, NRCHR, OUTPCH, -6, nblsys)
 537 C SIN: FUNCTION(INPUT REAL): REAL
 538       CALL  MSTAFP(2563, FPL1, 2, 0, NRRE, OUTPR, 23, nblsys)
 539 C COS: FUNCTION(INPUT REAL): REAL
 540       CALL  MSTAFP(2559, FPL1, 2, 0, NRRE, OUTPR, 24, nblsys)
 541 C TAN: FUNCTION (INPUT REAL): REAL
 542       CALL  MSTAFP(2555, FPL1, 2, 0, NRRE, OUTPR, 25, nblsys)
 543 C EXP: FUNCTION (INPUT REAL): REAL
 544       CALL  MSTAFP(2551, FPL1, 2, 0, NRRE, OUTPR, 26, nblsys)
 545 C LN: FUNCTION (INPUT REAL): REAL
 546       CALL  MSTAFP(717, FPL1, 2, 0, NRRE, OUTPR, 27, nblsys)
 547 C ATAN: FUNCTION (INPUT REAL): REAL
 548       CALL  MSTAFP(2547, FPL1, 2, 0, NRRE, OUTPR, 28, nblsys)
 549 C IMIN: FUNCTION (INUT INTEGER, INPUT INTEGER): INTEGER
 550       CALL  MSTAFP(331, FPL2+1, 3, 0, NRINT, OUTPI, 19, nblsys)
 551 C IMIN3: FUNCTION (INPUT INTEGER, INPUT INTEGER, INPUT INTEGER): INTEGER
 552       CALL  MSTAFP(2521, FPL2, 4, 0, NRINT, OUTPI, 21, nblsys)
 553 C IMAX: FUNCTION (INPUT INTEGER, INPUT INTEGER): INTEGER
 554       CALL  MSTAFP(2515, FPL2+1, 3, 0, NRINT, OUTPI, 20, nblsys)
 555 C IMAX3: FUNCTION (INPUT INTEGER, INPUT INTEGER, INPUT INTEGER): INTEGER
 556       CALL  MSTAFP(2511, FPL2, 4, 0, NRINT, OUTPI, 22, nblsys)
 557 C XOR: FUNCTION(INPUT X,Y: INTEGER): INTEGER
 558       CALL  MSTAFP(237, FPL2+1, 3, 0, NRINT, OUTPI, -7, nblsys)
 559 C PANELKEYS: FUNCTION: INTEGER
 560       CALL  MSTAFP (1203, FPL3+1, 1, 0, NRINT, OUTPI, 18, nblsys)
 561 C ENDRUN : PROCEDURE
 562       CALL  MSTAFP(2483, 0, 0, 0, 0, 0, 29, nblsys)
 563 C RANSET: PROCEDURE(INPUT X: REAL)
 564       CALL  MSTAFP(2375, FPL1, 1, 0, 0, 0, 30, nblsys)
 565 C CLOCK: PROCEDURE(OUTPUT H,M,S: INTEGER)
 566       CALL  MSTAFP(2369, FPL7, 3, 0, 0, 0, 31, nblsys)
 567 C OPTIONS: FUNCTION: INTEGER
 568       CALL  MSTAFP(1105, FPL3+1, 1, 0, NRINT, OUTPI, 32, nblsys)
 569 C DATE: PROCEDURE (OUTPUT Y,M,D: INTEGER)
 570       CALL  MSTAFP(1685, FPL7, 3, 0, 0, 0, 36, nblsys)
 571 C EXECPAR: FUNCTION: ARRAYOF CHAR
 572       CALL  MSTAFP(2357, FPL8+1, 1, 1, NRCHR, OUTACH, 37, nblsys)
 573 C UNPACK: FUNCTION( INPUT TEXT): ARRAYOF CHAR
 574       CALL  MSTAFP(2247, FPL8, 2, 1, NRCHR, OUTACH, 11, nblsys)
 575 cdsw  --- removed  ------
 576 C#F  NOWE PROCEDURY DLA PLIKOW
 577 C REW: PROCEDURE(INPUT FILE)
 578 cdsw  CALL  MSTAFP(2339, FPL9, 1, 0, 0, 0, 2, nblsys)
 579 C AVF: PROCEDURE(INPUT FILE, INPUT INTEGER)
 580 cdsw  CALL MSTAFP(1343, FPL9, 2, 0, 0, 0, 3, nblsys)
 581 C BVF: PROCEDURE(INPUT FILE, INPUT INTEGER)
 582 cdsw  CALL MSTAFP(1471, FPL9, 2, 0, 0, 0, 4, nblsys)
 583 C WEO: PROCEDURE(INPUT FILE)
 584 cdsw  CALL MSTAFP(  89, FPL9, 1, 0, 0, 0, 5, nblsys)
 585 C PUtREC: PROCEDURE(INPUT FILE, INPUT INTEGER, INPUT ARRAYOF INTEGER)
 586 cdsw  CALL MSTAFP(1243, FPL9, 3, 0, 0, 0, 6, nblsys)
 587 C GETREC: PROCEDURE(INPUT FILE, INPUT INTEGER, INPUT ARRAYOF INTEGER)
 588 cdsw  CALL MSTAFP(  59, FPL9, 3, 0, 0, 0, 7, nblsys)
 589 C ASS: PROCEDURE(INPUT FILE, INPUT TEXT)
 590 cdsw  CALL MSTAFP(2335, FPL10, 2, 0, 0, 0, 8, nblsys)
 591 C ASSIN: PROCEDURE(INPUT STRING)
 592 cdsw  CALL MSTAFP(2241, FPL10+1, 1, 0, 0, 0, 9, nblsys)
 593 C ASSOUT: PROCEDURE(INPUT STRING)
 594 cdsw  CALL MSTAFP(2235, FPL10+1, 1, 0, 0, 0, 10, nblsys)
 595 cfile  ---------------  added  ----------------------
 596 c reset: procedure(input file)
 597       call mstafp(2253,fpl9,1,0,0,0,78, nblsys)
 598 c  rewrite:procedure(input file)
 599       call mstafp(2259,fpl9,1,0,0,0,79, nblsys)
 600 c unlink:procedure(input file)
 601       call mstafp(2087,fpl9,1,0,0,0,80, nblsys)
 602 c seek:procedure(input file,input integer, input integer)
 603       call mstafp(2091,fpl14,3,0,0,0,81, nblsys)
 604 c position : function(input file):integer
 605 #if ( WSIZE == 4 )
 606       call mstafp(2023, fpl16, 2, 0, nrint, outpi, 84, nblsys)
 607 #else
 608       call mstafp(2023, fpl16, 2, 0, nrre,  outpr, 84, nblsys)
 609 #endif
 610 c memavail : function:integer
 611       call mstafp(7847, fpl2+3, 1, 0, nrint, outpi, 98, nblsys)
 612 c exec:function(input arrayof char):integer
 613       call mstafp(2101,fpl13,2,0,nrint,outpi,99, nblsys)
 614 C
 615 cdeb    ------------   debugger ------------
 616 c db01ox:procedure(nr:integer; inout ref1:arrayof integer,
 617 c                  offset:integer, ref2:arrayof integer, realval:real,
 618 c                  intval:integer );
 619       call mstafp(7759,fpl11,6,0,0,0,150, nblsys)
 620
 621 c  sccd01ox : procedure(nr:integer; inout max,lp:integer, bufor:arrayof int );
 622       call mstafp(7739,fpl12,4,0,0,0,151, nblsys)
 623
 624 c  scnd01ox:procedure(output s,k,adres:integer);
 625       call mstafp(7747,fpl7,3,0,0,0,152, nblsys)
 626
 627 c  db01of : procedure(input f1,f2:file);
 628       call mstafp(7753,fpl18,2,0,0,0,153, nblsys)
 629
 630 c  db01oe : procedure;
 631       call mstafp(7731,0,0,0,0,0, 154, nblsys)
 632 cdeb -------------------------------------------
 633
 634 cgr ------------- grafika ------------------
 635
 636 c  utworzenie klasy IIUWGRAPH
 637         prgraph = mstacl(323, nblsys)
 638         grpref = lprefs
 639
 640         outari = mgetm(6,41)+4
 641         ipmem(outari-4) = 1
 642         ipmem(outari-3) = nrint
 643         ipmem(outari+1) = 1
 644         ipmem(outari)   = inhx14
 645
 646         toto = mgetm(6,41)
 647         ipmem(toto)    = inpi
 648         ipmem(toto+1)  = inpi
 649         ipmem(toto+2)  = inpi
 650         ipmem(toto+3)  = inpi
 651         ipmem(toto+4)  = inpi
 652         ipmem(toto+5)  = inpi
 653
 654         toto2 = mgetm(5,41)
 655         ipmem(toto2)   = inpi
 656         ipmem(toto2+1) = inpi
 657         ipmem(toto2+2) = inpi
 658         ipmem(toto2+3) = inpi
 659         ipmem(toto2+4) = inpi
 660
 661         toto3 = mgetm(10,41)
 662         ipmem(toto3)    = inpi
 663         ipmem(toto3+1)  = inpi
 664         ipmem(toto3+2)  = inpi
 665         ipmem(toto3+3)  = inpi
 666         ipmem(toto3+4)  = inpi
 667         ipmem(toto3+5)  = inpi
 668         ipmem(toto3+6)  = inpi
 669         ipmem(toto3+7)  = inpi
 670         ipmem(toto3+8)  = inpi
 671         ipmem(toto3+9)  = outpi
 672
 673         fpl22 = mgetm(9,41)
 674         ipmem(fpl22)   = inpi
 675         ipmem(fpl22+1) = inpi
 676         ipmem(fpl22+2) = inpi
 677         ipmem(fpl22+3) = inpr
 678         ipmem(fpl22+4) = inpr
 679         ipmem(fpl22+5) = inpi
 680         ipmem(fpl22+6) = inpi
 681         ipmem(fpl22+7) = inpi
 682         ipmem(fpl22+8) = inpi
 683
 684         fpl23 = mgetm(3,41)
 685         ipmem(fpl23) = inpi
 686         ipmem(fpl23+1) = inpi
 687         ipmem(fpl23+2) = outari
 688
 689         toto5 = mgetm(9,41)
 690         ipmem(toto5)   = inpi
 691         ipmem(toto5+1) = inpi
 692         ipmem(toto5+2) = inpi
 693         ipmem(toto5+3) = inpi
 694         ipmem(toto5+4) = inptx
 695         ipmem(toto5+5) = inpi
 696         ipmem(toto5+6) = inpi
 697         ipmem(toto5+7) = inpi
 698         ipmem(toto5+8) = outach
 699
 700         toto6 = mgetm(5,41)
 701         ipmem(toto6)   = inpi
 702         ipmem(toto6+1) = inpi
 703         ipmem(toto6+2) = inptx
 704         ipmem(toto6+3) = inpi
 705         ipmem(toto6+4) = inpi
 706
 707         toto7 = mgetm(5,41)
 708         ipmem(toto7)   = inpi
 709         ipmem(toto7+1) = inpari
 710         ipmem(toto7+2) = inpari
 711         ipmem(toto7+3) = inpi
 712         ipmem(toto7+4) = inpi
 713
 714         toto8 = mgetm(8,41)
 715         ipmem(toto8)   = inpi
 716         ipmem(toto8+1) = inpi
 717         ipmem(toto8+2) = inpi
 718         ipmem(toto8+3) = inpi
 719         ipmem(toto8+4) = inpi
 720         ipmem(toto8+5) = inpi
 721         ipmem(toto8+6) = inpi
 722         ipmem(toto8+7) = inpi
 723
 724 c gron:procedure(input integer)
 725         call mstafp(85,fpl2,1,0,0,0,100, prgraph)
 726
 727 c groff: procedure
 728         call mstafp(2273,0,0,0,0,0,101, prgraph)
 729
 730 c cls: procedure
 731         call mstafp(2335,0,0,0,0,0,102, prgraph)
 732
 733 c point: procedure(input integer, input integer)
 734         call mstafp(1231,fpl2,2,0,0,0,103, prgraph)
 735
 736 c move: procedure(input integer, input integer)
 737         call mstafp(2279,fpl2,2,0,0,0,104, prgraph)
 738
 739 c draw: procedure(input integer, input integer)
 740         call mstafp(1719,fpl2,2,0,0,0,105, prgraph)
 741
 742 c hfill: procedure(input integer)
 743         call mstafp(189,fpl2,1,0,0,0,106, prgraph)
 744
 745 c vfill: procedure(input integer)
 746         call mstafp(2237,fpl2,1,0,0,0,107, prgraph)
 747
 748 c color: procedure(input integer)
 749         call mstafp(2231,fpl2,1,0,0,0,108, prgraph)
 750
 751 c style: procedure(input integer)
 752         call mstafp(2225,fpl2,1,0,0,0,109, prgraph)
 753
 754 c patern: procedure(input integer,input integer,input integer,input integer,
 755 c                   input integer,input boolean)
 756         call mstafp(2219,toto,6,0,0,0,110, prgraph)
 757
 758 c intens: procedure(input integer,arrayof int,arrayof int,int,int)
 759         call mstafp(2213,toto7,5,0,0,0,111, prgraph)
 760
 761 c pallet: procedure(input integer)
 762         call mstafp(2207,fpl2,1,0,0,0,112, prgraph)
 763
 764 c border: procedure(input integer)
 765         call mstafp(2201,fpl2,1,0,0,0,113, prgraph)
 766
 767 c video: procedure(input array of integer)
 768         call mstafp(2195,fpl9+2,1,0,0,0,114, prgraph)
 769
 770 c hpage: procedure(input integer, input integer, input integer)
 771         call mstafp(209,fpl2,3,0,0,0,115, prgraph)
 772
 773 c nocard: function: integer
 774         call mstafp(2029,fpl2+3,1,0,nrint,outpi,116, prgraph)
 775
 776 c pushxy: procedure
 777         call mstafp(2185,0,0,0,0,0,117, prgraph)
 778
 779 c popxy: procedure
 780         call mstafp(2179,0,0,0,0,0,118, prgraph)
 781
 782 c inxpos: function: integer
 783         call mstafp(2173,fpl2+3,1,0,nrint,outpi,119, prgraph)
 784
 785 c inypos: function: integer
 786         call mstafp(2167,fpl2+3,1,0,nrint,outpi,120, prgraph)
 787
 788 c inpix: function(input integer, input integer): integer
 789         call mstafp(2161,fpl2+1,3,0,nrint,outpi,121, prgraph)
 790
 791 c getmap: function(input integer, input integer): array of integer
 792         call mstafp(2155,fpl23,3,1,nrint,outari,122, prgraph)
 793
 794 c putmap: procedure(input array of integer)
 795         call mstafp(2149,fpl9+2,1,0,0,0,123, prgraph)
 796
 797 c ormap: procedure(input array of integer)
 798         call mstafp(2143,fpl9+2,1,0,0,0,124, prgraph)
 799
 800 c xormap: procedure(input array of integer)
 801         call mstafp(2137,fpl9+2,1,0,0,0,125, prgraph)
 802
 803 c track: procedure(input integer, input integer,input integer,input integer)
 804         call mstafp(2131,toto2,5,0,0,0,126, prgraph)
 805
 806 c inkey: function: integer
 807         call mstafp(2299,fpl2+3,1,0,nrint,outpi,127, prgraph)
 808
 809 c hascii: procedure(input integer)
 810         call mstafp(2293,fpl2,1,0,0,0,128, prgraph)
 811
 812 c hfont: function(input integer,input integer,input integer,input integer)
 813 c  (intput integer,input integer,input integer,input integer,input integer):
 814 c   integer              new name : gscnum
 815         call mstafp(2125,toto3,10,0,nrint,outpi,129, prgraph)
 816
 817 c hfont8: function(input int, input int,input int,input int,input string
 818 c          intput int,input int,input int) : arrayof char
 819         call mstafp(2119,toto5,9,1,nrchr,outari,130, prgraph)
 820
 821 c outstring: procedure(input int,input int,input string,input int,input int)
 822         call mstafp(2113,toto6,5,0,0,0,131, prgraph)
 823
 824 c cirb: procedure(input x,y,rx,ry,start,end,c,motif :integer)
 825         call mstafp(1573,toto8,8,0,0,0,132, prgraph)
 826
 827 cdsw -------------- mouse ------------------------
 828       prmouse = mstacl(7991, nblsys)
 829       mousepref = lprefs
 830
 831 c fpl30 - output int, output bool
 832       fpl30 = mgetm(2,41)
 833       ipmem(fpl30) = outpi
 834       ipmem(fpl30+1) = outpb
 835
 836 c fpl31 - input integer, output integerl, output integer, output integer,
 837 c             output integer, output integer, output integer
 838       fpl31 = mgetm(7, 41)
 839       ipmem(fpl31) = outpi
 840       ipmem(fpl31+1) = outpi
 841       ipmem(fpl31+2) = outpi
 842       ipmem(fpl31+3) = outpi
 843       ipmem(fpl31+4) = outpi
 844       ipmem(fpl31+5) = outpi
 845       ipmem(fpl31+6) = outpb
 846
 847       toto4 = mgetm(2, 41)
 848       ipmem(toto4)   = inpi
 849       ipmem(toto4+1) = inpi
 850
 851
 852 c init : procedure(mouse,keyboard:integer);
 853       call mstafp(7985, toto4, 2, 0, 0, 0,200,prmouse)
 854
 855 c showcursor : procedure;
 856       call mstafp(1601, 0, 0, 0, 0, 0, 201, prmouse)
 857
 858 c hidecursor : procedure;
 859       call mstafp(7973, 0, 0, 0, 0, 0, 202, prmouse)
 860
 861 c status : procedure(output h,v:integer, l, r, c:boolean)
 862       call mstafp(7963, fpl31+2, 5, 0, 0, 0, 203, prmouse)
 863
 864 c setposition : procedure(h,v:integer);
 865       call mstafp(7957, fpl2, 2, 0, 0, 0, 204, prmouse)
 866
 867 c getpress : function( output h,v,p,l,r,c : integer) : boolean
 868       call mstafp(7945, fpl31, 7, 0, nrbool, outpb, 205, prmouse)
 869
 870 c getrelease : function( output h,v,p,l,r,c : integer) : boolean
 871       call mstafp(7937, fpl31, 7, 0, nrbool, outpb, 206, prmouse)
 872
 873 c setwindow : procedure ( l,r,t,b:integer)
 874       call mstafp(7887, fpl15, 4, 0, 0, 0, 207, prmouse)
 875
 876 c defcursor : procedure (select, x, y:integer)
 877       call mstafp(7917, fpl2, 3, 0, 0, 0, 210, prmouse)
 878
 879 c getmovement : procedure ( input mo,ke:integer)
 880       call mstafp(7907, toto4, 2, 0, 0, 0, 211, prmouse)
 881
 882 c setevent : procedure( m:integer )
 883 c     call mstafp(7865 , fpl2, 1, 0, 0, 0, 212, prmouse)
 884
 885 c setspeed : procedure ( speed:integer)
 886       call mstafp(7895, fpl2, 1, 0, 0, 0, 215, prmouse)
 887
 888 c setmargins : procedure( l, r, t, b : integer)
 889       call mstafp(7927, fpl15, 4, 0, 0, 0, 216, prmouse)
 890
 891 c setthreshold : procedure(t:integer)
 892       call mstafp(7877, fpl2, 1, 0, 0, 0, 219, prmouse)
 893
 894 c  signal mouseevent
 895 c     call mstasg(7857 , 70, prmouse)
 896
 897
 898 C
 899 C.........UTWORZENIE I WSTAWIENIE DO TABLICY HASHU BLOKU GLOWNEGO
 900 C         PROTOTYPOW SYGNALOW STANDARDOWYCH
 901 C
 902 C NUMERROR
 903       CALL MSTASG( 987,  1, nblsys)
 904 C SYSERROR
 905       CALL MSTASG(1635,  2, nblsys)
 906 C LOGERROR
 907       CALL MSTASG(2319, 20, nblsys)
 908 C ACCERROR
 909       CALL MSTASG(1305, 21, nblsys)
 910 C MEMERROR
 911       CALL MSTASG( 827, 22, nblsys)
 912 C CONERROR
 913       CALL MSTASG(2311, 23, nblsys)
 914 C TYPERROR
 915       CALL MSTASG(1995, 24, nblsys)
 916 C
 917
 918       i = nblsys+10
 919 C.......UZUPELNIENIE TABLICY HASHU BLOKU GLOWNEGO O TYPY STANDARDOWE
 920       XX = INSERT(INTNM, IPMEM(I), 41)
 921         IPMEM(XX+2) = NRINT
 922       XX = INSERT(RENM, IPMEM(I), 41)
 923         IPMEM(XX+2) = NRRE
 924       XX = INSERT(BOOLNM, IPMEM(I), 41)
 925         IPMEM(XX+2) = NRBOOL
 926       XX = INSERT(CHRNM, IPMEM(I), 41)
 927         IPMEM(XX+2) = NRCHR
 928 C#F
 929       XX = INSERT(FILENM, IPMEM(I), 41)
 930         IPMEM(XX+2) = NRFILE
 931       XX = INSERT(CORNM, IPMEM(I), 41)
 932         IPMEM(XX+2) = NRCOR
 933       XX = INSERT(PROCNM, IPMEM(I), 41)
 934         IPMEM(XX+2) = NRPROC
 935       XX = INSERT(TEXTNM, IPMEM(I), 41)
 936         IPMEM(XX+2) = NRTEXT
 937       XX = INSERT(NEMPTY, IPMEM(I), 41)
 938         IPMEM(XX+2) = NRUNIV
 939 cdsw
 940 c   stala intsize
 941        xx = insert(2069,ipmem(i),41)
 942        ipmem(xx+2) = wrds1
 943 c   stala realsize
 944        xx = insert(2061,ipmem(i),41)
 945        ipmem(xx+2) = wrds2
 946
 947
 948 C
 949 C
 950       LPMSYS = LPML
 951 C
 952 C*******INICJALIZACJA SYSPP - W RAZIE POTRZEBY
 953       IF (SYSPP)    CALL  MLSPP
 954       RETURN
 955       END
 956
 957 cdsw      SUBROUTINE MSTASG( HNAME, NRSIG)
 958       subroutine mstasg( hname, nrsig, sl)
 959 C------------- TWORZENIE PROTOTYPU SYGNALU STANDARDOWEGO
 960 C              JEST ON SKROCONY I NIE POSIADA TABLICY HASHU
 961 C              NAZW ATRYBUTOW. OSTATNIM SLOWEM JEST +7.
 962 C              PROCEDURA WYWOLYWANA JEDYNIE Z INIT
 963 C              WERSJA Z DN. 16 05 83
 964
 965       IMPLICIT INTEGER(A-Z)
 966 CALL BLANK
 967       LOGICAL  INSYS, OWN
 968       COMMON /BLANK/ COM(278),
 969      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
 970      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
 971      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
 972      X        LOCAL , OWN   , OBJECT,
 973      X        IPMEM(5000)
 974 CALL #
 975       data msthex /x'00b1'/
 976
 977 C GENERACJA I INICJLIZACJA PROTOTYPU
 978       IPROT = MGETM(9, 41) + 1
 979 cdsw      IPMEM(IPROT-1) = NBLSYS
 980       ipmem(iprot-1) = sl
 981       IPMEM(IPROT) = MSTHEX
 982       IPMEM(IPROT+1) = NRSIG
 983 C
 984 C DODANIE NQZWY SYGNALU DO TBLICY HASHU W NBLYS
 985 cdsw      XX = INSERT(HNAME, IPMEM(NBLSYS+10), 41)
 986       xx = insert(hname, ipmem(sl+10), 41)
 987 C NAZWA SYGNALU JEST CLOSED
 988       IPMEM(XX+1) = 1
 989       IPMEM(XX+2) = IPROT
 990       RETURN
 991       END
 992
 993       SUBROUTINE  MSTAFP( HNAME, FPLIST, FPLENG, NDIM, NTYPE, NRESLT,
 994      x                    nrfp, sl)
 995 cdsw     X                        NRFP)
 996 C----------------PROCEDURA TWORZY PROTOTYP FUNKCJI STANDARDOWEJ
 997 C                I PROCEDURY STANDARDOWEJ - WTEDY NTYPE=0
 998 C                HNAME - NAZWA ZE SCANNERA TWORZONEJ FUNKCJI
 999 C                FPLIST, FPLENG - INDEKS LISTY PAR. FORM. I JEJ DLUGOSC
1000 C                NDIM, NTYPE - TYP FUNKCJI
1001 C                NRESLT - OPIS ATRYBUTU RESULT
1002 C                NRFP - ROZROZNIENIE FUNKCJI - WARTOSC DLA GENERATORA KODU
1003 c                sl - adres prototypu obejmujacego
1004 C
1005 C             WERSJA Z DNIA:                19.01.82
1006 C               (DLA PROCEDURY INIT)
1007 C             DLUGOSC KODU:  157
1008 C..................................................................
1009 C
1010       IMPLICIT INTEGER (A-Z)
1011 C
1012 CALL BLANK
1013       LOGICAL  INSYS, OWN
1014       COMMON /BLANK/ COM(278),
1015      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1016      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1017      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1018      X        LOCAL , OWN   , OBJECT,
1019      X        IPMEM(5000)
1020 CALL #
1021 C
1022 C
1023 CDSW  DATA MAFPHEX1,MAFPHEX2 /Z0201,Z0401/
1024       data mafhx1, mafhx2 / x'0201',x'0401'/
1025
1026
1027 cdsw  I = NBLSYS+10
1028       i = sl+10
1029 C
1030       IF (NTYPE .EQ. 0)    GOTO  100
1031 C-----FUNKCJA
1032       IPROT = MGETM(10, 41) + 5
1033       IPMEM(IPROT-5) = NRESLT
1034       IPMEM(IPROT-4) =  NDIM
1035       IPMEM(IPROT-3) = NTYPE
1036       IPMEM(IPROT) = mafhx1
1037       GOTO  200
1038 C-----PROCEDURA
1039   100 IPROT = MGETM(7, 41) + 2
1040       IPMEM(IPROT) = mafhx2
1041 C-----OBYDWIE RAZEM
1042 cdsw   200 IPMEM(IPROT-1) = NBLSYS
1043   200 ipmem(iprot-1) = sl
1044       IPMEM(IPROT+1) = 1
1045       IPMEM(IPROT+2) = NRFP
1046       IPMEM(IPROT+3) = FPLIST
1047       IPMEM(IPROT+4) = FPLENG
1048       XX = INSERT(HNAME, IPMEM(I), 41)
1049       IPMEM(XX+2) = IPROT
1050       RETURN
1051       END
1052
1053 cdsw  new procedure
1054
1055       integer function mstacl ( hname, sl)
1056       implicit integer (a-z)
1057
1058 CALL BLANK
1059       LOGICAL  INSYS, OWN
1060       COMMON /BLANK/ COM(278),
1061      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1062      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1063      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1064      X        LOCAL , OWN   , OBJECT,
1065      X        IPMEM(5000)
1066
1067       common /prefs/lprefs
1068 c  lprefs - ostatnio przydzielony numer w prefixset
1069
1070       insys = .false.
1071       prot = mgetm(33,41) + 7
1072       ipmem(prot) = 3
1073       ipmem(prot-1) = sl
1074       ipmem(prot+9) = 0
1075       xx = insert(hname, ipmem(sl+10), 41)
1076       ipmem(xx+2) = prot
1077 c  ustawienie prefixset i prefixlist
1078       i = mgetm(1,41)
1079       ipmem(i) = prot
1080       ipmem(prot+22) = i
1081       ipmem(prot+23) = 1
1082       call msetb(prot,2)
1083       lprefs = lprefs+1
1084       call msetb(prot,lprefs)
1085       ipmem(prot-6) = lprefs
1086 c inicjalizacja listy atrybutow
1087       ipmem(prot+7 ) = prot+5
1088       ipmem(prot+5) = nattr
1089       mstacl = prot
1090       insys = .true.
1091       return
1092       end
1093
1094       SUBROUTINE  MLSPP
1095 C-----------------------INICJUJE PROTOTYPY ANALIZY SEMANTYCZNEJ DLA
1096 C                       KLASY SYSPP
1097 C
1098       IMPLICIT INTEGER (A-Z)
1099 C
1100 CALL BLANK
1101       LOGICAL  INSYS, OWN
1102       COMMON /BLANK/ COM(278),
1103      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1104      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1105      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1106      X        LOCAL , OWN   , OBJECT,
1107      X        IPMEM(5000)
1108 cdsw  DATA MLSPHEX1,MLSPHEX2,MLSPHEX3 /ZC007,ZC061,ZC051/
1109 c    #c007 --> -#3ff9, #c061 --> -#3f9f, #c051 --> -#3faf
1110       data mlphx1, mlphx2, mlphx3 / -x'3ff9', -x'3f9f',-x'3faf' /
1111 CALL #
1112 C
1113 C----------POPRAWIENIE SLOW +3 I +4 W BLOKU SYSTEMOWYM
1114 C     +4 - JEST SYSPP
1115       IPMEM(NBLSYS+4) = 1
1116 C     +3 - OSTATNIO UZYTY NUMER W SENSIE PREFIXSET
1117       IPMEM(NBLSYS+3) = IPMEM(NBLSYS+3)+4
1118 C
1119 C **** UTWORZENIE KLASY SYSPP
1120       SYSPP = MLINCL (2, 3, NBLSYS, NBLSYS)
1121       IPMEM(NBLSYS+8) = SYSPP
1122 C **** UTWORZENIE KLASY PROCES
1123       PPROC = MLINCL(2469, 4, SYSPP, SYSPP)
1124 C       --POPRAWIENIE NA COROUTINE
1125       CALL  MSETB(PPROC, 0)
1126       IPMEM(PPROC) = mlphx1
1127 C **** UTWORZENIE KLASY SLOWNIK
1128       SLOW = MLINCL(1609, 5, SYSPP, PPROC)
1129 C **** UTWORZENIE KLASY SEMAFOR
1130       SEM = MLINCL(2477, 6, SYSPP, SLOW)
1131 C
1132 C****** WNETRZE KLASY PROCES
1133 C     ----WAITN: FUNCTION: PROCES
1134 C       --LISTA PF
1135       PFL = MGETM(1, 41)
1136 C       --PROTOTYP
1137       PROT = MLINFP(2431, PFL, 1, 0, PPROC, PPROC, SEM)
1138       PREV = PROT
1139 C       --OPIS PARAMETRU
1140       PAR = MLPAR(0, PPROC, 2, mlphx2  , PROT)
1141       IPMEM(PROT-5) = PAR
1142       IPMEM(PFL) = PAR
1143 C     ----STOPAR: PROCEDURE(INPUT Z: SEMAFOR)
1144 C       --LISTA PF
1145       PFL = MGETM(1, 41)
1146 C       --PROTOTYP
1147       PROT = MLINFP(2437, PFL, 1, 0, 0, PPROC, PREV)
1148       PREV = PROT
1149 C       --OPIS PF
1150       IPMEM(PFL) = MLPAR(0, SEM, 2, mlphx3  , PROT)
1151 C     ----WAITP: FUNCTION(INPUT Y:PROCES): PROCES
1152 C       --LISTA PF
1153       PFL = MGETM(2, 41)
1154 C       PROTOTYP
1155       PROT = MLINFP(2443, PFL, 2, 0, PPROC, PPROC, PREV)
1156       PREV = PROT
1157 C       --OPISY PF
1158       IPMEM(PFL) = MLPAR(0, PPROC, 2, mlphx3  , PROT)
1159       PAR = MLPAR(0, PPROC, 4, mlphx2  , PROT)
1160       IPMEM(PFL+1) = PAR
1161       IPMEM(PROT-5) = PAR
1162 C     ----STOPP: PROCEDURE
1163       PROT = MLINFP(2449, 0, 0, 0, 0, PPROC, PREV)
1164       PREV = PROT
1165 C     ----RESUMEP: PROCEDURE(INPUT X: PROCES)
1166 C       --LISTA PF
1167       PFL = MGETM(1, 41)
1168 C       --PROTOTYP
1169       DUPA = DUPA
1170 C BEZ TEJ DUPY FTS DAJE ZLY KOD WYNIKOWY
1171       PROT = MLINFP(2457, PFL, 1, 0, 0, PPROC, PREV)
1172       PREV = PROT
1173 C       --OPIS PF
1174       IPMEM(PFL) = MLPAR(0, PPROC, 2, mlphx3  , PROT)
1175 C
1176 C ***** WNETRZE SLOWNIK (KLASA LINK JEST NIEWIDOCZNA!!!)
1177 C     ----AMEMBER: FUNCTION: PROCES
1178 C       --LISTA PF
1179       PFL = MGETM (1, 41)
1180 C       --PROTOTYP
1181       PROT = MLINFP(1325, PFL, 1, 0, PPROC, SLOW, PREV)
1182       PREV = PROT
1183 C       --OPIS PF
1184       PAR = MLPAR(0, PPROC, 2, mlphx2  , PROT)
1185       IPMEM(PFL) = PAR
1186       IPMEM(PROT-5) = PAR
1187 C     ----DELETE: PROCEDURE(INPUT X: PROCES)
1188 C       --LISTA PF
1189       PFL = MGETM(1, 41)
1190 C       --PROTOTYP
1191       PROT = MLINFP(2393, PFL, 1, 0, 0, SLOW, PREV)
1192       PREV = PROT
1193 C       --OPIS PF
1194       IPMEM(PFL) = MLPAR(0, PPROC, 3, Mlphx3  , PROT)
1195 C     ----MIN: FUNCTION: PROCES
1196 C       --LISTA PF
1197       PFL =MGETM(1, 41)
1198 C       --PROTOTYP
1199       PROT = MLINFP(835, PFL, 1, 0, PPROC, SLOW, PREV)
1200       PREV = PROT
1201 C       --OPIS PF
1202       PAR = MLPAR(0, PPROC, 2, MLphx2  , PROT)
1203       IPMEM(PFL) = PAR
1204       IPMEM(PROT-5) = PAR
1205 C     ----EMPTY: FUNCTION: BOOLEAN
1206 C       --LISTA PF
1207       PFL = MGETM(1, 41)
1208 C       --PROTOTYP
1209       PROT = MLINFP(1837, PFL, 1, 0, NRBOOL, SLOW, PREV)
1210       PREV = PROT
1211 C       --OPIS PF
1212       PAR = MLPAR(0, NRBOOL, 2,mlphx2   , PROT)
1213       IPMEM(PFL) = PAR
1214       IPMEM(PROT-5) = PAR
1215 C     ----INSERT: PROCEDURE(INPUT X: PROCES)
1216 C       --LISTA PF
1217       PFL = MGETM(1, 41)
1218 C       --PROTOTYP
1219       PROT = MLINFP(2405, PFL, 1, 0, 0, SLOW, PREV)
1220       PREV = PROT
1221 C       --OPIS PF
1222       IPMEM(PFL) = MLPAR(0, PPROC, 2, mlphx3  , PROT)
1223 C
1224 C ***** WNETRZE SEMAFOR
1225 C     ----UNLOCKP: PROCEDURE
1226 C       --PROTOTYP
1227       PROT = MLINFP(2413, 0, 0, 0, 0, SEM, PREV)
1228       PREV = PROT
1229 C     ----LOCKP: PROCEDURE
1230 C       --PROTOTYP
1231       PROT = MLINFP(2419, 0, 0, 0, 0, SEM, PREV)
1232       PREV = PROT
1233 C     ----UP:  PROCEDURE
1234 C       --PROTOTYP
1235       PROT = MLINFP(2421, 0, 0, 0, 0, SEM, PREV)
1236       PREV = PROT
1237 C     ----TSP: FUNCTION: BOOLEAN
1238 C       --LISTA PF
1239       PFL = MGETM(1, 41)
1240 C       --PROTOTYP
1241       PROT =MLINFP(2425, PFL, 1, 0, NRBOOL, SEM, PREV)
1242 C       --OPIS PF
1243       PAR = MLPAR(0, NRBOOL, 2, mlphx2  , PROT)
1244       IPMEM(PFL) = PAR
1245       IPMEM(PROT-5) = PAR
1246 C
1247 C******I TO JUZ KONIEC INICJALIZACJI
1248       RETURN
1249       END
1250       INTEGER FUNCTION  MLINCL(HNAME, PREFNR, SL, PREV)
1251 C---------------------INICJUJE PROTOTYPY KLAS BIBLIOTECZNYCH Z SYSPP
1252 C
1253       IMPLICIT INTEGER (A-Z)
1254 C
1255 CALL BLANK
1256       LOGICAL  INSYS, OWN
1257       COMMON /BLANK/ COM(278),
1258      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1259      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1260      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1261      X        LOCAL , OWN   , OBJECT,
1262      X        IPMEM(5000)
1263 cdsw  DATA MLCLHEX1,MLCLHEX2,MLCLHEX3 /ZC003,ZA021,Z8000/
1264 c   #c003 --> -#3ffd, #a021 --> -#5fdf, #8000  --> undef
1265       data mlchx1, mlchx2  /-x'3ffd', -x'5fdf' /
1266       mlchx2 = ishft(X'0001',15)
1267 CALL #
1268 C
1269       MLINCL = MGETM(33, 41)+7
1270       PREFL = MGETM(1, 41)
1271       IPMEM(PREFL) = MLINCL
1272       IPMEM(MLINCL-6) = PREFNR
1273       IPMEM(MLINCL-3) = 4
1274       CALL  MSETB(MLINCL, PREFNR)
1275       IPMEM(MLINCL-1) = SL
1276       IPMEM(MLINCL) = mlchx1
1277       IPMEM(MLINCL+1) = mlchx2
1278       IPMEM(MLINCL+9) = mlchx3
1279       IPMEM(MLINCL+22) = PREFL
1280       IPMEM(MLINCL+23) = 1
1281 C----DOLACZENIE DO LISTY NEXTDECL
1282       IPMEM(PREV+2) = MLINCL
1283       XX = INSERT(HNAME, IPMEM(SL+10), 41)
1284       IPMEM(XX+2) = MLINCL
1285       RETURN
1286       END
1287       INTEGER FUNCTION  MLINFP (HNAME, FPLIST, FPLENG, NDIM, NTYPE,
1288      X                            SL, PREV)
1289 C-----------------------INICJUJE PROTOTYPY FUNKCJI I PROCEDUR Z SYSPP
1290 C
1291       IMPLICIT INTEGER (A-Z)
1292 C
1293 CALL BLANK
1294       LOGICAL  INSYS, OWN
1295       COMMON /BLANK/ COM(278),
1296      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1297      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1298      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1299      X        LOCAL , OWN   , OBJECT,
1300      X        IPMEM(5000)
1301 cdsw  DATA MLFPHEX1,MLFPHEX2/Z0201,Z0401/
1302       data mlfhx1, mlfhx2/x'0201',x'0401'/
1303 CALL #
1304 C
1305       I = SL+10
1306       IF (NTYPE .EQ. 0)    GOTO  100
1307 C-----FUNCKJA
1308       MLINFP = MGETM(29, 41)+5
1309       IPMEM(MLINFP-4) = NDIM
1310       IPMEM(MLINFP-3) = NTYPE
1311 C     ---OPIS ATRYBUTU RESULT POWINIEN BYC WSTAWIONY NA ZEWNATRZ
1312       IPMEM(MLINFP) = mlfhx1
1313       GOTO  200
1314 C-----PROCEDURA
1315   100 MLINFP = MGETM(26, 41)+2
1316       IPMEM(MLINFP) = mlfhx2
1317 C-----OBYDWIE
1318   200 IPMEM(MLINFP-1) = SL
1319       IPMEM(MLINFP+1) = 1
1320       IPMEM(MLINFP+3) = FPLIST
1321       IPMEM(MLINFP+4) = FPLENG
1322 C----DOLACZENIE DO NEXTDECL
1323       IPMEM(PREV+2) = MLINFP
1324       XX = INSERT(HNAME, IPMEM(I), 41)
1325       IPMEM(XX+2) = MLINFP
1326       RETURN
1327       END
1328       INTEGER FUNCTION  MLPAR  (NDIM, NTYPE, OFF, ZERWRD, SL)
1329 C----------------WPROWADZA OPIS PARAMETRU FORMALNEGO WRAZ Z OFFSETEM
1330 C
1331       IMPLICIT INTEGER (A-Z)
1332 C
1333 CALL BLANK
1334       LOGICAL  INSYS, OWN
1335       COMMON /BLANK/ COM(278),
1336      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1337      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1338      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1339      X        LOCAL , OWN   , OBJECT,
1340      X        IPMEM(5000)
1341 CALL #
1342 C
1343       MLPAR = MGETM(6, 41)+4
1344       IPMEM(MLPAR-4) = NDIM
1345       IPMEM(MLPAR-3) = NTYPE
1346       IPMEM(MLPAR-1) = SL
1347       IPMEM(MLPAR) = ZERWRD
1348       IPMEM(MLPAR+1) = OFF
1349       RETURN
1350       END
1351       SUBROUTINE  TORD (PRNR)
1352 C--------------PROCEDURA PORZADKUJACA TYPY KLASOWE DEKLAROWANE W PROTO-
1353 C             TYPIE O ADRESIE  PRNR . SORTOWANIE TOPOLOGICZNE ODBYWA SIE
1354 C             ZE WZGLEDU NA PREFIKSOWANIE.
1355 C             WYJSCIEM Z PROCEDURY JEST UPORZADKOWANA (W PROTOTYPIE  PRNR)
1356 C             LISTA TYPOW W KOLEJNOSCI OBROBKI DEKLARACJI. EWENTUALNE CYKLE
1357 C             SA ROZERWANE.
1358 C          SYGNALIZOWANY BLAD:
1359 C             399 - TYPY KLASOWE TWORZA CYKL ZE WZGLEDU NA PREFIKSOWANIE
1360 C                       (PROCEDURA TSORT)
1361 C             398 - PREFIKS I TYP PREFIKSOWANY JEST TEN SAM
1362 C
1363 C-----------------------------------------------------------------------------
1364 C             POMOCNICZE STRUKTURY DANYCH
1365 C
1366 C     W CZASIE TWORZENIA GRAFU DO SORTOWANIA UZYWANA JEST LOKALNA TABLICA
1367 C     HASH'U  THASH. ELEMENT LISTY HASH'U BEDACY JEDNOCZESNIE ELEMENTEM
1368 C     DO SORTOWANIA MA NASTEPUJACA BUDOWE:
1369 C     --> 0 - NAZWA MODULU
1370 C        +1 - LICZNIK ODWOLAN W CZSIE SORTOWANIA
1371 C        +2 - POCZATEK LISTY NASTEPNIKOW, TZN. ELEMENTOW PREFIKSOWANYCH
1372 C                 PRZEZ DANA KLASE
1373 C        +3 - NASTEPNY ELEMENT W LISCIE HASH-U
1374 C             W CZASIE SORTOWANIA - FLAGA "PROCESSED"= 1 GDY ELEMENT JEST
1375 C             JUZ WSORTOWANY
1376 C        +4 - NUMER PROTOTYPU W SLOWNIKU  ISDICT,
1377 C              0 - GDY NAZWA OPISUJE PROTOTYP NIEZADEKLAROWANY W  PRNR
1378 C              -1 - GDY TYP DEKLAROWANY BYL WIELOKROTNIE
1379 C        +5 - NEXTZERO - INDEKS NASTEPNEGO ELEMENTU Z ZEROWYM LICZNIKIEM
1380 C             PO WSORTOWANIU - INDEKS ELEMENTU NASTEPNEGO W UTWORZONYM
1381 C             PORZADKU LINIOWYM
1382 C        +6 - INDEKS NASTEPNEGO ELEMENTU W LISCIE DO SORTOWANIA
1383 C             (UZYWANY DO WYKRYCIA CYKLI)
1384 C        +7 - ELEMENT DO SORTOWANIA ODPOWIADAJACY BEZPOSREDNIEMU
1385 C             PREFIKSOWI (UZYWANY PRZY ROZRYWANIU CYKLI)
1386 C
1387 C     ELEMENT LISTY NASTEPNIKOW (WSKAZYWANEJ PRZEZ SLOWO +2) MA POSTAC
1388 C     --> 0 - ELEMENT DO SORTOWANIA ODPOWIADAJACY TYPOWI PREFIKSOWANEMU,
1389 C             0 - GDY TEN NASTEPNIK ZOSTAL USUNIETY (ROZERWANY CYKL)
1390 C        +1 - NASTEPNY ELEMENT LISTY
1391 C
1392 C     ELEMENTY WIELOKROTNIE DEKLAROWANE TWORZA POMOCNICZA LISTE WSKAZY-
1393 C     WANA PRZEZ ZMIENNA  ELIST POSTACI:
1394 C     --> 0 - NUMER PROTOTYPU W SLOWNIKU ISDICT
1395 C        +1 - NASTEPNY ELEMENT LISTY
1396 C
1397 C
1398 C     TE STRUKTURY PRZECHOWYWANE SA W  IPMEM ZA CZESCIA PRZEZNACZONA
1399 C     NA PROROTYPY SYSTEMOWE. REZERWACJA PAMIECI JEST WYKONYWANA PRZEZ
1400 C     PROCEDURE  MGETM .
1401 C
1402 C-----------------------------------------------------------------------------
1403 C
1404 C
1405 C
1406 C             OPIS W DOKUMENTACJI:          D.II.4.1
1407 C             WERSJA Z DNIA:                19.01.82
1408 C             DLUGOSC KODU:        220
1409 C..........................................................................
1410 C
1411       IMPLICIT INTEGER (A-Z)
1412 C
1413 CALL STREAM
1414       LOGICAL  ERRFLG
1415       COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
1416 CALL BLANK
1417       LOGICAL  INSYS, OWN
1418       COMMON /BLANK/ COM(278),
1419      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1420      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1421      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1422      X        LOCAL , OWN   , OBJECT,
1423      X        IPMEM(5000)
1424 CALL TC
1425       COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1426 CALL #
1427 C.............................................................................
1428 C             WSTEPNE ZBADANIE PROTOTYPU  PRNR
1429 C     SORTOWANIE NIE JEST WYKONYWANE, GDY LISTA TYPOW ZAWIERA MNIEJ NIZ
1430 C     DWA ELEMENTY
1431 C
1432       ILT = IPMEM(PRNR+5)
1433       IF (ILT .EQ. 0)    RETURN
1434       IF ( IPMEM(ILT+1) .EQ. 0)    GOTO  300
1435 C
1436 C.............................................................................
1437 C
1438 C INICJALIZACJA ZMIENNYCH
1439       SLIST = 0
1440       ELIST = 0
1441       SNUMB = 0
1442       OLPML = LPML
1443       INORD = MGETM(8,0)
1444       OUTORD = INORD
1445       ZFIRST = 0
1446 C
1447 C*******************************************
1448 C           UTWORZENIE GRAFU POWIAZAN ORAZ LIST TYPOW DO SORTOWANIA
1449 C
1450       CALL  TGRAPH
1451 C
1452 C*******************************************
1453 C           SORTOWANIE TOPOLOGICZNE
1454 C
1455       IF (SNUMB .EQ. 0)    GOTO  200
1456 C        --LISTA DO SORTOWANIA JEST PUSTA
1457 C
1458       CALL  TZLINK
1459 C        -- LACZENIE W LISTE ELEMENTOW Z ZEROWYM LICZNIKIEM
1460 C
1461   100 CALL  TSORT
1462       IF (SNUMB .EQ. 0)    GOTO  200
1463 C        -- GDY SNUMB JEST ROZNE OD ZERA, TO ISTNIEJE CYKL. WOWCZAS
1464 C        ROZERWANIE CYKLU I MODYFIKACJA GRAFU ORAZ LISTY ELEMENTOW
1465 C        Z ZEROWYM LICZNIKIEM I PONOWNE SORTOWANIE
1466 C
1467       CALL  TSPLIT
1468       GOTO  100
1469 C
1470 C********************************************
1471 C           ODTWORZENIE LISTY TYPOW W KOLEJNOSCI DO OBROBKI
1472 C           DEKLARACJI
1473 C
1474   200 CALL  TORDER(PRNR)
1475       LPML = OLPML
1476       RETURN
1477 C
1478 C************************************************
1479 C     SPRAWDZENIE, CZY TYP DO SORTOWANIA NIE JEST PREFIKSOWANY
1480 C     PRZEZ SAMEGO SIEBIE
1481   300 ILT = IPMEM(ILT)
1482 C          ILT - NUMER W ISDICT PROTOTYPU SORTOWANEGO
1483       ILT = IPMEM(ILT)
1484 C             ILT - PROTOTYP SORTOWANY
1485       IF ( IPMEM(ILT+2) .EQ. NEMPTY)    RETURN
1486 C           PROTOTYP NIE JEST PREFIKSOWANY - POWROT
1487       NAME = IPMEM(ILT+10)
1488       IF ( NAME .NE. IPMEM(ILT+2) )    RETURN
1489 C         NAZWY SA ROZNE - POWROT
1490 C     ...SYGNALIZACJA BLEDU
1491       LINE = IPMEM(ILT+9)
1492       CALL  MERR(398, NAME)
1493       IPMEM(ILT+2) = NEMPTY
1494       IPMEM(ILT) = 7
1495 C           ZAMARKOWANIE USZKODZONEJ LISTY PARAMETROW
1496       RETURN
1497       END
1498       SUBROUTINE  TGRAPH
1499 C--------------UTWORZENIE GRAFU POWIAZAN, LIST TYPOW DO SORTOWANIA
1500 C             ORAZ WIELOKROTNIE DEKLAROWANYCH
1501 C
1502 C             OPIS W DOKUMENTACJI:             D.II.4.2
1503 C             WERSJA Z DNIA:                   19.01.82
1504 C             DLUGOSC KODU:        590
1505 C......................................................................
1506 C
1507       IMPLICIT INTEGER (A-Z)
1508 cdsw  INTEGER THASH(8)
1509       dimension thash(8)
1510 C             POMOCNICZA TABLICA HASH-U
1511 C
1512 CALL BLANK
1513       LOGICAL  INSYS, OWN
1514       COMMON /BLANK/ COM(278),
1515      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1516      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1517      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1518      X        LOCAL , OWN   , OBJECT,
1519      X        IPMEM(5000)
1520 CALL TC
1521       COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1522 CALL STREAM
1523       LOGICAL  ERRFLG
1524       COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
1525 CALL #
1526 C     ZNACZENIE ZMIENNYCH
1527 C       ILT - ELEMENT LISTY DEKLAROWANYCH TYPOW
1528 C       DICTN - NUMER PROTOTYPU W SLOWNIKU ISDICT
1529 C       PRAD - ADRES PROTOTYPU W  IPMEM
1530 C       NAME - NAZWA TYPU
1531 C       IHT - ELEMENT LISTY HASH-U
1532 C
1533 C
1534       DO  10 I=1,8
1535         THASH(I) = 0
1536    10 CONTINUE
1537 C
1538 C*****************************************************************************
1539 C             PRZETWARZANIE ELEMENTU  ILT  Z LISTY TYPOW
1540 C
1541  1000 DICTN = IPMEM(ILT)
1542       PRAD = IPMEM(DICTN)
1543       NAME = IPMEM(PRAD+10)
1544       IF (NAME .EQ. NEMPTY)    GOTO  2500
1545 C             NAZWA PUSTA - SKOK DO WPISANIA TYPU DO LISTY TYPOW ZLE
1546 C             ZADEKLAROWANYCH
1547 C---------------------------------------------------------------------------
1548 C     SPRAWDZENIE, CZY TYP NIE JEST PREFIKSOWANY SAM SOBA
1549       IF ( NAME .NE. IPMEM(PRAD+2) )    GOTO  1050
1550       LINE = IPMEM(PRAD+9)
1551         CALL  MERR(398, NAME)
1552         IPMEM(PRAD+2) = NEMPTY
1553         IPMEM(PRAD) = 7
1554  1050 CONTINUE
1555 C-----------------------------------------------------------------------------
1556 C     ODSZUKANIE NAZWY
1557       IHT = MEMBER(NAME, THASH)
1558       IF (IHT .EQ. 0)    GOTO  1100
1559 C.....TU - NAZWA JUZ WYSTEPUJE W LISCIE HASH-U
1560 C     SPRAWDZENIE ,CZY POPRZEDNIE WYSTAPIENIE NIE BYLO DEKLARACJA NAZWY,
1561 C     JESLI TAK -TO BLAD
1562       IF ( IPMEM(IHT+4) .NE. 0)    GOTO  2000
1563 C             BYLA WCZESNIEJ DEKLAROWANA, SKOK DO ZLE ZADEKLAROWANEGO TYPU
1564       GOTO  1200
1565 C
1566 C-----------------------------------------------------------------------------
1567 C     TWORZENIE NOWEGO ELEMENTU LISTY DO SORTOWANIA
1568  1100 IHT = MGETM(8,0)
1569       IPMEM(IHT) = NAME
1570       I = IAND (ISHFT(NAME,-1), 7) + 1
1571       IPMEM(IHT+3) = THASH(I)
1572       THASH(I) = IHT
1573 C     WLACZENIE DO LISTY TYPOW DO SORTOWANIA
1574       IPMEM(IHT+6) = SLIST
1575       SLIST = IHT
1576       SNUMB = SNUMB+1
1577 C     WPISANIE NUMERU PROTOTYPU
1578  1200 IPMEM(IHT+4) = DICTN
1579 C
1580 C-----------------------------------------------------------------------------
1581 C     SPRAWDZENIE PREFIKSOWANIA
1582 C             INP - NAZWA BEZPOSREDNIEGO PREFIKSU
1583       INP = IPMEM(PRAD+2)
1584       IF (INP .EQ. 0)    GOTO  5000
1585 C             TYP NIE JEST PREFIKSOWANY - SKOK DO POBRANIA NASTEPNEGO
1586 C             ELEMENTU LISTY TYPOW
1587 C-----------------------------------------------------------------------------
1588 C     WYSZUKANIE NAZWY PREFIKSU
1589 C             PRAD - ELEMENT DO SORTOWANIA ODPOWIADAJACY PREFIKSOWI
1590       PRAD = MEMBER (INP, THASH)
1591       IF (PRAD .NE. 0)    GOTO  1300
1592 C             SKOK, GDY ELEMENT ODPOWIADAJACY PREFIKSOWI JEST JUZ
1593 C             W LISCIE DO SORTOWANIA
1594 C     WPROWADZENIE NOWEGO OPISU
1595       PRAD = MGETM(8, 0)
1596       IPMEM(PRAD) = INP
1597       I = IAND (ISHFT(INP,-1), 7) + 1
1598       IPMEM(PRAD+3) = THASH(I)
1599       THASH(I) = PRAD
1600       IPMEM(PRAD+6) = SLIST
1601       SLIST = PRAD
1602       SNUMB = SNUMB + 1
1603 C--------UTWORZENIE POWIAZANIA
1604  1300 I = MGETM(2,0)
1605       IPMEM(I) = IHT
1606       IPMEM(I+1) = IPMEM(PRAD+2)
1607       IPMEM(PRAD+2) = I
1608       IPMEM(IHT+7) = PRAD
1609       IPMEM(IHT+1) = 1
1610 C-------PRZEJSCIE DO POBIERANIA NASTEPNEGO ELEMENTU LISTY TYPOW
1611       GOTO  5000
1612 C
1613 C-----------------------------------------------------------------------------
1614 C     TYPY ZLE ZADEKLAROWANE
1615 C
1616 C------TYPY DEKLAROWANE WIELOKROTNIE
1617  2000 IF ( IPMEM(IHT+4) .EQ. -1)    GOTO  2500
1618 C-------PRZESUNIECIE TYPU WCZESNIEJ DEKLAROWANEGO DO LISTY TYPOW
1619 C     ZLE ZADEKLAROWANYCH
1620       INP = IHT
1621       I = IPMEM(INP+4)
1622       IPMEM(INP+4) = -1
1623       IHT = MGETM(2,0)
1624       IPMEM(IHT) = I
1625       IPMEM(IHT+1) = ELIST
1626       ELIST = IHT
1627 C-------USUNIECIE KRAWEDZI W PREFIKSIE TEGO TYPU
1628       IHT = IPMEM(INP+7)
1629 C          IHT - GDY ROZNE OD ZERA JEST OPISEM ELEMENTU ODPOWIADAJACEGO
1630 C         PREFIKSOWI
1631       IF (IHT .EQ. 0)    GOTO  2500
1632 C.....USUNIECIE KRAWEDZI W LISCIE NASTEPNIKOW PREFIKSU
1633       IHT = IPMEM(IHT+2)
1634 C          IHT - ELEMENT LISTY NASTEPNIKOW
1635  2100 IF (IHT .EQ. 0)    GOTO  2500
1636       IF ( IPMEM(IHT) .EQ. INP)    GOTO  2200
1637 C         TO BYL ELEMENT ODPOWIADAJACY POLACZENIU
1638       IHT = IPMEM(IHT+1)
1639       GOTO  2100
1640  2200 IPMEM(IHT) = 0
1641       IPMEM(INP+1) = 0
1642 C------DOLACZENIE AKTUALNEGO TYPU DO LISTY TYPOW ZLE ADEKLAROWANYCH
1643  2500 IHT = MGETM(2,0)
1644       IPMEM(IHT) = DICTN
1645       IPMEM(IHT+1) = ELIST
1646       ELIST = IHT
1647 C-----------------------------------------------------------------------------
1648 C     POBRANIE NASTEPNEGO ELEMENTU LISTY TYPOW
1649  5000 ILT = IPMEM(ILT+1)
1650       IF (ILT .NE. 0)    GOTO  1000
1651 C*****************************************************************************
1652       RETURN
1653       END
1654       SUBROUTINE  TZLINK
1655 C--------------LACZENIE W LISTE ROZPOCZYNAJACA SIE OD ZFIRST
1656 C             ELEMENTOW Z ZEROWYM LICZNIKIEM.
1657 C             ///PRZY OKAZJI USUNIECIE W PROTOTYPACH PREFIKSOW ODPOWIADAJACYCH
1658 C             TYPOM WIELOKROTNIE DEKLAROWANYM
1659 C
1660 C             OPIS W DOKUMENTACJI:          D.II.4.3
1661 C             WERSJA Z DNIA:                19.01.82
1662 C             DLUGOSC KODU:        135
1663 C........................................................................
1664 C
1665       IMPLICIT INTEGER (A-Z)
1666 C
1667 CALL BLANK
1668       LOGICAL  INSYS, OWN
1669       COMMON /BLANK/ COM(278),
1670      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1671      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1672      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1673      X        LOCAL , OWN   , OBJECT,
1674      X        IPMEM(5000)
1675 CALL TC
1676       COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1677 CALL #
1678 C
1679       I = SLIST
1680 C*****************************************************************************
1681  1000 IPR = IPMEM(I+7)
1682       IF ( IPMEM(IPR+4) .NE. -1)    GOTO  1100
1683 C--------USUNIECIE PREFIKSU Z PROTOTYPU , GDY PREFIKS
1684 C     BYL TYPEM ZLE ZADEKLAROWANYM
1685       IPR = IPMEM(I+4)
1686       IPR = IPMEM(IPR)
1687       IPMEM(IPR+2) = NEMPTY
1688       IPMEM(IPR) = 7
1689 C         ZAMARKOWANIE BLEDNEJ LISTY PARAMETROW
1690       IPMEM(I+1) = 0
1691  1100 IF (IPMEM(I+1) .NE. 0)    GOTO  1500
1692       IPMEM(I+5) = ZFIRST
1693       ZFIRST = I
1694  1500 IPMEM(I+3) = 0
1695 C             USTAWIENIE FLAGI "PROCESSED"
1696 C------POBRANIE NASTEPNEGO ELEMENTU LISTY DO SORTOWANIA
1697       I = IPMEM(I+6)
1698       IF (I .NE. 0)    GOTO  1000
1699 C*****************************************************************************
1700       RETURN
1701       END
1702       SUBROUTINE  TSORT
1703 C--------------SORTOWANIE TOPOLOGICZNE - CZESC WLASCIWA
1704 C
1705 C             OPIS W DOKUMENTACJI:           D.II.4.4
1706 C             WERSJA Z DNIA:                 19.01.82
1707 C             DLUGOSC KODU:        146
1708 C...................................................................
1709 C
1710       IMPLICIT INTEGER (A-Z)
1711 C
1712 CALL BLANK
1713       LOGICAL  INSYS, OWN
1714       COMMON /BLANK/ COM(278),
1715      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1716      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1717      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1718      X        LOCAL , OWN   , OBJECT,
1719      X        IPMEM(5000)
1720 CALL TC
1721       COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1722 CALL #
1723 C
1724 C     ILT - ROZPATRYWANY ELEMENT Z ZEROWYM LICZNIKIEM
1725  1000 ILT = ZFIRST
1726       IF (ILT .EQ. 0)    RETURN
1727       ZFIRST = IPMEM(ILT + 5)
1728       IPMEM(OUTORD+5) = ILT
1729       OUTORD = ILT
1730       SNUMB = SNUMB - 1
1731 C     USTAWIENIE FLAGI "PROCESSED"
1732       IPMEM(ILT+3) = 1
1733 C     ZMNIEJSZENIE LICZNIKOW ELEMENTOM PREFIKSOWANYM
1734 C     PRZEZ ILT
1735 C     ....SPRAWDZENIE, CZY SORTOWANY PROTOTYP NIE JEST PROTOTYPEM
1736 C     ZLYCH DEKLARACJI - DLA NIEGO NIE MA ELEMENTOW PREFIKSOWANYCH
1737       IF (IPMEM(ILT+4) .EQ. -1)    GOTO  1500
1738 C     INE - ELEMENT LISTY NASTEPNIKOW
1739       INE = IPMEM(ILT+2)
1740  1100 IF (INE .EQ. 0)    GOTO  1500
1741         I = IPMEM(INE)
1742         IF (I .EQ. 0)    GOTO  1200
1743 C             SKOK, GDY POLACZENIE JEST OMINIETE
1744 C     I -ELEMENT ODPOWIADAJACY TYPOWI PREFIKSOWANEMU
1745         IPMEM(I+1) = 0
1746         IPMEM(I+5) = ZFIRST
1747         ZFIRST = I
1748 C     POBRANIE NASTEPNEGO ELEMENTU LISTY NASTEPNIKOW
1749  1200 INE = IPMEM(INE+1)
1750       GOTO  1100
1751 C-------POBRANIE NASTEPNEGO ELEMENTUU DO SORTOWANIA
1752  1500 GOTO  1000
1753       END
1754       SUBROUTINE  TSPLIT
1755 C--------------PROCEDURA ROZRYWANIA CYKLI W LISCIE TYPOW DO
1756 C             PRZETWORZENIA.
1757 C             ZNAJDUJE TYP NAJWCZESNIEJ DEKLAROWANY, USUWA MU PREFIKS
1758 C             I MODYFIKUJE GRAF DO SORTOWANIA
1759 C     SYGNALIZOWANY BLAD:
1760 C             399 - WYSTAPIENIE CYKLU W PREFIKSOWANIU
1761 C
1762 C             OPIS W DOKUMENTACJI:           D.II.4.5
1763 C             WERSJA Z DNIA:                 19.01.82
1764 C             DLUGOSC KODU:        287
1765 C..................................................................
1766 C
1767       IMPLICIT INTEGER (A-Z)
1768 C
1769 CALL STREAM
1770       LOGICAL  ERRFLG
1771       COMMON /STREAM/  ERRFLG, LINE, IBUF2(265), IBUF3(7),JUNK(260)
1772 CALL BLANK
1773       LOGICAL  INSYS, OWN
1774       COMMON /BLANK/ COM(278),
1775      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1776      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1777      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1778      X        LOCAL , OWN   , OBJECT,
1779      X        IPMEM(5000)
1780 CALL TC
1781       COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1782 CALL #
1783 C
1784 C     ILT - ELEMENT LISTY DO SORTOWANIA ODPOWIADAJACY NAJWCZESNIEJ
1785 C             DEKLAROWANEMU PROTOTYPOWI
1786 C     LMIN - NUMER NAJWCZESNIEJSZEJ LINII
1787 C     IE - AKTUALNY ELEMENT LISTY DO SORTOWANIA
1788 C
1789       IE = SLIST
1790       LMIN = 32767
1791 C         NAJWIEKSZA STALA CALKOWITA
1792 C*****************************************************************************
1793  1000 CONTINUE
1794       IF (IPMEM(IE+3) .EQ. 1)    GOTO  1500
1795 C             SKOK, GDY TEN TYP JEST JUZ PRZETWORZONY
1796       IPR = IPMEM(IE+4)
1797       IPR = IPMEM(IPR)
1798 C     IPR - PROTOTYP TYPU ODPOWIADAJACEGO  IE
1799       LINE = IPMEM(IPR+9)
1800       IF (LINE .GT. LMIN)    GOTO  1500
1801 C....TU POTENCJALNY KANDYDAT NA USUNIECIE CYKLU
1802 C     SPRAWDZENIE, CZY TEN ELEMENT WYSTEPUJE W CYKLU
1803         ILOOP = IE
1804 C       MARKOWANIE CYKLU
1805  1100   IPMEM(ILOOP+3) = -1
1806         ILOOP = IPMEM(ILOOP+7)
1807 C           TO JEST PREFIKS ILOOP
1808         IF (IPMEM(ILOOP+3) .NE. -1)    GOTO  1100
1809         IF (ILOOP .NE. IE)    GOTO  1200
1810 C     --WYSTAPIL W CYKLU
1811         LMIN = LINE
1812         ILT = IE
1813 C     --PRZYWROCENIE STAREGO MARKOWANIA CYKLU
1814  1200   ILOOP = IE
1815  1300   IPMEM(ILOOP+3) = 0
1816         ILOOP = IPMEM(ILOOP+7)
1817         IF (IPMEM(ILOOP+3) .NE. 0)    GOTO  1300
1818 C---------POBRANIE NASTEPNEGO ELEMENTU LISTY DO SORTOWANIA
1819  1500 IE = IPMEM(IE+6)
1820       IF (IE .NE. 0)    GOTO  1000
1821 C
1822 C*****************************************************************************
1823 C     ILT JEST PROTOTYPEM TYPU NAJWCZESNIEJ DEKLAROWANEGO
1824       IPR = IPMEM(ILT+4)
1825       IPR = IPMEM(IPR)
1826       NAME = IPMEM(IPR+10)
1827       LINE = LMIN
1828 C     ...SYGNALIZACJA BLEDU
1829       CALL  MERR(399, NAME)
1830 C......USUNIECIE PREFIKSU
1831       IPMEM(IPR+2) = 0
1832 C......"USZKODZENIE" LISTY PARAMETROW
1833       IPMEM(IPR) = 7
1834 C.....WSTAWIENIE DO LISTY ELEMENTOW Z ZEROWYM LICZNIKIEM
1835       ZFIRST = ILT
1836 C------USUNIECIE POWIAZANIA Z PREFIKSEM
1837       IPR = IPMEM(ILT+7)
1838 C             IPR - ELEMENT LISTY DO SORTOWANIA ODPOWIADAJACY PREFIKSOWI
1839       IPR = IPMEM(IPR+2)
1840 C             LISTA NASTEPNIKOW PREFIKSU
1841  2000 IF (IPMEM(IPR) .EQ. ILT)    GOTO  2100
1842         IPR = IPMEM(IPR+1)
1843       GOTO  2000
1844  2100 IPMEM(IPR) = 0
1845       RETURN
1846       END
1847       SUBROUTINE  TORDER (PRNR)
1848 C------------WPISANIE DO LISTY TYPOW PRNR TYPOW TAM DEKLAROWANYCH
1849 C             W KOLEJNOSCI OBROBKI DEKLARACJI
1850 C
1851 C             OPIS W DOKUMENTACJI:         D.II.4.6
1852 C             WERSJA Z DNIA:               19.01.82
1853 C             DLUGOSC KODU:        117
1854 C.........................................................................
1855 C
1856 C
1857       IMPLICIT INTEGER(A-Z)
1858 C
1859 CALL BLANK
1860       LOGICAL  INSYS, OWN
1861       COMMON /BLANK/ COM(278),
1862      X        LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
1863      X        NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
1864      X        NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
1865      X        LOCAL , OWN   , OBJECT,
1866      X        IPMEM(5000)
1867 CALL TC
1868       COMMON /TC/ SLIST, ELIST, SNUMB, ILT, ZFIRST, INORD, OUTORD
1869 CALL #
1870 C
1871       ILT = IPMEM(PRNR+5)
1872 C       ILT - ELEMENT LISTY TYPOW DEKLAROWANYCH
1873 C
1874 C*****************************************************************************
1875 C     WPISANIE TYPOW Z LISTY INORD (NA POCZATKU JEST STRAZNIK)
1876  1000 INORD = IPMEM(INORD+5)
1877       IF (INORD .EQ. 0)    GOTO  2000
1878       IF (IPMEM(INORD+4) .LE. 0)    GOTO  1000
1879 C             -OMINIECIE TYPOW NIELOKALNYCH
1880       IPMEM(ILT) = IPMEM(INORD+4)
1881       ILT = IPMEM(ILT+1)
1882       GOTO  1000
1883 C*****************************************************************************
1884 C     WPISANIE TYPOW Z LISTY TYPOW ZLE ZADEKLAROWANYCH
1885  2000 IF (ELIST .EQ. 0)    RETURN
1886       IPMEM(ILT) = IPMEM(ELIST)
1887       ELIST = IPMEM(ELIST+1)
1888       ILT = IPMEM(ILT+1)
1889       GOTO  2000
1890       END
1891
1892